blob: 90311b0372c2c4c9c01110002932a258561e5463 (
plain)
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
|
(declare (usual-integrations write write-line pp eval))
(define write
(make-generic-operator 1
(access write user-initial-environment)))
(define write-line
(make-generic-operator 1
(access write-line user-initial-environment)))
(define pp
(make-generic-operator 1
(access pp user-initial-environment)))
(define (procedure-printable-representation procedure)
`(compound-procedure
,(procedure-parameters procedure)
,(procedure-body procedure)
<procedure-environment>))
(defhandler write
(compose write procedure-printable-representation)
compound-procedure?)
(defhandler write-line
(compose write-line procedure-printable-representation)
compound-procedure?)
(defhandler pp
(compose pp procedure-printable-representation)
compound-procedure?)
(define (read) (prompt-for-command-expression "eval> "))
(define the-global-environment)
;;; Initialization and driver loop
(define (evaluator exp succeed fail)
((analyze exp)
the-global-environment
succeed
fail))
(define input-prompt ";;; Amb-Eval input:\n")
(define output-prompt "\n;;; Amb-Eval value:\n")
(define (init)
(set! the-global-environment
(extend-environment '() '() the-empty-environment))
(driver-loop))
(define (driver-loop)
(define (internal-loop try-again)
(let ((input
(prompt-for-command-expression input-prompt)))
(if (eq? input 'try-again)
(try-again)
(begin
(newline)
(display ";;; Starting a new problem ")
(evaluator
input
(lambda (val next-alternative)
(display output-prompt)
(show-amb-count)
(pp val)
(internal-loop next-alternative))
(lambda ()
(display ";;; There are no more values of ")
(pp input)
(driver-loop)))))))
(internal-loop
(lambda ()
(display ";;; There is no current problem")
(driver-loop))))
(define go driver-loop)
|
