-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathjavagen.ml
198 lines (171 loc) · 8.55 KB
/
javagen.ml
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
open Ast
open Check
(* To Do:
length and access
D_call???
*)
let remove_semi s =
if String.contains s ';' then
let i = String.index s ';' in
String.sub s 0 i
else s
let write_type = function
Bool_Type -> "Boolean"
| Int_Type -> "int"
| String_Type -> "String"
| Pitch_Type -> "Pitch"
| Frac_Type -> "Frac"
| Rhythm_Type -> "Rhythm"
| Duration_Type -> "Duration"
| Chord_Type -> "Chord"
| Track_Type -> "Track"
| Composition_Type -> "Composition"
| PD_Type -> "Pitch_Duration_Tuple"
| _ -> raise(Failure "Type string of PD_Tuple or Null_Type being generated")
let write_types ts =
match ts with Corgi_Prim(t) -> write_type t
let write_op_primitive = function
Add -> " + "
| Sub -> " - "
| Mult -> " * "
| Div -> " / "
| Equal -> " == "
| Neq -> " != "
| Less -> " < "
| Leq -> " <= "
| Greater -> " > "
| Geq -> " >= "
| Mod -> " % "
| _ -> raise (Failure "and/or begin applied to a java primitive")
let write_op_compares e1 op e2 =
match op with
Equal -> "(" ^ e1 ^ ").equals(" ^ e2 ^ ")"
| Less -> "(" ^ e1 ^ ").compareTo(" ^ e2 ^ ")" ^ " < 0"
| Leq -> "(" ^ e1 ^ ").compareTo(" ^ e2 ^ ")" ^ " <= 0"
| Greater -> "(" ^ e1 ^ ").compareTo(" ^ e2 ^ ")" ^ " > 0"
| Geq -> "(" ^ e1 ^ ").compareTo(" ^ e2 ^ ")" ^ " >= 0"
| Neq -> "(" ^ e1 ^ ").compareTo(" ^ e2 ^ ")" ^ " != 0"
| _ -> raise (Failure "not a comparator operation")
let rec get_typeof_dexpr = function
D_Bool_Lit(boolLit, t) -> t
| D_Int_Lit(intLit, t) -> t
| D_String_Lit(strLit, t) -> t
| D_Frac_Lit(num_expr, denom_expr, t) -> t
| D_Id (str, t) -> t
| D_Array_Lit(dexpr_list, t) -> t
| D_Unop(d_expr, uop, t) -> t
| D_Binop (dexpr1, op, dexpr2, t) -> t
| D_Tuple(dexpr1, dexpr2, t) -> t
(* | D_Null_Lit -> "null" *)
| D_Noexpr -> Null_Type
| D_Call(str,dexpr_list,t) -> t
| D_Access(str,dexpr,t) -> t
let rec write_expr = function
D_Bool_Lit(boolLit, t) -> string_of_bool boolLit
| D_Int_Lit(intLit, t) -> (match t with
Int_Type -> string_of_int intLit
| Pitch_Type -> "new Pitch(" ^ string_of_int intLit ^ ")"
| Duration_Type -> "new Duration(" ^ string_of_int intLit ^ ")" ^ string_of_int intLit
| _ -> raise(Failure(write_type t ^ " is not a integer")))
| D_String_Lit(strLit, t) -> "\"" ^ strLit ^ "\""
| D_Frac_Lit(num_expr, denom_expr, t) -> (match t with
Frac_Type -> "new Frac(" ^ write_expr num_expr ^ "," ^ write_expr denom_expr ^ ")"
| Duration_Type -> "new Duration(new Frac(" ^ write_expr num_expr ^ "," ^ write_expr denom_expr ^ "))"
| _ -> raise(Failure(write_type t ^ " is not a fraction")))
| D_Id (str, yt) -> str
| D_Array_Lit(dexpr_list, t) -> write_array_expr dexpr_list t
| D_Unop(d_expr, uop, t) -> write_unop_expr d_expr uop t
| D_Binop (dexpr1, op, dexpr2, t) -> write_binop_expr dexpr1 op dexpr2 t
| D_Tuple(dexpr1, dexpr2, t) -> "new Pitch_Duration_Tuple(" ^ write_expr dexpr1 ^ "," ^ write_expr dexpr2 ^")"
(* | D_Null_Lit -> "null" *)
| D_Noexpr -> ""
| D_Call(str,dexpr_list,t) -> (match str with
"print" -> "System.out.println(" ^ String.concat "+" (List.map tostring_str dexpr_list) ^ ")"
| "play" -> "Utils." ^ str ^ "(" ^ String.concat "," (List.map write_expr dexpr_list) ^ ")"
| "export" -> "Utils.exportMidi(" ^ String.concat "," (List.map write_expr dexpr_list) ^ ")"
| "import" -> "Utils.importMidi(" ^ String.concat "," (List.map write_expr dexpr_list) ^ ")"
| "length" -> String.concat "," (List.map write_expr dexpr_list) ^ ".length()" (* semantic checking ensures length has 1 arg *)
| _ -> str ^ "(" ^ String.concat "," (List.map write_expr dexpr_list) ^ ")")
| D_Access(str,dexpr,t) -> (match t with
(Bool_Type | Int_Type | Frac_Type | Duration_Type | String_Type | Pitch_Type) -> str ^ "[" ^ write_expr dexpr ^ "]"
| _ -> str ^ ".get(" ^ write_expr dexpr ^ ")")
and write_binop_expr expr1 op expr2 t =
let e1 = write_expr expr1 and e2 = write_expr expr2 in
let write_binop_expr_help e1 op e2 =
match t with
Int_Type -> (match op with
(Add | Sub | Mult | Div | Equal | Neq | Less | Leq | Mod | Greater | Geq | And | Or) ->
e1 ^ write_op_primitive op ^ e2)
| String_Type -> (match op with
Add -> " + "
| (Equal | Less | Leq | Greater | Geq) -> write_op_compares e1 op e2
| _ -> raise(Failure(write_op_primitive op ^ " is not a supported operation for String_Type")))
| Bool_Type -> (match op with
And -> e1 ^ " && " ^ e2
| Or -> e1 ^ " || " ^ e2
| _ -> write_binop_expr expr1 op expr2 (get_typeof_dexpr expr1))
(* this function assumes that the return type of the binop is the return type of dexpr1 and dexpr2,
but in the case of comparaters (like i < 10 where i is an int. the return type is boolean even
though dexprs are ints! so fool this method by calling it again with the return type of int!*)
| (Pitch_Type | Frac_Type | Rhythm_Type | Duration_Type | Chord_Type | Track_Type | Composition_Type) -> (match op with
(Equal | Less | Leq | Greater | Geq | Neq) -> write_op_compares e1 op e2
| Add -> "(" ^ e1 ^ ").add(" ^ e2 ^ ")"
| Sub -> "(" ^ e1 ^ ").subtract(" ^ e2 ^ ")"
| Mult -> "(" ^ e1 ^ ").multiply(" ^ e2 ^ ")"
| Div -> "(" ^ e1 ^ ").divide(" ^ e2 ^ ")"
| _ -> raise(Failure(write_op_primitive op ^ " is not a supported operation for" ^ write_type t)))
| _ -> raise(Failure(write_op_primitive op ^ " is not a supported operation for" ^ write_type t))
in write_binop_expr_help e1 op e2
and write_unop_expr dexpr uop t =
(match uop with
Neg -> "-(" ^ write_expr dexpr ^ ")"
| Not -> "!" ^ write_expr dexpr)
and write_array_expr dexpr_list t =
match t with
PD_Type -> "new Pitch_Duration_Tuple[]" ^ " {" ^ String.concat "," (List.map write_expr dexpr_list) ^ "}"
| _ -> "new " ^ write_type t ^ " []" ^ " {" ^ String.concat "," (List.map write_expr dexpr_list) ^ "}"
and write_tostr_class dexpr =
let t = get_typeof_dexpr dexpr in
match t with
Bool_Type -> "Boolean"
| Int_Type -> "Integer"
| _ -> raise (Failure "toString method should already be in class")
and tostring_str dexpr =
let t = get_typeof_dexpr dexpr in
match t with
(Bool_Type | Int_Type) -> write_tostr_class dexpr ^ ".toString(" ^ write_expr dexpr ^ ")"
| String_Type -> write_expr dexpr
| _ -> "(" ^ write_expr dexpr ^ ").toString()"
let write_scope_var_decl_func svd =
let (n, b, t, _) = svd in
match b with
true -> (match t with
(Bool_Type | Int_Type | Frac_Type | Duration_Type | String_Type | Pitch_Type) -> write_type t ^ "[]" ^ n (* true if it is an array *)
| _ -> write_type t ^ " " ^ n)
| false -> write_type t ^ " " ^ n
let write_scope_var_decl svd =
write_scope_var_decl_func svd ^ ";\n"
let write_global_scope_var_decl gsvd =
"static " ^ write_scope_var_decl_func gsvd ^ ";\n"
let write_assign name dexpr t =
(match t with
Bool_Type | Int_Type | String_Type | Frac_Type -> name ^ " = " ^ write_expr dexpr
| Pitch_Type | Duration_Type | Rhythm_Type | Chord_Type | Track_Type | Composition_Type -> name ^ " = new " ^ write_type t ^ "(" ^ write_expr dexpr ^ ")"
| _ -> raise(Failure(write_type t ^ " is not a valid assign_type")))
let rec write_stmt = function
D_CodeBlock(dblock) -> write_block dblock
| D_Expr(dexpr) -> write_expr dexpr ^ ";"
| D_Assign (name, dexpr, t) -> write_assign name dexpr t ^ ";\n"
| D_Return(dexpr) -> "return " ^ write_expr dexpr ^ ";\n"
| D_If(dexpr, dstmt1, dstmt2) -> "if(" ^ write_expr dexpr ^ ")" ^ write_stmt dstmt1 ^ "else" ^ write_stmt dstmt2
| D_For(dstmt1, dstmt2, dstmt3, dblock) -> "for(" ^ write_stmt dstmt1 ^ write_stmt dstmt2 ^ remove_semi (write_stmt dstmt3) ^ ")" ^ write_block dblock
| D_While(dexpr, dblock) -> "while(" ^ write_expr dexpr ^ ")" ^ write_block dblock
| D_Array_Assign(str,dexpr_value, dexpr_index, t) -> str ^ ".set(" ^ write_expr dexpr_index ^ "," ^ write_expr dexpr_value ^ ");"
and write_block dblock =
"{\n" ^ String.concat "\n" (List.map write_scope_var_decl dblock.d_locals) ^ String.concat "\n" (List.map write_stmt dblock.d_statements) ^ "\n}"
let write_func dfunc =
match dfunc.d_fname with
"main" -> "public static void main(String[] args)" ^ write_block dfunc.d_fblock
| _ -> "static " ^ write_type dfunc.d_ret_type ^ " " ^ dfunc.d_fname ^ "(" ^ String.concat "," (List.map write_scope_var_decl_func dfunc.d_formals) ^ ")" ^ write_block dfunc.d_fblock
let write_pgm pgm =
"public class Intermediate {\n" ^ String.concat "\n" (List.map write_global_scope_var_decl pgm.d_gvars) ^ String.concat "\n" (List.map write_func pgm.d_pfuncs) ^ "}"