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
16f489e3
Commit
16f489e3
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2004-12-23 21:52:59 by afrisch] Empty log message
Original author: afrisch Date: 2004-12-23 21:52:59+00:00
parent
08e0fe01
Changes
1
Hide whitespace changes
Inline
Side-by-side
types/patterns.ml
View file @
16f489e3
...
...
@@ -1891,6 +1891,7 @@ x=(1,2)
outputs
:
output
array
;
rescode
:
rescode
;
reqs
:
(
Derivation
.
t
*
Types
.
t
*
fv
)
list
;
(* initial derivation; assumption; variables *)
assumpt
:
Types
.
t
;
mutable
actions
:
actions
option
;
}
...
...
@@ -2008,6 +2009,7 @@ x=(1,2)
(
r
,!
i
+
1
)
let
disp_id
=
ref
0
let
mk
reqs
=
let
nb
=
ref
(
-
1
)
in
let
codes
=
ref
[]
in
...
...
@@ -2015,7 +2017,7 @@ x=(1,2)
if
Types
.
is_empty
t0
then
RFail
else
match
l
with
|
[]
->
incr
nb
;
codes
:=
(
t0
,
ar
,
List
.
rev
binds
)
::
!
codes
;
RCode
!
nb
|
((
a
,
fv
,_
)
,
(
t
,
xs
))
::
rem
->
|
((
a
,
_
,_
)
,
(
t
,
xs
))
::
rem
->
let
(
alc
,
ar'
)
=
alloc
ar
xs
in
RSwitch
(
aux
(
Types
.
diff
t0
(
Types
.
diff
t
a
))
...
...
@@ -2030,13 +2032,15 @@ x=(1,2)
reqs
in
(* let t0 = Types.any in *)
let
rc
=
aux
t0
0
[]
reqs
in
let
reqs
=
List
.
map
(
fun
(
p
,
(
t
,
xs
))
->
(
Derivation
.
mkopt
p
t
xs
,
t
,
xs
))
reqs
in
let
os
=
Array
.
of_list
(
List
.
rev
!
codes
)
in
let
ders
=
List
.
map
(
fun
(
p
,
(
t
,
xs
))
->
(
Derivation
.
mkopt
p
t
xs
,
t
,
xs
))
reqs
in
{
id
=
(
incr
disp_id
;
!
disp_id
);
outputs
=
os
;
rescode
=
rc
;
reqs
=
der
s
;
reqs
=
req
s
;
assumpt
=
t0
;
actions
=
None
}
...
...
@@ -2081,8 +2085,8 @@ x=(1,2)
TargExpr.print res;
IdMap.iteri (fun x i ->
Format.fprintf Format.std_formatter "%a->%i@."
Ident.print x i) fill;
*)
(*
let fill = IdMap.restrict fill (IdMap.domain res) in *)
Ident.print x i) fill;
let fill = IdMap.restrict fill (IdMap.domain res) in
*)
IdMap
.
collide
(
fun
i
r
->
o
.
(
i
)
<-
r
)
fill
res
|
None
,
None
->
()
|
_
->
assert
false
)
...
...
@@ -2109,7 +2113,9 @@ x=(1,2)
let
aux
accu
(
t
,
xs
,
q1
,
q2
)
=
let
q
=
selq
(
q1
,
q2
)
in
let
xs
=
IdSet
.
cap
xs
q
.
fv
in
let
p
=
q
.
descr
in
let
t
=
pi
t
in
if
(
IdSet
.
is_empty
xs
)
&&
(
Types
.
subtype
t
(
Types
.
descr
q
.
accept
))
then
accu
else
add_req
accu
q
.
descr
t
xs
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