Skip to content

Instantly share code, notes, and snippets.

@cky

cky/gist:8500450

Last active June 21, 2022 02:25
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save cky/8500450 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save cky/8500450 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. cky revised this gist Jan 20, 2014. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion gistfile1.scm
    View file
    Original file line number Diff line number Diff line change
    @@ -1,5 +1,5 @@
    (use-srfis '(1 69))
    (read-hash-extend #\%
    (read-hash-extend #\#
    (lambda (c port)
    (define ht (make-hash-table eqv?))
    (define (ht-ref key)
  2. cky revised this gist Jan 20, 2014. 1 changed file with 6 additions and 4 deletions.
    10 changes: 6 additions & 4 deletions gistfile1.scm
    View file
    Original file line number Diff line number Diff line change
    @@ -1,6 +1,6 @@
    (use-srfis '(1 69))
    (read-hash-extend #\%
    (lambda (c port)
    (lambda (c port)
    (define ht (make-hash-table eqv?))
    (define (ht-ref key)
    (hash-table-ref ht key (lambda ()
    @@ -15,9 +15,11 @@
    ((%&) 0)
    ((#{}#) #f)
    (else (and (symbol? x)
    (eqv? #\% (string-ref (symbol->string x) 0))
    (char<=? #\1 (string-ref (symbol->string x) 1) #\9)
    (string->number (substring/shared (symbol->string x) 1))))))
    (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))
  3. cky revised this gist Jan 19, 2014. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion gistfile1.scm
    View file
    Original file line number Diff line number Diff line change
    @@ -23,7 +23,7 @@
    ((list? x) (map process x))
    (else x)))
    (define body (process (read port)))
    (define max-arg (apply max (hash-table-keys ht)))
    (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)))
  4. cky created this gist Jan 19, 2014.
    29 changes: 29 additions & 0 deletions gistfile1.scm
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,29 @@
    (use-srfis '(1 69))
    (read-hash-extend #\%
    (lambda (c 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)
    (eqv? #\% (string-ref (symbol->string x) 0))
    (char<=? #\1 (string-ref (symbol->string x) 1) #\9)
    (string->number (substring/shared (symbol->string x) 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 (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)))