Skip to content

GitLab

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
Hide whitespace changes
Inline Side-by-side
parser/parser.ml
View file @ 093f0462
......@@ -23,7 +23,10 @@ let rec tuple loc = function
| [ x ] -> x
| x :: l -> mk (x.loc) (Pair (x, tuple loc l))
| [] -> 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 string_regexp = Star (Elem char)
......@@ -124,8 +127,12 @@ EXTEND
| "("; l = LIST1 expr SEP ","; ")" -> tuple loc l
| "["; l = LIST0 seq_elem; e = OPT [ ";"; e = expr -> e ]; "]" ->
let e = match e with Some e -> e | None -> cst_nil in
let l = List.flatten l in
tuple loc (l @ [e])
List.fold_right
(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 ->
mk loc (Cst (Types.Atom (Types.AtomPool.mk a)))
| "<"; e = expr LEVEL "no_appl" -> e ];
......@@ -134,15 +141,16 @@ EXTEND
| "{"; r = [ expr_record_spec | -> mk loc (RecordLitt []) ]; "}" -> r
| s = STRING2 ->
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)
]
];
seq_elem: [
[ x = STRING1 -> char_list loc x
| e = expr LEVEL "no_appl" -> [e]
[ x = STRING1 -> `Elems (char_list loc x)
| e = expr LEVEL "no_appl" -> `Elems [e]
| "!"; e = expr LEVEL "no_appl" -> `Explode e
]
];
......
tests/biblio.cd
View file @ 093f0462
......@@ -35,7 +35,7 @@ let fun do_biblio (Biblio -> Html)
in
<html>[ <head>[ <title>h ] <body>body ]
in
let bib =
let bib : Biblio =
<bibliography>[
<heading>"Alain Frisch's bibliography"
<paper>[
......
tests/eval_concat.cd
View file @ 093f0462
......@@ -10,3 +10,5 @@ let fun h (x : [Int*] | ([Int*] -> [Int*])) : [Int*] = x [ 1 2 3 ];;
h [ 10 20 ];;
h (fun (x : [Int*]) : [Int*] = [ 100 200 ] x);;
(* 'explode' subsequences *)
[ 1 2 3 ![4 5 6] 7 8 9 ];;
types/types.ml
View file @ 093f0462
......@@ -320,11 +320,17 @@ let get_record r =
let diff_t d t = diff 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 =
List.fold_left
(fun (d1,d2) (t1,t2) -> (cap_t d1 t1, cap_t d2 t2))
(any,any)
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)
......@@ -369,7 +375,16 @@ and empty_rec_times_aux (left,right) =
in
let (accu1,accu2) = cap_product left in
(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 =
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