Real_cst on MELT branch

Index: gcc/melt-make.mk
===================================================================
--- gcc/melt-make.mk	(revision 160746)
+++ gcc/melt-make.mk	(working copy)
@@ -75,12 +75,12 @@ 
 ## the invoking command could set MELT_MAKE_MODULE_XTRAMAKEFLAGS=-j2
 MELT_MAKE_MODULE=$(MAKE) -f $(melt_make_module_makefile) $(MELT_MAKE_MODULE_XTRAMAKEFLAGS) VPATH=$(VPATH):.
 
-warmelt-%.0.so: warmelt-%.0.c $(melt_make_module_makefile)
+warmelt-%.0.so: warmelt-%.0.c $(melt_make_module_makefile) melt-predef.h
 	echo in melt-make.mk melt_cflags= $(melt_cflags) 
 	$(MELT_MAKE_MODULE) meltmodule \
 	      GCCMELT_CFLAGS="$(melt_cflags)" \
 	      GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
-warmelt-%.0.d.so: warmelt-%.0.c $(melt_make_module_makefile)
+warmelt-%.0.d.so: warmelt-%.0.c $(melt_make_module_makefile) melt-predef.h
 	$(MELT_MAKE_MODULE) meltmoduledynamic \
 	      GCCMELT_CFLAGS="$(melt_cflags)" \
 	      GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$(shell basename $@ .d.so).so
@@ -98,11 +98,11 @@ 
 	      GCCMELT_CFLAGS="$(melt_cflags)" \
 	      GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
 ## warmeltbig*.c is so big that it can only be compiled with -O0
-warmeltbig-%.so: warmeltbig-%.c $(melt_make_module_makefile)
+warmeltbig-%.so: warmeltbig-%.c $(melt_make_module_makefile) melt-predef.h
 	$(MELT_MAKE_MODULE) meltmodule \
 	      GCCMELT_CFLAGS="$(melt_cflags) -O0"   \
 	      GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
-warm%.so: warm%.c  $(melt_make_module_makefile)
+warm%.so: warm%.c  $(melt_make_module_makefile) melt-predef.h
 	$(MELT_MAKE_MODULE) meltmodule \
 	      GCCMELT_CFLAGS="$(melt_cflags) $(MELT_FINAL_CFLAGS)" \
 	      GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
Index: gcc/melt/warmelt-first.melt
===================================================================
--- gcc/melt/warmelt-first.melt	(revision 160746)
+++ gcc/melt/warmelt-first.melt	(working copy)
@@ -1475,6 +1475,14 @@ 
   :disc_super discr_any_receiver
   :named_name '"DISCR_INTEGER")
 
+;;; The discriminant for boxed reals.
+(definstance discr_real class_discriminant
+  :doc #{The $DISCR_REAL is the discriminant of boxed reals. }#
+  :predef DISCR_REAL
+  :obj_num OBMAG_REAL
+  :disc_super discr_any_receiver
+  :named_name '"DISCR_REAL")
+
 ;;; the discriminant for constant integers, like '123
 (definstance discr_constant_integer class_discriminant
   :predef DISCR_CONSTANT_INTEGER
@@ -3544,6 +3552,7 @@ 
  discr_ppl_constraint_system 
  discr_ppl_polyhedron 
  discr_rawfile
+ discr_real
  discr_routine                        
  discr_strbuf                         
  discr_string                         
Index: gcc/melt/xtramelt-ana-base.melt
===================================================================
--- gcc/melt/xtramelt-ana-base.melt	(revision 160746)
+++ gcc/melt/xtramelt-ana-base.melt	(working copy)
@@ -1329,8 +1329,19 @@ 
   #{ /*$treeintk !*/ $n  = tree_low_cst(($tr), 0);
   }#  )
 
-
-
+;;; pattern tree_real_cst
+(defcmatcher tree_real_cst
+  (:tree tr)
+  (:value v)
+  treerealc
+  ;; test expander 
+  #{ /* $treerealc ?*/ (($tr) && TREE_CODE($tr) == REAL_CST) }#
+  ;; fill expander
+  #{ /* treerealc! */
+  $v = meltgc_new_real ((meltobject_ptr_t) MELT_PREDEF (DISCR_REAL), 
+		        TREE_REAL_CST(($tr))); }#
+)
+  
 ;;; pattern for pointer types
 (defcmatcher tree_pointer_type_p
   (:tree tr)
Index: gcc/melt-runtime.c
===================================================================
--- gcc/melt-runtime.c	(revision 160746)
+++ gcc/melt-runtime.c	(working copy)
@@ -1973,7 +1973,32 @@ 
 #undef object_discrv
 }
 
