diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Builtins.hs | 1 | ||||
| -rw-r--r-- | app/Code.hs | 3 | ||||
| -rw-r--r-- | app/Compiler.hs | 16 | ||||
| -rw-r--r-- | app/IR.hs | 8 | ||||
| -rw-r--r-- | app/Interpreter.hs | 9 |
5 files changed, 26 insertions, 11 deletions
diff --git a/app/Builtins.hs b/app/Builtins.hs index e547bd0..22e1c30 100644 --- a/app/Builtins.hs +++ b/app/Builtins.hs @@ -33,6 +33,7 @@ bi = Builtin showTerm itos heap = runIdentity . heapStruct atom struct hrec heap where atom (Atom a) = pure $ itos M.! a + atom (Number n) = pure (show n) atom VoidRef = pure "_" struct (Struct (IR.Id h _)) args = pure $ itos M.! h ++ "(" ++ intercalate "," args ++ ")" diff --git a/app/Code.hs b/app/Code.hs index eb5149c..5ac4ce7 100644 --- a/app/Code.hs +++ b/app/Code.hs @@ -9,7 +9,8 @@ import Operators (Ops) import System.Console.Haskeline (InputT) data Datum - = Atom Int -- unifies a constant + = Atom Int -- unifies a symbolic constant + | Number Int -- unifies a numeric constant | Struct Id -- unifies a structure with arity | VoidRef -- unifies with anything | LocalRef Int -- code-local variable idx (should never occur on heap) diff --git a/app/Compiler.hs b/app/Compiler.hs index 6d104a9..206bc40 100644 --- a/app/Compiler.hs +++ b/app/Compiler.hs @@ -11,7 +11,7 @@ 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) = LiteralI list + go (ListI [] Nothing) = AtomI list go (ListI [] (Just x)) = go x go x = x @@ -29,10 +29,11 @@ variablizePrlg :: Int -> StrTable -> PrlgInt -> PrlgInt variablizePrlg void (StrTable _ _ itos) = go where go (CallI i ps) = CallI i $ map go ps - go (LiteralI i) + go (AtomI i) | i == void = VoidI | varname (itos M.! i) = VarI i i - | otherwise = LiteralI i + | otherwise = AtomI i + go x = x renumVars :: (Int -> Maybe PrlgInt) -> PrlgInt -> PrlgInt renumVars rename = go @@ -67,7 +68,8 @@ compileGoal = compileArg . struct2goal compileArg :: PrlgInt -> Code compileArg (CallI i args) = U (Struct Id {str = i, arity = length args}) : concatMap compileArg args -compileArg (LiteralI s) = [U (Atom s)] +compileArg (AtomI s) = [U (Atom s)] +compileArg (NumI s) = [U (Number s)] compileArg (VarI x _) = [U (LocalRef x)] compileArg (VoidI) = [U VoidRef] @@ -82,7 +84,7 @@ seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs heapStructPrlgInt :: Monad m => m PrlgInt -> Heap -> Int -> m PrlgInt heapStructPrlgInt heaperr heap ref = heapStruct atom struct hrec heap ref where - atom (Atom s) = pure $ LiteralI s + atom (Atom s) = pure $ AtomI s atom VoidRef = pure $ VoidI struct (Struct s) args = pure $ CallI (str s) args hrec (HeapRef r) ref @@ -91,9 +93,9 @@ heapStructPrlgInt heaperr heap ref = heapStruct atom struct hrec heap ref -- TODO check if this is used goal2struct :: PrlgInt -> PrlgInt -goal2struct (CallI s []) = LiteralI s +goal2struct (CallI s []) = AtomI s goal2struct x = x struct2goal :: PrlgInt -> PrlgInt -struct2goal (LiteralI s) = CallI s [] +struct2goal (AtomI s) = CallI s [] struct2goal x = x @@ -1,5 +1,6 @@ module IR where +import Data.Char (isNumber) import Data.List (mapAccumL) import qualified Data.Map as M @@ -18,7 +19,8 @@ data Id = data PrlgInt = CallI Int [PrlgInt] - | LiteralI Int + | AtomI Int + | NumI Int | ListI [PrlgInt] (Maybe PrlgInt) -- only exists before desugaring | VarI Int Int -- VarI localIndex strTableString | VoidI @@ -38,7 +40,9 @@ strtablize t@(StrTable nxt fwd rev) str = internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt) internPrlg = go where - go t (LiteralS str) = LiteralI <$> strtablize t str + go t (LiteralS str) + | all isNumber str = (t, NumI $ read str) + | otherwise = AtomI <$> strtablize t str go t (CallS str ps) = let (t', i) = strtablize t str in CallI i <$> mapAccumL go t' ps diff --git a/app/Interpreter.hs b/app/Interpreter.hs index d82793b..bb47144 100644 --- a/app/Interpreter.hs +++ b/app/Interpreter.hs @@ -94,6 +94,10 @@ proveStep = St.get >>= go | a == b = uok unify VoidRef (Atom _) = uok unify (Atom _) VoidRef = uok + unify (Number a) (Number b) + | a == b = uok + unify VoidRef (Number _) = uok + unify (Number _) VoidRef = uok unify (Struct a) (Struct b) | a == b = uok {- unifying a struct with void must cause us to skip the void -} @@ -130,6 +134,7 @@ proveStep = St.get >>= go FreeRef hr -> case g of atom@(Atom _) -> setHeap hr atom + number@(Number _) -> setHeap hr number s@(Struct _) -> withNewHeapStruct hr @@ -147,7 +152,8 @@ proveStep = St.get >>= go FreeRef gr -> setHeap hr (HeapRef gr) BoundRef addr _ -> setHeap hr (HeapRef addr) _ -> ifail "dangling goal ref (from head ref)" - BoundRef _ atom@(Atom a) -> unify atom g + BoundRef _ atom@(Atom _) -> unify atom g + BoundRef _ number@(Number _) -> unify number g BoundRef addr struct@(Struct Id {arity = arity}) -> c i @@ -165,6 +171,7 @@ proveStep = St.get >>= go FreeRef gr -> case h of atom@(Atom _) -> setHeap gr atom + number@(Number _) -> setHeap gr number s@(Struct _) -> withNewHeapStruct gr |