share/numeric/simpsn.dem

   1 /*-*-macsyma-*-*/
   2
   3 /* 1:53pm  Monday, 12 January 1981
   4   - George Carrette */
   5 /*
   6 (LOAD_PACKAGE(SHAREM,"DSK:SHAREM\;AUTOLOAD FASL"),
   7  IF SHOWTIME=FALSE THEN SHOWTIME:'ALL)$ */
   8
   9 load("[sharem]autolo")$
  10
  11 /* Macro's to do numerical integration. */
  12
  13 /* Macro's allow the user to extend the compiler's ability
  14    to open-compile constructs which takes arguments which
  15    are functional in nature. Of course, some languages don't
  16    even allow contructs to take functional arguments. */
  17
  18 /* Rectangle rule. */
  19
  20 defm(rectrule('expression,'var,'a,'b,'dvar),
  21      block([%_sum:0.0,%_a:floatcheck(a),
  22             %_b:floatcheck(b),%_dvar:floatcheck(dvar)],
  23            mode_declare([%_sum,%_a,%_b,%_dvar],float),
  24            for var:%_a thru %_b step %_dvar
  25             do %_sum:%_sum+expression,
  26            %_sum*%_dvar));
  27
  28 /* DEFM is a macro which is use to define macro's,
  29    you can see by looking at the definition of RECTRULE
  30    which it produces that it saves some typing
  31    Adding to the expressive power of "defining forms"
  32    is a common use of macros. */
  33
  34 /* First need a floatcheck function, because the macsyma
  35    function FLOAT does not always return a floating-point
  36    number. */
  37
  38 mode_declare(function(float_check),float)$
  39 floatcheck(x):=
  40  (x:float(x),
  41   if floatnump(x) then x else error("not floatcheck",x))$
  42
  43 rectrule(x,x,0,1,1/8);
  44
  45 /* Now for the hat trick. */
  46
  47 f(p,n):=(mode_declare(p,fixnum),
  48          rectrule(x^p,x,0,1,1/n))$
  49
  50 macroexpansion:'displace$
  51
  52 f(2,5);
  53
  54 /* Now, look at the function definition. */
  55
  56 grind(f);
  57
  58 /* If you did some timing's you would see that when macros
  59    are displacing the function runs faster the second time
  60    than it does the first. This is user-extendable
  61    compilation on-the-fly! */
  62
  63 translate(f,floatcheck)$
  64
  65 f(2,5);
  66
  67 /* Re-enter the untranslated definition. */
  68 f(p,n):=(mode_declare(p,fixnum),
  69          rectrule(x^p,x,0,1,1/n))$
  70
  71 /* If you want to experiment a little, use the untranslated F,
  72    and try F(5,1000); It should take about 13 cpu seconds.
  73    Then COMPILE(F); and try it. It should then take 0.053 cpu
  74    seconds, a speed up by a factor of 245. i.e. the computation
  75    takes only 0.4% as much time as it did before.
  76    [I'm not sure I know of any other compilers which give
  77     such a speed-up.]
  78 */