good enough. good enough. good enough. good enoguh.jjhbjhfsfbsjhdsfjbhsdbjhdfsbhjlbahjfdaojuai

src/Core/Parse.y

@@ -1,20 +1,24 @@
+-- TODO: resolve shift/reduce conflicts
 {
 module Core.Parse
     ( parseCore
-    -- , parseCoreExpr
+    , parseCoreExpr
     , module Core.Lex -- temp convenience
+    , parseTmp
     )
     where
 
 import Data.Foldable        (foldl')
 import Core.Syntax
 import Core.Lex
+import Compiler.RLPC
 }
 
-%name parseCore
+%name parseCore Module
 %name parseCoreExpr Expr
 %tokentype { CoreToken }
 %error { parseError }
+%monad { RLPC }
 
 %token
       let             { TokenLet }
@@ -24,8 +28,10 @@ import Core.Lex
       ','             { TokenComma }
       in              { TokenIn }
       litint          { TokenLitInt $$ }
-      name            { TokenName $$ }
-      sym             { TokenSym $$ }
+      varname         { TokenVarName $$ }
+      varsym          { TokenVarSym $$ }
+      conname         { TokenConName $$ }
+      consym          { TokenConSym $$ }
       'λ'             { TokenLambda }
       '->'            { TokenArrow }
       '='             { TokenEquals }
@@ -34,23 +40,43 @@ import Core.Lex
       '{'             { TokenLBrace }
       '}'             { TokenRBrace }
       ';'             { TokenSemicolon }
+      eof             { TokenEOF }
 
 %%
 
-ExportList      :: { [Name] }
-ExportList      : '(' Exports ')'               { $2 }
+Module          :: { Module }
+Module          : module conname where Program Eof { Module (Just ($2, [])) $4 }
+                | Program Eof                      { Module Nothing $1 }
 
-Exports         :: { [Name] }
-Exports         : Var ',' Exports               { $1 : $3 }
-                | Var                           { [$1] }
+Eof             :: { () }
+Eof             : eof           { () }
+                | error         { () }
+
+Program         :: { Program }
+Program         : '{' ScDefs Close              { Program $2 }
+
+ScDefs          :: { [ScDef] }
+ScDefs          : ScDef ';' ScDefs              { $1 : $3 }
+                | {- epsilon -}                 { [] }
+
+ScDef           :: { ScDef }
+ScDef           : Var ParList '=' Expr          { ScDef $1 $2 $4 }
+
+ParList         :: { [Name] }
+ParList         : Var ParList                   { $1 : $2 }
+                | {- epsilon -}                 { [] }
 
 Expr            :: { Expr }
-Expr            : let Bindings in Expr          { Let NonRec $2 $4 }
-                | letrec Bindings in Expr       { Let Rec $2 $4 }
+Expr            : let '{' Bindings Close in Expr  { Let NonRec $3 $6 }
+                | letrec '{' Bindings Close in Expr { Let Rec $3 $6 }
                 | 'λ' Binders '->' Expr         { Lam $2 $4 }
                 | Application                   { $1 }
                 | Expr1                         { $1 }
 
+Close           :: { () }
+Close           : '}'                           { () }
+                | error                         { () }
+
 Binders         :: { [Name] }
 Binders         : Var Binders                  { $1 : $2 }
                 | Var                          { [$1] }
@@ -65,18 +91,38 @@ AppArgs         : Expr1 AppArgs                 { $1 : $2 }
 
 Expr1           :: { Expr }
 Expr1           : litint                        { IntE $1 }
-                | Var                           { Var $1 }
+                | Id                            { Var $1 }
                 | '(' Expr ')'                  { $2 }
 
-Var            :: { Name }
-Var            : '(' sym ')'                    { $2 }
-               | name                           { $1 }
-
 Bindings        :: { [Binding] }
-Bindings        : Var '=' Expr                  { [$1 := $3] }
+Bindings        : Binding ';' Bindings          { $1 : $3 }
+                | Binding ';'                   { [$1] }
+                | Binding                       { [$1] }
+
+Binding         :: { Binding }
+Binding         : Var '=' Expr                  { $1 := $3 }
+
+Id              :: { Name }
+Id              : Var                                { $1 }
+                | Con                                { $1 }
+
+Var             :: { Name }
+Var             : '(' varsym ')'                    { $2 }
+                | varname                           { $1 }
+
+Con             :: { Name }
+Con             : '(' consym ')'                    { $2 }
+                | conname                           { $1 }
 
 {
 parseError :: [CoreToken] -> a
-parseError _ = error "fuuckk!"
+parseError ts = error $ "parse error at token: " <> show (head ts)
+
+parseTmp :: IO (Module)
+parseTmp = do
+    s <- readFile "/tmp/t.hs"
+    case lexCore' s >>= runRLPC . parseCore of
+        Left e -> error e
+        Right a -> pure a
 }