suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added some new primitive types

Browse Source 
svn: r990
This commit is contained in:
Eli Barzilay 2005-10-06 01:25:54 +00:00
parent ad376632e6
commit 6311e99d2d
3 changed files with 86 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/swindle/base.ss
View File

@ -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!)

70
collects/swindle/extra.ss
View File

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

39
collects/swindle/tiny-clos.ss
View File

@ -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 <immutable-string> <string> <immutable>)
(defprimclass <string-like> <sequence>)
(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)
<immutable-string> <string>)]
[(string? x) (if (immutable? x) <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) <symbol>]
[(symbol? x) (if (keyword? x) <keyword> <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>