From 3537b6ab6e6696fb5def82cde4c9c9e843f84ce9 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 16 May 2011 02:40:27 +0000 Subject: * boot/tokens.boot: "do" is now a keyword. * boot/ast.boot (bfDo): New. * boot/parser.boot (bpDo): New. (bpReturn): Include do-expressions. * interp/vmlisp.lisp (do): Remove. --- src/ChangeLog | 8 ++++++++ src/boot/ast.boot | 3 +++ src/boot/parser.boot | 6 ++++++ src/boot/strap/ast.clisp | 2 ++ src/boot/strap/parser.clisp | 6 +++++- src/boot/strap/tokens.clisp | 2 +- src/boot/tokens.boot | 1 + src/interp/macros.lisp | 2 -- 8 files changed, 26 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index bcab568f..2b03097c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2011-05-15 Gabriel Dos Reis + + * boot/tokens.boot: "do" is now a keyword. + * boot/ast.boot (bfDo): New. + * boot/parser.boot (bpDo): New. + (bpReturn): Include do-expressions. + * interp/vmlisp.lisp (do): Remove. + 2011-05-15 Gabriel Dos Reis * boot/ast.boot (shoeCompTran1): Don't indiscriminately walk CASE diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 2ab77036..6472449b 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -161,6 +161,9 @@ bfPile: %List %Form -> %List %Form bfPile(part) == part +bfDo x == + x + bfAppend: %List %List %Form -> %List %Form bfAppend ls == ls isnt [l,:ls] => nil diff --git a/src/boot/parser.boot b/src/boot/parser.boot index f7a0ba8f..db07d2f9 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -756,6 +756,11 @@ bpLeave() == bpEqKey "LEAVE" and (bpLogical() or bpTrap()) and bpPush bfLeave bpPop1() +++ Do: +++ DO Assign +bpDo() == + bpEqKey "DO" and (bpAssign() or bpTrap()) and bpPush bfDo bpPop1() + ++ Return: ++ RETURN Assign ++ Leave @@ -767,6 +772,7 @@ bpReturn()== or bpLeave() or bpThrow() or bpAnd() + or bpDo() bpLogical()== bpLeftAssoc('(OR),function bpReturn) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 6fcee2ea..74194f69 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -197,6 +197,8 @@ (DEFUN |bfPile| (|part|) |part|) +(DEFUN |bfDo| (|x|) |x|) + (DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| |%Form|))) (|%List| |%Form|)) |bfAppend|)) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 867d52e9..06dc31e3 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -818,10 +818,14 @@ (AND (|bpEqKey| 'LEAVE) (OR (|bpLogical|) (|bpTrap|)) (|bpPush| (|bfLeave| (|bpPop1|))))) +(DEFUN |bpDo| () + (AND (|bpEqKey| 'DO) (OR (|bpAssign|) (|bpTrap|)) + (|bpPush| (|bfDo| (|bpPop1|))))) + (DEFUN |bpReturn| () (OR (AND (|bpEqKey| 'RETURN) (OR (|bpAssign|) (|bpTrap|)) (|bpPush| (|bfReturnNoName| (|bpPop1|)))) - (|bpLeave|) (|bpThrow|) (|bpAnd|))) + (|bpLeave|) (|bpThrow|) (|bpAnd|) (|bpDo|))) (DEFUN |bpLogical| () (|bpLeftAssoc| '(OR) #'|bpReturn|)) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index b8eae135..297bcbb3 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -29,7 +29,7 @@ (DEFCONSTANT |shoeKeyWords| (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE) - (LIST "catch" 'CATCH) (LIST "cross" 'CROSS) + (LIST "catch" 'CATCH) (LIST "cross" 'CROSS) (LIST "do" 'DO) (LIST "else" 'ELSE) (LIST "finally" 'FINALLY) (LIST "for" 'FOR) (LIST "forall" 'FORALL) (LIST "has" 'HAS) (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 9acebffc..c6b6b4dc 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -62,6 +62,7 @@ shoeKeyWords == [ _ ['"case","CASE"] , _ ['"catch","CATCH"], _ ['"cross","CROSS"] , _ + ['"do", "DO" ], _ ['"else", "ELSE"] , _ ['"finally", "FINALLY"], _ ['"for", "FOR"] , _ diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp index 0deffb0e..bdc4d7e7 100644 --- a/src/interp/macros.lisp +++ b/src/interp/macros.lisp @@ -488,8 +488,6 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size #-(OR IBCL AKCL) (defmacro |elapsedGcTime| () '0) -(defmacro |do| (&rest args) (CONS 'PROGN args)) - (defun DROPTRAILINGBLANKS (LINE) (string-right-trim " " LINE)) ; This function was modified by Greg Vanuxem on March 31, 2005 -- cgit v1.2.3