From bd5f5b0df93361d31592738fb18d77a275f04bc9 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 30 Apr 2011 14:27:31 +0000 Subject: more cleanup --- src/boot/ast.boot | 118 +++++++++++++++++++++--------------------- src/boot/includer.boot | 8 +-- src/boot/initial-env.lisp | 3 -- src/boot/parser.boot | 89 +++++++++++++++---------------- src/boot/scanner.boot | 2 +- src/boot/strap/ast.clisp | 39 +++++++------- src/boot/strap/includer.clisp | 4 +- src/boot/strap/scanner.clisp | 3 +- src/boot/utility.boot | 2 +- 9 files changed, 131 insertions(+), 137 deletions(-) (limited to 'src/boot') diff --git a/src/boot/ast.boot b/src/boot/ast.boot index ab87e808..ab945fd0 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -121,8 +121,8 @@ quote x == bfGenSymbol: () -> %Symbol bfGenSymbol()== - $GenVarCounter := $GenVarCounter+1 - makeSymbol strconc('"bfVar#",toString $GenVarCounter) + $GenVarCounter := $GenVarCounter+1 + makeSymbol strconc('"bfVar#",toString $GenVarCounter) bfColon: %Thing -> %Form bfColon x== @@ -131,13 +131,13 @@ bfColon x== bfColonColon: (%Symbol,%Symbol) -> %Symbol bfColonColon(package, name) == %hasFeature KEYWORD::CLISP and package in '(EXT FFI) => - FIND_-SYMBOL(PNAME name,package) - makeSymbol(PNAME name, package) + FIND_-SYMBOL(symbolName name,package) + makeSymbol(symbolName name, package) bfSymbol: %Thing -> %Thing bfSymbol x== - string? x=> x - ['QUOTE,x] + string? x=> x + ['QUOTE,x] bfDot: () -> %Symbol @@ -173,7 +173,7 @@ bfColonAppend(x,y) == bfBeginsDollar: %Thing -> %Boolean bfBeginsDollar x == - stringChar(PNAME x,0) = char "$" + stringChar(symbolName x,0) = char "$" compFluid id == ["FLUID",id] @@ -229,18 +229,18 @@ bfFor(bflhs,U,step) == bfForTree('IN, bflhs, U) bfForTree(OP,lhs,whole)== - whole := - bfTupleP whole => bfMakeCons rest whole - whole - atom lhs => bfINON [OP,lhs,whole] - lhs := - bfTupleP lhs => second lhs - lhs - lhs is ["L%T",:.] => - G:=second lhs - [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,third lhs)] - G:=bfGenSymbol() - [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,lhs)] + whole := + bfTupleP whole => bfMakeCons rest whole + whole + atom lhs => bfINON [OP,lhs,whole] + lhs := + bfTupleP lhs => second lhs + lhs + lhs is ["L%T",:.] => + G := second lhs + [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,third lhs)] + G := bfGenSymbol() + [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,lhs)] bfSTEP(id,fst,step,lst)== @@ -495,7 +495,7 @@ defSheepAndGoats(x)== argl = nil => opassoc := [[op,:body]] [opassoc,[],[]] - op1 := makeSymbol strconc(PNAME $op,'",",PNAME op) + op1 := makeSymbol strconc(symbolName $op,'",",symbolName op) opassoc := [[op,:op1]] defstack := [[op1,args,body]] [opassoc,defstack,[]] @@ -538,9 +538,9 @@ bfLET1(lhs,rhs) == bfMKPROGN [rhs1,:let1,g] bfCONTAINED(x,y)== - sameObject?(x,y) => true - atom y=> false - bfCONTAINED(x,first y) or bfCONTAINED(x,rest y) + sameObject?(x,y) => true + atom y=> false + bfCONTAINED(x,first y) or bfCONTAINED(x,rest y) bfLET2(lhs,rhs) == lhs = nil => nil @@ -623,9 +623,9 @@ bfISApplication(op,left,right)== [op ,left,right] bfIS(left,right)== - $isGenVarCounter:local :=1 - $inDefIS :local :=true - bfIS1(left,right) + $isGenVarCounter: local :=1 + $inDefIS:local :=true + bfIS1(left,right) bfISReverse(x,a) == x is ['CONS,:.] => @@ -713,21 +713,21 @@ bfMember(var,seq) == ["MEMBER",var,seq] bfInfApplication(op,left,right)== - op is "EQUAL" => bfQ(left,right) - op is "/=" => bfNOT bfQ(left,right) - op is ">" => bfLessp(right,left) - op is "<" => bfLessp(left,right) - op is "<=" => bfNOT bfLessp(right,left) - op is ">=" => bfNOT bfLessp(left,right) - op is "OR" => bfOR [left,right] - op is "AND" => bfAND [left,right] - op is "IN" => bfMember(left,right) - [op,left,right] + op is "EQUAL" => bfQ(left,right) + op is "/=" => bfNOT bfQ(left,right) + op is ">" => bfLessp(right,left) + op is "<" => bfLessp(left,right) + op is "<=" => bfNOT bfLessp(right,left) + op is ">=" => bfNOT bfLessp(left,right) + op is "OR" => bfOR [left,right] + op is "AND" => bfAND [left,right] + op is "IN" => bfMember(left,right) + [op,left,right] bfNOT x== - x is ["NOT",a]=> a - x is ["NULL",a]=> a - ["NOT",x] + x is ["NOT",a]=> a + x is ["NULL",a]=> a + ["NOT",x] bfFlatten(op, x) == x is [=op,:.] => rest x @@ -814,7 +814,7 @@ bfDef1 [op,args,body] == shoeLAM (op,args,control,body)== margs :=bfGenSymbol() - innerfunc:= makeSymbol strconc(PNAME op,",LAM") + innerfunc:= makeSymbol strconc(symbolName op,",LAM") [[innerfunc,["LAMBDA",args,body]], [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc], ["WRAP",margs, ["QUOTE", control]]]]]] @@ -989,7 +989,7 @@ bfSetelt(e,l,r)== bfSetelt(bfElt(e,first l),rest l,r) bfElt(expr,sel)== - y:=symbol? sel and sel has SHOESELFUNCTION + y := symbol? sel and sel has SHOESELFUNCTION y => integer? y => ["ELT",expr,y] [y,expr] @@ -1081,7 +1081,7 @@ bfWhere (context,expr)== -- [exp,:shoeReadLispString(s,ind)] bfCompHash(op,argl,body) == - auxfn:= makeSymbol strconc(PNAME op,'";") + auxfn:= makeSymbol strconc(symbolName op,'";") computeFunction:= ["DEFUN",auxfn,argl,:body] bfTuple [computeFunction,:bfMain(auxfn,op)] @@ -1092,14 +1092,14 @@ shoeEVALANDFILEACTQ x== ["EVAL-WHEN", [KEYWORD::EXECUTE, KEYWORD::LOAD_-TOPLEVEL], x] bfMain(auxfn,op)== - g1:= bfGenSymbol() - arg:=["&REST",g1] + g1 := bfGenSymbol() + arg :=["&REST",g1] computeValue := ['APPLY,["FUNCTION",auxfn],g1] - cacheName:= makeSymbol strconc(PNAME op,'";AL") + cacheName := makeSymbol strconc(symbolName op,'";AL") g2:= bfGenSymbol() - getCode:= ['GETHASH,g1,cacheName] - secondPredPair:= [['SETQ,g2,getCode],g2] - putCode:= ['SETF ,getCode,computeValue] + getCode := ['GETHASH,g1,cacheName] + secondPredPair := [['SETQ,g2,getCode],g2] + putCode := ['SETF ,getCode,computeValue] thirdPredPair:= ['T,putCode] codeBody:= ['PROG,[g2], ['RETURN,['COND,secondPredPair,thirdPredPair]]] @@ -1317,11 +1317,11 @@ isSimpleNativeType t == coreSymbol: %Symbol -> %Symbol coreSymbol s == - makeSymbol(PNAME s, "AxiomCore") + makeSymbol(symbolName s, "AxiomCore") bootSymbol: %Symbol -> %Symbol bootSymbol s == - makeSymbol PNAME s + makeSymbol symbolName s unknownNativeTypeError t == @@ -1468,15 +1468,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, PNAME op']]] + [["DEFENTRY", op, argtypes, [rettype, symbolName op']]] -- Otherwise, do it the hard way. [["CLINES",ccode], ["DEFENTRY", op, argtypes, [rettype, cop]]] where - cop := strconc(PNAME op','"__stub") + cop := strconc(symbolName op','"__stub") ccode := "strconc"/[gclTypeInC t, '" ", cop, '"(", :[cparm(x,a) for x in tails s for a in tails cargs], '") { ", (t isnt "void" => '"return "; ""), - PNAME op', '"(", + symbolName op', '"(", :[gclArgsInC(x,a) for x in tails s for a in tails cargs], '"); }" ] where cargs := [mkCArgName i for i in 0..(#s - 1)] @@ -1485,7 +1485,7 @@ genGCLnativeTranslation(op,s,t,op') == strconc(gclTypeInC first x, '" ", first a, (rest x => '", "; '"")) gclTypeInC x == - x in $NativeSimpleDataTypes => PNAME x + x in $NativeSimpleDataTypes => symbolName x x is "void" => '"void" x is "string" => '"char*" x is [.,["pointer",.]] => "fixnum" @@ -1518,7 +1518,7 @@ genECLnativeTranslation(op,s,t,op') == rettype, callTemplate(op',#args,s), KEYWORD::ONE_-LINER, true]]] where callTemplate(op,n,s) == - "strconc"/[PNAME op,'"(", + "strconc"/[symbolName op,'"(", :[sharpArg(i,x) for i in 0..(n-1) for x in s],'")"] sharpArg(i,x) == i = 0 => strconc('"(#0)",selectDatum x) @@ -1554,7 +1554,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 := makeSymbol strconc(PNAME op, '"%clisp-hack") + n := makeSymbol strconc(symbolName 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 @@ -1568,7 +1568,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,PNAME op'], + [KEYWORD::NAME,symbolName op'], [KEYWORD::ARGUMENTS,:[[a, x] for x in argtypes for a in parms]], [KEYWORD::RETURN_-TYPE, rettype], [KEYWORD::LANGUAGE,KEYWORD::STDC]] @@ -1623,8 +1623,8 @@ genSBCLnativeTranslation(op,s,t,op') == unstableArgs := [a,:unstableArgs] op' := - %hasFeature KEYWORD::WIN32 => strconc('"__",PNAME op') - PNAME op' + %hasFeature KEYWORD::WIN32 => strconc('"__",symbolName op') + symbolName op' unstableArgs = nil => [["DEFUN",op,args, diff --git a/src/boot/includer.boot b/src/boot/includer.boot index 249c045f..26a38ba3 100644 --- a/src/boot/includer.boot +++ b/src/boot/includer.boot @@ -66,10 +66,6 @@ PNAME x == char? x => charString x nil --- close STREAM. -shoeCLOSE stream == - CLOSE stream - -- error out if file is not found. shoeNotFound fn == coreError [fn, '" not found"] @@ -79,7 +75,7 @@ shoeNotFound fn == shoeReadLispString(s,n) == l := #s n >= l => nil - readLispFromString strconc ( "(", subString(s,n,l-n) ,")") + readLispFromString strconc( "(", subString(s,n,l-n) ,")") -- read a line from stream shoeReadLine stream == @@ -90,7 +86,7 @@ shoeConsole line == writeLine(line, _*TERMINAL_-IO_*) shoeSpaces n == - MAKE_-FULL_-CVEC(n, '".") + makeString(n,char ".") --% diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp index 0a9f8b7c..b9a76109 100644 --- a/src/boot/initial-env.lisp +++ b/src/boot/initial-env.lisp @@ -107,9 +107,6 @@ (shoeprettyprin0 x stream) (terpri stream)) -(defun make-full-cvec (sint &optional (char #\space)) - (make-string sint :initial-element (character char))) - (defun |shoePLACEP| (item) (eq item nil)) diff --git a/src/boot/parser.boot b/src/boot/parser.boot index a6420449..c48fff77 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -47,28 +47,28 @@ module parser bpFirstToken()== - $stok:= - $inputStream = nil => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) - first $inputStream - $ttok := shoeTokPart $stok - true + $stok:= + $inputStream = nil => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) + first $inputStream + $ttok := shoeTokPart $stok + true bpFirstTok()== - $stok:= - $inputStream = nil => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) - first $inputStream - $ttok:=shoeTokPart $stok - $bpParenCount>0 and $stok is ["KEY",:.] => - $ttok = "SETTAB" => - $bpCount:=$bpCount+1 - bpNext() - $ttok = "BACKTAB" => - $bpCount:=$bpCount-1 - bpNext() - $ttok = "BACKSET" => - bpNext() - true - true + $stok:= + $inputStream = nil => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) + first $inputStream + $ttok:=shoeTokPart $stok + $bpParenCount>0 and $stok is ["KEY",:.] => + $ttok is "SETTAB" => + $bpCount:=$bpCount+1 + bpNext() + $ttok is "BACKTAB" => + $bpCount:=$bpCount-1 + bpNext() + $ttok is "BACKSET" => + bpNext() + true + true bpNext() == $inputStream := rest($inputStream) @@ -214,8 +214,8 @@ bpAnyNo s== -- AndOr(k,p,f)= k p bpAndOr(keyword,p,f)== - bpEqKey keyword and (apply(p,nil) or bpTrap()) - and bpPush FUNCALL(f, bpPop1()) + bpEqKey keyword and (apply(p,nil) or bpTrap()) + and bpPush FUNCALL(f, bpPop1()) bpConditional f== bpEqKey "IF" and (bpWhere() or bpTrap()) and (bpEqKey "BACKSET" or true) => @@ -240,31 +240,31 @@ bpBacksetElse()== bpEqKey "ELSE" bpEqPeek s == - $stok is ["KEY",:.] and sameObject?(s,$ttok) + $stok is ["KEY",:.] and symbolEq?(s,$ttok) bpEqKey s == - $stok is ["KEY",:.] and sameObject?(s,$ttok) and bpNext() + $stok is ["KEY",:.] and symbolEq?(s,$ttok) and bpNext() bpEqKeyNextTok s == - $stok is ["KEY",:.] and sameObject?(s,$ttok) and bpNextToken() + $stok is ["KEY",:.] and symbolEq?(s,$ttok) and bpNextToken() bpPileTrap() == bpMissing "BACKTAB" bpBrackTrap(x) == bpMissingMate("]",x) bpParenTrap(x) == bpMissingMate(")",x) bpMissingMate(close,open)== - bpSpecificErrorAtToken(open, '"possibly missing mate") - bpMissing close + bpSpecificErrorAtToken(open, '"possibly missing mate") + bpMissing close bpMissing s== - bpSpecificErrorHere strconc(PNAME s,'" possibly missing") - throw 'TRAPPED : BootParserException + bpSpecificErrorHere strconc(PNAME s,'" possibly missing") + throw 'TRAPPED : BootParserException bpCompMissing s == bpEqKey s or bpMissing s bpTrap()== - bpGeneralErrorHere() - throw 'TRAPPED : BootParserException + bpGeneralErrorHere() + throw 'TRAPPED : BootParserException bpRecoverTrap()== bpFirstToken() @@ -284,7 +284,7 @@ bpListAndRecover(f)== found := try apply(f,nil) catch(e: BootParserException) => e - if found = "TRAPPED" + if found is "TRAPPED" then $inputStream:=c bpRecoverTrap() @@ -547,16 +547,16 @@ bpAnyId()== and bpPush $ttok and bpNext() bpSexp()== - bpAnyId() or - bpEqKey "QUOTE" and (bpSexp() or bpTrap()) - and bpPush bfSymbol bpPop1() or - bpIndentParenthesized function bpSexp1 + bpAnyId() or + bpEqKey "QUOTE" and (bpSexp() or bpTrap()) + and bpPush bfSymbol bpPop1() or + bpIndentParenthesized function bpSexp1 bpSexp1()== bpFirstTok() and - bpSexp() and - (bpEqKey "DOT" and bpSexp() and bpPush [bpPop2(),:bpPop1()] or - bpSexp1() and bpPush [bpPop2(),:bpPop1()]) or - bpPush nil + bpSexp() and + (bpEqKey "DOT" and bpSexp() and bpPush [bpPop2(),:bpPop1()] or + bpSexp1() and bpPush [bpPop2(),:bpPop1()]) or + bpPush nil bpPrimary1() == bpParenthesizedApplication() or @@ -637,7 +637,7 @@ bpLeftAssoc(operations,parser)== false bpString()== - shoeTokType $stok = "STRING" and + shoeTokType $stok is "STRING" and bpPush(["QUOTE",makeSymbol $ttok]) and bpNext() bpThetaName() == @@ -812,7 +812,8 @@ bpIteratorList()== bpOneOrMore function bpIterator and bpPush bfIterators bpPop1 () -bpCrossBackSet()== bpEqKey "CROSS" and (bpEqKey "BACKSET" or true) +bpCrossBackSet()== + bpEqKey "CROSS" and (bpEqKey "BACKSET" or true) bpIterators()== bpListofFun(function bpIteratorList, @@ -1063,7 +1064,7 @@ bpRegularBVItem() == or bpBracketConstruct function bpPatternL bpBVString()== - shoeTokType $stok = "STRING" and + shoeTokType $stok is "STRING" and bpPush(["BVQUOTE",makeSymbol $ttok]) and bpNext() bpRegularBVItemL() == @@ -1170,7 +1171,7 @@ bpCaseItem()== bpOutItem()== $op := nil bpComma() or bpTrap() - b:=bpPop1() + b := bpPop1() bpPush b is ["+LINE",:.] => [ b ] b is ["L%T",l,r] and symbol? l => diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index b90bd0d5..e1f6bd0b 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -89,7 +89,7 @@ shoeNextLine(s)== $sz :=# $ln $n = nil => true stringChar($ln,$n) = shoeTAB => - a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ") + a := makeString(7-REM($n,8),char " ") $ln.$n := char " " $ln := strconc(a,$ln) s1:=[[$ln,:rest $f],:$r] diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 0f152136..67d31787 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -165,8 +165,8 @@ (COND ((AND (|%hasFeature| :CLISP) (|symbolMember?| |package| '(EXT FFI))) - (FIND-SYMBOL (PNAME |name|) |package|)) - (T (INTERN (PNAME |name|) |package|)))) + (FIND-SYMBOL (SYMBOL-NAME |name|) |package|)) + (T (INTERN (SYMBOL-NAME |name|) |package|)))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|)) @@ -215,7 +215,7 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|)) (DEFUN |bfBeginsDollar| (|x|) - (CHAR= (SCHAR (PNAME |x|) 0) (|char| '$))) + (CHAR= (SCHAR (SYMBOL-NAME |x|) 0) (|char| '$))) (DEFUN |compFluid| (|id|) (LIST 'FLUID |id|)) @@ -721,8 +721,8 @@ (SETQ |opassoc| (LIST (CONS |op| |body|))) (LIST |opassoc| NIL NIL)) (T (SETQ |op1| - (INTERN (CONCAT (PNAME |$op|) "," - (PNAME |op|)))) + (INTERN (CONCAT (SYMBOL-NAME |$op|) "," + (SYMBOL-NAME |op|)))) (SETQ |opassoc| (LIST (CONS |op| |op1|))) (SETQ |defstack| (LIST (LIST |op1| |args| |body|))) @@ -1453,7 +1453,7 @@ (RETURN (PROGN (SETQ |margs| (|bfGenSymbol|)) - (SETQ |innerfunc| (INTERN (CONCAT (PNAME |op|) '|,LAM|))) + (SETQ |innerfunc| (INTERN (CONCAT (SYMBOL-NAME |op|) '|,LAM|))) (LIST (LIST |innerfunc| (LIST 'LAMBDA |args| |body|)) (LIST |op| (LIST 'MLAMBDA (LIST '&REST |margs|) @@ -2099,7 +2099,7 @@ (PROG (|computeFunction| |auxfn|) (RETURN (PROGN - (SETQ |auxfn| (INTERN (CONCAT (PNAME |op|) ";"))) + (SETQ |auxfn| (INTERN (CONCAT (SYMBOL-NAME |op|) ";"))) (SETQ |computeFunction| (CONS 'DEFUN (CONS |auxfn| (CONS |argl| |body|)))) (|bfTuple| (CONS |computeFunction| (|bfMain| |auxfn| |op|))))))) @@ -2121,7 +2121,7 @@ (SETQ |arg| (LIST '&REST |g1|)) (SETQ |computeValue| (LIST 'APPLY (LIST 'FUNCTION |auxfn|) |g1|)) - (SETQ |cacheName| (INTERN (CONCAT (PNAME |op|) ";AL"))) + (SETQ |cacheName| (INTERN (CONCAT (SYMBOL-NAME |op|) ";AL"))) (SETQ |g2| (|bfGenSymbol|)) (SETQ |getCode| (LIST 'GETHASH |g1| |cacheName|)) (SETQ |secondPredPair| (LIST (LIST 'SETQ |g2| |getCode|) |g2|)) @@ -2442,11 +2442,11 @@ (DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|)) -(DEFUN |coreSymbol| (|s|) (INTERN (PNAME |s|) '|AxiomCore|)) +(DEFUN |coreSymbol| (|s|) (INTERN (SYMBOL-NAME |s|) '|AxiomCore|)) (DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |bootSymbol|)) -(DEFUN |bootSymbol| (|s|) (INTERN (PNAME |s|))) +(DEFUN |bootSymbol| (|s|) (INTERN (SYMBOL-NAME |s|))) (DEFUN |unknownNativeTypeError| (|t|) (|fatalError| (CONCAT "unsupported native type: " (PNAME |t|)))) @@ -2647,8 +2647,8 @@ (COND ((NOT |bfVar#161|) (RETURN NIL))))) (SETQ |bfVar#160| (CDR |bfVar#160|)))) (LIST (LIST 'DEFENTRY |op| |argtypes| - (LIST |rettype| (PNAME |op'|))))) - (T (SETQ |cop| (CONCAT (PNAME |op'|) "_stub")) + (LIST |rettype| (SYMBOL-NAME |op'|))))) + (T (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub")) (SETQ |cargs| (LET ((|bfVar#170| NIL) (|bfVar#171| NIL) (|bfVar#169| (- (LENGTH |s|) 1)) (|i| 0)) @@ -2710,7 +2710,7 @@ ((NOT (EQ |t| '|void|)) "return ") (T '||)) - (CONS (PNAME |op'|) + (CONS (SYMBOL-NAME |op'|) (CONS "(" (APPEND (LET @@ -2768,7 +2768,7 @@ (PROG (|ISTMP#3| |ISTMP#2| |ISTMP#1|) (RETURN (COND - ((MEMBER |x| |$NativeSimpleDataTypes|) (PNAME |x|)) + ((MEMBER |x| |$NativeSimpleDataTypes|) (SYMBOL-NAME |x|)) ((EQ |x| '|void|) "void") ((EQ |x| '|string|) "char*") ((AND (CONSP |x|) @@ -2834,7 +2834,7 @@ (DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|) (LET ((|bfVar#177| "") (|bfVar#179| - (CONS (PNAME |op|) + (CONS (SYMBOL-NAME |op|) (CONS "(" (APPEND (LET ((|bfVar#175| NIL) (|bfVar#176| NIL) @@ -2928,7 +2928,7 @@ (T (RPLACD |bfVar#182| #0#) (SETQ |bfVar#182| (CDR |bfVar#182|)))) (SETQ |bfVar#180| (CDR |bfVar#180|))))) - (SETQ |n| (INTERN (CONCAT (PNAME |op|) "%clisp-hack"))) + (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack"))) (SETQ |parms| (LET ((|bfVar#184| NIL) (|bfVar#185| NIL) (|bfVar#183| |s|) (|x| NIL)) @@ -2965,7 +2965,7 @@ (SETQ |bfVar#188| (CDR |bfVar#188|)))) (SETQ |foreignDecl| (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n| - (LIST :NAME (PNAME |op'|)) + (LIST :NAME (SYMBOL-NAME |op'|)) (CONS :ARGUMENTS (LET ((|bfVar#191| NIL) (|bfVar#192| NIL) (|bfVar#189| |argtypes|) (|x| NIL) @@ -3215,8 +3215,9 @@ (SETQ |bfVar#213| (CDR |bfVar#213|)))) (SETQ |op'| (COND - ((|%hasFeature| :WIN32) (CONCAT "_" (PNAME |op'|))) - (T (PNAME |op'|)))) + ((|%hasFeature| :WIN32) + (CONCAT "_" (SYMBOL-NAME |op'|))) + (T (SYMBOL-NAME |op'|)))) (COND ((NULL |unstableArgs|) (LIST (LIST 'DEFUN |op| |args| diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 7509ac95..669ca761 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -11,8 +11,6 @@ ((CHARACTERP |x|) (STRING |x|)) (T NIL))) -(DEFUN |shoeCLOSE| (|stream|) (CLOSE |stream|)) - (DEFUN |shoeNotFound| (|fn|) (PROGN (|coreError| (LIST |fn| " not found")) NIL)) @@ -30,7 +28,7 @@ (DEFUN |shoeConsole| (|line|) (WRITE-LINE |line| *TERMINAL-IO*)) -(DEFUN |shoeSpaces| (|n|) (MAKE-FULL-CVEC |n| ".")) +(DEFUN |shoeSpaces| (|n|) (|makeString| |n| (|char| '|.|))) (DEFUN |diagnosticLocation| (|tok|) (PROG (|pos|) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 1e5d418b..2a01edc0 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -52,7 +52,8 @@ (COND ((NULL |$n|) T) ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|) - (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " ")) + (SETQ |a| + (|makeString| (- 7 (REM |$n| 8)) (|char| '| |))) (SETF (ELT |$ln| |$n|) (|char| '| |)) (SETQ |$ln| (CONCAT |a| |$ln|)) (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|)) diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 1c32015b..c24ed738 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -36,7 +36,7 @@ module utility (objectMember?, symbolMember?, stringMember?, charMember?, scalarMember?, listMember?, reverse, reverse!, lastNode, append!, copyList, substitute, substitute!, setDifference, applySubst, applySubst!,remove,removeSymbol) where - removeSymbol: (%List %Symbol, %Symbol) -> %List %Symbol + removeSymbol: (%List %Thing, %Symbol) -> %List %Thing remove: (%List %Thing, %Thing) ->% List %Thing --% membership operators -- cgit v1.2.3