Richards M.The BCPL Cintcode and Cintpos user guide.2005

AND prim() = VALOF

{LET a = TABLE Num, 0 SWITCHON token INTO

}

AND nexp(n) = VALOF { lex(); RESULTIS exp(n) }

AND exp(n) = VALOF

{LET a, b = prim(), ?

{SWITCHON token INTO

{DEFAULT: BREAK CASE Lparen: CASE Num:

CASE Id: UNLESS n<6 BREAK

a := mk3(Ap, a, exp(6)); LOOP CASE Mul: UNLESS n<5 BREAK

a := mk3(Mul, a, nexp(5)); LOOP CASE Div: UNLESS n<5 BREAK

a := mk3(Div, a, nexp(5)); LOOP CASE Add: UNLESS n<4 BREAK

a := mk3(Add, a, nexp(4)); LOOP CASE Sub: UNLESS n<4 BREAK

a := mk3(Sub, a, nexp(4)); LOOP CASE Eq: UNLESS n<3 BREAK

a := mk3(Eq, a, nexp(3)); LOOP CASE Cond: UNLESS n<1 BREAK

b := nexp(0)

UNLESS token=Comma DO writes("Comma expected*n") a := mk4(Cond, a, b, nexp(0)); LOOP

}

} REPEAT RESULTIS a

}

AND try(expr) BE

{LET v = VEC 2000 space := v+2000

writef("Trying %s*n", expr)

writef("Answer: %n*n", eval(parse(expr), 0))

}

AND start() = VALOF

{try("(Lx x+1) 2") try("(Lx x) (Ly y) 99")

try("(Ls Lk s k k) (Lf Lg Lx f x (g x)) (Lx Ly x) (Lx x) 1234") try("(Y (Lf Ln n=0->1,n**f(n-1))) 5")

RESULTIS 0

}

9.6Fast Fourier Transform

The following program is a simple demonstration of the algorithm for the fast fourier transform. Instead of using complex numbers, it uses integer arithmetic modulo 65537 with an appropriate Nth root of unity.

GET "libhdr"

MANIFEST {

modulus = #x10001 // 2**16 + 1

$$ln10 // Set condition compilation flag to select data size //$$walsh

LET start() = VALOF

{writef("fft with N = %n and omega = %n modulus = %n*n*n",

//65017 26645 38448 37467 30114 19936 15550 42679

fft(data, ln, ovr(1,omega))

FOR i = 0 TO upb DO data!i := ovr(data!i, N) pr(data, 7)

//prints -- Restored data

{LET n = 1<<ln LET vn = v+n LET n2 = n>>1

//First do the perfect shuffle reorder(v, n)

//Then do all the butterfly operations FOR s = 1 TO ln DO

{ LET m = 1<<s LET m2 = m>>1

LET wk, wkfac = 1, w

FOR i = s+1 TO ln DO wkfac := mul(wkfac, wkfac) FOR j = 0 TO m2-1 DO

{LET p = v+j

WHILE p<vn DO { butterfly(p, p+m2, wk); p := p+m } wk := mul(wk, wkfac)

}

}

}

AND butterfly(p, q, wk) BE { LET a, b = !p, mul(!q, wk)

!p, !q := add(a, b), sub(a, b)

}

AND reorder(v, n) BE

{LET j = 0

FOR i = 0 TO n-2 DO

{LET k = n>>1

// j is i with its bits is reverse order

IF i<j DO { LET t = v!j; v!j := v!i; v!i := t }

}

}

AND check(w, n) BE

{// Check that w is a principal nth root of unity LET x = 1

FOR i = 1 TO n-1 DO { x := mul(x, w)

IF x=1 DO writef("omega****%n = 1*n", i)

}

UNLESS mul(x, w)=1 DO writef("Bad omega**%n should be 1*n", n)

}

AND pr(v, max) BE

{ FOR i = 0 TO max DO { writef("%I5 ", v!i)

IF i REM 8 = 7 DO newline()

}

newline()

}

AND dv(a, m, b, n) = a=1 -> m, a=0 -> m-n,

a<b -> dv(a, m, b REM a, m*(b/a)+n), dv(a REM b, m+n*(a/b), b, n)

AND inv(x) = dv(x, 1, modulus-x, 1)

AND add(x, y) = VALOF { LET a = x+y

IF a<modulus RESULTIS a RESULTIS a-modulus

}

131

Figure A.2: Declarations