From 9852c96d425eaad7f299ed36558930514a0487d3 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 24 Apr 2011 20:42:47 +0000 Subject: * boot/initial-env.lisp (MEMQ): Remove. * boot/ast.boot (shoeATOMs): Don't use it. (isDynamicVariable): Likewise. (shoeCompTran1): Likewise. * boot/translator.boot (defuse1): Likewise. --- src/boot/ast.boot | 49 +++++++++++++++++++---------------------- src/boot/initial-env.lisp | 3 --- src/boot/strap/ast.clisp | 44 ++++++++++++++++++------------------ src/boot/strap/translator.clisp | 4 ++-- src/boot/translator.boot | 4 ++-- 5 files changed, 50 insertions(+), 54 deletions(-) (limited to 'src/boot') diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 5d1893be..447f9253 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -571,7 +571,8 @@ bfLET2(lhs,rhs) == g := makeSymbol strconc('"LETTMP#", toString $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 l2 := bfLET2(patrev,g) - if cons? l2 and atom first l2 then l2 := [l2,:nil] + if cons? l2 and atom first l2 then + l2 := [l2,:nil] var1 = "DOT" => [['L%T,g,rev],:l2] last l2 is ['L%T, =var1, val1] => [['L%T,g,rev],:reverse rest reverse l2, @@ -598,8 +599,7 @@ bfLET(lhs,rhs) == addCARorCDR(acc,expr) == atom expr => [acc,expr] acc = 'CAR and expr is ["reverse",:.] => - ["CAR",["LAST",:rest expr]] - -- ['last,:rest expr] + ["CAR",["lastNode",:rest expr]] funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR CDAAR CDDAR CDADR CDDDR) p := bfPosition(first expr,funs) @@ -871,22 +871,20 @@ bfInsertLet1(y,body)== otherwise => [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]] shoeCompTran x== - lamtype:=first x - args :=second x - body :=CDDR x - $fluidVars:local:=nil - $locVars:local:=nil - $dollarVars:local:=nil + [lamtype,args,:body] := x + $fluidVars: local := nil + $locVars: local := nil + $dollarVars: local :=nil shoeCompTran1 body - $locVars:=setDifference(setDifference($locVars, - $fluidVars),shoeATOMs args) - body:= - lvars:=append($fluidVars,$locVars) - $fluidVars:=UNION($fluidVars,$dollarVars) + $locVars := setDifference(setDifference($locVars,$fluidVars),shoeATOMs args) + body := + lvars := append($fluidVars,$locVars) + $fluidVars := UNION($fluidVars,$dollarVars) body' := body - if $typings then body' := [["DECLARE",:$typings],:body'] + if $typings then + body' := [["DECLARE",:$typings],:body'] if $fluidVars then - fvars:=["DECLARE",["SPECIAL",:$fluidVars]] + fvars := ["DECLARE",["SPECIAL",:$fluidVars]] body' := [fvars,:body'] lvars or needsPROG body => shoePROG(lvars,body') body' @@ -896,15 +894,14 @@ shoeCompTran x== fvs:=["DECLARE",["SPECIAL",:fl]] [fvs,:body] body - [lamtype,args, :body] + [lamtype,args,:body] needsPROG body == atom body => false [op,:args] := body op in '(RETURN RETURN_-FROM) => true op in '(LET PROG LOOP BLOCK DECLARE LAMBDA) => false - or/[needsPROG t for t in body] => true - false + or/[needsPROG t for t in body] shoePROG(v,b)== b = nil => [["PROG", v]] @@ -927,7 +924,7 @@ shoeATOMs x == ++ dynamic (e.g. Lisp special) variable. isDynamicVariable x == symbol? x and bfBeginsDollar x => - MEMQ(x,$constantIdentifiers) => false + symbolMember?(x,$constantIdentifiers) => false CONSTANTP x => false BOUNDP x or $activeNamespace = nil => true y := FIND_-SYMBOL(symbolName x,$activeNamespace) => not CONSTANTP y @@ -938,7 +935,7 @@ shoeCompTran1 x== atom x=> isDynamicVariable x => $dollarVars:= - MEMQ(x,$dollarVars)=>$dollarVars + symbolMember?(x,$dollarVars)=>$dollarVars [x,:$dollarVars] nil U:=first x @@ -949,25 +946,25 @@ shoeCompTran1 x== symbol? l => not bfBeginsDollar l=> $locVars:= - MEMQ(l,$locVars)=>$locVars + symbolMember?(l,$locVars)=>$locVars [l,:$locVars] $dollarVars:= - MEMQ(l,$dollarVars)=>$dollarVars + symbolMember?(l,$dollarVars)=>$dollarVars [l,:$dollarVars] l is ["FLUID",:.] => $fluidVars:= - MEMQ(second l,$fluidVars)=>$fluidVars + symbolMember?(second l,$fluidVars)=>$fluidVars [second l,:$fluidVars] x.rest.first := second l U = "%Leave" => x.first := "RETURN" U in '(PROG LAMBDA) => newbindings:=nil for y in second x repeat - not MEMQ(y,$locVars)=> + not symbolMember?(y,$locVars)=> $locVars := [y,:$locVars] newbindings := [y,:newbindings] res := shoeCompTran1 CDDR x - $locVars := [y for y in $locVars | not MEMQ(y,newbindings)] + $locVars := [y for y in $locVars | not symbolMember?(y,newbindings)] shoeCompTran1 first x shoeCompTran1 rest x diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp index 3496cdd8..0a9f8b7c 100644 --- a/src/boot/initial-env.lisp +++ b/src/boot/initial-env.lisp @@ -67,9 +67,6 @@ ;; is called interactively. (defparameter |$InteractiveMode| nil) -(defmacro memq (a b) - `(member ,a ,b :test #'eq)) - (defvar *lisp-bin-filetype* "o") (defvar *lisp-source-filetype* "lisp") diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 290b3e31..68548330 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -927,7 +927,7 @@ ((ATOM |expr|) (LIST |acc| |expr|)) ((AND (EQ |acc| 'CAR) (CONSP |expr|) (EQ (CAR |expr|) '|reverse|)) - (LIST 'CAR (CONS 'LAST (CDR |expr|)))) + (LIST 'CAR (CONS '|lastNode| (CDR |expr|)))) (T (SETQ |funs| '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR CDAAR CDDAR CDADR CDDDR)) @@ -1571,8 +1571,8 @@ (RETURN (PROGN (SETQ |lamtype| (CAR |x|)) - (SETQ |args| (CADR |x|)) - (SETQ |body| (CDDR |x|)) + (SETQ |args| (CADR . #0=(|x|))) + (SETQ |body| (CDDR . #0#)) (SETQ |$fluidVars| NIL) (SETQ |$locVars| NIL) (SETQ |$dollarVars| NIL) @@ -1619,17 +1619,15 @@ ((|symbolMember?| |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL) - ((LET ((|bfVar#119| NIL) (|bfVar#118| |body|) (|t| NIL)) - (LOOP - (COND - ((OR (ATOM |bfVar#118|) - (PROGN (SETQ |t| (CAR |bfVar#118|)) NIL)) - (RETURN |bfVar#119|)) - (T (SETQ |bfVar#119| (|needsPROG| |t|)) - (COND (|bfVar#119| (RETURN |bfVar#119|))))) - (SETQ |bfVar#118| (CDR |bfVar#118|)))) - T) - (T NIL))))))) + (T (LET ((|bfVar#119| NIL) (|bfVar#118| |body|) (|t| NIL)) + (LOOP + (COND + ((OR (ATOM |bfVar#118|) + (PROGN (SETQ |t| (CAR |bfVar#118|)) NIL)) + (RETURN |bfVar#119|)) + (T (SETQ |bfVar#119| (|needsPROG| |t|)) + (COND (|bfVar#119| (RETURN |bfVar#119|))))) + (SETQ |bfVar#118| (CDR |bfVar#118|))))))))))) (DEFUN |shoePROG| (|v| |b|) (PROG (|blist| |blast| |LETTMP#1|) @@ -1665,7 +1663,7 @@ (COND ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (COND - ((MEMQ |x| |$constantIdentifiers|) NIL) + ((|symbolMember?| |x| |$constantIdentifiers|) NIL) ((CONSTANTP |x|) NIL) ((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T) ((SETQ |y| @@ -1684,7 +1682,7 @@ ((|isDynamicVariable| |x|) (SETQ |$dollarVars| (COND - ((MEMQ |x| |$dollarVars|) |$dollarVars|) + ((|symbolMember?| |x| |$dollarVars|) |$dollarVars|) (T (CONS |x| |$dollarVars|))))) (T NIL))) (T (SETQ U (CAR |x|)) @@ -1707,16 +1705,19 @@ ((NOT (|bfBeginsDollar| |l|)) (SETQ |$locVars| (COND - ((MEMQ |l| |$locVars|) |$locVars|) + ((|symbolMember?| |l| |$locVars|) + |$locVars|) (T (CONS |l| |$locVars|))))) (T (SETQ |$dollarVars| (COND - ((MEMQ |l| |$dollarVars|) |$dollarVars|) + ((|symbolMember?| |l| |$dollarVars|) + |$dollarVars|) (T (CONS |l| |$dollarVars|))))))) ((AND (CONSP |l|) (EQ (CAR |l|) 'FLUID)) (SETQ |$fluidVars| (COND - ((MEMQ (CADR |l|) |$fluidVars|) |$fluidVars|) + ((|symbolMember?| (CADR |l|) |$fluidVars|) + |$fluidVars|) (T (CONS (CADR |l|) |$fluidVars|)))) (RPLACA (CDR |x|) (CADR |l|))))) ((EQ U '|%Leave|) (RPLACA |x| 'RETURN)) @@ -1728,7 +1729,7 @@ ((OR (ATOM |bfVar#120|) (PROGN (SETQ |y| (CAR |bfVar#120|)) NIL)) (RETURN NIL)) - ((NOT (MEMQ |y| |$locVars|)) + ((NOT (|symbolMember?| |y| |$locVars|)) (IDENTITY (PROGN (SETQ |$locVars| (CONS |y| |$locVars|)) @@ -1746,7 +1747,8 @@ (SETQ |y| (CAR |bfVar#121|)) NIL)) (RETURN |bfVar#122|)) - (T (AND (NOT (MEMQ |y| |newbindings|)) + (T (AND (NOT (|symbolMember?| |y| + |newbindings|)) (COND ((NULL |bfVar#122|) (SETQ |bfVar#122| diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index e330c5bd..6e73c749 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -962,8 +962,8 @@ ((SYMBOLP |y|) (SETQ |$used| (COND - ((MEMQ |y| |e|) |$used|) - ((MEMQ |y| |$used|) |$used|) + ((|symbolMember?| |y| |e|) |$used|) + ((|symbolMember?| |y| |$used|) |$used|) ((|defusebuiltin| |y|) |$used|) (T (UNION (LIST |y|) |$used|))))) (T NIL))) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index d7bb643d..af1c967b 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -546,8 +546,8 @@ defuse1(e,y)== atom y => symbol? y => $used:= - MEMQ(y,e)=>$used - MEMQ(y,$used)=>$used + symbolMember?(y,e)=>$used + symbolMember?(y,$used)=>$used defusebuiltin y =>$used UNION([y],$used) [] -- cgit v1.2.3