From 0685de255a29c1c60b2917cd55f06d7aad3679f9 Mon Sep 17 00:00:00 2001 From: "waldemar%netscape.com" Date: Sat, 20 Nov 1999 02:16:56 +0000 Subject: [PATCH] Updated to work under Allegro Common Lisp git-svn-id: svn://10.0.0.236/trunk@54026 18797224-902f-48f8-a5cc-f745e15eee43 --- mozilla/js/semantics/GrammarSymbol.lisp | 2 +- mozilla/js/semantics/HTML.lisp | 2 +- mozilla/js/semantics/JS14/Parser.lisp | 6 +-- mozilla/js/semantics/JS20/Lexer.lisp | 12 ++--- mozilla/js/semantics/JS20/Parser.lisp | 6 +-- mozilla/js/semantics/JS20/RegExp.lisp | 10 ++-- mozilla/js/semantics/JSECMA/Lexer.lisp | 8 +-- mozilla/js/semantics/JSECMA/Parser.lisp | 6 +-- mozilla/js/semantics/Main.lisp | 52 ++++++++++++++++--- mozilla/js/semantics/Markup.lisp | 6 +-- mozilla/js/semantics/RTF.lisp | 10 ++-- mozilla/js/semantics/Test/BaseExample.lisp | 4 +- mozilla/js/semantics/Test/ConstraintTest.lisp | 6 +-- .../js/semantics/Test/StandardFunction.lisp | 4 +- mozilla/js/semantics/Test/ThrowCatch.lisp | 4 +- mozilla/js/semantics/Utilities.lisp | 3 +- mozilla/js2/semantics/GrammarSymbol.lisp | 2 +- mozilla/js2/semantics/HTML.lisp | 2 +- mozilla/js2/semantics/JS14/Parser.lisp | 6 +-- mozilla/js2/semantics/JS20/Lexer.lisp | 12 ++--- mozilla/js2/semantics/JS20/Parser.lisp | 6 +-- mozilla/js2/semantics/JS20/RegExp.lisp | 10 ++-- mozilla/js2/semantics/JSECMA/Lexer.lisp | 8 +-- mozilla/js2/semantics/JSECMA/Parser.lisp | 6 +-- mozilla/js2/semantics/Main.lisp | 52 ++++++++++++++++--- mozilla/js2/semantics/Markup.lisp | 6 +-- mozilla/js2/semantics/RTF.lisp | 10 ++-- mozilla/js2/semantics/Test/BaseExample.lisp | 4 +- .../js2/semantics/Test/ConstraintTest.lisp | 6 +-- .../js2/semantics/Test/StandardFunction.lisp | 4 +- mozilla/js2/semantics/Test/ThrowCatch.lisp | 4 +- mozilla/js2/semantics/Utilities.lisp | 3 +- 32 files changed, 180 insertions(+), 102 deletions(-) diff --git a/mozilla/js/semantics/GrammarSymbol.lisp b/mozilla/js/semantics/GrammarSymbol.lisp index 615790c9fee..b2af8e1c02d 100644 --- a/mozilla/js/semantics/GrammarSymbol.lisp +++ b/mozilla/js/semantics/GrammarSymbol.lisp @@ -345,7 +345,7 @@ (defun grammar-symbol-= (grammar-symbol1 grammar-symbol2) (eql grammar-symbol1 grammar-symbol2)) ; A version of grammar-symbol-= suitable for being the test function for hash tables. -(defconstant *grammar-symbol-=* #'eql) +(defparameter *grammar-symbol-=* #'eql) ; Return the general-grammar-symbol's symbol. Return it unchanged if it is not diff --git a/mozilla/js/semantics/HTML.lisp b/mozilla/js/semantics/HTML.lisp index b6e9f22bb86..1567388149a 100644 --- a/mozilla/js/semantics/HTML.lisp +++ b/mozilla/js/semantics/HTML.lisp @@ -322,7 +322,7 @@ ; Write html to the text file with the given name (relative to the ; local directory). (defun write-html-to-local-file (filename html) - (with-open-file (stream (merge-pathnames filename *semantic-engine-directory*) + (with-open-file (stream (filename-to-semantic-engine-pathname filename) :direction :output :if-exists :supersede #+mcl :mac-file-creator #+mcl "MOSS") diff --git a/mozilla/js/semantics/JS14/Parser.lisp b/mozilla/js/semantics/JS14/Parser.lisp index 7da33bc3f0c..d0aa2692c16 100644 --- a/mozilla/js/semantics/JS14/Parser.lisp +++ b/mozilla/js/semantics/JS14/Parser.lisp @@ -384,17 +384,17 @@ #| (depict-rtf-to-local-file - ";JS14;ParserGrammar.rtf" + "JS14/ParserGrammar.rtf" "JavaScript 1.4 Parser Grammar" #'(lambda (markup-stream) (depict-world-commands markup-stream *jw* :visible-semantics nil))) (depict-html-to-local-file - ";JS14;ParserGrammar.html" + "JS14/ParserGrammar.html" "JavaScript 1.4 Parser Grammar" t #'(lambda (markup-stream) (depict-world-commands markup-stream *jw* :visible-semantics nil))) -(with-local-output (s ";JS14;ParserGrammar.txt") (print-grammar *jg* s)) +(with-local-output (s "JS14/ParserGrammar.txt") (print-grammar *jg* s)) |# diff --git a/mozilla/js/semantics/JS20/Lexer.lisp b/mozilla/js/semantics/JS20/Lexer.lisp index 942af7ca078..cb9cfd24c89 100644 --- a/mozilla/js/semantics/JS20/Lexer.lisp +++ b/mozilla/js/semantics/JS20/Lexer.lisp @@ -524,7 +524,7 @@ #| (depict-rtf-to-local-file - ";JS20;LexerCharClasses.rtf" + "JS20/LexerCharClasses.rtf" "JavaScript 2 Lexer Character Classes" #'(lambda (rtf-stream) (depict-paragraph (rtf-stream ':grammar-header) @@ -537,33 +537,33 @@ (progn (depict-rtf-to-local-file - ";JS20;LexerGrammar.rtf" + "JS20/LexerGrammar.rtf" "JavaScript 2 Lexer Grammar" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw* :visible-semantics nil))) (depict-rtf-to-local-file - ";JS20;LexerSemantics.rtf" + "JS20/LexerSemantics.rtf" "JavaScript 2 Lexer Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*)))) (progn (depict-html-to-local-file - ";JS20;LexerGrammar.html" + "JS20/LexerGrammar.html" "JavaScript 2 Lexer Grammar" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw* :visible-semantics nil)) :external-link-base "notation.html") (depict-html-to-local-file - ";JS20;LexerSemantics.html" + "JS20/LexerSemantics.html" "JavaScript 2 Lexer Semantics" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*)) :external-link-base "notation.html")) -(with-local-output (s ";JS20;LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) +(with-local-output (s "JS20/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) (print-illegal-strings m) |# diff --git a/mozilla/js/semantics/JS20/Parser.lisp b/mozilla/js/semantics/JS20/Parser.lisp index 8a1cefd6510..e4659ed14cb 100644 --- a/mozilla/js/semantics/JS20/Parser.lisp +++ b/mozilla/js/semantics/JS20/Parser.lisp @@ -634,21 +634,21 @@ #| (depict-rtf-to-local-file - ";JS20;ParserGrammar.rtf" + "JS20/ParserGrammar.rtf" "JavaScript 2.0 Parser Grammar" #'(lambda (markup-stream) (depict-js-terminals markup-stream *jg*) (depict-world-commands markup-stream *jw* :visible-semantics nil))) (depict-html-to-local-file - ";JS20;ParserGrammar.html" + "JS20/ParserGrammar.html" "JavaScript 2.0 Parser Grammar" t #'(lambda (markup-stream) (depict-js-terminals markup-stream *jg*) (depict-world-commands markup-stream *jw* :visible-semantics nil))) -(with-local-output (s ";JS20;ParserGrammar.txt") (print-grammar *jg* s)) +(with-local-output (s "JS20/ParserGrammar.txt") (print-grammar *jg* s)) |# (length (grammar-states *jg*)) diff --git a/mozilla/js/semantics/JS20/RegExp.lisp b/mozilla/js/semantics/JS20/RegExp.lisp index 34886aa95f9..a5e4a642b85 100644 --- a/mozilla/js/semantics/JS20/RegExp.lisp +++ b/mozilla/js/semantics/JS20/RegExp.lisp @@ -586,33 +586,33 @@ #| (progn (depict-rtf-to-local-file - ";JS20;RegExpGrammar.rtf" + "JS20/RegExpGrammar.rtf" "Regular Expression Grammar" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *rw* :visible-semantics nil))) (depict-rtf-to-local-file - ";JS20;RegExpSemantics.rtf" + "JS20/RegExpSemantics.rtf" "Regular Expression Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *rw*)))) (progn (depict-html-to-local-file - ";JS20;RegExpGrammar.html" + "JS20/RegExpGrammar.html" "Regular Expression Grammar" t #'(lambda (html-stream) (depict-world-commands html-stream *rw* :visible-semantics nil)) :external-link-base "notation.html") (depict-html-to-local-file - ";JS20;RegExpSemantics.html" + "JS20/RegExpSemantics.html" "Regular Expression Semantics" t #'(lambda (html-stream) (depict-world-commands html-stream *rw*)) :external-link-base "notation.html")) -(with-local-output (s ";JS20;RegExpGrammar.txt") (print-lexer *rl* s) (print-grammar *rg* s)) +(with-local-output (s "JS20/RegExpGrammar.txt") (print-lexer *rl* s) (print-grammar *rg* s)) (lexer-pparse *rl* "a+" :trace t) (lexer-pparse *rl* "[]+" :trace t) diff --git a/mozilla/js/semantics/JSECMA/Lexer.lisp b/mozilla/js/semantics/JSECMA/Lexer.lisp index 8b242f5e175..a1e62985762 100644 --- a/mozilla/js/semantics/JSECMA/Lexer.lisp +++ b/mozilla/js/semantics/JSECMA/Lexer.lisp @@ -428,7 +428,7 @@ #| (depict-rtf-to-local-file - ";JSECMA;LexerCharClasses.rtf" + "JSECMA/LexerCharClasses.rtf" "ECMAScript 1 Lexer Character Classes" #'(lambda (rtf-stream) (depict-paragraph (rtf-stream ':grammar-header) @@ -440,19 +440,19 @@ (depict-grammar rtf-stream *lg*))) (depict-rtf-to-local-file - ";JSECMA;LexerSemantics.rtf" + "JSECMA/LexerSemantics.rtf" "ECMAScript 1 Lexer Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*))) (depict-html-to-local-file - ";JSECMA;LexerSemantics.html" + "JSECMA/LexerSemantics.html" "ECMAScript 1 Lexer Semantics" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*))) -(with-local-output (s ";JSECMA;LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) +(with-local-output (s "JSECMA/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) (print-illegal-strings m) diff --git a/mozilla/js/semantics/JSECMA/Parser.lisp b/mozilla/js/semantics/JSECMA/Parser.lisp index bbb8c15bc98..65265b01c20 100644 --- a/mozilla/js/semantics/JSECMA/Parser.lisp +++ b/mozilla/js/semantics/JSECMA/Parser.lisp @@ -829,19 +829,19 @@ #| (depict-rtf-to-local-file - ";JSECMA;ParserSemantics.rtf" + "JSECMA/ParserSemantics.rtf" "ECMAScript 1 Parser Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *gw*))) (depict-html-to-local-file - ";JSECMA;ParserSemantics.html" + "JSECMA/ParserSemantics.html" "ECMAScript 1 Parser Semantics" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *gw*))) -(with-local-output (s ";JSECMA;ParserGrammar.txt") (print-grammar *gg* s)) +(with-local-output (s "JSECMA/ParserGrammar.txt") (print-grammar *gg* s)) (ecma-pparse "('abc')") diff --git a/mozilla/js/semantics/Main.lisp b/mozilla/js/semantics/Main.lisp index ecbe6c05a17..a4f12decaaf 100644 --- a/mozilla/js/semantics/Main.lisp +++ b/mozilla/js/semantics/Main.lisp @@ -24,24 +24,62 @@ ;;; +#+allegro (shadow 'state) +#+allegro (shadow 'type) + (defparameter *semantic-engine-filenames* - '("Utilities" "Markup" "RTF" "HTML" "GrammarSymbol" "Grammar" "Parser" "Metaparser" "Lexer" "Calculus" "CalculusMarkup" - ";JS20;Parser" ";JS20;Lexer" ";JS20;RegExp" #|"JSECMA;Lexer" "JSECMA;Parser"|# )) + '("Utilities" "Markup" "RTF" "HTML" "GrammarSymbol" "Grammar" "Parser" "Metaparser" "Lexer" "Calculus" "CalculusMarkup")) + +(defparameter *semantics-filenames* + '("JS20/Parser" "JS20/Lexer" "JS20/RegExp" #|"JSECMA/Lexer" "JSECMA/Parser"|# )) (defparameter *semantic-engine-directory* (make-pathname - :directory (pathname-directory (truename *loading-file-source-file*)))) + :directory (pathname-directory #-mcl *load-truename* + #+mcl (truename *loading-file-source-file*)))) + + +;;; Convert a filename string possibly containing slashes into a Lisp relative pathname. +(defun filename-to-relative-pathname (filename) + (let ((directories nil)) + (loop + (let ((slash (position #\/ filename))) + (if slash + (progn + (push (subseq filename 0 slash) directories) + (setq filename (subseq filename (1+ slash)))) + (return (if directories + (make-pathname :directory (cons ':relative (nreverse directories)) :name filename) + filename))))))) + + +;;; Convert a filename string possibly containing slashes relative to *semantic-engine-directory* +;;; into a Lisp absolute pathname. +(defun filename-to-semantic-engine-pathname (filename) + (merge-pathnames (filename-to-relative-pathname filename) *semantic-engine-directory*)) + + +(defun operate-on-files (f files &rest options) + (with-compilation-unit () + (dolist (filename files) + (apply f (filename-to-semantic-engine-pathname filename) :verbose t options)))) + +(defun compile-semantic-engine () + (operate-on-files #'compile-file *semantic-engine-filenames* :load t)) (defun load-semantic-engine () - (dolist (filename *semantic-engine-filenames*) - (let ((pathname (merge-pathnames filename *semantic-engine-directory*))) - (load pathname :verbose t)))) + (operate-on-files #-allegro #'load #+allegro #'load-compiled *semantic-engine-filenames*)) + +(defun load-semantics () + (operate-on-files #'load *semantics-filenames*)) + (defmacro with-local-output ((stream filename) &body body) - `(with-open-file (,stream (merge-pathnames ,filename *semantic-engine-directory*) + `(with-open-file (,stream (filename-to-semantic-engine-pathname ,filename) :direction :output :if-exists :supersede) ,@body)) (load-semantic-engine) +(load-semantics) diff --git a/mozilla/js/semantics/Markup.lisp b/mozilla/js/semantics/Markup.lisp index 37ba99e5035..cc0d7975f1d 100644 --- a/mozilla/js/semantics/Markup.lisp +++ b/mozilla/js/semantics/Markup.lisp @@ -225,14 +225,14 @@ (substitute-soft-breaks tree #'(lambda (soft-break) - (list (make-string (soft-break-width soft-break) :initial-element #\space :element-type 'base-character))))) + (list (make-string (soft-break-width soft-break) :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character))))) ; Return a freshly consed markup list for a hard line break followed by indent spaces. (defun hard-break-markup (indent) (if (zerop indent) (list ':new-line) - (list ':new-line (make-string indent :initial-element #\space :element-type 'base-character)))) + (list ':new-line (make-string indent :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character)))) ; Destructively replace any soft-break that appears in a car position in the tree @@ -600,7 +600,7 @@ ; The string should contain only letters, dashes, and numbers. (defun string-to-mixed-case (string &optional capitalize) (let* ((length (length string)) - (dst-string (make-array length :element-type 'base-character :fill-pointer 0))) + (dst-string (make-array length :element-type #-mcl 'character #+mcl 'base-character :fill-pointer 0))) (dotimes (i length) (let ((char (char string i))) (if (eql char #\-) diff --git a/mozilla/js/semantics/RTF.lisp b/mozilla/js/semantics/RTF.lisp index f2624799a31..bd118ece7b4 100644 --- a/mozilla/js/semantics/RTF.lisp +++ b/mozilla/js/semantics/RTF.lisp @@ -355,8 +355,8 @@ ; (an output stream), dividing the text as specified by dynamically scoped calls ; to break-line. Return the text as a base-string. (defun write-limited-lines (emitter) - (let ((limited-stream (make-string-output-stream :element-type 'base-character)) - (*current-limited-lines* (make-string-output-stream :element-type 'base-character)) + (let ((limited-stream (make-string-output-stream :element-type #-mcl 'character #+mcl 'base-character)) + (*current-limited-lines* (make-string-output-stream :element-type #-mcl 'character #+mcl 'base-character)) (*current-limited-lines-non-empty* nil) (*current-limited-position* 0)) (funcall emitter limited-stream) @@ -525,7 +525,7 @@ ; Read RTF from the text file with the given name (relative to the ; local directory) and return it in list form. (defun read-rtf-from-local-file (filename) - (with-open-file (stream (merge-pathnames filename *semantic-engine-directory*) + (with-open-file (stream (filename-to-semantic-engine-pathname filename) :direction :input) (read-rtf stream))) @@ -543,7 +543,7 @@ (let ((i (position-if #'(lambda (char) (member char *rtf-special*)) string))) (if i (let* ((string-length (length string)) - (result-string (make-array string-length :element-type 'base-character :adjustable t :fill-pointer i))) + (result-string (make-array string-length :element-type #-mcl 'character #+mcl 'base-character :adjustable t :fill-pointer i))) (replace result-string string) (do ((i i (1+ i))) ((= i string-length)) @@ -632,7 +632,7 @@ ; Write RTF to the text file with the given name (relative to the ; local directory). (defun write-rtf-to-local-file (filename rtf) - (with-open-file (stream (merge-pathnames filename *semantic-engine-directory*) + (with-open-file (stream (filename-to-semantic-engine-pathname filename) :direction :output :if-exists :supersede #+mcl :external-format #+mcl "RTF " diff --git a/mozilla/js/semantics/Test/BaseExample.lisp b/mozilla/js/semantics/Test/BaseExample.lisp index 996f09ebd82..8a0741aa12f 100644 --- a/mozilla/js/semantics/Test/BaseExample.lisp +++ b/mozilla/js/semantics/Test/BaseExample.lisp @@ -45,13 +45,13 @@ #| (depict-rtf-to-local-file - ";Test;BaseExampleSemantics.rtf" + "Test/BaseExampleSemantics.rtf" "Base Example Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *bew*))) (depict-html-to-local-file - ";Test;BaseExampleSemantics.html" + "Test/BaseExampleSemantics.html" "Base Example Semantics" t #'(lambda (html-stream) diff --git a/mozilla/js/semantics/Test/ConstraintTest.lisp b/mozilla/js/semantics/Test/ConstraintTest.lisp index 8568d961f6e..a83934d6836 100644 --- a/mozilla/js/semantics/Test/ConstraintTest.lisp +++ b/mozilla/js/semantics/Test/ConstraintTest.lisp @@ -51,19 +51,19 @@ #| (depict-rtf-to-local-file - ";Test;ConstraintTestGrammar.rtf" + "Test/ConstraintTestGrammar.rtf" "Constraint Test Grammar" #'(lambda (markup-stream) (depict-world-commands markup-stream *ctw* :visible-semantics nil))) (depict-html-to-local-file - ";Test;ConstraintTestGrammar.html" + "Test/ConstraintTestGrammar.html" "Constraint Test Grammar" t #'(lambda (markup-stream) (depict-world-commands markup-stream *ctw* :visible-semantics nil))) -(with-local-output (s ";Test;ConstraintTestGrammar.txt") (print-grammar *ctg* s)) +(with-local-output (s "Test/ConstraintTestGrammar.txt") (print-grammar *ctg* s)) (pprint (parse *ctg* #'identity '(begin letter letter letter digit end))) |# diff --git a/mozilla/js/semantics/Test/StandardFunction.lisp b/mozilla/js/semantics/Test/StandardFunction.lisp index 2b63cc624da..550d7304bfc 100644 --- a/mozilla/js/semantics/Test/StandardFunction.lisp +++ b/mozilla/js/semantics/Test/StandardFunction.lisp @@ -20,13 +20,13 @@ #| (depict-rtf-to-local-file - ";Test;StandardFunctionSemantics.rtf" + "Test/StandardFunctionSemantics.rtf" "Standard Function Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *sfw*))) (depict-html-to-local-file - ";Test;StandardFunctionSemantics.html" + "Test/StandardFunctionSemantics.html" "Standard Function Semantics" t #'(lambda (html-stream) diff --git a/mozilla/js/semantics/Test/ThrowCatch.lisp b/mozilla/js/semantics/Test/ThrowCatch.lisp index 982665d14e7..91e2653c6ca 100644 --- a/mozilla/js/semantics/Test/ThrowCatch.lisp +++ b/mozilla/js/semantics/Test/ThrowCatch.lisp @@ -33,13 +33,13 @@ #| (depict-rtf-to-local-file - ";Test;ThrowCatchSemantics.rtf" + "Test/ThrowCatchSemantics.rtf" "Base Example Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *tcw*))) (depict-html-to-local-file - ";Test;ThrowCatchSemantics.html" + "Test/ThrowCatchSemantics.html" "Base Example Semantics" t #'(lambda (html-stream) diff --git a/mozilla/js/semantics/Utilities.lisp b/mozilla/js/semantics/Utilities.lisp index a0550813260..cf2a37ea58a 100644 --- a/mozilla/js/semantics/Utilities.lisp +++ b/mozilla/js/semantics/Utilities.lisp @@ -155,7 +155,8 @@ ;;; ------------------------------------------------------------------------------------------------------ ;;; VALUE ASSERTS -(defconstant *value-asserts* t) +(eval-when (:compile-toplevel :load-toplevel) + (defconstant *value-asserts* t)) ; Assert that (test value) returns non-nil. Return value. (defmacro assert-value (value test &rest format-and-parameters) diff --git a/mozilla/js2/semantics/GrammarSymbol.lisp b/mozilla/js2/semantics/GrammarSymbol.lisp index 615790c9fee..b2af8e1c02d 100644 --- a/mozilla/js2/semantics/GrammarSymbol.lisp +++ b/mozilla/js2/semantics/GrammarSymbol.lisp @@ -345,7 +345,7 @@ (defun grammar-symbol-= (grammar-symbol1 grammar-symbol2) (eql grammar-symbol1 grammar-symbol2)) ; A version of grammar-symbol-= suitable for being the test function for hash tables. -(defconstant *grammar-symbol-=* #'eql) +(defparameter *grammar-symbol-=* #'eql) ; Return the general-grammar-symbol's symbol. Return it unchanged if it is not diff --git a/mozilla/js2/semantics/HTML.lisp b/mozilla/js2/semantics/HTML.lisp index b6e9f22bb86..1567388149a 100644 --- a/mozilla/js2/semantics/HTML.lisp +++ b/mozilla/js2/semantics/HTML.lisp @@ -322,7 +322,7 @@ ; Write html to the text file with the given name (relative to the ; local directory). (defun write-html-to-local-file (filename html) - (with-open-file (stream (merge-pathnames filename *semantic-engine-directory*) + (with-open-file (stream (filename-to-semantic-engine-pathname filename) :direction :output :if-exists :supersede #+mcl :mac-file-creator #+mcl "MOSS") diff --git a/mozilla/js2/semantics/JS14/Parser.lisp b/mozilla/js2/semantics/JS14/Parser.lisp index 7da33bc3f0c..d0aa2692c16 100644 --- a/mozilla/js2/semantics/JS14/Parser.lisp +++ b/mozilla/js2/semantics/JS14/Parser.lisp @@ -384,17 +384,17 @@ #| (depict-rtf-to-local-file - ";JS14;ParserGrammar.rtf" + "JS14/ParserGrammar.rtf" "JavaScript 1.4 Parser Grammar" #'(lambda (markup-stream) (depict-world-commands markup-stream *jw* :visible-semantics nil))) (depict-html-to-local-file - ";JS14;ParserGrammar.html" + "JS14/ParserGrammar.html" "JavaScript 1.4 Parser Grammar" t #'(lambda (markup-stream) (depict-world-commands markup-stream *jw* :visible-semantics nil))) -(with-local-output (s ";JS14;ParserGrammar.txt") (print-grammar *jg* s)) +(with-local-output (s "JS14/ParserGrammar.txt") (print-grammar *jg* s)) |# diff --git a/mozilla/js2/semantics/JS20/Lexer.lisp b/mozilla/js2/semantics/JS20/Lexer.lisp index 942af7ca078..cb9cfd24c89 100644 --- a/mozilla/js2/semantics/JS20/Lexer.lisp +++ b/mozilla/js2/semantics/JS20/Lexer.lisp @@ -524,7 +524,7 @@ #| (depict-rtf-to-local-file - ";JS20;LexerCharClasses.rtf" + "JS20/LexerCharClasses.rtf" "JavaScript 2 Lexer Character Classes" #'(lambda (rtf-stream) (depict-paragraph (rtf-stream ':grammar-header) @@ -537,33 +537,33 @@ (progn (depict-rtf-to-local-file - ";JS20;LexerGrammar.rtf" + "JS20/LexerGrammar.rtf" "JavaScript 2 Lexer Grammar" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw* :visible-semantics nil))) (depict-rtf-to-local-file - ";JS20;LexerSemantics.rtf" + "JS20/LexerSemantics.rtf" "JavaScript 2 Lexer Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*)))) (progn (depict-html-to-local-file - ";JS20;LexerGrammar.html" + "JS20/LexerGrammar.html" "JavaScript 2 Lexer Grammar" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw* :visible-semantics nil)) :external-link-base "notation.html") (depict-html-to-local-file - ";JS20;LexerSemantics.html" + "JS20/LexerSemantics.html" "JavaScript 2 Lexer Semantics" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*)) :external-link-base "notation.html")) -(with-local-output (s ";JS20;LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) +(with-local-output (s "JS20/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) (print-illegal-strings m) |# diff --git a/mozilla/js2/semantics/JS20/Parser.lisp b/mozilla/js2/semantics/JS20/Parser.lisp index 8a1cefd6510..e4659ed14cb 100644 --- a/mozilla/js2/semantics/JS20/Parser.lisp +++ b/mozilla/js2/semantics/JS20/Parser.lisp @@ -634,21 +634,21 @@ #| (depict-rtf-to-local-file - ";JS20;ParserGrammar.rtf" + "JS20/ParserGrammar.rtf" "JavaScript 2.0 Parser Grammar" #'(lambda (markup-stream) (depict-js-terminals markup-stream *jg*) (depict-world-commands markup-stream *jw* :visible-semantics nil))) (depict-html-to-local-file - ";JS20;ParserGrammar.html" + "JS20/ParserGrammar.html" "JavaScript 2.0 Parser Grammar" t #'(lambda (markup-stream) (depict-js-terminals markup-stream *jg*) (depict-world-commands markup-stream *jw* :visible-semantics nil))) -(with-local-output (s ";JS20;ParserGrammar.txt") (print-grammar *jg* s)) +(with-local-output (s "JS20/ParserGrammar.txt") (print-grammar *jg* s)) |# (length (grammar-states *jg*)) diff --git a/mozilla/js2/semantics/JS20/RegExp.lisp b/mozilla/js2/semantics/JS20/RegExp.lisp index 34886aa95f9..a5e4a642b85 100644 --- a/mozilla/js2/semantics/JS20/RegExp.lisp +++ b/mozilla/js2/semantics/JS20/RegExp.lisp @@ -586,33 +586,33 @@ #| (progn (depict-rtf-to-local-file - ";JS20;RegExpGrammar.rtf" + "JS20/RegExpGrammar.rtf" "Regular Expression Grammar" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *rw* :visible-semantics nil))) (depict-rtf-to-local-file - ";JS20;RegExpSemantics.rtf" + "JS20/RegExpSemantics.rtf" "Regular Expression Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *rw*)))) (progn (depict-html-to-local-file - ";JS20;RegExpGrammar.html" + "JS20/RegExpGrammar.html" "Regular Expression Grammar" t #'(lambda (html-stream) (depict-world-commands html-stream *rw* :visible-semantics nil)) :external-link-base "notation.html") (depict-html-to-local-file - ";JS20;RegExpSemantics.html" + "JS20/RegExpSemantics.html" "Regular Expression Semantics" t #'(lambda (html-stream) (depict-world-commands html-stream *rw*)) :external-link-base "notation.html")) -(with-local-output (s ";JS20;RegExpGrammar.txt") (print-lexer *rl* s) (print-grammar *rg* s)) +(with-local-output (s "JS20/RegExpGrammar.txt") (print-lexer *rl* s) (print-grammar *rg* s)) (lexer-pparse *rl* "a+" :trace t) (lexer-pparse *rl* "[]+" :trace t) diff --git a/mozilla/js2/semantics/JSECMA/Lexer.lisp b/mozilla/js2/semantics/JSECMA/Lexer.lisp index 8b242f5e175..a1e62985762 100644 --- a/mozilla/js2/semantics/JSECMA/Lexer.lisp +++ b/mozilla/js2/semantics/JSECMA/Lexer.lisp @@ -428,7 +428,7 @@ #| (depict-rtf-to-local-file - ";JSECMA;LexerCharClasses.rtf" + "JSECMA/LexerCharClasses.rtf" "ECMAScript 1 Lexer Character Classes" #'(lambda (rtf-stream) (depict-paragraph (rtf-stream ':grammar-header) @@ -440,19 +440,19 @@ (depict-grammar rtf-stream *lg*))) (depict-rtf-to-local-file - ";JSECMA;LexerSemantics.rtf" + "JSECMA/LexerSemantics.rtf" "ECMAScript 1 Lexer Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*))) (depict-html-to-local-file - ";JSECMA;LexerSemantics.html" + "JSECMA/LexerSemantics.html" "ECMAScript 1 Lexer Semantics" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *lw*))) -(with-local-output (s ";JSECMA;LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) +(with-local-output (s "JSECMA/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s)) (print-illegal-strings m) diff --git a/mozilla/js2/semantics/JSECMA/Parser.lisp b/mozilla/js2/semantics/JSECMA/Parser.lisp index bbb8c15bc98..65265b01c20 100644 --- a/mozilla/js2/semantics/JSECMA/Parser.lisp +++ b/mozilla/js2/semantics/JSECMA/Parser.lisp @@ -829,19 +829,19 @@ #| (depict-rtf-to-local-file - ";JSECMA;ParserSemantics.rtf" + "JSECMA/ParserSemantics.rtf" "ECMAScript 1 Parser Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *gw*))) (depict-html-to-local-file - ";JSECMA;ParserSemantics.html" + "JSECMA/ParserSemantics.html" "ECMAScript 1 Parser Semantics" t #'(lambda (rtf-stream) (depict-world-commands rtf-stream *gw*))) -(with-local-output (s ";JSECMA;ParserGrammar.txt") (print-grammar *gg* s)) +(with-local-output (s "JSECMA/ParserGrammar.txt") (print-grammar *gg* s)) (ecma-pparse "('abc')") diff --git a/mozilla/js2/semantics/Main.lisp b/mozilla/js2/semantics/Main.lisp index ecbe6c05a17..a4f12decaaf 100644 --- a/mozilla/js2/semantics/Main.lisp +++ b/mozilla/js2/semantics/Main.lisp @@ -24,24 +24,62 @@ ;;; +#+allegro (shadow 'state) +#+allegro (shadow 'type) + (defparameter *semantic-engine-filenames* - '("Utilities" "Markup" "RTF" "HTML" "GrammarSymbol" "Grammar" "Parser" "Metaparser" "Lexer" "Calculus" "CalculusMarkup" - ";JS20;Parser" ";JS20;Lexer" ";JS20;RegExp" #|"JSECMA;Lexer" "JSECMA;Parser"|# )) + '("Utilities" "Markup" "RTF" "HTML" "GrammarSymbol" "Grammar" "Parser" "Metaparser" "Lexer" "Calculus" "CalculusMarkup")) + +(defparameter *semantics-filenames* + '("JS20/Parser" "JS20/Lexer" "JS20/RegExp" #|"JSECMA/Lexer" "JSECMA/Parser"|# )) (defparameter *semantic-engine-directory* (make-pathname - :directory (pathname-directory (truename *loading-file-source-file*)))) + :directory (pathname-directory #-mcl *load-truename* + #+mcl (truename *loading-file-source-file*)))) + + +;;; Convert a filename string possibly containing slashes into a Lisp relative pathname. +(defun filename-to-relative-pathname (filename) + (let ((directories nil)) + (loop + (let ((slash (position #\/ filename))) + (if slash + (progn + (push (subseq filename 0 slash) directories) + (setq filename (subseq filename (1+ slash)))) + (return (if directories + (make-pathname :directory (cons ':relative (nreverse directories)) :name filename) + filename))))))) + + +;;; Convert a filename string possibly containing slashes relative to *semantic-engine-directory* +;;; into a Lisp absolute pathname. +(defun filename-to-semantic-engine-pathname (filename) + (merge-pathnames (filename-to-relative-pathname filename) *semantic-engine-directory*)) + + +(defun operate-on-files (f files &rest options) + (with-compilation-unit () + (dolist (filename files) + (apply f (filename-to-semantic-engine-pathname filename) :verbose t options)))) + +(defun compile-semantic-engine () + (operate-on-files #'compile-file *semantic-engine-filenames* :load t)) (defun load-semantic-engine () - (dolist (filename *semantic-engine-filenames*) - (let ((pathname (merge-pathnames filename *semantic-engine-directory*))) - (load pathname :verbose t)))) + (operate-on-files #-allegro #'load #+allegro #'load-compiled *semantic-engine-filenames*)) + +(defun load-semantics () + (operate-on-files #'load *semantics-filenames*)) + (defmacro with-local-output ((stream filename) &body body) - `(with-open-file (,stream (merge-pathnames ,filename *semantic-engine-directory*) + `(with-open-file (,stream (filename-to-semantic-engine-pathname ,filename) :direction :output :if-exists :supersede) ,@body)) (load-semantic-engine) +(load-semantics) diff --git a/mozilla/js2/semantics/Markup.lisp b/mozilla/js2/semantics/Markup.lisp index 37ba99e5035..cc0d7975f1d 100644 --- a/mozilla/js2/semantics/Markup.lisp +++ b/mozilla/js2/semantics/Markup.lisp @@ -225,14 +225,14 @@ (substitute-soft-breaks tree #'(lambda (soft-break) - (list (make-string (soft-break-width soft-break) :initial-element #\space :element-type 'base-character))))) + (list (make-string (soft-break-width soft-break) :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character))))) ; Return a freshly consed markup list for a hard line break followed by indent spaces. (defun hard-break-markup (indent) (if (zerop indent) (list ':new-line) - (list ':new-line (make-string indent :initial-element #\space :element-type 'base-character)))) + (list ':new-line (make-string indent :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character)))) ; Destructively replace any soft-break that appears in a car position in the tree @@ -600,7 +600,7 @@ ; The string should contain only letters, dashes, and numbers. (defun string-to-mixed-case (string &optional capitalize) (let* ((length (length string)) - (dst-string (make-array length :element-type 'base-character :fill-pointer 0))) + (dst-string (make-array length :element-type #-mcl 'character #+mcl 'base-character :fill-pointer 0))) (dotimes (i length) (let ((char (char string i))) (if (eql char #\-) diff --git a/mozilla/js2/semantics/RTF.lisp b/mozilla/js2/semantics/RTF.lisp index f2624799a31..bd118ece7b4 100644 --- a/mozilla/js2/semantics/RTF.lisp +++ b/mozilla/js2/semantics/RTF.lisp @@ -355,8 +355,8 @@ ; (an output stream), dividing the text as specified by dynamically scoped calls ; to break-line. Return the text as a base-string. (defun write-limited-lines (emitter) - (let ((limited-stream (make-string-output-stream :element-type 'base-character)) - (*current-limited-lines* (make-string-output-stream :element-type 'base-character)) + (let ((limited-stream (make-string-output-stream :element-type #-mcl 'character #+mcl 'base-character)) + (*current-limited-lines* (make-string-output-stream :element-type #-mcl 'character #+mcl 'base-character)) (*current-limited-lines-non-empty* nil) (*current-limited-position* 0)) (funcall emitter limited-stream) @@ -525,7 +525,7 @@ ; Read RTF from the text file with the given name (relative to the ; local directory) and return it in list form. (defun read-rtf-from-local-file (filename) - (with-open-file (stream (merge-pathnames filename *semantic-engine-directory*) + (with-open-file (stream (filename-to-semantic-engine-pathname filename) :direction :input) (read-rtf stream))) @@ -543,7 +543,7 @@ (let ((i (position-if #'(lambda (char) (member char *rtf-special*)) string))) (if i (let* ((string-length (length string)) - (result-string (make-array string-length :element-type 'base-character :adjustable t :fill-pointer i))) + (result-string (make-array string-length :element-type #-mcl 'character #+mcl 'base-character :adjustable t :fill-pointer i))) (replace result-string string) (do ((i i (1+ i))) ((= i string-length)) @@ -632,7 +632,7 @@ ; Write RTF to the text file with the given name (relative to the ; local directory). (defun write-rtf-to-local-file (filename rtf) - (with-open-file (stream (merge-pathnames filename *semantic-engine-directory*) + (with-open-file (stream (filename-to-semantic-engine-pathname filename) :direction :output :if-exists :supersede #+mcl :external-format #+mcl "RTF " diff --git a/mozilla/js2/semantics/Test/BaseExample.lisp b/mozilla/js2/semantics/Test/BaseExample.lisp index 996f09ebd82..8a0741aa12f 100644 --- a/mozilla/js2/semantics/Test/BaseExample.lisp +++ b/mozilla/js2/semantics/Test/BaseExample.lisp @@ -45,13 +45,13 @@ #| (depict-rtf-to-local-file - ";Test;BaseExampleSemantics.rtf" + "Test/BaseExampleSemantics.rtf" "Base Example Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *bew*))) (depict-html-to-local-file - ";Test;BaseExampleSemantics.html" + "Test/BaseExampleSemantics.html" "Base Example Semantics" t #'(lambda (html-stream) diff --git a/mozilla/js2/semantics/Test/ConstraintTest.lisp b/mozilla/js2/semantics/Test/ConstraintTest.lisp index 8568d961f6e..a83934d6836 100644 --- a/mozilla/js2/semantics/Test/ConstraintTest.lisp +++ b/mozilla/js2/semantics/Test/ConstraintTest.lisp @@ -51,19 +51,19 @@ #| (depict-rtf-to-local-file - ";Test;ConstraintTestGrammar.rtf" + "Test/ConstraintTestGrammar.rtf" "Constraint Test Grammar" #'(lambda (markup-stream) (depict-world-commands markup-stream *ctw* :visible-semantics nil))) (depict-html-to-local-file - ";Test;ConstraintTestGrammar.html" + "Test/ConstraintTestGrammar.html" "Constraint Test Grammar" t #'(lambda (markup-stream) (depict-world-commands markup-stream *ctw* :visible-semantics nil))) -(with-local-output (s ";Test;ConstraintTestGrammar.txt") (print-grammar *ctg* s)) +(with-local-output (s "Test/ConstraintTestGrammar.txt") (print-grammar *ctg* s)) (pprint (parse *ctg* #'identity '(begin letter letter letter digit end))) |# diff --git a/mozilla/js2/semantics/Test/StandardFunction.lisp b/mozilla/js2/semantics/Test/StandardFunction.lisp index 2b63cc624da..550d7304bfc 100644 --- a/mozilla/js2/semantics/Test/StandardFunction.lisp +++ b/mozilla/js2/semantics/Test/StandardFunction.lisp @@ -20,13 +20,13 @@ #| (depict-rtf-to-local-file - ";Test;StandardFunctionSemantics.rtf" + "Test/StandardFunctionSemantics.rtf" "Standard Function Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *sfw*))) (depict-html-to-local-file - ";Test;StandardFunctionSemantics.html" + "Test/StandardFunctionSemantics.html" "Standard Function Semantics" t #'(lambda (html-stream) diff --git a/mozilla/js2/semantics/Test/ThrowCatch.lisp b/mozilla/js2/semantics/Test/ThrowCatch.lisp index 982665d14e7..91e2653c6ca 100644 --- a/mozilla/js2/semantics/Test/ThrowCatch.lisp +++ b/mozilla/js2/semantics/Test/ThrowCatch.lisp @@ -33,13 +33,13 @@ #| (depict-rtf-to-local-file - ";Test;ThrowCatchSemantics.rtf" + "Test/ThrowCatchSemantics.rtf" "Base Example Semantics" #'(lambda (rtf-stream) (depict-world-commands rtf-stream *tcw*))) (depict-html-to-local-file - ";Test;ThrowCatchSemantics.html" + "Test/ThrowCatchSemantics.html" "Base Example Semantics" t #'(lambda (html-stream) diff --git a/mozilla/js2/semantics/Utilities.lisp b/mozilla/js2/semantics/Utilities.lisp index a0550813260..cf2a37ea58a 100644 --- a/mozilla/js2/semantics/Utilities.lisp +++ b/mozilla/js2/semantics/Utilities.lisp @@ -155,7 +155,8 @@ ;;; ------------------------------------------------------------------------------------------------------ ;;; VALUE ASSERTS -(defconstant *value-asserts* t) +(eval-when (:compile-toplevel :load-toplevel) + (defconstant *value-asserts* t)) ; Assert that (test value) returns non-nil. Return value. (defmacro assert-value (value test &rest format-and-parameters)