[ViewVC] Diff of: cvs/microscheme/init.scm

Comparing microscheme/init.scm (file contents):
Revision 1.21 by root, Tue Dec 1 03:56:23 2015 UTC vs.
Revision 1.22 by root, Tue Dec 1 04:57:49 2015 UTC

      (let loop ((n (pred (string-length s))) (l '()))
           (if (= n -1)
                l
                (loop (pred n) (cons (string-ref s n) l)))))
-(define (string-copy str)
+;TODO string-upcase
-     (string-append str))
+;TODO string-downcase
+;TODO string-foldcase
+;TODO string-copy!
+;TODO string-fill!
+(define substring string-copy)
 (define (string->anyatom str pred)
      (let* ((a (string->atom str)))
        (if (pred a) a
          (error "string->xxx: not a xxx" a))))
 (define (char-ci=? a b) (char-ci-cmp? = a b))
 (define (char-ci<? a b) (char-ci-cmp? < a b))
 (define (char-ci>? a b) (char-ci-cmp? > a b))
 (define (char-ci<=? a b) (char-ci-cmp? <= a b))
 (define (char-ci>=? a b) (char-ci-cmp? >= a b))
+(define (digit-value ch)
+  (if (and (char<=? #\0 ch) (char<=? ch #\9))
+    (- (char->integer ch) (char->integer #\0))
+    #f))
+(define char-foldcase char-downcase)
 ; Note the trick of returning (cmp x y)
 (define (string-cmp? chcmp cmp a b)
      (let ((na (string-length a)) (nb (string-length b)))
           (let loop ((i 0))
                               (loop (succ i))))))))
 (define (list->vector x)
      (apply vector x))
+;TODO vector-fill! v e start end
 (define (vector-fill! v e)
      (let ((n (vector-length v)))
           (let loop ((i 0))
                (if (= i n)
                     v
 (define (vector->list v)
      (let loop ((n (pred (vector-length v))) (l '()))
           (if (= n -1)
                l
                (loop (pred n) (cons (vector-ref v n) l)))))
+;TODO vector->string vector start end
+(define (string->vector . args)
+  (list->vector (string->list (apply string-copy args))))
+;TODO vector-copy v s e
+;TODO vector-copy! to at v s e
+(define (vector-append hd . tl)
+  (if (null? tl)
+    hd
+    (list->vector (append (hd (vector->list (vector-append tl)))))))
 ;; The following quasiquote macro is due to Eric S. Tiedemann.
 ;;   Copyright 1988 by Eric S. Tiedemann; all rights reserved.
 ;;
 ;; Subsequently modified to handle vectors: D. Souflis
 (define (throw . x)
      (if (more-handlers?)
           (apply (pop-handler))
           (apply error x)))
+; catch handler thunk
 (macro (catch form)
      (let ((label (gensym)))
           `(call/cc (lambda (exit)
                (push-handler (lambda () (exit ,(cadr form))))
                (let ((,label (begin ,@(cddr form))))
                     (pop-handler)
                     ,label)))))
 (define *error-hook* throw)
+; same as above, r7rs
+(define (with-exception-handler handler thunk)
+  (catch (handler) (thunk)))
+(define (raise-continuable x)
+     (if (more-handlers?)
+          ((pop-handler) x)
+          (error x)))
+(define (raise x)
+  (raise-continuable x)
+  (error "raise: exception handler returned"))
+(with-exception-handler
+  (lambda () (display (list "xerror")))
+  (lambda () (begin (display ("aaa") (raise 5)))))
+;TODO: a lot more is missing, and it doesn't work
 ;;;;; Definition of MAKE-ENVIRONMENT, to be used with two-argument EVAL
 (macro (make-environment form)
      `(apply (lambda ()
 ;(load "macros/syntaxenv.scm")
 ;(load "macros/syntaxrules.scm")
 ;(load "macros/usual.scm")
 ;; r7rs
-; char library
-; string-upcase
-; string-downcase
-; string-foldcase
 ; sring-map, vector-map, string-for-each, vector-for-each
 ; bytevectors
 ;; srfi-1

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing microscheme/init.scm (file contents): Revision 1.21 by root, Tue Dec 1 03:56:23 2015 UTC vs. Revision 1.22 by root, Tue Dec 1 04:57:49 2015 UTC

Diff Legend

Comparing microscheme/init.scm (file contents):
Revision 1.21 by root, Tue Dec 1 03:56:23 2015 UTC vs.
Revision 1.22 by root, Tue Dec 1 04:57:49 2015 UTC