* boot/ast.boot (bfMDef): Simplify.

	(backquote): Do not quote integer and string literals.

4 files changed, 29 insertions, 94 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index fe569735..6fef514a 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -916,13 +916,8 @@ bfMDef (op,args,body) ==
   argl :=
     bfTupleP args => rest args
     [args]
-  [gargl,sgargl,nargl,largl]:=bfGargl argl
-  sb := [[i,:j] for i in nargl for j in sgargl]
-  body := applySubst(sb,body)
-  sb2 := [["CONS",quote i,j] for i in sgargl for j in largl]
-  body := ["applySubst",["LIST",:sb2],quote body]
-  lamex:= ["MLAMBDA",gargl,body]
-  def:= [op,lamex]
+  lamex := ["MLAMBDA",argl,backquote(body,argl)]
+  def := [op,lamex]
   [shoeComp def,:[:shoeComps bfDef1 d for d in $wheredefs]]
  
 bfGargl argl==
@@ -1424,6 +1419,7 @@ backquote(form,params) ==
   params = nil => quote  form
   form isnt [.,:.] =>
     symbolMember?(form,params) => form
+    integer? form or string? form => form
     quote form
   ["LIST",:[backquote(t,params) for t in form]]
 
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 249192fa..ec55fefc 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1462,86 +1462,30 @@
    (LIST 'LAMBDA |vars| |body|)))
 
 (DEFUN |bfMDef| (|op| |args| |body|)
-  (LET* (|def|
-         |lamex|
-         |sb2|
-         |sb|
-         |largl|
-         |nargl|
-         |sgargl|
-         |gargl|
-         |LETTMP#1|
-         |argl|)
+  (LET* (|def| |lamex| |argl|)
     (DECLARE (SPECIAL |$wheredefs|))
     (PROGN
      (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|))))
-     (SETQ |LETTMP#1| (|bfGargl| |argl|))
-     (SETQ |gargl| (CAR |LETTMP#1|))
-     (SETQ |sgargl| (CADR . #1=(|LETTMP#1|)))
-     (SETQ |nargl| (CADDR . #1#))
-     (SETQ |largl| (CADDDR . #1#))
-     (SETQ |sb|
-             (LET ((|bfVar#3| NIL)
-                   (|bfVar#4| NIL)
-                   (|bfVar#1| |nargl|)
-                   (|i| NIL)
-                   (|bfVar#2| |sgargl|)
-                   (|j| NIL))
-               (LOOP
-                (COND
-                 ((OR (NOT (CONSP |bfVar#1|))
-                      (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL)
-                      (NOT (CONSP |bfVar#2|))
-                      (PROGN (SETQ |j| (CAR |bfVar#2|)) NIL))
-                  (RETURN |bfVar#3|))
-                 ((NULL |bfVar#3|)
-                  (SETQ |bfVar#3| #2=(CONS (CONS |i| |j|) NIL))
-                  (SETQ |bfVar#4| |bfVar#3|))
-                 (T (RPLACD |bfVar#4| #2#) (SETQ |bfVar#4| (CDR |bfVar#4|))))
-                (SETQ |bfVar#1| (CDR |bfVar#1|))
-                (SETQ |bfVar#2| (CDR |bfVar#2|)))))
-     (SETQ |body| (|applySubst| |sb| |body|))
-     (SETQ |sb2|
-             (LET ((|bfVar#7| NIL)
-                   (|bfVar#8| NIL)
-                   (|bfVar#5| |sgargl|)
-                   (|i| NIL)
-                   (|bfVar#6| |largl|)
-                   (|j| NIL))
-               (LOOP
-                (COND
-                 ((OR (NOT (CONSP |bfVar#5|))
-                      (PROGN (SETQ |i| (CAR |bfVar#5|)) NIL)
-                      (NOT (CONSP |bfVar#6|))
-                      (PROGN (SETQ |j| (CAR |bfVar#6|)) NIL))
-                  (RETURN |bfVar#7|))
-                 ((NULL |bfVar#7|)
-                  (SETQ |bfVar#7| #3=(CONS (LIST 'CONS (|quote| |i|) |j|) NIL))
-                  (SETQ |bfVar#8| |bfVar#7|))
-                 (T (RPLACD |bfVar#8| #3#) (SETQ |bfVar#8| (CDR |bfVar#8|))))
-                (SETQ |bfVar#5| (CDR |bfVar#5|))
-                (SETQ |bfVar#6| (CDR |bfVar#6|)))))
-     (SETQ |body| (LIST '|applySubst| (CONS 'LIST |sb2|) (|quote| |body|)))
-     (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
+     (SETQ |lamex| (LIST 'MLAMBDA |argl| (|backquote| |body| |argl|)))
      (SETQ |def| (LIST |op| |lamex|))
      (CONS (|shoeComp| |def|)
-           (LET ((|bfVar#10| NIL)
-                 (|bfVar#11| NIL)
-                 (|bfVar#9| |$wheredefs|)
+           (LET ((|bfVar#2| NIL)
+                 (|bfVar#3| NIL)
+                 (|bfVar#1| |$wheredefs|)
                  (|d| NIL))
              (LOOP
               (COND
-               ((OR (NOT (CONSP |bfVar#9|))
-                    (PROGN (SETQ |d| (CAR |bfVar#9|)) NIL))
-                (RETURN |bfVar#10|))
+               ((OR (NOT (CONSP |bfVar#1|))
+                    (PROGN (SETQ |d| (CAR |bfVar#1|)) NIL))
+                (RETURN |bfVar#2|))
                (T
-                (LET ((|bfVar#12| (|copyList| (|shoeComps| (|bfDef1| |d|)))))
-                  (COND ((NULL |bfVar#12|) NIL)
-                        ((NULL |bfVar#10|) (SETQ |bfVar#10| |bfVar#12|)
-                         (SETQ |bfVar#11| (|lastNode| |bfVar#10|)))
-                        (T (RPLACD |bfVar#11| |bfVar#12|)
-                         (SETQ |bfVar#11| (|lastNode| |bfVar#11|)))))))
-              (SETQ |bfVar#9| (CDR |bfVar#9|))))))))
+                (LET ((|bfVar#4| (|copyList| (|shoeComps| (|bfDef1| |d|)))))
+                  (COND ((NULL |bfVar#4|) NIL)
+                        ((NULL |bfVar#2|) (SETQ |bfVar#2| |bfVar#4|)
+                         (SETQ |bfVar#3| (|lastNode| |bfVar#2|)))
+                        (T (RPLACD |bfVar#3| |bfVar#4|)
+                         (SETQ |bfVar#3| (|lastNode| |bfVar#3|)))))))
+              (SETQ |bfVar#1| (CDR |bfVar#1|))))))))
 
 (DEFUN |bfGargl| (|argl|)
   (LET* (|f| |d| |c| |b| |a| |LETTMP#1|)
@@ -2769,6 +2713,7 @@
   (COND ((NULL |params|) (|quote| |form|))
         ((NOT (CONSP |form|))
          (COND ((|symbolMember?| |form| |params|) |form|)
+               ((OR (INTEGERP |form|) (STRINGP |form|)) |form|)
                (T (|quote| |form|))))
         (T
          (CONS 'LIST
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 02d2408b..ce957612 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -68,9 +68,7 @@
 
 (DEFMACRO |sourceLineNumber| (|bfVar#1|) (LIST '|%SourceLine-num| |bfVar#1|))
 
-(DEFMACRO |makeSourceLine| (|bfVar#2| |bfVar#1|)
-  (|applySubst| (LIST (CONS '|bfVar#2| |bfVar#2|) (CONS '|bfVar#1| |bfVar#1|))
-                '(|mk%SourceLine| |bfVar#2| |bfVar#1|)))
+(DEFMACRO |makeSourceLine| (|s| |n|) (LIST '|mk%SourceLine| |s| |n|))
 
 (DEFUN |lineNo| (|p|) (|sourceLineNumber| (CAAR |p|)))
 
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 48582bbf..e1b8418a 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -34,13 +34,11 @@
 
 (DEFUN |makeLexer| () (|mk%Lexer| NIL NIL))
 
-(DEFMACRO |lexerRefresh?| (|bfVar#1|)
-  (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|))
-                '(NULL (|lexerCurrentPosition| |bfVar#1|))))
+(DEFMACRO |lexerRefresh?| (|lex|)
+  (LIST 'NULL (LIST '|lexerCurrentPosition| |lex|)))
 
-(DEFMACRO |lexerLineLength| (|bfVar#1|)
-  (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|))
-                '(LENGTH (|lexerLineString| |bfVar#1|))))
+(DEFMACRO |lexerLineLength| (|lex|)
+  (LIST 'LENGTH (LIST '|lexerLineString| |lex|)))
 
 (DEFUN |lexerSetLine!| (|lex| |line|)
   (PROGN
@@ -63,14 +61,12 @@
 (DEFUN |lexerCharCountToCompleteTab| (|lex|)
   (- 7 (REM (|lexerCurrentPosition| |lex|) 8)))
 
-(DEFMACRO |lexerCurrentChar| (|bfVar#1|)
-  (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|))
-                '(SCHAR (|lexerLineString| |bfVar#1|)
-                        (|lexerCurrentPosition| |bfVar#1|))))
+(DEFMACRO |lexerCurrentChar| (|lex|)
+  (LIST 'SCHAR (LIST '|lexerLineString| |lex|)
+        (LIST '|lexerCurrentPosition| |lex|)))
 
-(DEFMACRO |lexerCharacterAt| (|bfVar#2| |bfVar#1|)
-  (|applySubst| (LIST (CONS '|bfVar#2| |bfVar#2|) (CONS '|bfVar#1| |bfVar#1|))
-                '(SCHAR (|lexerLineString| |bfVar#2|) |bfVar#1|)))
+(DEFMACRO |lexerCharacterAt| (|lex| |k|)
+  (LIST 'SCHAR (LIST '|lexerLineString| |lex|) |k|))
 
 (DEFUN |lexerCharPosition| (|lex| |c|)
   (OR