From ff2a2895c08b667894b565c8d39f0bf63d85492a Mon Sep 17 00:00:00 2001 From: aarne Date: Fri, 24 Sep 2004 16:04:04 +0000 Subject: [PATCH] gfcc --- examples/gfcc/ImperJVM.gf | 38 ++++++++++----------- examples/gfcc/compiler/CleanJVM.hs | 53 +++++++++++++++++++----------- examples/gfcc/compiler/FILES | 5 +++ examples/gfcc/compiler/runtime.j | 25 ++++++++++++++ src/GF/Shell/Commands.hs | 2 ++ 5 files changed, 85 insertions(+), 38 deletions(-) create mode 100644 examples/gfcc/compiler/runtime.j diff --git a/examples/gfcc/ImperJVM.gf b/examples/gfcc/ImperJVM.gf index 1cfce48df..6d9dcdb39 100644 --- a/examples/gfcc/ImperJVM.gf +++ b/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 ++ ";" ++ - ".limit" ++ "locals" ++ rec.s2 ++ ";" ++ - ".limit" ++ "stack" ++ "1000" ++ ";" ++ + ".method" ++ "public" ++ "static" ++ rec.$0 ++ paren args.s ++ val.s ++ ";" ++ + ".limit" ++ "locals" ++ rec.s2 ++ ";" ++ + ".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) ; - EFloat a b = instr ("fpush" ++ a.s ++ "." ++ b.s) ; + EInt n = instr ("ldc" ++ n.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 ; diff --git a/examples/gfcc/compiler/CleanJVM.hs b/examples/gfcc/compiler/CleanJVM.hs index 02070df4c..4bbf011d8 100644 --- a/examples/gfcc/compiler/CleanJVM.hs +++ b/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" - writeFile obj $ mkJVM s + let cls = takeWhile (/='.') src + let obj = cls ++ ".j" + writeFile obj $ boilerplate cls + appendFile obj $ mkJVM cls 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 +mkJVM :: String -> String -> String +mkJVM cls = unlines . map trans . lines where + trans s = case words s of + ".method":p:s:f:ns -> unwords [".method",p,s, unindex f ++ typesig ns] + ".limit":"locals":ns -> ".limit locals " ++ show (length ns - 1) + "invokestatic":t:"runtime/lt":ns -> ".invokestatic " ++ "runtime/" ++ t ++ "lt" ++ typesig ns + "invokestatic":f:ns -> "invokestatic " ++ cls ++ "/" ++ unindex f ++ typesig ns + "alloc":ns -> "; " ++ s + t:('_':instr):x:_ -> t ++ instr ++ " " ++ address x + "goto":ns -> "goto " ++ label ns + "ifeq":ns -> "ifzero " ++ label ns + "label":ns -> label ns + ";":[] -> "" + _ -> 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 + unindex = reverse . drop 1 . dropWhile (/= '_') . reverse + typesig = init . map toUpper . concat + address = reverse . takeWhile (/= '_') . reverse + label = init . concat + +boilerplate :: String -> String +boilerplate cls = unlines [ + ".class public " ++ cls ++ ".j", + ".super java/lang/Object", + ".method public ()V", + "aload_0", + "invokenonvirtual java/lang/Object/()V", + "return", + ".end method" + ] diff --git a/examples/gfcc/compiler/FILES b/examples/gfcc/compiler/FILES index 306a8d133..332b37372 100644 --- a/examples/gfcc/compiler/FILES +++ b/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 diff --git a/examples/gfcc/compiler/runtime.j b/examples/gfcc/compiler/runtime.j new file mode 100644 index 000000000..c99523cc7 --- /dev/null +++ b/examples/gfcc/compiler/runtime.j @@ -0,0 +1,25 @@ +.class public runtime +.super java/lang/Object +; +; standard initializer +.method public ()V + aload_0 + invokenonvirtual java/lang/Object/()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 diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs index 09f9b5f78..b1f43ddbe 100644 --- a/src/GF/Shell/Commands.hs +++ b/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 $