Commit 093f0462 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-11-08 23:26:40 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-08 23:26:40+00:00
parent 01d26c82
...@@ -23,7 +23,10 @@ let rec tuple loc = function ...@@ -23,7 +23,10 @@ let rec tuple loc = function
| [ x ] -> x | [ x ] -> x
| x :: l -> mk (x.loc) (Pair (x, tuple loc l)) | x :: l -> mk (x.loc) (Pair (x, tuple loc l))
| [] -> assert false | [] -> assert false
let tuple_queue =
List.fold_right (fun x q -> mk x.loc (Pair (x, q)))
let char = mk noloc (Internal (Types.char Chars.any)) let char = mk noloc (Internal (Types.char Chars.any))
let string_regexp = Star (Elem char) let string_regexp = Star (Elem char)
...@@ -124,8 +127,12 @@ EXTEND ...@@ -124,8 +127,12 @@ EXTEND
| "("; l = LIST1 expr SEP ","; ")" -> tuple loc l | "("; l = LIST1 expr SEP ","; ")" -> tuple loc l
| "["; l = LIST0 seq_elem; e = OPT [ ";"; e = expr -> e ]; "]" -> | "["; l = LIST0 seq_elem; e = OPT [ ";"; e = expr -> e ]; "]" ->
let e = match e with Some e -> e | None -> cst_nil in let e = match e with Some e -> e | None -> cst_nil in
let l = List.flatten l in List.fold_right
tuple loc (l @ [e]) (fun x q ->
match x with
| `Elems l -> tuple_queue l q
| `Explode x -> mk x.loc (Op ("@",[x;q]))
) l e
| t = [ a = TAG -> | t = [ a = TAG ->
mk loc (Cst (Types.Atom (Types.AtomPool.mk a))) mk loc (Cst (Types.Atom (Types.AtomPool.mk a)))
| "<"; e = expr LEVEL "no_appl" -> e ]; | "<"; e = expr LEVEL "no_appl" -> e ];
...@@ -134,15 +141,16 @@ EXTEND ...@@ -134,15 +141,16 @@ EXTEND
| "{"; r = [ expr_record_spec | -> mk loc (RecordLitt []) ]; "}" -> r | "{"; r = [ expr_record_spec | -> mk loc (RecordLitt []) ]; "}" -> r
| s = STRING2 -> | s = STRING2 ->
tuple loc (char_list loc s @ [cst_nil]) tuple loc (char_list loc s @ [cst_nil])
| "!"; t = pat -> mk loc (DebugTyper t) (* | "!"; t = pat -> mk loc (DebugTyper t) *)
| a = LIDENT -> mk loc (Var a) | a = LIDENT -> mk loc (Var a)
] ]
]; ];
seq_elem: [ seq_elem: [
[ x = STRING1 -> char_list loc x [ x = STRING1 -> `Elems (char_list loc x)
| e = expr LEVEL "no_appl" -> [e] | e = expr LEVEL "no_appl" -> `Elems [e]
| "!"; e = expr LEVEL "no_appl" -> `Explode e
] ]
]; ];
......
...@@ -35,7 +35,7 @@ let fun do_biblio (Biblio -> Html) ...@@ -35,7 +35,7 @@ let fun do_biblio (Biblio -> Html)
in in
<html>[ <head>[ <title>h ] <body>body ] <html>[ <head>[ <title>h ] <body>body ]
in in
let bib = let bib : Biblio =
<bibliography>[ <bibliography>[
<heading>"Alain Frisch's bibliography" <heading>"Alain Frisch's bibliography"
<paper>[ <paper>[
......
...@@ -10,3 +10,5 @@ let fun h (x : [Int*] | ([Int*] -> [Int*])) : [Int*] = x [ 1 2 3 ];; ...@@ -10,3 +10,5 @@ let fun h (x : [Int*] | ([Int*] -> [Int*])) : [Int*] = x [ 1 2 3 ];;
h [ 10 20 ];; h [ 10 20 ];;
h (fun (x : [Int*]) : [Int*] = [ 100 200 ] x);; h (fun (x : [Int*]) : [Int*] = [ 100 200 ] x);;
(* 'explode' subsequences *)
[ 1 2 3 ![4 5 6] 7 8 9 ];;
...@@ -320,11 +320,17 @@ let get_record r = ...@@ -320,11 +320,17 @@ let get_record r =
let diff_t d t = diff d (descr t) let diff_t d t = diff d (descr t)
let cap_t d t = cap d (descr t) let cap_t d t = cap d (descr t)
let cup_t d t = cup d (descr t)
let cap_product l = let cap_product l =
List.fold_left List.fold_left
(fun (d1,d2) (t1,t2) -> (cap_t d1 t1, cap_t d2 t2)) (fun (d1,d2) (t1,t2) -> (cap_t d1 t1, cap_t d2 t2))
(any,any) (any,any)
l l
let cup_product l =
List.fold_left
(fun (d1,d2) (t1,t2) -> (cup_t d1 t1, cup_t d2 t2))
(empty,empty)
l
module Assumptions = Set.Make(struct type t = descr let compare = compare end) module Assumptions = Set.Make(struct type t = descr let compare = compare end)
...@@ -369,7 +375,16 @@ and empty_rec_times_aux (left,right) = ...@@ -369,7 +375,16 @@ and empty_rec_times_aux (left,right) =
in in
let (accu1,accu2) = cap_product left in let (accu1,accu2) = cap_product left in
(empty_rec accu1) || (empty_rec accu2) || (empty_rec accu1) || (empty_rec accu2) ||
(try aux accu1 accu2 right; true with NotEmpty -> false) (* OPT? It does'nt seem so ... The hope was to return false quickly
for large right hand-side *)
(
((*if (List length right > 2) then
let (cup1,cup2) = cup_product right in
(empty_rec (diff accu1 cup1)) && (empty_rec (diff accu2 cup2))
else*) true)
&&
(try aux accu1 accu2 right; true with NotEmpty -> false)
)
and empty_rec_arrow c = and empty_rec_arrow c =
List.for_all empty_rec_arrow_aux c List.for_all empty_rec_arrow_aux c
......
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