diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-04-30 14:27:31 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-04-30 14:27:31 +0000 |
| commit | bd5f5b0df93361d31592738fb18d77a275f04bc9 (patch) | |
| tree | e2b46b5d5ded0265990ef24f4bf2ddb9640e7fc4 | |
| parent | 6661a9aa8e79dc934bde807293857f2dfc0eca6f (diff) | |
| download | open-axiom-bd5f5b0df93361d31592738fb18d77a275f04bc9.tar.gz | |
more cleanup
42 files changed, 307 insertions, 289 deletions
diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet index 74c79801..2271f92b 100644 --- a/src/algebra/string.spad.pamphlet +++ b/src/algebra/string.spad.pamphlet @@ -301,9 +301,9 @@ IndexedString(mn:Integer): Export == Implementation where c: Character cc: CharacterClass --- new n == MAKE_-FULL_-CVEC(n, space$C)$Lisp - new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp - empty() == MAKE_-FULL_-CVEC(0@I)$Lisp +-- new n == makeString(n, space$C)$Lisp + new(n, c) == makeString(n, c)$Lisp + empty() == makeString(0@I)$Lisp empty?(s) == %strlength s = 0 #s == %strlength s s = t == %streq(s,t) 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 diff --git a/src/interp/as.boot b/src/interp/as.boot index d85b4743..f3522d20 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -44,9 +44,9 @@ $asyPrint := false asList() == removeFile '"temp.text" OBEY '"ls as/*.asy > temp.text" - instream := OPEN '"temp.text" + instream := inputTextFile '"temp.text" lines := [READLINE instream while not EOFP instream] - CLOSE instream + closeFile instream lines asAll lines == @@ -416,7 +416,7 @@ asyAncestorList x == [asyAncestors y for y in x] asytran fn == --put operations into table format for browser: -- <sig pred origin exposed? comments> - inStream := OPEN fn + inStream := inputTextFile fn sayBrightly ['" Reading ",fn] u := VMREAD inStream $niladics := mkNiladics u @@ -428,7 +428,7 @@ asytran fn == asytranDeclaration(d,'(top),nil,false) if null name then hohohoho() HPUT($docHash,name,$docHashLocal) - CLOSE inStream + closeFile inStream 'done mkNiladics u == diff --git a/src/interp/ax.boot b/src/interp/ax.boot index beca359f..5d94dfb7 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -73,7 +73,7 @@ makeAxFile(filename, constructors) == ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms] st := MAKE_-OUTSTREAM(filename) PPRINT(axForm,st) - CLOSE st + closeFile st makeAxExportForm(filename, constructors) == $defaultFlag : local := false diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 93ee91ea..0a1c5c8a 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -254,8 +254,8 @@ mkDomTypeForm(typeForm,conform,domname) == --called by kargPage domainDescendantsOf(conform,domform) == main where --called by kargPage main() == conform is [op,:r] => - op = 'Join => jfn(delete('(Type Object),r),delete('(Type Object),IFCDR domform)) - op = 'CATEGORY => nil + op is 'Join => jfn(remove(r,'Object),remove(IFCDR domform,'Object)) + op is 'CATEGORY => nil domainsOf(conform,domform) domainsOf(conform,domform) jfn([y,:r],domlist) == --keep only those domains that appear in ALL parts of Join diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index f0117bd6..8cb80ce6 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -256,9 +256,9 @@ getInfoAlist conname == abb := getConstructorAbbreviationFromDB conname or return '"not a constructor" fs := strconc(symbolName abb,'".NRLIB/info") inStream := - PROBE_-FILE fs => OPEN fs + PROBE_-FILE fs => inputTextFile fs filename := strconc('"/spad/int/algebra/",symbolName abb,'".NRLIB/info") - PROBE_-FILE filename => OPEN filename + PROBE_-FILE filename => inputTextFile filename return nil alist := mySort READ inStream if cat? then diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 4c49a8db..57969906 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -210,7 +210,7 @@ isFilterDelimiter? c == grepSplit(lines,doc?) == if doc? then - instream2 := OPEN strconc(systemRootDirectory(),'"/algebra/libdb.text") + instream2 := inputTextFile strconc(systemRootDirectory(),'"/algebra/libdb.text") cons := atts := doms := nil while lines is [line, :lines] repeat if doc? then @@ -230,7 +230,7 @@ grepSplit(lines,doc?) == kind = char "o" => ops := insert(line,ops) kind = char "-" => 'skip --for now systemError 'kind - if doc? then CLOSE instream2 + if doc? then closeFile instream2 [['"attribute",:reverse! atts], ['"operation",:reverse! ops], ['"category",:reverse! cats], @@ -930,9 +930,9 @@ dbWriteLines(s, :options) == pathname dbReadLines target == --AIX only--called by grepFile - instream := OPEN target + instream := inputTextFile target lines := [READLINE instream while not EOFP instream] - CLOSE instream + closeFile instream lines dbGetCommentOrigin line == @@ -942,10 +942,10 @@ dbGetCommentOrigin line == firstPart := dbPart(line,1,-1) 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 + instream := inputTextFile grepSource key --this always returns libdb now FILE_-POSITION(instream,readInteger address) line := READLINE instream - CLOSE instream + closeFile instream line grepSource key == diff --git a/src/interp/clam.boot b/src/interp/clam.boot index f6254c1d..cf45340d 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -687,7 +687,7 @@ constructor2ConstructorForm x == rightJustifyString(x,maxWidth) == size:= entryWidth x size > maxWidth => keyedSystemError("S2GE0014",[x]) - [fillerSpaces(maxWidth-size," "),x] + [fillerSpaces(maxWidth-size,char " "),x] domainEqualList(argl1,argl2) == --function used to match argument lists of constructors diff --git a/src/interp/cstream.boot b/src/interp/cstream.boot index c0913788..ead84d1b 100644 --- a/src/interp/cstream.boot +++ b/src/interp/cstream.boot @@ -58,7 +58,7 @@ incRgen1(:z)== [s]:=z a:=shoeread_-line s if null a - then (CLOSE s;StreamNil) + then (closeFile s;StreamNil) else [a,:incRgen s] diff --git a/src/interp/define.boot b/src/interp/define.boot index 9d2e41bf..b670c3c9 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -110,7 +110,6 @@ $subdomain := false --% compDefineAddSignature: (%Form,%Sig,%Env) -> %Env -DomainSubstitutionFunction: (%List %Symbol,%Form) -> %Form --% @@ -1950,14 +1949,14 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) == DomainSubstitutionFunction(parameters,body) == --see definition of DomainSubstitutionMacro in SPAD LISP if parameters then - (body:= Subst(parameters,body)) where + (body := Subst(parameters,body)) where Subst(parameters,body) == atom body => symbolMember?(body,parameters) => MKQ body body listMember?(body,parameters) => - g:=gensym() - $extraParms:=PUSH([g,:body],$extraParms) + g := gensym() + $extraParms := PUSH([g,:body],$extraParms) --Used in SetVector12 to generate a substitution list --bound in buildFunctor --For categories, bound and used in compDefineCategory @@ -1968,13 +1967,13 @@ DomainSubstitutionFunction(parameters,body) == body.op ~= $definition.op => ['QUOTE,simplifyVMForm body] [Subst(parameters,u) for u in body] - not (body is ["Join",:.]) => body + body isnt ["Join",:.] => body atom $definition => body null $definition.args => body --should not bother if it will only be called once - name:= makeSymbol strconc(KAR $definition,";CAT") + name := makeSymbol strconc(KAR $definition,";CAT") SETANDFILE(name,nil) - body:= ['%when,[name],['%otherwise,['%store,name,body]]] + body := ['%when,[name],['%otherwise,['%store,name,body]]] body diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 85d2eaa7..7a57359a 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -567,7 +567,7 @@ prepareResults(results,args,dummies,values,decls) == type := getFortranType(u,decls) data := [defaultValue(type,inFirstNotSecond(args,dummies),values),:data] where defaultValue(type,argNames,actual) == - LISTP(type) and first(type)="character" => MAKE_-STRING(1) + LISTP(type) and first(type)="character" => makeString 1 LISTP(type) and first(type) in ["complex","double complex"] => makeVector( makeList( 2*apply('_*,[getVal(tt,argNames,actual) for tt in rest(type)]),_ @@ -583,7 +583,7 @@ prepareResults(results,args,dummies,values,decls) == type = "double" => longZero type = "double precision" => longZero type = "logical" => 0 - type = "character" => MAKE_-STRING(1) + type = "character" => makeString 1 type = "complex" => makeVector([shortZero,shortZero],"%SingleFloat") type = "double complex" => makeVector([longZero,longZero],"%DoubleFloat") error ['"Unrecognised Fortran type: ",type] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index e4455ff2..e5821bd1 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -367,7 +367,7 @@ setVector3(name,instantiator) == mkDomainFormer x == if x is ['DomainSubstitutionMacro,parms,body] then - x:=DomainSubstitutionFunction(parms,body) + x := DomainSubstitutionFunction(parms,body) x := applySubst($extraParms,x) --The next line ensures that only one copy of this structure will --appear in the BPI being generated, thus saving (some) space diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index eceeae89..23648b53 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -105,7 +105,7 @@ changeVariableDefinitionToStore(form,vars) == jumpToToplevel? x == atomic? x => false op := x.op - op = 'SEQ => CONTAINED('THROW,x.args) -- FIXME: what about GO? + op is 'SEQ => CONTAINED('THROW,x.args) -- FIXME: what about GO? op in '(EXIT THROW %leave) => true or/[jumpToToplevel? x' for x' in x] @@ -175,15 +175,15 @@ resetTo(x,y) == ++ Simplify the VM form `x' simplifyVMForm x == - x = '%icst0 => 0 - x = '%icst1 => 1 + x is '%icst0 => 0 + x is '%icst1 => 1 atomic? x => x - x.op = 'CLOSEDFN => x + x.op is 'CLOSEDFN => x atom x.op => x is [op,vars,body] and op in $AbstractionOperator => third(x) := simplifyVMForm body x - if x.op = 'IF then + if x.op is 'IF then resetTo(x,optIF2COND x) for args in tails x.args repeat args.first := simplifyVMForm first args @@ -210,7 +210,7 @@ hasNoThrows(a,g) == hasNoThrows(first a,g) and hasNoThrows(rest a,g) changeThrowToGo(s,g) == - atom s or first s='QUOTE => nil + atom s or first s is 'QUOTE => nil s is ["THROW", =g,u] => changeThrowToGo(u,g) s.first := "PROGN" @@ -271,17 +271,17 @@ optCall (x is ['%call,:u]) == x.rest := [:a,name] x fn is [q,R,n] and q in '(ELT CONST) => - q = 'CONST => ['spadConstant,R,n] + q is 'CONST => ['spadConstant,R,n] emitIndirectCall(fn,a,x) systemErrorHere ['optCall,x] optCons (x is ["CONS",a,b]) == - a="NIL" => - b='NIL => (x.first := 'QUOTE; x.rest := ['NIL,:'NIL]; x) + a is "NIL" => + b is 'NIL => (x.first := 'QUOTE; x.rest := ['NIL,:'NIL]; x) b is ['QUOTE,:c] => (x.first := 'QUOTE; x.rest := ['NIL,:c]; x) x a is ['QUOTE,a'] => - b='NIL => (x.first := 'QUOTE; x.rest := [a',:'NIL]; x) + b is 'NIL => (x.first := 'QUOTE; x.rest := [a',:'NIL]; x) b is ['QUOTE,:c] => (x.first := 'QUOTE; x.rest := [a',:c]; x) x x @@ -292,20 +292,20 @@ optMkRecord ["mkRecord",:u] == ['%vector,:u] optCond (x is ['%when,:l]) == - if l is [a,[aa,b]] and aa = '%otherwise and b is ['%when,:c] then + if l is [a,[aa,b]] and aa is '%otherwise and b is ['%when,:c] then x.rest.rest := c if l is [[p1,:c1],[p2,:c2],:.] then if (p1 is ['%not,=p2]) or (p2 is ['%not,=p1]) then l:=[[p1,:c1],['%otherwise,:c2]] x.rest := l - c1 is ['NIL] and p2 = '%otherwise and first c2 = '%otherwise => + c1 is ['NIL] and p2 is '%otherwise and first c2 is '%otherwise => return optNot ['%not,p1] l is [[p1,['%when,[p2,c2]]]] => optCond ['%when,[['%and,p1,p2],c2]] l is [[p1,c1],['%otherwise,'%false]] => optAnd ['%and,p1,c1] l is [[p1,c1],['%otherwise,'%true]] => optOr ['%or,optNot ['%not,p1],c1] l is [[p1,'%false],['%otherwise,c2]] => optAnd ['%and,optNot ['%not,p1],c2] l is [[p1,'%true],['%otherwise,c2]] => optOr ['%or,p1,c2] - l is [[p1,:c1],[p2,:c2],[p3,:c3]] and p3 = '%otherwise => + l is [[p1,:c1],[p2,:c2],[p3,:c3]] and p3 is '%otherwise => EqualBarGensym(c1,c3) => optCond ['%when,[['%or,p1,optNot ['%not,p2]],:c1],['%otherwise,:c2]] EqualBarGensym(c1,c2) => @@ -348,7 +348,7 @@ optIF2COND ["IF",a,b,c] == optXLAMCond x == x is ['%when,u:= [p,c],:l] => - p = '%otherwise => c + p is '%otherwise => c ['%when,u,:optCONDtail l] atom x => x x.first := optXLAMCond first x @@ -358,7 +358,7 @@ optXLAMCond x == optCONDtail l == null l => nil [frst:= [p,c],:l']:= l - p = '%otherwise => [['%otherwise,c]] + p is '%otherwise => [['%otherwise,c]] null rest l => [frst,['%otherwise,["CondError"]]] [frst,:optCONDtail l'] @@ -383,7 +383,7 @@ optSEQ ["SEQ",:l] == null l => nil l is [["%LET",g,x],:r] and replaceableTemporary?(g,r) => getRidOfTemps substitute(x,g,r) - first l="/throwAway" => getRidOfTemps rest l + first l is "/throwAway" => getRidOfTemps rest l --this gets rid of unwanted labels generated by declarations in SEQs [first l,:getRidOfTemps rest l] SEQToCOND l == @@ -483,7 +483,7 @@ isSimpleVMForm form == ++ on the program point where it is evaluated. isFloatableVMForm: %Code -> %Boolean isFloatableVMForm form == - atom form => form ~= "$" + atom form => form isnt "$" form is ["QUOTE",:.] => true symbolMember?(form.op, $simpleVMoperators) and "and"/[isFloatableVMForm arg for arg in form.args] @@ -504,7 +504,7 @@ isVMConstantForm form == findVMFreeVars form == IDENTP form => [form] form isnt [op,:args] => nil - op = "QUOTE" => nil + op is "QUOTE" => nil vars := union/[findVMFreeVars arg for arg in args] atom op => vars union(findVMFreeVars op,vars) @@ -582,7 +582,7 @@ optLET u == body isnt [op,:args] => u -- Well, with case-patterns, it is beneficial to try a bit harder -- with conditional forms. - op = '%when => + op is '%when => continue := true -- shall be continue let-inlining? -- Since we do a single pass, we can't reuse the inits list -- as we may find later that we can't really inline into @@ -681,7 +681,7 @@ optCollectVector form == optRetract ["%retract",e,m,pred] == atom e => cond := simplifyVMForm substitute(e,"#1",pred) - cond = '%true => e + cond is '%true => e ["check-subtype",cond,MKQ m,e] g := gensym() ['%bind,[[g,e]],["check-subtype",substitute(g,"#1",pred),MKQ m,g]] @@ -690,23 +690,23 @@ optRetract ["%retract",e,m,pred] == --% Boolean expression transformers optNot(x is ['%not,a]) == - a = '%true => '%false - a = '%false => '%true + a is '%true => '%false + a is '%false => '%true a is ['%not,b] => b a is ['%when,:.] => optCond [a.op, :[[p,optNot ['%not,c]] for [p,c] in a.args]] x optAnd(x is ['%and,a,b]) == - a = '%true => b - b = '%true => a - a = '%false => '%false + a is '%true => b + b is '%true => a + a is '%false => '%false x optOr(x is ['%or,a,b]) == - a = '%false => b - b = '%false => a - a = '%true => '%true + a is '%false => b + b is '%false => a + a is '%true => '%true x optIeq(x is ['%ieq,a,b]) == diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot index 4abb299a..4b849bf8 100644 --- a/src/interp/g-timer.boot +++ b/src/interp/g-timer.boot @@ -51,10 +51,10 @@ printNamedStatsByProperty(listofnames, prop) == strname := STRINGIMAGE name strval := STRINGIMAGE n sayBrightly concat(bright strname, - fillerSpaces(70-#strname-#strval,'"."),bright strval) - sayBrightly bright fillerSpaces(72,'"-") + fillerSpaces(70-#strname-#strval,char "."),bright strval) + sayBrightly bright fillerSpaces(72,char "-") sayBrightly concat(bright '"Total", - fillerSpaces(65-# STRINGIMAGE total,'"."),bright STRINGIMAGE total) + fillerSpaces(65-# STRINGIMAGE total,char "."),bright STRINGIMAGE total) makeLongStatStringByProperty _ (listofnames, listofclasses, prop, classprop, units, flag) == diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 47522a3b..23aa218a 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -40,7 +40,7 @@ namespace BOOT module g_-util where atomic?: %Thing -> %Boolean getTypeOfSyntax: %Form -> %Mode - pairList: (%List %Form,%List %Form) -> %List %Pair(%Form.%Form) + pairList: (%List %Form,%List %Form) -> %List %Pair(%Form,%Form) mkList: %List %Form -> %Form isSubDomain: (%Mode,%Mode) -> %Form usedSymbol?: (%Symbol,%Code) -> %Boolean @@ -458,9 +458,9 @@ insertWOC(x,y) == --% Miscellaneous Functions for Working with Strings -fillerSpaces(n,:charPart) == +fillerSpaces(n,charPart == char " ") == n <= 0 => '"" - MAKE_-FULL_-CVEC(n,IFCAR charPart or '" ") + makeString(n,charPart) centerString(text,width,fillchar) == wid := entryWidth text @@ -487,7 +487,6 @@ stringPrefix?(pref,str) == ok stringChar2Integer(str,pos) == - -- replaces GETSTRINGDIGIT in UT LISP -- returns small integer represented by character in position pos -- in string str. Returns NIL if not a digit or other error. if IDENTP str then str := symbolName str diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index a8049f29..74359a51 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -438,8 +438,8 @@ srcPosDisplay(sp) == col := srcPosColumn sp dots := col = 0 => '"" - fillerSpaces(col, '".") - sayBrightly [fillerSpaces(#s, '" "), dots, '"^"] + fillerSpaces(col, char ".") + sayBrightly [fillerSpaces(#s, char " "), dots, '"^"] true diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 4bd60e63..ddb6f291 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -461,7 +461,7 @@ appChar(string,x,y,d) == RPLACSTR(line,shiftedX,n:=#string,string,0,n) if bumpDeltaIfTrue=true then $highlightDelta:= $highlightDelta+1 d - appChar(string,x,y,append!(d,[[y,:GETFULLSTR(10+$LINELENGTH+$MARGIN," ")]])) + appChar(string,x,y,append!(d,[[y,:makeString(10+$LINELENGTH+$MARGIN,char " ")]])) print(x,domain) == dom:= devaluate domain @@ -1595,7 +1595,7 @@ output(expr,domain) == sayALGEBRA [:bright '"LISP",'"output:",'"%l",expr or '"NIL"] outputNumber(start,linelength,num) == - if start > 1 then blnks := fillerSpaces(start-1,'" ") + if start > 1 then blnks := fillerSpaces(start-1,char " ") else blnks := '"" under := '"__" firsttime:=(linelength>3) @@ -1619,7 +1619,7 @@ outputNumber(start,linelength,num) == sayALGEBRA [blnks, num] outputString(start,linelength,str) == - if start > 1 then blnks := fillerSpaces(start-1,'" ") + if start > 1 then blnks := fillerSpaces(start-1,char " ") else blnks := '"" while # str > linelength repeat if $collectOutput then diff --git a/src/interp/i-parser.boot b/src/interp/i-parser.boot index 10959f93..87132e30 100644 --- a/src/interp/i-parser.boot +++ b/src/interp/i-parser.boot @@ -71,7 +71,10 @@ collectParsedLines(s, p) == ++ parse the whole file `file'. Returns a list of parse tree ++ containing full source location information. parseInputFile file == - WITH_-OPEN_-FILE(st file, parseStream(st, file)) + try + st := inputTextFile file + parseStream(st, file) + finally (if st ~= nil then close st) ++ Same as parseInputFile, but returns a parse form, instead of ++ of a parse tree, i.e. source location information left out. diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 1c8b3ddd..1ab82514 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -2240,14 +2240,14 @@ loadSpad2Cmd args == reportCount () == centerAndHighlight(" Current Count Settings ",$LINELENGTH,specialChar 'hbar) SAY " " - sayBrightly [:bright " cache",fillerSpaces(30,'".")," ",$cacheCount] + sayBrightly [:bright " cache",fillerSpaces(30,char ".")," ",$cacheCount] if $cacheAlist then for [a,:b] in $cacheAlist repeat aPart:= linearFormatName a n:= sayBrightlyLength aPart - sayBrightly concat(" ",aPart," ",fillerSpaces(32-n,'".")," ",b) + sayBrightly concat(" ",aPart," ",fillerSpaces(32-n,char ".")," ",b) SAY " " - sayBrightly [:bright " stream",fillerSpaces(29,'".")," ",$streamCount] + sayBrightly [:bright " stream",fillerSpaces(29,char ".")," ",$streamCount] --% )library library args == @@ -2886,7 +2886,7 @@ printLabelledList(ls,label1,label2,prefix,patterns) == if syn = '"%i" then syn := '"%i " wid := MAX(30 - (entryWidth syn),1) sayBrightly concat('"%b",prefix,syn,'"%d", - fillerSpaces(wid,'"."),'" ",prefix,comm) + fillerSpaces(wid,char "."),'" ",prefix,comm) sayBrightly '"" whatCommands(patterns) == diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot index 03d8edf7..9d3642aa 100644 --- a/src/interp/i-toplev.boot +++ b/src/interp/i-toplev.boot @@ -96,14 +96,14 @@ start(:l) == readSpadProfileIfThere() if $displayStartMsgs then spadStartUpMsgs() if $OLDLINE then - SAY fillerSpaces($LINELENGTH,'"=") + SAY fillerSpaces($LINELENGTH,char "=") sayKeyedMsg("S2IZ0050",[namestring ['axiom,'input]]) if $OLDLINE ~= 'END__UNIT then centerAndHighlight($OLDLINE,$LINELENGTH,'" ") sayKeyedMsg("S2IZ0051",NIL) else sayKeyedMsg("S2IZ0052",NIL) - SAY fillerSpaces($LINELENGTH,'"=") + SAY fillerSpaces($LINELENGTH,char "=") TERPRI() $OLDLINE := NIL $superHash := hashTable 'EQUAL diff --git a/src/interp/incl.boot b/src/interp/incl.boot index 578f3ff2..bbe9cb08 100644 --- a/src/interp/incl.boot +++ b/src/interp/incl.boot @@ -66,7 +66,7 @@ incStringStream s== incRenumber incLude(0,incRgen s,0,['"strings"] ,[Top]) incFile fn== - incRenumber incLude(0,incRgen OPEN fn,0,[fn],[Top]) + incRenumber incLude(0,incRgen inputTextFile fn,0,[fn],[Top]) incStream(st, fn) == incRenumber incLude(0,incRgen st,0,[fn],[Top]) diff --git a/src/interp/int-top.boot b/src/interp/int-top.boot index 3fecbbd5..74760f91 100644 --- a/src/interp/int-top.boot +++ b/src/interp/int-top.boot @@ -211,7 +211,10 @@ intloopInclude0(st, name, n) == next(function lineoftoks,$lines)))) intloopInclude(name, n) == - WITH_-OPEN_-FILE(st name, intloopInclude0(st, name, n)) + try + st := inputTextFile name + intloopInclude0(st, name, n) + finally (if st ~= nil then closeFile st) intloopInclude1(name,n) == a:=ncloopIncFileName name @@ -345,7 +348,10 @@ ncloopInclude0(st, name, n) == next(function lineoftoks,$lines)))) ncloopInclude(name, n) == - WITH_-OPEN_-FILE(st name, ncloopInclude0(st, name, n)) + try + st := inputTextFile name + ncloopInclude0(st, name, n) + finally (if st ~= nil then closeFile st) ncloopInclude1(name,n) == a:=ncloopIncFileName name diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 9c5a8bcd..413f0ebb 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -488,7 +488,7 @@ compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) == compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == --fn= compDefineCategory1 OR compDefineFunctor1 - sayMSG fillerSpaces(72,'"-") + sayMSG fillerSpaces(72,char "-") $LISPLIB: local := 'T $op: local := op $lisplibAttributes: local := NIL @@ -533,7 +533,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == filearg := $FILEP(libName,$spadLibFT,$libraryDirectory) RPACKFILE filearg FRESH_-LINE $algebraOutputStream - sayMSG fillerSpaces(72,'"-") + sayMSG fillerSpaces(72,char "-") unloadOneConstructor(op,libName) LOCALDATABASE([symbolName getConstructorAbbreviationFromDB op],NIL) $newConlist := [op, :$newConlist] ----------> bound in function "compiler" @@ -809,7 +809,7 @@ getIndexPathname: %String -> %String getIndexPathname dir == strconc(ensureTrailingSlash dir, $IndexFilename) -getAllIndexPathnames: %String -> %List %Form +getAllIndexPathnames: %String -> %List %Thing getAllIndexPathnames dir == -- GCL's semantics of Common Lisp's `DIRECTORY *' differs from the -- rest of everybody else' semantics. Namely, GCL would return a @@ -822,7 +822,7 @@ getAllIndexPathnames dir == )endif -getAllAldorObjectFiles: %String -> %List %Form +getAllAldorObjectFiles: %String -> %List %Thing getAllAldorObjectFiles dir == asys := DIRECTORY strconc(dir,'"*.asy") asos := DIRECTORY strconc(dir,'"*.ao") @@ -838,19 +838,20 @@ getAllAldorObjectFiles dir == ++ in directory designated by 'dir'. openIndexFileIfPresent: %String -> %Thing openIndexFileIfPresent dir == - OPEN(getIndexPathname dir,KEYWORD::DIRECTION,KEYWORD::INPUT, - KEYWORD::IF_-DOES_-NOT_-EXIST,nil) + inputTextFile getIndexPathname dir ++ getIndexTable: %String -> %Thing getIndexTable dir == indexFile := getIndexPathname dir existingFile? indexFile => - WITH_-OPEN_-FILE(stream indexFile, - GET_-INDEX_-TABLE_-FROM_-STREAM stream) + try + stream := inputTextFile indexFile + GET_-INDEX_-TABLE_-FROM_-STREAM stream + finally (if stream ~= nil then closeFile stream) -- index file doesn't exist but mark this directory as a Lisplib. - WITH_-OPEN_-FILE(stream(indexFile,KEYWORD::DIRECTION,KEYWORD::OUTPUT), - nil) + try stream := outputTextFile indexFile + finally (if stream ~= nil then closeFile stream) --% compDefineExports(form,ops,sig,e) == diff --git a/src/interp/msg.boot b/src/interp/msg.boot index 88873010..2bd735a8 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -166,7 +166,7 @@ processChPosesForOneLine msgList == posLetter := rest assoc(poCharPosn getMsgPos msg,chPosList) oldPre := getMsgPrefix msg setMsgPrefix (msg,strconc(oldPre,_ - MAKE_-FULL_-CVEC ($preLength - 4 - # oldPre),posLetter) ) + makeString($preLength - 4 - # oldPre),posLetter) ) leaderMsg := makeLeaderMsg chPosList append!(msgList,[leaderMsg]) --a back cons @@ -226,8 +226,7 @@ putFTText (msg,chPosList) == setMsgText(msg,[:markingText,:getMsgText msg]) rep (c,n) == - n > 0 => - MAKE_-FULL_-CVEC(n, c) + n > 0 => makeString(n, c) '"" --called from parameter list of nc message functions @@ -424,10 +423,10 @@ listDecideHowMuch(pos,oldPos) == 'NONE getPreStL optPre == - null optPre => [MAKE_-FULL_-CVEC 2] + null optPre => [makeString 2] spses := (extraPlaces := ($preLength - (# optPre) - 3)) > 0 => - MAKE_-FULL_-CVEC extraPlaces + makeString extraPlaces '"" ['"%b", optPre,spses,'":", '"%d"] @@ -503,7 +502,7 @@ whichCat attr == --% these functions directly interact with the message object makeLeaderMsg chPosList == - st := MAKE_-FULL_-CVEC ($preLength- 3) + st := makeString($preLength- 3) oldPos := -1 for [posNum,:posLetter] in reverse chPosList repeat st := strconc(st, _ diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index c821ed45..d61a33a7 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -231,7 +231,7 @@ substituteSegmentedMsg(msg,args) == c = char "%" and n > 1 and stringChar(x,1) = char "x" and digit? stringChar(x,2) => - l := [fillerSpaces(DIG2FIX stringChar(x,2), '" "),:l] + l := [fillerSpaces(DIG2FIX stringChar(x,2),char " "),:l] --x is a plain word l := [x,:l] addBlanks reverse! l @@ -450,8 +450,8 @@ flowSegmentedMsg(msg, len, offset) == potentialMarg := 0 actualMarg := 0 - off := (offset <= 0 => '""; fillerSpaces(offset,'" ")) - off1:= (offset <= 1 => '""; fillerSpaces(offset-1,'" ")) + off := (offset <= 0 => '""; fillerSpaces(offset,char " ")) + off1:= (offset <= 1 => '""; fillerSpaces(offset-1,char " ")) firstLine := true cons? msg => @@ -554,7 +554,7 @@ sayString(x,out == $OutputStream) == spadStartUpMsgs() == -- messages displayed when the system starts up $LINELENGTH < 60 => NIL - bar := fillerSpaces($LINELENGTH,specialChar 'hbar) + bar := fillerSpaces($LINELENGTH,char specialChar 'hbar) sayKeyedMsg("S2GL0001",[_*BUILD_-VERSION_*, _*YEARWEEK_*]) sayMSG bar sayKeyedMsg("S2GL0018C",NIL) @@ -720,7 +720,7 @@ brightPrintCenter(x,out == $OutputStream) == wid := # x if wid < $LINELENGTH then f := DIVIDE($LINELENGTH - wid,2) - x := [fillerSpaces(f.0,'" "),x] + x := [fillerSpaces(f.0,char " "),x] for y in x repeat brightPrint0(y,out) NIL y := NIL @@ -733,7 +733,7 @@ brightPrintCenter(x,out == $OutputStream) == wid := sayBrightlyLength y if wid < $LINELENGTH then f := DIVIDE($LINELENGTH - wid,2) - y := [fillerSpaces(f.0,'" "),:y] + y := [fillerSpaces(f.0,char " "),:y] for z in y repeat brightPrint0(z,out) if x then sayNewLine(out) @@ -765,7 +765,7 @@ brightPrintRightJustify(x, out == $OutputStream) == x := object2String x wid := # x wid < $LINELENGTH => - x := [fillerSpaces($LINELENGTH-wid,'" "),x] + x := [fillerSpaces($LINELENGTH-wid,char " "),x] for y in x repeat brightPrint0(y,out) NIL brightPrint0(x,out) @@ -779,7 +779,7 @@ brightPrintRightJustify(x, out == $OutputStream) == y := reverse! y wid := sayBrightlyLength y if wid < $LINELENGTH then - y := [fillerSpaces($LINELENGTH-wid,'" "),:y] + y := [fillerSpaces($LINELENGTH-wid,char " "),:y] for z in y repeat brightPrint0(z,out) if x then sayNewLine(out) @@ -823,7 +823,7 @@ sayAsManyPerLineAsPossible l == str := '"" for i in 0..(n-1) repeat [c,:l] := l - str := strconc(str,c,fillerSpaces(w - #c,'" ")) + str := strconc(str,c,fillerSpaces(w - #c,char " ")) (i+1) rem p = 0 => (sayMSG str ; str := '"" ) if str ~= '"" then sayMSG str NIL @@ -861,7 +861,7 @@ say2PerLineThatFit l == while l repeat sayBrightlyNT first l sayBrightlyNT - fillerSpaces(($LINELENGTH quo 2 - sayDisplayWidth first l),'" ") + fillerSpaces(($LINELENGTH quo 2 - sayDisplayWidth first l),char " ") (l:= rest l) => sayBrightlyNT first l l:= rest l @@ -898,7 +898,7 @@ pp2Cols(al) == nil ppPair(abb,name) == - sayBrightlyNT [:bright abb,fillerSpaces(8-entryWidth abb," "),name] + sayBrightlyNT [:bright abb,fillerSpaces(8-entryWidth abb,char " "),name] canFit2ndEntry(name,al) == wid := $LINELENGTH quo 2 - 10 diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index c0d7277e..d74329b4 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -297,9 +297,8 @@ fortran2Lines f == fortran2Lines1 f == -- f is a list of strings making up 1 FORTRAN statement -- return: a reverse list of FORTRAN lines - normPref := MAKE_-STRING($fortIndent) - --contPref := strconc(MAKE_-STRING($fortIndent-1),"&") - contPref := strconc(" &",MAKE_-STRING($fortIndent-6)) + normPref := makeString $fortIndent + contPref := strconc(" &",makeString($fortIndent-6)) lines := NIL ll := $fortIndent while f repeat @@ -850,10 +849,24 @@ fix2FortranFloat e == isFloat e == FLOATP(e) or string?(e) and FIND(char ".",e) +removeCharFromString(c,s) == + -- find c's position in s. + k := nil + for i in 0..maxIndex s while k = nil repeat + stringChar(s,i) = c => k := i + k = nil => s + -- make a copy without c. + s' := makeString(#s - 1) + for i in 0..(k-1) repeat + stringChar(s',i) := stringChar(s,i) + for i in k..maxIndex s' repeat + stringChar(s',i) := stringChar(s,i+1) + s' + checkPrecision e == -- Do we have a string? string? e and codePoint stringChar(e,0) = 34 => e - e := delete(char " ",STRINGIMAGE e) + e := removeCharFromString(char " ",STRINGIMAGE e) $fortranPrecision = "double" => iPart := subSequence(e,0,(period:=POSITION(char ".",e))+1) expt := if ePos := POSITION(char "E",e) then subSequence(e,ePos+1) else "0" diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp index b3279119..059caf40 100644 --- a/src/interp/preparse.lisp +++ b/src/interp/preparse.lisp @@ -156,7 +156,7 @@ (SETQ NCOMBLOCK NIL))) (SETQ NCOMBLOCK (CONS N (CONS A (IFCDR NCOMBLOCK)))) (SETQ A "")) - ('T (PUSH (STRCONC (GETFULLSTR N " ") + ('T (PUSH (STRCONC (|makeString| N #\Space) (SUBSTRING A N ())) $LINELIST) (SETQ $INDEX (1- $INDEX)) (SETQ A (SUBSEQ A 0 N)))) diff --git a/src/interp/scan.boot b/src/interp/scan.boot index 91b7d275..8dcfc387 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -161,30 +161,29 @@ scanKeyTable:=scanKeyTableCons() scanInsert(s,d) == l := #s h := codePoint stringChar(s,0) - u := d.h + u := vectorRef(d,h) n := #u k:=0 - while l <= #(u.k) repeat + while l <= #vectorRef(u,k) repeat k := k+1 v := newVector(n+1) for i in 0..k-1 repeat - vectorRef(v,i) := u.i + vectorRef(v,i) := vectorRef(u,i) vectorRef(v,k) := s for i in k..n-1 repeat - vectorRef(v,i+1) := u.i + vectorRef(v,i+1) := vectorRef(u,i) vectorRef(d,h) := v s scanDictCons()== - l:= HKEYS scanKeyTable d := a := newVector 256 b := newVector 1 - vectorRef(b,0) := MAKE_-CVEC 0 + vectorRef(b,0) := '"" for i in 0..255 repeat vectorRef(a,i) := b a - for s in l repeat + for s in HKEYS scanKeyTable repeat scanInsert(s,d) d diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index 659c784f..c2c2f563 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -321,14 +321,14 @@ displaySetVariableSettings(setTree,label) == sayBrightly ["Variable ", "Description ", "Current Value"] - SAY fillerSpaces($LINELENGTH,specialChar 'hbar) + SAY fillerSpaces($LINELENGTH,char specialChar 'hbar) subtree := nil for setData in setTree repeat null satisfiesUserLevel setData.setLevel => nil setOption := object2String setData.setName - setOption := strconc(setOption,fillerSpaces(13-#setOption,'" "), + setOption := strconc(setOption,fillerSpaces(13-#setOption,char " "), setData.setLabel) - setOption := strconc(setOption,fillerSpaces(55-#setOption,'" ")) + setOption := strconc(setOption,fillerSpaces(55-#setOption,char " ")) st := setData.setType st = 'FUNCTION => opt := diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 349304f8..c9667864 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -66,7 +66,7 @@ $COMBLOCKLIST := nil ++ the runtime system. getVMType d == IDENTP d => - d = "*" => d + d is "*" => d "%Thing" string? d => "%Thing" -- literal flag parameter case (d' := devaluate d) of @@ -86,7 +86,7 @@ getVMType d == Vector => ["%Vector",getVMType second d'] PrimitiveArray => ["%SimpleArray", getVMType second d'] Pair => ["%Pair",getVMType second d',getVMType third d'] - Union => ["%Pair",'%Thing,'%Thing] + Union => ["%Pair",'%Short,'%Thing] Record => #rest d' > 2 => "%Shell" ["%Pair",'%Thing,'%Thing] @@ -116,14 +116,6 @@ functionp f == IDENTP f => FBOUNDP f and null MACRO_-FUNCTION f function? f -++ remove `item' from `sequence'. -delete(item,sequence) == - symbol? item => - REMOVE(item,sequence,KEYWORD::TEST,function sameObject?) - atom item and not array? item => - REMOVE(item,sequence) - REMOVE(item,sequence,KEYWORD::TEST,function EQUALP) - ++ returns true if `x' is contained in `y'. CONTAINED: (%Thing,%Thing) -> %Boolean CONTAINED(x,y) == main where @@ -330,10 +322,6 @@ readByteFromFile ifile == writeByteToFile(ofile,b) == writeByte(b,ofile) -closeFile file == - CLOSE file - nil - --% stringImage x == symbol? x => symbolName x diff --git a/src/interp/topics.boot b/src/interp/topics.boot index c107aa90..7cc8356d 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -90,7 +90,7 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . for item in items repeat HPUT($defaultsHash,item,[kind,:HGET($defaultsHash,item)]) $conTopicHash := hashTable 'EQL --key is constructor name; value is - instream := OPEN '"topics.data" + instream := inputTextFile '"topics.data" while not EOFP instream repeat line := READLINE instream while blankLine? line repeat line := READLINE instream diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index 590aa4a8..c8f83c3d 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -843,11 +843,6 @@ (define-function 'getstr #'make-cvec) -(defun make-full-cvec (sint &optional (char #\space)) - (make-string sint :initial-element (character char))) - -(define-function 'getfullstr #'make-full-cvec) - ; 17.2 Accessing (defun string2id-n (cvec sint) diff --git a/src/interp/word.boot b/src/interp/word.boot index 0b1a3b92..84a8014d 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -174,15 +174,15 @@ pickANumber(word,list) == secondList:= TAKE(-halfLength,short) secondStartIndex:= halfLength + extra shortList:= - "append"/[[[:bright i,fillerSpaces(xx-WIDTH i,'" "),x], - [:bright(i+secondStartIndex),fillerSpaces(xx-WIDTH (i+halfLength),'" "),y]] + "append"/[[[:bright i,fillerSpaces(xx-WIDTH i,char " "),x], + [:bright(i+secondStartIndex),fillerSpaces(xx-WIDTH (i+halfLength),char " "),y]] for i in 1.. for x in firstList for y in secondList] say2PerLineThatFit shortList i:= 1 + halfLength if extra=1 then - sayBrightly [:bright i,fillerSpaces(xx-WIDTH i,'" "),list.(i-1)] + sayBrightly [:bright i,fillerSpaces(xx-WIDTH i,char " "),list.(i-1)] for x in long for i in (1+length).. repeat - sayBrightly [:bright i,fillerSpaces(xx-WIDTH i,'" "),x] + sayBrightly [:bright i,fillerSpaces(xx-WIDTH i,char " "),x] center80 ['"If so: type a number between",:bright 1,'"and",:bright n,"and ENTER"] center80 ['"Anything else means",:bright 'no] y := queryUser nil diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in index 3f34b9f8..a083b108 100644 --- a/src/lisp/core.lisp.in +++ b/src/lisp/core.lisp.in @@ -84,6 +84,9 @@ ;; IO "inputBinaryFile" "outputBinaryFile" + "inputTextFile" + "outputTextFile" + "closeFile" ;; compiler data structures "%Mode" @@ -118,6 +121,7 @@ "%ByteArray" "makeByteArray" + "makeString" "%hasFeature" "%systemOptions" @@ -215,12 +219,10 @@ (deftype |%Maybe| (s) `(or null ,s)) (deftype |%Pair| (u v) - (declare (ignore u v)) - 'cons) + `(cons ,u ,v)) (deftype |%List| (s) - (declare (ignore s)) - 'list) + `(or null (cons ,s))) (deftype |%SimpleArray| (s) `(simple-array ,s)) @@ -439,13 +441,30 @@ ;; -*- File IO -*- (defun |inputBinaryFile| (f) - (open f :direction :input :element-type 'unsigned-byte + (open f + :direction :input + :element-type 'unsigned-byte :if-does-not-exist nil)) (defun |outputBinaryFile| (f) - (open f :direction :output :element-type 'unsigned-byte + (open f + :direction :output + :element-type 'unsigned-byte :if-exists :supersede)) +(defun |inputTextFile| (f) + (open f + :direction :input + :if-does-not-exist nil)) + +(defun |outputTextFile| (f) + (open f + :direction :output + :if-exists :supersede)) + +(defun |closeFile| (f) + (close f)) + ;; ;; -*- OpenAxiom filesystem -*- ;; @@ -1248,6 +1267,9 @@ :element-type '(unsigned-byte 8) :initial-element 0)) +(defun |makeString| (n &optional (c (code-char 0))) + (make-string n :initial-element c)) + ;; native data type translation table (defconstant |$NativeTypeTable| '((|void| . @void_type@) |