diff options
Diffstat (limited to 'bytecomp')
| -rw-r--r-- | bytecomp/matching.ml | 25 | ||||
| -rw-r--r-- | bytecomp/printlambda.ml | 12 | ||||
| -rw-r--r-- | bytecomp/symtable.ml | 5 |
3 files changed, 28 insertions, 14 deletions
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index 4d1c1d084..bd155d4a7 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -1291,13 +1291,9 @@ let sort_lambda_list l = List.sort (fun (x,_) (y,_) -> match x,y with | Const_float f1, Const_float f2 -> float_compare f1 f2 - | Const_int i1, Const_int i2 -> Pervasives.compare i1 i2 - | Const_char c1, Const_char c2 -> Pervasives.compare c1 c2 - | Const_string s1, Const_string s2 -> Pervasives.compare s1 s2 - | _ -> assert false) + | _, _ -> Pervasives.compare x y) l - let rec cut n l = if n = 0 then [],l else match l with @@ -1733,8 +1729,23 @@ let combine_constant arg cst partial ctx def make_test_sequence fail (Pfloatcomp Cneq) (Pfloatcomp Clt) - arg const_lambda_list in - lambda1,jumps_union local_jumps total + arg const_lambda_list + | Const_int32 _ -> + make_test_sequence + fail + (Pbintcomp(Pint32, Cneq)) (Pbintcomp(Pint32, Clt)) + arg const_lambda_list + | Const_int64 _ -> + make_test_sequence + fail + (Pbintcomp(Pint64, Cneq)) (Pbintcomp(Pint64, Clt)) + arg const_lambda_list + | Const_nativeint _ -> + make_test_sequence + fail + (Pbintcomp(Pnativeint, Cneq)) (Pbintcomp(Pnativeint, Clt)) + arg const_lambda_list + in lambda1,jumps_union local_jumps total diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index 909ee4639..b8af27831 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -21,12 +21,12 @@ open Lambda let rec struct_const ppf = function | Const_base(Const_int n) -> fprintf ppf "%i" n - | Const_base(Const_char c) -> - fprintf ppf "%C" c - | Const_base(Const_string s) -> - fprintf ppf "%S" s - | Const_base(Const_float s) -> - fprintf ppf "%s" s + | Const_base(Const_char c) -> fprintf ppf "%C" c + | Const_base(Const_string s) -> fprintf ppf "%S" s + | Const_base(Const_float f) -> fprintf ppf "%s" f + | Const_base(Const_int32 n) -> fprintf ppf "%lil" n + | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n + | Const_base(Const_nativeint n) -> fprintf ppf "%nin" n | Const_pointer n -> fprintf ppf "%ia" n | Const_block(tag, []) -> fprintf ppf "[%i]" tag diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 74ec833b0..9ea585954 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -201,7 +201,10 @@ let rec transl_const = function Const_base(Const_int i) -> Obj.repr i | Const_base(Const_char c) -> Obj.repr c | Const_base(Const_string s) -> Obj.repr s - | Const_base(Const_float f) -> Obj.repr(float_of_string f) + | Const_base(Const_float f) -> Obj.repr (float_of_string f) + | Const_base(Const_int32 i) -> Obj.repr i + | Const_base(Const_int64 i) -> Obj.repr i + | Const_base(Const_nativeint i) -> Obj.repr i | Const_pointer i -> Obj.repr i | Const_block(tag, fields) -> let block = Obj.new_block tag (List.length fields) in |