2009-07-22 Basile Starynkevitch <basile@starynkevitch.net>

	[tmatch-4 compiles, but perhaps wrongly; the runfile command does
	not work...]
	* melt/warmelt-macro.melt: added debugprint in mexpand_match.
	* melt/warmelt-normatch.melt: added assert in normexp_match.
	* melt/warmelt-genobj.melt: added more debugprint notably in
	compilmatcher_cmatcher.
	* melt/warmelt-outobj.melt: replaced some multiple_every with
	foreach_in_multiple. class_objlocatedexpv may have null contents,
	at least for ctype_void -that is an empty C generated block-.
	* melt/ana-simple.melt: restored to previous version, but probably
	still miscompiled...



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@149949 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 44 insertions, 19 deletions

diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT
index 222bc91dab9..c5ccbbc314d 100644
--- a/gcc/ChangeLog.MELT
+++ b/gcc/ChangeLog.MELT
@@ -1,5 +1,18 @@
 
 2009-07-22  Basile Starynkevitch  <basile@starynkevitch.net>
+	[tmatch-4 compiles, but perhaps wrongly; the runfile command does
+	not work...]
+	* melt/warmelt-macro.melt: added debugprint in mexpand_match.
+	* melt/warmelt-normatch.melt: added assert in normexp_match.
+	* melt/warmelt-genobj.melt: added more debugprint notably in
+	compilmatcher_cmatcher.
+	* melt/warmelt-outobj.melt: replaced some multiple_every with
+	foreach_in_multiple. class_objlocatedexpv may have null contents,
+	at least for ctype_void -that is an empty C generated block-.
+	* melt/ana-simple.melt: restored to previous version, but probably
+	still miscompiled...
+
+2009-07-22  Basile Starynkevitch  <basile@starynkevitch.net>
 	* testsuite/melt/tmatch-4.melt: new file.
 	* testsuite/melt/tmatch-3.melt: updated comment.
 	* melt/ana-simple.melt: tomporarily remove code until tmatch-4
diff --git a/gcc/melt/ana-simple.melt b/gcc/melt/ana-simple.melt
index 1bc9ca2c199..2d03eb1742e 100644
--- a/gcc/melt/ana-simple.melt
+++ b/gcc/melt/ana-simple.melt
@@ -56,8 +56,6 @@
 	    (debugtree "makegreen_transform assign cast lhs" lhs)
 	    (debugtree "makegreen_transform assign cast rhs" rhs)
 	    )
-	  ;; we comment out the following, which fail to compile
-	  #|
 	  (?(gimple_assign_single  ?lhs 
 				   ?(as ?rhs
 					?(tree_var_decl 
@@ -65,7 +63,6 @@
 	    (debugtree "makegreen_transform assign single stdout lhs" lhs)
 	    (debugtree "makegreen_transform assign single stdout rhs" rhs)
 	    )
-	  |#
 	  (?(gimple_assign_single  ?lhs ?rhs)
 	    (debugtree "makegreen_transform assign single lhs" lhs)
 	    (debugtree "makegreen_transform assign single rhs" rhs)
diff --git a/gcc/melt/warmelt-genobj.melt b/gcc/melt/warmelt-genobj.melt
index 894455958fe..e8c8c9409e5 100644
--- a/gcc/melt/warmelt-genobj.melt
+++ b/gcc/melt/warmelt-genobj.melt
@@ -4290,6 +4290,7 @@
 			 :obcond_then othenblock
 			 :obcond_else oelseblock))
 	)
+    (debug_msg otest "compiltst_normtester_instance otest")
     (debug_msg gotothen "compiltst_normtester_instance gotothen")
     (debug_msg gotoelse "compiltst_normtester_instance gotoelse")
     (debug_msg ocond "compiltst_normtester_instance oclass")
@@ -4395,6 +4396,7 @@
 			 :obcond_else oelseblock))
 	(olist (make_list discr_list))
 	)
+    (debug_msg ocond "compiltst_normtester_same ocond")
     ;; clear the freelist
     (foreach_in_list
      (freelist)
@@ -4588,6 +4590,9 @@
 	  )
       (debug_msg exptest "compilmatcher_cmatcher exptest")
       (debug_msg expfill  "compilmatcher_cmatcher expfill")
+      (assert_msg "compilmatcher_cmatcher check exptest" exptest)
+      (debug_msg testchunk "compilmatcher_cmatcher testchunk")
+      (debug_msg fillchunk "compilmatcher_cmatcher fillchunk")
       (let ( 
 	    (othenlist (make_list discr_list))
 	    (othenbody (instance class_objblock
@@ -4606,6 +4611,7 @@
 			     :obcond_else oelsebody
 			     ))
 	    )
+	(debug_msg ocond "compilmatcher_cmatcher ocond")
 	(list_append olist ocond)
 	(foreach_in_multiple
 	 (cmouts)
diff --git a/gcc/melt/warmelt-macro.melt b/gcc/melt/warmelt-macro.melt
index 7ea7451d7f9..1d0d04c6947 100644
--- a/gcc/melt/warmelt-macro.melt
+++ b/gcc/melt/warmelt-macro.melt
@@ -3393,7 +3393,10 @@
 					      :pctx_mexpander mexpander
 					      :pctx_pexpander patternexpand_1
 					      :pctx_varmap (make_mapobject discr_mapobjects 13)))
