From e597ecbfc643f9137e8892965f8e898b7a881f75 Mon Sep 17 00:00:00 2001 From: crumbtoo Date: Sun, 14 Jan 2024 14:20:08 -0700 Subject: [PATCH] okay layouts kinda --- Makefile_happysrcs | 2 +- rlp.cabal | 1 + src/.DS_Store | Bin 6148 -> 6148 bytes src/Rlp/Lex.x | 98 +++++++++++++++++++++++++-------------------- src/Rlp/Parse.y | 2 +- 5 files changed, 58 insertions(+), 45 deletions(-) diff --git a/Makefile_happysrcs b/Makefile_happysrcs index 2baa703..35c2ca8 100644 --- a/Makefile_happysrcs +++ b/Makefile_happysrcs @@ -1,7 +1,7 @@ HAPPY = happy HAPPY_OPTS = ALEX = alex -ALEX_OPTS = +ALEX_OPTS = -d SRC = src CABAL_BUILD = dist-newstyle/build/x86_64-osx/ghc-9.6.2/rlp-0.1.0.0/build diff --git a/rlp.cabal b/rlp.cabal index e6b81a9..411434b 100644 --- a/rlp.cabal +++ b/rlp.cabal @@ -50,6 +50,7 @@ library -- required for happy , array , data-default-class + , data-default , unordered-containers , hashable , pretty diff --git a/src/.DS_Store b/src/.DS_Store index 2f1be0865f62a73b132a62e86953f60eef47401f..4390780d02bbee1b3430a6fac093424b3e29cf90 100644 GIT binary patch delta 306 zcmZoMXfc=|#>B`mu~3YagMop8V`8C*EE59+fM`Yr1_6eo^5TM|octsP28Qhu3zye} zBv=@n8S)v57*dfXlL~S&i%Sd)t}!w(v#_$UbFg!8bHoN`r7fQWN`UP)qRUTP6YNpNOLYEoiROn7EqN`ARheraAxF<5VKW*}IG zgOh_ZUO>FM+RVgQN5RmjR!5=Q%*a$n!Q9lSww9AaR9W9TC_XzUH!r^v;vYsv2+hC? yrD0UpL>=jk>4I#N4MbQrb8~QWFfnp$Ed0(qnO{Va735ik$%Z1rn>|GKFarRGc1u10 delta 82 zcmZoMXfc=|#>AjHu~3+iaq?|OX+b6i2w-GjU|?im5MbE+oKb;ovj9^+<7RdaehwxE e)y<4d-) as comments "--".* ; ";" { constToken TokenSemicolon } - "{" { explicitLBrace } - "}" { explicitRBrace } + -- "{" { explicitLBrace } + -- "}" { explicitRBrace } <0> { - $whitechar+ ; \n ; - "{" { expectLBrace } + "{" { explicitLBrace `thenBegin` one } + () { doLayout `thenBegin` one } } { - \n { begin bol } @varname { tokenWith TokenVarName } "=" { constToken TokenEquals } + \n { begin bol } } -- consume all whitespace leaving us at the beginning of the next non-empty @@ -71,11 +73,19 @@ rlp :- { $whitechar ; \n ; - () { doBol } + () { doBol `andBegin` one } } { +-- | @andBegin@, with the subtle difference that the start code is set +-- /after/ the action +thenBegin :: AlexAction a -> Int -> AlexAction a +thenBegin act c inp l = do + a <- act inp l + alexSetStartCode c + pure a + constToken :: RlpToken -> AlexAction (Located RlpToken) constToken t inp _ = pure $ Located (inp ^. _1) t @@ -105,20 +115,33 @@ data RlpToken | TokenSemicolon | TokenLBrace | TokenRBrace - -- 'virtual' control symbols, implicitly inserted by the lexer + -- 'virtual' control symbols, inserted by the lexer without any correlation + -- to a specific symbol | TokenSemicolonV | TokenLBraceV | TokenRBraceV | TokenEOF deriving (Show) -newtype P a = P { - runP :: AlexUserState -> Text -> Either String (AlexUserState, a) - } +newtype P a = P { runP :: ParseState -> Alex (ParseState, a) } deriving (Functor) -runPInit :: P a -> Text -> Either String (AlexUserState, a) -runPInit p = runP p alexInitUserState +execP :: P a -> ParseState -> Text -> Either String a +execP p st s = snd <$> runAlex s (runP p st) + +data ParseState = ParseState { } + +instance Default ParseState where + def = ParseState { } + +instance Applicative P where + pure a = P $ \st -> pure (st,a) + liftA2 = liftM2 + +instance Monad P where + p >>= k = P $ \st -> do + (st',a) <- runP p st + runP (k a) st' data AlexUserState = AlexUserState -- the layout context, along with a start code to return to when the layout @@ -136,16 +159,6 @@ data Layout = Explicit | Implicit Int deriving (Show, Eq) -instance Applicative P where - pure a = P $ \st _ -> Right (st,a) - - liftA2 = liftM2 - -instance Monad P where - m >>= k = P $ \st s -> case runP m st s of - Right (st',a) -> runP (k a) st' s - Left e -> Left e - data Located a = Located AlexPosn a deriving (Show) @@ -153,20 +166,21 @@ ausLayoutStack :: Lens' AlexUserState [(Layout, Int)] ausLayoutStack = lens _ausLayoutStack (\ s l -> s { _ausLayoutStack = l }) -lexer :: (Located RlpToken -> P a) -> P a -lexer f = P $ \st s -> case m st s of - Right (a,st',s') -> runP (f a) st' (s' ^. _4) - Left e -> error (show e) - where - m st s = runAlex s - ((,,) <$> (alexSetUserState st *> alexMonadScan) - <*> alexGetUserState - <*> alexGetInput) +lexer :: P (Located RlpToken) +lexer = P $ \st -> (st,) <$> lexToken -lexStream :: P [RlpToken] -lexStream = lexer go where - go (Located _ TokenEOF) = pure [TokenEOF] - go (Located _ t) = (t:) <$!> lexStream +lexerCont :: (Located RlpToken -> P a) -> P a +lexerCont = (lexer >>=) + +lexStream :: Alex [RlpToken] +lexStream = do + t <- lexToken + case t of + Located _ TokenEOF -> pure [TokenEOF] + Located _ a -> (a:) <$> lexStream + +lexTest :: Text -> Either String [RlpToken] +lexTest = flip runAlex lexStream lexToken :: Alex (Located RlpToken) lexToken = alexMonadScan @@ -210,13 +224,14 @@ insertToken t = do pure (Located (inp ^. _1) t) insertSemicolon, insertLBrace, insertRBrace :: Alex (Located RlpToken) -insertSemicolon = insertToken TokenSemicolonV -insertLBrace = insertToken TokenLBraceV -insertRBrace = insertToken TokenRBraceV +insertSemicolon = traceM "inserting semi" >> insertToken TokenSemicolonV +insertLBrace = traceM "inserting lbrace" >> insertToken TokenLBraceV +insertRBrace = traceM "inserting rbrace" >> insertToken TokenRBraceV -- pop the layout stack and jump to the popped return code popLayout :: Alex () popLayout = do + traceM "pop layout" ctx <- preuseAus (ausLayoutStack . _head) modifyingAus ausLayoutStack (drop 1) case ctx of @@ -225,6 +240,7 @@ popLayout = do pushLayout :: Layout -> Alex () pushLayout l = do + traceM "push layout" c <- alexGetStartCode modifyingAus ausLayoutStack ((l,c):) @@ -240,7 +256,7 @@ doBol inp len = do GT -> undefined -- alexSetStartCode one >> lexToken -- the line is indented less than the previous, pop the layout stack and -- insert a closing brace. - LT -> popLayout >> insertRBrace >> alexSetStartCode 0 >> lexToken + LT -> insertRBrace >> popLayout >> lexToken explicitLBrace, explicitRBrace :: AlexAction (Located RlpToken) @@ -258,9 +274,5 @@ doLayout _ _ = do pushLayout (Implicit i) insertLBrace -expectLBrace :: AlexAction (Located RlpToken) -expectLBrace _ _ = do - off <- cmpLayout - } diff --git a/src/Rlp/Parse.y b/src/Rlp/Parse.y index d136507..3016594 100644 --- a/src/Rlp/Parse.y +++ b/src/Rlp/Parse.y @@ -10,7 +10,7 @@ import Rlp.Parse.Types %name rlp %monad { P } -%lexer { lexer } { Located _ TokenEOF } +%lexer { lexerCont } { Located _ TokenEOF } %error { parseError } %tokentype { Located RlpToken }