From e6ad8129cc854dac38940acb24e3a07cd0cd7b56 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 13 May 2020 13:32:14 -0700
Subject: Re-namespace general scheme code to bs

---
 Alpha/Core.scm   | 221 --------------------------------------------------
 Alpha/Logic.scm  | 239 -------------------------------------------------------
 Alpha/Repl.scm   |  17 ----
 Alpha/Shell.scm  |  32 --------
 Alpha/String.scm |  72 -----------------
 Alpha/Test.scm   |  16 ----
 bs/core.scm      | 221 ++++++++++++++++++++++++++++++++++++++++++++++++++
 bs/dict.scm      |  50 ++++++++++++
 bs/logic.scm     | 239 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 bs/re.scm        |  11 +++
 bs/repl.scm      |  17 ++++
 bs/shell.scm     |  32 ++++++++
 bs/string.scm    |  72 +++++++++++++++++
 bs/test.scm      |  16 ++++
 dict.scm         |  50 ------------
 re.scm           |  11 ---
 z.scm            |   8 +-
 17 files changed, 662 insertions(+), 662 deletions(-)
 delete mode 100644 Alpha/Core.scm
 delete mode 100644 Alpha/Logic.scm
 delete mode 100644 Alpha/Repl.scm
 delete mode 100644 Alpha/Shell.scm
 delete mode 100644 Alpha/String.scm
 delete mode 100644 Alpha/Test.scm
 create mode 100644 bs/core.scm
 create mode 100644 bs/dict.scm
 create mode 100644 bs/logic.scm
 create mode 100644 bs/re.scm
 create mode 100644 bs/repl.scm
 create mode 100644 bs/shell.scm
 create mode 100644 bs/string.scm
 create mode 100644 bs/test.scm
 delete mode 100644 dict.scm
 delete mode 100644 re.scm

