blob: 59506c47b26aab995e436cd3560880655cb53918 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
concrete ImperJVM of Imper = open ResImper in {
flags lexer=codevars ; unlexer=code ; startcat=Stm ;
lincat
Body = {s,s2 : Str} ; -- code, storage for locals
Stm = Instr ;
lin
Empty = ss [] ;
Funct args val body rest = ss (
".method" ++ rest.$0 ++ paren args.s ++ val.s ++ ";" ++
".limit" ++ "locals" ++ body.s2 ++ ";" ++
".limit" ++ "stack" ++ "1000" ++ ";" ++
body.s ++
".end" ++ "method" ++ ";" ++
rest.s
) ;
BodyNil stm = stm ;
BodyCons a as body = instrb a.s (
"alloc" ++ a.s ++ body.$0 ++ body.s2) (body ** {s3 = []});
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") ;
While exp loop =
let
test = "TEST_" ++ loop.s2 ;
end = "END_" ++ loop.s2
in instrl (
test ++ ";" ++
exp.s ++
"ifzero" ++ end ++ ";" ++
loop.s ++
"goto" ++ test ++ ";" ++
end
) ;
IfElse exp t f =
let
false = "FALSE_" ++ t.s2 ++ f.s2 ;
true = "TRUE_" ++ t.s2 ++ f.s2
in instrl (
exp.s ++
"ifzero" ++ false ++ ";" ++
t.s ++
"goto" ++ true ++ ";" ++
false ++ ";" ++
f.s ++
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) ;
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") ;
EApp args val f exps = instr (
exps.s ++
"invoke" ++ f.s ++ paren args.s ++ val.s
) ;
TInt = ss "i" ;
TFloat = ss "f" ;
NilTyp = ss [] ;
ConsTyp = cc2 ;
NilExp = ss [] ;
ConsExp _ _ = cc2 ;
}
|
