Add json, primes, base64 tests for Racket

base64/Makefile

@@ -45,7 +45,8 @@ all_runners := $(patsubst %,run[%], $(artifacts)) \
 	run[jruby][test.rb] \
 	run[test-xs.pl] \
 	run[test.tcl] \
-	run[test.php]
+	run[test.php] \
+	run[test.rkt]
 
 # Build
 
@@ -218,6 +219,9 @@ run[test.tcl]:: run[%]: %
 run[test.php]:: run[%]: %
 	$(PHP_RUN)
 
+run[test.rkt]:: run[%]: %
+	$(RACKET_RUN)
+
 # Utilities
 
 .PHONY: clean

base64/test.rkt

@@ -0,0 +1,60 @@
+#lang racket/base
+
+(require racket/tcp racket/os net/base64)
+(#%declare #:unsafe)
+
+(define (verify)
+  (for ([(src dst) (in-hash (hash "hello" "aGVsbG8=" "world" "d29ybGQ="))])
+    (define encoded (bytes->string/utf-8 (base64-encode (string->bytes/utf-8 src) #"")))
+    (when (not (equal? encoded dst))
+      (error 'verify "~s != ~s" encoded dst))
+    (define decoded (bytes->string/utf-8 (base64-decode (string->bytes/utf-8 dst))))
+    (when (not (equal? decoded src))
+      (error 'verify "~s != ~s" decoded src))))
+
+(define (notify msg)
+  (with-handlers ([exn:fail:network? void])
+    (let-values ([(in out) (tcp-connect "localhost" 9001)])
+      (display msg out)
+      (close-input-port in)
+      (close-output-port out))))
+
+(module+ test
+  (verify))
+
+(module+ main
+  (verify)
+
+  (define STR-SIZE 131072)
+  (define TRIES 8192)
+
+  (define str1 (make-bytes STR-SIZE (char->integer #\a)))
+  (define str2 (base64-encode str1 #""))
+  (define str3 (base64-decode str2))
+
+  (notify (format "Racket\t~s" (getpid)))
+
+  (define-values (s-encoded t-encoded t-encoded-real t-encoded-gc)
+    (time-apply
+     (lambda ()
+       (for/sum ([_ (in-range 0 TRIES)])
+         (bytes-length (base64-encode str1 #""))))
+     '()))
+
+  (define-values (s-decoded t-decoded t-decoded-real t-decoded-gc)
+    (time-apply
+     (lambda ()
+       (for/sum ([_ (in-range 0 TRIES)])
+         (bytes-length (base64-decode str2))))
+     '()))
+
+  (notify "stop")
+
+  (printf "encode ~s... to ~s...: ~s, ~s\n"
+          (substring (bytes->string/utf-8 str1) 0 4)
+          (substring (bytes->string/utf-8 str2) 0 4)
+          s-encoded (* t-encoded 0.001))
+  (printf "decode ~s... to ~s...: ~s, ~s\n"
+          (substring (bytes->string/utf-8 str2) 0 4)
+          (substring (bytes->string/utf-8 str3) 0 4)
+          s-decoded (* t-decoded 0.001)))

json/Makefile

@@ -88,7 +88,8 @@ all_runners := $(patsubst %,run[%], $(artifacts)) \
 	run[truby-native][test.rb] \
 	run[jruby][test.rb] \
 	run[test.php] \
-	run[test.clj]
+	run[test.clj] \
+	run[test.rkt]
 
 # Build
 
@@ -436,6 +437,9 @@ run[test.clj]:: CLOJURE_FLAGS := -Sdeps '{:deps {cheshire/cheshire {:mvn/version
 run[test.clj]:: run[%]: %
 	$(CLOJURE_RUN)
 
+run[test.rkt]:: run[%]: %
+	$(RACKET_RUN)
+
 # Utilities
 
 .PHONY: clean

json/test.rkt

@@ -0,0 +1,52 @@
+#lang racket/base
+
+(require racket/flonum racket/tcp racket/file racket/os racket/unsafe/ops json)
+
+(#%declare #:unsafe)
+(struct Coordinates (x y z) #:transparent)
+
+(define (calc text)
+  (define jobj (bytes->jsexpr text))
+  (let-values ([(x y z len) (for/fold ([x 0.0]
+                                       [y 0.0]
+                                       [z 0.0]
+                                       [len 0])
+                                      ([coord (hash-ref jobj 'coordinates)])
+                              (values (unsafe-fl+ x (hash-ref coord 'x))
+                                      (unsafe-fl+ y (hash-ref coord 'y))
+                                      (unsafe-fl+ z (hash-ref coord 'z))
+                                      (unsafe-fx+ len 1)))])
+    (let ([len-fl (->fl len)])
+      (Coordinates (unsafe-fl/ x len-fl) (unsafe-fl/ y len-fl) (unsafe-fl/ z len-fl)))))
+
+(define (notify msg)
+  (with-handlers ([exn:fail:network? void])
+    (let-values ([(in out) (tcp-connect "localhost" 9001)])
+      (display msg out)
+      (close-input-port in)
+      (close-output-port out))))
+
+(define (verify)
+  (define right (Coordinates 2.0 0.5 0.25))
+  (for ([v '(#"{\"coordinates\":[{\"x\":2.0,\"y\":0.5,\"z\":0.25}]}"
+             #"{\"coordinates\":[{\"y\":0.5,\"x\":2.0,\"z\":0.25}]}")])
+    (define left (calc v))
+    (when (not (equal? left right))
+      (error 'verify "~s != ~s" left right))))
+
+(define (read-c path)
+  (parameterize ([current-locale "C"])
+    (file->bytes path)))
+
+(module+ test
+  (verify))
+
+(module+ main
+  (verify)
+  (define text (read-c "/tmp/1.json"))
+
+  (notify (format "Racket\t~s" (getpid)))
+  (define results (calc text))
+  (notify "stop")
+
+  (displayln results))

primes/Makefile

@@ -27,7 +27,8 @@ all_runners := $(patsubst %,run[%], $(artifacts)) \
 	run[jruby][primes.rb] \
 	run[primes.lua] \
 	run[primes_jit.lua] \
-	run[primes.jl]
+	run[primes.jl] \
+	run[primes.rkt]
 
 
 # Build
@@ -123,6 +124,9 @@ run[primes_jit.lua]:: run[%]: %
 run[primes.jl]:: run[%]: % | $(julia_fmt)
 	$(JULIA_RUN)
 
+run[primes.rkt]:: run[%]: %
+	$(RACKET_RUN)
+
 # Utilities
 
 .PHONY: clean

primes/primes.rkt

@@ -0,0 +1,149 @@
+#lang racket/base
+
+(require racket/os racket/fixnum racket/tcp racket/unsafe/ops racket/vector racket/list data/queue
+         (rename-in racket/unsafe/ops
+                    [unsafe-vector*-ref vector-ref]
+                    [unsafe-vector*-set! vector-set!]
+                    [unsafe-vector*-length vector-length]
+                    [unsafe-fx+ +]
+                    [unsafe-fx- -]
+                    [unsafe-fxmodulo modulo]
+                    [unsafe-fx* *]
+                    [unsafe-fx< <]
+                    [unsafe-fx> >]
+                    [unsafe-fx>= >=]
+                    [unsafe-fx<= <=]
+                    [unsafe-fx= =]))
+(#%declare #:unsafe)
+
+(struct Node (children terminal)
+  #:mutable
+  #:authentic)
+
+(struct Sieve (limit [prime #:mutable])
+  #:authentic
+  #:guard (lambda (limit prime type-name)
+            (values limit (make-vector (+ limit 1) #f))))
+
+(define (calc sieve)
+  (define limit (+ (Sieve-limit sieve)))
+  (define prime (Sieve-prime sieve))
+
+  (define (to-list)
+    (vector-set*! prime 2 #t 3 #t)
+    (for/list ([p (in-range 2 (+ limit 1))]
+               #:when (vector-ref prime p))
+      p))
+
+  (define (omit-squares)
+    (let loop ([r 5])
+      (define sq (* r r))
+      (cond
+        [(>= sq limit) r]
+        [else (when (vector-ref prime r)
+                (let loop ([i sq])
+                  (cond
+                    [(>= i limit) i]
+                    [else (vector-set! prime i #f)
+                          (loop (+ i sq))])))
+              (loop (+ r 1))])))
+
+  (define (step1 x y)
+    (let ([n (+ (* 4 x x) (* y y))])
+      (when (and (<= n limit) (or (= (modulo n 12) 1) (= (modulo n 12) 5)))
+        (vector-set! prime n (not (vector-ref prime n))))))
+
+  (define (step2 x y)
+    (let ([n (+ (* 3 x x) (* y y))])
+      (when (and (<= n limit) (= (modulo n 12) 7 ))
+        (vector-set! prime n (not (vector-ref prime n))))))
+
+  (define (step3 x y)
+    (let ([n (- (* 3 x x) (* y y))])
+      (when (and (> x y) (<= n limit) (= (modulo n 12) 11))
+        (vector-set! prime n (not (vector-ref prime n))))))
+
+  (define (loop-y x)
+    (let loop ([y 1])
+      (cond
+        [(< (* y y) limit)
+         (step1 x y)
+         (step2 x y)
+         (step3 x y)
+         (loop (+ y 1))]
+        [else y])))
+
+  (define (loop-x)
+    (let loop ([x 1])
+      (cond
+        [(< (* x x) limit)
+         (loop-y x)
+         (loop (+ x 1))]
+        [else x])))
+
+  (loop-x)
+  (omit-squares)
+  (to-list))
+
+(define (generate-trie primes)
+  (define root (Node (make-hasheq) #f))
+  (for ([el (in-list primes)])
+    (define head root)
+    (define children (Node-children head))
+    (define el-str (number->string el))
+    (define el-str-len (string-length el-str))
+    (for ([ch (in-string el-str)])
+      (set! head (hash-ref! (Node-children head) ch (Node (make-hasheq) #f))))
+    (set-Node-terminal! head #t))
+  root)
+
+(define (find upper-bound prefix)
+  (let/cc return
+    (define head (generate-trie (calc (Sieve upper-bound #f))))
+    (define str-prefix (number->string prefix))
+    (for ([ch (in-string str-prefix)])
+      (set! head (hash-ref! (Node-children head) ch #f))
+      (when (not head)
+        (return #f)))
+
+    (define queue (make-queue))
+    (enqueue! queue (cons head str-prefix))
+    (let loop ([queue queue]
+               [result '()])
+      (cond
+        [(queue-empty? queue) (sort result <)]
+        [else
+         (define top-prefix (dequeue! queue))
+         (define-values (top prefix) (values (car top-prefix) (cdr top-prefix)))
+         (for ([(ch v) (in-hash (Node-children top))])
+           (enqueue! queue (cons v (string-append prefix (string ch)))))
+         (if (Node-terminal top)
+           (loop queue (cons (string->number prefix) result))
+           (loop queue result))]))))
+
+(define (verify)
+  (define left '(2 23 29))
+  (define right (find 100 2))
+  (when (not (equal? left right))
+    (error 'verify "~s != ~s" left right)))
+
+(define (notify msg)
+  (with-handlers ([exn:fail:network? void])
+    (let-values ([(in out) (tcp-connect "localhost" 9001)])
+      (display msg out)
+      (close-input-port in)
+      (close-output-port out))))
+
+(define UPPER-BOUND 5000000)
+(define PREFIX 32338)
+
+(module+ test
+  (verify))
+
+(module+ main
+  (verify)
+  (notify (format "Racket\t~s" (getpid)))
+  (define results (find UPPER-BOUND PREFIX))
+  (notify "stop")
+
+  (displayln results))