gecko-dev/js/semantics/GrammarSymbol.lisp
1999-06-03 20:50:21 +00:00

540 lines
25 KiB
Common Lisp

;;; The contents of this file are subject to the Netscape Public License
;;; Version 1.0 (the "NPL"); you may not use this file except in
;;; compliance with the NPL. You may obtain a copy of the NPL at
;;; http://www.mozilla.org/NPL/
;;;
;;; Software distributed under the NPL is distributed on an "AS IS" basis,
;;; WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL
;;; for the specific language governing rights and limitations under the
;;; NPL.
;;;
;;; The Initial Developer of this code under the NPL is Netscape
;;; Communications Corporation. Portions created by Netscape are
;;; Copyright (C) 1998 Netscape Communications Corporation. All Rights
;;; Reserved.
;;;
;;; LALR(1) and LR(1) parametrized grammar utilities
;;;
;;; Waldemar Horwat (waldemar@netscape.com)
;;;
;;; ------------------------------------------------------------------------------------------------------
;;; UTILITIES
(declaim (inline identifier?))
(defun identifier? (form)
(and form (symbolp form) (not (keywordp form))))
(deftype identifier () '(satisfies identifier?))
; Make sure that form is one of the following:
; A symbol
; An integer
; A float
; A character
; A string
; A list of zero or more forms that also satisfy ensure-proper-form;
; the list cannot be dotted.
; Return the form.
(defun ensure-proper-form (form)
(labels
((ensure-list-form (form)
(or (null form)
(and (consp form)
(progn
(ensure-proper-form (car form))
(ensure-list-form (cdr form)))))))
(unless
(or (symbolp form)
(integerp form)
(floatp form)
(characterp form)
(stringp form)
(ensure-list-form form))
(error "Bad form: ~S" form))
form))
;;; ------------------------------------------------------------------------------------------------------
;;; TERMINALS
; A terminal is any of the following:
; A symbol that is neither nil nor a keyword
; A string;
; A character;
; An integer.
(defun terminal? (x)
(and x
(or (and (symbolp x) (not (keywordp x)))
(stringp x)
(characterp x)
(integerp x))))
; The following terminals are reserved and may not be used in user input:
; $$ Marker for end of token stream
(defconstant *end-marker* '$$)
(defconstant *end-marker-terminal-number* 0)
(deftype terminal () '(satisfies terminal?))
(deftype user-terminal () `(and terminal (not (eql ,*end-marker*))))
; Emit markup for a terminal. subscript is an optional integer.
(defun depict-terminal (markup-stream terminal &optional subscript)
(cond
((characterp terminal)
(depict-char-style (markup-stream ':character-literal)
(depict-character markup-stream terminal)
(when subscript
(depict-char-style (markup-stream ':plain-subscript)
(depict-integer markup-stream subscript)))))
((and terminal (symbolp terminal))
(let ((name (symbol-name terminal)))
(if (and (> (length name) 0) (char= (char name 0) #\$))
(depict-char-style (markup-stream ':terminal)
(depict markup-stream (subseq (symbol-upper-mixed-case-name terminal) 1))
(when subscript
(depict-char-style (markup-stream ':plain-subscript)
(depict-integer markup-stream subscript))))
(progn
(depict-char-style (markup-stream ':terminal-keyword)
(depict markup-stream (string-downcase name)))
(when subscript
(depict-char-style (markup-stream ':terminal)
(depict-char-style (markup-stream ':plain-subscript)
(depict-integer markup-stream subscript))))))))
(t (error "Don't know how to emit markup for terminal ~S" terminal))))
;;; ------------------------------------------------------------------------------------------------------
;;; NONTERMINAL PARAMETERS
(declaim (inline nonterminal-parameter?))
(defun nonterminal-parameter? (x)
(symbolp x))
(deftype nonterminal-parameter () 'symbol)
; Return true if this nonterminal parameter is a constant.
(declaim (inline nonterminal-attribute?))
(defun nonterminal-attribute? (parameter)
(and (symbolp parameter) (not (keywordp parameter))))
(deftype nonterminal-attribute () '(and symbol (not keyword)))
(defun depict-nonterminal-attribute (markup-stream attribute)
(depict-char-style (markup-stream ':nonterminal)
(depict-char-style (markup-stream ':nonterminal-attribute)
(depict markup-stream (symbol-lower-mixed-case-name attribute)))))
; Return true if this nonterminal parameter is a variable.
(declaim (inline nonterminal-argument?))
(defun nonterminal-argument? (parameter)
(keywordp parameter))
(deftype nonterminal-argument () 'keyword)
(defparameter *special-nonterminal-arguments*
'(:alpha :beta :gamma :delta :epsilon :zeta :eta :theta :iota :kappa :lambda :mu :nu
:xi :omicron :pi :rho :sigma :tau :upsilon :phi :chi :psi :omega))
(defun depict-nonterminal-argument-symbol (markup-stream argument)
(depict-char-style (markup-stream ':nonterminal-argument)
(let ((argument (symbol-abbreviation argument)))
(depict markup-stream
(if (member argument *special-nonterminal-arguments*)
argument
(symbol-upper-mixed-case-name argument))))))
(defun depict-nonterminal-argument (markup-stream argument)
(depict-char-style (markup-stream ':nonterminal)
(depict-nonterminal-argument-symbol markup-stream argument)))
;;; ------------------------------------------------------------------------------------------------------
;;; ATTRIBUTED NONTERMINALS
; An attributed-nonterminal is a specific instantiation of a generic-nonterminal.
(defstruct (attributed-nonterminal (:constructor allocate-attributed-nonterminal (symbol attributes))
(:copier nil)
(:predicate attributed-nonterminal?))
(symbol nil :type keyword :read-only t) ;The name of the attributed nonterminal
(attributes nil :type list :read-only t)) ;Ordered list of nonterminal attributes
; Make an attributed nonterminal with the given symbol and attributes. If there
; are no attributes, return the symbol as a plain nonterminal.
; Nonterminals are eq whenever they have identical symbols and attribute lists.
(defun make-attributed-nonterminal (symbol attributes)
(assert-type symbol keyword)
(assert-type attributes (list nonterminal-attribute))
(if attributes
(let ((generic-nonterminals (get symbol 'generic-nonterminals)))
(or (cdr (assoc attributes generic-nonterminals :test #'equal))
(let ((attributed-nonterminal (allocate-attributed-nonterminal symbol attributes)))
(setf (get symbol 'generic-nonterminals)
(acons attributes attributed-nonterminal generic-nonterminals))
attributed-nonterminal)))
symbol))
(defmethod print-object ((attributed-nonterminal attributed-nonterminal) stream)
(print-unreadable-object (attributed-nonterminal stream)
(format stream "a ~@_~W~{ ~:_~W~}"
(attributed-nonterminal-symbol attributed-nonterminal)
(attributed-nonterminal-attributes attributed-nonterminal))))
;;; ------------------------------------------------------------------------------------------------------
;;; GENERIC NONTERMINALS
; A generic-nonterminal is a parametrized nonterminal that can expand into two or more
; attributed-nonterminals.
(defstruct (generic-nonterminal (:constructor allocate-generic-nonterminal (symbol parameters))
(:copier nil)
(:predicate generic-nonterminal?))
(symbol nil :type keyword :read-only t) ;The name of the generic nonterminal
(parameters nil :type list :read-only t)) ;Ordered list of nonterminal attributes or arguments
; Make a generic nonterminal with the given symbol and parameters. If none of
; the parameters is an argument, make an attributed nonterminal instead. If there
; are no parameters, return the symbol as a plain nonterminal.
; Nonterminals are eq whenever they have identical symbols and parameter lists.
(defun make-generic-nonterminal (symbol parameters)
(assert-type symbol keyword)
(if parameters
(let ((generic-nonterminals (get symbol 'generic-nonterminals)))
(or (cdr (assoc parameters generic-nonterminals :test #'equal))
(progn
(assert-type parameters (list nonterminal-parameter))
(let ((generic-nonterminal (if (every #'nonterminal-attribute? parameters)
(allocate-attributed-nonterminal symbol parameters)
(allocate-generic-nonterminal symbol parameters))))
(setf (get symbol 'generic-nonterminals)
(acons parameters generic-nonterminal generic-nonterminals))
generic-nonterminal))))
symbol))
(defmethod print-object ((generic-nonterminal generic-nonterminal) stream)
(print-unreadable-object (generic-nonterminal stream)
(format stream "g ~@_~W~{ ~:_~W~}"
(generic-nonterminal-symbol generic-nonterminal)
(generic-nonterminal-parameters generic-nonterminal))))
;;; ------------------------------------------------------------------------------------------------------
;;; NONTERMINALS
;;; A nonterminal is a keyword or an attributed-nonterminal.
(declaim (inline nonterminal?))
(defun nonterminal? (x)
(or (keywordp x) (attributed-nonterminal? x)))
; The following nonterminals are reserved and may not be used in user input:
; :% Nonterminal that expands to the start nonterminal
(defconstant *start-nonterminal* :%)
(deftype nonterminal () '(or keyword attributed-nonterminal))
(deftype user-nonterminal () `(and nonterminal (not (eql ,*start-nonterminal*))))
;;; ------------------------------------------------------------------------------------------------------
;;; GENERAL NONTERMINALS
;;; A general-nonterminal is a nonterminal or a generic-nonterminal.
(declaim (inline general-nonterminal?))
(defun general-nonterminal? (x)
(or (nonterminal? x) (generic-nonterminal? x)))
(deftype general-nonterminal () '(or nonterminal generic-nonterminal))
; Return the list of parameters in the general-nonterminal. The list is empty if the
; general-nonterminal is a plain nonterminal.
(defun general-nonterminal-parameters (general-nonterminal)
(cond
((attributed-nonterminal? general-nonterminal) (attributed-nonterminal-attributes general-nonterminal))
((generic-nonterminal? general-nonterminal) (generic-nonterminal-parameters general-nonterminal))
(t (progn
(assert-true (keywordp general-nonterminal))
nil))))
; Emit markup for a general-nonterminal. subscript is an optional integer.
; link should be one of:
; :reference if this is a reference of this general-nonterminal;
; :external if this is an external reference of this general-nonterminal;
; :definition if this is a definition of this general-nonterminal;
; nil if this use of the general-nonterminal should not be cross-referenced.
(defun depict-general-nonterminal (markup-stream general-nonterminal link &optional subscript)
(labels
((depict-nonterminal-name (markup-stream symbol)
(let ((name (symbol-upper-mixed-case-name symbol)))
(depict-link (markup-stream link "N-" name t)
(depict markup-stream name))))
(depict-nonterminal-parameter (markup-stream parameter)
(if (nonterminal-attribute? parameter)
(depict-char-style (markup-stream ':nonterminal-attribute)
(depict markup-stream (symbol-lower-mixed-case-name parameter)))
(depict-nonterminal-argument-symbol markup-stream parameter)))
(depict-parametrized-nonterminal (markup-stream symbol parameters)
(depict-nonterminal-name markup-stream symbol)
(depict-char-style (markup-stream ':superscript)
(depict-list markup-stream #'depict-nonterminal-parameter parameters
:separator ",")))
(depict-general (markup-stream)
(depict-char-style (markup-stream ':nonterminal)
(cond
((keywordp general-nonterminal)
(depict-nonterminal-name markup-stream general-nonterminal))
((attributed-nonterminal? general-nonterminal)
(depict-parametrized-nonterminal markup-stream
(attributed-nonterminal-symbol general-nonterminal)
(attributed-nonterminal-attributes general-nonterminal)))
((generic-nonterminal? general-nonterminal)
(depict-parametrized-nonterminal markup-stream
(generic-nonterminal-symbol general-nonterminal)
(generic-nonterminal-parameters general-nonterminal)))
(t (error "Bad nonterminal ~S" general-nonterminal)))
(when subscript
(depict-char-style (markup-stream ':plain-subscript)
(depict-integer markup-stream subscript))))))
(if (or (eq link :definition)
(and (or (eq link :reference) (eq link :external))
(keywordp general-nonterminal)
(null subscript)))
(depict-link (markup-stream link "N-" (symbol-upper-mixed-case-name (general-grammar-symbol-symbol general-nonterminal)) t)
(setq link nil)
(depict-general markup-stream))
(depict-general markup-stream))))
;;; ------------------------------------------------------------------------------------------------------
;;; GRAMMAR SYMBOLS
;;; A grammar-symbol is either a terminal or a nonterminal.
(deftype grammar-symbol () '(or terminal nonterminal))
(deftype user-grammar-symbol () '(or user-terminal user-nonterminal))
;;; A general-grammar-symbol is either a terminal or a general-nonterminal.
(deftype general-grammar-symbol () '(or terminal general-nonterminal))
; Return true if x is a general-grammar-symbol. x can be any object.
(defun general-grammar-symbol? (x)
(or (terminal? x) (general-nonterminal? x)))
; Return true if the two grammar symbols are the same symbol.
(declaim (inline grammar-symbol-=))
(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)
; Return the general-grammar-symbol's symbol. Return it unchanged if it is not
; an attributed or generic nonterminal.
(defun general-grammar-symbol-symbol (general-grammar-symbol)
(cond
((attributed-nonterminal? general-grammar-symbol) (attributed-nonterminal-symbol general-grammar-symbol))
((generic-nonterminal? general-grammar-symbol) (generic-nonterminal-symbol general-grammar-symbol))
(t (assert-type general-grammar-symbol (or keyword terminal)))))
; Return the list of arguments in the general-grammar-symbol. The list is empty if the
; general-grammar-symbol is not a generic nonterminal.
(defun general-grammar-symbol-arguments (general-grammar-symbol)
(and (generic-nonterminal? general-grammar-symbol)
(remove-if (complement #'nonterminal-argument?) (generic-nonterminal-parameters general-grammar-symbol))))
; Return the general-grammar-symbol expanded into source form that can be interned to yield the same
; general-grammar-symbol.
(defun general-grammar-symbol-source (general-grammar-symbol)
(cond
((attributed-nonterminal? general-grammar-symbol)
(cons (attributed-nonterminal-symbol general-grammar-symbol) (attributed-nonterminal-attributes general-grammar-symbol)))
((generic-nonterminal? general-grammar-symbol)
(cons (generic-nonterminal-symbol general-grammar-symbol) (generic-nonterminal-parameters general-grammar-symbol)))
(t (assert-type general-grammar-symbol (or keyword terminal)))))
; Emit markup for a general-grammar-symbol. subscript is an optional integer.
; link should be one of:
; :reference if this is a reference of this general-grammar-symbol;
; :external if this is an external reference of this general-grammar-symbol;
; :definition if this is a definition of this general-grammar-symbol;
; nil if this use of the general-grammar-symbol should not be cross-referenced.
(defun depict-general-grammar-symbol (markup-stream general-grammar-symbol link &optional subscript)
(if (general-nonterminal? general-grammar-symbol)
(depict-general-nonterminal markup-stream general-grammar-symbol link subscript)
(depict-terminal markup-stream general-grammar-symbol subscript)))
; Styled text can include (:grammar-symbol <grammar-symbol-source> [<subscript>]) as long as
; *styled-text-grammar-parametrization* is bound around the call to depict-styled-text.
(defvar *styled-text-grammar-parametrization*)
(defun depict-grammar-symbol-styled-text (markup-stream grammar-symbol-source &optional subscript)
(depict-general-grammar-symbol markup-stream
(grammar-parametrization-intern *styled-text-grammar-parametrization* grammar-symbol-source)
:reference
subscript))
(setf (styled-text-depictor :grammar-symbol) #'depict-grammar-symbol-styled-text)
;;; ------------------------------------------------------------------------------------------------------
;;; GRAMMAR PARAMETRIZATIONS
; A grammar parametrization holds the rules for converting nonterminal arguments into nonterminal attributes.
(defstruct (grammar-parametrization (:constructor allocate-grammar-parametrization (argument-attributes))
(:predicate grammar-parametrization?))
(argument-attributes nil :type hash-table :read-only t)) ;Hash table of nonterminal-argument -> list of nonterminal-attributes
(defun make-grammar-parametrization ()
(allocate-grammar-parametrization (make-hash-table :test #'eq)))
; Declare that nonterminal arguments with the given name can hold any of the
; given nonterminal attributes given. At least one attribute must be provided.
(defun grammar-parametrization-declare-argument (grammar-parametrization argument attributes)
(assert-type argument nonterminal-argument)
(assert-type attributes (list nonterminal-attribute))
(assert-true attributes)
(when (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))
(error "Duplicate parametrized grammar argument ~S" argument))
(setf (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization)) attributes))
; Return the attributes to which the given argument may expand.
(defun grammar-parametrization-lookup-argument (grammar-parametrization argument)
(assert-non-null (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))))
; Create a plain, attributed, or generic grammar symbol from the specification in grammar-symbol-source.
; If grammar-symbol-source is not a cons, it is a plain grammar symbol. If it is a list, its first element
; must be a keyword that is a nonterminal's symbol and the other elements must be nonterminal
; parameters.
; Return two values:
; the grammar symbol
; a list of arguments used in the grammar symbol.
; If allowed-arguments is given, check that each argument is in the allowed-arguments list;
; if not, allow any arguments declared in grammar-parametrization but do not allow duplicates.
(defun grammar-parametrization-intern (grammar-parametrization grammar-symbol-source &optional (allowed-arguments nil allow-duplicates))
(if (consp grammar-symbol-source)
(progn
(assert-type grammar-symbol-source (cons keyword (list nonterminal-parameter)))
(let* ((symbol (car grammar-symbol-source))
(parameters (cdr grammar-symbol-source))
(arguments (remove-if (complement #'nonterminal-argument?) parameters)))
(mapl #'(lambda (arguments)
(let ((argument (car arguments)))
(if allow-duplicates
(unless (member argument allowed-arguments :test #'eq)
(error "Undefined nonterminal argument ~S" argument))
(progn
(unless (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))
(error "Undeclared nonterminal argument ~S" argument))
(when (member argument (cdr arguments) :test #'eq)
(error "Duplicate nonterminal argument ~S" argument))))))
arguments)
(values (make-generic-nonterminal symbol parameters) arguments)))
(values (assert-type grammar-symbol-source (or keyword terminal)) nil)))
; Call f on each possible binding permutation of the given arguments concatenated with the bindings in
; bound-argument-alist. f takes one argument, an association list that maps arguments to attributes.
(defun grammar-parametrization-each-permutation (grammar-parametrization f arguments &optional bound-argument-alist)
(if arguments
(let ((argument (car arguments))
(rest-arguments (cdr arguments)))
(dolist (attribute (grammar-parametrization-lookup-argument grammar-parametrization argument))
(grammar-parametrization-each-permutation grammar-parametrization f rest-arguments (acons argument attribute bound-argument-alist))))
(funcall f bound-argument-alist)))
; If general-grammar-symbol is a generic-nonterminal, return one possible binding permutation of its arguments;
; otherwise return nil.
(defun nonterminal-sample-bound-argument-alist (grammar-parametrization general-grammar-symbol)
(when (generic-nonterminal? general-grammar-symbol)
(grammar-parametrization-each-permutation
grammar-parametrization
#'(lambda (bound-argument-alist) (return-from nonterminal-sample-bound-argument-alist bound-argument-alist))
(general-grammar-symbol-arguments general-grammar-symbol))))
; If the grammar symbol is a generic nonterminal, convert it into an attributed nonterminal
; by instantiating its arguments with the corresponding attributes from the bound-argument-alist.
; If the grammar symbol is already an attributed or plain nonterminal, return it unchanged.
(defun instantiate-general-grammar-symbol (bound-argument-alist general-grammar-symbol)
(if (generic-nonterminal? general-grammar-symbol)
(make-attributed-nonterminal
(generic-nonterminal-symbol general-grammar-symbol)
(mapcar #'(lambda (parameter)
(if (nonterminal-argument? parameter)
(let ((binding (assoc parameter bound-argument-alist :test #'eq)))
(if binding
(cdr binding)
(error "Unbound nonterminal argument ~S" parameter)))
parameter))
(generic-nonterminal-parameters general-grammar-symbol)))
(assert-type general-grammar-symbol grammar-symbol)))
; If the grammar symbol is a generic nonterminal parametrized on argument, substitute
; attribute for argument in it and return the modified grammar symbol. Otherwise, return it unchanged.
(defun general-grammar-symbol-substitute (attribute argument general-grammar-symbol)
(assert-type attribute nonterminal-attribute)
(assert-type argument nonterminal-argument)
(if (and (generic-nonterminal? general-grammar-symbol)
(member argument (generic-nonterminal-parameters general-grammar-symbol) :test #'eq))
(make-generic-nonterminal
(generic-nonterminal-symbol general-grammar-symbol)
(substitute attribute argument (generic-nonterminal-parameters general-grammar-symbol) :test #'eq))
(assert-type general-grammar-symbol general-grammar-symbol)))
; If the general grammar symbol is a generic nonterminal, return a list of all possible attributed nonterminals
; that can be instantiated from it; otherwise, return a one-element list containing the given general grammar symbol.
(defun general-grammar-symbol-instances (grammar-parametrization general-grammar-symbol)
(if (generic-nonterminal? general-grammar-symbol)
(let ((instances nil))
(grammar-parametrization-each-permutation
grammar-parametrization
#'(lambda (bound-argument-alist)
(push (instantiate-general-grammar-symbol bound-argument-alist general-grammar-symbol) instances))
(general-grammar-symbol-arguments general-grammar-symbol))
(nreverse instances))
(list (assert-type general-grammar-symbol grammar-symbol))))
; Return true if grammar-symbol can be obtained by calling instantiate-general-grammar-symbol on
; general-grammar-symbol.
(defun general-nonterminal-is-instance? (grammar-parametrization general-grammar-symbol grammar-symbol)
(or (grammar-symbol-= general-grammar-symbol grammar-symbol)
(and (generic-nonterminal? general-grammar-symbol)
(attributed-nonterminal? grammar-symbol)
(let ((parameters (generic-nonterminal-parameters general-grammar-symbol))
(attributes (attributed-nonterminal-attributes grammar-symbol)))
(and (= (length parameters) (length attributes))
(every #'(lambda (parameter attribute)
(or (eq parameter attribute)
(and (nonterminal-argument? parameter)
(member attribute (grammar-parametrization-lookup-argument grammar-parametrization parameter) :test #'eq))))
parameters
attributes))))))