commit 0a46cf9435cb116ce79847d9812ea2ef079e6ccb Spenser Truex <spensertruexonline@gmail.com> 2018-04-19 22:24:38 -0300 Fixed make-read.
utils.lisp | 72 ++++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 42 insertions(+), 30 deletions(-)
diff --git a/utils.lisp b/utils.lisp index 9bbe06c..c462595 100644 --- a/utils.lisp +++ b/utils.lisp @@ -7,13 +7,35 @@ :y-comb :aif)) (in-package :utils) +(defun y-comb (f) + "The Y-combinator from the Lambda calculus of Alonzo Church." + ((lambda (x) (funcall x x)) + (lambda (y) + (funcall f (lambda (&rest args) + (apply (funcall y y) args)))))) +;;; Example code for the y-combinator is in order: +#|(funcall (y-comb #'(lambda (FUNCTION) (lambda (n) (if (= 0 n) + (progn (print 0) 0) ; + (progn (print n) (funcall FUNCTION (- n 1))))))) 10)|# +;;; Yes it is a bit complex and redundant, so there is an anaphoric macro +(defmacro y (lambda-list-args specific-args &rest code) + "Like Y-combinator, but is a recursive macro. The anaphor is 'f'. Don't forget +to funcall f instead of trying to use it like an interned function." + `(funcall (y-comb #'(lambda (f) #'(lambda ,lambda-list-args + ,@code))) + ,@specific-args)) +;;; Example code for the anaphoric y-combinator: +#|(y (a b) (10 0) +(if (= 0 a) + b + (funcall f (- a 1) (progn (print b) (+ b 1)))))|# +;;; If the downside is not obvious: No tail recursion optimization (I think). (defmacro with-gensyms (symbols &body body) "Create gensyms for those symbols." `(let (,@(mapcar #'(lambda (sym) `(,sym ',(gensym))) symbols)) ,@body)) -(defvar *buffer-char* "") -(defun numberp-char (char) +(defun number-charp (char) "Aux function." (or (char= #\0 char) (char= #\1 char) @@ -25,10 +47,10 @@ (char= #\7 char) (char= #\8 char) (char= #\9 char))) -(defun whitespacep-char (char) +(defun whitespace-charp (char) "Aux function." (or (char= #\Newline char) (char= #\Space char) (char= #\Tab char))) -(defmacro make-read (name char-predicate end-predicate) +#|(defmacro make-read (name char-predicate end-predicate) "Note: End predicate character gets eaten so we VALUES it. This is a token reader with character predicates." (with-gensyms (char str stream) @@ -41,9 +63,22 @@ This is a token reader with character predicates." (recur (concatenate 'string ,str (make-string 1 :initial-element ,char)))))))) - (recur ""))))) -(make-read read-token #'(lambda (x) t) #'whitespacep-char) -(make-read read-int #'numberp-char #'whitespacep-char) +(recur "")))))|# +(defmacro make-read (name charp endp) + "The ending character gets eaten, so it is put into VALUES." + (with-gensyms (char str stream) + `(defun ,name (&optional (,stream *standard-input*)) + (y (,str) ("") + (let ((,char (read-char ,stream))) + (cond ((funcall ,endp ,char) (values ,str ,char)) + ((funcall ,charp ,char) + (funcall f + (concatenate 'string + ,str + (make-string 1 :initial-element ,char)))) + (t (values ,str ,char)))))))) +(make-read read-token #'(lambda (x) (declare (ignore x)) t) #'whitespace-charp) +(make-read read-int #'number-charp #'whitespace-charp) (defmacro once-only ((&rest names) &body body) "A macro-writing utility for evaluating code only once." (let ((gensyms (loop for n in names collect (gensym)))) @@ -51,29 +86,6 @@ This is a token reader with character predicates." `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n))) ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g))) ,@body))))) -(defun y-comb (f) - "The Y-combinator from the Lambda calculus of Alonzo Church." - ((lambda (x) (funcall x x)) - (lambda (y) - (funcall f (lambda (&rest args) - (apply (funcall y y) args)))))) -;;; Example code for the y-combinator is in order: -#|(funcall (y-comb #'(lambda (FUNCTION) (lambda (n) (if (= 0 n) - (progn (print 0) 0) ; - (progn (print n) (funcall FUNCTION (- n 1))))))) 10)|# -;;; Yes it is a bit complex and redundant, so there is an anaphoric macro -(defmacro ay (lambda-list-args specific-args &rest code) - "Like Y-combinator, but is a recursive macro. The anaphor is 'f'. Don't forget -to funcall f instead of trying to use it like an interned function." - `(funcall (y-comb #'(lambda (f) #'(lambda ,lambda-list-args - ,@code))) - ,@specific-args)) -;;; Example code for the macro: -#|(y (a b) (10 0) - (if (= 0 a) - b - (funcall f (- a 1) (progn (print b) (+ b 1)))))|# -;;; It is peano arithmetic. (defmacro aif (conditional then &optional else) `(let ((it ,conditional)) (if it