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
|
;; -*-theme-d-*-
;; Copyright (C) 2016, 2021 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 test465)
(import (standard-library core)
(standard-library console-io))
(define <data-structure> (:uniform-list <integer>))
(define <source> <integer>)
(define <target> <boolean>)
(declare <consumer> :procedure)
(define <iterator> (:procedure (<consumer>) <target> pure))
(define <consumer> (:procedure
((:maybe <source>) <boolean> (:maybe <iterator>))
<target> pure))
(define-simple-method my-end (((consumer <consumer>)) <target> pure)
(force-pure-expr (console-display-line "my-end HEP"))
(consumer null #t null))
(define-simple-method 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-method my-every1 (((proc (:procedure (<source>) <boolean> pure))
(x1 <data-structure>))
<boolean> pure)
(letrec ((my-loop
(:procedure (<iterator>) <target> pure)
(lambda (((x1g <iterator>)) <target> pure)
(x1g (lambda (((x1 (:maybe <source>)) (eof1? <boolean>)
(x1g (:maybe <iterator>)))
<boolean> pure)
(or eof1?
(and
(proc (cast <source> x1))
(my-loop (cast <iterator> x1g)))))))))
(my-loop (lambda (((consumer <consumer>)) <target> pure)
(gen-list x1 consumer my-end)))))
(define-simple-method my-every2 (((proc (:procedure (<source> <source>)
<boolean> pure))
(x1 <data-structure>)
(x2 <data-structure>))
<boolean> 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>)))
<boolean> pure)
(x2g (lambda (((x2 (:maybe <source>)) (eof2? <boolean>)
(x2g (:maybe <iterator>)))
<boolean> pure)
(or (and eof1? eof2?)
(and
(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-method positive? (((i <integer>)) <boolean> pure)
(> i 0))
(define-main-proc (() <none> nonpure)
(let* ((l1 '(1 2 3 4 5))
(l2 '(1 2 -3 4 5))
(tmp1 (begin (console-display-line "*1*") 0))
(b1 (my-every1 positive? l1))
(tmp2 (begin (console-display-line "*2*") 0))
(b2 (my-every1 positive? l2))
(tmp3 (begin (console-display-line "*3*") 0))
(b3 (my-every2 = l1 l2))
(tmp4 (begin (console-display-line "*4*") 0))
(b4 (my-every2 = l1 l1)))
(console-display-line b1)
(console-display-line b2)
(console-display-line b3)
(console-display-line b4))))
|
