diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2007-06-04 08:26:02 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2007-06-04 08:26:02 +0000 |
| commit | 6f0f29f39d014c38d9cb616f074c16482fd8681a (patch) | |
| tree | 6f9a5125eaab8babe959f68d94ab8023e443185e | |
| parent | a42af9eaf579b8644c4aee5ac3b93fd93704515c (diff) | |
| download | ocaml-varunion.tar.gz | |
allow [] as a refinement of [> ] but not [< ..]varunion
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/varunion@8309 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | parsing/parser.mly | 2 | ||||
| -rw-r--r-- | typing/ctype.ml | 5 | ||||
| -rw-r--r-- | typing/oprint.ml | 8 |
3 files changed, 9 insertions, 6 deletions
diff --git a/parsing/parser.mly b/parsing/parser.mly index 429e4b6738..6c25eeeebd 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -1304,6 +1304,8 @@ simple_core_type2: { mktyp(Ptyp_class($3, [$1], $4)) } | LPAREN core_type_comma_list RPAREN SHARP class_longident opt_present { mktyp(Ptyp_class($5, List.rev $2, $6)) } + | LBRACKET RBRACKET + { mktyp(Ptyp_variant([], true, None)) } | LBRACKET tag_field RBRACKET { mktyp(Ptyp_variant([$2], true, None)) } /* PR#3835: this is not LR(1), would need lookahead=2 diff --git a/typing/ctype.ml b/typing/ctype.ml index 54c7adfaff..9455352600 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1937,8 +1937,9 @@ and unify_row env row1 row2 = abs = [] && List.for_all (fun (_,f) -> row_field_repr f = Rabsent) fields in (* Check whether we are going to build an empty type *) - if closed && apairs = [] - && (empty r1 abs1 || row2.row_closed) && (empty r2 abs2 || row1.row_closed) + let empty1 = empty r1 abs1 and empty2 = empty r2 abs2 in + if closed && apairs = [] && not (empty1 && empty2) + && (empty1 || row2.row_closed) && (empty2 || row1.row_closed) && List.for_all (fun (_,f1,f2) -> row_field_repr f1 = Rabsent || row_field_repr f2 = Rabsent) diff --git a/typing/oprint.ml b/typing/oprint.ml index 41cc40ff4b..6a76268c70 100644 --- a/typing/oprint.ml +++ b/typing/oprint.ml @@ -185,13 +185,13 @@ and print_simple_out_type ppf = fprintf ppf "@[<2>< %a >@]" (print_fields rest) fields | Otyp_stuff s -> fprintf ppf "%s" s | Otyp_var (ng, s) -> fprintf ppf "'%s%s" (if ng then "_" else "") s - | Otyp_variant (non_gen, row_fields, closed, tags) -> + | Otyp_variant (non_gen, fields, closed, tags) -> + if fields = Ovar_fields([],[]) && closed then fprintf ppf "[]" else let print_present ppf = function None | Some [] -> () | Some l -> fprintf ppf "@;<1 -2>> @[<hov>%a@]" pr_present l - in - let print_fields ppf = + and print_fields ppf = function Ovar_fields (fields, abs) -> let bar ppf = fprintf ppf "@;<1 -2>| " in @@ -204,7 +204,7 @@ and print_simple_out_type ppf = fprintf ppf "%s[%s@[<hv>@[<hv>%a@]%a ]@]" (if non_gen then "_" else "") (if closed then if tags = None then " " else "< " else if tags = None then "> " else "? ") - print_fields row_fields + print_fields fields print_present tags | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty -> fprintf ppf "@[<1>(%a)@]" print_out_type ty |