8e45aace13
Used http://wcp.sdf-eu.org/software/npg-20150517T144652.tbz (sha256 42e88f6067128fbdb3a3d578371c9b0ee2a34f1d36daf80be8a520094132d828). There's no upstream repository nor a release since 2015, so importing seems to make a lot of sense. Since we can't subtree making any depot-related changes in a separate CL -- this is only the source import. Change-Id: I64c984ca0a84b9e48c6f496577ffccce1d7bdceb Reviewed-on: https://cl.tvl.fyi/c/depot/+/3377 Tested-by: BuildkiteCI Reviewed-by: grfn <grfn@gws.fyi>
1901 lines
50 KiB
Common Lisp
1901 lines
50 KiB
Common Lisp
;;; vs-cobol-ii.lisp --- sample grammar for VS-Cobol II
|
|
|
|
;;; Copyright (C) 2003 by Walter C. Pelissero
|
|
|
|
;;; Author: Walter C. Pelissero <walter@pelissero.de>
|
|
;;; Project: NPG a Naive Parser Generator
|
|
;;; $Id: F-1D03709AEB30BA7644C1CFA2DF60FE8C.lisp,v 1.2 2004/03/09 10:33:07 wcp Exp $
|
|
|
|
;;; This library is free software; you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Lesser General Public License
|
|
;;; as published by the Free Software Foundation; either version 2.1
|
|
;;; of the License, or (at your option) any later version.
|
|
;;; This library is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;; Lesser General Public License for more details.
|
|
;;; You should have received a copy of the GNU Lesser General Public
|
|
;;; License along with this library; if not, write to the Free
|
|
;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
|
|
;;; 02111-1307 USA
|
|
|
|
;;; Commentary:
|
|
;;;
|
|
;;; A fairly incomplete VS-Cobol II grammar fro NPG. It's probably
|
|
;;; not very accurate either.
|
|
|
|
#+cmu (ext:file-comment "$Id: F-1D03709AEB30BA7644C1CFA2DF60FE8C.lisp,v 1.2 2004/03/09 10:33:07 wcp Exp $")
|
|
|
|
(in-package :grammar)
|
|
|
|
(defun make-keyword (string)
|
|
"Create a keyword from STRING."
|
|
(intern (string-upcase string) :keyword))
|
|
|
|
(defun flatten-list (list)
|
|
"Remove one depth level in LIST."
|
|
(mapcan #'identity list))
|
|
|
|
(deflazy define-grammar
|
|
(let ((*package* #.*package*)
|
|
(*compile-print* (and parser::*debug* t)))
|
|
(reset-grammar)
|
|
(format t "creating Cobol grammar...~%")
|
|
(populate-grammar)
|
|
(let ((grammar (parser:generate-grammar)))
|
|
(reset-grammar)
|
|
(parser:print-grammar-figures grammar)
|
|
grammar)))
|
|
|
|
(defun populate-grammar ()
|
|
;;;
|
|
;;; Hereafter PP means Partial Program
|
|
;;;
|
|
|
|
#+nil
|
|
(defrule pp--declarations
|
|
:= identification-division environment-division? data-division? "PROCEDURE" "DIVISION" using-phrase? "." :rest)
|
|
|
|
;;; We need to split the parsing of the declarations from the rest
|
|
;;; because the declarations may change the lexical rules (ie decimal
|
|
;;; point)
|
|
|
|
(defrule pp--declarations
|
|
:= identification-division environment-division? data-division-head-or-procedure-division-head :rest)
|
|
|
|
(defrule data-division-head-or-procedure-division-head
|
|
:= data-division-head
|
|
:reduce :data-division
|
|
:= procedure-division-head
|
|
:reduce (list :procedure-division $1))
|
|
|
|
(defrule pp--data-division
|
|
:= data-division-content procedure-division-head :rest)
|
|
|
|
(defrule pp--sentence
|
|
:= sentence :rest
|
|
:= :eof)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; The real grammar
|
|
;;;
|
|
|
|
(defrule cobol-source-program
|
|
:= identification-division environment-division? data-division procedure-division end-program?)
|
|
|
|
(defrule identification-division
|
|
:= identification "DIVISION" "." program-id-cobol-source-program identification-division-content
|
|
:reduce program-id-cobol-source-program)
|
|
|
|
(defrule priority-number
|
|
:= integer)
|
|
|
|
(defrule level-number
|
|
:= integer)
|
|
|
|
(defrule to-id-or-lit
|
|
:= "TO" id-or-lit)
|
|
|
|
(defrule inspect-by-argument
|
|
:= variable-identifier
|
|
:= string
|
|
:= figurative-constant-simple)
|
|
|
|
(defrule figurative-constant-simple
|
|
:= "ZERO"
|
|
:reduce :zero
|
|
:= "ZEROS"
|
|
:reduce :zero
|
|
:= "ZEROES"
|
|
:reduce :zero
|
|
:= "SPACE"
|
|
:reduce :space
|
|
:= "SPACES"
|
|
:reduce :space
|
|
:= "HIGH-VALUE"
|
|
:reduce :high
|
|
:= "HIGH-VALUES"
|
|
:reduce :high
|
|
:= "LOW-VALUE"
|
|
:reduce :low
|
|
:= "LOW-VALUES"
|
|
:reduce :low
|
|
:= "QUOTE"
|
|
:reduce :quote
|
|
:= "QUOTES"
|
|
:reduce :quote
|
|
:= "NULL"
|
|
:reduce :null
|
|
:= "NULLS"
|
|
:reduce :null)
|
|
|
|
(defrule write-exceptions
|
|
:= at-end-of-page-statement-list? not-at-end-of-page-statement-list? invalid-key-statement-list? not-invalid-key-statement-list?)
|
|
|
|
(defrule set-statement-phrase
|
|
:= variable-identifier+ set-oper set-src)
|
|
|
|
(defrule set-src
|
|
:= variable-identifier
|
|
:= literal
|
|
:= "TRUE"
|
|
:= "ON"
|
|
:= "OFF")
|
|
|
|
(defrule set-oper
|
|
:= "TO"
|
|
:reduce :to
|
|
:= "UP" "BY"
|
|
:reduce :up
|
|
:= "DOWN" "BY"
|
|
:reduce :down)
|
|
|
|
(defrule fce-phrase
|
|
:= reserve-clause
|
|
:= fce-organization
|
|
:= fce-access-mode
|
|
:= record-key-clause
|
|
:= password-clause
|
|
:= alternate-record-key-clause
|
|
:= file-status-clause
|
|
:= padding-character-clause
|
|
:= record-delimiter-clause)
|
|
|
|
(defrule fce-organization
|
|
:= organization-is? alt-indexed-relative-sequential
|
|
:reduce (list :organization (make-keyword alt-indexed-relative-sequential)))
|
|
|
|
(defrule fce-access-mode
|
|
:= "ACCESS" "MODE"? "IS"? alt-sequential-random-dynamic relative-key-clause?
|
|
:reduce (list :access-mode (make-keyword alt-sequential-random-dynamic)))
|
|
|
|
(defrule alt-indexed-relative-sequential
|
|
:= "INDEXED"
|
|
:= "RELATIVE"
|
|
:= "SEQUENTIAL")
|
|
|
|
(defrule is-not
|
|
:= "IS"? "NOT"?)
|
|
|
|
(defrule all-procedures
|
|
:= "ALL" "PROCEDURES")
|
|
|
|
(defrule next-sentence
|
|
:= "NEXT" "SENTENCE")
|
|
|
|
(defrule no-rewind
|
|
:= "NO" "REWIND")
|
|
|
|
(defrule for-removal
|
|
:= "FOR"? "REMOVAL")
|
|
|
|
(defrule values
|
|
:= "VALUE"
|
|
:= "VALUES")
|
|
|
|
(defrule records
|
|
:= "RECORD"
|
|
:= "RECORDS")
|
|
|
|
(defrule end-program
|
|
:= "END" "PROGRAM" program-name ".")
|
|
|
|
(defrule environment-division
|
|
:= "ENVIRONMENT" "DIVISION" "." environment-division-content)
|
|
|
|
(defrule data-division-head
|
|
:= "DATA" "DIVISION" ".")
|
|
|
|
(defrule data-division
|
|
:= data-division-head data-division-content
|
|
:reduce data-division-content)
|
|
|
|
(defrule identification
|
|
:= "IDENTIFICATION"
|
|
:= "ID")
|
|
|
|
(defrule identification-division-content
|
|
:= identification-division-phrase*)
|
|
|
|
(defrule author
|
|
:= "AUTHOR" ".")
|
|
|
|
(defrule installation
|
|
:= "INSTALLATION" ".")
|
|
|
|
(defrule date-written
|
|
:= "DATE-WRITTEN" ".")
|
|
|
|
(defrule date-compiled
|
|
:= "DATE-COMPILED" ".")
|
|
|
|
(defrule security
|
|
:= "SECURITY" ".")
|
|
|
|
(defrule remarks
|
|
:= "REMARKS" ".")
|
|
|
|
(defrule identification-division-phrase
|
|
:= author
|
|
:= installation
|
|
:= date-written
|
|
:= date-compiled
|
|
:= security
|
|
:= remarks)
|
|
|
|
(defrule program-id-cobol-source-program
|
|
:= "PROGRAM-ID" "."? program-name initial-program? "."
|
|
:reduce program-name)
|
|
|
|
(defrule initial-program
|
|
:= "IS"? "INITIAL" "PROGRAM"?)
|
|
|
|
(defrule environment-division-content
|
|
:= configuration-section? input-output-section?)
|
|
|
|
(defrule input-output-section
|
|
:= "INPUT-OUTPUT" "SECTION" "." file-control-paragraph? i-o-control-paragraph?
|
|
:reduce file-control-paragraph)
|
|
|
|
(defrule file-control-paragraph
|
|
:= "FILE-CONTROL" "." file-control-entry*)
|
|
|
|
(defrule file-control-entry
|
|
:= select-clause assign-clause fce-phrase* "."
|
|
:reduce (append select-clause
|
|
assign-clause
|
|
(flatten-list fce-phrase)))
|
|
|
|
(defrule organization-is
|
|
:= "ORGANIZATION" "IS"?)
|
|
|
|
(defrule alt-sequential-random-dynamic
|
|
:= "SEQUENTIAL"
|
|
:= "RANDOM"
|
|
:= "DYNAMIC")
|
|
|
|
(defrule select-clause
|
|
:= "SELECT" "OPTIONAL"? file-name
|
|
:reduce (list file-name :optional (and $2 t)))
|
|
|
|
(defrule assign-clause
|
|
:= "ASSIGN" "TO"? alt-assignment-name-literal+
|
|
:reduce (list :assign alt-assignment-name-literal))
|
|
|
|
(defrule alt-assignment-name-literal
|
|
:= assignment-name
|
|
:= literal)
|
|
|
|
(defrule reserve-clause
|
|
:= "RESERVE" integer areas?)
|
|
|
|
(defrule areas
|
|
:= "AREA"
|
|
:= "AREAS")
|
|
|
|
(defrule padding-character-clause
|
|
:= "PADDING" "CHARACTER"? "IS"? alt-qualified-data-name-literal)
|
|
|
|
(defrule record-delimiter-clause
|
|
:= "RECORD" "DELIMITER" "IS"? record-delimiter-name)
|
|
|
|
(defrule record-delimiter-name
|
|
:= "STANDARD-1"
|
|
:= assignment-name)
|
|
|
|
(defrule password-clause
|
|
:= "PASSWORD" "IS"? data-name)
|
|
|
|
(defrule file-status-clause
|
|
:= "FILE"? "STATUS" "IS"? qualified-data-name qualified-data-name?
|
|
:reduce (list :file-status qualified-data-name))
|
|
|
|
(defrule relative-key-clause
|
|
:= "RELATIVE" "KEY"? "IS"? qualified-data-name
|
|
:reduce (list :relative-key qualified-data-name))
|
|
|
|
(defrule record-key-clause
|
|
:= "RECORD" "KEY"? "IS"? qualified-data-name
|
|
:reduce (list :key qualified-data-name))
|
|
|
|
(defrule alternate-record-key-clause
|
|
:= "ALTERNATE" "RECORD"? "KEY"? "IS"? qualified-data-name password-clause? with-duplicates?
|
|
:reduce (list :alternate-key qualified-data-name with-duplicates))
|
|
|
|
(defrule with-duplicates
|
|
:= "WITH"? "DUPLICATES")
|
|
|
|
(defrule i-o-control-paragraph
|
|
:= "I-O-CONTROL" "." i-o-sam? i-o-sort-merge?)
|
|
|
|
(defrule i-o-sam
|
|
:= qsam-or-sam-or-vsam-i-o-control-entries+ ".")
|
|
|
|
(defrule i-o-sort-merge
|
|
:= sort-merge-i-o-control-entries ".")
|
|
|
|
(defrule qsam-or-sam-or-vsam-i-o-control-entries
|
|
:= qsam-or-sam-or-vsam-i-o-control-entries-1
|
|
:= qsam-or-sam-or-vsam-i-o-control-entries-2
|
|
:= qsam-or-sam-or-vsam-i-o-control-entries-3
|
|
:= qsam-or-sam-or-vsam-i-o-control-entries-4)
|
|
|
|
(defrule qsam-or-sam-or-vsam-i-o-control-entries-1
|
|
:= "RERUN" "ON" alt-assignment-name-file-name "EVERY"? every-phrase "OF"? file-name)
|
|
|
|
(defrule every-phrase-1
|
|
:= integer "RECORDS")
|
|
|
|
(defrule every-phrase-2
|
|
:= "END" "OF"? alt-reel-unit)
|
|
|
|
(defrule every-phrase
|
|
:= every-phrase-1
|
|
:= every-phrase-2)
|
|
|
|
(defrule alt-assignment-name-file-name
|
|
:= assignment-name
|
|
:= file-name)
|
|
|
|
(defrule qsam-or-sam-or-vsam-i-o-control-entries-2
|
|
:= "SAME" "RECORD"? "AREA"? "FOR"? file-name file-name+)
|
|
|
|
(defrule qsam-or-sam-or-vsam-i-o-control-entries-3
|
|
:= "MULTIPLE" "FILE" "TAPE"? "CONTAINS"? file-name-position+)
|
|
|
|
(defrule position
|
|
:= "POSITION" integer)
|
|
|
|
(defrule file-name-position
|
|
:= file-name position?)
|
|
|
|
(defrule qsam-or-sam-or-vsam-i-o-control-entries-4
|
|
:= "APPLY" "WRITE-ONLY" "ON"? file-name+)
|
|
|
|
(defrule sort-merge-i-o-control-entries
|
|
:= rerun-on? same-area+)
|
|
|
|
(defrule rerun-on
|
|
:= "RERUN" "ON" assignment-name)
|
|
|
|
(defrule record-sort
|
|
:= "RECORD"
|
|
:= "SORT"
|
|
:= "SORT-MERGE")
|
|
|
|
(defrule same-area
|
|
:= "SAME" record-sort "AREA"? "FOR"? file-name file-name+)
|
|
|
|
(defrule configuration-section
|
|
:= "CONFIGURATION" "SECTION" "." configuration-section-paragraph*
|
|
:reduce (flatten-list configuration-section-paragraph))
|
|
|
|
(defrule configuration-section-paragraph
|
|
:= source-computer-paragraph
|
|
:= object-computer-paragraph
|
|
:= special-names-paragraph)
|
|
|
|
(defrule source-computer-paragraph
|
|
:= "SOURCE-COMPUTER" "." source-computer-name
|
|
:reduce (list :source-computer source-computer-name))
|
|
|
|
(defrule with-debugging-mode
|
|
:= "WITH"? "DEBUGGING" "MODE")
|
|
|
|
(defrule source-computer-name
|
|
:= computer-name with-debugging-mode? "."
|
|
:reduce computer-name)
|
|
|
|
(defrule object-computer-paragraph
|
|
:= "OBJECT-COMPUTER" "." object-computer-name
|
|
:reduce (list :object-computer object-computer-name))
|
|
|
|
(defrule memory-size-type
|
|
:= "WORDS"
|
|
:= "CHARACTERS"
|
|
:= "MODULES")
|
|
|
|
(defrule memory-size
|
|
:= "MEMORY" "SIZE"? integer memory-size-type)
|
|
|
|
(defrule object-computer-name
|
|
:= computer-name memory-size? object-computer-paragraph-sequence-phrase "."
|
|
:reduce computer-name)
|
|
|
|
(defrule object-computer-paragraph-sequence-phrase
|
|
:= program-collating-sequence? segment-limit?)
|
|
|
|
(defrule program-collating-sequence
|
|
:= "PROGRAM"? "COLLATING"? "SEQUENCE" "IS"? alphabet-name)
|
|
|
|
(defrule segment-limit
|
|
:= "SEGMENT-LIMIT" "IS"? priority-number)
|
|
|
|
(defrule special-names-paragraph
|
|
:= "SPECIAL-NAMES" "." special-names-paragraph-phrase* special-names-paragraph-clause* "."
|
|
:reduce (flatten-list special-names-paragraph-clause))
|
|
|
|
(defrule is-mnemonic-name
|
|
:= "IS"? mnemonic-name special-names-paragraph-status-phrase?)
|
|
|
|
(defrule special-names-paragraph-phrase-tail
|
|
:= is-mnemonic-name
|
|
:= special-names-paragraph-status-phrase)
|
|
|
|
(defrule special-names-paragraph-phrase
|
|
:= environment-name special-names-paragraph-phrase-tail)
|
|
|
|
(defrule special-names-paragraph-status-phrase
|
|
:= special-names-paragraph-status-phrase-1
|
|
:= special-names-paragraph-status-phrase-2)
|
|
|
|
(defrule special-names-paragraph-status-phrase-1
|
|
:= "ON" "STATUS"? "IS"? condition off-status?)
|
|
|
|
(defrule off-status
|
|
:= "OFF" "STATUS"? "IS"? condition)
|
|
|
|
(defrule special-names-paragraph-status-phrase-2
|
|
:= "OFF" "STATUS"? "IS"? condition on-status?)
|
|
|
|
(defrule on-status
|
|
:= "ON" "STATUS"? "IS"? condition)
|
|
|
|
(defrule special-names-paragraph-clause
|
|
;; := alphabet-clause
|
|
;; := symbolic-characters-clause
|
|
:= currency-sign-clause
|
|
:= decimal-point-clause)
|
|
|
|
(defrule alphabet-clause
|
|
:= "ALPHABET" alphabet-name "IS"? alphabet-type)
|
|
|
|
(defrule alphabet-type-also
|
|
:= "ALSO" literal)
|
|
|
|
(defrule alphabet-type-alsos
|
|
:= alphabet-type-also+)
|
|
|
|
(defrule alphabet-type-also-through
|
|
:= through-literal
|
|
:= alphabet-type-alsos)
|
|
|
|
(defrule alphabet-type-other
|
|
:= literal alphabet-type-also-through?)
|
|
|
|
(defrule alphabet-type-others
|
|
:= alphabet-type-other+)
|
|
|
|
(defrule alphabet-type
|
|
:= "STANDARD-1"
|
|
:= "STANDARD-2"
|
|
:= "NATIVE"
|
|
:= "EBCDIC"
|
|
:= alphabet-type-others)
|
|
|
|
(defrule symbolic-characters-clause
|
|
:= "SYMBOLIC" "CHARACTERS"? symbolic-character-mapping+ in-alphabet-name?)
|
|
|
|
(defrule are
|
|
:= "ARE"
|
|
:= "IS")
|
|
|
|
(defrule symbolic-character-mapping
|
|
:= symbolic-character+ are? integer+)
|
|
|
|
(defrule in-alphabet-name
|
|
:= "IN" alphabet-name)
|
|
|
|
(defrule currency-sign-clause
|
|
:= "CURRENCY" "SIGN"? "IS"? literal
|
|
:reduce (list :currency-sign literal))
|
|
|
|
(defrule decimal-point-clause
|
|
:= "DECIMAL-POINT" "IS"? "COMMA"
|
|
:reduce (list :decimal-point #\,))
|
|
|
|
(defrule data-division-content
|
|
:= file-section? working-storage-section? linkage-section?)
|
|
|
|
(defrule file-section-entry
|
|
:= file-and-sort-description-entry data-description-entry+
|
|
:reduce (cons file-and-sort-description-entry data-description-entry))
|
|
|
|
(defrule file-section-head
|
|
:= "FILE" "SECTION" ".")
|
|
|
|
(defrule file-section
|
|
:= file-section-head file-section-entry*
|
|
:reduce $2)
|
|
|
|
(defrule working-storage-section-head
|
|
:= "WORKING-STORAGE" "SECTION" ".")
|
|
|
|
(defrule working-storage-section
|
|
:= working-storage-section-head data-description-entry*
|
|
:reduce $2)
|
|
|
|
(defrule linkage-section-head
|
|
:= "LINKAGE" "SECTION" ".")
|
|
|
|
(defrule linkage-section
|
|
:= linkage-section-head data-description-entry*
|
|
:reduce $2)
|
|
|
|
(defrule file-and-sort-description-entry
|
|
:= alt-fd-sd file-name file-and-sort-description-entry-clause* "."
|
|
:reduce (list (make-keyword alt-fd-sd) file-name file-and-sort-description-entry-clause))
|
|
|
|
(defrule alt-fd-sd
|
|
:= "FD"
|
|
:= "SD")
|
|
|
|
(defrule file-and-sort-description-entry-clause
|
|
:= external-clause
|
|
:= global-clause
|
|
:= block-contains-clause
|
|
:= record-clause
|
|
:= label-records-clause
|
|
:= value-of-clause
|
|
:= data-records-clause
|
|
:= linage-clause
|
|
:= recording-mode-clause
|
|
:= code-set-clause)
|
|
|
|
(defrule integer-to
|
|
:= integer "TO")
|
|
|
|
(defrule block-contains-clause
|
|
:= "BLOCK" "CONTAINS"? integer-to? integer alt-characters-records?)
|
|
|
|
(defrule alt-characters-records
|
|
:= "CHARACTERS"
|
|
:= "RECORDS"
|
|
:= "RECORD")
|
|
|
|
(defrule record-clause
|
|
:= "RECORD" record-clause-tail)
|
|
|
|
(defrule depending-on
|
|
:= "DEPENDING" "ON"? data-name)
|
|
|
|
(defrule record-clause-tail-1
|
|
:= "CONTAINS"? integer "CHARACTERS"?)
|
|
|
|
(defrule record-clause-tail-2
|
|
:= "CONTAINS"? integer "TO" integer "CHARACTERS"?)
|
|
|
|
(defrule record-clause-tail-3
|
|
:= record-varying-phrase depending-on?)
|
|
|
|
(defrule record-clause-tail
|
|
:= record-clause-tail-2
|
|
:= record-clause-tail-1
|
|
:= record-clause-tail-3)
|
|
|
|
(defrule record-varying-phrase
|
|
:= "IS"? "VARYING" "IN"? "SIZE"? from-integer? to-integer? "CHARACTERS"?)
|
|
|
|
(defrule from-integer
|
|
:= "FROM"? integer)
|
|
|
|
(defrule to-integer
|
|
:= "TO" integer)
|
|
|
|
(defrule label-records-clause
|
|
:= "LABEL" records-are label-records-clause-tail
|
|
:reduce (list :label-record label-records-clause-tail))
|
|
|
|
(defrule data-names
|
|
:= data-name+)
|
|
|
|
(defrule label-records-clause-tail
|
|
:= "STANDARD" :reduce :standard
|
|
:= "OMITTED" :reduce :omitted
|
|
:= data-names)
|
|
|
|
(defrule value-of-clause
|
|
:= "VALUE" "OF" value-of-clause-tail+)
|
|
|
|
(defrule alt-qualified-data-name-literal
|
|
:= qualified-data-name
|
|
:= literal)
|
|
|
|
(defrule value-of-clause-tail
|
|
:= variable-identifier "IS"? alt-qualified-data-name-literal)
|
|
|
|
(defrule data-records-clause
|
|
:= "DATA" records-are data-name+)
|
|
|
|
(defrule records-are
|
|
:= records are?)
|
|
|
|
(defrule linage-clause
|
|
:= "LINAGE" "IS"? alt-data-name-integer "LINES"? linage-footing-phrase)
|
|
|
|
(defrule linage-footing-phrase
|
|
:= footing? lines-top? lines-bottom?)
|
|
|
|
(defrule alt-data-name-integer
|
|
:= data-name
|
|
:= integer)
|
|
|
|
(defrule footing
|
|
:= "WITH"? "FOOTING" "AT"? alt-data-name-integer)
|
|
|
|
(defrule lines-top
|
|
:= "LINES"? "AT"? "TOP" alt-data-name-integer)
|
|
|
|
(defrule lines-bottom
|
|
:= "LINES"? "AT"? "BOTTOM" alt-data-name-integer)
|
|
|
|
(defrule recording-mode-clause
|
|
:= "RECORDING" "MODE"? "IS"? variable-identifier)
|
|
|
|
(defrule code-set-clause
|
|
:= "CODE-SET" "IS"? alphabet-name)
|
|
|
|
(defrule data-description-entry
|
|
:= level-number alt-data-name-filler? data-description-entry-clause* "."
|
|
:reduce (append (list level-number alt-data-name-filler)
|
|
(flatten-list data-description-entry-clause)))
|
|
|
|
(defrule alt-data-name-filler
|
|
:= data-name
|
|
:= "FILLER"
|
|
:reduce (list))
|
|
|
|
(defrule data-description-entry-clause
|
|
:= picture-clause
|
|
:= redefines-clause
|
|
:= blank-when-zero-clause
|
|
:= external-clause
|
|
:= global-clause
|
|
:= justified-clause
|
|
:= occurs-clause
|
|
:= sign-clause
|
|
:= synchronized-clause
|
|
:= usage-clause
|
|
:= renames-clause
|
|
:= value-clause)
|
|
|
|
(defrule value-clause
|
|
:= "VALUE" "IS"? literal
|
|
:reduce (list :value literal))
|
|
|
|
(defrule redefines-clause
|
|
:= "REDEFINES" data-name
|
|
:reduce `(:redefines ,data-name))
|
|
|
|
(defrule blank-when-zero-clause
|
|
:= "BLANK" "WHEN"? zeroes
|
|
:reduce '(:blank-when-zero t))
|
|
|
|
(defrule zeroes
|
|
:= "ZERO"
|
|
:= "ZEROS"
|
|
:= "ZEROES")
|
|
|
|
(defrule external-clause
|
|
:= "IS"? "EXTERNAL"
|
|
:reduce '(:external t))
|
|
|
|
(defrule global-clause
|
|
:= "IS"? "GLOBAL"
|
|
:reduce '(:global t))
|
|
|
|
(defrule justified-clause
|
|
:= justified "RIGHT"?
|
|
:reduce `(:justified ,(if $2 :right :left)))
|
|
|
|
(defrule justified
|
|
:= "JUSTIFIED"
|
|
:= "JUST")
|
|
|
|
(defrule occurs-clause
|
|
:= "OCCURS" integer "TIMES"? occurs-clause-key* indexed-by?
|
|
;; to be completed -wcp16/7/03.
|
|
:reduce `(:times ,integer)
|
|
:= "OCCURS" integer "TO" integer "TIMES"? "DEPENDING" "ON"? qualified-data-name occurs-clause-key* indexed-by?
|
|
;; to be completed -wcp16/7/03.
|
|
:reduce `(:times (,integer ,integer2 ,qualified-data-name)))
|
|
|
|
(defrule occurs-clause-key
|
|
:= alt-ascending-descending "KEY"? "IS"? qualified-data-name+)
|
|
|
|
(defrule indexed-by
|
|
:= "INDEXED" "BY"? index-name+)
|
|
|
|
(defrule picture-clause
|
|
:= picture "IS"? picture-string
|
|
:reduce `(:picture ,picture-string))
|
|
|
|
(defrule picture
|
|
:= "PICTURE"
|
|
:= "PIC")
|
|
|
|
(defrule sign-clause
|
|
:= sign-is? alt-leading-trailing separate-character?
|
|
:reduce `(:separate-sign ,separate-character :sign-position ,alt-leading-trailing))
|
|
|
|
(defrule sign-is
|
|
:= "SIGN" "IS"?)
|
|
|
|
(defrule separate-character
|
|
:= "SEPARATE" "CHARACTER"?
|
|
:reduce t)
|
|
|
|
(defrule alt-leading-trailing
|
|
:= "LEADING"
|
|
:reduce :leading
|
|
:= "TRAILING"
|
|
:reduce :trailing)
|
|
|
|
(defrule synchronized-clause
|
|
:= synchronized alt-left-right?
|
|
:reduce `(:synchronized ,(if alt-left-right
|
|
alt-left-right
|
|
t)))
|
|
|
|
(defrule alt-left-right
|
|
:= "LEFT"
|
|
:reduce :left
|
|
:= "RIGHT"
|
|
:reduce :right)
|
|
|
|
(defrule synchronized
|
|
:= "SYNCHRONIZED"
|
|
:= "SYNC")
|
|
|
|
(defrule usage-clause
|
|
:= usage-is? usage
|
|
:reduce (list :encoding usage))
|
|
|
|
(defrule usage-is
|
|
:= "USAGE" "IS"?)
|
|
|
|
(defrule usage
|
|
:= "BINARY"
|
|
:reduce :binary
|
|
:= "COMP"
|
|
:reduce :comp
|
|
:= "COMP-1"
|
|
:reduce :comp1
|
|
:= "COMP-2"
|
|
:reduce :comp2
|
|
:= "COMP-3"
|
|
:reduce :comp3
|
|
:= "COMP-4"
|
|
:reduce :comp4
|
|
:= "COMPUTATIONAL"
|
|
:reduce :comp
|
|
:= "COMPUTATIONAL-1"
|
|
:reduce :comp1
|
|
:= "COMPUTATIONAL-2"
|
|
:reduce :comp2
|
|
:= "COMPUTATIONAL-3"
|
|
:reduce :comp3
|
|
:= "COMPUTATIONAL-4"
|
|
:reduce :comp4
|
|
:= "DISPLAY"
|
|
:reduce :display
|
|
:= "DISPLAY-1"
|
|
:reduce :display1
|
|
:= "INDEX"
|
|
:reduce :index
|
|
:= "PACKED-DECIMAL"
|
|
:reduce :packed-decimal
|
|
:= "POINTER"
|
|
:reduce :pointer)
|
|
|
|
(defrule renames-clause
|
|
:= "RENAMES" qualified-data-name through-qualified-data-name?
|
|
:reduce `(:renames ,qualified-data-name ,through-qualified-data-name))
|
|
|
|
(defrule through-qualified-data-name
|
|
:= through qualified-data-name
|
|
:reduce qualified-data-name)
|
|
|
|
(defrule condition-value-clause
|
|
:= values-are literal-through-literal+)
|
|
|
|
(defrule through-literal
|
|
:= through literal)
|
|
|
|
(defrule literal-through-literal
|
|
:= literal through-literal?)
|
|
|
|
(defrule values-are
|
|
:= values are?)
|
|
|
|
(defrule procedure-division-head
|
|
:= "PROCEDURE" "DIVISION" using-phrase? ".")
|
|
|
|
(defrule procedure-division
|
|
:= procedure-division-head sentence+)
|
|
|
|
(defrule using-phrase
|
|
:= "USING" data-name+)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(defrule declaratives
|
|
:= "DECLARATIVES" "." declaratives-content+ "END" "DECLARATIVES" ".")
|
|
|
|
(defrule declaratives-content
|
|
:= cobol-identifier "SECTION" "." use-statement "." sentence*)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(defrule paragraph-header
|
|
:= cobol-identifier "SECTION"?
|
|
:reduce (list (if $2 :section :label) $1))
|
|
|
|
(defrule sentence
|
|
:= declaratives
|
|
:= statement* "."
|
|
:reduce $1
|
|
:= paragraph-header "."
|
|
:reduce $1)
|
|
|
|
(defrule statement
|
|
:= move-statement
|
|
:= if-statement
|
|
:= perform-statement
|
|
:= go-to-statement
|
|
:= accept-statement
|
|
:= add-statement
|
|
:= alter-statement
|
|
:= call-statement
|
|
:= cancel-statement
|
|
:= close-statement
|
|
:= compute-statement
|
|
:= continue-statement
|
|
:= delete-statement
|
|
:= display-statement
|
|
:= divide-statement
|
|
:= entry-statement
|
|
:= evaluate-statement
|
|
:= exit-program-statement
|
|
:= exit-statement
|
|
:= goback-statement
|
|
:= initialize-statement
|
|
:= inspect-statement
|
|
:= merge-statement
|
|
:= multiply-statement
|
|
:= open-statement
|
|
:= read-statement
|
|
:= release-statement
|
|
:= return-statement
|
|
:= rewrite-statement
|
|
:= search-statement
|
|
:= set-statement
|
|
:= sort-statement
|
|
:= start-statement
|
|
:= stop-statement
|
|
:= string-statement
|
|
:= subtract-statement
|
|
:= unstring-statement
|
|
:= write-statement
|
|
:= paragraph-header)
|
|
|
|
(defrule accept-statement
|
|
:= "ACCEPT" variable-identifier "FROM" date
|
|
:= "ACCEPT" variable-identifier "AT" screen-coordinates
|
|
:reduce (apply #'list 'accept-at variable-identifier screen-coordinates)
|
|
:= "ACCEPT" variable-identifier from-environment-name?)
|
|
|
|
(defrule from-environment-name
|
|
:= "FROM" cobol-identifier)
|
|
|
|
|
|
(defrule date
|
|
:= "DATE"
|
|
:= "DAY"
|
|
:= "DAY-OF-WEEK"
|
|
:= "TIME")
|
|
|
|
(defrule add-statement
|
|
:= "ADD" id-or-lit+ to-id-or-lit? "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-ADD"?
|
|
:= "ADD" id-or-lit+ "TO" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-ADD"?
|
|
:= "ADD" corresponding variable-identifier "TO" variable-identifier "ROUNDED"? on-size-error-statement-list? not-on-size-error-statement-list? "END-ADD"?)
|
|
|
|
(defrule statement-list
|
|
:= statement+)
|
|
|
|
(defrule alter-statement
|
|
:= "ALTER" procedure-to-procedure+)
|
|
|
|
(defrule proceed-to
|
|
:= "PROCEED" "TO")
|
|
|
|
(defrule procedure-to-procedure
|
|
:= procedure-name "TO" proceed-to? procedure-name)
|
|
|
|
(defrule call-statement
|
|
:= "CALL" id-or-lit using-parameters? call-rest-phrase "END-CALL"?
|
|
:reduce (list 'call id-or-lit (cons 'list using-parameters)))
|
|
|
|
(defrule by-reference
|
|
:= "BY"? "REFERENCE")
|
|
|
|
(defrule content-parameter-value
|
|
:= cobol-identifier
|
|
:= literal)
|
|
|
|
(defrule reference-parameter
|
|
:= by-reference? variable-identifier)
|
|
|
|
(defrule content-parameter
|
|
:= "BY"? "CONTENT" content-parameter-value+)
|
|
|
|
(defrule parameter
|
|
:= reference-parameter
|
|
:= content-parameter
|
|
:= literal)
|
|
|
|
(defrule using-parameters
|
|
:= "USING" parameter+)
|
|
|
|
(defrule call-rest-phrase
|
|
:= on-exception-statement-list? not-on-exception-statement-list? on-overflow-statement-list?)
|
|
|
|
(defrule on-exception-statement-list
|
|
:= "ON"? "EXCEPTION" statement-list)
|
|
|
|
(defrule not-on-exception-statement-list
|
|
:= "NOT" "ON"? "EXCEPTION" statement-list)
|
|
|
|
(defrule cancel-statement
|
|
:= "CANCEL" id-or-lit+)
|
|
|
|
(defrule close-statement
|
|
:= "CLOSE" close-statement-file-name+
|
|
:reduce (list 'close close-statement-file-name))
|
|
|
|
(defrule alt-removal-no-rewind
|
|
:= for-removal
|
|
:= with-no-rewind)
|
|
|
|
(defrule alt-reel-unit
|
|
:= "REEL"
|
|
:= "UNIT")
|
|
|
|
(defrule alt-no-rewind-lock
|
|
:= no-rewind
|
|
:= "LOCK")
|
|
|
|
(defrule close-statement-options-1
|
|
:= alt-reel-unit alt-removal-no-rewind?)
|
|
|
|
(defrule close-statement-options-2
|
|
:= "WITH"? alt-no-rewind-lock)
|
|
|
|
(defrule close-statement-options
|
|
:= close-statement-options-1
|
|
:= close-statement-options-2)
|
|
|
|
(defrule close-statement-file-name
|
|
:= file-name close-statement-options?)
|
|
|
|
(defrule compute-statement
|
|
:= "COMPUTE" cobword-rounded+ equal arithmetic-expression on-size-error-statement-list? not-on-size-error-statement-list? "END-COMPUTE"?
|
|
:reduce (list 'compute cobword-rounded arithmetic-expression :on-size-error on-size-error-statement-list
|
|
:not-on-size-error not-on-size-error-statement-list))
|
|
|
|
(defrule equal
|
|
:= "="
|
|
:= "EQUAL")
|
|
|
|
(defrule continue-statement
|
|
:= "CONTINUE")
|
|
|
|
(defrule delete-statement
|
|
:= "DELETE" file-name "RECORD"? invalid-key-statement-list? not-invalid-key-statement-list? "END-DELETE"?
|
|
:reduce (list 'delete file-name :invalid invalid-key-statement-list :not-invalid not-invalid-key-statement-list))
|
|
|
|
(defrule display-statement
|
|
:= "DISPLAY" id-or-lit+ upon-environment-name? with-no-advancing?
|
|
:reduce (list 'display (cons 'list id-or-lit) :upon upon-environment-name :advance (not with-no-advancing))
|
|
:= "DISPLAY" id-or-lit "AT" screen-coordinates
|
|
:reduce (apply #'list 'display-at id-or-lit screen-coordinates))
|
|
|
|
(defrule screen-coordinates
|
|
:= integer
|
|
:reduce (multiple-value-list (truncate integer 100)))
|
|
|
|
(defrule upon-environment-name
|
|
:= "UPON" cobol-identifier)
|
|
|
|
(defrule with-no-advancing
|
|
:= "WITH"? "NO" "ADVANCING")
|
|
|
|
(defrule divide-statement
|
|
:= "DIVIDE" id-or-lit "INTO" id-or-lit "GIVING" variable-identifier "ROUNDED"? "REMAINDER" variable-identifier on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
|
|
:= "DIVIDE" id-or-lit "BY" id-or-lit "GIVING" variable-identifier "ROUNDED"? "REMAINDER" variable-identifier on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
|
|
:= "DIVIDE" id-or-lit "INTO" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
|
|
:= "DIVIDE" id-or-lit "BY" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?
|
|
:= "DIVIDE" id-or-lit "INTO" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-DIVIDE"?)
|
|
|
|
(defrule entry-statement
|
|
:= "ENTRY" literal using-phrase?)
|
|
|
|
(defrule evaluate-statement
|
|
:= "EVALUATE" evaluate-condition also-phrase* when-phrases+ when-other-phrase? "END-EVALUATE"?)
|
|
|
|
(defrule evaluate-condition
|
|
:= condition
|
|
:= "TRUE"
|
|
:= "FALSE")
|
|
|
|
(defrule also-phrase
|
|
:= "ALSO" evaluate-condition)
|
|
|
|
(defrule when-phrase-also-phrase
|
|
:= "ALSO" evaluate-phrase)
|
|
|
|
(defrule when-phrase
|
|
:= "WHEN" evaluate-phrase when-phrase-also-phrase*)
|
|
|
|
(defrule when-phrases
|
|
:= when-phrase+ statement-list)
|
|
|
|
(defrule when-other-phrase
|
|
:= "WHEN" "OTHER" statement-list)
|
|
|
|
(defrule evaluate-phrase
|
|
:= "ANY"
|
|
:= condition
|
|
:= "TRUE"
|
|
:= "FALSE"
|
|
:= evaluate-phrase-1)
|
|
|
|
(defrule evaluate-phrase-1
|
|
:= "NOT"? arithmetic-expression through-arithmetic-expression?)
|
|
|
|
(defrule through-arithmetic-expression
|
|
:= through arithmetic-expression)
|
|
|
|
(defrule exit-statement
|
|
:= "EXIT"
|
|
:reduce '(exit-paragraph))
|
|
|
|
(defrule exit-program-statement
|
|
:= "EXIT" "PROGRAM"
|
|
:reduce '(exit-program))
|
|
|
|
(defrule goback-statement
|
|
:= "GOBACK"
|
|
:reduce '(go-back))
|
|
|
|
(defrule go-to-statement
|
|
:= "GO" "TO"? procedure-name+ "DEPENDING" "ON"? variable-identifier
|
|
:reduce (list 'goto-depending variable-identifier procedure-name)
|
|
:= "GO" "TO"? procedure-name
|
|
:reduce (list 'goto procedure-name))
|
|
|
|
(defrule if-phrase
|
|
:= "IF" condition "THEN"? alt-statement-list-next-sentence "ELSE" alt-statement-list-next-sentence
|
|
:reduce (list 'if condition
|
|
(if (cdr alt-statement-list-next-sentence)
|
|
(cons 'progn alt-statement-list-next-sentence)
|
|
(car alt-statement-list-next-sentence))
|
|
(if (cdr alt-statement-list-next-sentence2)
|
|
(cons 'progn alt-statement-list-next-sentence2)
|
|
(car alt-statement-list-next-sentence2)))
|
|
:= "IF" condition "THEN"? alt-statement-list-next-sentence
|
|
:reduce (append (list 'when condition) alt-statement-list-next-sentence))
|
|
|
|
(defrule if-statement
|
|
:= if-phrase "END-IF"?
|
|
:reduce $1)
|
|
|
|
(defrule initialize-statement
|
|
:= "INITIALIZE" variable-identifier+ initialize-replacing-phrase?)
|
|
|
|
(defrule initialize-replacing-type
|
|
:= "ALPHABETIC"
|
|
:= "ALPHANUMERIC"
|
|
:= "NUMERIC"
|
|
:= "ALPHANUMERIC-EDITED"
|
|
:= "NUMERIC-EDITED"
|
|
:= "DBCS"
|
|
:= "EGCS")
|
|
|
|
(defrule initialize-replacing-argument
|
|
:= initialize-replacing-type "DATA"? "BY" id-or-lit)
|
|
|
|
(defrule initialize-replacing-phrase
|
|
:= "REPLACING" initialize-replacing-argument+)
|
|
|
|
(defrule inspect-statement
|
|
:= inspect-statement-1
|
|
:= inspect-statement-2
|
|
:= inspect-statement-3
|
|
:= inspect-statement-4)
|
|
|
|
(defrule inspect-statement-1
|
|
:= "INSPECT" variable-identifier "TALLYING" tallying-argument+)
|
|
|
|
(defrule inspect-statement-2
|
|
:= "INSPECT" variable-identifier "CONVERTING" id-or-lit "TO" id-or-lit before-after-phrase*)
|
|
|
|
(defrule inspect-statement-3
|
|
:= "INSPECT" variable-identifier "TALLYING" tallying-argument+ "REPLACING" inspect-replacing-phrase+)
|
|
|
|
(defrule tallying-for-id-or-lit
|
|
:= id-or-lit before-after-phrase*)
|
|
|
|
(defrule alt-all-leading
|
|
:= "ALL"
|
|
:= "LEADING")
|
|
|
|
(defrule tallying-for-argument-1
|
|
:= "CHARACTERS" before-after-phrase*)
|
|
|
|
(defrule tallying-for-argument-2
|
|
:= alt-all-leading tallying-for-id-or-lit+)
|
|
|
|
(defrule tallying-for-argument
|
|
:= tallying-for-argument-1
|
|
:= tallying-for-argument-2)
|
|
|
|
(defrule tallying-argument
|
|
:= variable-identifier "FOR" tallying-for-argument+)
|
|
|
|
(defrule inspect-statement-4
|
|
:= "INSPECT" variable-identifier "REPLACING" inspect-replacing-phrase+)
|
|
|
|
(defrule inspect-replacing-argument
|
|
:= inspect-by-argument "BY" inspect-by-argument before-after-phrase*)
|
|
|
|
(defrule alt-all-leading-first
|
|
:= "ALL"
|
|
:= "LEADING"
|
|
:= "FIRST")
|
|
|
|
(defrule inspect-replacing-phrase-1
|
|
:= "CHARACTERS" "BY" id-or-lit before-after-phrase*)
|
|
|
|
(defrule inspect-replacing-phrase-2
|
|
:= alt-all-leading-first inspect-replacing-argument+)
|
|
|
|
(defrule inspect-replacing-phrase
|
|
:= inspect-replacing-phrase-1
|
|
:= inspect-replacing-phrase-2)
|
|
|
|
(defrule before-after-phrase
|
|
:= alt-before-after "INITIAL"? id-or-lit)
|
|
|
|
(defrule merge-statement
|
|
:= "MERGE" file-name on-key-phrase+ collating-sequence? "USING" file-name file-name+ merge-statement-tail)
|
|
|
|
(defrule on-key-phrase
|
|
:= "ON"? alt-ascending-descending "KEY"? qualified-data-name+)
|
|
|
|
(defrule merge-statement-tail
|
|
:= output-procedure
|
|
:= giving-file-names)
|
|
|
|
(defrule move-statement
|
|
:= "MOVE" id-or-lit "TO" variable-identifier+
|
|
:reduce (apply #'list 'move id-or-lit variable-identifier)
|
|
:= "MOVE" corresponding variable-identifier "TO" variable-identifier+
|
|
:reduce (apply #'list 'move-corresponding variable-identifier variable-identifier2))
|
|
|
|
(defrule multiply-statement
|
|
:= "MULTIPLY" id-or-lit "BY" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-MULTIPLY"?
|
|
:reduce (list 'multiply id-or-lit cobword-rounded :on-size-error on-size-error-statement-list
|
|
:not-on-size-error not-on-size-error-statement-list)
|
|
:= "MULTIPLY" id-or-lit "BY" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-MULTIPLY"?
|
|
:reduce (list 'multiply id-or-lit id-or-lit2 :giving cobword-rounded
|
|
:on-size-error on-size-error-statement-list
|
|
:not-on-size-error not-on-size-error-statement-list))
|
|
|
|
(defrule open-statement
|
|
:= "OPEN" open-statement-phrase+
|
|
:reduce (list 'open open-statement-phrase))
|
|
|
|
(defrule alt-reversed-with-no-rewind
|
|
:= "REVERSED"
|
|
:= with-no-rewind)
|
|
|
|
(defrule open-statement-input-file-name
|
|
:= file-name alt-reversed-with-no-rewind?)
|
|
|
|
(defrule with-no-rewind
|
|
:= "WITH"? "NO" "REWIND")
|
|
|
|
(defrule open-statement-output-file-name
|
|
:= file-name with-no-rewind?)
|
|
|
|
(defrule open-statement-input
|
|
:= "INPUT" open-statement-input-file-name+)
|
|
|
|
(defrule open-statement-output
|
|
:= "OUTPUT" open-statement-output-file-name+)
|
|
|
|
(defrule open-statement-i-o
|
|
:= "I-O" file-name+)
|
|
|
|
(defrule open-statement-extend
|
|
:= "EXTEND" file-name+)
|
|
|
|
(defrule open-statement-phrase
|
|
:= open-statement-input
|
|
:= open-statement-output
|
|
:= open-statement-i-o
|
|
:= open-statement-extend)
|
|
|
|
(defrule perform-statement
|
|
:= "PERFORM" procedure-name through-procedure-name? perform-until-phrase
|
|
:reduce `(perform-until ,procedure-name ,through-procedure-name ,perform-until-phrase)
|
|
:= "PERFORM" procedure-name through-procedure-name? perform-varying-phrase perform-after-phrase*
|
|
:reduce `(perform-varying ,perform-varying-phrase ,procedure-name ,through-procedure-name ,perform-after-phrase)
|
|
:= "PERFORM" procedure-name through-procedure-name? cobword-int "TIMES"
|
|
:reduce `(perform-times ,cobword-int ,procedure-name ,through-procedure-name)
|
|
:= "PERFORM" procedure-name through-procedure-name?
|
|
:reduce (append (list 'perform procedure-name) through-procedure-name))
|
|
|
|
(defrule perform-varying-phrase
|
|
:= with-test? "VARYING" variable-identifier "FROM" id-or-lit "BY" id-or-lit "UNTIL" condition)
|
|
|
|
(defrule perform-after-phrase
|
|
:= "AFTER" variable-identifier "FROM" id-or-lit "BY" id-or-lit "UNTIL" condition)
|
|
|
|
(defrule perform-until-phrase
|
|
:= with-test? "UNTIL" condition)
|
|
|
|
(defrule with-test
|
|
:= "WITH"? "TEST" alt-before-after
|
|
:reduce alt-before-after)
|
|
|
|
(defrule read-statement
|
|
:= "READ" file-name "NEXT"? "RECORD"? into-identifier? key-is-qualified-data-name? invalid-key-statement-list? not-invalid-key-statement-list? at-end-statement-list? not-at-end-statement-list? "END-READ"?)
|
|
|
|
(defrule key-is-qualified-data-name
|
|
:= "KEY" "IS"? qualified-data-name)
|
|
|
|
(defrule release-statement
|
|
:= "RELEASE" record-name from-identifier?)
|
|
|
|
(defrule return-statement
|
|
:= "RETURN" file-name "RECORD"? into-identifier? "AT"? "END" statement-list not-at-end-statement-list? "END-RETURN"?)
|
|
|
|
(defrule into-identifier
|
|
:= "INTO" variable-identifier)
|
|
|
|
(defrule not-at-end-statement-list
|
|
:= "NOT" "AT"? "END" statement-list)
|
|
|
|
(defrule rewrite-statement
|
|
:= "REWRITE" record-name from-identifier? invalid-key-statement-list? not-invalid-key-statement-list? "END-REWRITE"?)
|
|
|
|
(defrule search-statement
|
|
:= search-statement-1
|
|
:= search-statement-2)
|
|
|
|
(defrule search-statement-1
|
|
:= "SEARCH" cobol-identifier varying-identifier? at-end-statement-list? when-condition-stats+ "END-SEARCH"?)
|
|
|
|
(defrule varying-identifier
|
|
:= "VARYING" variable-identifier)
|
|
|
|
(defrule when-condition-stats
|
|
:= "WHEN" condition alt-statement-list-next-sentence)
|
|
|
|
(defrule search-statement-2
|
|
:= "SEARCH" "ALL" variable-identifier at-end-statement-list? "WHEN" search-statement-condition search-statement-condition-tail* alt-statement-list-next-sentence "END-SEARCH"?)
|
|
|
|
(defrule at-end-statement-list
|
|
:= "AT"? "END" statement-list)
|
|
|
|
(defrule search-statement-equal-expression
|
|
:= variable-identifier "IS"? equal-to arithmetic-expression
|
|
:reduce (list '= variable-identifier arithmetic-expression))
|
|
|
|
(defrule search-statement-condition
|
|
:= search-statement-equal-expression
|
|
:= condition-name-reference)
|
|
|
|
(defrule search-statement-condition-tail
|
|
:= "AND" search-statement-condition)
|
|
|
|
(defrule alt-statement-list-next-sentence
|
|
:= statement+
|
|
:= next-sentence
|
|
:reduce :next-sentence)
|
|
|
|
(defrule set-statement
|
|
:= "SET" set-statement-phrase+)
|
|
|
|
(defrule sort-statement
|
|
:= "SORT" file-name on-key-is-phrase+ with-duplicates-in-order? collating-sequence? sort-statement-in sort-statement-out)
|
|
|
|
(defrule key-is
|
|
:= "KEY" "IS"?)
|
|
|
|
(defrule alt-ascending-descending
|
|
:= "ASCENDING"
|
|
:= "DESCENDING")
|
|
|
|
(defrule on-key-is-phrase
|
|
:= "ON"? alt-ascending-descending key-is? qualified-data-name+)
|
|
|
|
(defrule with-duplicates-in-order
|
|
:= "WITH"? "DUPLICATES" "IN"? "ORDER"?)
|
|
|
|
(defrule collating-sequence
|
|
:= "COLLATING"? "SEQUENCE" "IS"? alphabet-name)
|
|
|
|
(defrule through
|
|
:= "THROUGH"
|
|
:= "THRU")
|
|
|
|
(defrule through-procedure-name
|
|
:= through procedure-name
|
|
:reduce procedure-name)
|
|
|
|
(defrule using-file-names
|
|
:= "USING" file-name+)
|
|
|
|
(defrule input-procedure
|
|
:= "INPUT" "PROCEDURE" "IS"? procedure-name through-procedure-name?)
|
|
|
|
(defrule giving-file-names
|
|
:= "GIVING" file-name+)
|
|
|
|
(defrule output-procedure
|
|
:= "OUTPUT" "PROCEDURE" "IS"? procedure-name through-procedure-name?)
|
|
|
|
(defrule sort-statement-in
|
|
:= using-file-names
|
|
:= input-procedure)
|
|
|
|
(defrule sort-statement-out
|
|
:= giving-file-names
|
|
:= output-procedure)
|
|
|
|
(defrule start-statement
|
|
:= "START" file-name key-is-rel-op-qualified-data-name? invalid-key-statement-list? not-invalid-key-statement-list? "END-START"?)
|
|
|
|
(defrule rel-op
|
|
:= equal-to
|
|
:reduce '=
|
|
:= greater-than
|
|
:reduce '>
|
|
:= greater-equal
|
|
:reduce '>=)
|
|
|
|
(defrule key-is-rel-op-qualified-data-name
|
|
:= "KEY" "IS"? rel-op qualified-data-name
|
|
:reduce (list rel-op qualified-data-name))
|
|
|
|
(defrule stop-statement
|
|
:= "STOP" alt-run-literal
|
|
:reduce '(stop))
|
|
|
|
(defrule alt-run-literal
|
|
:= "RUN"
|
|
:= literal)
|
|
|
|
(defrule string-statement
|
|
:= "STRING" delimited-by-phrase+ "INTO" variable-identifier with-pointer-identifier? on-overflow-statement-list? not-on-overflow-statement-list? "END-STRING"?
|
|
:reduce (list 'string-concat delimited-by-phrase variable-identifier :with-pointer with-pointer-identifier :on-overflow on-overflow-statement-list :not-on-overflow not-on-overflow-statement-list))
|
|
|
|
(defrule id-or-lit-size
|
|
:= literal
|
|
:= variable-identifier
|
|
:= "SIZE")
|
|
|
|
(defrule delimited-by-phrase
|
|
:= id-or-lit+ "DELIMITED" "BY"? id-or-lit-size
|
|
:reduce (list id-or-lit id-or-lit-size))
|
|
|
|
(defrule subtract-statement
|
|
:= "SUBTRACT" id-or-lit+ "FROM" id-or-lit "GIVING" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-SUBTRACT"?
|
|
:reduce (list 'subtract-giving id-or-lit id-or-lit2 cobword-rounded
|
|
:on-size-error on-size-error-statement-list
|
|
:not-on-size-error not-on-size-error-statement-list)
|
|
:= "SUBTRACT" id-or-lit+ "FROM" cobword-rounded+ on-size-error-statement-list? not-on-size-error-statement-list? "END-SUBTRACT"?
|
|
:reduce (list 'subtract id-or-lit cobword-rounded
|
|
:on-size-error on-size-error-statement-list
|
|
:not-on-size-error not-on-size-error-statement-list)
|
|
:= "SUBTRACT" corresponding variable-identifier "FROM" variable-identifier "ROUNDED"? on-size-error-statement-list? not-on-size-error-statement-list? "END-SUBTRACT"?
|
|
:reduce (list 'subtract-corr variable-identifier variable-identifier
|
|
:rounded (and $5 t)
|
|
:on-size-error on-size-error-statement-list
|
|
:not-on-size-error not-on-size-error-statement-list))
|
|
|
|
(defrule cobword-rounded
|
|
:= variable-identifier "ROUNDED"?
|
|
:reduce (list variable-identifier (and $2 t)))
|
|
|
|
(defrule on-size-error-statement-list
|
|
:= "ON"? "SIZE" "ERROR" statement-list
|
|
:reduce statement-list)
|
|
|
|
(defrule not-on-size-error-statement-list
|
|
:= "NOT" "ON"? "SIZE" "ERROR" statement-list
|
|
:reduce statement-list)
|
|
|
|
(defrule corresponding
|
|
:= "CORRESPONDING"
|
|
:= "CORR")
|
|
|
|
(defrule unstring-statement
|
|
:= "UNSTRING" variable-identifier delimited-by-all-phrase? "INTO" unstring-statement-dst+ with-pointer-identifier? tallying-in-identifier? on-overflow-statement-list? not-on-overflow-statement-list? "END-UNSTRING"?
|
|
:reduce (list 'unstring variable-identifier unstring-statement-dst
|
|
:delimited-by-all delimited-by-all-phrase
|
|
:with-pointer with-pointer-identifier
|
|
:tallying tallying-in-identifier
|
|
:on-overflow on-overflow-statement-list
|
|
:not-on-overflow not-on-overflow-statement-list))
|
|
|
|
(defrule id-or-lit
|
|
:= literal
|
|
:= variable-identifier)
|
|
|
|
(defrule or-all-id-or-lit
|
|
:= "OR" "ALL"? id-or-lit)
|
|
|
|
(defrule delimited-by-all-phrase
|
|
:= "DELIMITED" "BY"? "ALL"? id-or-lit or-all-id-or-lit*)
|
|
|
|
(defrule delimiter-in-identifier
|
|
:= "DELIMITER" "IN"? variable-identifier)
|
|
|
|
(defrule count-in-identifier
|
|
:= "COUNT" "IN"? variable-identifier)
|
|
|
|
(defrule unstring-statement-dst
|
|
:= variable-identifier delimiter-in-identifier? count-in-identifier?)
|
|
|
|
(defrule with-pointer-identifier
|
|
:= "WITH"? "POINTER" variable-identifier)
|
|
|
|
(defrule tallying-in-identifier
|
|
:= "TALLYING" "IN"? variable-identifier)
|
|
|
|
(defrule on-overflow-statement-list
|
|
:= "ON"? "OVERFLOW" statement-list)
|
|
|
|
(defrule not-on-overflow-statement-list
|
|
:= "NOT" "ON"? "OVERFLOW" statement-list)
|
|
|
|
(defrule write-statement
|
|
:= "WRITE" record-name from-identifier? advancing-phrase? write-exceptions "END-WRITE"?)
|
|
|
|
(defrule lines
|
|
:= "LINE"
|
|
:= "LINES")
|
|
|
|
(defrule cobword-int
|
|
:= cobol-identifier
|
|
:= integer)
|
|
|
|
(defrule nr-lines-phrase
|
|
:= cobword-int lines?)
|
|
|
|
(defrule page-phrase
|
|
:= nr-lines-phrase
|
|
:= "PAGE")
|
|
|
|
(defrule alt-before-after
|
|
:= "BEFORE"
|
|
:= "AFTER")
|
|
|
|
(defrule advancing-phrase
|
|
:= alt-before-after "ADVANCING"? page-phrase)
|
|
|
|
(defrule from-identifier
|
|
:= "FROM" variable-identifier)
|
|
|
|
(defrule invalid-key-statement-list
|
|
:= "INVALID" "KEY"? statement-list
|
|
:reduce statement-list)
|
|
|
|
(defrule not-invalid-key-statement-list
|
|
:= "NOT" "INVALID" "KEY"? statement-list
|
|
:reduce statement-list)
|
|
|
|
(defrule end-of-page
|
|
:= "END-OF-PAGE"
|
|
:= "EOP")
|
|
|
|
(defrule at-end-of-page-statement-list
|
|
:= "AT"? end-of-page statement-list
|
|
:reduce statement-list)
|
|
|
|
(defrule not-at-end-of-page-statement-list
|
|
:= "NOT" "AT"? end-of-page statement-list
|
|
:reduce statement-list)
|
|
|
|
;; This is left in the grammar but is not used. COPYs are handled by
|
|
;; the lexical scanner.
|
|
(defrule copy-statement
|
|
:= "COPY" alt-text-name-literal in-library? "SUPPRESS"? copy-statement-replacing-phrase?)
|
|
|
|
(defrule in
|
|
:= "OF"
|
|
:= "IN")
|
|
|
|
(defrule alt-library-name-literal
|
|
:= library-name
|
|
:= literal)
|
|
|
|
(defrule in-library
|
|
:= in alt-library-name-literal)
|
|
|
|
(defrule copy-statement-by-phrase
|
|
:= copy-operand "BY" copy-operand)
|
|
|
|
(defrule copy-statement-replacing-phrase
|
|
:= "REPLACING" copy-statement-by-phrase+)
|
|
|
|
(defrule alt-text-name-literal
|
|
:= text-name
|
|
:= literal)
|
|
|
|
(defrule copy-operand
|
|
:= cobol-identifier
|
|
:= literal)
|
|
|
|
(defrule use-statement
|
|
:= use-statement-1
|
|
:= use-statement-2
|
|
:= use-statement-3)
|
|
|
|
(defrule use-statement-1
|
|
:= "USE" "GLOBAL"? "AFTER" "STANDARD"? alt-exception-error "PROCEDURE" "ON"? alt-file-names-i-o)
|
|
|
|
(defrule alt-exception-error
|
|
:= "EXCEPTION"
|
|
:= "ERROR")
|
|
|
|
(defrule use-statement-2
|
|
:= "USE" "GLOBAL"? "AFTER" "STANDARD"? alt-beginning-ending? alt-file-reel-unit? "LABEL" "PROCEDURE" "ON"? alt-file-names-i-o)
|
|
|
|
(defrule alt-beginning-ending
|
|
:= "BEGINNING"
|
|
:= "ENDING")
|
|
|
|
(defrule alt-file-reel-unit
|
|
:= "FILE"
|
|
:= "REEL"
|
|
:= "UNIT")
|
|
|
|
(defrule file-names
|
|
:= file-name+)
|
|
|
|
(defrule alt-file-names-i-o
|
|
:= file-names
|
|
:= "INPUT"
|
|
:= "OUTPUT"
|
|
:= "I-O"
|
|
:= "EXTEND")
|
|
|
|
(defrule use-statement-3
|
|
:= "USE" "FOR"? "DEBUGGING" "ON"? alt-procedures-all-procedures)
|
|
|
|
(defrule procedure-names
|
|
:= procedure-name+)
|
|
|
|
(defrule alt-procedures-all-procedures
|
|
:= procedure-names
|
|
:= all-procedures)
|
|
|
|
(defrule condition
|
|
:= combinable-condition
|
|
:= combinable-condition "AND" condition
|
|
:reduce `(and ,combinable-condition ,condition)
|
|
:= combinable-condition "OR" condition
|
|
:reduce `(or ,combinable-condition ,condition)
|
|
:= combinable-condition "AND" id-or-lit
|
|
:reduce `(and ,combinable-condition (,(car combinable-condition) ,(cadr combinable-condition) ,id-or-lit))
|
|
:= combinable-condition "OR" id-or-lit
|
|
:reduce `(or ,combinable-condition (,(car combinable-condition) ,(cadr combinable-condition) ,id-or-lit)))
|
|
|
|
(defrule combinable-condition
|
|
:= "NOT"? simple-condition
|
|
:reduce (if $1
|
|
(list 'not simple-condition)
|
|
simple-condition))
|
|
|
|
(defrule simple-condition
|
|
:= class-condition
|
|
:= relation-condition
|
|
:= sign-condition
|
|
:= "(" condition ")"
|
|
;; not sure if it's necessary -wcp15/7/03.
|
|
;; := arithmetic-expression
|
|
)
|
|
|
|
(defrule class-condition
|
|
:= variable-identifier "IS"? "NOT"? class-type
|
|
:reduce (if $3
|
|
(list 'not (list 'type-of variable-identifier (make-keyword class-type)))
|
|
(list 'type-of variable-identifier (make-keyword class-type))))
|
|
|
|
(defrule class-type
|
|
:= "NUMERIC"
|
|
:= "ALPHABETIC"
|
|
:= "ALPHABETIC-LOWER"
|
|
:= "ALPHABETIC-UPPER"
|
|
:= "DBCS")
|
|
|
|
(defun unfold-subrelations (main-relation subs)
|
|
(destructuring-bind (main-operator main-variable other-variable) main-relation
|
|
(declare (ignore other-variable))
|
|
(labels ((unfold (subs)
|
|
(if (null subs)
|
|
main-relation
|
|
(destructuring-bind (connection operator variable) (car subs)
|
|
(list connection
|
|
(list (or operator main-operator) main-variable variable)
|
|
(unfold (cdr subs)))))))
|
|
(unfold subs))))
|
|
|
|
(defrule relation-condition
|
|
;; This is too complex
|
|
;; := arithmetic-expression relational-operator simple-condition
|
|
:= id-or-lit relational-operator id-or-lit subordinate-relation*
|
|
:reduce (unfold-subrelations (list relational-operator id-or-lit id-or-lit2) subordinate-relation))
|
|
|
|
(defrule or-and
|
|
:= "OR" :reduce 'or
|
|
:= "AND" :reduce 'and)
|
|
|
|
(defrule subordinate-relation
|
|
:= or-and relational-operator? id-or-lit
|
|
:reduce (list or-and relational-operator id-or-lit))
|
|
|
|
(defrule relational-operator
|
|
:= "IS"? relational-operator-type
|
|
:reduce relational-operator-type)
|
|
|
|
(defrule less-than
|
|
:= "LESS" "THAN"?
|
|
:= "<")
|
|
|
|
(defrule greater-equal
|
|
:= "GREATER" "THAN"? "OR" "EQUAL" "TO"?
|
|
:= ">="
|
|
:= ">" "="
|
|
:= "NOT" "<"
|
|
:= "NOT" "LESS" "THAN"?)
|
|
|
|
(defrule less-equal
|
|
:= "LESS" "THAN"? "OR" "EQUAL" "TO"?
|
|
:= "<="
|
|
:= "<" "="
|
|
:= "NOT" ">"
|
|
:= "NOT" "GREATER" "THAN"?)
|
|
|
|
(defrule greater-than
|
|
:= "GREATER" "THAN"?
|
|
:= ">")
|
|
|
|
(defrule equal-to
|
|
:= "EQUAL" "TO"?
|
|
:= "=")
|
|
|
|
(defrule relational-operator-type
|
|
:= greater-equal
|
|
:reduce 'cob>=
|
|
:= less-equal
|
|
:reduce 'cob<=
|
|
:= greater-than
|
|
:reduce 'cob>
|
|
:= less-than
|
|
:reduce 'cob<
|
|
:= equal-to
|
|
:reduce 'cob=
|
|
:= "NOT" equal-to
|
|
:reduce 'cob-not=)
|
|
|
|
(defrule sign-condition
|
|
:= arithmetic-expression "IS"? "NOT"? sign-type
|
|
:reduce (if $3
|
|
`(not (,sign-type ,arithmetic-expression))
|
|
`(,sign-type ,arithmetic-expression)))
|
|
|
|
(defrule sign-type
|
|
:= "POSITIVE" :reduce '>
|
|
:= "NEGATIVE" :reduce '<
|
|
:= "ZERO" :reduce '=
|
|
:= "ZEROES" :reduce '=
|
|
:= "ZEROS" :reduce '=)
|
|
|
|
(defrule procedure-name
|
|
:= paragraph-or-section-name in-section-name
|
|
:reduce (list paragraph-or-section-name in-section-name)
|
|
:= paragraph-or-section-name
|
|
:reduce paragraph-or-section-name)
|
|
|
|
(defrule in-section-name
|
|
:= in cobol-identifier
|
|
:reduce cobol-identifier)
|
|
|
|
(defrule variable-identifier
|
|
:= qualified-data-name subscript-parentheses* ;; reference-modification?
|
|
:reduce (if subscript-parentheses
|
|
(list :aref qualified-data-name subscript-parentheses)
|
|
qualified-data-name))
|
|
|
|
(defrule reference-modification
|
|
:= "(" leftmost-character-position ":" length? ")"
|
|
:reduce (if length
|
|
(list :range leftmost-character-position length)
|
|
leftmost-character-position))
|
|
|
|
(defrule condition-name-reference
|
|
:= condition-name in-data-or-file-or-mnemonic-name* subscript-parentheses*)
|
|
|
|
(defrule in-data-or-file-or-mnemonic-name
|
|
:= in data-or-file-or-mnemonic-name)
|
|
|
|
(defrule subscript-parentheses
|
|
:= "(" subscript ")")
|
|
|
|
(defrule subscript
|
|
:= subscript-expression+)
|
|
|
|
(defrule plus-minus-integer
|
|
:= plus-or-minus integer)
|
|
|
|
(defrule subscript-expression-ambiguous
|
|
:= qualified-data-name plus-minus-integer?)
|
|
|
|
(defrule subscript-expression
|
|
:= literal
|
|
:= subscript-expression-ambiguous)
|
|
|
|
(defrule qualified-data-name
|
|
:= data-name in-data-or-file-name*
|
|
:reduce (if in-data-or-file-name
|
|
(list data-name in-data-or-file-name) ; incomplete -wcp15/7/03.
|
|
data-name)
|
|
:= "ADDRESS" "OF" data-name
|
|
:reduce (list 'address-of data-name)
|
|
:= "LENGTH" "OF" cobol-identifier
|
|
:reduce (list 'length-of cobol-identifier))
|
|
|
|
(defrule in-data-or-file-name
|
|
:= in data-or-file-name)
|
|
|
|
(defrule leftmost-character-position
|
|
:= arithmetic-expression)
|
|
|
|
(defrule length
|
|
:= arithmetic-expression)
|
|
|
|
(defrule arithmetic-expression
|
|
:= times-div
|
|
:= times-div "+" arithmetic-expression
|
|
:reduce `(+ ,times-div ,arithmetic-expression)
|
|
:= times-div "-" arithmetic-expression
|
|
:reduce `(- ,times-div ,arithmetic-expression))
|
|
|
|
(defrule times-div
|
|
:= power
|
|
:= power "*" times-div
|
|
:reduce `(* ,power ,times-div)
|
|
:= power "/" times-div
|
|
:reduce `(/ ,power ,times-div))
|
|
|
|
(defrule power
|
|
:= plus-or-minus? basis
|
|
:= plus-or-minus? basis "**" power
|
|
:reduce (if plus-or-minus
|
|
`(plus-or-minus (expt basis basis2))
|
|
`(expt basis basis2)))
|
|
|
|
(defrule plus-or-minus
|
|
:= "+"
|
|
:reduce '+
|
|
:= "-"
|
|
:reduce '-)
|
|
|
|
;; (defrule power-tail
|
|
;; := "**" basis)
|
|
|
|
(defrule basis
|
|
:= literal
|
|
:= variable-identifier
|
|
:= "(" arithmetic-expression ")")
|
|
|
|
(defrule alphabet-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule condition-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule data-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule cobol-identifier
|
|
:= identifier
|
|
:reduce (intern (string-upcase identifier)))
|
|
|
|
(defrule file-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule data-or-file-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule index-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule mnemonic-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule data-or-file-or-mnemonic-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule record-name
|
|
:= qualified-data-name)
|
|
|
|
(defrule symbolic-character
|
|
:= cobol-identifier)
|
|
|
|
(defrule library-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule program-name
|
|
:= cobol-identifier
|
|
:= string)
|
|
|
|
(defrule text-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule paragraph-or-section-name
|
|
:= cobol-identifier
|
|
:= integer)
|
|
|
|
(defrule computer-name
|
|
:= identifier)
|
|
|
|
(defrule environment-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule assignment-name
|
|
:= cobol-identifier)
|
|
|
|
(defrule figurative-constant
|
|
:= figurative-constant-simple
|
|
:= figurative-constant-all)
|
|
|
|
(defrule figurative-constant-all
|
|
:= "ALL" literal)
|
|
|
|
(defrule literal
|
|
:= string
|
|
:= float
|
|
:= integer
|
|
:= figurative-constant)
|
|
|
|
) ; defun populate-grammar
|