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
|
;; -*-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 test466)
(import (standard-library core)
(standard-library console-io))
(define <data-structure> (:uniform-list <integer>))
(define <source> <integer>)
(define <target> (:uniform-list (:pair <integer> <integer>)))
(declare <consumer> :procedure)
(define <iterator> (:procedure (<consumer>) <target> pure))
(define <consumer> (:procedure
((:maybe <source>) <boolean> (:maybe <iterator>))
<target> pure))
(define-simple-proc my-end (((consumer <consumer>)) <target> pure)
(consumer null #t null))
(define-simple-proc gen-list (((l (:uniform-list <source>))
(consumer <consumer>)
(genrest <iterator>))
<target> pure)
(match-type l
((<null>) (genrest consumer))
((l2 (:nonempty-uniform-list <source>))
(consumer (car l2) #f (lambda (((consumer <consumer>)) <target> pure)
(gen-list (cdr l2) consumer genrest))))))
(define-simple-proc my-map1 (((proc (:procedure (<source>)
(:pair <source> <source>)
pure))
(x1 <data-structure>))
<target> pure)
(letrec ((my-loop
(:procedure (<iterator>) <target> pure)
(lambda (((x1g <iterator>)) <target> pure)
(x1g (lambda (((x1 (:maybe <source>)) (eof1? <boolean>)
(x1g (:maybe <iterator>)))
<target> pure)
(if eof1?
null
(cons
(proc (cast <source> x1))
(my-loop (cast <iterator> x1g)))))))))
(my-loop (lambda (((consumer <consumer>)) <target> pure)
(gen-list x1 consumer my-end)))))
(define-simple-proc my-map2 (((proc (:procedure (<source> <source>)
(:pair <source> <source>)
pure))
(x1 <data-structure>)
(x2 <data-structure>))
<target> pure)
(letrec ((my-loop
(:procedure (<iterator> <iterator>) <target> pure)
(lambda (((x1g <iterator>) (x2g <iterator>)) <target> pure)
(x1g (lambda (((x1 (:maybe <source>)) (eof1? <boolean>)
(x1g (:maybe <iterator>)))
<target> pure)
(x2g (lambda (((x2 (:maybe <source>)) (eof2? <boolean>)
(x2g (:maybe <iterator>)))
<target> pure)
(if (or eof1? eof2?)
null
(cons
(proc (cast <source> x1)
(cast <source> x2))
(my-loop (cast <iterator> x1g)
(cast <iterator> x2g)))))))))))
(my-loop (lambda (((consumer <consumer>)) <target> pure)
(gen-list x1 consumer my-end))
(lambda (((consumer <consumer>)) <target> pure)
(gen-list x2 consumer my-end)))))
(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 20 -30 40 50))
(l3 (my-map1 my-proc1 l1))
(l4 (my-map2 cons l1 l2)))
(console-display-line l3)
(console-display-line l4))))
|
