compiled vars carry ids

1 files changed, 24 insertions, 27 deletions

diff --git a/app/Compiler.hs b/app/Compiler.hs
index b3294a1..e9bd7f4 100644
--- a/app/Compiler.hs
+++ b/app/Compiler.hs
@@ -3,31 +3,38 @@ module Compiler where
 import Data.Char (isUpper)
 import Data.Containers.ListUtils (nubOrd)
 import Data.List
+import qualified Data.Map as M
 
 import Code (Code, Datum(..), Instr(..))
-import IR (Id(..), PrlgInt(..), PrlgStr(..), StrTable, strtablize)
+import IR (Id(..), PrlgInt(..), PrlgStr(..), StrTable(..), strtablize)
+
+internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
+internPrlg = 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
 
 varname :: String -> Bool
 varname ('_':_) = True
 varname (c:_) = isUpper c
 varname _ = False
 
-varnames :: PrlgStr -> [String]
-varnames (CallS _ xs) = nubOrd $ concatMap varnames xs
-varnames (LiteralS x)
-  | varname x = [x]
+varIds :: StrTable -> PrlgInt -> [Int]
+varIds st (CallI _ xs) = nubOrd $ concatMap (varIds st) xs
+varIds (StrTable _ _ st) (LiteralI x)
+  | Just s <- st M.!? x
+  , varname s = [x]
   | otherwise = []
 
-internPrlg :: [String] -> StrTable -> PrlgStr -> (StrTable, PrlgInt)
-internPrlg stab = go
-  where
-    go t (LiteralS str)
-      | str == "_" = (t, VoidI)
-      | Just idx <- elemIndex str stab = VarI idx <$> strtablize t str
-      | otherwise = 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
+variablizePrlg :: Int -> [Int] -> PrlgInt -> PrlgInt
+variablizePrlg void vs (CallI id ps) =
+  CallI id $ map (variablizePrlg void vs) ps
+variablizePrlg void vs (LiteralI i)
+  | i == void = VoidI i
+  | Just idx <- elemIndex i vs = VarI idx i
+  | otherwise = LiteralI i
 
 compileGoals :: Id -> PrlgInt -> [Code]
 compileGoals andop = go
@@ -43,8 +50,8 @@ compileGoal x = compileArg x
 compileArg :: PrlgInt -> Code
 compileArg (CallI x args) = U (Struct x) : concatMap compileArg args
 compileArg (LiteralI x) = [U (Atom x)]
-compileArg (VarI x _) = [U (LocalRef x)]
-compileArg VoidI = [U VoidRef]
+compileArg (VarI x i) = [U (LocalRef x $ Just i)]
+compileArg (VoidI i) = [U (VoidRef $ Just i)]
 
 seqGoals :: [Code] -> Code
 seqGoals [] = [NoGoal]
@@ -52,13 +59,3 @@ seqGoals [[Cut]] = [Cut, NoGoal]
 seqGoals [x] = [Goal] ++ x ++ [LastCall]
 seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
 seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
-
-compileClause :: Id -> Id -> PrlgInt -> Code
-compileClause 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 []