Merge pull request #117 from thinker1990/chapter04

add exercise 4.74 ~ 4.76

chapter04/4_74.scm

@@ -0,0 +1,15 @@
+#lang sicp
+
+;; a. 
+(define (simple-stream-flatmap proc s)
+  (simple-flatten (stream-map proc s)))
+
+(define (simple-flatten stream)
+  (stream-map stream-car
+    (stream-filter 
+      (lambda (frame) 
+        (not (stream-null? frame))) 
+      stream)))
+
+;; b. 
+;; There is no difference in behaviour (as long as Alyssa’s assertions are correct.)

chapter04/4_75.scm

@@ -0,0 +1,12 @@
+#lang sicp
+
+(define (uniquely-asserted operand frame-stream)
+  (stream-flatmap
+    (lambda (frame)
+      (let ((result (qeval operand (singleton-stream frame))))
+        (cond [(stream-null? result) the-empty-stream]
+              [(stream-null? (stream-cdr result)) result]
+              [else the-empty-stream])))
+  frame-stream))
+
+(put 'unique 'qeval uniquely-asserted)

chapter04/4_76.scm

@@ -0,0 +1,40 @@
+#lang sicp
+
+;; For more details, check: https://wizardbook.wordpress.com/2018/07/23/exercise-4-76/
+(define (effective-conjoin conjuncts frame-stream)
+  (let ((first-result (qeval (first-conjunct conjuncts) frame-stream))
+        (rest-result (qeval (rest-conjuncts conjuncts) frame-stream)))
+    (merge-stream first-result rest-result)))
+
+(define (merge-streams left right)
+  (stream-flatmap
+   (lambda (left-frame)
+     (stream-filter
+      succeeded?
+      (stream-map
+       (lambda (right-frame)
+         (merge-frames left-frame right-frame))
+       right)))
+   left))
+
+(define (succeeded? frame)
+  (not (failed? frame)))
+
+(define (failed? frame)
+  (eq? 'failed frame))
+
+(define (merge-frames left right)
+  (cond ((or (failed? left)
+             (failed? right))  'failed)
+        ((empty-frame? left) right)
+        (else (let* ((binding (first-binding left))
+                     (var (binding-variable binding))
+                     (val (binding-value binding))
+                     (extension (extend-if-possible var val right)))
+                (if (failed? extension)
+                    'failed
+                    (merge-frames (rest-bindings left) extension))))))
+
+(define empty-frame? null?)
+(define first-binding car)
+(define rest-bindings cdr)