Ticket #1521: test.pir

File test.pir, 1.2 KB (added by arnsholt, 12 years ago)

Original code

Line 
1.HLL 'parrotlog'
2
3.namespace []
4.sub 'choose'
5    .param pmc options :slurpy
6    .local pmc cc
7    .local pmc chosen
8    .local pmc paths
9
10    if options goto got_options
11    'fail'()
12  got_options:
13    chosen = shift options
14
15    cc = new 'Continuation'
16    set_addr cc, recurse
17    paths = get_global '!paths'
18    push paths, cc
19
20    say chosen
21    .return (chosen)
22
23  recurse:
24    #.tailcall 'choose'(options :flat)
25    'choose'(options :flat)
26.end
27
28.sub 'fail'
29    .local pmc cc
30    .local pmc paths
31
32    paths = get_global '!paths'
33
34    if paths goto got_paths
35    cc = get_global '!topcc'
36    goto call_cc
37  got_paths:
38    cc = shift paths
39
40  call_cc:
41    cc()
42.end
43
44.sub 'blob'
45    .local pmc city
46    .local pmc store
47    .local pmc bx
48    .local pmc paths
49
50    paths = new 'ResizablePMCArray'
51    set_global '!paths', paths
52
53    city = 'choose'("la", "ny", "bos")
54    say city
55    say ''
56
57    'fail'()
58.end
59
60.sub 'main' :main
61    .local pmc cc
62
63    # Install top-level cc in global.
64    cc = new 'Continuation'
65    set_addr cc, final_failure
66    set_global '!topcc', cc
67
68    'blob'()
69  final_failure:
70.end
71
72# Outputs:
73# Blob?
74# la
75# la
76# ny # Right value selected
77# la # Old return value...
78# bos # Right value selected
79# la # Still old return value...
80# Blob.