From 6311e99d2dd96516d0a53d3591cc029eaa2cce2a Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 6 Oct 2005 01:25:54 +0000 Subject: [PATCH] Added some new primitive types svn: r990 --- collects/swindle/base.ss | 8 +++- collects/swindle/extra.ss | 70 ++++++++++++++++++++++++----------- collects/swindle/tiny-clos.ss | 39 +++++++++++++++---- 3 files changed, 86 insertions(+), 31 deletions(-) diff --git a/collects/swindle/base.ss b/collects/swindle/base.ss index 26f93bf1a8..19d37fcb66 100644 --- a/collects/swindle/base.ss +++ b/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!) diff --git a/collects/swindle/extra.ss b/collects/swindle/extra.ss index 4ca83c9ef2..af55dadef6 100644 --- a/collects/swindle/extra.ss +++ b/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) -(add-as-method string->symbol) -(add-as-method exact->inexact) -(add-as-method inexact->exact) -(add-as-method number->string) -(add-as-method string->number) -(add-as-method string) -(add-as-method char->integer) -(add-as-method integer->char) -(add-as-method string->list) -(add-as-method list->string) -(add-as-method vector->list) -(add-as-method list->vector) -(add-as-method inexact->exact round) -(add-as-method inexact->exact round) -(add-as-method struct->vector) -(add-as-method regexp) -(add-as-method object-name) -;; Some weird combinations -(add-as-method string->number symbol->string) -(add-as-method string->symbol number->string) -(add-as-method vector->list struct->vector) +(for-each + (lambda (args) + (apply (lambda (from to . ops) + (add-as-method from to . ops) + (let ([from* (cond [(eq? from ) ] + [(eq? from ) ] + [else #f])]) + (when from* (add-as-method from* to . ops)))) + args)) + `((, , ,string-copy) + (, , ,string->immutable-string) + (, , ,string->symbol) + (, , ,symbol->string) + (, , ,exact->inexact) + (, , ,inexact->exact) + (, , ,number->string) + (, , ,string->number) + (, , ,string) + (, , ,char->integer) + (, , ,integer->char) + (, , ,string->list) + (, , ,list->string) + (, , ,vector->list) + (, , ,list->vector) + (, , ,inexact->exact ,round) + (, , ,inexact->exact ,round) + (, , ,struct->vector) + (, , ,regexp) + (, , ,object-name) + (, , ,bytes-copy) + (, , ,bytes->immutable-bytes) + (, , ,bytes->list) + (, , ,list->bytes) + (, , ,byte-regexp) + (, , ,object-name) + (, , ,string->bytes/utf-8) + (, , ,bytes->string/utf-8) + (, , ,string->path) + (, , ,path->string) + (, , ,bytes->path) + (, , ,path->bytes) + ;; Some weird combinations + (, , ,string->number ,symbol->string) + (, , ,string->symbol ,number->string) + (, , ,vector->list ,struct->vector) + (, , ,string->number ,bytes->string/utf-8) + (, , ,string->bytes/utf-8 ,number->string) + )) ;;; --------------------------------------------------------------------------- ;;; Recursive equality. diff --git a/collects/swindle/tiny-clos.ss b/collects/swindle/tiny-clos.ss index e1018d8ff5..ef1bc16197 100644 --- a/collects/swindle/tiny-clos.ss +++ b/collects/swindle/tiny-clos.ss @@ -1915,9 +1915,15 @@ ;;>> ;;>> ;;>> +;;>> ;;>> ;;>> +;;>> +;;>> +;;>> ;;>> +;;>> +;;>> ;;>> ;;>> ;;>> @@ -1945,6 +1951,7 @@ ;;>> ;;>> ;;>> +;;>> ;;>> ;;>> ;;>> @@ -1991,9 +1998,17 @@ (defprimclass ) (defprimclass ) (defprimclass ) -(defprimclass ) -(defprimclass ) +(defprimclass ) +(defprimclass ) +(defprimclass ) +(defprimclass ) +(defprimclass ) +(defprimclass ) +(defprimclass ) +(defprimclass ) (defprimclass ) +(defprimclass ) +(defprimclass ) (defprimclass ) ;; Have all possible number combinations in any case (defprimclass ) @@ -2023,6 +2038,7 @@ (defprimclass ) (defprimclass ) (defprimclass ) +(defprimclass ) (defprimclass ) (defprimclass ) (defprimclass ) @@ -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) ] [(primitive? x) ] [else ])] - [(string? x) (if (immutable? x) - )] + [(string? x) (if (immutable? x) )] [(pair? x) (if (list? x) (if (immutable? x) ) (if (immutable? x) ))] [(null? x) ] - [(char? x) ] - [(symbol? x) ] + [(symbol? x) (if (keyword? x) )] [(number? x) (if (exact? x) (cond [(integer? x) ] [(rational? x) ] @@ -2093,6 +2107,9 @@ [(complex? x) ] [else ]))] ; should not happen [(boolean? x) ] + [(char? x) ] + [(bytes? x) (if (immutable? x) )] + [(path? x) ] [(vector? x) ] [(eof-object? x) ] [(input-port? x) (if (file-stream-port? x) @@ -2107,9 +2124,11 @@ [(box? x) ] [(weak-box? x) ] [(regexp? x) ] + [(byte-regexp? x) ] [(promise? x) ] [(exn? x) (if (exn:break? x) )] + [(real-keyword? x) ] [(semaphore? x) ] [(hash-table? x) ] [(thread? x) ] @@ -2174,12 +2193,17 @@ ;;> : ;;> : ;;> : +;;> : +;;> : +;;> : ;;> : ;;> : ;;> : ;;> : ;;> : ;;> : +;;> : +;;> : ;;> : ;;> : ;;> : @@ -2217,6 +2241,7 @@ ;;> : ;;> : ;;> : +;;> : ;;> : ;;> : ;;> :