From 23ebe14da02856be9028da413c9ece06a1f92fc5 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 14 Nov 2013 20:41:51 +0900 Subject: [PATCH] support all functions under section 6.6 --- README.md | 4 ++-- piclib/built-in.scm | 42 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index c365391b..b736d00d 100644 --- a/README.md +++ b/README.md @@ -68,8 +68,8 @@ | 6.3 Booleans | yes | | | 6.4 Pairs and lists | yes | | | 6.5 Symbols | yes | | -| 6.6 Characters | incomplete | TODO: almost all functions in the section :-( | -| 6.7 Strings | incomplete | | +| 6.6 Characters | yes | | +| 6.7 Strings | incomplete | TODO: almost all functions in the section :-( | | 6.8 Vectors | incomplete | TODO: `vector-copy`, ...etc | | 6.9 Bytevectors | incomplete | TODO: string<->utf8 conversion, etc | | 6.10 Control features | incomplete | TODO: `string-map`, `vector-map`, ...etc | diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 7c599ce0..fcf8c290 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -274,6 +274,36 @@ ;;; 6.2. Numbers +(define (+ . args) + (do ((acc 0) + (nums args (cdr nums))) + ((pair? nums) acc) + (set! acc (+ acc (car nums))))) + +(define (* . args) + (do ((acc 1) + (nums args (cdr nums))) + ((pair? nums) acc) + (set! acc (* acc (car nums))))) + +;;; so ugly code, must rewrite everything as soon as possible... +(define-macro (define-transitive-predicate op) + `(define (,op . args) + (call/cc + (lambda (exit) + (do ((val (car args)) + (nums (cdr args) (cdr nums))) + ((pair? nums) #t) + (if (,op val (car nums)) + (set! val (car nums)) + (exit #f))))))) + +(define-transitive-predicate =) +(define-transitive-predicate <) +(define-transitive-predicate >) +(define-transitive-predicate <=) +(define-transitive-predicate >=) + (define (floor/ n m) (values (floor-quotient n m) (floor-remainder n m))) @@ -315,6 +345,18 @@ (cdr objs)) #f))) +;;; 6.6 Characters + +(define-macro (define-char-transitive-predicate name op) + `(define (,name . cs) + (apply ,op (map char->integer cs)))) + +(define-char-transitive-predicate char=? =) +(define-char-transitive-predicate char? >) +(define-char-transitive-predicate char<=? <=) +(define-char-transitive-predicate char>=? >=) + ;;; 6.8. Vector (define (vector . objs)