diff options
35 files changed, 112 insertions, 150 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 082ca6e2..aa1f06b9 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -40,7 +40,7 @@ import includer namespace BOOTTRAN -module ast +module ast (quote) ++ True means that Boot functions should be translated to use ++ hash tables to remember values. By default, functions are @@ -116,7 +116,7 @@ $inDefIS := false ++ returns a `quote' ast for x. quote x == - ["QUOTE",x] + ['QUOTE,x] --% @@ -191,7 +191,7 @@ bfAppend ls == bfColonAppend: (%List %Form,%Form) -> %Form bfColonAppend(x,y) == x = nil => - y is ["BVQUOTE",:a] => ["&REST",["QUOTE",:a]] + y is ["BVQUOTE",:a] => ["&REST",['QUOTE,:a]] ["&REST",y] [first x,:bfColonAppend(rest x,y)] @@ -358,7 +358,7 @@ bfSep(iters)== bfReduce(op,y)== a := - op is ["QUOTE",:.] => second op + op is ['QUOTE,:.] => second op op op := bfReName a init := a has SHOETHETA or op has SHOETHETA @@ -380,7 +380,7 @@ bfReduceCollect(op,y)== body := second y itl := third y a := - op is ["QUOTE",:.] => second op + op is ['QUOTE,:.] => second op op a is "append!" => bfDoCollect(body,itl,'lastNode,'skipNil) a is "append" => bfDoCollect(['copyList,body],itl,'lastNode,'skipNil) @@ -634,7 +634,7 @@ bfLET2(lhs,rhs) == cons? first b => [a,:b] [a,b] lhs is ['CONS,var1,var2] => - var1 is "DOT" or var1 is ["QUOTE",:.] => + var1 is "DOT" or var1 is ['QUOTE,:.] => bfLET2(var2,addCARorCDR('CDR,rhs)) l1 := bfLET2(var1,addCARorCDR('CAR,rhs)) var2 = nil or var2 is "DOT" =>l1 @@ -779,7 +779,7 @@ bfReName x== x sequence?(x,pred) == - x is ["QUOTE",seq] and cons? seq and + x is ['QUOTE,seq] and cons? seq and "and"/[apply(pred,y,nil) for y in seq] idList? x == @@ -795,10 +795,10 @@ stringList? x == ++ is a sequence (e.g. a list) bfMember(var,seq) == integer? var or sequence?(seq,function integer?) => - seq is ["QUOTE",[x]] => ["EQL",var,x] + seq is ['QUOTE,[x]] => ["EQL",var,x] ["scalarMember?",var,seq] defQuoteId var or sequence?(seq,function symbol?) => - seq is ["QUOTE",[x]] => ["EQ",var, quote x] + seq is ['QUOTE,[x]] => ["EQ",var, quote x] ["symbolMember?",var,seq] idList? seq => seq.args is [.] => ["EQ",var,:seq.args] @@ -806,7 +806,7 @@ bfMember(var,seq) == bfOR [["EQ",var,x],["EQ",var,y]] ["symbolMember?",var,seq] bfChar? var or sequence?(seq,function char?) => - seq is ["QUOTE",[x]] => ["CHAR=",var,x] + seq is ['QUOTE,[x]] => ["CHAR=",var,x] ["charMember?",var,seq] charList? seq => seq.args is [.] => ["CHAR=",var,:seq.args] @@ -814,7 +814,7 @@ bfMember(var,seq) == bfOR [["CHAR=",var,x],["CHAR=",var,y]] ["charMember?",var,seq] bfString? var or sequence?(seq,function string?) => - seq is ["QUOTE",[x]] => ["STRING=",var,x] + seq is ['QUOTE,[x]] => ["STRING=",var,x] ["stringMember?",var,seq] stringList? seq => seq.args is [.] => ["STRING=",var,:seq.args] @@ -856,7 +856,7 @@ bfAND l == defQuoteId x== - x is ["QUOTE",:.] and symbol? second x + x is ['QUOTE,:.] and symbol? second x bfChar? x == char? x or cons? x and x.op in '(char CODE_-CHAR SCHAR) @@ -964,7 +964,7 @@ bfParameterList(p1,p2) == bfInsertLet(x,body)== x = nil => [false,nil,x,body] x is ["&REST",a] => - a is ["QUOTE",b] => [true,"QUOTE",["&REST",b],body] + a is ['QUOTE,b] => [true,'QUOTE,["&REST",b],body] [false,nil,x,body] [b,norq,name1,body1] := bfInsertLet1 (first x,body) [b1,norq1,name2,body2] := bfInsertLet (rest x,body1) @@ -973,7 +973,7 @@ bfInsertLet(x,body)== bfInsertLet1(y,body)== y is ["L%T",l,r] => [false,nil,l,bfMKPROGN [bfLET(r,l),body]] symbol? y => [false,nil,y,body] - y is ["BVQUOTE",b] => [true,"QUOTE",b,body] + y is ["BVQUOTE",b] => [true,'QUOTE,b,body] g:=bfGenSymbol() y isnt [.,:.] => [false,nil,g,body] case y of @@ -1045,7 +1045,7 @@ shoeCompTran1 x == $dollarVars := [x,:$dollarVars] x U := first x - U is "QUOTE" => x + U is 'QUOTE => x x is ["CASE",y,:zs] => second(x) := shoeCompTran1 y while zs ~= nil repeat diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index cdeedf96..05a253a1 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -40,10 +40,6 @@ module scanner shoeTAB == abstractChar 9 --- converts X to double-float. -double x == - FLOAT(x, 1.0) - dqUnit s== a := [s] [a,:a] diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 6a92bd8d..2842cf8a 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -5,6 +5,8 @@ (PROVIDE "ast") +(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (EXPORT '|quote|)) + (DEFPARAMETER |$bfClamming| NIL) (DEFPARAMETER |$constantIdentifiers| NIL) diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 28ade94d..a5beae8e 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -182,38 +182,6 @@ (DEFUN |shoeLine?| (|s|) (|shoePrefix?| ")line" |s|)) -(DEFUN |shoeBiteOff| (|x|) - (PROG (|n1| |n|) - (RETURN - (PROGN - (SETQ |n| (|firstNonblankPosition| |x| 0)) - (COND ((NULL |n|) NIL) - (T (SETQ |n1| (|firstBlankPosittion| |x| |n|)) - (COND ((NULL |n1|) (LIST (|subString| |x| |n|) "")) - (T - (LIST (|subString| |x| |n| (- |n1| |n|)) - (|subString| |x| |n1|)))))))))) - -(DEFUN |shoeFileName| (|x|) - (PROG (|c| |a|) - (RETURN - (PROGN - (SETQ |a| (|shoeBiteOff| |x|)) - (COND ((NULL |a|) "") - (T (SETQ |c| (|shoeBiteOff| (CADR |a|))) - (COND ((NULL |c|) (CAR |a|)) - (T (CONCAT (CAR |a|) "." (CAR |c|)))))))))) - -(DEFUN |shoeFnFileName| (|x|) - (PROG (|c| |a|) - (RETURN - (PROGN - (SETQ |a| (|shoeBiteOff| |x|)) - (COND ((NULL |a|) (LIST "" "")) - (T (SETQ |c| (|shoeFileName| (CADR |a|))) - (COND ((NULL |c|) (LIST (CAR |a|) "")) - (T (LIST (CAR |a|) |c|))))))))) - (DEFUN |shoeInclude| (|s|) (|bDelay| #'|shoeInclude1| (LIST |s|))) (DEFUN |shoeInclude1| (|s|) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 166a9dce..1df760be 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -9,8 +9,6 @@ (DEFCONSTANT |shoeTAB| (CODE-CHAR 9)) -(DEFUN |double| (|x|) (FLOAT |x| 1.0)) - (DEFUN |dqUnit| (|s|) (PROG (|a|) (RETURN (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|))))) @@ -24,16 +22,17 @@ (DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) (T (CAR |s|)))) +(DEFUN |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|))) + (DEFUN |shoeConstructToken| (|lp| |b| |n|) - (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|)))) + (|shoeTokConstruct| (ELT |b| 0) (ELT |b| 1) (CONS |lp| |n|))) (DEFUN |shoeTokType| (|x|) (CAR |x|)) (DEFUN |shoeTokPart| (|x|) (CADR |x|)) -(DEFUN |shoeTokPosn| (|x|) (CDDR |x|)) - -(DEFUN |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|))) +(DEFUN |shoeTokPosn| (|x|) + (PROG (|p|) (RETURN (PROGN (SETQ |p| (CDDR |x|)) |p|)))) (DEFUN |shoeNextLine| (|s|) (PROG (|s1| |a|) @@ -406,7 +405,7 @@ (LET ((|bfVar#1| (- |ns| 1)) (|i| 0)) (LOOP (COND ((> |i| |bfVar#1|) (RETURN NIL)) - (T (SETQ |d| (|shoeOrdToNum| (SCHAR |s| |i|))) + (T (SETQ |d| (DIGIT-CHAR-P (SCHAR |s| |i|))) (SETQ |ival| (+ (* 10 |ival|) |d|)))) (SETQ |i| (+ |i| 1)))) |ival|)))) @@ -468,8 +467,6 @@ " is not a Boot character")) (|shoeLeafError| (SCHAR |$ln| |n|)))))) -(DEFUN |shoeOrdToNum| (|x|) (DIGIT-CHAR-P |x|)) - (DEFUN |shoeKeyWord| (|st|) (|tableValue| |shoeKeyTable| |st|)) (DEFUN |shoeKeyWordP| (|st|) (|tableValue| |shoeKeyTable| |st|)) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index c39dcf5b..2f87cc64 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -599,8 +599,6 @@ (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (EQ (CAR |ISTMP#2|) '|Foreign|)))))) (COND ((|%hasFeature| :SBCL) 'SB-ALIEN) - ((|%hasFeature| :CLISP) 'FFI) - ((|%hasFeature| :CLOZURE) 'CCL) ((|%hasFeature| :ECL) 'FFI) (T (RETURN NIL)))) ((|ident?| |ns|) |ns|) (T (|bpTrap|)))) (CONS 'USE-PACKAGE (CONS (SYMBOL-NAME |z|) |user|))))) @@ -877,7 +875,7 @@ (COND ((OR (NOT (CONSP |bfVar#5|)) (PROGN (SETQ |i| (CAR |bfVar#5|)) NIL)) (RETURN NIL)) - (T (SETQ |b| (CONCAT (PNAME |i|) " is used in ")) + (T (SETQ |b| (CONCAT (SYMBOL-NAME |i|) " is used in ")) (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream| |b|))) (SETQ |bfVar#5| (CDR |bfVar#5|)))))))) @@ -1131,7 +1129,7 @@ (COND ((OR (NOT (CONSP |bfVar#3|)) (PROGN (SETQ |i| (CAR |bfVar#3|)) NIL)) (RETURN NIL)) - (T (SETQ |a| (CONCAT (PNAME |i|) " is used in ")) + (T (SETQ |a| (CONCAT (SYMBOL-NAME |i|) " is used in ")) (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream| |a|))) (SETQ |bfVar#3| (CDR |bfVar#3|)))))))) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 7125bd09..c42cc8f2 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -19,8 +19,8 @@ |scalarMember?| |listMember?| |reverse| |reverse!| |lastNode| |append| |append!| |copyList| |substitute| |substitute!| |setDifference| |setUnion| |setIntersection| - |applySubst| |applySubst!| |applySubstNQ| |remove| - |removeSymbol| |atomic?| |finishLine|))) + |applySubst| |applySubst!| |applySubstNQ| |objectAssoc| + |remove| |removeSymbol| |atomic?| |finishLine|))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|)) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 8b58821c..7179d8fa 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -591,7 +591,7 @@ defuse1(e,y)== for i in dol repeat tableValue($bootDefined,i) := true defuse1 (append(ndol,e),b) - y is ["QUOTE",:a] => [] + y is ['QUOTE,:a] => [] y is ["+LINE",:a] => [] for i in y repeat defuse1(e,i) diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 44c20d2c..d60c7d5c 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -225,7 +225,7 @@ applySubst!(sl,t) == ++ Like applySubst, but skip quoted materials. applySubstNQ(sl,t) == t is [hd,:tl] => - hd is "QUOTE" => t + hd is 'QUOTE => t hd := applySubstNQ(sl,hd) tl := applySubstNQ(sl,tl) sameObject?(hd,first t) and sameObject?(tl,rest t) => t diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 49752fd0..492838bb 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -276,7 +276,7 @@ dbOuttran form == x res := mathform2HtString algCoerceInteractive(arg,typ,'(OutputForm)) integer? res or string? res => res - ['QUOTE,res] + quote res [op,:argl] dbOpsForm form == diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 33feca63..1905714d 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -459,8 +459,8 @@ MappingCategory(:sig) == sig = nil => error '"MappingCategory requires at least one argument" cat := eval ['Join,$Type, - ['mkCategory,quoteForm 'domain, - quoteForm [[['elt,[first sig,'$,:rest sig]],true]], + ['mkCategory,quote 'domain, + quote [[['elt,[first sig,'$,:rest sig]],true]], [], [], nil]] canonicalForm(cat) := ['MappingCategory,:sig] cat @@ -499,8 +499,8 @@ coerceMap2E(x) == EnumerationCategory(:"args") == cat := eval ['Join,$SetCategory, - ['mkCategory,quoteForm 'domain, - quoteForm [[[arg,['$],'constant],'T] for arg in args], + ['mkCategory,quote 'domain, + quote [[[arg,['$],'constant],'T] for arg in args], [], [], nil]] canonicalForm(cat) := ['EnumerationCategory,:args] cat diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 4e209b84..ca882986 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -200,7 +200,7 @@ $optExportedFunctionReference := false ++ Quote form, if not a basic value. quoteMinimally form == integer? form or string? form or form = nil or form = true => form - ["QUOTE",form] + quote form ++ If using old `Rep' definition semantics, return `$' when m is `Rep'. ++ Otherwise, return `m'. @@ -1761,7 +1761,7 @@ expandFormTemplate(shell,args,slot) == slot is ["local",parm] and (n := isFormal parm) => args.n -- FIXME: we should probably expand with dual signature slot is ["NRTEVAL",val] => val - slot is ["QUOTE",val] => + slot is ['QUOTE,val] => string? val => val slot [expandFormTemplate(shell,args,i) for i in slot] @@ -1776,7 +1776,7 @@ equalFormTemplate(shell,args,slot,form) == slot is ["local",parm] and (n := isFormal parm) => equalFormTemplate(shell,args,args.n,form) slot is ["NTREVAL",val] => form = val - slot is ["QUOTE",val] => + slot is ['QUOTE,val] => string? val or symbol? val or integer? val => val = form slot = form slot isnt [.,:.] or form isnt [.,:.] => form = slot diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 39a3f765..5a93d546 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -180,11 +180,11 @@ comp3(x,m,$e) == $e:= addDomain(m,$e) e:= $e --for debugging purposes m is ["Mapping",:.] => compWithMappingMode(x,m,e) - m is ["QUOTE",a] => (x=a => [x,m,$e]; nil) + m is ['QUOTE,a] => (x=a => [x,m,$e]; nil) string? m => (x isnt [.,:.] => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil) -- In quasiquote mode, x should match exactly (y := isQuasiquote m) => - y = x => [["QUOTE",x], m, $e] + y = x => [quote x, m, $e] nil x isnt [.,:.] => compAtom(x,m,e) op:= x.op @@ -394,7 +394,7 @@ primitiveType x == compSymbol(s,m,e) == s is "$NoValue" => ["$NoValue",$NoValueMode,e] isFluid s => [s,getmode(s,e) or return nil,e] - sameObject?(s,m) or isLiteral(s,e) => [["QUOTE",s],s,e] + sameObject?(s,m) or isLiteral(s,e) => [quote s,s,e] v := get(s,"value",e) => symbolMember?(s,$functorLocalParameters) => NRTgetLocalIndex s @@ -408,7 +408,7 @@ compSymbol(s,m,e) == symbolMember?(s,$FormalMapVariableList) => stackMessage('"no mode found for %1b",[s]) listMember?(m,$IOFormDomains) or member(m,[$Identifier,$Symbol]) => - [['QUOTE,s],m,e] + [quote s,m,e] not isFunction(s,e) => errorRef s ++ Return true if `m' is the most recent unique type case assumption @@ -687,7 +687,7 @@ compApplication(op,argl,m,T) == compToApply(op,argl,m,e) == T := compNoStacking(op,$EmptyMode,e) or return nil - T.expr is ["QUOTE", =T.mode] => nil + T.expr is ['QUOTE, =T.mode] => nil compApplication(op,argl,m,T) ++ `form' is a call to a operation described by the signature `sig'. @@ -912,7 +912,7 @@ setqMultipleExplicit(nameList,valList,m,e) == compileQuasiquote: (%Instantiation,%Mode,%Env) -> %Maybe %Triple compileQuasiquote(["[||]",:form],m,e) == null form => nil - coerce([["QUOTE", :form],$Syntax,e], m) + coerce([['QUOTE, :form],$Syntax,e], m) --% WHERE @@ -967,7 +967,7 @@ compConstruct(form is ["construct",:l],m,e) == ++ Compile a literal (quoted) symbol. compQuote: (%Form,%Mode,%Env) -> %Maybe %Triple compQuote(expr,m,e) == - expr is ["QUOTE",x] and ident? x => + expr is ['QUOTE,x] and ident? x => -- Ideally, Identifier should be the default type. However, for -- historical reasons we cannot afford that luxury yet. m = $Identifier or listMember?(m,$IOFormDomains) => [expr,m,e] @@ -985,7 +985,7 @@ compVector: (%Form,%Mode,%Env) -> %Maybe %Triple compVector(l,m is ["Vector",mUnder],e) == Tl := [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] Tl is "failed" => nil - [["MAKE-ARRAY", #Tl, KEYWORD::ELEMENT_-TYPE, quoteForm getVMType mUnder, + [["MAKE-ARRAY", #Tl, KEYWORD::ELEMENT_-TYPE, quote getVMType mUnder, KEYWORD::INITIAL_-CONTENTS, ['%list, :[T.expr for T in Tl]]],m,e] --% MACROS @@ -1228,7 +1228,7 @@ compHasFormat(pred is ["has",olda,b],e) == a := applySubst(pairList(formals,argl),olda) [a,.,e] := comp(a,$EmptyMode,e) or return nil a := applySubst(pairList(argl,formals),a) - b is ["ATTRIBUTE",c] => ["HasAttribute",a,["QUOTE",c]] + b is ["ATTRIBUTE",c] => ["HasAttribute",a,quote c] b is ["SIGNATURE",op,sig,:.] => ["HasSignature",a, mkList [MKQ op,mkList [mkTypeForm type for type in sig]]] @@ -2292,7 +2292,7 @@ numberize x == localReferenceIfThere m == m is "$" => m idx := NRTassocIndex m => ['%tref,'$,idx] - quoteForm m + quote m massageLoop x == main x where main x == @@ -2601,7 +2601,7 @@ compLambda(x is ["+->",vars,body],m,e) == stackAndThrow('"inappropriate function type for unnamed mapping",nil) compUnnamedMapping(parms,src,dst,body,e) or return nil -- Otherwise, assumes this is just purely syntactic code block. - [quoteForm ["+->",parms,body],$AnonymousFunction,e] + [quote ["+->",parms,body],$AnonymousFunction,e] -- 2.2. If all parameters are declared, then compile as a mapping. and/[s ~= nil for s in source] => compUnnamedMapping(parms,source,$EmptyMode,body,e) or return nil diff --git a/src/interp/define.boot b/src/interp/define.boot index a3911f27..e0d4f9ea 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1041,9 +1041,9 @@ compDefineCategory2(form,signature,specialCases,body,m,e, for [u,:v] in $extraParms repeat formals := [u,:formals] actuals := [MKQ v,:actuals] - body := ['sublisV,['pairList,['QUOTE,formals],['%list,:actuals]],body] + body := ['sublisV,['pairList,quote formals,['%list,:actuals]],body] if argl then body:= -- always subst for args after extraparms - ['sublisV,['pairList,['QUOTE,sargl],['%list,: + ['sublisV,['pairList,quote sargl,['%list,: [['devaluate,u] for u in sargl]]],body] body:= ["%bind",[[g:= gensym(),body]], @@ -1071,7 +1071,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, mkConstructor: %Form -> %Form mkConstructor form == form isnt [.,:.] => ['devaluate,form] - null form.args => ['QUOTE,[form.op]] + null form.args => quote [form.op] ['%list,MKQ form.op,:[mkConstructor x for x in form.args]] compDefineCategory(df,m,e,prefix,fal) == @@ -1448,7 +1448,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], -- Functors are incomplete during bootstrap if $bootStrapMode then evalAndRwriteLispForm('%incomplete, - ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'%incomplete], true]) + ['MAKEPROP,quote op',quote '%incomplete,true]) dbBeingDefined?(db) := false [fun,['Mapping,:signature'],originale] @@ -2404,13 +2404,13 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) == ["mkCategory",MKQ domainOrPackage,['%list,:reverse sigList], ['%list,:reverse atList],MKQ domList,nil] where domList() == - ("union"/[fn sig for ["QUOTE",[[.,sig,:.],:.]] in sigList]) where + ("union"/[fn sig for ['QUOTE,[[.,sig,:.],:.]] in sigList]) where fn sig == [D for D in sig | mustInstantiate D] parameters:= removeDuplicates ("append"/ [[x for x in sig | ident? x and x~='_$] - for ["QUOTE",[[.,sig,:.],:.]] in sigList]) + for ['QUOTE,[[.,sig,:.],:.]] in sigList]) wrapDomainSub(parameters,body) DomainSubstitutionFunction(parameters,body) == @@ -2427,9 +2427,9 @@ DomainSubstitutionFunction(parameters,body) == --bound in buildFunctor --For categories, bound and used in compDefineCategory MKQ g - first body is "QUOTE" => body + first body is 'QUOTE => body cons? $definition and isFunctor body.op and - body.op ~= $definition.op => quoteForm simplifyVMForm body + body.op ~= $definition.op => quote simplifyVMForm body [Subst(parameters,u) for u in body] body isnt ["Join",:.] => body $definition isnt [.,:.] => body diff --git a/src/interp/format.boot b/src/interp/format.boot index c368f164..4498f339 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -789,7 +789,7 @@ form2Fence form == form2Fence1 x == x is [op,:argl] => - op = "QUOTE" => ['"(QUOTE ",:form2FenceQuote first argl,'")"] + op = 'QUOTE => ['"(QUOTE ",:form2FenceQuote first argl,'")"] ['"(", FORMAT(nil, '"|~a|", op),:"append"/[form2Fence1 y for y in argl],'")"] null x => '"" ident? x => FORMAT(nil, '"|~a|", x) diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 2ffe80a1..a5907f06 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -283,14 +283,14 @@ spadTypeTTT u == mkQuote l == [addQuote(u)for u in l] where addQuote u == - u isnt [.,:.] => ['QUOTE,u] + u isnt [.,:.] => quote u ["construct",:[addQuote(v) for v in u]] makeLispList(l) == outputList := [] for u in l repeat outputList := [:outputList, _ - if u isnt [.,:.] then ['QUOTE,u] else [["$elt","Lisp","construct"],_ + if u isnt [.,:.] then quote u else [["$elt","Lisp","construct"],_ :makeLispList(u)]] outputList diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 3860c8e8..21be836f 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -257,7 +257,7 @@ optFunctorBody x == null l => nil l:= [optFunctorBody u for u in l] and/[optFunctorBodyQuotable u for u in l] => - ['QUOTE,[optFunctorBodyRequote u for u in l]] + quote [optFunctorBodyRequote u for u in l] ['%list,:l] x is ['PROGN,:l] => ['PROGN,:optFunctorPROGN l] x is ['%when,:l] => @@ -573,7 +573,7 @@ SigSlotsMatch(sig,pattern,implem) == makeMissingFunctionEntry(alist,i) == tran applySubst(alist,$SetFunctions.i) where tran x == - x is ["HasCategory",a,["QUOTE",b]] => ["has",a,b] + x is ["HasCategory",a,['QUOTE,b]] => ["has",a,b] x is [op,:l] and op in '(AND OR NOT) => [op,:[tran y for y in l]] x @@ -679,7 +679,7 @@ InvestigateConditions(catvecListMaker,env) == reshape(u,env) == ['%when,[TryGDC ICformat(rest u,env)], ['%otherwise,['RPLACA,'(CAR TrueDomain), - ['delete,['QUOTE,first u],'(CAAR TrueDomain)]]]] + ['delete, quote first u,'(CAAR TrueDomain)]]]] $supplementaries:= [u for u in list | not listMember?(first u,masterSecondaries) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 38ad55b6..e2a1e7c9 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -483,7 +483,7 @@ isSimpleVMForm form == isFloatableVMForm: %Code -> %Boolean isFloatableVMForm form == form isnt [.,:.] => form isnt "$" - form is ["QUOTE",:.] => true + form is ['QUOTE,:.] => true symbolMember?(form.op, $simpleVMoperators) and "and"/[isFloatableVMForm arg for arg in form.args] @@ -503,7 +503,7 @@ isVMConstantForm form == findVMFreeVars form == ident? form => [form] form isnt [op,:args] => nil - op is "QUOTE" => nil + op is 'QUOTE => nil vars := union/[findVMFreeVars arg for arg in args] op isnt [.,:.] => vars setUnion(findVMFreeVars op,vars) @@ -586,7 +586,7 @@ optList form == form is ['%list] => '%nil literalElts := [(x is ['QUOTE,y] => y; leave "failed") for x in form.args] literalElts is "failed" => form - quoteForm literalElts + quote literalElts optCollectVector form == [.,eltType,:iters,body] := form diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 41a07a51..f9bb8ef0 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -357,7 +357,7 @@ getTypeOfSyntax t == $Syntax [op,:.] := t op = "Mapping" => '(MappingAst) - op = "QUOTE" and #t = 2 and ident? second t => ["Literal",$Symbol] + op = 'QUOTE and #t = 2 and ident? second t => ["Literal",$Symbol] op = "IF" => '(IfAst) op = "REPEAT" => '(RepeatAst) op = "WHILE" => '(WhileAst) diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index c6fafef5..0def18d3 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -49,7 +49,7 @@ evalDomain form == mkEvalable form == form is [op,:argl] => - op is "QUOTE" => form + op is 'QUOTE => form op is ":" => [op,second form,mkEvalable third form] op is "WRAPPED" => mkEvalable devaluate argl op in '(Record Union Mapping) => diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 11199b26..e91f1d43 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -77,7 +77,7 @@ mkAtreeExpandMacros x == args => "doNothing" x := body x is [op,:argl] => - op = "QUOTE" => "doNothing" + op = 'QUOTE => "doNothing" op = "where" and argl is [before,after] => -- in a where clause, what follows "where" (the "after" parm -- above) might be a local macro, so do not expand the "before" @@ -135,7 +135,7 @@ mkAtree2(x,op,argl) == [mkAtreeNode op,mkAtree1 val] [mkAtreeNode op,mkAtree1 '(void)] op="exit" => mkAtree1 second argl - op = "QUOTE" => [mkAtreeNode op,:argl] + op = 'QUOTE => [mkAtreeNode op,:argl] op="SEGMENT" => argl is [a] => [mkAtreeNode op, mkAtree1 a] z := diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 5a25e8e3..8261ac76 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -343,7 +343,7 @@ mkFormalArg(x,s) == isConstantArgument x == integer? x => x - x is ["QUOTE",.] => x + x is ['QUOTE,.] => x isPatternArgument x == x is ["construct",:.] diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index dc486e75..972d6ed4 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -102,11 +102,11 @@ unwrap x == x quote2Wrapped x == - x is ["QUOTE",y] => wrap y + x is ['QUOTE,y] => wrap y x removeQuote x == - x is ["QUOTE",y] => y + x is ['QUOTE,y] => y x ++ returns the normal form of `obj''s value, suitable for use as @@ -133,7 +133,7 @@ instantiationNormalForm(op,argl) == -- addQuote x == -- integer? x => x --- ['QUOTE,x] +-- quote x --% Library compiler structures needed by the interpreter @@ -146,10 +146,10 @@ asTupleNew0(eltType,listOfElts) == [#listOfElts,:makeSimpleArrayFromList(eltType,listOfElts)] asTupleNewCode(eltType, size, listOfElts) == - ["asTupleNew", quoteForm getVMType eltType, size, ['%list, :listOfElts]] + ["asTupleNew", quote getVMType eltType, size, ['%list, :listOfElts]] asTupleNewCode0(eltType,listForm) == - ["asTupleNew0", quoteForm getVMType eltType, listForm] + ["asTupleNew0", quote getVMType eltType, listForm] asTupleSize(at) == first at asTupleAsVector(at) == rest at diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot index b3fd5f40..ee5291ed 100644 --- a/src/interp/i-special.boot +++ b/src/interp/i-special.boot @@ -1744,7 +1744,7 @@ up%LET t == cons? lhs => var:= getUnname first lhs var = "construct" => upLETWithPatternOnLhs t - var = "QUOTE" => throwKeyedMsg("S2IS0027",['"A quoted form"]) + var = 'QUOTE => throwKeyedMsg("S2IS0027",['"A quoted form"]) upLETWithFormOnLhs(op,lhs,rhs) var:= getUnname lhs var = $immediateDataSymbol => @@ -1846,7 +1846,7 @@ upLETWithPatternOnLhs(t := [op,pattern,a]) == -- have to change code to return value of a failCode := ['spadThrowBrightly,['concat, - '" Pattern",['QUOTE,bright form2String pattern], + '" Pattern",quote bright form2String pattern, '"is not matched in assignment to right-hand side."]] if $genValue then @@ -2062,7 +2062,7 @@ upQUOTE t == evalQUOTE(op,[expr],[m]) == triple:= $genValue => objNewWrap(expr,m) - objNew(['QUOTE,expr],m) + objNew(quote expr,m) putValue(op,triple) --% Quasiquotation diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot index fc7d4cf2..073666b8 100644 --- a/src/interp/i-toplev.boot +++ b/src/interp/i-toplev.boot @@ -152,7 +152,6 @@ processInteractive(form, posnForm) == $domPvar: local := nil $inRetract: local := nil object := processInteractive1(form, posnForm) - --object := ERRORSET(['processInteractive1,LIST('QUOTE,form),['QUOTE,posnForm]],'t,'t) if not($ProcessInteractiveValue) then if $reportInstantiations then reportInstantiations() diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 778f6d91..89972184 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -194,7 +194,7 @@ expandList(x is ['%list,:args]) == arg is ['QUOTE,form] => form nil args' = 'failed => ['LIST,:args] - quoteForm args' + quote args' expandReturn(x is ['%return,.,y]) == $FUNNAME = nil => systemErrorHere ['expandReturn,x] @@ -290,7 +290,7 @@ expandFgt ['%fgt,x,y] == expandFlt ['%flt,y,x] expandFcstpi ['%fcstpi] == - ['COERCE,'PI,quoteForm '%DoubleFloat] + ['COERCE,'PI,quote '%DoubleFloat] expandFsqrt ['%fsqrt,x] == ['C_-TO_-R,['SQRT,expandToVMForm x]] @@ -338,11 +338,11 @@ expandStrstc ['%strstc,x,y,z] == expandToVMForm ['%store,['%schar,x,y],z] expandBytevec2str ['%bytevec2str,x] == - ['MAP,quoteForm 'STRING, --FIXME: should be '%String, fix when SBCL is fixed. + ['MAP,quote 'STRING, --FIXME: should be '%String, fix when SBCL is fixed. ['FUNCTION,['LAMBDA,['c],['CODE_-CHAR,'c]]],expandToVMForm x] expandStr2bytevec ['%str2bytevec,x] == - ['MAP,quoteForm ['%Vector,'%Byte], + ['MAP,quote ['%Vector,'%Byte], ['FUNCTION,['LAMBDA,['c],['CHAR_-CODE,'c]]],expandToVMForm x] -- bit vector operations @@ -371,7 +371,7 @@ expandBitveccopy ['%bitveccopy,x] == ['COPY_-SEQ,expandToVMForm x] expandBitvecconc ['%bitvecconc,x,y] == - ['CONCATENATE, quoteForm '%BitVector,expandToVMForm x,expandToVMForm y] + ['CONCATENATE, quote '%BitVector,expandToVMForm x,expandToVMForm y] expandBitvecref ['%bitvecref,x,y] == ['SBIT,expandToVMForm x,expandToVMForm y] @@ -384,7 +384,7 @@ expandBitveclt ['%bitveclt,x,y] == expandBitvector ['%bitvector,x,y] == ['MAKE_-ARRAY,['LIST,expandToVMForm x], - KEYWORD::ELEMENT_-TYPE,quoteForm '%Bit, + KEYWORD::ELEMENT_-TYPE,quote '%Bit, KEYWORD::INITIAL_-ELEMENT,expandToVMForm y] --% complex number conversions diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index a6cf576b..7e38ce42 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -464,11 +464,11 @@ initializeLisplib libName == ADDOPTIONS('FILE,$libFile) mkCtorDBForm ctor == - ['constructorDB,quoteForm ctor] + ['constructorDB,quote ctor] writeInfo(ctor,info,key,prop,file) == if info ~= nil then - insn := ['%store,[prop,mkCtorDBForm ctor],quoteForm info] + insn := ['%store,[prop,mkCtorDBForm ctor],quote info] LAM_,FILEACTQ(key,expandToVMForm insn) lisplibWrite(symbolName key,info,file) diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 7edba7aa..53cba5de 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -437,7 +437,7 @@ exp2FortSpecial(op,args,nargs) == mkFortFn("EQ",[first args, third args],2) --the next line is NEVER used by FORTRAN code but is needed when -- called to get a linearized form for the browser - op = "QUOTE" => + op = 'QUOTE => (arg := first args) isnt [.,:.] => STRINGIMAGE arg tailPart := strconc/[strconc('",",x) for x in rest arg] strconc('"[",first arg,tailPart,'"]") @@ -744,7 +744,7 @@ updateSymbolTable(name,type) == fun := ['$elt,'SYMS,'declare!] coercion := ['_:_:,STRING type,'FST] $insideCompileBodyIfTrue: local := false - interpret([fun,["QUOTE",name],coercion]) + interpret([fun,quote name,coercion]) addCommas l == not l => nil diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 0215f047..93bcebb4 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -130,7 +130,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == v x is "$" => x x is "$$" => x - ['QUOTE,x] + quote x --------------FUNCTIONS CALLED DURING CAPSULE FUNCTION COMPILATION------------- listOfBoundVars form == @@ -745,7 +745,7 @@ NRTputInHead bod == bod is ['%when,:clauses] => for cc in clauses repeat NRTputInTail cc bod - bod is ["QUOTE",:.] => bod + bod is ['QUOTE,:.] => bod bod is ["CLOSEDFN",:.] => bod NRTputInHead first bod NRTputInTail rest bod diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index f5afe44c..91c2560c 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -381,7 +381,7 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == ++ constructor, that is a builtin constructor or any operator we ++ deem as a constructor from the domain slot-filling machinery perspective. generalizedBuiltinConstructor? s == - builtinConstructor? s or s is "QUOTE" or s is "[||]" + builtinConstructor? s or s is 'QUOTE or s is "[||]" lazyMatch(source,lazyt,dollar,domain) == lazyt is [op,:argl] and cons? source and op=first source @@ -468,7 +468,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) == [":",first argl,newExpandLocalTypeArgs(second argl,dollar,domain,true)] functorName is "[||]" => [functorName,newExpandLocalTypeArgs(first argl,dollar,domain,true)] - functorName is "QUOTE" => [functorName,:argl] + functorName is 'QUOTE => [functorName,:argl] builtinConstructor? functorName => [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] coSig := getDualSignature functorName or @@ -526,7 +526,7 @@ lazyDomainSet(lazyForm,thisDomain,slot) == resolveNiladicConstructors form == ident? form and niladicConstructor? form => [form] form isnt [.,:.] => form - form is ["QUOTE",:.] => form + form is ['QUOTE,:.] => form for args in tails rest form repeat args.first := resolveNiladicConstructors first args form diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot index eaf188a8..d368e2fc 100644 --- a/src/interp/pf2atree.boot +++ b/src/interp/pf2atree.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -509,7 +509,7 @@ pfCollect2Atree pf == -- [[.,.,:rhs],:.] := $multiVarPredicateList -- pvarPredTran(rhs, varList) -- ['suchThat, rule, --- ['construct, :[["QUOTE", var] for var in varList]], +-- ['construct, :[quote var for var in varList]], -- ['ADEF, '(predicateVariable), -- '((Boolean) (List (Expression (Integer)))), '(() ()), -- predBody]] diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot index 30e619ff..232a004a 100644 --- a/src/interp/pf2sex.boot +++ b/src/interp/pf2sex.boot @@ -62,15 +62,15 @@ pf2Sex1 pf == pfSymbol? pf => $insideRule = 'left => s := pfSymbolSymbol pf - ["constant", ["QUOTE", s]] - ["QUOTE", pfSymbolSymbol pf] + ["constant", quote s] + quote pfSymbolSymbol pf pfLiteral? pf => pfLiteral2Sex pf pfId? pf => $insideRule => s := pfIdSymbol pf SymMemQ(s, '(%pi %e %i)) => s - ["QUOTE", s] + quote s pfIdSymbol pf pfApplication? pf => pfApplication2Sex pf @@ -194,10 +194,10 @@ pfLiteral2Sex pf == type = 'symbol => $insideRule => s := pfSymbolSymbol pf - ["QUOTE", s] + quote s pfSymbolSymbol pf type = 'expression => - ["QUOTE", pfLeafToken pf] + quote pfLeafToken pf keyedSystemError('"S2GE0017", ['"pfLiteral2Sex: unexpected form"]) symEqual(sym, sym2) == sameObject?(sym, sym2) @@ -212,7 +212,7 @@ pmDontQuote? sy == pfOp2Sex pf == alreadyQuoted := pfSymbol? pf op := pf2Sex1 pf - op is ["QUOTE", realOp] => + op is ['QUOTE, realOp] => $insideRule = 'left => realOp $insideRule = 'right => pmDontQuote? realOp => realOp @@ -266,11 +266,11 @@ pfApplication2Sex pf == symEqual(op, "%braceFromCurly") => argSex is ["SEQ",:.] => argSex ["brace", ["construct", :argSex]] - op is [qt, realOp] and symEqual(qt, "QUOTE") => + op is [qt, realOp] and symEqual(qt, 'QUOTE) => ["applyQuote", op, :argSex] val := hasOptArgs? argSex => [op, :val] [op, :argSex] - op is [qt, realOp] and symEqual(qt, "QUOTE") => + op is [qt, realOp] and symEqual(qt, 'QUOTE) => pfFinishApplication ["applyQuote", op, pf2Sex1 args] symEqual(op, "%braceFromCurly") => pfFinishApplication x := pf2Sex1 args @@ -458,7 +458,7 @@ rulePredicateTran rule == [[.,.,:rhs],:.] := $multiVarPredicateList pvarPredTran(rhs, varList) ['suchThat, rule, - ['construct, :[["QUOTE", var] for var in varList]], + ['construct, :[quote var for var in varList]], ['ADEF, '(predicateVariable), '((Boolean) (List (Expression (Integer)))), '(() ()), predBody]] diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 264bcdc8..142b498e 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -247,7 +247,7 @@ postDefArgs argl == argl is [[":",a],:b] => b ~= nil => postError ['" Argument",:bright a,'"of indefinite length must be last"] - a isnt [.,:.] or a is ["QUOTE",:.] => a + a isnt [.,:.] or a is ['QUOTE,:.] => a postError ['" Argument",:bright a,'"of indefinite length must be a name"] [first argl,:postDefArgs rest argl] @@ -313,7 +313,7 @@ postForm u == postQuote: %ParseTree -> %ParseForm postQuote [.,a] == - ["QUOTE",a] + quote a postScriptsForm: (%ParseTree,%List %ParseTree) -> %ParseForm @@ -555,7 +555,7 @@ postcheck x == x is ["DEF",form,[target,:.],:.] => setDefOp form postcheck rest rest x - x is ["QUOTE",:.] => nil + x is ['QUOTE,:.] => nil postcheck first x postcheck rest x diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 3f78da41..b39a800c 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -346,9 +346,6 @@ subString(s,f,n == nil) == n = nil => subSequence(s,f) subSequence(s,f,f + n) -quoteForm t == - ["QUOTE",t] - --% assoc symbolAssoc(s,l) == diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in index 98461fec..ba19d87f 100644 --- a/src/lisp/core.lisp.in +++ b/src/lisp/core.lisp.in @@ -187,6 +187,7 @@ "ident?" ;; numeric support + "double" "%fNaN?" )) @@ -1347,6 +1348,10 @@ #+:ecl `(ext:float-nan-p ,x) #-(or :sbcl :ecl) `(/= ,x ,x)) +;; convert an integer to double-float +(defmacro |double| (x) + `(float ,x 1.0d0)) + ;; ;; -*- Native Datatype correspondance -*- ;; |