Commit 21219422 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-03-03 23:47:00 by afrisch] Identifiers are now qualified names. Uniform...

[r2005-03-03 23:47:00 by afrisch] Identifiers are now qualified names. Uniform dot syntax for external
CDuce and OCaml unit

Original author: afrisch
Date: 2005-03-03 23:47:02+00:00
parent 4d110fdc
...@@ -13,7 +13,9 @@ let global_size env = env.global_size ...@@ -13,7 +13,9 @@ let global_size env = env.global_size
let dump ppf env = let dump ppf env =
Env.iter Env.iter
(fun id loc -> (fun id loc ->
Format.fprintf ppf "Var %a : %a@\n" U.print (Id.value id) Lambda.print_var_loc loc) Format.fprintf ppf "Var %a : %a@\n"
Ident.print id
Lambda.print_var_loc loc)
env.vars env.vars
...@@ -257,8 +259,8 @@ let rec collect_funs accu = function ...@@ -257,8 +259,8 @@ let rec collect_funs accu = function
| rest -> (accu,rest) | rest -> (accu,rest)
let rec collect_types accu = function let rec collect_types accu = function
| { descr = Ast.TypeDecl (x,t) } :: rest -> | { descr = Ast.TypeDecl ((loc,x),t) } :: rest ->
collect_types ((x,t) :: accu) rest collect_types ((loc,x,t) :: accu) rest
| rest -> (accu,rest) | rest -> (accu,rest)
let rec phrases ~run ~show ~loading ~directive = let rec phrases ~run ~show ~loading ~directive =
......
...@@ -51,7 +51,7 @@ let print_value ppf v = ...@@ -51,7 +51,7 @@ let print_value ppf v =
let dump_value ppf x t v = let dump_value ppf x t v =
Format.fprintf ppf "@[val %a : @[%a = %a@]@]@." Format.fprintf ppf "@[val %a : @[%a = %a@]@]@."
U.print (Id.value x) print_norm t print_value v Ident.print x print_norm t print_value v
let dump_env ppf tenv cenv = let dump_env ppf tenv cenv =
Format.fprintf ppf "Types:%a@." Typer.dump_types tenv; Format.fprintf ppf "Types:%a@." Typer.dump_types tenv;
...@@ -116,12 +116,12 @@ let rec print_exn ppf = function ...@@ -116,12 +116,12 @@ let rec print_exn ppf = function
print_norm t; print_norm t;
Format.fprintf ppf "Sample:@.%a@." print_sample (Sample.get t) Format.fprintf ppf "Sample:@.%a@." print_sample (Sample.get t)
| Typer.UnboundId (x,tn) -> | Typer.UnboundId (x,tn) ->
Format.fprintf ppf "Unbound identifier %a%s@." U.print (Id.value x) Format.fprintf ppf "Unbound identifier %a%s@." Ident.print x
(if tn then " (it is a type name)" else "") (if tn then " (it is a type name)" else "")
| Typer.UnboundExtId (cu,x) -> | Typer.UnboundExtId (cu,x) ->
Format.fprintf ppf "Unbound external identifier %a:%a@." Format.fprintf ppf "Unbound external identifier %a:%a@."
U.print (Types.CompUnit.value cu) U.print (Types.CompUnit.value cu)
U.print (Id.value x) Ident.print x
| Ulexer.Error (i,j,s) -> | Ulexer.Error (i,j,s) ->
let loc = Location.loc_of_pos (i,j), `Full in let loc = Location.loc_of_pos (i,j), `Full in
Format.fprintf ppf "Error %a:@." Location.print_loc loc; Format.fprintf ppf "Error %a:@." Location.print_loc loc;
...@@ -188,7 +188,8 @@ let debug ppf tenv cenv = function ...@@ -188,7 +188,8 @@ let debug ppf tenv cenv = function
Patterns.Print.print (Patterns.descr p); Patterns.Print.print (Patterns.descr p);
let f = Patterns.filter (Types.descr t) p in let f = Patterns.filter (Types.descr t) p in
IdMap.iteri (fun x t -> IdMap.iteri (fun x t ->
Format.fprintf ppf " %a:%a@." U.print (Id.value x) Format.fprintf ppf " %a:%a@."
Ident.print x
print_norm (Types.descr t)) f print_norm (Types.descr t)) f
| `Accept p -> | `Accept p ->
Format.fprintf ppf "[DEBUG:accept]@."; Format.fprintf ppf "[DEBUG:accept]@.";
...@@ -272,7 +273,7 @@ let directive ppf tenv cenv = function ...@@ -272,7 +273,7 @@ let directive ppf tenv cenv = function
let print_id_opt ppf = function let print_id_opt ppf = function
| None -> Format.fprintf ppf "-" | None -> Format.fprintf ppf "-"
| Some id -> Format.fprintf ppf "val %a" U.print (Id.value id) | Some id -> Format.fprintf ppf "val %a" Ident.print id
let print_value_opt ppf = function let print_value_opt ppf = function
| None -> () | None -> ()
......
...@@ -17,5 +17,5 @@ val run: string -> unit ...@@ -17,5 +17,5 @@ val run: string -> unit
val print_exn: Format.formatter -> exn -> unit val print_exn: Format.formatter -> exn -> unit
val eval: string -> (Encodings.Utf8.t option * Value.t) list val eval: string -> (Ns.qname option * Value.t) list
(* Can be used from CDuce units *) (* Can be used from CDuce units *)
...@@ -141,7 +141,7 @@ let show ppf id t v = ...@@ -141,7 +141,7 @@ let show ppf id t v =
match id with match id with
| Some id -> | Some id ->
Format.fprintf ppf "@[val %a : @[%a@]@." Format.fprintf ppf "@[val %a : @[%a@]@."
U.print (Id.value id) Ident.print id
Types.Print.print t Types.Print.print t
| None -> () | None -> ()
...@@ -164,7 +164,6 @@ let rec compile verbose name id src = ...@@ -164,7 +164,6 @@ let rec compile verbose name id src =
raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e
in in
if src <> "" then close_in ic; if src <> "" then close_in ic;
let argv = ident (U.mk "argv") in
during_compile := true; during_compile := true;
C.enter id; C.enter id;
let show = let show =
......
...@@ -439,7 +439,7 @@ let exts = ref [] ...@@ -439,7 +439,7 @@ let exts = ref []
let check_value ty_env c_env (s,caml_t,t) = let check_value ty_env c_env (s,caml_t,t) =
(* Find the type for the value in the CDuce module *) (* Find the type for the value in the CDuce module *)
let id = Id.mk (U.mk s) in let id = Id.mk (Ns.empty, U.mk s) in
let vt = let vt =
try Typer.find_value id ty_env try Typer.find_value id ty_env
with Not_found -> with Not_found ->
......
...@@ -7,7 +7,7 @@ type pprog = pmodule_item list ...@@ -7,7 +7,7 @@ type pprog = pmodule_item list
and pmodule_item = pmodule_item' located and pmodule_item = pmodule_item' located
and pmodule_item' = and pmodule_item' =
| TypeDecl of id * ppat | TypeDecl of (Location.loc * U.t) * ppat
| SchemaDecl of U.t * string * U.t option (* name, uri, ns prefix *) | SchemaDecl of U.t * string * U.t option (* name, uri, ns prefix *)
| LetDecl of ppat * pexpr | LetDecl of ppat * pexpr
| FunDecl of pexpr | FunDecl of pexpr
...@@ -74,7 +74,6 @@ and pexpr = ...@@ -74,7 +74,6 @@ and pexpr =
| NamespaceIn of U.t * Ns.t * pexpr | NamespaceIn of U.t * Ns.t * pexpr
| Forget of pexpr * ppat | Forget of pexpr * ppat
| Check of pexpr * ppat | Check of pexpr * ppat
(* | Op of string * pexpr list *)
| Ref of pexpr * ppat | Ref of pexpr * ppat
| External of string * ppat list | External of string * ppat list
...@@ -83,7 +82,7 @@ and pexpr = ...@@ -83,7 +82,7 @@ and pexpr =
and label = U.t and label = U.t
and abstr = { and abstr = {
fun_name : id option; fun_name : (Location.loc * U.t) option;
fun_iface : (ppat * ppat) list; fun_iface : (ppat * ppat) list;
fun_body : branches fun_body : branches
} }
...@@ -94,12 +93,12 @@ and branches = (ppat * pexpr) list ...@@ -94,12 +93,12 @@ and branches = (ppat * pexpr) list
and ppat = ppat' located and ppat = ppat' located
and ppat' = and ppat' =
| PatVar of U.t | PatVar of (U.t option) * U.t (* optional compilation unit *)
| SchemaVar of (* type/pattern schema variable *) | SchemaVar of (* type/pattern schema variable *)
Schema_types.component_kind * U.t * U.t (* kind, schema, name *) Schema_types.component_kind * U.t * U.t (* kind, schema, name *)
| Cst of pexpr | Cst of pexpr
| NsT of U.t | NsT of U.t
| Recurs of ppat * (id * ppat) list | Recurs of ppat * (Location.loc * U.t * ppat) list
| Internal of Types.descr | Internal of Types.descr
| Or of ppat * ppat | Or of ppat * ppat
| And of ppat * ppat | And of ppat * ppat
...@@ -109,7 +108,7 @@ and ppat' = ...@@ -109,7 +108,7 @@ and ppat' =
| Arrow of ppat * ppat | Arrow of ppat * ppat
| Optional of ppat | Optional of ppat
| Record of bool * (label * (ppat * ppat option)) list | Record of bool * (label * (ppat * ppat option)) list
| Constant of id * pexpr | Constant of U.t * pexpr
| Regexp of regexp | Regexp of regexp
and regexp = and regexp =
...@@ -120,7 +119,7 @@ and regexp = ...@@ -120,7 +119,7 @@ and regexp =
| Alt of regexp * regexp | Alt of regexp * regexp
| Star of regexp | Star of regexp
| WeakStar of regexp | WeakStar of regexp
| SeqCapture of id * regexp | SeqCapture of Location.loc * U.t * regexp
let pat_true = mknoloc (Internal Builtin_defs.true_type) let pat_true = mknoloc (Internal Builtin_defs.true_type)
......
...@@ -23,10 +23,21 @@ let gram = Grammar.gcreate Ulexer.lex ...@@ -23,10 +23,21 @@ let gram = Grammar.gcreate Ulexer.lex
let parse_ident = U.mk let parse_ident = U.mk
let id_dummy = ident (U.mk "$$$") let id_dummy = U.mk "$$$"
let ident s =
let b = Buffer.create (String.length s) in
let rec aux i =
if (i = String.length s) then Buffer.contents b
else match s.[i] with
| '\\' -> assert (s.[i+1] = '.'); Buffer.add_char b '.'; aux (i+2)
| c -> Buffer.add_char b c; aux (i+1)
in
aux 0
let label = parse_ident let label s = U.mk (ident s)
let ident s = ident (parse_ident s) (*let ident s = ident (parse_ident s)*)
let ident s = U.mk (ident s)
let prog = Grammar.Entry.create gram "prog" let prog = Grammar.Entry.create gram "prog"
let top_phrases = Grammar.Entry.create gram "toplevel phrases" let top_phrases = Grammar.Entry.create gram "toplevel phrases"
...@@ -35,7 +46,8 @@ let pat = Grammar.Entry.create gram "type/pattern expression" ...@@ -35,7 +46,8 @@ let pat = Grammar.Entry.create gram "type/pattern expression"
let regexp = Grammar.Entry.create gram "type/pattern regexp" let regexp = Grammar.Entry.create gram "type/pattern regexp"
let keyword = Grammar.Entry.create gram "keyword" let keyword = Grammar.Entry.create gram "keyword"
let exp pos e = LocatedExpr (loc_of_pos (tloc pos),e) let lop pos = loc_of_pos (tloc pos)
let exp pos e = LocatedExpr (lop pos,e)
let rec multi_prod loc = function let rec multi_prod loc = function
| [ x ] -> x | [ x ] -> x
...@@ -90,6 +102,15 @@ let is_fun_decl = ...@@ -90,6 +102,15 @@ let is_fun_decl =
| _ -> raise Stream.Failure | _ -> raise Stream.Failure
) )
let is_capture =
Grammar.Entry.of_parser gram "[is_capture]"
(fun strm ->
match Stream.npeek 2 strm with
| [ ("IDENT", _) ; ("", "::") ; _ ] -> ()
| _ -> raise Stream.Failure
)
let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2]) let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])
let logical_and e1 e2 = if_then_else e1 e2 cst_false let logical_and e1 e2 = if_then_else e1 e2 cst_false
...@@ -117,7 +138,7 @@ EXTEND ...@@ -117,7 +138,7 @@ EXTEND
[ mk loc (LetDecl (p,e)) ] [ mk loc (LetDecl (p,e)) ]
| (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"-> | (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
[ mk loc (EvalStatement (exp loc (Match (e1,[p,e2])))) ] [ mk loc (EvalStatement (exp loc (Match (e1,[p,e2])))) ]
| "type"; x = IDENT; "="; t = pat -> [ mk loc (TypeDecl (ident x,t)) ] | "type"; x = located_ident; "="; t = pat -> [ mk loc (TypeDecl (x,t)) ]
| "using"; name = IDENT; "="; cu = [ IDENT | STRING2 ] -> | "using"; name = IDENT; "="; cu = [ IDENT | STRING2 ] ->
[ mk loc (Using (U.mk name, U.mk cu)) ] [ mk loc (Using (U.mk name, U.mk cu)) ]
| "schema"; name = IDENT; | "schema"; name = IDENT;
...@@ -131,20 +152,20 @@ EXTEND ...@@ -131,20 +152,20 @@ EXTEND
let e = exp loc (NamespaceIn (name, ns, e2)) in let e = exp loc (NamespaceIn (name, ns, e2)) in
[ mk loc (EvalStatement (exp loc e)) ] [ mk loc (EvalStatement (exp loc e)) ]
| "debug"; d = debug_directive -> [ mk loc (Directive (`Debug d)) ] | "debug"; d = debug_directive -> [ mk loc (Directive (`Debug d)) ]
| DIRECTIVE "#verbose" -> [ mk loc (Directive `Verbose) ] | "#"; IDENT "verbose" -> [ mk loc (Directive `Verbose) ]
| DIRECTIVE "#silent" -> [ mk loc (Directive `Silent) ] | "#"; IDENT "silent" -> [ mk loc (Directive `Silent) ]
| DIRECTIVE "#utf8" -> Ulexer.enc := Ulexing.Utf8; [ ] | "#"; IDENT "utf8" -> Ulexer.enc := Ulexing.Utf8; [ ]
| DIRECTIVE "#latin1" -> Ulexer.enc := Ulexing.Latin1; [ ] | "#"; IDENT "latin1" -> Ulexer.enc := Ulexing.Latin1; [ ]
| DIRECTIVE "#ascii" -> Ulexer.enc := Ulexing.Ascii; [ ] | "#"; IDENT "ascii" -> Ulexer.enc := Ulexing.Ascii; [ ]
| DIRECTIVE "#quit" -> [ mk loc (Directive `Quit) ] | "#"; IDENT "quit" -> [ mk loc (Directive `Quit) ]
| DIRECTIVE "#env" -> [ mk loc (Directive `Env) ] | "#"; IDENT "env" -> [ mk loc (Directive `Env) ]
| DIRECTIVE "#print_schema"; name = IDENT -> | "#"; IDENT "print_schema"; name = IDENT ->
[ mk loc (Directive (`Print_schema (U.mk name))) ] [ mk loc (Directive (`Print_schema (U.mk name))) ]
| DIRECTIVE "#print_type"; t = pat -> | "#"; IDENT "print_type"; t = pat ->
[ mk loc (Directive (`Print_type t)) ] [ mk loc (Directive (`Print_type t)) ]
| DIRECTIVE "#dump_value"; e = expr -> [ mk loc (Directive (`Dump e)) ] | "#"; IDENT "dump_value"; e = expr -> [ mk loc (Directive (`Dump e)) ]
| DIRECTIVE "#reinit_ns" -> [ mk loc (Directive `Reinit_ns) ] | "#"; IDENT "reinit_ns" -> [ mk loc (Directive `Reinit_ns) ]
| DIRECTIVE "#help" -> [ mk loc (Directive `Help) ] | "#"; IDENT "help" -> [ mk loc (Directive `Help) ]
| "include"; s = STRING2 -> | "include"; s = STRING2 ->
let s = let s =
if Filename.is_relative s if Filename.is_relative s
...@@ -265,10 +286,10 @@ EXTEND ...@@ -265,10 +286,10 @@ EXTEND
let tag = mk loc (Internal (Types.atom (Atoms.any))) in let tag = mk loc (Internal (Types.atom (Atoms.any))) in
let att = mk loc (Internal Types.Record.any) in let att = mk loc (Internal Types.Record.any) in
let any = mk loc (Internal (Types.any)) in let any = mk loc (Internal (Types.any)) in
let re = Star(Alt(SeqCapture(id_dummy,Elem p), Elem any)) in let re = Star(Alt(SeqCapture(noloc,id_dummy,Elem p), Elem any)) in
let ct = mk loc (Regexp re) in let ct = mk loc (Regexp re) in
let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
let b = (p, Var (Id.value id_dummy)) in let b = (p, Var id_dummy) in
exp loc (Transform (e,[b])) exp loc (Transform (e,[b]))
] ]
| |
...@@ -350,7 +371,7 @@ EXTEND ...@@ -350,7 +371,7 @@ EXTEND
let_binding: [ let_binding: [
[ "let"; is_fun_decl; OPT "fun"; (f,a,b) = fun_decl -> [ "let"; is_fun_decl; OPT "fun"; (f,a,b) = fun_decl ->
let f = match f with Some x -> x | None -> assert false in let f = match f with Some x -> x | None -> assert false in
let p = mk loc (PatVar (Id.value f)) in let p = mk loc (PatVar (None, snd f)) in
let abst = { fun_name = Some f; fun_iface = a; fun_body = b } in let abst = { fun_name = Some f; fun_iface = a; fun_body = b } in
let e = exp loc (Abstraction abst) in let e = exp loc (Abstraction abst) in
(true,p,e) (true,p,e)
...@@ -406,8 +427,7 @@ EXTEND ...@@ -406,8 +427,7 @@ EXTEND
fun_decl: [ fun_decl: [
[ f = OPT IDENT; "("; (a,b) = fun_decl_after_lparen -> [ f = OPT located_ident; "("; (a,b) = fun_decl_after_lparen ->
let f = match f with Some x -> Some (ident x) | None -> None in
(f,a,b) (f,a,b)
] ]
]; ];
...@@ -437,7 +457,7 @@ EXTEND ...@@ -437,7 +457,7 @@ EXTEND
| Elem x, Elem y -> Elem (mk loc (And (x,y))) | Elem x, Elem y -> Elem (mk loc (And (x,y)))
| _ -> error loc "Conjunction not allowed in regular expression" | _ -> error loc "Conjunction not allowed in regular expression"
] ]
| [ a = IDENT; "::"; x = regexp -> SeqCapture (ident a,x) ] | [ a = IDENT; "::"; x = regexp -> SeqCapture (lop loc,ident a,x) ]
| [ x = regexp; "*" -> Star x | [ x = regexp; "*" -> Star x
| x = regexp; "*?" -> WeakStar x | x = regexp; "*?" -> WeakStar x
| x = regexp; "+" -> Seq (x, Star x) | x = regexp; "+" -> Seq (x, Star x)
...@@ -508,9 +528,12 @@ EXTEND ...@@ -508,9 +528,12 @@ EXTEND
] ]
]; ];
located_ident: [ [ a = IDENT -> (lop loc,ident a) ] ];
pat: [ pat: [
[ x = pat; "where"; [ x = pat; "where";
b = LIST1 [ a = IDENT; "="; y = pat -> (ident a,y) ] SEP "and" b = LIST1 [ (la,a) = located_ident; "="; y = pat ->
(la,a,y) ] SEP "and"
-> mk loc (Recurs (x,b)) ] -> mk loc (Recurs (x,b)) ]
| RIGHTA [ x = pat; "->"; y = pat -> mk loc (Arrow (x,y)) ] | RIGHTA [ x = pat; "->"; y = pat -> mk loc (Arrow (x,y)) ]
| "no_arrow" [ x = pat; "|"; y = pat -> mk loc (Or (x,y)) ] | "no_arrow" [ x = pat; "|"; y = pat -> mk loc (Or (x,y)) ]
...@@ -533,8 +556,10 @@ EXTEND ...@@ -533,8 +556,10 @@ EXTEND
mk loc (SchemaVar (kind, U.mk schema, U.mk typ)) mk loc (SchemaVar (kind, U.mk schema, U.mk typ))
| "!"; a = IDENT -> | "!"; a = IDENT ->
mk loc (Internal (Types.abstract (Types.Abstract.atom a))) mk loc (Internal (Types.abstract (Types.Abstract.atom a)))
| a = IDENT -> (* | a = IDENT ->
mk loc (PatVar (U.mk a)) mk loc (PatVar (None, U.mk a)) *)
| cu = OPT [ cu = IDENT; "." -> U.mk cu ]; a = IDENT ->
mk loc (PatVar (cu, U.mk a))
| i = INT ; "--"; j = INT -> | i = INT ; "--"; j = INT ->
let i = Intervals.V.mk i let i = Intervals.V.mk i
and j = Intervals.V.mk j in and j = Intervals.V.mk j in
...@@ -595,7 +620,7 @@ EXTEND ...@@ -595,7 +620,7 @@ EXTEND
[ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat -> [ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat ->
let (o,x,y) = let (o,x,y) =
match f with match f with
| None -> (false, mknoloc (PatVar (U.mk l)), None) | None -> (false, mknoloc (PatVar (None,U.mk l)), None)
| Some z -> z | Some z -> z
in in
let x = if o then mk loc (Optional x) else x in let x = if o then mk loc (Optional x) else x in
...@@ -614,7 +639,7 @@ EXTEND ...@@ -614,7 +639,7 @@ EXTEND
[ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat; OPT ";" -> [ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat; OPT ";" ->
let (o,x,y) = let (o,x,y) =
match f with match f with
| None -> (false, mknoloc (PatVar (U.mk l)), None) | None -> (false, mknoloc (PatVar (None,U.mk l)), None)
| Some z -> z | Some z -> z
in in
let x = if o then mk loc (Optional x) else x in let x = if o then mk loc (Optional x) else x in
......
...@@ -44,7 +44,7 @@ let parse_char lexbuf base i = ...@@ -44,7 +44,7 @@ let parse_char lexbuf base i =
let regexp ncname_char = let regexp ncname_char =
xml_letter | xml_digit | [ '.' '-' '_' ] | xml_combining_char | xml_extender xml_letter | xml_digit | [ '-' '_' ] | xml_combining_char | xml_extender | "\\."
let regexp ncname = (xml_letter | '_' ) ncname_char* let regexp ncname = (xml_letter | '_' ) ncname_char*
let regexp qname = (ncname ':')? ncname let regexp qname = (ncname ':')? ncname
...@@ -77,8 +77,6 @@ let rec token = lexer ...@@ -77,8 +77,6 @@ let rec token = lexer
| "{|" | "|}" | "<=" | ">=" | "<<" | ">>" | "||" | "&&" | "**" | "{|" | "|}" | "<=" | ">=" | "<<" | ">>" | "||" | "&&" | "**"
| ["?+*"] "?" | "#" -> | ["?+*"] "?" | "#" ->
return lexbuf ("", L.utf8_lexeme lexbuf) return lexbuf ("", L.utf8_lexeme lexbuf)
| "#" ncname ->
return lexbuf ("DIRECTIVE", L.utf8_lexeme lexbuf)
| '"' | "'" -> | '"' | "'" ->
let start = L.lexeme_start lexbuf in let start = L.lexeme_start lexbuf in
let double_quote = L.latin1_lexeme_char lexbuf 0 = '"' in let double_quote = L.latin1_lexeme_char lexbuf 0 = '"' in
......
...@@ -50,7 +50,7 @@ let rec string_of_ppat p = ...@@ -50,7 +50,7 @@ let rec string_of_ppat p =
match rg with match rg with
|Elem(e) -> string_of_ppat e |Elem(e) -> string_of_ppat e
|Guard(e) -> "/" ^ (string_of_ppat e) |Guard(e) -> "/" ^ (string_of_ppat e)
|SeqCapture(id,rg) -> U.get_str (Id.value id) ^"::"^ string_of_regexp rg |SeqCapture(_,id,rg) -> U.get_str id ^"::"^ string_of_regexp rg
|Seq(r1,r2) -> string_of_regexp r1 ^ " "^string_of_regexp r2 |Seq(r1,r2) -> string_of_regexp r1 ^ " "^string_of_regexp r2
|Alt(r1,r2) -> " ("^string_of_regexp r1 ^"|"^ string_of_regexp r2^")" |Alt(r1,r2) -> " ("^string_of_regexp r1 ^"|"^ string_of_regexp r2^")"
|Star r1 -> string_of_regexp r1^"* " |Star r1 -> string_of_regexp r1^"* "
...@@ -59,7 +59,7 @@ let rec string_of_ppat p = ...@@ -59,7 +59,7 @@ let rec string_of_ppat p =
in match p with in match p with
{loc = loc ; descr = descr } {loc = loc ; descr = descr }
-> ( match descr with -> ( match descr with
|PatVar(id) -> U.get_str ( id) |PatVar(_,id) -> U.get_str ( id)
|Cst(Atom a) -> U.get_str a |Cst(Atom a) -> U.get_str a
|Internal(descr) -> |Internal(descr) ->
if descr=Builtin_defs.true_type then "`true" if descr=Builtin_defs.true_type then "`true"
...@@ -82,7 +82,7 @@ mais pas prioritaire [] -> "" ...@@ -82,7 +82,7 @@ mais pas prioritaire [] -> ""
|(s,ppat)::r -> " "^(U.get_str |(s,ppat)::r -> " "^(U.get_str
((LabelPool.value s)))^"="^string_of_ppat(ppat)^listing r ((LabelPool.value s)))^"="^string_of_ppat(ppat)^listing r
)in listing (lm) *) )in listing (lm) *)
|Constant(i,t) -> U.get_str (Id.value i) |Constant(i,t) -> U.get_str i
|Regexp(rg) -> "["^string_of_regexp rg ^ "]" |Regexp(rg) -> "["^string_of_regexp rg ^ "]"
| _ ->"?" | _ ->"?"
) )
...@@ -92,7 +92,7 @@ let rec var_of_ppat x = ...@@ -92,7 +92,7 @@ let rec var_of_ppat x =
match rg with match rg with
|Elem(e) -> [] |Elem(e) -> []
|Guard(e) -> [] |Guard(e) -> []
|SeqCapture(id,rg) -> [id] @ var_of_rg rg |SeqCapture(_,id,rg) -> [ident (Ns.empty,id)] @ var_of_rg rg
|Seq(r1,r2) -> var_of_rg r1 @ var_of_rg r2 |Seq(r1,r2) -> var_of_rg r1 @ var_of_rg r2
|Alt(r1,r2) -> var_of_rg r1 @ var_of_rg r2 |Alt(r1,r2) -> var_of_rg r1 @ var_of_rg r2
|Star r1 -> var_of_rg r1 |Star r1 -> var_of_rg r1
...@@ -102,7 +102,8 @@ let rec var_of_ppat x = ...@@ -102,7 +102,8 @@ let rec var_of_ppat x =
in match x with in match x with
{loc = loc ; descr = descr } {loc = loc ; descr = descr }
-> ( match descr with -> ( match descr with
|PatVar(id) -> [ident id] |PatVar(None,id) -> [ident (Ns.empty,id)]
|PatVar(Some _,_) -> []
|Internal(descr) -> [] |Internal(descr) -> []
|Or(p1,p2) -> var_of_ppat p1 @ var_of_ppat p2 |Or(p1,p2) -> var_of_ppat p1 @ var_of_ppat p2
|And(p1,p2) -> var_of_ppat p1 @ var_of_ppat p2 |And(p1,p2) -> var_of_ppat p1 @ var_of_ppat p2
...@@ -119,7 +120,7 @@ let rec var_of_ppat x = ...@@ -119,7 +120,7 @@ let rec var_of_ppat x =
| Some ppat -> var_of_ppat ppat @ accu | Some ppat -> var_of_ppat ppat @ accu
in in
List.fold_left aux [] lm