From 2496589346deae800b5a0190c5bb05852bdb615c Mon Sep 17 00:00:00 2001 From: crumbtoo Date: Fri, 12 Jan 2024 17:53:53 -0700 Subject: [PATCH] aagh --- .ghci | 16 ++++++ Makefile_happysrcs | 19 +++++++ src/.DS_Store | Bin 0 -> 6148 bytes src/Rlp/Lex.x | 125 +++++++++++++++++++++++++++++++++++++++------ 4 files changed, 143 insertions(+), 17 deletions(-) create mode 100644 Makefile_happysrcs create mode 100644 src/.DS_Store diff --git a/.ghci b/.ghci index 83c65a0..4d96080 100644 --- a/.ghci +++ b/.ghci @@ -1,2 +1,18 @@ :set -XOverloadedStrings +:set -package process + +:{ +import System.Exit qualified +import System.Process qualified + +_reload_and_make _ = do + p <- System.Process.spawnCommand "make -f Makefile_happysrcs" + r <- System.Process.waitForProcess p + case r of + System.Exit.ExitSuccess -> pure ":reload" + _ -> pure "" +:} + +:def! r _reload_and_make + diff --git a/Makefile_happysrcs b/Makefile_happysrcs new file mode 100644 index 0000000..2baa703 --- /dev/null +++ b/Makefile_happysrcs @@ -0,0 +1,19 @@ +HAPPY = happy +HAPPY_OPTS = +ALEX = alex +ALEX_OPTS = + +SRC = src +CABAL_BUILD = dist-newstyle/build/x86_64-osx/ghc-9.6.2/rlp-0.1.0.0/build + +all: parsers lexers + +parsers: $(CABAL_BUILD)/Rlp/Parse.hs +lexers: $(CABAL_BUILD)/Rlp/Lex.hs + +$(CABAL_BUILD)/Rlp/Parse.hs: $(SRC)/Rlp/Parse.y + $(HAPPY) $(HAPPY_OPTS) $< -o $@ + +$(CABAL_BUILD)/Rlp/Lex.hs: $(SRC)/Rlp/Lex.x + $(ALEX) $(ALEX_OPTS) $< -o $@ + diff --git a/src/.DS_Store b/src/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..2f1be0865f62a73b132a62e86953f60eef47401f GIT binary patch literal 6148 zcmZQzU|@7AO)+F(5MW?n;9!8z45|#6fRTZLfrY`DA)ld$A+;>HC@&{JFCCbS3Ltr!nhHD5gvbY4hIDsln96kiqxd~7? z5F1n#GlJ@9h#qiN3~K~1K?W2hpvpnjJ-8}nWPsG) as comments "--".* ; ";" { constToken TokenSemicolon } - "{" { constToken TokenLBrace } - "}" { constToken TokenRBrace } + "{" { explicitLBrace } + "}" { explicitRBrace } <0> { + $whitechar+ ; + \n ; + "{" { expectLBrace } +} + + +{ + \n { begin bol } @varname { tokenWith TokenVarName } "=" { constToken TokenEquals } } +-- consume all whitespace leaving us at the beginning of the next non-empty +-- line. we then compare the indentation of that line to the enclosing layout +-- context and proceed accordingly { $whitechar ; @@ -91,15 +105,27 @@ data RlpToken | TokenSemicolon | TokenLBrace | TokenRBrace + -- 'virtual' control symbols, implicitly inserted by the lexer + | TokenSemicolonV + | TokenLBraceV + | TokenRBraceV | TokenEOF deriving (Show) -newtype P a = P { runP :: Text -> Either String a } +newtype P a = P { + runP :: AlexUserState -> Text -> Either String (AlexUserState, a) + } deriving (Functor) +runPInit :: P a -> Text -> Either String (AlexUserState, a) +runPInit p = runP p alexInitUserState + data AlexUserState = AlexUserState - { _ausLayoutStack :: [Layout] + -- the layout context, along with a start code to return to when the layout + -- ends + { _ausLayoutStack :: [(Layout, Int)] } + deriving Show alexInitUserState :: AlexUserState alexInitUserState = AlexUserState @@ -111,34 +137,40 @@ data Layout = Explicit deriving (Show, Eq) instance Applicative P where - pure = P . const . Right + pure a = P $ \st _ -> Right (st,a) liftA2 = liftM2 instance Monad P where - m >>= k = P $ \s -> case runP m s of - Right a -> runP (k a) s - Left e -> Left e + 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) -ausLayoutStack :: Lens' AlexUserState [Layout] +ausLayoutStack :: Lens' AlexUserState [(Layout, Int)] ausLayoutStack = lens _ausLayoutStack (\ s l -> s { _ausLayoutStack = l }) lexer :: (Located RlpToken -> P a) -> P a -lexer f = P $ \s -> case m s of - Right (a,s') -> runP (f a) (s' ^. _4) - Left e -> error (show e) +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 s = runAlex s ((,) <$> alexMonadScan <*> alexGetInput) + m st s = runAlex s + ((,,) <$> (alexSetUserState st *> alexMonadScan) + <*> alexGetUserState + <*> alexGetInput) lexStream :: P [RlpToken] lexStream = lexer go where go (Located _ TokenEOF) = pure [TokenEOF] go (Located _ t) = (t:) <$!> lexStream +lexToken :: Alex (Located RlpToken) +lexToken = alexMonadScan + getsAus :: (AlexUserState -> b) -> Alex b getsAus k = alexGetUserState <&> k @@ -152,6 +184,11 @@ preuseAus l = do aus <- alexGetUserState pure (aus ^? l) +modifyingAus :: ASetter' AlexUserState a -> (a -> a) -> Alex () +modifyingAus l f = do + aus <- alexGetUserState + alexSetUserState (aus & l %~ f) + indentLevel :: Alex Int indentLevel = do inp <- alexGetInput @@ -163,13 +200,67 @@ cmpLayout :: Alex Ordering cmpLayout = do i <- indentLevel ctx <- preuseAus (ausLayoutStack . _head) - case ctx ^. non (Implicit 0) of - Implicit n -> pure (n `compare` i) + case (ctx <&> fst) ^. non (Implicit 1) of + Implicit n -> pure (i `compare` n) Explicit -> pure GT +insertToken :: RlpToken -> Alex (Located RlpToken) +insertToken t = do + inp <- alexGetInput + pure (Located (inp ^. _1) t) + +insertSemicolon, insertLBrace, insertRBrace :: Alex (Located RlpToken) +insertSemicolon = insertToken TokenSemicolonV +insertLBrace = insertToken TokenLBraceV +insertRBrace = insertToken TokenRBraceV + +-- pop the layout stack and jump to the popped return code +popLayout :: Alex () +popLayout = do + ctx <- preuseAus (ausLayoutStack . _head) + modifyingAus ausLayoutStack (drop 1) + case ctx of + Just (l,c) -> alexSetStartCode c + Nothing -> pure () + +pushLayout :: Layout -> Alex () +pushLayout l = do + c <- alexGetStartCode + modifyingAus ausLayoutStack ((l,c):) + doBol :: AlexAction (Located RlpToken) -doBol _ _ = do - undefined +doBol inp len = do + off <- cmpLayout + case off of + -- the line is aligned with the previous. it therefore belongs to the + -- same list + EQ -> insertSemicolon + -- the line is indented further than the previous, so we assume it is a + -- line continuation. ignore it and move on! + 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 + +explicitLBrace, explicitRBrace :: AlexAction (Located RlpToken) + +explicitLBrace _ _ = do + pushLayout Explicit + insertToken TokenLBrace + +explicitRBrace _ _ = do + popLayout + insertToken TokenRBrace + +doLayout :: AlexAction (Located RlpToken) +doLayout _ _ = do + i <- indentLevel + pushLayout (Implicit i) + insertLBrace + +expectLBrace :: AlexAction (Located RlpToken) +expectLBrace _ _ = do + off <- cmpLayout }