msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

gfcc in Types

Browse Source
This commit is contained in:
aarne
2004-12-20 07:57:05 +00:00
parent 8caa3ed737
commit 6e1f41b26a
7 changed files with 125 additions and 153 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
examples/gfcc/compiler/CleanJVM.hs
View File

@@ -24,27 +24,23 @@ mkJVM cls = unlines . reverse . fst . foldl trans ([],([],0)) . lines where
| f == "main" ->
(".method public static main([Ljava/lang/String;)V":code,([],1))
| otherwise ->
(unwords [".method",p,s, f ++ typesig ns] : code,([],0))
(unwords [".method",p,s, f ++ glue ns] : code,([],0))
"alloc":t:x:_ -> (("; " ++ s):code, ((x,v):env, v + size t))
".limit":"locals":ns -> chCode (".limit locals " ++ show (length ns))
"invokestatic":t:f:ns
| take 8 f == "runtime/" ->
chCode $ "invokestatic " ++ "runtime/" ++ t ++ drop 8 f ++ typesig ns
"invokestatic":f:ns ->
chCode $ "invokestatic " ++ cls ++ "/" ++ f ++ typesig ns
"runtime":f:ns -> chCode $ "invokestatic " ++ "runtime/" ++ f ++ glue ns
"static":f:ns -> chCode $ "invokestatic " ++ cls ++ "/" ++ f ++ glue ns
"alloc":ns -> chCode $ "; " ++ s
t:('_':instr):[";"] -> chCode $ t ++ instr
t:('_':instr):x:_ -> chCode $ t ++ instr ++ " " ++ look x
"goto":ns -> chCode $ "goto " ++ label ns
"ifeq":ns -> chCode $ "ifeq " ++ label ns
"label":ns -> chCode $ label ns ++ ":"
ins:x:_ | symb ins -> chCode $ ins ++ " " ++ look x
"goto":ns -> chCode $ "goto " ++ glue ns
"ifeq":ns -> chCode $ "ifeq " ++ glue ns
"label":ns -> chCode $ glue ns ++ ":"
";":[] -> chCode ""
_ -> chCode s
where
chCode c = (c:code,(env,v))
look x = maybe (error $ x ++ show env) show $ lookup x env
typesig = init . map toUpper . concat
label = init . concat
glue = init . concat
symb = flip elem ["load","store"] . tail
size t = case t of
"d" -> 2
_ -> 1