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
7c7455a8
Commit
7c7455a8
authored
Sep 12, 2014
by
Pietro Abate
Browse files
Add Type check for parametric types arguments
parent
08a5a432
Changes
3
Show whitespace changes
Inline
Side-by-side
typing/typepat.ml
View file @
7c7455a8
...
...
@@ -287,12 +287,12 @@ let deferr s = raise (Patterns.Error s)
(* From the intermediate representation to the internal one *)
let
rec
typ
n
=
let
rec
typ
?
(
err
=
deferr
)
n
=
let
n
=
repr
n
in
match
n
.
t
with
|
Some
t
->
t
|
None
->
let
t
=
compute_typ
n
.
desc
in
n
.
t
<-
Some
t
;
t
and
compute_typ
=
function
|
None
->
let
t
=
compute_typ
err
n
.
desc
in
n
.
t
<-
Some
t
;
t
and
compute_typ
err
=
function
|
IType
(
t
,_
)
->
t
|
IOr
(
s1
,
s2
,_
)
->
Types
.
cup
(
typ
s1
)
(
typ
s2
)
|
IAnd
(
s1
,
s2
,_
)
->
Types
.
cap
(
typ
s1
)
(
typ
s2
)
...
...
@@ -304,9 +304,10 @@ let deferr s = raise (Patterns.Error s)
|
IRecord
(
o
,
r
,
err
)
->
Types
.
record_fields
(
o
,
LabelMap
.
map
(
compute_typ_field
err
)
r
)
|
ILink
_
->
assert
false
|
ICapture
_
|
IConstant
(
_
,_
)
->
assert
false
|
ICapture
x
|
IConstant
(
x
,_
)
->
raise
(
err
(
"Identifier "
^
(
to_string
x
)
^
" is not a valid type"
))
|
IConcat
_
|
IMerge
_
->
assert
false
and
compute_typ_field
err
=
function
and
compute_typ_field
err
=
function
|
(
s
,
None
)
->
typ_node
s
|
(
s
,
Some
_
)
->
raise
(
err
"Or-else clauses are not allowed in types"
)
...
...
typing/typepat.mli
View file @
7c7455a8
...
...
@@ -26,7 +26,7 @@ val internalize: node -> unit
val
peek_fv
:
node
->
id
option
val
typ
:
node
->
Types
.
descr
val
typ
:
?
err
:
err
->
node
->
Types
.
descr
val
typ_node
:
node
->
Types
.
Node
.
t
val
pat_node
:
node
->
Patterns
.
node
...
...
typing/typer.ml
View file @
7c7455a8
...
...
@@ -394,10 +394,20 @@ module IType = struct
let
a
=
Array
.
of_list
a
in
let
l
=
ref
[]
in
for
i
=
0
to
(
Array
.
length
pargs
)
-
1
do
l
:=
(
pargs
.
(
i
)
,
typ
(
derecurs
env
a
.
(
i
)))
::!
l
try
let
err
s
=
Error
s
in
l
:=
(
pargs
.
(
i
)
,
typ
~
err
(
derecurs
env
a
.
(
i
)))
::!
l
with
|
Error
s
->
raise_loc_generic
loc
s
|_
->
assert
false
done
;
mk_type
(
Types
.
Positive
.
substitute_list
t
!
l
)
with
Not_found
->
mk_capture
v
with
Not_found
->
if
List
.
length
a
>=
1
then
raise_loc_generic
loc
(
Printf
.
sprintf
"Parametric type %s does not exists"
(
Ident
.
to_string
v
))
else
mk_capture
v
end
|
(
ids
,_
)
->
mk_type
(
fst
(
find_global_type
env
.
penv_tenv
loc
ids
))
...
...
@@ -533,7 +543,6 @@ let pat_false =
Patterns
.
define
n
(
Patterns
.
constr
Builtin_defs
.
false_type
);
n
let
ops
=
Hashtbl
.
create
13
let
register_op
op
arity
f
=
Hashtbl
.
add
ops
op
(
arity
,
f
)
let
typ_op
op
=
snd
(
Hashtbl
.
find
ops
op
)
...
...
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