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 1 commit
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 Void a where
driveVoid :: a

instance Void () where
driveVoid = ()

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

instance Void (DFM2S a) where
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Do we need this? I can see in the code addDef could be used for a Forward, But when does this happen?

Copy link
Author

@t-wallet t-wallet Jul 24, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The examples do not only contain function like this:

fstC2 :: Circuit (Signal domain a, Signal domain b) (Signal domain a)
fstC2 = circuit $ \ab -> do
  (a, _b) <- idC -< ab
  idC -< a

But also functions like this:

unfstC3 :: Circuit (DF dom a) (DF dom a, DF dom b)
unfstC3 = circuit $ \a -> do
  ab <- idC -< (a, _b)
  ab' <- idC -< ab
  idC -< ab'

So you can easily create an empty stream if you need it.

driveVoid = DFM2S False (error "void")

instance Void 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
6 changes: 3 additions & 3 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 @@ -1176,7 +1175,7 @@ completeUnderscores = do
let addDef :: String -> PortDescription PortName -> CircuitM ()
t-wallet marked this conversation as resolved.
Show resolved Hide resolved
addDef 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 ()
Expand All @@ -1187,7 +1186,6 @@ completeUnderscores = do
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