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
|
;; -*-theme-d-*-
;; Copyright (C) 2014 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 test291)
(import (standard-library core)
(standard-library console-io))
(define-class <my-object>
(fields
(id <string> public public)))
(define-class <my-record>
(fields
(name <string> public public)
(address <string> public public)))
(define-param-class :my-stack
(parameters %type)
(superclass <my-object>)
(fields
(contents (:uniform-list %type) module module null)))
(define-class <custom-stack>
(superclass (:my-stack <my-record>))
(fields
(str-label <string> public public)))
(define-class <my-app>
(inheritance-access hidden)
(fields
(stack <custom-stack> public public)))
(define my-push
(lambda (((stack <custom-stack>) (element <my-record>)) <none> nonpure)
(field-set! stack 'contents (cons element (field-ref stack 'contents)))))
(define my-pop
(lambda (((stack <custom-stack>)) (:maybe <my-record>) nonpure)
(let ((contents (field-ref stack 'contents)))
(if (equal? contents null)
null
(let* ((contents1 (cast (:nonempty-uniform-list <my-record>)
contents))
(result (car contents1)))
(field-set! stack 'contents
(cdr contents1))
result)))))
(define main
(lambda (() <integer> nonpure)
(let* ((my-app <my-app>
(create <my-app>
((constructor <custom-stack>) "my-stack" "stack 1")))
(my-stack (field-ref my-app 'stack)))
(my-push my-stack ((constructor <my-record>) "Tommi" "PL 0"))
(my-push my-stack ((constructor <my-record>) "Jukka" "PL 1"))
(my-push my-stack ((constructor <my-record>) "Janne" "PL 2"))
(let-mutable ((cur (:maybe <my-record>) (my-pop my-stack)))
(until ((equal? cur null))
(if (not (equal? cur null))
(let ((cur1 (cast <my-record> cur)))
(console-display
(field-ref cur1 'name))
(console-display " ")
(console-display
(field-ref cur1 'address))
(console-newline)
(set! cur (my-pop my-stack)))))))
0)))
|
