From 8a199176af85b6c29ee5fb3a088fca139212711d Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Tue, 1 Oct 2019 16:00:16 -0700
Subject: [PATCH] desugar compiles

---
 pkg/proto/lib/Untyped/Hoon.hs | 28 +++++++++++++++++++---------
 1 file changed, 19 insertions(+), 9 deletions(-)

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