diff --git a/examples/gfcc/Imper.gf b/examples/gfcc/Imper.gf index 28ac3d4bd..06b2f9d95 100644 --- a/examples/gfcc/Imper.gf +++ b/examples/gfcc/Imper.gf @@ -24,13 +24,15 @@ abstract Imper = PredefAbs ** { RecCons : (A : Typ) -> (AS : ListTyp) -> (Var A -> Rec AS) -> Program -> Rec (ConsTyp A AS) ; - Decl : (A : Typ) -> (Var A -> Stm) -> Stm ; - Assign : (A : Typ) -> Var A -> Exp A -> Stm -> Stm ; - Return : (A : Typ) -> Exp A -> Stm ; - While : Exp TInt -> Stm -> Stm -> Stm ; - IfElse : Exp TInt -> Stm -> Stm -> Stm -> Stm ; - Block : Stm -> Stm -> Stm ; - End : Stm ; + Decl : (A : Typ) -> (Var A -> Stm) -> Stm ; + Assign : (A : Typ) -> Var A -> Exp A -> Stm -> Stm ; + While : Exp TInt -> Stm -> Stm -> Stm ; + IfElse : Exp TInt -> Stm -> Stm -> Stm -> Stm ; + Block : Stm -> Stm -> Stm ; + Printf : (A : Typ) -> Exp A -> Stm -> Stm ; + Return : (A : Typ) -> Exp A -> Stm ; + Returnv : Stm ; + End : Stm ; EVar : (A : Typ) -> Var A -> Exp A ; EInt : Int -> Exp (TNum TInt) ; diff --git a/examples/gfcc/ImperC.gf b/examples/gfcc/ImperC.gf index fd59e16d5..d4e690635 100644 --- a/examples/gfcc/ImperC.gf +++ b/examples/gfcc/ImperC.gf @@ -27,10 +27,12 @@ concrete ImperC of Imper = open ResImper in { Decl typ cont = continues (typ.s ++ cont.$0) cont ; Assign _ x exp = continues (x.s ++ "=" ++ exp.s) ; - Return _ exp = statement ("return" ++ exp.s) ; While exp loop = continue ("while" ++ paren exp.s ++ loop.s) ; IfElse exp t f = continue ("if" ++ paren exp.s ++ t.s ++ "else" ++ f.s) ; Block stm = continue ("{" ++ stm.s ++ "}") ; + Printf t e = continues ("printf" ++ paren (t.s ++ "," ++ e.s)) ; + Return _ exp = statement ("return" ++ exp.s) ; + Returnv = statement "return" ; End = ss [] ; EVar _ x = constant x.s ; diff --git a/examples/gfcc/ImperJVM.gf b/examples/gfcc/ImperJVM.gf index 6d9dcdb39..007f8cd6f 100644 --- a/examples/gfcc/ImperJVM.gf +++ b/examples/gfcc/ImperJVM.gf @@ -36,13 +36,7 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ; Decl typ cont = instrb typ.s ( ["alloc"] ++ typ.s ++ cont.$0 ) cont ; - Assign t x exp = instrc ( - exp.s ++ - t.s ++ "_store" ++ x.s - ) ; - Return t exp = instr ( - exp.s ++ - t.s ++ "_return") ; + Assign t x exp = instrc (exp.s ++ t.s ++ "_store" ++ x.s) ; While exp loop = let test = "TEST_" ++ loop.s2 ; @@ -69,14 +63,17 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ; "label" ++ true ) ; Block stm = instrc stm.s ; + Printf t e = instrc (e.s ++ "invokestatic" ++ t.s ++ "runtime/printf" ++ paren (t.s) ++ "v") ; + Return t exp = instr (exp.s ++ t.s ++ "_return") ; + Returnv = instr "return" ; End = ss [] ** {s2,s3 = []} ; EVar t x = instr (t.s ++ "_load" ++ x.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" ; + EAdd = binopt "_add" ; + ESub = binopt "_sub" ; + EMul = binopt "_mul" ; ELt t = binop ("invokestatic" ++ t.s ++ "runtime/lt" ++ paren (t.s ++ t.s) ++ "i") ; EApp args val f exps = instr ( exps.s ++ diff --git a/examples/gfcc/ResImper.gf b/examples/gfcc/ResImper.gf index c392f078e..10454e4df 100644 --- a/examples/gfcc/ResImper.gf +++ b/examples/gfcc/ResImper.gf @@ -72,6 +72,6 @@ resource ResImper = open Predef in { ss (s ++ ";" ++ i.s) ** {s2 = v ++ i.s2 ; s3 = i.s3} ; binop : Str -> SS -> SS -> SS = \op, x, y -> ss (x.s ++ y.s ++ op ++ ";") ; - binopt : Str -> SS -> SS -> SS -> SS = \op, x, y, t -> - ss (x.s ++ y.s ++ t.s ++ op ++ ";") ; + binopt : Str -> SS -> SS -> SS -> SS = \op, t -> + binop (t.s ++ op) ; } diff --git a/examples/gfcc/compiler/CleanJVM.hs b/examples/gfcc/compiler/CleanJVM.hs index 4bbf011d8..72a0060c2 100644 --- a/examples/gfcc/compiler/CleanJVM.hs +++ b/examples/gfcc/compiler/CleanJVM.hs @@ -3,6 +3,8 @@ module Main where import Char import System +--- now works for programs with exactly 2 functions, main last + main :: IO () main = do jvm:src:_ <- getArgs @@ -12,30 +14,38 @@ main = do writeFile obj $ boilerplate cls appendFile obj $ mkJVM cls s putStrLn $ "wrote file " ++ obj + system $ "jasmin " ++ obj + return () 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 + ".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 -> "ifzero " ++ label ns - "label":ns -> label ns + "goto":ns -> "goto " ++ label ns + "ifeq":ns -> "ifeq " ++ label ns + "label":ns -> label ns ++ ":" ";":[] -> "" _ -> s where unindex = reverse . drop 1 . dropWhile (/= '_') . reverse typesig = init . map toUpper . concat - address = reverse . takeWhile (/= '_') . reverse + address x = case (filter isDigit . reverse . takeWhile (/= '_') . reverse) x of + s@(_:_) -> show $ read s - (1 :: Int) + s -> s label = init . concat boilerplate :: String -> String boilerplate cls = unlines [ - ".class public " ++ cls ++ ".j", + ".class public " ++ cls, ".super java/lang/Object", ".method public ()V", "aload_0", diff --git a/examples/gfcc/compiler/abs.c b/examples/gfcc/compiler/abs.c index c93b703b6..90312a2de 100644 --- a/examples/gfcc/compiler/abs.c +++ b/examples/gfcc/compiler/abs.c @@ -1,12 +1,20 @@ int abs (int x){ + int y ; + { if (x < 0){ - return 0 - x ; + y = 0 - x ; } - else return x ; + else { + y = x ; + } + } + return y ; } ; int main () { int i ; i = abs (16); + printf (int,i) ; + return ; } ; diff --git a/examples/gfcc/compiler/fibonacci.c b/examples/gfcc/compiler/fibonacci.c new file mode 100644 index 000000000..c5a791bdf --- /dev/null +++ b/examples/gfcc/compiler/fibonacci.c @@ -0,0 +1,18 @@ +int mx () { + return 5000000 ; +} ; + +int main () { + int lo ; int hi ; + lo = 1 ; + hi = lo ; + printf(int,lo) ; + { + while (hi < mx()) { + printf(int,hi) ; + hi = lo + hi ; + lo = hi - lo ; + } + } + return ; +} ; diff --git a/examples/gfcc/compiler/runtime.j b/examples/gfcc/compiler/runtime.j index c99523cc7..88db0b9b8 100644 --- a/examples/gfcc/compiler/runtime.j +++ b/examples/gfcc/compiler/runtime.j @@ -19,7 +19,37 @@ Label0: iconst_0 ireturn - Label1: .end method -; TODO: flt missing +.method public static flt(FF)I +.limit locals 2 +.limit stack 2 + fload_0 + fload_1 + fcmpl + ifge Label0 + iconst_1 + ireturn + Label0: + iconst_0 + ireturn +.end method + +.method public static iprintf(I)V +.limit locals 1 +.limit stack 1000 + getstatic java/lang/System/out Ljava/io/PrintStream; + iload_0 + invokevirtual java/io/PrintStream/println(I)V + return +.end method + +.method public static fprintf(F)V +.limit locals 1 +.limit stack 1000 + getstatic java/lang/System/out Ljava/io/PrintStream; + fload_0 + invokevirtual java/io/PrintStream/println(F)V + return +.end method +