diff options
Diffstat (limited to 'snug-clean/src/Snug/Compile.icl')
| -rw-r--r-- | snug-clean/src/Snug/Compile.icl | 38 |
1 files changed, 37 insertions, 1 deletions
diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl index c354950..43f8a37 100644 --- a/snug-clean/src/Snug/Compile.icl +++ b/snug-clean/src/Snug/Compile.icl @@ -34,13 +34,40 @@ compile :: !Namespace ![Definition] -> [Line] compile ns defs = concatMap (compileDefinition ns globals) defs where - globals = + globals = combineGlobals + [ builtin + , gatherGlobals ns defs + ] + + builtin = { constructors = 'Data.Map'.fromList [ ({ns="", id="INT"}, ConstructorDef "INT" []) ] , functions = 'Data.Map'.newMap } +combineGlobals :: ![Globals] -> Globals +combineGlobals sets = + { constructors = 'Data.Map'.unions [g.constructors \\ g <- sets] + , functions = 'Data.Map'.unions [g.functions \\ g <- sets] + } + +gatherGlobals :: !Namespace ![Definition] -> Globals +gatherGlobals ns defs = + { constructors = 'Data.Map'.fromList + [ ({ns=ns, id=id}, cons) + \\ DataDef _ _ conses <- defs + , cons=:(ConstructorDef id _) <- conses + ] + , functions = 'Data.Map'.fromList + [ ({ns=ns, id=id}, {arity=length args, type=foldr TyApp ret (map snd (reverse args))}) + \\ FunDef id args ret _ <- defs + ] + } + +lookupFunction :: !Namespace !SymbolIdent !Globals -> ?FunctionInfo +lookupFunction ns id globs = 'Data.Map'.get {ns=ns, id=id} globs.functions + compileDefinition :: !Namespace !Globals !Definition -> [Line] compileDefinition _ _ (TypeDef _ _) = [] @@ -91,6 +118,15 @@ simulator _ _ _ (BasicValue bv) = where label (BVInt _) = "INT" label (BVChar _) = "CHAR" +simulator ns globals locals (Symbol id) = // TODO include locals + case lookupFunction ns id globals of + ?None -> abort ("unknown symbol: " +++ id +++ "\n") // TODO pass error up + ?Just info -> + case info.arity of + 0 -> + buildThunk (functionLabel ns NodeEntry id) 0 + _ -> + abort "symbol with arity > 0\n" // TODO implement simulator _ _ _ _ = // TODO pushBasicValue (BVInt 0) >>| buildCons (constructorLabel "" "INT") 1 |