Skip to content
GitLab
Menu
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
15f78be4
Commit
15f78be4
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2003-03-14 16:14:17 by cvscast] Empty log message
Original author: cvscast Date: 2003-03-14 16:15:14+00:00
parent
35a2f963
Changes
19
Expand all
Hide whitespace changes
Inline
Side-by-side
depend
View file @
15f78be4
...
...
@@ -8,18 +8,18 @@ parser/ast.cmo: types/ident.cmo parser/location.cmi types/types.cmi
parser/ast.cmx: types/ident.cmx parser/location.cmx types/types.cmx
parser/location.cmo: parser/location.cmi
parser/location.cmx: parser/location.cmi
parser/parser.cmo: parser/ast.cmo types/atoms.cmi types/
chars
.cm
i
\
types/ident.cmo types/intervals.cmi parser/location.cmi \
parser/parser.cmo: parser/ast.cmo types/atoms.cmi types/
builtin
.cm
o
\
types/chars.cmi
types/ident.cmo types/intervals.cmi parser/location.cmi \
types/sequence.cmi types/types.cmi parser/wlexer.cmo parser/parser.cmi
parser/parser.cmx: parser/ast.cmx types/atoms.cmx types/
chars
.cmx \
types/ident.cmx types/intervals.cmx parser/location.cmx \
parser/parser.cmx: parser/ast.cmx types/atoms.cmx types/
builtin
.cmx \
types/chars.cmx
types/ident.cmx types/intervals.cmx parser/location.cmx \
types/sequence.cmx types/types.cmx parser/wlexer.cmx parser/parser.cmi
parser/wlexer.cmo: parser/location.cmi
parser/wlexer.cmx: parser/location.cmx
typing/typed.cmo: types/ident.cmo parser/location.cmi types/patterns.cmi \
types/sortedMap.cmi
types/types.cmi
types/types.cmi
typing/typed.cmx: types/ident.cmx parser/location.cmx types/patterns.cmx \
types/sortedMap.cmx
types/types.cmx
types/types.cmx
typing/typer.cmo: parser/ast.cmo types/builtin.cmo types/ident.cmo \
types/intervals.cmi parser/location.cmi types/patterns.cmi \
types/sequence.cmi typing/typed.cmo types/types.cmi typing/typer.cmi
...
...
@@ -59,11 +59,11 @@ types/sortedMap.cmx: types/sortedMap.cmi
types/type_bool.cmo: types/boolean.cmi types/recursive.cmo
types/type_bool.cmx: types/boolean.cmx types/recursive.cmx
types/types.cmo: types/atoms.cmi types/boolean.cmi types/chars.cmi \
types/intervals.cmi types/normal.cmi
misc/pool.cmi
types/recursive.cmo \
types/sortedList.cmi
types/sortedMap.cmi
misc/state.cmi types/types.cmi
types/ident.cmo
types/intervals.cmi types/normal.cmi types/recursive.cmo \
types/sortedList.cmi misc/state.cmi types/types.cmi
types/types.cmx: types/atoms.cmx types/boolean.cmx types/chars.cmx \
types/intervals.cmx types/normal.cmx
misc/pool.cmx
types/recursive.cmx \
types/sortedList.cmx
types/sortedMap.cmx
misc/state.cmx types/types.cmi
types/ident.cmx
types/intervals.cmx types/normal.cmx types/recursive.cmx \
types/sortedList.cmx misc/state.cmx types/types.cmi
runtime/eval.cmo: types/atoms.cmi types/ident.cmo types/intervals.cmi \
runtime/load_xml.cmi parser/location.cmi runtime/print_xml.cmo \
runtime/run_dispatch.cmi misc/state.cmi typing/typed.cmo \
...
...
@@ -72,22 +72,24 @@ runtime/eval.cmx: types/atoms.cmx types/ident.cmx types/intervals.cmx \
runtime/load_xml.cmx parser/location.cmx runtime/print_xml.cmx \
runtime/run_dispatch.cmx misc/state.cmx typing/typed.cmx \
runtime/value.cmx runtime/eval.cmi
runtime/load_xml.cmo: types/atoms.cmi parser/location.cmi types/sortedMap.cmi \
types/types.cmi runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: types/atoms.cmx parser/location.cmx types/sortedMap.cmx \
types/types.cmx runtime/value.cmx runtime/load_xml.cmi
runtime/print_xml.cmo: types/atoms.cmi types/chars.cmi types/sequence.cmi \
types/types.cmi runtime/value.cmi
runtime/print_xml.cmx: types/atoms.cmx types/chars.cmx types/sequence.cmx \
types/types.cmx runtime/value.cmx
runtime/run_dispatch.cmo: types/patterns.cmi types/types.cmi \
runtime/value.cmi runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/patterns.cmx types/types.cmx \
runtime/value.cmx runtime/run_dispatch.cmi
runtime/value.cmo: types/atoms.cmi types/chars.cmi types/intervals.cmi \
types/sequence.cmi types/sortedMap.cmi types/types.cmi runtime/value.cmi
runtime/value.cmx: types/atoms.cmx types/chars.cmx types/intervals.cmx \
types/sequence.cmx types/sortedMap.cmx types/types.cmx runtime/value.cmi
runtime/load_xml.cmo: types/atoms.cmi types/ident.cmo parser/location.cmi \
runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: types/atoms.cmx types/ident.cmx parser/location.cmx \
runtime/value.cmx runtime/load_xml.cmi
runtime/print_xml.cmo: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/sequence.cmi runtime/value.cmi
runtime/print_xml.cmx: types/atoms.cmx types/chars.cmx types/ident.cmx \
types/sequence.cmx runtime/value.cmx
runtime/run_dispatch.cmo: types/chars.cmi types/ident.cmo types/patterns.cmi \
types/types.cmi runtime/value.cmi runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/chars.cmx types/ident.cmx types/patterns.cmx \
types/types.cmx runtime/value.cmx runtime/run_dispatch.cmi
runtime/value.cmo: types/atoms.cmi types/builtin.cmo types/chars.cmi \
types/ident.cmo types/intervals.cmi types/sequence.cmi types/types.cmi \
runtime/value.cmi
runtime/value.cmx: types/atoms.cmx types/builtin.cmx types/chars.cmx \
types/ident.cmx types/intervals.cmx types/sequence.cmx types/types.cmx \
runtime/value.cmi
driver/cduce.cmo: parser/ast.cmo types/builtin.cmo runtime/eval.cmi \
types/ident.cmo parser/location.cmi parser/parser.cmi types/patterns.cmi \
misc/state.cmi typing/typed.cmo typing/typer.cmi types/types.cmi \
...
...
@@ -110,16 +112,15 @@ parser/parser.cmi: parser/ast.cmo
typing/typer.cmi: parser/ast.cmo types/ident.cmo typing/typed.cmo \
types/types.cmi
types/boolean.cmi: types/sortedList.cmi
types/normal.cmi: types/boolean.cmi
types/patterns.cmi: types/ident.cmo types/types.cmi
types/sequence.cmi: types/atoms.cmi types/types.cmi
types/sortedMap.cmi: types/sortedList.cmi
types/syntax.cmi: types/patterns.cmi types/types.cmi
types/types.cmi: types/atoms.cmi types/chars.cmi types/int
ervals
.cm
i
\
misc/pool.cmi types/sortedMap
.cmi
types/types.cmi: types/atoms.cmi types/chars.cmi types/i
de
nt.cm
o
\
types/intervals
.cmi
runtime/eval.cmi: types/ident.cmo typing/typed.cmo runtime/value.cmi
runtime/load_xml.cmi: runtime/value.cmi
runtime/run_dispatch.cmi: types/patterns.cmi runtime/value.cmi
runtime/value.cmi: types/atoms.cmi types/chars.cmi types/int
ervals
.cm
i
\
types/
sortedMap
.cmi types/types.cmi
runtime/value.cmi: types/atoms.cmi types/chars.cmi types/i
de
nt.cm
o
\
types/
intervals
.cmi types/types.cmi
driver/cduce.cmi: runtime/eval.cmi typing/typer.cmi
parser/parser.ml
View file @
15f78be4
...
...
@@ -97,6 +97,10 @@ EXTEND
mk
noloc
(
Op
(
"raise"
,
[
mk
noloc
(
Var
(
ident
"x"
))])))
in
mk
loc
(
Try
(
e
,
b
@
[
default
]))
|
"map"
;
e
=
SELF
;
"with"
;
b
=
branches
->
mk
loc
(
Map
(
e
,
b
))
|
"if"
;
e
=
SELF
;
"then"
;
e1
=
SELF
;
"else"
;
e2
=
SELF
->
let
p1
=
mk
loc
(
Internal
(
Builtin
.
true_type
))
and
p2
=
mk
loc
(
Internal
(
Builtin
.
false_type
))
in
mk
loc
(
Match
(
e
,
[
p1
,
e1
;
p2
,
e2
]))
|
"transform"
;
e
=
SELF
;
"with"
;
b
=
branches
->
let
default
=
mk
noloc
(
Capture
(
ident
"x"
))
,
cst_nil
in
mk
loc
(
Op
(
"flatten"
,
[
mk
loc
(
Map
(
e
,
b
@
[
default
]))]))
...
...
@@ -109,6 +113,15 @@ EXTEND
]
|
[
e1
=
expr
;
op
=
[
"="
|
"<="
|
"<<"
|
">>"
|
">="
];
e2
=
expr
->
let
op
=
match
op
with
|
"<<"
->
"<"
|
">>"
->
">"
|
s
->
s
in
mk
loc
(
Op
(
op
,
[
e1
;
e2
]))
]
|
[
e1
=
expr
;
op
=
[
"+"
|
"-"
|
"@"
];
e2
=
expr
->
mk
loc
(
Op
(
op
,
[
e1
;
e2
]))
]
...
...
parser/wlexer.ml
View file @
15f78be4
...
...
@@ -75,6 +75,7 @@ let nb_classes = 34
exception
Unterminated_string
exception
Unterminated_string_in_comment
(* Buffer for string literals *)
let
string_buff
=
Buffer
.
create
1024
...
...
@@ -83,6 +84,11 @@ let nb_classes = 34
let
s
=
Buffer
.
contents
string_buff
in
Buffer
.
clear
string_buff
;
s
let
store_special
=
function
|
'
n'
->
store_char
'\n'
|
'
r'
->
store_char
'\r'
|
'
t'
->
store_char
'\t'
|
c
->
raise
(
Illegal_character
'\\'
)
let
string_start_pos
=
ref
0
;;
let
comment_start_pos
:
int
list
ref
=
ref
[]
;;
...
...
@@ -100,102 +106,107 @@ let nb_classes = 34
let
lex_tables
=
{
Lexing
.
lex_base
=
"
\000\000\009\000\012\000\018\000\252\255\251\255\004\000\255\255
\
\005\000\254\255\014\000\013\000\003\000\005\000\253\255\255\255
\
\247\255\246\255\020\000\047\000\051\000\018\000\043\000\250\255
\
\027\000\017\000\044\000\052\000\005\000\011\000\045\000\043\000
\
\249\255\250\255\248\255\066\000\069\000\082\000\086\000\060\000
\
\090\000\103\000\120\000\124\000\137\000\141\000\074\000
"
;
"
\000\000\012\000\010\000\018\000\251\255\250\255\016\000\255\255
\
\253\255\005\000\254\255\027\000\013\000\252\255\251\255\000\000
\
\006\000\253\255\255\255\247\255\246\255\021\000\047\000\060\000
\
\028\000\067\000\026\000\250\255\033\000\024\000\040\000\053\000
\
\011\000\018\000\039\000\037\000\249\255\248\255\077\000\080\000
\
\084\000\097\000\055\000\101\000\114\000\118\000\131\000\135\000
\
\148\000\071\000
"
;
Lexing
.
lex_backtrk
=
"
\255\255\255\255\255\255\255\255\255\255\255\255\004\000\255\255
\
\002\000\255\255\004\000\002\000\004\000\004\000\255\255\255\255
\
\255\255\255\255\000\000\001\000\002\000\003\000\005\000\255\255
\
\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000
\
\255\255\255\255\255\255\255\255\004\000\255\255\004\000\003\000
\
\002\000\255\255\002\000\001\000\255\255\001\000\000\000
"
;
"
\255\255\255\255\255\255\255\255\255\255\255\255\005\000\255\255
\
\255\255\003\000\255\255\005\000\003\000\255\255\255\255\004\000
\
\004\000\255\255\255\255\255\255\255\255\000\000\001\000\002\000
\
\003\000\005\000\005\000\255\255\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\004\000\003\000\002\000\255\255\002\000\001\000\255\255
\
\001\000\000\000
"
;
Lexing
.
lex_default
=
"
\023\000\005\000\005\000\005\000\000\000\000\000\255\255\000\000
\
\255\255\000\000\255\255\255\255\255\255\255\255\000\000\000\000
\
\000\000\000\000\255\255\255\255\255\255\255\255\255\255\000\000
\
"
\027\000\014\000\005\000\005\000\000\000\000\000\255\255\000\000
\
\000\000\255\255\000\000\255\255\255\255\000\000\000\000\255\255
\
\255\255\000\000\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\000\000\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\255\255\255\255\255\255\255\255\255\255
"
;
\255\255\255\255
"
;
Lexing
.
lex_trans
=
"
\016\000\017\000\017\000\018\000\019\000\020\000\021\000\019\000
\
\022\000\004\000\008\000\008\000\004\000\024\000\025\000\026\000
\
\027\000\028\000\004\000\011\000\011\000\029\000\015\000\046\000
\
\039\000\030\000\012\000\031\000\028\000\009\000\032\000\033\000
\
\032\000\033\000\013\000\009\000\009\000\033\000\033\000\014\000
\
\033\000\014\000\007\000\010\000\009\000\009\000\035\000\036\000
\
\036\000\006\000\007\000\043\000\043\000\043\000\043\000\040\000
\
\040\000\040\000\040\000\033\000\044\000\033\000\034\000\043\000
\
\041\000\033\000\039\000\040\000\033\000\035\000\036\000\036\000
\
\033\000\036\000\036\000\036\000\036\000\046\000\000\000\043\000
\
\000\000\000\000\037\000\040\000\000\000\036\000\038\000\038\000
\
\038\000\038\000\038\000\038\000\038\000\038\000\040\000\040\000
\
\040\000\040\000\038\000\037\000\000\000\036\000\038\000\041\000
\
\000\000\000\000\040\000\042\000\042\000\042\000\042\000\000\000
\
\000\000\000\000\038\000\000\000\000\000\000\000\038\000\042\000
\
\000\000\000\000\040\000\000\000\042\000\042\000\042\000\042\000
\
\043\000\043\000\043\000\043\000\000\000\041\000\000\000\042\000
\
\042\000\044\000\000\000\000\000\043\000\045\000\045\000\045\000
\
\045\000\045\000\045\000\045\000\045\000\000\000\000\000\000\000
\
\042\000\045\000\044\000\000\000\043\000\045\000\000\000\000\000
\
"
\019\000\020\000\020\000\021\000\022\000\023\000\024\000\022\000
\
\025\000\026\000\004\000\009\000\013\000\028\000\029\000\030\000
\
\031\000\032\000\004\000\012\000\008\000\033\000\009\000\018\000
\
\049\000\034\000\010\000\035\000\032\000\015\000\036\000\008\000
\
\036\000\012\000\042\000\005\000\005\000\016\000\005\000\005\000
\
\007\000\011\000\017\000\005\000\017\000\005\000\005\000\010\000
\
\010\000\006\000\007\000\046\000\046\000\046\000\046\000\005\000
\
\037\000\010\000\010\000\005\000\047\000\042\000\005\000\046\000
\
\043\000\043\000\043\000\043\000\005\000\005\000\038\000\039\000
\
\039\000\044\000\049\000\005\000\043\000\005\000\000\000\046\000
\
\038\000\039\000\039\000\000\000\039\000\039\000\039\000\039\000
\
\041\000\041\000\041\000\041\000\043\000\040\000\000\000\000\000
\
\039\000\000\000\000\000\000\000\041\000\041\000\041\000\041\000
\
\041\000\043\000\043\000\043\000\043\000\000\000\040\000\000\000
\
\039\000\041\000\044\000\000\000\041\000\043\000\045\000\045\000
\
\045\000\045\000\045\000\045\000\045\000\045\000\000\000\000\000
\
\000\000\041\000\045\000\044\000\000\000\043\000\045\000\046\000
\
\046\000\046\000\046\000\048\000\048\000\048\000\048\000\000\000
\
\047\000\000\000\045\000\046\000\000\000\000\000\045\000\048\000
\
\048\000\048\000\048\000\048\000\000\000\000\000\000\000\000\000
\
\000\000\047\000\000\000\046\000\048\000\000\000\000\000\048\000
\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
\
\000\000\
045\000\
000\000\000\000\000\000\04
5
\000\000\000
"
;
\000\000\000\000\000\000\000\000\04
8
\000\000\000
"
;
Lexing
.
lex_check
=
"
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
\
\000\000\001\000\006\000\008\000\002\000\000\000\000\000\000\000
\
\000\000\000\000\003\000\011\000\010\000\000\000\013\000\018\000
\
\021\000\000\000\001\000\000\000\000\000\012\000\000\000\025\000
\
\000\000\028\000\001\000\006\000\006\000\024\000\029\000\001\000
\
\024\000\001\000\002\000\002\000\010\000\010\000\022\000\022\000
\
\022\000\003\000\003\000\019\000\019\000\019\000\019\000\020\000
\
\020\000\020\000\020\000\026\000\019\000\027\000\030\000\019\000
\
\020\000\031\000\039\000\020\000\027\000\035\000\035\000\035\000
\
\026\000\036\000\036\000\036\000\036\000\046\000\255\255\019\000
\
\255\255\255\255\036\000\020\000\255\255\036\000\037\000\037\000
\
\037\000\037\000\038\000\038\000\038\000\038\000\040\000\040\000
\
\040\000\040\000\037\000\038\000\255\255\036\000\038\000\040\000
\
\255\255\255\255\040\000\041\000\041\000\041\000\041\000\255\255
\
\255\255\255\255\037\000\255\255\255\255\255\255\038\000\041\000
\
\255\255\255\255\040\000\255\255\042\000\042\000\042\000\042\000
\
\043\000\043\000\043\000\043\000\255\255\042\000\255\255\041\000
\
\042\000\043\000\255\255\255\255\043\000\044\000\044\000\044\000
\
\044\000\045\000\045\000\045\000\045\000\255\255\255\255\255\255
\
\042\000\044\000\045\000\255\255\043\000\045\000\255\255\255\255
\
\000\000\000\000\002\000\009\000\001\000\000\000\000\000\000\000
\
\000\000\000\000\003\000\012\000\006\000\000\000\006\000\016\000
\
\021\000\000\000\015\000\000\000\000\000\001\000\000\000\011\000
\
\000\000\011\000\024\000\026\000\026\000\001\000\029\000\032\000
\
\002\000\002\000\001\000\028\000\001\000\033\000\028\000\006\000
\
\006\000\003\000\003\000\022\000\022\000\022\000\022\000\030\000
\
\034\000\011\000\011\000\035\000\022\000\042\000\031\000\022\000
\
\023\000\023\000\023\000\023\000\030\000\031\000\025\000\025\000
\
\025\000\023\000\049\000\025\000\023\000\025\000\255\255\022\000
\
\038\000\038\000\038\000\255\255\039\000\039\000\039\000\039\000
\
\040\000\040\000\040\000\040\000\023\000\039\000\255\255\255\255
\
\039\000\255\255\255\255\255\255\040\000\041\000\041\000\041\000
\
\041\000\043\000\043\000\043\000\043\000\255\255\041\000\255\255
\
\039\000\041\000\043\000\255\255\040\000\043\000\044\000\044\000
\
\044\000\044\000\045\000\045\000\045\000\045\000\255\255\255\255
\
\255\255\041\000\044\000\045\000\255\255\043\000\045\000\046\000
\
\046\000\046\000\046\000\047\000\047\000\047\000\047\000\255\255
\
\046\000\255\255\044\000\046\000\255\255\255\255\045\000\047\000
\
\048\000\048\000\048\000\048\000\255\255\255\255\255\255\255\255
\
\255\255\048\000\255\255\046\000\048\000\255\255\255\255\047\000
\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
\
\255\255\
044\000\
255\255\255\255\255\255\04
5
\000\255\255
"
\255\255\255\255\255\255\255\255\04
8
\000\255\255
"
}
let
rec
token
engine
lexbuf
=
match
engine
lex_tables
0
lexbuf
with
0
->
(
#
5
1
"parser/wlexer.mll"
#
5
7
"parser/wlexer.mll"
token
engine
lexbuf
)
|
1
->
(
#
5
2
"parser/wlexer.mll"
#
5
8
"parser/wlexer.mll"
let
s
=
Lexing
.
lexeme
lexbuf
in
if
Hashtbl
.
mem
keywords
s
then
""
,
s
else
"LIDENT"
,
s
)
|
2
->
(
#
5
6
"parser/wlexer.mll"
#
6
2
"parser/wlexer.mll"
"UIDENT"
,
Lexing
.
lexeme
lexbuf
)
|
3
->
(
#
57
"parser/wlexer.mll"
#
63
"parser/wlexer.mll"
"INT"
,
Lexing
.
lexeme
lexbuf
)
|
4
->
(
#
58
"parser/wlexer.mll"
#
64
"parser/wlexer.mll"
let
s
=
Lexing
.
lexeme
lexbuf
in
"TAG"
,
tag_of_tag
s
1
)
|
5
->
(
#
66
"parser/wlexer.mll"
#
72
"parser/wlexer.mll"
""
,
Lexing
.
lexeme
lexbuf
)
|
6
->
(
#
69
"parser/wlexer.mll"
#
75
"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
...
...
@@ -205,15 +216,15 @@ let rec token engine lexbuf =
(if double_quote then "
STRING2
" else "
STRING1
"),
(get_stored_string()) )
| 7 -> (
#
79
"
parser
/
wlexer
.
mll
"
#
85
"
parser
/
wlexer
.
mll
"
comment_start_pos := [Lexing.lexeme_start lexbuf];
comment engine lexbuf;
token engine lexbuf )
| 8 -> (
#
84
"
parser
/
wlexer
.
mll
"
#
90
"
parser
/
wlexer
.
mll
"
"
EOI
","" )
| 9 -> (
#
86
"
parser
/
wlexer
.
mll
"
#
92
"
parser
/
wlexer
.
mll
"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character ((Lexing.lexeme lexbuf).[0])) )
...
...
@@ -222,17 +233,17 @@ let rec token engine lexbuf =
and comment engine lexbuf =
match engine lex_tables 1 lexbuf with
0 -> (
# 9
2
"
parser
/
wlexer
.
mll
"
# 9
8
"
parser
/
wlexer
.
mll
"
comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
comment engine lexbuf;
)
| 1 -> (
#
96
"
parser
/
wlexer
.
mll
"
#
102
"
parser
/
wlexer
.
mll
"
comment_start_pos := List.tl !comment_start_pos;
if !comment_start_pos <> [] then comment engine lexbuf;
)
| 2 -> (
# 10
0
"
parser
/
wlexer
.
mll
"
# 10
6
"
parser
/
wlexer
.
mll
"
string_start_pos := Lexing.lexeme_start lexbuf;
let string =
if Lexing.lexeme_char lexbuf 0 = '"
'
then
string2
else
string1
in
...
...
@@ -243,33 +254,38 @@ and comment engine lexbuf =
Buffer
.
clear
string_buff
;
comment
engine
lexbuf
)
|
3
->
(
#
11
0
"parser/wlexer.mll"
#
11
6
"parser/wlexer.mll"
let
st
=
List
.
hd
!
comment_start_pos
in
error
st
(
st
+
2
)
Unterminated_comment
)
|
4
->
(
#
1
14
"parser/wlexer.mll"
#
1
20
"parser/wlexer.mll"
comment
engine
lexbuf
)
|
_
->
failwith
"lexing: empty token [comment]"
and
string2
engine
lexbuf
=
match
engine
lex_tables
2
lexbuf
with
0
->
(
#
1
18
"parser/wlexer.mll"
#
1
24
"parser/wlexer.mll"
()
)
|
1
->
(
#
12
0
"parser/wlexer.mll"
#
12
6
"parser/wlexer.mll"
store_char
(
Lexing
.
lexeme_char
lexbuf
1
);
string2
engine
lexbuf
)
|
2
->
(
#
123
"parser/wlexer.mll"
#
128
"parser/wlexer.mll"
store_special
(
Lexing
.
lexeme_char
lexbuf
1
);
string1
engine
lexbuf
)
|
3
->
(
#
132
"parser/wlexer.mll"
store_char
(
char_for_decimal_code
(
Lexing
.
lexeme
lexbuf
));
string2
engine
lexbuf
)
|
3
->
(
#
126
"parser/wlexer.mll"
error
!
string_start_pos
(
!
string_start_pos
+
1
)
Unterminated_string
)
|
4
->
(
#
128
"parser/wlexer.mll"
#
135
"parser/wlexer.mll"
error
!
string_start_pos
(
!
string_start_pos
+
1
)
Unterminated_string
)
|
5
->
(
#
137
"parser/wlexer.mll"
store_char
(
Lexing
.
lexeme_char
lexbuf
0
);
(* TODO: Unicode *)
string2
engine
lexbuf
)
...
...
@@ -278,28 +294,33 @@ and string2 engine lexbuf =
and
string1
engine
lexbuf
=
match
engine
lex_tables
3
lexbuf
with
0
->
(
#
1
3
4
"parser/wlexer.mll"
#
14
3
"parser/wlexer.mll"
()
)
|
1
->
(
#
1
36
"parser/wlexer.mll"
#
1
45
"parser/wlexer.mll"
store_char
(
Lexing
.
lexeme_char
lexbuf
1
);
string1
engine
lexbuf
)
|
2
->
(
#
139
"parser/wlexer.mll"
#
147
"parser/wlexer.mll"
store_special
(
Lexing
.
lexeme_char
lexbuf
1
);
string1
engine
lexbuf
)
|
3
->
(
#
151
"parser/wlexer.mll"
store_char
(
char_for_decimal_code
(
Lexing
.
lexeme
lexbuf
));
string1
engine
lexbuf
)
|
3
->
(
#
142
"parser/wlexer.mll"
error
!
string_start_pos
(
!
string_start_pos
+
1
)
Unterminated_string
)
|
4
->
(
#
144
"parser/wlexer.mll"
#
154
"parser/wlexer.mll"
error
!
string_start_pos
(
!
string_start_pos
+
1
)
Unterminated_string
)
|
5
->
(
#
156
"parser/wlexer.mll"
store_char
(
Lexing
.
lexeme_char
lexbuf
0
);
string1
engine
lexbuf
)
|
_
->
failwith
"lexing: empty token [string1]"
;;
#
1
47
"parser/wlexer.mll"
#
1
59
"parser/wlexer.mll"
let
lexer_func_of_wlex
lexfun
lexengine
cs
=
...
...
parser/wlexer.mll
View file @
15f78be4
...
...
@@ -18,6 +18,7 @@ classes
exception
Unterminated_string
exception
Unterminated_string_in_comment
(* Buffer for string literals *)
let
string_buff
=
Buffer
.
create
1024
...
...
@@ -26,6 +27,11 @@ classes
let
s
=
Buffer
.
contents
string_buff
in
Buffer
.
clear
string_buff
;
s
let
store_special
=
function
|
'
n'
->
store_char
'\n'
|
'
r'
->
store_char
'\r'
|
'
t'
->
store_char
'\t'
|
c
->
raise
(
Illegal_character
'\\'
)
let
string_start_pos
=
ref
0
;;
let
comment_start_pos
:
int
list
ref
=
ref
[]
;;
...
...
@@ -61,7 +67,7 @@ rule token = parse
}
|
[
"<>=.,:;+-*/@&{}[]()|?`!"
]
|
"->"
|
"::"
|
";;"
|
"--"
|
":="
|
"
\\
"
|
"++"
|
"{|"
|
"|}"
|
"{|"
|
"|}"
|
"<="
|
">="
|
"<<"
|
">>"
|
[
"?+*"
]
"?"
{
""
,
Lexing
.
lexeme
lexbuf
}
...
...
@@ -119,6 +125,9 @@ and string2 = parse
| '
\\
' ['
\\
' '"
'
]
{
store_char
(
Lexing
.
lexeme_char
lexbuf
1
);
string2
engine
lexbuf
}
|
'\\'
lowercase
{
store_special
(
Lexing
.
lexeme_char
lexbuf
1
);
string1
engine
lexbuf
}
|
'\\'
ascii_digit
+
{
store_char
(
char_for_decimal_code
(
Lexing
.
lexeme
lexbuf
));
string2
engine
lexbuf
}
...
...
@@ -135,6 +144,9 @@ and string1 = parse
|
'\\'
[
'\\'
'\''
]
{
store_char
(
Lexing
.
lexeme_char
lexbuf
1
);
string1
engine
lexbuf
}
|
'\\'
lowercase
{
store_special
(
Lexing
.
lexeme_char
lexbuf
1
);
string1
engine
lexbuf
}
|
'\\'
ascii_digit
+
{
store_char
(
char_for_decimal_code
(
Lexing
.
lexeme
lexbuf
));
string1
engine
lexbuf
}
...
...
runtime/eval.ml
View file @
15f78be4
...
...
@@ -70,6 +70,11 @@ let rec eval env e0 =
|
Typed
.
Op
(
"string_of"
,
[
e
])
->
eval_string_of
(
eval
env
e
)
|
Typed
.
Op
(
"dump_to_file"
,
[
e1
;
e2
])
->
eval_dump_to_file
(
eval
env
e1
)
(
eval
env
e2
)
|
Typed
.
Op
(
"="
,
[
e1
;
e2
])
->
eval_equal
(
eval
env
e1
)
(
eval
env
e2
)
|
Typed
.
Op
(
"<"
,
[
e1
;
e2
])
->
eval_lt
(
eval
env
e1
)
(
eval
env
e2
)
|
Typed
.
Op
(
"<="
,
[
e1
;
e2
])
->
eval_lte
(
eval
env
e1
)
(
eval
env
e2
)
|
Typed
.
Op
(
">"
,
[
e1
;
e2
])
->
eval_gt
(
eval
env
e1
)
(
eval
env
e2
)
|
Typed
.
Op
(
">="
,
[
e1
;
e2
])
->
eval_gte
(
eval
env
e1
)
(
eval
env
e2
)
|
Typed
.
Dot
(
e
,
l
)
->
eval_dot
l
(
eval
env
e
)
|
Typed
.
Op
(
o
,_
)
->
failwith
(
"Unknown operator "
^
o
)
...
...
@@ -170,3 +175,23 @@ and eval_string_of v =
Format
.
pp_print_flush
ppf
()
;
string
(
Buffer
.
contents
b
)
and
eval_equal
v1
v2
=
let
c
=
Value
.
compare
v1
v2
in
Value
.
vbool
(
Value
.
compare
v1
v2
=
0
)
and
eval_lt
v1
v2
=
let
c
=
Value
.
compare
v1
v2
in
Value
.
vbool
(
Value
.
compare
v1
v2
<
0
)
and
eval_lte
v1
v2
=
let
c
=
Value
.
compare
v1
v2
in
Value
.
vbool
(
Value
.
compare
v1
v2
<=
0
)
and
eval_gt
v1
v2
=
let
c
=
Value
.
compare
v1
v2
in
Value
.
vbool
(
Value
.
compare
v1
v2
>
0
)
and
eval_gte
v1
v2
=
let
c
=
Value
.
compare
v1
v2
in
Value
.
vbool
(
Value
.
compare
v1
v2
>=
0
)
runtime/run_dispatch.ml
View file @
15f78be4
...
...
@@ -4,6 +4,13 @@ open Value
open
Ident
open
Patterns
.
Compile
(*
module Array = struct
include Array
let get = unsafe_get
end
*)
let
make_result_prod
v1
r1
v2
r2
v
(
code
,
r
)
=
let
ret
=
Array
.
map
(
function
...
...
runtime/value.ml
View file @
15f78be4
...
...
@@ -16,6 +16,10 @@ exception CDuceExn of t
let
nil
=
Atom
Sequence
.
nil_atom
let
string
s
=
String
(
0
,
String
.
length
s
,
s
,
nil
)
let
vtrue
=
Atom
Builtin
.
true_atom
let
vfalse
=
Atom
Builtin
.
false_atom
let
vbool
x
=
if
x
then
vtrue
else
vfalse
let
const
=
function
|
Types
.
Integer
i
->
Integer
i
...
...
@@ -109,8 +113,49 @@ and print_field ppf (l,v) =
Format
.
fprintf
ppf
"%s=%a"
(
LabelPool
.
value
l
)
print
v
let
normalize_string
i
j
s
q
=
if
i
=
j
then
q
else
Pair
(
Char
(
Chars
.
mk_char
(
String
.
unsafe_get
s
i
))
,
String
(
succ
i
,
j
,
s
,
q
))
let
normalize
=
function
|
String
(
i
,
j
,
s
,
q
)
->
if
i
=
j
then
q
else
Pair
(
Char
(
Chars
.
mk_char
s
.
[
i
])
,
String
(
succ
i
,
j
,
s
,
q
))
|
String
(
i
,
j
,
s
,
q
)
->
normalize_string
i
j
s
q
|
v
->
assert
false
let
rec
compare
x
y
=
if
(
x
==
y
)
then
0
else
match
(
x
,
y
)
with
|
Pair
(
x1
,
x2
)
,
Pair
(
y1
,
y2
)
|
Xml
(
x1
,
x2
)
,
Xml
(
y1
,
y2
)
->
let
c
=
compare
x1
y1
in
if
c
<>
0
then
c
else
compare
x2
y2
|
Record
rx
,
Record
ry
->
LabelMap
.
compare
compare
rx
ry
|
Atom
x
,
Atom
y
->
Atoms
.
vcompare
x
y
|
Integer
x
,
Integer
y
->
Intervals
.
vcompare
x
y
|
Char
x
,
Char
y
->
Chars
.
vcompare
x
y
|
Abstraction
(
_
,_
)
,
Abstraction
(
_
,_
)
->
raise
(
CDuceExn
(
string
"comparing functional values"
))
|
Absent
,_
|
_
,
Absent
->
assert
false
|
String
(
ix
,
jx
,
sx
,
qx
)
,
String
(
iy
,
jy
,
sy
,
qy
)
->
if
(
sx
==
sy
)
&&
(
ix
=
iy
)
&&
(
jx
=
jy
)
then
compare
qx
qy
else
(* Note: we would like to compare first jx-ix and jy-iy,
but this is not compatible with the equivalence of values *)
let
rec
aux
ix
iy
=
if
(
ix
=
jx
)
then
if
(
iy
=
jy
)
then
compare
qx
qy
else
compare
qx
(
normalize_string
iy
jy
sy
qy
)
else
if
(
iy
=
jy
)
then
compare
(
normalize_string
ix
jx
sx
qx
)
qy
else
let
c1
=
String
.
unsafe_get
sx
ix
and
c2
=
String
.
unsafe_get
sy
iy
in
if
c1
<
c2
then
-
1
else
if
c1
>
c2
then
1
else
aux
(
ix
+
1
)
(
iy
+
1
)
in
aux
ix
iy
|
String
(
i
,
j
,
s
,
q
)
,
_
->
compare
(
normalize_string
i
j
s
q
)
y
|
_
,
String
(
i
,
j
,
s
,
q
)
->
compare
x
(
normalize_string
i
j
s
q
)
|
_
,_
->
Obj
.
tag
(
Obj
.
repr
x
)
-
Obj
.
tag
(
Obj
.
repr
y
)
(* TODO: rewrite this case *)
runtime/value.mli
View file @
15f78be4
...
...
@@ -27,6 +27,11 @@ val normalize: t -> t
val
const
:
Types
.
const
->
t
val
string
:
string
->
t
val
nil
:
t
val
vtrue
:
t
val
vfalse
:
t