From 8f47919624f0153ff9afa299d994d66bb63037ef Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Fri, 4 Nov 2022 17:56:31 +0100
Subject: better shunting errors

---
 app/Interpreter.hs | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

(limited to 'app/Interpreter.hs')

diff --git a/app/Interpreter.hs b/app/Interpreter.hs
index 7df773e..76cef52 100644
--- a/app/Interpreter.hs
+++ b/app/Interpreter.hs
@@ -6,7 +6,7 @@ import qualified Data.Map as M
 {- VAM 2P, done the lazy way -}
 data StrTable =
   StrTable Int (M.Map String Int) (M.Map Int String)
-  deriving Show
+  deriving (Show)
 
 emptystrtable = StrTable 0 M.empty M.empty
 
@@ -15,12 +15,17 @@ strtablize t@(StrTable nxt fwd rev) str =
     Just i -> (t, i)
     _ -> (StrTable (nxt + 1) (M.insert str nxt fwd) (M.insert nxt str rev), nxt)
 
-data Id = Id {str::Int,arity::Int} deriving (Show, Eq, Ord)
+data Id =
+  Id
+    { str :: Int
+    , arity :: Int
+    }
+  deriving (Show, Eq, Ord)
 
 data Datum
   = Atom Int -- unifies a constant
   | Struct Id -- unifies a structure with arity
-  -- | VoidVar -- unifies with anything
+  | VoidVar -- unifies with anything
   -- | LocalVar Int -- unifies with a local variable (possibly making a new one when it's not in use yet)
   -- | Ref Int -- unifies with the referenced value on the heap (not to be used in code)
   deriving (Show, Eq, Ord)
@@ -89,10 +94,13 @@ proveStep c f i = go i
      = unify a b
       where
         uok = c i {cur = cur {hed = hs, gol = gs}}
-        unify (Atom a) (Atom b)
-          | a == b = uok
-        unify (Struct a) (Struct b)
-          | a == b = uok
+        unify VoidVar VoidVar = uok
+        unify (Atom a) (Atom b) | a == b = uok
+        unify VoidVar (Atom _) = uok
+        unify (Atom _) VoidVar = uok
+        unify (Struct a) (Struct b) | a == b = uok
+        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 _ _ = backtrack i
     {- Resulution -}
     go i@Interp { cur = cur@Cho {hed = hed, gol = gol, stk = stk, cut = cut}
-- 
cgit v1.2.3