+melt_ptr_t 
+meltgc_new_real (meltobject_ptr_t discr_p, REAL_VALUE_TYPE r)
+{
+    MELT_ENTERFRAME (2, NULL);
+#define resv   meltfram__.varptr[0]
+#define discrv meltfram__.varptr[1]
+#define object_discrv ((meltobject_ptr_t)(discrv))
+#define real_resv ((struct meltreal_st*) resv)
+    discrv = (void*) discr_p;
+    if (!discrv)
+	discrv = (meltobject_ptr_t) MELT_PREDEF (DISCR_REAL);
+    if (object_discrv->object_magic != OBMAG_REAL)
+	goto end;
+    resv = meltgc_allocate (sizeof (struct meltreal_st), 0);
+    real_resv->discr = object_discrv;
+    real_resv->val = r;
+end:
+    MELT_EXITFRAME ();
+    return (melt_ptr_t) resv;
+#undef resv
+#undef discrv
+#undef object_discrv
+#undef real_resv
+}
 
+
 /* allocate a new routine object of given DISCR and of length LEN,
    with a DESCR-iptive string a a PROC-edure */
 meltroutine_ptr_t
@@ -2961,7 +2986,7 @@ 
   return ((meltobject_ptr_t) cont)->obj_vartab[FCONTAINER_VALUE];
 }
 
-/* allocate a new boxed tree of given DISCR [or DISCR_TREE] & content
+/* allocate a new boxedtree of given DISCR [or DISCR_TREE] & content
    VAL */
 melt_ptr_t
 meltgc_new_tree (meltobject_ptr_t discr_p, tree tr)
Index: gcc/melt-runtime.h
===================================================================
--- gcc/melt-runtime.h	(revision 160746)
+++ gcc/melt-runtime.h	(working copy)
@@ -1522,6 +1522,7 @@ 
 /* allocate a boxed long integer (or null if bad DISCR) fillen with NUM */
 melt_ptr_t meltgc_new_int (meltobject_ptr_t discr, long num);
 
+/* Retrieve an integer from a boxed integer or mixnumbers.  */
 static inline long
 melt_get_int (melt_ptr_t v)
 {
@@ -1540,8 +1541,19 @@ 
     }
 }
 
+/* Make a boxed real from a real value.  If discr is NULL, use DISCR_REAL.  */
+melt_ptr_t meltgc_new_real(meltobject_ptr_t discr, REAL_VALUE_TYPE r);
 
+/* Unbox real value. It returns 0 if not a boxed real.  */
+static inline REAL_VALUE_TYPE
+melt_get_real (melt_ptr_t v)
+{
+    if (melt_magic_discr (v) == OBMAG_REAL)
+	return ((struct meltreal_st*) v)->val;
+    return dconst0;
+}
 
+
 static inline long
 melt_obj_hash (melt_ptr_t v)
 {
Index: gcc/melt-predef.list
===================================================================
--- gcc/melt-predef.list	(revision 160746)
+++ gcc/melt-predef.list	(working copy)
@@ -96,6 +96,7 @@ 
   DISCR_NAME_STRING
   DISCR_NULL_RECEIVER
   DISCR_PAIR
+  DISCR_REAL
   DISCR_ROUTINE
   DISCR_STRBUF
   DISCR_STRING