-			 (curpat (patternexpand_1 curmatchpatx env curpatctx curmatchloc))
+			 (curpat (let ( (cp (patternexpand_1 curmatchpatx env curpatctx curmatchloc)) )
+					(debug_msg cp "mexpand_match curpat")
+					(assert_msg "check curpat" cp)
+					cp))
 			 (curbody (expand_pairlist_as_tuple curmatchrestpairs env mexpander))
 			 (curcase (instance class_src_casematch
 					    :src_loc curmatchloc
diff --git a/gcc/melt/warmelt-normatch.melt b/gcc/melt/warmelt-normatch.melt
index 88e5ae93b4c..32d5608dcea 100644
--- a/gcc/melt/warmelt-normatch.melt
+++ b/gcc/melt/warmelt-normatch.melt
@@ -1386,6 +1386,9 @@
 			     ))
 	      (ntestcont (instance class_container)) ;container for tester
 	      )
+	  ;; I am not entirely sure of this assert! Perhaps there maybe
+	  ;; strange cases where curpat is null...
+	  (assert_msg "normexp_match check curpat" curpat)
 	  (scan_pattern curpat curloc ctyp pcn)
 	  (debug_msg mapvar "normexp_match mapvar")
 	  (debug_msg mapcst "normexp_match mapcst")
diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt
index 3f8da326889..7e3e99c3c62 100644
--- a/gcc/melt/warmelt-outobj.melt
+++ b/gcc/melt/warmelt-outobj.melt
@@ -2728,11 +2728,10 @@
 	 (boxdepthp1 (make_integerbox discr_integer (+i depth 1)))
 	 )
     (assert_msg "check cont" (is_multiple cont))
-    (multiple_every
-     cont
-     (lambda (comp :long ix)
-       (output_c_code comp declbuf implbuf (get_int boxdepthp1)))))
-  )
+    (foreach_in_multiple
+     (cont)
+     (comp :long ix)
+     (output_c_code comp declbuf implbuf (get_int boxdepthp1)))))
 (install_method class_objexpv output_c_code outpucod_objexpv)
 
 ;;; output a located expression
@@ -2743,7 +2742,8 @@
 	 (boxdepthp1 (make_integerbox discr_integer (+i depth 1)))
 	 (otyp (unsafe_get_field :obv_type oexp))
 	 )
-    (assert_msg "check cont" (is_multiple cont))
+    ;; the cont may be null
+    (assert_msg "check cont" (is_multiple_or_null cont))
     (if (== otyp ctype_void)
 	(progn
 	  (add2sbuf_indentnl implbuf depth)
@@ -2755,10 +2755,11 @@
 	  (output_raw_location oloc implbuf depth "expr")
 	)
       )
-    (multiple_every
-     cont
-     (lambda (comp :long ix)
-       (output_c_code comp declbuf implbuf (get_int boxdepthp1))))
+    ;;
+    (foreach_in_multiple
+     (cont)
+     (comp :long ix)
+     (output_c_code comp declbuf implbuf (get_int boxdepthp1)))
     (if (== otyp ctype_void)
 	(progn
 	  (add2sbuf_strconst implbuf ";}")
diff --git a/gcc/testsuite/melt/tmatch-4.melt b/gcc/testsuite/melt/tmatch-4.melt
index 255c294c5ea..2033bffe42e 100644
--- a/gcc/testsuite/melt/tmatch-4.melt
+++ b/gcc/testsuite/melt/tmatch-4.melt
@@ -4,7 +4,7 @@
 #| run in buildir/gcc
  ./cc1 -fmelt=translatefile  -fmelt-module-path=.    -fmelt-source-path=.:...melt-source \
     -fmelt-compile-script=./built-melt-cc-script \
-    -fmelt-tempdir=/tmp -fmelt-init=@warmelt2 \
+    -fmelt-tempdir=/tmp -fmelt-init=@warmelt2:ana-base \
     -fmelt-arg=.../tmatch-4.melt -fmelt-debug empty-file-for-melt.c
 |#
 
@@ -19,10 +19,12 @@
    (:gimple g)
    (debuggimple "tmatch4_transform before matching g" g)
    (match g
-	  (?(gimple_assign_single  ?lhs 
-				   ?(as ?rhs
-					?(tree_var_decl 
-					  ?(cstring_same "stdout"))))
+	  (?(gimple_assign_single  
+	     ?lhs 
+	     ?(as ?rhs
+		  ?(tree_var_decl 
+		    ?(cstring_same "stdout"))))
+	    ;
 	    (debugtree "tmatch4_transform assign single stdout lhs" lhs)
 	    (debugtree "tmatch4_transform assign single stdout rhs" rhs)
 	    )