5
5
6
6
Defines helper functions related to free variables and substitutions.
7
7
-}
8
- module FSM.FreeVars where
8
+ module FSM.FreeVars (
9
+ FreeVars (.. ), FreeVarsPat (.. ), PatFV (.. ),
10
+ patSingleton , patFreeSingleton , patFreeVars , underPat ,
11
+ boundVars , freeVarsFunMap ,
12
+ Subst (.. ), substSingle , rename , renameSingle , boundAsVars , substPat ,
13
+ isConstantExpr
14
+ ) where
9
15
10
16
import qualified Language.Haskell.TH as TH
11
17
import qualified Data.Set as S
@@ -16,29 +22,46 @@ import FSM.Desc
16
22
import Control.Arrow
17
23
import qualified FSM.Util.SetClass as SC
18
24
25
+ -- | Things that have free variables.
19
26
class FreeVars a where
20
27
freeVars :: SC. SetClass s => a -> s TH. Name
21
28
29
+ -- | Things that have bound and free variables.
22
30
class FreeVarsPat a where
23
31
freeVarsPat :: SC. SetClass s => a -> PatFV s
24
32
25
- data PatFV s = PatFV { patBound :: s TH. Name , patFree :: s TH. Name }
33
+ {-|
34
+ Represents bound and free variables (e.g. for a pattern).
35
+ A Haskell pattern can both bind variables, and have free variables (e.g.
36
+ in view patterns).
37
+ -}
38
+ data PatFV s = PatFV {
39
+ patBound :: s TH. Name , -- ^ Bound variables.
40
+ patFree :: s TH. Name -- ^ Free variables.
41
+ }
26
42
27
43
instance SC. SetClass s => Semigroup (PatFV s ) where
28
44
PatFV s1 s2 <> PatFV t1 t2 = PatFV (s1 `SC.union` t1) (s2 `SC.union` t2)
29
45
30
46
instance SC. SetClass s => Monoid (PatFV s ) where
31
47
mempty = PatFV mempty mempty
32
48
49
+ -- | A single bound variable.
33
50
patSingleton :: SC. SetClass s => TH. Name -> PatFV s
34
51
patSingleton n = PatFV (SC. singleton n) mempty
35
52
53
+ -- | A single free variable.
36
54
patFreeSingleton :: SC. SetClass s => TH. Name -> PatFV s
37
55
patFreeSingleton n = PatFV mempty (SC. singleton n)
38
56
57
+ -- | Free variables of something, as a 'PatFV'.
39
58
patFreeVars :: (SC. SetClass s , FreeVars a ) => a -> PatFV s
40
59
patFreeVars e = PatFV mempty (freeVars e)
41
60
61
+ {-|
62
+ Free variables under a pattern. The pattern's bound variables
63
+ reduce the set of free variables; its free variables extend it.
64
+ -}
42
65
underPat :: SC. SetClass s => s TH. Name -> PatFV s -> s TH. Name
43
66
underPat s (PatFV bs fs) = fs <> (s `SC.difference` bs)
44
67
@@ -48,6 +71,7 @@ underPatFV (PatFV bs1 fs1) (PatFV bs2 fs2) = PatFV (bs1 <> bs2) (fs2 <> (fs1 `SC
48
71
freeVarsUnderPat :: (SC. SetClass s , FreeVarsPat a ) => s TH. Name -> a -> s TH. Name
49
72
freeVarsUnderPat s p = s `underPat` freeVarsPat p
50
73
74
+ -- | Bound vars of something.
51
75
boundVars :: (SC. SetClass s , FreeVarsPat a ) => a -> s TH. Name
52
76
boundVars = patBound . freeVarsPat
53
77
@@ -57,6 +81,7 @@ instance FreeVars a => FreeVars (Maybe a) where
57
81
instance FreeVarsPat a => FreeVarsPat (Maybe a ) where
58
82
freeVarsPat = maybe mempty id . fmap freeVarsPat
59
83
84
+ -- | Free variables of a function set.
60
85
freeVarsFunMap :: (IsDesugared l , SC. SetClass s ) => FunMap l -> s TH. Name
61
86
freeVarsFunMap = mconcat . map (\ (_, (p, s)) -> freeVars s `freeVarsUnderPat` p) . M. toList
62
87
@@ -199,7 +224,9 @@ substName :: M.Map TH.Name TH.Exp -> TH.Name -> TH.Exp
199
224
substName s n | Just e <- M. lookup n s = e
200
225
| otherwise = TH. VarE n
201
226
227
+ -- | Things that can have expressions substituted for variables.
202
228
class Subst a where
229
+ -- | Variable substitution.
203
230
subst :: M. Map TH. Name TH. Exp -> a -> a
204
231
205
232
instance Subst TH. Exp where
@@ -323,19 +350,23 @@ instance Subst a => Subst [a] where
323
350
instance Subst a => Subst (Maybe a ) where
324
351
subst s = fmap (subst s)
325
352
353
+ -- | Perform a single variable substitution.
326
354
substSingle :: Subst a => TH. Name -> TH. Exp -> a -> a
327
355
substSingle n e = subst (M. singleton n e)
328
356
329
357
instance Subst VStmt where
330
358
subst su (VExp e) = VExp (subst su e)
331
359
subst su (VCall n e) = VCall n (subst su e)
332
360
361
+ -- | Rename variables (substitute variables for variables).
333
362
rename :: Subst a => M. Map TH. Name TH. Name -> a -> a
334
363
rename su = subst (M. map TH. VarE su)
335
364
365
+ -- | Rename a single variable.
336
366
renameSingle :: Subst a => TH. Name -> TH. Name -> a -> a
337
367
renameSingle n n' = substSingle n (TH. VarE n')
338
368
369
+ -- | Variables bound in @as@ patterns.
339
370
boundAsVars :: TH. Pat -> S. Set TH. Name
340
371
boundAsVars (TH. LitP _) = mempty
341
372
boundAsVars (TH. VarP _) = mempty
@@ -355,6 +386,7 @@ boundAsVars (TH.ListP ps) = mconcat $ map boundAsVars ps
355
386
boundAsVars (TH. SigP p _) = boundAsVars p
356
387
boundAsVars (TH. ViewP _ p) = boundAsVars p
357
388
389
+ -- | Substitute a pattern for a bound variable in a pattern.
358
390
substPat :: M. Map TH. Name TH. Pat -> TH. Pat -> TH. Pat
359
391
substPat _ p@ (TH. LitP _) = p
360
392
substPat s p@ (TH. VarP n) | Just p' <- M. lookup n s = p'
@@ -407,6 +439,11 @@ isConstructorExpr (TH.UnboundVarE _) = False
407
439
isConstructorExpr (TH. LabelE _) = False
408
440
isConstructorExpr (TH. ImplicitParamVarE _) = False
409
441
442
+ {-|
443
+ Expressions that can be substituted without duplicating circuits.
444
+ In digital circuits, constructors are represented as bundles of wires,
445
+ and therefore can be duplicated without a performance penalty.
446
+ -}
410
447
isConstantExpr :: TH. Exp -> Bool
411
448
isConstantExpr (TH. VarE _) = True
412
449
isConstantExpr e = isConstructorExpr e
0 commit comments