;;;;; intro.l

;;;; source: http://www.it.uu.se/edu/course/homepage/avfunpro/ht11
;;;;                            /notes/handout/f04-lisp.html

;;;; C-c C-z to run Lisp interpreter
;;;; then (load "intro.l") to run once
;;;; from then on, (rn) to run
;;;; quit with (quit)

(defun rn ()
  (load "intro.l") )

;;; lists
;; quote (') is used so first list element is not interpreted as operator
nil                                     ; empty; or false, or uninitiated
'()                                     ; empty; (eq '() nil) => t
'(1 2 3)                                ; flat
'( (1 2) (3 4))                         ; nested

;; destructive update on lists
(defparameter *decimal-digits* '(0 1 2 3 4 5 6 7 8 9))
(setf (car *decimal-digits*) 1)

;; recursive list append
;; "append" predefined: (append '(x) '(y z)) => '(x y z)
(defun appendx (x y)                    ; untyped arguments
  (cond                                 ; preferred to if
   ((null x) y)                         ; empty list check
   (t                                   ; t = true; here else token
    (cons                               ; cons: head + tail = list
     (car x)                            ; car = first ("head")
     (appendx (cdr x) y) ))))           ; cdr: "tail"

;;; number types
1        ; 1            integer
1.2e7    ; 1.2 * 10^7   float
1.2d68   ; 1.2 * 10^68  double
#c(0 1)  ; i            complex number

;; artihmetic operations on rationals
(/ 10 3)
(+ (/ 10 3) (/ 20 3))

;;; symbols
;; start                                   ; ordinary
;; stop-here                               ; hyphen preferred to underscore
;; |symbols like this are silly|           ; anything goes between pipes

;;; dotted list notation
;; what if the second argument to cons isn't a list?
;; (cons 'x 'y) => (x . y)
;; "Not common in modern code! Don't build lists like this!" (OK...)

;; strings between double quotes
"Hello World!"

;; HOF syntax: (map-function 'output-type lambda input) => mapped-output
;; input can be a list, a vector, or a string (and possibly other things)
(mapcar                                 ; list function
  (lambda (x) (* x x))                  ; anonymous function on element
 '(1 2 3 4) )                           ; input list

(map 'list                              ; map 'list ≈ mapcar (?)
      (lambda (x) (* x x))
     '(1 2 3 4) )

(map 'vector                            ; a vector: #(1 4 9 16)
      (lambda (x) (* x x))
     #(1 2 3 4) )                       ; list here works too

(map 'string
     (lambda (x) (code-char (+ 64 x)))
     '(1 2 3 4) )

;; my-map
(defun my-map (f l)
  (cond
   ((null l) nil)
   (t (cons
       (funcall f (car l))      ; funcall: f undefined at compile time
       (my-map f (cdr l)) ))))

;; more HOF: reduce (lists)
(reduce #'+ '(1 2 3 4))                 ; 10
(reduce #'* '(1 2 3 4))                 ; 24

(reduce #'+ '())                        ; 0 (identity of addition)
(reduce #'* '())                        ; 1 (ditto multiplication)

(+)                                     ; 0
(*)                                     ; 1

;;; equality
(defparameter *one*   1)
(defparameter *two*   2)
(defparameter *three* 3)

;; eq (at least one symbol)
(eq *one* *one*)
(eq *one* 1)
(eq 123 123)                            ; t
(eq 1234567890 1234567890)              ; nil, too big integers; use =

;; = (at least one number)
(= 1 1)
(= 1 *one*)
(= 1234567890 1234567890)               ; t

;; eql - arguments are of the same _type_, *and* equal under eq *or* =
(eql 1 1.0) ; nil as 1 is integer and 1.0 is float

;; equal (list equality - probably recursive "eql")
(equal '(1 2 3 4) '(1 2 3 4))

;; all-equal
(defun all-equal (f l)
  (labels ((all-equal-help (f hd tl)    ; a local function (labels)
             (let ((tl-hd (car tl)))    ; with a local variable (let)
               (cond
                ((null tl) t)
                ((funcall f hd tl-hd) (all-equal-help f tl-hd (cdr tl)))
                (t nil) ))))
    (all-equal-help f (car l) (cdr l)) ))

;; nil exercise
nil
(null nil)       ; t
(not (null nil)) ; => (not t) => nil

;;; reverse a list
;; a tail-recursive local (convenience) accumulator function
(defun rev (l)
  (labels
      ((rev-help (l acc)                
         (cond
          ((null l) acc)
          (t (rev-help (cdr l) (cons (car l) acc))) )))
    (rev-help l nil) ))

;; sum
(defun sum (n)
  (labels
      ((sum-help (i s)
         (if
           (zerop i) s                  ; zero predicate: (zerop 0) => t
           (sum-help (1- i)             ; (1- i) = (- i 1)
                     (+ i s) ))))
    (sum-help n 0) ))

; trace with (trace f), but cannot trace local functions

;; imperative-style rev ("setf" => side effects)
(defun imp-rev (l)
  (let ((acc nil))
    (labels ((my-rev-help ()
               (cond
                ((null l) acc)
                (t
                 (setf acc (cons (car l) acc))
                 (setf l (cdr l))
                 (my-rev-help) ))))
      (my-rev-help)
      acc )))

;;; control constructs

;; dolist
(defun dolist-rev (l)
  (let ((acc nil))
    (dolist (e l)                       ; (dolist (elem list) fun)
      (setf acc (cons e acc)) )
    acc ))

;; dotimes
;; i = 0, 2, 3, ..., (n - 1)
;; (setf i (1+ i)) implicit
(defun fac (n)
  (let ((acc 1))
    (dotimes (i n)                      ; (dotimes (iter while-below) fun)
      (setf acc (* acc (1+ i))) )
    acc ))

;; when - condition and single branch (on true)
(defun when-loop (i r)
  (when (<= r i)
    (print "Done.") )
  (when (< i r)
    (print i)
    (when-loop (1+ i) r) ))

;; loop - infinite loop
(defun block-loop (i r)
  (print i)
  (block inc                            ; named scope to return from
    (loop                               ; infinite loop
     (setf i (1+ i))                    ; do things
     (when (<= r i)                     ; condition
       (return-from inc i)) )))         ; return with exit value

;; when-fac
(defun when-fac (n)
  (let ((acc 1))
    (block fac
      (loop
       (setf acc (* acc n))
       (setf n (1- n))
       (when (zerop n)
         (return-from fac acc) )))))

;; implicit block
(defun imp-fac (n)
  (let ((acc 1))
    (loop
     (setf acc (* acc n))
     (setf n (1- n))
     (when (zerop n)
       (return-from imp-fac acc) )))) ; function name as scope

;; arrays
(defparameter *xyz-position* #(1 2 3))

(defun get-pos (a pos)
  (cond ((eq a 'x) (aref pos 0))
        ((eq a 'y) (aref pos 1))
        ((eq a 'z) (aref pos 2)) ))

(defparameter *x* 0)
(defparameter *y* 1)
(defparameter *z* 2)

(defun get-pos-2 (a pos)
  (aref pos a) )

(defun set-pos-2 (a pos new-a-pos)
  (setf (aref pos a) new-a-pos) )

;; circular list
(setf *print-circle* t)
(defparameter *finite-list* '(1 2 3))
(defparameter *infinite-list* (setf (cdddr *finite-list*) *finite-list*))

;; shared lists
(defparameter *my-list* '(2 3 4))
(defparameter *your-list* '(5 6 7))
(defparameter *shared-list* (append *my-list* *your-list*))
(setf (car *your-list*) 0)

;; multiple return values
(values 1 2 3)                          ; returns 1, 2, and 3!
(+ (values 1 2 3) 5)                    ; 6 (only first is used...)

;; hash tables
(defparameter *htbl* (make-hash-table))

(setf (gethash 'Per     *htbl*) 1)
(setf (gethash 'Manne   *htbl*) 2)
(setf (gethash 'Björn   *htbl*) 3) ; works in Sweden
(setf (gethash 'Marquéz *htbl*) 4) ; and in Mexico

(hash-table-size  *htbl*) ; 16 for ≤ 16 entries; then 32; etc.
(hash-table-count *htbl*) ; number of entries

;; print all tuples
(defun itr-tbl (tbl)
  (with-hash-table-iterator (gen tbl)            ; make iterator
    (loop                                        ; iterate
     (multiple-value-bind (more key value) (gen) ; get entry; check for more
       (unless more (return-from itr-tbl))       ; exit on end of table
       (format t               ; t = *standard-output* (print to stdout)
               "[~w: ~w]~%"    ; ~w = anything writable; ~% = newline
               key value )))))

;;; sequences

;; length
(length '(1 2 3 4)) ; 4
(length #(1 2 3))   ; 3
(length "Ema")      ; 3

;; concatenate
(concatenate 'string
             "You " "are " "not " "you; " "you " "are " "me.")
(concatenate 'list
             "You " "are " "you.") ; (#\Y #\o ...

;; find
(defparameter *total-recall* "You are not you. You are me.")
(find #\x *total-recall*) ; nil - `x` not in string
(find #\y *total-recall*) ; #\y - `y` in string

;; both characters and functions are prefixed by the hash sign
#\a ; the `a` character
#'+ ; the `+` (addition) operator