Added some new primitive types

svn: r990

collects/swindle/base.ss

@@ -99,7 +99,7 @@
   ;; also -- forbid using :keyword identifiers
   ;; also -- make (define (values ...) ...) a shortcut for define-values (this
   ;;   is just a patch, a full solution should override `define-values', and
-  ;;   also deal with `let...' and `let...-values')
+  ;;   also deal with `let...' and `let...-values' and lambda binders)
   ;; also -- if the syntax is top-level, then translate all defines into a
   ;;   define with (void) followed by a set! -- this is for the problem of
   ;;   defining something that is provided by some module, and re-binding a
@@ -495,7 +495,11 @@
 ;; Keyword utilities
 (provide (rename keyword*? keyword?) syntax-keyword?
          (rename keyword->string* keyword->string)
-         (rename string->keyword* string->keyword))
+         (rename string->keyword* string->keyword)
+         ;; also provide the builtin as `real-keyword'
+         (rename keyword? real-keyword?)
+         (rename keyword->string real-keyword->string)
+         (rename string->keyword string->real-keyword))
 ;;>> (keyword? x)
 ;;>   A predicate for keyword symbols (symbols that begin with a ":").
 ;;>   (Note: this is different from MzScheme's keywords!)

collects/swindle/extra.ss

@@ -186,28 +186,54 @@
     (add-method as (method ([c = to] [x from]) (op x)))))
 
 ;; Add Scheme primitives.
-(add-as-method <symbol>   <string>  symbol->string)
+(for-each
-(add-as-method <string>   <symbol>  string->symbol)
+ (lambda (args)
-(add-as-method <exact>    <inexact> exact->inexact)
+   (apply (lambda (from to . ops)
-(add-as-method <inexact>  <exact>   inexact->exact)
+            (add-as-method from to . ops)
-(add-as-method <number>   <string>  number->string)
+            (let ([from* (cond [(eq? from <string>) <immutable-string>]
-(add-as-method <string>   <number>  string->number)
+                               [(eq? from <bytes>) <immutable-bytes>]
-(add-as-method <char>     <string>  string)
+                               [else #f])])
-(add-as-method <char>     <integer> char->integer)
+              (when from* (add-as-method from* to . ops))))
-(add-as-method <integer>  <char>    integer->char)
+          args))
-(add-as-method <string>   <list>    string->list)
+ `((,<immutable-string> ,<string> ,string-copy)
-(add-as-method <list>     <string>  list->string)
+   (,<string> ,<immutable-string> ,string->immutable-string)
-(add-as-method <vector>   <list>    vector->list)
+   (,<string> ,<symbol> ,string->symbol)
-(add-as-method <list>     <vector>  list->vector)
+   (,<symbol> ,<string> ,symbol->string)
-(add-as-method <number>   <integer> inexact->exact round)
+   (,<exact> ,<inexact> ,exact->inexact)
-(add-as-method <rational> <integer> inexact->exact round)
+   (,<inexact> ,<exact> ,inexact->exact)
-(add-as-method <struct>   <vector>  struct->vector)
+   (,<number> ,<string> ,number->string)
-(add-as-method <string>   <regexp>  regexp)
+   (,<string> ,<number> ,string->number)
-(add-as-method <regexp>   <string>  object-name)
+   (,<char> ,<string> ,string)
+   (,<char> ,<integer> ,char->integer)
+   (,<integer> ,<char> ,integer->char)
+   (,<string> ,<list> ,string->list)
+   (,<list> ,<string> ,list->string)
+   (,<vector> ,<list> ,vector->list)
+   (,<list> ,<vector> ,list->vector)
+   (,<number> ,<integer> ,inexact->exact ,round)
+   (,<rational> ,<integer> ,inexact->exact ,round)
+   (,<struct> ,<vector> ,struct->vector)
+   (,<string> ,<regexp> ,regexp)
+   (,<regexp> ,<string> ,object-name)
+   (,<immutable-bytes> ,<bytes> ,bytes-copy)
+   (,<bytes> ,<immutable-bytes> ,bytes->immutable-bytes)
+   (,<bytes> ,<list> ,bytes->list)
+   (,<list> ,<bytes> ,list->bytes)
+   (,<bytes> ,<byte-regexp> ,byte-regexp)
+   (,<byte-regexp> ,<bytes> ,object-name)
+   (,<string> ,<bytes> ,string->bytes/utf-8)
+   (,<bytes> ,<string> ,bytes->string/utf-8)
+   (,<string> ,<path> ,string->path)
+   (,<path> ,<string> ,path->string)
+   (,<bytes> ,<path> ,bytes->path)
+   (,<path> ,<bytes> ,path->bytes)
    ;; Some weird combinations
-(add-as-method <symbol>   <number>  string->number symbol->string)
+   (,<symbol> ,<number> ,string->number ,symbol->string)
-(add-as-method <number>   <symbol>  string->symbol number->string)
+   (,<number> ,<symbol> ,string->symbol ,number->string)
-(add-as-method <struct>   <list>    vector->list struct->vector)
+   (,<struct> ,<list> ,vector->list ,struct->vector)
+   (,<bytes> ,<number> ,string->number ,bytes->string/utf-8)
+   (,<number> ,<bytes> ,string->bytes/utf-8 ,number->string)
+   ))
 
 ;;; ---------------------------------------------------------------------------
 ;;; Recursive equality.

collects/swindle/tiny-clos.ss

