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
133
134
|
;; -*-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 test468)
(import (standard-library core)
(standard-library console-io))
(declare :consumer <param-logical-type>)
(define-param-logical-type :iterator (%source %target)
(:procedure ((:consumer %source %target)) %target pure))
(define-param-logical-type :consumer (%source %target)
(:procedure ((:maybe %source) <boolean>
(:maybe (:iterator %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 %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-iterator0 (%source %target)
(((l (:uniform-list %source)))
(:iterator %source %target)
pure)
(lambda (((consumer (:consumer %source %target))) %target pure)
(gen-list l consumer end-iter)))
(define-param-proc my-map1 (%source %target %component)
(((proc (:procedure (%source) %component pure))
(iter (:iterator %source %target)))
%target pure)
(letrec ((my-loop
(:procedure ((:iterator %source %target)) %target pure)
(lambda (((iter (:iterator %source %target))) %target pure)
(iter (lambda (((x1 (:maybe %source))
(eof1? <boolean>)
(iter (:maybe (:iterator %source %target))))
%target pure)
(if eof1?
null
(cons
(proc (cast %source x1))
(my-loop (cast (:iterator %source %target)
iter)))))))))
(my-loop iter)))
(define-param-proc my-map2 (%source1 %source2 %target %component)
(((proc (:procedure (%source1 %source2) %component pure))
(iter1 (:iterator %source1 %target))
(iter2 (:iterator %source2 %target)))
%target pure)
(letrec ((my-loop
(:procedure ((:iterator %source1 %target)
(:iterator %source2 %target))
%target pure)
(lambda (((iter1 (:iterator %source1 %target))
(iter2 (:iterator %source2 %target))) %target pure)
(iter1 (lambda (((x1 (:maybe %source1))
(eof1? <boolean>)
(iter1 (:maybe (:iterator %source1 %target))))
%target pure)
(iter2 (lambda (((x2 (:maybe %source2))
(eof2? <boolean>)
(iter2 (:maybe (:iterator
%source2 %target))))
%target pure)
(if (or eof1? eof2?)
null
(cons
(proc (cast %source1 x1)
(cast %source2 x2))
(my-loop (cast
(:iterator %source1 %target)
iter1)
(cast
(:iterator %source2 %target)
iter2)))))))))))
(my-loop iter1 iter2)))
(define-simple-proc my-proc1 (((i <integer>)) (:pair <integer> <integer>)
pure)
(cons i i))
(define-main-proc (() <none> nonpure)
(let* ((l1 '(1 2 3 4 5))
(l2 '(10.5 20.5 -30.5 40.5 50.5))
(iter-proc1 (param-lambda (%target)
(((l (:uniform-list <integer>)))
(:iterator <integer> %target)
pure)
((param-proc-instance get-list-iterator0
<integer> %target)
l)))
(iter-inst1
((param-proc-instance iter-proc1 (:uniform-list (:pair <integer> <integer>)))
l1))
(l3 (my-map1 my-proc1 iter-inst1)))
;; (iter1-2 ((param-proc-instance get-list-iterator
;; <integer>
;; (:uniform-list
;; (:pair <integer> <real>)))
;; l1))
;; (iter2 ((param-proc-instance get-list-iterator
;; <real>
;; (:uniform-list
;; (:pair <integer> <real>)))
;; l2))
;; (l4 (my-map2 cons iter1-2 iter2)))
(console-display-line l3))))
;; (console-display-line l4))))
|
