diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-02-25 05:13:53 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-02-25 05:13:53 +0000 |
| commit | b71fd7a811c516e8ca2a8a3f4ad578e9f637596b (patch) | |
| tree | e676e8436022b7a51c0c3c10511fc16876f87b13 | |
| parent | 66f5a47122d91ad3a395cc02549908b8daf1bdd8 (diff) | |
| download | open-axiom-b71fd7a811c516e8ca2a8a3f4ad578e9f637596b.tar.gz | |
* boot/tokens.boot: makeSymbol is not a builtin function.
* boot/ast.boot: Use makeSymbol in place of INTERN.
* boot/parser.boot: Likewise.
* boot/scanner.boot: Likewise.
* boot/translator.boot: Likewise.
* interp/alql.boot: Likewise.
* interp/as.boot: Likewise.
* interp/ax.boot: Likewise.
* interp/bc-matrix.boot: Likewise.
* interp/bc-solve.boot: Likewise.
* interp/br-con.boot: Likewise.
* interp/br-data.boot: Likewise.
* interp/br-op2.boot: Likewise.
* interp/br-prof.boot: Likewise.
* interp/br-search.boot: Likewise.
* interp/c-doc.boot: Likewise.
* interp/c-util.boot: Likewise.
* interp/clam.boot: Likewise.
* interp/compiler.boot: Likewise.
* interp/define.boot: Likewise.
* interp/format.boot: Likewise.
* interp/fortcall.boot: Likewise.
* interp/i-syscmd.boot: Likewise.
* interp/i-spec1.boot: Likewise.
* interp/i-output.boot: Likewise.
* interp/i-coerce.boot: Likewise.
* interp/i-map.boot: Likewise.
* interp/htsetvar.boot: Likewise.
* interp/ht-util.boot: Likewise.
* interp/g-util.boot: Likewise.
* interp/functor.boot: Likewise.
* interp/pspad1.boot: Likewise.
* interp/pspad2.boot: Likewise.
* interp/postpar.boot: Likewise.
* interp/pf2sex.boot: Likewise.
* interp/parse.boot: Likewise.
* interp/packtran.boot: Likewise.
* interp/nrunopt.boot: Likewise.
* interp/nruncomp.boot: Likewise.
* interp/newfort.boot: Likewise.
* interp/msgdb.boot: Likewise.
* interp/modemap.boot: Likewise.
* interp/mark.boot: Likewise.
* interp/intfile.boot: Likewise.
* interp/interop.boot: Likewise.
* interp/incl.boot: Likewise.
* interp/word.boot: Likewise.
* interp/wi2.boot: Likewise.
* interp/wi1.boot: Likewise.
* interp/trace.boot: Likewise.
* interp/topics.boot: Likewise.
* interp/sys-constants.boot: Likewise.
* interp/showimp.boot: Likewise.
* interp/scan.boot: Likewise.
70 files changed, 388 insertions, 361 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 74b5e82b..4d2c3789 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,62 @@ 2011-02-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/tokens.boot: makeSymbol is not a builtin function. + * boot/ast.boot: Use makeSymbol in place of INTERN. + * boot/parser.boot: Likewise. + * boot/scanner.boot: Likewise. + * boot/translator.boot: Likewise. + * interp/alql.boot: Likewise. + * interp/as.boot: Likewise. + * interp/ax.boot: Likewise. + * interp/bc-matrix.boot: Likewise. + * interp/bc-solve.boot: Likewise. + * interp/br-con.boot: Likewise. + * interp/br-data.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-prof.boot: Likewise. + * interp/br-search.boot: Likewise. + * interp/c-doc.boot: Likewise. + * interp/c-util.boot: Likewise. + * interp/clam.boot: Likewise. + * interp/compiler.boot: Likewise. + * interp/define.boot: Likewise. + * interp/format.boot: Likewise. + * interp/fortcall.boot: Likewise. + * interp/i-syscmd.boot: Likewise. + * interp/i-spec1.boot: Likewise. + * interp/i-output.boot: Likewise. + * interp/i-coerce.boot: Likewise. + * interp/i-map.boot: Likewise. + * interp/htsetvar.boot: Likewise. + * interp/ht-util.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/pspad1.boot: Likewise. + * interp/pspad2.boot: Likewise. + * interp/postpar.boot: Likewise. + * interp/pf2sex.boot: Likewise. + * interp/parse.boot: Likewise. + * interp/packtran.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/newfort.boot: Likewise. + * interp/msgdb.boot: Likewise. + * interp/modemap.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/intfile.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/incl.boot: Likewise. + * interp/word.boot: Likewise. + * interp/wi2.boot: Likewise. + * interp/wi1.boot: Likewise. + * interp/trace.boot: Likewise. + * interp/topics.boot: Likewise. + * interp/sys-constants.boot: Likewise. + * interp/showimp.boot: Likewise. + * interp/scan.boot: Likewise. + +2011-02-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/sys-macros.lisp (shellEntry): New. * interp/g-util.boot (setShellEntry): Remove. * interp/compiler.boot: Use %store to %tref forms instead of diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp index c6cbc624..360d36ef 100644 --- a/src/algebra/strap/BOOLEAN.lsp +++ b/src/algebra/strap/BOOLEAN.lsp @@ -150,16 +150,14 @@ (DEFUN |Boolean| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1399) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|Boolean|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| - (LIST (CONS NIL (CONS 1 (|Boolean;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))) + (LET ((#0=#:G1399 (HGET |$ConstructorCache| '|Boolean|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| + (LIST (CONS NIL (CONS 1 (|Boolean;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|)))))))) (DEFUN |Boolean;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index 70fb8abb..8df1f121 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -249,18 +249,14 @@ (DEFUN |Character| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1408) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|Character|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| - (LIST (CONS NIL - (CONS 1 (|Character;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))) + (LET ((#0=#:G1408 (HGET |$ConstructorCache| '|Character|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| + (LIST (CONS NIL (CONS 1 (|Character;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Character|)))))))) (DEFUN |Character;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 2d0a6877..91085f61 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -896,18 +896,16 @@ (DEFUN |DoubleFloat| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1556) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|DoubleFloat|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| - (LIST (CONS NIL - (CONS 1 (|DoubleFloat;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))) + (LET ((#0=#:G1556 (HGET |$ConstructorCache| '|DoubleFloat|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| + (LIST (CONS NIL + (CONS 1 (|DoubleFloat;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|)))))))) (DEFUN |DoubleFloat;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index 259e43d0..5eb94cfe 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -406,19 +406,17 @@ (DEFUN |IndexedList| (&REST #0=#:G1499 &AUX #1=#:G1497) (DECLARE (SPECIAL |$ConstructorCache|)) (DSETQ #1# #0#) - (PROG (#2=#:G1498) - (RETURN - (COND - ((SETQ #2# - (|lassocShiftWithFunction| (|devaluateList| #1#) - (HGET |$ConstructorCache| '|IndexedList|) - '|domainEqualList|)) - (|CDRwithIncrement| #2#)) - (T (UNWIND-PROTECT - (PROG1 (APPLY (|function| |IndexedList;|) #1#) - (SETQ #2# T)) - (COND - ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))) + (LET ((#2=#:G1498 + (|lassocShiftWithFunction| (|devaluateList| #1#) + (HGET |$ConstructorCache| '|IndexedList|) + '|domainEqualList|))) + (COND + (#2# (|CDRwithIncrement| #2#)) + (T (UNWIND-PROTECT + (PROG1 (APPLY (|function| |IndexedList;|) #1#) + (SETQ #2# T)) + (COND + ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|)))))))) (DEFUN |IndexedList;| (|#1| |#2|) (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index c206c7d8..ae8740a7 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -494,16 +494,14 @@ (DEFUN |Integer| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1511) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|Integer|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| - (LIST (CONS NIL (CONS 1 (|Integer;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))) + (LET ((#0=#:G1511 (HGET |$ConstructorCache| '|Integer|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| + (LIST (CONS NIL (CONS 1 (|Integer;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Integer|)))))))) (DEFUN |Integer;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index f9ef1671..7cbede50 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -635,18 +635,16 @@ (DEFUN |IndexedString| (#0=#:G1519) (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#1=#:G1520) - (RETURN - (COND - ((SETQ #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|IndexedString|) - '|domainEqualList|)) - (|CDRwithIncrement| #1#)) - (T (UNWIND-PROTECT - (PROG1 (|IndexedString;| #0#) (SETQ #1# T)) - (COND - ((NOT #1#) (HREM |$ConstructorCache| '|IndexedString|))))))))) + (LET ((#1=#:G1520 + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|IndexedString|) + '|domainEqualList|))) + (COND + (#1# (|CDRwithIncrement| #1#)) + (T (UNWIND-PROTECT + (PROG1 (|IndexedString;| #0#) (SETQ #1# T)) + (COND + ((NOT #1#) (HREM |$ConstructorCache| '|IndexedString|)))))))) (DEFUN |IndexedString;| (|#1|) (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp index 6c4ca272..f224231a 100644 --- a/src/algebra/strap/LIST.lsp +++ b/src/algebra/strap/LIST.lsp @@ -162,17 +162,14 @@ (DEFUN |List| (#0=#:G1421) (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#1=#:G1422) - (RETURN - (COND - ((SETQ #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|List|) - '|domainEqualList|)) - (|CDRwithIncrement| #1#)) - (T (UNWIND-PROTECT - (PROG1 (|List;| #0#) (SETQ #1# T)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))) + (LET ((#1=#:G1422 + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|List|) '|domainEqualList|))) + (COND + (#1# (|CDRwithIncrement| #1#)) + (T (UNWIND-PROTECT + (PROG1 (|List;| #0#) (SETQ #1# T)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|)))))))) (DEFUN |List;| (|#1|) (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp index ffcb6f5b..0419b586 100644 --- a/src/algebra/strap/NNI.lsp +++ b/src/algebra/strap/NNI.lsp @@ -40,21 +40,18 @@ (DEFUN |NonNegativeInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1384) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|NonNegativeInteger|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| - '|NonNegativeInteger| - (LIST (CONS NIL - (CONS 1 - (|NonNegativeInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|NonNegativeInteger|))))))))) + (LET ((#0=#:G1384 (HGET |$ConstructorCache| '|NonNegativeInteger|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| + '|NonNegativeInteger| + (LIST (CONS NIL + (CONS 1 (|NonNegativeInteger;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|NonNegativeInteger|)))))))) (DEFUN |NonNegativeInteger;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp index 36423f85..7a8ffae9 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -969,18 +969,15 @@ (DEFUN |OutputForm| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1532) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|OutputForm|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| - (LIST (CONS NIL - (CONS 1 (|OutputForm;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))) + (LET ((#0=#:G1532 (HGET |$ConstructorCache| '|OutputForm|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| + (LIST (CONS NIL + (CONS 1 (|OutputForm;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|)))))))) (DEFUN |OutputForm;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp index c6f9420d..109f6a2a 100644 --- a/src/algebra/strap/PI.lsp +++ b/src/algebra/strap/PI.lsp @@ -6,19 +6,16 @@ (DEFUN |PositiveInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1376) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|PositiveInteger|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|PositiveInteger| - (LIST (CONS NIL - (CONS 1 (|PositiveInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|PositiveInteger|))))))))) + (LET ((#0=#:G1376 (HGET |$ConstructorCache| '|PositiveInteger|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|PositiveInteger| + (LIST (CONS NIL + (CONS 1 (|PositiveInteger;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|PositiveInteger|)))))))) (DEFUN |PositiveInteger;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp index 683dbae2..87b00200 100644 --- a/src/algebra/strap/SINT.lsp +++ b/src/algebra/strap/SINT.lsp @@ -506,18 +506,16 @@ (DEFUN |SingleInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1478) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|SingleInteger|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| - (LIST (CONS NIL - (CONS 1 (|SingleInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|SingleInteger|))))))))) + (LET ((#0=#:G1478 (HGET |$ConstructorCache| '|SingleInteger|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| + (LIST (CONS NIL + (CONS 1 (|SingleInteger;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|SingleInteger|)))))))) (DEFUN |SingleInteger;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 5191e56c..298cb495 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -595,16 +595,14 @@ (DEFUN |Symbol| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1531) - (RETURN - (COND - ((SETQ #0# (HGET |$ConstructorCache| '|Symbol|)) - (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| - (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))) + (LET ((#0=#:G1531 (HGET |$ConstructorCache| '|Symbol|))) + (COND + (#0# (|CDRwithIncrement| (CDAR #0#))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| + (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|)))))))) (DEFUN |Symbol;| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp index fa232c7d..2c8e5eac 100644 --- a/src/algebra/strap/VECTOR.lsp +++ b/src/algebra/strap/VECTOR.lsp @@ -28,17 +28,15 @@ (DEFUN |Vector| (#0=#:G1383) (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#1=#:G1384) - (RETURN - (COND - ((SETQ #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|Vector|) - '|domainEqualList|)) - (|CDRwithIncrement| #1#)) - (T (UNWIND-PROTECT - (PROG1 (|Vector;| #0#) (SETQ #1# T)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|))))))))) + (LET ((#1=#:G1384 + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|Vector|) + '|domainEqualList|))) + (COND + (#1# (|CDRwithIncrement| #1#)) + (T (UNWIND-PROTECT + (PROG1 (|Vector;| #0#) (SETQ #1# T)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|)))))))) (DEFUN |Vector;| (|#1|) (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 8d3f8c5c..3dce3667 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -149,7 +149,7 @@ quote x == bfGenSymbol: () -> %Symbol bfGenSymbol()== $GenVarCounter := $GenVarCounter+1 - INTERN strconc('"bfVar#",toString $GenVarCounter) + makeSymbol strconc('"bfVar#",toString $GenVarCounter) bfColon: %Thing -> %List bfColon x== @@ -159,7 +159,7 @@ bfColonColon: (%Symbol,%Symbol) -> %Symbol bfColonColon(package, name) == %hasFeature KEYWORD::CLISP and package in '(EXT FFI) => FIND_-SYMBOL(PNAME name,package) - INTERN(PNAME name, package) + makeSymbol(PNAME name, package) bfSymbol: %Thing -> %Thing bfSymbol x== @@ -497,7 +497,7 @@ defSheepAndGoats(x)== argl = nil => opassoc := [[op,:body]] [opassoc,[],[]] - op1 := INTERN strconc(PNAME $op,'",",PNAME op) + op1 := makeSymbol strconc(PNAME $op,'",",PNAME op) opassoc := [[op,:op1]] defstack := [[op1,args,body]] [opassoc,defstack,[]] @@ -531,7 +531,7 @@ bfLET1(lhs,rhs) == l2 is ["PROGN",:.] => bfMKPROGN [l1,:rest l2] if symbol? first l2 then l2 := [l2,:nil] bfMKPROGN [l1,:l2,name] - g := INTERN strconc('"LETTMP#",toString $letGenVarCounter) + g := makeSymbol strconc('"LETTMP#",toString $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 rhs1 := ['L%T,g,rhs] let1 := bfLET1(lhs,g) @@ -568,7 +568,7 @@ bfLET2(lhs,rhs) == lhs is ['APPEND,var1,var2] => patrev := bfISReverse(var2,var1) rev := ['REVERSE,rhs] - g := INTERN strconc('"LETTMP#", toString $letGenVarCounter) + g := makeSymbol strconc('"LETTMP#", toString $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 l2 := bfLET2(patrev,g) if cons? l2 and atom first l2 then l2 := [l2,:nil] @@ -653,7 +653,7 @@ bfIS1(lhs,rhs) == bfAND [bfIS1(lhs,d),bfMKPROGN [l,'T]] rhs is ["EQUAL",a] => bfQ(lhs,a) cons? lhs => - g := INTERN strconc('"ISTMP#",toString $isGenVarCounter) + g := makeSymbol strconc('"ISTMP#",toString $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)] rhs is ['CONS,a,b] => @@ -670,7 +670,7 @@ bfIS1(lhs,rhs) == bfAND [['CONSP,lhs],a1,b1] rhs is ['APPEND,a,b] => patrev := bfISReverse(b,a) - g := INTERN strconc('"ISTMP#",toString $isGenVarCounter) + g := makeSymbol strconc('"ISTMP#",toString $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],'T]] l2 := bfIS1(g,patrev) @@ -810,7 +810,7 @@ bfDef1 [op,args,body] == shoeLAM (op,args,control,body)== margs :=bfGenSymbol() - innerfunc:=INTERN strconc(PNAME op,",LAM") + innerfunc:= makeSymbol strconc(PNAME op,",LAM") [[innerfunc,["LAMBDA",args,body]], [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc], ["WRAP",margs, ["QUOTE", control]]]]]] @@ -1077,7 +1077,7 @@ bfWhere (context,expr)== -- [exp,:shoeReadLispString(s,ind)] bfCompHash(op,argl,body) == - auxfn:= INTERN strconc(PNAME op,'";") + auxfn:= makeSymbol strconc(PNAME op,'";") computeFunction:= ["DEFUN",auxfn,argl,:body] bfTuple [computeFunction,:bfMain(auxfn,op)] @@ -1091,7 +1091,7 @@ bfMain(auxfn,op)== g1:= bfGenSymbol() arg:=["&REST",g1] computeValue := ['APPLY,["FUNCTION",auxfn],g1] - cacheName:= INTERN strconc(PNAME op,'";AL") + cacheName:= makeSymbol strconc(PNAME op,'";AL") g2:= bfGenSymbol() getCode:= ['GETHASH,g1,cacheName] secondPredPair:= [['SETQ,g2,getCode],g2] @@ -1163,7 +1163,7 @@ bfCI(g,x,y)== bfCARCDR: (%Short,%Thing) -> %List bfCARCDR(n,g) == - [INTERN strconc('"CA",bfDs n,'"R"),g] + [makeSymbol strconc('"CA",bfDs n,'"R"),g] bfDs: %Short -> %String bfDs n == @@ -1313,11 +1313,11 @@ isSimpleNativeType t == coreSymbol: %Symbol -> %Symbol coreSymbol s == - INTERN(PNAME s, "AxiomCore") + makeSymbol(PNAME s, "AxiomCore") bootSymbol: %Symbol -> %Symbol bootSymbol s == - INTERN PNAME s + makeSymbol PNAME s unknownNativeTypeError t == @@ -1550,7 +1550,7 @@ genCLISPnativeTranslation(op,s,t,op') == -- from the same class. Consequently, we must allocate C-storage, -- copy data there, pass pointers to them, and possibly copy -- them back. Ugh. - n := INTERN strconc(PNAME op, '"%clisp-hack") + n := makeSymbol strconc(PNAME op, '"%clisp-hack") parms := [gensym '"parm" for x in s] -- parameters of the forward decl. -- Now, separate non-simple data from the rest. This is a triple-list @@ -1624,13 +1624,13 @@ genSBCLnativeTranslation(op,s,t,op') == unstableArgs = nil => [["DEFUN",op,args, - [INTERN('"ALIEN-FUNCALL",'"SB-ALIEN"), - [INTERN('"EXTERN-ALIEN",'"SB-ALIEN"), op', + [makeSymbol('"ALIEN-FUNCALL",'"SB-ALIEN"), + [makeSymbol('"EXTERN-ALIEN",'"SB-ALIEN"), op', ["FUNCTION",rettype,:argtypes]], :args]]] [["DEFUN",op,args, [bfColonColon("SB-SYS","WITH-PINNED-OBJECTS"), nreverse unstableArgs, - [INTERN('"ALIEN-FUNCALL",'"SB-ALIEN"), - [INTERN('"EXTERN-ALIEN",'"SB-ALIEN"), op', + [makeSymbol('"ALIEN-FUNCALL",'"SB-ALIEN"), + [makeSymbol('"EXTERN-ALIEN",'"SB-ALIEN"), op', ["FUNCTION",rettype,:argtypes]], :nreverse newArgs]]]] diff --git a/src/boot/parser.boot b/src/boot/parser.boot index ff0d0cc4..03c2f639 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -629,7 +629,7 @@ bpLeftAssoc(operations,parser)== bpString()== shoeTokType $stok = "STRING" and - bpPush(["QUOTE",INTERN $ttok]) and bpNext() + bpPush(["QUOTE",makeSymbol $ttok]) and bpNext() bpThetaName() == $stok is ["ID",:.] and $ttok has SHOETHETA => @@ -1050,7 +1050,7 @@ bpRegularBVItem() == bpBVString()== shoeTokType $stok = "STRING" and - bpPush(["BVQUOTE",INTERN $ttok]) and bpNext() + bpPush(["BVQUOTE",makeSymbol $ttok]) and bpNext() bpRegularBVItemL() == bpRegularBVItem() and bpPush [bpPop1()] diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index 3b521975..8066ee94 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -184,7 +184,7 @@ shoeToken () == -- to pair badge and badgee shoeLeafId x == - ["ID",INTERN x] + ["ID",makeSymbol x] shoeLeafKey x== ["KEY",shoeKeyWord x] diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 013f5e2b..b33cbc0b 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -215,7 +215,8 @@ (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|lowerCase?| 'LOWER-CASE-P) - (LIST '|mkpf| 'MKPF) (LIST '|nconc| 'NCONC) + (LIST '|makeSymbol| 'INTERN) (LIST '|mkpf| 'MKPF) + (LIST '|nconc| 'NCONC) (LIST '|newString| 'MAKE-STRING) (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL) (LIST '|not| 'NOT) (LIST '|nreverse| 'NREVERSE) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 26b59767..af6f83a8 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -269,6 +269,7 @@ for i in [ _ ["LAST", "last"] , _ ["list", "LIST"] , _ ["lowerCase?", "LOWER-CASE-P"], _ + ["makeSymbol", "INTERN"] , _ ["mkpf", "MKPF"] , _ ["nconc", "NCONC"] , _ ["newString", "MAKE-STRING"], _ diff --git a/src/boot/translator.boot b/src/boot/translator.boot index c964f48f..b071fd0a 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -53,7 +53,7 @@ genModuleFinalization(stream) == $currentModuleName = nil => coreError '"current module has no name" init := - ["DEFUN", INTERN strconc($currentModuleName,"InitCLispFFI"), nil, + ["DEFUN", makeSymbol strconc($currentModuleName,"InitCLispFFI"), nil, ["MAPC",["FUNCTION", "FMAKUNBOUND"], ["QUOTE",[second d for d in $foreignsDefsForCLisp]]], :[["EVAL",["QUOTE",d]] for d in $foreignsDefsForCLisp]] @@ -657,7 +657,7 @@ shoeItem (str)== stripm (x,pk,bt)== atom x => symbol? x => - SYMBOL_-PACKAGE x = bt => INTERN(PNAME x,pk) + SYMBOL_-PACKAGE x = bt => makeSymbol(PNAME x,pk) x x [stripm(first x,pk,bt),:stripm(rest x,pk,bt)] diff --git a/src/interp/alql.boot b/src/interp/alql.boot index 59d25d42..4bc574fe 100644 --- a/src/interp/alql.boot +++ b/src/interp/alql.boot @@ -38,7 +38,7 @@ namespace BOOT getBrowseDatabase(kind) == $includeUnexposed? : local := true not (kind in '("o" "k" "c" "d" "p")) => nil - grepConstruct('"*",INTERN kind) + grepConstruct('"*",makeSymbol kind) stringMatches?(pattern,subject) == integer? basicMatch?(pattern,subject) => true diff --git a/src/interp/as.boot b/src/interp/as.boot index 0c167248..d7e1aac1 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -109,7 +109,7 @@ asySubstMapping u == u --asyFilePackage asyFile == --- name := INTERN PATHNAME_-NAME asyFile +-- name := makeSymbol PATHNAME_-NAME asyFile -- modemap := -- [[[name],['CATEGORY,'domain, -- :[asyMkSignature(con,CDAR mm) for [con,:mm] in $mmAlist]]],['T,name]] @@ -701,12 +701,12 @@ asyAbbreviation(id,n) == chk(id,main) where --> n = number of arguments main() == a := createAbbreviation id => a name := PNAME id --- #name < 8 => INTERN UPCASE name +-- #name < 8 => makeSymbol UPCASE name parts := asySplit(name,MAXINDEX name) newname := strconc/[asyShorten x for x in parts] - #newname < 8 => INTERN newname + #newname < 8 => makeSymbol newname tryname := subString(name,0,7) - not createAbbreviation tryname => INTERN UPCASE tryname + not createAbbreviation tryname => makeSymbol UPCASE tryname nil chk(conname,abb) == (xx := asyGetAbbrevFromComments conname) => xx @@ -753,7 +753,7 @@ asySplit(name,end) == [subString(name,0,k),:asySplit(subString(name,k),end-k)] createAbbreviation s == - if string? s then s := INTERN s + if string? s then s := makeSymbol s a := constructor? s a ~= s => a nil diff --git a/src/interp/ax.boot b/src/interp/ax.boot index 5e843b71..19bd6154 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -53,7 +53,7 @@ setExtendedDomains(l) == $extendedDomains := l fileConstructors name == - [INTERN(con,"BOOT") for con in SRCABBREVS SOURCEPATH STRING name] + [makeSymbol(con,"BOOT") for con in SRCABBREVS SOURCEPATH STRING name] makeAxFile(filename, constructors) == $defaultFlag : local := false @@ -121,7 +121,7 @@ modemapToAx(modemap) == null args => ['Extend, ['Define, ['Declare, constructor, resultType], ['Add, ['PretendTo, ['Add, [], []], resultType], []]]] - conscat := INTERN(strconc(symbolName(constructor), "ExtendCategory"),"BOOT") + conscat := makeSymbol(strconc(symbolName(constructor), "ExtendCategory"),"BOOT") rtype := ['Apply, conscat, :args] -- if resultType is ['With,a,b] then -- if not(b is ['Sequence,:withseq]) then withseq := [b] @@ -167,7 +167,7 @@ axFormatType(typeform) == atom typeform => typeform = '$ => '% string? typeform => - ['Apply,'Enumeration, INTERN typeform] + ['Apply,'Enumeration, makeSymbol typeform] integer? typeform => -- need to test for PositiveInteger vs Integer axAddLiteral('integer, 'PositiveInteger, 'Literal) @@ -211,8 +211,8 @@ axFormatType(typeform) == valueCount := 0 for x in args repeat tag := - string? x => INTERN x - x is ['QUOTE,val] and string? val => INTERN val + string? x => makeSymbol x + x is ['QUOTE,val] and string? val => makeSymbol val valueCount := valueCount + 1 INTERNL("value", STRINGIMAGE valueCount) taglist := [tag ,: taglist] diff --git a/src/interp/bc-matrix.boot b/src/interp/bc-matrix.boot index f70c168c..033bf212 100644 --- a/src/interp/bc-matrix.boot +++ b/src/interp/bc-matrix.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -118,8 +118,8 @@ bcInputExplicitMatrix(htPage,junk) == rowpart := strconc('"{\em Row",htStringPad(i,wrows)) colpart := strconc('", Column",htStringPad(j,wcols),'":}\space{2}") prefix := strconc(rowpart,colpart) - -- name := INTERN strconc(htMkName('"row",i),htMkName('"col",j)) - name := INTERN STRINGIMAGE (k := k + 1) + -- name := makeSymbol strconc(htMkName('"row",i),htMkName('"col",j)) + name := makeSymbol STRINGIMAGE (k := k + 1) [prefix,'"",30, 0,name,'P] labelList := [['domainConditions, '(isDomain P (Polynomial $EmptyMode)), cond], diff --git a/src/interp/bc-solve.boot b/src/interp/bc-solve.boot index e3062226..abdc8293 100644 --- a/src/interp/bc-solve.boot +++ b/src/interp/bc-solve.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -146,8 +146,8 @@ bcInputEquations(htPage,solutionMethod) == spacer := (i > 99 => 0; i > 9 => 1; 2) prefix := strconc('"\newline\tab{2}{\em Equation ",STRINGIMAGE i,'":}") prefix := strconc(prefix,'"\space{",STRINGIMAGE spacer,'"}") - lnam := INTERN strconc('"l",STRINGIMAGE i) - rnam := INTERN strconc('"r",STRINGIMAGE i) + lnam := makeSymbol strconc('"l",STRINGIMAGE i) + rnam := makeSymbol strconc('"r",STRINGIMAGE i) var:= linearp => bcMakeLinearEquations(i,n) bcMakeEquations(i,n) @@ -278,7 +278,7 @@ bcLinearSolveMatrixInhomo(htPage,junk) == prefix := strconc('"{\em Coefficient ",STRINGIMAGE i,'":}") if spacer ~= 0 then prefix := strconc(prefix,'"\space{",STRINGIMAGE spacer,'"}") - name := INTERN strconc('"c",STRINGIMAGE i) + name := makeSymbol strconc('"c",STRINGIMAGE i) [prefix,"",30, 0,name, 'P] page := htInitPage('"Linear Solve Basic Command",htpPropertyList htPage) htpSetProperty(page,'matrix,htpProperty(htPage,'matrix)) diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index df066221..d12e0d23 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -77,7 +77,7 @@ conPageFastPath x == --called by conPage and constructorSearch --gets line quickly for constructor name or abbreviation s := STRINGIMAGE x charPosition(char '_*,s,0) < #s => nil --quit if name has * in it - name := (string? x => INTERN x; x) + name := (string? x => makeSymbol x; x) entry := HGET($lowerCaseConTb,name) or return nil lineNumber := LASSQ('dbLineNumber,CDDR entry) => --'dbLineNumbers property is set by function dbAugmentConstructorDataTable @@ -110,7 +110,7 @@ conPageConEntry entry == --% conname := opOf conform --% capitalKind := capitalize kind --% signature := ncParseFromString sig ---% sourceFileName := dbSourceFile INTERN name +--% sourceFileName := dbSourceFile makeSymbol name --% constrings := --% KDR form => dbConformGenUnder form --% [strconc(name,args)] @@ -176,8 +176,8 @@ kdPageInfo(name,abbrev,nargs,conform,signature,file?) == if nargs > 0 then kPageArgs(conform,signature) htSayStandard '"\indentrel{-2}" if name.(#name-1) = char "&" then name := subSequence(name, 0, #name-1) ---sourceFileName := dbSourceFile INTERN name - sourceFileName := getConstructorSourceFileFromDB INTERN name +--sourceFileName := dbSourceFile makeSymbol name + sourceFileName := getConstructorSourceFileFromDB makeSymbol name filename := extractFileNameFromPath sourceFileName if filename ~= '"" then htSayStandard '"\newline{}" @@ -577,13 +577,13 @@ augmentHasArgs(alist,conform) == kcdePage(htPage,junk) == [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - conname := INTERN name + conname := makeSymbol name constring := strconc(name,args) conform := kind ~= '"default package" => ncParseFromString constring - [INTERN name,:rest ncParseFromString strconc('"d",args)] --because of & + [makeSymbol name,:rest ncParseFromString strconc('"d",args)] --because of & pakname := --- kind = '"category" => INTERN strconc(name,'"&") +-- kind = '"category" => makeSymbol strconc(name,'"&") opOf conform domList := getDependentsOfConstructor pakname cAlist := [[getConstructorForm x,:true] for x in domList] @@ -593,13 +593,13 @@ kcdePage(htPage,junk) == kcuPage(htPage,junk) == [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - conname := INTERN name + conname := makeSymbol name constring := strconc(name,args) conform := kind ~= '"default package" => ncParseFromString constring - [INTERN name,:rest ncParseFromString strconc('"d",args)] --because of & + [makeSymbol name,:rest ncParseFromString strconc('"d",args)] --because of & pakname := - kind = '"category" => INTERN strconc(name,'"&") + kind = '"category" => makeSymbol strconc(name,'"&") opOf conform domList := getUsersOfConstructor pakname cAlist := [[getConstructorForm x,:true] for x in domList] @@ -620,7 +620,7 @@ kcnPage(htPage,junk) == htpSetProperty(htPage,'heading,heading) conform:= htpProperty(htPage,'conform) pakname := - kind = '"category" => INTERN strconc(PNAME name,'"&") + kind = '"category" => makeSymbol strconc(PNAME name,'"&") opOf conform domList := getImports pakname if domname then @@ -631,7 +631,7 @@ kcnPage(htPage,junk) == dbShowCons(htPage,'names) koPageInputAreaUnchanged?(htPage, nargs) == - [htpLabelInputString(htPage,INTERN strconc('"*",STRINGIMAGE i)) for i in 1..nargs] + [htpLabelInputString(htPage,makeSymbol strconc('"*",STRINGIMAGE i)) for i in 1..nargs] = htpProperty(htPage,'inputAreaList) kDomainName(htPage,kind,name,nargs) == @@ -639,7 +639,7 @@ kDomainName(htPage,kind,name,nargs) == inputAreaList := [htpLabelInputString(htPage,var) for i in 1..nargs for var in $PatternVariableList] htpSetProperty(htPage,'inputAreaList,inputAreaList) - conname := INTERN name + conname := makeSymbol name args := [kArgumentCheck(domain?,x) or nil for x in inputAreaList for domain? in rest getDualSignatureFromDB conname] or/[null x for x in args] => @@ -711,7 +711,7 @@ mkConform(kind,name,argString) == systemError '"Keywords in argument list?" atom parse => [parse] parse - [INTERN name,:rest ncParseFromString strconc('"d",argString)] --& case + [makeSymbol name,:rest ncParseFromString strconc('"d",argString)] --& case --======================================================================= -- Operation Page for a Domain Form from Scratch @@ -754,7 +754,7 @@ conOpPage1(conform,:options) == conform := mkConform(kind,name,args) capitalKind := capitalize kind signature := ncParseFromString sig - sourceFileName := dbSourceFile INTERN name + sourceFileName := dbSourceFile makeSymbol name emString := ['"{\sf ",constring,'"}"] heading := [capitalKind,'" ",:emString] if not isExposedConstructor conname then heading := ['"Unexposed ",:heading] @@ -778,7 +778,7 @@ conOpPage1(conform,:options) == koPage(htPage,which) == [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) constring := strconc(name,args) - conname := INTERN name + conname := makeSymbol name domname := (u := htpProperty(htPage,'domname)) is [=conname,:.] and (htpProperty(htPage,'fromConOpPage1) = true or @@ -1308,7 +1308,7 @@ PUT('Enumeration, 'documentation, substitute(MESSAGE, 'MESSAGE, '( mkConArgSublis args == - [[arg,:INTERN digits2Names PNAME arg] for arg in args + [[arg,:makeSymbol digits2Names PNAME arg] for arg in args | (s := PNAME arg) and "or"/[digit? s.i for i in 0..MAXINDEX s]] digits2Names s == diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index ef6a6972..822efdc3 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -231,7 +231,7 @@ dbAugmentConstructorDataTable() == while not EOFP instream repeat fp := FILE_-POSITION instream line := READLINE instream - cname := INTERN dbName line + cname := makeSymbol dbName line entry := getCDTEntry(cname,true) => --skip over Mapping, Union, Record [name,abb,:.] := entry entry.rest.rest := PUTALIST(CDDR entry,'dbLineNumber,fp) @@ -247,7 +247,7 @@ dbHasExamplePage conname == abb := constructor? conname ucname := UPCASE STRINGIMAGE abb pathname :=strconc(systemRootDirectory(),'"/share/hypertex/pages/",ucname,'".ht") - isExistingFile pathname => INTERN strconc(sname,'"XmpPage") + isExistingFile pathname => makeSymbol strconc(sname,'"XmpPage") nil dbRead(n) == @@ -433,9 +433,9 @@ mkUsersHashTable() == --called by buildDatabase (database.boot) $usersTb getDefaultPackageClients con == --called by mkUsersHashTable - catname := INTERN subString(s := PNAME con,0,MAXINDEX s) + catname := makeSymbol subString(s := PNAME con,0,MAXINDEX s) for [catAncestor,:.] in childrenOf([catname]) repeat - pakname := INTERN strconc(PNAME catAncestor,'"&") + pakname := makeSymbol strconc(PNAME catAncestor,'"&") if getCDTEntry(pakname,true) then acc := [pakname,:acc] acc := union([CAAR x for x in domainsOf([catAncestor],nil)],acc) listSort(function GLESSEQP,acc) diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 3dc6086a..22ced871 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -545,7 +545,7 @@ opPageFastPath opstring == --return nil x := STRINGIMAGE opstring charPosition(char '_*,x,0) < #x => nil --quit if name has * in it - op := (string? x => INTERN x; x) + op := (string? x => makeSymbol x; x) mmList := getAllModemapsFromDatabase(op,nil) or return nil opAlist := [[op,:[item for mm in mmList]]] where item() == [predList, origin, sig] := modemap2Sig(op, mm) diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index 4f4983c8..64274acf 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -78,7 +78,7 @@ dbShowInfoOp(htPage,op,sig,alist) == kind := getConstructorKindFromDB conname honestConform := kind = 'category => - [INTERN strconc(PNAME conname,'"&"),"$",:rest conform] + [makeSymbol strconc(PNAME conname,'"&"),"$",:rest conform] conform faTypes := CDDAR getConstructorModemapFromDB conname @@ -252,7 +252,7 @@ hasNewInfoText u == getInfoAlist conname == cat? := getConstructorKindFromDB conname = "category" - if cat? then conname := INTERN strconc(STRINGIMAGE conname,'"&") + if cat? then conname := makeSymbol strconc(STRINGIMAGE conname,'"&") abb := constructor? conname or return '"not a constructor" fs := strconc(PNAME abb,'".NRLIB/info") inStream := diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 27a2b847..08ad1bb9 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -627,7 +627,7 @@ kPage(line,:options) == --any cat, dom, package, default package conname := opOf conform capitalKind := capitalize kind signature := ncParseFromString sig - sourceFileName := dbSourceFile INTERN name + sourceFileName := dbSourceFile makeSymbol name constrings := KDR form => dbConformGenUnder form [strconc(name,args)] @@ -1717,7 +1717,7 @@ purgeNewConstructorLines(lines, conlist) == -- screenLocalLine1(line, conlist) == screenLocalLine(line, conlist) == k := dbKind line - con := INTERN + con := makeSymbol k = char 'o or k = char 'a => s := dbPart(line,5,1) k := charPosition(char '_(,s,1) diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index b17045a2..c7f24eed 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -76,7 +76,7 @@ grepConstructDo(x, key) == grepf(x,key,false) dbExposed?(line,kind) == -- does line come from an unexposed constructor? - conname := INTERN + conname := makeSymbol kind = char 'a or kind = char 'o => dbNewConname line --get conname from middle dbName line isExposedConstructor conname @@ -655,7 +655,7 @@ constructorSearch(filter,key,kind) == (parse := conSpecialString? filter) => conPage parse pageName := LASSOC(DOWNCASE filter,'(("union" . DomainUnion)("record" . DomainRecord)("mapping" . DomainMapping) ("enumeration" . DomainEnumeration))) => downlink pageName - name := (string? filter => INTERN filter; filter) + name := (string? filter => makeSymbol filter; filter) if u := HGET($lowerCaseConTb,name) then filter := STRINGIMAGE first u line := conPageFastPath DOWNCASE filter => code := dbKind line @@ -719,7 +719,7 @@ conLowerCaseConTran x == string2Constructor x == not string? x => x - IFCAR HGET($lowerCaseConTb, INTERN DOWNCASE x) or x + IFCAR HGET($lowerCaseConTb, makeSymbol DOWNCASE x) or x conLowerCaseConTranTryHarder x == IDENTP x => IFCAR HGET($lowerCaseConTb,DOWNCASE x) or x @@ -933,7 +933,7 @@ dbGetCommentOrigin line == --Comment lines have format [dcpxoa]xxxxxx`ccccc... where --x's give pointer into libdb, c's are comments firstPart := dbPart(line,1,-1) - key := INTERN subString(firstPart,0,1) --extract this and throw away + key := makeSymbol subString(firstPart,0,1) --extract this and throw away address := subString(firstPart, 1) --address in libdb instream := OPEN grepSource key --this always returns libdb now FILE_-POSITION(instream,readInteger address) diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 1a49bd7c..c738b784 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -1143,7 +1143,7 @@ checkTransformFirsts(opname,u,margin) == u strconc('"\spad{",subString(u,0,k + 1),'"}",subString(u,k + 1)) k := checkSkipToken(u,j,m) or return u - infixOp := INTERN subString(u,j,k - j) + infixOp := makeSymbol subString(u,j,k - j) not GETL(infixOp,'Led) => --case 3 namestring ~= (firstWord := subString(u,0,i)) => checkDocError ['"Improper first word in comments: ",firstWord] @@ -1165,7 +1165,7 @@ checkTransformFirsts(opname,u,margin) == namestring ~= (firstWord := subString(u,0,i)) => checkDocError ['"Improper first word in comments: ",firstWord] u - prefixOp := INTERN subString(u,0,i) + prefixOp := makeSymbol subString(u,0,i) not GETL(prefixOp,'Nud) => u ---what could this be? j := checkSkipBlanks(u,i,m) or return u diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index ab41941f..8312e4b1 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -264,7 +264,7 @@ mkErrorExpr level == highlight(b,a) == atom b => substitute(var,b,a) where - var:= INTERN strconc(STRINGIMAGE $bright,STRINGIMAGE b,STRINGIMAGE $dim) + var:= makeSymbol strconc(STRINGIMAGE $bright,STRINGIMAGE b,STRINGIMAGE $dim) highlight1(b,a) where highlight1(b,a) == atom a => a diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 6a85ca07..6a014d9f 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -175,7 +175,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == -- (<argument list>, <reference count>,:<value>) -- where the reference count is optional - if cacheNameOrNil and cacheNameOrNil~='_$ConstructorCache then + if cacheNameOrNil and cacheNameOrNil ~= '_$ConstructorCache then keyedSystemError("S2GE0010",[op]) --restriction due to omission of call to hputNewValue (see *** lines below) @@ -229,7 +229,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == ['HGET,cacheNameOrNil,MKQ op],MKQ eqEtc] ['lassocShift,cacheArgKey,['HGET,cacheNameOrNil,MKQ op]] ['HGET,cacheName,g1] - secondPredPair:= [['%store,g2,getCode],:hitCountCode,returnFoundValue] + secondPredPair:= [g2,optSEQ ['SEQ,:hitCountCode,['EXIT,returnFoundValue]]] putCode:= null argl => cacheNameOrNil => @@ -246,9 +246,9 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]], ['%when,[['%not,g2],['HREM,cacheName,MKQ op]]]] thirdPredPair:= ['%otherwise,putCode] - codeBody:= - ['PROG,[g2], - :callCountCode,['RETURN,['%when,secondPredPair,thirdPredPair]]] + codeBody:= optSEQ + ['SEQ,:callCountCode, + ['EXIT,['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] computeFunction:= [auxfn,['LAMBDA,argl,:body]] @@ -293,19 +293,19 @@ compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == argl is [.] => [auxfn,g1] --g1 is a parameter ['APPLX,['function,auxfn],g1] --g1 is a parameter list [g1,['consForHashLookup,MKQ op,g1],application] - g2:= gensym() --value computed by calling function + g2 := gensym() --value computed by calling function returnFoundValue:= countFl => ['CDRwithIncrement,g2] g2 getCode:= ['HGET,cacheName,cacheArgKey] - secondPredPair:= [['%store,g2,getCode],returnFoundValue] + secondPredPair:= [g2,returnFoundValue] putForm:= ['%pair,MKQ op,g1] putCode:= countFl => ['HPUT,cacheName,putForm,['%pair,1,computeValue]] ['HPUT,cacheName,putForm,computeValue] - thirdPredPair:= ['%otherwise,putCode] - codeBody:= ['PROG,[g2], ['RETURN,['%when,secondPredPair,thirdPredPair]]] - lamex:= ['LAM,arg,codeBody] + thirdPredPair := ['%otherwise,putCode] + codeBody := ['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]] + lamex := ['LAM,arg,codeBody] mainFunction:= [op,lamex] computeFunction:= [auxfn,['LAMBDA,argl,:body]] compileInteractive mainFunction @@ -705,4 +705,4 @@ domainEqualList(argl1,argl2) == removeAllClams() == for [fun,:.] in $clamList repeat sayBrightly ['"Un-clamming function",'"%b",fun,'"%d"] - setDynamicBinding(fun,eval INTERN strconc(STRINGIMAGE fun,'";")) + setDynamicBinding(fun,eval makeSymbol strconc(STRINGIMAGE fun,'";")) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 6b83d268..b0fc14e4 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -258,7 +258,7 @@ applyMapping([op,:argl],m,e,ml) == -- form:= -- not MEMQ(op,$formalArgList) and atom op => -- [op',:argl',"$"] where --- op':= INTERN strconc(STRINGIMAGE $prefix,";",STRINGIMAGE op) +-- op':= makeSymbol strconc(STRINGIMAGE $prefix,";",STRINGIMAGE op) -- ['%call,["applyFun",op],:argl'] -- pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] -- convert([form,SUBLIS(pairlis,first ml),e],m) @@ -353,7 +353,7 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] ) and extendsCategoryForm("$",target,m') then return [x,m,e] x is ["+->",:.] => compLambda(x,m,oldE) - if string? x then x:= INTERN x + if string? x then x:= makeSymbol x for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat [.,.,e]:= compMakeDeclaration(v,m,e) (vl ~= nil) and not hasFormalMapVariable(x, vl) => return @@ -1314,7 +1314,7 @@ compImport(["import",:doms],m,e) == bootDenotation: %Symbol -> %Symbol bootDenotation s == - INTERN(symbolName s,"BOOTTRAN") + makeSymbol(symbolName s,"BOOTTRAN") ++ Return the Boot denotation of a basic FFI type. getBasicFFIType: %Mode -> %Symbol @@ -2223,7 +2223,7 @@ compReduce(form,m,e) == compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) == [collectOp,:itl,body] := collectForm - if string? op then op := INTERN op + if string? op then op := makeSymbol op collectOp ~= "COLLECT" => systemError ['"illegal reduction form:",form] $until: local := nil oldEnv := e diff --git a/src/interp/define.boot b/src/interp/define.boot index c0ede0fa..b921d206 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -296,7 +296,7 @@ compDefine1(form,m,e) == $formalArgList) null $form => stackAndThrow ['"bad == form ",form] newPrefix:= - $prefix => INTERN strconc(encodeItem $prefix,'",",encodeItem $op) + $prefix => makeSymbol strconc(encodeItem $prefix,'",",encodeItem $op) getConstructorAbbreviationFromDB $op compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList) @@ -431,8 +431,8 @@ makeCategoryPredicates(form,u) == pl mkCategoryPackage(form is [op,:argl],cat,def) == - packageName:= INTERN(strconc(symbolName op,'"&")) - packageAbb := INTERN(strconc(getConstructorAbbreviationFromDB op,'"-")) + packageName:= makeSymbol(strconc(symbolName op,'"&")) + packageAbb := makeSymbol(strconc(getConstructorAbbreviationFromDB op,'"-")) $options:local := [] -- This stops the next line from becoming confused abbreviationsSpad2Cmd ['domain,packageAbb,packageName] @@ -1212,7 +1212,7 @@ compile u == (and/[modeEqual(x,y) for x in sig for y in $signatureOfForm])] isLocalFunction op => if opexport then userError ['"%b",op,'"%d",'" is local and exported"] - INTERN strconc(encodeItem $prefix,'";",encodeItem op) + makeSymbol strconc(encodeItem $prefix,'";",encodeItem op) encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix) where isLocalFunction op == @@ -1687,7 +1687,7 @@ DomainSubstitutionFunction(parameters,body) == atom $definition => body null $definition.args => body --should not bother if it will only be called once - name:= INTERN strconc(KAR $definition,";CAT") + name:= makeSymbol strconc(KAR $definition,";CAT") SETANDFILE(name,nil) body:= ['%when,[name],['%otherwise,['%store,name,body]]] body diff --git a/src/interp/format.boot b/src/interp/format.boot index 2acc4e80..519d0169 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -175,7 +175,7 @@ reportOpSymbol op1 == if op1 = "^" then sayMessage ['" ",op1, '" is another name for", :bright '"**"] op1 := "**" - op := (string? op1 => INTERN op1; op1) + op := (string? op1 => makeSymbol op1; op1) modemaps := getAllModemapsFromDatabase(op,nil) null modemaps => ok := true @@ -587,7 +587,7 @@ linearFormatForm(op,argl) == s:= PNAME op indexList:= [readInteger PNAME d for i in 1.. while (digit? (d:= s.(maxIndex:= i)))] - cleanOp:= INTERN (strconc/[PNAME s.i for i in maxIndex..MAXINDEX s]) + cleanOp:= makeSymbol (strconc/[PNAME s.i for i in maxIndex..MAXINDEX s]) fnArgs:= indexList.0 > 0 => concat('"(",formatArgList take(-indexList.0,argl),'")") @@ -744,7 +744,7 @@ object2String x == object2Identifier x == IDENTP x => x - INTERN object2String x + makeSymbol object2String x blankList x == "append"/[[BLANK,y] for y in x] diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 42c6ba4d..7f47e5a5 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -107,7 +107,7 @@ writeCFile(name,args,fortranArgs,dummies,decls,results,returnType,asps,fp) == routineName := name -- If it is a function then give it somewhere to stick its result: if returnType then - returnName := INTERN strconc(name,'"__result") + returnName := makeSymbol strconc(name,'"__result") wl(['" ",getCType returnType,'" ",returnName,'",",routineName,'"();"],fp) -- print out type declarations for the Fortran parameters, and build an -- ordered list of pairs [<parameter> , <type>] @@ -300,18 +300,18 @@ makeSpadFun(name,userArgs,args,dummies,decls,results,returnType,asps,aspInfo, -- To make sure the spad interpreter isn't confused: if returnType then - returnName := INTERN strconc(name,'"Result") + returnName := makeSymbol strconc(name,'"Result") decls := [[returnType,returnName], :decls] results := [returnName, :results] - argNames := [INTERN strconc(STRINGIMAGE(u),'"__arg") for u in userArgs] + argNames := [makeSymbol strconc(STRINGIMAGE(u),'"__arg") for u in userArgs] aType := [axiomType(a,decls,asps,aspInfo) for a in userArgs] aspTypes := [second NTH(POSITION(u,userArgs),aType) for u in asps] nilLst := MAKE_-LIST(#args+1) decPar := [["$elt","Lisp","construct"],:makeLispList decls] - fargNames := [INTERN strconc(STRINGIMAGE(u),'"__arg") for u in args | + fargNames := [makeSymbol strconc(STRINGIMAGE(u),'"__arg") for u in args | not (MEMQ(u,dummies) or MEMQ(u,asps)) ] for u in asps repeat - fargNames := delete(INTERN strconc(STRINGIMAGE(u),'"__arg"),fargNames) + fargNames := delete(makeSymbol strconc(STRINGIMAGE(u),'"__arg"),fargNames) resPar := ["construct",["@",["construct",:fargNames],_ ["List",["Any"]]]] call := [["$elt","Lisp","invokeFortran"],strconc(file,'".spadexe"),_ @@ -363,7 +363,7 @@ makeAspGenerators(asps,types,aspId) == makeAspGenerators1(asp,type,aspId) == [[["$elt","FOP","pushFortranOutputStack"] ,_ ["filename",'"",strconc(STRINGIMAGE asp,aspId),'"f"]] , _ - makeOutputAsFortran INTERN strconc(STRINGIMAGE(asp),'"__arg"), _ + makeOutputAsFortran makeSymbol strconc(STRINGIMAGE(asp),'"__arg"), _ [["$elt","FOP","popFortranOutputStack"]] _ ] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index b3a87b0c..5393aefe 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -74,7 +74,7 @@ DomainPrint1(D,brief,$e) == --if we were passed a vector, go to the domain Sublis:= [: - [[rest u,:INTERNL strconc('"View",STRINGIMAGE i)] + [[rest u,:makeSymbol strconc('"View",STRINGIMAGE i)] for u in D for i in 1..],:$Sublis] for u in D for i in 1.. repeat brief and i>1 => nil @@ -865,7 +865,7 @@ encodeLocalFunctionName op == $prefix => $prefix $functorForm => getConstructorAbbreviationFromDB first $functorForm stackAndThrow('"There is no context for local function %1b",[op]) - INTERN strconc(prefix,'";",encodeItem op) + makeSymbol strconc(prefix,'";",encodeItem op) splitEncodedFunctionName(encodedName, sep) == -- [encodedPackage, encodedItem, encodedSig, sequenceNo] or NIL @@ -930,6 +930,6 @@ alistSize c == addSuffix(n,u) == alphabetic?((s:= STRINGIMAGE u).(MAXINDEX s)) => - INTERN strconc(s,STRINGIMAGE n) + makeSymbol strconc(s,STRINGIMAGE n) INTERNL strconc(s,STRINGIMAGE ";",STRINGIMAGE n) diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 9e0d7126..3859a8ca 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -81,10 +81,10 @@ $interpOnly := false --% Utility Functions of General Use mkCacheName(name) == - INTERN strconc(symbolName name,'";AL") + makeSymbol strconc(symbolName name,'";AL") mkAuxiliaryName(name) == - INTERN strconc(symbolName name,'";AUX") + makeSymbol strconc(symbolName name,'";AUX") homogeneousListToVector(t,l) == @@ -792,7 +792,7 @@ pr x == intern x == string? x => digit? x.0 => string2Integer x - INTERN x + makeSymbol x x isDomain a == diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index fb03dbbf..61781d39 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -396,7 +396,7 @@ htMakeTemplates(templateList, numLabels) == [[substLabel(i, template) for template in templateList] for i in 1..numLabels] where substLabel(i, template) == cons? template => - INTERN strconc(first template, toString i, rest template) + makeSymbol strconc(first template, toString i, rest template) template templateParts template == diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot index 5dd805bb..6acb52c4 100644 --- a/src/interp/htsetvar.boot +++ b/src/interp/htsetvar.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -272,7 +272,7 @@ htCheck(checker,value) == parseWord x == string? x => and/[digit? x.i for i in 0..MAXINDEX x] => readInteger x - INTERN x + makeSymbol x x htCheckList(checker,value) == @@ -334,7 +334,7 @@ chkAllNonNegativeInteger s == htMakePathKey path == null path => systemError '"path is not set" - INTERN fn(PNAME first path,rest path) where + makeSymbol fn(PNAME first path,rest path) where fn(a,b) == null b => a fn(strconc(a,'".",PNAME first b),rest b) @@ -422,14 +422,14 @@ htCacheAddChoice htPage == htSetvarDoneButton('"Select to Set Values",'htCacheSet) htShowPage() -htMakeLabel(prefix,i) == INTERN strconc(prefix,stringize i) +htMakeLabel(prefix,i) == makeSymbol strconc(prefix,stringize i) htCacheSet htPage == names := htpProperty(htPage,'names) for i in 1.. for name in names repeat num := chkAllNonNegativeInteger htpLabelInputString(htPage,htMakeLabel('"c",i)) - $cacheAlist := ADDASSOC(INTERN name,num,$cacheAlist) + $cacheAlist := ADDASSOC(makeSymbol name,num,$cacheAlist) if (n := LASSOC('all,$cacheAlist)) then $cacheCount := n $cacheAlist := deleteAssoc('all,$cacheAlist) diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index ae41e1f9..89e1699b 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -269,7 +269,7 @@ coerceRetract(object,t2) == (c := retractByFunction(object, t2)) => c t1 is [D,:.] => fun := GETL(D,'retract) or - INTERN strconc('"retract",STRINGIMAGE D) + makeSymbol strconc('"retract",STRINGIMAGE D) functionp fun => PUT(D,'retract,fun) c := CATCH('coerceFailure,FUNCALL(fun,object,t2)) @@ -1168,7 +1168,7 @@ coerceIntCommute(obj,target) == source is [D,:.] => fun := GETL(D,'coerceCommute) or - INTERN strconc('"commute",STRINGIMAGE D) + makeSymbol strconc('"commute",STRINGIMAGE D) functionp fun => PUT(D,'coerceCommute,fun) u := objValUnwrap obj diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index ee477c60..4448342c 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -53,7 +53,7 @@ makeInternalMapName(userName,numArgs,numMms,extraPart) == if extraPart then name := strconc(name,'";",extraPart) if $specialMapNameSuffix then name := strconc(name,'";",$specialMapNameSuffix) - INTERN name + makeSymbol name isInternalMapName name == -- this only returns true or false as a "best guess" @@ -67,8 +67,8 @@ isInternalMapName name == makeInternalMapMinivectorName(name) == string? name => - INTERN strconc(name,'";MV") - INTERN strconc(symbolName name,'";MV") + makeSymbol strconc(name,'";MV") + makeSymbol strconc(symbolName name,'";MV") --% Adding a function definition @@ -485,7 +485,7 @@ getEqualSublis pred == fn(pred,nil) where fn(x,sl) == --% User function analysis mapCatchName mapname == - INTERN strconc('"$",STRINGIMAGE mapname,'"CatchMapIdentifier$") + makeSymbol strconc('"$",STRINGIMAGE mapname,'"CatchMapIdentifier$") analyzeMap(op,argTypes,mapDef, tar) == -- Top level enty point for map type analysis. Sets up catch point @@ -989,7 +989,7 @@ mkValCheck(val,i) == mkSharpVar i == -- create #i - INTERN strconc('"#",STRINGIMAGE i) + makeSymbol strconc('"#",STRINGIMAGE i) mapPredTran pred == -- transforms "x in i..j" to "x>=i and x<=j" diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index afbfb7e8..901dbed4 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -168,7 +168,7 @@ $plainRTspecialCharacters == [ ++ Stream in lean mode. $RecordSeparator == abstractChar 30 -makeCharacter n ==> INTERN(charString abstractChar n) +makeCharacter n ==> makeSymbol(charString abstractChar n) $RTspecialCharacters == [ makeCharacter 218, -- upper left corner (+) @@ -535,7 +535,7 @@ outputTran x == [op,:l]:= flattenOps x --needed since "op" is string in some spad code - if string? op then (op := INTERN op; x:= [op,:l]) + if string? op then (op := makeSymbol op; x:= [op,:l]) op = 'LAMBDA_-CLOSURE => 'Closure x is ['break,:.] => 'break x is ['SEGMENT,a] => @@ -748,7 +748,7 @@ mkSuperSub(op,argl) == s:= PNAME op indexList:= [readInteger PNAME d for i in 1.. while (digit? (d:= s.(maxIndex:= i)))] - cleanOp:= INTERN (strconc/[PNAME s.i for i in maxIndex..MAXINDEX s]) + cleanOp:= makeSymbol (strconc/[PNAME s.i for i in maxIndex..MAXINDEX s]) -- if there is just a subscript use the SUB special form #indexList=2 => subPart:= ['SUB,cleanOp,:take(indexList.1,argl)] @@ -1657,7 +1657,7 @@ outputOp x == n:= GETL(op,"NARY") => 2 #args - newop:= INTERN strconc('"*",STRINGIMAGE n,PNAME op) + newop:= makeSymbol strconc('"*",STRINGIMAGE n,PNAME op) [newop,:[outputOp y for y in args]] x @@ -2712,7 +2712,7 @@ inputForm2String x == callForm2String x inputForm2OutputForm x == - INTERN inputForm2String x + makeSymbol inputForm2String x -- function for turning strings in tex format diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index ffc57722..ebc27251 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -219,7 +219,7 @@ upAlgExtension t == null (canonicalAE:= coerceInteractive(T,pd)) => throwKeyedMsgCannotCoerceWithValue(objVal T,objMode T,pd) sae:= ['SimpleAlgebraicExtension,field,pd,objValUnwrap canonicalAE] - saeTypeSynonym := INTERN strconc('"SAE",STRINGIMAGE a) + saeTypeSynonym := makeSymbol strconc('"SAE",STRINGIMAGE a) saeTypeSynonymValue := objNew(sae,$Domain) fun := getFunctionFromDomain('generator,sae,NIL) expr:= wrap SPADCALL(fun) diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index e26c256d..86f213bc 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -334,7 +334,7 @@ clearCmdParts(l is [opt,:vl]) == -- clears the bindings indicated by opt of all variables in vl option:= selectOptionLC(opt,$clearOptions,'optionError) - option:= INTERN PNAME option + option:= makeSymbol PNAME option -- the option can be plural but the key in the alist is sometimes -- singular @@ -3145,7 +3145,7 @@ handleNoParseCommands(unab, string) == copyright ) => sayKeyedMsg("S2IV0005", NIL) nil - funName := INTERN strconc('"np",STRING unab) + funName := makeSymbol strconc('"np",STRING unab) FUNCALL(funName, subSequence(string, spaceIndex+1)) @@ -3194,7 +3194,7 @@ tokTran tok == isIntegerString tok => READ_-FROM_-STRING tok tok.0 = char "_"" => subSequence(tok, 1, #tok-1) - INTERN tok + makeSymbol tok tok isIntegerString tok == diff --git a/src/interp/incl.boot b/src/interp/incl.boot index c5d84db6..73f2d5b6 100644 --- a/src/interp/incl.boot +++ b/src/interp/incl.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis +-- Copyright (C) 2007-2011, Gabriel Dos Reis -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -161,11 +161,11 @@ incFileName x == first incBiteOff x fileNameStrings fn==[PNAME(fn.0),PNAME(fn.1),PNAME(fn.2)] ifCond(s, info) == - word := INTERN StringTrim(incCommandTail(s, info), WhiteSpaceCset) + word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset) ListMemberQ?(word, $inclAssertions) assertCond(s, info) == - word := INTERN StringTrim(incCommandTail(s, info), WhiteSpaceCset) + word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset) if not ListMemberQ?(word, $inclAssertions) then $inclAssertions := [word, :$inclAssertions] diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 4c5b62ee..0d076bfa 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -63,7 +63,7 @@ DNameOtherID := 3 DNameToSExpr1 dname == null dname => error "unexpected domain name" first dname = DNameStringID => - INTERN(CompStrToString rest dname) + makeSymbol(CompStrToString rest dname) name0 := DNameToSExpr1 second dname args := rest rest dname name0 = '_-_> => diff --git a/src/interp/intfile.boot b/src/interp/intfile.boot index 5bd0fdcb..f87b3e5d 100644 --- a/src/interp/intfile.boot +++ b/src/interp/intfile.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -46,7 +46,7 @@ shoeIntern (s)== f:=first s # f < 8 => shoeIntern rest s f.0=char " " =>shoeIntern rest s - a:=INTERN subString(f,0,8) + a:=makeSymbol subString(f,0,8) [b,c]:= shoeStrings rest s GET(a,"MSGS") := b shoeIntern c diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 509fd8ba..6915b4d8 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -172,7 +172,7 @@ markAutoCoerceDown(x,tag,T,killColonColon?) == markAutoCoerceUp(x,T) == -- y := getSourceWI x -- y := --- string? y => INTERN y +-- string? y => makeSymbol y -- y tcheck T [mkWi('coerceExtraHard,'LAMBDA, nil,["REPLACE",['construct, "##1"]],T.expr), @@ -518,7 +518,7 @@ markOrigName x == s := symbolName op k := charPosition(char '_;, s, 0) k > MAXINDEX s => nil - origName := INTERN subString(s, k + 1) + origName := makeSymbol subString(s, k + 1) property(op, 'ORIGNAME) := origName REMPROP(op,'PNAME) markOrigName op @@ -1250,7 +1250,7 @@ changeToEqualEqual lines == while (m := m + 1) <= N and alphabetic? (x . m) repeat nil m = n + 2 => nil not upperCase? (x . (n + 4)) => nil - word := INTERN subString(x, n + 4, m - n - 4) + word := makeSymbol subString(x, n + 4, m - n - 4) expandedWord := macroExpand(word,$e) not (word in '(Record Union Mapping) or getConstructorFormFromDB opOf expandedWord) => nil @@ -1440,7 +1440,7 @@ combineDefinitions() == [predl,.,:def] := item ['DEF, form, :.] := def ops := PNAME op - opName := INTERN(strconc(ops,'"X",STRINGIMAGE i)) + opName := makeSymbol(strconc(ops,'"X",STRINGIMAGE i)) form.first := opName -- rplacaSubst(op, opName, def) $acc := [[form,:predl], :$acc] diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index d058a937..8e52c4f6 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -143,7 +143,7 @@ addEltModemap(op,mc,sig,pred,fn,e) == --add flag identifiers as literals in the envir op='elt and sig is [:lt,sel] => string? sel => - id:= INTERN sel + id:= makeSymbol sel if $insideCapsuleFunctionIfTrue=true then $e:= makeLiteral(id,$e) else e:= makeLiteral(id,e) @@ -152,7 +152,7 @@ addEltModemap(op,mc,sig,pred,fn,e) == addModemap1(op,mc,sig,pred,fn,e) op='setelt and sig is [:lt,sel,v] => string? sel => - id:= INTERN sel + id:= makeSymbol sel if $insideCapsuleFunctionIfTrue=true then $e:= makeLiteral(id,$e) else e:= makeLiteral(id,e) diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index d4c03552..adc8d1e1 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -148,7 +148,7 @@ removeAttributes msg == until item = '"%atend" repeat msg := rest msg item := first msg - attList := [INTERN item,:attList] + attList := [makeSymbol item,:attList] msg := rest msg attList := rest attList [msg,attList] @@ -182,7 +182,7 @@ substituteSegmentedMsg(msg,args) == l := NCONC(nreverse pkey subString(x,2),l) -- ?name gets replaced by '"Push PF10" or '"Type >b (enter)" - (x.0 = char "?") and n > 1 and (v := pushOrTypeFuture(INTERN x,nil)) => + (x.0 = char "?") and n > 1 and (v := pushOrTypeFuture(makeSymbol x,nil)) => l := NCONC(nreverse v,l) -- x requires parameter substitution diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 0f98b0c6..e85042a9 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -79,7 +79,7 @@ expression2Fortran1(name,e) == newFortranTempVar() == $exp2FortTempVarIndex := 1 + $exp2FortTempVarIndex - newVar := INTERN strconc('"T",STRINGIMAGE $exp2FortTempVarIndex) + newVar := makeSymbol strconc('"T",STRINGIMAGE $exp2FortTempVarIndex) updateSymbolTable(newVar,$defaultFortranType) newVar @@ -374,7 +374,7 @@ formatAsFortranExpression x == dispfortexp x == if atom(x) or x is [op,:.] and not object2Identifier op in '(_= MATRIX construct ) then - var := INTERN strconc('"R",object2String $IOindex) + var := makeSymbol strconc('"R",object2String $IOindex) x := ['"=",var,x] dispfortexp1 x diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 408ee6c8..8f3c278c 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -528,7 +528,7 @@ NRTcheckVector domainShell == alist := [[first v,:$SetFunctions.i],:alist] alist -mkDomainCatName id == INTERN strconc(id,'";CAT") +mkDomainCatName id == makeSymbol strconc(id,'";CAT") NRTsetVector4Part1(siglist,formlist,condlist) == $uncondList: local := nil diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index 2e943e3f..fb525a68 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -383,7 +383,7 @@ encodeCatform x == NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist) hasDefaultPackage catname == - defname := INTERN strconc(catname,'"&") + defname := makeSymbol strconc(catname,'"&") constructor? defname => defname nil diff --git a/src/interp/packtran.boot b/src/interp/packtran.boot index a49da1f2..d8ef9d69 100644 --- a/src/interp/packtran.boot +++ b/src/interp/packtran.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -44,7 +44,7 @@ packageTran sex == -- current package symbol? sex => EQ(_*PACKAGE_*, SYMBOL_-PACKAGE sex) => sex - INTERN symbolName sex + makeSymbol symbolName sex cons? sex => sex.first := packageTran first sex sex.rest := packageTran rest sex diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 9a66be2b..5399d8ef 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -59,7 +59,7 @@ $parsingType := false washOperatorName x == string? x => stackWarning('"String syntax for %1b in signature is deprecated.",[x]) - INTERN x + makeSymbol x x parseTransform: %ParseForm -> %Form diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot index d00e4cd7..1faf14fa 100644 --- a/src/interp/pf2sex.boot +++ b/src/interp/pf2sex.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -35,7 +35,7 @@ import ptrees namespace BOOT -$dotdot := INTERN('"..", '"BOOT") +$dotdot := makeSymbol('"..", '"BOOT") $specificMsgTags := nil ++ nonzero means we are processing an Application parse form diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 645f4162..596a3c49 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -489,7 +489,7 @@ postSignature t == t isnt ["%Signature",op,sig] => systemErrorHere ["postSignature",t] sig is ["->",:.] => sig1:= postType sig - op:= postAtom (string? op => INTERN op; op) + op:= postAtom (string? op => makeSymbol op; op) ["SIGNATURE",op,:removeSuperfluousMapping killColons sig1] ["SIGNATURE",postAtom op,:postType ["->","constant",sig]] @@ -503,7 +503,7 @@ killColons x == postSlash: %ParseTree -> %ParseForm postSlash t == t isnt ['_/,a,b] => systemErrorHere ["postSlash",t] - string? a => postTran ["%Reduce",INTERN a,b] + string? a => postTran ["%Reduce",makeSymbol a,b] ['_/,postTran a,postTran b] removeSuperfluousMapping: %ParseTree -> %ParseForm diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 40fe464f..2adbd906 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -338,9 +338,9 @@ formatUnion(['Union,:r]) == $count : local := 0 formatFormNoColonDecl formatTestForPartial ['Union,:[fn x for x in r]] where fn x == x is [":",y,'Branch] => fn STRINGIMAGE y - string? x => [":", INTERN x, ['Enumeration,x]] + string? x => [":", makeSymbol x, ['Enumeration,x]] x is [":",:.] => x - tag := INTERN strconc('"value",STRINGIMAGE ($count := $count + 1)) + tag := makeSymbol strconc('"value",STRINGIMAGE ($count := $count + 1)) [":", tag, x] formatTestForPartial u == @@ -349,7 +349,7 @@ formatTestForPartial u == u formatEnumeration(y is ['Enumeration,:r]) == - r is [x] => format "'" and format INTERN STRINGIMAGE x and format "'" + r is [x] => format "'" and format makeSymbol STRINGIMAGE x and format "'" formatForm y formatRecord(u) == formatFormNoColonDecl u diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index aac07f64..b0a0250a 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -85,7 +85,7 @@ formatDeftran(u,SEQflag) == ['IF,a,b,c] u is ['Union,:argl] => ['Union,:[x for a in argl - | x := (string? a => [":",INTERN a,'Branch]; formatDeftran(a,nil))]] + | x := (string? a => [":",makeSymbol a,'Branch]; formatDeftran(a,nil))]] u is [op,:itl,body] and op in '(REPEAT COLLECT) and ([nitl,:nbody] := formatDeftranREPEAT(itl,body)) => formatDeftran([op,:nitl,nbody],SEQflag) @@ -398,7 +398,7 @@ formatREDUCE ["REDUCE",op,.,u] == formatReduce1(op,u) formatreduce ["reduce",op,u] == formatReduce1(op,u) formatReduce1(op,u) == - if string? op then op := INTERN op + if string? op then op := makeSymbol op id := LASSOC(op, '((_+ Zero)(_* One)(append . NIL)(gcd Zero) (lcm One) (strconc . "")(lcm One))) formatFunctionCall @@ -572,7 +572,7 @@ ident2PrintImage s == if not (digit? s.i or alphabetic? s.i or ((c := s.i) = char '?) or (c = char '_!)) then SUFFIX('__,u) u:= SUFFIX(s.i,u) - INTERN u + makeSymbol u isIdentifier x == IDENTP x => diff --git a/src/interp/scan.boot b/src/interp/scan.boot index 7973d579..e3110d2f 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -312,9 +312,9 @@ scanToken() == -- to pair badge and badgee --- lfid x== ["id",INTERN x] +-- lfid x== ["id",makeSymbol x] lfid x == - ["id",INTERN(x, '"BOOT")] + ["id",makeSymbol(x, '"BOOT")] lfkey x == ["key",keyword x] @@ -322,9 +322,9 @@ lfkey x == lfinteger x== ["integer",x] -- if x = '"0" --- then ["id",INTERN x] +-- then ["id",makeSymbol x] -- else if x = '"1" --- then ["id",INTERN x] +-- then ["id",makeSymbol x] -- else ["integer",x] lfrinteger (r,x)== diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index 2708ab34..b608d024 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -81,7 +81,7 @@ showImp(dom,:options) == u := SORTBY('CDDR,defexports) while u repeat [.,.,:key] := first u - defop := INTERN(subString((s := PNAME first key),0,MAXINDEX s)) + defop := makeSymbol(subString((s := PNAME first key),0,MAXINDEX s)) domainForm := [defop,:CDDR key] sayBrightly ["Default functions from",:bright form2String domainForm,'":"] u := showDomainsOp1(u,key) diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index aa0219dd..3c61487e 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.boot @@ -295,7 +295,7 @@ $TriangleVariableList == $AtVariables == - [INTERN strconc('"@",toString i) for i in 1..50] + [makeSymbol strconc('"@",toString i) for i in 1..50] ++ List of basic predicates the system has a built-in optimization ++ support for. diff --git a/src/interp/topics.boot b/src/interp/topics.boot index ebed7994..0a87eb00 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -100,7 +100,7 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . line := trimString line --3-n ... m := MAXINDEX line -- (blank line) ... line.m ~= (char '_:) => systemError('"wrong heading") - con := INTERN subString(line,0,m) + con := makeSymbol subString(line,0,m) alist := [lst while not EOFP instream and not (blankLine? (line := READLINE instream)) and line.0 ~= char '_- for i in 1.. @@ -137,7 +137,7 @@ string2OpAlist s == upperCase? s.k => nil --skip constructor names k := 0 while (k := skipBlanks(s,k,m)) repeat - acc := [INTERN subString(s,k,-k + (k := charPosition(char '_ ,s,k + 1))),:acc] + acc := [makeSymbol subString(s,k,-k + (k := charPosition(char '_ ,s,k + 1))),:acc] acc := nreverse acc --now add defaults if u := getDefaultProps first acc then acc := [first acc,:u,:rest acc] diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 1715ddc0..7533cbe8 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -231,33 +231,33 @@ traceOptionError(opt,keys) == resetTimers () == for timer in _/TIMERLIST repeat - setDynamicBinding(INTERN strconc(timer,'"_,TIMER"),0) + setDynamicBinding(makeSymbol strconc(timer,'"_,TIMER"),0) resetSpacers () == for spacer in _/SPACELIST repeat - setDynamicBinding(INTERN strconc(spacer,'"_,SPACE"),0) + setDynamicBinding(makeSymbol strconc(spacer,'"_,SPACE"),0) resetCounters () == for k in _/COUNTLIST repeat - setDynamicBinding(INTERN strconc(k,'"_,COUNT"),0) + setDynamicBinding(makeSymbol strconc(k,'"_,COUNT"),0) ptimers() == null _/TIMERLIST => sayBrightly '" no functions are timed" for timer in _/TIMERLIST repeat sayBrightly [" ",:bright timer,'_:,'" ", - eval(INTERN strconc(timer,'"_,TIMER")) / float $timerTicksPerSecond,'" sec."] + eval(makeSymbol strconc(timer,'"_,TIMER")) / float $timerTicksPerSecond,'" sec."] pspacers() == null _/SPACELIST => sayBrightly '" no functions have space monitored" for spacer in _/SPACELIST repeat sayBrightly [" ",:bright spacer,'_:,'" ", - eval INTERN strconc(spacer,'"_,SPACE"),'" bytes"] + eval makeSymbol strconc(spacer,'"_,SPACE"),'" bytes"] pcounters() == null _/COUNTLIST => sayBrightly '" no functions are being counted" for k in _/COUNTLIST repeat sayBrightly [" ",:bright k,'_:,'" ", - eval INTERN strconc(k,'"_,COUNT"),'" times"] + eval makeSymbol strconc(k,'"_,COUNT"),'" times"] transOnlyOption l == l is [n,:y] => @@ -431,7 +431,7 @@ spadTrace(domain,options) == listOfOperations:= [g x for x in getOption("OPS",options)] where g x == - string? x => INTERN x + string? x => makeSymbol x x if listOfVariables := getOption("VARS",options) then options := removeOption("VARS",options) @@ -497,7 +497,7 @@ traceDomainLocalOps(dom,lops,options) == -- lops = 'all => _/TRACE_,1(actualLops,options) -- l := NIL -- for lop in lops repeat --- internalName := INTERN strconc(PNAME abb,'";",PNAME lop) +-- internalName := makeSymbol strconc(PNAME abb,'";",PNAME lop) -- not MEMQ(internalName,actualLops) => -- sayMSG ['" ",:bright abb,'"does not have a local", -- '" function called",:bright lop] @@ -517,7 +517,7 @@ untraceDomainLocalOps(dom,lops) == -- sayMSG ['" ",:bright abb,'"has no local functions to untrace."] -- l := NIL -- for lop in lops repeat --- internalName := INTERN strconc(PNAME abb,'";",PNAME lop) +-- internalName := makeSymbol strconc(PNAME abb,'";",PNAME lop) -- not MEMQ(internalName,actualLops) => -- sayMSG ['" ",:bright abb,'"does not have a local", -- '" function called",:bright lop] @@ -545,7 +545,7 @@ traceDomainConstructor(domainConstructor,options) == for [argl,.,:domain] in HGET($ConstructorCache,domainConstructor) repeat spadTrace(domain,options) SETQ(_/TRACENAMES,[domainConstructor,:_/TRACENAMES]) - innerDomainConstructor := INTERN strconc(domainConstructor,'";") + innerDomainConstructor := makeSymbol strconc(domainConstructor,'";") if FBOUNDP innerDomainConstructor then domainConstructor := innerDomainConstructor EMBED(domainConstructor, ['LAMBDA, ['_&REST, 'args], @@ -565,7 +565,7 @@ untraceDomainConstructor domainConstructor == false true untraceAllDomainLocalOps domainConstructor - innerDomainConstructor := INTERN strconc(domainConstructor,'";") + innerDomainConstructor := makeSymbol strconc(domainConstructor,'";") if FBOUNDP innerDomainConstructor then UNEMBED innerDomainConstructor else UNEMBED domainConstructor SETQ(_/TRACENAMES,delete(domainConstructor,_/TRACENAMES)) diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index e71a9ece..a584b351 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -52,7 +52,7 @@ tr fn == markSay '"#pile" markSay('"#include _"axiom.as_"") markTerpri() - CATCH($SpadReaderTag,compiler [INTERN sfn]) + CATCH($SpadReaderTag,compiler [makeSymbol sfn]) SHUT $outStream ppFull x == @@ -318,7 +318,7 @@ compWithMappingMode(x,m,oldE) == if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] ) and extendsCategoryForm("$",target,m') then return [x,m,e] - if string? x then x:= INTERN x + if string? x then x:= makeSymbol x for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat [.,.,e]:= compMakeDeclaration(v,m,e) not null vl and not hasFormalMapVariable(x, vl) => return @@ -1012,8 +1012,8 @@ compCase1(x,m,e) == genCaseTag(t,l,n) == l is [x, :l] => x = t => - string? x => INTERN x - INTERN strconc("value", STRINGIMAGE n) + string? x => makeSymbol x + makeSymbol strconc("value", STRINGIMAGE n) x is ["::",=t,:.] => t string? x => genCaseTag(t, l, n) genCaseTag(t, l, n + 1) @@ -1106,7 +1106,7 @@ compDefine1(form,m,e) == $formalArgList) null $form => stackAndThrow ['"bad == form ",form] newPrefix:= - $prefix => INTERN strconc(encodeItem $prefix,'",",encodeItem $op) + $prefix => makeSymbol strconc(encodeItem $prefix,'",",encodeItem $op) getAbbreviation($op,#rest $form) compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList) diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index 1f79c307..85068b58 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -433,7 +433,7 @@ applyMapping([op,:argl],m,e,ml) == -- following needed for referencing local funs at capsule level getAbbreviation($op,#rest $form) [op',:argl',"$"] where - op':= INTERN strconc(encodeItem nprefix,";",encodeItem op) + op':= makeSymbol strconc(encodeItem nprefix,";",encodeItem op) ['%call,['applyFun,op],:argl'] pairlis := pairList(argl',$FormalMapVariableList) convert([form,SUBLIS(pairlis,first ml),e],m) diff --git a/src/interp/word.boot b/src/interp/word.boot index f37d34be..b39c79c9 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -138,7 +138,7 @@ add2WordFunctionTable fn == -- Guess Function Name --======================================================================= guess word == - u := bootFind word => INTERN u + u := bootFind word => makeSymbol u nil bootFind word == @@ -361,7 +361,7 @@ forge(word,w,W,entry,e,E,n) == patternTran pattern == not hasWildCard? pattern and LITER pattern.0 and UPCASE copy pattern = pattern => - name:= abbreviation? INTERN pattern + name:= abbreviation? makeSymbol pattern or browseError [:bright pattern, '"is not a constructor abbreviation"] DOWNCASE PNAME name |