2014-10-19 Basile Starynkevitch <basile@starynkevitch.net>

	* melt/warmelt-first.melt (class_any_module_context): add
	mocx_basenv field.
	* melt/warmelt-macro.melt (install_global_definition): New
	incomplete function..
	* melt/warmelt-normal.melt (normexp_defcmatcher): More debug.
	* melt/warmelt-modes.melt (makedoc_docmd): Set mocx_basenv field.
	* melt/warmelt-outobj.melt (compile_list_sexpr)
	(compile_first_bootstrap_list_sexpr)
	(melt_translate_run_macroexpansions_list): Likewise.
	* testsuite/melt/t-macrocmat.melt: Improved.



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

1 files changed, 38 insertions, 41 deletions

diff --git a/gcc/melt/warmelt-normal.melt b/gcc/melt/warmelt-normal.melt
index 89e140e79c6..2d6a033575f 100644
--- a/gcc/melt/warmelt-normal.melt
+++ b/gcc/melt/warmelt-normal.melt
@@ -7536,7 +7536,7 @@ source location.}#
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;; normalize a DEFCMATCHER
 (defun normexp_defcmatcher (recv env ncx psloc)
-  (debug "normexp_defcmatcher recv=" recv "; env=" debug_more env)
+  (debug "normexp_defcmatcher recv=" recv "\n.. env=" debug_more env)
   (assert_msg "check defcmatcher recv" (is_a recv class_source_defcmatcher) recv)
   (assert_msg "check env" (is_a env class_environment) env)
   (assert_msg "check ncx" (is_a ncx class_normalization_context) ncx)
@@ -7619,51 +7619,48 @@ source location.}#
 			nstatcmadata)
       )
 ;;; fill the cmatch_exptest of insdata
-    (if (is_multiple testcma)
-	(progn
-	  (fill_normal_expansion testcma testtup ncx sloc)
-	  (let ( (ntesttupdata  (instance class_nrep_datatuple
-					  :nrep_loc sloc
-					  :ndata_name sname
-					  :ndata_discrx (normal_predef discr_multiple ncx sloc "discr_multiple")
-					  :ntup_comp testtup))
-		 )
-	    (add_nctx_data ncx ntesttupdata)
-	    (multiple_put_nth slotup (get_int cmatch_exptest) ntesttupdata)
-	    )
-	  ))
+    (when (is_multiple testcma)
+      (fill_normal_expansion testcma testtup ncx sloc)
+      (let ( (ntesttupdata  (instance class_nrep_datatuple
+				      :nrep_loc sloc
+				      :ndata_name sname
+				      :ndata_discrx (normal_predef discr_multiple ncx sloc "discr_multiple")
+				      :ntup_comp testtup))
+	     )
+	(add_nctx_data ncx ntesttupdata)
+	(multiple_put_nth slotup (get_int cmatch_exptest) ntesttupdata)
+	)
+      )
 ;;; fill the cmatch_expfill of insdata
-    (if (is_multiple fillcma)
-	(progn
-	  (fill_normal_expansion fillcma filltup ncx sloc)
-	  (let ( (nfilltupdata  (instance class_nrep_datatuple
-					  :nrep_loc sloc
-					  :ndata_name sname
-					  :ndata_discrx (normal_predef discr_multiple ncx sloc "discr_multiple")
-					  :ntup_comp filltup))
-		 )
-	    (add_nctx_data ncx nfilltupdata)
-	    (multiple_put_nth slotup (get_int cmatch_expfill) nfilltupdata)
-	    )
-	  ))
+    (when (is_multiple fillcma)
+      (fill_normal_expansion fillcma filltup ncx sloc)
+      (let ( (nfilltupdata  (instance class_nrep_datatuple
+				      :nrep_loc sloc
+				      :ndata_name sname
+				      :ndata_discrx (normal_predef discr_multiple ncx sloc "discr_multiple")
+				      :ntup_comp filltup))
+	     )
+	(add_nctx_data ncx nfilltupdata)
+	(multiple_put_nth slotup (get_int cmatch_expfill) nfilltupdata)
+	)
+      )
 ;;; fill the cmatch_expoper of insdata
-    (if (is_multiple opercma)
-	(progn
-	  (fill_normal_expansion opercma opertup ncx sloc)
-	  (let ( (nopertupdata  (instance class_nrep_datatuple
-					  :nrep_loc sloc
-					  :ndata_name sname
-					  :ndata_discrx (normal_predef discr_multiple ncx sloc "discr_multiple")
-					  :ntup_comp opertup))
-		 )
-	    (add_nctx_data ncx nopertupdata)
-	    (multiple_put_nth slotup (get_int cmatch_expoper) nopertupdata)
-	    )
-	  ))
+    (when (is_multiple opercma)
+      (fill_normal_expansion opercma opertup ncx sloc)
+      (let ( (nopertupdata  (instance class_nrep_datatuple
+				      :nrep_loc sloc
+				      :ndata_name sname
+				      :ndata_discrx (normal_predef discr_multiple ncx sloc "discr_multiple")
+				      :ntup_comp opertup))
+	     )
+	(add_nctx_data ncx nopertupdata)
+	(multiple_put_nth slotup (get_int cmatch_expoper) nopertupdata)
+	)
+      )
 ;;; put the data in the binding
     (put_fields cmbind :fixbind_data insdata)
     ;; return the data
-    (debug "normexp_defcmatcher return insdata" insdata)
+    (debug "normexp_defcmatcher return insdata=" insdata)
     (return insdata ())
     )
   )