* added an (ikarus system $bytevectors) library
This commit is contained in:
		
							parent
							
								
									97f59ad1ee
								
							
						
					
					
						commit
						9d3e23fb6d
					
				
							
								
								
									
										
											BIN
										
									
								
								src/ikarus.boot
								
								
								
								
							
							
						
						
									
										
											BIN
										
									
								
								src/ikarus.boot
								
								
								
								
							
										
											Binary file not shown.
										
									
								
							|  | @ -126,6 +126,12 @@ | |||
|     [$string-length     1   value] | ||||
|     [$string-ref        2   value] | ||||
|     [$string-set!       3   effect] | ||||
|     ;;; bytevectors | ||||
|     [bytevector?        1   pred] | ||||
|     [$make-bytevector   1   value] | ||||
|     [$bytevector-length 1   value] | ||||
|     [$bytevector-ref    2   value] | ||||
|     [$bytevector-set!   3   effect] | ||||
|     ;;; symbols | ||||
|     [$make-symbol       1   value] | ||||
|     [$symbol-value      1   value] | ||||
|  |  | |||
|  | @ -117,6 +117,7 @@ | |||
|     [$chars      (ikarus system $chars)       #f] | ||||
|     [$strings    (ikarus system $strings)     #f] | ||||
|     [$vectors    (ikarus system $vectors)     #f] | ||||
|     [$bytes      (ikarus system $bytevectors) #f] | ||||
|     [$fx         (ikarus system $fx)          #f] | ||||
|     [$symbols    (ikarus system $symbols)     #f] | ||||
|     [$records    (ikarus system $records)     #f] | ||||
|  | @ -130,6 +131,7 @@ | |||
|     [$boot       (ikarus system $bootstrap)   #f] | ||||
|     )) | ||||
| 
 | ||||
| 
 | ||||
| (define bootstrap-collection | ||||
|   (let ([ls (map  | ||||
|               (lambda (x)  | ||||
|  | @ -469,6 +471,14 @@ | |||
|     [$string-set!       $strings] | ||||
|     [$string-length     $strings] | ||||
|    | ||||
|     [bytevector?        i] | ||||
| 
 | ||||
|     [$make-bytevector   $bytes] | ||||
|     [$bytevector-length $bytes] | ||||
|     [$bytevector-ref    $bytes] | ||||
|     [$bytevector-set!   $bytes] | ||||
| 
 | ||||
| 
 | ||||
|     [$make-vector       $vectors] | ||||
|     [$vector-length     $vectors] | ||||
|     [$vector-ref        $vectors] | ||||
|  |  | |||
|  | @ -0,0 +1,7 @@ | |||
| #!/usr/bin/env ikarus --r6rs-script | ||||
| 
 | ||||
| (import (ikarus) | ||||
|         (tests bytevectors)) | ||||
| 
 | ||||
| (test-bytevectors) | ||||
| (printf "Happy Happy Joy Joy\n") | ||||
|  | @ -0,0 +1,23 @@ | |||
| 
 | ||||
| (library (tests bytevectors) | ||||
|   (export test-bytevectors) | ||||
|   (import (ikarus) (tests framework)) | ||||
| 
 | ||||
|   (define (not-byte-vector? x)  | ||||
|     (not (bytevector? x))) | ||||
| 
 | ||||
|   (define-tests test-bytevectors | ||||
|     [bytevector? (make-bytevector 1)] | ||||
|     [bytevector? (make-bytevector 1 17)] | ||||
|     [bytevector? (make-bytevector 10 -17)] | ||||
|     [not-bytevector? 'foo]  | ||||
|     [not-bytevector? "hey"]  | ||||
|     [not-bytevector? (current-output-port)]  | ||||
|     [not-bytevector? (current-input-port)]  | ||||
|     [not-bytevector? '#(2837 2398 239)]  | ||||
|     )) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
|  | @ -0,0 +1,15 @@ | |||
| 
 | ||||
| (library (tests framework) | ||||
|   (export define-tests) | ||||
|   (import (ikarus)) | ||||
|   (define-syntax define-tests | ||||
|     (syntax-rules () | ||||
|       [(_ test-all [p0 e0] ...) | ||||
|        (define test-all | ||||
|          (lambda () | ||||
|            (let ([p p0] [e e0]) | ||||
|              (unless (p e) | ||||
|                (error 'test-all "~s failed, got ~s"  | ||||
|                       '(p0 e0) e)))  | ||||
|            ... | ||||
|            (printf "[~s] Happy Happy Joy Joy\n" 'test-all)))]))) | ||||
		Loading…
	
		Reference in New Issue
	
	 Abdulaziz Ghuloum
						Abdulaziz Ghuloum