Plaster

common-lisp
(defgeneric input-empty-p (input) (:method ((input string)) (zerop (length input)))) (defgeneric input-first (input) (:method ((input string)) (aref input 0))) (defgeneric input-rest (input) (:method ((input string)) (multiple-value-bind (string displacement) (array-displacement input) (make-array (1- (length input)) :displaced-to (or string input) :displaced-index-offset (1+ displacement) :element-type (array-element-type input))))) (defun .identity (value) (lambda (input) (list (cons value input)))) (defun .item () (lambda (input) (unless (input-empty-p input) (list (cons (input-first input) (input-rest input)))))) (defun .fail () (lambda (input) (declare (ignore input)) nil)) (defun .bind (parser function) (lambda (input) (loop :for (value . input) :in (run parser input) :append (run (funcall function value) input)))) (defun .satisfies (predicate &rest args) (.bind (.item) (lambda (x) (if (apply predicate x args) (.identity x) (.fail))))) (funcall (.satisfies #'digit-char-p) "1 and") ;; the below code does not work? why??? (setq ss (.bind (.item) (lambda (x) (if (apply #'digit-char-p x) (.identity x) (.fail))))) (funcall ss "1 and") ;;error trace 0: ((LAMBDA (X)) #\1) 1: ((LAMBDA (INPUT) :IN .BIND) "1 and") 2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (FUNCALL SS "1 and") #<NULL-LEXENV>) 3: (EVAL (FUNCALL SS "1 and")) ;;But the below code works (setq qq (.bind (.item) (lambda (char) (.identity (list :char char))))) (funcall qq "foo")