Re-namespace general scheme code to bs

1 files changed, 0 insertions, 221 deletions

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))))