Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use DriveVoid typeclass instead of Default for underscored circuits #25

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Use DriveVoid typeclass instead of Default for underscored circuits #25

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
f5f5ab0
use Void typeclass instead of Default for underscored circuits
t-wallet Jul 24, 2024
64f5661
Change Void to DriveVoid
t-wallet Jul 25, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 16 additions & 4 deletions src/Circuit.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,10 +54,22 @@ data DF (dom :: Domain) a
data DFM2S a = DFM2S Bool a
newtype DFS2M = DFS2M Bool

instance Default (DFM2S a) where
def = DFM2S False (error "error default")
instance Default DFS2M where
def = DFS2M True
-- | For /dev/null-like circuits: always acknowledge incoming data
-- while never sending out data. Used for ignoring streams with an underscore prefix.
class DriveVoid a where
driveVoid :: a

instance DriveVoid () where
driveVoid = ()

instance (DriveVoid a) => DriveVoid (Signal dom a) where
driveVoid = pure driveVoid

instance DriveVoid (DFM2S a) where
driveVoid = DFM2S False (error "void")

instance DriveVoid DFS2M where
driveVoid = DFS2M True

type instance Fwd (DF dom a) = Signal dom (DFM2S a)
type instance Bwd (DF dom a) = Signal dom DFS2M
Expand Down
14 changes: 7 additions & 7 deletions src/CircuitNotation.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,6 @@ module CircuitNotation
-- base
import Control.Exception
import qualified Data.Data as Data
import Data.Default
import Data.Maybe (fromMaybe)
#if __GLASGOW_HASKELL__ >= 900
#else
Expand Down Expand Up @@ -1173,21 +1172,20 @@ completeUnderscores = do
binds <- L.use circuitBinds
masters <- L.use circuitMasters
slaves <- L.use circuitSlaves
let addDef :: String -> PortDescription PortName -> CircuitM ()
addDef suffix = \case
let addVoid :: String -> PortDescription PortName -> CircuitM ()
addVoid suffix = \case
Ref (PortName loc (unpackFS -> name@('_':_))) -> do
let bind = patBind (varP loc (name <> suffix)) (tagE $ varE loc (thName 'def))
let bind = patBind (varP loc (name <> suffix)) (tagE $ varE loc (driveVoid ?nms))
circuitLets <>= [L loc bind]

_ -> pure ()
addBind :: Binding exp PortName -> CircuitM ()
addBind (Binding _ bOut bIn) = do
L.traverseOf_ L.cosmos (addDef "_Fwd") bOut
L.traverseOf_ L.cosmos (addDef "_Bwd") bIn
L.traverseOf_ L.cosmos (addVoid "_Fwd") bOut
L.traverseOf_ L.cosmos (addVoid "_Bwd") bIn
mapM_ addBind binds
addBind (Binding undefined masters slaves)


-- | Transform declarations in the module by converting circuit blocks.
transform
:: (?nms :: ExternalNames)
Expand Down Expand Up @@ -1321,6 +1319,7 @@ data ExternalNames = ExternalNames
, fwdBwdCon :: GHC.RdrName
, fwdAndBwdTypes :: Direction -> GHC.RdrName
, trivialBwd :: GHC.RdrName
, driveVoid :: GHC.RdrName
, consPat :: GHC.RdrName
}

Expand All @@ -1335,6 +1334,7 @@ defExternalNames = ExternalNames
, fwdAndBwdTypes = \case
Fwd -> GHC.Unqual (OccName.mkTcOcc "Fwd")
Bwd -> GHC.Unqual (OccName.mkTcOcc "Bwd")
, driveVoid = GHC.Unqual (OccName.mkVarOcc "driveVoid")
, trivialBwd = GHC.Unqual (OccName.mkVarOcc "unitBwd")
#if __GLASGOW_HASKELL__ > 900
, consPat = GHC.Unqual (OccName.mkDataOcc ":>!")
Expand Down