diff --git a/pkg/proto/lib/Untyped/Hoon.hs b/pkg/proto/lib/Untyped/Hoon.hs index ea3fb7652a..5f0ace50c5 100644 --- a/pkg/proto/lib/Untyped/Hoon.hs +++ b/pkg/proto/lib/Untyped/Hoon.hs @@ -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