From 35ebffe4bc978cdf5f97c7ef6e5d28bf22354315 Mon Sep 17 00:00:00 2001 From: ronny Date: Fri, 10 Dec 1999 15:11:47 +0000 Subject: handle constructor with strict arguments (for Clean 1.3.3) git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@64 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d --- frontend/Wrap.dcl | 11 ++++--- frontend/Wrap.icl | 99 ++++++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 83 insertions(+), 27 deletions(-) (limited to 'frontend') diff --git a/frontend/Wrap.dcl b/frontend/Wrap.dcl index e5c4b41..8cb683a 100644 --- a/frontend/Wrap.dcl +++ b/frontend/Wrap.dcl @@ -1,8 +1,11 @@ -definition module Wrap - /* - Wrap arbitrary Clean nodes (for debugging purposes). + Wrap Clean nodes (for debugging purposes). + + Version 1.0.1 + Ronny Wichers Schreur + ronny@cs.kun.nl */ +definition module Wrap from StdOverloaded import toString @@ -40,4 +43,4 @@ instance toString WrappedDescriptorId // other nodes | WrappedOther !WrappedDescriptor !{WrappedNode} -Wrap :: !.a -> WrappedNode \ No newline at end of file +wrapNode :: !.a -> WrappedNode \ No newline at end of file diff --git a/frontend/Wrap.icl b/frontend/Wrap.icl index eeb36d8..64f0d08 100644 --- a/frontend/Wrap.icl +++ b/frontend/Wrap.icl @@ -1,3 +1,10 @@ +/* + Wrap Clean nodes (for debugging purposes). + + Version 1.0.1 + Ronny Wichers Schreur + ronny@cs.kun.nl +*/ implementation module Wrap import StdOverloaded @@ -39,8 +46,8 @@ instance toString WrappedDescriptorId where .o 1 0 } -Wrap :: !.a -> WrappedNode -Wrap node +wrapNode :: !.a -> WrappedNode +wrapNode node = code { | A: @@ -133,7 +140,7 @@ Wrap node | B: | wrap arg push_a 1 - build e_Wrap_sWrap 1 e_Wrap_nWrap + build e_Wrap_swrapNode 1 e_Wrap_nwrapNode update_a 0 2 pop_a 1 @@ -208,6 +215,7 @@ Wrap node rtn .o 2 0 + | constructors with strict arguments are also represented by records :wrap_record pushI 0 pushD_a 0 @@ -221,37 +229,59 @@ Wrap node | (l: points to record layout, | desc: record descriptor | return: return selector) + + | determine if it's a record or a constructor with strict arguments push_b 0 + push_r_arg_t + eqC_b 'd' 0 + jmp_false is_record + + pop_b 1 + | increment if it's not a record + incI + pushB FALSE + jmp count_fields + + :is_record + pop_b 1 + pushB TRUE + + :count_fields + push_b 1 :count_fields_loop | A: - | B:

+ | B:

| (p=l+offset) push_b 0 push_r_arg_t eqI_b 0 0 jmp_true end_count_record_fields pop_b 1 - incI + + | increment

+ incI + jmp count_fields_loop :end_count_record_fields pop_b 1 push_b 0 - update_b 2 1 + update_b 3 1 subI | A: - | B: + | B: create_array_ _ 1 0 pushI 0 - push_b 1 + push_b 2 + update_b 2 3 update_b 1 2 update_b 0 1 pop_b 1 :wrap_fields_loop | A: <_{fields}> - | B:

+ | B:

push_b 0 push_r_arg_t eqI_b 0 0 @@ -268,7 +298,7 @@ Wrap node jmp_true wrap_file_field eqC_b 'a' 0 jmp_true wrap_graph_field - print_sc "Wrap: unimplemented record field type\n" + print_sc "Wrap.wrapNode: unimplemented record field type\n" halt :wrap_int_field @@ -276,12 +306,13 @@ Wrap node | create and fill int node create - fillI_b 2 0 + fillI_b 3 0 push_a 1 update_a 1 2 update_a 0 1 pop_a 1 + update_b 2 3 update_b 1 2 update_b 0 1 pop_b 1 @@ -293,12 +324,13 @@ Wrap node | create and fill char node create - fillC_b 2 0 + fillC_b 3 0 push_a 1 update_a 1 2 update_a 0 1 pop_a 1 + update_b 2 3 update_b 1 2 update_b 0 1 pop_b 1 @@ -310,12 +342,13 @@ Wrap node | create and fill bool node create - fillB_b 2 0 + fillB_b 3 0 push_a 1 update_a 1 2 update_a 0 1 pop_a 1 + update_b 2 3 update_b 1 2 update_b 0 1 pop_b 1 @@ -328,12 +361,13 @@ Wrap node | create and fill real node create - fillR_b 2 0 + fillR_b 3 0 push_a 1 update_a 1 2 update_a 0 1 pop_a 1 + update_b 2 4 update_b 1 3 update_b 0 2 pop_b 2 @@ -345,12 +379,13 @@ Wrap node | create and fill file node create - fillF_b 2 0 + fillF_b 3 0 push_a 1 update_a 1 2 update_a 0 1 pop_a 1 + update_b 2 4 update_b 1 3 update_b 0 2 pop_b 2 @@ -365,7 +400,7 @@ Wrap node | A: <_{fields}> | wrap field push_a 1 - build e_Wrap_sWrap 1 e_Wrap_nWrap + build e_Wrap_swrapNode 1 e_Wrap_nwrapNode update_a 0 2 pop_a 1 @@ -373,25 +408,31 @@ Wrap node push_b 1 update _ 1 0 | A: <_{fields}> - | B:

+ | B:

| increment index push_b 1 incI update_b 0 2 + pop_b 1 | increment pointer in layout string - pop_b 1 incI jmp wrap_fields_loop :end_wrap_record_fields | A: <_{fields}> - | B:

+ | B:

pop_b 3 | A: <_{fields}> - | B: + | B: + + push_b 1 + update_b 1 2 + update_b 0 1 + pop_b 1 + | B: | create WrappedDescriptorOther node build_r e_Wrap_rWrappedDescriptorId 0 1 0 0 @@ -400,11 +441,23 @@ Wrap node update_a 0 1 pop_a 1 | A: <{fields}> + | B: - | fill result node + | pop is_record +++ use this + jmp_false fill_constructor_result + + | fill result node for record fill_r e_Wrap_kWrappedRecord 2 0 2 0 0 pop_a 2 + jmp wrapped_record_return_to_caller + + :fill_constructor_result + | fill result node for constructor + + fill_r e_Wrap_kWrappedOther 2 0 2 0 0 + pop_a 2 + :wrapped_record_return_to_caller | A: | B: | return to caller (determined by the return selector) @@ -412,7 +465,7 @@ Wrap node jmp_true wrap_record_return_node eqI_b 1 0 jmp_true wrap_record_array_return - print_sc "Wrap: (record fields) unknown return selector\n" + print_sc "Wrap.wrapNode: (record fields) unknown return selector\n" halt :wrap_record_return_node @@ -494,7 +547,7 @@ Wrap node push_b 1 push_a 1 select _ 1 0 - build e_Wrap_sWrap 1 e_Wrap_nWrap + build e_Wrap_swrapNode 1 e_Wrap_nwrapNode | A: <_wrapped_array> <_array> | B: | update i-th element of _wrapped_array with wrapped element -- cgit v1.2.3