mirror of
https://github.com/mozilla/gecko-dev.git
synced 2024-10-09 11:25:00 +00:00
191 lines
8.8 KiB
Common Lisp
Executable File
191 lines
8.8 KiB
Common Lisp
Executable File
;;;
|
|
;;; JavaScript 2.0 unit lexer
|
|
;;;
|
|
;;; Waldemar Horwat (waldemar@acm.org)
|
|
;;;
|
|
|
|
|
|
(progn
|
|
(defparameter *uw*
|
|
(generate-world
|
|
"U"
|
|
'((lexer unit-lexer
|
|
:lalr-1
|
|
:unit-pattern
|
|
((:unicode-initial-alphabetic
|
|
(% initial-alpha (:text "Any Unicode initial alphabetic character (includes ASCII "
|
|
(:character-literal #\A) :nbhy (:character-literal #\Z) " and "
|
|
(:character-literal #\a) :nbhy (:character-literal #\z) ")"))
|
|
() t)
|
|
(:unicode-alphanumeric
|
|
(% alphanumeric (:text "Any Unicode alphabetic or decimal digit character (includes ASCII "
|
|
(:character-literal #\0) :nbhy (:character-literal #\9) ", "
|
|
(:character-literal #\A) :nbhy (:character-literal #\Z) ", and "
|
|
(:character-literal #\a) :nbhy (:character-literal #\z) ")"))
|
|
() t)
|
|
(:white-space-character (++ (#?0009 #?000B #?000C #\space #?00A0)
|
|
(#?2000 #?2001 #?2002 #?2003 #?2004 #?2005 #?2006 #?2007)
|
|
(#?2008 #?2009 #?200A #?200B)
|
|
(#?3000)) ())
|
|
(:line-terminator (#?000A #?000D #?0085 #?2028 #?2029) ())
|
|
(:initial-identifier-character (+ :unicode-initial-alphabetic (#\$ #\_))
|
|
(($default-action $default-action)))
|
|
(:continuing-identifier-character (+ :unicode-alphanumeric (#\$ #\_))
|
|
(($default-action $default-action)))
|
|
(:a-s-c-i-i-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
|
(($default-action $default-action)
|
|
(decimal-value $digit-value))))
|
|
(($default-action char16 nil identity)
|
|
($digit-value integer digit-value digit-char-36)))
|
|
|
|
|
|
(%text nil "The start nonterminal is " (:grammar-symbol :unit-pattern) ".")
|
|
|
|
(%print-actions)
|
|
|
|
|
|
(%heading 1 "White Space")
|
|
|
|
(grammar-argument :sigma wsopt wsreq)
|
|
|
|
(%charclass :white-space-character)
|
|
(%charclass :line-terminator)
|
|
|
|
(production :required-white-space (:white-space-character) required-white-space-character)
|
|
(production :required-white-space (:line-terminator) required-white-space-line-terminator)
|
|
(production :required-white-space (:required-white-space :white-space-character) required-white-space-more-character)
|
|
(production :required-white-space (:required-white-space :line-terminator) required-white-space-more-line-terminator)
|
|
|
|
(production (:white-space :sigma) (:required-white-space) white-space-required-white-space)
|
|
(production (:white-space wsopt) () white-space-empty)
|
|
|
|
(%heading 1 "Unit Patterns")
|
|
|
|
(rule :unit-pattern ((value unit-list))
|
|
(production :unit-pattern ((:white-space wsopt) :unit-quotient) unit-pattern-quotient
|
|
(value (value :unit-quotient))))
|
|
|
|
(rule :unit-quotient ((value unit-list))
|
|
(production :unit-quotient ((:unit-product wsopt)) unit-quotient-product
|
|
(value (value :unit-product)))
|
|
(production :unit-quotient ((:unit-product wsopt) #\/ (:white-space wsopt) (:unit-product wsopt)) unit-quotient-quotient
|
|
(value (append (value :unit-product 1) (unit-reciprocal (value :unit-product 2))))))
|
|
|
|
(rule (:unit-product :sigma) ((value unit-list))
|
|
(production (:unit-product :sigma) ((:unit-factor :sigma)) unit-product-factor
|
|
(value (value :unit-factor)))
|
|
(production (:unit-product :sigma) ((:unit-product wsopt) #\* (:white-space wsopt) (:unit-factor :sigma)) unit-product-product
|
|
(value (append (value :unit-product) (value :unit-factor))))
|
|
(production (:unit-product :sigma) ((:unit-product wsreq) (:unit-factor :sigma)) unit-product-implied-product
|
|
(value (append (value :unit-product) (value :unit-factor)))))
|
|
|
|
(rule (:unit-factor :sigma) ((value unit-list))
|
|
(production (:unit-factor :sigma) (#\1 (:white-space :sigma)) unit-factor-one
|
|
(value (vector-of unit-factor)))
|
|
(production (:unit-factor :sigma) (#\1 (:white-space wsopt) #\^ (:white-space wsopt) :signed-integer (:white-space :sigma)) unit-factor-one-exponent
|
|
(value (vector-of unit-factor)))
|
|
(production (:unit-factor :sigma) (:identifier (:white-space :sigma)) unit-factor-identifier
|
|
(value (vector (new unit-factor (name :identifier) 1))))
|
|
(production (:unit-factor :sigma) (:identifier (:white-space wsopt) #\^ (:white-space wsopt) :signed-integer (:white-space :sigma)) unit-factor-identifier-exponent
|
|
(value (vector (new unit-factor (name :identifier) (integer-value :signed-integer))))))
|
|
|
|
(deftuple unit-factor (identifier string) (exponent integer))
|
|
(deftype unit-list (vector unit-factor))
|
|
|
|
(define (unit-reciprocal (value unit-list)) unit-list
|
|
(return (map value f (new unit-factor (& identifier f) (neg (& exponent f))))))
|
|
|
|
(%print-actions)
|
|
|
|
|
|
(%heading 1 "Signed Integers")
|
|
(rule :signed-integer ((integer-value integer))
|
|
(production :signed-integer (:decimal-digits) signed-integer-no-sign
|
|
(integer-value (integer-value :decimal-digits)))
|
|
(production :signed-integer (#\+ :decimal-digits) signed-integer-plus
|
|
(integer-value (integer-value :decimal-digits)))
|
|
(production :signed-integer (#\- :decimal-digits) signed-integer-minus
|
|
(integer-value (neg (integer-value :decimal-digits)))))
|
|
|
|
(rule :decimal-digits ((integer-value integer))
|
|
(production :decimal-digits (:a-s-c-i-i-digit) decimal-digits-first
|
|
(integer-value (decimal-value :a-s-c-i-i-digit)))
|
|
(production :decimal-digits (:decimal-digits :a-s-c-i-i-digit) decimal-digits-rest
|
|
(integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :a-s-c-i-i-digit)))))
|
|
|
|
(%charclass :a-s-c-i-i-digit)
|
|
(%print-actions)
|
|
|
|
|
|
(%heading 1 "Identifiers")
|
|
(rule :identifier ((name string))
|
|
(production :identifier (:initial-identifier-character) identifier-initial
|
|
(name (vector ($default-action :initial-identifier-character))))
|
|
(production :identifier (:identifier :continuing-identifier-character) identifier-continuing
|
|
(name (append (name :identifier) (vector ($default-action :continuing-identifier-character))))))
|
|
|
|
(%charclass :initial-identifier-character)
|
|
(%charclass :continuing-identifier-character)
|
|
(%charclass :unicode-initial-alphabetic)
|
|
(%charclass :unicode-alphanumeric)
|
|
(%print-actions)
|
|
)))
|
|
|
|
(defparameter *ul* (world-lexer *uw* 'unit-lexer))
|
|
(defparameter *ug* (lexer-grammar *ul*))
|
|
(set-up-lexer-metagrammar *ul*)
|
|
(defparameter *um* (lexer-metagrammar *ul*)))
|
|
|
|
|
|
(defun dump-units ()
|
|
(values
|
|
(depict-rtf-to-local-file
|
|
"JS20/UnitGrammar.rtf"
|
|
"JavaScript 2 Unit Grammar"
|
|
#'(lambda (rtf-stream)
|
|
(depict-world-commands rtf-stream *uw* :heading-offset 1 :visible-semantics nil)))
|
|
(depict-rtf-to-local-file
|
|
"JS20/UnitSemantics.rtf"
|
|
"JavaScript 2 Unit Semantics"
|
|
#'(lambda (rtf-stream)
|
|
(depict-world-commands rtf-stream *uw* :heading-offset 1)))
|
|
(depict-html-to-local-file
|
|
"JS20/UnitGrammar.html"
|
|
"JavaScript 2 Unit Grammar"
|
|
t
|
|
#'(lambda (html-stream)
|
|
(depict-world-commands html-stream *uw* :heading-offset 1 :visible-semantics nil))
|
|
:external-link-base "notation.html")
|
|
(depict-html-to-local-file
|
|
"JS20/UnitSemantics.html"
|
|
"JavaScript 2 Unit Semantics"
|
|
t
|
|
#'(lambda (html-stream)
|
|
(depict-world-commands html-stream *uw* :heading-offset 1))
|
|
:external-link-base "notation.html")))
|
|
|
|
#|
|
|
(dump-units)
|
|
|
|
(depict-rtf-to-local-file
|
|
"JS20/UnitCharClasses.rtf"
|
|
"JavaScript 2 Unit Character Classes"
|
|
#'(lambda (rtf-stream)
|
|
(depict-paragraph (rtf-stream :grammar-header)
|
|
(depict rtf-stream "Character Classes"))
|
|
(dolist (charclass (lexer-charclasses *ul*))
|
|
(depict-charclass rtf-stream charclass))
|
|
(depict-paragraph (rtf-stream :grammar-header)
|
|
(depict rtf-stream "Grammar"))
|
|
(depict-grammar rtf-stream *ug*)))
|
|
|
|
|
|
(with-local-output (s "JS20/UnitGrammar.txt") (print-lexer *ul* s) (print-grammar *ug* s))
|
|
|
|
(print-illegal-strings m)
|
|
|#
|
|
|
|
|
|
#+allegro (clean-grammar *ug*) ;Remove this line if you wish to print the grammar's state tables.
|
|
(length (grammar-states *ug*))
|