2009-09-00 Basile Starynkevitch <basile@starynkevitch.net>

	[while adding makedoc command, found a bug in matcher translation,
	so added testcase tmatch-5.melt]
	* gcc/doc/melt.texi: Improved documentation about quote, and example
	of primitive.
	* gcc/melt-make.mk (meltarg_arglis): Added variable.
	(meltgendoc.texi): Added new target.
	* gcc/testsuite/melt/tmatch-5.melt: Added new file.
	* gcc/melt/warmelt-outobj.melt: Start adding makedoc command.



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

5 files changed, 123 insertions, 8 deletions

diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT
index a78cbdeffdf..b4abbd3a4d6 100644
--- a/gcc/ChangeLog.MELT
+++ b/gcc/ChangeLog.MELT
@@ -1,4 +1,14 @@
 
+2009-09-00  Basile Starynkevitch  <basile@starynkevitch.net>
+	[while adding makedoc command, found a bug in matcher translation,
+	so added testcase tmatch-5.melt]
+	* doc/melt.texi: Improved documentation about quote, and example
+	of primitive.
+	* melt-make.mk (meltarg_arglis): Added variable.
+	(meltgendoc.texi): Added new target.
+	* testsuite/melt/tmatch-5.melt: Added new file.
+	* melt/warmelt-outobj.melt: Start adding makedoc command.
+
 2009-09-08  Basile Starynkevitch  <basile@starynkevitch.net>
 	[the command infrastucture is improved thru the
 	CLASS_MELT_COMMAND]
