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
edd1b1d1
Commit
edd1b1d1
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2005-02-24 09:07:07 by afrisch] Bug
Original author: afrisch Date: 2005-02-24 09:07:07+00:00
parent
954309ae
Changes
2
Hide whitespace changes
Inline
Side-by-side
schema/schema_validator.ml
View file @
edd1b1d1
...
...
@@ -253,7 +253,7 @@ let rec validate_simple_type def s =
|
Primitive
_
->
assert
false
|
Derived
(
_
,
Atomic
primitive
,
facets
,
base
)
->
let
literal
=
normalize_white_space
(
fst
facets
.
whiteSpace
)
s
in
let
value
=
validate_simple_type_ref
base
(
*primitive
*)
(*???*)
let
value
=
validate_simple_type_ref
(*
base*
)
primitive
(*???*)
literal
in
Schema_facets
.
facets_valid
facets
value
;
value
...
...
typing/typer.ml
View file @
edd1b1d1
...
...
@@ -473,6 +473,7 @@ module IType = struct
|
None
,
d
->
iter
aux
d
)
in
assert
(
!
to_clear
==
[]
);
match
n
.
fv
with
|
Some
x
->
x
|
None
->
aux
n
;
clear
()
;
n
.
fv
<-
Some
!
fv
;
!
fv
...
...
@@ -480,11 +481,9 @@ module IType = struct
(* optimized version to check closedness *)
let
no_fv
=
Some
IdSet
.
empty
let
check_no_fv
loc
n
=
let
err
x
=
raise_loc_generic
loc
(
"Capture variable not allowed: "
^
(
Ident
.
to_string
x
))
in
exception
FoundFv
of
id
let
peek_fv
n
=
let
err
x
=
raise
(
FoundFv
x
)
in
let
rec
aux
n
=
let
n
=
repr
n
in
if
(
n
.
sid
=
0
)
then
(
...
...
@@ -496,6 +495,7 @@ module IType = struct
|
None
,
d
->
iter
aux
d
)
in
assert
(
!
to_clear
==
[]
);
try
match
n
.
fv
with
|
Some
x
->
(
match
IdSet
.
pick
x
with
Some
x
->
err
x
|
None
->
()
)
...
...
@@ -504,6 +504,17 @@ module IType = struct
to_clear
:=
[]
with
exn
->
clear
()
;
raise
exn
let
check_no_fv
loc
n
=
try
peek_fv
n
with
FoundFv
x
->
raise_loc_generic
loc
(
"Capture variable not allowed: "
^
(
Ident
.
to_string
x
))
let
has_no_fv
n
=
try
peek_fv
n
;
true
with
FoundFv
_
->
false
(* From the intermediate representation to the internal one *)
...
...
@@ -652,10 +663,24 @@ module IType = struct
|
l
->
PAlt
l
let
rec
merge_alt
=
function
|
PElem
p
::
PElem
q
::
l
->
merge_alt
(
PElem
(
ior
p
q
)
::
l
)
|
PElem
p
::
PElem
q
::
l
when
(
has_no_fv
p
)
&&
(
has_no_fv
q
)
->
merge_alt
(
PElem
(
ior
p
q
)
::
l
)
(* Need the guard because of
[ (x&Int|_) R' ] which is produced from [ (x::Int|_) R ]
Might weaken it to (fv p = fv q)
*)
|
r
::
l
->
r
::
(
merge_alt
l
)
|
[]
->
[]
let
rec
print_regexp
ppf
=
function
|
PElem
_
->
Format
.
fprintf
ppf
"Elem"
|
PGuard
_
->
Format
.
fprintf
ppf
"Guard"
|
PSeq
l
->
Format
.
fprintf
ppf
"Seq(%a)"
print_regexp_list
l
|
PAlt
l
->
Format
.
fprintf
ppf
"Alt(%a)"
print_regexp_list
l
|
PStar
r
->
Format
.
fprintf
ppf
"Star(%a)"
print_regexp
r
|
PWeakStar
r
->
Format
.
fprintf
ppf
"WStar(%a)"
print_regexp
r
and
print_regexp_list
ppf
l
=
List
.
iter
(
fun
x
->
Format
.
fprintf
ppf
"%a;"
print_regexp
x
)
l
let
rec
remove_regexp
r
q
=
match
r
with
|
PElem
p
->
...
...
@@ -665,7 +690,7 @@ module IType = struct
|
PSeq
l
->
List
.
fold_right
(
fun
r
a
->
remove_regexp
r
a
)
l
q
|
PAlt
rl
->
let
rl
=
merge_alt
rl
in
let
rl
=
merge_alt
rl
in
List
.
fold_left
(
fun
a
r
->
ior
a
(
remove_regexp
r
q
))
iempty
rl
|
PStar
r
->
let
x
=
mk_delayed
()
in
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment