diff --git a/circat.cabal b/circat.cabal index cccd914..258ef55 100755 --- a/circat.cabal +++ b/circat.cabal @@ -47,6 +47,7 @@ Library Circat.Shift Circat.Mealy Circat.Scan + Circat.Doubli Circat.Complex Circat.FFT Circat.Circuit diff --git a/src/Circat/Circuit.hs b/src/Circat/Circuit.hs index 09369cc..98e9eda 100644 --- a/src/Circat/Circuit.hs +++ b/src/Circat/Circuit.hs @@ -125,6 +125,7 @@ import TypeUnary.Vec hiding (get) -- TODO: Eliminate most of the following, as I move data types out of circat import Circat.Misc (Unit,(:*),(<~),Unop,Binop) +import Circat.Doubli import Circat.Complex import Circat.Category import Circat.Classes @@ -207,7 +208,7 @@ data Buses :: * -> * where BoolB :: Source -> Buses Bool IntB :: Source -> Buses Int FloatB :: Source -> Buses Float - DoubleB :: Source -> Buses Double + DoubleB :: Source -> Buses Doubli PairB :: Buses a -> Buses b -> Buses (a :* b) FunB :: (a :> b) -> Buses (a -> b) IsoB :: Buses (Rep a) -> Buses a @@ -298,7 +299,7 @@ instance GenBuses Float where delay = primDelay ty = const FloatT -instance GenBuses Double where +instance GenBuses Doubli where genBuses' = genBus DoubleB 64 delay = primDelay ty = const DoubleT @@ -334,9 +335,15 @@ isoErr nm = error (nm ++ ": IsoB") pairB :: Buses a :* Buses b -> Buses (a :* b) pairB (a,b) = PairB a b +-- Workaround for "spurious non-exhaustive warning with GADT and newtypes" +-- . +#define BogusMatch(name) name _ = error "BogusMatch" +#define BogusAlt _ -> error "BogusMatch" + unUnitB :: Buses Unit -> Unit unUnitB UnitB = () unUnitB (IsoB _) = isoErr "unUnitB" +BogusMatch(unUnitB) unPairB :: Buses (a :* b) -> Buses a :* Buses b #if 0 @@ -346,14 +353,14 @@ unPairB (IsoB _) = isoErr "unPairB" -- Lazier unPairB w = (a,b) where - a = case w of PairB p _ -> p IsoB _ -> isoErr "unPairB" + BogusAlt b = case w of PairB _ q -> q IsoB _ -> isoErr "unPairB" - + BogusAlt -- (a,b) = case w of -- PairB p q -> (p,q) -- IsoB _ -> isoErr "unPairB" @@ -363,6 +370,7 @@ unPairB w = (a,b) unFunB :: Buses (a -> b) -> (a :> b) unFunB (FunB circ) = circ unFunB (IsoB _) = isoErr "unFunB" +BogusMatch(unFunB) exlB :: Buses (a :* b) -> Buses a exlB = fst . unPairB @@ -801,7 +809,7 @@ class SourceToBuses a where toBuses :: Source -> Buses a instance SourceToBuses Bool where toBuses = BoolB instance SourceToBuses Int where toBuses = IntB instance SourceToBuses Float where toBuses = FloatB -instance SourceToBuses Double where toBuses = DoubleB +instance SourceToBuses Doubli where toBuses = DoubleB sourceB :: SourceToBuses a => Source -> CircuitM (Maybe (Buses a)) sourceB = justA . toBuses diff --git a/src/Circat/Doubli.hs b/src/Circat/Doubli.hs new file mode 100644 index 0000000..6855df0 --- /dev/null +++ b/src/Circat/Doubli.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -Wall #-} + +-- {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TEMP +-- {-# OPTIONS_GHC -fno-warn-unused-binds #-} -- TEMP + +---------------------------------------------------------------------- +-- | +-- Module : Circat.Doubli +-- Copyright : (c) 2016 Conal Elliott +-- License : BSD3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- newtype wrapper around Double to work around a problem finding instances +-- defined in GHC.Float. +---------------------------------------------------------------------- + +module Circat.Doubli where + +newtype Doubli = Doubli Double + deriving (Enum,Eq,Floating,Fractional,Num,Ord,Read,Real,RealFloat,RealFrac,Show) + diff --git a/src/Circat/Prim.hs b/src/Circat/Prim.hs index 93831de..6c86f37 100644 --- a/src/Circat/Prim.hs +++ b/src/Circat/Prim.hs @@ -59,6 +59,7 @@ import Circat.Circuit (GenBuses,(:>) import Circat.Misc import Circat.ShowUtils (Show'(..)) import Circat.Show (showsApp1) +import Circat.Doubli {-------------------------------------------------------------------- Literals @@ -70,7 +71,7 @@ data Lit :: * -> * where BoolL :: Bool -> Lit Bool IntL :: Int -> Lit Int FloatL :: Float -> Lit Float - DoubleL :: Double -> Lit Double + DoubleL :: Doubli -> Lit Doubli -- The Unit argument is just for uniformity @@ -91,7 +92,7 @@ instance HasLit Unit where toLit = UnitL instance HasLit Bool where toLit = BoolL instance HasLit Int where toLit = IntL instance HasLit Float where toLit = FloatL -instance HasLit Double where toLit = DoubleL +instance HasLit Doubli where toLit = DoubleL -- TODO: Do I still need this stuff?