gfcc

examples/gfcc/ImperJVM.gf

@@ -10,31 +10,31 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ;
   lin
     Empty = ss [] ;
     FunctNil val stm cont = ss (
-      ".method" ++ cont.$0 ++ paren [] ++ val.s ++ ";" ++
+      ".method" ++ "public" ++ "static" ++ cont.$0 ++ paren [] ++ val.s ++ ";" ++
       ".limit" ++ "locals" ++ stm.s2 ++ ";" ++
       ".limit" ++ "stack" ++ "1000" ++ ";" ++
       stm.s ++
-      ".end" ++ "method" ++ ";" ++
+      ".end" ++ "method" ++ ";" ++ ";" ++
       cont.s 
       ) ;
     Funct args val rec = ss (
-      ".method" ++ rec.$0 ++ paren args.s ++ val.s ++ ";" ++
+      ".method" ++ "public" ++ "static" ++ rec.$0 ++ paren args.s ++ val.s ++ ";" ++
-      ".limit" ++ "locals" ++ rec.s2 ++ ";" ++
+      ".limit"  ++ "locals" ++ rec.s2 ++ ";" ++
-      ".limit" ++ "stack" ++ "1000" ++ ";" ++
+      ".limit"  ++ "stack"  ++ "1000" ++ ";" ++
       rec.s ++
-      ".end" ++ "method" ++ ";" ++
+      ".end" ++ "method" ++ ";" ++ ";" ++
       rec.s3 
       ) ;
 
     RecOne typ stm prg = instrb typ.s (
-      "alloc" ++ typ.s ++ stm.$0 ++ stm.s2) {s = stm.s ; s2 = stm.s2 ; s3 = prg.s};
+      ["alloc"] ++ typ.s ++ stm.$0 ++ stm.s2) {s = stm.s ; s2 = stm.s2 ; s3 = prg.s};
 
     RecCons typ _ body prg = instrb typ.s (
-      "alloc" ++ typ.s ++ body.$0 ++ body.s2) 
+      ["alloc"] ++ typ.s ++ body.$0 ++ body.s2) 
          {s = body.s ; s2 = body.s2 ; s3 = prg.s};
 
     Decl  typ cont = instrb typ.s (
-      "alloc" ++ typ.s ++ cont.$0
+      ["alloc"] ++ typ.s ++ cont.$0
       ) cont ;
     Assign t x exp = instrc (
       exp.s ++ 
@@ -48,12 +48,12 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ;
         test = "TEST_" ++ loop.s2 ; 
         end = "END_" ++ loop.s2
       in instrl (
-        test ++ ";" ++
+        "label" ++ test ++ ";" ++
         exp.s ++ 
-        "ifzero" ++ end ++ ";" ++ 
+        "ifeq" ++ end ++ ";" ++ 
         loop.s ++
         "goto" ++ test ++ ";" ++ 
-        end
+        "label" ++ end
         ) ;
     IfElse exp t f = 
       let 
@@ -61,26 +61,26 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ;
         true  = "TRUE_" ++ t.s2 ++ f.s2
       in instrl (
         exp.s ++ 
-        "ifzero" ++ false ++ ";" ++ 
+        "ifeq" ++ false ++ ";" ++ 
         t.s ++
         "goto" ++ true ++ ";" ++
-        false ++ ";" ++
+        "label" ++ false ++ ";" ++
         f.s ++ 
-        true
+        "label" ++ true
         ) ;
     Block stm      = instrc stm.s ;
     End            = ss [] ** {s2,s3 = []} ;
 
     EVar  t x  = instr (t.s ++ "_load" ++ x.s) ;
-    EInt    n  = instr ("ipush" ++ n.s) ;
+    EInt    n  = instr ("ldc" ++ n.s) ;
-    EFloat a b = instr ("fpush" ++ a.s ++ "." ++ b.s) ;
+    EFloat a b = instr ("ldc" ++ a.s ++ "." ++ b.s) ;
     EAdd       = binopt "add" ;
     ESub       = binopt "sub" ;
     EMul       = binopt "mul" ;
-    ELt t      = binop ("invoke" ++ t.s ++ "lt" ++ paren (t.s ++ t.s) ++ "i") ;
+    ELt t      = binop ("invokestatic" ++ t.s ++ "runtime/lt" ++ paren (t.s ++ t.s) ++ "i") ;
     EApp args val f exps = instr (
       exps.s ++
-      "invoke" ++ f.s ++ paren args.s ++ val.s
+      "invokestatic" ++ f.s ++ paren args.s ++ val.s
       ) ;
 
     TNum t = t ;

examples/gfcc/compiler/CleanJVM.hs

@@ -1,30 +1,45 @@
 module Main where
 
+import Char
 import System
 
 main :: IO ()
 main = do
   jvm:src:_ <- getArgs
   s <- readFile jvm
-  let obj = takeWhile (/='.') src ++ ".j"
+  let cls = takeWhile (/='.') src
-  writeFile obj $ mkJVM s
+  let obj = cls ++ ".j"
+  writeFile  obj $ boilerplate cls
+  appendFile obj $ mkJVM cls s
   putStrLn $ "wrote file " ++ obj
 
-mkJVM :: String -> String
+mkJVM :: String -> String -> String
-mkJVM = unlines . reverse . fst . foldl trans ([],([],0)) . lines where
+mkJVM cls = unlines . map trans . lines where
-  trans (code,(env,v)) s = case words s of
+  trans s = case words s of
-    ".method":f:ns -> ((".method " ++ f ++ concat ns):code,([],0))
+    ".method":p:s:f:ns   -> unwords [".method",p,s, unindex f ++ typesig ns]
-    "alloc":t:x:_  -> (code, ((x,v):env, v + size t))
+    ".limit":"locals":ns -> ".limit locals " ++ show (length ns - 1)
-    ".limit":"locals":ns -> chCode (".limit locals " ++ show (length ns - 1))
+    "invokestatic":t:"runtime/lt":ns -> ".invokestatic " ++ "runtime/" ++ t ++ "lt" ++ typesig ns 
-    t:"_load" :x:_ -> chCode (t ++ "load "  ++ look x) 
+    "invokestatic":f:ns  -> "invokestatic " ++ cls ++ "/" ++ unindex f ++ typesig ns 
-    t:"_store":x:_ -> chCode (t ++ "store " ++ look x)
+    "alloc":ns           -> "; " ++ s
-    t:"_return":_  -> chCode (t ++ "return")
+    t:('_':instr):x:_    -> t ++ instr ++ " " ++ address x
-    "goto":ns      -> chCode ("goto " ++ concat ns)
+    "goto":ns            -> "goto "   ++ label ns
-    "ifzero":ns    -> chCode ("ifzero " ++ concat ns) 
+    "ifeq":ns            -> "ifzero " ++ label ns
-    _ ->   chCode s
+    "label":ns           -> label ns
+    ";":[] -> ""
+    _ -> s
    where
-     chCode c = (c:code,(env,v))
+     unindex = reverse . drop 1 . dropWhile (/= '_') . reverse
-     look x = maybe (x ++ show env) show $ lookup x env
+     typesig = init . map toUpper . concat
-     size t = case t of
+     address = reverse . takeWhile (/= '_') . reverse
-       "d" -> 2
+     label   = init . concat
-       _ -> 1
+
+boilerplate :: String -> String
+boilerplate cls = unlines [
+  ".class public " ++ cls ++ ".j",
+  ".super java/lang/Object",
+  ".method public <init>()V",
+  "aload_0",
+  "invokenonvirtual java/lang/Object/<init>()V",
+  "return",
+  ".end method"
+  ]

examples/gfcc/compiler/FILES

@@ -12,6 +12,11 @@ typecheck.gfs -- the type checker and constraint solver ; GF editor script
 CleanJVM.hs   -- cleans up jvm.tmp to produce Foo.j ; Haskell module
 makefile      -- builds the compiler from GF source ; Unix Make file
 
+Runtime system:
+--------------
+
+runtime.j     -- jasmin source of the runtime class
+
 Generated files:
 ---------------
 Imper.gfcm    -- canonical multilingual GF grammar for C and JVM

examples/gfcc/compiler/runtime.j

@@ -0,0 +1,25 @@
+.class public runtime
+.super java/lang/Object
+;
+; standard initializer
+.method public <init>()V
+  aload_0
+  invokenonvirtual java/lang/Object/<init>()V
+  return
+.end method
+
+.method public static ilt(II)I
+.limit locals 2
+.limit stack 2
+    iload_0
+    iload_1
+    if_icmpge Label0
+    iconst_1
+    ireturn
+  Label0:
+    iconst_0
+    ireturn
+  Label1:
+.end method
+
+; TODO: flt missing

src/GF/Shell/Commands.hs

@@ -248,6 +248,8 @@ execECommand env c = case c of
   CSelectCand i      -> selectCand cgr i
 
   CTermCommand c     -> case c of
+                         "reindex" -> \s ->
+                           replaceByTermCommand der gr c (actTree (stateSState s)) s
                          "paraphrase" -> \s ->
                            replaceByTermCommand der gr c (actTree (stateSState s)) s
 ----                          "transfer" -> action2commandNext $