https://svn.lrde.epita.fr/svn/xrm/trunk Index: ChangeLog from SIGOURE Benoit &lt;sigoure.benoit(a)lrde.epita.fr&gt; Add the static_rand builtin. NOTE: Some C was needed to implement rand(from, to) because for some reason I didn't succeed in writing something equivalent in Stratego. For some reason, the numbers I generated were all too small. * src/tools/pp-xrm.str: Remove a FIXME. * src/tools/pp-prism.str: Ditto. * src/lib/xrm/pp/xrm-expression.str: Add boxing for static_rand. * src/lib/native/rand.c: New. * src/lib/native/Makefile.am: Add rand.c. * src/str/prism-desugar.str (prism-desugar-first-pass): Re-order calls and correct a minor bug. * src/str/builtin-rand.str: Handle static_rand. * src/str/xrm-front.str: Set a random seed before the main transformation pipeline starts. * src/syn/xrm/XRM-Expression.sdf: Add static_rand. lib/native/Makefile.am | 5 +- lib/native/rand.c | 27 +++++++++++ lib/xrm/pp/xrm-expression.str | 5 ++ str/builtin-rand.str | 101 ++++++++++++++++++++++++++++++------------ str/prism-desugar.str | 8 +-- str/xrm-front.str | 1 syn/xrm/XRM-Expression.sdf | 9 +++ tools/pp-prism.str | 2 tools/pp-xrm.str | 2 9 files changed, 124 insertions(+), 36 deletions(-) Index: src/tools/pp-xrm.str --- src/tools/pp-xrm.str (revision 48) +++ src/tools/pp-xrm.str (working copy) @@ -22,7 +22,7 @@ ?(<read-from-stream>, out-file) ; pp-xrm-to-abox ; box2text-stream(|80, out-file) - // FIXME: a final \n is missing + ; <fputs> ("\n", out-file) /** * Documentation Index: src/tools/pp-prism.str --- src/tools/pp-prism.str (revision 48) +++ src/tools/pp-prism.str (working copy) @@ -22,7 +22,7 @@ ?(<read-from-stream>, out-file) ; pp-prism-to-abox ; box2text-stream(|80, out-file) - // FIXME: a final \n is missing + ; <fputs> ("\n", out-file) /** * Documentation Index: src/lib/xrm/pp/xrm-expression.str --- src/lib/xrm/pp/xrm-expression.str (revision 48) +++ src/lib/xrm/pp/xrm-expression.str (working copy) @@ -21,3 +21,8 @@ Rand(args) // because func(rand, ...) is just uggly. -> box |[ H hs=0 [ KW["rand"] "(" H hs=1 [ ~args-imploded ] ")" ] ]| where <implode-list(|",")> args => args-imploded + + prism-to-box: + StaticRand(args) + -> box |[ H hs=0 [ KW["static_rand"] "(" H hs=1 [~args-imploded] ")" ] ]| + where <implode-list(|",")> args => args-imploded Index: src/lib/native/rand.c --- src/lib/native/rand.c (revision 0) +++ src/lib/native/rand.c (revision 0) @@ -0,0 +1,27 @@ +/* +** rand.c for str-reals in /home/tsuna/work/xrm/trunk/src/lib/native +** +** Made by SIGOURE Benoit +** Mail &lt;sigoure.benoit(a)lrde.epita.fr&gt; +** +** Started on Tue Jun 6 15:13:53 2006 SIGOURE Benoit +** Last update Tue Jun 6 15:23:57 2006 SIGOURE Benoit +*/ + +#include <stdlib.h> +#include "libstr-reals.h" + +ATerm STR_REALS_rand(ATerm from, ATerm to) +{ + int ifrom; + int ito; + int r; + + if((ATgetType(from) != AT_REAL && ATgetType(from) != AT_INT) || + (ATgetType(to) != AT_REAL && ATgetType(to) != AT_INT)) + return NULL; + NUMERIC_ATERM_TO_REAL(ifrom, from); + NUMERIC_ATERM_TO_REAL(ito, to); + r = ifrom + (unsigned)((float)(ito - ifrom + 1) * rand() / (RAND_MAX + 1.)); + return (ATerm) ATmakeInt(r); +} Index: src/lib/native/Makefile.am --- src/lib/native/Makefile.am (revision 48) +++ src/lib/native/Makefile.am (working copy) @@ -5,7 +5,7 @@ ## Mail &lt;sigoure.benoit(a)lrde.epita.fr&gt; ## ## Started on Wed May 10 19:27:12 2006 SIGOURE Benoit -## Last update Thu May 25 20:19:00 2006 SIGOURE Benoit +## Last update Tue Jun 6 15:13:38 2006 SIGOURE Benoit ## include $(top_srcdir)/config/toplevel.mk @@ -16,7 +16,8 @@ libstr_reals_la_SOURCES = $(include_HEADERS) \ ceil.c \ floor.c \ - power.c + power.c \ + rand.c # FIXME: Detect in configure whether -lm needs to be used. libstr_reals_la_LIBADD = $(SSL_LIBS) -lm Index: src/str/prism-desugar.str --- src/str/prism-desugar.str (revision 48) +++ src/str/prism-desugar.str (working copy) @@ -41,13 +41,13 @@ ** formulas and ExpandFormulas. */ prism-desugar-first-pass = - ConstInt(id, prism-desugar) + ?Int(_); IntToDouble + <+ ExpandStaticConsts; prism-desugar-first-pass // we must desugar the + <+ ExpandFormulas; prism-desugar-first-pass // expansed code. + <+ ConstInt(id, prism-desugar) <+ ConstDouble(id, prism-desugar) <+ ConstBool(id, prism-desugar) <+ FormulaDef(id, prism-desugar) - <+ ?Int(_); IntToDouble - <+ ExpandStaticConsts - <+ ExpandFormulas <+ all(prism-desugar-first-pass) rules Index: src/str/builtin-rand.str --- src/str/builtin-rand.str (revision 48) +++ src/str/builtin-rand.str (working copy) @@ -20,48 +20,39 @@ ** rand(x) -> rand(x, 0) if x < 0 */ DesugarRand: Rand([arg]) -> Rand([arg1, arg2]) - where ?current-term + where desugar-rand(|arg) => (arg1, arg2) + + DesugarRand: + StaticRand([arg]) -> StaticRand([arg1, arg2]) + where desugar-rand(|arg) => (arg1, arg2) + +strategies + + desugar-rand(|arg) = + ?current-term ; <prism-desugar> arg => arg' ; if not( !arg' => Int(iarg) ) then <invalid-call-to-rand-non-int> current-term end ; if <ltS>(iarg, "0") then - !Int("0") => arg2 - ; !arg' => arg1 + !(arg', Int("0")) else - !Int("0") => arg1 - ; !arg' => arg2 + !(Int("0"), arg') end +rules + EvalRand: Rand(args) -> Identifier(rand-var) - where ?current-term // save the current term for error messages - /* check that rand is called with exactly two arguments */ - ; if not( !args => [from, to] ) then - err-msg(|<concat-strings>["invalid call to XRM builtin: rand", - " takes either one or two arguments"]) - ; !current-term; debug; <xtc-exit> 4 - end - /* desugar (constant propagation) to make both arguments simple Int */ - ; <prism-desugar> from => from' - ; <prism-desugar> to => to' - /* check that both arguments are simple Int */ - ; if not( !from' => Int(ifrom); !to' => Int(ito) ) then - <invalid-call-to-rand-non-int> current-term - end - ; if <gtS>(ifrom, ito) then - err-msg(|<concat-strings>["invalid call to XRM builtin: ", - "rand(x,y) where x > y"]) - ; !current-term; debug; <xtc-exit> 4 - end + where check-rand-args(|"rand", args) => (from, to) /* generate a name for the random variable */ ; <newname> "__rand" => rand-var - /* template: 1/(ito-ifrom+1):(rand-var'=FIXME) */ - ; !ProbUpdate( Div(Int("1"), Int( <addS>(<subtS>(ito, ifrom), "1") )) + /* template: 1/(to-from+1):(rand-var'=FIXME) */ + ; !ProbUpdate( Div(Int("1"), Int( <addS>(<subtS>(to, from), "1") )) , UpdateList([UpdateElement(IdentifierPrime(rand-var), FIXME())])) /* generate the updates by replacing the FIXME */ ; {| RandUpdateList: - for-loop(gen-rand-update-list | ifrom, ito, "1", []) + for-loop(gen-rand-update-list | from, to, "1", []) ; bagof-RandUpdateList |} ; reverse // bagof gives us the list in reverse order @@ -69,12 +60,52 @@ ; !ProbUpdateList(<id>) => u /* inject that node in a module */ ; !|[ module ~id:rand-var - ~id:rand-var : [~int:ifrom..~int:ito]; + ~id:rand-var : [~int:from..~int:to]; [] true -> u; endmodule ]| => rand-gen-module /* save this module in a DR for later retrieval */ ; rules(RandGenModules:+ _ -> rand-gen-module) + EvalRand: + StaticRand(args) -> Int(rand-val) + where check-rand-args(|"static_rand", args) => (from, to) + ; rand(|<string-to-int> from, <string-to-int> to) + ; int-to-string => rand-val + +strategies + + /** + ** Ensure that the arguments passed to rand or static_rand builtin are + ** correct: + ** - It must have exactly two arguments. + ** - Both arguments must be statically evaluable as Int(_). + ** - The first argument must be lesser than or equal to the second. + ** @param builtin-name: String used in error messages + ** @param args: arguments of the builtin call + ** @return (to, from) where to and from are integers. + */ + check-rand-args(|builtin-name, args) = + ?current-term // save the current term for error messages + /* check that rand is called with exactly two arguments */ + ; if not( !args => [from, to] ) then + err-msg(|<concat-strings>["invalid call to XRM builtin: ", + builtin-name, " takes either one or two arguments"]) + ; !current-term; debug; <xtc-exit> 4 + end + /* desugar (constant propagation) to make both arguments simple Int */ + ; <prism-desugar> from => from' + ; <prism-desugar> to => to' + /* check that both arguments are simple Int */ + ; if not( !from' => Int(ifrom); !to' => Int(ito) ) then + <invalid-call-to-rand-non-int> current-term + end + ; if <gtS>(ifrom, ito) then + err-msg(|<concat-strings>["invalid call to XRM builtin: ", + builtin-name, "(x,y) where x > y"]) + ; !current-term; debug; <xtc-exit> 4 + end + ; !(ifrom, ito) + strategies gen-rand-update-list(|i, data) = @@ -86,3 +117,17 @@ " arguments must be statically evaluable"]) ; debug ; <xtc-exit> 4 + +strategies + + /** + ** Returns a random integer between `from' and `to' (included). + ** @param from Integer + ** @param to Integer + ** @return Integer + ** @warning You must call <set-random-seed> seed before calling this + ** strategy, otherwise every run will generate the same sequence of + ** random numbers. + */ + rand(|from, to) = + prim("STR_REALS_rand", from, to) Index: src/str/xrm-front.str --- src/str/xrm-front.str (revision 48) +++ src/str/xrm-front.str (working copy) @@ -40,6 +40,7 @@ /** pipeline of transformations performed by xrm-front */ xrm-front-pipeline = notice-msg(|"transformation pipeline starting") + ; where(<set-random-seed> (<time>)) ; xrm-to-prism ; dbg(|"xrm-to-prism finished") ; if must-desugar then Index: src/syn/xrm/XRM-Expression.sdf --- src/syn/xrm/XRM-Expression.sdf (revision 48) +++ src/syn/xrm/XRM-Expression.sdf (working copy) @@ -14,8 +14,10 @@ %% ExpressionFunc ::= %% (* older builtin functions for backwards compat. *) %% "rand" "(" Expression {"," Expression} ")" + %% | "static_rand" "(" Expression {"," Expression} ")" %% (* builtin functions calls using the "func" notation *) %% | "func" "(" "rand" "," Expression {"," Expression} ")" + %% | "func" "(" "static_rand" "," Expression {"," Expression} ")" context-free syntax ArrayAccess -> Expression @@ -27,9 +29,16 @@ ArrayAccess "?=" {Range ","}+ -> Expression {cons("ExistsEq")} ArrayAccess "?!=" {Range ","}+ -> Expression {cons("ExistsNotEq")} + %% rand builtin "rand" "(" {Expression ","}+ ")" -> Expression {cons("Rand")} "func" "(" "rand" "," {Expression ","}+ ")" -> Expression {cons("Rand")} + %% static rand builtin + "static_rand" "(" {Expression ","}+ ")" + -> Expression {cons("StaticRand")} + "func" "(" "static_rand" "," {Expression ","}+ ")" + -> Expression {cons("StaticRand")} + %% NOTE: remember: priorities are transitive in SDF. %% The following priorities are marked either with "inherited" or "new". %% The former means that these priorities are inherited from the base