ohhhhhhhh

src/Rlp/Parse.y

@@ -183,9 +183,8 @@ CaseExpr    :: { Expr' RlpcPs SrcSpan }
             : case Expr of layout0(Alt)     { nolo' $ CaseEF $2 $4 }
 
 -- TODO: where-binds
-Alt         :: { Alt RlpcPs }
+Alt         :: { Alt' RlpcPs SrcSpan }
-            : Pat '->' Expr                 { AltA $1 (collapse . strip $ $3)
+            : Pat '->' Expr                 { undefined }
-                                                Nothing }
 
 -- layout0(p : β) :: [β]
 layout0(p)  : '{' layout_list0(';',p) '}'   { $2 }
@@ -204,8 +203,8 @@ layout1(p)  : '{' layout_list1(';',p) '}'   { $2 }
 layout_list1(sep,p) : p                          { [$1] }
                     | layout_list1(sep,p) sep p  { $1 `snoc` $3 }
 
-Binding     :: { Binding RlpcPs }
+Binding     :: { Binding RlpcPs (Cofree (ExprF RlpcPs) SrcSpan) }
-            : Pat '=' Expr              { PatB $1 (collapse . strip $ $3) }
+            : Pat '=' Expr              { undefined }
 
 Expr1       :: { Expr' RlpcPs SrcSpan }
             : '(' Expr ')'              { $2 }
@@ -232,7 +231,10 @@ Con         :: { PsName }
 
 {
 
-parseRlpProgR :: Text -> RLPCT m (Program )
+parseRlpProgR :: Text -> RLPCT m (Program RlpcPs SrcSpan)
+parseRlpProgR = undefined
+
+parseRlpExprR :: Text -> RLPCT m (Expr' RlpcPs SrcSpan)
 parseRlpExprR = undefined
 
 mkInfixD :: Assoc -> Int -> PsName -> P (Decl RlpcPs SrcSpan)

src/Rlp/Syntax/Backstage.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Rlp.Syntax.Backstage
-    ( strip, collapse
+    ( strip
     )
     where
 --------------------------------------------------------------------------------
@@ -15,6 +15,12 @@ import Language.Haskell.TH.Syntax   (Lift)
 
 -- oprhan instances because TH
 
+instance (Show (NameP p)) => Show1 (Alt p) where
+    liftShowsPrec = $(makeLiftShowsPrec ''Alt)
+
+instance (Show (NameP p)) => Show1 (Binding p) where
+    liftShowsPrec = $(makeLiftShowsPrec ''Binding)
+
 instance (Show (NameP p)) => Show1 (ExprF p) where
     liftShowsPrec = $(makeLiftShowsPrec ''ExprF)
 
@@ -27,6 +33,3 @@ deriving instance (Show (NameP p), Show a) => Show (Program p a)
 strip :: Functor f => Cofree f a -> Fix f
 strip (_ :< as) = Fix $ strip <$> as
 
-collapse :: Fix (ExprF b) -> Expr b
-collapse = cata embed
-

src/Rlp/Syntax/Types.hs

@@ -8,10 +8,10 @@ module Rlp.Syntax.Types
     , SimpleP
     , Assoc(..)
     , ConAlt(..)
-    , Alt(..)
+    , Alt(..), Alt'
     , Ty(..)
-    , Binding(..)
+    , Binding(..), Binding'
-    , Expr(..), Expr', ExprF(..)
+    , Expr', ExprF(..)
     , Rec(..)
     , Lit(..)
     , Pat(..)
@@ -54,19 +54,16 @@ type instance NameP SimpleP = String
 
 type family NameP p
 
-data Expr p = LetE   Rec [Binding p] (Expr p)
+data ExprF p a = LetEF   Rec [Binding p a] a
-            | VarE   (NameP p)
+               | VarEF   (NameP p)
-            | LamE   [Pat p] (Expr p)
+               | LamEF   [Pat p] a
-            | CaseE  (Expr p) [Alt p]
+               | CaseEF  a [Alt p a]
-            | IfE    (Expr p) (Expr p) (Expr p)
+               | IfEF    a a a
-            | AppE   (Expr p) (Expr p)
+               | AppEF   a a
-            | LitE   (Lit p)
+               | LitEF   (Lit p)
-            | ParE   (Expr p)
+               | ParEF   a
-            | InfixE (NameP p) (Expr p) (Expr p)
+               | InfixEF (NameP p) a a
-            deriving (Generic)
+               deriving (Functor, Foldable, Traversable)
-
-deriving instance (Lift (NameP p)) => Lift (Expr p)
-deriving instance (Show (NameP p)) => Show (Expr p)
 
 data ConAlt p = ConAlt (NameP p) [Ty p]
 
@@ -88,38 +85,44 @@ data Pat p = VarP (NameP p)
 deriving instance (Lift (NameP p)) => Lift (Pat p)
 deriving instance (Show (NameP p)) => Show (Pat p)
 
-data Binding p = PatB (Pat p) (Expr p)
-
-deriving instance (Lift (NameP p)) => Lift (Binding p)
-deriving instance (Show (NameP p)) => Show (Binding p)
-
 data Lit p = IntL Int
     deriving Show
 
 deriving instance (Lift (NameP p)) => Lift (Lit p)
 
-data Alt p = AltA (Pat p) (Expr p) (Maybe (Where p))
-
-deriving instance (Show (NameP p)) => Show (Alt p)
-deriving instance (Lift (NameP p)) => Lift (Alt p)
-
-type Where p = [Binding p]
-
 data Assoc = InfixL | InfixR | Infix
     deriving (Lift, Show)
 
-makeBaseFunctor ''Expr
-
 deriving instance (Show (NameP p), Show a) => Show (ExprF p a)
 deriving instance (Lift (NameP p), Lift a) => Lift (ExprF p a)
 
+data Binding p a = PatB (Pat p) (ExprF p a)
+    deriving (Functor, Foldable, Traversable)
+
+deriving instance (Lift (NameP p), Lift a) => Lift (Binding p a)
+deriving instance (Show (NameP p), Show a) => Show (Binding p a)
+
+type Binding' p a = Binding p (Cofree (ExprF p) a)
+
+type Where p a = [Binding p a]
+
+data Alt p a = AltA (Pat p) (ExprF p a) (Maybe (Where p a))
+    deriving (Functor, Foldable, Traversable)
+
+deriving instance (Show (NameP p), Show a) => Show (Alt p a)
+deriving instance (Lift (NameP p), Lift a) => Lift (Alt p a)
+
+type Expr p = Fix (ExprF p)
+
+type Alt' p a = Alt p (Cofree (ExprF p) a)
+
 --------------------------------------------------------------------------------
 
 data Program p a = Program
     { _programDecls :: [Decl p a]
     }
 
-data Decl p a = FunD   (NameP p) [Pat p] (Expr' p a) (Maybe (Where p))
+data Decl p a = FunD   (NameP p) [Pat p] (Expr' p a) (Maybe (Where p a))
               | TySigD [NameP p] (Ty p)
               | DataD  (NameP p) [NameP p] [ConAlt p]
               | InfixD Assoc Int (NameP p)