From 2c60a2d82a0d7b90924e7dbbcacf36afb8549d17 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Thu, 23 Sep 2004 14:41:42 +0000
Subject: Ints n

---
 examples/gfcc/compiler/CleanJVM.hs | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)
 create mode 100644 examples/gfcc/compiler/CleanJVM.hs

(limited to 'examples/gfcc/compiler/CleanJVM.hs')

diff --git a/examples/gfcc/compiler/CleanJVM.hs b/examples/gfcc/compiler/CleanJVM.hs
new file mode 100644
index 000000000..02070df4c
--- /dev/null
+++ b/examples/gfcc/compiler/CleanJVM.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import System
+
+main :: IO ()
+main = do
+  jvm:src:_ <- getArgs
+  s <- readFile jvm
+  let obj = takeWhile (/='.') src ++ ".j"
+  writeFile obj $ mkJVM s
+  putStrLn $ "wrote file " ++ obj
+
+mkJVM :: String -> String
+mkJVM = unlines . reverse . fst . foldl trans ([],([],0)) . lines where
+  trans (code,(env,v)) s = case words s of
+    ".method":f:ns -> ((".method " ++ f ++ concat ns):code,([],0))
+    "alloc":t:x:_  -> (code, ((x,v):env, v + size t))
+    ".limit":"locals":ns -> chCode (".limit locals " ++ show (length ns - 1))
+    t:"_load" :x:_ -> chCode (t ++ "load "  ++ look x) 
+    t:"_store":x:_ -> chCode (t ++ "store " ++ look x)
+    t:"_return":_  -> chCode (t ++ "return")
+    "goto":ns      -> chCode ("goto " ++ concat ns)
+    "ifzero":ns    -> chCode ("ifzero " ++ concat ns) 
+    _ ->   chCode s
+   where
+     chCode c = (c:code,(env,v))
+     look x = maybe (x ++ show env) show $ lookup x env
+     size t = case t of
+       "d" -> 2
+       _ -> 1
-- 
cgit v1.2.3