From 0f612f581a6d58a4d3ceed0ade26e04681b32e13 Mon Sep 17 00:00:00 2001 From: Gabriel Dos Reis Date: Sun, 21 Aug 2022 13:01:37 -0700 Subject: Boot parser: Remove useless AST functions (#17) A couple of the Boot AST building functions are identity functions. Remove to reduce obfuscation. --- src/boot/ast.boot | 13 +------------ src/boot/parser.boot | 6 +++--- src/boot/strap/ast.clisp | 10 ---------- src/boot/strap/parser.clisp | 10 +++++----- src/boot/strap/tokens.clisp | 12 ++++++------ 5 files changed, 15 insertions(+), 36 deletions(-) diff --git a/src/boot/ast.boot b/src/boot/ast.boot index b37992de..d6fcc111 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2016, Gabriel Dos Reis. +-- Copyright (C) 2007-2022, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -198,17 +198,6 @@ bfEqual: %Form -> %Form bfEqual(name) == ["EQUAL",name] -bfBracket: %Thing -> %Thing -bfBracket(part) == - part - -bfPile: %List %Form -> %List %Form -bfPile(part) == - part - -bfDo x == - x - bfAtScope(s,x) == ["LET",[["*PACKAGE*",s]],x] diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 2cd2ca86..c5810f74 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -188,7 +188,7 @@ bpBracket(ps,f) == a := parserCurrentToken ps bpEqKey(ps,"OBRACK") => apply(f,[ps]) and (bpEqKey(ps,"CBRACK") or bpBrackTrap(ps,a)) => - bpPush(ps,bfBracket bpPop1 ps) + bpPush(ps,bpPop1 ps) bpEqKey(ps,"CBRACK") => bpPush(ps,[]) bpBrackTrap(ps,a) false @@ -197,7 +197,7 @@ bpPileBracketed(ps,f) == bpEqKey(ps,"SETTAB") => bpEqKey(ps,"BACKTAB") => true apply(f,[ps]) and (bpEqKey(ps,"BACKTAB") or bpPileTrap ps) => - bpPush(ps,bfPile bpPop1 ps) + bpPush(ps,bpPop1 ps) false false @@ -871,7 +871,7 @@ bpDo ps == bpRequire(ps,function bpDo) bpPush(ps,bfAtScope(bpPop2 ps,bpPop1 ps)) bpEqKey(ps,"DO") and bpRequire(ps,function bpAssign) and - bpPush(ps,bfDo bpPop1 ps) + bpPush(ps,bpPop1 ps) ++ Return: ++ RETURN Assign diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 63c806be..cba0ef88 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -244,16 +244,6 @@ (DEFUN |bfEqual| (|name|) (LIST 'EQUAL |name|)) -(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfBracket|)) - -(DEFUN |bfBracket| (|part|) |part|) - -(DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|)) (|%List| |%Form|)) |bfPile|)) - -(DEFUN |bfPile| (|part|) |part|) - -(DEFUN |bfDo| (|x|) |x|) - (DEFUN |bfAtScope| (|s| |x|) (LIST 'LET (LIST (LIST '*PACKAGE* |s|)) |x|)) (DECLAIM diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 7bf31b92..b55ddd35 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -183,7 +183,7 @@ (COND ((AND (FUNCALL |f| |ps|) (OR (|bpEqKey| |ps| 'CBRACK) (|bpBrackTrap| |ps| |a|))) - (|bpPush| |ps| (|bfBracket| (|bpPop1| |ps|)))) + (|bpPush| |ps| (|bpPop1| |ps|))) ((|bpEqKey| |ps| 'CBRACK) (|bpPush| |ps| NIL)) (T (|bpBrackTrap| |ps| |a|)))) (T NIL))))) @@ -194,7 +194,7 @@ (COND ((|bpEqKey| |ps| 'BACKTAB) T) ((AND (FUNCALL |f| |ps|) (OR (|bpEqKey| |ps| 'BACKTAB) (|bpPileTrap| |ps|))) - (|bpPush| |ps| (|bfPile| (|bpPop1| |ps|)))) + (|bpPush| |ps| (|bpPop1| |ps|))) (T NIL))) (T NIL))) @@ -387,7 +387,7 @@ (COND (|done| (RETURN NIL)) (T (SETQ |found| - (LET ((#1=#:G393 + (LET ((#1=#:G370 (CATCH :OPEN-AXIOM-CATCH-POINT (FUNCALL |f| |ps|)))) (COND ((AND (CONSP #1#) @@ -932,7 +932,7 @@ (|bpPush| |ps| (|bfAtScope| (|bpPop2| |ps|) (|bpPop1| |ps|)))) (T (AND (|bpEqKey| |ps| 'DO) (|bpRequire| |ps| #'|bpAssign|) - (|bpPush| |ps| (|bfDo| (|bpPop1| |ps|))))))) + (|bpPush| |ps| (|bpPop1| |ps|)))))) (DEFUN |bpReturn| (|ps|) (OR @@ -1411,7 +1411,7 @@ (SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|))) (SETQ |varno| (|parserGensymSequenceNumber| |ps|)) (UNWIND-PROTECT - (LET ((#1=#:G394 + (LET ((#1=#:G371 (CATCH :OPEN-AXIOM-CATCH-POINT (PROGN (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 7aae98ae..20f8f7e4 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -84,10 +84,10 @@ (LET* (|s|) (COND ((SETQ |s| - (WITH-HASH-TABLE-ITERATOR (#1=#:G392 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G369 |shoeKeyTable|) (LET ((|bfVar#1| NIL)) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G393 |k| |v|) + (MULTIPLE-VALUE-BIND (#2=#:G370 |k| |v|) (#1#) (COND ((NOT #2#) (RETURN |bfVar#1|)) (T @@ -138,9 +138,9 @@ (COND ((> |i| 255) (RETURN NIL)) (T (SETF (ELT |a| |i|) |b|))) (SETQ |i| (+ |i| 1)))) |a|)) - (WITH-HASH-TABLE-ITERATOR (#1=#:G394 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G371 |shoeKeyTable|) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G395 |s| #:G396) + (MULTIPLE-VALUE-BIND (#2=#:G372 |s| #:G373) (#1#) (COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|)))))) |d|))) @@ -154,9 +154,9 @@ (LET ((|i| 0)) (LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0))) (SETQ |i| (+ |i| 1)))) - (WITH-HASH-TABLE-ITERATOR (#1=#:G397 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G374 |shoeKeyTable|) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G398 |k| #:G399) + (MULTIPLE-VALUE-BIND (#2=#:G375 |k| #:G376) (#1#) (COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL) (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1)))))) -- cgit v1.2.3