summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/gfcc/Imper.gf12
-rw-r--r--examples/gfcc/ImperC.gf20
-rw-r--r--examples/gfcc/ImperJVM.gf45
-rw-r--r--examples/gfcc/ResImper.gf2
4 files changed, 49 insertions, 30 deletions
diff --git a/examples/gfcc/Imper.gf b/examples/gfcc/Imper.gf
index 31ca82f75..28ac3d4bd 100644
--- a/examples/gfcc/Imper.gf
+++ b/examples/gfcc/Imper.gf
@@ -2,6 +2,7 @@ abstract Imper = PredefAbs ** {
cat
Program ;
+ Rec ListTyp ;
Typ ;
NumTyp ;
ListTyp ;
@@ -15,12 +16,13 @@ abstract Imper = PredefAbs ** {
fun
Empty : Program ;
Funct : (AS : ListTyp) -> (V : Typ) ->
- Body AS -> (Fun AS V -> Program) -> Program ;
+ (Fun AS V -> Rec AS) -> Program ;
+ FunctNil : (V : Typ) ->
+ Stm -> (Fun NilTyp V -> Program) -> Program ;
- BodyNil : Stm -> Body NilTyp ;
- BodyOne : (A : Typ) -> (Var A -> Stm) -> Body (ConsTyp A NilTyp) ;
- BodyCons : (A : Typ) -> (AS : ListTyp) ->
- (Var A -> Body AS) -> Body (ConsTyp A AS) ;
+ RecOne : (A : Typ) -> (Var A -> Stm) -> Program -> Rec (ConsTyp A NilTyp) ;
+ 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 ;
diff --git a/examples/gfcc/ImperC.gf b/examples/gfcc/ImperC.gf
index 28ce65a95..69ffa9226 100644
--- a/examples/gfcc/ImperC.gf
+++ b/examples/gfcc/ImperC.gf
@@ -4,21 +4,25 @@ concrete ImperC of Imper = open ResImper in {
lincat
Exp = PrecExp ;
- Body = {s,s2 : Str} ;
+ Rec = {s,s2,s3 : Str} ;
lin
Empty = ss [] ;
- Funct args val body cont = ss (
- val.s ++ cont.$0 ++ paren body.s2 ++ "{" ++
- body.s ++ "}" ++ ";" ++ cont.s) ;
+ FunctNil val stm cont = ss (
+ val.s ++ cont.$0 ++ paren [] ++ "{" ++
+ stm.s ++ "}" ++ ";" ++ cont.s) ;
+ Funct args val rec = ss (
+ val.s ++ rec.$0 ++ paren rec.s2 ++ "{" ++
+ rec.s ++ "}" ++ ";" ++ rec.s3) ;
- BodyNil stm = stm ** {s2 = []} ;
- BodyOne typ stm = stm ** {
- s2 = typ.s ++ stm.$0
+ RecOne typ stm prg = stm ** {
+ s2 = typ.s ++ stm.$0 ;
+ s3 = prg.s
} ;
- BodyCons typ _ body = {
+ RecCons typ _ body prg = {
s = body.s ;
s2 = typ.s ++ body.$0 ++ "," ++ body.s2 ;
+ s3 = prg.s
} ;
Decl typ cont = continues (typ.s ++ cont.$0) cont ;
diff --git a/examples/gfcc/ImperJVM.gf b/examples/gfcc/ImperJVM.gf
index 59506c47b..1cfce48df 100644
--- a/examples/gfcc/ImperJVM.gf
+++ b/examples/gfcc/ImperJVM.gf
@@ -1,24 +1,37 @@
+--# -path=.:../prelude
concrete ImperJVM of Imper = open ResImper in {
flags lexer=codevars ; unlexer=code ; startcat=Stm ;
lincat
- Body = {s,s2 : Str} ; -- code, storage for locals
+ Rec = {s,s2,s3 : Str} ; -- code, storage for locals, continuation
Stm = Instr ;
lin
Empty = ss [] ;
- Funct args val body rest = ss (
- ".method" ++ rest.$0 ++ paren args.s ++ val.s ++ ";" ++
- ".limit" ++ "locals" ++ body.s2 ++ ";" ++
+ FunctNil val stm cont = ss (
+ ".method" ++ cont.$0 ++ paren [] ++ val.s ++ ";" ++
+ ".limit" ++ "locals" ++ stm.s2 ++ ";" ++
".limit" ++ "stack" ++ "1000" ++ ";" ++
- body.s ++
+ stm.s ++
".end" ++ "method" ++ ";" ++
- rest.s
+ cont.s
) ;
- BodyNil stm = stm ;
- BodyCons a as body = instrb a.s (
- "alloc" ++ a.s ++ body.$0 ++ body.s2) (body ** {s3 = []});
+ Funct args val rec = ss (
+ ".method" ++ rec.$0 ++ paren args.s ++ val.s ++ ";" ++
+ ".limit" ++ "locals" ++ rec.s2 ++ ";" ++
+ ".limit" ++ "stack" ++ "1000" ++ ";" ++
+ rec.s ++
+ ".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};
+
+ RecCons typ _ body prg = instrb typ.s (
+ "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
@@ -61,19 +74,16 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ;
EVar t x = instr (t.s ++ "_load" ++ x.s) ;
EInt n = instr ("ipush" ++ n.s) ;
EFloat a b = instr ("fpush" ++ a.s ++ "." ++ b.s) ;
- EAddI = binop "iadd" ;
- EAddF = binop "fadd" ;
- ESubI = binop "isub" ;
- ESubF = binop "fsub" ;
- EMulI = binop "imul" ;
- EMulF = binop "fmul" ;
- ELtI = binop ("call" ++ "ilt") ;
- ELtF = binop ("call" ++ "flt") ;
+ EAdd = binopt "add" ;
+ ESub = binopt "sub" ;
+ EMul = binopt "mul" ;
+ ELt t = binop ("invoke" ++ t.s ++ "lt" ++ paren (t.s ++ t.s) ++ "i") ;
EApp args val f exps = instr (
exps.s ++
"invoke" ++ f.s ++ paren args.s ++ val.s
) ;
+ TNum t = t ;
TInt = ss "i" ;
TFloat = ss "f" ;
@@ -81,5 +91,6 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ;
ConsTyp = cc2 ;
NilExp = ss [] ;
+ OneExp _ e = e ;
ConsExp _ _ = cc2 ;
}
diff --git a/examples/gfcc/ResImper.gf b/examples/gfcc/ResImper.gf
index a72aaf8c2..62097bdc3 100644
--- a/examples/gfcc/ResImper.gf
+++ b/examples/gfcc/ResImper.gf
@@ -67,4 +67,6 @@ resource ResImper = {
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 ++ ";") ;
}