[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/8cfeZ3ER    [ raw code | output | fork ]

Scheme, pasted on Oct 28:
; rip john mccarthy

(define null null?)

(define (atom x) (not (pair? x)))

(define (*pairlis x y a)
  (cond ((null x) a)
        (else (cons (cons (car x) (car y))
                    (*pairlis (cdr x) (cdr y) a)))))

(define (*assoc x a)
  (cond ((equal? (caar a) x) (car a))
        (else (*assoc x (cdr a)))))

(define (*apply fn x a)
        (cond ((atom fn)
                (cond ((eq? fn 'car) (caar x))
                      ((eq? fn 'cdr) (cdar x))
                      ((eq? fn 'cons) (cons (car x) (cadr x)))
                      ((eq? fn 'atom) (atom (car x)))
                      ((eq? fn 'eq) (eq? (car x) (cadr x)))
                      ((eq? fn 'null) (null (car x)))
                      (else (*apply (*eval fn a) x a))))
              ((eq? (car fn) 'lambda)
                (*eval (caddr fn) (*pairlis (cadr fn) x a)))
              ((eq? (car fn) 'label)
                (*apply (caddr fn) (cdr x) (cons (cons (cadr fn) (caddr fn)) a)))))

(define (*eval e a)
  (cond ((atom e) (cdr (*assoc e a)))
        ((atom (car e))
          (cond ((eq? (car e) 'quote) (cadr e))
                ((eq? (car e) 'cond) (*evcon (cdr e) a))
                (else (*apply (car e) (*evlis (cdr e) a) a))))
        (else (*apply (car e) (*evlis (cdr e) a) a))))

(define (*evcon c a)
  (cond ((*eval (caar c) a) (*eval (cadar c) a))
        (else (*evcon (cdr c) a))))

(define (*evlis m a)
  (cond ((null m) '())
        (else (cons (*eval (car m) a) (*evlis (cdr m) a)))))

(define (*evalquote fn x) (*apply fn x '()))

(display
  (*evalquote
    '(lambda (x y)
       (cons (car x) y))
    '((a b) (c d))))
(newline)

(display
  (*evalquote
    '(label reverse
      (lambda (ls new)
        (cond ((null ls) new)
              ((quote t) (reverse (cdr ls) (cons (car ls) new))))))
    '(reverse (a b c d e) ())))
(newline)


Output:
1
2
(a c d)
(e d c b a)


Create a new paste based on this one


Comments: