looks like vars work

3 files changed, 47 insertions, 34 deletions

diff --git a/app/Compiler.hs b/app/Compiler.hs
index 08e4b24..4f94637 100644
--- a/app/Compiler.hs
+++ b/app/Compiler.hs
@@ -1,5 +1,7 @@
 module Compiler where
 
+import Data.Char (isUpper)
+import Data.Containers.ListUtils (nubOrd)
 import Data.List
 import Interpreter (Code, Datum(..), Id(..), Instr(..), StrTable, strtablize)
 
@@ -10,13 +12,29 @@ data PrlgStr
 
 data PrlgInt
   = CallI Id [PrlgInt]
-  | LiteralI Int --split off vars here later
+  | LiteralI Int
+  | VarI Int Int
+  | VoidI
   deriving (Show)
 
-strtablizePrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
-strtablizePrlg = go
+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]
+  | otherwise = []
+
+strtablizePrlg :: [String] -> StrTable -> PrlgStr -> (StrTable, PrlgInt)
+strtablizePrlg stab = go
   where
-    go t (LiteralS str) = LiteralI <$> strtablize t str
+    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
@@ -35,6 +53,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]
 
 seqGoals :: [Code] -> Code
 seqGoals [] = [NoGoal]
diff --git a/app/Frontend.hs b/app/Frontend.hs
index 2be4f68..2c92e1f 100644
--- a/app/Frontend.hs
+++ b/app/Frontend.hs
@@ -66,7 +66,8 @@ interpret = (>> return True) . lex
         Left err -> liftIO $ putStrLn $ "expression parsing: " ++ err
         Right prlg -> intern prlg
     intern prlgs = do
-      prlgi <- withStrTable $ flip C.strtablizePrlg prlgs
+      prlgi <-
+        withStrTable $ \st -> C.strtablizePrlg (C.varnames prlgs) st prlgs
       compile prlgi
     compile prlgi
       {- TODO: switch between prove goal/compile clause here -}
@@ -93,18 +94,23 @@ addBuiltins = do
   c <- findAtom "c"
   b0 <- findStruct "b" 0
   any <- findStruct "any" 1
+  eq <- findStruct "=" 2
   modify $ \s ->
     s
       { defs =
           M.fromList
-            [ (a1, [[I.U (I.Atom a), I.NoGoal], [I.U (I.Atom b), I.NoGoal]])
+            [ (eq, [[I.U (I.LocalRef 0),I.U (I.LocalRef 0), I.NoGoal]])
+            , (a1, [[I.U (I.Atom a), I.NoGoal], [I.U (I.Atom b), I.NoGoal]])
             , ( b0
               , [ [I.Goal, I.U (I.Struct a1), I.U (I.Atom c), I.LastCall]
                 , [I.Goal, I.U (I.Struct a1), I.U (I.Atom b), I.LastCall]
                 ])
-            , (any, [[I.U I.VoidVar, I.NoGoal]])
+            , (any, [[I.U I.VoidRef, I.NoGoal]])
             ]
-      , ops = [(",", P.Op 1000 $ P.Infix P.X P.Y)]
+      , ops =
+        [ (",", P.Op 1000 $ P.Infix P.X P.Y)
+        , ("=", P.Op 700 $ P.Infix P.X P.X)
+        ]
       }
 
 interpreterStart :: PrlgEnv ()
diff --git a/app/Interpreter.hs b/app/Interpreter.hs
index 6a80232..b42f079 100644
--- a/app/Interpreter.hs
+++ b/app/Interpreter.hs
@@ -25,7 +25,7 @@ data Id =
 data Datum
   = Atom Int -- unifies a constant
   | Struct Id -- unifies a structure with arity
-  | VoidVar -- in code this unifies with anything; everywhere else this is an unbound variable
+  | VoidRef -- in code this unifies with anything; everywhere else this is an unbound variable
   | LocalRef Int -- local variable idx
   | HeapRef Int -- heap structure idx
   deriving (Show, Eq, Ord)
@@ -47,7 +47,7 @@ data Heap =
   Heap Int (M.Map Int Datum)
   deriving (Show)
 
-emptyHeap = Heap 1 M.empty
+emptyHeap = Heap 0 M.empty
 
 type Scope = M.Map Int Int
 
@@ -154,35 +154,22 @@ proveStep c f i = go i
                 m'
            in cont (map HeapRef $ tail addrs) (Heap nxt' m'')
         {- simple cases first -}
-        unify VoidVar VoidVar = uok
+        unify VoidRef VoidRef = uok
         unify (Atom a) (Atom b)
           | a == b = uok
-        unify VoidVar (Atom _) = uok
-        unify (Atom _) VoidVar = uok
+        unify VoidRef (Atom _) = uok
+        unify (Atom _) VoidRef = uok
         unify (Struct a) (Struct b)
           | a == b = uok
         {- unifying a struct with void must cause us to skip the void -}
-        unify VoidVar (Struct Id {arity = a}) =
-          c i {cur = cur {hed = replicate a (U VoidVar) ++ hs, gol = gs}}
-        unify (Struct Id {arity = a}) VoidVar =
-          c i {cur = cur {hed = hs, gol = replicate a (U VoidVar) ++ gs}}
+        unify VoidRef (Struct Id {arity = a}) =
+          c i {cur = cur {hed = replicate a (U VoidRef) ++ hs, gol = gs}}
+        unify (Struct Id {arity = a}) VoidRef =
+          c i {cur = cur {hed = hs, gol = replicate a (U VoidRef) ++ gs}}
         {- handle local refs; first ignore their combination with voids to save memory -}
-        unify (LocalRef _) VoidVar = uok
-        unify VoidVar (LocalRef _) = uok
+        unify (LocalRef _) VoidRef = uok
+        unify VoidRef (LocalRef _) = uok
         {- allocate heap for LocalRefs and retry with HeapRefs -}
-        unify (LocalRef hv) (LocalRef gv) =
-          allocLocal gv (gvar cur) $ \gvar' heap' addr ->
-            c
-              i
-                { cur =
-                    cur
-                      { hed = U (HeapRef addr) : hs
-                      , hvar = M.insert hv addr (hvar cur)
-                      , gol = U (HeapRef addr) : gs
-                      , gvar = gvar'
-                      , heap = heap'
-                      }
-                }
         unify (LocalRef hv) _ =
           allocLocal hv (hvar cur) $ \hvar' heap' addr ->
             c
@@ -200,8 +187,8 @@ proveStep c f i = go i
                       {gol = U (HeapRef addr) : gs, gvar = gvar', heap = heap'}
                 }
         {- handle heap refs; first ignore their combination with voids again -}
-        unify (HeapRef _) VoidVar = uok
-        unify VoidVar (HeapRef _) = uok
+        unify (HeapRef _) VoidRef = uok
+        unify VoidRef (HeapRef _) = uok
         {- actual HeapRefs, these are dereferenced and then unified; decide between copying and linking -}
         unify (HeapRef hr') g =
           case deref hr' of