diff options
Diffstat (limited to 'lore/sicp')
-rw-r--r-- | lore/sicp/meta.scm | 20 | ||||
-rw-r--r-- | lore/sicp/set.scm | 42 |
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))))))) |