1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
;; -*-theme-d-*-
;; Copyright (C) 2016 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.
;; Expected results: translation and running OK
(define-proper-program (tests test469)
(import (standard-library core)
(standard-library console-io))
(declare :consumer <param-logical-type>)
(define-param-logical-type :iterator-inst (%source %target)
(:procedure ((:consumer %source %target)) %target pure))
(define-param-logical-type :iterator (%source)
(:param-proc (%target) ((:consumer %source %target)) %target pure))
(define-param-logical-type :consumer (%source %target)
(:procedure ((:maybe %source) <boolean>
(:maybe (:iterator-inst %source %target)))
%target pure))
(define-param-proc end-iter (%source %target)
(((consumer (:consumer %source %target))) %target pure)
(consumer null #t null))
(define-param-proc gen-list (%source %target)
(((l (:uniform-list %source))
(consumer (:consumer %source %target))
(genrest (:iterator-inst %source %target)))
%target pure)
(match-type l
((<null>) (genrest consumer))
((l2 (:nonempty-uniform-list %source))
(consumer (car l2) #f
(lambda (((consumer (:consumer %source %target)))
%target pure)
(gen-list (cdr l2) consumer genrest))))))
(define-param-proc get-list-iterator (%source)
(((l (:uniform-list %source)))
(:iterator %source)
pure)
(param-lambda (%target)
(((consumer (:consumer %source %target))) %target pure)
(gen-list l consumer end-iter)))
(define-param-proc my-map1 (%source %component)
(((proc (:procedure (%source) %component pure))
(iter (:iterator %source)))
(:uniform-list %component) pure)
(let ((%target (:uniform-list %component)))
(letrec ((my-loop
(:procedure ((:iterator-inst %source %target)) %target pure)
(lambda (((iter (:iterator-inst %source %target))) %target pure)
(iter (lambda (((x1 (:maybe %source))
(eof1? <boolean>)
(iter (:maybe (:iterator-inst %source %target))))
%target pure)
(if eof1?
null
(cons
(proc (cast %source x1))
(my-loop (cast (:iterator-inst %source %target)
iter)))))))))
(my-loop (param-proc-instance iter %target)))))
(define-param-proc my-map2 (%source1 %source2 %component)
(((proc (:procedure (%source1 %source2) %component pure))
(iter1 (:iterator %source1))
(iter2 (:iterator %source2)))
(:uniform-list %component)
pure)
(let ((%target (:uniform-list %component)))
(letrec ((my-loop
(:procedure ((:iterator-inst %source1 %target)
(:iterator-inst %source2 %target))
%target pure)
(lambda (((iter1 (:iterator-inst %source1 %target))
(iter2 (:iterator-inst %source2 %target))) %target pure)
(iter1 (lambda (((x1 (:maybe %source1))
(eof1? <boolean>)
(iter1 (:maybe (:iterator-inst %source1 %target))))
%target pure)
(iter2 (lambda (((x2 (:maybe %source2))
(eof2? <boolean>)
(iter2 (:maybe (:iterator-inst
%source2 %target))))
%target pure)
(if (or eof1? eof2?)
null
(cons
(proc (cast %source1 x1)
(cast %source2 x2))
(my-loop (cast
(:iterator-inst %source1 %target)
iter1)
(cast
(:iterator-inst %source2 %target)
iter2)))))))))))
(my-loop (param-proc-instance iter1 %target)
(param-proc-instance iter2 %target)))))
(define-simple-proc my-proc1 (((i <integer>)) (:pair <integer> <integer>)
pure)
(cons i i))
(define-simple-proc my-proc2 (((i <integer>) (r <real>))
(:pair <integer> <real>)
pure)
(cons i r))
(define-main-proc (() <none> nonpure)
(let* ((l1 '(1 2 3 4 5))
(l2 '(10.5 20.5 -30.5 40.5 50.5))
(iter1 (get-list-iterator l1))
(l3 (my-map1 my-proc1 iter1))
(iter2 (get-list-iterator l2))
(l4 (my-map2 cons iter1 iter2)))
(console-display-line l3)
(console-display-line l4))))
|
