i should've made a lisp man this sucks

This commit is contained in:
crumbtoo
2024-01-28 19:33:05 -07:00
parent 7d42f9b641
commit ab979cb934
3 changed files with 56 additions and 2 deletions

View File

@@ -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

View File

@@ -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 }

View File

@@ -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)