Common Lisp scratch space

README.md

Common Lisp scratch space

• Common Lisp Notes
• Adding question-mark suffixed aliases for Common Lisp predicate functions
• scratch space for 100 days of common lisp

Land of Lisp, Ch 2 notes

topics:

• defining global vars: defparameter
• mutating global vars: setf
• defining and calling functions: defun
• defining local vars: let
• defining local functions: flet, labels
• functions introduced: 1-, 1+, ash

remarks:

• symbols are case insensitive?
• defvar behavior is odd
• clever, guess-my-number can't mess up after reaching your number
• seems like you should just always use labels over flet?
  • scheme has a similar mess with let-rec, etc.

Land of Lisp, Ch 3 notes

topics:

• syntax vs semantics
• lists, symbols, numbers, strings
• code mode / data mode
• cons cells, cons, car, cdr
• functions introduced: eq, list

remarks:

• case insensitive?!?
• surprised he didn't mention quote
• surprised he didn't elaborate that cons was short for construct?
• cons, car, cdr are the same in scheme, but are conj, first, and rest in clojure.
• cadr, etc needs to be mentally evaluated in reverse order

guess-my-number.cl

(defparameter *small* 1)
(defparameter *big* 100)

(defun guess-my-number ()
    (ash (+ *small* *big*) -1))

(defun smaller ()
    (setf *big* (1- (guess-my-number)))
    (guess-my-number))

(defun bigger ()
    (setf *small* (1+ (guess-my-number)))
    (guess-my-number))

(defun start-over ()
    (setf *small* 1)
    (setf *big* 100)
    (guess-my-number))

problem1-1.cl

; misc resources:
; https://hyperpolyglot.org/lisp
; http://www.lispworks.com/documentation/HyperSpec/Body/f_parse_.htm
; https://gigamonkeys.com/book/files-and-file-io.html
; https://lispcookbook.github.io/cl-cookbook/iteration.html
; http://www.ai.sri.com/pkarp/loop.html

; read a file as a list of lines.
; thanks to https://stackoverflow.com/a/3814098
(defun read-lines (filename)
    (with-open-file (stream filename)
        (loop for line = (read-line stream nil)
            while line
            collect line)))

; convert a list of strings into a list of integers.
(defun as-ints (strs)
    (mapcar (function parse-integer) strs))

; return the number of increases in the list of depths.
(defun count-depth-increases (depths)
    (let ((current nil) (previous nil) (total 0))
        (loop
            for depth in depths
            do (if (not current) (setq current depth))
                   (progn (setq previous current)
                          (setq current depth)
                          (if (> current previous) (incf total))))
        total))

; main:
(let* ((lines (read-lines "problem1.input.txt"))
       (depths (as-ints lines))
       (num-depth-increases (count-depth-increases depths)))
    (print num-depth-increases))

problem1.cl

; misc resources:
; https://hyperpolyglot.org/lisp
; http://www.lispworks.com/documentation/HyperSpec/Body/f_parse_.htm
; https://gigamonkeys.com/book/files-and-file-io.html
; https://lispcookbook.github.io/cl-cookbook/iteration.html
; http://www.ai.sri.com/pkarp/loop.html

; read a file as a list of lines.
; thanks to https://stackoverflow.com/a/3814098
(defun read-lines (filename)
    (with-open-file (stream filename)
        (loop for line = (read-line stream nil)
            while line
            collect line)))

; convert a list of strings into a list of integers.
(defun as-ints (strs)
    (mapcar (function parse-integer) strs))

; (princ (as-ints (read-lines "problem1.input.txt")))

(defparameter *previous* nil)
(defparameter *current* nil)
(defparameter *depth-increase-count* 0)

(loop for depth in (as-ints (read-lines "problem1.input.txt"))
    do (cond ((not *current*) (setq *current* depth))
             (t (progn (setq *previous* *current*)
                       (setq *current* depth)
                       (if (> *current* *previous*) (setq *depth-increase-count* (+ 1 *depth-increase-count*)))))))

(print *depth-increase-count*)

wizard-game.cl

(load "~/lisp/qmark.cl")

(setf (fdefinition (quote prepend)) (function cons))

(setf (fdefinition (quote alist/get-pair)) (function assoc))

(defun alist/get (key alist)
    (second (alist/get-pair key alist)))

; (defparameter *nodes* (quote (
;     (living-room
;         (you are in the living-room. a wizard is snoring loudly on the couch.))
;     (garden
;         (you are in a beautiful garden. there is a well in front of you.))
;     (attic
;         (you are in the attic. there is a giant welding torch in the corner.)))))

; (assoc (quote garden) *nodes*)

; (describe-location (quote garden) *nodes*)

(defun alist/new (alist) alist)

(defun alist/push (alist key value)
    (cons (cons key value) alist))

(defun alist/get (alist key)
    (cond ((null alist) alist)
        ((eq (first (first alist)) key) (cdr (first alist)))
        (:else (alist/get (cdr alist) key))))

; (alist/get (quote ((a . 1) (b . 2))) (quote b))

; (defmacro alist/get)
; input: (alist/get alist key)
; output: (alist/get alist (quote key))

; (defparameter n (alist/new (quote ((a . 1) (b . 2)))))

(defparameter *nodes* (alist/new (quote (
    (living-room . (you are in the living-room. a wizard is snoring loudly on the couch.))
    (garden . (you are in a beautiful garden. there is a well in front of you.))
    (attic . (you are in the attic. there is a giant welding torch in the corner.))))))

(defun describe-location (location nodes)
    (alist/get location nodes))

(defparameter *edges* (alist/new (quote (
    (living-room . ((garden west door) (attic upstairs ladder)))
    (garden . ((living-room east door)))
    (attic . ((living-room downstairs ladder)))))))

(defun describe-path (edge)
    `(there is a ,(third edge) going ,(second edge) from here.))

; (describe-path '(garden west door))
;; (THERE IS A DOOR GOING WEST FROM HERE.)

(defun describe-paths (location edges)
    (let ((descriptions (mapcar (function describe-path) (alist/get edges location))))
        (apply (function append) descriptions)))

; (describe-paths (quote living-room) *edges*)
;; (THERE IS A DOOR GOING WEST FROM HERE. THERE IS A LADDER GOING UPSTAIRS FROM HERE.)

(defparameter *objects* (quote (whiskey bucket frog chain)))

(defparameter *object-locations* (alist/new (quote (
    (whiskey . living-room)
    (bucket . living-room)
    (chain . gargen)
    (frog . garden)))))

(defun objects-at (loc objs obj-locs)
    (labels ((at-loc? (obj)
                (eq (alist/get obj-locs obj) loc)))
        (remove-if-not (function at-loc?) objs)))

(objects-at (quote living-room) *objects* *object-locations*)

; hmm, this appears to be broken, returning (frog) instead of (chain frog)
(objects-at (quote garden) *objects* *object-locations*)

how do function pointers work exactly?

(substitute-if #\a (lambda (ch) t) "abcd")
(substitute-if #\a (function atom) "abcd")