[Projects] XRM 80: Factor some code.

20 Jun 2006

https://svn.lrde.epita.fr/svn/xrm/trunk


Index: ChangeLog
from  SIGOURE Benoit  <sigoure.benoit@lrde.epita.fr>

	Factor some code.

	* src/str/array-decl-desugar.str: Factor the code expanding array
	  declarations.
	* src/str/xrm-to-prism.str: Update a comment.
	* src/str/xrm-front.str: Remove a FIXME.
	* configure.ac: The trunk is now v1.1.
	* config/Makefile.am: Remove dist-hook.
	* bootstrap: Work around autoxt's timestamps.

 bootstrap                      |   16 +++
 config/Makefile.am             |    8 -
 configure.ac                   |    4 
 src/str/array-decl-desugar.str |  188 ++++++++++++++++++++---------------------
 src/str/xrm-front.str          |    2 
 src/str/xrm-to-prism.str       |    8 -
 6 files changed, 115 insertions(+), 111 deletions(-)

Index: src/str/array-decl-desugar.str

--- src/str/array-decl-desugar.str	(revision 79)
+++ src/str/array-decl-desugar.str	(working copy)
@@ -9,9 +9,71 @@
 module array-decl-desugar
 imports desugar-array-access
 
+strategies
+
+  /** @internal
+  ** Transform an array access in a declaration (eg: const int N[0..2] = 0;)
+  ** in a list of declarations (eg: const int N_0, N_1, N_2).
+  ** @param build-dec    Strategy that will be used to build each declaration.
+  **                     The strategy must have the following prototype:
+  **                     build-dec(|var-name)
+  ** @param array-access ArrayAccess at the top of the declaration.
+  */
+  array-access-to-dec-list(build-dec: name * c -> r | array-access, data) =
+  /* NOTE: This strategy has a weird prototype because build-dec, the strategy
+   * we receive in argument, is a so-called "high order" strategy (eg, not in
+   * the form t -> t). So its "prototype" must be defined here.
+   *  ``The actual types (such has name, c, r...) do not really matter: only
+   *    the structure of the type is necessary. The default type of strategy
+   *    parameters is a -> b. If a strategy has more formal parameters, then
+   *    one need to add "(a -> b)" if this is a strategy, or "a" if it is a
+   *    term parameter.'' -- Martin Bravenboer, iin the stratego mailing list.
+   * NOTE: This is not documented ATM, hence this comment. Also note that here,
+   *       `c' stands for the default argument, eg, the current term.
+   */
+    <fetch-idf> array-access => idf
+    ; <desugar-array-access> array-access => aa-list
+    ; rules(DeclaredIdentifier: Identifier(idf) -> aa-list)
+    ; desugared-array-access-list-to-identifier-list(|idf)
+    ; map({var-name:
+            ?var-name
+            ; <build-dec(|var-name)> data
+         })
+
+/** Builders. */
+rules
+
+  build-int-dec-no-init(|var-name):
+    [low, up] -> IntDecNoInit(Identifier(var-name), low, up)
+
+  build-int-dec(|var-name):
+    [low, up, value] -> IntDec(Identifier(var-name), low, up, value)
+
+  build-bool-dec-no-init(|var-name):
+    [] -> BoolDecNoInit(Identifier(var-name))
+
+  build-bool-dec(|var-name):
+    [value] -> BoolDec(Identifier(var-name), value)
+
+  build-const-int(|var-name):
+    [value] -> ConstInt(Identifier(var-name), value)
+
+  build-const-int-no-init(|var-name):
+    [] -> ConstIntNoInit(Identifier(var-name))
+
+  build-const-double(|var-name):
+    [value] -> ConstDouble(Identifier(var-name), value)
+
+  build-const-double-no-init(|var-name):
+    [] -> ConstDoubleNoInit(Identifier(var-name))
+
+  build-const-bool(|var-name):
+    [value] -> ConstBool(Identifier(var-name), value)
+
+  build-const-bool-no-init(|var-name):
+    [] -> ConstBoolNoInit(Identifier(var-name))
+
 rules
