aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/ast.boot49
-rw-r--r--src/boot/initial-env.lisp3
-rw-r--r--src/boot/strap/ast.clisp44
-rw-r--r--src/boot/strap/translator.clisp4
-rw-r--r--src/boot/translator.boot4
5 files changed, 50 insertions, 54 deletions
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)
[]
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 19:19:47 +0000