aagh

.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
+

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

src/Rlp/Lex.x

@@ -14,11 +14,14 @@ import Control.Monad
 import Data.Functor.Identity
 import Core.Syntax              (Name)
 import Data.Monoid              (First)
+import Data.Maybe
 import Data.Text                (Text)
 import Data.Text                qualified as T
 import Lens.Micro.Mtl
 import Lens.Micro
 import Lens.Micro.TH
+
+import Debug.Trace
 }
 
 %wrapper "monadUserState-strict-text"
@@ -44,15 +47,26 @@ rlp :-
     -- TODO: don't treat operators like (-->) as comments
     "--".*              ;
     ";"                 { constToken TokenSemicolon }
-    "{"                 { constToken TokenLBrace }
-    "}"                 { constToken TokenRBrace }
+    "{"                 { explicitLBrace }
+    "}"                 { explicitRBrace }
 
 <0>
 {
+    $whitechar+         ;
+    \n                  ;
+    "{"                 { expectLBrace }
+}
+
+<one>
+{
+    \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
 <bol>
 {
     $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
 
 }