--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Fri Oct 04 11:49:00 2019 +0200
@@ -0,0 +1,6 @@
+syntax: glob
+*.*~
+*.fasl
+\#*\#
+.\#*\#
+.\#*
\ No newline at end of file

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lists.lisp	Fri Oct 04 11:49:00 2019 +0200
@@ -0,0 +1,38 @@
+;; Reverse list
+
+(defun my-reverse (l)
+  (if (= 0 (length l)) '() (append (my-reverse (cdr l)) (list (car l)))))
+
+(defun my-foldl (f init l) ;; tail-recursive but not lazy
+  (if l (my-foldl f (funcall f init (car l)) (cdr l)) init))
+
+(defun my-foldr (f l init) ;; lazy but not tail-recursive
+  (if l (funcall f (car l) (my-foldr f (cdr l) init))))
+
+(defun my-map (f l)
+  (if l (cons (funcall f (car l)) (my-map f (cdr l))) nil))
+
+(defun my-mapf (f l)
+  (defun folder (acc e) (cons (funcall f e) acc))
+  (my-reverse (my-foldl #'folder nil l)))
+
+(defun my-range (from to)
+  (defun _my-range (acc from to) ;; for tail recursion
+    (if (eql from to) acc (_my-range (cons to acc) from (- to 1))))
+  (_my-range () (- from 1) (- to 1)))
+
+(defun my-append (a b) ;; not tail-recursive
+  (if a (cons (car a) (my-append (cdr a) b)) b))
+
+(defmacro my-dotimes ((var up-to) &rest body)
+  `(mapcar #'(lambda (,var) ,@body) (my-range 0 ,up-to)))
+
+(defmacro my-let (bindings &rest body)
+  (defun _names () (mapcar #'car bindings))
+  (defun _vals () (mapcar #'cadr bindings))
+  `(funcall #'(lambda (,@(_names)) ,@body) ,@(_vals)))
+
+(defmacro my-let* (bindings &rest body)
+  (if (not bindings)
+      `(funcall (lambda () ,@body))
+      `(my-let (,(car bindings)) (my-let* ,(cdr bindings) ,@body))))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/macro.lisp	Fri Oct 04 11:49:00 2019 +0200
@@ -0,0 +1,5 @@
+;; macro.lisp
+
+;; simple aliasing
+(defmacro backwards (expr) (reverse expr))
+

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test.lisp	Fri Oct 04 11:49:00 2019 +0200
@@ -0,0 +1,74 @@
+(defun make-cd (title artist rating ripped)
+  (list :title title :artist artist :rating rating :ripped ripped))
+
+(defvar *db* nil)
+
+(defun add-record (cd) (push cd *db*))
+
+(defun dump-db ()
+  (dolist (cd *db*) (format t "~{~a:~10t~a~%~}~%" cd)))
+
+(defun prompt-read (prompt)
+  (format *query-io* "~a: " prompt)
+  (force-output *query-io*)
+  (read-line *query-io*))
+
+(defun prompt-cd ()
+  (make-cd (prompt-read "title")
+	   (prompt-read "artist")
+	   (or (parse-integer (prompt-read "rating x/5")) 0)
+	   (y-or-n-p "ripped y/n")))
+
+(defun add-cds ()
+  (loop (add-record (prompt-cd))
+     (if (not (y-or-n-p "one more? y/n ")) (return))))
+
+(defun save-db (filename)
+  (with-open-file (out filename :direction :output :if-exists :supersede)
+    (with-standard-io-syntax (print *db* out))))
+
+(defun load-db (filename)
+  (with-open-file (in filename)
+    (with-standard-io-syntax (setf *db* (read in)))))
+
+(defun select-eq (key val)
+  (remove-if-not (lambda (record) (equal (getf record key) val)) *db*))
+
+(defun select (pred)
+  (remove-if-not pred *db*))
+
+(defun where (&key title artist rating (ripped nil ripped-p))
+  (lambda (record)
+    (and
+     (if title (equal title (getf record :title)) 't)
+     (if artist (equal artist (getf record :artist)) 't)
+     (if ripped-p (equal ripped (getf record :ripped)) 't)
+     (if rating (equal rating (getf record :rating)) 't))))
+
+(defun where-2 (key val)
+  (lambda (record) (if (equal val (getf record key)) 't nil)))
+
+(defun update (pred &key title artist rating (ripped nil ripped-p))
+  (setf *db*
+	(mapcar
+	 (lambda (record)
+	   (when (funcall pred record)
+	     (if title (setf (getf record :title) title))
+	     (if artist (setf (getf record :artist) artist))
+	     (if rating (setf (getf record :rating) rating))
+	     (if ripped-p (setf (getf record :ripped) ripped)))
+	   record) *db*)))
+
+(defun delete-cds (pred)
+  (setf *db* (remove-if pred *db*)))
+
+;; Fancy selection with macros
+(defun make-comparison-expr (field value)
+  `(equal (getf cd ,field) ,value))
+
+(defun make-comparisons-list (fields)
+  (loop while fields collecting
+       (make-comparison-expr (pop fields) (pop fields))))
+
+(defmacro where-m (&rest clauses)
+  `#'(lambda (cd) (and ,@(make-comparisons-list clauses))))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test3.lisp	Fri Oct 04 11:49:00 2019 +0200
@@ -0,0 +1,9 @@
+;; syntax test
+
+(load "~/dev/lisp/lists.lisp")
+
+(print (my-foldl
+	(lambda (a x) (+ a (* x 2)))
+	0
+	(my-range 0 10000001)))
+