From c74c19264569e9776f198f77befe87a0b3da5da0 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Fri, 26 Jan 2024 19:19:41 -0700
Subject: [PATCH] idk

---
 src/Rlp/Parse.y        | 12 +++++++-----
 src/Rlp/Parse/Types.hs |  1 +
 src/Rlp/Syntax.hs      | 12 +++++++++---
 3 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/src/Rlp/Parse.y b/src/Rlp/Parse.y
index 048617d..9792878 100644
--- a/src/Rlp/Parse.y
+++ b/src/Rlp/Parse.y
@@ -17,6 +17,7 @@ import Data.Functor.Apply
 import Data.Functor.Bind
 import Control.Comonad
 import Data.Functor
+import Data.Semigroup.Traversable
 import Data.Text                    qualified as T
 import Data.Void
 }
@@ -104,23 +105,24 @@ DataCons    :: { [ConAlt RlpcPs] }
             | DataCon                   { [$1] }
 
 DataCon     :: { ConAlt RlpcPs }
-            : Con Type1s                { ConAlt $1 $2 }
+            : Con Type1s                { undefined }
 
 Type1s      :: { [Type] }
             : {- epsilon -}             { [] }
             | Type1s Type1              { $1 `snoc` $2 }
 
 Type1       :: { Type }
-            : '(' Type ')'              { $2 }
-            | conname                   { TyCon $1 }
-            | varname                   { TyVar $1 }
+            : '(' Type ')'              { undefined }
+            | conname                   { undefined }
+            | varname                   { undefined }
 
 Type        :: { Type }
             : Type '->' Type            { $1 :-> $3 }
             | Type1                     { $1 }
 
 FunDecl     :: { Decl' RlpcPs }
-FunDecl     : Var Params '=' Expr       { FunD undefined $2 $4 Nothing }
+FunDecl     : Var Params '=' Expr       { $4 =>> \e ->
+                                          FunD' (extract $1) $2 e Nothing }
 
 Params      :: { [Pat' RlpcPs] }
 Params      : {- epsilon -}             { [] }
diff --git a/src/Rlp/Parse/Types.hs b/src/Rlp/Parse/Types.hs
index b8af882..5a3e6d4 100644
--- a/src/Rlp/Parse/Types.hs
+++ b/src/Rlp/Parse/Types.hs
@@ -55,6 +55,7 @@ type instance IdP RlpcPs = PsName
 type instance XInfixD RlpcPs = ()
 type instance XVarE RlpcPs = ()
 type instance XLitE RlpcPs = ()
+type instance XFunD RlpcPs = ()
 
 type PsName = Text
 
diff --git a/src/Rlp/Syntax.hs b/src/Rlp/Syntax.hs
index ced123b..69d5d0d 100644
--- a/src/Rlp/Syntax.hs
+++ b/src/Rlp/Syntax.hs
@@ -12,16 +12,17 @@ module Rlp.Syntax
     , Assoc(..)
     , Lit(..), Lit'
     , Type(..)
+    , pattern (:->)
     , ConAlt(..)
 
     -- * Pattern synonyms for unused extensions
     -- ** Decl
-    , pattern InfixD'
+    , pattern InfixD', pattern FunD'
     -- ** RlpExpr
     , pattern ParE', pattern VarE', pattern LitE'
 
     -- * Trees That Grow extensions
-    , XRec, IdP
+    , UnXRec(..), MapXRec(..), XRec, IdP
     -- ** RlpExpr
     , XLetE, XVarE, XConE, XLamE, XCaseE, XIfE, XAppE, XLitE, XXRlpExpr
     -- ** Decl
@@ -47,7 +48,7 @@ data RlpModule p = RlpModule
 
 newtype RlpProgram p = RlpProgram [Decl p]
 
-data Decl p = FunD   (XFunD p)   (IdP p) [Pat p] (RlpExpr p) (Maybe (Where p))
+data Decl p = FunD   (XFunD p)   (IdP p) [Pat' p] (RlpExpr' p) (Maybe (Where p))
             | TySigD (XTySigD p) [IdP p] Type
             | DataD  (XDataD p)  (IdP p) [IdP p] [ConAlt p]
             | InfixD (XInfixD p) Assoc Int (IdP p)
@@ -59,6 +60,11 @@ type family XDataD p
 type family XInfixD p
 type family XXDecl p
 
+pattern FunD' :: (XFunD p ~ ())
+              => IdP p -> [Pat' p] -> RlpExpr' p -> (Maybe (Where p))
+              -> Decl p
+pattern FunD' n as e wh = FunD () n as e wh
+
 pattern InfixD' :: (XInfixD p ~ ()) => Assoc -> Int -> (IdP p) -> Decl p
 pattern InfixD' a p n = InfixD () a p n