-// FIXME: Try to figure out why concrete syntax fails to work here.
-// FIXME: Try to put some code in common in order to shorten the rules.
 
 /*
 ** ## ============ ##
@@ -22,56 +84,30 @@
   // int without init
   array-decl-desugar:
     IntDecNoInit(aa@ArrayAccess(aa_idf, _), low, up)
-    -> int-decl-no-init-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !IntDecNoInit(Identifier(var-name), low, up)
-              })
-        ; ?int-decl-no-init-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-int-dec-no-init | aa, [low, up]) => dec-list
 
   // int with init
   array-decl-desugar:
     IntDec(aa@ArrayAccess(aa_idf, _), low, up, value)
-    -> int-decl-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !IntDec(Identifier(var-name), low, up, value)
-              })
-        ; ?int-decl-list
-
-
+    -> dec-list
+    where
+    array-access-to-dec-list(build-int-dec | aa, [low, up, value]) => dec-list
 
   // bool without init
   array-decl-desugar:
     BoolDecNoInit(aa@ArrayAccess(aa_idf, _))
-    -> bool-decl-no-init-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !BoolDecNoInit(Identifier(var-name))
-              })
-        ; ?bool-decl-no-init-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-bool-dec-no-init | aa, []) => dec-list
 
   // bool with init
   array-decl-desugar:
     BoolDec(aa@ArrayAccess(aa_idf, _), value)
-    -> bool-decl-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !BoolDec(Identifier(var-name), value)
-              })
-        ; ?bool-decl-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-bool-dec | aa, [value]) => dec-list
 
 /*
 ** ## =================== ##
@@ -82,81 +118,45 @@
   // const int with init
   array-decl-desugar:
     ConstInt(aa@ArrayAccess(aa_idf, _), value)
-    -> const-int-decl-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !ConstInt(Identifier(var-name), value)
-              })
-        ; ?const-int-decl-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-const-int | aa, [value]) => dec-list
 
   // const int without init
   array-decl-desugar:
     ConstIntNoInit(aa@ArrayAccess(aa_idf, _))
-    -> const-int-decl-no-init-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !ConstIntNoInit(Identifier(var-name))
-              })
-        ; ?const-int-decl-no-init-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-const-int-no-init | aa, []) => dec-list
 
 
 
   // const double with init
   array-decl-desugar:
     ConstDouble(aa@ArrayAccess(aa_idf, _), value)
-    -> const-double-decl-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !ConstDouble(Identifier(var-name), value)
-              })
-        ; ?const-double-decl-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-const-double | aa, [value]) => dec-list
 
   // const double without init
   array-decl-desugar:
     ConstDoubleNoInit(aa@ArrayAccess(aa_idf, _))
-    -> const-double-decl-no-init-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !ConstDoubleNoInit(Identifier(var-name))
-              })
-        ; ?const-double-decl-no-init-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-const-double-no-init | aa, []) => dec-list
 
 
 
   // const bool with init
   array-decl-desugar:
     ConstBool(aa@ArrayAccess(aa_idf, _), value)
-    -> const-bool-decl-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !ConstBool(Identifier(var-name), value)
-              })
-        ; ?const-bool-decl-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-const-bool | aa, [value]) => dec-list
 
   // const bool without init
   array-decl-desugar:
     ConstBoolNoInit(aa@ArrayAccess(aa_idf, _))
-    -> const-bool-decl-no-init-list
-    where <fetch-idf> aa_idf => idf
-        ; <desugar-array-access> aa
-        ; desugared-array-access-list-to-identifier-list(|idf)
-        ; map({var-name:
-                ?var-name
-                ; !ConstBoolNoInit(Identifier(var-name))
-              })
-        ; ?const-bool-decl-no-init-list
+    -> dec-list
+    where
+    array-access-to-dec-list(build-const-bool-no-init | aa, []) => dec-list
Index: src/str/xrm-to-prism.str
--- src/str/xrm-to-prism.str	(revision 79)
+++ src/str/xrm-to-prism.str	(working copy)
@@ -78,13 +78,11 @@
       | "debug: pretty printing current AST in ATerms to debug.aterm", 2)
     */
 
