From a04bd7da64005cc17a8ae7b8225b04579e1c76f7 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sat, 2 Nov 2013 21:54:27 -0200 Subject: [PATCH] Update for Shen 13 --- CHANGELOG | 10 ++++++++ init.scm | 2 +- shen.sld | 4 +-- shen/primitives.scm | 61 +++++++++++++++++++-------------------------- shen/primitives.sld | 2 +- 5 files changed, 39 insertions(+), 40 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index e22b836..a708417 100644 --- a/CHANGELOG +++ b/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 diff --git a/init.scm b/init.scm index a0d84c5..c2ca67d 100644 --- a/init.scm +++ b/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)) diff --git a/shen.sld b/shen.sld index 47334cc..5ea6013 100644 --- a/shen.sld +++ b/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))) diff --git a/shen/primitives.scm b/shen/primitives.scm index d22261b..b5d46b1 100644 --- a/shen/primitives.scm +++ b/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 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 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 ;; diff --git a/shen/primitives.sld b/shen/primitives.sld index 17d85d2..40f8413 100644 --- a/shen/primitives.sld +++ b/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