wortelstoemp · May 13, 2020 13:19
diff --git a/cl-cheatsheet.lisp b/cl-cheatsheet.lisp
 ;;;; Cheatsheet for Common Lisp

 ;;;  REFERENCES
 ;;; - Info: https://anticrisis.github.io/2017/09/04/how-i-got-started-with-common-lisp-2017.html
 ;;; - Learning Common Lisp: 
 ;;;			http://www.newthinktank.com/2015/07/learn-lisp-one-video/
 ;;;			https://lispcookbook.github.io/cl-cookbook/
 ;;; 		(Advanced) http://www.gigamonkeys.com/book/
 ;;; - Exercises:
 ;;;		http://www.4clojure.com/problems 

 ;;; - Install sbcl installer on http://www.sbcl.org/platform-table.html 
 ;;; - Download quicklisp.lisp from https://beta.quicklisp.org/quicklisp.lisp
 ;;; - Install quicklisp:
 ;;; 		$ sbcl --load quicklisp.lisp
 ;;; 		(quicklisp-quickstart:install :path "./quicklisp")
 ;;; 		(ql:add-to-init-file)
 ;;; 		(quit)
 ;;; - Find libraries on http://quickdocs.org/
 ;;; - Use REPL: 
 ;;; 		$ sbcl
 ;;; 		(format t "Hello, World!")
 ;;; - Create a project:
 ;;; 		$ cd my_projects
 ;;; 		$ sbcl	
 ;;; 		(ql:quickload "cl-project")
 ;;; 		(cl-project:make-project #P"./name-of-my-project/")
 ;;; 		(quit)

 ;;; 	https://stackoverflow.com/questions/48103501/deploying-common-lisp-web-applications
 ;;; 	https://github.com/fare/asdf/blob/master/doc/best_practices.md
 ;;;		BEFORE WORKING ON EACH PROJECT 	
 ;;;		In the quicklisp/local-projects/system-index.txt file you need to
 ;;;		put the path to the .asd file, e.g.: D:/Projects/Startup/kp/cl-photon-framework/cl-photon-framework.asd
 ;;;		Better alternative: Symlink (on Windows/Linux) to appear as if the project is in quicklisp/local-projects


 ;;; - Using REPL: $ sbcl
 ;;; - Load lisp file in REPL:
 ;;;		$ sbcl
 ;;; 		(load "hello.lisp")
 ;;; - Better: install Atom and SLIMA!

 ;;; - Compile the project
 ;;;		$ sbcl
 ;;;			(asdf:load-system "my-app")
 ;;; 		(ql:quickload :my-app)
 ;;; 		(asdf:make :my-app)
 ;;; 		Press 0 to continue if necessary
 ;;; 	or in 1 command to put in shell script:
 ;;;		$sbcl --eval "(asdf:load-system :my-app)" ^ 
 ;;;   --eval "(ql:quickload :my-app)" ^
 ;;;   --eval "(asdf:make :my-app)" ^
 ;;;   --eval "(quit)"  

 ;;; C libraries on Windows: put them in same folder as lisp.exe of sbcl (or maybe in System32 ?)

 ;;; Debugging: 
    ;; Use print/format in code
    ;; (inspect x) in REPL
    ;; Breakpoints: (break "x=~a, y=~a" 10 20)
    ;; Trace functions:
        ;; (trace f), use function, (untrace f)
    ;; Trace methods:
        ;; (trace foo :methods t)

 ;;; Remembering function names in Lisp:
  ;; Partially: (apropos "map" :cl)
  ;; Describe: (describe 'map)

 ;;; Performance tuning:
    ;; Assembly:  (disassemble #'my-func)
    ;; Timing:    (time (my-func 1 2))
    ;; Optimization: inline + more speed (3) and less safety (0) + type hinting + function types + avoid generic functions
    ;; YOU CAN'T PUT DECLARES IN MACROS!!!    
 		;; (declaim (inline max-optimized))
        ;; (declaim (ftype (function (integer integer) integer) max-optimized))
        ;; (defun max-optimized (a b)
        ;;   (declare (optimize (speed 3) (safety 0)))
        ;;   (declare (type integer a b))
        ;;   (the integer (max a b)))

        ;; or for entire file: (declaim (optimize (speed 3) (safety 0)))
        ;; Must re-compile callers when inlined function changes.

        ;; Types for variables:
        ;; (declaim (type (string) *str*))
        ;; (defparameter *str* "hello")

 ;;; ----------------------------------------------------------------------------
 ;;;
 ;;; Common Lisp
 ;;;
 ;;; ----------------------------------------------------------------------------

 ;;; ----------------------------------------------------------------------------
 ;;; Imperative programming
 ;;; ----------------------------------------------------------------------------
 ;;; Lisp code is a tree: (+ 5 (- 6 2)) ; => 9

 (format t "Hello, World!~%")    ; t (true) prints to console 
                                ; and returns nil, '~%' is newline, '~T' is tab)
 (print "Hello, World!")
 (terpri)                        ; print newline

 (format nil "Hello!")           ; nil (false) just returns string

 ;;; Global variables (and read from console)
 (defconstant +c+ 20)            ; constant
 (defvar *var* (read))           ; keeps same begin value unless changed with setf
 (defparameter *param* 15)       ; can be assigned new value when recompiling
 (defparameter *param* 16)       ; 

 ;;; Datatypes
  ;; integer:			  10			#b1010 in binary, #o12 in octal, #xA in hexadecimal
  ;;								        #2r1010 in binary, #8r12 in octal, #16rA in hexadecimal
  ;; single-float:	1.0f0		(= default floating-point number 1.0)
  ;; double-float:	1.0d0
  ;; boolean:			  t / nil
  ;; character:		  #\A

 ;;; Change value of variable
 (setf *number* 6)

 ;;; ---------- STRUCTS ---------------------------------------------------------
 ;;; Structs are always pass by reference as function parameter, so mutable!
 (defstruct person
  (id 0 :type integer)
  (name nil :type string)
  age)

 ;;; make on heap
 (defparameter *me* (make-person
                    :id 9000
                    :name "Tom Q"
                    :age 28))

 ;;; make on stack (needs local scope!)
 (let ((you (make-person
            :id 69
            :name "Sexy Lady"
            :age 30)))
  (declare (dynamic-extent you))
  (format t "~s~%" you))

 (person-name *me*)          ; get
 (setf (person-age *me*) 27) ; set

 (format t "~s~%" *me*)

 ;;; predicate function to check type
 (person-p *me*) ; => t

 ;;; ---------- LOCAL VARIABLES -------------------------------------------------
 ;;; (let (definitions) (body))
 (let ((x 5) (y 10) (z 20)) 
  (format t "~d ~%" (+ x y z))) ;; body

 ;;; Local variables which are used in other definitions
 ;;; (let* (definitions) (body))
 (let* ((a 1) 
       (b (* a 2)))
 (+ a b)) ;; body

 ;; rotatef: swap values of 2 variables
 (let ((a 1) (b 2))
  (print a)
  (print b)
  (rotatef a b)
  (print a)
  (print b))

 ;;; ---------- FUNCTIONS -------------------------------------------------------
 (defun hello-world (name)
  "Description of function"
  (format t "Hello, world to ~a!~%" name))

 (hello-world *name*)

 ;;; Functions returning multiple values (NOT a list!)
 (defun test0 (x y)
  (values 
    (+ x 1)
    (+ y 1)))
  
 (test0 10 20)
 (multiple-value-bind (a b) (test0 10 20)
      (format t "~d and ~d~%" a b))

 ;;; Functions with optional defaulted parameters
 (defun test1 (x &optional (y 0) (z 0))
  (+ x y z))

 (test1 10)

 ;;; Test if an optional value is set
 (defun test2 (&optional (y 0 y-set))
  (if y-set
    (format t "y is set: ~d~%" y)
    (format t "y is not set~%")))

 ;;; Functions with any number of parameters
 ;;; DON'T USE &REST AND &OPTIONAL TOGETHER!!!
 (defun test3 (&rest params)
  (format t "~a~%" params)
  (length params))

 (test3 10 20 30 40)

 ;;; Functions with keyword parameters 
 (defun test4 (&key x y (z 0))
  (format t "List: ~a ~%" (list x y z)))


 (test4 :y 10 :x 20) ;; order doesn't matter

 ;;; Functions with parameters passed by reference
 (defvar *x* 100)

 (defun test-inc (x) 
  (incf (symbol-value x)))

 (test-inc '*x*) ; *x* is now 101

 ;;; Generic functions (inlined methods)       => avoid because slower
 (defgeneric test-f (x y)
  (:method ((x number) (y number)) 
    (+ x y))
  (:method ((x string) (y string))
    (concatenate 'string x y)))

 ;;; Generic functions (use for extension):    => avoid because slower
 ;;; different methods for same function name (methods are not bound to classes in LISP)
 (defgeneric test-g (x y))
 (defmethod test-g ((x number) (y number)) 
  (+ x y))
 (defmethod test-g ((x string) (y string))
  (concatenate 'string x y))

 ;;; Functions as arguments
 (defun test (x y)
  (+ x y))

 (defun test-caller (f x y)
  (funcall f x y))

 (test-caller #'test 1 2)

 ;;; Split elements of list as function arguments
 (defun test (x y)
  (+ x y))

 (apply #'test '(1 2))

 ;;; ---------- CONTROL STRUCTURES ----------------------------------------------
 ;;; if (is a special form and only evaluates cases that apply to condition)
 (if (> 5 4) 
  (format t "true")
  (format t "false")) ; else

 (if (and (>= 100 18) (<= 20 67))
  (format t "Yes!~%")
  (format t "No!~%"))

 ;;; relational operators: = < <= >= >
 ;;; logical operators: and, or, not

 ;;; progn to execute multiple statements in if 
 (defun add10 (val)
  "Description of function"
  (if val
    (progn                
      (format t "start!~%")
      (incf val 10)
      val)              ; => return last result
    (format t "I need a value!~%")))   ; else

 (add10 10) ; => 20

 ;;; when is used when there is no else so you can execute multiple statements
 (when (> 5 4) 
  (format t "first~%") 
  (format t "second~%"))

 ;;; cond (is like switch-case, check value comparable with eql function)
 (defun test-cond (x)
  (cond
    ((= x 0) "0")
    ((= x 1) "1")
    ((= x 2) "2")
    (t nil)))

 (test-cond 3) ; => nil

 ;;; case (check value comparable with eq function => identical in memory)
 ;;; DON'T USE NUMBERS, ONLY SYMBOLS!!!
 (defun test-case (x)
  (case x
    (:p (format nil ":p"))
    (:d (format nil ":d"))
    (:n (format nil ":n"))
    (otherwise nil))) ; optional

 (test-case :a) ; => nil (otherwise case)

 ;;; typecase (check datatype)
 (defun test-typecase (x)
  (typecase x
    (integer (format nil "integer"))
    (string (format nil "string"))
    (otherwise (format nil "otherwise"))))

 (test-typecase 1.0) ; => otherwise

 ;;; flet: define local function(s)
 (flet ((square (val) 
        (* val val)) 
       (cube (val) 
         (* val val val))) 
  (list (square 10) (cube 10)))

 ;;; labels: same as flet, but now you can use functions in other functions
 ;;; order of functions doesn't matter!
 (labels  ((square (val) 
           (* val val)) 
          (cube (val)
            (* (square val) val))) 
  (list (square 10)(cube 10)))

 ;;; ---------- LOOPING ---------------------------------------------------------
 (dotimes (i 12)
  (print i))

 ;;; loop for
 (loop for i from 0 below 10 do      ; [0, 10[
  (print i))

 (loop for i from 0 to 10 by 2 do    ; [0, 10] stepsize = 2
  (print i))

 (loop for i from 10 above 0 do      ; [10, 0[
  (print i)
  (terpri))
  
 (loop :for c1 :across "Hello" :for c2 :across "abcde" :do
  (print c1)
  (print c2))
  
 (loop for x from 0 to 50 by 10 collect x)      ; => (0 10 20 30 40 50) 
 (loop for x from 50 downto 0 by 10 collect x)  ; => (50 40 30 20 10 0) 

 ; stepsize: #'cdr = 1 (default), #'cddr = 2, #'cdddr = 3,...
 (loop for x in '(0 10 20 30 40 50) by #'cdr do
  (format t "~d~%" x))
 
 ;;; loop while
 (let ((i 0))
  (loop while (<= i 10) do
    (print i)
    (incf i)))
 	
 ;;; loop until	
 (let ((i 0))
  (loop until (> i 10) do
    (print i)
    (incf i)))
 
 ;;; ---------- STRINGS ---------------------------------------------------------
 ;;; Strings are mutable arrays	(type-of *my-string*)
 ;;; (defvar *arr* (make-array 5 :element-type 'character :initial-element #\_))
 (defvar *my-string* "Hello")
 (aref *my-string* 0)                ; => #\H
 (setf (aref *my-string* 0) #\B)
 (print *my-string*)                 ; => "Bello"

 ;;; compare strings
 (equal "hello" "Hello")             ; case-sensitive
 (string= "hello" "Hello")
 (equalp "hello" "Hello")            ; case-insensitive
 (string-equal "hello" "Hello")

 ;;; String formatting
 (format nil "Hello, ~a!" "Tom")     
 (format nil "~s" :foo)              ; Data as string
 (format nil "~:d" 10000000)         ; Number with commas
 (format nil "~b" 42)                ; Number as binary string 
 (format nil "~o" 42)                ; Number as octal string
 (format nil "~x" 42)                ; Number as hexadecimal string 
 (format nil "~,2F" 20.1)            ; 2 digits after decimal

 (format nil "~{~a~^, ~}" '(1 2 3))  ; List and no , after last element: 1, 2, 3
                                    ; ("~{ ~}" is a loop)
 (format t "PI to 5 characters ~5f" pi)
 (format t "PI to 5 decimals ~,5f" pi)

 (defparameter *my-str* "abcdefghijklm")
 ;;; characters from string
 (char *my-str* 4)
 (setf (char *my-str* 4) #\E)

 ;;; character as number and vice versa
 (char-code #\a)                               ; => 97
 (code-char 97)                                ; => #\a

 ;;; string to integer or other numbers
 (parse-integer "42")                          ; => 42
 (read-from-string "1.2e2")                    ; => 120.0

 ;;; number to string
 (write-to-string 42)                          ; => "42"
 (write-to-string 1.2e2)                       ; => "1.2e2"

 ;;; substrings
 (subseq *my-str* 4)                           ; substring from 4th char to end
 (subseq *my-str* 4 5)                         ; substring from [4, 5[
                                              
 (setf (subseq *my-str* 0 4) "iiii")           ; change substring

 ;;; string trimming
 (string-trim " " " trim me ")                 ; => "trim me"
 (string-left-trim " " " trim me ")            ; => "trim me "
 (string-right-trim " " " trim me")            ; => " trim me"

 ;;; remove char from string
 (remove #\o "Homo Sapiens")                   ; => "Hm Sapiens"
 (remove #\o "Homo Sapiens" :start 3)          ; => "Hom Sapiens"
 (remove-if #'upper-case-p "He-Man")           ; => "e-an"

 ;;; substitute char
 (substitute #\l #\m "Tommy")                  ; => "Tolly"
 (substitute-if #\_ #'upper-case-p "He-Man")   ; => "_e-_an"

 ;;; concatenate strings
 (concatenate 'string "a" "b" "c")             ; => "abc"

 ;;; loop through string
 (loop for c across "Hello" do 
  (print c))

 (map 'string #'(lambda (c) (print c)) "Hello")

 ;;; reverse string
 (reverse "Hello")                             ; => "olleH"

 ;;; change cases (also can use :start and :end)
 (string-upcase "cool")                        ; => "COOL"
 (string-downcase "COOL")                      ; => "cool"
 (string-capitalize "cool")                    ; => "Cool"

 ;;; string to char
 (coerce "a" 'character) 

 ;;; char array to string
 (coerce #(#\h #\e #\y) 'string)

 ;;; ---------- MATH FUNCTIONS --------------------------------------------------
 (defparameter *x* 1)
 (incf *x*)                            ; x++
 (decf *x*)                            ; x--
 (null nil)                            ; = T Is something equal to nil

 (+ 5 4) 
 (- 5 4) 
 (* 5 4) 
 (/ 5 4)                               ; 5/4
 (/ 5 4.0)                             ; 1.25 or (float (/ 5 4))
 (mod 5 4)                             ; 1  (or rem)
  
 (expt 4 2000)                         ; 4^2000 (get the exact large number)
 (sqrt 81)                             ; 9
 (isqrt 10)                            ; 3
 (sqrt -4)                             ; #C(0.0 2.0) (complex number)

 (exp 1)                               ; e^1
 (log 1000 10)                         ; = 3 = Because 10^3 = 1000
 (floor 5.5)                           ; = 5
 (ceiling 5.5)                         ; = 6
 (max 5 1000 200 50)                   ; = 10
 (min 5 1000 200 50)                   ; = 5
 ;;; sin, cos, tan, asin, acos, atan
 (sin (/ pi 2.0))

 (evenp 15)                            ; Check if even 
 (oddp 15)                             ; Check if odd 
 (numberp 2)                           ; Check if number
 (integerp 2)                          ; Check if integer
 (stringp "a")                         ; Check if string
 (arrayp #(1 2 3))                     ; Check if array
 (vectorp #(1 2 3))                    ; Check if vector (1D arrays are vectors!)

 ;;; ----------- EQUALITY -------------------------------------------------------
 (eq "Hello" "Hello")                  ; Compare address of objects
 (= 1 1)                               ; Compare numbers
 (char= #\a #\A)                       ; Compare characters

 ;;; Otherwise use equal
 (equal 'car 'truck)
 (equal 10 10)
 (equal 5.5 5.3)
 (equal "string" "String")             ; case-sensitive
 (equal (list 1 2 3) (list 1 2 3))

 ;;; eql: must also have same type (===)
 (eql 1 1.0) ; => nil
  
 ;;; equalp: compare strings case insensitively and integers to floats
 (equalp 1.0 1)
 (equalp "tom" "Tom")

 ;;; ----------- ARRAYS ---------------------------------------------------------
 ;;; Make mutable 1D array of size 3 and all 0
 ;;; A constant 1D array is: #(1.0 2.0 3.0)
 (defparameter num-array (make-array 3 :initial-element 0 :element-type '(integer)))
 ;;; Get an element
 (aref num-array 0)
 ;; Set an element
 (setf (aref num-array 0) 42)
 ;;; Length
 (length num-array)     ; => 3
 ;;; Rank (number of dimensions)
 (array-rank num-array)   ; => 1

 ;;; Allocate array on stack (1D only!)
 (let ((arr #(1 2 3)))
  (declare (dynamic-extent arr))
  (format t "~d~%" (aref arr 1)))

 ;;; Loop through 1D array
 (loop for e across #(0 10 20 30 40) do 
  (print e))

 (map 'simple-vector #'(lambda (e) (print e)) #(0 10 20 30 40))

 ;;; Mutable 2D array (nD arrays possible too)
 ;;; A constant 2D array is: #2A((0 1 2) (3 4 5) (6 7 8))
 (defparameter num-array-2d 
  (make-array '(3 3) :initial-contents '((0 1 2) (3 4 5) (6 7 8))))
 ;;; Length of 2D array
 (array-total-size num-array-2d)     ; => 9
 ;;; Number of rows
 (array-dimension num-array-2d 0)    ; => 3
 ;;; Number of columns
 (array-dimension num-array-2d 1)    ; => 3
 ;;; Array dimensions
 (array-dimensions num-array-2d)      ; => (3 3)

 ;;; get element in 2D array as if it was a 1D array
 (row-major-aref num-array-2d 5) ; => 5 (value)
 (array-row-major-index num-array-2d 1 2) ; => 5 (index)

 ;;; Loop through 2D array
 (destructuring-bind (row-count column-count) (array-dimensions num-array-2d)
  (loop for i from 0 below row-count do
    (loop for j from 0 below column-count do
      (print (aref num-array-2d i j)))))

 ;;; vector/array to list
 (coerce #(0 1 2) 'list)

 ;;; copy a sequence
 (copy-seq #(0 1 2))

 ;;; ---------- ADJUSTABLE ARRAYS -----------------------------------------------
 (defparameter num-array (make-array 0 :adjustable t))  ; empty adjustable array
 (adjust-array num-array 5)    
 (setf (aref num-array 1) 10)
 (setf (aref num-array 3) 30)
 (adjust-array num-array 4)

 ;;; immitate vector
 ;;; vector-push, vector-push-extend return an index
 (defparameter num-array (make-array 3 :adjustable t :fill-pointer 0)) ; fill starting at index 0
 (vector-push 0 num-array)           ; #(0)
 (vector-push 10 num-array)           ; #(0 10)
 (vector-push 20 num-array)           ; #(0 10 20)
 (vector-push 30 num-array)           ; #(0 10 20) => returns nil => needs to adjust!!!
              
 (vector-push-extend 30 num-array)      ; #(0 10 20 30) (only extends when full => size * 2)
 (vector-pop num-array)            ; pop element of fill-pointer and decrease it by 1
                      ; => popped element
 ;;; cleanup vector
 (setf (fill-pointer num-array) 0)       ; move back fill-pointer to index 0
 (adjust-array num-array 0)          ; optional if you want no preallocation

 ;;; size of vector
 (length num-array)              ; number of elements in use
 (array-total-size num-array)        ; total number of elements allocated

 ;;; ---------- HASH TABLES -----------------------------------------------------
 (defparameter *ht* (make-hash-table :size 100))  ; Use size to avoid rehashing!
 (setf (gethash :foo *ht*) "Tom")        ; Set
 (gethash :foo *ht*)                ; Get
 (remhash :foo *ht*)               ; Remove
 (clrhash *ht*)                  ; Clear full hash table

 ;;; Normally use symbols (like :foo) or numbers instead of strings as keys!
 ;;; If you want strings, define hash table as:
 (defparameter *ht* (make-hash-table :size 100 :test #'equal)) ; default test is eql !!!

 ;;; maphash: do function on each item and returns nil
 (maphash 
  (lambda (k v) 
    (format t "~a = ~a~%" k v) 
    *ht*))

 ;;; ---------- CONS CELLS / LISTS / TREES --------------------------------------
 (list 1 2 3 4)                  ; Create list
 '(1 2 3 4)

 (listp '(1 2 3 4))              ; Check if list or not (t or nil)

 (cons 0 '(1 2 3 4))             ; Add item to front of list

 (car '(1 2 3 4))                ; Get 1st element of list
 (first '(1 2 3 4))                
 (nth 0 '(1 2 3 4))                

 (cdr '(1 2 3 4))                ; Get rest of list
 (rest '(1 2 3 4))               

 (cadr '(1 2 3 4))               ; Get 2nd element of list (1st of rest)
 (second '(1 2 3 4))               
 (nth 1 '(1 2 3 4))                

 (caddr '(1 2 3 4))              ; Get 3rd element of list (1st of rest of rest)
 (third '(1 2 3 4))                
 (nth 2 '(1 2 3 4))                

 (cadddr '(1 2 3 4))             ; Get 4th element of list
 (fourth '(1 2 3 4))
 (nth 3 '(1 2 3 4))

 ;;; Is 3 a member of the list
 (format t "Is 3 in the List = ~a ~%" (if (member 3 '(2 4 6)) 't nil)) 
 
 ;;; Combine lists into 1 list (every list except last list is copied!)
 (append '(just) '(some) '(random words))
 
 ;;; Push an item on the front of a list
 (defparameter *nums* '(2 4 6))
 (push 1 *nums*)
 
 ;;; Get the nth value from a list
 (format t "2nd Item in the List = ~a ~%" (nth 2 *nums*)) 
 
 ;;; Create a plist which uses a symbol to describe the data
 (defvar superman (list :name "Superman" :secret-id "Clark Kent"))
 
 ;;; This list will hold heroes
 (defvar *hero-list* nil)
 
 ;;; Adds items to our list
 (push superman *hero-list*)
 
 ;;; Cycle through all heros in the list and print them out
 (dolist (hero *hero-list*)
  ;; Surround with ~{ and ~} to automatically grab data from list
  (format t "~{~a : ~a ~}~%" hero))

 ;;; Trees
 (defvar *tree* '((1 2) (3 4 5) (6 7)))
 (cadadr *tree*) ; too cryptic...
 (nth 1 (nth 1 *tree*)) ; better!

 (nth 2 (nth 1 *tree*))

 ;;; Set operations
 (intersection '(0 1 2 3) '(0 2 4))
 (set-difference '(0 1 2 3) '(0 2 4))
 (union '(0 1 2 3) '(0 2 4))
 (set-exclusive-or '(0 1 2 3) '(0 2 4)) ; remove common elements and merge 

 ;;; ----------------------------------------------------------------------------
 ;;; CLOS: Common Lisp Object System
 ;;; ----------------------------------------------------------------------------
 (defclass person () 
  ((name :type string 
         :initform "Tom"
         :initarg :name
         :accessor name) ; :reader (only getter) :writer (only setter)
  (age :type integer
        :initform 28
        :initarg :age
        :accessor age)))
 		
 (defclass child (person) ; put superclasses in (), multiple inheritance allowed!
  ())

 (defun make-person (&key (name "Tommm") (age 20)) ; constructor
  (make-instance 'person :name name :age age))

 (defmethod print-age ((self person))
  (format t "Age: ~d!~%" (age self)))

 (defparameter *me* (make-person :name "Tom" :age 28))
 (name *me*)          ; get
 (setf (age *me*) 27) ; set

 (class-of *me*)
 (type-of *me*)

 (defgeneric greet (obj)
  (:documentation "say hello"))

 (defmethod greet ((obj person))
  (format t "Hello I'm a ~a!~&" (type-of obj)))
  
 (defmethod greet ((obj child))
  (format t "Yo, I'm a ~a!~&" (type-of obj)))
  
 ;;; Whenever you want to change method definition in REPL do this first:
 (fmakunbound 'greet)

 ;;; ----------------------------------------------------------------------------
 ;;; Functional programming
 ;;; ----------------------------------------------------------------------------
 ;;; sort (mutable)
 (sort #(1 8 4 5 6 7 2) #'<) ; from small to big
 (sort #(1 8 4 5 6 7 2) #'>) ; from big to small
 (stable-sort #(1 8 4 5 6 7 2) #'>) ; if same elements need to appear in same order

 ;;; These work on lists, arrays, vectors,...
 (some #'evenp '(1 2 3 4 5))      ; t if it contains even number
 (notany #'evenp '(1 2 3 4 5))     ; t if no number is even
 (every #'evenp '(1 2 3 4 5))    ; t if every number is even
 (notevery #'evenp '(1 2 3 4 5))    ; t if not every number is even

 ;;; Complement of function
 (defvar *my-even* (complement #'oddp))
 (funcall *my-even* 0) ; => t

 ;;; map function on every element of sequence
 (map 'vector #'(lambda (x) (* x 2)) #(1 2 3 4 5))
 (mapcar #'(lambda (x) (* x 2)) '(1 2 3 4 5))

 ;;; reduce
 (reduce #'+ #(1 2 3 4))              ; => 10
 (reduce #'(lambda (x y) (+ x y)) #(1 2 3 4))  ; => 10

 ;;; filter
 (remove-if (complement #'evenp) #(1 2 3 4 5))
 (remove-if #'(lambda (x) (<= x 2)) #(1 2 3 4 5))

 ;;; zip
 (map 'vector #'vector #(1 2 3) #(4 5 6) #(7 8 9))  ; => #(#(1 4 7) #(2 5 8) #(3 6 9))
 (mapcar #'list '(1 2 3) '(4 5 6) '(7 8 9))      ; => ((1 4 7) (2 5 8) (3 6 9))

 ;;; search (default :test is eql, can also use :test-not)
 ;;; also possible on strings
 (defparameter *num-array* #(10 20 30 40 50))
 (find 40 *num-array* :test #'eql :start 0 :end 3)  ; => value or nil when not found
 (find 40 *num-array* :from-end t) ; backwards search

 (find-if #'evenp *num-array*) ; => first element it finds or nil
 (find-if-not 40 *num-array*)

 (position 40 *num-array*) ; => index
 (position-if #'oddp *num-array*) ; => index of first element it finds or nil
 (position-if-not #'oddp *num-array*)

 ; Scope: let
 (let (()) )
 ; Function: lambda over let
 (funcall (lambda (x) (let ((y 5)) (+ x y))) 95)

 ; Closure (class with 1 method): let over lambda over let
 ; put defun over it to have a named class instead of anonymous class
 (defparameter *counter* (let ((x 0)) (lambda () (incf x))))

 ; let over lambda over let with values		=> class with multiple methods
 (defparameter *counter* 
 	(let ((x 0)) 
    (defun increase-counter ()
      (incf x))
    (defun decrease-counter ()
      (decf x))))
 	  
 (increase-counter)
 (decrease-counter)
 		 
 ; lambda over let over lambda over let		=> namespace with classes
 ; lambda over lambda over let			=> namespace with functions

 ;;; ----------------------------------------------------------------------------
 ;;; MACROS
 ;;; ----------------------------------------------------------------------------
 ;;; TODO: Read macros chapter of Common Lisp Cookbook 
 ;;; https://lispcookbook.github.io/cl-cookbook/macros.html#quote-comma- 
 ;;; Expand existing macros (debugging macros)
 (macroexpand '(loop for i from 0 below 10 do (print i)))

 (defvar my-ast (read-from-string "(defun foo (x y) (+ x y))"))
 (nth 0 my-ast)
 (nth 1 my-ast)
 (nth 0 (nth 2 my-ast))

 ;;; Turn code into data with ' or (quote (...))
 ;;; Code is list of elements in cons cells [+] [5] [4] [nil] 
 ;;; nil is end of list
 (first '(+ 5 4)) ; => +

 ;;; Quasiquote ` and , doesn't evaluate list except for , and ,@ removes its ()
 `(1 2 ,(loop for i from 3 to 5 collect i))  ; => (1 2 (3 4 5))
 `(1 2 ,@(loop for i from 3 to 5 collect i)) ; => (1 2 3 4 5)

 ;;; Macros
 (defclass my-class ()
  ((resource :type string 
             :initform "bye"
             :initarg :resource
             :accessor resource)))

 (defmethod my-class-dispose ((self my-class))
  (format t "Disposing: ~a!~%" (resource self)))

 (defmacro with-my-class (var form &body body)
  (let ((tempvar (gensym))) ; make sure this name is never used
    `(let* ((,tempvar ,form)
            (,var ,tempvar))
      (unwind-protect 
        (progn ,@body)
        (my-class-dispose ,var)))))

 (with-my-class x (make-instance 'my-class)
  (format t "hey!~%")
  (format t "cool!~%"))

 ; Domain Specific Language
 (defmacro unit-of-time (value unit)
  `(* ,value
      ,(case unit
         ((s) 1)
         ((m) 60)
         ((h) 3600)
         ((d) 86400)
         ((ms) 1/1000)
         ((us) 1/1000000))))

 (unit-of-time 1 d)
  
 ;;; ----------------------------------------------------------------------------
 ;;; FILE I/O
 ;;; ----------------------------------------------------------------------------
 ;;; TODO

 ;;; ----------------------------------------------------------------------------
 ;;; ERROR HANDLING
 ;;; ----------------------------------------------------------------------------
 ;;; unwind-protect: make sure cleanup code is run after error
 (let ((x 3))
  (unwind-protect
    (progn 
      (print "start")
      (print (error "error!"))
      (format t "success, ~d~%!" x)) ; doesn't execute due to error!

    (print "cleanup")
    (print "done with cleanup!")))

 ;;; ----------------------------------------------------------------------------
 ;;; Threading: bordeaux-threads
 ;;; ----------------------------------------------------------------------------
 ;; Before starting to use threads
 (bt:start-multiprocessing)

 (bt:all-threads)
 (bt:thread-name (bt:current-thread))

 (bt:make-thread (lambda () (sleep 100) (format t "Thread!~%")) :name "thread1")
 (bt:thead-alive-p *)
 ;;; Find a thread
 (find-if
  (lambda (th)
    (search "thread1" (bt:thread-name th))) 
  (bt:all-threads))
 (bt:destroy-thread *) ; destroy before completion
 (bt:thead-alive-p **)

 ;;; Join thread: wait in current thread for the given thread to finish
 (bt:make-thread (lambda () (sleep 100) (format t "Thread!~%")) :name "thread1")
 (bt:join-thread *)

 ;;; Mutexes
 (defparameter *lock* (bt:make-lock "my-lock"))
 ; try to acquire the lock in each thread and release it. Or use with-macro.
 (bt:acquire-lock *lock*)
 (bt:release-lock *lock*)
 (bt:with-lock-held (*lock*) 
 	(format t "Locking!~%"))
 	
 ;;; Semaphores: thread safe counter, thread1 can wait on semaphore 
 ;;; while thread2 can signal so thread1 can continue. 
 ;;; Multiple waits can have multiple signals.
 ;;; A semaphore is a mutex + wait queue
 (defparameter *sem* (bt:make-semaphore :name "sem")
 (bt:wait-on-semaphore *sem*)
 (bt:signal-semaphore *sem* :count 1) ; signal x times

 ;;; Condition variables:
 ; make a condition variable together with a lock
 ; thread1 acquires lock and waits on condition
 ; thread2 acquires lock but after if-test uses a notify
 ; thread1 doesn't wait on condition anymore

 ;;; ----------------------------------------------------------------------------
 ;;; CFFI: C Foreign Function Interface (talk to C)
 ;;; ----------------------------------------------------------------------------
 (ql:quickload :cffi)
 (require :cffi)

 ;;; Types:  :int, :unsigned-int (uint), :long, :long-long, :short,
 ;;;         :int8, uint8, int16, ... , int64, uint64
 ;;;         :float, :double, :char, :bool
 ;;;         :pointer, '(:pointer :int), '(:pointer :char),...
 (cffi:foreign-type-size :int)             ; int is 4 bytes
 (cffi:foreign-type-size '(:struct my-struct))

 ;;; Pointers
 (defvar tmp0 (cffi:foreign-alloc :int))		; malloc a pointer tmp0 to int
 (cffi:mem-aref tmp0 :int)			            ; get value of pointer
 (setf (cffi:mem-aref tmp0 :int) 10)		    ; set value of pointer
 (cffi:foreign-free tmp0)                  ; free

 ;;; Null pointer
 (cffi:null-pointer)

 ;;; Arrays
 (defvar tmp1 nil)
 (setf tmp1 (cffi:foreign-alloc :int :count 10))
 (cffi:mem-aref tmp1 :int 0)
 (setf (cffi:mem-aref tmp1 :int 0) 10)

 (loop for i from 0 below 10 do 
  (setf (cffi:mem-aref tmp1 :int i) 0))

 (cffi:foreign-free tmp1)

 ;;; Strings
 (defvar tmp2 nil)
 (setf tmp2 (cffi:foreign-string-alloc "hello!"))
 (code-char (cffi:mem-aref tmp2 :char 0)) ; => #\h
 (code-char (cffi:mem-aref tmp2 :char 6)) ; => #\Nul

 (cffi:foreign-free tmp2)
 ;; better to use cffi:with-foreign-string macro!

 ;;; Own types
 (cffi:defctype my-int :int)

 ;;; Structs (can't set default values)
 (cffi:defcstruct my-struct
  (id :int)
  (x :float)
  (y :float)
  (a :float :offset 4)  ; alias for x
  (b :float))           ; alias for y

 (defvar tmp3 (cffi:foreign-alloc '(:struct my-struct)))

 (cffi:foreign-slot-value tmp3 '(:struct my-struct) 'x)
 (setf (cffi:foreign-slot-value tmp3 '(:struct my-struct) 'x) 10.0)

 (cffi:with-foreign-slots ((id x y) tmp3 (:struct my-struct))
  (print id)
  (print x)
  (print y)
  nil)	

 ;;; Unions
 (defcunion my-union
  (x :int32) 
  (y :int8 :count 4)))

 ;;; Enums
 (cffi:defcenum (my-enum :uint8)
  (:monday 0)
  (:tuesday 1)
  (:wednesday 2)
  (:thursday 3)
  (:friday 4)
  (:saturday 5)
  (:sunday 6)
  (:days-in-week 7))

 ;;; Functions
 (cffi:defcfun ("c_name_function" my-function) (:int)
  (x (:float))
  (y (:float)))

 ;;; Example 1: From C library to Common Lisp
 ;;; C backend
 (cffi:define-foreign-library soil
  (:darwin (:or "libSOIL.dylib"
                #+X86-64 "local_x64_libSOIL.dylib"))
  (:unix (:or "libSOIL.so"
              "libSOIL.so.1"
              #+X86-64 "local_x64_libSOIL.so"))
  (:windows (:or "libSOIL.dll"
                 #+X86 "local_x86_libSOIL.dll"
                 #+X86-64 "local_x64_libSOIL.dll"))
  (t (:default "libSOIL.so")))

 (cffi:use-foreign-library soil)

 ;;; Then define cffi structs, functions, enums,... as above
 (cffi:defcenum image-format-enum
  (:auto 0)
  (:l 1)
  (:la 2)
  (:rgb 3)
  (:rgba 4))

 (cffi:defcfun ("SOIL_load_image" soil-load-image) (:pointer :unsigned-char)
  (filename :pointer)
  (width (:pointer :int))
  (height (:pointer :int))
  (channels (:pointer :int))
  (force-channels image-format-enum))

 ;;; Common Lisp frontend
 (defun load-image (filepath &optional (force-channels :rgba))
  (cffi:with-foreign-filepath (c-filepath filepath)
    (cffi:with-foreign-objects ((c-width :int) (c-height :int) (c-channels :int))
      (let ((result-pointer (soil-load-image c-filepath c-width c-height
                                             c-channels force-channels)))
        (if (cffi:null-pointer-p result-pointer)
            (error "Could not load image ~a~%Recieved NULL pointer" filepath)
            ;; else
            (values result-pointer
              (cffi:mem-aref c-width :int)
              (cffi:mem-aref c-height :int)
 		          (cffi:mem-aref c-channels :int)))))))

 ;;; Example 2: From Common Lisp to C
 (declaim (ftype (function (single-float single-float) 
                          (simple-array single-float (2))) 
                vec2)
          (inline vec2))
 (defun vec2 (x y)
  (declare (optimize (speed 3) (safety 0)))
  (let ((v (make-array 2 :element-type 'single-float :initial-element 0.0)))
    (setf (aref v 0) x)
    (setf (aref v 1) y)
    v))

 (let ((v (vec2 1.0 2.0))) 
  (declare (dynamic-extent v))
  (print v))

 (cffi:defcstruct c-vec2-struct
  (x :float)
  (y :float))

 (cffi:define-foreign-type c-vec2-type ()
  ()
  (:actual-type :struct c-vec2-struct)
  (:simple-parser vec2))

 (defmethod cffi:translate-from-foreign (ptr (type c-vec2-type))
  (vec2 (cffi:mem-aref ptr :float 0)
        (cffi:mem-aref ptr :float 1)))

 (defmethod cffi:translate-into-foreign-memory (value (type c-vec2-type) ptr)
  (setf (cffi:mem-aref ptr :float 0) (aref value 0))
  (setf (cffi:mem-aref ptr :float 1) (aref value 1)))

 (defmethod cffi:expand-from-foreign (ptr (type c-vec2-type))
  `(vec2 (cffi:mem-aref ,ptr :float 0)
         (cffi:mem-aref ,ptr :float 1)))

 (defmethod cffi:expand-into-foreign-memory (value (type c-vec2-type) ptr)
  `(progn
    (setf (cffi:mem-aref ,ptr :float 0) (aref ,value 0))
    (setf (cffi:mem-aref ,ptr :float 1) (aref ,value 1))))

 (defvar tmp4 (cffi:foreign-alloc 'vec2))
 (cffi:mem-aref tmp4 'vec2)
 (setf (cffi:mem-aref tmp4 'vec2) (vec2 2.0 3.0))
 (cffi:foreign-free tmp4)
No results found