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
1cee30ae
Commit
1cee30ae
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-11-28 11:18:14 by szach] better error message while referencing an unregistered schema
Original author: szach Date: 2003-11-28 11:18:14+00:00
parent
603a6478
Changes
2
Hide whitespace changes
Inline
Side-by-side
typing/typer.ml
View file @
1cee30ae
...
...
@@ -172,6 +172,7 @@ let error loc msg = raise_loc loc (Error msg)
(* just to remember imported schemas *)
let
schemas
=
State
.
ref
"Typer.schemas"
(
Hashtbl
.
create
3
)
let
is_registered_schema
=
Hashtbl
.
mem
!
schemas
let
schema_types
=
State
.
ref
"Typer.schema_types"
(
Hashtbl
.
create
51
)
let
schema_elements
=
State
.
ref
"Typer.schema_elements"
(
Hashtbl
.
create
51
)
...
...
@@ -208,8 +209,11 @@ let find_schema_descr' k s n =
try
find_schema_descr
k
s
n
with
Not_found
->
raise
(
Error
(
Printf
.
sprintf
"No %s named '%s' found in schema '%s'"
(
Schema_common
.
string_of_component_kind
k
)
(
U
.
get_str
n
)
(
U
.
get_str
s
)))
if
is_registered_schema
s
then
raise
(
Error
(
Printf
.
sprintf
"No %s named '%s' found in schema '%s'"
(
Schema_common
.
string_of_component_kind
k
)
(
U
.
get_str
n
)
(
U
.
get_str
s
)))
else
raise
(
Error
(
Printf
.
sprintf
"%s: no such schema"
(
U
.
get_str
s
)))
(* Eliminate Recursion, propagate Sequence Capture Variables *)
...
...
@@ -1533,7 +1537,7 @@ let get_schema name =
let
get_schema_names
()
=
Hashtbl
.
fold
(
fun
n
_
acc
->
n
::
acc
)
!
schemas
[]
let
register_schema
schema_name
schema
=
if
Hashtbl
.
mem
!
schema
s
schema_name
then
if
is_registered_
schema
schema_name
then
failwith
(
"Redefinition of schema "
^
U
.
get_str
schema_name
)
else
begin
let
log_schema_component
kind
schema
name
cd_type
=
...
...
typing/typer.mli
View file @
1cee30ae
...
...
@@ -61,6 +61,7 @@ val flatten: loc ->
(** {2 Schema stuff} *)
val
register_schema
:
U
.
t
->
Schema_types
.
schema
->
unit
val
is_registered_schema
:
U
.
t
->
bool
val
get_schema
:
U
.
t
->
Schema_types
.
schema
(** lookup schema by name *)
val
get_schema_names
:
unit
->
U
.
t
list
(** registered schema names *)
...
...
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