From bec376b7c7c443a0606d66f2cfcee4db39496e6f Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Thu, 11 Jan 2024 08:36:44 -0700
Subject: [PATCH] threaded lexer

---
 rlp.cabal       |  4 +++-
 src/Rlp/Lex.x   | 64 +++++++++++++++++++++++++++++++++++++++++++++++++
 src/Rlp/Parse.y | 28 ++++++++++++++++++++++
 3 files changed, 95 insertions(+), 1 deletion(-)
 create mode 100644 src/Rlp/Lex.x
 create mode 100644 src/Rlp/Parse.y

diff --git a/rlp.cabal b/rlp.cabal
index dc83431..e6b81a9 100644
--- a/rlp.cabal
+++ b/rlp.cabal
@@ -31,7 +31,9 @@ library
                     , Core.HindleyMilner
                     , Control.Monad.Errorful
                     , Rlp.Syntax
-                    , Rlp.Parse.Decls
+                    -- , Rlp.Parse.Decls
+                    , Rlp.Parse
+                    , Rlp.Lex
                     , Rlp.Parse.Types
 
     other-modules:    Data.Heap
diff --git a/src/Rlp/Lex.x b/src/Rlp/Lex.x
new file mode 100644
index 0000000..893a487
--- /dev/null
+++ b/src/Rlp/Lex.x
@@ -0,0 +1,64 @@
+{
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Rlp.Lex
+    ( P(..)
+    , RlpToken(..)
+    , Located(..)
+    , AlexPosn
+    , lexer
+    )
+    where
+import Data.Functor.Identity
+import Core.Syntax              (Name)
+import Data.Text                (Text)
+import Data.Text                qualified as T
+import Lens.Micro
+}
+
+%wrapper "monad-strict-text"
+
+rlp :-
+<0>
+{
+    "a" { const $ const $ pure $ Located (AlexPn 0 0 0) (TokenVarName "a") }
+    "" { undefined }
+}
+
+{
+
+alexEOF :: Alex a
+alexEOF = undefined
+
+data RlpToken = TokenEquals
+              | TokenLitInt Int
+              | TokenVarName Name
+              | TokenConName Name
+              | TokenVarSym Name
+              | TokenConSym Name
+              | TokenData
+              | TokenPipe
+              | TokenEOF
+              deriving (Show)
+
+newtype P a = P { runP :: Text -> Either String a }
+    deriving (Functor)
+
+instance Applicative P where
+    pure = P . const . Right
+
+    liftA2 f p q = P $ \s -> undefined
+
+instance Monad P where
+    m >>= k = P $ \s -> case runP m s of
+        Right a -> runP (k a) s
+        Left e -> Left e
+
+data Located a = Located AlexPosn a
+    deriving (Show)
+
+lexer :: (Located RlpToken -> P a) -> P a
+lexer f = P $ \s -> case runAlex s ((,) <$> alexMonadScan <*> alexGetInput) of
+    Right (a,s') -> runP (f a) (s' ^. _4)
+
+}
diff --git a/src/Rlp/Parse.y b/src/Rlp/Parse.y
new file mode 100644
index 0000000..efc5d22
--- /dev/null
+++ b/src/Rlp/Parse.y
@@ -0,0 +1,28 @@
+{
+module Rlp.Parse
+    (
+    )
+    where
+import Rlp.Lex
+}
+
+%name rlp
+%monad { P }
+%lexer { lexer } { Located _ TokenEOF }
+%error { parseError }
+%tokentype { Located RlpToken }
+
+%token
+    t { Located _ _ }
+
+%%
+
+P :: { () }
+P : { error "aa" }
+
+{
+
+parseError :: Located RlpToken -> P a
+parseError = error "aaaaah"
+
+}