Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
22e13e75
Commit
22e13e75
authored
Apr 22, 2010
by
Andrei Paskevich
Browse files
registered transformations may now depend on driver_query
parent
5d5a8047
Changes
28
Hide whitespace changes
Inline
Side-by-side
Makefile.in
View file @
22e13e75
...
...
@@ -94,11 +94,12 @@ LIBGENERATED = src/util/rc.ml \
LIB_UTIL
=
pp loc prtree util hashcons sysutil hashweak rc
LIB_CORE
=
ident ty term pattern decl theory task pretty trans
env
register
LIB_CORE
=
ident ty term pattern decl theory task pretty trans
env
LIB_PARSER
=
ptree parser lexer denv typing
LIB_DRIVER
=
call_provers driver_ast driver_parser driver_lexer driver whyconf
LIB_DRIVER
=
call_provers driver_ast driver_parser driver_lexer driver
\
register prover whyconf
LIB_TRANSFORM
=
simplify_recursive_definition inlining
\
split_conjunction encoding_decorate
\
...
...
src/core/task.ml
View file @
22e13e75
...
...
@@ -42,9 +42,10 @@ and tdecl =
|
Use
of
theory
|
Clone
of
theory
*
(
ident
*
ident
)
list
let
task_known
=
option_apply
Mid
.
empty
(
fun
t
->
t
.
task_known
)
let
task_clone
=
option_apply
Mid
.
empty
(
fun
t
->
t
.
task_clone
)
let
task_used
=
option_apply
Mid
.
empty
(
fun
t
->
t
.
task_used
)
let
task_tag
=
option_apply
(
-
1
)
(
fun
t
->
t
.
task_tag
)
let
task_used
=
option_apply
Mid
.
empty
(
fun
t
->
t
.
task_used
)
let
task_tag
=
option_apply
(
-
1
)
(
fun
t
->
t
.
task_tag
)
module
Task
=
struct
type
t
=
task_hd
...
...
@@ -188,10 +189,6 @@ let rec last_clone task = match task with
|
Some
{
task_prev
=
task
}
->
last_clone
task
|
None
->
None
let
get_known
=
option_apply
Mid
.
empty
(
fun
t
->
t
.
task_known
)
let
get_clone
=
option_apply
Mid
.
empty
(
fun
t
->
t
.
task_clone
)
let
get_used
=
option_apply
Mid
.
empty
(
fun
t
->
t
.
task_used
)
exception
GoalNotFound
let
task_goal
=
function
...
...
src/core/task.mli
View file @
22e13e75
...
...
@@ -41,9 +41,10 @@ and tdecl = private
|
Use
of
theory
|
Clone
of
theory
*
(
ident
*
ident
)
list
val
task_known
:
task
->
known_map
val
task_clone
:
task
->
clone_map
val
task_used
:
task
->
use_map
val
task_tag
:
task
->
int
val
task_used
:
task
->
use_map
val
task_tag
:
task
->
int
(* constructors *)
...
...
@@ -80,10 +81,6 @@ val task_goal : task -> prsymbol
val
last_clone
:
task
->
task
val
last_use
:
task
->
task
val
get_known
:
task
->
known_map
val
get_clone
:
task
->
clone_map
val
get_used
:
task
->
use_map
(* exceptions *)
exception
GoalNotFound
...
...
src/core/trans.ml
View file @
22e13e75
...
...
@@ -39,8 +39,6 @@ let singleton f x = [f x]
let
compose
f
g
x
=
g
(
f
x
)
let
list_apply
f
=
List
.
fold_left
(
fun
acc
x
->
List
.
rev_append
(
f
x
)
acc
)
[]
let
compose_l
f
g
x
=
list_apply
g
(
f
x
)
let
apply
f
x
=
f
x
...
...
src/driver/driver.ml
View file @
22e13e75
...
...
@@ -17,6 +17,7 @@
(* *)
(**************************************************************************)
open
Format
open
Util
open
Ident
open
Ty
...
...
@@ -24,7 +25,6 @@ open Term
open
Decl
open
Theory
open
Task
open
Register
open
Driver_ast
open
Call_provers
...
...
@@ -32,9 +32,9 @@ open Call_provers
type
error
=
string
exception
Error
of
string
exception
Error
of
error
let
report
=
Format
.
pp_print_string
let
report
=
pp_print_string
let
error
?
loc
e
=
match
loc
with
|
None
->
raise
(
Error
e
)
...
...
@@ -42,10 +42,10 @@ let error ?loc e = match loc with
let
errorm
?
loc
f
=
let
buf
=
Buffer
.
create
512
in
let
fmt
=
Format
.
formatter_of_buffer
buf
in
Format
.
kfprintf
let
fmt
=
formatter_of_buffer
buf
in
kfprintf
(
fun
_
->
Format
.
pp_print_flush
fmt
()
;
pp_print_flush
fmt
()
;
let
s
=
Buffer
.
contents
buf
in
Buffer
.
clear
buf
;
error
?
loc
s
)
...
...
@@ -60,14 +60,14 @@ let global_substitute_fmt expr repl_fun text fmt =
let
rec
replace
start
last_was_empty
=
let
startpos
=
if
last_was_empty
then
start
+
1
else
start
in
if
startpos
>
String
.
length
text
then
Format
.
pp_print_string
fmt
(
Str
.
string_after
text
start
)
pp_print_string
fmt
(
Str
.
string_after
text
start
)
else
match
opt_search_forward
expr
text
startpos
with
|
None
->
Format
.
pp_print_string
fmt
(
Str
.
string_after
text
start
)
pp_print_string
fmt
(
Str
.
string_after
text
start
)
|
Some
pos
->
let
end_pos
=
Str
.
match_end
()
in
Format
.
pp_print_string
fmt
(
String
.
sub
text
start
(
pos
-
start
));
pp_print_string
fmt
(
String
.
sub
text
start
(
pos
-
start
));
repl_fun
text
fmt
;
replace
end_pos
(
end_pos
=
pos
)
in
...
...
@@ -106,20 +106,12 @@ let syntax_arguments s print fmt l =
(** drivers *)
type
driver_query
=
{
query_syntax
:
ident
->
string
option
;
query_remove
:
ident
->
bool
;
query_tags
:
ident
->
Sstr
.
t
;
}
type
printer
=
driver_query
->
Format
.
formatter
->
task
->
unit
type
driver
=
{
drv_env
:
Env
.
env
;
drv_printer
:
p
rin
ter
option
;
drv_printer
:
st
rin
g
option
;
drv_prelude
:
string
list
;
drv_filename
:
string
option
;
drv_transform
:
task
trans_reg
;
drv_transform
:
string
list
;
drv_thprelude
:
string
list
Mid
.
t
;
drv_tags
:
Sstr
.
t
Mid
.
t
;
drv_tags_cl
:
Sstr
.
t
Mid
.
t
;
...
...
@@ -128,22 +120,9 @@ type driver = {
drv_remove_cl
:
Sid
.
t
;
drv_regexps
:
(
Str
.
regexp
*
Call_provers
.
prover_answer
)
list
;
drv_exitcodes
:
(
int
*
Call_provers
.
prover_answer
)
list
;
drv_tag
:
int
}
(** register printers and transformations *)
let
printers
:
(
string
,
printer
)
Hashtbl
.
t
=
Hashtbl
.
create
17
let
register_printer
name
printer
=
Hashtbl
.
replace
printers
name
printer
let
list_printers
()
=
Hashtbl
.
fold
(
fun
k
_
acc
->
k
::
acc
)
printers
[]
let
transforms
:
(
string
,
task
trans_reg
)
Hashtbl
.
t
=
Hashtbl
.
create
17
let
register_transform
name
trans
=
Hashtbl
.
replace
transforms
name
trans
let
list_transforms
()
=
Hashtbl
.
fold
(
fun
k
_
acc
->
k
::
acc
)
transforms
[]
let
transforms_l
:
(
string
,
task
tlist_reg
)
Hashtbl
.
t
=
Hashtbl
.
create
17
let
register_transform_l
name
trans
=
Hashtbl
.
replace
transforms_l
name
trans
let
list_transforms_l
()
=
Hashtbl
.
fold
(
fun
k
_
ac
->
k
::
ac
)
transforms_l
[]
(** parse a driver file *)
let
load_plugin
dir
(
byte
,
nat
)
=
...
...
@@ -163,13 +142,13 @@ let load_file file =
let
string_of_qualid
thl
idl
=
String
.
concat
"."
thl
^
"."
^
String
.
concat
"."
idl
let
load_driver
env
file
=
let
load_driver
=
let
driver_tag
=
ref
(
-
1
)
in
fun
env
file
->
let
prelude
=
ref
[]
in
let
regexps
=
ref
[]
in
let
exitcodes
=
ref
[]
in
let
filename
=
ref
None
in
let
printer
=
ref
None
in
let
transform
=
ref
identity
in
let
transform
=
ref
[]
in
let
set_or_raise
loc
r
v
error
=
match
!
r
with
|
Some
_
->
errorm
~
loc
"duplicate %s"
error
...
...
@@ -189,12 +168,8 @@ let load_driver env file =
|
ExitCodeUnknown
(
s
,
t
)
->
add_to_list
exitcodes
(
s
,
Unknown
t
)
|
ExitCodeFailure
(
s
,
t
)
->
add_to_list
exitcodes
(
s
,
Failure
t
)
|
Filename
s
->
set_or_raise
loc
filename
s
"filename"
|
Printer
s
->
begin
try
set_or_raise
loc
printer
(
Hashtbl
.
find
printers
s
)
"printer"
with
Not_found
->
errorm
~
loc
"unknown printer %s"
s
end
|
Transform
s
->
begin
try
transform
:=
compose
!
transform
(
Hashtbl
.
find
transforms
s
)
with
Not_found
->
errorm
~
loc
"unknown transformation %s"
s
end
|
Printer
s
->
set_or_raise
loc
printer
s
"printer"
|
Transform
s
->
add_to_list
transform
s
|
Plugin
files
->
load_plugin
(
Filename
.
dirname
file
)
files
in
let
f
=
load_file
file
in
...
...
@@ -222,7 +197,8 @@ let load_driver env file =
if
Mid
.
mem
id
!
syntax
then
errorm
~
loc
"duplicate syntax rule for %s symbol %s"
k
(
string_of_qualid
!
qualid
q
);
syntax
:=
Mid
.
add
id
s
!
syntax
syntax
:=
Mid
.
add
id
s
!
syntax
;
remove
:=
Sid
.
add
id
!
remove
in
let
add_tag
c
id
s
=
let
mr
=
if
c
then
tags_cl
else
tags
in
...
...
@@ -255,6 +231,8 @@ let load_driver env file =
List
.
iter
(
add_local
th
)
trl
in
List
.
iter
add_theory
f
.
f_rules
;
transform
:=
List
.
rev
!
transform
;
incr
driver_tag
;
{
drv_env
=
env
;
drv_printer
=
!
printer
;
...
...
@@ -269,15 +247,46 @@ let load_driver env file =
drv_remove_cl
=
!
remove_cl
;
drv_regexps
=
!
regexps
;
drv_exitcodes
=
!
exitcodes
;
drv_tag
=
!
driver_tag
;
}
(** query drivers *)
type
driver_query
=
{
query_syntax
:
ident
->
string
option
;
query_remove
:
ident
->
bool
;
query_tags
:
ident
->
Sstr
.
t
;
query_driver
:
driver
;
query_lclone
:
task
;
query_tag
:
int
;
}
module
Hsdq
=
Hashcons
.
Make
(
struct
type
t
=
driver_query
let
equal
q1
q2
=
q1
.
query_driver
==
q2
.
query_driver
&&
q1
.
query_lclone
==
q2
.
query_lclone
let
hash
q
=
Hashcons
.
combine
q
.
query_driver
.
drv_tag
(
task_tag
q
.
query_lclone
)
let
tag
n
q
=
{
q
with
query_tag
=
n
}
end
)
module
Dq
=
StructMake
(
struct
type
t
=
driver_query
let
tag
q
=
q
.
query_tag
end
)
module
Sdq
=
Dq
.
S
module
Mdq
=
Dq
.
M
module
Hdq
=
Dq
.
H
let
get_tags
map
id
=
try
Mid
.
find
id
map
with
Not_found
->
Sstr
.
empty
let
add_tags
drv
id
acc
=
Sstr
.
union
(
get_tags
drv
.
drv_tags_cl
id
)
acc
let
add_remove
drv
id
acc
=
acc
||
Sid
.
mem
id
drv
.
drv_remove_cl
let
query_driver
drv
clone
=
let
driver_query
drv
task
=
let
clone
=
task_clone
task
in
let
htags
=
Hid
.
create
7
in
let
query_tags
id
=
try
Hid
.
find
htags
id
with
Not_found
->
let
r
=
try
Mid
.
find
id
clone
with
Not_found
->
Sid
.
empty
in
...
...
@@ -293,14 +302,30 @@ let query_driver drv clone =
let
query_syntax
id
=
try
Some
(
Mid
.
find
id
drv
.
drv_syntax
)
with
Not_found
->
None
in
{
query_syntax
=
query_syntax
;
Hsdq
.
hashcons
{
query_syntax
=
query_syntax
;
query_remove
=
query_remove
;
query_tags
=
query_tags
}
query_tags
=
query_tags
;
query_driver
=
drv
;
query_lclone
=
last_clone
task
;
query_tag
=
-
1
}
let
query_syntax
dq
=
dq
.
query_syntax
let
query_remove
dq
=
dq
.
query_remove
let
query_tags
dq
=
dq
.
query_tags
let
query_driver
dq
=
dq
.
query_driver
let
query_env
dq
=
dq
.
query_driver
.
drv_env
let
query_clone
dq
=
task_clone
(
dq
.
query_lclone
)
let
query_tag
dq
=
dq
.
query_tag
(** apply drivers *)
let
print_prelude
drv
used
fmt
=
let
pr_pr
s
()
=
Format
.
fprintf
fmt
"%s@
\n
"
s
in
let
get_transform
drv
=
drv
.
drv_transform
let
get_printer
drv
=
drv
.
drv_printer
let
get_env
drv
=
drv
.
drv_env
let
print_prelude
drv
task
fmt
=
let
pr_pr
s
()
=
fprintf
fmt
"%s@
\n
"
s
in
List
.
fold_right
pr_pr
drv
.
drv_prelude
()
;
let
seen
=
Hid
.
create
17
in
let
rec
print_prel
th_name
th
=
...
...
@@ -314,17 +339,8 @@ let print_prelude drv used fmt =
List
.
fold_right
pr_pr
prel
()
end
in
Mid
.
iter
print_prel
used
;
Format
.
fprintf
fmt
"@."
let
print_task
drv
fmt
task
=
let
task
=
apply_env
drv
.
drv_transform
drv
.
drv_env
task
in
let
printer
=
match
drv
.
drv_printer
with
|
None
->
errorm
"no printer specified in the driver file"
|
Some
p
->
p
(
query_driver
drv
(
task_clone
task
))
in
print_prelude
drv
(
task_used
task
)
fmt
;
Format
.
fprintf
fmt
"@[%a@]@?"
printer
task
Mid
.
iter
print_prel
(
task_used
task
);
fprintf
fmt
"@."
let
filename_regexp
=
Str
.
regexp
"%
\\
(.
\\
)"
...
...
@@ -352,12 +368,6 @@ let call_on_buffer ?debug ~command ~timelimit ~memlimit drv buffer =
Call_provers
.
call_on_buffer
?
debug
~
command
~
timelimit
~
memlimit
~
regexps
~
exitcodes
~
filename
buffer
let
prove_task
?
debug
~
command
~
timelimit
~
memlimit
drv
task
=
let
buf
=
Buffer
.
create
1024
in
let
fmt
=
Format
.
formatter_of_buffer
buf
in
print_task
drv
fmt
task
;
Format
.
pp_print_flush
fmt
()
;
call_on_buffer
?
debug
~
command
~
timelimit
~
memlimit
drv
buf
(*
Local Variables:
compile-command: "unset LANG; make -C ../.. test"
...
...
src/driver/driver.mli
View file @
22e13e75
...
...
@@ -38,44 +38,28 @@ val load_driver : env -> string -> driver
(** {2 query a driver} *)
val
syntax_arguments
:
string
->
(
formatter
->
'
a
->
unit
)
->
formatter
->
'
a
list
->
unit
(** (syntax_argument templ print_arg fmt l) prints in the formatter fmt
the list l using the template templ and the printer print_arg *)
(** {2 register printers and transformations} *)
type
driver_query
=
{
query_syntax
:
ident
->
string
option
;
query_remove
:
ident
->
bool
;
query_tags
:
ident
->
Sstr
.
t
;
}
type
driver_query
type
printer
=
driver_query
->
formatt
er
->
task
->
unit
val
driver_query
:
driv
er
->
task
->
driver_query
val
register_printer
:
string
->
printer
->
unit
val
register_transform
:
string
->
task
Register
.
trans_reg
->
unit
val
register_transform_l
:
string
->
task
Register
.
tlist_reg
->
unit
val
list_printers
:
unit
->
string
list
val
list_transforms
:
unit
->
string
list
val
list_transforms_l
:
unit
->
string
list
val
query_syntax
:
driver_query
->
ident
->
string
option
val
query_remove
:
driver_query
->
ident
->
bool
val
query_tags
:
driver_query
->
ident
->
Sstr
.
t
val
query_clone
:
driver_query
->
Theory
.
clone_map
val
query_driver
:
driver_query
->
driver
val
query_env
:
driver_query
->
env
val
query_tag
:
driver_query
->
int
(** {2 use a driver} *)
val
file_of_task
:
driver
->
string
->
string
->
task
->
string
(** file_of_task input_file theory_name task *)
val
get_env
:
driver
->
env
val
get_printer
:
driver
->
string
option
val
get_transform
:
driver
->
string
list
val
print_task
:
driver
->
formatter
->
task
->
unit
(** print a task *)
(** file_of_task input_file theory_name task *)
val
file_of_task
:
driver
->
string
->
string
->
task
->
string
val
prove_task
:
?
debug
:
bool
->
command
:
string
->
timelimit
:
int
->
memlimit
:
int
->
driver
->
task
->
unit
->
Call_provers
.
prover_result
val
print_prelude
:
driver
->
task
->
formatter
->
unit
val
call_on_buffer
:
?
debug
:
bool
->
...
...
@@ -84,6 +68,13 @@ val call_on_buffer :
memlimit
:
int
->
driver
->
Buffer
.
t
->
unit
->
Call_provers
.
prover_result
(** {2 syntax arguments} *)
val
syntax_arguments
:
string
->
(
formatter
->
'
a
->
unit
)
->
formatter
->
'
a
list
->
unit
(** (syntax_argument templ print_arg fmt l) prints in the formatter fmt
the list l using the template templ and the printer print_arg *)
(** {2 error reporting} *)
type
error
...
...
src/driver/prover.ml
0 → 100644
View file @
22e13e75
(**************************************************************************)
(* *)
(* Copyright (C) 2010- *)
(* Francois Bobot *)
(* Jean-Christophe Filliatre *)
(* Johannes Kanig *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
open
Format
open
Driver
open
Register
(** error handling *)
type
error
=
string
exception
Error
of
error
let
report
=
pp_print_string
let
error
e
=
raise
(
Error
e
)
let
errorm
f
=
let
buf
=
Buffer
.
create
512
in
let
fmt
=
formatter_of_buffer
buf
in
kfprintf
(
fun
_
->
pp_print_flush
fmt
()
;
let
s
=
Buffer
.
contents
buf
in
Buffer
.
clear
buf
;
error
s
)
fmt
f
(** print'n'prove *)
exception
NoPrinter
exception
UnknownPrinter
of
string
exception
UnknownTransform
of
string
let
print_task
drv
fmt
task
=
let
p
=
match
get_printer
drv
with
|
None
->
errorm
"no printer specified in the driver file"
|
Some
p
->
p
in
let
printer
=
try
lookup_printer
p
with
Not_found
->
errorm
"unknown printer %s"
p
in
let
lookup
t
=
try
lookup_transform
t
with
Not_found
->
errorm
"unknown transformation %s"
t
in
let
transl
=
List
.
map
lookup
(
get_transform
drv
)
in
let
apply
task
tr
=
Register
.
apply_driver
tr
drv
task
in
let
task
=
List
.
fold_left
apply
task
transl
in
let
printer
=
printer
(
driver_query
drv
task
)
in
print_prelude
drv
task
fmt
;
fprintf
fmt
"@[%a@]@?"
printer
task
let
prove_task
?
debug
~
command
~
timelimit
~
memlimit
drv
task
=
let
buf
=
Buffer
.
create
1024
in
let
fmt
=
formatter_of_buffer
buf
in
print_task
drv
fmt
task
;
pp_print_flush
fmt
()
;
call_on_buffer
?
debug
~
command
~
timelimit
~
memlimit
drv
buf
src/driver/prover.mli
0 → 100644
View file @
22e13e75
(**************************************************************************)
(* *)
(* Copyright (C) 2010- *)
(* Francois Bobot *)
(* Jean-Christophe Filliatre *)
(* Johannes Kanig *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
val
print_task
:
Driver
.
driver
->
Format
.
formatter
->
Task
.
task
->
unit
val
prove_task
:
?
debug
:
bool
->
command
:
string
->
timelimit
:
int
->
memlimit
:
int
->
Driver
.
driver
->
Task
.
task
->
unit
->
Call_provers
.
prover_result
(** {2 error reporting} *)
type
error
exception
Error
of
error
val
report
:
Format
.
formatter
->
error
->
unit
src/
core
/register.ml
→
src/
driver
/register.ml
View file @
22e13e75
...
...
@@ -17,22 +17,22 @@
(* *)
(**************************************************************************)
open
Env
open
Task
open
Trans
open
Driver
type
'
a
value
=
env
option
->
'
a
type
use
=
Theory
.
use_map
type
clone
=
Theory
.
clone_map
type
query
=
driver_query
type
'
a
value
=
Env
.
env
option
->
driver
option
->
task
->
'
a
type
'
a
registe
re
d
=
{
type
'
a
trans_
re
g
=
{
mutable
value
:
'
a
value
;
generate
:
unit
->
'
a
value
;
}
type
'
a
trans_reg
=
(
task
->
'
a
)
registered
type
'
a
tlist_reg
=
(
task
->
'
a
list
)
registered
type
use
=
Theory
.
use_map
type
clone
=
Theory
.
clone_map
type
'
a
tlist_reg
=
'
a
list
trans_reg
let
create
gen
=
{
value
=
gen
()
;
...
...
@@ -41,7 +41,7 @@ let create gen = {
exception
ArgumentNeeded
let
memo
tag
f
=
let
memo
tag
f
=
let
h
=
Hashtbl
.
create
7
in
function
|
None
->
raise
ArgumentNeeded
...
...
@@ -53,7 +53,8 @@ let memo tag f =
Hashtbl
.
add
h
t
r
;
r
let
memo_env
e
=
memo
env_tag
e
let
memo_env
e
=
memo
Env
.
env_tag
e
let
memo_query
q
=
memo
query_tag
q
let
memo2
extract
f
=
let
h
=
Hashtbl
.
create
7
in
...
...
@@ -64,80 +65,95 @@ let memo2 extract f =
let
r
=
f
arg
x
in
Hashtbl
.
add
h
tag
r
;
r
let
memo_clone
x
=
memo2
(
fun
t
->
let
t
=
last_clone
t
in
task_clone
t
,
task_tag
t
)
x
let
memo_use
x
=
memo2
(
fun
t
->
let
t
=
last_use
t
in
task_used
t
,
task_tag
t
)
x
let
memo_task
x
=
memo2
(
fun
t
->
t
,
task_tag
t
)
x
let
store
f
=
let
gen
()
=
let
f0
_
task
=
Trans
.
apply
(
f
()
)
task
in
f0
in
create
gen
let
store0
memo_env
f
=
let
gen
()
=
let
f0
()
env
task
=
Trans
.
apply
(
f
()
env
)
task
in
memo_env
(
f0
()
)
in
create
gen
let
store1
memo_env
memo_arg2
f
=
let
gen
()
=
let
f0
()
env
arg2
task
=
Trans
.
apply
(
f
()
env
arg2
)
task
in
let
f1
()
env
=
memo_arg2
(
f0
()
env
)
in
memo_env
(
f1
()
)
in
create
gen
let
store2
memo_env
memo_arg2
memo_arg3
f
=
let
gen
()
=
let
f0
()
env
arg2
arg3
task
=
Trans
.
apply
(
f
()
env
arg2
arg3
)
task
in
let
f1
()
env
arg2
=
memo_arg3
(
f0
()
env
arg2
)
in
let
f2
()
env
=
memo_arg2
(
f1
()
env
)
in
memo_env
(
f2
()
)
in
create
gen