Update for Shen 13

CHANGELOG

@@ -1,3 +1,13 @@
+0.6
+
+	* Works with Shen 13.
+
+	* Update the 'open' procedure.
+
+	* Add 'write-byte' procedure.
+
+	* Remove 'pr' procedure.
+
 0.5
 
 	* Works with Shen 9

init.scm

@@ -1,6 +1,6 @@
 (set ($$quote *language*) "Scheme")
 (set ($$quote *implementation*) "chibi-scheme")
-(set ($$quote *port*) "0.5")
+(set ($$quote *port*) "0.6")
 (set ($$quote *porters*) "Bruno Deferrari")
 (set ($$quote *stinput*) ($$current-input-port))
 (set ($$quote *stoutput*) ($$current-output-port))

shen.sld

@@ -34,8 +34,8 @@
      (kl:<-address        <-address)
      (kl:address->        address->)
      (kl:absvector?       absvector?)
-     (kl:pr               pr)
      (kl:read-byte        read-byte)
+     (kl:write-byte       write-byte)
      (kl:open             open)
      (kl:close            close)
      (kl:get-time         get-time)
@@ -62,7 +62,7 @@
 
   (include "init.scm")
 
-  (begin      
+  (begin
     ($$define ($$eval-kl-file filename)
       ($$for-each $$display ($$list "Loading " filename " ...\n"))
       ($$for-each eval-kl ($$read-kl-file filename)))

shen/primitives.scm

@@ -235,23 +235,17 @@
 ;; Streams and I/O
 ;;
 
-(define (kl:pr string out)
-  (display string out)
-  string)
-
 (define kl:read-byte read-u8)
+(define kl:write-byte write-u8)
 
-(define (kl:open type filename direction)
-  (case type
-    ((file)
-     (let ((full-path (full-path-for-file filename)))
-       (case direction
-         ((in) (if (file-exists? full-path)
-                   (open-input-file full-path)
-                   (error "File does not exist" full-path)))
-         ((out) (open-output-file full-path))
-         (else (error "Invalid direction" direction)))))
-    (else (error "Invalid stream type" type))))
+(define (kl:open filename direction)
+  (let ((full-path (full-path-for-file filename)))
+    (case direction
+      ((in) (if (file-exists? full-path)
+                (open-input-file full-path)
+                (error "File does not exist" full-path)))
+      ((out) (open-output-file full-path))
+      (else (error "Invalid direction" direction)))))
 
 (define (kl:close stream)
   (cond
@@ -315,8 +309,8 @@
        (<-address ,kl:<-address)
        (address-> ,kl:address->)
        (absvector? ,kl:absvector?)
-       (pr ,kl:pr)
        (read-byte ,kl:read-byte)
+       (write-byte ,kl:write-byte)
        (open ,kl:open)
        (close ,kl:close)
        (get-time ,kl:get-time)
@@ -341,26 +335,21 @@
         (initialize-arity-table (cddr entries)))))
 
 (initialize-arity-table
- '(adjoin 2 and 2 append 2 arity 1 assoc 2 boolean? 1 cd 1 compile 3 concat 2 cons 2
-   cons? 1 cn 2 declare 2 destroy 1 difference 2 do 2 element? 2 empty? 1
-   enable-type-theory 1 interror 2 eval 1 eval-kl 1 explode 1
-   external 1 fail-if 2 fail 0 fix 2 findall 5 freeze 1 fst 1 gensym 1 get 3
-   address-> 3 <-address 2 <-vector 2 > 2
-   >= 2 = 2 hd 1 hdv 1 hdstr 1 head 1 if 3 integer? 1 identical 4 inferences 1
-   intoutput 2 make-string 2 intersection 2 length 1 lineread 0 load 1 < 2 <= 2
-   vector 1 macroexpand 1 map 2 mapcan 2 intmake-string 2
-   maxinferences 1 not 1 nth 2 n->string 1 number? 1 output 2 occurs-check 1
-   occurrences 2 occurs-check 1 or 2 package 3 pos 2 print 1 profile 1
-   profile-results 1 ps 1 preclude 1 preclude-all-but 1 protect 1 address-> 3
-   put 4 reassemble 2 read-file-as-string 1 read-file 1 read-byte 1 remove 2
-   reverse 1 set 2 simple-error 1 snd 1 specialise 1
-   spy 1 step 1 stinput 1 stoutput 1 string->n 1 string? 1 strong-warning 1
-   subst 3 symbol? 1 tail 1 tl 1 tc 1 tc? 1 thaw 1
-   track 1 trap-error 2 tuple? 1 type 1 return 3 unprofile 1 unify 4 unify! 4
-   union 2 untrack 1 unspecialise 1 vector 1
-   vector-> 3 value 1 variable? 1 version 1 warn 1 write-to-file 2 y-or-n? 1
-   + 2 * 2 / 2 - 2 == 2 <1> 1 <e> 1
-   @p 2 @v 2 @s 2 preclude 1 include 1 preclude-all-but 1 include-all-but 1 where 2))
+ '(absvector 1 adjoin 2 and 2 append 2 arity 1 assoc 2 boolean? 1 cd 1 compile 3 concat 2 cons 2 cons? 1
+   cn 2 declare 2 destroy 1 difference 2 do 2 element? 2 empty? 1 enable-type-theory 1 interror 2 eval 1
+   eval-kl 1 explode 1 external 1 fail-if 2 fail 0 fix 2 findall 5 freeze 1 fst 1 gensym 1 get 3
+   get-time 1 address-> 3 <-address 2 <-vector 2 > 2 >= 2 = 2 hd 1 hdv 1 hdstr 1 head 1 if 3 integer? 1
+   intern 1 identical 4 inferences 0 input 1 input+ 2 implementation 0 intersection 2 kill 0 language 0
+   length 1 lineread 1 load 1 < 2 <= 2 vector 1 macroexpand 1 map 2 mapcan 2 maxinferences 1 not 1 nth 2
+   n->string 1 number? 1 occurs-check 1 occurrences 2 occurs-check 1 optimise 1 or 2 os 0 package 3 port 0
+   porters 0 pos 2 print 1 profile 1 profile-results 0 pr 2 ps 1 preclude 1 preclude-all-but 1 protect 1
+   address-> 3 put 4 reassemble 2 read-file-as-string 1 read-file 1 read 1 read-byte 1 read-from-string 1
+   release 0 remove 2 reverse 1 set 2 simple-error 1 snd 1 specialise 1 spy 1 step 1 stinput 0 stoutput 0
+   string->n 1 string->symbol 1 string? 1 strong-warning 1 subst 3 sum 1 symbol? 1 tail 1 tl 1 tc 1 tc? 0
+   thaw 1 tlstr 1 track 1 trap-error 2 tuple? 1 type 1 return 3 undefmacro 1 unprofile 1 unify 4 unify! 4
+   union 2 untrack 1 unspecialise 1 undefmacro 1 vector 1 vector-> 3 value 1 variable? 1 version 0 warn 1
+   write-byte 2 write-to-file 2 y-or-n? 1 + 2 * 2 / 2 - 2 == 2 <e> 1 @p 2 @v 2 @s 2 preclude 1 include 1
+   preclude-all-but 1 include-all-but 1 where 2))
 
 ;; Kl to Scheme translator
 ;;

shen/primitives.sld

@@ -63,8 +63,8 @@
    kl:<-address
    kl:address->
    kl:absvector?
-   kl:pr
    kl:read-byte
+   kl:write-byte
    kl:open
    kl:close
    kl:get-time