зеркало из https://github.com/mozilla/pjs.git
484 строки
22 KiB
Common Lisp
484 строки
22 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)
|
||
|
|
(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.
|
||
|
|
(defun depict-general-nonterminal (markup-stream general-nonterminal &optional subscript)
|
||
|
|
(depict-char-style (markup-stream ':nonterminal)
|
||
|
|
(labels
|
||
|
|
((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 (symbol parameters)
|
||
|
|
(depict markup-stream (symbol-upper-mixed-case-name symbol))
|
||
|
|
(depict-char-style (markup-stream ':superscript)
|
||
|
|
(depict-list markup-stream #'depict-nonterminal-parameter parameters
|
||
|
|
:separator ","))))
|
||
|
|
|
||
|
|
(cond
|
||
|
|
((keywordp general-nonterminal)
|
||
|
|
(depict markup-stream (symbol-upper-mixed-case-name general-nonterminal)))
|
||
|
|
((attributed-nonterminal? general-nonterminal)
|
||
|
|
(depict-parametrized-nonterminal (attributed-nonterminal-symbol general-nonterminal)
|
||
|
|
(attributed-nonterminal-attributes general-nonterminal)))
|
||
|
|
((generic-nonterminal? general-nonterminal)
|
||
|
|
(depict-parametrized-nonterminal (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))))))
|
||
|
|
|
||
|
|
|
||
|
|
;;; ------------------------------------------------------------------------------------------------------
|
||
|
|
;;; 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 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))))
|
||
|
|
|
||
|
|
|
||
|
|
; Emit markup for a general-grammar-symbol. subscript is an optional integer.
|
||
|
|
(defun depict-general-grammar-symbol (markup-stream general-grammar-symbol &optional subscript)
|
||
|
|
(if (general-nonterminal? general-grammar-symbol)
|
||
|
|
(depict-general-nonterminal markup-stream general-grammar-symbol subscript)
|
||
|
|
(depict-terminal markup-stream general-grammar-symbol subscript)))
|
||
|
|
|
||
|
|
|
||
|
|
;;; ------------------------------------------------------------------------------------------------------
|
||
|
|
;;; 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 grammar-symbol-source 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))))))
|