Commit b7fccb6a authored by Pietro Abate's avatar Pietro Abate

[r2003-03-22 15:22:10 by cvscast] Empty log message

Original author: cvscast
Date: 2003-03-22 15:22:11+00:00
parent e3dc47a9
......@@ -5,7 +5,7 @@ CLEAN_DIRS = $(DIRS) tools tests
# Objects to build
MISC = misc/state.cmo misc/pool.cmo misc/encodings.cmo
MISC = misc/state.cmo misc/pool.cmo misc/encodings.cmo misc/bool.cmo
PARSER = parser/lexer.cmo parser/location.cmo \
parser/wlexer.cmo \
......
misc/bool.cmo: misc/bool.cmi
misc/bool.cmx: misc/bool.cmi
misc/encodings.cmo: misc/encodings.cmi
misc/encodings.cmx: misc/encodings.cmi
misc/pool.cmo: misc/state.cmi misc/pool.cmi
......@@ -42,10 +44,12 @@ types/intervals.cmo: types/intervals.cmi
types/intervals.cmx: types/intervals.cmi
types/normal.cmo: types/normal.cmi
types/normal.cmx: types/normal.cmi
types/patterns.cmo: types/ident.cmo types/sortedList.cmi types/sortedMap.cmi \
misc/state.cmi types/types.cmi types/patterns.cmi
types/patterns.cmx: types/ident.cmx types/sortedList.cmx types/sortedMap.cmx \
misc/state.cmx types/types.cmx types/patterns.cmi
types/patterns.cmo: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/sortedList.cmi types/sortedMap.cmi misc/state.cmi types/types.cmi \
types/patterns.cmi
types/patterns.cmx: types/atoms.cmx types/chars.cmx types/ident.cmx \
types/sortedList.cmx types/sortedMap.cmx misc/state.cmx types/types.cmx \
types/patterns.cmi
types/recursive_noshare.cmo: types/recursive.cmo misc/state.cmi
types/recursive_noshare.cmx: types/recursive.cmx misc/state.cmx
types/recursive_share.cmo: types/recursive.cmo misc/state.cmi
......@@ -58,10 +62,10 @@ types/sortedMap.cmo: types/sortedMap.cmi
types/sortedMap.cmx: types/sortedMap.cmi
types/type_bool.cmo: types/boolean.cmi types/recursive.cmo
types/type_bool.cmx: types/boolean.cmx types/recursive.cmx
types/types.cmo: types/atoms.cmi types/boolean.cmi types/chars.cmi \
types/types.cmo: types/atoms.cmi misc/bool.cmi types/chars.cmi \
types/ident.cmo types/intervals.cmi types/normal.cmi types/recursive.cmo \
types/sortedList.cmi misc/state.cmi types/types.cmi
types/types.cmx: types/atoms.cmx types/boolean.cmx types/chars.cmx \
types/types.cmx: types/atoms.cmx misc/bool.cmx types/chars.cmx \
types/ident.cmx types/intervals.cmx types/normal.cmx types/recursive.cmx \
types/sortedList.cmx misc/state.cmx types/types.cmi
runtime/eval.cmo: types/atoms.cmi types/ident.cmo types/intervals.cmi \
......@@ -80,10 +84,12 @@ runtime/print_xml.cmo: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/sequence.cmi runtime/value.cmi
runtime/print_xml.cmx: types/atoms.cmx types/chars.cmx types/ident.cmx \
types/sequence.cmx runtime/value.cmx
runtime/run_dispatch.cmo: types/chars.cmi types/ident.cmo types/patterns.cmi \
types/types.cmi runtime/value.cmi runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/chars.cmx types/ident.cmx types/patterns.cmx \
types/types.cmx runtime/value.cmx runtime/run_dispatch.cmi
runtime/run_dispatch.cmo: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/patterns.cmi types/types.cmi runtime/value.cmi \
runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/atoms.cmx types/chars.cmx types/ident.cmx \
types/patterns.cmx types/types.cmx runtime/value.cmx \
runtime/run_dispatch.cmi
runtime/value.cmo: types/atoms.cmi types/builtin.cmo types/chars.cmi \
types/ident.cmo types/intervals.cmi types/sequence.cmi types/types.cmi \
runtime/value.cmi
......@@ -112,7 +118,8 @@ parser/parser.cmi: parser/ast.cmo
typing/typer.cmi: parser/ast.cmo types/ident.cmo typing/typed.cmo \
types/types.cmi
types/boolean.cmi: types/sortedList.cmi
types/patterns.cmi: types/ident.cmo types/types.cmi
types/patterns.cmi: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/types.cmi
types/sequence.cmi: types/atoms.cmi types/types.cmi
types/sortedMap.cmi: types/sortedList.cmi
types/syntax.cmi: types/patterns.cmi types/types.cmi
......
type 'a obj = { id : int; mutable v : 'a }
type 'a t =
| True
| False
| Split of 'a obj * 'a t * 'a t * 'a t
let rec equal a b =
(a == b) ||
match (a,b) with
| Split (x1, p1,i1,n1), Split (x2, p2,i2,n2) ->
(x1.id = x2.id) && (equal p1 p2) & (equal i1 i2) &&
(equal n1 n2)
| _ -> false
let rec compare a b =
if (a == b) then 0
else match (a,b) with
| Split (x1, p1,i1,n1), Split (x2, p2,i2,n2) ->
if x1.id < x2.id then -1
else if x1.id > x2.id then 1
else let c = compare p1 p2 in if c <> 0 then c
else let c = compare i1 i2 in if c <> 0 then c
else compare n1 n2
| True,_ -> -1
| _, True -> 1
| False,_ -> -1
| _,False -> 1
let rec hash = function
| True -> 1
| False -> 2
| Split (x, p,i,n) ->
x.id + 17 * (hash p) + 257 * (hash i) + 16637 * (hash n)
let rec iter f = function
| Split (x, p,i,n) -> f x.v; iter f p; iter f i; iter f n
| _ -> ()
(* TODO: precompute hash value for Split node to have fast equality... *)
(*
let rec print f ppf = function
| True -> Format.fprintf ppf "True"
| False -> Format.fprintf ppf "False"
| Split (x, p,i,n) ->
Format.fprintf ppf "%a(@[%a,%a,%a@])"
f x.v (print f) p (print f) i (print f) n
*)
let rec print f ppf = function
| True -> Format.fprintf ppf "Any"
| False -> Format.fprintf ppf "Empty"
| Split (x, p,i, n) ->
(* Format.fprintf ppf "{%i}" x.id; *)
let flag = ref false in
let b () = if !flag then Format.fprintf ppf " | " else flag := true in
(match p with
| True -> b(); Format.fprintf ppf "%a" f x.v
| False -> ()
| _ -> b (); Format.fprintf ppf "%a & @[(%a)@]" f x.v (print f) p );
(match i with
| True -> assert false;
| False -> ()
| _ -> b(); print f ppf i);
(match n with
| True -> b (); Format.fprintf ppf "@[~%a@]" f x.v
| False -> ()
| _ -> b (); Format.fprintf ppf "@[~%a@] & @[(%a)@]" f x.v (print f) n)
let rec dump ppf = function
| True -> Format.fprintf ppf "True"
| False -> Format.fprintf ppf "False"
| Split (x, p,i,n) ->
Format.fprintf ppf "%i(@[%a,%a,%a@])"
x.id dump p dump i dump n
let rec dnf accu pos neg = function
| True -> (pos,neg) :: accu
| False -> accu
| Split (x, p,i,n) ->
let accu = dnf accu (x.v::pos) neg p in
let accu = dnf accu pos (x.v::neg) n in
let accu = dnf accu pos neg i in
accu
let dnf x = dnf [] [] [] x
let compute ~empty ~any ~cup ~cap ~diff ~atom b =
let rec aux = function
| True -> any
| False -> empty
| Split(x, p,i,n) ->
let p = cap (atom x.v) (aux p)
and i = aux i
and n = diff (aux p) (atom x.v) in
cup (cup p i) n
in
aux b
(* Invariants:
Split (x, pos,ign,neg) ==> (ign <> True);
(pos <> False or neg <> False)
Other meaningful invariant that could be enforced:
- pos <> neg
- no ``subsumption'' --> DONE (cf below)
*)
let split x pos ign neg =
if ign = True then True
else if (pos = False) && (neg = False) then ign
else Split (x, pos, ign, neg)
let ( !! ) x = Split (x, True, False, False)
let empty = False
let any = True
let rec simplify a l =
(* Format.fprintf Format.std_formatter "simplify %a <=" dump a;
List.iter (fun b -> Format.fprintf Format.std_formatter " %a" dump b) l;
Format.fprintf Format.std_formatter "@\n";
*)
if (a = False) then False else simpl_aux1 a [] l
and simpl_aux1 a accu = function
| [] ->
if accu = [] then a else
(match a with
| True -> True
| False -> assert false
| Split (x,p,i,n) -> simpl_aux2 x p i n [] [] [] accu)
| False :: l -> simpl_aux1 a accu l
| True :: l -> False
| b :: l -> if a == b then False else simpl_aux1 a (b::accu) l
and simpl_aux2 x p i n ap ai an = function
| [] -> split x (simplify p ap) (simplify i ai) (simplify n an)
| (Split (x2,p2,i2,n2) as b) :: l ->
if x2.id < x.id then
simpl_aux3 x p i n ap ai an l i2
else if x.id < x2.id then
simpl_aux2 x p i n (b :: ap) (b :: ai) (b :: an) l
else
simpl_aux2 x p i n (p2 :: i2 :: ap) (i2 :: ai) (n2 :: i2 :: an) l
| _ -> assert false
and simpl_aux3 x p i n ap ai an l = function
| False -> simpl_aux2 x p i n ap ai an l
| True -> assert false
| Split (x2,p2,i2,n2) as b ->
if x2.id < x.id then
simpl_aux3 x p i n ap ai an l i2
else if x.id < x2.id then
simpl_aux2 x p i n (b :: ap) (b :: ai) (b :: an) l
else
simpl_aux2 x p i n (p2 :: i2 :: ap) (i2 :: ai) (n2 :: i2 :: an) l
let split x p i n =
split x (simplify p [i]) i (simplify n [i])
let rec ( ++ ) a b =
if a == b then a
else match (a,b) with
| True, _ | _, True -> True
| False, a | a, False -> a
| Split (x1, p1,i1,n1), Split (x2, p2,i2,n2) ->
if x1.id = x2.id then
split x1 (p1 ++ p2) (i1 ++ i2) (n1 ++ n2)
else if x1.id < x2.id then
split x1 p1 (i1 ++ b) n1
else
split x2 p2 (i2 ++ a) n2
(* TODO: optimize the cup with 3 arguments ? *)
let rec ( ** ) a b =
if a == b then a
else match (a,b) with
| True, a | a, True -> a
| False, _ | _, False -> False
| Split (x1, p1,i1,n1), Split (x2, p2,i2,n2) ->
if x1.id = x2.id then
split x1
((p1 ** p2) ++ (p1 ** i2) ++ (p2 ** i1))
(i1 ** i2)
((n1 ** n2) ++ (n1 ** i2) ++ (n2 ** i1))
else if x1.id < x2.id then
split x1 (p1 ** b) (i1 ** b) (n1 ** b)
else
split x2 (p2 ** a) (i2 ** a) (n2 ** a)
let rec ( // ) a b =
if a == b then False
else match (a,b) with
| False,_ | _, True -> False
| a, False -> a
| True, Split (x2, p2,i2,n2) ->
let i = True // i2 in
split x2 (i // p2) False (i // n2)
| Split (x1, p1,i1,n1), Split (x2, p2,i2,n2) ->
if x1.id = x2.id then
let i = i1 // i2 in
split x1
((p1 // p2 // i2) ++ (i // p2))
False
((n1 // n2 // i2) ++ (i // n2))
else if x1.id < x2.id then
split x1 (p1 // b) (i1 // b) (n1 // b)
else
let i = a // i2 in
split x2 (i // p2) False (i // n2)
type 'a obj = { id : int; mutable v : 'a }
type 'a t (* = True | False | Split of 'a obj * 'a t * 'a t * 'a t *)
val equal : 'a t -> 'a t -> bool
val compare: 'a t -> 'a t -> int
val hash: 'a t -> int
val iter: ('a -> unit) -> ('a t -> unit)
val print :
(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
val dump : Format.formatter -> 'a t -> unit
val dnf : 'a t -> ('a list * 'a list) list
val compute: empty:'b -> any:'b -> cup:('b -> 'b -> 'b)
-> cap:('b -> 'b -> 'b) -> diff:('b -> 'b -> 'b) ->
atom:('a -> 'b) -> 'a t -> 'b
val empty : 'a t
val any : 'a t
val ( !! ) : 'a obj -> 'a t
val ( ++ ) : 'a t -> 'a t -> 'a t
val ( ** ) : 'a t -> 'a t -> 'a t
val ( // ) : 'a t -> 'a t -> 'a t
......@@ -3,6 +3,7 @@ type Text = [ (Char | (Letter+ ' '* Note))* ];;
type Letter = 'a'--'z' | 'A'--'Z';;
type Note = <note>[ PCDATA ];;
(*
type Flow = [ (Char | <ref no=Int>[ PCDATA ])* ];;
type Notes = [ <note no=Int>[ PCDATA ]* ];;
type Result = <doc>[ <body>Flow <notes>Notes ];;
......@@ -17,9 +18,11 @@ let fun text ( (Text,Int) -> (Flow,Notes) )
(pre @ [<ref no=count>word] @ body,
[<note no=count>n] @ notes)
| (body,_) -> (body, []);;
*)
try
match load_xml "tests/notes.xml" with
| x & Doc -> format x
| x & Doc -> [] (* format x *)
| _ -> raise "Invalid input document"
with _-> "Bon ca va";;
with _ -> "Bon ca va";;
......@@ -37,10 +37,13 @@ let base : Person =
]
;;
sort base;;
let fun contact(Person->String)
(*
let fun contact(Person -> String)
| <person>[ _ _ ((<tel kind="work"> x) | (<email> x) | (<tel> x))] -> x
| _ ->"no contact";;
......@@ -75,3 +78,4 @@ transform [ base base ] with
| _ -> [];;
*)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment