Re: [lisp-snmp] Patch to asn.1 to change from parsergen to a modified cl-yacc
Brought to you by:
binghe
Menu
▾
▴
Re: [lisp-snmp] Patch to asn.1 to change from parsergen to a modified cl-yacc
|
From: Chun T. (binghe) <bin...@gm...> - 2009-02-06 12:09:08
|
Hi, John
Thanks for your work, and I would like to merge it. Read following
words please:
-----
|1) For the question about nicknames of generated packages, I think my
current solution is the best, my ideas on this design:
On ASN.1 package trunk, the ASN.1 "module" is directly mapped into
Lisp "package", this change let us could have two OID instances with
the same name but in different modules. One example is
"netSnmpAgentOIDs.linux" (in NET-SNMP-TC) and "ucdSnmpAgent.linux" (in
UCD-SNMP-MIB). A new OID function syntax has been introduced:
ASN.1 47 > (oid "NET-SNMP-TC::linux")
#<OBJECT-ID NET-SNMP-TC::linux (10) [0]>
ASN.1 48 > (oid "UCD-SNMP-MIB::linux")
#<OBJECT-ID UCD-SNMP-MIB::linux (10) [0]>
Or using following method:
ASN.1 49 > (oid "netSnmpAgentOIDs.linux")
#<OBJECT-ID NET-SNMP-TC::linux (10) [0]>
ASN.1 50 > (oid "ucdSnmpAgent.linux")
#<OBJECT-ID NET-SNMP-TC::linux (10) [0]>
The "NET-SNMP-TC" in form (oid "NET-SNMP-TC::linux") is just a package
name, and the "linux" is just a variable in that package, so following
method can also works:
ASN.1 53 > NET-SNMP-TC::|linux|
#<OBJECT-ID NET-SNMP-TC::linux (10) [0]>
ASN.1 54 > UCD-SNMP-MIB::|linux|
#<OBJECT-ID UCD-SNMP-MIB::linux (10) [0]>
Due to this design, the implementation of OID function is very easy,
and highly depend on what Common Lisp already have, and it's delivery
friendly (need only symbols but the CL compiler/interpreter). So the
"short" package name is necessary, no matter if they may clash with
other CL packages. (Actually the clash chance is very small, because
most formally defined MIB module has a "MIB" as part of its module
name).
The "long" package name is used to identify these packages when a
Lisper look at the output of (LIST-ALL-PACKAGES), because the main
name of a package will be shown when it's PRINT-OBJECTed.
I hope you can understand above explanation, I really don't want to
change this part unless there're better solutions founded on it.
-----
|2) For the "EVAL" issue and your related questions. I think, the only
issue you have solved is to use cl-yacc instead of lispworks'
parsergen, then all supported CL platform can use the ASN.1 compiler.
I don't quite like the use of function EVAL at runtime, because this
will cause some delivery issues. I don't know much about Allegro CL,
but to support EVAL on runtime in delivered LispWorks images, the
whole Common Lisp runtime and interpreter will be hold in target
executions, this may increase the file size. And EVAL itself also
suffer from environment-related problems, one of which is the symbol
intern issues you have mentioned.
The better way to load MIB definitions at runtime may be to use
COMPILE-FILE and LOAD instead of EVAL, if a new lisp file is generated
from the ASN.1 definitions, we should be able to COMPILE-FILE it
first, and then LOAD it. This could also solve the rest issues. But
unfortunately this approach only works on Open Source CL platforms
which COMPILE-FILE is free. In LispWorks, COMPILE-FILE function is
removed after delivery. I think Allegro CL have more strict rules on
this part due to its complex license options.
The best way to load MIB definitions at runtime, I think, is to
compile the ASN.1 definitions into another form: the AST itself or a
modified version. Then we can use a pure-lisp ASN.1 "interpreter" to
read this ACT, and create correspond OID variables at runtime. This is
a delivery-free solution, we only need something like MAKE-INSTANCE,
and DEFCLASS sometimes.
What your opinion here?
-----
|3) I'd very like your functions to convert LispWorks PARSERGEN syntax
into CL-YACC syntax.
The reason to keep PARSERGEN: The ASN.1 compiler based on LispWorks'
parsergen must be faster than those based on CL-YACC, and on LispWorks
the CL-YACC package is not needed.
PARSERGEN will compile LALR(1) syntax into a series of Lisp functions
which do the actual parsing job, these functions will be compiled and
saved into syntax.fasl and on runtime they can do things very fast (no
depend on these LALR definitions any more). Compare to that, CL-YACC
is NOT a LALR compiler, it just compile LALR syntax definitons into a
private-format "parser" object, and use it on runtime, this method
should be slower than LispWorks' primitive parser functions.
I'll try to modify your patch to keep the ASN.1 syntax definitions
only one copy, and let both PARSERGEN and CL-YACC can use it.
Opinions are welcome.
On 2009-2-6, at 18:26, John Fremlin wrote:
> Hi Chun Tian,
>
> This patch allows one to use cl-yacc to parse ASN.1 files instead of
> only Lispworks' parsergen. We intend to allow users to load in ASN.1
> MIB
> definitions for our SNMP project. It requires a patch to cl-yacc,
> attached at the bottom of this mail.
>
>
> A new function eval-compile-asn.1 was introduced, to immediately
> load a
> compiled ASN.1.
>
> There are several problems relating to the use of Common Lisp packages
> for each ASN module definition.
>
> Would it be possible to stop giving the package a nickname that
> is entirely specified by the user? The long-package-name made with
>
> (defvar *asn.1-package-prefix* "ASN.1/")
>
> (defun module->package (module)
> (declare (type symbol module))
> (let ((package-symbol (intern (concatenate 'string
> *asn.1-package-prefix*
> (symbol-name module))
> :keyword)))
> (the symbol package-symbol)))
>
> is just fine, and it is annoying to have a :nickname that may clash
> with
> a normal Lisp package.
>
>
> Secondly, it is not possible to eval the output of the compiler
> directly
> because it incorrectly interns symbols in the current package, when
> they
> should be interned in the module package. The module-specific
> package must
> created at compile time to support this.
>
> Would you accept a patch for these changes?
>
> Running on Lispworks, the patch will use both the cl-yacc parser and
> the
> parsergen parser simultaneously and asserts that the output of both is
> equalp. When enough testing has been done, this can be removed and
> only
> one parser used.
>
> Please review this
>
> Index: package.lisp
> ===================================================================
> --- package.lisp (revision 706)
> +++ package.lisp (working copy)
> @@ -27,6 +27,7 @@
> #:defoid
> #:delete-object
> #:ensure-oid
> + #:eval-compile-asn.1
> #:gauge
> #:general-type
> #:get-asn.1-type
> Index: asn.1-dev.asd
> ===================================================================
> --- asn.1-dev.asd (revision 706)
> +++ asn.1-dev.asd (working copy)
> @@ -10,17 +10,17 @@
> #+lispworks
> (require "parsergen")
>
> -#+lispworks
> (defsystem asn.1-dev
> :description "ASN.1 Compiler"
> :version "5.0-dev"
> :licence "MIT"
> :author "Chun Tian (binghe) <bin...@gm...>"
> - :depends-on (:asn.1)
> + :depends-on (:asn.1 :yacc)
> :components ((:module "compiler"
> :components ((:file "reader")
> (:file "syntax")
> - (:file "parser" :depends-on ("reader" "syntax"))
> + (:file "yacc" :depends-on ("syntax"))
> + (:file "parser" :depends-on ("yacc" "reader"))
> (:file "compile-type")
> (:file "sort")
> (:file "compiler" :depends-on ("sort"
> "parser" "compile-type"))
> Index: compiler/compiler.lisp
> ===================================================================
> --- compiler/compiler.lisp (revision 706)
> +++ compiler/compiler.lisp (working copy)
> @@ -3,7 +3,7 @@
>
> (in-package :asn.1)
>
> -(defvar *mib-name-map-table* (make-hash-table :test #'string=))
> +(defvar *mib-name-map-table* (make-hash-table :test #'equal))
>
> ;;; Empty and old MIB module
> (defvar *mib-name-map* nil)
> @@ -223,3 +223,23 @@
> (defmethod compile-dfo-internal ((key (eql 'MAX-ACCESS)) (value
> symbol))
> (declare (ignore key))
> `(:max-access ',value))
> +
> +
> +(defun eval-compile-asn.1 (pathname)
> +;; Unfortunately it is not possible to eval the generated list
> +;; directly, because the package in which the symbols should actually
> +;; reside is not created at compile time.
> +
> +;; To move into the correct package, the list is written to a string
> +;; and then read in.
> +
> +;; This is very messy and should be fixed.
> + (with-standard-io-syntax
> + (let ((*package* (find-package #.(package-name *package*))))
> + (handler-case
> + (with-input-from-string
> + (*standard-input*
> + (with-output-to-string (*standard-output*)
> + (mapcar 'print (sort-definitions (cdr (compile-asn.1
> pathname))))))
> + (loop (eval (read))))
> + (end-of-file ())))))
> Index: compiler/parser.lisp
> ===================================================================
> --- compiler/parser.lisp (revision 706)
> +++ compiler/parser.lisp (working copy)
> @@ -7,9 +7,8 @@
> (let ((*readtable* *asn.1-readtable*)
> (*package* (find-package :asn.1)))
> (let ((token (read stream nil nil nil)))
> - (if token
> - (values (detect-token token) token)
> - (values nil nil)))))
> + (when token
> + (values (detect-token token) token)))))
>
> (defgeneric detect-token (token))
>
> @@ -32,8 +31,27 @@
> (with-open-file (s source :direction :input)
> (parse s)))
>
> -(defmethod parse ((source stream))
> - (asn.1-parser #'(lambda () (asn.1-lexer source))))
> +(defmethod parse ((stream stream))
> + #-lispworks
> + (yacc:parse-with-lexer
> + (lambda() (asn.1-lexer stream))
> + *asn-1-yacc-parser*)
>
> + #+lispworks
> + (progn
> + (let ((forms (loop for pair = (multiple-value-list (asn.1-lexer
> stream))
> + collect pair
> + until (every 'not pair))))
> + (flet ((lexer ()
> + (let ((forms forms))
> + (lambda()(values-list (pop forms))))))
> + (let ((parsergen (asn.1-parser (lexer)))
> + (yacc
> + (yacc:parse-with-lexer
> + (lexer)
> + *asn-1-yacc-parser*)))
> + (assert (equalp yacc parsergen))
> + yacc)))))
> +
> (defmethod parse ((source t))
> (error "Unknown Parser Source"))
> Index: compiler/yacc.lisp
> ===================================================================
> --- compiler/yacc.lisp (revision 0)
> +++ compiler/yacc.lisp (revision 0)
> @@ -0,0 +1,431 @@
> +(in-package :asn.1)
> +
> +(yacc:define-parser *asn-1-yacc-parser*
> + (:terminals
> + #.`(,@*reserved-words*
> + :id
> + :number
> + :string))
> + (:start-symbol
> + %module-definition)
> +
> + (root (assignment #'(lambda ($1) $1)))
> + (%module-definition
> + (:id
> + definitions
> + %tag-default
> + %extension-default
> + \:\:=
> + begin
> + %module-body
> + end
> + #'(lambda ($1 $2 $3 $4 $5 $6 $7 $8)
> + (declare (ignore $8 $6 $5 $4 $3 $2))
> + `(:module ,$1 ,$7))))
> + (%tag-default nil)
> + (%extension-default nil)
> + (%module-body
> + (%exports
> + %imports
> + %assignment-list
> + #'(lambda ($1 $2 $3) `((,$1 ,$2) ,$3)))
> + nil)
> + (%exports
> + (exports
> + all
> + \;
> + #'(lambda ($1 $2 $3) (declare (ignore $3 $2 $1)) '(export :all)))
> + (exports
> + %symbol*
> + \;
> + #'(lambda ($1 $2 $3) (declare (ignore $3 $1)) `(export ,@$2)))
> + nil)
> + (%imports
> + (imports
> + %symbols-from-modules
> + \;
> + #'(lambda ($1 $2 $3) (declare (ignore $3 $1)) `(import ,@$2)))
> + nil)
> + (%symbols-from-modules
> + (%symbols-from-module #'(lambda ($1) `(,$1)))
> + (%symbols-from-modules
> + %symbols-from-module
> + #'(lambda ($1 $2) `(,@$1 ,$2))))
> + (%symbols-from-module
> + (%symbol+
> + from
> + :id
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,$1 :from ,$3))))
> + (%assignment-list
> + (%assignment-list %assignment #'(lambda ($1 $2) `(,@$1 ,$2)))
> + (%assignment #'(lambda ($1) `(,$1)))
> + nil)
> + (%assignment
> + (%macro-definition #'(lambda ($1) $1))
> + (%type-assignment #'(lambda ($1) $1))
> + (%value-assignment #'(lambda ($1) $1)))
> + (%macro-definition
> + (%macro-name
> + macro
> + \:\:=
> + begin
> + %general-list
> + end
> + #'(lambda ($1 $2 $3 $4 $5 $6)
> + (declare (ignore $6 $5 $4 $3 $2))
> + `(:macro ,$1))))
> + (%value-assignment
> + (:id
> + %type
> + \:\:=
> + %value
> + #'(lambda ($1 $2 $3 $4)
> + (declare (ignore $3))
> + `(:value-assignment ,$2 (,$1 ,$4))))
> + (:id
> + %macro-name
> + %macro-arguments+
> + \:\:=
> + %object-identifier-value
> + #'(lambda ($1 $2 $3 $4 $5)
> + (declare (ignore $4))
> + `(:define ,$2 (,$1 ,$3) ,$5)))
> + (:id
> + %macro-name
> + %macro-arguments+
> + \:\:=
> + :number
> + #'(lambda ($1 $2 $3 $4 $5)
> + (declare (ignore $4))
> + `(:define ,$2 (,$1 ,$3) ,$5))))
> + (%macro-arguments+
> + (%macro-arguments #'(lambda ($1) `(,$1)))
> + (%macro-arguments+ %macro-arguments #'(lambda ($1 $2) `(,@$1 ,
> $2))))
> + (%macro-arguments
> + (:id :id #'(lambda ($1 $2) `(,$1 ,$2)))
> + (:id :string #'(lambda ($1 $2) `(,$1 ,$2)))
> + (syntax %type #'(lambda ($1 $2) `(,$1 ,$2)))
> + (write-syntax %type #'(lambda ($1 $2) `(,$1 ,$2)))
> + (object :id #'(lambda ($1 $2) `(,$1 ,$2)))
> + (module
> + :id
> + %macro-arguments+
> + #'(lambda ($1 $2 $3) (declare (ignore $1)) `(:module ,$2 ,$3)))
> + (module
> + %macro-arguments+
> + #'(lambda ($1 $2) (declare (ignore $1)) `(:module nil ,$2)))
> + (:id
> + {
> + {
> + %symbol*
> + }
> + }
> + #'(lambda ($1 $2 $3 $4 $5 $6)
> + (declare (ignore $6 $5 $3 $2))
> + `(,$1 ,$4)))
> + (:id
> + {
> + :string
> + }
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $2)) `(,$1 ,$3)))
> + (:id
> + {
> + :number
> + }
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $2)) `(,$1 ,$3)))
> + (:id
> + {
> + %implied-symbol+
> + }
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $2)) `(,$1 ,$3))))
> + (%type-assignment
> + (:id
> + \:\:=
> + %type
> + #'(lambda ($1 $2 $3)
> + (declare (ignore $2))
> + `(:type-assignment ,$1 ,$3))))
> + (%type
> + (%builtin-type #'(lambda ($1) $1))
> + (%tagged-type #'(lambda ($1) $1))
> + (:id #'(lambda ($1) $1))
> + (:id
> + \(
> + size
> + \(
> + %numbers+
> + \)
> + \)
> + #'(lambda ($1 $2 $3 $4 $5 $6 $7)
> + (declare (ignore $7 $6 $4 $3 $2))
> + `(:general-string ,$1 ,$5)))
> + (:id
> + \(
> + %numbers+
> + \)
> + #'(lambda ($1 $2 $3 $4)
> + (declare (ignore $4 $2))
> + `(:general-integer ,$1 ,$3)))
> + (:id
> + {
> + %named-number+
> + }
> + #'(lambda ($1 $2 $3 $4)
> + (declare (ignore $4 $2))
> + `(:general-integer ,$1 ,$3)))
> + (%named-type #'(lambda ($1) `(:named-type ,$1))))
> + (%named-type (:id %type #'(lambda ($1 $2) `(,$1 ,$2))))
> + (%builtin-type
> + (%object-identifier-type #'(lambda ($1) $1))
> + (%choice-type #'(lambda ($1) $1))
> + (%string-type #'(lambda ($1) $1))
> + (%integer-type #'(lambda ($1) $1))
> + (%sequence-of-type #'(lambda ($1) $1))
> + (%sequence-type #'(lambda ($1) $1))
> + (%textual-convention-type #'(lambda ($1) $1))
> + (null #'(lambda ($1) (declare (ignore $1)) '(:null))))
> + (%object-identifier-type
> + (object
> + identifier
> + #'(lambda ($1 $2) (declare (ignore $2 $1)) :object-identifier)))
> + (%choice-type
> + (choice
> + {
> + %alternative-type-lists
> + }
> + #'(lambda ($1 $2 $3 $4)
> + (declare (ignore $4 $2 $1))
> + `(:choice ,$3))))
> + (%alternative-type-lists
> + (%root-alternative-type-list #'(lambda ($1) $1)))
> + (%root-alternative-type-list
> + (%alternative-type-list #'(lambda ($1) $1)))
> + (%alternative-type-list
> + (%named-type #'(lambda ($1) `(,$1)))
> + (%alternative-type-list
> + \,
> + %named-type
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,@$1 ,$3))))
> + (%string-type
> + (octet
> + string
> + %string-options
> + #'(lambda ($1 $2 $3)
> + (declare (ignore $2 $1))
> + `(:octet-string ,$3))))
> + (%string-options
> + (\(
> + size
> + \(
> + %numbers+
> + \)
> + \)
> + #'(lambda ($1 $2 $3 $4 $5 $6)
> + (declare (ignore $6 $5 $3 $2 $1))
> + `(:size ,$4)))
> + (\(
> + %numbers+
> + \)
> + #'(lambda ($1 $2 $3) (declare (ignore $3 $1)) `(:size ,$2)))
> + nil)
> + (%numbers+
> + (%numbers+
> + \|
> + %splited-numbers
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,@$1 ,$3)))
> + (%splited-numbers #'(lambda ($1) `(,$1))))
> + (%integer-type
> + (%integer-type-name
> + \(
> + %numbers+
> + \)
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $2)) `(,$1 ,$3)))
> + (%integer-type-name
> + {
> + %named-number+
> + }
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $2)) `(,$1 ,$3)))
> + (%integer-type-name #'(lambda ($1) $1)))
> + (%integer-type-name
> + (integer #'(lambda ($1) (declare (ignore $1)) :integer)))
> + (%splited-numbers
> + (:number #'(lambda ($1) $1))
> + (:number
> + |..|
> + :number
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,$1 ,$3))))
> + (%named-number+
> + (%named-number #'(lambda ($1) `(,$1)))
> + (%named-number+
> + \,
> + %named-number
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,@$1 ,$3))))
> + (%named-number
> + (:id
> + \(
> + :number
> + \)
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $2)) `(,$1 ,$3))))
> + (%tagged-type
> + (%tag
> + implicit
> + %builtin-type
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(:implicit ,$1 ,$3)))
> + (%tag
> + explicit
> + %builtin-type
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(:explicit ,$1 ,$3)))
> + (%tag %builtin-type #'(lambda ($1 $2) `(:tag ,$1 ,$2))))
> + (%tag
> + ([
> + %class
> + :number
> + ]
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $1)) `(,$2 ,$3))))
> + (%class
> + (universal #'(lambda ($1) (declare (ignore $1)) :universal))
> + (application #'(lambda ($1) (declare (ignore $1)) :application))
> + (private #'(lambda ($1) (declare (ignore $1)) :private))
> + nil)
> + (%value
> + (%object-identifier-value #'(lambda ($1) $1))
> + (:string #'(lambda ($1) $1))
> + (:number #'(lambda ($1) $1)))
> + (%object-identifier-value
> + ({
> + %obj-id-component+
> + }
> + #'(lambda ($1 $2 $3) (declare (ignore $3 $1)) `(,@$2))))
> + (%obj-id-component+
> + (%obj-id-component+ %obj-id-component #'(lambda ($1 $2) `(,@$1 ,
> $2)))
> + (%obj-id-component #'(lambda ($1) `(,$1))))
> + (%obj-id-component
> + (%name-and-number-form #'(lambda ($1) $1))
> + (:id #'(lambda ($1) $1))
> + (:number #'(lambda ($1) $1)))
> + (%name-and-number-form
> + (:id
> + \(
> + :number
> + \)
> + #'(lambda ($1 $2 $3 $4) (declare (ignore $4 $2)) `(,$1 ,$3))))
> + (%sequence-of-type
> + (sequence
> + of
> + %type
> + #'(lambda ($1 $2 $3) (declare (ignore $2 $1)) `(:sequence-of ,
> $3))))
> + (%sequence-type
> + (sequence
> + {
> + }
> + #'(lambda ($1 $2 $3) (declare (ignore $3 $2 $1)) '(:sequence)))
> + (sequence
> + {
> + %component-type-lists
> + }
> + #'(lambda ($1 $2 $3 $4)
> + (declare (ignore $4 $2 $1))
> + `(:sequence ,@$3))))
> + (%component-type-lists (%root-component-type-list #'(lambda ($1)
> $1)))
> + (%root-component-type-list (%component-type-list #'(lambda ($1)
> $1)))
> + (%component-type-list
> + (%component-type #'(lambda ($1) `(,$1)))
> + (%component-type-list
> + \,
> + %component-type
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,@$1 ,$3))))
> + (%component-type
> + (%named-type
> + optional
> + #'(lambda ($1 $2) (declare (ignore $2)) `(,$1 :optional)))
> + (%named-type
> + default
> + %value
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,$1 :default ,$3)))
> + (%named-type #'(lambda ($1) $1))
> + (components
> + of
> + %type
> + #'(lambda ($1 $2 $3)
> + (declare (ignore $2 $1))
> + `(:components-of ,$3))))
> + (%textual-convention-type
> + (textual-convention
> + %tc-args
> + syntax
> + %type
> + #'(lambda ($1 $2 $3 $4)
> + (declare (ignore $3 $1))
> + `(:textual-convention ,$2 (:syntax ,$4)))))
> + (%tc-args
> + (%tc-arg #'(lambda ($1) `(,$1)))
> + (%tc-args %tc-arg #'(lambda ($1 $2) `(,@$1 ,$2))))
> + (%tc-arg
> + (:id :id #'(lambda ($1 $2) `(,$1 ,$2)))
> + (:id :string #'(lambda ($1 $2) `(,$1 ,$2))))
> + (%symbol+
> + (%symbol #'(lambda ($1) `(,$1)))
> + (%symbol+
> + \,
> + %symbol
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,@$1 ,$3))))
> + (%implied-symbol+
> + (%implied-symbol #'(lambda ($1) `(,$1)))
> + (%implied-symbol+
> + \,
> + %implied-symbol
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,@$1 ,$3))))
> + (%symbol*
> + (%symbol #'(lambda ($1) `(,$1)))
> + (%symbol*
> + \,
> + %symbol
> + #'(lambda ($1 $2 $3) (declare (ignore $2)) `(,@$1 ,$3)))
> + nil)
> + (%symbol (%macro-name #'(lambda ($1) $1)) (:id #'(lambda ($1) $1)))
> + (%implied-symbol
> + (:id #'(lambda ($1) $1))
> + (implied
> + :id
> + #'(lambda ($1 $2) (declare (ignore $1)) `(:implied ,$2))))
> + (%macro-name
> + (module-identity #'(lambda ($1) $1))
> + (object-type #'(lambda ($1) $1))
> + (notification-type #'(lambda ($1) $1))
> + (textual-convention #'(lambda ($1) $1))
> + (module-compliance #'(lambda ($1) $1))
> + (object-group #'(lambda ($1) $1))
> + (notification-group #'(lambda ($1) $1))
> + (object-identity #'(lambda ($1) $1))
> + (agent-capabilities #'(lambda ($1) $1))
> + (trap-type #'(lambda ($1) $1)))
> + (%general-list
> + (%general #'(lambda ($1) `(,$1)))
> + (%general-list
> + \,
> + %general
> + #'(lambda ($1 $2 $3) (declare (ignore $3)) `(,@$1 ,$2)))
> + (%general-list %general #'(lambda ($1 $2) `(,@$1 ,$2))))
> + (%general
> + (:number #'(lambda ($1) $1))
> + (:id #'(lambda ($1) $1))
> + (:string #'(lambda ($1) $1))
> + (\:\:= #'(lambda ($1) $1))
> + (\( #'(lambda ($1) $1))
> + (\) #'(lambda ($1) $1))
> + (\| #'(lambda ($1) $1))
> + ({ #'(lambda ($1) $1))
> + (} #'(lambda ($1) $1))
> + (< #'(lambda ($1) $1))
> + (> #'(lambda ($1) $1))
> + (type #'(lambda ($1) $1))
> + (value #'(lambda ($1) $1))
> + (notation #'(lambda ($1) $1))
> + (sequence #'(lambda ($1) $1))
> + (object #'(lambda ($1) $1))
> + (identifier #'(lambda ($1) $1))
> + (integer #'(lambda ($1) $1))
> + (|IA5String| #'(lambda ($1) $1))))
> +
> +
> +
> Index: compiler/syntax.lisp
> ===================================================================
> --- compiler/syntax.lisp (revision 706)
> +++ compiler/syntax.lisp (working copy)
> @@ -44,6 +44,7 @@
> (eval-when (:load-toplevel :execute)
> (fill-reserved-words))
>
> +#+lispworks
> (defparser asn.1-parser
> ((%root %module-definition) $1)
> ((root assignment) $1)
>
>
> For reference here is the patch to cl-yacc needed to resolve the
> ambiguities in the same way as parsergen does.
>
> diff -rN -u old-cl-yacc/yacc.lisp new-cl-yacc/yacc.lisp
> --- old-cl-yacc/yacc.lisp 2009-02-06 14:04:14.000000000 +0900
> +++ new-cl-yacc/yacc.lisp 2009-02-06 14:04:14.000000000 +0900
> @@ -808,9 +808,10 @@
> (define-condition conflict-warning (yacc-compile-warning simple-
> warning)
> ((kind :initarg :kind :reader conflict-warning-kind)
> (state :initarg :state :reader conflict-warning-state)
> - (terminal :initarg :terminal :reader conflict-warning-terminal))
> + (terminal :initarg :terminal :reader conflict-warning-terminal)
> + (chosen-action :initarg :chosen-action :reader conflict-warning-
> chosen-action :initform nil))
> (:report (lambda (w stream)
> - (format stream "~A conflict on terminal ~S in state
> ~A, ~_~?"
> + (format stream "~A conflict on terminal ~S in state
> ~A, ~_~?, ~@[taking action ~A~]"
> (case (conflict-warning-kind w)
> (:shift-reduce "Shift/Reduce")
> (:reduce-reduce "Reduce/Reduce")
> @@ -818,7 +819,8 @@
> (conflict-warning-terminal w)
> (conflict-warning-state w)
> (simple-condition-format-control w)
> - (simple-condition-format-arguments w)))))
> + (simple-condition-format-arguments w)
> + (conflict-warning-chosen-action w)))))
>
> (define-condition conflict-summary-warning (yacc-compile-warning)
> ((shift-reduce :initarg :shift-reduce
> @@ -885,19 +887,26 @@
> (if (tailp op2-tail (cdr op1-tail))
> (values a1 0 0)
> (values a2 0 0))))))))
> - ;; default: prefer shift or first production
> - (unless muffle-conflicts
> - (warn (make-condition
> - 'conflict-warning
> - :kind (typecase a1
> + ;; default: prefer first defined production
> + (let ((kind (typecase a1
> (shift-action :shift-reduce)
> - (t :reduce-reduce))
> + (t :reduce-reduce)))
> + (chosen-action
> + (if (production< p1 p2)
> + a1
> + a2)))
> + (unless muffle-conflicts
> + (warn (make-condition
> + 'conflict-warning
> + :kind kind
> :state id :terminal s
> :format-control "~S and ~S~@[ ~_~A~]~@[ ~_~A~]"
> - :format-arguments (list a1 a2 p1 p2))))
> - (typecase a1
> - (shift-action (values a1 1 0))
> - (t (values a1 0 1)))))
> + :format-arguments (list a1 a2 p1 p2)
> + :chosen-action chosen-action)))
> + (values chosen-action
> + (if (eq kind :shift-reduce) 1 0)
> + (if (eq kind :reduce-reduce) 1 0)))))
> +
>
> (defun compute-parsing-tables (kernels grammar
> &key muffle-conflicts)
>
>
>
> And if anybody is interested in converting from parsergen syntax to
> cl-yacc syntax, here are some helper functions
>
> (defun defparser-production-to-yacc (grammar-symbols forms)
> (cond ((not (and forms (or (not (listp forms)) (some 'identity
> forms))))
> nil)
> (t
> (labels ((make-var (i)
> (intern (format nil "$~D" i)))
> (vars ()
> (loop for i from 1 for x in grammar-symbols collect (make-var
> i)))
> (used-vars ()
> (remove-duplicates
> (loop for sym in (alexandria:flatten forms)
> when (and (symbolp sym) (eql #\$ (elt (symbol-name sym) 0))
> (ignore-errors (parse-integer (symbol-name sym) :start 1)))
> collect (make-var (parse-integer (symbol-name sym) :start 1)))
> :test 'eql)))
> (let ((unused-vars (set-difference (vars) (used-vars))))
> (list `#'(lambda(,@(vars))
> ,@(when unused-vars (list `(declare (ignore ,@unused-vars))))
> ,forms)))))))
>
> (defun defparser-to-yacc (rules)
> (let (grouped-rules)
> (loop for rule in rules do
> (destructuring-bind ((non-terminal &rest grammar-symbols)
> &optional forms)
> rule
> (assert non-terminal)
> (push (append grammar-symbols (defparser-production-to-yacc
> grammar-symbols forms))
> (sys:cdr-assoc non-terminal grouped-rules))))
> (loop for (name . alternatives) in (nreverse grouped-rules)
> collect `(,name ,@(reverse alternatives)))))
--
Chun Tian (binghe)
NetEase.com, Inc.
P. R. China
|