annotate ppc/test/cpsfib.p @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
mike@0 1 (* cpsfib.p *)
mike@0 2
mike@0 3 (* This program computes fibonacci numbers using the usual doubly
mike@0 4 recursive algorithm. However, the algorithm has been transformed
mike@0 5 into continuation passing style. A good test for procedural
mike@0 6 parameters! *)
mike@0 7
mike@0 8 (* fib -- fibonacci numbers *)
mike@0 9 proc fib(n: integer): integer;
mike@0 10
mike@0 11 (* fib1 -- continuation transformer for fib *)
mike@0 12 proc fib1(n: integer; proc k(r: integer): integer) : integer;
mike@0 13 proc k1(r1: integer): integer;
mike@0 14 proc k2(r2: integer): integer; begin return k(r1 + r2) end;
mike@0 15 begin return fib1(n-2, k2) end;
mike@0 16 begin
mike@0 17 if n <= 1 then
mike@0 18 return k(1)
mike@0 19 else
mike@0 20 return fib1(n-1, k1)
mike@0 21 end
mike@0 22 end;
mike@0 23
mike@0 24 (* id -- identity continuation *)
mike@0 25 proc id(r: integer): integer; begin return r end;
mike@0 26
mike@0 27 begin
mike@0 28 return fib1(n, id)
mike@0 29 end;
mike@0 30
mike@0 31 begin
mike@0 32 print_num(fib(6)); newline()
mike@0 33 end.
mike@0 34
mike@0 35 (*<<
mike@0 36 13
mike@0 37 >>*)
mike@0 38
mike@0 39 (*[[
mike@0 40 MODULE Main 0 0
mike@0 41 IMPORT Lib 0
mike@0 42 ENDHDR
mike@0 43
mike@0 44 PROC _fib 0 0 0
mike@0 45 ! return fib1(n, id)
mike@0 46 LOCAL 0
mike@0 47 GLOBAL _id
mike@0 48 LDLW 16
mike@0 49 LOCAL 0
mike@0 50 GLOBAL _fib1
mike@0 51 PCALLW 3
mike@0 52 RETURNW
mike@0 53 END
mike@0 54
mike@0 55 PROC _fib1 0 0 0
mike@0 56 ! if n <= 1 then
mike@0 57 LDLW 16
mike@0 58 CONST 1
mike@0 59 JGT L2
mike@0 60 ! return k(1)
mike@0 61 CONST 1
mike@0 62 LDLW 24
mike@0 63 LDLW 20
mike@0 64 PCALLW 1
mike@0 65 RETURNW
mike@0 66 LABEL L2
mike@0 67 ! return fib1(n-1, k1)
mike@0 68 LOCAL 0
mike@0 69 GLOBAL _k1
mike@0 70 LDLW 16
mike@0 71 CONST 1
mike@0 72 MINUS
mike@0 73 LDLW 12
mike@0 74 GLOBAL _fib1
mike@0 75 PCALLW 3
mike@0 76 RETURNW
mike@0 77 END
mike@0 78
mike@0 79 PROC _k1 0 0 0
mike@0 80 ! begin return fib1(n-2, k2) end;
mike@0 81 LOCAL 0
mike@0 82 GLOBAL _k2
mike@0 83 LDLW 12
mike@0 84 LDNW 16
mike@0 85 CONST 2
mike@0 86 MINUS
mike@0 87 LDLW 12
mike@0 88 LDNW 12
mike@0 89 GLOBAL _fib1
mike@0 90 PCALLW 3
mike@0 91 RETURNW
mike@0 92 END
mike@0 93
mike@0 94 PROC _k2 0 0 0
mike@0 95 ! proc k2(r2: integer): integer; begin return k(r1 + r2) end;
mike@0 96 LDLW 12
mike@0 97 LDNW 16
mike@0 98 LDLW 16
mike@0 99 PLUS
mike@0 100 LDLW 12
mike@0 101 LDNW 12
mike@0 102 LDNW 24
mike@0 103 LDLW 12
mike@0 104 LDNW 12
mike@0 105 LDNW 20
mike@0 106 PCALLW 1
mike@0 107 RETURNW
mike@0 108 END
mike@0 109
mike@0 110 PROC _id 0 0 0
mike@0 111 ! proc id(r: integer): integer; begin return r end;
mike@0 112 LDLW 16
mike@0 113 RETURNW
mike@0 114 END
mike@0 115
mike@0 116 PROC MAIN 0 0 0
mike@0 117 ! print_num(fib(6)); newline()
mike@0 118 CONST 6
mike@0 119 CONST 0
mike@0 120 GLOBAL _fib
mike@0 121 PCALLW 1
mike@0 122 CONST 0
mike@0 123 GLOBAL lib.print_num
mike@0 124 PCALL 1
mike@0 125 CONST 0
mike@0 126 GLOBAL lib.newline
mike@0 127 PCALL 0
mike@0 128 RETURN
mike@0 129 END
mike@0 130
mike@0 131 ! End
mike@0 132 ]]*)