diff options
| -rw-r--r-- | src/boot/ast.boot | 56 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 84 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 8 | ||||
| -rw-r--r-- | src/boot/translator.boot | 8 | ||||
| -rw-r--r-- | src/boot/utility.boot | 2 |
5 files changed, 76 insertions, 82 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 8d5405e5..5b04ea8f 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -255,7 +255,7 @@ bfForTree(OP,lhs,whole)== whole := bfTupleP whole => bfMakeCons rest whole whole - atom lhs => bfINON [OP,lhs,whole] + lhs isnt [.,:.] => bfINON [OP,lhs,whole] lhs := bfTupleP lhs => second lhs lhs @@ -272,13 +272,13 @@ bfSTEP(id,fst,step,lst)== initvar := [id] initval := [fst] inc := - atom step => step + step isnt [.,:.] => step g1 := bfGenSymbol() initvar := [g1,:initvar] initval := [step,:initval] g1 final := - atom lst => lst + lst isnt [.,:.] => lst g2 := bfGenSymbol() initvar := [g2,:initvar] initval := [lst,:initval] @@ -497,7 +497,7 @@ bfLeave x == ["%Leave",x] bfSUBLIS(p,e)== - atom e => bfSUBLIS1(p,e) + e isnt [.,:.] => bfSUBLIS1(p,e) e.op is 'QUOTE => e [bfSUBLIS(p,first e),:bfSUBLIS(p,rest e)] @@ -564,7 +564,7 @@ bfLET1(lhs,rhs) == bfCONTAINED(x,y)== sameObject?(x,y) => true - atom y=> false + y isnt [.,:.] => false bfCONTAINED(x,first y) or bfCONTAINED(x,rest y) bfLET2(lhs,rhs) == @@ -574,7 +574,7 @@ bfLET2(lhs,rhs) == lhs is ['L%T,a,b] => a := bfLET2(a,rhs) (b := bfLET2(b,rhs)) = nil => a - atom b => [a,b] + b isnt [.,:.] => [a,b] cons? first b => [a,:b] [a,b] lhs is ['CONS,var1,var2] => @@ -582,18 +582,20 @@ bfLET2(lhs,rhs) == bfLET2(var2,addCARorCDR('CDR,rhs)) l1 := bfLET2(var1,addCARorCDR('CAR,rhs)) var2 = nil or var2 is "DOT" =>l1 - if cons? l1 and atom first l1 then l1 := [l1,:nil] + if cons? l1 and first l1 isnt [.,:.] then + l1 := [l1,:nil] symbol? var2 => [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))] l2 := bfLET2(var2,addCARorCDR('CDR,rhs)) - if cons? l2 and atom first l2 then l2 := [l2,:nil] + if cons? l2 and first l2 isnt [.,:.] then + l2 := [l2,:nil] [:l1,:l2] lhs is ['append,var1,var2] => patrev := bfISReverse(var2,var1) rev := ['reverse,rhs] g := bfLetVar() l2 := bfLET2(patrev,g) - if cons? l2 and atom first l2 then + if cons? l2 and first l2 isnt [.,:.] then l2 := [l2,:nil] var1 is "DOT" => [['L%T,g,rev],:l2] first lastNode l2 is ['L%T, =var1, val1] => @@ -619,7 +621,7 @@ bfLET(lhs,rhs) == bfLET1(lhs,rhs) addCARorCDR(acc,expr) == - atom expr => [acc,expr] + expr isnt [.,:.] => [acc,expr] acc is 'CAR and expr is ["reverse",:.] => ["CAR",["lastNode",:rest expr]] funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR @@ -664,19 +666,23 @@ bfIS1(lhs,rhs) == rhs = nil => ['NULL,lhs] bfString? rhs => bfAND [['STRINGP,lhs],["STRING=",lhs,rhs]] bfChar? rhs or integer? rhs => ['EQL,lhs,rhs] - atom rhs => ['PROGN,bfLetForm(rhs,lhs),'T] - rhs is ['QUOTE,a] => + rhs isnt [.,:.] => ['PROGN,bfLetForm(rhs,lhs),'T] + rhs.op is 'QUOTE => + [.,a] := rhs symbol? a => ['EQ,lhs,rhs] string? a => bfAND [['STRINGP,lhs],["STRING=",lhs,a]] ["EQUAL",lhs,rhs] - rhs is ['L%T,c,d] => + rhs.op is 'L%T => + [.,c,d] := rhs l := bfLET(c,lhs) bfAND [bfIS1(lhs,d),bfMKPROGN [l,'T]] rhs is ["EQUAL",a] => bfQ(lhs,a) + rhs is ['CONS,a,b] and a is "DOT" and b is "DOT" => ['CONSP,lhs] cons? lhs => g := bfIsVar() bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)] - rhs is ['CONS,a,b] => + rhs.op is 'CONS => + [.,a,b] := rhs a is "DOT" => b = nil => bfAND [['CONSP,lhs],['NULL,['CDR,lhs]]] b is "DOT" => ['CONSP,lhs] @@ -689,12 +695,14 @@ bfIS1(lhs,rhs) == a1 is ['PROGN,c,'T] and b1 is ['PROGN,:cls] => bfAND [['CONSP,lhs],bfMKPROGN [c,:cls]] bfAND [['CONSP,lhs],a1,b1] - rhs is ['append,a,b] => + rhs.op is 'append => + [.,a,b] := rhs patrev := bfISReverse(b,a) g := bfIsVar() rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['reverse,lhs]],'T]] l2 := bfIS1(g,patrev) - if cons? l2 and atom first l2 then l2 := [l2,:nil] + if cons? l2 and first l2 isnt [.,:.] then + l2 := [l2,:nil] a is "DOT" => bfAND [rev,:l2] bfAND [rev,:l2,['PROGN,bfLetForm(a,['reverse!,a]),'T]] bpSpecificErrorHere '"bad IS code is generated" @@ -890,7 +898,7 @@ shoeComp x== ++ on parameters with default values are satisfied. Return the ++ new augmented parameter list. bfParameterList(p1,p2) == - p2=nil and not atom p1 => p1 + p2=nil and p1 is [.,:.] => p1 p1 is ["&OPTIONAL",:.] => p2 isnt ["&OPTIONAL",:.] => bpSpecificErrorHere '"default value required" [first p1,:rest p1,:rest p2] @@ -911,7 +919,7 @@ bfInsertLet1(y,body)== symbol? y => [false,nil,y,body] y is ["BVQUOTE",b] => [true,"QUOTE",b,body] g:=bfGenSymbol() - atom y => [false,nil,g,body] + y isnt [.,:.] => [false,nil,g,body] case y of %DefaultValue(p,v) => [false,nil,["&OPTIONAL",[p,v]],body] otherwise => [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]] @@ -943,7 +951,7 @@ shoeCompTran x== [lamtype,args,:body] needsPROG body == - atom body => false + body isnt [.,:.] => false [op,:args] := body op in '(RETURN RETURN_-FROM) => true op in '(LET PROG LOOP BLOCK DECLARE LAMBDA) => false @@ -976,7 +984,7 @@ isDynamicVariable x == false shoeCompTran1 x == - atom x => + x isnt [.,:.] => if isDynamicVariable x and not symbolMember?(x,$dollarVars) then $dollarVars := [x,:$dollarVars] x @@ -1199,7 +1207,7 @@ bfCase(x,y)== -- To minimize the number of GENSYMS and assignments, we want -- to do this only when the scrutinee is not reduced yet. g := - atom x => x + x isnt [.,:.] => x bfGenSymbol() body := ["CASE",["CAR", g], :bfCaseItems(g,y)] sameObject?(g,x) => body @@ -1275,7 +1283,7 @@ bfThrow e == backquote: (%Form,%List %Symbol) -> %Form backquote(form,params) == params = nil => quote form - atom form => + form isnt [.,:.] => symbolMember?(form,params) => form quote form ["LIST",:[backquote(t,params) for t in form]] @@ -1383,7 +1391,7 @@ unknownNativeTypeError t == nativeType t == t = nil => t - atom t => + t isnt [.,:.] => t' := rest ASSOC(coreSymbol t,$NativeTypeTable) => t' := %hasFeature KEYWORD::SBCL => bfColonColon("SB-ALIEN", t') @@ -1479,7 +1487,7 @@ nativeArgumentType t == -- Allow 'string' for `pass-by-value' t is "string" => nativeType t -- anything else must use a modified reference type. - atom t or #t ~= 2 => + t isnt [.,:.] or #t ~= 2 => coreError '"invalid argument type for a native function" [m,[c,t']] := t -- Require a modifier. diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 3c4e2be5..cc337d1b 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -350,7 +350,7 @@ ((|bfTupleP| |whole|) (|bfMakeCons| (CDR |whole|))) (T |whole|))) (COND - ((ATOM |lhs|) (|bfINON| (LIST OP |lhs| |whole|))) + ((NOT (CONSP |lhs|)) (|bfINON| (LIST OP |lhs| |whole|))) (T (SETQ |lhs| (COND ((|bfTupleP| |lhs|) (CADR |lhs|)) (T |lhs|))) (COND @@ -371,13 +371,13 @@ (SETQ |initval| (LIST |fst|)) (SETQ |inc| (COND - ((ATOM |step|) |step|) + ((NOT (CONSP |step|)) |step|) (T (SETQ |g1| (|bfGenSymbol|)) (SETQ |initvar| (CONS |g1| |initvar|)) (SETQ |initval| (CONS |step| |initval|)) |g1|))) (SETQ |final| (COND - ((ATOM |lst|) |lst|) + ((NOT (CONSP |lst|)) |lst|) (T (SETQ |g2| (|bfGenSymbol|)) (SETQ |initvar| (CONS |g2| |initvar|)) (SETQ |initval| (CONS |lst| |initval|)) |g2|))) @@ -736,7 +736,7 @@ (DEFUN |bfSUBLIS| (|p| |e|) (COND - ((ATOM |e|) (|bfSUBLIS1| |p| |e|)) + ((NOT (CONSP |e|)) (|bfSUBLIS1| |p| |e|)) ((EQ (CAR |e|) 'QUOTE) |e|) (T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|)))))) @@ -844,7 +844,7 @@ (DEFUN |bfCONTAINED| (|x| |y|) (COND ((EQ |x| |y|) T) - ((ATOM |y|) NIL) + ((NOT (CONSP |y|)) NIL) (T (OR (|bfCONTAINED| |x| (CAR |y|)) (|bfCONTAINED| |x| (CDR |y|)))))) (DEFUN |bfLET2| (|lhs| |rhs|) @@ -872,7 +872,7 @@ (SETQ |a| (|bfLET2| |a| |rhs|)) (COND ((NULL (SETQ |b| (|bfLET2| |b| |rhs|))) |a|) - ((ATOM |b|) (LIST |a| |b|)) + ((NOT (CONSP |b|)) (LIST |a| |b|)) ((CONSP (CAR |b|)) (CONS |a| |b|)) (T (LIST |a| |b|)))) ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'CONS) @@ -892,7 +892,7 @@ (COND ((OR (NULL |var2|) (EQ |var2| 'DOT)) |l1|) (T (COND - ((AND (CONSP |l1|) (ATOM (CAR |l1|))) + ((AND (CONSP |l1|) (NOT (CONSP (CAR |l1|)))) (SETQ |l1| (CONS |l1| NIL)))) (COND ((SYMBOLP |var2|) @@ -904,7 +904,7 @@ (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) (COND - ((AND (CONSP |l2|) (ATOM (CAR |l2|))) + ((AND (CONSP |l2|) (NOT (CONSP (CAR |l2|)))) (SETQ |l2| (CONS |l2| NIL)))) (|append| |l1| |l2|)))))))) ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|append|) @@ -920,7 +920,7 @@ (SETQ |rev| (LIST '|reverse| |rhs|)) (SETQ |g| (|bfLetVar|)) (SETQ |l2| (|bfLET2| |patrev| |g|)) (COND - ((AND (CONSP |l2|) (ATOM (CAR |l2|))) + ((AND (CONSP |l2|) (NOT (CONSP (CAR |l2|)))) (SETQ |l2| (CONS |l2| NIL)))) (COND ((EQ |var1| 'DOT) (CONS (LIST 'L%T |g| |rev|) |l2|)) @@ -970,7 +970,7 @@ (PROG (|funsR| |funsA| |p| |funs|) (RETURN (COND - ((ATOM |expr|) (LIST |acc| |expr|)) + ((NOT (CONSP |expr|)) (LIST |acc| |expr|)) ((AND (EQ |acc| 'CAR) (CONSP |expr|) (EQ (CAR |expr|) '|reverse|)) (LIST 'CAR (CONS '|lastNode| (CDR |expr|)))) @@ -1026,8 +1026,8 @@ (T (|bpSpecificErrorHere| "Error in bfISReverse") (|bpTrap|)))))) (DEFUN |bfIS1| (|lhs| |rhs|) - (PROG (|l2| |rev| |patrev| |cls| |b1| |a1| |b| |g| |l| |d| |ISTMP#2| - |c| |a| |ISTMP#1|) + (PROG (|l2| |rev| |patrev| |cls| |b1| |a1| |g| |b| |ISTMP#2| + |ISTMP#1| |l| |d| |c| |a|) (RETURN (COND ((NULL |rhs|) (LIST 'NULL |lhs|)) @@ -1036,28 +1036,17 @@ (LIST 'STRING= |lhs| |rhs|)))) ((OR (|bfChar?| |rhs|) (INTEGERP |rhs|)) (LIST 'EQL |lhs| |rhs|)) - ((ATOM |rhs|) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T)) - ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'QUOTE) - (PROGN - (SETQ |ISTMP#1| (CDR |rhs|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) + ((NOT (CONSP |rhs|)) + (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T)) + ((EQ (CAR |rhs|) 'QUOTE) (SETQ |a| (CADR |rhs|)) (COND ((SYMBOLP |a|) (LIST 'EQ |lhs| |rhs|)) ((STRINGP |a|) (|bfAND| (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |a|)))) (T (LIST 'EQUAL |lhs| |rhs|)))) - ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T) - (PROGN - (SETQ |ISTMP#1| (CDR |rhs|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |c| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |d| (CAR |ISTMP#2|)) T)))))) - (SETQ |l| (|bfLET| |c| |lhs|)) + ((EQ (CAR |rhs|) 'L%T) (SETQ |c| (CADR . #0=(|rhs|))) + (SETQ |d| (CADDR . #0#)) (SETQ |l| (|bfLET| |c| |lhs|)) (|bfAND| (LIST (|bfIS1| |lhs| |d|) (|bfMKPROGN| (LIST |l| 'T))))) ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'EQUAL) @@ -1066,8 +1055,6 @@ (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) (|bfQ| |lhs| |a|)) - ((CONSP |lhs|) (SETQ |g| (|bfIsVar|)) - (|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |g| |rhs|)))) ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'CONS) (PROGN (SETQ |ISTMP#1| (CDR |rhs|)) @@ -1076,7 +1063,13 @@ (SETQ |a| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))) + (PROGN (SETQ |b| (CAR |ISTMP#2|)) T))))) + (EQ |a| 'DOT) (EQ |b| 'DOT)) + (LIST 'CONSP |lhs|)) + ((CONSP |lhs|) (SETQ |g| (|bfIsVar|)) + (|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |g| |rhs|)))) + ((EQ (CAR |rhs|) 'CONS) (SETQ |a| (CADR . #1=(|rhs|))) + (SETQ |b| (CADDR . #1#)) (COND ((EQ |a| 'DOT) (COND @@ -1111,15 +1104,8 @@ (|bfAND| (LIST (LIST 'CONSP |lhs|) (|bfMKPROGN| (CONS |c| |cls|))))) (T (|bfAND| (LIST (LIST 'CONSP |lhs|) |a1| |b1|))))))) - ((AND (CONSP |rhs|) (EQ (CAR |rhs|) '|append|) - (PROGN - (SETQ |ISTMP#1| (CDR |rhs|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |a| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))) + ((EQ (CAR |rhs|) '|append|) (SETQ |a| (CADR . #2=(|rhs|))) + (SETQ |b| (CADDR . #2#)) (SETQ |patrev| (|bfISReverse| |b| |a|)) (SETQ |g| (|bfIsVar|)) (SETQ |rev| (|bfAND| (LIST (LIST 'CONSP |lhs|) @@ -1129,7 +1115,7 @@ 'T)))) (SETQ |l2| (|bfIS1| |g| |patrev|)) (COND - ((AND (CONSP |l2|) (ATOM (CAR |l2|))) + ((AND (CONSP |l2|) (NOT (CONSP (CAR |l2|)))) (SETQ |l2| (CONS |l2| NIL)))) (COND ((EQ |a| 'DOT) (|bfAND| (CONS |rev| |l2|))) @@ -1633,7 +1619,7 @@ (DEFUN |bfParameterList| (|p1| |p2|) (COND - ((AND (NULL |p2|) (NOT (ATOM |p1|))) |p1|) + ((AND (NULL |p2|) (CONSP |p1|)) |p1|) ((AND (CONSP |p1|) (EQ (CAR |p1|) '&OPTIONAL)) (COND ((NOT (AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL))) @@ -1697,7 +1683,7 @@ (LIST T 'QUOTE |b| |body|)) (T (SETQ |g| (|bfGenSymbol|)) (COND - ((ATOM |y|) (LIST NIL NIL |g| |body|)) + ((NOT (CONSP |y|)) (LIST NIL NIL |g| |body|)) (T (CASE (CAR |y|) (|%DefaultValue| (LET ((|p| (CADR |y|)) (|v| (CADDR |y|))) @@ -1756,7 +1742,7 @@ (PROG (|args| |op|) (RETURN (COND - ((ATOM |body|) NIL) + ((NOT (CONSP |body|)) NIL) (T (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|)) (COND ((|symbolMember?| |op| '(RETURN RETURN-FROM)) T) @@ -1820,7 +1806,7 @@ (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|)) (RETURN (COND - ((ATOM |x|) + ((NOT (CONSP |x|)) (COND ((AND (|isDynamicVariable| |x|) (NOT (|symbolMember?| |x| |$dollarVars|))) @@ -2278,7 +2264,7 @@ (PROG (|body| |g|) (RETURN (PROGN - (SETQ |g| (COND ((ATOM |x|) |x|) (T (|bfGenSymbol|)))) + (SETQ |g| (COND ((NOT (CONSP |x|)) |x|) (T (|bfGenSymbol|)))) (SETQ |body| (CONS 'CASE (CONS (LIST 'CAR |g|) (|bfCaseItems| |g| |y|)))) @@ -2481,7 +2467,7 @@ (DEFUN |backquote| (|form| |params|) (COND ((NULL |params|) (|quote| |form|)) - ((ATOM |form|) + ((NOT (CONSP |form|)) (COND ((|symbolMember?| |form| |params|) |form|) (T (|quote| |form|)))) @@ -2536,7 +2522,7 @@ (RETURN (COND ((NULL |t|) |t|) - ((ATOM |t|) + ((NOT (CONSP |t|)) (COND ((SETQ |t'| (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|))) @@ -2652,7 +2638,7 @@ ((|objectMember?| |t| |$NativeSimpleDataTypes|) (|nativeType| |t|)) ((EQ |t| '|string|) (|nativeType| |t|)) - ((OR (ATOM |t|) (NOT (EQL (LENGTH |t|) 2))) + ((OR (NOT (CONSP |t|)) (NOT (EQL (LENGTH |t|) 2))) (|coreError| "invalid argument type for a native function")) (T (SETQ |m| (CAR |t|)) (SETQ |c| (CAADR . #0=(|t|))) (SETQ |t'| (CADADR . #0#)) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index ae9f2de2..734d8c27 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -628,7 +628,7 @@ |$currentModuleName|)) (RETURN (COND - ((ATOM |b|) (LIST |b|)) + ((NOT (CONSP |b|)) (LIST |b|)) ((AND (CONSP |b|) (EQ (CAR |b|) 'TUPLE)) (SETQ |xs| (CDR |b|)) (|coreError| "invalid AST")) (T (CASE (CAR |b|) @@ -986,7 +986,7 @@ (DECLARE (SPECIAL |$bootDefined| |$used|)) (RETURN (COND - ((ATOM |y|) + ((NOT (CONSP |y|)) (COND ((SYMBOLP |y|) (SETQ |$used| @@ -1054,7 +1054,7 @@ (RETURN (COND ((NULL |x|) NIL) - ((ATOM |x|) (LIST |x|)) + ((NOT (CONSP |x|)) (LIST |x|)) ((AND (CONSP |x|) (EQ (CAR |x|) '&REST) (PROGN (SETQ |ISTMP#1| (CDR |x|)) @@ -1167,7 +1167,7 @@ (DEFUN |stripm| (|x| |pk| |bt|) (COND - ((ATOM |x|) + ((NOT (CONSP |x|)) (COND ((SYMBOLP |x|) (COND diff --git a/src/boot/translator.boot b/src/boot/translator.boot index e9d720a2..0aec8e92 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -421,7 +421,7 @@ exportNames ns == [inAllContexts ["EXPORT",quote ns]] translateToplevel(b,export?) == - atom b => [b] -- generally happens in interactive mode. + b isnt [.,:.] => [b] -- generally happens in interactive mode. b is ["TUPLE",:xs] => coreError '"invalid AST" case b of %Signature(op,t) => [genDeclaration(op,t)] @@ -560,7 +560,7 @@ defuse(e,x)== tableValue($bootUsed,i) := [nee,:tableValue($bootUsed,i)] defuse1(e,y)== - atom y => + y isnt [.,:.] => symbol? y => $used:= symbolMember?(y,e)=>$used @@ -587,7 +587,7 @@ defSeparate x== unfluidlist x== x = nil => [] - atom x => [x] + x isnt [.,:.] => [x] x is ["&REST",y]=> [y] [first x,:unfluidlist rest x] @@ -650,7 +650,7 @@ shoeItem (str)== [[[first line for line in shoeDQlines dq]],:rest str] stripm (x,pk,bt)== - atom x => + x isnt [.,:.] => symbol? x => symbolScope x = bt => makeSymbol(symbolName x,pk) x diff --git a/src/boot/utility.boot b/src/boot/utility.boot index a0444d0f..1e60c8e2 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -60,7 +60,7 @@ module utility (objectMember?, symbolMember?, stringMember?, ++ Return true if `x' is an atom of a quotation. atomic? x == - not cons? x or x.op is 'QUOTE + x isnt [.,:.] or x.op is 'QUOTE --% membership operators |