From 468d6e7745e1698d3eeec590c5b19564c875cab4 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Sun, 3 Mar 2024 14:52:27 -0700
Subject: [PATCH] ohhhh

---
 src/Rlp/AltParse.y   | 19 +++++++++++++++++++
 src/Rlp/AltSyntax.hs | 29 +++++++++++++++++++++++++++--
 2 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/src/Rlp/AltParse.y b/src/Rlp/AltParse.y
index 277c4b7..1cbf7f1 100644
--- a/src/Rlp/AltParse.y
+++ b/src/Rlp/AltParse.y
@@ -101,6 +101,14 @@ DataCon             :: { DataCon PsName }
 Type1               :: { Type PsName }
                     : varname               { VarT $ extractVarName $1 }
                     | Con                   { ConT $1 }
+                    | '(' Type ')'          { $2 }
+
+Type                :: { Type PsName }
+                    : AppT                  { $1 }
+
+AppT                :: { Type PsName }
+                    : Type1                 { $1 }
+                    | AppT Type1            { AppT $1 $2 }
 
 TyVars              :: { [PsName] }
                     : list0(varname)     { $1 <&> view ( to extract
@@ -111,6 +119,14 @@ FunD                :: { Decl PsName (RlpExpr PsName) }
 
 Expr                :: { RlpExpr PsName }
                     : AppE                  { $1 }
+                    | LetE                  { $1 }
+
+LetE                :: { RlpExpr PsName }
+                    : let layout1(Binding) in Expr
+                        { Finr $ LetEF Core.NonRec $2 $4 }
+
+Binding             :: { Binding PsName (RlpExpr PsName) }
+                    : Pat '=' Expr          { VarB $1 $3 }
 
 AppE                :: { RlpExpr PsName }
                     : AppE VarE             { Finl $ Core.AppF $1 $2 }
@@ -125,6 +141,9 @@ Pat1s               :: { [Pat PsName] }
 Pat1                :: { Pat PsName }
                     : Var                   { VarP $1 }
 
+Pat                 :: { Pat PsName }
+                    : Pat1                  { $1 }
+
 Con                 :: { PsName }
                     : conname               { $1 ^. to extract
                                                   . singular _TokenConName }
diff --git a/src/Rlp/AltSyntax.hs b/src/Rlp/AltSyntax.hs
index 4e6f033..bc625bd 100644
--- a/src/Rlp/AltSyntax.hs
+++ b/src/Rlp/AltSyntax.hs
@@ -3,7 +3,7 @@ module Rlp.AltSyntax
     (
     -- * AST
       Program(..), Decl(..), ExprF(..), Pat(..)
-    , RlpExprF, RlpExpr
+    , RlpExprF, RlpExpr, Binding(..)
     , DataCon(..), Type(..)
 
     , Core.Name, PsName
@@ -16,6 +16,7 @@ module Rlp.AltSyntax
 import Data.Functor.Sum
 import Control.Comonad.Cofree
 import Data.Fix
+import Data.Function            (fix)
 
 import Text.Show.Deriving
 import Data.Text                qualified as T
@@ -44,6 +45,11 @@ data Type b = VarT b
             deriving Show
 
 data ExprF b a = InfixEF b a a
+               | LetEF Core.Rec [Binding b a] a
+
+data Binding b a = FunB b [Pat b] a
+                 | VarB (Pat b) a
+    deriving Show
 
 -- type Expr b = Cofree (ExprF b)
 
@@ -54,6 +60,7 @@ type RlpExpr b = Fix (RlpExprF b)
 data Pat b = VarP b
     deriving Show
 
+deriveShow1 ''Binding
 deriveShow1 ''ExprF
 deriving instance (Show b, Show a) => Show (ExprF b a)
 
@@ -76,10 +83,28 @@ instance (Pretty b, Pretty a) => Pretty (Decl b a) where
     prettyPrec = prettyPrec1
 
 instance (Pretty b) => Pretty1 (Decl b) where
-    liftPrettyPrec pr p (FunD f as e) = maybeParens (p>0) $
+    liftPrettyPrec pr _ (FunD f as e) =
         hsep [ ttext f, hsep (prettyPrec appPrec1 <$> as)
              , "=", pr 0 e ]
 
+    liftPrettyPrec _ _ (DataD f as []) =
+        hsep [ "data", ttext f, hsep (pretty <$> as) ]
+
+    liftPrettyPrec _ _ (DataD f as ds) =
+        hsep [ "data", ttext f, hsep (pretty <$> as), cons ]
+      where
+        cons = vcat $ zipWith (<+>) delims (pretty <$> ds)
+        delims = "=" : repeat "|"
+
+instance (Pretty b) => Pretty (DataCon b) where
+    pretty (DataCon n as) = ttext n <+> hsep (prettyPrec appPrec1 <$> as)
+
+instance (Pretty b) => Pretty (Type b) where
+    prettyPrec _ (VarT n) = ttext n
+    prettyPrec _ (ConT n) = ttext n
+    prettyPrec p (AppT f x) = maybeParens (p>appPrec) $
+        prettyPrec appPrec f <+> prettyPrec appPrec1 x
+
 instance (Pretty b) => Pretty (Pat b) where
     prettyPrec p (VarP b) = prettyPrec p b