diff options
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/boot/ast.boot | 7 | ||||
| -rw-r--r-- | src/boot/parser.boot | 10 | ||||
| -rw-r--r-- | src/boot/scanner.boot | 7 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 4 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 9 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 6 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 6 |
8 files changed, 46 insertions, 10 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 0c0562e6..50be349c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2013-06-20 Gabriel Dos Reis <gdr@integrable-solutions.net> + + * boot/scanner.boot (shoeToken): Allow inerts. + * boot/ast.boot (bfInert): New. + * boot/parser.boot (bpInert): New. + (bpConstTok): Use it. + 2013-06-18 Gabriel Dos Reis <gdr@integrable-solutions.net> * interp/compiler.boot (compHasFormat): Take a DB parameter. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 14259ebd..f3f2b12c 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-2012, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -811,8 +811,11 @@ bfHas(expr,prop) == bfKeyArg(k,x) == ['%Key,k,x] +bfInert x == + makeSymbol(stringUpcase x,'"KEYWORD") + lispKey k == - makeSymbol(stringUpcase symbolName k,'"KEYWORD") + bfInert symbolName k bfExpandKeys l == args := nil diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 43507640..f49ebc5d 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2012, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -429,6 +429,7 @@ bpName ps == ++ LINE ++ QUOTE S-Expression ++ STRING +++ INERT bpConstTok ps == parserTokenClass ps in '(INTEGER FLOAT) => bpPush(ps,parserTokenValue ps) @@ -443,7 +444,12 @@ bpConstTok ps == bpNext ps bpRequire(ps,function bpSexp) and bpPush(ps,bfSymbol bpPop1 ps) - bpString ps or bpFunction ps + bpString ps or bpFunction ps or bpInert ps + +bpInert ps == + parserTokenClass ps = 'INERT => + bpPush(ps,bfInert parserTokenValue ps) and bpNext ps + nil bpChar ps == parserTokenClass ps = "ID" and parserTokenValue ps is "char" => diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index 8b9a5e5e..bf7ba428 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2012, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -212,6 +212,7 @@ shoeToken lex == ch = shoeTAB => lexerAdvancePosition! lex [] + ch = char "&" => shoeInert lex shoeError lex b = nil => nil dqUnit makeToken(linepos,b,n) @@ -410,6 +411,10 @@ shoeWord(lex,esp) == shoeLeafKey w shoeLeafId w +shoeInert lex == + lexerAdvancePosition! lex + ['INERT,second shoeW(lex,false)] + shoeInteger lex == shoeInteger1(lex,false) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 6cb05e57..3fca935f 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1223,7 +1223,9 @@ (DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|)) -(DEFUN |lispKey| (|k|) (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD")) +(DEFUN |bfInert| (|x|) (INTERN (STRING-UPCASE |x|) "KEYWORD")) + +(DEFUN |lispKey| (|k|) (|bfInert| (SYMBOL-NAME |k|))) (DEFUN |bfExpandKeys| (|l|) (LET* (|x| |ISTMP#2| |k| |ISTMP#1| |a| |args|) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index fcb8a2ef..7684716b 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -466,7 +466,14 @@ ((|bpEqPeek| |ps| 'QUOTE) (|bpNext| |ps|) (AND (|bpRequire| |ps| #'|bpSexp|) (|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|))))) - (T (OR (|bpString| |ps|) (|bpFunction| |ps|))))) + (T (OR (|bpString| |ps|) (|bpFunction| |ps|) (|bpInert| |ps|))))) + +(DEFUN |bpInert| (|ps|) + (COND + ((EQ (|parserTokenClass| |ps|) 'INERT) + (AND (|bpPush| |ps| (|bfInert| (|parserTokenValue| |ps|))) + (|bpNext| |ps|))) + (T NIL))) (DEFUN |bpChar| (|ps|) (LET* (|ISTMP#1| |s| |a|) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 744d4e28..92912515 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -194,6 +194,7 @@ ((DIGIT-CHAR-P |ch|) (|shoeNumber| |lex|)) ((CHAR= |ch| (|char| '_)) (|shoeEscape| |lex|)) ((EQUAL |ch| |shoeTAB|) (|lexerAdvancePosition!| |lex|) NIL) + ((CHAR= |ch| (|char| '&)) (|shoeInert| |lex|)) (T (|shoeError| |lex|)))) (COND ((NULL |b|) NIL) (T (|dqUnit| (|makeToken| |linepos| |b| |n|))))))) @@ -426,6 +427,11 @@ ((|shoeKeyWordP| |w|) (SETQ |$floatok| T) (|shoeLeafKey| |w|)) (T (|shoeLeafId| |w|)))))) +(DEFUN |shoeInert| (|lex|) + (PROGN + (|lexerAdvancePosition!| |lex|) + (LIST 'INERT (CADR (|shoeW| |lex| NIL))))) + (DEFUN |shoeInteger| (|lex|) (|shoeInteger1| |lex| NIL)) (DEFUN |shoeInteger1| (|lex| |zro|) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 55653a76..6fa7d340 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -225,9 +225,9 @@ (LIST '|flushOutput| 'FORCE-OUTPUT) (LIST '|fourth| 'CADDDR) (LIST '|freshLine| 'FRESH-LINE) (LIST '|function?| 'FUNCTIONP) (LIST '|functionSymbol?| 'FBOUNDP) (LIST '|gensym| 'GENSYM) - (LIST '|genvar| 'GENVAR) (LIST '|inert?| 'KEYWORDP) - (LIST '|integer?| 'INTEGERP) (LIST 'LAST '|last|) - (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL) + (LIST '|genvar| 'GENVAR) (LIST '|importSymbol| 'IMPORT) + (LIST '|inert?| 'KEYWORDP) (LIST '|integer?| 'INTEGERP) + (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL) (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeFilePath| 'MAKE-PATHNAME) (LIST '|makeSymbol| 'INTERN) (LIST '|mergeFilePaths| 'MERGE-PATHNAMES) (LIST '|mkpf| 'MKPF) |