initial commit

.gitignore

@@ -0,0 +1,8 @@
+*.fasl
+*.dx32fsl
+*.dx64fsl
+*.lx32fsl
+*.lx64fsl
+*.x86f
+*~
+.#*

README.markdown

@@ -0,0 +1,49 @@
+# Cl-Punch - Scala-like anonymous lambda literal
+
+## Usage
+
+```
+;; Enable syntax.
+(cl-punch:enable-punch-syntax)
+
+;; ^() is comverted into (lambda ...) .
+;; Each underscore is converted into a lambda argument.
+
+(mapcar ^(* 2 _) '(1 2 3 4 5))
+;; => '(2 4 6 8 10)
+
+;; One underscore corresponds one argument.
+
+(^(* _ _) 2 3)
+;; => 6
+
+;; <_ reuses last argument.
+
+(mapcar ^(if (oddp _) (* 2 <_) <_) '(1 2 3 4 5))
+;; => '(2 2 6 4 10)
+
+;; _! corresponds one argument but it is brought to top of the argument list.
+;; It can be useful when you want to change argument order.
+
+(^(cons _ _!) :a :b)
+;; => (:b . :a)
+
+(^(list _! _! _!) 1 2 3)
+;; => '(3 2 1)
+```
+
+## Installation
+
+WIP: Register to quicklisp
+
+## Author
+
+* Windymelt
+
+## Copyright
+
+Copyright (c) 2018 Windymelt
+
+## License
+
+Licensed under the MIT License.

cl-punch-test.asd

@@ -0,0 +1,24 @@
+#|
+  This file is a part of cl-punch project.
+  Copyright (c) 2018 Windymelt
+|#
+
+(in-package :cl-user)
+(defpackage cl-punch-test-asd
+  (:use :cl :asdf))
+(in-package :cl-punch-test-asd)
+
+(defsystem cl-punch-test
+  :author "Windymelt"
+  :license "MIT"
+  :depends-on (:cl-punch
+               :prove)
+  :components ((:module "t"
+                :components
+                ((:test-file "cl-punch"))))
+  :description "Test system for cl-punch"
+
+  :defsystem-depends-on (:prove-asdf)
+  :perform (test-op :after (op c)
+                    (funcall (intern #.(string :run-test-system) :prove-asdf) c)
+                    (asdf:clear-system c)))

cl-punch.asd

@@ -0,0 +1,38 @@
+#|
+  This file is a part of cl-punch project.
+  Copyright (c) 2018 Windymelt
+|#
+
+#|
+  Scala-like anonymous lambda literal
+
+  Author: Windymelt
+|#
+
+(in-package :cl-user)
+(defpackage cl-punch-asd
+  (:use :cl :asdf))
+(in-package :cl-punch-asd)
+
+(defsystem cl-punch
+  :version "0.1"
+  :author "Windymelt"
+  :license "MIT"
+  :depends-on ()
+  :components ((:module "src"
+                :components
+                ((:file "cl-punch"))))
+  :description "Scala-like anonymous lambda literal"
+  :long-description
+  #.(with-open-file (stream (merge-pathnames
+                             #p"README.markdown"
+                             (or *load-pathname* *compile-file-pathname*))
+                            :if-does-not-exist nil
+                            :direction :input)
+      (when stream
+        (let ((seq (make-array (file-length stream)
+                               :element-type 'character
+                               :fill-pointer t)))
+          (setf (fill-pointer seq) (read-sequence seq stream))
+          seq)))
+  :in-order-to ((test-op (test-op cl-punch-test))))

src/cl-punch.lisp

@@ -0,0 +1,37 @@
+(in-package :cl-user)
+(defpackage cl-punch
+  (:use :cl)
+  (:export :punch-reader :enable-punch-syntax))
+(in-package :cl-punch)
+
+(defun punch-reader (s c)
+  "A reader which converts _ into lambda argument, <_ into last lambda argument."
+  (declare (ignorable c))
+  (let ((form (read s nil nil t))
+        (arg-symbol-list nil))
+    (labels ((replace-underscore (x)
+               (cond
+                 ((and (symbolp x) (string= (symbol-name x) "_!"))
+                  (let ((sym (gensym)))
+                    (if (null arg-symbol-list)
+                        (push sym arg-symbol-list)
+                        (push sym (cdr (last arg-symbol-list))))
+                    sym))
+                 ((and (symbolp x) (string= (symbol-name x) "_"))
+                  (let ((sym (gensym)))
+                    (push sym arg-symbol-list)
+                    sym))
+                 ((and (symbolp x) (string= (symbol-name x) "<_"))
+                  (first arg-symbol-list))
+                 ((listp x) (mapcar #'replace-underscore x))
+                 ('otherwise x))))
+      (let ((result-inner-form (mapcar #'replace-underscore form)))
+        `(lambda ,(nreverse arg-symbol-list) ,result-inner-form)))))
+
+(defun %enable-punch-syntax ()
+  (setf *readtable* (copy-readtable))
+  (set-macro-character #\^ #'punch-reader))
+
+(defmacro enable-punch-syntax ()
+  '(eval-when (:compile-toplevel :load-toplevel :execute)
+    (%enable-punch-syntax)))

t/cl-punch.lisp

@@ -0,0 +1,27 @@
+(in-package :cl-user)
+(defpackage cl-punch-test
+  (:use :cl
+        :cl-punch
+        :prove))
+(in-package :cl-punch-test)
+
+;; NOTE: To run this test file, execute `(asdf:test-system :cl-punch)' in your Lisp.
+
+(plan 2)
+
+(enable-punch-syntax)
+
+(is (^(* _ 2) 2) 4)
+
+(is (mapcar ^(* _ 3) '(1 2 3))
+    '(3 6 9))
+
+(is (^(* _ _) 2 3) 6)
+
+(is (mapcar ^(if (oddp _) (* 2 <_) <_)
+            '(1 2 3 4 5))
+    '(2 2 6 4 10))
+
+(is (^(cons _ _!) :a :b) '(:b . :a))
+
+(finalize)