fork(1) download
  1. (eval-when (:load-toplevel :compile-toplevel :execute)
  2. (defun simple-lambda-list-p (lambda-list)
  3. (notany (lambda (x)
  4. (member x '(&optional &rest &key)))
  5. lambda-list))
  6.  
  7. (defmacro spicy-lambda ((&rest args) &body body)
  8. (assert (simple-lambda-list-p args) (args))
  9. (reduce (lambda (arg form)
  10. `(lambda (,arg) ,form))
  11. args :from-end t :initial-value `(progn ,@body)))
  12.  
  13. (defmacro defspicy (name (&rest args) &body body)
  14. (if (<= (length args) 1)
  15. `(defun ,name ,args ,@body)
  16. `(defun ,name (,(first args))
  17. (spicy-lambda ,(rest args) ,@body))))
  18.  
  19. (defun $-reader (stream subchar arg)
  20. (destructuring-bind (function &rest args) (read stream t nil t)
  21. (let ((init-expr
  22. `(,@(cond ((eq function 'funcall) `(funcall ,(pop args)))
  23. ((eq function 'apply) (error "`apply' is not implemented yet"))
  24. ((symbolp function) `(,function))
  25. ((listp function) `(funcall ,function)))
  26. ,@(and args `(,(pop args))))))
  27. (reduce (lambda (fn x) `(funcall ,fn ,x)) args :initial-value init-expr))))
  28.  
  29. (set-dispatch-macro-character #\# #\$ '$-reader))
  30.  
  31.  
  32.  
  33. (defspicy compose (f g x)
  34. (funcall f (funcall g x)))
  35.  
  36. (defspicy const (x y) x)
  37.  
  38. (defspicy plus (x y) (+ x y))
  39.  
  40. ;; yoba dx = (dx +) . length
  41. (defspicy yoba (dx)
  42. #$(compose (plus dx) 'length))
  43.  
  44. (map 'nil #$(compose 'print (yoba 111))
  45. '(() (1) (3 2 3)))
Success #stdin #stdout 0.01s 25308KB
stdin
Standard input is empty
stdout
111 
112 
114