[m-dev.] for review: implement copying of closures
Fergus Henderson
fjh at cs.mu.OZ.AU
Tue Oct 19 01:23:10 AEST 1999
For review by Zoltan and/or Tyson.
----------
Estimated hours taken: 3
Implement deep_copy() of closures.
compiler/stack_layout.m:
Change the way we generate closure layouts
so that it matches the MR_Closure_Layout structure
defined in runtime/mercury_ho_call.h.
runtime/mercury_deep_copy_body.h:
Handle copying of closures, using the layout information
in the MR_Closure_Layout structure.
runtime/mercury_deep_copy.c:
#include "mercury_ho_call.h", since it is needed for the
MR_Closure_Layout type.
tests/hard_coded/Mmakefile:
tests/hard_coded/copy_pred.m:
tests/hard_coded/copy_pred.exp:
A test case for this change.
Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.35
diff -u -r1.35 stack_layout.m
--- compiler/stack_layout.m 1999/10/08 02:55:39 1.35
+++ compiler/stack_layout.m 1999/10/18 13:35:05
@@ -657,17 +657,10 @@
{ stack_layout__sort_livevals(LiveLvals, SortedLiveLvals) },
stack_layout__construct_liveval_arrays(SortedLiveLvals,
VarLengthRval, LiveValRval, NamesRval),
-
- ( { map__is_empty(TVarLocnMap) } ->
- { TypeParamRval = const(int_const(0)) }
- ;
- { stack_layout__construct_tvar_rvals(TVarLocnMap,
- Vector, VectorTypes) },
- stack_layout__get_next_cell_number(CNum1),
- { TypeParamRval = create(0, Vector, VectorTypes,
- must_be_static, CNum1,
- "stack_layout_type_param_locn_vector") }
- ),
+ stack_layout__get_cell_number(CNum0),
+ { stack_layout__construct_tvar_vector(TVarLocnMap,
+ TypeParamRval, CNum0, CNum) },
+ stack_layout__set_cell_number(CNum),
{ RvalList = [yes(VarLengthRval), yes(LiveValRval),
yes(NamesRval), yes(TypeParamRval)] },
{ ArgTypes = initial([1 - yes(integer), 3 - yes(data_ptr)],
@@ -677,6 +670,21 @@
{ ArgTypes = initial([1 - yes(integer)], none) }
).
+:- pred stack_layout__construct_tvar_vector(map(tvar, set(layout_locn))::in,
+ rval::out, int::in, int::out) is det.
+stack_layout__construct_tvar_vector(TVarLocnMap, TypeParamRval, CNum0, CNum) :-
+ ( map__is_empty(TVarLocnMap) ->
+ TypeParamRval = const(int_const(0)),
+ CNum = CNum0
+ ;
+ stack_layout__construct_tvar_rvals(TVarLocnMap,
+ Vector, VectorTypes),
+ CNum is CNum0 + 1,
+ TypeParamRval = create(0, Vector, VectorTypes,
+ must_be_static, CNum,
+ "stack_layout_type_param_locn_vector")
+ ).
+
:- pred stack_layout__construct_tvar_rvals(map(tvar, set(layout_locn))::in,
list(maybe(rval))::out, create_arg_types::out) is det.
@@ -952,13 +960,15 @@
ClosureLayoutInfo = closure_layout_info(ClosureArgs,
TVarLocnMap),
stack_layout__construct_closure_arg_rvals(ClosureArgs,
- ClosureArgRvals, ClosureArgTypes, CNum0, CNum),
- stack_layout__construct_tvar_rvals(TVarLocnMap, TVarRvals,
- TVarRvalTypes),
- list__append(ClosureArgRvals, TVarRvals, LayoutRvals),
+ ClosureArgRvals, ClosureArgTypes, CNum0, CNum1),
+ stack_layout__construct_tvar_vector(TVarLocnMap, TVarVectorRval,
+ CNum1, CNum),
+ TVarVectorRvals = [yes(TVarVectorRval)],
+ TVarVectorTypes = [1 - yes(data_ptr)],
+ list__append(TVarVectorRvals, ClosureArgRvals, LayoutRvals),
list__append(ProcIdRvals, LayoutRvals, Rvals),
- ArgTypes = initial(ProcIdTypes, initial(ClosureArgTypes,
- TVarRvalTypes)).
+ ArgTypes = initial(ProcIdTypes, initial(TVarVectorTypes,
+ initial(ClosureArgTypes, none))).
:- pred stack_layout__construct_closure_arg_rvals(list(closure_arg_info)::in,
list(maybe(rval))::out, initial_arg_types::out, int::in, int::out)
Index: runtime/mercury_deep_copy.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.c,v
retrieving revision 1.14
diff -u -r1.14 mercury_deep_copy.c
--- runtime/mercury_deep_copy.c 1999/08/12 09:58:48 1.14
+++ runtime/mercury_deep_copy.c 1999/10/18 12:03:52
@@ -15,6 +15,7 @@
#include "mercury_imp.h"
#include "mercury_deep_copy.h"
#include "mercury_type_info.h"
+#include "mercury_ho_call.h"
#include "mercury_memory.h"
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.12
diff -u -r1.12 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 1999/10/08 02:56:14 1.12
+++ runtime/mercury_deep_copy_body.h 1998/12/31 14:01:00
@@ -12,7 +12,6 @@
** copying application.
*/
-
/*
** Prototypes.
*/
@@ -185,7 +184,7 @@
}
break;
- case MR_TYPECTOR_REP_PRED: {
+ case MR_TYPECTOR_REP_PRED:
/*
** predicate closures store the number of curried arguments
** as their first argument, the Code * as their second, and
@@ -195,46 +194,42 @@
** pred/0, arity, and then argument typeinfos.
*/
if (in_range(data_value)) {
- int args, i;
- Word *new_closure;
-
- /* get number of curried arguments */
- args = data_value[0];
+ Unsigned args, i;
+ MR_Closure *old_closure;
+ MR_Closure *new_closure;
+ MR_Closure_Layout *closure_layout;
+
+ old_closure = (MR_Closure *) data_value;
+ closure_layout = old_closure->MR_closure_layout;
+ args = old_closure->MR_closure_num_hidden_args;
/* create new closure */
- incr_saved_hp(LVALUE_CAST(Word, new_closure), args + 2);
+ incr_saved_hp(LVALUE_CAST(Word, new_closure), args + 3);
- /* copy number of arguments */
- new_closure[0] = args;
+ /* copy the fixed fields */
+ new_closure->MR_closure_layout = closure_layout;
+ new_closure->MR_closure_num_hidden_args = args;
+ new_closure->MR_closure_code = old_closure->MR_closure_code;
- /* copy pointer to code for closure */
- new_closure[1] = data_value[1];
-
-#if 0
- /*
- ** XXX THIS IS WRONG. We don't have any information
- ** about the types of the things in closures.
- ** The pred type only tells us about the arguments
- ** which have not yet been applied, not the ones
- ** in the closure.
- */
- /* copy arguments */
+ /* copy the arguments */
for (i = 0; i < args; i++) {
- new_closure[i + 2] = copy(&data_value[i + 2],
- (const Word *)
- type_info[i + TYPEINFO_OFFSET_FOR_PRED_ARGS],
- lower_limit, upper_limit);
+ Word *arg_pseudo_type_info =
+ (Word *) closure_layout->arg_pseudo_type_info[i];
+ new_closure->MR_closure_hidden_args_0[i] =
+ copy_arg(
+ &old_closure->MR_closure_hidden_args_0[i],
+ type_info + TYPEINFO_OFFSET_FOR_PRED_ARGS - 1,
+ arg_pseudo_type_info,
+ lower_limit, upper_limit
+ );
}
-#else
- fatal_error("sorry, not implemented: cannot copy closure");
-#endif
+
new_data = (Word) new_closure;
leave_forwarding_pointer(data_ptr, new_data);
} else {
new_data = data;
found_forwarding_pointer(data);
}
- }
break;
case MR_TYPECTOR_REP_UNIV:
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.66
diff -u -r1.66 Mmakefile
--- tests/hard_coded/Mmakefile 1999/10/15 03:45:26 1.66
+++ tests/hard_coded/Mmakefile 1999/10/18 14:39:42
@@ -20,6 +20,7 @@
closure_extension \
common_type_cast \
construct \
+ copy_pred \
curry \
curry2 \
cut_test \
Index: tests/hard_coded/copy_pred.exp
===================================================================
RCS file: copy_pred.exp
diff -N copy_pred.exp
--- /dev/null Wed May 6 06:32:27 1998
+++ copy_pred.exp Tue Oct 19 01:11:26 1999
@@ -0,0 +1 @@
+10, 20, blah
Index: tests/hard_coded/copy_pred.m
===================================================================
RCS file: copy_pred.m
diff -N copy_pred.m
--- /dev/null Wed May 6 06:32:27 1998
+++ copy_pred.m Tue Oct 19 00:39:03 1999
@@ -0,0 +1,31 @@
+ :- module copy_pred.
+ :- interface.
+ :- import_module io.
+
+ :- pred main(io__state::di, io__state::uo) is det.
+
+ :- implementation.
+
+ :- import_module list, map.
+ :- import_module std_util, string.
+
+ main -->
+ { F = foo(10, 20) },
+ { copy(F, F2) },
+ io__set_globals(univ(F2)),
+ io__get_globals(Univ),
+ { det_univ_to_type(Univ, F3) },
+ { inst_cast(F3, F4) },
+ { F4("blah", S) },
+ print(S), nl.
+
+ :- pred inst_cast(pred(string, string), pred(string, string)).
+ :- mode inst_cast(in, out(pred(in, out) is det)) is det.
+ :- pragma c_code(inst_cast(X::in, Y::out(pred(in, out) is det)),
+ [will_not_call_mercury, thread_safe], "Y = X").
+
+ :- pred foo(int, int, string, string) is det.
+ :- mode foo(in, in, in, out) is det.
+ foo(A, B, S0, S) :-
+ string__format("%d, %d, %s", [i(A), i(B), s(S0)], S).
+
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list