some small stuff

1 files changed, 54 insertions, 0 deletions

diff --git a/app/Compiler.hs b/app/Compiler.hs
new file mode 100644
index 0000000..7684f80
--- /dev/null
+++ b/app/Compiler.hs
@@ -0,0 +1,54 @@
+module Compiler where
+
+import Data.List
+import Interpreter (Code, Datum(..), Id(..), Instr(..), StrTable, strtablize)
+
+data PrlgStr
+  = CallS String [PrlgStr]
+  | LiteralS String
+  deriving (Show)
+
+data PrlgInt
+  = CallI Id [PrlgInt]
+  | LiteralI Int --split off vars here later
+  deriving (Show)
+
+strtablizePrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
+strtablizePrlg = go
+  where
+    go t (LiteralS str) = LiteralI <$> strtablize t str
+    go t (CallS str ps) =
+      let (t', i) = strtablize t str
+       in CallI (Id i $ length ps) <$> mapAccumL go t' ps
+
+compileGoals :: Id -> PrlgInt -> [Code]
+compileGoals andop = go
+  where
+    go p@(CallI x args)
+      | x == andop = concatMap go args
+    go x = [compileGoal x]
+
+compileGoal :: PrlgInt -> Code
+compileGoal (LiteralI x) = [U (Struct $ Id x 0)]
+compileGoal x = compileArg x
+
+compileArg :: PrlgInt -> Code
+compileArg (CallI x args) = U (Struct x) : concatMap compileArg args
+compileArg (LiteralI x) = [U (Atom x)]
+
+seqGoals :: [Code] -> Code
+seqGoals [] = [NoGoal]
+seqGoals [[Cut]] = [Cut, NoGoal]
+seqGoals [x] = [Goal] ++ x ++ [LastCall]
+seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
+seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
+
+compileRule :: Id -> Id -> PrlgInt -> Code
+compileRule proveop andop = go
+  where
+    go :: PrlgInt -> Code
+    go h@(CallI x args)
+      | x == proveop
+      , [head, goals] <- args =
+        compileGoal head ++ seqGoals (compileGoals andop goals)
+      | otherwise = compileGoal h ++ seqGoals []