Working on 4.78

main
Felix Martin 2021-03-11 12:11:20 -05:00
parent f1d0c83ebc
commit 0d0fc72d8a
3 changed files with 759 additions and 62 deletions

View File

@ -209,46 +209,3 @@
(salary ?p1 ?s1)
(salary ?p2 ?s2)))
(newline)
(display "\nex-4.78 - non-deterministic-query\n")
; Exercise 4.78. Redesign the query language as a nondeterministic program to
; be implemented using the evaluator of section 4.3, rather than as a stream
; process. In this approach, each query will produce a single answer (rather
; than the stream of all answers) and the user can type try-again to see more
; answers. You should find that much of the mechanism we built in this section
; is subsumed by nondeterministic search and backtracking. You will probably
; also find, however, that your new query language has subtle differences in
; behavior from the one implemented here. Can you find examples that illustrate
; this difference?
(display "\nex-4.79 - rule-application-environment\n")
; Exercise 4.79. When we implemented the Lisp evaluator in section 4.1, we saw
; how to use local environments to avoid name conflicts between the parameters
; of procedures. For example, in evaluating
; (define (square x)
; (* x x))
; (define (sum-of-squares x y)
; (+ (square x) (square y)))
; (sum-of-squares 3 4)
; there is no confusion between the x in square and the x in sum-of-squares,
; because we evaluate the body of each procedure in an environment that is
; specially constructed to contain bindings for the local variables. In the
; query system, we used a different strategy to avoid name conflicts in
; applying rules. Each time we apply a rule we rename the variables with new
; names that are guaranteed to be unique. The analogous strategy for the Lisp
; evaluator would be to do away with local environments and simply rename the
; variables in the body of a procedure each time we apply the procedure.
; Implement for the query language a rule-application method that uses
; environments rather than renaming. See if you can build on your environment
; structure to create constructs in the query language for dealing with large
; systems, such as the rule analog of block-structured procedures. Can you
; relate any of this to the problem of making deductions in a context (e.g.,
; ``If I supposed that P were true, then I would be able to deduce A and B.'')
; as a method of problem solving? (This problem is open-ended. A good answer is
; probably worth a Ph.D.)

719
ex-4_78-79.scm Normal file
View File

