i should've made a lisp man this sucks
This commit is contained in:
@@ -10,6 +10,7 @@ module Rlp.Lex
|
||||
, lexStream
|
||||
, lexDebug
|
||||
, lexCont
|
||||
, popLexState
|
||||
)
|
||||
where
|
||||
import Codec.Binary.UTF8.String (encodeChar)
|
||||
@@ -73,6 +74,17 @@ $white_no_nl+ ;
|
||||
-- for the definition of `doBol`
|
||||
<0> \n { beginPush bol }
|
||||
|
||||
<layout>
|
||||
{
|
||||
|
||||
}
|
||||
|
||||
-- layout keywords
|
||||
<0>
|
||||
{
|
||||
"let" { constToken TokenLet `thenBeginPush` layout_let }
|
||||
}
|
||||
|
||||
-- scan various identifiers and reserved words. order is important here!
|
||||
<0>
|
||||
{
|
||||
@@ -110,6 +122,14 @@ $white_no_nl+ ;
|
||||
() { doBol }
|
||||
}
|
||||
|
||||
<layout_let>
|
||||
{
|
||||
\n { beginPush bol }
|
||||
"{" { explicitLBrace }
|
||||
"in" { constToken TokenIn `thenDo` (popLexState *> popLayout) }
|
||||
() { doLayout }
|
||||
}
|
||||
|
||||
<layout_top>
|
||||
{
|
||||
\n ;
|
||||
@@ -144,6 +164,12 @@ thenBegin act c inp l = do
|
||||
psLexState . _head .= c
|
||||
pure a
|
||||
|
||||
thenBeginPush :: LexerAction a -> Int -> LexerAction a
|
||||
thenBeginPush act c inp l = do
|
||||
a <- act inp l
|
||||
pushLexState c
|
||||
pure a
|
||||
|
||||
andBegin :: LexerAction a -> Int -> LexerAction a
|
||||
andBegin act c inp l = do
|
||||
psLexState . _head .= c
|
||||
@@ -342,6 +368,7 @@ explicitRBrace inp l = do
|
||||
doLayout :: LexerAction (Located RlpToken)
|
||||
doLayout _ _ = do
|
||||
i <- indentLevel
|
||||
traceM $ "doLayout: i: " <> show i
|
||||
pushLayout (Implicit i)
|
||||
popLexState
|
||||
insertLBrace
|
||||
|
||||
@@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE LambdaCase, ViewPatterns #-}
|
||||
module Rlp.Parse
|
||||
( parseRlpProg
|
||||
, parseRlpExpr
|
||||
)
|
||||
where
|
||||
import Compiler.RlpcError
|
||||
@@ -23,6 +24,7 @@ import Data.Void
|
||||
}
|
||||
|
||||
%name parseRlpProg StandaloneProgram
|
||||
%name parseRlpExpr StandaloneExpr
|
||||
|
||||
%monad { P }
|
||||
%lexer { lexCont } { Located _ TokenEOF }
|
||||
@@ -51,8 +53,12 @@ import Data.Void
|
||||
infixl { Located _ TokenInfixL }
|
||||
infixr { Located _ TokenInfixR }
|
||||
infix { Located _ TokenInfix }
|
||||
let { Located _ TokenLet }
|
||||
in { Located _ TokenIn }
|
||||
|
||||
%nonassoc '='
|
||||
%right '->'
|
||||
%right in
|
||||
|
||||
%%
|
||||
|
||||
@@ -60,6 +66,9 @@ StandaloneProgram :: { RlpProgram RlpcPs }
|
||||
StandaloneProgram : '{' Decls '}' {% mkProgram $2 }
|
||||
| VL DeclsV VR {% mkProgram $2 }
|
||||
|
||||
StandaloneExpr :: { RlpExpr RlpcPs }
|
||||
: VL Expr VR { extract $2 }
|
||||
|
||||
VL :: { () }
|
||||
VL : vlbrace { () }
|
||||
|
||||
@@ -143,6 +152,20 @@ Expr :: { RlpExpr' RlpcPs }
|
||||
: Expr1 InfixOp Expr { $2 =>> \o ->
|
||||
OAppE (extract o) $1 $3 }
|
||||
| Expr1 { $1 }
|
||||
| LetExpr { $1 }
|
||||
|
||||
LetExpr :: { RlpExpr' RlpcPs }
|
||||
: let layout1(Binding) in Expr { $1 \$> LetE $2 $4 }
|
||||
|
||||
layout1(p) : '{' layout_list1(';',p) '}' { $2 }
|
||||
| VL layout_list1(VS,p) VR { $2 }
|
||||
|
||||
layout_list1(sep,p) : p sep { [$1] }
|
||||
| p { [$1] }
|
||||
| layout_list1(sep,p) sep p { $1 `snoc` $3 }
|
||||
|
||||
Binding :: { Binding' RlpcPs }
|
||||
: Pat1 '=' Expr { PatB <<~ $1 <~> $3 }
|
||||
|
||||
Expr1 :: { RlpExpr' RlpcPs }
|
||||
: '(' Expr ')' { $1 .> $2 <. $3 }
|
||||
|
||||
@@ -14,6 +14,7 @@ module Rlp.Syntax
|
||||
, Lit(..), Lit'
|
||||
, RlpType(..), RlpType'
|
||||
, ConAlt(..)
|
||||
, Binding(..), Binding'
|
||||
|
||||
-- * Trees That Grow extensions
|
||||
, UnXRec(..), MapXRec(..), XRec, IdP
|
||||
@@ -28,7 +29,7 @@ import Data.Functor.Classes
|
||||
import Data.Kind (Type)
|
||||
import Lens.Micro
|
||||
import Lens.Micro.TH
|
||||
import Core.Syntax hiding (Lit, Type, Binding)
|
||||
import Core.Syntax hiding (Lit, Type, Binding, Binding')
|
||||
import Core (HasRHS(..), HasLHS(..))
|
||||
----------------------------------------------------------------------------------
|
||||
|
||||
@@ -42,6 +43,7 @@ type PhaseShow p =
|
||||
( Show (XRec p Pat), Show (XRec p RlpExpr)
|
||||
, Show (XRec p Lit), Show (IdP p)
|
||||
, Show (XRec p RlpType)
|
||||
, Show (XRec p Binding)
|
||||
)
|
||||
|
||||
newtype RlpProgram p = RlpProgram [Decl' p]
|
||||
@@ -77,7 +79,7 @@ data ConAlt p = ConAlt (IdP p) [RlpType' p]
|
||||
|
||||
deriving instance (Show (IdP p), Show (XRec p RlpType)) => Show (ConAlt p)
|
||||
|
||||
data RlpExpr p = LetE [Binding p] (RlpExpr' p)
|
||||
data RlpExpr p = LetE [Binding' p] (RlpExpr' p)
|
||||
| VarE (IdP p)
|
||||
| LamE [Pat p] (RlpExpr' p)
|
||||
| CaseE (RlpExpr' p) [(Alt p, Where p)]
|
||||
@@ -111,6 +113,8 @@ deriving instance (PhaseShow p) => Show (Alt p)
|
||||
data Binding p = PatB (Pat' p) (RlpExpr' p)
|
||||
| FunB (IdP p) [Pat' p] (RlpExpr' p)
|
||||
|
||||
type Binding' p = XRec p Binding
|
||||
|
||||
deriving instance (Show (XRec p Pat), Show (XRec p RlpExpr), Show (IdP p)
|
||||
) => Show (Binding p)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user