comparison lab4/test/twice.p @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bfdcc3820b32
1 (* Another test of higher-order functions *)
2
3 type int = integer;
4
5 proc square(x: int): int; begin return x * x end;
6
7 proc twice(proc f(y: int): int; x: int): int;
8 begin return f(f(x)) end;
9
10 proc ap_to_sq(proc ff(proc f(x: int): int; x: int): int; x: int): int;
11 begin return ff(square, x) end;
12
13 begin
14 print_num(ap_to_sq(twice, 3));
15 newline()
16 end.
17
18 (*<<
19 81
20 >>*)
21
22 (*[[
23 @ picoPascal compiler output
24 .include "fixup.s"
25 .global pmain
26
27 @ proc square(x: int): int; begin return x * x end;
28 .text
29 _square:
30 mov ip, sp
31 stmfd sp!, {r0-r1}
32 stmfd sp!, {r4-r10, fp, ip, lr}
33 mov fp, sp
34 @ proc square(x: int): int; begin return x * x end;
35 ldr r4, [fp, #40]
36 mul r0, r4, r4
37 ldmfd fp, {r4-r10, fp, sp, pc}
38 .ltorg
39
40 @ proc twice(proc f(y: int): int; x: int): int;
41 _twice:
42 mov ip, sp
43 stmfd sp!, {r0-r3}
44 stmfd sp!, {r4-r10, fp, ip, lr}
45 mov fp, sp
46 @ begin return f(f(x)) end;
47 ldr r4, [fp, #40]
48 ldr r5, [fp, #44]
49 ldr r0, [fp, #48]
50 mov r10, r5
51 blx r4
52 mov r10, r5
53 blx r4
54 ldmfd fp, {r4-r10, fp, sp, pc}
55 .ltorg
56
57 @ proc ap_to_sq(proc ff(proc f(x: int): int; x: int): int; x: int): int;
58 _ap_to_sq:
59 mov ip, sp
60 stmfd sp!, {r0-r3}
61 stmfd sp!, {r4-r10, fp, ip, lr}
62 mov fp, sp
63 @ begin return ff(square, x) end;
64 ldr r2, [fp, #48]
65 mov r1, #0
66 set r0, _square
67 ldr r10, [fp, #44]
68 ldr r3, [fp, #40]
69 blx r3
70 ldmfd fp, {r4-r10, fp, sp, pc}
71 .ltorg
72
73 pmain:
74 mov ip, sp
75 stmfd sp!, {r4-r10, fp, ip, lr}
76 mov fp, sp
77 @ print_num(ap_to_sq(twice, 3));
78 mov r2, #3
79 mov r1, #0
80 set r0, _twice
81 bl _ap_to_sq
82 bl print_num
83 @ newline()
84 bl newline
85 ldmfd fp, {r4-r10, fp, sp, pc}
86 .ltorg
87
88 @ End
89 ]]*)