Skip to content

GitLab

C
cduce
Commit abc9aee3 authored by Pietro Abate's avatar Pietro Abate
Browse files
Options

[r2003-03-09 23:48:48 by cvscast] Groose simplification records + ralentissement 

Original author: cvscast
Date: 2003-03-09 23:48:49+00:00
parent c1a95ed6
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 594 additions and 960 deletions
driver/cduce.ml
View file @ abc9aee3
......@@ -119,53 +119,7 @@ let debug ppf = function
let t = Typer.typ !glb_env t
and pl = List.map (Typer.pat !glb_env) pl in
Patterns.Compile.debug_compile ppf t pl
| `Normal_record t ->
Format.fprintf ppf "[DEBUG:normal_record]@\n";
let t = Types.Record.get (Types.descr (Typer.typ !glb_env t)) in
match Types.Record.first_label t with
| `Fail -> Format.fprintf ppf "Empty@\n"
| `Success -> Format.fprintf ppf "{ }@\n"
| `NoField -> Format.fprintf ppf "{| |}@\n"
| `SomeField -> Format.fprintf ppf "{ } \ {| |}@\n"
| `Label l ->
let (pr,ab) = Types.Record.normal' t l in
Format.fprintf ppf "Label (%s,@[" (Types.LabelPool.value l);
List.iter (fun (d,n) ->
Format.fprintf ppf "%a => @[%a@];@\n"
Types.Print.print_descr d
Types.Print.print_descr (Types.Record.descr n)
) pr;
Format.fprintf ppf "@] Absent: @[%a@])@\n"
Types.Print.print_descr
(Types.Record.descr ab)
(*
| `Normal_record t ->
Format.fprintf ppf "[DEBUG:normal_record]@\n";
let t = Types.descr (Typer.typ !glb_env t) in
let r = Types.Record.normal t in
let count = ref 0 and seen = ref [] in
let rec aux ppf x =
try
let no = List.assq x !seen in
Format.fprintf ppf "[[%i]]" no
with Not_found ->
incr count;
seen := (x, !count) :: !seen;
Format.fprintf ppf "[[%i]]:" !count;
match x with
| `Success -> Format.fprintf ppf "Success"
| `Fail -> Format.fprintf ppf "Fail"
| `Label (l,pr,ab) ->
Format.fprintf ppf "Label (%s,@[" (Types.label_name l);
List.iter (fun (d,n) ->
Format.fprintf ppf "%a => @[%a@];@\n"
Types.Print.print_descr d
aux n
) pr;
Format.fprintf ppf "@] Absent: @[%a@])" aux ab
in
Format.fprintf ppf "%a@\n" aux r
*)
| `Normal_record p -> assert false
......
parser/ast.ml
View file @ abc9aee3
......@@ -67,7 +67,8 @@ and ppat' =
| Prod of ppat * ppat
| XmlT of ppat * ppat
| Arrow of ppat * ppat
| Record of bool * (Types.label * bool * ppat) list
| Optional of ppat
| Record of bool * (Types.label * ppat) list
| Capture of id
| Constant of id * Types.const
| Regexp of regexp * ppat
......
parser/parser.ml
View file @ abc9aee3
......@@ -108,6 +108,10 @@ EXTEND
[ e1 = expr; op = ["+" | "-" | "@"]; e2 = expr -> mk loc (Op (op,[e1;e2]))
]
|
[ e1 = expr; "++"; "{"; l = [LIDENT | UIDENT]; "="; e = expr; "}" ->
assert false
]
|
[ e1 = expr; op = ["*"]; e2 = expr -> mk loc (Op (op,[e1;e2]))
| e = expr; op = "/"; p = pat ->
......@@ -322,10 +326,12 @@ EXTEND
record_spec:
[ [ r = LIST0 [ l = [LIDENT | UIDENT]; "=";
o = [ "?" -> true | -> false];
x = pat -> (Types.LabelPool.mk l,o,x)
x = pat ->
let x = if o then mk loc (Optional x) else x in
(Types.LabelPool.mk l, x)
] SEP ";" ->
(* TODO: check here uniqueness *)
List.sort (fun (l1,_,_) (l2,_,_) -> compare l1 l2) r
List.sort (fun (l1,_) (l2,_) -> compare l1 l2) r
] ];
char:
......
parser/wlexer.ml
View file @ abc9aee3
......@@ -103,65 +103,67 @@ let lex_tables = {
"\000\000\009\000\012\000\018\000\252\255\251\255\004\000\255\255\
\005\000\254\255\014\000\013\000\003\000\005\000\253\255\255\255\
\247\255\246\255\020\000\047\000\051\000\018\000\043\000\250\255\
\027\000\017\000\005\000\050\000\011\000\044\000\040\000\249\255\
\250\255\248\255\064\000\067\000\071\000\080\000\057\000\084\000\
\100\000\104\000\114\000\118\000\124\000\062\000";
\027\000\017\000\044\000\052\000\005\000\011\000\045\000\041\000\
\249\255\250\255\248\255\062\000\069\000\080\000\084\000\063\000\
\089\000\099\000\104\000\119\000\123\000\133\000\067\000";
Lexing.lex_backtrk =
"\255\255\255\255\255\255\255\255\255\255\255\255\004\000\255\255\
\002\000\255\255\004\000\002\000\004\000\004\000\255\255\255\255\
\255\255\255\255\000\000\001\000\002\000\003\000\005\000\255\255\
\005\000\005\000\005\000\005\000\005\000\005\000\005\000\255\255\
\255\255\255\255\255\255\004\000\255\255\004\000\003\000\002\000\
\255\255\002\000\001\000\255\255\001\000\000\000";
\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\
\255\255\255\255\255\255\255\255\004\000\255\255\004\000\003\000\
\002\000\255\255\002\000\001\000\255\255\001\000\000\000";
Lexing.lex_default =
"\023\000\005\000\005\000\005\000\000\000\000\000\255\255\000\000\
\255\255\000\000\255\255\255\255\255\255\255\255\000\000\000\000\
\000\000\000\000\255\255\255\255\255\255\255\255\255\255\000\000\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\
\000\000\000\000\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255";
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\000\000\000\000\000\000\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255";
Lexing.lex_trans =
"\016\000\017\000\017\000\018\000\019\000\020\000\021\000\019\000\
\022\000\004\000\008\000\008\000\004\000\024\000\025\000\026\000\
\027\000\026\000\004\000\011\000\011\000\028\000\015\000\045\000\
\038\000\029\000\012\000\030\000\026\000\009\000\031\000\032\000\
\031\000\032\000\013\000\009\000\009\000\032\000\032\000\014\000\
\032\000\014\000\007\000\010\000\009\000\009\000\034\000\035\000\
\035\000\006\000\007\000\042\000\042\000\042\000\042\000\039\000\
\039\000\039\000\039\000\032\000\043\000\033\000\032\000\038\000\
\040\000\045\000\032\000\034\000\035\000\035\000\000\000\035\000\
\035\000\035\000\035\000\037\000\037\000\037\000\037\000\042\000\
\036\000\000\000\000\000\039\000\037\000\037\000\037\000\037\000\
\039\000\039\000\039\000\039\000\000\000\036\000\000\000\000\000\
\000\000\040\000\000\000\035\000\000\000\000\000\000\000\037\000\
\041\000\041\000\041\000\041\000\041\000\041\000\041\000\041\000\
\037\000\000\000\000\000\000\000\039\000\040\000\042\000\042\000\
\042\000\042\000\044\000\044\000\044\000\044\000\000\000\043\000\
\044\000\044\000\044\000\044\000\041\000\000\000\000\000\000\000\
\041\000\043\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\042\000\000\000\000\000\000\000\044\000\000\000\
\000\000\000\000\000\000\000\000\044\000\000\000";
\027\000\028\000\004\000\011\000\011\000\029\000\015\000\046\000\
\039\000\030\000\012\000\031\000\028\000\009\000\032\000\033\000\
\032\000\033\000\013\000\009\000\009\000\033\000\033\000\014\000\
\033\000\014\000\007\000\010\000\009\000\009\000\035\000\036\000\
\036\000\006\000\007\000\043\000\043\000\043\000\043\000\040\000\
\040\000\040\000\040\000\033\000\044\000\033\000\034\000\033\000\
\041\000\035\000\036\000\036\000\033\000\039\000\046\000\000\000\
\033\000\036\000\036\000\036\000\036\000\000\000\000\000\043\000\
\000\000\000\000\037\000\040\000\038\000\038\000\038\000\038\000\
\038\000\038\000\038\000\038\000\000\000\040\000\040\000\040\000\
\040\000\037\000\000\000\000\000\000\000\036\000\041\000\042\000\
\042\000\042\000\042\000\000\000\042\000\042\000\042\000\042\000\
\038\000\000\000\000\000\000\000\038\000\041\000\000\000\000\000\
\000\000\040\000\000\000\043\000\043\000\043\000\043\000\045\000\
\045\000\045\000\045\000\042\000\044\000\000\000\000\000\000\000\
\042\000\045\000\045\000\045\000\045\000\000\000\000\000\000\000\
\000\000\000\000\044\000\000\000\000\000\000\000\000\000\043\000\
\000\000\000\000\000\000\045\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\045\000\000\000";
Lexing.lex_check =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\001\000\006\000\008\000\002\000\000\000\000\000\000\000\
\000\000\000\000\003\000\011\000\010\000\000\000\013\000\018\000\
\021\000\000\000\001\000\000\000\000\000\012\000\000\000\025\000\
\000\000\026\000\001\000\006\000\006\000\024\000\028\000\001\000\
\000\000\028\000\001\000\006\000\006\000\024\000\029\000\001\000\
\024\000\001\000\002\000\002\000\010\000\010\000\022\000\022\000\
\022\000\003\000\003\000\019\000\019\000\019\000\019\000\020\000\
\020\000\020\000\020\000\027\000\019\000\029\000\030\000\038\000\
\020\000\045\000\027\000\034\000\034\000\034\000\255\255\035\000\
\035\000\035\000\035\000\036\000\036\000\036\000\036\000\019\000\
\035\000\255\255\255\255\020\000\037\000\037\000\037\000\037\000\
\039\000\039\000\039\000\039\000\255\255\037\000\255\255\255\255\
\255\255\039\000\255\255\035\000\255\255\255\255\255\255\036\000\
\040\000\040\000\040\000\040\000\041\000\041\000\041\000\041\000\
\037\000\255\255\255\255\255\255\039\000\041\000\042\000\042\000\
\042\000\042\000\043\000\043\000\043\000\043\000\255\255\042\000\
\044\000\044\000\044\000\044\000\040\000\255\255\255\255\255\255\
\041\000\044\000\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\042\000\255\255\255\255\255\255\043\000\255\255\
\255\255\255\255\255\255\255\255\044\000\255\255"
\020\000\020\000\020\000\026\000\019\000\027\000\030\000\031\000\
\020\000\035\000\035\000\035\000\027\000\039\000\046\000\255\255\
\026\000\036\000\036\000\036\000\036\000\255\255\255\255\019\000\
\255\255\255\255\036\000\020\000\037\000\037\000\037\000\037\000\
\038\000\038\000\038\000\038\000\255\255\040\000\040\000\040\000\
\040\000\038\000\255\255\255\255\255\255\036\000\040\000\041\000\
\041\000\041\000\041\000\255\255\042\000\042\000\042\000\042\000\
\037\000\255\255\255\255\255\255\038\000\042\000\255\255\255\255\
\255\255\040\000\255\255\043\000\043\000\043\000\043\000\044\000\
\044\000\044\000\044\000\041\000\043\000\255\255\255\255\255\255\
\042\000\045\000\045\000\045\000\045\000\255\255\255\255\255\255\
\255\255\255\255\045\000\255\255\255\255\255\255\255\255\043\000\
\255\255\255\255\255\255\044\000\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\045\000\255\255"
}
let rec token engine lexbuf =
......
parser/wlexer.mll
View file @ abc9aee3
......@@ -60,7 +60,7 @@ rule token = parse
"TAG", tag_of_tag s 1
}
| [ "<>=.,:;+-*/@&{}[]()|?`!" ]
| "->" | "::" | ";;" | "--" | ":=" | "\\"
| "->" | "::" | ";;" | "--" | ":=" | "\\" | "++"
| "{|" | "|}"
| ["?+*"] "?"
{ "",Lexing.lexeme lexbuf }
......
runtime/run_dispatch.ml
View file @ abc9aee3
(* Running dispatchers *)
(* TODO: remove `Absent and clean .... *)
open Value
open Patterns.Compile
......@@ -15,19 +13,6 @@ let make_result_prod v1 r1 v2 r2 v (code,r) =
| Recompose (i,j) ->
Pair ((if (i < 0) then v1 else r1.(i)),
(if (j < 0) then v2 else r2.(j)))
| _ -> assert false
) r in
(code,ret)
let make_result_record fields v bindings (code,r) =
let ret = Array.map
(function
| Catch -> v
| Const c -> const c
| Field (l,i) ->
if (i < 0) then List.assoc l fields
else (List.assoc l bindings).(i)
| _ -> assert false
) r in
(code,ret)
......@@ -43,6 +28,10 @@ let make_result_basic v (code,r) =
let dummy_r = [||]
let rec run_dispatcher d v =
(*
Format.fprintf Format.std_formatter "Matching (%a) with:@\n" Value.print v;
Patterns.Compile.print_dispatcher Format.std_formatter d;
*)
match actions d with
| AIgnore r -> make_result_basic v r
| AKind k -> run_disp_kind k v
......@@ -51,7 +40,7 @@ and run_disp_kind actions v =
match v with
| Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
| Xml (v1,v2) -> run_disp_prod v v1 v2 actions.xml
| Record r -> run_disp_record r v [] r false actions.record
| Record r -> run_disp_record false v r actions.record
| Atom a ->
run_disp_basic v (fun t -> Types.Atom.has_atom t a) actions.basic
| Char c ->
......@@ -61,19 +50,20 @@ and run_disp_kind actions v =
| Abstraction (iface,_) ->
run_disp_basic v (fun t -> Types.Arrow.check_iface iface t)
actions.basic
| Absent ->
run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
| v ->
run_disp_kind actions (normalize v)
and run_disp_basic v f x =
match x with
| [(_,r)] -> make_result_basic v r
and run_disp_basic v f = function
(* | [(_,r)] -> make_result_basic v r *)
| (t,r)::rem -> if f t then make_result_basic v r else run_disp_basic v f rem
| _ -> assert false
| _ ->
assert false
and run_disp_prod v v1 v2 x =
match x with
and run_disp_prod v v1 v2 = function
| Impossible -> assert false
| TailCall d1 -> run_dispatcher d1 v1
| Ignore d2 -> run_disp_prod2 v1 dummy_r v v2 d2
......@@ -81,8 +71,7 @@ and run_disp_prod v v1 v2 x =
let (code1,r1) = run_dispatcher d1 v1 in
run_disp_prod2 v1 r1 v v2 b1.(code1)
and run_disp_prod2 v1 r1 v v2 x =
match x with
and run_disp_prod2 v1 r1 v v2 = function
| Impossible -> assert false
| Ignore r -> make_result_prod v1 r1 v2 dummy_r v r
| TailCall d2 -> run_dispatcher d2 v2
......@@ -90,29 +79,41 @@ and run_disp_prod2 v1 r1 v v2 x =
let (code2,r2) = run_dispatcher d2 v2 in
make_result_prod v1 r1 v2 r2 v b2.(code2)
and run_disp_record f v bindings fields other = function
and run_disp_record other v fields = function
| None -> assert false
| Some record -> run_disp_record' f v bindings fields other record
and run_disp_record' f v bindings fields other = function
| `Result r ->
make_result_record f v bindings r
| `Result_other (_,r1,r2) ->
let other = other || fields <> [] in
make_result_record f v bindings (if other then r1 else r2)
| `Label (l, present, absent) ->
| Some (`Label (l,d)) ->
let rec aux other = function
| (l1,_) :: rem when l1 < l -> aux true rem
| (l1,vl) :: rem when l1 = l ->
run_disp_field f v bindings rem other l vl present
| _ -> run_disp_record f v bindings fields other absent
| (l1,vl) :: rem when l1 = l ->
run_disp_record1 other vl rem d
| rem ->
run_disp_record1 other Absent rem d
in
aux other fields
| Some (`Nolabel (some,none)) ->
let r = if other then some else none in
match r with
| Some r -> make_result_basic v r
| None -> assert false
and run_disp_record1 other v1 rem = function
| Impossible -> assert false
| TailCall d1 -> run_dispatcher d1 v1
| Ignore d2 -> run_disp_record2 other v1 dummy_r rem d2
| Dispatch (d1,b1) ->
let (code1,r1) = run_dispatcher d1 v1 in
run_disp_record2 other v1 r1 rem b1.(code1)
and run_disp_field f v bindings fields other l vl = function
and run_disp_record2 other v1 r1 rem = function
| Impossible -> assert false
| Ignore r -> run_disp_record' f v bindings fields other r
| TailCall d -> run_dispatcher d vl
| Dispatch (dl,bl) ->
let (codel,rl) = run_dispatcher dl vl in
run_disp_record' f v ((l,rl)::bindings) fields other bl.(codel)
| Ignore r -> make_result_prod v1 r1 Absent dummy_r Absent r
| TailCall d2 -> run_disp_record_loop other rem d2
| Dispatch (d2,b2) ->
let (code2,r2) = run_disp_record_loop other rem d2 in
make_result_prod v1 r1 Absent r2 Absent b2.(code2)
and run_disp_record_loop other rem d =
match actions d with
| AIgnore r -> make_result_basic Absent r
| AKind k -> run_disp_record other (Pair(Absent,Absent)) rem k.record
runtime/value.ml
View file @ abc9aee3
......@@ -7,6 +7,7 @@ type t =
| Char of Chars.v
| Abstraction of (Types.descr * Types.descr) list * (t -> t)
| String of int * int * string * t
| Absent
exception CDuceExn of t
......@@ -60,6 +61,8 @@ let rec print ppf v =
| Abstraction _ -> Format.fprintf ppf "<fun>"
| String (i,j,s,q) ->
Format.fprintf ppf "<string:%i-%i,%S,%a>" i j s print q
| Absent ->
Format.fprintf ppf "<[absent]>"
and print_quoted_str ppf = function
| Pair (Char c, q) ->
Chars.print_v_in_string ppf c;
......
runtime/value.mli
View file @ abc9aee3
......@@ -11,6 +11,9 @@ type t =
(* Derived forms *)
| String of int * int * string * t
(* Special value for absent record fields *)
| Absent
exception CDuceExn of t
......
tests/overloading.cd
View file @ abc9aee3
......@@ -74,4 +74,4 @@ transform [ base base ] with
<person>[ n <children>[Person]; _] -> [n]
| _ -> [];;
debug compile Any Any;;
types/normal.ml
View file @ abc9aee3
......@@ -3,10 +3,11 @@ sig
type t
val any: t
val empty: t
val cup: t -> t -> t
val cap: t -> t -> t
val diff: t -> t -> t
val empty: t -> bool
val is_empty: t -> bool
end
module Make(X1 : S)(X2 : S) =
......@@ -27,14 +28,15 @@ struct
match l with
{ t1 = s1; t2 = s2; next = next } ->
let i = X1.cap t1 s1 in
if X1.empty i then add root t1 t2 l.next
if X1.is_empty i then add root t1 t2 l.next
else (
l.t1 <- i; l.t2 <- X2.cup t2 s2;
let k = X1.diff s1 t1 in
if not (X1.empty k) then root := { t1 = k; t2 = s2; next = !root };
if not (X1.is_empty k) then
root := { t1 = k; t2 = s2; next = !root };
let j = X1.diff t1 s1 in
if not (X1.empty j) then add root j t2 next
if not (X1.is_empty j) then add root j t2 next
)
let rec get accu l =
......@@ -52,23 +54,38 @@ struct
let bigcap = bigcap_aux X1.any X2.any
let boolean x =
let line res (p,n) =
let (d1,d2) = bigcap p in
if not ((X1.is_empty d1) || (X2.is_empty d2)) then
(let resid = ref d1 in
List.iter
(fun (t1,t2) ->
let t1 = X1.cap d1 t1 in
if not (X1.is_empty t1) then
(resid := X1.diff !resid t1;
let t2 = X2.diff d2 t2 in
if not (X2.is_empty t2) then add res t1 t2 !res
)
) (normal n);
if not (X1.is_empty !resid) then add res !resid d2 !res)
let boolean_normal x =
let res = ref (Obj.magic 0) in
let line (p,n) =
let (d1,d2) = bigcap p in
if not ((X1.empty d1) || (X2.empty d2)) then
(let resid = ref d1 in
List.iter
(fun (t1,t2) ->
let t1 = X1.cap d1 t1 in
if not (X1.empty t1) then
(resid := X1.diff !resid t1;
let t2 = X2.diff d2 t2 in
if not (X2.empty t2) then add res t1 t2 !res
)
) (normal n);
if not (X1.empty !resid) then add res !resid d2 !res)
in
List.iter line x;
List.iter (line res) x;
get [] !res
let boolean =
List.fold_left (fun accu x ->
let res = ref (Obj.magic 0) in
line res x;
get accu !res) []
let pi1 =
List.fold_left (fun accu (t1,t2) -> X1.cup accu t1) X1.empty
let pi2_restricted restr =
List.fold_left (fun accu (t1,t2) ->
if X1.is_empty (X1.cap t1 restr) then accu
else X2.cup accu t2) X2.empty
end
types/normal.mli
View file @ abc9aee3
......@@ -3,10 +3,11 @@ sig
type t
val any: t
val empty: t
val cup: t -> t -> t
val cap: t -> t -> t
val diff: t -> t -> t
val empty: t -> bool
val is_empty: t -> bool
end
module Make(X1 : S)(X2 : S) :
......@@ -14,5 +15,16 @@ sig
type t = (X1.t * X2.t) list
val normal: t -> t
(* normalized form:
(t1,t2),...,(s1,s2) ==> t1 & s1 = 0
(t1,t2) => t1 <> 0, t2 <> 0
*)
val boolean_normal: (X1.t * X2.t) Boolean.t -> t
(* return a normalized form *)
val boolean: (X1.t * X2.t) Boolean.t -> t
val pi1: t -> X1.t
val pi2_restricted: X1.t -> t -> X2.t
end
types/patterns.ml
View file @ abc9aee3
This diff is collapsed.
types/patterns.mli
View file @ abc9aee3
......@@ -55,11 +55,9 @@ module Compile: sig
xml: result dispatch dispatch;
record: record option;
}
and record =
[ `Label of Types.label * record dispatch * record option
| `Result of result
| `Result_other of Types.label list * result * result ]
and record =
[ `Label of Types.label * result dispatch dispatch
| `Nolabel of result option * result option ]
and 'a dispatch =
| Dispatch of dispatcher * 'a array
| TailCall of dispatcher
......@@ -70,7 +68,6 @@ module Compile: sig
and source =
| Catch | Const of Types.const
| Left of int | Right of int | Recompose of int * int
| Field of Types.label * int
val actions: dispatcher -> actions
......@@ -78,5 +75,7 @@ module Compile: sig
Types.descr -> (node * 'a) list ->
dispatcher * (int id_map * 'a) array
val print_dispatcher: Format.formatter -> dispatcher -> unit
val debug_compile : Format.formatter -> Types.node -> node list -> unit
end
types/sortedMap.ml
View file @ abc9aee3
......@@ -50,6 +50,15 @@ let add f x y m =
let change x f =
add (fun _ -> f) x
let rec set x y = function
| [] -> [x,y]
| (((x1,y1) as a)::l1) as l ->
let c = compare x1 x in
if c < 0 then a::(set x y l1)
else if c > 0 then (x,y)::l
else (x,y)::l1
let rec change_exists x1 f = function
| [] -> raise Not_found
| (x,y)::q when x = x1 -> (x,f y)::q
......
types/sortedMap.mli
View file @ abc9aee3
......@@ -10,6 +10,7 @@ val map: ('b -> 'c) -> ('a,'b) t -> ('a,'c) t
val add: ('b -> 'b -> 'b) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
val change: 'a -> ('b -> 'b) -> 'b -> ('a,'b) t -> ('a,'b) t
val set: 'a -> 'b -> ('a,'b) t -> ('a,'b) t
val change_exists: 'a -> ('b -> 'b) -> ('a,'b) t -> ('a,'b) t
......
types/types.ml
View file @ abc9aee3
This diff is collapsed.
types/types.mli
View file @ abc9aee3
module LabelPool : Pool.T with type value = string
module LabelPool : Pool.T with type value = string and type t = int
type label = LabelPool.t
type const = | Integer of Intervals.v
| Atom of Atoms.v
......@@ -47,8 +47,8 @@ val atom : Atoms.t -> descr
val times : node -> node -> descr
val xml : node -> node -> descr
val arrow : node -> node -> descr
val record : label -> bool -> node -> descr
val record' : bool * (label, (bool * node)) SortedMap.t -> descr
val record : label -> node -> descr
val record' : bool * (label, node) SortedMap.t -> descr
val char : Chars.t -> descr
val constant : const -> descr
......@@ -80,6 +80,7 @@ module Product : sig
val get: ?kind:pair_kind -> descr -> t
val pi1: t -> descr
val pi2: t -> descr
val pi2_restricted: descr -> t -> descr
(* Intersection with (pi1,Any) *)
val restrict_1: t -> descr -> t
......@@ -94,10 +95,26 @@ module Product : sig
end
module Record : sig
type t
val get : descr -> t
val descr: t -> descr
val is_empty: t -> bool
val any : descr
val or_absent: descr -> descr
val any_or_absent: descr
val has_absent: descr -> bool
val has_record: descr -> bool
val split : descr -> label -> Product.t
val split_normal : descr -> label -> Product.normal
val project : descr -> label -> descr
(* Raise Not_found if label is not necessarily present *)
val first_label: descr -> label
val empty_cases: descr -> bool * bool
(*
val restrict_field : t -> label -> descr -> t
val restrict_label_absent: t -> label -> t
val restrict_label_present: t -> label -> t
......@@ -132,10 +149,13 @@ module Record : sig
val normal': t -> label -> (descr * t) list * t
val first_label: t -> [ `Success|`Fail|`NoField|`SomeField|`Label of label ]
val change_field: t -> label -> node -> t
(*
val project : descr -> label -> descr
(* Raise Not_found if label is not necessarily present *)
*)
*)
end
module Arrow : sig
......
typing/typer.ml
View file @ abc9aee3
......@@ -42,7 +42,8 @@ and descr =
| ITimes of ti * ti
| IXml of ti * ti