almost the final version

examples/gfcc/compiler/CleanJVM.hs

@@ -3,7 +3,7 @@ module Main where
 import Char
 import System
 
---- now works for programs with exactly 2 functions, main last
+--- translation from Symbolic JVM to real Jasmin code
 
 main :: IO ()
 main = do
@@ -18,30 +18,36 @@ main = do
   return () 
 
 mkJVM :: String -> String -> String
-mkJVM cls = unlines . map trans . lines where
-  trans s = case words s of
+mkJVM cls = unlines . reverse . fst . foldl trans ([],([],0)) . lines where
+  trans (code,(env,v)) s = case words s of
     ".method":p:s:f:ns
-        | take 5 f == "main_" -> ".method public static main([Ljava/lang/String;)V"   
-        | otherwise  -> unwords [".method",p,s, unindex f ++ typesig ns]
-    ".limit":"locals":ns -> ".limit locals " ++ show (length ns)
-    "invokestatic":t:f:ns | take 8 f == "runtime/" -> 
-        "invokestatic " ++ "runtime/" ++ t ++ drop 8 f ++ typesig ns 
-    "invokestatic":f:ns  -> "invokestatic " ++ cls ++ "/" ++ unindex f ++ typesig ns 
-    "alloc":ns           -> "; " ++ s
-    t:('_':instr):[]     -> t ++ instr
-    t:('_':instr):x:_    -> t ++ instr ++ " " ++ address x
-    "goto":ns            -> "goto " ++ label ns
-    "ifeq":ns            -> "ifeq " ++ label ns
-    "label":ns           -> label ns ++ ":"
-    ";":[] -> ""
-    _ -> s
+        | f == "main" -> 
+            (".method public static main([Ljava/lang/String;)V":code,([],1))   
+        | otherwise  -> 
+            (unwords [".method",p,s, f ++ typesig 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 
+    "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 ++ ":"
+    ";":[] -> chCode ""
+    _ -> chCode s
    where
-     unindex = reverse . drop 1 . dropWhile (/= '_') . reverse
-     typesig = init . map toUpper . concat
-     address x = case (filter isDigit . reverse . takeWhile (/= '_') . reverse) x of
-       s@(_:_) -> show $ read s - (1 :: Int)
-       s -> s
-     label   = init . concat
+     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
+     size t   = case t of
+       "d" -> 2
+       _ -> 1
 
 boilerplate :: String -> String
 boilerplate cls = unlines [

examples/gfcc/compiler/abs.c

@@ -13,7 +13,7 @@ int abs (int x){
 int main () {
   int i ;
   i = abs (16);
-  printf (int,i) ;
+  printf ("%d",i) ;
   return ;
   } ;
 

examples/gfcc/compiler/factorial.c

@@ -14,7 +14,7 @@ int main () {
   int n ;
   n = 1 ;
   {
-    while (n < 11) printf(int,fact(n)) ; n = n+1 ;
+    while (n < 11) printf("%d",fact(n)) ; n = n+1 ;
   }
   return ;
 } ;

examples/gfcc/compiler/fibonacci.c

@@ -6,10 +6,10 @@ int main () {
   int lo ; int hi ;
   lo = 1 ;
   hi = lo ;
-  printf(int,lo) ;
+  printf("%d",lo) ;
   {
     while (hi < mx()) {
-      printf(int,hi) ;
+      printf("%d",hi) ;
       hi = lo + hi ;
       lo = hi - lo ;
       }

examples/gfcc/compiler/gfcc

@@ -1,4 +1,4 @@
 ./TestImperC $1 | tail -1 >gft.tmp
 echo "es -file=typecheck.gfs" | gf+ -s Imper.gfcm
 runhugs CleanJVM jvm.tmp $1
-rm *.tmp
+#rm *.tmp

examples/gfcc/compiler/typecheck.gfs

@@ -3,6 +3,4 @@ open gft.tmp
 '
 c solve
 '
-c reindex
-'
 save ImperJVM jvm.tmp