Implement till 4.50

ex-4_45-xx.scm

@@ -15,6 +15,22 @@
   (set! result (reverse result))
   result)
 
+(define (amb5 exp)
+  ;; puts the first five amb results into result
+  (set! count 0)
+  (set! result '())
+  (ambeval exp
+           the-global-environment
+           (lambda (value next)
+             (set! result (cons value result))
+             (set! count (+ count 1))
+             (if (< count 5)
+               (next)
+               result))
+           (lambda () result))
+  (set! result (reverse result))
+  result)
+
 (amball '(begin
 
 (define (require p)
@@ -252,6 +268,60 @@
 
 (display "\nex-4.49 - generate-sentence\n")
 
+(amb5 '(begin
+(define (list-amb word-list)
+  (if (null? word-list)
+    (amb)
+    (amb (car word-list) (list-amb (cdr word-list)))))
+(define (parse-word word-list)
+  (require (not (null? *unparsed*)))
+  (require (memq (car *unparsed*) (cdr word-list)))
+  (let ((found-word (list-amb (cdr word-list))))
+    (set! *unparsed* (cdr *unparsed*))
+    (list (car word-list) found-word)))
 
-(display "\nex-4.50\n")
+(parse '(the cat eats))
+))
+
+(map (lambda (r) (display r) (newline)) result)
+(display "[ok]\n")
+
+(display "\nex-4.50 - ramb\n")
+
+(define (random-element xs)
+  (define (create i n xs current others)
+    (if (null? xs)
+      (list current others)
+      (if (= i n)
+        (create (+ i 1) n (cdr xs) (car xs) others)
+        (create (+ i 1) n (cdr xs) current (cons (car xs) others)))))
+  (create 0 (random (length xs)) xs #f '()))
+
+(define (analyze-ramb exp)
+  (let ((cprocs (map analyze (amb-choices exp))))
+    (lambda (env succeed fail)
+      (define (try-next choices)
+        (if (null? choices)
+            (fail)
+            (let* ((pair (random-element choices))
+                   (current (car pair))
+                   (others (cadr pair)))
+            (current env
+                     succeed
+                     (lambda () (try-next others))))))
+      (try-next cprocs))))
+
+(amball '(ramb 1 2 3 4 5))
+(display result) (newline)
+(display "[ok]\n")
+
+; This implementation of ramb cannot directly help us with Alyssa's problem
+; because we used list-amb to get amb behavior. We would need list-ramb which would
+; require shuffling the items inside the evalutor or use something like apply.
+
+(display "\nex-4.51\n")
+
+(display "\nex-4.52\n")
+; (display "\nex-4.53\n")
+; (display "\nex-4.54\n")
 

misc/sicp-ambeval.scm

@@ -366,6 +366,9 @@
 (define (amb? exp) (tagged-list? exp 'amb))
 (define (amb-choices exp) (cdr exp))
 
+(define (ramb? exp) (tagged-list? exp 'ramb))
+(define (ramb-choices exp) (cdr exp))
+
 ;; analyze from 4.1.6, with clause from 4.3.3 added
 ;; and also support for Let
 (define (analyze exp)
@@ -381,6 +384,7 @@
         ((cond? exp) (analyze (cond->if exp)))
         ((let? exp) (analyze (let->combination exp))) ;**
         ((amb? exp) (analyze-amb exp))                ;**
+        ((ramb? exp) (analyze-ramb exp))                ;**
         ((application? exp) (analyze-application exp))
         (else
          (error "Unknown expression type -- ANALYZE" exp))))