Not logged in
Overview
SHA1 Hash:87847d60e23fb81fe2bb9e7ece6be386aa491838
Date: 2011-01-25 23:43:52
User: crc
Comment:use when combinator
Timelines: family | ancestors | descendants | both | trunk
Other Links: files | Tarball | ZIP archive | manifest
Tags And Properties
Changes
[hide diffs]    [patch]

Modified casket.rx from [6da23be8654f0bd5] to [30d593d59ee72b37].

@@ -17,23 +17,24 @@
   : Content-type:    ( "- )
     "Content-type: " getToken ^strings'append "\n\n" ^strings'append
      keepString .data ` puts ; immediate
   ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
   {{
+    : withBase ( n$q-$ ) [ swap ] dip @base [ do ] dip !base ;
     : char ( $-$ )
-      @+ 'n over = [ drop cr      0 ] ifTrue
-         '' over = [ drop '" putc 0 ] ifTrue
-         '[ over = [ 27 putc putc 0 ] ifTrue
-      0; putc ;
+      @+ [ 'n = ] [ drop cr      ] when
+         [ '' = ] [ drop '" putc ] when
+         [ '[ = ] [ 27 putc putc ] when
+      putc ;
     : obj  ( $-$ )
-      @+ 'd over = [ drop swap @base [ decimal putn ] dip !base 0 ] ifTrue
-         'o over = [ drop swap @base [ octal   putn ] dip !base 0 ] ifTrue
-         'x over = [ drop swap @base [ hex     putn ] dip !base 0 ] ifTrue
-         'c over = [ drop swap putc 0 ] ifTrue
-         's over = [ drop &puts dip 0 ] ifTrue
-         'u over = [ drop casket:url puts 0 ] ifTrue
-      0; putc ;
+      @+ [ 'd = ] [ drop [ decimal putn ] withBase ] when
+         [ 'o = ] [ drop [ octal   putn ] withBase ] when
+         [ 'x = ] [ drop [ hex     putn ] withBase ] when
+         [ 'c = ] [ drop swap putc                 ] when
+         [ 's = ] [ drop &puts dip                 ] when
+         [ 'u = ] [ drop casket:url puts           ] when
+      putc ;
     : complex ( $-n )
       repeat
         @+ 0;
         dup '\ = [ drop char 0 ] ifTrue
         dup '% = [ drop obj  0 ] ifTrue