Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

PR#7031 Fix ambiguous orpats + guards in the compiler.

master
Luc Maranget 2015-12-04 16:58:33 +01:00
parent 6a89000b5c
commit 74356166ac
2 changed files with 18 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
asmcomp/cmmgen.ml
View File

@ -88,14 +88,20 @@ let int_const n =
else Cconst_natint
(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n)
let add_no_overflow n x c =
let d = n + x in
if d = 0 then c else Cop(Caddi, [c; Cconst_int d])
let rec add_const c n =
if n = 0 then c
else match c with
| Cconst_int x when no_overflow_add x n -> Cconst_int (x + n)
| Cop(Caddi, ([Cconst_int x; c] | [c; Cconst_int x]))
| Cop(Caddi, [Cconst_int x; c])
when no_overflow_add n x ->
let d = n + x in
if d = 0 then c else Cop(Caddi, [c; Cconst_int d])
add_no_overflow n x c
| Cop(Caddi, [c; Cconst_int x])
when no_overflow_add n x ->
add_no_overflow n x c
| Cop(Csubi, [Cconst_int x; c]) when no_overflow_add n x ->
Cop(Csubi, [Cconst_int (n + x); c])
| Cop(Csubi, [c; Cconst_int x]) when no_overflow_sub n x ->
@ -138,6 +144,10 @@ let rec lsl_int c1 c2 =
| (_, _) ->
Cop(Clsl, [c1; c2])
let is_power2 n = n = 1 lsl Misc.log2 n
and mult_power2 c n = lsl_int c (Cconst_int (Misc.log2 n))
let rec mul_int c1 c2 =
match (c1, c2) with
| (c, Cconst_int 0) | (Cconst_int 0, c) ->
@ -146,8 +156,8 @@ let rec mul_int c1 c2 =
c
| (c, Cconst_int(-1)) | (Cconst_int(-1), c) ->
sub_int (Cconst_int 0) c
| (c, Cconst_int n) | (Cconst_int n, c) when n = 1 lsl Misc.log2 n->
lsl_int c (Cconst_int (Misc.log2 n))
| (c, Cconst_int n) when is_power2 n -> mult_power2 c n
| (Cconst_int n, c) when is_power2 n -> mult_power2 c n
| (Cop(Caddi, [c; Cconst_int n]), Cconst_int k) |
(Cconst_int k, Cop(Caddi, [c; Cconst_int n]))
when no_overflow_mul n k ->

4
typing/printtyp.ml
View File

@ -1397,7 +1397,9 @@ let explanation unif t3 t4 ppf =
fprintf ppf "@,@[<hov>This instance of %a is ambiguous:@ %s@]"
type_expr t'
"it would escape the scope of its equation"
| Tfield (lab, _, _, _), _
| Tfield (lab, _, _, _), _ when lab = dummy_method ->
fprintf ppf
"@,Self type cannot be unified with a closed object type"
| _, Tfield (lab, _, _, _) when lab = dummy_method ->
fprintf ppf
"@,Self type cannot be unified with a closed object type"