Skip to content

Instantly share code, notes, and snippets.

@ktakashi
ktakashi / define-dummy.scm
Created January 23, 2017 08:04
Initialisation with dummy name
#!r6rs
(import (rnrs))
(define-syntax define-dummy
(syntax-rules ()
((_ body ...)
(define dummy
(begin
body ...
#t)))))
@ktakashi
ktakashi / foo.scm
Created October 7, 2016 15:10
List splicing via with-syntax
(import (rnrs))
(define-syntax foo
(lambda (x)
(syntax-case x ()
((k)
(with-syntax (((x ...) (datum->syntax #'k '(a b c))))
#'(begin (display '(x ...)) (newline)))))))
(foo)
@ktakashi
ktakashi / lcs.scm
Last active September 26, 2016 12:35
benchmark of 'Deriving Pure, Naturally-Recursive Operations for Processing Tail-Aligned Lists'
(import (rnrs) (only (chezscheme) time))
;;(import (rnrs) (only (racket base) time))
;;(import (rnrs) (time))
(define (tt a1 a2) a1)
(define (ff a1 a2) a2)
(define (slot-f f l) (fold-right (lambda (a f) (f a)) f l))
(define (build-k j as k)
(lambda (r)
(lambda (a1)
@ktakashi
ktakashi / fast-inv-sqrt.scm
Created July 26, 2016 06:53
Fast inverse square root in R6RS
#!r6rs
(import (rnrs))
(define (fast-inv-sqrt f)
(let ((bv (make-bytevector 4)))
(bytevector-ieee-single-native-set! bv 0 f)
(let* ((i0 (bitwise-arithmetic-shift (bytevector-s32-native-ref bv 0) -1))
(i1 (- #x5f3759df i0)))
(bytevector-s32-native-set! bv 0 i1)
(let ((y (bytevector-ieee-single-native-ref bv 0)))
@ktakashi
ktakashi / grep.scm
Last active June 16, 2016 14:33
O(1) memory k length grep
(import (rnrs)
(prefix (binary io) binary:)
(util bytevector))
;; assume all UTF-8 and EOL is \n
;; It's as close as O(1) memory space.
;; The amount of memory usage is O(m), m is the length of one line.
;; (and I think reading one line isn't that bad comparing storing n lines)
;; It is possible to make this actual O(1) to search port each time set
;; port position. But I don't think that's a good trade off (it doesn't pay off).
@ktakashi
ktakashi / cps.scm
Created April 29, 2016 12:26
CPS conversion
;; expression must already be expanded by expander
;; so it shall only have the following syntaxes:
;; - define
;; - lambda
;; - set!
;; - quote
;; - if
;; - begin
;; NB: by this point, all of the optimisation in Scheme level
;; must be done. (e.g. constant folding)
@ktakashi
ktakashi / generic-copy.scm
Last active April 15, 2016 09:15
Generic copy and record copy
(import (scheme base))
;; copier
(define *copier-table* '())
(define (generic-copy obj)
(cond ((assoc obj *copier-table* (lambda (x p) (p x))) =>
(lambda (s) ((cdr s) obj)))
;; shallow copy, sort of
(else obj)))
(define (register-copier! pred copier)
@ktakashi
ktakashi / psql.log
Created March 11, 2016 14:32
PostgreSQL: select ${table} from ${table}
postit=> \d users
Table "public.users"
Column | Type | Modifiers
-------------+-----------------------------+-------------------------------------------------
id | integer | not null default nextval('users_seq'::regclass)
username | character varying | not null
password | character varying | not null
create_date | timestamp without time zone | default now()
Indexes:
"users_pkey" PRIMARY KEY, btree (id)
@ktakashi
ktakashi / match.scm
Last active November 27, 2015 12:23
Match with syntax-case
#!r6rs
(import (rnrs))
(define-syntax match
(lambda (x)
;; extract identifier in pattern
(define (parse-pattern pattern)
(let loop ((p pattern) (acc '()))
(syntax-case p ()
(() (reverse acc))
@ktakashi
ktakashi / expt.scm
Last active November 2, 2015 08:55
expt performance comparison
;; for Sagittarius, Ypsilon
(import (rnrs) (time))
;; for Mosh
;; (import (rnrs) (mosh))
;; for Chez with --script option
;; (import (rnrs))
;; for Vicare
;; (import (rnrs) (vicare))
;; for Racket
;; (import (rnrs) (only (racket base) time))