temporarily remove layout support

the core language doesn't need it. let's just keep the core simple for now while i focus on more important things
2023-11-24 14:13:20 -07:00
parent 1cd7b5a25b
commit 0b72bc8f11
6 changed files with 521 additions and 202 deletions
--- a/src/Core/Parse.y.old
+++ b/src/Core/Parse.y.old
@@ -0,0 +1,159 @@
+{
+module Core.Parse
+    ( parseCore
+    , parseCoreExpr
+    , parseCoreProg
+    , module Core.Lex -- temp convenience
+    , parseTmp
+    , SrcError
+    , ParseError
+    , Module
+    )
+    where
+
+import Control.Monad        ((>=>))
+import Data.Foldable        (foldl')
+import Core.Syntax
+import Core.Lex
+import Compiler.RLPC
+import Data.Default.Class   (def)
+}
+
+%name parseCore Module
+%name parseCoreExpr StandaloneExpr
+%name parseCoreProg StandaloneProgram
+%tokentype { Located CoreToken }
+%error { parseError }
+%monad { RLPC ParseError }
+
+%token
+      let             { Located _ _ _ TokenLet }
+      letrec          { Located _ _ _ TokenLetrec }
+      module          { Located _ _ _ TokenModule }
+      where           { Located _ _ _ TokenWhere }
+      ','             { Located _ _ _ TokenComma }
+      in              { Located _ _ _ TokenIn }
+      litint          { Located _ _ _ (TokenLitInt $$) }
+      varname         { Located _ _ _ (TokenVarName $$) }
+      varsym          { Located _ _ _ (TokenVarSym $$) }
+      conname         { Located _ _ _ (TokenConName $$) }
+      consym          { Located _ _ _ (TokenConSym $$) }
+      'λ'             { Located _ _ _ TokenLambda }
+      '->'            { Located _ _ _ TokenArrow }
+      '='             { Located _ _ _ TokenEquals }
+      '('             { Located _ _ _ TokenLParen }
+      ')'             { Located _ _ _ TokenRParen }
+      '{'             { Located _ _ _ TokenLBrace }
+      '}'             { Located _ _ _ TokenRBrace }
+      vl              { Located _ _ _ TokenLBraceV }
+      vr              { Located _ _ _ TokenRBraceV }
+      ';'             { Located _ _ _ TokenSemicolon }
+      eof             { Located _ _ _ TokenEOF }
+
+%%
+
+Module          :: { Module }
+Module          : module conname where Program Eof { Module (Just ($2, [])) $4 }
+                | Program Eof                      { Module Nothing $1 }
+
+Eof             :: { () }
+Eof             : eof           { () }
+                | error         { () }
+
+StandaloneProgram :: { Program }
+StandaloneProgram : Program eof                 { $1 }
+
+Program         :: { Program }
+Program         : VOpen ScDefs VClose           { Program $2 }
+                | '{'   ScDefs '}'              { Program $2 }
+
+VOpen           :: { () }
+VOpen           : vl                            { () }
+
+VClose          :: { () }
+VClose          : vr                            { () }
+                | error                         { () }
+
+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 -}                 { [] }
+
+StandaloneExpr  :: { Expr }
+StandaloneExpr  : Expr eof                      { $1 }
+
+Expr            :: { Expr }
+Expr            : LetExpr                       { $1 }
+                | 'λ' Binders '->' Expr         { Lam $2 $4 }
+                | Application                   { $1 }
+                | Expr1                         { $1 }
+
+LetExpr         :: { Expr }
+LetExpr         : let    VOpen Bindings VClose in Expr { Let NonRec $3 $6 }
+                | letrec VOpen Bindings VClose in Expr { Let Rec $3 $6 }
+                | let    '{'   Bindings '}'    in Expr { Let NonRec $3 $6 }
+                | letrec '{'   Bindings '}'    in Expr { Let Rec $3 $6 }
+
+Binders         :: { [Name] }
+Binders         : Var Binders                  { $1 : $2 }
+                | Var                          { [$1] }
+
+Application     :: { Expr }
+Application     : Expr1 AppArgs                 { foldl' App $1 $2 }
+
+-- TODO: Application can probably be written as a single rule, without AppArgs
+AppArgs         :: { [Expr] }
+AppArgs         : Expr1 AppArgs                 { $1 : $2 }
+                | Expr1                         { [$1] }
+
+Expr1           :: { Expr }
+Expr1           : litint                        { IntE $1 }
+                | Id                            { Var $1 }
+                | '(' Expr ')'                  { $2 }
+
+Bindings        :: { [Binding] }
+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 :: [Located CoreToken] -> RLPC ParseError a
+parseError (Located y x l _ : _) = addFatal err
+    where err = SrcError
+            { _errSpan       = (y,x,l)
+            , _errSeverity   = Error
+            , _errDiagnostic = ParErrParse
+            }
+
+parseTmp :: IO Module
+parseTmp = do
+    s <- readFile "/tmp/t.hs"
+    case parse s of
+        Left e -> error (show e)
+        Right (ts,_) -> pure ts
+    where
+        parse = evalRLPC def . (lexCore >=> parseCore)
+
+}
+