Skip to content

Instantly share code, notes, and snippets.

@pauloricardokoch
Last active May 3, 2016 02:57
Show Gist options
  • Save pauloricardokoch/d92a614cbad49e93e8882f9c8ad8c404 to your computer and use it in GitHub Desktop.
Save pauloricardokoch/d92a614cbad49e93e8882f9c8ad8c404 to your computer and use it in GitHub Desktop.
The little schemer
;; THE LAW OF CAR
;; The primitive car is defined only for non-empty lists.
;; THE LAW OF CDR
;; The primitive cdr is defined only for non-empty lists.
;; The cdr of any non-empty list is always another list.
;; THE LAW OF CONS
;; The primitive cons takes two arguments.
;; The second argument to cons must be a list.
;; The result is a list.
;; THE LAW OF NULL?
;; The primitive null? is defined only for lists.
;; THE LAW OF EQ?
;; The primitive eq? takes two arguments.
;; Each must be a non-numeric atom.
;; THE FIRST COMMANDMENT (preliminary)
;; Always ask null? as the first question in expressing
;; any function.
;; THE SECOND COMMANDMENT
;; Use cons to build lists.
;; THE THIRD COMMANDMENT
;; When building a list, describe the first typical element,
;; and then cons it onto the natural recursion.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Asks if x is an atom.
(define atom?
(lambda (x)
(and (not (pair? x)) (not (null? x)))))
;; Asks if each S-expression in l is an atom.
(define lat?
(lambda (l)
(cond
((null? l) #t)
((atom? (car l)) (lat? (cdr l)))
(else #f))))
;; Asks if one of the atom of the lat is the same as
;; the atom a.
(define member?
(lambda (a lat)
(cond
((null? lat) #f)
(else (or (eq? (car lat) a)
(member? a (cdr lat)))))))
;; Takes an atom and a lat as its arguments, and makes a
;; new lat with the first occurrence of the atom in the old
;; lat removed.
(define rember
(lambda (a lat)
(cond
((null? lat) (quote ()))
((eq? (car lat) a) (cdr lat))
(else (cons (car lat)
(rember a (cdr lat)))))))
;; Takes one argument, a list, which is either a null list
;; or contains only non-empty lists. It builds another list
;; composed of the first S-expression of each internal list.
(define firsts
(lambda (l)
(cond
((null? l) (quote ()))
(else (cons (car (car l))
(firsts (cdr l)))))))
;; Takes three arguments: the atoms new and old, and a lat.
;; The function builds a lat with new inserted to the right
;; of the first occurrence of old.
(define insertR
(lambda (new old lat)
(cond
((null? lat) (quote ()))
((eq? old (car lat)) (cons (car lat) (cons new (cdr lat))))
(else
(cons (car lat) (insertR new old (cdr lat)))))))
;; Takes three arguments: the atoms new and old, and a lat.
;; The function builds a lat with new inserted to the left
;; of the first occurrence of old.
(define insertL
(lambda (new old lat)
(cond
((null? lat) (quote ()))
((eq? old (car lat)) (cons new (cons old (cdr lat))))
(else
(cons (car lat) (insertL new old (cdr lat)))))))
;; Builds a new lat with the new on the place of first
;; occurrence of old.
(define subst
(lambda (new old lat)
(cond
((null? lat) (quote ()))
((eq? old (car lat)) (cons new (cdr lat)))
(else
(cons (car lat) (subst new old (cdr lat)))))))
;; Builds a new lat with the new on the place of first
;; occurrence of o1 or o2.
(define subst2
(lambda (new o1 o2 lat)
(cond
((null? lat) (quote ()))
((or (eq? o1 (car lat)) (eq? o2 (car lat))) (cons new (cdr lat)))
(else
(cons (car lat) (subst2 new o1 o2 (cdr lat)))))))
;; Build a new lat with all occurrences of a removed.
(define multirember
(lambda (a lat)
(cond
((null? lat) (quote ()))
((eq? a (car lat)) (multirember a (cdr lat)))
(else (cons (car lat) (multirember a (cdr lat)))))))
;; Takes three arguments: the atoms new and old, and a lat.
;; The function builds a lat with new inserted to the right
;; of all occurrences of old.
(define multiinsertR
(lambda (new old lat)
(cond
((null? lat) (quote ()))
((eq? old (car lat)) (cons (car lat) (cons new (multiinsertR new old (cdr lat)))))
(else (cons (car lat) (multiinsertR new old (cdr lat)))))))
;; Takes three arguments: the atoms new and old, and a lat.
;; The function builds a lat with new inserted to the left
;; of all occurrences of old.
(define multiinsertL
(lambda (new old lat)
(cond
((null? lat) (quote ()))
((eq? old (car lat)) (cons new (cons old (multiinsertL new old (cdr lat)))))
(else (cons (car lat) (insertL new old (cdr lat)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment