strings and a few other small nice changes

1 files changed, 15 insertions, 25 deletions

diff --git a/app/Compiler.hs b/app/Compiler.hs
index f77a969..693bf99 100644
--- a/app/Compiler.hs
+++ b/app/Compiler.hs
@@ -1,20 +1,12 @@
 module Compiler where
 
+import Constant
 import Data.Char (isUpper)
 import qualified Data.Map as M
 
-import Code (Code, Datum(..), Heap, Instr(..))
+import Code (Code, Datum(..), Heap, Id(..), Instr(..))
 import Heap (heapStruct)
-import IR (Id(..), PrlgInt(..), StrTable(..))
-
-desugarPrlg :: Int -> PrlgInt -> PrlgInt
-desugarPrlg list = go
-  where
-    go (CallI id ps) = CallI id $ map go ps
-    go (ListI (x:xs) t) = CallI list [go x, go (ListI xs t)]
-    go (ListI [] Nothing) = AtomI list
-    go (ListI [] (Just x)) = go x
-    go x = x
+import IR (PrlgInt(..), StrTable(..))
 
 varname :: String -> Bool
 varname ('_':_) = True
@@ -23,24 +15,24 @@ varname _ = False
 
 varOccurs :: PrlgInt -> M.Map Int Int
 varOccurs (CallI _ xs) = M.unionsWith (+) $ map varOccurs xs
-varOccurs (VarI idx _) = M.singleton idx 1
+varOccurs (VarI idx) = M.singleton idx 1
 varOccurs _ = M.empty
 
 variablizePrlg :: Int -> StrTable -> PrlgInt -> PrlgInt
 variablizePrlg void (StrTable _ _ itos) = go
   where
     go (CallI i ps) = CallI i $ map go ps
-    go (AtomI i)
+    go o@(ConstI (Atom i))
       | i == void = VoidI
-      | varname (itos M.! i) = VarI i i
-      | otherwise = AtomI i
+      | varname (itos M.! i) = VarI i
+      | otherwise = o
     go x = x
 
 renumVars :: (Int -> Maybe PrlgInt) -> PrlgInt -> PrlgInt
 renumVars rename = go
   where
     go (CallI i ps) = CallI i $ map go ps
-    go (VarI idx i)
+    go (VarI idx)
       | Just new <- rename idx = new
     go x = x
 
@@ -50,7 +42,7 @@ squashVars x =
       m' =
         M.fromList $
         [(idx, VoidI) | (idx, n) <- occurs, n <= 1] ++
-        [(idx, VarI idx' 0) | ((idx, n), idx') <- zip occurs [1 ..], n > 1]
+        [(idx, VarI idx') | ((idx, n), idx') <- zip occurs [1 ..], n > 1]
    in renumVars (m' M.!?) x
 
 squashChoices :: [Code] -> Code
@@ -79,9 +71,8 @@ compileGoal = compileArg . struct2goal
 compileArg :: PrlgInt -> Code
 compileArg (CallI i args) =
   U (Struct Id {str = i, arity = length args}) : concatMap compileArg args
-compileArg (AtomI s) = [U (Atom s)]
-compileArg (NumI s) = [U (Number s)]
-compileArg (VarI x _) = [U (LocalRef x)]
+compileArg (ConstI c) = [U (C c)]
+compileArg (VarI x) = [U (LocalRef x)]
 compileArg (VoidI) = [U VoidRef]
 
 seqGoals :: [Code] -> Code
@@ -90,20 +81,19 @@ seqGoals = (++ [Done]) . concat
 heapStructPrlgInt :: Monad m => m PrlgInt -> Heap -> Int -> m PrlgInt
 heapStructPrlgInt heaperr heap ref = heapStruct atom struct hrec heap ref
   where
-    atom (Atom s) = pure $ AtomI s
-    atom (Number n) = pure $ NumI n
+    atom (C c) = pure (ConstI c)
     atom VoidRef = pure $ VoidI
     struct (Struct s) args = pure $ CallI (str s) args
     hrec (HeapRef r) ref
-      | r == ref = pure $ VarI r 0
+      | r == ref = pure $ VarI r
       | otherwise = heaperr
 
 -- TODO check if this is used
 goal2struct :: PrlgInt -> PrlgInt
-goal2struct (CallI s []) = AtomI s
+goal2struct (CallI s []) = ConstI (Atom s)
 goal2struct x = x
 
 struct2goal :: PrlgInt -> PrlgInt
-struct2goal (AtomI s) = CallI s []
+struct2goal (ConstI (Atom s)) = CallI s []
 struct2goal call@(CallI _ _) = call
 struct2goal _ = error "TODO."