diff options
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 14 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 20 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 6 | ||||
| -rw-r--r-- | src/interp/define.boot | 6 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 48 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 4 |
7 files changed, 61 insertions, 44 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index f1db0f63..0bb8ffc1 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ -2010-05-07 Gabriel Dos Reis <gdr@cse.tamu.edu> +2010-05-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/c-util.boot: Replace uses of rplac with explicit assignments. + * interp/compiler.boot: Likewise. + * interp/define.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/nrunfast.boot: Likewise. * lisp/core.lisp.in ($FilesToRetain): New. Export. * lisp/Makefile.in: Tidy. * boot/translator.boot (retainFile?): New. diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 9a23effe..bb7c66d3 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -1274,6 +1274,16 @@ (|defaultBootToLispFile| |file|))) (BOOTTOCL |file| (ENOUGH-NAMESTRING |outFile|)))))) +(DEFUN |retainFile?| (|ext|) + (COND + ((OR (MEMBER (|Option| '|all|) |$FilesToRetain|) + (MEMBER (|Option| '|yes|) |$FilesToRetain|)) + T) + ((MEMBER (|Option| '|no|) |$FilesToRetain|) NIL) + (T (MEMBER (|Option| |ext|) |$FilesToRetain|)))) + +(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) (TRACE |retainFile?|)) + (DEFUN |compileBootHandler| (|progname| |options| |file|) (PROG (|objFile| |intFile|) (RETURN @@ -1287,7 +1297,9 @@ (SETQ |objFile| (|compileLispHandler| |progname| |options| |intFile|)) - (DELETE-FILE |intFile|) |objFile|) + (COND + ((NOT (|retainFile?| '|lisp|)) (DELETE-FILE |intFile|))) + |objFile|) (T NIL)))))) (EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index f65b5dd6..566a6dad 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1035,7 +1035,7 @@ mutateCONDFormWithUnaryFunction(form,fun) == for clauses in tails body repeat -- a clause is a list of forms for subForms in tails first clauses repeat - rplac(first subForms, FUNCALL(fun, first subForms)) + subForms.first := FUNCALL(fun, first subForms) form ++ Walk VM LET-form mutating enclosed expression forms with @@ -1049,7 +1049,7 @@ mutateLETFormWithUnaryFunction(form,fun) == atom def => nil -- no initializer rplac(second def, FUNCALL(fun, second def)) for stmts in tails body repeat - rplac(first stmts, FUNCALL(fun, first stmts)) + stmts.first := FUNCALL(fun, first stmts) form --% @@ -1116,14 +1116,14 @@ replaceSimpleFunctions form == for args in tails rest form repeat arg' := replaceSimpleFunctions(arg := first args) not EQ(arg',arg) => - rplac(first args, arg') + args.first := arg' -- 2. see if we know something about this function. [fun,:args] := form atom fun => null (fun' := getFunctionReplacement fun) => form -- 2.1. the renaming case. atom fun' => - rplac(first form,fun') + form.first := fun' NBUTLAST form -- 2.2. the substitution case. fun' is ["XLAM",parms,body] => @@ -1141,7 +1141,7 @@ replaceSimpleFunctions form == form form fun' := replaceSimpleFunctions fun - not EQ(fun',fun) => rplac(first form,fun') + not EQ(fun',fun) => form.first := fun' form @@ -1199,8 +1199,8 @@ foldSpadcall form == fun := lastNode form fun isnt [["getShellEntry","$",slot]] => form null (op := getCapsuleDirectoryEntry slot) => form - rplac(first fun, "$") - rplac(first form, op) + fun.first := "$" + form.first := op ++ `defs' is a list of function definitions from the current domain. @@ -1460,7 +1460,7 @@ il2OldForm x == %ilDeref(e,.) => ["applyFun",il2OldForm e] %ilCall(e,.) => e is [["%ilLocal",op,:.],:.] => - rplac(first e,op) + e.first := op ilTransformInsns rest e e ["%Call",:ilTransformInsns e] @@ -1469,7 +1469,7 @@ il2OldForm x == ++ Subroutines of il2OldForm to walk sequence of IL instructions. ilTransformInsns form == for insns in tails form repeat - rplac(first insns, il2OldForm first insns) + insns.first := il2OldForm first insns form @@ -1536,7 +1536,7 @@ simplifySEQ form == isAtomicForm form => form form is ["SEQ",[op,a]] and op in '(EXIT RETURN) => simplifySEQ a for stmts in tails form repeat - rplac(first stmts, simplifySEQ first stmts) + stmts.first := simplifySEQ first stmts form ++ Generate Lisp code by lowering middle end defining form `x'. diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index fdc81fe7..78cc6188 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1028,12 +1028,12 @@ replaceExitEtc(x,tag,opFlag,opMode) == --bound in compSeq1 and compDefineCapsuleFunction $finalEnv => intersectionEnvironment($finalEnv,t.env) t.env - rplac(first x,"THROW") + x.first := "THROW" rplac(second x,tag) rplac(third x,(convertOrCroak(t,opMode)).expr) true => rplac(second x,second x-1) x is [key,n,t] and key in '(TAGGEDreturn TAGGEDexit) => - rplac(first t,replaceExitEtc(first t,tag,opFlag,opMode)) + t.first := replaceExitEtc(first t,tag,opFlag,opMode) replaceExitEtc(first x,tag,opFlag,opMode) replaceExitEtc(rest x,tag,opFlag,opMode) @@ -1378,7 +1378,7 @@ checkExternalEntity(id,type,lang,e) == removeModifiers t == for (ts := [x,:.]) in tails t repeat x is [m,t'] and m in $FFITypeModifier => - rplac(first ts,t') + ts.first := t' t ++ Compile external entity signature import. diff --git a/src/interp/define.boot b/src/interp/define.boot index e1fe1ebf..90a1b6d5 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -240,8 +240,8 @@ checkRepresentation(addForm,body,env) == stackAndThrow('"You cannot specify type for %1b",["Rep"]) -- Now, trick the rest of the compiler into believing that -- `Rep' was defined the Old Way, for lookup purpose. - rplac(first stmt,"%LET") - rplac(rest stmt,["Rep",domainRep]) + stmt.first := "%LET" + stmt.rest := ["Rep",domainRep] $useRepresentationHack := false -- Don't confuse `Rep' and `%'. -- Shall we perform the dirty tricks? @@ -964,7 +964,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], -- been changed before we get here. if first form = "^" then sayBrightly ['"Replacing", :bright '"^", '"with",:bright '"**"] - rplac(first form,"**") + form.first := "**" [$op,:argl]:= form $form:= [$op,:argl] argl:= stripOffArgumentConditions argl diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index c7dba6e2..783900ed 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -59,9 +59,9 @@ getDomainTemplate dom == ++ Emit code for an indirect call to domain-wide Spad function. ++ This is usually the case for exported functions. emitIndirectCall(fn,args,x) == - rplac(first x, "SPADCALL") - rplac(first fn,"getShellEntry") - rplac(rest x, [:args,fn]) + x.first := "SPADCALL" + fn.first := "getShellEntry" + x.rest := [:args,fn] x --% OPTIMIZER @@ -90,8 +90,8 @@ optimizeFunctionDef(def) == x fn(x,g) == x is ["THROW", =g,:u] => - rplac(first x,"RETURN") - rplac(rest x,replaceThrowByReturn(u,g)) + x.first := "RETURN" + x.rest := replaceThrowByReturn(u,g) atom x => nil replaceThrowByReturn(first x,g) replaceThrowByReturn(rest x,g) @@ -125,7 +125,7 @@ subrname u == changeThrowToExit(s,g) == atom s or first s in '(QUOTE SEQ REPEAT COLLECT) => nil - s is ["THROW", =g,:u] => (rplac(first s,"EXIT"); rplac(rest s,u)) + s is ["THROW", =g,:u] => (s.first := "EXIT"; s.rest := u) changeThrowToExit(first s,g) changeThrowToExit(rest s,g) @@ -138,8 +138,8 @@ changeThrowToGo(s,g) == atom s or first s='QUOTE => nil s is ["THROW", =g,u] => changeThrowToGo(u,g) - rplac(first s,"PROGN") - rplac(rest s,[["%LET",second g,u],["GO",second g]]) + s.first := "PROGN" + s.rest := [["%LET",second g,u],["GO",second g]] changeThrowToGo(first s,g) changeThrowToGo(rest s,g) @@ -148,15 +148,15 @@ optCatch (x is ["CATCH",g,a]) == atom a => a if a is ["SEQ",:s,["THROW", =g,u]] then changeThrowToExit(s,g) - rplac(rest a,[:s,["EXIT",u]]) + a.rest := [:s,["EXIT",u]] ["CATCH",y,a]:= optimize x if hasNoThrows(a,g) then - rplac(first x,first a) - rplac(rest x,rest a) + x.first := first a + x.rest := rest a else changeThrowToGo(a,g) - rplac(first x,"SEQ") - rplac(rest x,[["EXIT",a],second g,["EXIT",second g]]) + x.first := "SEQ" + x.rest := [["EXIT",a],second g,["EXIT",second g]] x optSPADCALL(form is ['SPADCALL,:argl]) == @@ -208,12 +208,12 @@ optCallEval u == optCons (x is ["CONS",a,b]) == a="NIL" => - b='NIL => (rplac(first x,'QUOTE); rplac(rest x,['NIL,:'NIL]); x) - b is ['QUOTE,:c] => (rplac(first x,'QUOTE); rplac(rest x,['NIL,:c]); x) + b='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 => (rplac(first x,'QUOTE); rplac(rest x,[a',:'NIL]); x) - b is ['QUOTE,:c] => (rplac(first x,'QUOTE); rplac(rest x,[a',:c]); x) + b='NIL => (x.first := 'QUOTE; x.rest := [a',:'NIL]; x) + b is ['QUOTE,:c] => (x.first := 'QUOTE; x.rest := [a',:c]; x) x x @@ -225,8 +225,8 @@ optSpecialCall(x,y,n) == '"invalid constant"]) MKQ yval.n fn := getFunctionReplacement compileTimeBindingOf first yval.n => - rplac(rest x,CDAR x) - rplac(first x,fn) + x.rest := CDAR x + x.first := fn if fn is ["XLAM",:.] then x:=first optimize [x] x is ["EQUAL",:args] => RPLACW(x,DEF_-EQUAL args) --DEF-EQUAL is really an optimiser @@ -319,7 +319,7 @@ optSEQ ["SEQ",:l] == splicePROGN l == isAtomicForm l => l l is [["PROGN",:stmts],:l'] => [:stmts,:l'] - rplac(rest l, splicePROGN rest l) + l.rest := splicePROGN rest l getRidOfTemps l == null l => nil l is [["%LET",g,x,:.],:r] and GENSYMP g and 2>numOfOccurencesOf(g,r) => @@ -507,7 +507,7 @@ optLET u == clause isnt [test,stmt] => continue := false -- Stop inlining at least one test is not simple not isSimpleVMForm test => continue := false - rplac(first clause,SUBLIS(substPairs,test)) + clause.first := SUBLIS(substPairs,test) isSimpleVMForm stmt => rplac(second clause,SUBLIS(substPairs,stmt)) continue := false @@ -521,7 +521,7 @@ optLET u == for defs in tails inits repeat def := first defs atom def => systemErrorHere ["optLET",def] -- cannot happen - rplac(rest def, second def) + def.rest := second def SUBLIS(inits,body) optLET_* form == @@ -530,11 +530,11 @@ optLET_* form == while ok for [[var,.],:inits] in tails second form repeat if CONTAINED(var,inits) then ok := false not ok => form - rplac(first form,"LET") + form.first := "LET" optLET form optBind form == - rplac(first form,"LET*") + form.first := "LET*" optLET_* form optLIST form == diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 0b9ea020..607884cf 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -610,7 +610,7 @@ resolveNiladicConstructors form == atom form => form form is ["QUOTE",:.] => form for args in tails rest form repeat - rplac(first args, resolveNiladicConstructors first args) + args.first := resolveNiladicConstructors first args form --======================================================= @@ -663,7 +663,7 @@ newHasTest(domform,catOrAtt) == sig := type is ["Mapping",:sig'] => for ts in tails sig' repeat - rplac(first ts, resolveNiladicConstructors first ts) + ts.first := resolveNiladicConstructors first ts sig' -- a constant; make it look like op: () -> type [resolveNiladicConstructors type] |