support all functions under section 6.6

This commit is contained in:
Yuichi Nishiwaki 2013-11-14 20:41:51 +09:00
parent 850290dda3
commit 23ebe14da0
2 changed files with 44 additions and 2 deletions

View File

@ -68,8 +68,8 @@
| 6.3 Booleans | yes | | | 6.3 Booleans | yes | |
| 6.4 Pairs and lists | yes | | | 6.4 Pairs and lists | yes | |
| 6.5 Symbols | yes | | | 6.5 Symbols | yes | |
| 6.6 Characters | incomplete | TODO: almost all functions in the section :-( | | 6.6 Characters | yes | |
| 6.7 Strings | incomplete | | | 6.7 Strings | incomplete | TODO: almost all functions in the section :-( |
| 6.8 Vectors | incomplete | TODO: `vector-copy`, ...etc | | 6.8 Vectors | incomplete | TODO: `vector-copy`, ...etc |
| 6.9 Bytevectors | incomplete | TODO: string<->utf8 conversion, etc | | 6.9 Bytevectors | incomplete | TODO: string<->utf8 conversion, etc |
| 6.10 Control features | incomplete | TODO: `string-map`, `vector-map`, ...etc | | 6.10 Control features | incomplete | TODO: `string-map`, `vector-map`, ...etc |

View File

@ -274,6 +274,36 @@
;;; 6.2. Numbers ;;; 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) (define (floor/ n m)
(values (floor-quotient n m) (values (floor-quotient n m)
(floor-remainder n m))) (floor-remainder n m)))
@ -315,6 +345,18 @@
(cdr objs)) (cdr objs))
#f))) #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<=? <=)
(define-char-transitive-predicate char>=? >=)
;;; 6.8. Vector ;;; 6.8. Vector
(define (vector . objs) (define (vector . objs)