@@ -62,23 +62,6 @@ let translate loc (prim_name : string)
6262 let call m =
6363 E. runtime_call m prim_name args in
6464 begin match prim_name with
65- (* | "caml_gc_stat"
66- | "caml_gc_quick_stat"
67- | "caml_gc_get" * )
68- | " caml_gc_counters"
69- | " caml_gc_set"
70- | " caml_gc_minor"
71- | " caml_gc_major_slice"
72- | " caml_gc_major"
73- | " caml_gc_full_major"
74- | " caml_gc_compaction"
75- | " caml_final_register"
76- | " caml_final_release"
77- -> call Js_runtime_modules. gc
78- (* | "caml_abs_float" ->
79- E.math "abs" args *)
80- (* | "caml_acos_float" ->
81- E.math "acos" args *)
8265 | "caml_add_float" ->
8366 begin match args with
8467 | [e0;e1] -> E. float_add e0 e1 (* * TODO float plus*)
@@ -109,110 +92,11 @@ let translate loc (prim_name : string)
10992 | [e0;e1] -> E. float_comp Cgt e0 e1
11093 | _ -> assert false
11194 end
112- (* | "caml_tan_float" ->
113- E.math "tan" args
114- | "caml_tanh_float" ->
115- E.math "tanh" args
116- | "caml_asin_float" ->
117- E.math "asin" args
118- | "caml_atan2_float" ->
119- E.math "atan2" args
120- | "caml_atan_float" ->
121- E.math "atan" args
122- | "caml_ceil_float" ->
123- E.math "ceil" args
124- | "caml_cos_float" ->
125- E.math "cos" args
126- | "caml_cosh_float" ->
127- E.math "cosh" args
128- | "caml_exp_float" ->
129- E.math "exp" args
130- | "caml_sin_float" ->
131- E.math "sin" args
132- | "caml_sinh_float"->
133- E.math "sinh" args
134- | "caml_sqrt_float" ->
135- E.math "sqrt" args
136-
137- *)
13895 | "caml_float_of_int" ->
13996 begin match args with
14097 | [e] -> e
14198 | _ -> assert false
14299 end
143- (* | "caml_floor_float" ->
144- E.math "floor" args
145- | "caml_log_float" ->
146- E.math "log" args
147- | "caml_log10_float" ->
148- E.math "log10" args
149- | "caml_log1p_float" ->
150- E.math "log1p" args
151- | "caml_power_float" ->
152- E.math "pow" args *)
153-
154- | "caml_array_get" ->
155- call Js_runtime_modules. array
156- | " caml_array_get_addr"
157- | " caml_array_get_float"
158- | " caml_array_unsafe_get"
159- | "caml_array_unsafe_get_float" ->
160- begin match args with
161- | [e0;e1] -> Js_of_lam_array. ref_array e0 e1
162- | _ -> assert false
163- end
164- | "caml_array_set" ->
165- call Js_runtime_modules. array
166- | " caml_array_set_addr"
167- | " caml_array_set_float"
168- | " caml_array_unsafe_set"
169- | " caml_array_unsafe_set_addr"
170- | "caml_array_unsafe_set_float" ->
171- begin match args with
172- | [e0;e1;e2] ->
173- Js_of_lam_array. set_array e0 e1 e2
174- | _ -> assert false
175- end
176-
177- | " caml_int32_add"
178- ->
179- begin match args with
180- | [e0;e1] -> E. int32_add e0 e1
181- | _ -> assert false
182- end
183-
184- | " caml_nativeint_add"
185- ->
186- begin match args with
187- | [e0;e1] -> E. unchecked_int32_add e0 e1
188- | _ -> assert false
189- end
190- | " caml_int32_div"
191- ->
192- begin match args with
193- | [e0;e1] ->
194- E. int32_div ~checked: (! Js_config. check_div_by_zero) e0 e1
195- | _ -> assert false
196- end
197-
198- | " caml_nativeint_div"
199- -> (* nativeint behaves exactly the same as js numbers except division *)
200- begin match args with
201- | [e0;e1] -> E. int32_div ~checked: false e0 e1
202- | _ -> assert false
203- end
204-
205- | " caml_int32_mul"
206- ->
207- begin match args with
208- | [e0;e1] -> E. int32_mul e0 e1
209- | _ -> assert false
210- end
211- | "caml_nativeint_mul" ->
212- begin match args with
213- | [e0;e1] -> E. unchecked_int32_mul e0 e1
214- | _ -> assert false
215- end
216100 | " caml_int32_of_int"
217101 | " caml_nativeint_of_int"
218102 | "caml_nativeint_of_int32" ->
@@ -236,63 +120,10 @@ let translate loc (prim_name : string)
236120 | [e] -> e (* TODO: do more checking when [to_int32]*)
237121 | _ -> assert false
238122 end
239- | "caml_int32_sub" ->
240- begin match args with
241- | [e0;e1] -> E. int32_minus e0 e1
242- | _ -> assert false
243- end
244-
245- | "caml_nativeint_sub" ->
246- begin match args with
247- | [e0;e1] -> E. unchecked_int32_minus e0 e1
248- | _ -> assert false
249- end
250- | " caml_int32_xor"
251- | "caml_nativeint_xor" ->
252- begin match args with
253- | [e0; e1] -> E. int32_bxor e0 e1
254- | _ -> assert false
255- end
256-
257- | " caml_int32_and"
258- | "caml_nativeint_and" ->
259- begin match args with
260- | [e0;e1] -> E. int32_band e0 e1
261- | _ -> assert false
262- end
263- | " caml_int32_or"
264- | "caml_nativeint_or" ->
265- begin match args with
266- | [e0;e1] -> E. int32_bor e0 e1
267- | _ -> assert false
268- end
269- | "caml_le_float" ->
270- begin match args with
271- | [e0;e1] -> E. float_comp Cle e0 e1
272- | _ -> assert false
273- end
274- | "caml_lt_float" ->
275- begin match args with
276- | [e0;e1] -> E. float_comp Clt e0 e1
277- | _ -> assert false
278- end
279- | "caml_neg_float" ->
280- begin match args with
281- | [e] ->
282- (* * TODO: use float.. *)
283- E. int32_minus E. zero_int_literal e
284- | _ -> assert false
285- end
286- | "caml_neq_float" ->
287- begin match args with
288- | [e0;e1] -> E. float_notequal e0 e1
289- | _ -> assert false
290- end
291- | "caml_mul_float" ->
292- begin match args with
293- | [e0; e1] -> E. float_mul e0 e1
294- | _ -> assert false
295- end
123+ | " caml_bytes_greaterthan"
124+ | " caml_bytes_greaterequal"
125+ | " caml_bytes_lessthan"
126+ | " caml_bytes_lessequal"
296127 | " caml_bytes_compare"
297128 | " caml_bytes_equal"
298129 ->
@@ -517,7 +348,7 @@ let translate loc (prim_name : string)
517348 begin match args with
518349 | [{expression_desc = Bool a} ; {expression_desc = Bool b} ]
519350 ->
520- let c = compare a b in
351+ let c = compare (a : bool ) b in
521352 E. int (if c = 0 then 0l else if c > 0 then 1l else - 1l )
522353 | _ ->
523354 call Js_runtime_modules. caml_primitive
0 commit comments