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

rlp.cabal

@@ -43,6 +43,7 @@ library
                     -- required for happy
                     , array
                     , data-default-class
+
     hs-source-dirs:   src
     default-language: GHC2021
 

src/Core/Examples.hs

@@ -10,15 +10,16 @@ import Core.TH
 
 letrecExample :: Program
 letrecExample = [coreProg|
-    pair x y f = f x y
+    pair x y f = f x y;
 
-    fst' p = p k
+    fst' p = p k;
-    snd' p = p k1
+    snd' p = p k1;
 
     f x y =
-        letrec a = pair x b
+        letrec
-               b = pair y a
+        { a = pair x b
-        in fst' (snd' (snd' (snd' a)));
+        ; b = pair y a
+        } in fst' (snd' (snd' (snd' a)));
 
     main = f 3 4;
 |]
@@ -37,9 +38,10 @@ indExample2 = [coreProg|
 |]
 
 indExample3 = [coreProg|
-    main = letrec x = 2
+    main = letrec
-                  y = f x x
+        { x = 2
-           in g y y;
+        ; y = f x x
+        } in g y y;
 
     f a b = b;
     g a b = a;
@@ -74,7 +76,7 @@ ifExample2 = [coreProg|
 |]
 
 facExample = [coreProg|
-    fac n = if# ((==#) n 0) 1 ((*#) n (fac ((-#) n 1)))
+    fac n = if# ((==#) n 0) 1 ((*#) n (fac ((-#) n 1)));
     main = fac 3;
 |]
 
@@ -91,12 +93,19 @@ listExample1 = [coreProg|
 |]
 
 listExample2 = [coreProg|
-    cc f x xs = Cons (f x) (map f xs)
+    cc f x xs = Cons (f x) (map f xs);
-    map f l = caseList# l Nil (cc f)
+    map f l = caseList# l Nil (cc f);
-    list = Cons 1 (Cons 2 (Cons 3 Nil))
+    list = Cons 1 (Cons 2 (Cons 3 Nil));
     main = map negate# list;
 |]
 
+listExample3 = [coreProg|
+    cc f z x xs = f x (foldr f z xs);
+    foldr f z l = caseList# l z (cc f z);
+    list = Cons 1 (Cons 2 (Cons 3 Nil));
+    main = foldr (+#) 0 list;
+|]
+
 corePrelude :: Module
 corePrelude = Module (Just ("Prelude", [])) $ Program
     [ ScDef "id" ["x"] $ "x"

src/Core/Lex.x

@@ -1,6 +1,4 @@
 {
--- TODO: layout semicolons are not inserted at EOf.
-{-# LANGUAGE TemplateHaskell #-}
 module Core.Lex
     ( lexCore
     , lexCore'
@@ -18,7 +16,7 @@ import Lens.Micro
 import Lens.Micro.TH
 }
 
-%wrapper "monadUserState"
+%wrapper "monad"
 
 $whitechar = [ \t\n\r\f\v]
 $special   = [\(\)\,\;\[\]\{\}]
@@ -57,81 +55,37 @@ $white_no_nl = $white # $nl
 
 rlp :-
 
--- everywhere: skip whitespace
-$white_no_nl+           { skip }
-
--- TODO: `--` could begin an operator
-"--"[^$nl]*             { skip }
-"--"\-*[^$symbol].*     { skip }
-
-"{-"                        { nestedComment }
-
--- syntactic symbols
 <0>
 {
     "("                     { constTok TokenLParen }
     ")"                     { constTok TokenRParen }
-    "{"                     { lbrace }
+    "{"                     { constTok TokenLBrace }
-    "}"                     { rbrace }
+    "}"                     { constTok TokenRBrace }
     ";"                     { constTok TokenSemicolon }
     ","                     { constTok TokenComma }
-}
 
--- keywords
+    "let"                   { constTok TokenLet }
--- see commentary on the layout system
+    "letrec"                { constTok TokenLetrec }
-<0>
+    "of"                    { constTok TokenOf }
-{
-    "let"                   { constTok TokenLet `andBegin` layout }
-    "letrec"                { constTok TokenLetrec `andBegin` layout }
-    "of"                    { constTok TokenOf `andBegin` layout }
     "case"                  { constTok TokenCase }
     "module"                { constTok TokenModule }
-    "in"                    { letin }
+    "in"                    { constTok TokenIn }
-    "where"                 { constTok TokenWhere `andBegin` layout }
+    "where"                 { constTok TokenWhere }
-}
 
--- reserved symbols
+    "\\"                    { constTok TokenLambda }
-<0>
+    "λ"                     { constTok TokenLambda }
-{
     "="                     { constTok TokenEquals }
     "->"                    { constTok TokenArrow }
-}
 
--- identifiers
-<0>
-{
-    -- TODO: qualified names
     @varname                { lexWith TokenVarName }
     @conname                { lexWith TokenConName }
     @varsym                 { lexWith TokenVarSym }
-}
+    @consym                 { lexWith TokenConSym }
 
--- literals
-<0>
-{
     @decimal                { lexWith (TokenLitInt . read @Int) }
-}
 
-<0> \n                      { begin bol }
-
-<initial>
-{
     $white                  { skip }
     \n                      { skip }
-    ()                      { topLevelOff `andBegin` 0 }
-}
-
-<bol>
-{
-    \n                      { skip }
-    ()                      { doBol `andBegin` 0 }
-}
-
-<layout>
-{
-    $white                  { skip }
-    \{                      { lbrace `andBegin` 0 }
-    ()                      { noBrace `andBegin` 0 }
 }
 
 {
@@ -161,57 +115,14 @@ data CoreToken = TokenLet
                | TokenRParen
                | TokenLBrace
                | TokenRBrace
-               | TokenLBraceV -- virtual brace inserted by layout
-               | TokenRBraceV -- virtual brace inserted by layout
-               | TokenIndent Int
-               | TokenDedent Int
                | TokenSemicolon
                | TokenEOF
                deriving Show
 
-data LayoutContext = Layout Int
-                   | NoLayout
-                   deriving Show
-
-data AlexUserState = AlexUserState
-    { _ausContext :: [LayoutContext]
-    }
-
-ausContext :: Lens' AlexUserState [LayoutContext]
-ausContext f (AlexUserState ctx)
-  = fmap
-      (\a -> AlexUserState a) (f ctx)
-{-# INLINE ausContext #-}
-
-pushContext :: LayoutContext -> Alex ()
-pushContext c = do
-    st <- alexGetUserState
-    alexSetUserState $ st { _ausContext = c : _ausContext st }
-
-popContext :: Alex ()
-popContext = do
-    st <- alexGetUserState
-    alexSetUserState $ st { _ausContext = drop 1 (_ausContext st) }
-
-getContext :: Alex [LayoutContext]
-getContext = do
-    st <- alexGetUserState
-    pure $ _ausContext st
-
 type Lexer = AlexInput -> Int -> Alex (Located CoreToken)
 
-alexInitUserState :: AlexUserState
+lexWith :: (String -> CoreToken) -> Lexer
-alexInitUserState = AlexUserState []
+lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located y x l (f $ take l s)
-
-nestedComment :: Lexer
-nestedComment _ _ = undefined
-
-lexStream :: Alex [Located CoreToken]
-lexStream = do
-    l <- alexMonadScan
-    case l of
-        Located _ _ _ TokenEOF  -> pure [l]
-        _                       -> (l:) <$> lexStream
 
 -- | The main lexer driver.
 lexCore :: String -> RLPC ParseError [Located CoreToken]
@@ -224,7 +135,7 @@ lexCore s = case m of
                 }
     Right ts -> pure ts
     where
-        m = runAlex s (alexSetStartCode initial *> lexStream)
+        m = runAlex s lexStream
 
 -- | @lexCore@, but the tokens are stripped of location info. Useful for
 -- debugging
@@ -232,84 +143,20 @@ lexCore' :: String -> RLPC ParseError [CoreToken]
 lexCore' s = fmap f <$> lexCore s
     where f (Located _ _ _ t) = t
 
+lexStream :: Alex [Located CoreToken]
+lexStream = do
+    l <- alexMonadScan
+    case l of
+        Located _ _ _ TokenEOF  -> pure [l]
+        _                       -> (l:) <$> lexStream
+
 data ParseError = ParErrLexical String
                 | ParErrParse
                 deriving Show
 
-lexWith :: (String -> CoreToken) -> Lexer
-lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located y x l (f $ take l s)
-
-lexToken :: Alex (Located CoreToken)
-lexToken = alexMonadScan
-
-getSrcCol :: Alex Int
-getSrcCol = Alex $ \ st ->
-    let AlexPn _ _ col = alex_pos st
-    in Right (st, col)
-
-lbrace :: Lexer
-lbrace (AlexPn _ y x,_,_,_) l = do
-    pushContext NoLayout
-    pure $ Located y x l TokenLBrace
-
-rbrace :: Lexer
-rbrace (AlexPn _ y x,_,_,_) l = do
-    popContext
-    pure $ Located y x l TokenRBrace
-
-insRBraceV :: AlexPosn -> Alex (Located CoreToken)
-insRBraceV (AlexPn _ y x) = do
-    popContext
-    pure $ Located y x 0 TokenRBraceV
-
-insSemi  :: AlexPosn -> Alex (Located CoreToken)
-insSemi (AlexPn _ y x) = do
-    pure $ Located y x 0 TokenSemicolon
-
-modifyUst :: (AlexUserState -> AlexUserState) -> Alex ()
-modifyUst f = do
-    st <- alexGetUserState
-    alexSetUserState $ f st
-
-getUst :: Alex AlexUserState
-getUst = alexGetUserState
-
-newLayoutContext :: Lexer
-newLayoutContext (p,_,_,_) _ = do
-    undefined
-
-noBrace :: Lexer
-noBrace (AlexPn _ y x,_,_,_) l = do
-    col <- getSrcCol
-    pushContext (Layout col)
-    pure $ Located y x l TokenLBraceV
-
-getOffside :: Alex Ordering
-getOffside = do
-    ctx <- getContext
-    m <- getSrcCol
-    case ctx of
-        Layout n : _ -> pure $ m `compare` n
-        _            -> pure GT
-
-doBol :: Lexer
-doBol (p,c,_,s) _ = do
-    off <- getOffside
-    case off of
-        LT      -> insRBraceV p
-        EQ      -> insSemi p
-        _       -> lexToken
-
-letin :: Lexer
-letin (AlexPn _ y x,_,_,_) l = do
-    popContext
-    pure $ Located y x l TokenIn
-
-topLevelOff :: Lexer
-topLevelOff = noBrace
-
 alexEOF :: Alex (Located CoreToken)
 alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) ->
     Right (st, Located y x 0 TokenEOF)
 
 }
+

src/Core/Lex.x.old

@@ -0,0 +1,315 @@
+{
+-- TODO: layout semicolons are not inserted at EOf.
+{-# LANGUAGE TemplateHaskell #-}
+module Core.Lex
+    ( lexCore
+    , lexCore'
+    , CoreToken(..)
+    , ParseError(..)
+    , Located(..)
+    , AlexPosn(..)
+    )
+    where
+import Data.Char (chr)
+import Debug.Trace
+import Core.Syntax
+import Compiler.RLPC
+import Lens.Micro
+import Lens.Micro.TH
+}
+
+%wrapper "monadUserState"
+
+$whitechar = [ \t\n\r\f\v]
+$special   = [\(\)\,\;\[\]\{\}]
+
+$digit     = 0-9
+
+$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]
+$unisymbol = [] -- TODO
+$symbol    = [$ascsymbol $unisymbol] # [$special \_\:\"\']
+
+$large     = [A-Z \xc0-\xd6 \xd8-\xde]
+$small     = [a-z \xdf-\xf6 \xf8-\xff \_]
+$alpha     = [$small $large]
+
+$graphic   = [$small $large $symbol $digit $special \:\"\']
+
+$octit     = 0-7
+$hexit     = [0-9 A-F a-f]
+$namechar  = [$alpha $digit \' \#]
+$symchar   = [$symbol \:]
+$nl        = [\n\r]
+$white_no_nl = $white # $nl
+
+@reservedid = 
+    case|data|do|import|in|let|letrec|module|of|where
+
+@reservedop =
+    "=" | \\ | "->"
+
+@varname   = $small $namechar*
+@conname   = $large $namechar*
+@varsym    = $symbol $symchar*
+@consym    = \: $symchar*
+
+@decimal = $digit+
+
+rlp :-
+
+-- everywhere: skip whitespace
+$white_no_nl+           { skip }
+
+-- TODO: `--` could begin an operator
+"--"[^$nl]*             { skip }
+"--"\-*[^$symbol].*     { skip }
+
+"{-"                        { nestedComment }
+
+-- syntactic symbols
+<0>
+{
+    "("                     { constTok TokenLParen }
+    ")"                     { constTok TokenRParen }
+    "{"                     { lbrace }
+    "}"                     { rbrace }
+    ";"                     { constTok TokenSemicolon }
+    ","                     { constTok TokenComma }
+}
+
+-- keywords
+-- see commentary on the layout system
+<0>
+{
+    "let"                   { constTok TokenLet `andBegin` layout }
+    "letrec"                { constTok TokenLetrec `andBegin` layout }
+    "of"                    { constTok TokenOf `andBegin` layout }
+    "case"                  { constTok TokenCase }
+    "module"                { constTok TokenModule }
+    "in"                    { letin }
+    "where"                 { constTok TokenWhere `andBegin` layout }
+}
+
+-- reserved symbols
+<0>
+{
+    "="                     { constTok TokenEquals }
+    "->"                    { constTok TokenArrow }
+}
+
+-- identifiers
+<0>
+{
+    -- TODO: qualified names
+    @varname                { lexWith TokenVarName }
+    @conname                { lexWith TokenConName }
+    @varsym                 { lexWith TokenVarSym }
+}
+
+-- literals
+<0>
+{
+    @decimal                { lexWith (TokenLitInt . read @Int) }
+}
+
+<0> \n                      { begin bol }
+
+<initial>
+{
+    $white                  { skip }
+    \n                      { skip }
+    ()                      { topLevelOff `andBegin` 0 }
+}
+
+<bol>
+{
+    \n                      { skip }
+    ()                      { doBol `andBegin` 0 }
+}
+
+<layout>
+{
+    $white                  { skip }
+    \{                      { lbrace `andBegin` 0 }
+    ()                      { noBrace `andBegin` 0 }
+}
+
+{
+data Located a = Located Int Int Int a
+    deriving Show
+
+constTok :: t -> AlexInput -> Int -> Alex (Located t)
+constTok t (AlexPn _ y x,_,_,_) l = pure $ Located y x l t
+
+data CoreToken = TokenLet
+               | TokenLetrec
+               | TokenIn
+               | TokenModule
+               | TokenWhere
+               | TokenComma
+               | TokenCase
+               | TokenOf
+               | TokenLambda
+               | TokenArrow
+               | TokenLitInt Int
+               | TokenVarName Name
+               | TokenConName Name
+               | TokenVarSym Name
+               | TokenConSym Name
+               | TokenEquals
+               | TokenLParen
+               | TokenRParen
+               | TokenLBrace
+               | TokenRBrace
+               | TokenLBraceV -- virtual brace inserted by layout
+               | TokenRBraceV -- virtual brace inserted by layout
+               | TokenIndent Int
+               | TokenDedent Int
+               | TokenSemicolon
+               | TokenEOF
+               deriving Show
+
+data LayoutContext = Layout Int
+                   | NoLayout
+                   deriving Show
+
+data AlexUserState = AlexUserState
+    { _ausContext :: [LayoutContext]
+    }
+
+ausContext :: Lens' AlexUserState [LayoutContext]
+ausContext f (AlexUserState ctx)
+  = fmap
+      (\a -> AlexUserState a) (f ctx)
+{-# INLINE ausContext #-}
+
+pushContext :: LayoutContext -> Alex ()
+pushContext c = do
+    st <- alexGetUserState
+    alexSetUserState $ st { _ausContext = c : _ausContext st }
+
+popContext :: Alex ()
+popContext = do
+    st <- alexGetUserState
+    alexSetUserState $ st { _ausContext = drop 1 (_ausContext st) }
+
+getContext :: Alex [LayoutContext]
+getContext = do
+    st <- alexGetUserState
+    pure $ _ausContext st
+
+type Lexer = AlexInput -> Int -> Alex (Located CoreToken)
+
+alexInitUserState :: AlexUserState
+alexInitUserState = AlexUserState []
+
+nestedComment :: Lexer
+nestedComment _ _ = undefined
+
+lexStream :: Alex [Located CoreToken]
+lexStream = do
+    l <- alexMonadScan
+    case l of
+        Located _ _ _ TokenEOF  -> pure [l]
+        _                       -> (l:) <$> lexStream
+
+-- | The main lexer driver.
+lexCore :: String -> RLPC ParseError [Located CoreToken]
+lexCore s = case m of
+    Left e   -> addFatal err
+        where err = SrcError
+                { _errSpan       = (0,0,0) -- TODO: location
+                , _errSeverity   = Error
+                , _errDiagnostic = ParErrLexical e
+                }
+    Right ts -> pure ts
+    where
+        m = runAlex s (alexSetStartCode initial *> lexStream)
+
+-- | @lexCore@, but the tokens are stripped of location info. Useful for
+-- debugging
+lexCore' :: String -> RLPC ParseError [CoreToken]
+lexCore' s = fmap f <$> lexCore s
+    where f (Located _ _ _ t) = t
+
+data ParseError = ParErrLexical String
+                | ParErrParse
+                deriving Show
+
+lexWith :: (String -> CoreToken) -> Lexer
+lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located y x l (f $ take l s)
+
+lexToken :: Alex (Located CoreToken)
+lexToken = alexMonadScan
+
+getSrcCol :: Alex Int
+getSrcCol = Alex $ \ st ->
+    let AlexPn _ _ col = alex_pos st
+    in Right (st, col)
+
+lbrace :: Lexer
+lbrace (AlexPn _ y x,_,_,_) l = do
+    pushContext NoLayout
+    pure $ Located y x l TokenLBrace
+
+rbrace :: Lexer
+rbrace (AlexPn _ y x,_,_,_) l = do
+    popContext
+    pure $ Located y x l TokenRBrace
+
+insRBraceV :: AlexPosn -> Alex (Located CoreToken)
+insRBraceV (AlexPn _ y x) = do
+    popContext
+    pure $ Located y x 0 TokenRBraceV
+
+insSemi  :: AlexPosn -> Alex (Located CoreToken)
+insSemi (AlexPn _ y x) = do
+    pure $ Located y x 0 TokenSemicolon
+
+modifyUst :: (AlexUserState -> AlexUserState) -> Alex ()
+modifyUst f = do
+    st <- alexGetUserState
+    alexSetUserState $ f st
+
+getUst :: Alex AlexUserState
+getUst = alexGetUserState
+
+newLayoutContext :: Lexer
+newLayoutContext (p,_,_,_) _ = do
+    undefined
+
+noBrace :: Lexer
+noBrace (AlexPn _ y x,_,_,_) l = do
+    col <- getSrcCol
+    pushContext (Layout col)
+    pure $ Located y x l TokenLBraceV
+
+getOffside :: Alex Ordering
+getOffside = do
+    ctx <- getContext
+    m <- getSrcCol
+    case ctx of
+        Layout n : _ -> pure $ m `compare` n
+        _            -> pure GT
+
+doBol :: Lexer
+doBol (p,c,_,s) _ = do
+    off <- getOffside
+    case off of
+        LT      -> insRBraceV p
+        EQ      -> insSemi p
+        _       -> lexToken
+
+letin :: Lexer
+letin (AlexPn _ y x,_,_,_) l = do
+    popContext
+    pure $ Located y x l TokenIn
+
+topLevelOff :: Lexer
+topLevelOff = noBrace
+
+alexEOF :: Alex (Located CoreToken)
+alexEOF = Alex $ \ st@(AlexState { alex_pos = AlexPn _ y x }) ->
+    Right (st, Located y x 0 TokenEOF)
+
+}

src/Core/Parse.y

@@ -45,8 +45,6 @@ import Data.Default.Class   (def)
       ')'             { Located _ _ _ TokenRParen }
       '{'             { Located _ _ _ TokenLBrace }
       '}'             { Located _ _ _ TokenRBrace }
-      vl              { Located _ _ _ TokenLBraceV }
-      vr              { Located _ _ _ TokenRBraceV }
       ';'             { Located _ _ _ TokenSemicolon }
       eof             { Located _ _ _ TokenEOF }
 
@@ -64,15 +62,7 @@ StandaloneProgram :: { Program }
 StandaloneProgram : Program eof                 { $1 }
 
 Program         :: { Program }
-Program         : VOpen ScDefs VClose           { Program $2 }
+Program         : ScDefs                        { Program $1 }
-                | '{'   ScDefs '}'              { Program $2 }
-
-VOpen           :: { () }
-VOpen           : vl                            { () }
-
-VClose          :: { () }
-VClose          : vr                            { () }
-                | error                         { () }
 
 ScDefs          :: { [ScDef] }
 ScDefs          : ScDef ';' ScDefs              { $1 : $3 }
@@ -95,9 +85,7 @@ Expr            : LetExpr                       { $1 }
                 | Expr1                         { $1 }
 
 LetExpr         :: { Expr }
-LetExpr         : let    VOpen Bindings VClose in Expr { Let NonRec $3 $6 }
+LetExpr         : let    '{'   Bindings '}'    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] }

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)
+
+}
+