Implement till 4.52

misc/sicp-ambeval.scm

@@ -105,6 +105,9 @@
 (define (assignment? exp)
   (tagged-list? exp 'set!))
 
+(define (permanent-assignment? exp)
+  (tagged-list? exp 'permanent-set!))
+
 (define (assignment-variable exp) (cadr exp))
 
 (define (assignment-value exp) (caddr exp))
@@ -377,8 +380,10 @@
         ((quoted? exp) (analyze-quoted exp))
         ((variable? exp) (analyze-variable exp))
         ((assignment? exp) (analyze-assignment exp))
+        ((permanent-assignment? exp) (analyze-permanent-assignment exp))
         ((definition? exp) (analyze-definition exp))
         ((if? exp) (analyze-if exp))
+        ((if-fail? exp) (analyze-if-fail exp))
         ((lambda? exp) (analyze-lambda exp))
         ((begin? exp) (analyze-sequence (begin-actions exp)))
         ((cond? exp) (analyze (cond->if exp)))
@@ -432,6 +437,10 @@
              ;; failure continuation for evaluating the predicate
              fail))))
 
+(define (if-fail? exp) (tagged-list? exp 'if-fail))
+(define (if-fail-first exp) (cadr exp))
+(define (if-fail-second exp) (caddr exp))
+
 (define (analyze-sequence exps)
   (define (sequentially a b)
     (lambda (env succeed fail)
@@ -480,6 +489,17 @@
                             (fail2)))))
              fail))))
 
+(define (analyze-permanent-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+             (lambda (val fail2)
+                 (set-variable-value! var val env)
+                 (succeed 'ok
+                          (lambda () (fail2))))
+             fail))))
+
 ;;;Procedure applications
 
 (define (analyze-application exp)