urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-21 09:51:36 +03:00
Code Issues Packages Projects Releases Wiki Activity

desugar compiles

Browse Source
This commit is contained in:
pilfer-pandex 2019-10-01 16:00:16 -07:00
parent b57f8973c4
commit 8a199176af
1 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
pkg/proto/lib/Untyped/Hoon.hs
View File

@ -2,8 +2,8 @@ module Untyped.Hoon where
import ClassyPrelude
import Bound
import Bound.Name
import Control.Monad.State
import Noun
import Untyped.Core
@ -17,9 +17,9 @@ data Hoon a
| CenBar a (Hoon a)
| CenGar (Hoon a) (Hoon a)
| CenGal (Hoon a) (Hoon a)
| CenKet (Hoon a) (Hoon a) (Hoon a)
| CenTar [Hoon a]
| TisFas a (Hoon a)
-- | CenKet (Hoon a) (Hoon a) (Hoon a)
-- | CenTar [Hoon a]
| TisFas a (Hoon a) (Hoon a)
| DotLus (Hoon a)
| DotTis (Hoon a) (Hoon a)
| WutCol (Hoon a) (Hoon a) (Hoon a)
@ -36,11 +36,21 @@ desugar :: Eq a => Hoon a -> Exp a
desugar = go
where
go = \case
HVar v -> Var v
HCons h j -> Cel (go h) (go j)
BarCen cs -> undefined --Lam $ Scope $ go $ WutHep (Var (B ()))
-- CenBar cs -> Fix $ Scope
WutHep h cs -> undefined
HVar v -> Var v
HCons h j -> Cel (go h) (go j)
BarCen cs -> Lam $ Scope $ branch (Var . F . go) (Var (B ())) cs
BarHep r s i h -> go $ CenGar i $ CenBar r $ BarTis s $ h
BarTis v h -> lam v (go h)
CenBar v h -> fix v (go h)
CenGar h j -> App (go j) (go h)
CenGal h j -> App (go h) (go j)
TisFas v h j -> ledt v (go h) (go j)
DotLus h -> Suc (go h)
DotTis h j -> Eql (go h) (go j)
WutCol h j k -> Ift (go h) (go j) (go k)
-- or branch go (go h) cs
WutHep h cs -> Let (go h) $ Scope $ branch (Var . F . go) (Var (B ())) cs
ZapZap -> Zap
branch :: (Hoon b -> Exp a) -> Exp a -> Cases b -> Exp a
branch go e = foldr f Zap