desugar

src/Rlp/Parse.y

@@ -143,7 +143,11 @@ Type1       :: { RlpType' RlpcPs }
 
 Type        :: { RlpType' RlpcPs }
             : Type '->' Type            { FunT <<~ $1 <~> $3 }
-            | Type1                     { $1 }
+            | TypeApp                   { $1 }
+
+TypeApp     :: { RlpType' RlpcPs }
+            : Type1                     { $1 }
+            | TypeApp Type1             { AppT <<~ $1 <~> $2 }
 
 FunDecl     :: { Decl' RlpcPs }
 FunDecl     : Var Params '=' Expr       { $4 =>> \e ->
@@ -173,7 +177,11 @@ Expr        :: { RlpExpr' RlpcPs }
                                           OAppE (extract o) $1 $3 }
             | LetExpr                   { $1 }
             | CaseExpr                  { $1 }
-            | Expr1                     { $1 }
+            | ExprApp                   { $1 }
+
+ExprApp     :: { RlpExpr' RlpcPs }
+            : Expr1                     { $1 }
+            | ExprApp Expr1             { AppE <<~ $1 <~> $2 }
 
 LetExpr     :: { RlpExpr' RlpcPs }
             : let layout1(Binding) in Expr { $1 \$> LetE $2 $4 }

src/Rlp2Core.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveTraversable #-}
 module Rlp2Core
-    ( rlpProgToCore
+    ( desugarRlpProg
+    , desugarRlpExpr
     )
     where
 --------------------------------------------------------------------------------
@@ -23,6 +24,7 @@ import Data.Foldable
 import Data.Fix
 import Data.Maybe                       (fromJust, fromMaybe)
 import Data.Functor.Bind
+import Data.Function                    (on)
 import Debug.Trace
 import Effectful.State.Static.Local
 import Effectful.Labeled
@@ -51,6 +53,14 @@ type Rose = Fix Branch
 
 deriveShow1 ''Branch
 
+--------------------------------------------------------------------------------
+
+desugarRlpProg :: RlpProgram RlpcPs -> Program'
+desugarRlpProg = rlpProgToCore
+
+desugarRlpExpr :: RlpExpr RlpcPs -> Expr'
+desugarRlpExpr = runPureEff . runNameSupply "anon" . exprToCore
+
 -- the rl' program is desugared by desugaring each declaration as a separate
 -- program, and taking the monoidal product of the lot :3
 
@@ -95,6 +105,8 @@ exprToCore :: (NameSupply :> es) => RlpExpr RlpcPs -> Eff es Expr'
 
 exprToCore (VarE n) = pure $ Var (dsNameToName n)
 
+exprToCore (AppE a b) = (liftA2 App `on` exprToCore . unXRec) a b
+
 exprToCore (CaseE (unXRec -> e) as) = do
     e' <- exprToCore e
     Case e' <$> caseAltToCore `traverse` as