2008-10-07 Basile Starynkevitch <basile@starynkevitch.net>

	[export_patmacro does not work well]
	* melt/warmelt-first.bysl: added debug_msg in initpatmacro_exporter.
	* melt/warmelt-macro.bysl: adding class_srcpattern_or.
	temporarily an oror_ patmacro..
	* melt/warmelt-normal.bysl: reindented.


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

4 files changed, 46 insertions, 9 deletions

diff --git a/gcc/ChangeLog.melt b/gcc/ChangeLog.melt
index d2088a3a212..c4a68f2afb5 100644
--- a/gcc/ChangeLog.melt
+++ b/gcc/ChangeLog.melt
@@ -1,3 +1,9 @@
+2008-10-07  Basile Starynkevitch  <basile@starynkevitch.net>
+	[export_patmacro does not work well]
+	* melt/warmelt-first.bysl: added debug_msg in initpatmacro_exporter.
+	* melt/warmelt-macro.bysl: adding class_srcpattern_or.
+	temporarily an oror_ patmacro..
+	* melt/warmelt-normal.bysl: reindented.
 2008-10-06  Basile Starynkevitch  <basile@starynkevitch.net>
 	* doc/melt.texi: documented instance, get_field, put_fields.
 	* melt/warmelt-first.bysl: using instance instead of make_instance.
diff --git a/gcc/melt/warmelt-first.bysl b/gcc/melt/warmelt-first.bysl
index 250fa7dc501..4675b4d8ed5 100644
--- a/gcc/melt/warmelt-first.bysl
+++ b/gcc/melt/warmelt-first.bysl
@@ -1708,6 +1708,7 @@
 
 ;; initial patmacro exporter
 (defun initpatmacro_exporter (sym macval patval contenv)
+  (debug_msg sym "initpatmacro_exporter sym")
   (assert_msg "check sym" (is_a sym class_symbol))
   (if (null contenv)
       (progn
diff --git a/gcc/melt/warmelt-macro.bysl b/gcc/melt/warmelt-macro.bysl
index a9c5249537b..9b57000ee9e 100644
--- a/gcc/melt/warmelt-macro.bysl
+++ b/gcc/melt/warmelt-macro.bysl
@@ -411,6 +411,12 @@
   :fields (
 	   ))
 
+;;; or patterns
+(defclass class_srcpattern_or
+  :super class_srcpattern_any
+  :fields (orpat_disj		    ;tuple of disjuncts
+))
+
 ;;; simple source pattern variable
 (defclass class_srcpattern_variable
   :super class_srcpattern_any
@@ -1104,6 +1110,7 @@
 			  )) )
     (put_env initial_environment mbind)
     (debug_msg symb "install_initial_patmacro done symb")
+    (debug_msg mbind "install_initial_patmacro done mbind")
     ))
 
 
@@ -2484,11 +2491,11 @@
 (install_initial_macro 'and mexpand_and)
 (export_macro and mexpand_and)
 
-;;;; the or expanser
+;;;; the or macro expanser
 (defun mexpand_or (sexpr env mexpander)
+  (debug_msg sexpr "mexpand_or sexpr")
   (assert_msg "check sexpr" (is_a sexpr class_sexpr))
   (assert_msg "check env" (is_a env class_environment))
-  (debug_msg sexpr "mexpand_or sexpr")
   (let (
 	(cont (unsafe_get_field :sexp_contents sexpr))
 	(loc  (unsafe_get_field :loca_location sexpr))
@@ -2510,9 +2517,31 @@
 	(debug_msg res "mexpand_or res")
 	(return res)
 	))))
+
+;;;; the or pattern expander
+(defun patexpand_or (sexpr env pctx)
+  (assert_msg "check sexpr" (is_a sexpr class_sexpr))
+  (assert_msg "check env" (is_a env class_environment))
+  (assert_msg "check pctx" (is_a pctx class_pattexpcontext))
+  (debug_msg sexpr "patexpand_or sexpr")
+  (let (
+	(cont (unsafe_get_field :sexp_contents sexpr))
+	(loc  (unsafe_get_field :loca_location sexpr))
+	(curpair (pair_tail (list_first cont)))
+	(argsp (patternexpand_pairlist_as_tuple curpair env pctx))
+	(res (instance class_srcpattern_or
+		       :src_loc loc
+		       :orpat_disj argsp))
+	)
+    (debug_msg res "patexpand_or res")
+    (return res)
+    )
+  )
+(install_initial_patmacro 'oror_ patexpand_or mexpand_or)
+;(export_patmacro oror_ patexpand_or mexpand_or)
 (install_initial_macro 'or mexpand_or)
 (export_macro or mexpand_or)
-
+(compile_warning "OR should be a patmacro & export_patmacro dont work" ())
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; the match expander
@@ -3483,6 +3512,7 @@
  class_srcpattern_instance
  class_srcpattern_jokervar
  class_srcpattern_object
+ class_srcpattern_or
  class_srcpattern_variable
  )			       ;end classes for source representations
 
diff --git a/gcc/melt/warmelt-normal.bysl b/gcc/melt/warmelt-normal.bysl
index 2f10d1dc1b1..3daca1311f0 100644
--- a/gcc/melt/warmelt-normal.bysl
+++ b/gcc/melt/warmelt-normal.bysl
@@ -876,12 +876,12 @@
  )
 
 
-					; for symbols which are imported from a previous environment (this
-					; only happens when compiling stuff which is not this warmelt-*) we
-					; should detect them and generate some special data to fetch them, in
-					; the start routine, from the given environment (which is the only
-					; argument to the start routine). Detecting such symbols is easy : their
-					; binding is a class_value_binding
+;; for symbols which are imported from a previous environment (this
+;; only happens when compiling stuff which is not this warmelt-*) we
+;; should detect them and generate some special data to fetch them, in
+;; the start routine, from the given environment (which is the only
+;; argument to the start routine). Detecting such symbols is easy : their
+;; binding is a class_value_binding
 
 ;;;; normalize a symbol occurrence
 (defun normexp_symbol (recv env ncx psloc)