examples13.txt

****************************************************************

Explicit deallocation in a pure OO language.

    // Returns a value of x that satisfies the equation
    // 0 = a x^2 + b x + c
    //
    // Strategy: quadratic formula

    double root (double a, double b, double c) {
        return (- b + Math.sqrt (b * b - 4 * a * c)) / (2 * a);
    }

****************************************************************

    // Returns a value of x that satisfies the equation
    // 0 = a x^2 + b x + c
    //
    // The caller is responsible for deallocating that value of x.
    //
    // Strategy: quadratic formula

    double root (double a, double b, double c) {
        double bsquared = b * b;
        double ac = a * c;
        double fourAC = 4 * ac;
        double diff = bsquared - fourAC;
        double sqrtDiff = Math.sqrt (diff);
        double minusB = - b;
        double numerator = minusB + sqrtDiff;
        double denominator = 2 * a;
        double result = numerator / denominator;

        delete bsquared;
        delete ac;
        delete fourAC;
        delete diff;
        delete sqrtDiff;
        delete minusB;
        delete numerator;
        delete denominator;

        return result;
    }

****************************************************************

    fib (n)
      if n < 2
        then n
        else fib (n - 1) + fib (n - 2)



    core 0      core 1       core 2       core 3

    fib (10)
    fib (9)                  fib (8)
    fib (8)     fib (7)      fib (7)      fib (6)

****************************************************************

    fib (n)
      if n < 2
        then n
        else fibLoop (2, n, 0, 1)

    # Given i <= n and the values of fib(i-2) and fib(i-1),
    # returns fib(n).

    fibLoop (i, n, x2, x1)
        if i = n
          then x2 + x1
          else fibLoop (i + 1, n, x1, x2 + x1)

****************************************************************

    // Returns the inner product of the given arrays.

    double ip (double[] a, double[] b) {
        int n = a.length;
        double result = 0.0;
        for (int i = 0; i < n; i = i + 1)
            result = result + a[i] * b[i];
        return result;
    }

****************************************************************

double ip (register double *a, register double *b, register int n) {
  register double result = 0.0;
  while (n-- > 0)
    result += *(a++) * *(b++);
  return result;
}

****************************************************************

	while (m > 0) {
	    m = m - 1;
	    result = ip (a, b);
	}
	System.out.println (ip (a, b));

****************************************************************

    double ip (double[] a, double[] b) {
        int n = a.length;
        if (n != b.length)
            throw new RuntimeException();
        double result = 0.0;
        for (int i = 0; i < n; i = i + 1)
            result = result + a[i] * b[i];
        return result;
    }


    // a is in r1
    // b is in r2
    // n is in r3
    // result is in f0

    sub     r4,r4,r4            // i is in r4
L1:
    cmp     r4,r3,r5
    bge     L2
    cmpi    r1,0,r5             // null check for a
    trapeq  r5
    cmpi    r4,0,r5             // range check for a[i]
    traplt  r5
    ldi     -4(r1),r5
    cmp     r4,r5,r5
    trapge  r5
    muli    r4,8,r5             // fetch a[i] into f1
    fld     r5(r1),f1
    cmpi    r2,0,r5             // null check for b
    trapeq  r5
    cmpi    r4,0,r5             // range check for b[i]
    traplt  r5
    ldi     -4(r2),r5
    cmp     r4,r5,r5
    trapge  r5
    muli    r4,8,r5             // fetch b[i] into f2
    fld     r5(r2),f2
    fmul    f1,f2,f1            // floating point multiplication
    fadd    f0,f1,f0            // floating point addition
    addi    r4,1,r4             // i = i + 1;
    b       L1
L2:

****************************************************************

L1:
    cmp     r4,r3,r5
    bge     L2
    muli    r4,8,r5             // fetch a[i] into f1
    fld     r5(r1),f1
    muli    r4,8,r5             // fetch b[i] into f2
    fld     r5(r2),f2
    fmul    f1,f2,f1            // floating point multiplication
    fadd    f0,f1,f0            // floating point addition
    addi    r4,1,r4             // i = i + 1;
    b       L1
L2:

****************************************************************

L1:
    cmp     r4,r3,r5
    bge     L2
L1b:
    muli    r4,8,r5             // fetch a[i] into f1
    fld     r5(r1),f1
    muli    r4,8,r5             // fetch b[i] into f2
    fld     r5(r2),f2
    fmul    f1,f2,f1            // floating point multiplication
    fadd    f0,f1,f0            // floating point addition
    addi    r4,1,r4             // i = i + 1;
    cmp     r4,r3,r5
    blt     L1b
L2:

****************************************************************

L1:
    cmp     r4,r3,r5
    bge     L2
L1b:
    fld     r4(r1),f1           // fetch a[i] into f1
    fld     r4(r2),f2           // fetch b[i] into f2
    fmul    f1,f2,f1            // floating point multiplication
    fadd    f0,f1,f0            // floating point addition
    addi    r4,8,r4             // i8 = i8 + 8;
    cmp     r4,r3,r5            // is i8 < n8 ?
    blt     L1b
L2:

****************************************************************

    # Returns a tree of height n.

    makeTree(n)
        if n = 0
          then emptyTree
          else makeNode (makeTree (n - 1),
                         makeTree (n - 1))



    # Returns a tree of height n.

    makeTree(n)
        if n = 0
          then emptyTree
          else let tmp1 = makeTree (n - 1)
               in makeNode (tmp1, tmp1)

****************************************************************

(define-syntax
  (syntax-rules (else)
   ((cond)
    (if #f #f))
   ((cond (else <expr>) clause ...)
    <expr>)
   ((cond (<test> <result>) clause ...)
    (if <test> <result> (cond clause ...)))))


    (cond ((empty? y) #f)
          ((equal? x (first y))
           #t)
          (else
           (member? x (rest y))))

macro-expands into

    (if (empty? y)
        #f
        (if (equal? x (first y))
            #t
            (member? x (rest y))))

****************************************************************

(define-syntax
  (syntax-rules ()
   ((let ((<var> <rhs>) ...) <expr>)
    ((lambda (<var> ...) <expr>)
     <rhs> ...))))


    (let ((x 1)
          (y 2)
          (z 3))
      (+ x y z))

macro-expands into

    ((lambda (x y z) (+ x y z))
     1 2 3)

****************************************************************

(define-syntax while
  (syntax-rules ()
   ((while <test> <stmt1> ...)
    (let ((loop (lambda (loop)
                  (if <test>
                      (begin <stmt1> ... (loop loop))))))
      (loop loop)))))

****************************************************************

(let ((if 1000.0)    ; intermediate frequency of transceiver
      (loop 3)       ; we want to loop 3 times
      (result 0))    ; will become the 3rd harmonic of if
  (while (> loop 0)
    (set! loop (- loop 1))
    (set! result (+ result if)))
  result)


With non-hygienic macro expansion, that example would expand
into

    ((lambda (if loop result)
       ((lambda (loop) (loop loop))
        (lambda (loop)
          (if (> loop 0)
              (begin (set! loop (- loop 1))
                     (set! result (+ result if))
                     (loop loop))))))
     1000.0
     3
     0)

****************************************************************