diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml index 49c824632811ae09cf5b7b9fd0fc5f89d03ea0a4..6948d0e5a1709ec1b74c9323d67dca4a8ebb8826 100644 --- a/generator/js_of_ast.ml +++ b/generator/js_of_ast.ml @@ -146,7 +146,7 @@ let ppf_ifthenelse cond iftrue iffalse = cond iftrue iffalse let ppf_sequence exp1 exp2 = - Printf.sprintf "%s,@,%s" + Printf.sprintf "%s;@,%s" exp1 exp2 let ppf_while cd body = @@ -585,8 +585,8 @@ and js_of_expression ctx dest e = | Texp_ifthenelse (e1, e2, Some e3) -> reject_inline dest; ppf_ifthenelse (inline_of_wrap e1) (js_of_expression ctx dest e2) (js_of_expression ctx dest e3) - | Texp_sequence (e1, e2) -> out_of_scope loc "sequence" - (* ppf_sequence (js_of_expression e1) (js_of_expression e2) *) + | Texp_sequence (e1, e2) -> + ppf_sequence (inline_of_wrap e1) (js_of_expression ctx dest e2) | Texp_while (cd, body) -> out_of_scope loc "while" (* ppf_while (js_of_expression cd) (js_of_expression body) *) | Texp_for (id, _, st, ed, fl, body) -> out_of_scope loc "for" @@ -634,7 +634,9 @@ and js_of_let_pattern ctx pat expr = let id = match pat.pat_desc with | Tpat_var (id, _) -> ppf_ident id - | _ -> error ~loc:pat.pat_loc "let can't deconstruct values" + | _ -> + Printf.printf "warning: unsupported let-record\n"; "" + (* error ~loc:pat.pat_loc "let can't deconstruct values" *) in (id, js_of_expression ctx (Dest_assign id) expr) @@ -677,7 +679,7 @@ and js_of_pattern pat obj = | Tpat_tuple el -> unsupported ~loc "tuple matching, if not in a simple let-binding" | Tpat_array el -> unsupported ~loc "array-match" | Tpat_record (_,_) -> unsupported ~loc "record" - | Tpat_or (_,_,_) -> error ~loc "not implemented yet" + | Tpat_or (_,_,_) -> error ~loc "or pattern not implemented yet" | Tpat_alias (_,_,_) -> out_of_scope loc "alias-pattern" | Tpat_variant (_,_,_) -> out_of_scope loc "polymorphic variants in pattern matching" | Tpat_lazy _ -> out_of_scope loc "lazy-pattern" diff --git a/generator/stdlib_ml/stdlib.mli b/generator/stdlib_ml/stdlib.mli index c4b9780e08e6ab2e7cb18cf55621adc105a36bd1..2f9f1c9bdf5507343458d772f6b0762cdefcd8d6 100644 --- a/generator/stdlib_ml/stdlib.mli +++ b/generator/stdlib_ml/stdlib.mli @@ -86,6 +86,7 @@ end (* This may be awkward! *) module Lazy : sig type 'a t + val force : 'a t -> 'a (* ARTHUR added *) end module List : sig diff --git a/generator/tests/jsref/JsCommon.ml b/generator/tests/jsref/JsCommon.ml index 09c16b8a6d4851c4023b73ec59c075d0376546fd..6bc57c3be58ceb97f77345f8cb15872c64533e8c 100644 --- a/generator/tests/jsref/JsCommon.ml +++ b/generator/tests/jsref/JsCommon.ml @@ -1,3 +1,4 @@ + open Datatypes open JsNumber open JsSyntax diff --git a/generator/tests/jsref/JsNumber.ml b/generator/tests/jsref/JsNumber.ml index 9baccf42dfdee0900b18248108596aaf51a41c23..bda40329068e86b95cd4a61700048131708ce327 100644 --- a/generator/tests/jsref/JsNumber.ml +++ b/generator/tests/jsref/JsNumber.ml @@ -125,9 +125,18 @@ let of_int = fun x -> x (** val to_int32 : number -> float **) + +(* ARTHUR hacked this in *) +let classify_float n = + let x = classify_float n in + match x with + | FP_normal -> FP_normal + | FP_subnormal -> FP_normal + | _ -> x + let to_int32 = fun n -> match classify_float n with - | FP_normal | FP_subnormal -> + | FP_normal -> let i32 = 2. ** 32. in let i31 = 2. ** 31. in let posint = (if n < 0. then (-1.) else 1.) *. (floor (abs_float n)) in @@ -142,7 +151,7 @@ let to_int32 = fun n -> let to_uint32 = fun n -> match classify_float n with - | FP_normal | FP_subnormal -> + | FP_normal -> let i32 = 2. ** 32. in let posint = (if n < 0. then (-1.) else 1.) *. (floor (abs_float n)) in let int32bit =