Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
193b887b
Commit
193b887b
authored
Oct 05, 2007
by
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
Changes
21
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
p
const
|
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
*
p
const
|
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\0
22
\000\02
4
\000\000\000\000\000
\
\000\000\000\000\000\000\002\000\0
00
\000\02
2
\000\000\000\000\000
\
\000\000\000\000\000\000\003\000\018\000\003\000\000\000\001\000
\
\02
5
\000\013\000\000\000\017\000\000\000\000\000\02
6
\000\000\000
\
\02
6
\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000
\
\03
0
\000\001\000\002\000\002\000\002\000\011\000\005\000\011\000
\
\005\000\001\000\006\000\0
33
\000\006\000\0
34
\000\001\000\03
5
\000
\
\02
4
\000\013\000\000\000\017\000\000\000\000\000\02
5
\000\000\000
\
\02
9
\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000
\
\03
1
\000\001\000\002\000\002\000\002\000\011\000\005\000\011\000
\
\005\000\001\000\006\000\0
26
\000\006\000\0
26
\000\001\000\03
4
\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
->
(
#
9
3
"parser/wlexer.mll"
"DIRECTIVE
"
,
Lexing
.
lexeme
lexbuf
)
#
9
4
"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
-> (
# 1
05
"
parser
/
wlexer
.
mll
"
|
8
-> (
# 1
12
"
parser
/
wlexer
.
mll
"
comment_start_pos := [Lexing.lexeme_start lexbuf];
in_comment := true;
comment engine lexbuf;
in_comment := false;
token engine lexbuf )
|
7
-> (
# 11
2
"
parser
/
wlexer
.
mll
"
|
9
-> (
# 11
9
"
parser
/
wlexer
.
mll
"
"
EOI
","" )
|
8
-> (
# 11
4
"
parser
/
wlexer
.
mll
"
|
10
-> (
# 1
2
1 "
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 -> (
# 12
0
"
parser
/
wlexer
.
mll
"
# 12
7
"
parser
/
wlexer
.
mll
"
comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
comment engine lexbuf;
)
| 1 -> (
# 1
24
"
parser
/
wlexer
.
mll
"
# 1
31
"
parser
/
wlexer
.
mll
"
comment_start_pos := List.tl !comment_start_pos;
if !comment_start_pos <> [] then comment engine lexbuf;
)
| 2 -> (
# 1
28
"
parser
/
wlexer
.
mll
"
# 1
35
"
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 -> (
# 1
38
"
parser
/
wlexer
.
mll
"
# 1
45
"
parser
/
wlexer
.
mll
"
let st = List.hd !comment_start_pos in
error st (st+2) Unterminated_comment
)
| 4 -> (
# 14
2
"
parser
/
wlexer
.
mll
"
# 14
9
"
parser
/
wlexer
.
mll
"
comment engine lexbuf )
| _ -> failwith "
lexing
:
empty
token
[
comment
]
"
and string ender engine lexbuf =
match engine lex_tables 2 lexbuf with
0 -> (
# 1
46
"
parser
/
wlexer
.
mll
"
# 1
53
"
parser
/
wlexer
.
mll
"
let c = Lexing.lexeme lexbuf in
if c = ender then ()
else (store_char (Lexing.lexeme lexbuf);
string ender engine lexbuf) )
| 1 -> (
# 15
1
"
parser
/
wlexer
.
mll
"
# 15
8
"
parser
/
wlexer
.
mll
"
store_ascii (Lexing.lexeme_char lexbuf 1);
string ender engine lexbuf )
| 2 -> (
# 1
54
"
parser
/
wlexer
.
mll
"
# 1
61
"
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 -> (
# 16
0
"
parser
/
wlexer
.
mll
"
# 16
7
"
parser
/
wlexer
.
mll
"
store_code (decimal_char (Lexing.lexeme lexbuf));
string ender engine lexbuf )
| 4 -> (
# 1
63
"
parser
/
wlexer
.
mll
"
# 1
70
"
parser
/
wlexer
.
mll
"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '
\\
') )
| 5 -> (
# 1
6
7 "
parser
/
wlexer
.
mll
"
# 17
4
"
parser
/
wlexer
.
mll
"
error !string_start_pos (!string_start_pos+1) Unterminated_string )
| 6 -> (
# 16
9
"
parser
/
wlexer
.
mll
"
# 1
7
6 "
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 -> (
# 1
75
"
parser
/
wlexer
.
mll
"
# 1
82
"
parser
/
wlexer
.
mll
"
store_code (hexa_char (Lexing.lexeme lexbuf)) )
| 1 -> (
# 1
77
"
parser
/
wlexer
.
mll
"
# 1
84
"
parser
/
wlexer
.
mll
"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '
\\
') )
...
...
@@ -324,7 +333,7 @@ and parse_hexa_char engine lexbuf =
;;
# 1
83
"
parser
/
wlexer
.
mll
"