2009-12-02 Basile Starynkevitch <basile@starynkevitch.net>

	{{more work for letrec, but tletrec.melt test is failing still}}
	* gc/melt/REAME-MELT: updated a bit, don't mention melt-cc-script
	anymore.
	* gcc/melt/warmelt-genobj.melt: added compiletrec_lambda &
	compiletrec_tuple but they probably don't work yet.
	* gcc/melt/warmelt-outobj.melt: don't inform about generated C files,
	since the runtime inform about these..



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

4 files changed, 84 insertions, 12 deletions

diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT
index fc6bac96111..16bc0e016d1 100644
--- a/gcc/ChangeLog.MELT
+++ b/gcc/ChangeLog.MELT
@@ -1,3 +1,13 @@
+2009-12-02  Basile Starynkevitch  <basile@starynkevitch.net>
+
+	{{more work for letrec, but tletrec.melt test is failing still}}
+	* melt/REAME-MELT: updated a bit, don't mention melt-cc-script
+	anymore.
+	* melt/warmelt-genobj.melt: added compiletrec_lambda &
+	compiletrec_tuple but they probably don't work yet.
+	* melt/warmelt-outobj.melt: don't inform about generated C files,
+	since the runtime inform about these..
+
 2009-12-01  Basile Starynkevitch  <basile@starynkevitch.net>
 
 	* Makefile.in (upgrade-warmelt, upgrade-bigmelt): recoded entirely
diff --git a/gcc/melt/README-MELT b/gcc/melt/README-MELT
index 152b3c9431c..3bdba9fdec4 100644
--- a/gcc/melt/README-MELT
+++ b/gcc/melt/README-MELT
@@ -5,17 +5,14 @@ and my GCC summit 2007 paper
 Multi-stage construction of a global static analyser by Basile Starynkevitch, pages 143 - 152
 
 This directory contains melt files. MELT is a dialect of Lisp compiled
