summaryrefslogtreecommitdiff
path: root/lore/sicp
diff options
context:
space:
mode:
Diffstat (limited to 'lore/sicp')
-rw-r--r--lore/sicp/meta.scm20
-rw-r--r--lore/sicp/set.scm42
2 files changed, 62 insertions, 0 deletions
diff --git a/lore/sicp/meta.scm b/lore/sicp/meta.scm
new file mode 100644
index 0000000..94dc784
--- /dev/null
+++ b/lore/sicp/meta.scm
@@ -0,0 +1,20 @@
+(define (eval exp env)
+ (cond
+ ((self-evaluating? exp) exp)
+ ((variable? exp) (lookup-variable-value exp env))
+ ((quoted? exp) (text-of-quotation exp))
+ ((assignment? exp) (eval-assignment exp env))
+ ((definition? exp) (eval-definition exp env))
+ ((if? exp) (eval-if exp env))
+ ((lambda? exp)
+ (make-procedure (lambda-parameters exp)
+ (lambda-body exp)
+ env))
+ ((begin? exp)
+ (eval-sequence (begin-actions exp) env))
+ ((cond? exp) (eval (cond->if exp) env))
+ ((application? exp)
+ (apply (eval (operator exp) env)
+ (list-of-values (operands exp) env)))
+ (else
+ (error "Unknown expression type -- EVAL" exp))))
diff --git a/lore/sicp/set.scm b/lore/sicp/set.scm
new file mode 100644
index 0000000..3d60c5c
--- /dev/null
+++ b/lore/sicp/set.scm
@@ -0,0 +1,42 @@
+;; A set module, based on binary trees (from sicp)
+
+(define (entry tree) (car tree))
+(define (left-branch tree) (cadr tree))
+(define (right-branch tree) (caddr tree))
+
+(define (make-tree entry left right)
+ (list entry left right))
+
+(define (element-of-set? x set)
+ (cond ((null? set) #f)
+ ((= x (entry set)) #t)
+ ((< x (entry set))
+ (element-of-set? x (left-branch set)))
+ ((> x (entry set))
+ (element-of-set? x (right-branch set)))))
+
+(define (adjoin-set x set)
+ (cond ((null? set) (make-tree x '() '()))
+ ((= x (entry set)) set)
+ ((< x (entry set))
+ (make-tree (entry set)
+ (adjoin-set x (left-branch set))
+ (right-branch set)))
+ ((> x (entry set))
+ (make-tree (entry set)
+ (left-branch set)
+ (adjoin-set x (right-branch set))))))
+
+(define (intersection-set set1 set2)
+ (if (or (null? set1) (null? set2))
+ '()
+ (let ((x1 (car set1))
+ (x2 (car set2)))
+ (cond ((= x1 x2)
+ (cons x1
+ (intersection-set (cdr set1)
+ (cdr set2))))
+ ((< x1 x2)
+ (intersection-set (cdr set1) set2))
+ ((< x2 x1)
+ (intersection-set set1 (cdr set2)))))))