reorg.

1 files changed, 31 insertions, 52 deletions

diff --git a/app/Parser.hs b/app/Parser.hs
index 302194e..de6af9c 100644
--- a/app/Parser.hs
+++ b/app/Parser.hs
@@ -1,6 +1,10 @@
 {-# LANGUAGE FlexibleInstances #-}
 
-module Parser where
+module Parser
+  ( lexPrlg
+  , parsePrlg
+  , shuntPrlg
+  ) where
 
 import Control.Applicative (liftA2)
 import Control.Monad (void)
@@ -12,7 +16,8 @@ import Data.Void
 import Text.Megaparsec
 import Text.Megaparsec.Char
 
-import Compiler (PrlgStr(..))
+import IR (PrlgStr(..))
+import Operators
 
 singleToks = ",;|()[]"
 
@@ -113,10 +118,10 @@ instance TraversableStream [Lexeme] where
                         }
                   }
 
-data AST
-  = Call String [[AST]]
-  | Seq [AST]
-  | List [AST] (Maybe [AST])
+data PAST
+  = Call String [[PAST]]
+  | Seq [PAST]
+  | List [PAST] (Maybe [PAST])
   | Literal String
   deriving (Show, Eq)
 
@@ -138,7 +143,7 @@ isNormalTok _ = False
 unTok (Tok t) = t
 unTok (QTok t _) = t
 
-literal :: Parser AST
+literal :: Parser PAST
 literal = Literal . unTok <$> free (satisfy isNormalTok <* notFollowedBy lParen)
 
 call = do
@@ -177,64 +182,38 @@ listTail = simpleTok "|"
 
 rBracket = simpleTok "]"
 
-clause :: Parser AST
+clause :: Parser PAST
 clause = Seq <$> some (free seqItem) <* free comma
 
-parsePrlg :: Parser [AST]
+parsePrlg :: Parser [PAST]
 parsePrlg = ws *> many clause <* eof
 
-data Op =
-  Op Int Fixity
-  deriving (Show, Eq)
-
-data ArgKind
-  = X
-  | Y
-  deriving (Show, Eq)
-
-data Fixity
-  = Infix ArgKind ArgKind
-  | Prefix ArgKind
-  | Suffix ArgKind
-  deriving (Show, Eq)
-
-isPrefix (Prefix _) = True
-isPrefix _ = False
-
-numArgs :: Op -> Int
-numArgs (Op _ f) = go f
-  where
-    go (Infix _ _) = 2
-    go _ = 1
-
-type Ops = [(String, Op)]
-
-type PrlgError = String
+type ShuntError = String
 
-type PrlgResult = Either PrlgError PrlgStr
+type ShuntResult = Either ShuntError PrlgStr
 
-err :: PrlgError -> Either PrlgError a
+err :: ShuntError -> Either ShuntError a
 err = Left
 
-ast2prlg :: Ops -> AST -> PrlgResult
-ast2prlg ot = ast2prlg' (("", Op 0 $ Infix X Y) : ot)
+shuntPrlg :: Ops -> PAST -> ShuntResult
+shuntPrlg ot = shuntPrlg' (("", Op 0 $ Infix X Y) : ot)
 
-ast2prlg' :: Ops -> AST -> PrlgResult
-ast2prlg' ot (List _ _) = err "no lists yet"
-ast2prlg' ot (Seq ss) = shunt ot ss
-ast2prlg' ot (Literal s) = pure (LiteralS s)
-ast2prlg' ot (Call fn ss) = CallS fn <$> traverse (shunt ot) ss
+shuntPrlg' :: Ops -> PAST -> ShuntResult
+shuntPrlg' ot (List _ _) = err "no lists yet"
+shuntPrlg' ot (Seq ss) = shunt ot ss
+shuntPrlg' ot (Literal s) = pure (LiteralS s)
+shuntPrlg' ot (Call fn ss) = CallS fn <$> traverse (shunt ot) ss
 
-shunt :: Ops -> [AST] -> PrlgResult
+shunt :: Ops -> [PAST] -> ShuntResult
 shunt optable = start
   where
-    start :: [AST] -> PrlgResult
+    start :: [PAST] -> ShuntResult
     start [x] = rec x --singleton, possibly either a single operator name or a single value
     start [] = err "empty parentheses?"
     start xs = wo [] [] xs
     resolve = foldr1 (<|>)
     {- "want operand" state, incoming literal -}
-    wo :: Ops -> [PrlgStr] -> [AST] -> PrlgResult
+    wo :: Ops -> [PrlgStr] -> [PAST] -> ShuntResult
     wo ops vs (l@(Literal x):xs) =
       resolve
         [ do getPrefix x
@@ -252,7 +231,7 @@ shunt optable = start
     {- end of stream, but the operand is missing -}
     wo ops vs [] = err "expected final operand"
     {- "have operand" state, expecting an operator -}
-    ho :: Ops -> [PrlgStr] -> [AST] -> PrlgResult
+    ho :: Ops -> [PrlgStr] -> [PAST] -> ShuntResult
     ho ops vs xs'@(Literal x:xs) =
       resolve
         [ do getSuffix x
@@ -275,8 +254,8 @@ shunt optable = start
       (ops', vs') <- pop ops vs
       ho ops' vs' []
     {- recurse to delimited subexpression -}
-    rec :: AST -> PrlgResult
-    rec = ast2prlg' optable
+    rec :: PAST -> ShuntResult
+    rec = shuntPrlg' optable
     {- pop a level, possibly uncovering a higher prio -}
     pop ((x, Op _ (Infix _ _)):ops) (r:l:vs) = pure (ops, (CallS x [l, r] : vs))
     pop ((x, Op _ (Prefix _)):ops) (p:vs) = pure (ops, (CallS x [p] : vs))
@@ -292,7 +271,7 @@ shunt optable = start
       | null [op | (s, op) <- optable, s == x] = pure ()
       | otherwise = err "expected an operand"
     {- actual pushery -}
-    canPush :: Ops -> Op -> Either PrlgError Bool
+    canPush :: Ops -> Op -> Either ShuntError Bool
     canPush [] op = pure True
     canPush ((_, Op p f):ops) (Op np nf) = go p f np nf
         {- helper -}