aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xconfigure18
-rw-r--r--configure.ac2
-rw-r--r--configure.ac.pamphlet2
-rw-r--r--src/ChangeLog15
-rw-r--r--src/boot/ast.boot58
-rw-r--r--src/boot/parser.boot2
-rw-r--r--src/boot/scanner.boot20
-rw-r--r--src/boot/strap/ast.clisp33
-rw-r--r--src/boot/translator.boot16
-rw-r--r--src/interp/cparse.boot18
10 files changed, 99 insertions, 85 deletions
diff --git a/configure b/configure
index 6dc69542..979420b0 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2010-05-17.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2010-05-22.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -745,8 +745,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.4.0-2010-05-17'
-PACKAGE_STRING='OpenAxiom 1.4.0-2010-05-17'
+PACKAGE_VERSION='1.4.0-2010-05-22'
+PACKAGE_STRING='OpenAxiom 1.4.0-2010-05-22'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1513,7 +1513,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OpenAxiom 1.4.0-2010-05-17 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2010-05-22 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1583,7 +1583,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-05-17:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-05-22:";;
esac
cat <<\_ACEOF
@@ -1691,7 +1691,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2010-05-17
+OpenAxiom configure 1.4.0-2010-05-22
generated by GNU Autoconf 2.63
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1705,7 +1705,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OpenAxiom $as_me 1.4.0-2010-05-17, which was
+It was created by OpenAxiom $as_me 1.4.0-2010-05-22, which was
generated by GNU Autoconf 2.63. Invocation command line was
$ $0 $@
@@ -21182,7 +21182,7 @@ exec 6>&1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OpenAxiom $as_me 1.4.0-2010-05-17, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2010-05-22, which was
generated by GNU Autoconf 2.63. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -21245,7 +21245,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
-OpenAxiom config.status 1.4.0-2010-05-17
+OpenAxiom config.status 1.4.0-2010-05-22
configured by $0, generated by GNU Autoconf 2.63,
with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
diff --git a/configure.ac b/configure.ac
index 6fd2f912..ea363dc9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2010-05-17],
+AC_INIT([OpenAxiom], [1.4.0-2010-05-22],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index 32a7dca3..33025571 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1210,7 +1210,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2010-05-17],
+AC_INIT([OpenAxiom], [1.4.0-2010-05-22],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index 658a5a39..bd262eab 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,18 @@
+2010-05-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/cparse.boot (npQuiver): Redefine. Now send Application
+ to Application.
+ (npTypedForm): Replace Application with Quiver.
+ (npTypified): Likewise.
+ (npTagged): Use npTypedForm not npTypedForm1.
+ (npDiscrim): Now extend Relation, not Quiver.
+ (npMdef): Allow same LHS as npDef.
+ (npSingleRule): Likewise.
+ * boot/ast.boot: Replace CONCAT with strconc. Replace SYMBOL-NAME
+ with PNAME.
+ * boot/scanner.boot: Likewise.
+ * boot/translator.boot: Likewise.
+
2010-05-18 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/ast.boot: Add %Leave ast node.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 0f55e523..8de1ae5c 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -146,8 +146,8 @@ quote x ==
bfGenSymbol: () -> %Symbol
bfGenSymbol()==
- $GenVarCounter:=$GenVarCounter+1
- INTERN(CONCAT ('"bfVar#",STRINGIMAGE $GenVarCounter))
+ $GenVarCounter := $GenVarCounter+1
+ INTERN strconc('"bfVar#",STRINGIMAGE $GenVarCounter)
bfColon: %Thing -> %List
bfColon x==
@@ -156,8 +156,8 @@ bfColon x==
bfColonColon: (%Symbol,%Symbol) -> %Symbol
bfColonColon(package, name) ==
%hasFeature KEYWORD::CLISP and package in '(EXT FFI) =>
- FIND_-SYMBOL(SYMBOL_-NAME name,package)
- INTERN(SYMBOL_-NAME name, package)
+ FIND_-SYMBOL(PNAME name,package)
+ INTERN(PNAME name, package)
bfSymbol: %Thing -> %Thing
bfSymbol x==
@@ -491,7 +491,7 @@ defSheepAndGoats(x)==
argl = nil =>
opassoc := [[op,:body]]
[opassoc,[],[]]
- op1 := INTERN CONCAT(PNAME $op,'",",PNAME op)
+ op1 := INTERN strconc(PNAME $op,'",",PNAME op)
opassoc := [[op,:op1]]
defstack := [[op1,args,body]]
[opassoc,defstack,[]]
@@ -525,7 +525,7 @@ bfLET1(lhs,rhs) ==
l2 is ["PROGN",:.] => bfMKPROGN [l1,:rest l2]
if IDENTP first l2 then l2 := [l2,:nil]
bfMKPROGN [l1,:l2,name]
- g := INTERN CONCAT('"LETTMP#",STRINGIMAGE $letGenVarCounter)
+ g := INTERN strconc('"LETTMP#",STRINGIMAGE $letGenVarCounter)
$letGenVarCounter := $letGenVarCounter + 1
rhs1 := ['L%T,g,rhs]
let1 := bfLET1(lhs,g)
@@ -562,7 +562,7 @@ bfLET2(lhs,rhs) ==
lhs is ['APPEND,var1,var2] =>
patrev := bfISReverse(var2,var1)
rev := ['REVERSE,rhs]
- g := INTERN CONCAT('"LETTMP#", STRINGIMAGE $letGenVarCounter)
+ g := INTERN strconc('"LETTMP#", STRINGIMAGE $letGenVarCounter)
$letGenVarCounter := $letGenVarCounter + 1
l2 := bfLET2(patrev,g)
if cons? l2 and atom first l2 then l2 := [l2,:nil]
@@ -645,7 +645,7 @@ bfIS1(lhs,rhs) ==
bfAND [bfIS1(lhs,d),bfMKPROGN [l,'T]]
rhs is ["EQUAL",a] => bfQ(lhs,a)
cons? lhs =>
- g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+ g := INTERN strconc('"ISTMP#",STRINGIMAGE $isGenVarCounter)
$isGenVarCounter := $isGenVarCounter + 1
bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)]
rhs is ['CONS,a,b] =>
@@ -662,7 +662,7 @@ bfIS1(lhs,rhs) ==
bfAND [['CONSP,lhs],a1,b1]
rhs is ['APPEND,a,b] =>
patrev := bfISReverse(b,a)
- g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+ g := INTERN strconc('"ISTMP#",STRINGIMAGE $isGenVarCounter)
$isGenVarCounter := $isGenVarCounter + 1
rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],'T]]
l2 := bfIS1(g,patrev)
@@ -787,7 +787,7 @@ bfDef1 [op,args,body] ==
shoeLAM (op,args,control,body)==
margs :=bfGenSymbol()
- innerfunc:=INTERN(CONCAT(PNAME op,",LAM"))
+ innerfunc:=INTERN strconc(PNAME op,",LAM")
[[innerfunc,["LAMBDA",args,body]],
[op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc],
["WRAP",margs, ["QUOTE", control]]]]]]
@@ -1044,7 +1044,7 @@ bfWhere (context,expr)==
a:=[[first d,second d,bfSUBLIS(opassoc,third d)]
for d in defs]
$wheredefs:=append(a,$wheredefs)
- bfMKPROGN bfSUBLIS(opassoc,NCONC(nondefs,[expr]))
+ bfMKPROGN bfSUBLIS(opassoc,nconc(nondefs,[expr]))
--shoeReadLispString(s,n)==
-- n>= # s => nil
@@ -1053,7 +1053,7 @@ bfWhere (context,expr)==
-- [exp,:shoeReadLispString(s,ind)]
bfCompHash(op,argl,body) ==
- auxfn:= INTERN CONCAT (PNAME op,'";")
+ auxfn:= INTERN strconc(PNAME op,'";")
computeFunction:= ["DEFUN",auxfn,argl,:body]
bfTuple [computeFunction,:bfMain(auxfn,op)]
@@ -1067,7 +1067,7 @@ bfMain(auxfn,op)==
g1:= bfGenSymbol()
arg:=["&REST",g1]
computeValue := ['APPLY,["FUNCTION",auxfn],g1]
- cacheName:= INTERN CONCAT (PNAME op,'";AL")
+ cacheName:= INTERN strconc(PNAME op,'";AL")
g2:= bfGenSymbol()
getCode:= ['GETHASH,g1,cacheName]
secondPredPair:= [['SETQ,g2,getCode],g2]
@@ -1139,12 +1139,12 @@ bfCI(g,x,y)==
bfCARCDR: (%Short,%Thing) -> %List
bfCARCDR(n,g) ==
- [INTERN CONCAT ('"CA",bfDs n,'"R"),g]
+ [INTERN strconc('"CA",bfDs n,'"R"),g]
bfDs: %Short -> %String
bfDs n ==
n = 0 => '""
- CONCAT('"D",bfDs(n-1))
+ strconc('"D",bfDs(n-1))
++ Generate code for try-catch expressions.
@@ -1262,15 +1262,15 @@ isSimpleNativeType t ==
coreSymbol: %Symbol -> %Symbol
coreSymbol s ==
- INTERN(SYMBOL_-NAME s, "AxiomCore")
+ INTERN(PNAME s, "AxiomCore")
bootSymbol: %Symbol -> %Symbol
bootSymbol s ==
- INTERN SYMBOL_-NAME s
+ INTERN PNAME s
unknownNativeTypeError t ==
- fatalError CONCAT('"unsupported native type: ", SYMBOL_-NAME t)
+ fatalError strconc('"unsupported native type: ", PNAME t)
nativeType t ==
@@ -1362,7 +1362,7 @@ nativeType t ==
nativeReturnType t ==
t in $NativeSimpleReturnTypes => nativeType t
coreError strconc('"invalid return type for native function: ",
- SYMBOL_-NAME t)
+ PNAME t)
++ Check that `t' is a valid parameter type for a native function,
++ and returns its translation.
@@ -1401,7 +1401,7 @@ coerceToNativeType(a,t) ==
c = "pointer" => [bfColonColon("SB-SYS","ALIEN-SAP"),a]
needsStableReference? t =>
fatalError strconc('"don't know how to coerce argument for native type",
- SYMBOL_-NAME c)
+ PNAME c)
fatalError '"don't know how to coerce argument for native type"
@@ -1413,15 +1413,15 @@ genGCLnativeTranslation(op,s,t,op') ==
rettype := nativeReturnType t
-- If a simpel DEFENTRY will do, go for it
and/[isSimpleNativeType x for x in [t,:s]] =>
- [["DEFENTRY", op, argtypes, [rettype, SYMBOL_-NAME op']]]
+ [["DEFENTRY", op, argtypes, [rettype, PNAME op']]]
-- Otherwise, do it the hard way.
[["CLINES",ccode], ["DEFENTRY", op, argtypes, [rettype, cop]]] where
- cop := strconc(SYMBOL_-NAME op','"__stub")
+ cop := strconc(PNAME op','"__stub")
ccode :=
"strconc"/[gclTypeInC t, '" ", cop, '"(",
:[cparm(x,a) for x in tails s for a in tails cargs],
'") { ", (t ~= "void" => '"return "; ""),
- SYMBOL_-NAME op', '"(",
+ PNAME op', '"(",
:[gclArgsInC(x,a) for x in tails s for a in tails cargs],
'"); }" ]
where cargs := [mkCArgName i for i in 0..(#s - 1)]
@@ -1430,7 +1430,7 @@ genGCLnativeTranslation(op,s,t,op') ==
strconc(gclTypeInC first x, '" ", first a,
(rest x => '", "; '""))
gclTypeInC x ==
- x in $NativeSimpleDataTypes => SYMBOL_-NAME x
+ x in $NativeSimpleDataTypes => PNAME x
x = "void" => '"void"
x = "string" => '"char*"
x is [.,["pointer",.]] => "fixnum"
@@ -1463,7 +1463,7 @@ genECLnativeTranslation(op,s,t,op') ==
rettype, callTemplate(op',#args,s),
KEYWORD::ONE_-LINER, true]]] where
callTemplate(op,n,s) ==
- "strconc"/[SYMBOL_-NAME op,'"(",
+ "strconc"/[PNAME op,'"(",
:[sharpArg(i,x) for i in 0..(n-1) for x in s],'")"]
sharpArg(i,x) ==
i = 0 => strconc('"(#0)",selectDatum x)
@@ -1499,7 +1499,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(SYMBOL_-NAME op, '"%clisp-hack")
+ n := INTERN 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
@@ -1513,7 +1513,7 @@ genCLISPnativeTranslation(op,s,t,op') ==
-- parameter of non-simple datatype are described as being pointers.
foreignDecl :=
[bfColonColon("FFI","DEF-CALL-OUT"),n,
- [KEYWORD::NAME,SYMBOL_-NAME op'],
+ [KEYWORD::NAME,PNAME op'],
[KEYWORD::ARGUMENTS,:[[a, x] for x in argtypes for a in parms]],
[KEYWORD::RETURN_-TYPE, rettype],
[KEYWORD::LANGUAGE,KEYWORD::STDC]]
@@ -1568,8 +1568,8 @@ genSBCLnativeTranslation(op,s,t,op') ==
unstableArgs := [a,:unstableArgs]
op' :=
- %hasFeature KEYWORD::WIN32 => strconc('"__",SYMBOL_-NAME op')
- SYMBOL_-NAME op'
+ %hasFeature KEYWORD::WIN32 => strconc('"__",PNAME op')
+ PNAME op'
unstableArgs = nil =>
[["DEFUN",op,args,
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 5e5b7a09..909568b9 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -257,7 +257,7 @@ bpMissingMate(close,open)==
bpMissing close
bpMissing s==
- bpSpecificErrorHere(CONCAT(PNAME s,'" possibly missing"))
+ bpSpecificErrorHere strconc(PNAME s,'" possibly missing")
throw TRAPPOINT "TRAPPED"
bpCompMissing s == bpEqKey s or bpMissing s
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 7241df13..011100e6 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -89,7 +89,7 @@ shoeNextLine(s)==
QENUM($ln,$n)=shoeTAB =>
a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ")
$ln.$n:='" ".0
- $ln:=CONCAT(a,$ln)
+ $ln := strconc(a,$ln)
s1:=[[$ln,:rest $f],:$r]
shoeNextLine s1
true
@@ -112,7 +112,7 @@ shoeLineToks(s)==
[[dq],:$r]
command:=shoeLisp? $ln=> shoeLispToken($r,command)
command:=shoePackage? $ln=>
- a:=CONCAT('"(IN-PACKAGE ",command,'")")
+ a := strconc('"(IN-PACKAGE ",command,'")")
dq:=dqUnit shoeConstructToken
($ln,$linepos,shoeLeafLisp a,0)
[[dq],:$r]
@@ -145,8 +145,8 @@ shoeAccumulateLines(s,string)==
a:=STRPOS('";",command,0,nil)
a=>
shoeAccumulateLines($r,
- CONCAT(string,SUBSTRING(command,0,a-1)))
- shoeAccumulateLines($r,CONCAT(string,command))
+ strconc(string,SUBSTRING(command,0,a-1)))
+ shoeAccumulateLines($r,strconc(string,command))
shoeAccumulateLines($r,string)
[s,:string]
@@ -195,7 +195,7 @@ shoeLeafInteger x==
["INTEGER",shoeIntValue x]
shoeLeafFloat(a,w,e)==
- b:=shoeIntValue CONCAT(a,w)
+ b:=shoeIntValue strconc(a,w)
c:= double b * EXPT(double 10, e-#w)
["FLOAT",c]
@@ -339,11 +339,11 @@ shoeS()==
a := shoeEsc()
b :=
a =>
- str := CONCAT(str,$ln.$n)
+ str := strconc(str,$ln.$n)
$n := $n+1
shoeS()
shoeS()
- CONCAT(str,b)
+ strconc(str,b)
@@ -371,7 +371,7 @@ shoeW(b)==
bb :=
a => shoeW(true)
[b,'""] -- escape finds space or newline
- [bb.0 or b,CONCAT(str,bb.1)]
+ [bb.0 or b,strconc(str,bb.1)]
shoeWord(esp) ==
aaa:=shoeW(false)
@@ -398,7 +398,7 @@ shoeInteger1(zro) ==
$n := $n+1
a := shoeEsc()
bb := shoeInteger1(zro)
- CONCAT(str,bb)
+ strconc(str,bb)
shoeIntValue(s) ==
ns := #s
@@ -453,7 +453,7 @@ shoeError()==
n:=$n
$n:=$n+1
SoftShoeError([$linepos,:n],
- CONCAT( '"The character whose number is ",
+ strconc( '"The character whose number is ",
STRINGIMAGE QENUM($ln,n),'" is not a Boot character"))
shoeLeafError ($ln.n)
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index ec4a2fdd..737250ef 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -175,8 +175,8 @@
(DEFUN |bfColonColon| (|package| |name|)
(COND
((AND (|%hasFeature| :CLISP) (MEMQ |package| '(EXT FFI)))
- (FIND-SYMBOL (SYMBOL-NAME |name|) |package|))
- (T (INTERN (SYMBOL-NAME |name|) |package|))))
+ (FIND-SYMBOL (PNAME |name|) |package|))
+ (T (INTERN (PNAME |name|) |package|))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|))
@@ -2118,14 +2118,14 @@
(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|))
-(DEFUN |coreSymbol| (|s|) (INTERN (SYMBOL-NAME |s|) '|AxiomCore|))
+(DEFUN |coreSymbol| (|s|) (INTERN (PNAME |s|) '|AxiomCore|))
(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |bootSymbol|))
-(DEFUN |bootSymbol| (|s|) (INTERN (SYMBOL-NAME |s|)))
+(DEFUN |bootSymbol| (|s|) (INTERN (PNAME |s|)))
(DEFUN |unknownNativeTypeError| (|t|)
- (|fatalError| (CONCAT "unsupported native type: " (SYMBOL-NAME |t|))))
+ (|fatalError| (CONCAT "unsupported native type: " (PNAME |t|))))
(DEFUN |nativeType| (|t|)
(PROG (|t'|)
@@ -2238,7 +2238,7 @@
((MEMBER |t| |$NativeSimpleReturnTypes|) (|nativeType| |t|))
(T (|coreError|
(CONCAT "invalid return type for native function: "
- (SYMBOL-NAME |t|))))))
+ (PNAME |t|))))))
(DEFUN |nativeArgumentType| (|t|)
(PROG (|t'| |c| |m|)
@@ -2286,7 +2286,7 @@
((|needsStableReference?| |t|)
(|fatalError|
(CONCAT "don't know how to coerce argument for native type"
- (SYMBOL-NAME |c|))))))))
+ (PNAME |c|))))))))
(T (|fatalError|
"don't know how to coerce argument for native type"))))))
@@ -2319,8 +2319,8 @@
(COND ((NOT |bfVar#134|) (RETURN NIL))))))
(SETQ |bfVar#133| (CDR |bfVar#133|))))
(LIST (LIST 'DEFENTRY |op| |argtypes|
- (LIST |rettype| (SYMBOL-NAME |op'|)))))
- (T (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub"))
+ (LIST |rettype| (PNAME |op'|)))))
+ (T (SETQ |cop| (CONCAT (PNAME |op'|) "_stub"))
(SETQ |cargs|
(LET ((|bfVar#141| NIL)
(|bfVar#140| (- (LENGTH |s|) 1)) (|i| 0))
@@ -2365,7 +2365,7 @@
((NOT (EQ |t| '|void|))
"return ")
(T '||))
- (CONS (SYMBOL-NAME |op'|)
+ (CONS (PNAME |op'|)
(CONS "("
(APPEND
(LET
@@ -2413,7 +2413,7 @@
(PROG (|ISTMP#3| |ISTMP#2| |ISTMP#1|)
(RETURN
(COND
- ((MEMBER |x| |$NativeSimpleDataTypes|) (SYMBOL-NAME |x|))
+ ((MEMBER |x| |$NativeSimpleDataTypes|) (PNAME |x|))
((EQ |x| '|void|) "void")
((EQ |x| '|string|) "char*")
((AND (CONSP |x|)
@@ -2480,7 +2480,7 @@
(DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|)
(LET ((|bfVar#146| "")
(|bfVar#148|
- (CONS (SYMBOL-NAME |op|)
+ (CONS (PNAME |op|)
(CONS "("
(APPEND (LET ((|bfVar#145| NIL)
(|bfVar#143| (- |n| 1)) (|i| 0)
@@ -2560,7 +2560,7 @@
(CONS (|nativeArgumentType| |x|)
|bfVar#150|))))
(SETQ |bfVar#149| (CDR |bfVar#149|)))))
- (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
+ (SETQ |n| (INTERN (CONCAT (PNAME |op|) "%clisp-hack")))
(SETQ |parms|
(LET ((|bfVar#152| NIL) (|bfVar#151| |s|) (|x| NIL))
(LOOP
@@ -2594,7 +2594,7 @@
(SETQ |bfVar#155| (CDR |bfVar#155|))))
(SETQ |foreignDecl|
(LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n|
- (LIST :NAME (SYMBOL-NAME |op'|))
+ (LIST :NAME (PNAME |op'|))
(CONS :ARGUMENTS
(LET ((|bfVar#158| NIL)
(|bfVar#156| |argtypes|) (|x| NIL)
@@ -2806,9 +2806,8 @@
(SETQ |bfVar#174| (CDR |bfVar#174|))))
(SETQ |op'|
(COND
- ((|%hasFeature| :WIN32)
- (CONCAT "_" (SYMBOL-NAME |op'|)))
- (T (SYMBOL-NAME |op'|))))
+ ((|%hasFeature| :WIN32) (CONCAT "_" (PNAME |op'|)))
+ (T (PNAME |op'|))))
(COND
((NULL |unstableArgs|)
(LIST (LIST 'DEFUN |op| |args|
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 85f67993..191d958b 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -170,7 +170,7 @@ EVAL_-BOOT_-FILE fn ==
b := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
infn:=shoeAddbootIfNec fn
- outfn:=CONCAT(shoeRemovebootIfNec fn,'".",_*LISP_-SOURCE_-FILETYPE_*)
+ outfn := strconc(shoeRemovebootIfNec fn,'".",_*LISP_-SOURCE_-FILETYPE_*)
shoeOpenInputFile(a,infn,shoeClLines(a,infn,[],outfn))
setCurrentPackage b
LOAD outfn
@@ -575,7 +575,7 @@ defusebuiltin x ==
GETHASH(x,$lispWordTable)
bootOut (l,outfn)==
- for i in l repeat shoeFileLine (CONCAT ('" ",PNAME i),outfn)
+ for i in l repeat shoeFileLine(strconc ('" ",PNAME i),outfn)
CLESSP(s1,s2)==
not(SHOEGREATERP(s1,s2))
@@ -589,7 +589,7 @@ bootOutLines(l,outfn,s)==
#s + #a > 70 =>
shoeFileLine(s,outfn)
bootOutLines(l,outfn,'" ")
- bootOutLines(rest l,outfn,CONCAT(s,'" ",a))
+ bootOutLines(rest l,outfn,strconc(s,'" ",a))
-- (xref "fn") produces a cross reference listing in "fn.xref"
@@ -597,7 +597,7 @@ bootOutLines(l,outfn,s)==
-- used in "fn.boot", together with a list of functions that use it.
XREF fn==
- infn:=CONCAT(fn,'".boot")
+ infn := strconc(fn,'".boot")
shoeOpenInputFile(a,infn,shoeXref(a,fn))
shoeXref(a,fn)==
@@ -609,7 +609,7 @@ shoeXref(a,fn)==
$GenVarCounter :=0
$bfClamming :=false
shoeDefUse shoeTransformStream a
- out:=CONCAT(fn,'".xref")
+ out := strconc(fn,'".xref")
shoeOpenOutputFile(stream,out,shoeXReport stream)
out
@@ -618,7 +618,7 @@ shoeXReport stream==
shoeFileLine('"USED and where DEFINED",stream)
c:=SSORT HKEYS $bootUsed
for i in c repeat
- a:=CONCAT(PNAME i,'" is used in ")
+ a := strconc(PNAME i,'" is used in ")
bootOutLines( SSORT GETHASH(i,$bootUsed),stream,a)
FBO (name,fn)==
@@ -633,14 +633,14 @@ shoeGeneralFC(f,name,fn)==
infn:=shoeAddbootIfNec fn
a:= shoeOpenInputFile(a,infn,shoeFindName2(fn,name, a))
filename:= if # name > 8 then SUBSTRING(name,0,8) else name
- a => FUNCALL(f, CONCAT('"/tmp/",filename))
+ a => FUNCALL(f, strconc('"/tmp/",filename))
nil
shoeFindName2(fn,name,a)==
lines:=shoeFindLines(fn,name,a)
lines =>
filename:= if # name > 8 then SUBSTRING(name,0,8) else name
- filename := CONCAT ('"/tmp/",filename,'".boot")
+ filename := strconc('"/tmp/",filename,'".boot")
shoeOpenOutputFile(stream, filename,
for line in lines repeat shoeFileLine (line,stream))
true
diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot
index 6714874c..ab364fc7 100644
--- a/src/interp/cparse.boot
+++ b/src/interp/cparse.boot
@@ -497,8 +497,11 @@ npTypedForm1(sy,fn) ==
npEqKey sy and (npType() or npTrap()) and
npPush FUNCALL(fn,npPop2(),npPop1())
+npQuiver() ==
+ npRightAssoc('(ARROW LARROW),function npApplication)
+
npTypedForm(sy,fn) ==
- npEqKey sy and (npApplication() or npTrap()) and
+ npEqKey sy and (npQuiver() or npTrap()) and
npPush FUNCALL(fn,npPop2(),npPop1())
npRestrict() ==
@@ -514,10 +517,10 @@ npTypeStyle()==
npCoerceTo() or npRestrict() or npPretend()
npTypified() ==
- npApplication() and npAnyNo function npTypeStyle
+ npQuiver() and npAnyNo function npTypeStyle
npTagged() ==
- npTypedForm1("COLON",function pfTagged)
+ npTypedForm("COLON",function pfTagged)
npColon() ==
npTypified() and npAnyNo function npTagged
@@ -576,11 +579,8 @@ npRelation() ==
npLeftAssoc ('(EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE),
function npSynthetic)
-npQuiver() ==
- npRightAssoc('(ARROW LARROW),function npRelation)
-
npDiscrim()==
- npLeftAssoc ('(CASE HAS IS ISNT), function npQuiver)
+ npLeftAssoc ('(CASE HAS IS ISNT), function npRelation)
npDisjand() ==
npLeftAssoc('(AND ),function npDiscrim)
@@ -991,7 +991,7 @@ npDefTail kw ==
npEqKey kw and npDefinitionOrStatement()
npMdef kw ==
- npQuiver() =>
+ npSuch() =>
[op,arg] := pfCheckMacroOut(npPop1())
npDefTail kw or npTrap()
body := npPop1()
@@ -1001,7 +1001,7 @@ npMdef kw ==
npSingleRule()==
- npQuiver() =>
+ npSuch() =>
npDefTail "DEF" or npTrap()
npPush pfRule(npPop2(),npPop1())
false
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-08 20:32:00 +0000