diff --git a/Alpha/Core.scm b/Alpha/Core.scm
deleted file mode 100644
index 076ad28..0000000
--- a/Alpha/Core.scm
+++ /dev/null
@@ -1,221 +0,0 @@
-(define-module (Alpha Core)
-  #:use-module ((ice-9 format))
-  #:use-module ((system vm program))
-  #:use-module ((ice-9 rdelim) #:select (read-line))
-  #:use-module (srfi srfi-1)
-  #:export (fmt printf pr prn rest last butlast
-                true? false? some? empty?
-                -> ->> fn /. curry comp
-                repeat for seq turn
-                inc dec member? contains?
-                comment get-source* get-source source))
-
-(define (flip f)           (lambda (x y) (f y x)))
-(define (curry f a)        (lambda (b) (apply f (cons a (list b)))))
-(define pos?
-  (curry < 0))
-
-(define neg?
-  (curry > 0))
-
-(define (foldr f end lst)
-  (if (null? lst)
-      end
-      (f (car lst) (foldr f end (cdr lst)))))
-
-(define (foldl f acc lst)
-  (if (null? lst)
-      acc
-      (foldl f (f acc (car lst)) (cdr lst))))
-
-(define (sum lst)          (fold + 0 lst))
-(define (product lst)      (fold * 1 lst))
-
-(define count length)
-
-(define (pr . a)
-  "Print"
-  (for-each display a))
-
-(define (prn . a)
-  "Print, followed by a newline"
-  (apply pr a)
-  (newline))
-
-(define (false? x)
-  (not (eq? #t x)))
-
-(define (true? x)
-  (eq? #t x))
-
-(define (some? a)
-  (not (null? a)))
-
-(define (empty? a)
-  (equal? a '()))
-
-(define (ffirst a)
-  (first (first a)))
-
-(define (rest a)
-  "Returns a list of the items after the first."
-  (cdr a))
-
-(define (last coll)
-  "Return the last time in coll, in linear time."
-  (if (second coll)
-      (last (rest coll))
-      (first coll)))
-
-(define (butlast ls)
-  "Return everthing execpt the last element in ls."
-  (let ((len (length ls)))
-    (list-head ls (- len 1))))
-
-;; Ignores body, returns '().
-(define-syntax comment
-  (syntax-rules ()
-    ((_ ...) '())))
-
-(define (some pred coll)
-  (or (pred (first coll))
-      (some pred (second coll))))
-
-(define comp compose)
-
-(define (not-any? pred coll)
-  (comp not some))
-
-(define (printf . args)
-  (display (apply format args)))
-
-(define-syntax fmt
-  (syntax-rules ()
-    ((_ s args ...)
-     (format #f s args ...))))
-
-(define-syntax fn
-  (syntax-rules ()
-    ((_ args body ...)
-     (lambda args body ...))))
-
-(define-syntax ->
-  (syntax-rules ()
-    [(_ a) a]
-    [(_ a (b c ...))
-     (b a c ...)]
-    [(_ a b)
-     (-> a (b))]
-    [(_ a b c ...)
-     (-> (-> a b) c ...)]))
-
-(define-syntax ->>
-  (syntax-rules ()
-    [(_ a) a]
-    [(_ a (b ...))
-     (b ... a)]
-    [(_ a b)
-     (b a)]
-    [(_ a b c ...)
-     (->> (->> a b) c ...)]))
-
-;; Shen-like lambda
-(define-syntax /.
-  (syntax-rules ()
-    [(/. a b)
-     (lambda (a) b)]
-    [(/. a ... b)
-     (lambda (a ...) b)]
-    [(/. a ... (b ...))
-     (lambda (a ...) (b ...))]))
-
-(define (inc a) (+ a 1))
-(define (dec a) (- a 1))
-
-(define* (repeat a #:optional (n 10))
-  (do ((i 1 (inc i)))
-      ((> i n))
-    a))
-
-(define-syntax if-let
-  (syntax-rules ()
-    [(_ (binding value) then else)
-     (let ([binding value])
-       (if binding then else))]))
-
-(define-syntax when-let
-  (syntax-rules ()
-    [(_ (binding value) body ...)
-     (when binding body ...)]))
-
-
-;; source utils
-
-(define (skip-lines port n)
-  (cond
-   ((zero? n) port)
-   (else (read-line port) (skip-lines port (1- n)))))
-
-(define (get-source* source pname)
-  (let* ([file (source:file source)]
-         [filename (any (fn (x)
-                            (let ((f (string-append x "/" file)))
-                              (if (file-exists? f) f #f)))
-                        %load-path)]
-         [re (make-regexp (format #f "\\(define (~a|\\(~a.*\\))" pname pname))]
-         [read-between (lambda (in start end)
-                         (seek in 0 SEEK_SET)
-                         (skip-lines in (1- start))
-                         (call-with-output-string
-                           (lambda (out)
-                             (let self ((line (read-line in))
-                                        (cur start))
-                               (cond
-                                [(or (eof-object? line) (> cur end))
-                                 (close in)]
-                                [else
-                                 (format out "~a~%" line)
-                                 (self (read-line in) (inc cur))])))))])
-    (call-with-input-file filename
-      (lambda (in)
-        (let self ((line (read-line in)))
-          (cond
-           [(eof-object? line) #f]
-           [(regexp-exec re line)
-            (unread-string line in)
-            (let*  ((start (port-line in))
-                    (end (begin (read in) (port-line in))))
-              (read-between in start (inc end)))]
-           [else
-            (self (read-line in))]))))))
-
-(define (get-source p)
-  "Get the source of a procedure as a string."
-  (let ((psrc (program-source p 0)))
-    (cond
-     [(not psrc) (fmt "<~a: compiled C procedure>\n" p)]
-     [(not (source:file psrc)) #f]
-     [else (get-source* psrc (symbol->string (procedure-name p)))])))
-
-(define (source p)
-  "Print the source of a procedure."
-  (pr (get-source p)))
-
-(define member? member)
-
-(define (contains? ls x)
-  (member? x ls))
-
-(define (turn ls f)
-  (map f ls))
-
-(define (seq x)
-  (if (list? x)
-      x
-      (list x)))
-
-;; is this not in srfi-1?
-(define (flatten x)
-  (cond ((null? x) '())
-        ((pair? x) (append (flatten (car x)) (flatten (cdr x))))
-        (else (list x))))
diff --git a/Alpha/Logic.scm b/Alpha/Logic.scm
deleted file mode 100644
index 4b160d8..0000000
--- a/Alpha/Logic.scm
+++ /dev/null
@@ -1,239 +0,0 @@
-;; my mini kanren impl - basically untested so far
-;; TODO: https://github.com/webyrd/faster-miniKanren
-
-(define-module (Alpha Logic))
-
-(define-syntax λg
-  (syntax-rules ()
-    ((_ (s) e) (lambda (s) e))))
-
-(define-syntax λf
-  (syntax-rules ()
-    ((_ () e) (lambda () e))))
-
-(define (unify u v s)
-  (let ([u (walk u s)]
-        [v (walk v s)])
-    (cond
-     [(eq? u u) s]
-
-     [(var? u)
-      (cond
-       [(var? v) (ext-s-check u v s)]
-       [else (ext-s-check u v s)])]
-
-     [(and (pair? u) (pair? v))
-      (let ([s (unify (car u) (car v) s)])
-        (and s (unify (cdr u) (cdr v) s)))]
-
-     [(equal? u v) s]
-
-     [else #f])))
-
-(define-syntax if-not
-  (syntax-rules ()
-    ((_ pred then else)
-     (if (not pred) then else))))
-
-(define (walk v s)
-  (if-not (var? v)
-      v
-    (let ([a (assq v s)])
-      (if a
-          (walk (cdr a) s)
-          v))))
-
-(define (ext-s-check x v s)
-  (if-not (occurs-check x v s)
-      (ext-s x v s)
-    #f))
-
-(define (occurs-check x v s)
-  (let ([v (walk v s)])
-    (cond
-     [(var? v) (eq? v x)]
-     [(pair? v)
-      (or (occurs-check x (car v) s)
-          (occurs-check x (cdr v) s))]
-     [else #f])))
-
-(define (ext-s x v s)
-  (cons `(,x . ,v) s))
-
-(define empty-s '())
-
-(define var vector)
-(define var? vector?)
-
-(define reify
-  (letrec ([reify-s (lambda [v s]
-                      (let ([v (walk v s)])
-                        (cond
-                         [(var? v) (ext-s v (reify-name (length s)) s)]
-                         [(pair? v) (reify-s (cdr v) (reify-s (car v) s))]
-                         [else s])))])
-    (lambda [v s]
-      (let ([v (walk* v s)])
-        (walk* v (reify-s v empty-s))))))
-
-(define walk*
-  (lambda [w s]
-    (let ([v (walk w s)])
-      (cond
-       [(var? v) v]
-       [(pair? v) (cons (walk* (car v) s)
-                        (walk* (cdr v) s))]
-       [else v]))))
-
-(define reify-name
-  (lambda [n]
-    (string->symbol
-     (string-append "_" "." (number->string n)))))
-
-(define-syntax mzero
-  (syntax-rules ()
-    ((_) #f)))
-
-(define-syntax unit
-  (syntax-rules ()
-    ((_ a) a)))
-
-(define-syntax choice
-  (syntax-rules ()
-    ((_ a f) (cons a f))))
-
-(define-syntax inc
-  (syntax-rules ()
-    ((_ e) (λf () e))))
-
-(define-syntax case-inf
-  (syntax-rules ()
-    ((_ e on-zero
-        [(a^) on-one]
-        [(a f) on-choice]
-        [(f^) on-inc])
-     (let ([a-inf e])
-       (cond
-        ;; a-inf = #f
-        [(not a-inf) on-zero]
-        ;; a-inf = lambda
-        [(procedure? a-inf) (let ((f^ a-inf)) on-inc)]
-        ;; a-inf = (x . lambda)
-        [(and (pair? a-inf) (procedure? (cdr a-inf)))
-         (let ([a (car a-inf)]
-               [f (cdr a-inf)])
-           on-choice)]
-        [else (let ((a^ a-inf)) on-one)])))))
-
-(define-syntax ==
-  (syntax-rules ()
-    ((_ u v)
-     (λg (s) (unify u v s)))))
-
-(define-syntax conde
-  (syntax-rules ()
-    ((_ (g0 g ...) (g1 g^ ...) ...)
-     (λg (s)
-         (inc (mplus*
-               (bind* (g0 s) g ...)
-               (bind* (g1 s) g^ ...) ...))))))
-
-(define-syntax mplus*
-  (syntax-rules ()
-    ((_ e) e)
-    ((_ e0 e ...) (mplus e0 (λf () (mplus* e ...))))))
-
-(define mplus
-  (lambda (a-inf f)
-    (case-inf a-inf (f)
-              ((a) (choice a f))
-              ((a f^) (choice a (λf () (mplus (f) f^))))
-              ((f^) (inc (mplus (f) f^))))))
-
-(define-syntax fresh
-  (syntax-rules ()
-    ((_ (x ...) g0 g ...)
-     (λg (s)
-         (let ((x (var 'x)) ...)
-           (bind* (g0 s) g ...))))))
-
-(define-syntax bind*
-  (syntax-rules ()
-    ((_ e) e)
-    ((_ e g0 g ...)
-     (let ((a-inf e))
-       (and a-inf (bind* (bind a-inf g0) g ...))))))
-
-(define bind
-  (lambda (a-inf g)
-    (case-inf a-inf (mzero)
-              ((a) (g a))
-              ((a f) (mplus (g a) (λf () (bind (f) g))))
-              ((f) (inc (bind (f) g))))))
-
-(define-syntax run
-  (syntax-rules ()
-    ((_ n (x) g0 g^ ...)
-     (take n
-           (λf
-            ()
-            (let ((g (fresh
-                      (x)
-                      (λg
-                       (s)
-                       (bind* (g0 s) g^ ...
-                              (λg (s)
-                                  (list (reify x s))))))))
-              (g empty-s)))))))
-
-(define-syntax run*
-  (syntax-rules ()
-    ((_ (x) g ...) (run #f (x) g ...))))
-
-(define take
-  (lambda (n f)
-    (if (and n (zero? n))
-        '()
-        (case-inf (f) '()
-                  [(a) a]
-                  [(a f) (cons (car a) (take (and n (- n 1)) f))]
-                  [(f) (take n f)]))))
-
-(define-syntax conda
-  (syntax-rules ()
-    ((_ (g0 g ...) (g1 g^ ...) ...)
-     (λg (s)
-         (if* (picka (g0 s) g ...) (picka (g1 s) g^ ...) ...)))))
-
-(define-syntax condu
-  (syntax-rules ()
-    ((_ (g0 g ...) (g1 g^ ...) ...)
-     (λg (s)
-         (if* (picku (g0 s) g ...)
-              (picku (g1 s) g^ ...)
-              ...)))))
-
-(define-syntax if*
-  (syntax-rules ()
-    ((_) (mzero))
-    ((_ (pick e g ...) b ...)
-     (let loop ((a-inf e))
-       (case-inf a-inf (if* b ...)
-                 [(a) (bind* a-inf g ...)]
-                 [(a f) (bind* (pick a a-inf) g ...)]
-                 [(f) (inc (loop (f)))])))))
-
-(define-syntax picka
-  (syntax-rules ()
-    ((_ a a-inf) a-inf)))
-
-(define-syntax picku
-  (syntax-rules ()
-    ((_ a a-inf) (unit a))))
-
-(define-syntax project
-  (syntax-rules ()
-    ((_ (x ...) g0 g ...)
-     (λg (s)
-         (let ((x (walk* x s)) ...)
-           (bind* (g0 s) g ...))))))
diff --git a/Alpha/Repl.scm b/Alpha/Repl.scm
deleted file mode 100644
index f3f7898..0000000
--- a/Alpha/Repl.scm
+++ /dev/null
@@ -1,17 +0,0 @@
-(define-module (Alpha Repl))
-;; (use-modules (system repl common))
-;; (repl-default-option-set!
-;;  'prompt
-;;  (lambda (repl)
-;;    (format #f "\n[~a@~a:~a]\nλ> "
-;;            (getenv "USER")
-;;            (vector-ref (uname) 1)
-;;            (pwd))))
-
-;; TODO(bsima): (doc x)
-
-(eval-when (compile load eval)
-  (define-meta-command ((src nala) repl (form))
-    "Print source code of specified Scheme procedure."
-    (call-with-values (repl-prepare-eval-thunk repl (repl-parse repl form))
-      (lambda args (for-each print-src args)))))
diff --git a/Alpha/Shell.scm b/Alpha/Shell.scm
deleted file mode 100644
index b00b174..0000000
--- a/Alpha/Shell.scm
+++ /dev/null
@@ -1,32 +0,0 @@
-(define-module (Alpha Shell)
-  #:use-module ((ice-9 popen) #:prefix popen/)
-  #:use-module ((ice-9 rdelim) #:prefix rdelim/)
-  #:use-module ((ice-9 ftw) #:prefix ftw/)
-  #:export (exec
-            stream
-            pwd
-            ls
-            cd))
-
-(define (exec cmd)
-  (let* ((port (popen/open-input-pipe cmd))
-         (ret (read port)))
-    (popen/close-pipe port)
-    ret))
-
-(define (stream cmd)
-  (let* ((port (popen/open-input-pipe cmd))
-         (_ (setvbuf port 'none))
-         (ret (rdelim/read-string port)))
-    (flush-all-ports)
-    (popen/close-pipe port)
-    ret))
-
-(define pwd getcwd)
-
-(define (ls)
-  (ftw/scandir (getcwd)))
-
-(define (cd path)
-  (chdir path)
-  (ls))
diff --git a/Alpha/String.scm b/Alpha/String.scm
deleted file mode 100644
index 6e29663..0000000
--- a/Alpha/String.scm
+++ /dev/null
@@ -1,72 +0,0 @@
-(define-module (Alpha String)
-  #:export (replace replace-char to-string str capitalize split
-                    strip lstrip rstrip))
-
-(define (split s c)
-  (if s
-      (string-split s c)
-      #f))
-
-(define (replace-char s match repl)
-  (let ((f (lambda (a b)
-             (let ((next-char (if (eq? a match) repl a)))
-               (string-concatenate (list b (string next-char)))))))
-    (string-fold f "" s)))
-
-(define (replace s match repl)
-  (string-replace-substring s match repl))
-
-(define (to-string x)
-  (format #f "~a" x))
-
-(define str
-  (case-lambda
-    (() "")
-    ((x) (to-string x))
-    ((x . rest) (string-concatenate (map str (cons x rest))))))
-
-(define (capitalize s)
-  (let ((s (to-string s)))
-    (if (< (string-length s) 2)
-        (string-upcase s)
-        (str (string-upcase (substring s 0 1))
-             (substring s 1 )))))
-
-(define (strip s char)
-  (string-trim-both s char))
-
-(define (lstrip s char)
-  (string-trim s char))
-
-(define (rstrip s char)
-  (string-trim-right s char ))
-
-
-;;; {String Fun: string-replace-substring}
-;;;
-
-;; string-replace-substring By A. Wingo in
-;; https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00058.html
-;; also in string-replace-substring guix:guix/utils.scm.
-
-(define (string-replace-substring str substring replacement)
-  "Return a new string where every instance of @var{substring} in string
-   @var{str} has been replaced by @var{replacement}. For example:
-
-   @lisp
-   (string-replace-substring \"a ring of strings\" \"ring\" \"rut\")
-   @result{} \"a rut of struts\"
-   @end lisp
-   "
-  (let ((sublen (string-length substring)))
-    (with-output-to-string
-      (lambda ()
-        (let lp ((start 0))
-          (cond
-           ((string-contains str substring start)
-            => (lambda (end)
-                 (display (substring/shared str start end))
-                 (display replacement)
-                 (lp (+ end sublen))))
-           (else
-            (display (substring/shared str start)))))))))
diff --git a/Alpha/Test.scm b/Alpha/Test.scm
deleted file mode 100644
index 8c0916d..0000000
--- a/Alpha/Test.scm
+++ /dev/null
@@ -1,16 +0,0 @@
-;; a testing framework for scheme
-;; inspired by clojure.test and srfi-64
-
-(define-module (Alpha Test)
-  #:use-module ((Alpha Core)
-                #:select (prn))
-  #:export (testing))
-
-;; TODO: learn srfi-64
-;; TODO: port over `deftest' et al from clojure
-;; TODO: someday a quickcheck-like would be best
-
-;; simple analog to clojure's `testing'
-(define-syntax testing
-  ((_ description ...)
-   ((begin (prn description) ...))))
diff --git a/bs/core.scm b/bs/core.scm
new file mode 100644
index 0000000..d8e0060
--- /dev/null
+++ b/bs/core.scm
@@ -0,0 +1,221 @@
+(define-module (bs core)
+  #:use-module ((ice-9 format))
+  #:use-module ((system vm program))
+  #:use-module ((ice-9 rdelim) #:select (read-line))
+  #:use-module (srfi srfi-1)
+  #:export (fmt printf pr prn rest last butlast
+                true? false? some? empty?
+                -> ->> fn /. curry comp
+                repeat for seq turn
+                inc dec member? contains?
+                comment get-source* get-source source))
+
+(define (flip f)           (lambda (x y) (f y x)))
+(define (curry f a)        (lambda (b) (apply f (cons a (list b)))))
+(define pos?
+  (curry < 0))
+
+(define neg?
+  (curry > 0))
+
+(define (foldr f end lst)
+  (if (null? lst)
+      end
+      (f (car lst) (foldr f end (cdr lst)))))
+
+(define (foldl f acc lst)
+  (if (null? lst)
+      acc
+      (foldl f (f acc (car lst)) (cdr lst))))
+
+(define (sum lst)          (fold + 0 lst))
+(define (product lst)      (fold * 1 lst))
+
+(define count length)
+
+(define (pr . a)
+  "Print"
+  (for-each display a))
+
+(define (prn . a)
+  "Print, followed by a newline"
+  (apply pr a)
+  (newline))
+
+(define (false? x)
+  (not (eq? #t x)))
+
+(define (true? x)
+  (eq? #t x))
+
+(define (some? a)
+  (not (null? a)))
+
+(define (empty? a)
+  (equal? a '()))
+
+(define (ffirst a)
+  (first (first a)))
+
+(define (rest a)
+  "Returns a list of the items after the first."
+  (cdr a))
+
+(define (last coll)
+  "Return the last time in coll, in linear time."
+  (if (second coll)
+      (last (rest coll))
+      (first coll)))
+
+(define (butlast ls)
+  "Return everthing execpt the last element in ls."
+  (let ((len (length ls)))
+    (list-head ls (- len 1))))
+
+;; Ignores body, returns '().
+(define-syntax comment
+  (syntax-rules ()
+    ((_ ...) '())))
+
+(define (some pred coll)
+  (or (pred (first coll))
+      (some pred (second coll))))
+
+(define comp compose)
+
+(define (not-any? pred coll)
+  (comp not some))
+
+(define (printf . args)
+  (display (apply format args)))
+
+(define-syntax fmt
+  (syntax-rules ()
+    ((_ s args ...)
+     (format #f s args ...))))
+
+(define-syntax fn
+  (syntax-rules ()
+    ((_ args body ...)
+     (lambda args body ...))))
+
+(define-syntax ->
+  (syntax-rules ()
+    [(_ a) a]
+    [(_ a (b c ...))
+     (b a c ...)]
+    [(_ a b)
+     (-> a (b))]
+    [(_ a b c ...)
+     (-> (-> a b) c ...)]))
+
+(define-syntax ->>
+  (syntax-rules ()
+    [(_ a) a]
+    [(_ a (b ...))
+     (b ... a)]
+    [(_ a b)
+     (b a)]
+    [(_ a b c ...)
+     (->> (->> a b) c ...)]))
+
+;; Shen-like lambda
+(define-syntax /.
+  (syntax-rules ()
+    [(/. a b)
+     (lambda (a) b)]
+    [(/. a ... b)
+     (lambda (a ...) b)]
+    [(/. a ... (b ...))
+     (lambda (a ...) (b ...))]))
+
+(define (inc a) (+ a 1))
+(define (dec a) (- a 1))
+
+(define* (repeat a #:optional (n 10))
+  (do ((i 1 (inc i)))
+      ((> i n))
+    a))
+
+(define-syntax if-let
+  (syntax-rules ()
+    [(_ (binding value) then else)
+     (let ([binding value])
+       (if binding then else))]))
+
+(define-syntax when-let
+  (syntax-rules ()
+    [(_ (binding value) body ...)
+     (when binding body ...)]))
+
+
+;; source utils
+
+(define (skip-lines port n)
+  (cond
+   ((zero? n) port)
+   (else (read-line port) (skip-lines port (1- n)))))
+
+(define (get-source* source pname)
+  (let* ([file (source:file source)]
+         [filename (any (fn (x)
+                            (let ((f (string-append x "/" file)))
+                              (if (file-exists? f) f #f)))
+                        %load-path)]
+         [re (make-regexp (format #f "\\(define (~a|\\(~a.*\\))" pname pname))]
+         [read-between (lambda (in start end)
+                         (seek in 0 SEEK_SET)
+                         (skip-lines in (1- start))
+                         (call-with-output-string
+                           (lambda (out)
+                             (let self ((line (read-line in))
+                                        (cur start))
+                               (cond
+                                [(or (eof-object? line) (> cur end))
+                                 (close in)]
+                                [else
+                                 (format out "~a~%" line)
+                                 (self (read-line in) (inc cur))])))))])
+    (call-with-input-file filename
+      (lambda (in)
+        (let self ((line (read-line in)))
+          (cond
+           [(eof-object? line) #f]
+           [(regexp-exec re line)
+            (unread-string line in)
+            (let*  ((start (port-line in))
+                    (end (begin (read in) (port-line in))))
+              (read-between in start (inc end)))]
+           [else
+            (self (read-line in))]))))))
+
+(define (get-source p)
+  "Get the source of a procedure as a string."
+  (let ((psrc (program-source p 0)))
+    (cond
+     [(not psrc) (fmt "<~a: compiled C procedure>\n" p)]
+     [(not (source:file psrc)) #f]
+     [else (get-source* psrc (symbol->string (procedure-name p)))])))
+
+(define (source p)
+  "Print the source of a procedure."
+  (pr (get-source p)))
+
+(define member? member)
+
+(define (contains? ls x)
+  (member? x ls))
+
+(define (turn ls f)
+  (map f ls))
+
+(define (seq x)
+  (if (list? x)
+      x
+      (list x)))
+
+;; is this not in srfi-1?
+(define (flatten x)
+  (cond ((null? x) '())
+        ((pair? x) (append (flatten (car x)) (flatten (cdr x))))
+        (else (list x))))
diff --git a/bs/dict.scm b/bs/dict.scm
new file mode 100644
index 0000000..ac55ba7
--- /dev/null
+++ b/bs/dict.scm
@@ -0,0 +1,50 @@
+#!r6rs
+;; Experimental python-like dictionary.  Import this qualified, eg:
+;;     (import (prefix (dict) dict/))
+;; or
+;;     (import (prefix (dict) dict.))
+(library (bs dict (2))
+  (export
+   empty new dict dict? keys vals contains?
+   set get del update map)
+  (import
+    (rnrs base)
+    (srfi srfi-69))
+
+  (define (empty)
+    (make-hash-table))
+
+  (define (new tuples)
+    (let ([dict (make-hash-table)])
+      (map (lambda (k . v) (hash-table-set! dict k v)) tuples)
+      dict))
+
+  (define (dict? dict)
+    (hash-table? dict))
+
+  (define (keys dict)
+    (hash-table-keys dict))
+
+  (define (vals dict)
+    (hash-table-values dict))
+
+  (define (len dict)
+    (hash-table-size dict))
+
+  (define (contains? dict key)
+    (hash-table-exists? dict key))
+
+  (define (set dict key value)
+    (hash-table-set! dict key value))
+
+  (define (get dict key)
+    (hash-table-ref dict key #f))
+
+  (define (del dict key)
+    (hash-table-delete! dict key))
+
+  (define (update dict key func)
+    (hash-table-update! dict key func (lambda () '())))
+
+  (define (map func dict)
+    (hash-table-walk dict func)))
diff --git a/bs/logic.scm b/bs/logic.scm
new file mode 100644
index 0000000..1e25b1c
--- /dev/null
+++ b/bs/logic.scm
@@ -0,0 +1,239 @@
+;; my mini kanren impl - basically untested so far
+;; TODO: https://github.com/webyrd/faster-miniKanren
+
+(define-module (bs logic))
+
+(define-syntax λg
+  (syntax-rules ()
+    ((_ (s) e) (lambda (s) e))))
+
+(define-syntax λf
+  (syntax-rules ()
+    ((_ () e) (lambda () e))))
+
+(define (unify u v s)
+  (let ([u (walk u s)]
+        [v (walk v s)])
+    (cond
+     [(eq? u u) s]
+
+     [(var? u)
+      (cond
+       [(var? v) (ext-s-check u v s)]
+       [else (ext-s-check u v s)])]
+
+     [(and (pair? u) (pair? v))
+      (let ([s (unify (car u) (car v) s)])
+        (and s (unify (cdr u) (cdr v) s)))]
+
+     [(equal? u v) s]
+
+     [else #f])))
+
+(define-syntax if-not
+  (syntax-rules ()
+    ((_ pred then else)
+     (if (not pred) then else))))
+
+(define (walk v s)
+  (if-not (var? v)
+      v
+    (let ([a (assq v s)])
+      (if a
+          (walk (cdr a) s)
+          v))))
+
+(define (ext-s-check x v s)
+  (if-not (occurs-check x v s)
+      (ext-s x v s)
+    #f))
+
+(define (occurs-check x v s)
+  (let ([v (walk v s)])
+    (cond
+     [(var? v) (eq? v x)]
+     [(pair? v)
+      (or (occurs-check x (car v) s)
+          (occurs-check x (cdr v) s))]
+     [else #f])))
+
+(define (ext-s x v s)
+  (cons `(,x . ,v) s))
+
+(define empty-s '())
+
+(define var vector)
+(define var? vector?)
+
+(define reify
+  (letrec ([reify-s (lambda [v s]
+                      (let ([v (walk v s)])
+                        (cond
+                         [(var? v) (ext-s v (reify-name (length s)) s)]
+                         [(pair? v) (reify-s (cdr v) (reify-s (car v) s))]
+                         [else s])))])
+    (lambda [v s]
+      (let ([v (walk* v s)])
+        (walk* v (reify-s v empty-s))))))
+
+(define walk*
+  (lambda [w s]
+    (let ([v (walk w s)])
+      (cond
+       [(var? v) v]
+       [(pair? v) (cons (walk* (car v) s)
+                        (walk* (cdr v) s))]
+       [else v]))))
+
+(define reify-name
+  (lambda [n]
+    (string->symbol
+     (string-append "_" "." (number->string n)))))
+
+(define-syntax mzero
+  (syntax-rules ()
+    ((_) #f)))
+
+(define-syntax unit
+  (syntax-rules ()
+    ((_ a) a)))
+
+(define-syntax choice
+  (syntax-rules ()
+    ((_ a f) (cons a f))))
+
+(define-syntax inc
+  (syntax-rules ()
+    ((_ e) (λf () e))))
+
+(define-syntax case-inf
+  (syntax-rules ()
+    ((_ e on-zero
+        [(a^) on-one]
+        [(a f) on-choice]
+        [(f^) on-inc])
+     (let ([a-inf e])
+       (cond
+        ;; a-inf = #f
+        [(not a-inf) on-zero]
+        ;; a-inf = lambda
+        [(procedure? a-inf) (let ((f^ a-inf)) on-inc)]
+        ;; a-inf = (x . lambda)
+        [(and (pair? a-inf) (procedure? (cdr a-inf)))
+         (let ([a (car a-inf)]
+               [f (cdr a-inf)])
+           on-choice)]
+        [else (let ((a^ a-inf)) on-one)])))))
+
+(define-syntax ==
+  (syntax-rules ()
+    ((_ u v)
+     (λg (s) (unify u v s)))))
+
+(define-syntax conde
+  (syntax-rules ()
+    ((_ (g0 g ...) (g1 g^ ...) ...)
+     (λg (s)
+         (inc (mplus*
+               (bind* (g0 s) g ...)
+               (bind* (g1 s) g^ ...) ...))))))
+
+(define-syntax mplus*
+  (syntax-rules ()
+    ((_ e) e)
+    ((_ e0 e ...) (mplus e0 (λf () (mplus* e ...))))))
+
+(define mplus
+  (lambda (a-inf f)
+    (case-inf a-inf (f)
+              ((a) (choice a f))
+              ((a f^) (choice a (λf () (mplus (f) f^))))
+              ((f^) (inc (mplus (f) f^))))))
+
+(define-syntax fresh
+  (syntax-rules ()
+    ((_ (x ...) g0 g ...)
+     (λg (s)
+         (let ((x (var 'x)) ...)
+           (bind* (g0 s) g ...))))))
+
+(define-syntax bind*
+  (syntax-rules ()
+    ((_ e) e)
+    ((_ e g0 g ...)
+     (let ((a-inf e))
+       (and a-inf (bind* (bind a-inf g0) g ...))))))
+
+(define bind
+  (lambda (a-inf g)
+    (case-inf a-inf (mzero)
+              ((a) (g a))
+              ((a f) (mplus (g a) (λf () (bind (f) g))))
+              ((f) (inc (bind (f) g))))))
+
+(define-syntax run
+  (syntax-rules ()
+    ((_ n (x) g0 g^ ...)
+     (take n
+           (λf
+            ()
+            (let ((g (fresh
+                      (x)
+                      (λg
+                       (s)
+                       (bind* (g0 s) g^ ...
+                              (λg (s)
+                                  (list (reify x s))))))))
+              (g empty-s)))))))
+
+(define-syntax run*
+  (syntax-rules ()
+    ((_ (x) g ...) (run #f (x) g ...))))
+
+(define take
+  (lambda (n f)
+    (if (and n (zero? n))
+        '()
+        (case-inf (f) '()
+                  [(a) a]
+                  [(a f) (cons (car a) (take (and n (- n 1)) f))]
+                  [(f) (take n f)]))))
+
+(define-syntax conda
+  (syntax-rules ()
+    ((_ (g0 g ...) (g1 g^ ...) ...)
+     (λg (s)
+         (if* (picka (g0 s) g ...) (picka (g1 s) g^ ...) ...)))))
+
+(define-syntax condu
+  (syntax-rules ()
+    ((_ (g0 g ...) (g1 g^ ...) ...)
+     (λg (s)
+         (if* (picku (g0 s) g ...)
+              (picku (g1 s) g^ ...)
+              ...)))))
+
+(define-syntax if*
+  (syntax-rules ()
+    ((_) (mzero))
+    ((_ (pick e g ...) b ...)
+     (let loop ((a-inf e))
+       (case-inf a-inf (if* b ...)
+                 [(a) (bind* a-inf g ...)]
+                 [(a f) (bind* (pick a a-inf) g ...)]
+                 [(f) (inc (loop (f)))])))))
+
+(define-syntax picka
+  (syntax-rules ()
+    ((_ a a-inf) a-inf)))
+
+(define-syntax picku
+  (syntax-rules ()
+    ((_ a a-inf) (unit a))))
+
+(define-syntax project
+  (syntax-rules ()
+    ((_ (x ...) g0 g ...)
+     (λg (s)
+         (let ((x (walk* x s)) ...)
+           (bind* (g0 s) g ...))))))
diff --git a/bs/re.scm b/bs/re.scm
new file mode 100644
index 0000000..6ecc074
--- /dev/null
+++ b/bs/re.scm
@@ -0,0 +1,11 @@
+#!r6rs
+(library (bs re (0))
+  (export match group)
+  (import (rnrs base (6))
+          (ice-9 regex))
+  (define (match s pat)
+    (string-match pat s))
+  (define (group m n)
+    (if m
+        (match:substring m n)
+        #f)))
diff --git a/bs/repl.scm b/bs/repl.scm
new file mode 100644
index 0000000..3932433
--- /dev/null
+++ b/bs/repl.scm
@@ -0,0 +1,17 @@
+(define-module (bs repl))
+;; (use-modules (system repl common))
+;; (repl-default-option-set!
+;;  'prompt
+;;  (lambda (repl)
+;;    (format #f "\n[~a@~a:~a]\nλ> "
+;;            (getenv "USER")
+;;            (vector-ref (uname) 1)
+;;            (pwd))))
+
+;; TODO(bsima): (doc x)
+
+(eval-when (compile load eval)
+  (define-meta-command ((src nala) repl (form))
+    "Print source code of specified Scheme procedure."
+    (call-with-values (repl-prepare-eval-thunk repl (repl-parse repl form))
+      (lambda args (for-each print-src args)))))
diff --git a/bs/shell.scm b/bs/shell.scm
new file mode 100644
index 0000000..8578f72
--- /dev/null
+++ b/bs/shell.scm
@@ -0,0 +1,32 @@
+(define-module (bs shell)
+  #:use-module ((ice-9 popen) #:prefix popen/)
+  #:use-module ((ice-9 rdelim) #:prefix rdelim/)
+  #:use-module ((ice-9 ftw) #:prefix ftw/)
+  #:export (exec
+            stream
+            pwd
+            ls
+            cd))
+
+(define (exec cmd)
+  (let* ((port (popen/open-input-pipe cmd))
+         (ret (read port)))
+    (popen/close-pipe port)
+    ret))
+
+(define (stream cmd)
+  (let* ((port (popen/open-input-pipe cmd))
+         (_ (setvbuf port 'none))
+         (ret (rdelim/read-string port)))
+    (flush-all-ports)
+    (popen/close-pipe port)
+    ret))
+
+(define pwd getcwd)
+
+(define (ls)
+  (ftw/scandir (getcwd)))
+
+(define (cd path)
+  (chdir path)
+  (ls))
diff --git a/bs/string.scm b/bs/string.scm
new file mode 100644
index 0000000..b12bf00
--- /dev/null
+++ b/bs/string.scm
@@ -0,0 +1,72 @@
+(define-module (bs string)
+  #:export (replace replace-char to-string str capitalize split
+                    strip lstrip rstrip))
+
+(define (split s c)
+  (if s
+      (string-split s c)
+      #f))
+
+(define (replace-char s match repl)
+  (let ((f (lambda (a b)
+             (let ((next-char (if (eq? a match) repl a)))
+               (string-concatenate (list b (string next-char)))))))
+    (string-fold f "" s)))
+
+(define (replace s match repl)
+  (string-replace-substring s match repl))
+
+(define (to-string x)
+  (format #f "~a" x))
+
+(define str
+  (case-lambda
+    (() "")
+    ((x) (to-string x))
+    ((x . rest) (string-concatenate (map str (cons x rest))))))
+
+(define (capitalize s)
+  (let ((s (to-string s)))
+    (if (< (string-length s) 2)
+        (string-upcase s)
+        (str (string-upcase (substring s 0 1))
+             (substring s 1 )))))
+
+(define (strip s char)
+  (string-trim-both s char))
+
+(define (lstrip s char)
+  (string-trim s char))
+
+(define (rstrip s char)
+  (string-trim-right s char ))
+
+
+;;; {String Fun: string-replace-substring}
+;;;
+
+;; string-replace-substring By A. Wingo in
+;; https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00058.html
+;; also in string-replace-substring guix:guix/utils.scm.
+
+(define (string-replace-substring str substring replacement)
+  "Return a new string where every instance of @var{substring} in string
+   @var{str} has been replaced by @var{replacement}. For example:
+
+   @lisp
+   (string-replace-substring \"a ring of strings\" \"ring\" \"rut\")
+   @result{} \"a rut of struts\"
+   @end lisp
+   "
+  (let ((sublen (string-length substring)))
+    (with-output-to-string
+      (lambda ()
+        (let lp ((start 0))
+          (cond
+           ((string-contains str substring start)
+            => (lambda (end)
+                 (display (substring/shared str start end))
+                 (display replacement)
+                 (lp (+ end sublen))))
+           (else
+            (display (substring/shared str start)))))))))
diff --git a/bs/test.scm b/bs/test.scm
new file mode 100644
index 0000000..9152760
--- /dev/null
+++ b/bs/test.scm
@@ -0,0 +1,16 @@
+;; a testing framework for scheme
+;; inspired by clojure.test and srfi-64
+
+(define-module (bs test)
+  #:use-module ((bs core)
+                #:select (prn))
+  #:export (testing))
+
+;; TODO: learn srfi-64
+;; TODO: port over `deftest' et al from clojure
+;; TODO: someday a quickcheck-like would be best
+
+;; simple analog to clojure's `testing'
+(define-syntax testing
+  ((_ description ...)
+   ((begin (prn description) ...))))
diff --git a/dict.scm b/dict.scm
deleted file mode 100644
index 564b1ae..0000000
--- a/dict.scm
+++ /dev/null
@@ -1,50 +0,0 @@
-#!r6rs
-;; Experimental python-like dictionary.  Import this qualified, eg:
-;;     (import (prefix (dict) dict/))
-;; or
-;;     (import (prefix (dict) dict.))
-(library (dict (2))
-  (export
-   empty new dict dict? keys vals contains?
-   set get del update map)
-  (import
-    (rnrs base)
-    (srfi srfi-69))
-
-  (define (empty)
-    (make-hash-table))
-
-  (define (new tuples)
-    (let ([dict (make-hash-table)])
-      (map (lambda (k . v) (hash-table-set! dict k v)) tuples)
-      dict))
-
-  (define (dict? dict)
-    (hash-table? dict))
-
-  (define (keys dict)
-    (hash-table-keys dict))
-
-  (define (vals dict)
-    (hash-table-values dict))
-
-  (define (len dict)
-    (hash-table-size dict))
-
-  (define (contains? dict key)
-    (hash-table-exists? dict key))
-
-  (define (set dict key value)
-    (hash-table-set! dict key value))
-
-  (define (get dict key)
-    (hash-table-ref dict key #f))
-
-  (define (del dict key)
-    (hash-table-delete! dict key))
-
-  (define (update dict key func)
-    (hash-table-update! dict key func (lambda () '())))
-
-  (define (map func dict)
-    (hash-table-walk dict func)))
diff --git a/re.scm b/re.scm
deleted file mode 100644
index f6f4b75..0000000
--- a/re.scm
+++ /dev/null
@@ -1,11 +0,0 @@
-#!r6rs
-(library (re (0))
-  (export match group)
-  (import (rnrs base (6))
-          (ice-9 regex))
-  (define (match s pat)
-    (string-match pat s))
-  (define (group m n)
-    (if m
-        (match:substring m n)
-        #f)))
diff --git a/z.scm b/z.scm
index b8bcbfe..dd091c6 100644
--- a/z.scm
+++ b/z.scm
@@ -1,13 +1,13 @@
-(import (Alpha Core))
-(import (prefix (Alpha String) string.))
+(import (bs core))
+(import (prefix (bs dict) dict.))
+(import (prefix (bs re) re.))
+(import (prefix (bs string) string.))
 (import (srfi srfi-1))
 (import (sxml simple))
 (import (oop goops))
 (import (ice-9 peg))
 (import (only (srfi srfi-19) date->string current-date))
 (import (only (ice-9 match) match match-lambda))
-(import (prefix (dict) dict.))
-(import (prefix (re) re.))
 (import (prefix (web server) http.))
 (import (prefix (web request) http.req.))
 (import (prefix (web response) http.res.))
-- 
cgit v1.2.3