From: Chris Hanson Date: Tue, 18 Apr 1989 16:30:11 +0000 (+0000) Subject: Update runtime system to use lower case as the canonical case for X-Git-Tag: 20090517-FFI~12165 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=97ed1244936b671c5eeea8bd7a7b8da733e46920;p=mit-scheme.git Update runtime system to use lower case as the canonical case for interned symbols. --- diff --git a/v7/src/runtime/defstr.scm b/v7/src/runtime/defstr.scm index 719010c5e..c5d83c560 100644 --- a/v7/src/runtime/defstr.scm +++ b/v7/src/runtime/defstr.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/defstr.scm,v 14.6 1989/02/28 18:23:55 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/defstr.scm,v 14.7 1989/04/18 16:29:25 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -345,7 +345,7 @@ must be defined when the defstruct is evaluated. read-only?)) (define-integrable structure - (string->symbol "#[DEFSTRUCT-DESCRIPTION]")) + (string->symbol "#[defstruct-description]")) (define slot-assoc) diff --git a/v7/src/runtime/lambda.scm b/v7/src/runtime/lambda.scm index 730ae3fda..7a79743f3 100644 --- a/v7/src/runtime/lambda.scm +++ b/v7/src/runtime/lambda.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambda.scm,v 14.4 1988/12/30 06:42:58 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambda.scm,v 14.5 1989/04/18 16:29:32 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -470,10 +470,10 @@ MIT in each case. |# ;;;; Internal Lambda (define-integrable lambda-tag:internal-lambda - (string->symbol "#[INTERNAL-LAMBDA]")) + (string->symbol "#[internal-lambda]")) (define-integrable lambda-tag:internal-lexpr - (string->symbol "#[INTERNAL-LEXPR]")) + (string->symbol "#[internal-lexpr]")) (define-integrable (make-internal-lambda names body) (make-slambda lambda-tag:internal-lambda names body)) diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm index 92527948e..8d107f75c 100644 --- a/v7/src/runtime/make.scm +++ b/v7/src/runtime/make.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.9 1988/12/31 06:39:18 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.10 1989/04/18 16:29:39 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -62,7 +62,7 @@ MIT in each case. |# string-length substring=? substring-move-right! - substring-upcase! + substring-downcase! tty-beep tty-flush-output tty-read-char-immediate @@ -170,7 +170,8 @@ MIT in each case. |# object) (define (implemented-primitive-procedure? primitive) - (get-primitive-address (get-primitive-name (object-datum primitive)) false)) + (get-primitive-address (intern (get-primitive-name (object-datum primitive))) + false)) (define map-filename (if (and (implemented-primitive-procedure? file-exists?) @@ -191,17 +192,20 @@ MIT in each case. |# (substring-move-right! y 0 y-length result x-length) result))) -(define (string-upcase string) +(define (string-downcase string) (let ((size (string-length string))) (let ((result (string-allocate size))) (substring-move-right! string 0 size result 0) - (substring-upcase! result 0 size) + (substring-downcase! result 0 size) result))) (define (string=? string1 string2) (substring=? string1 0 (string-length string1) string2 0 (string-length string2))) +(define (intern string) + (string->symbol (string-downcase string))) + (define (package-initialize package-name procedure-name) (tty-write-char newline-char) (tty-write-string "initialize: (") @@ -300,7 +304,7 @@ MIT in each case. |# (string=? filename "gc"))) (eval (purify (fasload (map-filename filename) true)) environment))) `((SORT-TYPE . MERGE-SORT) - (OS-TYPE . ,(string->symbol (string-upcase os-name-string))) + (OS-TYPE . ,(intern os-name-string)) (OPTIONS . NO-LOAD))) ;; Funny stuff is done. Rest of sequence is standardized. diff --git a/v7/src/runtime/parse.scm b/v7/src/runtime/parse.scm index 37dd0b38f..2681ffe50 100644 --- a/v7/src/runtime/parse.scm +++ b/v7/src/runtime/parse.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/parse.scm,v 14.6 1989/02/10 22:13:50 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/parse.scm,v 14.7 1989/04/18 16:29:45 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -269,7 +269,7 @@ MIT in each case. |# (define (intern-string! string) ;; Special version of `intern' to reduce consing and increase speed. - (substring-upcase! string 0 (string-length string)) + (substring-downcase! string 0 (string-length string)) (string->symbol string)) (define (parse-object/symbol) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index fd41b26eb..70f35de8c 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.34 1989/04/15 01:24:38 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.35 1989/04/18 16:29:51 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -1341,7 +1341,6 @@ MIT in each case. |# make-definition make-delay make-in-package - make-named-tag make-quotation make-the-environment make-variable @@ -1355,7 +1354,6 @@ MIT in each case. |# string->symbol string->uninterned-symbol symbol->string - symbol->string/downcase? symbol-append symbol-hash symbol? diff --git a/v7/src/runtime/scan.scm b/v7/src/runtime/scan.scm index 411429b59..bd3a4556c 100644 --- a/v7/src/runtime/scan.scm +++ b/v7/src/runtime/scan.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scan.scm,v 14.2 1988/06/16 06:28:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scan.scm,v 14.3 1989/04/18 16:29:59 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -54,7 +54,7 @@ MIT in each case. |# ;;; UNSCAN-DEFINES, respectively. (define-integrable open-block-tag - (string->symbol "#[OPEN-BLOCK]")) + (string->symbol "#[open-block]")) (define-integrable sequence-2-type (ucode-type sequence-2)) diff --git a/v7/src/runtime/scode.scm b/v7/src/runtime/scode.scm index 77b89a6ce..6f53db152 100644 --- a/v7/src/runtime/scode.scm +++ b/v7/src/runtime/scode.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 14.4 1989/04/15 01:22:03 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 14.5 1989/04/18 16:30:05 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -106,28 +106,19 @@ MIT in each case. |# (define-integrable string->symbol (ucode-primitive string->symbol)) -(define symbol->string/downcase? - true) - -(define (symbol->string symbol) - (let ((string (system-pair-car symbol))) - (if (and symbol->string/downcase? - (object-type? (ucode-type interned-symbol) symbol) - (not (string-find-next-char-in-set string char-set:lower-case))) - (string-downcase string) - (string-copy string)))) - -(define (make-named-tag name) - (string->symbol (string-append "#[" name "]"))) +(define-integrable (symbol->string symbol) + (string-copy (system-pair-car symbol))) (define-integrable (intern string) - (string->symbol (string-upcase string))) + (string->symbol (string-downcase string))) (define-integrable (symbol-hash symbol) (string-hash (system-pair-car symbol))) (define (symbol-append . symbols) - (string->symbol (apply string-append (map system-pair-car symbols)))) + (let ((string (apply string-append (map system-pair-car symbols)))) + (string-downcase! string) + (string->symbol string))) ;;;; Variable @@ -234,7 +225,7 @@ MIT in each case. |# (eq? (car text) declaration-tag))))) (define-integrable declaration-tag - (string->symbol "#[DECLARATION]")) + (string->symbol "#[declaration]")) (define-integrable (declaration-text declaration) (cdr (comment-text declaration))) diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm index b2558ff4b..7b414d4d6 100644 --- a/v7/src/runtime/syntax.scm +++ b/v7/src/runtime/syntax.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 14.7 1988/12/05 23:32:12 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 14.8 1989/04/18 16:30:11 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -603,16 +603,16 @@ MIT in each case. |# (list body))))) (define-integrable lambda-tag:unnamed - (string->symbol "#[UNNAMED-PROCEDURE]")) + (string->symbol "#[unnamed-procedure]")) (define-integrable lambda-tag:let - (string->symbol "#[LET-PROCEDURE]")) + (string->symbol "#[let-procedure]")) (define-integrable lambda-tag:fluid-let - (string->symbol "#[FLUID-LET-PROCEDURE]")) + (string->symbol "#[fluid-let-procedure]")) (define-integrable lambda-tag:make-environment - (string->symbol "#[MAKE-ENVIRONMENT]")) + (string->symbol "#[make-environment]")) ;;;; Lambda List Parser diff --git a/v8/src/runtime/make.scm b/v8/src/runtime/make.scm index 1f520a3ce..bc87dbc24 100644 --- a/v8/src/runtime/make.scm +++ b/v8/src/runtime/make.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.9 1988/12/31 06:39:18 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.10 1989/04/18 16:29:39 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -62,7 +62,7 @@ MIT in each case. |# string-length substring=? substring-move-right! - substring-upcase! + substring-downcase! tty-beep tty-flush-output tty-read-char-immediate @@ -170,7 +170,8 @@ MIT in each case. |# object) (define (implemented-primitive-procedure? primitive) - (get-primitive-address (get-primitive-name (object-datum primitive)) false)) + (get-primitive-address (intern (get-primitive-name (object-datum primitive))) + false)) (define map-filename (if (and (implemented-primitive-procedure? file-exists?) @@ -191,17 +192,20 @@ MIT in each case. |# (substring-move-right! y 0 y-length result x-length) result))) -(define (string-upcase string) +(define (string-downcase string) (let ((size (string-length string))) (let ((result (string-allocate size))) (substring-move-right! string 0 size result 0) - (substring-upcase! result 0 size) + (substring-downcase! result 0 size) result))) (define (string=? string1 string2) (substring=? string1 0 (string-length string1) string2 0 (string-length string2))) +(define (intern string) + (string->symbol (string-downcase string))) + (define (package-initialize package-name procedure-name) (tty-write-char newline-char) (tty-write-string "initialize: (") @@ -300,7 +304,7 @@ MIT in each case. |# (string=? filename "gc"))) (eval (purify (fasload (map-filename filename) true)) environment))) `((SORT-TYPE . MERGE-SORT) - (OS-TYPE . ,(string->symbol (string-upcase os-name-string))) + (OS-TYPE . ,(intern os-name-string)) (OPTIONS . NO-LOAD))) ;; Funny stuff is done. Rest of sequence is standardized. diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index bd510f77c..24a39ae10 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.34 1989/04/15 01:24:38 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.35 1989/04/18 16:29:51 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -1341,7 +1341,6 @@ MIT in each case. |# make-definition make-delay make-in-package - make-named-tag make-quotation make-the-environment make-variable @@ -1355,7 +1354,6 @@ MIT in each case. |# string->symbol string->uninterned-symbol symbol->string - symbol->string/downcase? symbol-append symbol-hash symbol?