diff options
Diffstat (limited to 'app/Compiler.hs')
| -rw-r--r-- | app/Compiler.hs | 40 |
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." |