-     /* Desugar array declarations
-     *  eg: x[4][5] is transformed into two nested meta for loops
-     *  We can't do this in xrm-to-prism-desugar because the innermost
-     *  traversal is bottomup and won't recurse into generated code.
-     *
+     /* Desugar array declarations.
+      * We also collect them to detect later uses of undeclared arrays.
      *  This must come AFTER collect-static-const-decl since we might need
      *  to expand an arrays which rely on static const variables.
+      * NOTE: We also re-use this traversal to perform an EvalStaticRand.
      */
     ; log-timed(topdown(try(array-decl-desugar + EvalStaticRand))
                | "Desugaring array declarations", 2)
Index: src/str/xrm-front.str
--- src/str/xrm-front.str	(revision 79)
+++ src/str/xrm-front.str	(working copy)
@@ -1,7 +1,7 @@
 module xrm-front
 
 imports
-  libxtclib // FIXME: import libstratego-xtc for strc 0.17
+  libstratego-xtc
   tool-doc
   xrm-to-prism
   prism-desugar
Index: configure.ac
--- configure.ac	(revision 79)
+++ configure.ac	(working copy)
@@ -5,7 +5,7 @@
 ## Mail   <sigoure.benoit@lrde.epita.fr>
 ##
 ## Started on  Thu Apr 27 15:55:56 2006 SIGOURE Benoit
-## Last update Sun Jun 18 18:09:31 2006 SIGOURE Benoit
+## Last update Tue Jun 20 23:54:18 2006 SIGOURE Benoit
 ##
 
 ## --------------- ##
@@ -14,7 +14,7 @@
 
 AC_PREREQ(2.57)
 
-AC_INIT([xrm], [1.0], [sigoure.benoit@lrde.epita.fr])
+AC_INIT([xrm], [1.1], [sigoure.benoit@lrde.epita.fr])
 
 AC_CONFIG_MACRO_DIR([config])
 AC_CONFIG_AUX_DIR([config])
Index: config/Makefile.am
--- config/Makefile.am	(revision 79)
+++ config/Makefile.am	(working copy)
@@ -5,7 +5,7 @@
 ## Mail   <sigoure.benoit@lrde.epita.fr>
 ##
 ## Started on  Mon May  8 23:34:38 2006 SIGOURE Benoit
-## Last update Mon May  8 23:35:53 2006 SIGOURE Benoit
+## Last update Tue Jun 20 17:41:06 2006 SIGOURE Benoit
 ##
 
 EXTRA_DIST =					\
@@ -13,9 +13,3 @@
 	toplevel.mk				\
 	Transformers.mk				\
 	autoxt.m4
-
-# Makefile.xt and autoxt.m4 happen to have a mtime of 0 (Jan 1 1970)
-# So we change them by touching them
-dist-hook:
-	touch $(distdir)/Makefile.xt
-	touch $(distdir)/autoxt.m4
Index: bootstrap
--- bootstrap	(revision 79)
+++ bootstrap	(working copy)
@@ -6,7 +6,7 @@
 ## Mail   <sigoure.benoit@lrde.epita.fr>
 ##
 ## Started on  Thu Apr 27 16:02:29 2006 SIGOURE Benoit
-## Last update Thu Apr 27 16:59:41 2006 SIGOURE Benoit
+## Last update Wed Jun 21 00:08:28 2006 SIGOURE Benoit
 ##
 
 set -e
@@ -15,6 +15,18 @@
 rm -f config.cache aclocal.m4
 
 #test -d config || mkdir config
-(cd config && autoxt)
+cd config;
 
+autoxt="`which autoxt`"
+
+echo "Using autoxt from $autoxt"
+
+ln()
+{
+  cp -fv $2 .
+}
+
+source "$autoxt"
+
+cd ..
 autoreconf -fvi

    