diff options
Diffstat (limited to 'src')
35 files changed, 108 insertions, 106 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 632fdc47..c741a315 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -608,11 +608,11 @@ defSheepAndGoats(tu,x)== bfTupleP args => rest args [args] argl = nil => - opassoc := [[op,:body]] + opassoc := [[op,:translateForm body]] [opassoc,[],[]] op1 := makeSymbol strconc(symbolName enclosingFunction tu,'",",symbolName op) opassoc := [[op,:op1]] - defstack := [[op1,args,body]] + defstack := [[op1,args,translateForm body]] [opassoc,defstack,[]] %Pile defs => defSheepAndGoatsList(tu,defs) otherwise => [[],[],[x]] @@ -837,7 +837,7 @@ bfReName x== sequence?(x,pred) == x is ['QUOTE,seq] and cons? seq and - "and"/[apply(pred,y,nil) for y in seq] + "and"/[apply(pred,[y]) for y in seq] idList? x == x is ["LIST",:.] and "and"/[defQuoteId arg for arg in x.args] diff --git a/src/boot/parser.boot b/src/boot/parser.boot index fe167c4c..e390894b 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -111,7 +111,7 @@ bpNextToken ps == bpFirstToken ps bpRequire(ps,f) == - apply(f,ps,nil) or bpTrap ps + apply(f,[ps]) or bpTrap ps bpState ps == [parserTokens ps,parserTrees ps,parserNesting ps,parserScope ps] @@ -154,7 +154,7 @@ bpIndentParenthesized(ps,f) == bpEqPeek(ps,"OPAREN") => parserNesting(ps) := parserNesting ps + 1 bpNext ps - apply(f,ps,nil) and bpFirstTok ps and + apply(f,[ps]) and bpFirstTok ps and (bpEqPeek(ps,"CPAREN") or bpParenTrap(ps,a)) => parserNesting(ps) := parserNesting ps - 1 bpNextToken ps @@ -177,7 +177,7 @@ bpIndentParenthesized(ps,f) == bpParenthesized(ps,f) == a := parserCurrentToken ps bpEqKey(ps,"OPAREN") => - apply(f,ps,nil) and (bpEqKey(ps,"CPAREN") or bpParenTrap(ps,a)) => true + apply(f,[ps]) and (bpEqKey(ps,"CPAREN") or bpParenTrap(ps,a)) => true bpEqKey(ps,"CPAREN") => bpPush(ps,bfTuple []) true @@ -187,7 +187,7 @@ bpParenthesized(ps,f) == bpBracket(ps,f) == a := parserCurrentToken ps bpEqKey(ps,"OBRACK") => - apply(f,ps,nil) and (bpEqKey(ps,"CBRACK") or bpBrackTrap(ps,a)) => + apply(f,[ps]) and (bpEqKey(ps,"CBRACK") or bpBrackTrap(ps,a)) => bpPush(ps,bfBracket bpPop1 ps) bpEqKey(ps,"CBRACK") => bpPush(ps,[]) bpBrackTrap(ps,a) @@ -196,13 +196,13 @@ bpBracket(ps,f) == bpPileBracketed(ps,f) == bpEqKey(ps,"SETTAB") => bpEqKey(ps,"BACKTAB") => true - apply(f,ps,nil) and (bpEqKey(ps,"BACKTAB") or bpPileTrap ps) => + apply(f,[ps]) and (bpEqKey(ps,"BACKTAB") or bpPileTrap ps) => bpPush(ps,bfPile bpPop1 ps) false false bpListof(ps,f,str1,g)== - apply(f,ps,nil) => + apply(f,[ps]) => bpEqKey(ps,str1) and bpRequire(ps,f) => a := parserTrees ps parserTrees(ps) := nil @@ -215,18 +215,18 @@ bpListof(ps,f,str1,g)== -- to do ,<backset> bpListofFun(ps,f,h,g)== - apply(f,ps,nil) => - apply(h,ps,nil) and bpRequire(ps,f) => + apply(f,[ps]) => + apply(h,[ps]) and bpRequire(ps,f) => a := parserTrees ps parserTrees(ps) := nil - while apply(h,ps,nil) and bpRequire(ps,f) repeat nil + while apply(h,[ps]) and bpRequire(ps,f) repeat nil parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,FUNCALL(g, [bpPop3 ps,bpPop2 ps,:bpPop1 ps])) true false bpList(ps,f,str1)== - apply(f,ps,nil) => + apply(f,[ps]) => bpEqKey(ps,str1) and bpRequire(ps,f) => a := parserTrees ps parserTrees(ps) := nil @@ -237,10 +237,10 @@ bpList(ps,f,str1)== bpPush(ps,nil) bpOneOrMore(ps,f) == - apply(f,ps,nil)=> + apply(f,[ps])=> a := parserTrees ps parserTrees(ps) := nil - while apply(f,ps,nil) repeat nil + while apply(f,[ps]) repeat nil parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,[bpPop2 ps,:bpPop1 ps]) false @@ -248,7 +248,7 @@ bpOneOrMore(ps,f) == -- s must transform the head of the stack bpAnyNo(ps,s) == - while apply(s,ps,nil) repeat nil + while apply(s,[ps]) repeat nil true @@ -341,7 +341,7 @@ bpListAndRecover(ps,f)== c := parserTokens ps while not done repeat found := - try apply(f,ps,nil) + try apply(f,[ps]) catch(e: BootParserException) => e if found is "TRAPPED" then @@ -721,7 +721,7 @@ bpInfGeneric(ps,s) == bpRightAssoc(ps,o,p)== a := bpState ps - apply(p,ps,nil) => + apply(p,[ps]) => while bpInfGeneric(ps,o) and (bpRightAssoc(ps,o,p) or bpTrap ps) repeat bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps)) true @@ -729,7 +729,7 @@ bpRightAssoc(ps,o,p)== false bpLeftAssoc(ps,operations,parser)== - apply(parser,ps,nil) => + apply(parser,[ps]) => while bpInfGeneric(ps,operations) and bpRequire(ps,parser) repeat bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps)) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 820f308e..5c3e7db8 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -851,7 +851,8 @@ (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|)))) (COND - ((NULL |argl|) (SETQ |opassoc| (LIST (CONS |op| |body|))) + ((NULL |argl|) + (SETQ |opassoc| (LIST (CONS |op| (|translateForm| |body|)))) (LIST |opassoc| NIL NIL)) (T (SETQ |op1| @@ -859,7 +860,8 @@ (CONCAT (SYMBOL-NAME (|enclosingFunction| |tu|)) "," (SYMBOL-NAME |op|)))) (SETQ |opassoc| (LIST (CONS |op| |op1|))) - (SETQ |defstack| (LIST (LIST |op1| |args| |body|))) + (SETQ |defstack| + (LIST (LIST |op1| |args| (|translateForm| |body|)))) (LIST |opassoc| |defstack| NIL)))))) (|%Pile| (LET ((|defs| (CADR |x|))) diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 37907145..4d4646a5 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -94,11 +94,11 @@ atomic? x == ++ Return the last image of `f' if all images of elements in `l' ++ are non-nil. Otherwise return nil. every?(f,l) == - and/[apply(f,x,nil) for x in l] + and/[apply(f,[x]) for x in l] ++ Return the first non-nil image of `f' of elements in `l'. any?(f,l) == - or/[apply(f,x,nil) for x in l] + or/[apply(f,[x]) for x in l] ++ Return the `n' node prefixes of the list `l'. If `n' is negative, ++ take from the end of the list. @@ -108,7 +108,7 @@ take(n,l) == ++ Return the sublist of `l' whose elements have non-nil image by `f'. takeWhile(f,l) == - [x for x in l while apply(f,x,nil)] + [x for x in l while apply(f,[x])] ++ Return the `n+1'th node and its successors of the list `l'. ++ If `n' is negative, drop from the end. diff --git a/src/interp/bc-matrix.boot b/src/interp/bc-matrix.boot index 13997d7f..1af6f1cc 100644 --- a/src/interp/bc-matrix.boot +++ b/src/interp/bc-matrix.boot @@ -93,7 +93,7 @@ bcInputMatrixByFormula(htPage,junk) == htShowPage() bcInputMatrixByFormulaGen htPage == - fun := htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage) + fun := htpProperty(htPage,'exitFunction) => apply(fun, [htPage]) formula := htpLabelInputString(htPage,'formula) rowVar := htpLabelInputString(htPage,'rowVar) colVar := htpLabelInputString(htPage,'colVar) @@ -134,7 +134,7 @@ bcInputExplicitMatrix(htPage,junk) == bcGenExplicitMatrix htPage == htpSetProperty(htPage,'matrix,htpInputAreaAlist htPage) - fun := htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage) + fun := htpProperty(htPage,'exitFunction) => apply(fun, [htPage]) bcGen bcMatrixGen htPage bcMatrixGen htPage == diff --git a/src/interp/bc-solve.boot b/src/interp/bc-solve.boot index ce1fce75..839fc8ca 100644 --- a/src/interp/bc-solve.boot +++ b/src/interp/bc-solve.boot @@ -207,7 +207,7 @@ bcMakeLinearEquations(i,number)== bcInputEquationsEnd htPage == - fun := htpProperty(htPage, 'exitFunction) => FUNCALL(fun,htPage) + fun := htpProperty(htPage, 'exitFunction) => apply(fun,[htPage]) systemError nil bcSolveEquationsNumerically(htPage,p) == diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index c4e53323..db83fbaf 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -473,7 +473,7 @@ kcaPage1(htPage,kind,article,whichever,fn, isCatDescendants?) == htpSetProperty(htPage,'heading,heading) conform := htpProperty(htPage,'conform) conname := opOf conform - ancestors := FUNCALL(fn, conform, domname) + ancestors := apply(fn, [conform, domname]) if whichever ~= '"ancestor" then ancestors := augmentHasArgs(ancestors,conform) ancestors := listSort(function GLESSEQP,ancestors) @@ -760,7 +760,7 @@ koaPageFilterByName(htPage,functionToCall) == opAlist := [x for x in htpProperty(htPage,'opAlist) | superMatch?(filter,DOWNCASE STRINGIMAGE first x)] htpSetProperty(htPage,'opAlist,opAlist) - FUNCALL(functionToCall,htPage,nil) + apply(functionToCall,[htPage,nil]) --======================================================================= -- Get Constructor Documentation diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index db446fb5..94f1f937 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -162,7 +162,7 @@ dbShowOp1(htPage,opAlist,which,key) == -- the only place where specialMessage property is set seems to be commented. out if u := htpProperty(page,'specialMessage) then apply(first u,rest u) htSayStandard('"\beginscroll ") - FUNCALL(fn,page,opAlist,which,data) --apply branch function + apply(fn,[page,opAlist,which,data]) --apply branch function dbOpsExposureMessage() htSayStandard("\endscroll ") dbPresentOps(page,which,branch) @@ -356,7 +356,7 @@ dbGatherData(htPage,opAlist,which,key) == --create data, a list of the form ((entry,exposeFlag,:entries)...) for [op,:alist] in opAlist repeat for item in alist repeat - entry := FUNCALL(dataFunction,op,item)--get key item + entry := apply(dataFunction,[op,item])--get key item exposeFlag := --is the current op-sig exposed? null (r := rest rest item) => true --not given, assume yes r . 1 --is given, use value @@ -465,7 +465,7 @@ dbReduceByForm(opAlist,form) == dbReduceBySelection(opAlist,key,fn) == acc := nil for [op,:alist] in opAlist repeat - items := [x for x in alist | FUNCALL(fn,x) = key] => + items := [x for x in alist | apply(fn,[x]) = key] => acc := [[op,:items],:acc] reverse! acc diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index dd290317..98b86cad 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -484,7 +484,7 @@ htDoneButton(func, htPage, :optionalArgs) == htMakeErrorPage htPage not functionSymbol? func => systemError ['"unknown function", func] - FUNCALL(symbolFunction func, htPage) + apply(symbolFunction func, [htPage]) htBcLinks(links,:options) == skipStateInfo? := IFCAR options @@ -1002,7 +1002,7 @@ dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) == if cons? thing then if constructorIfTrue then htSay('" {\em ",dbShowKind thing,'"}") htSay '" " - FUNCALL(fn,thing) + apply(fn,[thing]) htSay('":\newline ") dbShowOpSigList(which,items,(1 + bincount) * 8192) bincount := bincount + 1 diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 78b17437..0b346ed6 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -733,7 +733,7 @@ constructorSearchGrep(filter,key,kind) == grepSearchJump(htPage,yes) == [filter,key,kind,fn] := htpProperty(htPage,'items) - FUNCALL(fn,filter,key,kind) + apply(fn,[filter,key,kind]) --======================================================================= -- Branch Functions After Database Search diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index fadc5bf9..e8d82f6c 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -464,7 +464,7 @@ bcNameCountTable(u,fn,gn,:options) == if firstTime then firstTime := false else htSaySaturn '"&" htSay '"{" - htMakePage [[linkFunction,[FUNCALL(fn,x),'"",gn,i]]] + htMakePage [[linkFunction,[apply(fn,[x]),'"",gn,i]]] htSay '"}" htEndTable() diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 8ecf95f6..2006b1c8 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -434,7 +434,7 @@ UnionEqual(x, y, dom) == same := false for b in stripTags branches for p in predlist while not same repeat typeFun := eval ['%lambda,'(_#1),p] - FUNCALL(typeFun,x) and FUNCALL(typeFun,y) => + apply(typeFun,[x]) and apply(typeFun,[y]) => string? b => same := (x = y) if p is ['%ieq,['%head,.],:.] then (x := rest x; y := rest y) same := SPADCALL(x, y, findEqualFun(evalDomain b)) @@ -449,7 +449,7 @@ coerceUn2E(x,source) == byGeorge := byJane := gensym() for b in stripTags branches for p in predlist repeat typeFun := eval ['%lambda,'(_#1),p] - if FUNCALL(typeFun,x) then return + if apply(typeFun,[x]) then return if p is ['%ieq,['%head,.],:.] then x := rest x -- string? b => return x -- to catch "failed" etc. string? b => byGeorge := x -- to catch "failed" etc. @@ -567,7 +567,7 @@ UnionCategory(:"x") == constructorCategory ["Union",:x] constructorCategory (title is [op,:.]) == constructorFunction:= property(op,"makeFunctionList") or systemErrorHere ['"constructorCategory",title] - [funlist,.]:= FUNCALL(constructorFunction,"$",title,$CategoryFrame) + [funlist,.]:= apply(constructorFunction,["$",title,$CategoryFrame]) oplist:= [[[a,b],true,c] for [a,b,c] in funlist] cat:= JoinInner([eval $SetCategory,mkCategory("domain",oplist,nil,nil,nil)], diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index e91871b4..a81d043e 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1007,7 +1007,7 @@ listOfIdentifiersIn x == x is [op,:l] => removeDuplicates ("append"/[listOfIdentifiersIn y for y in l]) nil -mapInto(x,fn) == [FUNCALL(fn,y) for y in x] +mapInto(x,fn) == [apply(fn,[y]) for y in x] numOfOccurencesOf(x,y) == fn(x,y,0) where @@ -1295,7 +1295,7 @@ mutateConditionalFormWithUnaryFunction(form,fun) == for clauses in tails body repeat -- a clause is a list of forms for subForms in tails first clauses repeat - subForms.first := FUNCALL(fun, first subForms) + subForms.first := apply(fun,[first subForms]) form ++ Walk VM a binding-form mutating enclosed expression forms with @@ -1307,9 +1307,9 @@ mutateBindingFormWithUnaryFunction(form,fun) == for defs in tails inits repeat def := first defs def isnt [.,:.] => nil -- no initializer - def.rest.first := FUNCALL(fun, second def) + def.rest.first := apply(fun,[second def]) for stmts in tails body repeat - stmts.first := FUNCALL(fun, first stmts) + stmts.first := apply(fun,[first stmts]) form --% diff --git a/src/interp/clam.boot b/src/interp/clam.boot index c921e953..98b992b7 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -277,7 +277,7 @@ listTruncate(l,n) == lassocShiftWithFunction(x,l,fn) == y:= l while cons? y repeat - FUNCALL(fn,x,first first y) => return (result := first y) + apply(fn,[x,first first y]) => return (result := first y) y:= rest y result => if not sameObject?(y,l) then diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index e070e214..b5516273 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -356,7 +356,7 @@ compExpression(db,x,m,e) == $insideExpressionIfTrue: local:= true -- special forms have dedicated compilers. (op := x.op) and ident? op and (fn := property(op,'SPECIAL)) => - FUNCALL(fn,x,m,e) + apply(fn,[x,m,e]) compForm(db,x,m,e) ++ Subroutine of compAtomWithModemap. @@ -2022,7 +2022,7 @@ modeEqualSubst(m1,m,e) == compBuiltinDomain(form is [functorName,:argl],m,e) == fn := property(functorName,"makeFunctionList") or return nil diagnoseUnknownType(form,e) - [funList,e]:= FUNCALL(fn,form,form,e) + [funList,e]:= apply(fn,[form,form,e]) exports := [cat for x in parentsOfBuiltinInstance form] where cat() == x.rest is true => x.first diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot index 8960fbb0..ee7e1c99 100644 --- a/src/interp/cparse.boot +++ b/src/interp/cparse.boot @@ -152,9 +152,9 @@ npParenthesize (open,close,f)== npEnclosed(open,close,fn,f)== a := $stok npEqKey open => - npEqKey close => npPush FUNCALL(fn,a,pfTuple pfListOf []) + npEqKey close => npPush apply(fn,[a,pfTuple pfListOf []]) apply(f,nil) and (npEqKey close or npMissingMate(close,a)) => - npPush FUNCALL (fn,a,pfEnSequence npPop1()) + npPush apply(fn,[a,pfEnSequence npPop1()]) false false @@ -205,7 +205,7 @@ npListofFun(f,h,g)== $stack := nil while apply(h,nil) and (apply(f,nil) or npTrap()) repeat 0 $stack := [reverse! $stack,:a] - npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) + npPush apply(g, [[npPop3(),npPop2(),:npPop1()]]) true false @@ -220,13 +220,13 @@ npList(f,str1,g)== -- always produces a list, g is applied to it while npEqKey str1 and (npEqKey "BACKSET" or true) and (apply(f,nil) or npTrap()) repeat 0 $stack := [reverse! $stack,:a] - npPush FUNCALL(g,[npPop3(),npPop2(),:npPop1()]) - npPush FUNCALL(g, [npPop1()]) - npPush FUNCALL(g, []) + npPush apply(g,[[npPop3(),npPop2(),:npPop1()]]) + npPush apply(g,[[npPop1()]]) + npPush apply(g,[nil]) npPPff f == - FUNCALL f and npPush [npPop1()] + apply(f,[]) and npPush [npPop1()] npPPf f == npSemiListing function (() +-> npPPff f) @@ -239,10 +239,10 @@ npPP(f) == npParened function (() +-> npPPf f) or npPileBracketed function (() +-> npPPg f) and npPush pfEnSequence npPop1() - or FUNCALL f + or apply(f,[]) npPCff f == - FUNCALL f and npPush [npPop1()] + apply(f,[]) and npPush [npPop1()] npPCg f == npListAndRecover function (() +-> npPCff f) @@ -251,7 +251,7 @@ npPCg f == npPC(f) == npPileBracketed function (() +-> npPCg f) and npPush pfEnSequence npPop1() - or FUNCALL f + or apply(f,[]) ++ Parser combinator: Apply the parser `s' any number of time it @@ -265,7 +265,7 @@ npAnyNo s == ++ and build the resulting parse tree with `f'. npAndOr(keyword,p,f)== npEqKey keyword and (apply(p,nil) or npTrap()) and - npPush FUNCALL(f, npPop1()) + npPush apply(f,[npPop1()]) ++ Parser combinator: parse a right-associative syntax with operand ++ syntax `p', and operator `o'. @@ -495,14 +495,14 @@ npApplication2() == npTypedForm1(sy,fn) == npEqKey sy and (npType() or npTrap()) and - npPush FUNCALL(fn,npPop2(),npPop1()) + npPush apply(fn,[npPop2(),npPop1()]) npQuiver() == npRightAssoc('(ARROW LARROW),function npApplication) npTypedForm(sy,fn) == npEqKey sy and (npQuiver() or npTrap()) and - npPush FUNCALL(fn,npPop2(),npPop1()) + npPush apply(fn,[npPop2(),npPop1()]) npRestrict() == npTypedForm("AT",function pfRestrict) @@ -907,7 +907,7 @@ npListing p == npList(p,"COMMA",function pfListOf) npQualified(f)== - FUNCALL f => + apply(f,[]) => while npEqKey "WHERE" and (npDefinition() or npTrap()) repeat npPush pfWhere(npPop1(),npPop1()) true @@ -917,7 +917,7 @@ npLetQualified f== npEqKey "%LET" and (npDefinition() or npTrap()) and npCompMissing "IN" and - (FUNCALL f or npTrap()) and + (apply(f,[]) or npTrap()) and npPush pfWhere(npPop2(),npPop1()) npQualifiedDefinition()== diff --git a/src/interp/cstream.boot b/src/interp/cstream.boot index 76a96ca2..f9e5dada 100644 --- a/src/interp/cstream.boot +++ b/src/interp/cstream.boot @@ -74,7 +74,7 @@ incZip(g,f1,f2)== incZip1(g,f1,f2) == StreamNull f1 => StreamNil StreamNull f2 => StreamNil - [FUNCALL(g,first f1,first f2),:incZip(g,rest f1,rest f2)] + [apply(g,[first f1,first f2]),:incZip(g,rest f1,rest f2)] incAppend(x,y) == Delay(function incAppend1,[x,y]) diff --git a/src/interp/define.boot b/src/interp/define.boot index 187c3768..c73b5433 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1388,7 +1388,7 @@ addConstructorModemaps(name,form is [functorName,:.],e) == $InteractiveMode: local:= nil e:= putDomainsInScope(name,e) --frame fn := property(functorName,"makeFunctionList") - [funList,e]:= FUNCALL(fn,name,form,e) + [funList,e]:= apply(fn,[name,form,e]) for [op,sig,opcode] in funList repeat if opcode is [sel,dc,n] and sel='ELT then nsig := substitute("$$$",name,sig) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 47859de8..2548cb53 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -447,7 +447,7 @@ simplifyVMForm x == x for args in tails x.args repeat args.first := simplifyVMForm first args - opt := subrname x.op has OPTIMIZE => resetTo(x,FUNCALL(opt,x)) + opt := subrname x.op has OPTIMIZE => resetTo(x,apply(opt,[x])) x for xs in tails x repeat xs.first := simplifyVMForm first xs @@ -537,7 +537,7 @@ optCall (x is ['%call,:u]) == resetTo(x,doInlineCall(args,vars,body)) [fn,:a] := u fn isnt [.,:.] => - opt := fn has OPTIMIZE => resetTo(x,FUNCALL(opt,u)) + opt := fn has OPTIMIZE => resetTo(x,apply(opt,[u])) resetTo(x,u) fn is ['%apply,name] => do diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 371bcdfe..25ec813d 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -404,7 +404,7 @@ ScanOrPairVec(f, ob) == tableValue($seen, ob) := true for i in 0..#ob-1 repeat ScanOrInner(f, ob.i) nil - FUNCALL(f, ob) => + apply(f,[ob]) => THROW('ScanOrPairVecAnswer, true) nil @@ -803,18 +803,18 @@ mergeInPlace(f,g,p,q) == -- merge the two sorted lists p and q if null p then return p if null q then return q - if FUNCALL(f,FUNCALL(g, first p),FUNCALL(g, first q)) + if apply(f,[apply(g,[first p]),apply(g,[first q])]) then (r := t := p; p := rest p) else (r := t := q; q := rest q) while not null p and not null q repeat - if FUNCALL(f,FUNCALL(g,first p),FUNCALL(g,first q)) + if apply(f,[apply(g,[first p]),apply(g,[first q])]) then (t.rest := p; t := p; p := rest p) else (t.rest := q; t := q; q := rest q) if null p then t.rest := q else t.rest := p r mergeSort(f,g,p,n) == - if n=2 and FUNCALL(f,FUNCALL(g,second p),FUNCALL(g,first p)) then + if n=2 and apply(f,[apply(g,[second p]),apply(g,[first p])]) then t := p p := rest p p.rest := t diff --git a/src/interp/ht-root.boot b/src/interp/ht-root.boot index 00b98472..1b9dbf35 100644 --- a/src/interp/ht-root.boot +++ b/src/interp/ht-root.boot @@ -113,7 +113,7 @@ htSystemVariables() == main where htSetSystemVariableKind(htPage,[variable,name,fun]) == value := htpLabelInputString(htPage,name) - if string? value and fun then value := FUNCALL(fun,value) + if string? value and fun then value := apply(fun,[value]) --SCM::what to do??? if not integer? value then userError ??? symbolValue(variable) := value htSystemVariables () diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 197675ce..3b31c716 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -130,7 +130,7 @@ htpLabelFilteredInputString(htPage, label) == props := LASSOC(label, htpInputAreaAlist htPage) props => #props > 5 and props.6 => - FUNCALL(symbolFunction props.6, props.0) + apply(symbolFunction props.6,[props.0]) replacePercentByDollar props.0 nil @@ -494,7 +494,7 @@ typeCheckInputAreas htPage == checkCondition(s1, string, condList) == condList is [['Satisfies, pvar, pred]] => - val := FUNCALL(pred, string) + val := apply(pred,[string]) string? val => val ['(String), :wrap s1] condList isnt [['isDomain, pvar, pattern]] => diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot index b7a2555b..49c62337 100644 --- a/src/interp/htsetvar.boot +++ b/src/interp/htsetvar.boot @@ -84,7 +84,7 @@ htShowCount s == --# discounting {\em .. } htShowSetTreeValue(setData) == st := setData.setType - st = 'FUNCTION => object2String FUNCALL(setData.setVar,"%display%") + st = 'FUNCTION => object2String apply(setData.setVar,["%display%"]) st = 'INTEGER => object2String eval setData.setVar st = 'STRING => object2String eval setData.setVar st = 'LITERALS => @@ -176,7 +176,7 @@ htSetInteger(htPage) == htKill(htPage,val) htShowFunctionPage(htPage,setData) == - fn := setData.setDef => FUNCALL(fn,htPage) + fn := setData.setDef => apply(fn,[htPage]) htpSetProperty(htPage,'setData,setData) htpSetProperty(htPage,'parts, setData.setLeaf) htShowFunctionPageContinued(htPage) @@ -267,7 +267,7 @@ htDoNothing(htPage,command) == nil htCheck(checker,value) == cons? checker => htCheckList(checker,parseWord value) - FUNCALL(checker,value) + apply(checker,[value]) parseWord x == string? x => diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 4446d731..245f1d3c 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -240,7 +240,7 @@ bottomUp t == -- call a special handler if we are not being package called dol := getAtree(op,'dollar) and (opName ~= 'construct) - (null dol) and (fn:= property(opName,"up")) and (u:= FUNCALL(fn, t)) => u + (null dol) and (fn:= property(opName,"up")) and (u:= apply(fn,[t])) => u nargs := #argl if opName then for x in argl for i in 1.. repeat putCallInfo(x,opName,i,nargs) diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 108b5eb8..e6a47b7a 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -271,7 +271,7 @@ coerceRetract(object,t2) == makeSymbol strconc('"retract",STRINGIMAGE D) functionp fun => property(D,'retract) := fun - c := CATCH('coerceFailure,FUNCALL(fun,object,t2)) + c := CATCH('coerceFailure,apply(fun,[object,t2])) (c = $coerceFailure) => nil c nil @@ -608,7 +608,7 @@ canCoerceLocal(t1,t2) == tag='partial => nil tag='total => true (functionp(fun) and - (v:=CATCH('coerceFailure,FUNCALL(fun,'_$fromCoerceable_$,t1,t2))) + (v:=CATCH('coerceFailure,apply(fun,['_$fromCoerceable_$,t1,t2]))) and v ~= $coerceFailure) or canCoerceByFunction(t1,t2) canCoerceByFunction(t1,t2) @@ -921,7 +921,7 @@ coerceSubDomain(val, tSuper, tSub) == val = '_$fromCoerceable_$ => nil pred := isSubDomain(tSub,tSuper) => predFun := getSubDomainPredicate(tSuper,tSub,pred) - FUNCALL(predFun,val) => objNew(val,tSub) + apply(predFun,[val]) => objNew(val,tSub) nil getSubDomainPredicate(tSuper, tSub, pred) == @@ -1171,7 +1171,7 @@ coerceIntCommute(obj,target) == functionp fun => property(D,'coerceCommute) := fun u := objValUnwrap obj - c := CATCH('coerceFailure,FUNCALL(fun,u,source,S,target,T)) + c := CATCH('coerceFailure,apply(fun,[u,source,S,target,T])) (c = $coerceFailure) => nil u = "$fromCoerceable$" => c objNewWrap(c,target) @@ -1285,7 +1285,7 @@ coerceByTable(fn,x,t1,t2,isTotalCoerce) == t2 = $OutputForm and not (newType? t1) => nil isWrapped x => x:= unwrap x - c:= CATCH('coerceFailure,FUNCALL(fn,x,t1,t2)) + c:= CATCH('coerceFailure,apply(fn,[x,t1,t2])) c=$coerceFailure => nil objNewWrap(c,t2) isTotalCoerce => objNew([fn,x,MKQ t1,MKQ t2],t2) @@ -1293,7 +1293,7 @@ coerceByTable(fn,x,t1,t2,isTotalCoerce) == catchCoerceFailure(fn,x,t1,t2) == -- compiles a catchpoint for compiling boot coercions - c:= CATCH('coerceFailure,FUNCALL(fn,x,t1,t2)) + c:= CATCH('coerceFailure,apply(fn,[x,t1,t2])) c = $coerceFailure => throwKeyedMsgCannotCoerceWithValue(wrap unwrap x,t1,t2) c diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 1deb25cb..066fbc46 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -876,7 +876,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == -- cat := constructorCategory dc makeFunc := property(dcName,"makeFunctionList") or systemErrorHere ["findFunctionInCategory",dcName] - [funlist,.] := FUNCALL(makeFunc,"$",dc,$CategoryFrame) + [funlist,.] := apply(makeFunc,["$",dc,$CategoryFrame]) -- get list of implementations and remove sharps maxargs := -1 impls := nil diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index ccbcb385..9b696f0e 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -504,7 +504,7 @@ APP(u,x,y,d) == GETL(op,'isSuffix) => appChar(s,x+WIDTH a,y,APP(a,x,y,d)) APP(a,x+#s,y,appChar(s,x,y,d)) u is [[id,:.],:.] => - fn := GETL(id,'APP) => FUNCALL(fn,u,x,y,d) + fn := GETL(id,'APP) => apply(fn,[u,x,y,d]) not integer? id and (d':= appInfix(u,x,y,d))=> d' appelse(u,x,y,d) appelse(u,x,y,d) @@ -1174,7 +1174,7 @@ putWidth u == newFirst:= (oldFirst:= first u) isnt [.,:.] => fn:= GETL(oldFirst,"WIDTH") => - [oldFirst,:FUNCALL(fn,[oldFirst,:l])] + [oldFirst,:apply(fn,[[oldFirst,:l]])] if l then ll := rest l else ll := nil [oldFirst,:opWidth(oldFirst,ll)+argsWidth] [putWidth oldFirst,:2+WIDTH oldFirst+argsWidth] diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 1c8036bd..0280ade1 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -105,7 +105,7 @@ systemCommand [[op,:argl],:options] == helpSpad2Cmd [fun] fun := selectOption(fun,commandsForUserLevel $systemCommands, 'commandUserLevelError) - FUNCALL(fun, argl) + apply(fun,[argl]) commandsForUserLevel l == --[a for [a,:b] in l | satisfiesUserLevel(a)] c := nil @@ -154,11 +154,11 @@ selectOptionLC(x,l,errorFunction) == selectOption(x,l,errorFunction) == member(x,l) => x --exact spellings are always OK not ident? x => - errorFunction => FUNCALL(errorFunction,x,u) + errorFunction => apply(errorFunction,[x,u]) nil u := [y for y in l | stringPrefix?(PNAME x,PNAME y)] u is [y] => y - errorFunction => FUNCALL(errorFunction,x,u) + errorFunction => apply(errorFunction,[x,u]) nil terminateSystemCommand() == @@ -2155,8 +2155,8 @@ reportOpsFromUnitDirectly unitForm == then constructorFunction:= GETL(top,"makeFunctionList") or systemErrorHere ["reportOpsFromUnitDirectly",top] - [funlist,.]:= FUNCALL(constructorFunction,"$",unitForm, - $CategoryFrame) + [funlist,.]:= apply(constructorFunction,["$",unitForm, + $CategoryFrame]) sigList := removeDuplicates MSORT [[[a,b],true,slot c] for [a,b,c] in funlist] where slot c == (c isnt [.,:.] => [c,0,1]; c) @@ -2631,7 +2631,7 @@ filterListOfStringsWithFn(patterns,names,fn) == (null patterns) or (null names) => names names' := nil for name in reverse names repeat - satisfiesRegularExpressions(FUNCALL(fn,name),patterns) => + satisfiesRegularExpressions(apply(fn,[name]),patterns) => names' := [name,:names'] names' @@ -2708,7 +2708,7 @@ zsystemdevelopment1(l,im) == upf := [KAR optargs or _/VERSION, KADR optargs or _/WSNAME, KADDR optargs or '_*] fun := (opt is "patch" => '_/UPDATE_-LIB_-1; '_/UPDATE_-1) - CATCH('FILENAM, FUNCALL(fun, upf)) + CATCH('FILENAM, apply(fun,[upf])) sayMessage '" Update/patch is completed." null optargs => sayBrightly ['" An argument is required for",:bright opt] @@ -2790,7 +2790,7 @@ handleNoParseCommands(unab, string) == unab is "synonym" => npsynonym(unab, (null spaceIndex => '""; subSequence(string, spaceIndex+1))) null spaceIndex => - FUNCALL unab + apply(unab,[]) unab in '( quit _ fin _ pquit _ @@ -2799,7 +2799,7 @@ handleNoParseCommands(unab, string) == sayKeyedMsg("S2IV0005", nil) nil funName := makeSymbol strconc('"np",STRING unab) - FUNCALL(funName, subSequence(string, spaceIndex+1)) + apply(funName,[subSequence(string, spaceIndex+1)]) npboot str == diff --git a/src/interp/int-top.boot b/src/interp/int-top.boot index 51a426da..fffdc72d 100644 --- a/src/interp/int-top.boot +++ b/src/interp/int-top.boot @@ -186,7 +186,7 @@ intloopProcess(n,interactive,s)== [lines,ptree]:=first s pfAbSynOp?(ptree,"command")=> if interactive then setCurrentLine tokPart ptree - FUNCALL($systemCommandFunction, tokPart ptree) + apply($systemCommandFunction,[tokPart ptree]) intloopProcess(n ,interactive ,rest s) intloopProcess(intloopSpadProcess(n,lines,ptree,interactive) ,interactive ,rest s) @@ -286,7 +286,7 @@ nonBlank str == ncloopCommand (line,n) == a:=ncloopPrefix?('")include",line)=> ncloopInclude1( a,n) - FUNCALL($systemCommandFunction,line) + apply($systemCommandFunction,[line]) n ncloopEscaped x== @@ -431,7 +431,7 @@ PullAndExecuteSpadSystemCommand stream == rest stream ExecuteSpadSystemCommand string == - FUNCALL($systemCommandFunction, string) + apply($systemCommandFunction,[string]) clearMacroTable() == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 18463c04..d8764a26 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -417,7 +417,7 @@ getLookupFun infovec == 'lookupIncomplete makeSpadConstant [fn,dollar,slot] == - val := FUNCALL(fn,dollar) + val := apply(fn,[dollar]) u := domainRef(dollar,slot) u.first := function IDENTITY u.rest := val diff --git a/src/interp/parse.boot b/src/interp/parse.boot index b4c77d10..6adb6fd1 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -76,7 +76,7 @@ parseTran x == r:= parseConstruct ["construct",:argl] op is ["elt",:.] => [parseTran op,:rest r] r - symbol? u and (fn:= property(u,'parseTran)) => FUNCALL(fn,x) + symbol? u and (fn:= property(u,'parseTran)) => apply(fn,[x]) [parseTran op,:parseTranList argl] parseType t == diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index e3d88016..db8cb474 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -80,7 +80,7 @@ postTran x == x isnt [.,:.] => postAtom x op := first x op is 'QUOTE => x - symbol? op and (f:= property(op,'postTran)) => FUNCALL(f,x) + symbol? op and (f:= property(op,'postTran)) => apply(f,[x]) op is ["elt",a,b] => u:= postTran [b,:rest x] [postTran op,:rest u] diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot index 4ec6f7e5..e68407bd 100644 --- a/src/interp/ptrees.boot +++ b/src/interp/ptrees.boot @@ -788,7 +788,7 @@ pfCopyWithPos( pform , pos ) == pfMapParts(f, pform) == pfLeaf? pform => pform parts0 := pfParts pform - parts1 := [FUNCALL(f, p) for p in parts0] + parts1 := [apply(f,[p]) for p in parts0] -- Return the original if no changes. same := true for p0 in parts0 for p1 in parts1 while same repeat same := sameObject?(p0,p1) diff --git a/src/interp/scan.boot b/src/interp/scan.boot index 835712bd..c92d4d50 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -525,7 +525,7 @@ spleI(dig) == spleI1(dig,zro) == n := $n l := $sz - while $n<l and FUNCALL(dig,($ln.$n)) repeat + while $n<l and apply(dig,[$ln.$n]) repeat $n := $n+1 $n = l or stringChar($ln,$n) ~= char "__" => n = $n and zro => '"0" diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index de8883b6..3c412d83 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -123,7 +123,7 @@ initializeSetVariables (setTree) == st = 'FUNCTION => -- here setVar is really the name of a function to call if functionp(setData.setVar) - then FUNCALL( setData.setVar,"%initialize%") + then apply(setData.setVar,["%initialize%"]) else sayMSG '" Function not implemented." st = 'INTEGER => symbolValue(setData.setVar) := setData.setDef @@ -205,7 +205,7 @@ set1(l,setTree) == -- (arg2 := selectOption(l.1,['default],nil)) => "%initialize%" KDR l if functionp(setData.setVar) - then FUNCALL( setData.setVar,setfunarg) + then apply(setData.setVar,[setfunarg]) else sayMSG '" Function not implemented." -- if so set, then show option information if $displaySetValue then displaySetOptionInformation(arg,setData) @@ -279,7 +279,7 @@ displaySetOptionInformation(arg,setData) == st = 'FUNCTION => finishLine $OutputStream if functionp(setData.setVar) - then FUNCALL(setData.setVar,"%describe%") + then apply(setData.setVar,["%describe%"]) else sayMSG '" Function not implemented." st = 'INTEGER => @@ -330,7 +330,7 @@ displaySetVariableSettings(setTree,label) == st := setData.setType st = 'FUNCTION => opt := - functionp(setData.setVar) => FUNCALL( setData.setVar,"%display%") + functionp(setData.setVar) => apply(setData.setVar,["%display%"]) '"unimplemented" if cons? opt then opt := [:[o,'" "] for o in opt] sayBrightly concat(setOption,'"%b",opt,'"%d") |