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