1 files changed, 38 insertions, 0 deletions
diff --git a/bs/core.scm b/bs/core.scm
index 73b328d..8a41425 100644
--- a/bs/core.scm
+++ b/bs/core.scm
@@ -3,6 +3,7 @@
   #:use-module ((system vm program))
   #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-69)
   #:export (fmt printf pr prn
                 first ffirst second rest last butlast
                 true? false? some? empty?
@@ -140,6 +141,43 @@
     [(/. a ... (b ...))
      (lambda (a ...) (b ...))]))
 
+;; https://gist.github.com/cky/8500450
+;; clojure-like anonymous functions:
+;;
+;;   (map ##(+ % 5) '(1 2 3)) ;;=> (6 7 8)
+;;
+(read-hash-extend
+ #\#
+ (lambda (_ port)
+   (define ht (make-hash-table eqv?))
+   (define (ht-ref key)
+     (hash-table-ref ht key (lambda ()
+                              (define sym (gensym))
+                              (hash-table-set! ht key sym)
+                              sym)))
+   (define (hash-key x)
+     (case x
+       ((% %1) 1)
+       ((%2) 2)
+       ((%3) 3)
+       ((%&) 0)
+       ((#{}#) #f)
+       (else (and (symbol? x)
+                  (symbol-interned? x)
+                  (let ((str (symbol->string x)))
+                    (and (char=? #\% (string-ref str 0))
+                         (char<=? #\1 (string-ref str 1) #\9)
+                         (string->number (substring/shared str 1))))))))
+   (define (process x)
+     (cond ((hash-key x) => ht-ref)
+           ((list? x) (map process x))
+           (else x)))
+   (define body (process (read port)))
+   (define max-arg (apply max 0 (hash-table-keys ht)))
+   (define lambda-list (list-tabulate max-arg (compose ht-ref 1+)))
+   `(lambda (,@lambda-list . ,(hash-table-ref/default ht 0 '()))
+      ,body)))
+
 (define (inc a) (+ a 1))
 (define (dec a) (- a 1))