Skip to content
GitLab
Commit 193b887b authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-06-25 23:11:01 by cvscast] Starting Namespaces -- Alain 

Original author: cvscast
Date: 2003-06-25 23:11:03+00:00
parent 3b8d004b
Hide whitespace changes
Inline Side-by-side
Makefile.distrib
View file @ 193b887b
......@@ -64,7 +64,8 @@ OBJECTS = \
misc/pretty.cmo \
\
types/sortedList.cmo types/boolean.cmo types/ident.cmo \
types/intervals.cmo types/chars.cmo types/atoms.cmo types/normal.cmo \
types/intervals.cmo types/chars.cmo types/atoms.cmo \
types/normal.cmo \
types/types.cmo types/patterns.cmo types/sequence.cmo \
types/sample.cmo types/builtin_defs.cmo \
\
......
depend
View file @ 193b887b
......@@ -18,6 +18,8 @@ types/intervals.cmo: misc/q_symbol.cmo types/intervals.cmi
types/intervals.cmx: misc/q_symbol.cmo types/intervals.cmi
types/chars.cmo: misc/q_symbol.cmo types/chars.cmi
types/chars.cmx: misc/q_symbol.cmo types/chars.cmi
types/ns.cmo: misc/q_symbol.cmo misc/encodings.cmi misc/pool.cmi types/ns.cmi
types/ns.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/pool.cmx types/ns.cmi
types/atoms.cmo: misc/q_symbol.cmo misc/encodings.cmi misc/pool.cmi types/sortedList.cmi \
types/atoms.cmi
types/atoms.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/pool.cmx types/sortedList.cmx \
......@@ -92,14 +94,16 @@ typing/typed.cmo: misc/q_symbol.cmo types/ident.cmo parser/location.cmi types/pa
types/types.cmi runtime/value.cmi
typing/typed.cmx: misc/q_symbol.cmo types/ident.cmx parser/location.cmx types/patterns.cmx \
types/types.cmx runtime/value.cmx
typing/typer.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/ident.cmo \
parser/location.cmi types/patterns.cmi schema/schema_builtin.cmi \
schema/schema_types.cmi schema/schema_validator.cmi types/sequence.cmi \
misc/state.cmi typing/typed.cmo types/types.cmi typing/typer.cmi
typing/typer.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/ident.cmx \
parser/location.cmx types/patterns.cmx schema/schema_builtin.cmx \
schema/schema_types.cmx schema/schema_validator.cmx types/sequence.cmx \
misc/state.cmx typing/typed.cmx types/types.cmx typing/typer.cmi
typing/typer.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/chars.cmi \
types/ident.cmo parser/location.cmi types/patterns.cmi \
schema/schema_builtin.cmi schema/schema_types.cmi \
schema/schema_validator.cmi types/sequence.cmi misc/state.cmi \
typing/typed.cmo types/types.cmi typing/typer.cmi
typing/typer.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/chars.cmx \
types/ident.cmx parser/location.cmx types/patterns.cmx \
schema/schema_builtin.cmx schema/schema_types.cmx \
schema/schema_validator.cmx types/sequence.cmx misc/state.cmx \
typing/typed.cmx types/types.cmx typing/typer.cmi
runtime/load_xml.cmo: misc/q_symbol.cmo types/atoms.cmi misc/encodings.cmi types/ident.cmo \
parser/location.cmi runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: misc/q_symbol.cmo types/atoms.cmx misc/encodings.cmx types/ident.cmx \
......@@ -149,6 +153,7 @@ driver/webiface.cmo: misc/q_symbol.cmo driver/cduce.cmi driver/examples.cmo pars
driver/webiface.cmx: misc/q_symbol.cmo driver/cduce.cmx driver/examples.cmx parser/location.cmx \
misc/state.cmx
types/boolean.cmi: misc/q_symbol.cmo types/sortedList.cmi
types/ns.cmi: misc/q_symbol.cmo misc/encodings.cmi
types/atoms.cmi: misc/q_symbol.cmo misc/encodings.cmi
types/types.cmi: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi types/ident.cmo \
types/intervals.cmi types/sortedList.cmi
......
driver/cduce.ml
View file @ 193b887b
......@@ -39,8 +39,10 @@ let dump_env ppf =
Format.fprintf ppf "@[val %a : @[%a = %a@]@]@."
U.print (Id.value x) print_norm t print_value v
)
!eval_env
!eval_env;
Format.fprintf ppf "Namespaces:@.";
Atoms.Ns.dump_prefix_table ppf
let rec print_exn ppf = function
| Location (loc, w, exn) ->
......@@ -54,9 +56,9 @@ let rec print_exn ppf = function
Format.fprintf ppf "Multiple declaration for global value %a@."
U.print (Id.value v)
| Typer.WrongLabel (t,l) ->
Format.fprintf ppf "Wrong record selection: the label %a@."
Format.fprintf ppf "Wrong record selection; field %a "
U.print (LabelPool.value l);
Format.fprintf ppf "applied to an expression of type:@.%a@."
Format.fprintf ppf "not present in an expression of type:@.%a@."
print_norm t
| Typer.ShouldHave (t,msg) ->
Format.fprintf ppf "This expression should have type:@.%a@.%s@."
......@@ -168,6 +170,9 @@ let rec phrases ppf phs = match phs with
| { descr = Ast.SchemaDecl (name, schema) } :: rest ->
Typer.register_schema name schema;
phrases ppf rest
| { descr = Ast.Namespace (pr,ns) } :: rest ->
Typer.register_ns_prefix pr ns;
phrases ppf rest
| { descr = Ast.EvalStatement e } :: rest ->
let (fv,e) = Typer.expr e in
let t = Typer.type_check !typing_env e Types.any true in
......
misc/encodings.ml
View file @ 193b887b
......@@ -7,6 +7,7 @@ struct
let hash = Hashtbl.hash
let equal (x : t) y = x = y
let compare (x : t) y = compare x y
(* TODO: handle UTF-8 viewport *)
let to_string s =
......
misc/encodings.mli
View file @ 193b887b
......@@ -7,6 +7,7 @@ sig
val hash: t -> int
val equal: t -> t -> bool
val compare: t -> t -> int
val check: string -> bool
......
parser/ast.ml
View file @ 193b887b
......@@ -9,10 +9,11 @@ type pprog = pmodule_item list
and pmodule_item = pmodule_item' located
and pmodule_item' =
| TypeDecl of string * ppat
| TypeDecl of U.t * ppat
| SchemaDecl of string * Schema_types.schema (* name, schema *)
| LetDecl of ppat * pexpr
| FunDecl of pexpr
| Namespace of U.t * Atoms.Ns.t
| EvalStatement of pexpr
| Debug of debug_directive
| Directive of toplevel_directive
......@@ -29,6 +30,10 @@ and toplevel_directive =
]
and pconst =
| Const_internal of Types.const
| Const_atom of U.t * U.t
and pexpr =
| LocatedExpr of loc * pexpr
......@@ -41,7 +46,7 @@ and pexpr =
| Abstraction of abstr
(* Data constructors *)
| Cst of Types.const
| Cst of pconst
| Pair of pexpr * pexpr
| Xml of pexpr * pexpr
| RecordLitt of pexpr label_map
......@@ -71,10 +76,11 @@ and branches = (ppat * pexpr) list
and ppat = ppat' located
and ppat' =
| PatVar of string
| PatVar of U.t
| SchemaVar of (* type/pattern schema variable *)
schema_item_kind * string * string
| Recurs of ppat * (string * ppat) list
| AtomT of U.t * (U.t option)
| Recurs of ppat * (U.t * ppat) list
| Internal of Types.descr
| Or of ppat * ppat
| And of ppat * ppat
......@@ -85,7 +91,7 @@ and ppat' =
| Optional of ppat
| Record of bool * ppat label_map
| Capture of id
| Constant of id * Types.const
| Constant of id * pconst
| Regexp of regexp * ppat
(* regular expression, continuation: [ re ; cont ], e.g: [ re ; nil ] *)
......@@ -99,14 +105,3 @@ and regexp =
| SeqCapture of id * regexp
open Printf
(*
let rec string_of_regexp = function
| Epsilon -> "e"
| Elem _ -> "ELEM"
| Seq (re1, re2) -> sprintf "(%s),(%s)" (string_of_regexp re1) (string_of_regexp re2)
| Alt (re1, re2) -> sprintf "(%s)|(%s)" (string_of_regexp re1) (string_of_regexp re2)
| Star re -> sprintf "(%s)*" (string_of_regexp re)
| WeakStar _ -> assert false
| SeqCapture _ -> assert false
*)
parser/parser.ml
View file @ 193b887b
......@@ -7,6 +7,8 @@ open Printf
let () = Grammar.error_verbose := true
*)
exception Error of string
let error (i,j) s = Location.raise_loc i j (Error s)
let gram = Grammar.gcreate (Wlexer.lexer Wlexer.token Wlexer.latin1_engine)
......@@ -15,10 +17,19 @@ let false_atom = Atoms.mk_ascii "false"
let true_type = Types.atom (Atoms.atom true_atom)
let false_type = Types.atom (Atoms.atom false_atom)
let parse_ident = Encodings.Utf8.mk_latin1
let parse_ident = U.mk_latin1
let id_dummy = ident (U.mk "$$$")
let atom s = Atoms.mk (parse_ident s)
let split_qname s =
try
let i = String.index s ':' in
let ns = String.sub s 0 i in
let s = String.sub s (i + 1) (String.length s - i - 1) in
(parse_ident ns, parse_ident s)
with Not_found ->
(U.mk "", parse_ident s)
let label s = LabelPool.mk (parse_ident s)
let ident s = ident (parse_ident s)
......@@ -48,7 +59,7 @@ let tuple_queue =
let char = mknoloc (Internal (Types.char Chars.any))
let string_regexp = Star (Elem char)
let cst_nil = Cst (Types.Atom Sequence.nil_atom)
let cst_nil = Cst (Const_internal (Types.Atom Sequence.nil_atom))
let seq_of_string s =
let s = Encodings.Utf8.mk s in
......@@ -58,9 +69,6 @@ let seq_of_string s =
in
aux (Encodings.Utf8.start_index s) (Encodings.Utf8.end_index s)
exception Error of string
let error (i,j) s = Location.raise_loc i j (Error s)
let make_record loc r =
LabelMap.from_list (fun _ _ -> error loc "Duplicated record field") r
......@@ -97,19 +105,29 @@ EXTEND
[ l = LIST0 [ p = phrase ; OPT ";;" -> p ]; EOI -> List.flatten l ]
];
uident: [ [ x = UIDENT -> parse_ident x ] ];
phrase: [
[ (f,p,e) = let_binding ->
if f then [ mk loc (FunDecl e) ] else
[ mk loc (LetDecl (p,e)) ]
| (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
[ mk loc (EvalStatement (exp loc (Match (e1,[p,e2])))) ]
| "type"; x = UIDENT; "="; t = pat -> [ mk loc (TypeDecl (x,t)) ]
| "type"; x = uident; "="; t = pat -> [ mk loc (TypeDecl (x,t)) ]
| "type"; x = LIDENT -> error loc "Type identifiers must be capitalized"
| "schema"; name = UIDENT; "="; uri = STRING2 ->
protect_op "schema";
let schema_doc = Schema_xml.pxp_tree_of uri in
let schema = Schema_parser.parse_schema schema_doc in
[ mk loc (SchemaDecl (name, schema))]
| "namespace";
name = [ name = [ UIDENT | LIDENT | keyword ]; "=" ->
parse_ident name
| -> U.mk "" ];
uri = STRING2 ->
let ns = Atoms.Ns.mk (parse_ident uri) in
Atoms.Ns.register_prefix name ns;
[ mk loc (Namespace (name, ns)) ]
| "debug"; d = debug_directive -> [ mk loc (Debug d) ]
| DIRECTIVE "#quit" -> [ mk loc (Directive `Quit) ]
| DIRECTIVE "#env" -> [ mk loc (Directive `Env) ]
......@@ -158,7 +176,7 @@ EXTEND
| "if" | "then" | "else"
| "transform" | "fun" | "in"
| "let" | "type" | "debug" | "include"
| "and" | "validate" | "schema"
| "and" | "validate" | "schema" | "namespace"
]
-> a
]
......@@ -260,10 +278,11 @@ EXTEND
in
exp loc l
| "<"; t = [ "("; e = expr; ")" -> e
| a = [ LIDENT | UIDENT | keyword ] ->
exp loc (Cst (Types.Atom (atom a))) ];
| a = tag -> exp loc (Cst a)
];
a = expr_attrib_spec; ">"; c = expr ->
exp loc (Xml (t, Pair (a,c)))
(* let t = Pair (cst_nil, t) in *)
exp loc (Xml (t, Pair (a,c)))
| "{"; r = [ expr_record_spec | -> exp loc (RecordLitt LabelMap.empty) ]; "}" -> r
| s = STRING2 ->
let s = U.mk s in
......@@ -273,6 +292,19 @@ EXTEND
];
tag: [ [ a = [ LIDENT | UIDENT | keyword ] ->
let (ns,l) = split_qname a in Const_atom (ns,l) ] ];
tag_type: [
[ LIDENT "_" -> mk loc (Internal (Types.atom Atoms.any))
| a = [ LIDENT | UIDENT | keyword ] ->
let (ns,l) = split_qname a in
mk loc (AtomT (ns, Some l))
| t = ANY_IN_NS ->
mk loc (AtomT (parse_ident t, None))
]
];
seq_elem: [
[ x = STRING1 ->
let s = U.mk x in
......@@ -373,7 +405,7 @@ EXTEND
pat: [
[ x = pat; LIDENT "where";
b = LIST1 [ a = UIDENT; "="; y = pat -> (a,y)
b = LIST1 [ a = uident; "="; y = pat -> (a,y)
| LIDENT -> error loc "Type/pattern identifiers must be capitalized"
] SEP "and"
-> mk loc (Recurs (x,b)) ]
......@@ -399,7 +431,7 @@ EXTEND
| _ -> assert false
in
mk loc (SchemaVar (kind, schema, typ))
| a = UIDENT -> mk loc (PatVar a)
| a = uident -> mk loc (PatVar a)
| i = INT ; "--"; j = INT ->
let i = Intervals.mk i
and j = Intervals.mk j in
......@@ -417,18 +449,23 @@ EXTEND
mk loc (Internal (Types.char (Chars.char_class i i)))
| i = char ; "--"; j = char ->
mk loc (Internal (Types.char (Chars.char_class i j)))
| c = const -> mk loc (Internal (Types.constant c))
| "`"; c = tag_type -> c
| c = const ->
(match c with
| Const_atom (ns,l) -> mk loc (AtomT (ns,Some l))
| Const_internal c ->
mk loc (Internal (Types.constant c))
)
| "("; l = LIST1 pat SEP ","; ")" -> multi_prod loc l
| "["; r = [ r = regexp -> r | -> Epsilon ];
q = [ ";"; q = pat -> q
| -> mknoloc (Internal (Sequence.nil_type)) ];
"]" -> mk loc (Regexp (r,q))
| "<"; t =
[ x = [ LIDENT | UIDENT | keyword ] ->
let a = if x = "_" then Atoms.any else Atoms.atom (atom x) in
mk loc (Internal (Types.atom a))
| "("; t = pat; ")" -> t ];
[ x = tag_type -> x
| "("; t = pat; ")" -> t ];
a = attrib_spec; ">"; c = pat ->
(* let t = mk loc (Prod (mk loc (Internal Sequence.nil_type), t)) in *)
mk loc (XmlT (t, multi_prod loc [a;c]))
| s = STRING2 ->
let s =
......@@ -463,9 +500,9 @@ EXTEND
const:
[
[ i = INT -> Types.Integer (Intervals.mk i)
| "`"; a = [LIDENT | UIDENT | keyword ] -> Types.Atom (atom a)
| c = char -> Types.Char c ]
[ i = INT -> Const_internal (Types.Integer (Intervals.mk i))
| "`"; a = tag -> a
| c = char -> Const_internal (Types.Char c) ]
];
......
parser/wlexer.ml
View file @ 193b887b
......@@ -126,68 +126,67 @@ let lex_tables = {
Lexing.lex_base =
"\000\000\023\000\011\000\015\000\254\255\042\000\046\000\255\255\
\250\255\249\255\255\255\041\000\253\255\019\000\252\255\252\255\
\251\255\000\000\002\000\253\255\248\255\247\255\009\000\054\000\
\007\000\020\000\021\000\053\000\252\255\056\000\025\000\049\000\
\069\000\022\000\025\000\037\000\046\000\250\255\070\000\073\000\
\090\000\076\000\126\000\079\000";
\251\255\000\000\002\000\253\255\246\255\245\255\010\000\054\000\
\018\000\026\000\042\000\053\000\250\255\018\000\056\000\025\000\
\049\000\069\000\026\000\041\000\058\000\054\000\248\255\250\255\
\247\255\074\000\063\000\078\000\090\000\079\000\104\000\082\000\
";
Lexing.lex_backtrk =
"\255\255\255\255\255\255\255\255\255\255\001\000\255\255\255\255\
\255\255\255\255\255\255\004\000\255\255\255\255\255\255\255\255\
\255\255\004\000\004\000\255\255\255\255\255\255\000\000\001\000\
\002\000\003\000\003\000\003\000\255\255\003\000\003\000\003\000\
\003\000\003\000\003\000\003\000\003\000\255\255\002\000\004\000\
\001\000\255\255\001\000\000\000";
\004\000\005\000\005\000\005\000\255\255\005\000\005\000\005\000\
\005\000\005\000\005\000\005\000\005\000\005\000\255\255\255\255\
\255\255\004\000\255\255\006\000\001\000\255\255\001\000\000\000\
";
Lexing.lex_default =
"\028\000\016\000\009\000\004\000\000\000\255\255\255\255\000\000\
\000\000\000\000\000\000\255\255\000\000\255\255\000\000\000\000\
\000\000\255\255\255\255\000\000\000\000\000\000\255\255\255\255\
\255\255\255\255\255\255\255\255\000\000\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\000\000\255\255\255\255\
\255\255\255\255\255\255\255\255";
\255\255\255\255\255\255\255\255\255\255\255\255\000\000\000\000\
\000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
";
Lexing.lex_trans =
"\020\000\021\000\021\000\022\000\023\000\023\000\024\000\025\000\
\023\000\026\000\027\000\008\000\043\000\038\000\029\000\030\000\
\031\000\032\000\033\000\005\000\007\000\005\000\034\000\015\000\
\039\000\013\000\035\000\004\000\036\000\033\000\014\000\037\000\
\014\000\037\000\014\000\023\000\023\000\021\000\021\000\021\000\
\014\000\017\000\010\000\011\000\010\000\012\000\006\000\013\000\
\006\000\018\000\006\000\014\000\006\000\014\000\019\000\009\000\
\019\000\007\000\040\000\040\000\040\000\007\000\040\000\014\000\
\014\000\014\000\040\000\014\000\041\000\014\000\014\000\040\000\
\004\000\004\000\004\000\038\000\038\000\039\000\014\000\014\000\
\042\000\042\000\043\000\000\000\042\000\000\000\014\000\000\000\
\000\000\040\000\040\000\040\000\040\000\040\000\040\000\040\000\
\040\000\000\000\040\000\000\000\000\000\000\000\040\000\000\000\
\041\000\000\000\000\000\040\000\000\000\000\000\000\000\042\000\
\042\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\040\000\040\000\040\000\
\040\000\040\000\042\000\042\000\042\000\000\000\042\000\000\000\
\000\000\000\000\042\000\000\000\000\000\000\000\000\000\042\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\042\000\042\000\042\000\042\000\042\000";
\023\000\026\000\027\000\008\000\029\000\047\000\030\000\031\000\
\032\000\033\000\034\000\005\000\007\000\005\000\035\000\015\000\
\041\000\013\000\036\000\004\000\037\000\034\000\043\000\038\000\
\042\000\038\000\014\000\023\000\023\000\021\000\021\000\021\000\
\039\000\017\000\010\000\011\000\010\000\012\000\006\000\013\000\
\006\000\018\000\006\000\039\000\006\000\039\000\019\000\039\000\
\019\000\007\000\044\000\044\000\044\000\007\000\044\000\039\000\
\039\000\039\000\044\000\039\000\045\000\039\000\039\000\044\000\
\004\000\004\000\004\000\041\000\040\000\039\000\039\000\039\000\
\041\000\014\000\043\000\046\000\046\000\047\000\039\000\046\000\
\000\000\044\000\044\000\044\000\044\000\044\000\044\000\044\000\
\044\000\012\000\044\000\000\000\000\000\000\000\044\000\000\000\
\045\000\000\000\000\000\044\000\046\000\046\000\046\000\000\000\
\046\000\000\000\046\000\046\000\046\000\000\000\000\000\000\000\
\000\000\046\000\000\000\000\000\000\000\044\000\044\000\044\000\
\044\000\044\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\046\000\046\000\046\000\046\000\046\000\
";
Lexing.lex_check =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\002\000\022\000\024\000\000\000\000\000\
\000\000\000\000\000\000\002\000\000\000\022\000\000\000\000\000\
\000\000\000\000\000\000\003\000\018\000\003\000\000\000\001\000\
\025\000\013\000\000\000\017\000\000\000\000\000\026\000\000\000\
\026\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\
\030\000\001\000\002\000\002\000\002\000\011\000\005\000\011\000\
\005\000\001\000\006\000\033\000\006\000\034\000\001\000\035\000\
\024\000\013\000\000\000\017\000\000\000\000\000\025\000\000\000\
\029\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\
\031\000\001\000\002\000\002\000\002\000\011\000\005\000\011\000\
\005\000\001\000\006\000\026\000\006\000\026\000\001\000\034\000\
\001\000\005\000\023\000\023\000\023\000\006\000\023\000\027\000\
\027\000\031\000\023\000\029\000\023\000\036\000\029\000\023\000\
\011\000\011\000\011\000\032\000\038\000\039\000\031\000\032\000\
\041\000\041\000\043\000\255\255\041\000\255\255\032\000\255\255\
\255\255\023\000\023\000\023\000\023\000\023\000\040\000\040\000\
\040\000\255\255\040\000\255\255\255\255\255\255\040\000\255\255\
\040\000\255\255\255\255\040\000\255\255\255\255\255\255\041\000\
\041\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\040\000\040\000\040\000\
\040\000\040\000\042\000\042\000\042\000\255\255\042\000\255\255\
\255\255\255\255\042\000\255\255\255\255\255\255\255\255\042\000\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\042\000\042\000\042\000\042\000\042\000"
\027\000\032\000\023\000\030\000\023\000\035\000\030\000\023\000\
\011\000\011\000\011\000\033\000\036\000\037\000\032\000\033\000\
\041\000\042\000\043\000\045\000\045\000\047\000\033\000\045\000\
\255\255\023\000\023\000\023\000\023\000\023\000\044\000\044\000\
\044\000\045\000\044\000\255\255\255\255\255\255\044\000\255\255\
\044\000\255\255\255\255\044\000\046\000\046\000\046\000\255\255\
\046\000\255\255\045\000\045\000\046\000\255\255\255\255\255\255\
\255\255\046\000\255\255\255\255\255\255\044\000\044\000\044\000\
\044\000\044\000\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\046\000\046\000\046\000\046\000\046\000\
"
}
let rec token engine lexbuf =
......@@ -205,15 +204,25 @@ let rec token engine lexbuf =
)
| 2 -> (
# 87 "parser/wlexer.mll"
"INT",Lexing.lexeme lexbuf )
let s = Lexing.lexeme lexbuf in
let s = String.sub s 0 (String.length s - 2) in
"ANY_IN_NS", s
)
| 3 -> (
# 92 "parser/wlexer.mll"
"",Lexing.lexeme lexbuf )
"ANY_IN_NS", "" )
| 4 -> (
# 93 "parser/wlexer.mll"
"DIRECTIVE",Lexing.lexeme lexbuf )
# 94 "parser/wlexer.mll"
"INT",Lexing.lexeme lexbuf )
| 5 -> (
# 95 "parser/wlexer.mll"
# 99 "parser/wlexer.mll"
"",Lexing.lexeme lexbuf )
| 6 -> (
# 100 "parser/wlexer.mll"
"DIRECTIVE",Lexing.lexeme lexbuf )
| 7 -> (
# 102 "parser/wlexer.mll"
let string_start = Lexing.lexeme_start lexbuf in
string_start_pos := string_start;
let double_quote = Lexing.lexeme_char lexbuf 0 = '"' in
......@@ -222,18 +231,18 @@ let rec token engine lexbuf =
string_start - lexbuf.Lexing.lex_abs_pos;
(if double_quote then "STRING2" else "STRING1"),
(get_stored_string()) )
| 6 -> (
# 105 "parser/wlexer.mll"
| 8 -> (
# 112 "parser/wlexer.mll"
comment_start_pos := [Lexing.lexeme_start lexbuf];
in_comment := true;
comment engine lexbuf;
in_comment := false;
token engine lexbuf )
| 7 -> (
# 112 "parser/wlexer.mll"
| 9 -> (
# 119 "parser/wlexer.mll"
"EOI","" )
| 8 -> (
# 114 "parser/wlexer.mll"
| 10 -> (
# 121 "parser/wlexer.mll"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character ((Lexing.lexeme lexbuf).[0])) )
......@@ -242,17 +251,17 @@ let rec token engine lexbuf =
and comment engine lexbuf =
match engine lex_tables 1 lexbuf with
0 -> (
# 120 "parser/wlexer.mll"
# 127 "parser/wlexer.mll"
comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
comment engine lexbuf;
)
| 1 -> (
# 124 "parser/wlexer.mll"
# 131 "parser/wlexer.mll"
comment_start_pos := List.tl !comment_start_pos;
if !comment_start_pos <> [] then comment engine lexbuf;
)
| 2 -> (
# 128 "parser/wlexer.mll"
# 135 "parser/wlexer.mll"
string_start_pos := Lexing.lexeme_start lexbuf;
Buffer.clear string_buff;
let ender = Lexing.lexeme lexbuf in
......@@ -263,48 +272,48 @@ and comment engine lexbuf =
Buffer.clear string_buff;
comment engine lexbuf )
| 3 -> (
# 138 "parser/wlexer.mll"
# 145 "parser/wlexer.mll"
let st = List.hd !comment_start_pos in
error st (st+2) Unterminated_comment
)
| 4 -> (
# 142 "parser/wlexer.mll"
# 149 "parser/wlexer.mll"
comment engine lexbuf )
| _ -> failwith "lexing: empty token [comment]"
and string ender engine lexbuf =
match engine lex_tables 2 lexbuf with
0 -> (
# 146 "parser/wlexer.mll"
# 153 "parser/wlexer.mll"
let c = Lexing.lexeme lexbuf in
if c = ender then ()
else (store_char (Lexing.lexeme lexbuf);
string ender engine lexbuf) )
| 1 -> (
# 151 "parser/wlexer.mll"
# 158 "parser/wlexer.mll"
store_ascii (Lexing.lexeme_char lexbuf 1);
string ender engine lexbuf )
| 2 -> (
# 154 "parser/wlexer.mll"
# 161 "parser/wlexer.mll"
let c = Lexing.lexeme_char lexbuf 1 in
if c = 'x'
then parse_hexa_char engine lexbuf
else store_special c;
string ender engine lexbuf )
| 3 -> (
# 160 "parser/wlexer.mll"
# 167 "parser/wlexer.mll"
store_code (decimal_char (Lexing.lexeme lexbuf));
string ender engine lexbuf )
| 4 -> (
# 163 "parser/wlexer.mll"
# 170 "parser/wlexer.mll"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '\\') )
| 5 -> (
# 167 "parser/wlexer.mll"
# 174 "parser/wlexer.mll"
error !string_start_pos (!string_start_pos+1) Unterminated_string )
| 6 -> (
# 169 "parser/wlexer.mll"
# 176 "parser/wlexer.mll"
store_code (Char.code (Lexing.lexeme_char lexbuf 0));
(* Adapt when source is UTF8 *)
string ender engine lexbuf )
......@@ -313,10 +322,10 @@ and string ender engine lexbuf =
and parse_hexa_char engine lexbuf =
match engine lex_tables 3 lexbuf with
0 -> (
# 175 "parser/wlexer.mll"
# 182 "parser/wlexer.mll"
store_code (hexa_char (Lexing.lexeme lexbuf)) )
| 1 -> (
# 177 "parser/wlexer.mll"
# 184 "parser/wlexer.mll"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '\\') )
......@@ -324,7 +333,7 @@ and parse_hexa_char engine lexbuf =
;;
# 183 "parser/wlexer.mll"