-into C code which should be compilable (by the strange melt-cc-script
-invoking any GCC [or perhaps even another compiler?] with the
-appropriate -fPIC and -I options (and using some melt-private-headers
-directory containing the required *.h files from GCC source tree
-needed to compile the MELT generated C code).
+into C code which should be compilable with the appropriate -fPIC and
+-I options (perhaps using some melt-private-headers directory containing
+the required *.h files from GCC source tree needed to compile the MELT
+generated C code).
 
 The MELT source files -a lisp like code- are *.melt and used to be
 .bysl before April 9th 2009 (MELT branch rev 145716)
 
-
-
 See the gcc/doc/melt.texi  file.
 
 #### comments and questions to <basile@starynkevitch.net> 
diff --git a/gcc/melt/warmelt-genobj.melt b/gcc/melt/warmelt-genobj.melt
index fa026274d23..3e982f7d236 100644
--- a/gcc/melt/warmelt-genobj.melt
+++ b/gcc/melt/warmelt-genobj.melt
@@ -1891,12 +1891,76 @@
 (install_method discr_any_receiver compile_letrec_fill fail_compiletrecfill)
 
 ;;;;;;;;;;;;;;;;
+;; generate inside the body list the code for filling lambda in letrecs
 (defun compiletrec_lambda (recv obva obodl gcx sloc)
   (debug_msg recv "compiletrec_lambda recv")
   (debug_msg obva "compiletrec_lambda obva")
-  (assert_msg "$@$unimplemented compiletrec_lambda" ())
-)
-
+  (assert_msg "check recv" (is_a recv class_normal_constructed_lambda_binding))
+  (assert_msg "check obva" (is_a obva class_objlocv))
+  (assert_msg "check obodl" (is_list obodl))
+  (let ( (loc (or (get_field :nconsb_loc recv) sloc))
+	 (nclosed (get_field :nlambdab_nclosed recv))
+	 (nrout (get_field :nlambdab_datarout recv))
+	 )
+    (debug_msg nclosed "compiletrec_lambda nclosed tuple")
+    (foreach_in_multiple 
+     (nclosed) 
+     (curclosed :long curix)
+     (debug_msg curclosed "compiletrec_lambda curclosed")
+     (let ( (oclosed (compile_obj curclosed gcx)) 
+	    )
+       (debug_msg oclosed "compiletrec_lambda oclosed")
+       (if (is_not_a oclosed class_objpurevalue)
+	   (list_append obodl oclosed))
+       (let ( (oputclo (instance class_objputclosedv
+				 :obi_loc loc
+				 :opclov_clos obva
+				 :opclov_off (make_integerbox discr_integer curix)
+				 :opclov_cval oclosed
+				 )) 
+	      )
+	 (debug_msg oputclo "compiletrec_lambda oputclo")
+	 (list_append obodl oputclo)
+	 ;; do we need to touch the obva?
+	 (compile_warning "maybe compiletrec_lambda should add a touch objcode")
+	 ))
+     (debug_msg obodl "compiletrec_lambda final obodl")
+     )))
+(install_method class_normal_constructed_lambda_binding compile_letrec_fill compiletrec_lambda)
+
+;; generate inside the body list the code for filling tuple in letrecs
+(defun compiletrec_tuple (recv obva obodl gcx sloc)
+  (debug_msg recv "compiletrec_tuple recv")
+  (debug_msg obva "compiletrec_tuple obva")
+  (assert_msg "check recv" (is_a recv class_normal_constructed_tuple_binding))
+  (assert_msg "check obva" (is_a obva class_objlocv))
+  (assert_msg "check obodl" (is_list obodl))
+  (let ( (loc (or (get_field :nconsb_loc recv) sloc))
+	 (ncomptup (get_field :ntupb_comp recv))
+	 )
+    (debug_msg ncomptup "compiletrec_tuple ncomptup")
+    (foreach_in_multiple
+     (ncomptup)
+     (ncurcomp :long ix)
+     (debug_msg ncurcomp "compiletrec_tuple ncurcomp")
+     (let ( (ocomp (compile_obj ncurcomp gcx)) 
+	    (oputn (instance class_objputuple
+			     :obi_loc loc
+			     :oputu_tupled obva
+			     :oputu_offset (make_integerbox discr_integer ix)
+			     :oputu_value ocomp
+			     ))
+	    )
+       (debug_msg ocomp "compiletrec_tuple ocomp")
+       (if (is_not_a ocomp class_objpurevalue)
+	   (list_append obodl ocomp))
+       (list_append obodl oputn)
+     ))
+    ;; do we need to touch the obva?
+    (compile_warning "maybe compiletrec_tuple should add a touch objcode")
+    (debug_msg obodl "compiletrec_tuple final obodl")
+    ))
+(install_method class_normal_constructed_tuple_binding compile_letrec_fill compiletrec_tuple)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; compile of LETREC
 (defun compilobj_nrep_letrec (rlet gcx)
@@ -1959,6 +2023,7 @@
        (debug_msg obva "compilobj_nrep_letrec again obva")
        (debug_msg curbnd "compilobj_nrep_letrec again curbnd")
        (compile_letrec_fill curbnd obva obodl gcx loc)
+       (debug_msg obodl "compilobj_nrep_letrec letrecfilled obodl")
      ))
     ;; should compile the body
     (compile_warning "unimplemented compilobj_nrep_letrec")
diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt
index 2a2b83cd524..010c62862eb 100644
--- a/gcc/melt/warmelt-outobj.melt
+++ b/gcc/melt/warmelt-outobj.melt
@@ -3125,7 +3125,7 @@
 						    (melt_ptr_t)($declbuf),
 						    (melt_ptr_t)($implbuf)) ;
 			}#)
-	    (informsg_strv "warmelt generated module C file" modnamstr)
+	    ;(informsg_strv "warmelt generated module C file" modnamstr)
 	    (if (not (wants_single_c_file))
 		(let ( (secfiles (get_field :mocx_filetuple modctx)) )
 		  (debug_msg secfiles "compile_list_sexpr secfiles")
@@ -3151,7 +3151,7 @@
 							(melt_ptr_t)($secimplbuf),
 							$filix) ;
 			    }#)
-			   (informsg_strv "warmelt generated secondary C file" secfilpath)
+			   ;(informsg_strv "warmelt generated secondary C file" secfilpath)
 			   ))
 		     )))))))))
   (message_dbg "ended compile_list_sexpr")