diff options
Diffstat (limited to 'compiler.hs')
| -rw-r--r-- | compiler.hs | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/compiler.hs b/compiler.hs index 64b887c..2e3b80b 100644 --- a/compiler.hs +++ b/compiler.hs @@ -6,6 +6,7 @@ import Control.Monad.State.Strict import Data.List import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import Debug.Trace import AST import Intermediate @@ -70,8 +71,11 @@ data ScopeItem = SIParam Int | SIClosure Int | SIGlobal newtype CM a = CM {unCM :: StateT CompState (Except String) a} deriving (Functor, Applicative, Monad, MonadState CompState, MonadError String) +-- TODO: extra info like number of arguments, dunno, might be useful builtinMap :: Map.Map Name () -builtinMap = Map.fromList [("+", ()), ("-", ()), ("<=", ()), ("print", ())] +builtinMap = Map.fromList [ + ("+", ()), ("-", ()), ("<=", ()), ("print", ()), + ("list", ()), ("car", ()), ("cdr", ())] bbId :: BB -> Int bbId (BB i _ _) = i @@ -228,6 +232,7 @@ genTValue (TVDefine name value) nextnext = do dref <- genTemp defineAdd name dref vref <- genTValue value nextnext + -- traceM $ "Defining '" ++ name ++ "', ref " ++ show dref ++ ", with value " ++ show vref addIns (dref, IAssign vref) return RNone genTValue (TVLambda args body closure) nextnext = do @@ -245,12 +250,11 @@ genTValue (TVLambda args body closure) nextnext = do resref <- case closure of [] -> return (RSClo uname) _ -> do - refs <- foldM (\refs' cname -> do - b <- newBlock - r <- genTValue (TVName cname undefined) b - switchBlock b - return (r : refs')) - [] closure + refs <- forM closure $ \cname -> do + b <- newBlock + r <- genTValue (TVName cname undefined) b + switchBlock b + return r r <- genTemp addIns (r, IAllocClo uname refs) return r @@ -279,3 +283,4 @@ genTValue (TVName name _) nextnext = do _ -> throwError $ "Use of undefined name \"" ++ name ++ "\"" setTerm $ IJmp nextnext return r +genTValue TVEllipsis _ = throwError "Ellipses not supported in compiler" |