@@ -1915,9 +1915,15 @@
 ;;>> <null>
 ;;>> <vector>
 ;;>> <char>
+;;>> <string-like>
 ;;>> <string>
 ;;>> <immutable-string>
+;;>> <bytes>
+;;>> <immutable-bytes>
+;;>> <path>
 ;;>> <symbol>
+;;>> <keyword>
+;;>> <real-keyword>
 ;;>> <boolean>
 ;;>> <number>
 ;;>> <exact>
@@ -1945,6 +1951,7 @@
 ;;>> <box>
 ;;>> <weak-box>
 ;;>> <regexp>
+;;>> <byte-regexp>
 ;;>> <parameter>
 ;;>> <promise>
 ;;>> <exn>
@@ -1991,9 +1998,17 @@
 (defprimclass <null> <list>)
 (defprimclass <vector> <sequence>)
 (defprimclass <char>)
-(defprimclass <string> <sequence>)
+(defprimclass <string-like> <sequence>)
-(defprimclass <immutable-string> <string> <immutable>)
+(defprimclass <immutable-string-like> <string-like> <immutable>)
+(defprimclass <string> <string-like>)
+(defprimclass <immutable-string> <immutable-string-like>)
+(defprimclass <bytes> <string-like>)
+(defprimclass <immutable-bytes> <immutable-string-like>)
+(defprimclass <path> <string-like>)
+(defprimclass <immutable-path> <immutable-string-like>)
 (defprimclass <symbol>)
+(defprimclass <keyword> <symbol>)
+(defprimclass <real-keyword>)
 (defprimclass <boolean>)
 ;; Have all possible number combinations in any case
 (defprimclass <number>)
@@ -2023,6 +2038,7 @@
 (defprimclass <box>)
 (defprimclass <weak-box> <box>)
 (defprimclass <regexp>)
+(defprimclass <byte-regexp>)
 (defprimclass <parameter>)
 (defprimclass <promise>)
 (defprimclass <exn>)
@@ -2066,21 +2082,19 @@
       (lambda (x)
         ;; If all Schemes were IEEE compliant, the order of these wouldn't
         ;; matter?
-        ;; ELI: changed the order so it fits best the expected results.
+        ;; ELI: changed the order so it fits better the expected results.
         (cond [(instance?    x) (instance-class x)]
               [(procedure?   x) (cond [(parameter? x) <parameter>]
                                       [(primitive? x) <primitive-procedure>]
                                       [else <procedure>])]
-              [(string?      x) (if (immutable? x)
+              [(string?      x) (if (immutable? x) <immutable-string> <string>)]
-                                  <immutable-string> <string>)]
               [(pair?        x) (if (list? x)
                                   (if (immutable? x)
                                     <immutable-nonempty-list> <nonempty-list>)
                                   (if (immutable? x)
                                     <immutable-pair> <pair>))]
               [(null?        x) <null>]
-              [(char?        x) <char>]
+              [(symbol?      x) (if (keyword? x) <keyword> <symbol>)]
-              [(symbol?      x) <symbol>]
               [(number?      x) (if (exact? x)
                                   (cond [(integer?  x) <exact-integer>]
                                         [(rational? x) <exact-rational>]
@@ -2093,6 +2107,9 @@
                                         [(complex?  x) <inexact-complex>]
                                         [else <inexact>]))] ; should not happen
               [(boolean?     x) <boolean>]
+              [(char?        x) <char>]
+              [(bytes?       x) (if (immutable? x) <immutable-bytes> <bytes>)]
+              [(path?        x) <path>]
               [(vector?      x) <vector>]
               [(eof-object?  x) <end-of-file>]
               [(input-port?  x) (if (file-stream-port? x)
@@ -2107,9 +2124,11 @@
               [(box?            x) <box>]
               [(weak-box?       x) <weak-box>]
               [(regexp?         x) <regexp>]
+              [(byte-regexp?    x) <byte-regexp>]
               [(promise?        x) <promise>]
               [(exn?            x) (if (exn:break? x)
                                      <break-exn> <non-break-exn>)]
+              [(real-keyword?   x) <real-keyword>]
               [(semaphore?      x) <semaphore>]
               [(hash-table?     x) <hash-table>]
               [(thread?         x) <thread>]
@@ -2174,12 +2193,17 @@
 ;;>         <vector> : <primitive-class>
 ;;>         <string> : <primitive-class>
 ;;>           <immutable-string> : <primitive-class>
+;;>         <bytes> : <primitive-class>
+;;>           <immutable-bytes> : <primitive-class>
+;;>         <path> : <primitive-class>
 ;;>       <immutable> : <primitive-class>
 ;;>         <immutable-nonempty-list> : <primitive-class>
 ;;>         <immutable-pair> : <primitive-class>
 ;;>         <immutable-string> : <primitive-class>
 ;;>       <char> : <primitive-class>
 ;;>       <symbol> : <primitive-class>
+;;>         <keyword> : <primitive-class>
+;;>       <real-keyword> : <primitive-class>
 ;;>       <boolean> : <primitive-class>
 ;;>       <number> : <primitive-class>
 ;;>         <complex> : <primitive-class>
@@ -2217,6 +2241,7 @@
 ;;>       <box> : <primitive-class>
 ;;>         <weak-box> : <primitive-class>
 ;;>       <regexp> : <primitive-class>
+;;>       <byte-regexp> : <primitive-class>
 ;;>       <parameter> : <primitive-class>
 ;;>       <promise> : <primitive-class>
 ;;>       <exn> : <primitive-class>