Eliminate references to symbol-append.

diff --git a/src/compiler/base/lvalue.scm b/src/compiler/base/lvalue.scm
index 4f83167705a10e92de29df071b302ab0fd553674..ebfd3c98dfa34cc0bd2611d7e9af566dd4fcdb3e 100644 (file)
--- a/src/compiler/base/lvalue.scm
+++ b/src/compiler/base/lvalue.scm
@@ -110,17 +110,17 @@ USA.
    (lambda (form environment)
      environment
      (let* ((name (cadr form))
-           (symbol
+           (variable-name
             (intern (string-append "#[" (symbol->string name) "]"))))
        `(BEGIN (DEFINE-INTEGRABLE
-                (,(symbol-append 'MAKE- name '-VARIABLE) BLOCK)
-                (MAKE-VARIABLE BLOCK ',symbol))
+                (,(symbol 'MAKE- name '-VARIABLE) BLOCK)
+                (MAKE-VARIABLE BLOCK ',variable-name))
               (DEFINE-INTEGRABLE
-                (,(symbol-append 'VARIABLE/ name '-VARIABLE?) LVALUE)
-                (EQ? (VARIABLE-NAME LVALUE) ',symbol))
-              (DEFINE (,(symbol-append name '-VARIABLE?) LVALUE)
+                (,(symbol 'VARIABLE/ name '-VARIABLE?) LVALUE)
+                (EQ? (VARIABLE-NAME LVALUE) ',variable-name))
+              (DEFINE (,(symbol name '-VARIABLE?) LVALUE)
                 (AND (VARIABLE? LVALUE)
-                     (EQ? (VARIABLE-NAME LVALUE) ',symbol))))))))
+                     (EQ? (VARIABLE-NAME LVALUE) ',variable-name))))))))
 
 (define-named-variable continuation)
 (define-named-variable value)

diff --git a/src/compiler/base/macros.scm b/src/compiler/base/macros.scm
index c0e62ddae253f40364e40e0a553e01f9a84fa740..ff26f94a4bd7ae0a059e8c86207ee7449ab752a9 100644 (file)
--- a/src/compiler/base/macros.scm
+++ b/src/compiler/base/macros.scm
@@ -86,11 +86,11 @@ USA.
                 (slots (cdddr form)))
             (let ((make-defs
                    (lambda (slot index)
-                     (let ((ref-name (symbol-append class '- slot)))
+                     (let ((ref-name (symbol class '- slot)))
                        `((DEFINE-INTEGRABLE (,ref-name V)
                            (VECTOR-REF V ,index))
                          (DEFINE-INTEGRABLE
-                           (,(symbol-append 'SET- ref-name '!) V OBJECT)
+                           (,(symbol 'SET- ref-name '!) V OBJECT)
                            (VECTOR-SET! V ,index OBJECT)))))))
               (if (pair? slots)
                   `(BEGIN
@@ -117,12 +117,12 @@ USA.
        (if (syntax-match? pattern (cdr form))
           (let ((type (cadr form))
                 (slots (cddr form)))
-            (let ((tag-name (symbol-append type '-TAG)))
+            (let ((tag-name (symbol type '-TAG)))
               (let ((tag-ref (close-syntax tag-name environment)))
                 `(BEGIN
                    (DEFINE ,tag-name
                      (MAKE-VECTOR-TAG #F ',type #F))
-                   (DEFINE ,(symbol-append type '?)
+                   (DEFINE ,(symbol type '?)
                      (TAGGED-VECTOR/SUBCLASS-PREDICATE ,tag-ref))
                    (DEFINE-VECTOR-SLOTS ,type 1 ,@slots)
                    (SET-VECTOR-TAG-DESCRIPTION! ,tag-ref
@@ -137,8 +137,8 @@ USA.
           (reserved (caddr form))
           (enumeration (close-syntax (cadddr form) environment)))
        (let ((parent
-             (close-syntax (symbol-append name '-TAG) environment)))
-        `(define-syntax ,(symbol-append 'DEFINE- name)
+             (close-syntax (symbol name '-TAG) environment)))
+        `(define-syntax ,(symbol 'DEFINE- name)
            (sc-macro-transformer
             (let ((pattern
                    `(SYMBOL * ,(lambda (x)
@@ -149,14 +149,14 @@ USA.
                 (if (syntax-match? pattern (cdr form))
                     (let ((type (cadr form))
                           (slots (cddr form)))
-                      (let ((tag-name (symbol-append type '-TAG)))
+                      (let ((tag-name (symbol type '-TAG)))
                         (let ((tag-ref
                                (close-syntax tag-name environment)))
                           `(BEGIN
                              (DEFINE ,tag-name
                                (MAKE-VECTOR-TAG ,',parent ',type
                                                 ,',enumeration))
-                             (DEFINE ,(symbol-append type '?)
+                             (DEFINE ,(symbol type '?)
                                (TAGGED-VECTOR/PREDICATE ,tag-ref))
                              (DEFINE-VECTOR-SLOTS ,type ,,reserved
                                ,@slots)
@@ -191,7 +191,7 @@ USA.
                 (slots (cdddr form)))
             (let ((ref-name
                    (lambda (slot)
-                     (close-syntax (symbol-append type '- slot)
+                     (close-syntax (symbol type '- slot)
                                    environment))))
               `(LIST
                 ,@(map (lambda (slot)
@@ -290,18 +290,18 @@ USA.
           (SET! ,types (CONS ',type ,types))
           ,(let ((parameters (map make-synthetic-identifier components)))
              `(DEFINE-INTEGRABLE
-                (,(symbol-append prefix 'MAKE- type) ,@parameters)
+                (,(symbol prefix 'MAKE- type) ,@parameters)
                 ,(wrap-constructor `(LIST ',type ,@parameters))))
-          (DEFINE-INTEGRABLE (,(symbol-append 'RTL: type '?) EXPRESSION)
+          (DEFINE-INTEGRABLE (,(symbol 'RTL: type '?) EXPRESSION)
             (EQ? (CAR EXPRESSION) ',type))
           ,@(let loop ((components components) (ref-index 6) (set-index 2))
               (if (pair? components)
-                  (let ((name (symbol-append type '- (car components))))
+                  (let ((name (symbol type '- (car components))))
                     `((DEFINE-INTEGRABLE
-                        (,(symbol-append 'RTL: name) OBJECT)
+                        (,(symbol 'RTL: name) OBJECT)
                         (GENERAL-CAR-CDR OBJECT ,ref-index))
                       (DEFINE-INTEGRABLE
-                        (,(symbol-append 'RTL:SET- name '!) OBJECT V)
+                        (,(symbol 'RTL:SET- name '!) OBJECT V)
                         (SET-CAR! (GENERAL-CAR-CDR OBJECT ,set-index) V))
                       ,@(loop (cdr components)
                               (* ref-index 2)
@@ -358,13 +358,13 @@ USA.
      (if (syntax-match? '(SYMBOL (* SYMBOL)) (cdr form))
         (let ((name (cadr form))
               (elements (caddr form)))
-          (let ((enumeration (symbol-append name 'S)))
+          (let ((enumeration (symbol name 'S)))
             (let ((enum-ref (close-syntax enumeration environment)))
               `(BEGIN
                  (DEFINE ,enumeration
                    (MAKE-ENUMERATION ',elements))
                  ,@(map (lambda (element)
-                          `(DEFINE ,(symbol-append name '/ element)
+                          `(DEFINE ,(symbol name '/ element)
                              (ENUMERATION/NAME->INDEX ,enum-ref ',element)))
                         elements)))))
         (ill-formed-syntax form)))))
@@ -375,7 +375,7 @@ USA.
      (if (syntax-match? '(SYMBOL EXPRESSION * (DATUM * EXPRESSION)) (cdr form))
         (enumeration-case-1 (caddr form) (cdddr form) environment
                             (lambda (element)
-                              (symbol-append (cadr form) '/ element))
+                              (symbol (cadr form) '/ element))
                             (lambda (expression) expression '()))
         (ill-formed-syntax form)))))
 
@@ -384,7 +384,7 @@ USA.
    (lambda (form environment)
      (if (syntax-match? '(EXPRESSION * (DATUM * EXPRESSION)) (cdr form))
         (enumeration-case-1 (cadr form) (cddr form) environment
-                            (lambda (element) (symbol-append element '-TAG))
+                            (lambda (element) (symbol element '-TAG))
                             (lambda (expression)
                               `((ELSE
                                  (ERROR "Unknown node type:" ,expression)))))

diff --git a/src/compiler/base/utils.scm b/src/compiler/base/utils.scm
index b9c229d40b2f804e030b05f1c349f4e6b9a743c3..5dec6dceb3b22de4ec8bc034c5f4382a7f2a1494 100644 (file)
--- a/src/compiler/base/utils.scm
+++ b/src/compiler/base/utils.scm
@@ -144,7 +144,7 @@ USA.
   (sc-macro-transformer
    (lambda (form environment)
      environment
-     `(DEFINE-INTEGRABLE ,(symbol-append 'TYPE-CODE: (cadr form))
+     `(DEFINE-INTEGRABLE ,(symbol 'TYPE-CODE: (cadr form))
        ',(microcode-type (cadr form))))))
 
 (define-type-code lambda)

diff --git a/src/compiler/fggen/canon.scm b/src/compiler/fggen/canon.scm
index 2083aba354d8ea20e3d44f147bea7941805322bb..a1f156402d952ab39e17af3f615640a8d0adc6c1 100644 (file)
--- a/src/compiler/fggen/canon.scm
+++ b/src/compiler/fggen/canon.scm
@@ -835,8 +835,7 @@ ARBITRARY:  The expression may be executed more than once.  It
           (lambda (form environment)
             (let ((name (cadr form)))
               `(DISPATCH-ENTRY ,name
-                               ,(close-syntax (symbol-append 'CANONICALIZE/
-                                                             name)
+                               ,(close-syntax (symbol 'CANONICALIZE/ name)
                                               environment))))))
 
         (nary-entry
@@ -846,9 +845,9 @@ ARBITRARY:  The expression may be executed more than once.  It
                   (name (caddr form)))
               `(DISPATCH-ENTRY ,name
                                ,(close-syntax
-                                 `(,(symbol-append 'CANONICALIZE/ nary)
-                                   ,(symbol-append 'SCODE/ name '-COMPONENTS)
-                                   ,(symbol-append 'SCODE/MAKE- name))
+                                 `(,(symbol 'CANONICALIZE/ nary)
+                                   ,(symbol 'SCODE/ name '-COMPONENTS)
+                                   ,(symbol 'SCODE/MAKE- name))
                                  environment))))))
 
         (binary-entry

diff --git a/src/compiler/fggen/fggen.scm b/src/compiler/fggen/fggen.scm
index f9eee18a79b4cfa7ae5b20d326a9cb239c67a3f7..e008fda4fa2db4469544449bba45cb85ab6c7853 100644 (file)
--- a/src/compiler/fggen/fggen.scm
+++ b/src/compiler/fggen/fggen.scm
@@ -979,7 +979,7 @@ USA.
           (lambda (form environment)
             (let ((name (cadr form)))
               `(DISPATCH-ENTRY ,name
-                               ,(close-syntax (symbol-append 'GENERATE/ name)
+                               ,(close-syntax (symbol 'GENERATE/ name)
                                               environment)))))))
       (standard-entry access)
       (standard-entry assignment)

diff --git a/src/compiler/machines/C/lapgen.scm b/src/compiler/machines/C/lapgen.scm
index 342d398f982d5dbedd32748001d59ef76f9f3b43..f9a227180b9c76a260da6f3c8081db8f9bc4438c 100644 (file)
--- a/src/compiler/machines/C/lapgen.scm
+++ b/src/compiler/machines/C/lapgen.scm
@@ -662,8 +662,7 @@ USA.
        ,@(let loop ((names (cddr form)) (index (cadr form)))
            (if (pair? names)
                (cons `(DEFINE-INTEGRABLE
-                        ,(symbol-append 'CODE:COMPILER-
-                                        (car names))
+                        ,(symbol 'CODE:COMPILER- (car names))
                         ,index)
                      (loop (cdr names) (1+ index)))
                `()))))))

diff --git a/src/compiler/machines/C/rules3.scm b/src/compiler/machines/C/rules3.scm
index 30bfce12816dfcd9cbaff2aa37b2ae180f219f14..0fa3e71eecbf66d065568cec1292c5fc3420bb58 100644 (file)
--- a/src/compiler/machines/C/rules3.scm
+++ b/src/compiler/machines/C/rules3.scm
@@ -157,7 +157,7 @@ USA.
                ,(make-primitive-procedure name #t))
               FRAME-SIZE CONTINUATION
               (INVOKE-SPECIAL-PRIMITIVE
-               ,(close-syntax (symbol-append 'CODE:COMPILER- name)
+               ,(close-syntax (symbol 'CODE:COMPILER- name)
                               environment))))))))
   (define-special-primitive-invocation &+)
   (define-special-primitive-invocation &-)

diff --git a/src/compiler/machines/C/stackops.scm b/src/compiler/machines/C/stackops.scm
index 3f2ae28958bd164a40cf03daecc7a6c9bfdee1ad..aa8beb6712680d3981c4bc0ddf356467790410e3 100644 (file)
--- a/src/compiler/machines/C/stackops.scm
+++ b/src/compiler/machines/C/stackops.scm
@@ -64,7 +64,7 @@ USA.
                       (bindings '()))
              (if (not (pair? elements))
                  (reverse!
-                  (cons `(define ,(symbol-append '* name '*)
+                  (cons `(define ,(symbol '* name '*)
                            '#(,@(reverse! bindings)))
                         code))
                  (let* ((next (car elements))
@@ -78,7 +78,7 @@ USA.
                                      (error "define-enumeration: Overlap"
                                             next)
                                      m)))))
-                   (let ((name (symbol-append name '/ suffix)))
+                   (let ((name (symbol name '/ suffix)))
                      (loop (+ n 1)
                            (cdr elements)
                            (cons `(DEFINE-INTEGRABLE ,name ,n)

diff --git a/src/compiler/machines/i386/lapgen.scm b/src/compiler/machines/i386/lapgen.scm
index a260666babaf481b38be2ff8c2a0945c98676885..3f7a8ae27d45c23149444fb18dd0d23e14c03dcb 100644 (file)
--- a/src/compiler/machines/i386/lapgen.scm
+++ b/src/compiler/machines/i386/lapgen.scm
@@ -265,7 +265,7 @@ USA.
 (define (load-pc-relative-address target label-expr)
   (with-pc
     (lambda (pc-label pc-register)
-      (LAP (LEA ,target (@RO W ,pc-register (- ,label-expr ,pc-label)))))))  
+      (LAP (LEA ,target (@RO W ,pc-register (- ,label-expr ,pc-label)))))))
 \f
 (define (with-pc recvr)
   (with-values (lambda () (get-cached-label))
@@ -310,7 +310,7 @@ USA.
 (define (target-register target)
   (delete-dead-registers!)
   (or (register-alias target 'GENERAL)
-      (allocate-alias-register! target 'GENERAL)))  
+      (allocate-alias-register! target 'GENERAL)))
 
 (define-integrable (target-register-reference target)
   (register-reference (target-register target)))
@@ -357,7 +357,7 @@ USA.
         (with-reused-temp
           (lambda (temp)
             (need-register! temp)
-            (with-address-temp temp)))        
+            (with-address-temp temp)))
         (fail-index
          (lambda ()
            (with-address-temp
@@ -575,8 +575,7 @@ USA.
        ,@(let loop ((names (cddr form)) (index (cadr form)))
            (if (pair? names)
                (cons `(DEFINE-INTEGRABLE
-                        ,(symbol-append 'CODE:COMPILER-
-                                        (car names))
+                        ,(symbol 'CODE:COMPILER- (car names))
                         ,index)
                      (loop (cdr names) (+ index 1)))
                '()))))))
@@ -584,7 +583,7 @@ USA.
 (define-codes #x012
   primitive-apply primitive-lexpr-apply
   apply error lexpr-apply link
-  interrupt-closure interrupt-dlink interrupt-procedure 
+  interrupt-closure interrupt-dlink interrupt-procedure
   interrupt-continuation interrupt-ic-procedure
   assignment-trap cache-reference-apply
   reference-trap safe-reference-trap unassigned?-trap
@@ -619,8 +618,7 @@ USA.
            (if (pair? names)
                (if (< index high)
                    (cons `(DEFINE-INTEGRABLE
-                            ,(symbol-append 'ENTRY:COMPILER-
-                                            (car names))
+                            ,(symbol 'ENTRY:COMPILER- (car names))
                             (byte-offset-reference regnum:regs-pointer
                                                    ,index))
                          (loop (cdr names) (+ index 4) high))

diff --git a/src/compiler/machines/i386/rules3.scm b/src/compiler/machines/i386/rules3.scm
index 8f9e54eedb1f09e77887660702bee5d6598bd962..890d6e35514de8ca731f34d94eed5565a9024285 100644 (file)
--- a/src/compiler/machines/i386/rules3.scm
+++ b/src/compiler/machines/i386/rules3.scm
@@ -233,11 +233,11 @@ USA.
               (expect-no-exit-interrupt-checks)
               #|
               (special-primitive-invocation
-               ,(close-syntax (symbol-append 'CODE:COMPILER- name)
+               ,(close-syntax (symbol 'CODE:COMPILER- name)
                               environment))
               |#
               (optimized-primitive-invocation
-               ,(close-syntax (symbol-append 'ENTRY:COMPILER- name)
+               ,(close-syntax (symbol 'ENTRY:COMPILER- name)
                               environment))))))))
 
   (define-primitive-invocation &+)

diff --git a/src/compiler/machines/svm/machine.scm b/src/compiler/machines/svm/machine.scm
index ae6cd502a6b573fb37259190b9e5f433ad605921..fe587c32dd630c85a495e0652204897cb3b7cd68 100644 (file)
--- a/src/compiler/machines/svm/machine.scm
+++ b/src/compiler/machines/svm/machine.scm
@@ -73,11 +73,11 @@ USA.
      (if (syntax-match? '(SYMBOL * SYMBOL) (cdr form))
         (let ((tag (cadr form))
               (params (cddr form)))
-          (let ((name (symbol-append 'INST: tag)))
+          (let ((name (symbol 'INST: tag)))
             `(BEGIN
                (DEFINE-INTEGRABLE (,name ,@params)
                  (LIST (LIST ',tag ,@params)))
-               (DEFINE-INTEGRABLE (,(symbol-append name '?) INST)
+               (DEFINE-INTEGRABLE (,(symbol name '?) INST)
                  (EQ? (CAR INST) ',tag)))))
         (ill-formed-syntax form)))))
 
@@ -178,12 +178,12 @@ USA.
      (if (syntax-match? '(SYMBOL * SYMBOL) (cdr form))
         (let ((tag (cadr form))
               (params (cddr form)))
-          (let ((name (symbol-append 'EA: tag)))
+          (let ((name (symbol 'EA: tag)))
             `(BEGIN
                (DEFINE-INTEGRABLE (,name ,@params)
                  (INST-EA (,tag ,@(map (lambda (p) (list 'UNQUOTE p))
                                        params))))
-               (DEFINE-INTEGRABLE (,(symbol-append name '?) EA)
+               (DEFINE-INTEGRABLE (,(symbol name '?) EA)
                  (AND (PAIR? EA)
                       (EQ? (CAR EA) ',tag))))))
         (ill-formed-syntax form)))))
@@ -257,7 +257,7 @@ USA.
        ,@(map (lambda (name)
                 (let ((code (if (pair? name) (cadr name) name))
                       (prim (if (pair? name) (car name) name)))
-                  `(DEFINE (,(symbol-append 'TRAP: prim) . ARGS)
+                  `(DEFINE (,(symbol 'TRAP: prim) . ARGS)
                      (APPLY INST:TRAP ',code ARGS))))
               (cdr form))))))
 
@@ -281,7 +281,7 @@ USA.
      environment
      `(BEGIN
        ,@(map (lambda (name)
-               `(DEFINE-INST ,(symbol-append 'INTERRUPT-TEST- name)))
+               `(DEFINE-INST ,(symbol 'INTERRUPT-TEST- name)))
              (cdr form))))))
 
 (define-interrupt-tests dynamic-link procedure continuation ic-procedure)
@@ -331,11 +331,11 @@ USA.
                      '()))))
           `(BEGIN
              ,@(map (lambda (p)
-                      `(DEFINE-INTEGRABLE ,(symbol-append 'REGNUM: (car p))
+                      `(DEFINE-INTEGRABLE ,(symbol 'REGNUM: (car p))
                          ,(cdr p)))
                     alist)
              ,@(map (lambda (p)
-                      `(DEFINE-INTEGRABLE ,(symbol-append 'RREF: (car p))
+                      `(DEFINE-INTEGRABLE ,(symbol 'RREF: (car p))
                          (REGISTER-REFERENCE ,(cdr p))))
                     alist)
              (DEFINE FIXED-REGISTERS ',alist)))
@@ -407,12 +407,12 @@ USA.
   (sc-macro-transformer
    (lambda (form environment)
      (if (syntax-match? '(symbol identifier) (cdr form))
-        (let ((name (symbol-append 'INTERPRETER- (cadr form)))
+        (let ((name (symbol 'INTERPRETER- (cadr form)))
               (regnum (close-syntax (caddr form) environment)))
           `(BEGIN
              (DEFINE (,name)
                (RTL:MAKE-MACHINE-REGISTER ,regnum))
-             (DEFINE (,(symbol-append name '?) EXPRESSION)
+             (DEFINE (,(symbol name '?) EXPRESSION)
                (AND (RTL:REGISTER? EXPRESSION)
                     (FIX:= (RTL:REGISTER-NUMBER EXPRESSION) ,regnum)))))
         (ill-formed-syntax form)))))

diff --git a/src/compiler/machines/svm/rules.scm b/src/compiler/machines/svm/rules.scm
index f67f119e28c330188325d3b009cbbc4ba9824082..16481d3c8fea723d2faa3719ea6294f06596f7a8 100644 (file)
--- a/src/compiler/machines/svm/rules.scm
+++ b/src/compiler/machines/svm/rules.scm
@@ -725,7 +725,7 @@ USA.
          frame-size continuation
          (expect-no-exit-interrupt-checks)
          (%primitive-invocation
-          ,(close-syntax (symbol-append 'TRAP: name) environment)))))))
+          ,(close-syntax (symbol 'TRAP: name) environment)))))))
 
 (define (%primitive-invocation make-trap)
   (LAP ,@(clear-map!)

diff --git a/src/compiler/machines/x86-64/lapgen.scm b/src/compiler/machines/x86-64/lapgen.scm
index 0be73d44f6b4d5eec177d929fc6c5eda9d780db8..61f515b31f91fc9a8fd3bd1810a4eac811d177c2 100644 (file)
--- a/src/compiler/machines/x86-64/lapgen.scm
+++ b/src/compiler/machines/x86-64/lapgen.scm
@@ -686,8 +686,7 @@ USA.
      `(BEGIN
        ,@(let loop ((names (cddr form)) (index (cadr form)))
            (if (pair? names)
-               (cons `(DEFINE-INTEGRABLE
-                        ,(symbol-append 'CODE:COMPILER-
+               (cons `(DEFINE-INTEGRABLE ,(symbol 'CODE:COMPILER-
                                         (car names))
                         ,index)
                      (loop (cdr names) (+ index 1)))
@@ -727,7 +726,7 @@ USA.
        ,@(let loop ((names (cddr form)) (index (cadr form)))
            (if (pair? names)
                (cons `(DEFINE-INTEGRABLE
-                          ,(symbol-append 'ENTRY:COMPILER- (car names))
+                          ,(symbol 'ENTRY:COMPILER- (car names))
                         (BYTE-OFFSET-REFERENCE REGNUM:REGS-POINTER ,index))
                      (loop (cdr names) (+ index 8)))
                '()))))))

diff --git a/src/compiler/machines/x86-64/rules3.scm b/src/compiler/machines/x86-64/rules3.scm
index b2adced301576bba71b94690993ef47d48aa42c9..85337e125b325294a9c71db5774303cdd0952962 100644 (file)
--- a/src/compiler/machines/x86-64/rules3.scm
+++ b/src/compiler/machines/x86-64/rules3.scm
@@ -203,11 +203,11 @@ USA.
               (expect-no-exit-interrupt-checks)
               #|
               (special-primitive-invocation
-               ,(close-syntax (symbol-append 'CODE:COMPILER- name)
+               ,(close-syntax (symbol 'CODE:COMPILER- name)
                               environment))
               |#
               (optimized-primitive-invocation
-               ,(close-syntax (symbol-append 'ENTRY:COMPILER- name)
+               ,(close-syntax (symbol 'ENTRY:COMPILER- name)
                               environment))))))))
 
   (define-primitive-invocation &+)

diff --git a/src/compiler/rtlbase/rtlreg.scm b/src/compiler/rtlbase/rtlreg.scm
index e5b71b6d69b81c61ef5e66a652b0854424473f6e..70a667fdf3fe8e7b2e772d2e2e30c671d504ab3d 100644 (file)
--- a/src/compiler/rtlbase/rtlreg.scm
+++ b/src/compiler/rtlbase/rtlreg.scm
@@ -73,16 +73,16 @@ USA.
   (sc-macro-transformer
    (lambda (form environment)
      (let ((slot (cadr form)))
-       (let ((name (symbol-append 'REGISTER- slot)))
+       (let ((name (symbol 'REGISTER- slot)))
         (let ((vector
-               `(,(close-syntax (symbol-append 'RGRAPH- name)
+               `(,(close-syntax (symbol 'RGRAPH- name)
                                 environment)
                  *CURRENT-RGRAPH*)))
           `(BEGIN
              (DEFINE-INTEGRABLE (,name REGISTER)
                (VECTOR-REF ,vector REGISTER))
              (DEFINE-INTEGRABLE
-               (,(symbol-append 'SET- name '!) REGISTER VALUE)
+               (,(symbol 'SET- name '!) REGISTER VALUE)
                (VECTOR-SET! ,vector REGISTER VALUE)))))))))
 
 (define-register-references bblock)

diff --git a/src/compiler/rtlbase/valclass.scm b/src/compiler/rtlbase/valclass.scm
index 5ca57574608c9757b20fe260c71f6c42dd30ef25..0c5fad0112e49e6d1c5702460e18f8f7e173b8dc 100644 (file)
--- a/src/compiler/rtlbase/valclass.scm
+++ b/src/compiler/rtlbase/valclass.scm
@@ -85,7 +85,7 @@ USA.
           (parent-name (caddr form)))
        (let* ((name->variable
               (lambda (name)
-                (symbol-append 'VALUE-CLASS= name)))
+                (symbol 'VALUE-CLASS= name)))
              (variable (name->variable name)))
         `(BEGIN
            (DEFINE ,variable
@@ -95,9 +95,9 @@ USA.
                    (close-syntax (name->variable parent-name)
                                  environment)
                    `#F)))
-           (DEFINE (,(symbol-append variable '?) CLASS)
+           (DEFINE (,(symbol variable '?) CLASS)
              (VALUE-CLASS/ANCESTOR-OR-SELF? CLASS ,variable))
-           (DEFINE (,(symbol-append 'REGISTER- variable '?) REGISTER)
+           (DEFINE (,(symbol 'REGISTER- variable '?) REGISTER)
              (VALUE-CLASS/ANCESTOR-OR-SELF?
               (REGISTER-VALUE-CLASS REGISTER)
               ,variable))))))))

diff --git a/src/edwin/buffer.scm b/src/edwin/buffer.scm
index 620d4bf8e7fe7fd2d1855815516e27e50ea310cf..537b226c771cdf537a568517d9e864de5e25c3bf 100644 (file)
--- a/src/edwin/buffer.scm
+++ b/src/edwin/buffer.scm
@@ -53,8 +53,8 @@ USA.
   (sc-macro-transformer
    (lambda (form environment)
      (let ((slot-name (cadr form)))
-       `(DEFINE-INTEGRABLE ,(symbol-append 'BUFFER- slot-name)
-         ,(close-syntax (symbol-append 'BUFFER-% slot-name)
+       `(DEFINE-INTEGRABLE ,(symbol 'BUFFER- slot-name)
+         ,(close-syntax (symbol 'BUFFER-% slot-name)
                         environment))))))
 
 (rename-buffer-accessor name)

diff --git a/src/edwin/editor.scm b/src/edwin/editor.scm
index 2f38855e687e94316bf10fd07c7fd4f5a6000aac..ef6772a98f09c7c0a5cf8b955e0e908d381253d3 100644 (file)
--- a/src/edwin/editor.scm
+++ b/src/edwin/editor.scm
@@ -291,7 +291,7 @@ with the contents of the startup message."
 (define (maybe-debug-scheme-error error-type condition)
   (let ((p
         (variable-default-value
-         (or (name->variable (symbol-append 'DEBUG-ON- error-type '-ERROR) #f)
+         (or (name->variable (symbol 'DEBUG-ON- error-type '-ERROR) #f)
              (ref-variable-object debug-on-internal-error)))))
     (if p
        (debug-scheme-error error-type condition (eq? p 'ASK))))

diff --git a/src/edwin/macros.scm b/src/edwin/macros.scm
index df31897da839d875e0858b7207c9b3aa94d111f0..850683016bdc75f0b11ad0f16ba5e5c18e3b4c94 100644 (file)
--- a/src/edwin/macros.scm
+++ b/src/edwin/macros.scm
@@ -93,7 +93,7 @@ USA.
         (ill-formed-syntax form)))))
 
 (define (command-name->scheme-name name)
-  (symbol-append 'EDWIN-COMMAND$ name))
+  (symbol 'EDWIN-COMMAND$ name))
 
 (define-syntax ref-command
   (sc-macro-transformer
@@ -146,7 +146,7 @@ USA.
         (ill-formed-syntax form)))))
 
 (define (variable-name->scheme-name name)
-  (symbol-append 'EDWIN-VARIABLE$ name))
+  (symbol 'EDWIN-VARIABLE$ name))
 
 (define-syntax ref-variable
   (sc-macro-transformer
@@ -261,4 +261,4 @@ USA.
         (ill-formed-syntax form)))))
 
 (define (mode-name->scheme-name name)
-  (symbol-append 'EDWIN-MODE$ name))
\ No newline at end of file
+  (symbol 'EDWIN-MODE$ name))
\ No newline at end of file

diff --git a/src/edwin/tterm.scm b/src/edwin/tterm.scm
index 93847596836e5a3d7bbc5d3df9ab5ba8424abeed..60eca3a7088a9a87a58d677dffe96e52b6141833 100644 (file)
--- a/src/edwin/tterm.scm
+++ b/src/edwin/tterm.scm
@@ -490,8 +490,8 @@ USA.
   (sc-macro-transformer
    (lambda (form environment)
      (let ((name (cadr form)))
-       `(DEFINE-INTEGRABLE (,(symbol-append 'SCREEN- name) SCREEN)
-         (,(close-syntax (symbol-append 'TERMINAL-STATE/ name)
+       `(DEFINE-INTEGRABLE (,(symbol 'SCREEN- name) SCREEN)
+         (,(close-syntax (symbol 'TERMINAL-STATE/ name)
                          environment)
           (SCREEN-STATE SCREEN)))))))
 
@@ -501,9 +501,9 @@ USA.
      (let ((name (cadr form)))
        (let ((param (make-synthetic-identifier name)))
         `(DEFINE-INTEGRABLE
-           (,(symbol-append 'SET-SCREEN- name '!) SCREEN ,param)
+           (,(symbol 'SET-SCREEN- name '!) SCREEN ,param)
            (,(close-syntax
-              (symbol-append 'SET-TERMINAL-STATE/ name '!)
+              (symbol 'SET-TERMINAL-STATE/ name '!)
               environment)
             (SCREEN-STATE SCREEN)
             ,param)))))))

diff --git a/src/edwin/xcom.scm b/src/edwin/xcom.scm
index e1682e396248ec6dfe38d65183e10268b9729a1d..7c0d9b26583933598953e5232b419104bb9af82b 100644 (file)
--- a/src/edwin/xcom.scm
+++ b/src/edwin/xcom.scm
@@ -295,8 +295,8 @@ When called interactively, completion is available on the input."
   (sc-macro-transformer
    (lambda (form environment)
      (let ((name (cadr form)))
-       `(DEFINE ,(symbol-append 'EDWIN-COMMAND$X- name)
-         ,(close-syntax (symbol-append 'EDWIN-COMMAND$ name)
+       `(DEFINE ,(symbol 'EDWIN-COMMAND$X- name)
+         ,(close-syntax (symbol 'EDWIN-COMMAND$ name)
                         environment))))))
 
 (define-old-mouse-command set-foreground-color)
@@ -327,8 +327,8 @@ When called interactively, completion is available on the input."
   (sc-macro-transformer
    (lambda (form environment)
      (let ((name (cadr form)))
-       `(DEFINE ,(symbol-append 'EDWIN-VARIABLE$X-SCREEN- name)
-         ,(close-syntax (symbol-append 'EDWIN-VARIABLE$FRAME- name)
+       `(DEFINE ,(symbol 'EDWIN-VARIABLE$X-SCREEN- name)
+         ,(close-syntax (symbol 'EDWIN-VARIABLE$FRAME- name)
                         environment))))))
 
 (define-old-screen-command icon-name-format)

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 5603e4933ade43e069447e471a702b39e07e90fa..3875d679fa429e901f9328d792805ab6ce7e2225 100644 (file)
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -156,13 +156,13 @@ USA.
                               ZS))
                     (VECTOR
                      (FIXED-OBJECTS-ITEM 'arity-dispatcher-tag)
-                     (NAMED-LAMBDA (,(symbol-append 'NULLARY- name))
+                     (NAMED-LAMBDA (,(symbol 'NULLARY- name))
                        ,identity)
-                     (NAMED-LAMBDA (,(symbol-append 'UNARY- name) Z)
+                     (NAMED-LAMBDA (,(symbol 'UNARY- name) Z)
                        (IF (NOT (COMPLEX:COMPLEX? Z))
                            (ERROR:WRONG-TYPE-ARGUMENT Z "number" ',name))
                        Z)
-                     (NAMED-LAMBDA (,(symbol-append 'BINARY- name) Z1 Z2)
+                     (NAMED-LAMBDA (,(symbol 'BINARY- name) Z1 Z2)
                        ((UCODE-PRIMITIVE ,(list-ref form 4)) Z1 Z2))))))))))
     (commutative + complex:+ 0 &+)
     (commutative * complex:* 1 &*))
@@ -185,7 +185,7 @@ USA.
                      (FIXED-OBJECTS-ITEM 'arity-dispatcher-tag)
                      #F
                      ,(close-syntax (list-ref form 2) environment)
-                     (NAMED-LAMBDA (,(symbol-append 'BINARY- name) Z1 Z2)
+                     (NAMED-LAMBDA (,(symbol 'BINARY- name) Z1 Z2)
                        ((UCODE-PRIMITIVE ,(list-ref form 6)) Z1 Z2))))))))))
     (non-commutative - complex:negate complex:- complex:+ 0 &-)
     (non-commutative / complex:invert complex:/ complex:* 1 &/))
@@ -205,14 +205,14 @@ USA.
                        ZS ',name))
                     (VECTOR
                      (FIXED-OBJECTS-ITEM 'arity-dispatcher-tag)
-                     (NAMED-LAMBDA (,(symbol-append 'NULLARY- name)) #T)
-                     (NAMED-LAMBDA (,(symbol-append 'UNARY- name) Z)
+                     (NAMED-LAMBDA (,(symbol 'NULLARY- name)) #T)
+                     (NAMED-LAMBDA (,(symbol 'UNARY- name) Z)
                        (IF (NOT (,(intern (string-append "complex:" type "?"))
                                  Z))
                            (ERROR:WRONG-TYPE-ARGUMENT
                             Z ,(string-append type " number") ',name))
                        #T)
-                     (NAMED-LAMBDA (,(symbol-append 'BINARY- name) Z1 Z2)
+                     (NAMED-LAMBDA (,(symbol 'BINARY- name) Z1 Z2)
                        ,(let ((p
                                `((UCODE-PRIMITIVE ,(list-ref form 3)) Z1 Z2)))
                           (if (list-ref form 5)
@@ -238,7 +238,7 @@ USA.
                     (VECTOR
                      (FIXED-OBJECTS-ITEM 'arity-dispatcher-tag)
                      #F
-                     (NAMED-LAMBDA (,(symbol-append 'UNARY- name) X)
+                     (NAMED-LAMBDA (,(symbol 'UNARY- name) X)
                        (IF (NOT (COMPLEX:REAL? X))
                            (ERROR:WRONG-TYPE-ARGUMENT X "real number" ',name))
                        X)

diff --git a/src/runtime/defstr.scm b/src/runtime/defstr.scm
index d4d133907afc2cd03d26e16768d7c621e883a069..6b0870d2814a737afcd9be82273e008f25c80926 100644 (file)
--- a/src/runtime/defstr.scm
+++ b/src/runtime/defstr.scm
@@ -289,16 +289,16 @@ differences:
   (car (option/arguments option)))
 
 (define (default-conc-name context)
-  (symbol-append (parser-context/name context) '-))
+  (symbol (parser-context/name context) '-))
 
 (define (default-constructor-name context)
-  (symbol-append 'MAKE- (parser-context/name context)))
+  (symbol 'MAKE- (parser-context/name context)))
 
 (define (default-copier-name context)
-  (symbol-append 'COPY- (parser-context/name context)))
+  (symbol 'COPY- (parser-context/name context)))
 
 (define (default-predicate-name context)
-  (symbol-append (parser-context/name context) '?))
+  (symbol (parser-context/name context) '?))
 
 (define (default-unparser-text context)
   `(,(absolute 'STANDARD-UNPARSER-METHOD context)
@@ -306,7 +306,7 @@ differences:
     #F))
 
 (define (default-type-name context)
-  (symbol-append 'RTD: (parser-context/name context)))
+  (symbol 'RTD: (parser-context/name context)))
 \f
 (define (apply-option-transformers options context)
   (let loop ((options options))
@@ -623,7 +623,7 @@ differences:
                  (accessor-name
                   (let ((conc-name (structure/conc-name structure)))
                     (if conc-name
-                        (symbol-append conc-name name)
+                        (symbol conc-name name)
                         name))))
             (if (structure/safe-accessors? structure)
                 `(DEFINE ,accessor-name
@@ -651,8 +651,8 @@ differences:
                  (modifier-name
                   (let ((conc-name (structure/conc-name structure)))
                     (if conc-name
-                        (symbol-append 'SET- conc-name name '!)
-                        (symbol-append 'SET- name '!)))))
+                        (symbol 'SET- conc-name name '!)
+                        (symbol 'SET- name '!)))))
             (if (structure/safe-accessors? structure)
                 `(DEFINE ,modifier-name
                    (,(absolute (case (structure/physical-type structure)

diff --git a/src/runtime/graphics.scm b/src/runtime/graphics.scm
index ebdc689ca5cb1113f5715dcda3f3ee9e3117ee30..4eaca985c24e1acc82f6532181c4f6ae6ba2ef1b 100644 (file)
--- a/src/runtime/graphics.scm
+++ b/src/runtime/graphics.scm
@@ -259,8 +259,8 @@ USA.
    (lambda (form environment)
      (let ((name (cadr form)))
        `(DEFINE-INTEGRABLE
-         (,(symbol-append 'GRAPHICS-DEVICE/OPERATION/ name) DEVICE)
-         (,(close-syntax (symbol-append 'GRAPHICS-DEVICE-TYPE/OPERATION/
+         (,(symbol 'GRAPHICS-DEVICE/OPERATION/ name) DEVICE)
+         (,(close-syntax (symbol 'GRAPHICS-DEVICE-TYPE/OPERATION/
                                         name)
                          environment)
           (GRAPHICS-DEVICE/TYPE DEVICE)))))))

diff --git a/src/runtime/infstr.scm b/src/runtime/infstr.scm
index d7938cbf4be22f1eabb9450b72d5a58642955a0e..cbd802db96f5140d95e85c1f8770b40bf782326f 100644 (file)
--- a/src/runtime/infstr.scm
+++ b/src/runtime/infstr.scm
@@ -205,7 +205,7 @@ USA.
     ((dbg-block-name
       (sc-macro-transformer
        (lambda (form environment)
-        (let ((symbol (symbol-append 'DBG-BLOCK-NAME/ (cadr form))))
+        (let ((symbol (symbol 'DBG-BLOCK-NAME/ (cadr form))))
           `(DEFINE-INTEGRABLE ,symbol
              ',((ucode-primitive string->symbol)
                 (string-append "#[(runtime compiler-info)"

diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index 0d44f4ef34e33750055062c466010e5c630f1a86..5380c967cdefb46c1cee879c41f2225f7432b5ac 100644 (file)
--- a/src/runtime/parse.scm
+++ b/src/runtime/parse.scm
@@ -1095,7 +1095,7 @@ USA.
         (let ((name (caadr form))
               (field-names (cdadr form))
               (reporter (caddr form)))
-          (let ((ct (symbol-append 'CONDITION-TYPE: name)))
+          (let ((ct (symbol 'CONDITION-TYPE: name)))
             `(BEGIN
                (SET! ,ct
                      (MAKE-CONDITION-TYPE ',name CONDITION-TYPE:PARSE-ERROR
@@ -1106,7 +1106,7 @@ USA.
                                    `(ACCESS-CONDITION CONDITION ',field-name))
                                  field-names)
                           PORT))))
-               (SET! ,(symbol-append 'ERROR: name)
+               (SET! ,(symbol 'ERROR: name)
                      (CONDITION-SIGNALLER ,ct
                                           ',field-names
                                           STANDARD-ERROR-HANDLER)))))

diff --git a/src/runtime/pgsql.scm b/src/runtime/pgsql.scm
index d177dd07cfbbd070a9e0c51b0ca137a390e260ea..a747479d650f54f52a18c546b5a24888ab5d2d49 100644 (file)
--- a/src/runtime/pgsql.scm
+++ b/src/runtime/pgsql.scm
@@ -125,11 +125,11 @@ USA.
      environment
      (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form))
         (let ((type (cadr form)))
-          (let ((type? (symbol-append type '?))
-                (guarantee-type (symbol-append 'GUARANTEE- type))
-                (error:not-type (symbol-append 'ERROR:NOT- type))
-                (guarantee-valid-type (symbol-append 'GUARANTEE-VALID- type))
-                (type-handle (symbol-append type '-HANDLE)))
+          (let ((type? (symbol type '?))
+                (guarantee-type (symbol 'GUARANTEE- type))
+                (error:not-type (symbol 'ERROR:NOT- type))
+                (guarantee-valid-type (symbol 'GUARANTEE-VALID- type))
+                (type-handle (symbol type '-HANDLE)))
             `(BEGIN
                (DEFINE-INTEGRABLE (,guarantee-type OBJECT CALLER)
                  (IF (NOT (,type? OBJECT))
@@ -270,8 +270,8 @@ USA.
      environment
      (if (syntax-match? '(SYMBOL) (cdr form))
         (let ((field (cadr form)))
-          `(DEFINE (,(symbol-append 'PGSQL-CONN- field) OBJECT)
-             (,(symbol-append 'PQ- field) (CONNECTION->HANDLE OBJECT))))
+          `(DEFINE (,(symbol 'PGSQL-CONN- field) OBJECT)
+             (,(symbol 'PQ- field) (CONNECTION->HANDLE OBJECT))))
         (ill-formed-syntax form)))))
 
 (define-connection-accessor db)
@@ -350,8 +350,8 @@ USA.
      environment
      (if (syntax-match? '(SYMBOL) (cdr form))
         (let ((field (cadr form)))
-          `(DEFINE (,(symbol-append 'PGSQL- field) OBJECT)
-             (,(symbol-append 'PQ- field) (RESULT->HANDLE OBJECT))))
+          `(DEFINE (,(symbol 'PGSQL- field) OBJECT)
+             (,(symbol 'PQ- field) (RESULT->HANDLE OBJECT))))
         (ill-formed-syntax form)))))
 
 (define-result-accessor result-error-message)

diff --git a/src/runtime/rgxcmp.scm b/src/runtime/rgxcmp.scm
index 87e94bc838b70c167e3fe29ff59a04b2c191a579..b5e52785a5301b918fb567c11a66ff4e1730989a 100644 (file)
--- a/src/runtime/rgxcmp.scm
+++ b/src/runtime/rgxcmp.scm
@@ -42,7 +42,7 @@ USA.
          ,@(let loop ((n 0) (suffixes suffixes))
              (if (pair? suffixes)
                  (cons `(DEFINE-INTEGRABLE
-                          ,(symbol-append prefix (car suffixes))
+                          ,(symbol prefix (car suffixes))
                           ,n)
                        (loop (+ n 1) (cdr suffixes)))
                  '()))

diff --git a/src/runtime/starbase.scm b/src/runtime/starbase.scm
index 9ff8744bde00171d227f5e0698a6bf82367397af..044c2fb87317cbd91861f42b0009af9b2d3a77c0 100644 (file)
--- a/src/runtime/starbase.scm
+++ b/src/runtime/starbase.scm
@@ -113,15 +113,15 @@ USA.
    (lambda (form environment)
      (let ((name (cadr form)))
        `(BEGIN
-         (DEFINE (,(symbol-append 'STARBASE-DEVICE/ name) DEVICE)
+         (DEFINE (,(symbol 'STARBASE-DEVICE/ name) DEVICE)
            (,(close-syntax
-              (symbol-append 'STARBASE-GRAPHICS-DESCRIPTOR/ name)
+              (symbol 'STARBASE-GRAPHICS-DESCRIPTOR/ name)
               environment)
             (GRAPHICS-DEVICE/DESCRIPTOR DEVICE)))
          (DEFINE
-           (,(symbol-append 'SET-STARBASE-DEVICE/ name '!) DEVICE VALUE)
+           (,(symbol 'SET-STARBASE-DEVICE/ name '!) DEVICE VALUE)
            (,(close-syntax
-              (symbol-append 'SET-STARBASE-GRAPHICS-DESCRIPTOR/ name '!)
+              (symbol 'SET-STARBASE-GRAPHICS-DESCRIPTOR/ name '!)
               environment)
             (GRAPHICS-DEVICE/DESCRIPTOR DEVICE)
             VALUE)))))))

diff --git a/src/sf/object.scm b/src/sf/object.scm
index 4ea0f632f07994e8bcf67887ede950b7f9be48b9..981db88b1cf008e48e1a3c5b5591bb096f6efb0c 100644 (file)
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -76,7 +76,7 @@ USA.
           (DEFINE ,enumeration-name
             (ENUMERATION/MAKE ',enumerand-names))
           ,@(map (lambda (enumerand-name)
-                   `(DEFINE ,(symbol-append enumerand-name '/ENUMERAND)
+                   `(DEFINE ,(symbol enumerand-name '/ENUMERAND)
                       (ENUMERATION/NAME->ENUMERAND
                        ,(close-syntax enumeration-name environment)
                        ',enumerand-name)))
@@ -122,11 +122,11 @@ USA.
               (,name
                (TYPE VECTOR)
                (NAMED
-                ,(close-syntax (symbol-append name '/ENUMERAND) environment))
-               (TYPE-DESCRIPTOR ,(symbol-append 'RTD: name))
-               (CONC-NAME ,(symbol-append name '/))
+                ,(close-syntax (symbol name '/ENUMERAND) environment))
+               (TYPE-DESCRIPTOR ,(symbol 'RTD: name))
+               (CONC-NAME ,(symbol name '/))
                (CONSTRUCTOR ,(or constructor-name
-                                 (symbol-append name '/MAKE))))
+                                 (symbol name '/MAKE))))
             (scode #f read-only #t)
             ,@slots)
          (DEFINE-GUARANTEE ,name ,(symbol->string name)))))))

diff --git a/src/win32/ffimacro.scm b/src/win32/ffimacro.scm
index e7411f018b93be65ad58766b36c5b8004311230e..2987beea793aaed3af3a71360307814295d6e3cd 100644 (file)
--- a/src/win32/ffimacro.scm
+++ b/src/win32/ffimacro.scm
@@ -235,7 +235,7 @@ to inside a string that is being used as the buffer).
              (,revert X Y))))))))
 \f
 (define ((make-type-namer suffix) type #!optional environment)
-  (let ((name (symbol-append type suffix)))
+  (let ((name (symbol type suffix)))
     (if (default-object? environment)
        name
        (close-syntax name environment))))

diff --git a/src/win32/win_ffi.scm b/src/win32/win_ffi.scm
index b803f00df7fb9d85046b2a2d603b1c819284f623..20e2e0f073eb4ad4e2b7acda8ead5e996aeda123 100644 (file)
--- a/src/win32/win_ffi.scm
+++ b/src/win32/win_ffi.scm
@@ -72,7 +72,7 @@ USA.
                      (intern (string-append "arg" (number->string i))))
                    indexes))
              (type-names
-              (map (lambda (n) (symbol-append n '-TYPE))
+              (map (lambda (n) (symbol n '-TYPE))
                    arg-names)))
         `(LAMBDA (MODULE-ENTRY)
            (LET ,(map (lambda (type-name index)

diff --git a/src/x11-screen/x11-command.scm b/src/x11-screen/x11-command.scm
index 46e53b86230c6d908b5c853a84165e04dc43746b..e4a970270b023e5164e1e470f68636563bbfdfab 100644 (file)
--- a/src/x11-screen/x11-command.scm
+++ b/src/x11-screen/x11-command.scm
@@ -268,8 +268,8 @@ When called interactively, completion is available on the input."
   (sc-macro-transformer
    (lambda (form environment)
      (let ((name (cadr form)))
-       `(DEFINE ,(symbol-append 'EDWIN-COMMAND$X- name)
-         ,(close-syntax (symbol-append 'EDWIN-COMMAND$ name)
+       `(DEFINE ,(symbol 'EDWIN-COMMAND$X- name)
+         ,(close-syntax (symbol 'EDWIN-COMMAND$ name)
                         environment))))))
 
 (define-old-mouse-command set-foreground-color)

diff --git a/src/xdoc/xdoc.scm b/src/xdoc/xdoc.scm
index 12111e98c4c1f039a220946e80f1f91966ba1479..8d5aec733a9cb2ceeea28bbfbd0051fffdfaaa65 100644 (file)
--- a/src/xdoc/xdoc.scm
+++ b/src/xdoc/xdoc.scm
@@ -1474,12 +1474,12 @@ USA.
      (let ((local (cadr form))
           (content-type (caddr form))
           (elt-type (cadddr form)))
-       (let ((qname (symbol-append 'xd: local)))
+       (let ((qname (symbol 'xd: local)))
         `(BEGIN
            (DEFINE ,qname
              (STANDARD-XML-ELEMENT-CONSTRUCTOR ',qname XDOC-URI
                                                ,(eq? content-type 'empty)))
-           (DEFINE ,(symbol-append qname '?)
+           (DEFINE ,(symbol qname '?)
              (LET ((NAME (MAKE-XML-NAME ',qname XDOC-URI)))
                (LAMBDA (OBJECT)
                  (AND (XML-ELEMENT? OBJECT)

diff --git a/src/xml/xhtml.scm b/src/xml/xhtml.scm
index 96e01e42b47e136a6dbda7fea9e72708943fc3ef..bdd4c498bc841581068b970bad9946f3c365a9f9 100644 (file)
--- a/src/xml/xhtml.scm
+++ b/src/xml/xhtml.scm
@@ -139,9 +139,9 @@ USA.
               (context (caddr form))
               (empty? (pair? (cdddr form))))
           `(BEGIN
-             (DEFINE ,(symbol-append 'HTML: name)
+             (DEFINE ,(symbol 'HTML: name)
                (STANDARD-XML-ELEMENT-CONSTRUCTOR ',name HTML-URI ,empty?))
-             (DEFINE ,(symbol-append 'HTML: name '?)
+             (DEFINE ,(symbol 'HTML: name '?)
                (STANDARD-XML-ELEMENT-PREDICATE ',name HTML-URI))
              (DEFINE-HTML-ELEMENT-CONTEXT ',name ',context)))
         (ill-formed-syntax form)))))

diff --git a/src/xml/xml-struct.scm b/src/xml/xml-struct.scm
index 502d7636ce20de80d8559376b692fa8c8e7e3adf..9f960004987c15c43cb1e8b9bbd17e49eb1e059b 100644 (file)
--- a/src/xml/xml-struct.scm
+++ b/src/xml/xml-struct.scm
@@ -38,13 +38,13 @@ USA.
                  (or (syntax-match? '(IDENTIFIER EXPRESSION) slot)
                      (syntax-match? '(IDENTIFIER 'CANONICALIZE EXPRESSION)
                                     slot)))))
-        (let ((root (symbol-append 'XML- (cadr form)))
+        (let ((root (symbol 'XML- (cadr form)))
               (slots (cddr form)))
-          (let ((rtd (symbol-append '< root '>))
-                (%constructor (symbol-append '%MAKE- root))
-                (constructor (symbol-append 'MAKE- root))
-                (predicate (symbol-append root '?))
-                (error:not (symbol-append 'ERROR:NOT- root))
+          (let ((rtd (symbol '< root '>))
+                (%constructor (symbol '%MAKE- root))
+                (constructor (symbol 'MAKE- root))
+                (predicate (symbol root '?))
+                (error:not (symbol 'ERROR:NOT- root))
                 (slot-vars
                  (map (lambda (slot)
                         (close-syntax (car slot) environment))
@@ -66,7 +66,7 @@ USA.
                    (MAKE-RECORD-TYPE ',root '(,@(map car slots))))
                  (DEFINE ,predicate
                    (RECORD-PREDICATE ,rtd))
-                 (DEFINE (,(symbol-append 'GUARANTEE- root) OBJECT CALLER)
+                 (DEFINE (,(symbol 'GUARANTEE- root) OBJECT CALLER)
                    (IF (NOT ,predicate)
                        (,error:not OBJECT CALLER)))
                  (DEFINE (,error:not OBJECT CALLER)
@@ -86,8 +86,8 @@ USA.
                            slots
                            slot-vars)))
                  ,@(map (lambda (slot var)
-                          (let* ((accessor (symbol-append root '- (car slot)))
-                                 (modifier (symbol-append 'SET- accessor '!)))
+                          (let* ((accessor (symbol root '- (car slot)))
+                                 (modifier (symbol 'SET- accessor '!)))
                             `(BEGIN
                                (DEFINE ,accessor
                                  (RECORD-ACCESSOR ,rtd ',(car slot)))
@@ -447,9 +447,9 @@ USA.
      (if (syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
         (let ((name (cadr form))
               (accessor (caddr form)))
-          (let ((root (symbol-append 'XML- name)))
+          (let ((root (symbol 'XML- name)))
             `(SET-RECORD-TYPE-UNPARSER-METHOD!
-              ,(close-syntax (symbol-append '< root '>) environment)
+              ,(close-syntax (symbol '< root '>) environment)
               (SIMPLE-UNPARSER-METHOD ',root
                 (LAMBDA (,name)
                   (LIST (,(close-syntax accessor environment) ,name)))))))
@@ -486,7 +486,7 @@ USA.
   (let ((value
         (find-xml-attr (if (null-xml-name-prefix? prefix)
                            'xmlns
-                           (symbol-append 'xmlns: prefix))
+                           (symbol 'xmlns: prefix))
                        elt)))
     (and value
         (begin

diff --git a/tests/runtime/test-entity.scm b/tests/runtime/test-entity.scm
index 79a66b77dee4e9b3423c041d408469cd69644a70..2ff1914bf2b1d82255b80105478c8617c6733e0b 100644 (file)
--- a/tests/runtime/test-entity.scm
+++ b/tests/runtime/test-entity.scm
@@ -38,14 +38,14 @@ USA.
    ((lambda (f)
       (for-each (lambda (descriptor) (apply f descriptor)) descriptors))
     (lambda (name constructor predicate get-procedure get-extra)
-      (define-test (symbol-append name '?)
+      (define-test (symbol name '?)
         (lambda ()
           (assert-true (predicate (constructor some-procedure some-extra)))))
-      (define-test (symbol-append name '- 'PROCEDURE)
+      (define-test (symbol name '- 'PROCEDURE)
         (lambda ()
           (assert-eq some-procedure
                      (get-procedure (constructor some-procedure some-extra)))))
-      (define-test (symbol-append name '- 'EXTRA)
+      (define-test (symbol name '- 'EXTRA)
         (lambda ()
           (assert-eq
            some-extra
@@ -61,28 +61,28 @@ USA.
     (lambda (name constructor predicate get-procedure get-extra
              name* constructor* predicate* get-procedure* get-extra*)
       constructor predicate* get-procedure* get-extra*
-      (define-test (symbol-append name '? '/ name*)
+      (define-test (symbol name '? '/ name*)
         (lambda ()
           (assert-false (predicate (constructor* some-procedure some-extra)))))
-      (define-test (symbol-append name '? '/ 'JUNK)
+      (define-test (symbol name '? '/ 'JUNK)
         (lambda ()
           (assert-false (predicate some-extra))))
-      (define-test (symbol-append name '- 'PROCEDURE '/ name*)
+      (define-test (symbol name '- 'PROCEDURE '/ name*)
         (lambda ()
           (let ((object* (constructor* some-procedure some-extra)))
             (assert-error (lambda ()
                             (get-procedure object*))
                           (list condition-type:wrong-type-argument)))))
-      (define-test (symbol-append name '- 'PROCEDURE '/ 'JUNK)
+      (define-test (symbol name '- 'PROCEDURE '/ 'JUNK)
         (lambda ()
           (assert-error (lambda () (get-procedure some-extra))
                         (list condition-type:wrong-type-argument))))
-      (define-test (symbol-append name '- 'EXTRA '/ name*)
+      (define-test (symbol name '- 'EXTRA '/ name*)
         (lambda ()
           (let ((object* (constructor* some-procedure some-extra)))
             (assert-error (lambda () (get-extra object*))
                           (list condition-type:wrong-type-argument)))))
-      (define-test (symbol-append name '- 'EXTRA '/ 'JUNK)
+      (define-test (symbol name '- 'EXTRA '/ 'JUNK)
         (lambda ()
           (assert-error (lambda () (get-extra some-extra))
                         (list condition-type:wrong-type-argument)))))))

diff --git a/tests/runtime/test-floenv.scm b/tests/runtime/test-floenv.scm
index 42e59caea5cad5c326b22cb28720a3264da27c46..c063cf3d6978f4f40980fee1f63ca9b8b088af0b 100644 (file)
--- a/tests/runtime/test-floenv.scm
+++ b/tests/runtime/test-floenv.scm
@@ -54,7 +54,7 @@ USA.
 
 (for-each-rounding-mode
  (lambda (mode)
-   (define-test (symbol-append 'FLO:SET-ROUNDING-MODE ': mode)
+   (define-test (symbol 'FLO:SET-ROUNDING-MODE ': mode)
      (lambda ()
        (let ((mode* (flo:rounding-mode)))
          (flo:preserving-environment
@@ -65,7 +65,7 @@ USA.
 
 (for-each-rounding-mode
  (lambda (mode)
-   (define-test (symbol-append 'FLO:WITH-ROUNDING-MODE ': mode)
+   (define-test (symbol 'FLO:WITH-ROUNDING-MODE ': mode)
      (lambda ()
        (let ((mode* (flo:rounding-mode)))
         (flo:with-rounding-mode mode
@@ -77,7 +77,7 @@ USA.
  (lambda (mode)
    (define inputs '(-2.0 -1.5 -1.0 -0.5 -0.0 0.0 0.5 1.0 1.5 2.0))
    (define (define-rounding-test name operator outputs)
-     (define-test (symbol-append 'ROUNDING-MODE-INDEPENDENT ': mode '/ name)
+     (define-test (symbol 'ROUNDING-MODE-INDEPENDENT ': mode '/ name)
        (lambda ()
         (do ((inputs inputs (cdr inputs))
              (outputs outputs (cdr outputs))
@@ -229,10 +229,10 @@ USA.
 (for-each-exception
  (lambda (name exception condition-type trappable? elicitors)
    condition-type trappable? elicitors ;ignore
-   (define-test (symbol-append 'FLO:EXCEPTIONS->NAMES ': name)
+   (define-test (symbol 'FLO:EXCEPTIONS->NAMES ': name)
      (lambda ()
        (assert-equal (flo:exceptions->names (exception)) (list name))))
-   (define-test (symbol-append 'FLO:NAMES->EXCEPTIONS ': name)
+   (define-test (symbol 'FLO:NAMES->EXCEPTIONS ': name)
      (lambda ()
        (assert-equal (flo:names->exceptions (list name)) (exception))))))
 
@@ -271,7 +271,7 @@ USA.
     (flo:trapped-exceptions)))
 
 (define (define-set-trapped-exceptions-test name to-trap)
-  (define-test (symbol-append 'FLO:SET-TRAPPED-EXCEPTIONS! ': name)
+  (define-test (symbol 'FLO:SET-TRAPPED-EXCEPTIONS! ': name)
     (lambda ()
       (let ((exceptions (to-trap))
            (trapped (flo:trapped-exceptions)))
@@ -281,7 +281,7 @@ USA.
           (assert-eqv (flo:trapped-exceptions) exceptions)))))))
 
 (define (define-with-trapped-exceptions-test name to-trap)
-  (define-test (symbol-append 'FLO:WITH-TRAPPED-EXCEPTIONS ': name)
+  (define-test (symbol 'FLO:WITH-TRAPPED-EXCEPTIONS ': name)
     (lambda ()
       (let ((exceptions (to-trap)))
        (flo:with-trapped-exceptions exceptions
@@ -297,7 +297,7 @@ USA.
 (for-each-trappable-exception
  (lambda (name exception condition-type elicitors)
    condition-type elicitors            ;ignore
-   (define-test (symbol-append 'FLO:WITH-TRAPPED-EXCEPTIONS ': name)
+   (define-test (symbol 'FLO:WITH-TRAPPED-EXCEPTIONS ': name)
      (lambda ()
        (flo:with-trapped-exceptions (exception)
         (lambda ()
@@ -306,7 +306,7 @@ USA.
 (for-each-trappable-exception
  (lambda (name exception condition-type elicitors)
    condition-type elicitors            ;ignore
-   (define-test (symbol-append 'FLO:TRAP-EXCEPTIONS! ': name)
+   (define-test (symbol 'FLO:TRAP-EXCEPTIONS! ': name)
      (lambda ()
        (flo:with-trapped-exceptions 0
         (lambda ()
@@ -316,7 +316,7 @@ USA.
 (for-each-trappable-exception
  (lambda (name exception condition-type elicitors)
    condition-type elicitors            ;ignore
-   (define-test (symbol-append 'FLO:UNTRAP-EXCEPTIONS! ': name)
+   (define-test (symbol 'FLO:UNTRAP-EXCEPTIONS! ': name)
      (lambda ()
        (flo:with-trapped-exceptions (flo:trappable-exceptions)
         (lambda ()
@@ -328,7 +328,7 @@ USA.
 (for-each-trappable-exception
  (lambda (name exception condition-type elicitors)
    condition-type elicitors            ;ignore
-   (define-test (symbol-append 'FLO:SET-TRAPPED-EXCEPTIONS! ': name ': 'ENABLE)
+   (define-test (symbol 'FLO:SET-TRAPPED-EXCEPTIONS! ': name ': 'ENABLE)
      (lambda ()
        (flo:with-trapped-exceptions 0
         (lambda ()
@@ -338,7 +338,7 @@ USA.
 (for-each-trappable-exception
  (lambda (name exception condition-type elicitors)
    condition-type elicitors            ;ignore
-   (define-test (symbol-append 'FLO:SET-TRAPPED-EXCEPTIONS! ': name ': 'DISABLE)
+   (define-test (symbol 'FLO:SET-TRAPPED-EXCEPTIONS! ': name ': 'DISABLE)
      (lambda ()
        (let ((exceptions (fix:andc (flo:trappable-exceptions) (exception))))
         (flo:with-trapped-exceptions (flo:trappable-exceptions)
@@ -349,7 +349,7 @@ USA.
 \f
 (for-each-trappable-exception-elicitor
  (lambda (name exception condition-type elicitor-name elicitor)
-   (define-test (symbol-append 'ELICIT ': name ': elicitor-name)
+   (define-test (symbol 'ELICIT ': name ': elicitor-name)
      (lambda ()
        (assert-error (lambda ()
                       (flo:with-trapped-exceptions (exception) elicitor))
@@ -358,7 +358,7 @@ USA.
 (for-each-trappable-exception-elicitor
  (lambda (name exception condition-type elicitor-name elicitor)
    exception                           ;ignore
-   (define-test (symbol-append 'ELICIT-DEFERRED ': name ': elicitor-name)
+   (define-test (symbol 'ELICIT-DEFERRED ': name ': elicitor-name)
      (lambda ()
        (assert-error
        (lambda ()
@@ -375,14 +375,14 @@ USA.
 (for-each-exception-elicitor
  (lambda (name exception condition-type trappable? elicitor-name elicitor)
    exception condition-type trappable? ;ignore
-   (define-test (symbol-append 'ELICIT-IGNORED ': name ': elicitor-name)
+   (define-test (symbol 'ELICIT-IGNORED ': name ': elicitor-name)
      (lambda ()
        (flo:ignoring-exception-traps elicitor)))))
 
 (for-each-exception-elicitor
  (lambda (name exception condition-type trappable? elicitor-name elicitor)
    condition-type trappable?           ;ignore
-   (define-test (symbol-append 'ELICIT-AND-TEST ': name ': elicitor-name)
+   (define-test (symbol 'ELICIT-AND-TEST ': name ': elicitor-name)
      (lambda ()
        (assert-eqv (flo:ignoring-exception-traps
                    (lambda ()
@@ -393,7 +393,7 @@ USA.
 (for-each-exception-elicitor
  (lambda (name exception condition-type trappable? elicitor-name elicitor)
    condition-type trappable?           ;ignore
-   (define-test (symbol-append 'ELICIT-CLEAR-TEST ': name ': elicitor-name)
+   (define-test (symbol 'ELICIT-CLEAR-TEST ': name ': elicitor-name)
      (lambda ()
        (assert-eqv (flo:ignoring-exception-traps
                    (lambda ()
@@ -427,7 +427,7 @@ USA.
     (flo:with-default-environment (lambda () 0))))
 
 (define (define-default-environment-test name procedure)
-  (define-test (symbol-append 'FLO:DEFAULT-ENVIRONMENT ': name)
+  (define-test (symbol 'FLO:DEFAULT-ENVIRONMENT ': name)
     (lambda ()
       (flo:preserving-environment
        (lambda ()

diff --git a/tests/runtime/test-hash-table.scm b/tests/runtime/test-hash-table.scm
index 13ee5919200922dd83920948d3a1511db3155bb0..e6cb17ce823f4401393cbfe0fc398a0d63bc8bc8 100644 (file)
--- a/tests/runtime/test-hash-table.scm
+++ b/tests/runtime/test-hash-table.scm
@@ -209,10 +209,10 @@ USA.
   (for-each (lambda (hash-parameters)
              (for-each (lambda (entry-type)
                          (define-test
-                           (symbol-append 'CORRECTNESS-VS-RB:
-                                          (car entry-type)
-                                          '-
-                                          (car hash-parameters))
+                           (symbol 'CORRECTNESS-VS-RB:
+                                   (car entry-type)
+                                   '-
+                                   (car hash-parameters))
                            (lambda ()
                              (check
                               (make-hash-table-implementation