Commit 08c96461 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-03-06 19:02:15 by afrisch] Record concatenation in types

Original author: afrisch
Date: 2005-03-06 19:02:15+00:00
parent 48ac778a
......@@ -26,7 +26,8 @@ Since 0.2.2
- the ";" between fields is optional even for records
(used to be optional only for attributes)
* Keywords are now allowed as type names
* Concatenatiom @ allowed in types
* Concatenation @ allowed in types
* Record concatenation + allowed in types
- Tools:
* A new tool cduce_mktop produces customized CDuce toplevels with embedded
......
......@@ -113,6 +113,7 @@ and ppat' =
| Constant of U.t * pexpr
| Regexp of regexp
| Concat of ppat * ppat
| Merge of ppat * ppat
and regexp =
| Epsilon
......
......@@ -554,7 +554,8 @@ EXTEND
(la,a,y) ] SEP "and"
-> mk loc (Recurs (x,b)) ]
| RIGHTA [ x = pat; "->"; y = pat -> mk loc (Arrow (x,y))
| x = pat; "@"; y = pat -> mk loc (Concat (x,y)) ]
| x = pat; "@"; y = pat -> mk loc (Concat (x,y))
| x = pat; "+"; y = pat -> mk loc (Merge (x,y)) ]
| "no_arrow" [ x = pat; "|"; y = pat -> mk loc (Or (x,y)) ]
| "simple" [ x = pat; "&"; y = pat -> mk loc (And (x,y))
| x = pat; "\\"; y = pat -> mk loc (Diff (x,y)) ]
......
......@@ -282,6 +282,7 @@ module IType = struct
| ICapture of id
| IConstant of id * Types.const
| IConcat of node * node
| IMerge of node * node
let rec node_temp = {
desc = ILink node_temp;
......@@ -310,7 +311,7 @@ module IType = struct
257*(LabelMap.hash (hash_field f) r)
| ICapture x -> 10 + 17 * (Id.hash x)
| IConstant (x,c) -> 11 + 17 * (Id.hash x) + 257*(Types.Const.hash c)
| IConcat (p1,p2) -> assert false
| IConcat _ | IMerge _ -> assert false
let hash0 = hash (fun n -> 1)
let hash1 = hash hash0
......@@ -526,7 +527,7 @@ module IType = struct
| IRecord (o,r) -> Types.record' (o, LabelMap.map compute_typ_field r)
| ILink _ -> assert false
| ICapture _ | IConstant (_,_) -> assert false
| IConcat _ -> assert false
| IConcat _ | IMerge _ -> assert false
and compute_typ_field = function
| (s, None) -> typ_node s
| (s, Some _) ->
......@@ -586,7 +587,7 @@ module IType = struct
| IConstant (x,c) -> Patterns.constant x c
| IArrow _ ->
raise (Patterns.Error "Arrows are not allowed in patterns")
| IType _ | ILink _ | IConcat _ -> assert false
| IType _ | ILink _ | IConcat _ | IMerge _ -> assert false
and pat_node n =
let n = repr n in
......@@ -795,6 +796,10 @@ module IType = struct
let n = mk (IConcat (derecurs env p1, derecurs env p2)) in
concats := n :: !concats;
n
| Merge (p1,p2) ->
let n = mk (IMerge (derecurs env p1, derecurs env p2)) in
concats := n :: !concats;
n
and derecurs_regexp vars b rvars f env = function
(* - vars: seq variables to be propagated top-down and added
......@@ -879,11 +884,62 @@ module IType = struct
let rec elim_concat n =
match n.desc with
| IConcat (a,b) ->
if (n.sid > 0) then
raise (Patterns.Error "Ill-formed concatenation loop");
if (n.sid > 0)
then raise (Patterns.Error "Ill-formed concatenation loop");
n.sid <- 1;
n.desc <- ILink (elim_conc a b)
| IMerge (a,b) ->
if (n.sid > 0)
then raise (Patterns.Error "Ill-formed concatenation loop");
n.sid <- 1;
n.desc <- ILink (elim_merge a b)
| _ -> ()
and elim_merge a b =
let get_rec t =
let t = Types.Record.get t in
List.map (fun (l,o,_) ->
o,
LabelMap.map
(fun (opt,x) ->
let x = itype x in
(if opt then mk (IOptional x) else x),
None)
l) t in
let merge (o1,l1) (o2,l2) =
mk (IRecord (o1||o2, LabelMap.merge (fun _ x -> x) l1 l2)) in
(* Problem: repr can loop with ill-formed recursion.
type t = s + t where s = s | s;; *)
match (repr a).desc, (repr b).desc with
| IType (t1,_), IType (t2,_) ->
if not (Types.subtype t1 Types.Record.any) then
raise
(Patterns.Error
"Left argument of record concatenation is not a record type");
if not (Types.subtype t2 Types.Record.any) then
raise
(Patterns.Error
"Right argument of record concatenation is not a record type");
itype (Types.Record.merge t1 t2)
| IOr (a1,a2), _ -> ior (elim_merge a1 b) (elim_merge a2 b)
| _, IOr (b1,b2) -> ior (elim_merge a b1) (elim_merge a b2)
| IRecord (o1,l1), IRecord (o2,l2) -> merge (o1,l1) (o2,l2)
| IType (t1,_), IRecord (o2,l2) ->
if not (Types.subtype t1 Types.Record.any) then
raise
(Patterns.Error
"Left argument of record concatenation is not a record type");
List.fold_left (fun accu (o1,l1) ->
ior accu (merge (o1,l1) (o2,l2)))
iempty (get_rec t1)
| IRecord (o1,l1), IType (t2,_) ->
if not (Types.subtype t2 Types.Record.any) then
raise
(Patterns.Error
"Right argument of record concatenation is not a record type");
List.fold_left (fun accu (o2,l2) ->
ior accu (merge (o1,l1) (o2,l2)))
iempty (get_rec t2)
| _ -> raise (Patterns.Error "Cannot compute record concatenation")
and elim_conc n q =
let mem = ref [] in
let rec aux n =
......@@ -892,14 +948,13 @@ module IType = struct
let r = mk_delayed () in
mem := (n,r) :: !mem;
let rec aux2 n =
let m = match n.desc with
match n.desc with
| ILink n' -> aux2 n'
| IOr (a,b) -> ior (aux a) (aux b)
| ITimes (a,b) -> mk (ITimes (a, aux b))
| IConcat (a,b) -> elim_concat n; aux2 n
| IType (t,_) -> elim_concat_type t q
| _ -> assert false in
m
| _ -> raise (Patterns.Error "Cannot compute concatenation")
in
r.desc <- ILink (aux2 n);
r
......
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