view lists.lisp @ 1:a3dca97e5f3b

heap and some play list macros
author Lewin Bormann <lbo@spheniscida.de>
date Mon, 07 Oct 2019 11:04:39 +0200
parents 81137f478b5c
children
line wrap: on
line source

;; 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))))

(defmacro my-if (condition expr-t expr-f)
  `(or
   (and ,condition (or ,expr-t t))
   ,expr-f))

(defmacro my-looptimes (n &body body)
  `(let ((i 0))
     (tagbody
	start
	,@body
	(incf i)
	(unless (eql i ,n) (go start)))))

(defmacro my-looplist ((name list) &body body)
  `(let ((_list ,list))
     (tagbody
      start
	(let ((,name (pop _list)))
	  ,@body
	  (when _list (go start)))
	)))

(defun access-nth (list n)
  (if (= n 1) (car list) (access-nth (cdr list) (1- n))))

(defmacro make-nth-accessor (name n)
  (let ((list-arg-name (gensym)))
    `(defun ,name (,list-arg-name) (access-nth ,list-arg-name ,n))))

(make-nth-accessor my-first 1)
(make-nth-accessor my-second 2)
(make-nth-accessor my-third 3)