@ -0,0 +1,719 @@
(load "util.scm")
(load "misc/sicp-ambeval.scm")
(define the-global-environment (setup-environment))
(define result '())
; Copied from 4.45
(define result '())
(define (amball exp)
(set! result '()) ; reset result
(ambeval exp
the-global-environment
(lambda (value next)
(set! result (cons value result))
(next))
(lambda () result))
(set! result (reverse result))
result)
(amball '(begin
(define input-prompt ";;; Query input:")
(define output-prompt ";;; Query results:")
(define (query-driver-loop)
(prompt-for-input input-prompt)
(let ((q (query-syntax-process (read))))
(cond ((assertion-to-be-added? q)
(add-rule-or-assertion! (add-assertion-body q))
(newline)
(display "Assertion added to data base.")
(query-driver-loop))
(else
(newline)
(display output-prompt)
;; [extra newline at end] (announce-output output-prompt)
(display-stream
(stream-map
(lambda (frame)
(instantiate q
frame
(lambda (v f)
(contract-question-mark v))))
(qeval q (singleton-stream '()))))
(query-driver-loop)))))
(define (instantiate exp frame unbound-var-handler)
(define (copy exp)
(cond ((var? exp)
(let ((binding (binding-in-frame exp frame)))
(if binding
(copy (binding-value binding))
(unbound-var-handler exp frame))))
((pair? exp)
(cons (copy (car exp)) (copy (cdr exp))))
(else exp)))
(copy exp))
;;;SECTION 4.4.4.2
;;;The Evaluator
(define (qeval query frame-stream)
(let ((qproc (get (type query) 'qeval)))
(if qproc
(qproc (contents query) frame-stream)
(simple-query query frame-stream))))
;;;Simple queries
(define (simple-query query-pattern frame-stream)
;; (display "SIMPLE-QUERY ") (display query-pattern) (newline)
(stream-flatmap
(lambda (frame)
(stream-append-delayed
(find-assertions query-pattern frame)
(delay (apply-rules query-pattern frame))))
frame-stream))
;;;Compound queries
(define (conjoin conjuncts frame-stream)
(if (empty-conjunction? conjuncts)
frame-stream
(conjoin (rest-conjuncts conjuncts)
(qeval (first-conjunct conjuncts)
frame-stream))))
;;(put 'and 'qeval conjoin)
(define (disjoin disjuncts frame-stream)
(if (empty-disjunction? disjuncts)
the-empty-stream
(interleave-delayed
(qeval (first-disjunct disjuncts) frame-stream)
(delay (disjoin (rest-disjuncts disjuncts)
frame-stream)))))
;;(put 'or 'qeval disjoin)
;;;Filters
(define (negate operands frame-stream)
(stream-flatmap
(lambda (frame)
(if (stream-null? (qeval (negated-query operands)
(singleton-stream frame)))
(singleton-stream frame)
the-empty-stream))
frame-stream))
(define (uniquely-asserted query frame-stream)
(stream-flatmap
(lambda (frame)
(let ((matches (qeval (car query) (singleton-stream frame))))
(cond ((stream-null? matches) matches)
((stream-null? (stream-cdr matches)) matches)
(else the-empty-stream))))
frame-stream))
;;(put 'not 'qeval negate)
(define (lisp-value call frame-stream)
(stream-flatmap
(lambda (frame)
(if (execute
(instantiate
call
frame
(lambda (v f)
(error "Unknown pat var -- LISP-VALUE" v))))
(singleton-stream frame)
the-empty-stream))
frame-stream))
;;(put 'lisp-value 'qeval lisp-value)
(define (execute exp)
(apply (eval (predicate exp) user-initial-environment)
(args exp)))
(define (always-true ignore frame-stream) frame-stream)
;;(put 'always-true 'qeval always-true)
;;;SECTION 4.4.4.3
;;;Finding Assertions by Pattern Matching
(define (find-assertions pattern frame)
(stream-flatmap (lambda (datum)
(check-an-assertion datum pattern frame))
(fetch-assertions pattern frame)))
(define (check-an-assertion assertion query-pat query-frame)
(let ((match-result
(pattern-match query-pat assertion query-frame)))
(if (eq? match-result 'failed)
the-empty-stream
(singleton-stream match-result))))
(define (pattern-match pat dat frame)
(cond ((eq? frame 'failed) 'failed)
((equal? pat dat) frame)
((var? pat) (extend-if-consistent pat dat frame))
((and (pair? pat) (pair? dat))
(pattern-match (cdr pat)
(cdr dat)
(pattern-match (car pat)
(car dat)
frame)))
(else 'failed)))
(define (extend-if-consistent var dat frame)
(let ((binding (binding-in-frame var frame)))
(if binding
(pattern-match (binding-value binding) dat frame)
(extend var dat frame))))
;;;SECTION 4.4.4.4
;;;Rules and Unification
(define (apply-rules pattern frame)
(stream-flatmap (lambda (rule)
(apply-a-rule rule pattern frame))
(fetch-rules pattern frame)))
(define (apply-a-rule rule query-pattern query-frame)
(let ((clean-rule (rename-variables-in rule)))
(let ((unify-result
(unify-match query-pattern
(conclusion clean-rule)
query-frame)))
(if (eq? unify-result 'failed)
the-empty-stream
(qeval (rule-body clean-rule)
(singleton-stream unify-result))))))
(define (rename-variables-in rule)
(let ((rule-application-id (new-rule-application-id)))
(define (tree-walk exp)
(cond ((var? exp)
(make-new-variable exp rule-application-id))
((pair? exp)
(cons (tree-walk (car exp))
(tree-walk (cdr exp))))
(else exp)))
(tree-walk rule)))
(define (unify-match p1 p2 frame)
(cond ((eq? frame 'failed) 'failed)
((equal? p1 p2) frame)
((var? p1) (extend-if-possible p1 p2 frame))
((var? p2) (extend-if-possible p2 p1 frame)) ; {\em ; ***}
((and (pair? p1) (pair? p2))
(unify-match (cdr p1)
(cdr p2)
(unify-match (car p1)
(car p2)
frame)))
(else 'failed)))
(define (extend-if-possible var val frame)
(let ((binding (binding-in-frame var frame)))
(cond (binding
(unify-match
(binding-value binding) val frame))
((var? val) ; {\em ; ***}
(let ((binding (binding-in-frame val frame)))
(if binding
(unify-match
var (binding-value binding) frame)
(extend var val frame))))
((depends-on? val var frame) ; {\em ; ***}
'failed)
(else (extend var val frame)))))
(define (depends-on? exp var frame)
(define (tree-walk e)
(cond ((var? e)
(if (equal? var e)
true
(let ((b (binding-in-frame e frame)))
(if b
(tree-walk (binding-value b))
false))))
((pair? e)
(or (tree-walk (car e))
(tree-walk (cdr e))))
(else false)))
(tree-walk exp))
;;;SECTION 4.4.4.5
;;;Maintaining the Data Base
(define THE-ASSERTIONS the-empty-stream)
(define (fetch-assertions pattern frame)
(if (use-index? pattern)
(get-indexed-assertions pattern)
(get-all-assertions)))
(define (get-all-assertions) THE-ASSERTIONS)
(define (get-indexed-assertions pattern)
(get-stream (index-key-of pattern) 'assertion-stream))
(define (get-stream key1 key2)
(let ((s (get key1 key2)))
(if s s the-empty-stream)))
(define THE-RULES the-empty-stream)
(define (fetch-rules pattern frame)
(if (use-index? pattern)
(get-indexed-rules pattern)
(get-all-rules)))
(define (get-all-rules) THE-RULES)
(define (get-indexed-rules pattern)
(stream-append
(get-stream (index-key-of pattern) 'rule-stream)
(get-stream '? 'rule-stream)))
(define (add-rule-or-assertion! assertion)
(if (rule? assertion)
(add-rule! assertion)
(add-assertion! assertion)))
(define (add-assertion! assertion)
(store-assertion-in-index assertion)
(let ((old-assertions THE-ASSERTIONS))
(set! THE-ASSERTIONS
(cons-stream assertion old-assertions))
'ok))
(define (add-rule! rule)
(store-rule-in-index rule)
(let ((old-rules THE-RULES))
(set! THE-RULES (cons-stream rule old-rules))
'ok))
(define (store-assertion-in-index assertion)
(if (indexable? assertion)
(let ((key (index-key-of assertion)))
(let ((current-assertion-stream
(get-stream key 'assertion-stream)))
(put key
'assertion-stream
(cons-stream assertion
current-assertion-stream))))))
(define (store-rule-in-index rule)
(let ((pattern (conclusion rule)))
(if (indexable? pattern)
(let ((key (index-key-of pattern)))
(let ((current-rule-stream
(get-stream key 'rule-stream)))
(put key
'rule-stream
(cons-stream rule
current-rule-stream)))))))
(define (indexable? pat)
(or (constant-symbol? (car pat))
(var? (car pat))))
(define (index-key-of pat)
(let ((key (car pat)))
(if (var? key) '? key)))
(define (use-index? pat)
(constant-symbol? (car pat)))
;;;SECTION 4.4.4.6
;;;Stream operations
(define (stream-append-delayed s1 delayed-s2)
(if (stream-null? s1)
(force delayed-s2)
(cons-stream
(stream-car s1)
(stream-append-delayed (stream-cdr s1) delayed-s2))))
(define (interleave-delayed s1 delayed-s2)
(if (stream-null? s1)
(force delayed-s2)
(cons-stream
(stream-car s1)
(interleave-delayed (force delayed-s2)
(delay (stream-cdr s1))))))
(define (stream-flatmap proc s)
(flatten-stream (stream-map proc s)))
(define (flatten-stream stream)
(if (stream-null? stream)
the-empty-stream
(interleave-delayed
(stream-car stream)
(delay (flatten-stream (stream-cdr stream))))))
(define (singleton-stream x)
(cons-stream x the-empty-stream))
;;;SECTION 4.4.4.7
;;;Query syntax procedures
(define (type exp)
(if (pair? exp)
(car exp)
(error "Unknown expression TYPE" exp)))
(define (contents exp)
(if (pair? exp)
(cdr exp)
(error "Unknown expression CONTENTS" exp)))
(define (assertion-to-be-added? exp)
(eq? (type exp) 'assert!))
(define (add-assertion-body exp)
(car (contents exp)))
(define (empty-conjunction? exps) (null? exps))
(define (first-conjunct exps) (car exps))
(define (rest-conjuncts exps) (cdr exps))
(define (empty-disjunction? exps) (null? exps))
(define (first-disjunct exps) (car exps))
(define (rest-disjuncts exps) (cdr exps))
(define (negated-query exps) (car exps))
(define (predicate exps) (car exps))
(define (args exps) (cdr exps))
(define (rule? statement)
(tagged-list? statement 'rule))
(define (conclusion rule) (cadr rule))
(define (rule-body rule)
(if (null? (cddr rule))
'(always-true)
(caddr rule)))
(define (query-syntax-process exp)
(map-over-symbols expand-question-mark exp))
(define (map-over-symbols proc exp)
(cond ((pair? exp)
(cons (map-over-symbols proc (car exp))
(map-over-symbols proc (cdr exp))))
((symbol? exp) (proc exp))
(else exp)))
(define (expand-question-mark symbol)
(let ((chars (symbol->string symbol)))
(if (string=? (substring chars 0 1) "?")
(list '?
(string->symbol
(substring chars 1 (string-length chars))))
symbol)))
(define (var? exp)
(tagged-list? exp '?))
(define (constant-symbol? exp) (symbol? exp))
(define rule-counter 0)
(define (new-rule-application-id)
(set! rule-counter (+ 1 rule-counter))
rule-counter)
(define (make-new-variable var rule-application-id)
(cons '? (cons rule-application-id (cdr var))))
(define (contract-question-mark variable)
(string->symbol
(string-append "?"
(if (number? (cadr variable))
(string-append (symbol->string (caddr variable))
"-"
(number->string (cadr variable)))
(symbol->string (cadr variable))))))
;;;SECTION 4.4.4.8
;;;Frames and bindings
(define (make-binding variable value)
(cons variable value))
(define (binding-variable binding)
(car binding))
(define (binding-value binding)
(cdr binding))
(define (binding-in-frame variable frame)
(assoc variable frame))
(define (extend variable value frame)
(cons (make-binding variable value) frame))
;;;;From Section 4.1
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
(define (prompt-for-input string)
(newline) (newline) (display string) (newline))
;;;;Stream support from Chapter 3
(define (stream-map proc s)
(if (stream-null? s)
the-empty-stream
(cons-stream (proc (stream-car s))
(stream-map proc (stream-cdr s)))))
(define (stream-for-each proc s)
(if (stream-null? s)
'done
(begin (proc (stream-car s))
(stream-for-each proc (stream-cdr s)))))
(define (display-stream s)
(stream-for-each display-line s))
(define (display-line x)
(newline)
(display x))
(define (stream-filter pred stream)
(cond ((stream-null? stream) the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred
(stream-cdr stream))))
(else (stream-filter pred (stream-cdr stream)))))
(define (stream-append s1 s2)
(if (stream-null? s1)
s2
(cons-stream (stream-car s1)
(stream-append (stream-cdr s1) s2))))
(define (interleave s1 s2)
(if (stream-null? s1)
s2
(cons-stream (stream-car s1)
(interleave s2 (stream-cdr s1)))))
;;;;Table support from Chapter 3, Section 3.3.3 (local tables)
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
;;;; From instructor's manual
(define get '())
(define put '())
(define (initialize-data-base rules-and-assertions)
(define (deal-out r-and-a rules assertions)
(cond ((null? r-and-a)
(set! THE-ASSERTIONS (list->stream assertions))
(set! THE-RULES (list->stream rules))
'done)
(else
(let ((s (query-syntax-process (car r-and-a))))
(cond ((rule? s)
(store-rule-in-index s)
(deal-out (cdr r-and-a)
(cons s rules)
assertions))
(else
(store-assertion-in-index s)
(deal-out (cdr r-and-a)
rules
(cons s assertions))))))))
(let ((operation-table (make-table)))
(set! get (operation-table 'lookup-proc))
(set! put (operation-table 'insert-proc!)))
(put 'and 'qeval conjoin)
(put 'or 'qeval disjoin)
(put 'not 'qeval negate)
(put 'unique 'qeval uniquely-asserted)
(put 'lisp-value 'qeval lisp-value)
(put 'always-true 'qeval always-true)
(deal-out rules-and-assertions '() '()))
;; Do following to reinit the data base from microshaft-data-base
;; in Scheme (not in the query driver loop)
;; (initialize-data-base microshaft-data-base)
(define microshaft-data-base
'(
;; from section 4.4.1
(address (Bitdiddle Ben) (Slumerville (Ridge Road) 10))
(id (Bitdiddle Ben) 0)
(job (Bitdiddle Ben) (computer wizard))
(salary (Bitdiddle Ben) 60000)
(address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))
(id (Hacker Alyssa P) 1)
(job (Hacker Alyssa P) (computer programmer))
(salary (Hacker Alyssa P) 40000)
(supervisor (Hacker Alyssa P) (Bitdiddle Ben))
(address (Fect Cy D) (Cambridge (Ames Street) 3))
(id (Fect Cy D) 2)
(job (Fect Cy D) (computer programmer))
(salary (Fect Cy D) 35000)
(supervisor (Fect Cy D) (Bitdiddle Ben))
(address (Tweakit Lem E) (Boston (Bay State Road) 22))
(id (Tweakit Lem E) 3)
(job (Tweakit Lem E) (computer technician))
(salary (Tweakit Lem E) 25000)
(supervisor (Tweakit Lem E) (Bitdiddle Ben))
(address (Reasoner Louis) (Slumerville (Pine Tree Road) 80))
(id (Reasoner Louis) 4)
(job (Reasoner Louis) (computer programmer trainee))
(salary (Reasoner Louis) 30000)
(supervisor (Reasoner Louis) (Hacker Alyssa P))
(supervisor (Bitdiddle Ben) (Warbucks Oliver))
(address (Warbucks Oliver) (Swellesley (Top Heap Road)))
(id (Warbucks Oliver) 5)
(job (Warbucks Oliver) (administration big wheel))
(salary (Warbucks Oliver) 150000)
(address (Scrooge Eben) (Weston (Shady Lane) 10))
(id (Scrooge Eben) 6)
(job (Scrooge Eben) (accounting chief accountant))
(salary (Scrooge Eben) 75000)
(supervisor (Scrooge Eben) (Warbucks Oliver))
(address (Cratchet Robert) (Allston (N Harvard Street) 16))
(id (Cratchet Robert) 7)
(job (Cratchet Robert) (accounting scrivener))
(salary (Cratchet Robert) 18000)
(supervisor (Cratchet Robert) (Scrooge Eben))
(address (Aull DeWitt) (Slumerville (Onion Square) 5))
(id (Aull DeWitt) 8)
(job (Aull DeWitt) (administration secretary))
(salary (Aull DeWitt) 25000)
(supervisor (Aull DeWitt) (Warbucks Oliver))
(meeting accounting (Monday 9am))
(meeting administration (Monday 10am))
(meeting computer (Wednesday 3pm))
(meeting administration (Friday 1pm))
(meeting whole-company (Wednesday 4pm))
(can-do-job (computer wizard) (computer programmer))
(can-do-job (computer wizard) (computer technician))
(can-do-job (computer programmer)
(computer programmer trainee))
(can-do-job (administration secretary)
(administration big wheel))
(rule (lives-near ?person-1 ?person-2)
(and (address ?person-1 (?town . ?rest-1))
(address ?person-2 (?town . ?rest-2))
(not (same ?person-1 ?person-2))))
(rule (same ?x ?x))
(rule (wheel ?person)
(and (supervisor ?middle-manager ?person)
(supervisor ?x ?middle-manager)))
(rule (outranked-by ?staff-person ?boss)
(or (supervisor ?staff-person ?boss)
(and (supervisor ?staff-person ?middle-manager)
(outranked-by ?middle-manager ?boss))))
; From 4.63
(son Adam Cain)
(son Cain Enoch)
(son Enoch Irad)
(son Irad Mehujael)
(son Mehujael Methushael)
(son Methushael Lamech)
(wife Lamech Ada)
(son Ada Jabal)
(son Ada Jubal)
(married Mickey Minnie)
))
(initialize-data-base microshaft-data-base)
(display "[done]\n")
))
(display "\nex-4.78 - non-deterministic-query\n")
; I am trying to get the query evaluator working within the non-deterministic
; evaluator. The next step is to implement analyze-or in the non-deterministic
; evaluator.
; Exercise 4.78. Redesign the query language as a nondeterministic program to
; be implemented using the evaluator of section 4.3, rather than as a stream
; process. In this approach, each query will produce a single answer (rather
; than the stream of all answers) and the user can type try-again to see more
; answers. You should find that much of the mechanism we built in this section
; is subsumed by nondeterministic search and backtracking. You will probably
; also find, however, that your new query language has subtle differences in
; behavior from the one implemented here. Can you find examples that illustrate
; this difference?
(display "\nex-4.79\n")

View File

@ -372,6 +372,14 @@
(define (ramb? exp) (tagged-list? exp 'ramb))
(define (ramb-choices exp) (cdr exp))
; The lamb statement takes a single list and treats each item as a value. So
; its the equivalent of (apply amb list) in Scheme. Since our evaluator does
; not support that expression we use lamb. Analyze-lamb calls analyze-amb.
(define (lamb? exp) (tagged-list? exp 'lamb))
(define (lamb-choices exp) (cdr exp))
(define (analyze-lamb exp)
(analyze-amb (cons (car exp) (cadr exp))))
;; analyze from 4.1.6, with clause from 4.3.3 added
;; and also support for Let
(define (analyze exp)
@ -390,6 +398,8 @@
((let? exp) (analyze (let->combination exp))) ;**
((amb? exp) (analyze-amb exp)) ;**
((ramb? exp) (analyze-ramb exp)) ;**
((lamb? exp) (analyze-lamb exp)) ;**
((or? exp) (analyze-or exp))
((application? exp) (analyze-application exp))
(else
(error "Unknown expression type -- ANALYZE" exp))))
@ -420,8 +430,14 @@
(succeed (make-procedure vars bproc env)
fail))))
;;;Conditionals and sequences
(define (or? exp) (tagged-list? exp 'or))
(define (clauses exp) (cdr exp))
(define (no-clauses? exp) (null? exp))
(define (first-clause exp) (car exp))
(define (rest-clauses exp) (cdr exp))
; TODO: (define (analyze-or exp) ...)
;;;Conditionals and sequences
(define (analyze-if exp)
(let ((pproc (analyze (if-predicate exp)))
(cproc (analyze (if-consequent exp)))
@ -615,8 +631,6 @@
(let-body exp))
(map let-val bindings))))
;; A longer list of primitives -- suitable for running everything in 4.3
;; Overrides the list in ch4-mceval.scm
;; Has Not to support Require; various stuff for code in text (including
@ -624,30 +638,37 @@
;; eq? for ex. solution
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
(list 'list list)
(list 'memq memq)
(list 'member member)
(list 'not not)
(list 'display display)
(list (list '* *)
(list '+ +)
(list '- -)
(list '* *)
(list '<= <=)
(list '= =)
(list '> >)
(list '>= >=)
(list '<= <=)
(list 'abs abs)
(list 'remainder remainder)
(list 'integer? integer?)
(list 'sqrt sqrt)
(list 'assoc assoc)
(list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'display display)
(list 'eq? eq?)
(list 'integer? integer?)
(list 'list list)
(list 'member member)
(list 'memq memq)
(list 'newline newline)
;; more primitives
(list 'not not)
(list 'null? null?)
(list 'pair? pair?)
(list 'remainder remainder)
(list 'set-car! set-car!)
(list 'set-cdr! set-cdr!)
(list 'sqrt sqrt)
(list 'string=? string=?)
(list 'substring substring)
(list 'symbol->string symbol->string)
(list 'symbol? symbol?)
(list 'the-empty-stream the-empty-stream)
))
'AMB-EVALUATOR-LOADED