diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2024-08-30 17:48:15 +0200 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2024-08-30 17:48:15 +0200 |
| commit | 8b047ff11ebd4715647bfc041a190f72dcf4d5a9 (patch) | |
| tree | e8440120b7bbd4e45b367acb3f7185d25e7f3766 /src/AST/Weaken.hs | |
| parent | f4b94d7cc2cb05611b462ba278e4f12f7a7a5e5e (diff) | |
Migrate to accumulators (mostly removing EVM code)
Diffstat (limited to 'src/AST/Weaken.hs')
| -rw-r--r-- | src/AST/Weaken.hs | 23 |
1 files changed, 14 insertions, 9 deletions
diff --git a/src/AST/Weaken.hs b/src/AST/Weaken.hs index 4b3016d..d992404 100644 --- a/src/AST/Weaken.hs +++ b/src/AST/Weaken.hs @@ -36,7 +36,7 @@ data env :> env' where WIdx :: Idx env t -> (t : env) :> env deriving instance Show (env :> env') -infixr @> +infixr 2 @> (@>) :: env :> env' -> Idx env t -> Idx env' t WId @> i = i WSink @> i = IS i @@ -48,6 +48,7 @@ WClosed _ @> i = case i of {} WIdx j @> IZ = j WIdx _ @> IS i = i +infixr 3 .> (.>) :: env2 :> env3 -> env1 :> env2 -> env1 :> env3 (.>) = flip WThen @@ -70,14 +71,18 @@ wCopies :: SList f bs -> env1 :> env2 -> Append bs env1 :> Append bs env2 wCopies SNil w = w wCopies (SCons _ spine) w = WCopy (wCopies spine w) --- wStack :: forall env b1 b2. b1 :> b2 -> Append b1 env :> Append b2 env --- wStack WId = WId --- wStack WSink = WSink --- wStack (WCopy w) = WCopy (wStack @env w) --- wStack (WPop w) = WPop (wStack @env w) --- wStack (WThen w1 w2) = WThen (wStack @env w1) (wStack @env w2) --- wStack (WClosed s) = wSinks s --- wStack (WIdx i) = WIdx (_ i) +wStack :: forall env b1 b2. b1 :> b2 -> Append b1 env :> Append b2 env +wStack WId = WId +wStack WSink = WSink +wStack (WCopy w) = WCopy (wStack @env w) +wStack (WPop w) = WPop (wStack @env w) +wStack (WThen w1 w2) = WThen (wStack @env w1) (wStack @env w2) +wStack (WClosed s) = wSinks s +wStack (WIdx i) = WIdx (goIdx i) + where + goIdx :: Idx b t -> Idx (Append b env) t + goIdx IZ = IZ + goIdx (IS i') = IS (goIdx i') wRaiseAbove :: SList f env1 -> SList g env -> env1 :> Append env1 env wRaiseAbove SNil env = WClosed (slistMap (\_ -> Const ()) env) |