diff --git a/gcc/doc/melt.texi b/gcc/doc/melt.texi
index 17bd340e6aa..8f1ba6a9e75 100644
--- a/gcc/doc/melt.texi
+++ b/gcc/doc/melt.texi
@@ -1673,10 +1673,16 @@ field named @var{:field-name1} to the value of @var{val1} etc@dots{}
 @item quote
 @cindex @code{quote} MELT syntax
 @code{(quote x)} is the same as @code{'x} and returns the symbol
-@code{x} itself (as an instance of
-@code{CLASS_SYMBOL}). [Expert]Currently, only symbols can be
-quoted. But @code{'1} and @code{'"string"} should be a way to express
-static boxed values [unimplemented].
+@code{x} itself (as an instance of @code{CLASS_SYMBOL}). When applied
+to an integer, like @code{'1}, it gives a constant boxed integer value
+(of @code{DISCR_INTEGER}). When applied to a string, like
+@code{'"string"}, it gives a constant boxed string value (of
+@code{DISCR_STRING}). Therefore, when passed as an actual argument (to
+a primitive, a function, ...) @code{'1} (a boxed integer value) is not
+the same as @code{1} (a raw integer stuff), and likewise @code{'"abc"}
+is a boxed string value, different of @code{"abc"} (a raw string
+stuff).  This is very different from other Lisps!  Only symbols,
+strings, integers can be quoted.
 
 
 @item return
@@ -1956,7 +1962,7 @@ code have to use the @code{make_integerbox} defined in
 @file{warmelt-first.melt} as
 @lisp
 (defprimitive make_integerbox (discr :long n) :value
-  "(meltgc_new_int((meltobject_ptr_t)(" discr "), (" n ")))")
+  #@{(meltgc_new_int((meltobject_ptr_t)(" discr "), (" n ")))@}#
 @end lisp
 If the passed @code{discr} is not a discriminant for boxed integers,
 @code{make_integerbox} gives nil.
@@ -2011,9 +2017,9 @@ object. We could have tested that it is indeed an instance of
 test that the discriminant's magic is indeed
 @code{OBMAG_INT}@footnote{It is essential to ensure that every MELT
 value has the good magic numer in its discriminant. Violating that
-would crash GCC.}. If either test fail, we return nil by @code{goto
-end}. We cannot code a direct @code{return} statement, because that
-would not pop the topmost MELT frame.
+would crash GCC MELT.}. If either test fail, we return nil by
+@code{goto end}. We cannot code a direct @code{return} statement,
+because that would not pop the topmost MELT frame.
 
 @verbatim
   newintv = meltgc_allocate (sizeof (struct meltint_st), 0);
diff --git a/gcc/melt-make.mk b/gcc/melt-make.mk
index 5fbd9256cba..507702200cf 100644
--- a/gcc/melt-make.mk
+++ b/gcc/melt-make.mk
@@ -43,6 +43,7 @@ meltarg_source_path=$(if $(melt_is_plugin),-fplugin-arg-melt-source-path,-fmelt-
 meltarg_tempdir=$(if $(melt_is_plugin),-fplugin-arg-melt-tempdir,-fmelt-tempdir)
 meltarg_compile_script=$(if $(melt_is_plugin),-fplugin-arg-melt-compile-script,-fmelt-compile-script)
 meltarg_arg=$(if $(melt_is_plugin),-fplugin-arg-melt-arg,-fmelt-arg)
+meltarg_arglist=$(if $(melt_is_plugin),-fplugin-arg-melt-arglist,-fmelt-arglist)
 meltarg_output=$(if $(melt_is_plugin),-fplugin-arg-melt-output,-fmelt-output)
 
 ## MELT_DEBUG could be set to -fmelt-debug or -fplugin-arg-melt-debug
@@ -325,4 +326,16 @@ $(melt_default_modules_list).modlis:  $(WARMELT_BASE3SO) $(ANAMELT_BASESO)
 	for f in  $(ANAMELT_BASE); do echo $$f >> $@-tmp; done
 	$(melt_make_move) $@-tmp $@
 
+### generated melt documentation
+meltgendoc.texi: $(melt_default_modules_list).modlis $(WARMELT_SRCFILES) empty-file-for-melt.c
+	$(melt_cc1) $(melt_cc1flags) -Wno-shadow $(meltarg_mode)=makedoc  \
+	      $(meltarg_module_path)=.:$(melt_make_module_dir) \
+	      $(meltarg_source_path)=.:$(melt_make_source_dir):$(melt_source_dir) \
+	      $(meltarg_compile_script)=$(melt_make_compile_script) \
+	      $(meltarg_tempdir)=.  $(MELT_DEBUG) \
+	      $(meltarg_init)="@$(melt_default_modules_list)" \
+	      $(meltarg_arglist)=$(WARMELT_SRCARGLIST)  \
+	      $(meltarg_output)=$@   empty-file-for-melt.c
+
+
 #eof melt-make.mk
\ No newline at end of file
diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt
index cb71730d285..edc8627276e 100644
--- a/gcc/melt/warmelt-outobj.melt
+++ b/gcc/melt/warmelt-outobj.melt
@@ -3227,6 +3227,69 @@
 (install_melt_command translateinit_command)
 
 
+;;;;;;;;;;;;;;;;
+;;;;;
+(defun makedoc_docmd (cmd moduldata)
+  (debug_msg cmd "start makedoc_docmd cmd")
+  (debug_msg moduldata "start makedoc_docmd moduldata")
+  (let ( 
+	(parmodenv (parent_module_environment))
+	(curenv (if moduldata moduldata initial_environment))
+	(arglist (split_string_comma discr_string (melt_argument "arglist")))
+	(outarg (make_stringconst discr_string (melt_argument "output")))
+	(rlist (make_list discr_list))
+	(:long nbfil (list_length arglist))
+	)
+    (debug_msg arglist "makedoc_docmd arglist")
+    (debug_msg outarg "makedoc_docmd outarg")
+    ;; read into rlist all the stuff
+    (list_every 
+     arglist 
+     (lambda (curarg)
+       (informsg_strv "reading from file" curarg)
+       (let ( (curead (read_file curarg))
+	      )
+	 (assert_msg "check rlist" (is_list rlist))
+	 (assert_msg "check curead" (is_list_or_null curead))
+	 (debug_msg curead "makedoc_docmd curead")
+	 (list_append2list rlist curead))))
+    ;; macro expand it
+    (let ( (xlist (macroexpand_toplevel_list rlist curenv)) 
+	   (:long xlistlen (list_length xlist))
+	   )
+      (code_chunk 
+       informxlist
+       #{ inform (UNKNOWN_LOCATION,
+		  "MELT makedoc [#%ld]: read and expanded %ld expressions from %ld files",
+		  melt_dbgcounter, $xlistlen, $nbfil) ; 
+       }#)
+       (list_every
+	xlist
+	(lambda (curexp)
+	  (debug_msg curexp "makedoc_docmd curexp")
+	  ;; this exposes a bug in the translator
+#|
+	  (match 
+	   curexp 
+	   (?(instance class_srcdef 
+		       :sdef_name ?dnam
+		       :sdef_doc ?(as ?doc ?(instance class_sexpr :loca_location ?loc :sexp_contents ?docl)))
+	     (debug_msg dnam "makedoc_docmd dnam")
+	     (debug_msg doc "makedoc_docmd doc")
+	     )
+	   )
+|#
+	  )))))
+      
+
+;;;
+(definstance makedoc_command
+  class_melt_command
+  :named_name '"makedoc"
+  :meltcmd_help '"MELT 'makedoc' command: ARGLIST= input file, ...; OUTPUT= generated file"
+  :meltcmd_fun makedoc_docmd
+)
+(install_melt_command makedoc_command)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (export_values 
diff --git a/gcc/testsuite/melt/tmatch-5.melt b/gcc/testsuite/melt/tmatch-5.melt
new file mode 100644
index 00000000000..4d38d435109
--- /dev/null
+++ b/gcc/testsuite/melt/tmatch-5.melt
@@ -0,0 +1,23 @@
+; -*- lisp -*-
+;; file tmatch-5.melt
+
+#| 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-arg=.../tmatch-5.melt -fmelt-debug empty-file-for-melt.c
+|#
+
+(defun tmatch5 (curexp)
+  (match 
+   curexp 
+   (?(instance class_srcdef 
+	       :sdef_name ?dnam
+	       :sdef_doc ?(as ?doc ?(instance class_sexpr :loca_location ?loc :sexp_contents ?docl)))
+     (debug_msg dnam "makedoc_docmd dnam")
+     (debug_msg doc "makedoc_docmd doc")
+     )
+   )
+  )
+
+;; eof tmatch-5.melt
\ No newline at end of file