Skip to content

Instantly share code, notes, and snippets.

@yehohanan7

yehohanan7/lambda.lisp

Created January 17, 2016 00:42
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save yehohanan7/3b73f205a49e6f72b32b to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save yehohanan7/3b73f205a49e6f72b32b to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. yehohanan7 created this gist Jan 17, 2016.
    34 changes: 34 additions & 0 deletions lambda.lisp
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,34 @@
    (defun flatten (structure)
    (cond ((null structure) nil)
    ((atom structure) (list structure))
    (t (mapcan #'flatten structure))))


    (defun g!-symbol-p (s)
    (and (symbolp s)
    (> (length (symbol-name s)) 2)
    (string= (symbol-name s)
    "G!"
    :start1 0
    :end1 2)))


    (defmacro defmacro/g! (name args &rest body)
    (let ((syms (remove-duplicates (remove-if-not #'g!-symbol-p (flatten body)))))
    `(defmacro ,name ,args
    (let ,(mapcar (lambda (s) `(,s (gensym ,(subseq (symbol-name s) 2)))) syms)
    ,@body))))


    (macroexpand-1 '(defmacro/g! nif (expr pos zero neg)
    `(let ((,g!result ,expr))
    (cond ((plusp ,g!result) ,pos)
    ((zerop ,g!result) ,zero)
    (t ,neg)))))


    ;; output
    (DEFMACRO NIF (EXPR POS ZERO NEG)
    (LET ()
    `(LET ((,G!RESULT ,EXPR))
    (COND ((PLUSP ,G!RESULT) ,POS) ((ZEROP ,G!RESULT) ,ZERO) (T ,NEG)))))