From 562a9a52d599d9a05f871404050968a5fd282640 Mon Sep 17 00:00:00 2001
From: elioat <elioat@tilde.institute>
Date: Wed, 23 Aug 2023 07:52:19 -0400
Subject: *

---
 .../nluqo.github.io/~bh/61a-pages/Lib/analyze.scm  | 117 +++++++++++++++++++++
 1 file changed, 117 insertions(+)
 create mode 100644 js/games/nluqo.github.io/~bh/61a-pages/Lib/analyze.scm

(limited to 'js/games/nluqo.github.io/~bh/61a-pages/Lib/analyze.scm')

diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Lib/analyze.scm b/js/games/nluqo.github.io/~bh/61a-pages/Lib/analyze.scm
new file mode 100644
index 0000000..3fee1cc
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/61a-pages/Lib/analyze.scm
@@ -0,0 +1,117 @@
+;;;;METACIRCULAR EVALUATOR THAT SEPARATES ANALYSIS FROM EXECUTION
+;;;; FROM SECTION 4.1.7 OF STRUCTURE AND INTERPRETATION OF COMPUTER PROGRAMS
+
+;;;;Matches code in ch4.scm
+
+;;;;This file can be loaded into Scheme as a whole.
+;;;;**NOTE**This file loads the metacircular evaluator of
+;;;;  sections 4.1.1-4.1.4, since it uses the expression representation,
+;;;;  environment representation, etc.
+;;;;  You may need to change the (load ...) expression to work in your
+;;;;  version of Scheme.
+
+;;;;Then you can initialize and start the evaluator by evaluating
+;;;; the expression (mce).
+
+
+;;**implementation-dependent loading of evaluator file
+;;Note: It is loaded first so that the section 4.1.7 definition
+;; of eval overrides the definition from 4.1.1
+(load "61a/Lib/mceval.scm")
+
+;;;SECTION 4.1.7
+
+(define (mc-eval exp env)
+  ((analyze exp) env))
+
+(define (analyze exp)
+  (cond ((self-evaluating? exp) 
+         (analyze-self-evaluating exp))
+        ((quoted? exp) (analyze-quoted exp))
+        ((variable? exp) (analyze-variable exp))
+        ((assignment? exp) (analyze-assignment exp))
+        ((definition? exp) (analyze-definition exp))
+        ((if? exp) (analyze-if exp))
+        ((lambda? exp) (analyze-lambda exp))
+        ((begin? exp) (analyze-sequence (begin-actions exp)))
+        ((cond? exp) (analyze (cond->if exp)))
+        ((application? exp) (analyze-application exp))
+        (else
+         (error "Unknown expression type -- ANALYZE" exp))))
+
+(define (analyze-self-evaluating exp)
+  (lambda (env) exp))
+
+(define (analyze-quoted exp)
+  (let ((qval (text-of-quotation exp)))
+    (lambda (env) qval)))
+
+(define (analyze-variable exp)
+  (lambda (env) (lookup-variable-value exp env)))
+
+(define (analyze-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env)
+      (set-variable-value! var (vproc env) env)
+      'ok)))
+
+(define (analyze-definition exp)
+  (let ((var (definition-variable exp))
+        (vproc (analyze (definition-value exp))))
+    (lambda (env)
+      (define-variable! var (vproc env) env)
+      'ok)))
+
+(define (analyze-if exp)
+  (let ((pproc (analyze (if-predicate exp)))
+        (cproc (analyze (if-consequent exp)))
+        (aproc (analyze (if-alternative exp))))
+    (lambda (env)
+      (if (true? (pproc env))
+          (cproc env)
+          (aproc env)))))
+
+(define (analyze-lambda exp)
+  (let ((vars (lambda-parameters exp))
+        (bproc (analyze-sequence (lambda-body exp))))
+    (lambda (env) (make-procedure vars bproc env))))
+
+(define (analyze-sequence exps)
+  (define (sequentially proc1 proc2)
+    (lambda (env) (proc1 env) (proc2 env)))
+  (define (loop first-proc rest-procs)
+    (if (null? rest-procs)
+        first-proc
+        (loop (sequentially first-proc (car rest-procs))
+              (cdr rest-procs))))
+  (let ((procs (map analyze exps)))
+    (if (null? procs)
+        (error "Empty sequence -- ANALYZE"))
+    (loop (car procs) (cdr procs))))
+
+(define (analyze-application exp)
+  (let ((fproc (analyze (operator exp)))
+        (aprocs (map analyze (operands exp))))
+    (lambda (env)
+      (execute-application (fproc env)
+                           (map (lambda (aproc) (aproc env))
+                                aprocs)))))
+
+(define (execute-application proc args)
+  (cond ((primitive-procedure? proc)
+         (apply-primitive-procedure proc args))
+        ((compound-procedure? proc)
+         ((procedure-body proc)
+          (extend-environment (procedure-parameters proc)
+                              args
+                              (procedure-environment proc))))
+        (else
+         (error
+          "Unknown procedure type -- EXECUTE-APPLICATION"
+          proc))))
+
+;;; Added at Berkeley:
+
+(define input-prompt ";;; A-Eval input:")
+(define output-prompt ";;; A-Eval value:")
-- 
cgit 1.4.1-2-gfad0