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