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

	* testsuite/melt/tletmacro-3.melt: New file.
	* testsuite/melt/tletmacro-3-loaded.melt: New file.

	* melt/warmelt-macro.melt (mexpand_load): More debug.



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

4 files changed, 57 insertions, 4 deletions

diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT
index 1ec4c7aac46..415c9d5b78b 100644
--- a/gcc/ChangeLog.MELT
+++ b/gcc/ChangeLog.MELT
@@ -1,4 +1,11 @@
 
+2014-10-02  Basile Starynkevitch  <basile@starynkevitch.net>
+
+	* testsuite/melt/tletmacro-3.melt: New file.
+	* testsuite/melt/tletmacro-3-loaded.melt: New file.
+
+	* melt/warmelt-macro.melt (mexpand_load): More debug.
+
 2014-10-01  Basile Starynkevitch  <basile@starynkevitch.net>
 
 	* Makefile.in (melt.encap): Add dependency on generated
diff --git a/gcc/melt/warmelt-macro.melt b/gcc/melt/warmelt-macro.melt
index 0e8512367e2..823ff4db1bf 100644
--- a/gcc/melt/warmelt-macro.melt
+++ b/gcc/melt/warmelt-macro.melt
@@ -4923,11 +4923,12 @@ messages. Syntax is (DEFSELECTOR <symbol> <selector-class> [:doc
 
 ;;;; the load expander should return the tuple of expanded stuff read from the file
 (defun mexpand_load (sexpr env mexpander modctx)
-  (debug "mexpand_load start sexpr" sexpr)
+  (debug "mexpand_load start sexpr=" sexpr "\n.. env=" env)
   (assert_msg "check sexpr" (is_a sexpr class_sexpr) sexpr)
   (assert_msg "check env" (is_a env class_environment) env)
   (assert_msg "check modctx" (is_object modctx) modctx)
-  (if (null mexpander) (setq mexpander macroexpand_1))
+  (assert_msg "check mexpander" (is_closure mexpander) mexpander)
+  (shortbacktrace_dbg "mexpand_load" 15)
   (let ( (cont (unsafe_get_field :sexp_contents sexpr))
 	 (loc  (unsafe_get_field :loca_location sexpr))
 	 (curpair (pair_tail (list_first cont)))
@@ -4943,11 +4944,11 @@ messages. Syntax is (DEFSELECTOR <symbol> <selector-class> [:doc
      ( (is_string filnam)
        (inform_strv loc "MELT loading file " filnam)
        (let ( (curead (read_file filnam)) )
-	 (debug "mexpand_load curead" curead)
+	 (debug "mexpand_load"" curead=" curead)
 	 (let ( (explist (macroexpand_toplevel_list curead env mexpander modctx)) 
 		(exptuple (list_to_multiple explist discr_multiple))
 		)
-	   (debug "mexpand_load return exptuple" exptuple)
+	   (debug "mexpand_load" " return exptuple=" exptuple)
 	   (return exptuple)
 	   )
 	 )
diff --git a/gcc/testsuite/melt/tletmacro-3-loaded.melt b/gcc/testsuite/melt/tletmacro-3-loaded.melt
new file mode 100644
index 00000000000..bd2e855a36d
--- /dev/null
+++ b/gcc/testsuite/melt/tletmacro-3-loaded.melt
@@ -0,0 +1,6 @@
+;; file tletmacro-3-loaded.melt in -*- Lisp -*- 
+;; see file tletmacro-3.melt which loads this file
+(loadedmac aa)
+(loadedmac bb)
+(loadedmac cc)
+;; eof tletmacro-3-loaded.melt
diff --git a/gcc/testsuite/melt/tletmacro-3.melt b/gcc/testsuite/melt/tletmacro-3.melt
new file mode 100644
index 00000000000..bdcd283a094
--- /dev/null
+++ b/gcc/testsuite/melt/tletmacro-3.melt
@@ -0,0 +1,39 @@
+;; file tletmacro-3.melt -*- lisp -*-
+;; this sample code is in the public domain
+#| run in buildir/gcc
+ ln -sv $GCCMELT_SOURCE/gcc/testsuite/melt/tletmacro-3.melt
+ ln -sv $GCCMELT_SOURCE/gcc/testsuite/melt/tletmacro-3-loaded.melt
+
+ ./cc1 -fmelt-mode=runfile @meltbuild-common.args -Iinclude/ \
+    -fmelt-init=@warmelt.quicklybuilt -fmelt-arg=tletmacro-3.melt \
+     /dev/null -o /dev/null
+## perhaps also: -fmelt-debugging=all -fmelt-out-descr-comment
+
+or in a MELT module
+
+gcc -fplugin=melt -fplugin-arg-melt-mode=runfile @meltbuild-common.args \
+    -fplugin-arg-melt-init=@melt-default-modules.quicklybuilt -fplugin-arg-melt-arg=tletmacro-3.melt \
+     -c -x c /dev/null -o /dev/null
+|#
+(module_is_gpl_compatible "public domain")
+
+(let (
+      (the_stdout (unsafe_get_field :sysdata_stdout initial_system_data))
+      (:macro loadedmac (sexp env mexpander modctx)
+	      (debug "macro loadedmac" " sexp=" sexp)
+	      (let ( (arg1 (list_nth (usafe_get_field :sexp_contents sexp) 1))
+		     (sloc (unsafe_get_field :loca_location sexp))
+		     (sline (get_int sloc))
+		     (res (instance class_source_apply
+				    :loca_location sloc
+				    :sapp_fun 'add2out
+				    :sargop_args (tuple 'the_stdout "loadedmac@" sline ":" arg1)))
+		     )
+		(debug "macro loadedmac" " arg1=" arg1 " sline=" sline
+		       "\n.. res=" res)
+		res))
+      )
+  (debug "before loading tletmacro-3-loaded")
+  (load "tletmacro-3-loaded.melt")
+  (debug "after loading tletmacro-3-loaded")  
+  )