Search code examples
common-lispsbclcdr

Write a function that behaves like car, cadr, caddr etc


I'm new to lisp (i'm experimenting with sbcl and ccl), i came across the use of car and cdr that can be chained arbitrarily within a single function call like (caddr).

I was wandering how one would write functions that behave like this... Say for example i'd like my-eval to eval the input s-exp 3 times if i invoke it like (my-evaaal '(+ 2 1))

I've hacked my way around with a macro like (my-ev $$$$ '(...)) where the behavior is dictated by the number of '$' in the first argument by transforming it into char sequence (coerce (symbol-name x) 'list) and the evaluate and recurse until the list is nil...

basic need:

;; if 
(defvar *foo* 1)
(eval '*foo*) ;; => 1
(eval ''*foo*) ;; => *foo*
(eval '''*foo*) ;; => '*foo*

;; then
(eval (eval (eval '''*foo*))) ;; => 1

desired syntax

(my-eval '''*foo*) ;; => '*foo*
(my-evaal '''*foo*) ;; => *foo*
(my-evaaal '''foo) ;; => 1

Solution

  • Functions like CAAR, CADR are just regular functions; you can define a macro to help you define them easily if you want to.

     Macros

     (defpackage :so (:use :cl :ppcre))
     (in-package :so)
    
     (defmacro eval%% (count form)
       (case count
         (0  form)
         (1 `(eval ,form))
         (t (check-type count (integer 2))
            `(eval%% ,(1- count) (eval ,form)))))
    

    For example, the following :

    (eval%% 3 '''most-positive-fixnum)
    

    expands successively as:

    (EVAL%% 2 (EVAL '''MOST-POSITIVE-FIXNUM))
    (EVAL%% 1 (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
    (EVAL (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
    

    Then, you can define custom eval functions as follows, or even with another macro:

    (defun evaal (x) (eval%% 2 x))
    (defun evaaal (x) (eval%% 3 x))
    

    Handler and restarts

    Alternatively, note that you can catch calls to undefined functions:

    (block nil
      (handler-bind ((undefined-function
                      (lambda (e)
                        (return
                          (values (cell-error-name e)
                                  (compute-restarts e))))))
        (evaaaaaal 'a)))
    
    => EVAAAAAAL
      (#<RESTART CONTINUE {7FD5F5F8CE43}> #<RESTART USE-VALUE {7FD5F5F8CE03}>
       #<RESTART SB-KERNEL::RETURN-VALUE {7FD5F5F8CDC3}>
       #<RESTART SB-KERNEL::RETURN-NOTHING {7FD5F5F8CD83}>
       #<RESTART SWANK::RETRY {7FD5F5F8DA13}> #<RESTART ABORT {7FD5F5F8DEC3}>
       #<RESTART ABORT {7FD5F5F8EB03}>)
    

    You can also use the standard USE-VALUE restart to provide a different function to call:

    (defun multi-eval-handler (condition)
      (let ((name (cell-error-name condition)))
        (when (eq (symbol-package name) (find-package :so))
          (register-groups-bind ((#'length count)) ("EV\(A+\)L" (string name))
            (invoke-restart 'use-value (make-repeated-evaluator count))))))
    

    You need an auxiliary function that computes an evaluation N times:

    (defun make-repeated-evaluator (count)
      (case count
        (0 #'identity)
        (1 #'eval)
        (t (check-type count (integer 2))
           (lambda (form)
             (loop
                for value = form then (eval value)
                repeat count
                finally (return value))))))
    

    For example:

    (funcall (make-repeated-evaluator 3)
             '''most-positive-fixnum)
    => 4611686018427387903
    

    And then, you can have arbitrarily long eval functions:

     (handler-bind ((undefined-function #'multi-eval-handler))
         (evaaaaaaaaaaaaaal '''''''''''''0))
    

    Now, if you compile the code, you'll have warnings at compile-time about the unknown function, when then you can muffle warnings.