Move C and Scheme code into subdirs.

1 files changed, 0 insertions, 168 deletions

diff --git a/util.scm b/util.scm
deleted file mode 100644
index 6f1b955a..00000000
--- a/util.scm
+++ /dev/null
@@ -1,168 +0,0 @@
-(define-module (util)
-  #:use-module (srfi srfi-1)
-  #:use-module ((sxml fold) #:select (fold-values))
-  #:export (destructure-lambda let-multi fold-lists catch-let
-                               for-each-in
-                               define-quick-record define-quick-record!
-                               mod! sort* sort*!
-                               find-min)
-  #:replace (let*)
-  )
-
-(define-public upstring->symbol (compose string->symbol string-upcase))
-
-(define-public symbol-upcase (compose string->symbol string-upcase symbol->string))
-
-(define-public symbol-downcase (compose string->symbol string-downcase symbol->string))
-
-(define-syntax destructure-lambda
-  (syntax-rules ()
-    ((_ expr-list body ...)
-     (lambda (expr)
-       (apply (lambda expr-list body ...) expr)))))
-
-(define-syntax catch-let
-  (syntax-rules ()
-    ((_ thunk ((type handler) ...))
-     (catch #t thunk
-       (lambda (err . args)
-         (case err
-           ((type) (apply handler err args)) ...
-           (else (format #t "Unhandled error type ~a, rethrowing ~%" err)
-                 (apply throw err args))))))))
-
-;;; For-each with arguments in reverse order.
-(define-syntax-rule (for-each-in lst proc)
-  (for-each proc lst))
-
-
-;;; Helper macros to make define-quick-record better
-
-(define (class-name symb) (symbol-append '< symb '>))
-(define (constructor symb) (symbol-append 'make- symb))
-(define (pred symb) (symbol-append symb '?))
-
-(define (getter name symb) (symbol-append 'get- name '- symb))
-(define* (setter name symb #:optional bang?)
-  (symbol-append 'set- name '- symb (if bang? '! (symbol))))
-
-(define (%define-quick-record internal-define bang? name fields)
-  (let ((symb (gensym)))
-    `((,internal-define ,(class-name name)
-             (,(constructor name) ,@fields)
-             ,(pred name)
-             ,@(map (lambda (f) `(,f ,(getter f symb) ,(setter f symb bang?)))
-                    fields))
-            ,@(map (lambda (f) `(define ,f (make-procedure-with-setter
-                                       ,(getter f symb) ,(setter f symb bang?))))
-                   fields))))
-
-;;; Creates srfi-9 define{-immutable,}-record-type declations.
-;;; Also creates srfi-17 accessor ((set! (access field) value))
-
-;; (define (define-quick-record-templated define-proc name field))
-
-(define-macro (define-quick-record name . fields)
-  (let ((public-fields  (or (assoc-ref fields #:public)  '()))
-        (private-fields (or (assoc-ref fields #:private) '())))
-    `(begin
-       ,@(%define-quick-record '(@ (srfi srfi-9 gnu) define-immutable-record-type)
-                               #f name
-                               (append public-fields private-fields))
-       ,@(map (lambda (field) `(export ,field))
-              public-fields))))
-  ;; (define-quick-record-templated 'define-immutable-record-type name fields))
-
-;; (define-macro (define-quick-record! name . fields)
-;;   (define-quick-record-templated 'define-record-type name fields))
-
-;; Replace let* with a version that can bind from lists.
-;; Also supports SRFI-71 (extended let-syntax for multiple values)
-;; @lisp
-;; (let* ([a b (values 1 2)]               ; @r{SRFI-71}
-;;        [(c d) '(3 4)]                   ; @r{Let-list (mine)}
-;;        [e 5])                           ; @r{Regular}
-;;   (list e d c b a))
-;; ;; => (5 4 3 2 1)
-;; @end lisp
-(define-syntax let*
-  (syntax-rules ()
-
-    ;; Base case
-    [(_ () body ...)
-     (begin body ...)]
-
-    ;; (let (((a b) '(1 2))) (list b a)) => (2 1)
-    [(_ (((k k* ...) list-value) rest ...)
-        body ...)
-     (apply (lambda (k k* ...)
-              (let* (rest ...)
-                    body ...))
-            list-value)]
-
-    ;; "Regular" case
-    [(_ ((k value) rest ...) body ...)
-     (let ((k value))
-       (let* (rest ...)
-         body ...))]
-
-    ;; SRFI-71 let-values
-    [(_ ((k k* ... values) rest ...) body ...)
-     (call-with-values (lambda () values)
-       (lambda (k k* ...)
-         (let* (rest ...)
-           body ...)))]
-
-    ))
-
-;; Like set!, but applies a transformer on the already present value.
-(define-syntax-rule (mod! field transform-proc)
-  (set! field (transform-proc field)))
-
-(define-public (concat lists)
-  (apply append lists))
-
-;; This function borrowed from web-ics (calendar util)
-(define* (sort* items comperator #:optional (get identity))
-  "A sort function more in line with how python's sorted works"
-  (sort items (lambda (a b)
-                (comperator (get a)
-                            (get b)))))
-
-;;; This function borrowed from web-ics (calendar util)
-(define* (sort*! items comperator #:optional (get identity))
-  "A sort function more in line with how python's sorted works"
-  (sort! items (lambda (a b)
-                 (comperator (get a)
-                             (get b)))))
-
-;; Finds the smallest element in @var{items}, compared with @var{<} after
-;; applying @var{foo}. Returns 2 values. The smallest item in @var{items},
-;; and the other items in some order.
-(define (find-min < ac items)
-  (if (null? items)
-      ;; Vad fan retunerar man här?
-      (values #f '())
-      (fold-values
-       (lambda (c min other)
-         (if (< (ac c) (ac min))
-             ;; Current stream head is smaller that previous min
-             (values c (cons min other))
-             ;; Previous min is still smallest
-             (values min (cons c other))))
-       (cdr items)
-       ;; seeds:
-       (car items) '())))
-
-(define-public (filter-sorted proc list)
-  (take-while
-   proc (drop-while
-         (negate proc) list)))
-
-;; (define (!= a b) (not (= a b)))
-(define-public != (negate =))
-
-(define-public (take-to lst i)
-  "Like @var{take}, but might lists shorter than length."
-  (if (> i (length lst))
-      lst (take lst i)))