step-toybox-commits — List receives commit messages from the SCM

[Step-toybox-commits] SF.net SVN: step-toybox:[16] trunk/src/apps/tool/misc.lisp

[<cla...@us...>]

Revision: 16
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=16&view=rev
Author:   clanning
Date:     2008-07-22 14:25:35 +0000 (Tue, 22 Jul 2008)

Log Message:
-----------
Remove expression-def

Modified Paths:
--------------
    trunk/src/apps/tool/misc.lisp

Modified: trunk/src/apps/tool/misc.lisp
===================================================================
--- trunk/src/apps/tool/misc.lisp	2008-07-22 14:24:52 UTC (rev 15)
+++ trunk/src/apps/tool/misc.lisp	2008-07-22 14:25:35 UTC (rev 16)
@@ -210,17 +210,3 @@
     (setf ids (loop collect (get-token stream)
 		    until (eql (get-token stream) #\:)))
     (setf type (parse-exp nil 'parameter-type stream))))
-
-(define-object EXPRESSION-DEF ()
-    ((tokens))
-  )
-
-;; ??? expression = ?????? .
-(defmethod PARSE-EXP (def (tag (eql 'expression)) stream)
-  (declare (ignore def))
-  (let ((new (make-instance 'expression-def)))
-    (setf (tokens new)
-	  (loop for token = (get-token stream)
-	    until (eql token #\;)
-	    collect token))
-    new))


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Step-toybox-commits] SF.net SVN: step-toybox:[15] trunk/src/apps/tool/globals.lisp

[<cla...@us...>]

Revision: 15
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=15&view=rev
Author:   clanning
Date:     2008-07-22 14:24:52 +0000 (Tue, 22 Jul 2008)

Log Message:
-----------
Clean up

Modified Paths:
--------------
    trunk/src/apps/tool/globals.lisp

Modified: trunk/src/apps/tool/globals.lisp
===================================================================
--- trunk/src/apps/tool/globals.lisp	2008-07-22 14:24:10 UTC (rev 14)
+++ trunk/src/apps/tool/globals.lisp	2008-07-22 14:24:52 UTC (rev 15)
@@ -90,11 +90,21 @@
             prefix (eql status :released) status system branch)
     (format stream "~D.~D~@[ (~A)~]~@[ ~A~]~%" major minor eco suffix)))
 
+(defmethod GENERATE ((view (eql :header)) schema stream &key prefix suffix)
+  (format stream "~@[~A ~]From file ~A~@[ ~A~]~%" prefix (file schema) suffix)
+  (loop for slot in '(types entities rules functions procedures)
+    as vals = (slot-value schema slot)
+    when vals
+    do (format stream "~@[~A ~]~10@<~A:~> ~D~@[ ~A~]~%" prefix
+	       (string-capitalize slot) (length vals) suffix)))
+
 (defmethod GENERATE (view (object cl:Symbol) stream &key quiet)
   (declare (ignore view))
   (unless quiet (format t "~% WARNING -- ~A was never resolved!" object))
-  (cond ((member object '(self true false exists query typeof oneof sizeof rolesof usedin not))
+  (cond ((member object '(self true false exists query typeof oneof sizeof rolesof usedin))
          (princ object stream))
+	((member object '(not))
+	 (format stream "~A " object))
         ((member object '(xor or and andor in mod))
          (format stream " ~A " object))
         (t (princ (string-downcase object) stream))))


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Step-toybox-commits] SF.net SVN: step-toybox:[14] trunk/src/apps/tool/gen/gen-flat.lisp

[<cla...@us...>]

Revision: 14
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=14&view=rev
Author:   clanning
Date:     2008-07-22 14:24:10 +0000 (Tue, 22 Jul 2008)

Log Message:
-----------
Add new file for writing a flattened schema

Added Paths:
-----------
    trunk/src/apps/tool/gen/gen-flat.lisp

Added: trunk/src/apps/tool/gen/gen-flat.lisp
===================================================================
--- trunk/src/apps/tool/gen/gen-flat.lisp	                        (rev 0)
+++ trunk/src/apps/tool/gen/gen-flat.lisp	2008-07-22 14:24:10 UTC (rev 14)
@@ -0,0 +1,357 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: EXP; Base: 10 -*-
+
+#-Genera
+(in-package :EXPRESS-TOOL)
+
+
+(defmethod generate ((view (eql :flat)) (schema schema-def) (file string) &rest options)
+  (apply #'generate view schema (pathname file) options))
+
+(defmethod generate ((view (eql :flat)) (schema schema-def) (file pathname) &rest options)
+  (with-open-file (str file :direction :output :if-exists :supersede)
+    (generate view :top str :schema schema)
+    (terpri str)
+    (generate view schema str)))
+
+(defmethod generate ((view (eql :flat)) (tag (eql :top)) stream
+		     &key combine quiet schema)
+  (princ "-- -*- Mode: EXPRESS -*-" stream) (terpri stream) (terpri stream)
+  (princ "-- Flattened EXPRESS file" stream) (terpri stream)
+  (generate :sys-ver nil stream :prefix "--")
+  (generate :header schema stream :prefix "--"))
+
+;;;
+;;; Generate Flat EXPRESS
+;;;
+
+(defmethod generate ((view (eql :flat)) (schema schema-def) stream &key)
+  (with-slots (constants types entities rules functions procedures) schema
+    (format stream "~&SCHEMA ~A;~%" schema)
+    ;; reference from
+    ;; use from
+    (when constants
+      (format stream "~% CONSTANT")
+      (loop for const in constants
+	do (format stream "~%    ")
+	(generate view const stream))
+      (format stream "~% END_CONSTANT;~%"))
+    (loop for type in types
+      do (terpri stream) (generate view type stream))
+    (loop for ent in entities
+      do (terpri stream) (generate view ent stream))
+    (loop for rule in rules
+      do (terpri stream) (generate view rule stream))
+    (loop for fun in functions
+      do (terpri stream) (generate view fun stream))
+    (loop for proc in procedures
+      do (terpri stream) (generate view proc stream))
+    (format stream "~2&END_SCHEMA; -- ~A~%" schema)))
+
+(defmethod generate ((view (eql :flat)) (obj constant-def) stream &key name-only-p)
+  (with-slots (name base-type value) obj
+    (if name-only-p (princ (string-downcase name) stream)
+      (progn
+	(generate view obj stream :name-only-p t)
+	(princ " : " stream)
+	(generate view base-type stream :name-only-p t)
+	(princ " := " stream)
+	(generate view value stream)
+	(princ #\; stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj type-def) stream &key name-only-p)
+  (with-slots (name underlying where) obj
+    (if name-only-p (princ (string-downcase name) stream)
+      (progn
+	(format stream "TYPE ~A = " obj)
+	(generate view underlying stream :name-only-p t)
+	(princ #\; stream) (terpri stream)
+	(when where
+	  (princ " WHERE" stream)
+	  (loop for whr in where
+	    do (terpri stream) (princ "   " stream)
+	    (generate view whr stream))
+	  (terpri stream))
+	(princ "END_TYPE;" stream) (terpri stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj entity-def) stream &key name-only-p)
+  (with-slots (name abstract supertype-of subtype-of explicit-attr
+		    derive inverse unique where) obj
+    (if name-only-p (princ (string-downcase name) stream)
+      (progn
+	(princ "ENTITY " stream)
+	(generate view obj stream :name-only-p t)
+	(when abstract
+	  (terpri stream) (princ "   ABSTRACT SUPERTYPE" stream))
+	(when supertype-of
+	  (unless abstract (terpri stream) (princ "   SUPERTYPE" stream))
+	  (princ " OF " stream)
+	  (generate view supertype-of stream :name-only-p t))
+	(when subtype-of
+	  (terpri stream) (princ "    SUBTYPE OF (" stream)
+	  (loop for subs on subtype-of
+	    as sub = (first subs)
+	    do (generate view sub stream :name-only-p t)
+	    when (rest subs) do (princ ", " stream))
+	  (princ ")" stream))
+	(princ ";" stream)
+
+	;; Explicit Attributes
+	(loop for attr in (collect-inherited :explicit obj)
+	  do (terpri stream) (princ "   " stream)
+	  (generate view attr stream :qualify-p (not (eql obj (entity attr)))))
+
+	;; Derived Attributes
+	(let ((derives (collect-inherited :derive obj)))
+	  (when derives
+	    (terpri stream) (princ " DERIVE" stream)
+	    (loop for attr in derives
+	      do (terpri stream) (princ "   " stream)
+	      (generate view attr stream :qualify-p (not (eql obj (entity attr)))))))
+
+	;; Inverse Attributes
+	(let ((inverses (collect-inherited :inverse obj)))
+	  (when inverses
+	    (terpri stream) (princ " INVERSE" stream)
+	    (loop for attr in inverses
+	      do (terpri stream) (princ "   " stream)
+	      (generate view attr stream :qualify-p (not (eql obj (entity attr)))))))
+
+	;; Unique Clauses
+	(let ((uniques (collect-inherited :unique obj)))
+	  (when uniques
+	    (terpri stream) (princ " UNIQUE" stream)
+	    (loop for attr in uniques
+	      do (terpri stream) (princ "   " stream)
+	      (generate view attr stream :qualify-p (not (eql obj (entity attr)))))))
+
+	;; Where Clauses
+	(let ((wheres (collect-inherited :where obj)))
+	  (when wheres
+	    (terpri stream) (princ " WHERE" stream)
+	    (loop for attr in wheres
+	      do (terpri stream) (princ "   " stream)
+	      (generate view attr stream :qualify-p (not (eql obj (definition attr)))))))
+	(terpri stream) (princ "END_ENTITY;" stream) (terpri stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj rule-def) stream &key name-only-p)
+  (with-slots (name) obj
+    (if name-only-p (princ (string-downcase name) stream)
+      (progn
+	(princ "-- RULE " stream)
+	(generate view obj stream :name-only-p t)
+	(princ ";" stream) (terpri stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj function-def) stream &key name-only-p)
+  (with-slots (name) obj
+    (if name-only-p (princ (string-downcase name) stream)
+      (progn
+	(princ "-- FUNCTION " stream)
+	(generate view obj stream :name-only-p t)
+	(princ ";" stream) (terpri stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj procedure-def) stream &key name-only-p)
+  (with-slots (name) obj
+    (if name-only-p (princ (string-downcase name) stream)
+      (princ
+       (princ "-- PROCEDURE " stream)
+       (generate view obj stream :name-only-p t)
+       (princ ";" stream) (terpri stream)))))
+
+
+;; ----------------------------------------------------------------------
+
+(defmethod generate ((view (eql :flat)) (obj Simple-Type) stream &key)
+  (princ (type-of obj) stream))
+
+(defmethod generate ((view (eql :flat)) (obj Select-Type) stream &key)
+  (with-slots (types) obj
+    (princ "SELECT (" stream)
+    (loop for items on types
+      do (terpri stream) (princ "  " stream)
+      (generate view (first items) stream :name-only-p t)
+      when (rest items) do (princ ", " stream))
+    (princ ")" stream)))
+
+(defmethod generate ((view (eql :flat)) (obj Enumeration-Type) stream &key)
+  (with-slots (enum-vals) obj
+    (princ "ENUMERATION OF (" stream)
+    (loop for items on enum-vals
+      do (terpri stream) (princ "  " stream)
+      (princ (string-downcase (first items)) stream)
+      when (rest items) do (princ ", " stream))
+    (princ ")" stream)))
+
+(defmethod generate ((view (eql :flat)) (obj supertype-of) stream &key)
+  (with-slots (expression) obj
+    (unless (typep expression '(or super-and super-andor))
+      (princ #\( stream))
+    (generate view expression stream :name-only-p t)
+    (unless (typep expression '(or super-and super-andor))
+      (princ #\) stream))))
+
+(defmethod generate ((view (eql :flat)) (obj super-and) stream &key)
+  (with-slots (contents) obj
+    (princ #\( stream)
+    (loop for items on contents
+      as item = (first items)
+      do (generate view item stream :name-only-p t)
+      when (rest items) do (princ " AND " stream))
+    (princ #\) stream)))
+
+(defmethod generate ((view (eql :flat)) (obj super-andor) stream &key)
+  (with-slots (contents) obj
+    (princ #\( stream)
+    (loop for items on contents
+      as item = (first items)
+      do (generate view item stream :name-only-p t)
+      when (rest items) do (princ " ANDOR " stream))
+    (princ #\) stream)))
+
+(defmethod generate ((view (eql :flat)) (obj super-oneof) stream &key)
+  (with-slots (contents) obj
+    (princ "ONEOF(" stream)
+    (loop for items on contents
+      as item = (first items)
+      do (generate view item stream :name-only-p t)
+      when (rest items) do (princ ", " stream))
+    (princ #\) stream)))
+
+(defmethod generate ((view (eql :flat)) (obj attrib-def) stream &key qualify-p name-only-p)
+  (with-slots (optional? type) obj
+    (if name-only-p
+	(let ((name obj) (entity))
+	  (loop until (symbolp name)
+	    do (setf entity (entity name))
+	    (setf name (name name)))
+	  (format stream "~:[~(~A~).~;~*~]~(~A~)"
+		  (null qualify-p) (name entity) name))
+      (progn
+	(generate view obj stream :name-only-p t :qualify-p qualify-p)
+	(princ ": " stream)
+	(when optional? (princ "OPTIONAL " stream))
+	(generate view type stream :name-only-p t)
+	(princ #\; stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj derive-attr) stream &key qualify-p name-only-p)
+  (with-slots (type computation) obj
+    (if name-only-p
+	(let ((name obj) (entity))
+	  (loop until (symbolp name)
+	    do (setf entity (entity name))
+	    (setf name (name name)))
+	  (format stream "~:[~(~A~).~;~*~]~(~A~)"
+		  (null qualify-p) (name entity) name))
+      (progn
+	(generate view obj stream :qualify-p qualify-p :name-only-p t)
+	(princ ": " stream)
+	(generate view type stream :name-only-p t)
+	(princ " := " stream)
+	(generate view computation stream)
+	(princ #\; stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj inverse-attr) stream &key qualify-p name-only-p)
+  (with-slots (agg-name bound-1 bound-2 type attr-ref) obj
+    (if name-only-p
+	(let ((name obj) (entity))
+	  (loop until (symbolp name)
+	    do (setf entity (entity name))
+	    (setf name (name name)))
+	  (format stream "~:[~(~A~).~;~*~]~(~A~)"
+		  (null qualify-p) (name entity) name))
+      (progn
+	(generate view obj stream :qualify-p qualify-p :name-only-p t)
+	(princ ": " stream)
+	(when agg-name
+	  (format stream "~A~@[ [~A:~:[?~;~:*~A~]]~] OF "
+		  agg-name bound-1 bound-2))
+	(generate view type stream :name-only-p t)
+	(princ " FOR " stream)
+	(generate view attr-ref stream :name-only-p t)
+	(princ #\; stream)))))
+
+(defmethod generate ((view (eql :flat)) (obj aggregate) stream &key)
+  (with-slots (bound-1 bound-2 type) obj
+    (princ (type-of obj) stream)
+    (when bound-1 (format stream " [~D:~:[?~;~:*~D~]]" bound-1 bound-2))
+    (princ " OF " stream)
+    (generate view type stream :name-only-p t)))
+
+(defmethod generate ((view (eql :flat)) (obj unique-rule) stream &key qualify-p)
+  (with-slots (entity name attributes) obj
+    (when name (format stream "~:[~(~A~).~;~*~]~A: " (null qualify-p) (name entity) name))
+    (labels ((attr-name (obj)
+	       (if (symbolp (name obj)) (name obj) (attr-name (name obj))))
+	     (find-attr (name obj)
+	       (or (loop for super in (subtype-of obj)
+		     as attr = (find-attr name super)
+		     when attr return attr)
+		   (find name (explicit-attr obj) :key #'attr-name)
+		   (find name (derive obj) :key #'attr-name)
+		   (find name (inverse obj) :key #'attr-name))))
+      (loop for attrs on attributes
+	as attr = (first attrs)
+	as sattr = (find-attr (attr-name attr) entity) ;; qualifier)
+	do (generate view attr stream :name-only-p t)
+	when (rest attrs) do (princ ", " stream)))
+    (princ #\; stream)))
+
+(defmethod generate ((view (eql :flat)) (obj where-rule) stream &key qualify-p)
+  (with-slots (name definition expression) obj
+    (when (and (name-boundp obj) name)
+      (format stream "~:[~(~A~).~;~*~]~A: " (null qualify-p) (name definition) name))
+    (generate view expression stream)
+    (princ #\; stream)))
+
+(defmethod generate ((view (eql :flat)) (obj expression) stream &key)
+  (with-slots ((tkns tokens)) obj
+    (loop for tokens on tkns
+      as token = (first tokens)
+      do (generate view token stream))))
+
+
+;; ----------------------------------------------------------------------
+
+;(defmethod GENERATE-ATTR ((view (eql :flat)) (obj Entity-Def) stream
+;			  (type (eql :where-rule)) entity &key)
+;  (dolist (super (subtype-of obj))
+;    (generate-attr view super stream type entity))
+;  (dolist (attr (where obj))
+;    (format stream "~%   ~:[~A.~;~*~]" (eql obj entity)
+;	    (string-downcase (name obj)))
+;    (generate view attr stream)))
+
+;(defmethod GENERATE-ATTR ((view (eql :flat)) (obj Entity-Def) stream
+;			  (type (eql :explicit-attr)) entity &key)
+;  (dolist (super (subtype-of obj))
+;    (generate-attr view super stream type entity))
+;  (dolist (attr (explicit-attr obj))
+;    (format stream "~%   ~:[~A.~;~*~]" (eql obj entity)
+;	    (string-downcase (name obj)))
+;    (generate view attr stream)))
+
+;(defmethod GENERATE-ATTR ((view (eql :flat)) (obj Entity-Def) stream
+;			  (type (eql :derive)) entity &key)
+;  (dolist (super (subtype-of obj))
+;    (generate-attr view super stream type entity))
+;  (dolist (attr (derive obj))
+;    (format stream "~%   ~:[~A.~;~*~]" (eql obj entity)
+;	    (string-downcase (name obj)))
+;    (generate view attr stream)))
+
+;(defmethod GENERATE-ATTR ((view (eql :flat)) (obj Entity-Def) stream
+;			  (type (eql :inverse)) entity &key)
+;  (dolist (super (subtype-of obj))
+;    (generate-attr view super stream type entity))
+;  (dolist (attr (inverse obj))
+;    (format stream "~%   ~:[~A.~;~*~]" (eql obj entity)
+;	    (string-downcase (name obj)))
+;    (generate view attr stream)))
+
+;(defmethod GENERATE-ATTR ((view (eql :flat)) (obj Entity-Def) stream
+;			  (type (eql :unique)) entity &key)
+;  (dolist (super (subtype-of obj))
+;    (generate-attr view super stream type entity))
+;  (dolist (attr (unique obj))
+;    (format stream "~%   ~:[~A.~;~*~]" (eql obj entity)
+;	    (string-downcase (name obj)))
+;    (generate view attr stream)))


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Step-toybox-commits] SF.net SVN: step-toybox:[13] trunk/src/apps/tool/attribute.lisp

[<cla...@us...>]

Revision: 13
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=13&view=rev
Author:   clanning
Date:     2008-07-21 19:31:45 +0000 (Mon, 21 Jul 2008)

Log Message:
-----------
Fixed parsing of INVERSE attributes

Modified Paths:
--------------
    trunk/src/apps/tool/attribute.lisp

Modified: trunk/src/apps/tool/attribute.lisp
===================================================================
--- trunk/src/apps/tool/attribute.lisp	2008-05-23 16:24:04 UTC (rev 12)
+++ trunk/src/apps/tool/attribute.lisp	2008-07-21 19:31:45 UTC (rev 13)
@@ -147,14 +147,12 @@
 	(princ obj stream))
       (princ (string-downcase (name obj)) stream)))
 
-;; 227 inverse_attr = attribute_id ':' [ ( SET | BAG ) [ bound_spec ] OF ] entity_ref
-;;			FOR attribute_ref ';' .
+;; 234 inverse_attr = attribute_decl ':' [ ( SET | BAG ) [ bound_spec ] OF ] entity_ref
+;;                    FOR attribute_ref ';' .
+;; 167 attribute_decl = attribute_id | qualified_attribute .
 (defmethod PARSE-EXP ((obj Null) (tag (eql 'inverse-attr)) stream)
-  (when (eql (peek-token stream) #\:)
-    (put-token (%%unique-id :inverse) stream)
-    (format t "~%Unnamed inverse attribute; will be named ~A" (peek-token stream)))
-  (let ((new (make-instance 'inverse-attr :entity entity-def
-			    :name (get-token stream))))
+  (let ((new (make-instance 'inverse-attr :entity entity-def)))
+    (setf (name new) (parse-exp nil 'attribute-decl stream))
     (assert (eql (get-token stream) #\:) ()
 	    "Colon (:) expected after inverse attribute name")
     (when (member (peek-token stream) '(set bag))
@@ -172,7 +170,14 @@
 	    "Semicolon (;) expected after inverse attribute")
     new))
 
-(defmethod RESOLVE-REF ((obj Inverse-Attr) objs &key)
-  (declare (ignore objs))
-  (call-next-method)
-  (setf (attr-ref obj) (resolve-ref (attr-ref obj) (type obj) :explicit-only t)))
+(defmethod RESOLVE-REF ((obj Inverse-Attr) objs &key keys)
+  (when (consp (name obj))
+    ;; Resolve the name
+    (let ((ent (resolve-ref (first (name obj)) objs :entity-only t)))
+      (unless ent (error "Entity ~A was not found" (first (name obj))))
+      (setf (name obj) (apply #'resolve-ref (cdr (name obj)) ent keys))))
+  ;; resolve entity reference
+  (setf (type obj) (apply #'resolve-ref (type obj) objs keys))
+  ;; resolve attribute reference
+  (setf (attr-ref obj) (resolve-ref (attr-ref obj) (type obj) :explicit-only t :local-only nil))
+  obj)


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Step-toybox-commits] SF.net SVN: step-toybox: [12] trunk/src/apps/tool

[<cla...@us...>]

Revision: 12
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=12&view=rev
Author:   clanning
Date:     2008-05-23 09:24:04 -0700 (Fri, 23 May 2008)

Log Message:
-----------
initial checkin of EXPRESS Tool code

Added Paths:
-----------
    trunk/src/apps/tool/00todo.txt
    trunk/src/apps/tool/aggregates.lisp
    trunk/src/apps/tool/attribute.lisp
    trunk/src/apps/tool/base.lisp
    trunk/src/apps/tool/constructed-types.lisp
    trunk/src/apps/tool/doc/iso-10303-11--1994-raw.bnf
    trunk/src/apps/tool/doc/iso-10303-11--1994.bnf
    trunk/src/apps/tool/doc/iso-10303-11--2004-raw.bnf
    trunk/src/apps/tool/doc/iso-10303-11--2004.bnf
    trunk/src/apps/tool/entity.lisp
    trunk/src/apps/tool/function.lisp
    trunk/src/apps/tool/gen/gen-exp.lisp
    trunk/src/apps/tool/globals.lisp
    trunk/src/apps/tool/macros.lisp
    trunk/src/apps/tool/misc.lisp
    trunk/src/apps/tool/object.lisp
    trunk/src/apps/tool/package.lisp
    trunk/src/apps/tool/procedure.lisp
    trunk/src/apps/tool/read-exp.lisp
    trunk/src/apps/tool/rule.lisp
    trunk/src/apps/tool/schema.lisp
    trunk/src/apps/tool/system.lisp
    trunk/src/apps/tool/type.lisp

Property Changed:
----------------
    trunk/src/apps/tool/
    trunk/src/apps/tool/gen/


Property changes on: trunk/src/apps/tool
___________________________________________________________________
Name: svn:ignore
   + *.fasl


Added: trunk/src/apps/tool/00todo.txt
===================================================================
--- trunk/src/apps/tool/00todo.txt	                        (rev 0)
+++ trunk/src/apps/tool/00todo.txt	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,28 @@
+
+			      To Do List
+
+ o  Add pres-to-cmd-trans for Read-Express command on blank-area
+    (get rid of annoying bogus menu)
+ o  check on crash in "Collect Dependent Entities"
+ o  Add code to generate HTML version of Schema
+ o  Add command to show "current modules"
+    o  name
+    o  version
+ o  Create document to specify the API used by "gen" modules
+
+ o  Add error handling code
+    o  error classes
+    o  handler-bind's
+    o  restart-bind's
+
+ o  Define generic "Presentation Method Definer" that is converted into
+    (define-presentation-method PRESENT) method when CLIM is present
+    and a more generic GENERATE method when CLIM not present.
+
+ o  Add support for reading/writing EXPRESS v2.
+
+ o  Keep "library" of IR's and AIC's that can be scanned when resolving
+    USE FROM and REFERENCE FROM.
+    o  USE FROM causes the referenced schema to be added to the schema
+    o  REFERENCE FROM requires that the referenced schema be present,
+       but doesn't add it.

Added: trunk/src/apps/tool/aggregates.lisp
===================================================================
--- trunk/src/apps/tool/aggregates.lisp	                        (rev 0)
+++ trunk/src/apps/tool/aggregates.lisp	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,217 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: EXP; Base: 10 -*-
+
+#-Genera
+(in-package :EXPRESS-TOOL)
+
+;;;
+;;; Aggregates
+;;;
+
+
+;; 159 aggregation_types = array_type | bag_type | list_type | set_type .
+(defmethod PARSE-EXP (obj (tag (eql 'aggregation-types)) stream)
+  (parse-exp obj (get-token stream) stream))
+
+;; 209 general_aggregation_types = general_array_type | general_bag_type
+;;				 | general_list_type | general_set_type .
+(defmethod PARSE-EXP (obj (tag (eql 'general-aggregation-types)) stream)
+  (case (get-token stream)
+    #|(aggregate )|#
+    (array (parse-exp obj 'general-array-type stream))
+    (bag (parse-exp obj 'general-bag-type stream))
+    (list (parse-exp obj 'general-list-type stream))
+    (set (parse-exp obj 'general-set-type stream))))
+
+  
+(define-object AGGREGATE ()
+    ((bound-1 integer)
+     (bound-2 integer)
+     (type base-type))
+  (:default-initargs :bound-1 nil :bound-2 nil))
+
+#+Clim-2
+(define-presentation-type AGGREGATE ()
+  :options (name-only-p))
+
+(defmethod PRINT-OBJECT ((obj Aggregate) stream)
+  (print-unreadable-object (obj stream :type t :identity t)
+    (format stream "~:[~*~;[~:*~A:~:[?~;~:*~A~]] ~]OF ~A"
+	    (bound-1 obj) (bound-2 obj) (type obj))))
+
+;; 174 bound_spec = '[' bound_1 ':' bound_2 ']' .
+;; 172 bound_1 = numeric_expression .
+;; 173 bound_2 = numeric_expression .
+(defmethod PARSE-EXP ((obj Aggregate) (tag (eql 'bounds)) stream)
+  (assert (eql (get-token stream) #\[) ()
+	  "Left Bracket ([) expected before bounds range")
+;  (setf (bound-1 obj) (parse-exp obj 'numeric-expression stream))
+  (setf (bound-1 obj) (get-token stream))
+  (assert (eql (get-token stream) #\:) ()
+	  "Colon (:) expected between bounds ranges")
+;  (setf (bound-2 obj) (parse-exp obj 'numeric-expression stream))
+  (setf (bound-2 obj) (get-token stream))
+  (when (eql (bound-2 obj) #\?) (setf (bound-2 obj) nil))
+  (assert (eql (get-token stream) #\]) ()
+	  "Right Bracket (]) expected before bounds range")
+  )
+
+(defmethod RESOLVE-REF ((obj Aggregate) objs &rest keys)
+  (setf (type obj) (apply #'resolve-ref (type obj) objs keys))
+  obj)
+
+(defmethod ADD-REF ((obj Aggregate) refr)
+  (add-ref (type obj) refr))
+
+;; ----------
+(define-object ARRAY (Aggregate)
+    ((optional? boolean)
+     (unique? boolean))
+  )
+
+#+Clim-2
+(define-presentation-type ARRAY ()
+  :options (name-only-p))
+
+;; 163 array_type = ARRAY bound_spec OF [ OPTIONAL ] [ UNIQUE ] base_type .
+;; 169 base_type = aggregation_types | simple_types | named_types .
+(defmethod PARSE-EXP (obj (tag (eql 'array)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'array)))
+    (setf (unique? new) nil)
+    (setf (optional? new) nil)
+    (parse-exp new 'bounds stream)
+    (assert (eql (get-token stream) 'of) ()
+	    "OF exptected after Bounds")
+    (when (eql (peek-token stream) 'optional)
+      (get-token stream)			; eat OPTIONAL
+      (setf (optional? new) t))
+    (when (eql (peek-token stream) 'unique)
+      (get-token stream)			; eat UNIQUE
+      (setf (unique? new) t))
+    (setf (type new) (parse-exp new 'base-type stream))
+    new))
+
+;; 210 general_array_type = ARRAY [ bound_spec ] OF [ OPTIONAL ] [ UNIQUE ] parameter_type .
+;; 246 parameter_type = generalized_types | named_types | simple_types .
+(defmethod PARSE-EXP (obj (tag (eql 'general-array-type)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'array)))
+    (setf (unique? new) nil)
+    (setf (optional? new) nil)
+    (when (eql (peek-token stream) #\[)
+      (parse-exp new 'bounds stream))
+    (assert (eql (get-token stream) 'of) ()
+	    "OF expected after Bounds")
+    (when (eql (peek-token stream) 'optional)
+      (get-token stream)			; eat OPTIONAL
+      (setf (optional? new) t))
+    (when (eql (peek-token stream) 'unique)
+      (get-token stream)			; eat UNIQUE
+      (setf (unique? new) t))
+    (setf (type new) (parse-exp new 'parameter-type stream))
+    new))
+
+;; ----------
+(define-object BAG (Aggregate) ())
+
+#+Clim-2
+(define-presentation-type BAG ()
+  :options (name-only-p))
+
+;; 168 bag_type = BAG [ bound_spec ] OF base_type .
+;; 169 base_type = aggregate_types | simple_types | named_types .
+(defmethod PARSE-EXP (obj (tag (eql 'bag)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'bag)))
+    (when (eql (peek-token stream) #\[)
+      (parse-exp new 'bounds stream))
+    (assert (eql (get-token stream) 'of) ()
+	    "OF exptected after Bounds")
+    (setf (type new) (parse-exp new 'base-type stream))
+    new))
+
+;; 211 general_bag_type = BAG [ bound_spec ] OF parameter_type .
+;; 246 parameter_type = generalized_types | named_types | simple_types .
+(defmethod PARSE-EXP (obj (tag (eql 'general-bag-type)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'bag)))
+    (when (eql (peek-token stream) #\[)
+      (parse-exp new 'bounds stream))
+    (assert (eql (get-token stream) 'of) ()
+	    "OF exptected after Bounds")
+    (setf (type new) (parse-exp new 'parameter-type stream))
+    new))
+
+;; ----------
+(define-object LIST (Aggregate)
+    ((unique? boolean))
+  )
+
+#+Clim-2
+(define-presentation-type LIST ()
+  :options (name-only-p))
+
+;; 230 list_type = LIST [ bound_spec ] OF [ UNIQUE ] base_type .
+;; 169 base_type = aggregate_types | simple_types | named_types .
+(defmethod PARSE-EXP (obj (tag (eql 'list)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'list)))
+    (setf (unique? new) nil)
+    (when (eql (peek-token stream) #\[)
+      (parse-exp new 'bounds stream))
+    (assert (eql (get-token stream) 'of) ()
+	    "OF exptected after Bounds")
+    (when (eql (peek-token stream) 'unique)
+      (get-token stream) ;; eat UNIQUE
+      (setf (unique? new) t))
+    (setf (type new) (parse-exp new 'base-type stream))
+    new))
+
+;; 212 general_list_type = LIST [ bound_spec ] OF [ UNIQUE ] parameter_type .
+;; 246 parameter_type = generalized_types | named_types | simple_types .
+(defmethod PARSE-EXP (obj (tag (eql 'general-list-type)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'list)))
+    (setf (unique? new) nil)
+    (when (eql (peek-token stream) #\[)
+      (parse-exp new 'bounds stream))
+    (assert (eql (get-token stream) 'of) ()
+	    "OF exptected after Bounds")
+    (when (eql (peek-token stream) 'unique)
+      (get-token stream) ;; eat UNIQUE
+      (setf (unique? new) t))
+    (setf (type new) (parse-exp new 'parameter-type stream))
+    new))
+
+;; ----------
+(define-object SET (Aggregate)
+    ()
+  )
+
+#+Clim-2
+(define-presentation-type SET ()
+  :options (name-only-p))
+
+;; 278 set_type = SET [ bound_spec ] OF base_type .
+;; 169 base_type = aggregate_types | simple_types | named_types .
+(defmethod PARSE-EXP (obj (tag (eql 'set)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'set)))
+    (when (eql (peek-token stream) #\[)
+      (parse-exp new 'bounds stream))
+    (assert (eql (get-token stream) 'of) ()
+	    "OF exptected after Bounds")
+    (setf (type new) (parse-exp new 'base-type stream))
+    new))
+
+;; 214 general_set_type = SET [ bound_spec ] OF parameter_type .
+;; 246 parameter_type = generalized_types | named_types | simple_types .
+(defmethod PARSE-EXP (obj (tag (eql 'general-set-type)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'set)))
+    (when (eql (peek-token stream) #\[)
+      (parse-exp new 'bounds stream))
+    (assert (eql (get-token stream) 'of) ()
+	    "OF exptected after Bounds")
+    (setf (type new) (parse-exp new 'parameter-type stream))
+    new))
\ No newline at end of file

Added: trunk/src/apps/tool/attribute.lisp
===================================================================
--- trunk/src/apps/tool/attribute.lisp	                        (rev 0)
+++ trunk/src/apps/tool/attribute.lisp	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,178 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: EXP; Base: 10 -*-
+
+#-Genera
+(in-package :EXPRESS-TOOL)
+
+;;;
+;;; Attribute Definition
+;;;
+
+
+(define-object ATTRIB-DEF (Name-Mixin Object)
+    ((entity Entity-Def)
+     (optional? boolean)
+     (type base-type)
+     (%mapping (:set string)))
+  )
+
+#+Clim-2
+(define-presentation-type ATTRIB-DEF ()
+  :options (name-only-p qualifyp))
+
+(defmethod PRINT-OBJECT ((obj Attrib-Def) stream)
+  (labels ((rname (attr)
+	     (if (typep attr 'standard-object)
+		 (rname (name attr))
+		 attr)))
+    (if *print-escape*
+	(print-unreadable-object (obj stream :type t :identity t)
+	  (format stream "~A.~(~A~)" (entity obj) (rname obj)))
+	(format stream "~(~A~)" (rname obj)))))
+
+(defmethod INITIALIZE-INSTANCE :after ((obj Attrib-Def) &key)
+  (unless (slot-boundp obj 'optional?)
+    (setf (optional? obj) nil)))
+
+;;----------
+
+;; 201 explicit_attr = attribute_decl { ',' attribute_decl } ':'
+;;		       [ OPTIONAL ] base_type ';' .
+;; 165 attribute_decl = attribute_id | qualified_attribute .
+(defmethod PARSE-EXP ((obj Null) (tag (eql 'explicit-attr)) stream)
+  (let ((attribs (do* ((token (peek-token stream) (peek-token stream))
+		       (state #\,) (attrs nil))
+		      ((eql token #\:)
+		       (get-token stream)	;eat #\:
+		       (nreverse attrs))
+		   (if (eql token #\,)
+		       (when (eql state #\,)
+			 (warn "Extraneous comma (,) in Attrib def"))
+		       (progn
+			 (when (null state) (warn "Comma (,) missing in Attrib def"))
+			 (push (make-instance 'attrib-def :entity entity-def
+					      :name (parse-exp nil 'attribute-decl stream))
+			       attrs))))))
+    (when (null attribs)
+      (push (make-instance 'attrib-def :entity entity-def
+			   :name (%%unique-id :attrib))
+	    attribs)
+      (format t "~%Unnamed attribute; will be named ~A" (name (first attribs))))
+    (when (eql (peek-token stream) 'optional)
+      (get-token stream)			; eat OPTIONAL
+      (dolist (attrib attribs)
+	(setf (optional? attrib) t)))
+    (let ((btype (parse-exp nil 'base-type stream)))
+      (dolist (attrib attribs)
+	(setf (type attrib) btype)))
+    (let ((token (get-token stream)))
+      (assert (eql token #\;
+		   ) ()
+	      "Semicolon (;) expected after attribute"))
+    attribs))
+
+
+(defmethod RESOLVE-REF ((obj Attrib-Def) objs &rest keys)
+  (when (consp (name obj))
+    (let ((ent (resolve-ref (first (name obj)) objs :entity-only t)))
+      (unless ent (error "Entity ~A was not found" (first (name obj))))
+      (setf (name obj) (apply #'resolve-ref (cdr (name obj)) ent keys))))
+  (setf (type obj) (apply #'resolve-ref (type obj) objs keys)))
+
+(defmethod ADD-REF ((obj Attrib-Def) refr)
+  (add-ref (type obj) refr))
+
+;; ----------
+(define-object DERIVE-ATTR (Attrib-Def)
+    ((computation expression))
+  )
+
+#+Clim-2
+(define-presentation-type DERIVE-ATTR ()
+  :options (name-only-p qualifyp))
+
+;; 188 derive_attr = attribute_decl ':' base_type ':=' expression ';' .
+(defmethod PARSE-EXP ((obj Null) (tag (eql 'derive-attr)) stream)
+  (let ((new (make-instance 'derive-attr :entity entity-def)))
+    (setf (name new) (parse-exp nil 'attribute-decl stream))
+    (assert (eql (get-token stream) #\:) ()
+	    "Colon (:) expected after attribute_decl")
+    (setf (optional? new) nil)			;DERIVEd attr's are never OPTIONAL
+    (when (eql (peek-token stream) 'optional)
+      (get-token stream)			;eat OPTIONAL (even though it's wrong)
+      (warn "OPTIONAL found in DERIVE'd attribute ~A" new))
+    (setf (type new) (parse-exp obj 'base-type stream))
+    (assert (eql (get-token stream) :colon-equal) ()
+	    "':=' expected after base_type")
+    (setf (computation new) (parse-exp new 'expression stream))
+    new))
+
+
+;; ----------
+
+;; 165 attribute_decl = attribute_id | qualified_attribute .
+(defmethod PARSE-EXP ((obj Null) (tag (eql 'attribute-decl)) stream)
+  (if (eql (peek-token stream) 'self)
+      (parse-exp obj 'qualified-attribute stream)
+      (get-token stream)))
+
+;; 256 qualified_attribute = SELF group_qualifier attribute_qualifier .
+;; 217 group_qualifier = '\' entity_ref .
+;; 167 attribute_qualifier = '.' attribute_ref .
+(defmethod PARSE-EXP ((obj Null) (tag (eql 'qualified-attribute)) stream)
+  (get-token stream)				;eat SELF
+  (assert (eql (get-token stream) #\\) ()
+	    "Backslash (\\) expected after SELF")
+  (let (entity name)
+    (setf entity (get-token stream))
+    (assert (eql (get-token stream) #\.) ()
+	    "Period (.) expected after entity_ref")
+    (setf name (get-token stream))
+    (cons entity name)))
+
+;; ----------
+
+(define-object INVERSE-ATTR (Name-Mixin Aggregate)
+    ((entity Entity-Def)
+     (agg-name (member set bag))
+     (attr-ref attribute-def))
+  )
+
+#+Clim-2
+(define-presentation-type INVERSE-ATTR ()
+  :options (name-only-p qualifyp))
+
+(defmethod PRINT-OBJECT ((obj Inverse-Attr) stream)
+  (if *print-escape*
+      (print-unreadable-object (obj stream :type t :identity t)
+	(princ obj stream))
+      (princ (string-downcase (name obj)) stream)))
+
+;; 227 inverse_attr = attribute_id ':' [ ( SET | BAG ) [ bound_spec ] OF ] entity_ref
+;;			FOR attribute_ref ';' .
+(defmethod PARSE-EXP ((obj Null) (tag (eql 'inverse-attr)) stream)
+  (when (eql (peek-token stream) #\:)
+    (put-token (%%unique-id :inverse) stream)
+    (format t "~%Unnamed inverse attribute; will be named ~A" (peek-token stream)))
+  (let ((new (make-instance 'inverse-attr :entity entity-def
+			    :name (get-token stream))))
+    (assert (eql (get-token stream) #\:) ()
+	    "Colon (:) expected after inverse attribute name")
+    (when (member (peek-token stream) '(set bag))
+      (setf (agg-name new) (get-token stream))
+      (when (eql (peek-token stream) #\[)
+	(parse-exp new 'bounds stream))
+      (assert (eql (get-token stream) 'of) ()
+	      "OF expected after inverse aggregate spec"))
+    (setf (type new) (get-token stream))
+    (assert (eql (get-token stream) 'for) ()
+	    "FOR expected after inverse entity_ref")
+    (setf (attr-ref new) (get-token stream))
+    (assert (eql (get-token stream) #\;
+		 ) ()
+	    "Semicolon (;) expected after inverse attribute")
+    new))
+
+(defmethod RESOLVE-REF ((obj Inverse-Attr) objs &key)
+  (declare (ignore objs))
+  (call-next-method)
+  (setf (attr-ref obj) (resolve-ref (attr-ref obj) (type obj) :explicit-only t)))

Added: trunk/src/apps/tool/base.lisp
===================================================================
--- trunk/src/apps/tool/base.lisp	                        (rev 0)
+++ trunk/src/apps/tool/base.lisp	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,215 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: EXP; Base: 10 -*-
+
+#-Genera
+(in-package :EXPRESS-TOOL)
+
+;;;
+;;; Base Definitions
+;;;
+
+
+(defclass NAME-MIXIN ()
+    ((name :accessor name :initarg :name))
+  )
+
+(defmethod NAME-BOUNDP ((obj Name-Mixin))
+  (slot-boundp obj 'name))
+
+(defun TRUE-NAME (obj)
+  (if (symbolp (name obj))
+      (name obj)
+    (true-name (name obj))))
+
+(defmethod PRINT-OBJECT ((obj Name-Mixin) stream)
+  (if *print-escape*
+      (print-unreadable-object (obj stream :type t :identity t)
+	(princ (string-downcase (true-name obj)) stream))
+      (princ (string-downcase (true-name obj)) stream)))
+
+(defmethod HYPHENATE ((obj Name-Mixin) scase)
+  (with-slots (name) obj
+    (hyphenate name scase)))
+
+
+#+CLIM
+(define-presentation-type SYMBOL ()
+  :options (name-only-p))
+
+;; ----------------------------------------------------------------------
+;; Basic Definition
+
+(define-object DEFINITION ()
+    ()
+  )
+
+
+;; ----------------------------------------------------------------------
+;; Built-In Definition
+
+(define-object SIMPLE-TYPE () ())
+
+#+CLIM
+(define-presentation-type SIMPLE-TYPE ()
+  :options (name-only-p))
+
+;; 282 simple_types = binary_type | boolean_type | integer_type | logical_type
+;;		    | number_type | real_type | string_type .
+(defmethod PARSE-EXP (obj (tag (eql 'simple-types)) stream)
+  (parse-exp obj (get-token stream) stream))
+
+(defmethod RESOLVE-REF ((obj Simple-Type) objs &key)
+  (declare (ignore objs))
+  obj)
+
+(defmethod ADD-REF ((obj Simple-Type) refr)
+  (declare (ignore refr))
+  nil)
+
+;; ----------
+(define-object NUMBER (Simple-Type) ())
+
+#+CLIM
+(define-presentation-type NUMBER ()
+  :options (name-only-p))
+
+;; 241 number_type = NUMBER .
+(defmethod PARSE-EXP (obj (tag (eql 'number)) stream)
+  (declare (ignore obj stream))
+  (make-instance 'number))
+
+;; ----------
+(define-object REAL (Number)
+    ((precision))
+  )
+
+#+CLIM
+(define-presentation-type REAL ()
+  :options (name-only-p))
+
+;; 258 real_type = REAL [ '(' precision_spec ')' ] .
+;; 248 precision_spec = numeric_expression .
+(defmethod PARSE-EXP (obj (tag (eql 'real)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'real)))
+    (when (eql (peek-token stream) #\()
+      (get-token stream) ;; eat (
+      ;;(parse-exp new 'numeric-expression stream)
+      (setf (precision new)
+	    (do* ((result nil) (token (get-token stream) (get-token stream)))
+		 ((eql token #\)) (nreverse result))
+	      (push token result))))
+    new))
+
+;; ----------
+(define-object INTEGER (Number) ())
+
+#+CLIM
+(define-presentation-type INTEGER ()
+  :options (name-only-p))
+
+;; 222 integer_type = INTEGER .
+(defmethod PARSE-EXP (obj (tag (eql 'integer)) stream)
+  (declare (ignore obj stream))
+  (make-instance 'integer))
+
+;; ----------
+(define-object LOGICAL (Simple-Type) ()) ;; True, False, Unknown
+
+#+CLIM
+(define-presentation-type LOGICAL ()
+  :options (name-only-p))
+
+;; 236 logical_type = LOGICAL .
+(defmethod PARSE-EXP (obj (tag (eql 'logical)) stream)
+  (declare (ignore obj stream))
+  (make-instance 'logical))
+
+;; ----------
+(define-object BOOLEAN (Logical) ()) ;; True, False
+
+#+CLIM
+(define-presentation-type BOOLEAN ()
+  :options (name-only-p))
+
+;; 171 boolean_type = BOOLEAN .
+(defmethod PARSE-EXP (obj (tag (eql 'boolean)) stream)
+  (declare (ignore obj stream))
+  (make-instance 'boolean))
+
+;; ----------
+(define-object STRING (Simple-Type)
+    ((width)
+     (fixed?))
+  )
+
+#+CLIM
+(define-presentation-type STRING ()
+  :options (name-only-p))
+
+;; 286 string_type = STRING [ '(' width ')' [ FIXED ] ] .
+;; 306 width = numeric_expression .
+(defmethod PARSE-EXP (obj (tag (eql 'string)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'string)))
+    (when (eql (peek-token stream) #\()
+      (get-token stream) ;; eat (
+      ;;(parse-exp new 'numeric-expression stream)
+      (setf (width new)
+	    (do* ((result nil) (token (get-token stream) (get-token stream)))
+		 ((eql token #\)) (nreverse result))
+	      (push token result)))
+      (when (eql (peek-token stream) 'fixed)
+	(get-token stream) ;; eat FIXED
+	(setf (fixed? new) t)))
+    new))
+
+;; ----------
+(define-object BINARY (Simple-Type)
+    ((width)
+     (fixed?))
+  )
+
+#+CLIM
+(define-presentation-type BINARY ()
+  :options (name-only-p))
+
+;; 170 binary_type = BINARY [ '(' width ')' [ FIXED ] ] .
+;; 306 width = numeric_expression .
+(defmethod PARSE-EXP (obj (tag (eql 'binary)) stream)
+  (declare (ignore obj))
+  (let ((new (make-instance 'binary)))
+    (when (eql (peek-token stream) #\()
+      (get-token stream) ;; eat (
+      ;;(parse-exp new 'numeric-expression stream)
+      (setf (width new)
+	    (do* ((result nil) (token (get-token stream) (get-token stream)))
+		 ((eql token #\)) (nreverse result))
+	      (push token result)))
+      (when (eql (peek-token stream) 'fixed)
+	(get-token stream) ;; eat FIXED
+	(setf (fixed? new) t)))
+    new))
+
+;; ----------------------------------------------------------------------
+
+(define-object GENERIC-TYPE ()
+    ((label type-label :optional))
+  )
+
+#+CLIM
+(define-presentation-type GENERIC-TYPE ()
+  :options (name-only-p))
+
+;; 216 generic_type = GENERIC [ ':' type_label ] .
+(defmethod PARSE-EXP (obj (tag (eql 'generic-type)) stream)
+  (declare (ignore obj))
+  (get-token stream)				;eat GENERIC token
+  (let ((new (make-instance 'generic-type)))
+    (when (eql (peek-token stream) #\:)
+      (get-token stream)				;eat ':' token
+      (setf (label new) (get-token stream)))
+    new))
+
+(defmethod RESOLVE-REF ((obj Generic-Type) objs &key)
+  (declare (ignore objs))
+  obj)

Added: trunk/src/apps/tool/constructed-types.lisp
===================================================================
--- trunk/src/apps/tool/constructed-types.lisp	                        (rev 0)
+++ trunk/src/apps/tool/constructed-types.lisp	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,83 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: EXP; Base: 10 -*-
+
+#-Genera
+(in-package :EXPRESS-TOOL)
+
+;;;
+;;; Constructed Types
+;;;
+
+
+(define-object CONSTRUCTED-TYPE () ())
+
+;; 186 constructed_types = enumeration_type | select_type .
+(defmethod PARSE-EXP (obj (tag (eql 'constructed-types)) stream)
+  (parse-exp obj (get-token stream) stream))
+
+;; ----------
+
+(define-object ENUMERATION-TYPE (Constructed-Type)
+    ((enum-vals (:set string)))
+  )
+
+;; 199 enumeration_type = ENUMERATION OF '(' enumeration_id
+;;			  { ',' enumeration_id } ')' .
+(defmethod PARSE-EXP (obj (tag (eql 'enumeration)) stream)
+  (declare (ignore obj))
+  (assert (eql (get-token stream) 'of) ()
+	  "OF expected after ENUMERATION")
+  (assert (eql (get-token stream) #\() ()
+	  "'(' expected after OF")
+  (let ((new (make-instance 'enumeration-type)))
+    (setf (enum-vals new)
+	  (do ((token (get-token stream) (get-token stream))
+	       (state #\,) (vals nil))
+	      ((eql token #\)) (nreverse vals))
+	    (cond ((and (eql state #\,) (eql token #\,))
+		   (warn "Extraneous comma (,) found in ENUMERATION"))
+		  ((and (null state) (not (eql token #\,)))
+		   (warn "Comma (,) missing in ENUMERATION")
+		   (push token vals))
+		  ((eql token #\,) (setf state token))
+		  (t (push token vals) (setf state nil)))))
+    new))
+
+(defmethod RESOLVE-REF ((obj Enumeration-Type) objs &key)
+  (declare (ignore objs))
+  obj)
+
+;; ----------
+(define-object SELECT-TYPE (Constructed-Type)
+    ((types (:set named-types)))
+  )
+
+;; 276 select_type = SELECT '(' named_types { ',' named_types } ')' .
+(defmethod PARSE-EXP (obj (tag (eql 'select)) stream)
+  (declare (ignore obj))
+  (assert (eql (get-token stream) #\() ()
+	  "'(' expected after SELECT")
+  (let ((new (make-instance 'select-type)))
+    (setf (types new)
+	  (do ((token (get-token stream) (get-token stream))
+	       (state #\,) (vals nil))
+	      ((eql token #\)) (nreverse vals))
+	    (cond ((and (eql state #\,) (eql token #\,))
+		   (warn "Extraneous comma (,) found in SELECT"))
+		  ((and (null state) (not (eql token #\,)))
+		   (warn "Comma (,) missing in SELECT")
+		   (push token vals))
+		  ((eql token #\,) (setf state token))
+		  (t (push token vals) (setf state nil)))))
+    new))
+
+(defmethod RESOLVE-REF ((obj Select-Type) objs &rest keys)
+  (setf (types obj)
+	(do* ((types (types obj) (cdr types))
+	      (type (car types) (car types)) (result nil))
+	     ((null types) (nreverse result))
+	  (push (apply #'resolve-ref type objs keys) result)))
+  obj)
+
+(defmethod ADD-REF ((obj Select-Type) refr)
+  (dolist (type (types obj))
+    (add-ref type refr)))

Added: trunk/src/apps/tool/doc/iso-10303-11--1994-raw.bnf
===================================================================
--- trunk/src/apps/tool/doc/iso-10303-11--1994-raw.bnf	                        (rev 0)
+++ trunk/src/apps/tool/doc/iso-10303-11--1994-raw.bnf	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,321 @@
+;; iso-10303-11:1994 (no numbers)
+
+ABS = 'abs' .
+ABSTRACT = 'abstract' .
+ACOS = 'acos' .
+AGGREGATE = 'aggregate' .
+ALIAS = 'alias' .
+AND = 'and' .
+ANDOR = 'andor' .
+ARRAY = 'array' .
+AS = 'as' .
+ASIN = 'asin' .
+ATAN = 'atan' .
+BAG = 'bag' .
+BEGIN = 'begin' .
+BINARY = 'binary' .
+BLENGTH = 'blength' .
+BOOLEAN = 'boolean' .
+BY = 'by' .
+CASE = 'case' .
+CONSTANT = 'constant' .
+CONST_E = 'const_e' .
+CONTEXT = 'context' .
+COS = 'cos' .
+DERIVE = 'derive' .
+DIV = 'div' .
+ELSE = 'else' .
+END = 'end' .
+END_ALIAS = 'end_alias' .
+END_CASE = 'end_case' .
+END_CONSTANT = 'end_constant' .
+END_CONTEXT = 'end_context' .
+END_ENTITY = 'end_entity' .
+END_FUNCTION = 'end_function' .
+END_IF = 'end_if' .
+END_LOCAL = 'end_local' .
+END_MODEL = 'end_model' .
+END_PROCEDURE = 'end_procedure' .
+END_REPEAT = 'end_repeat' .
+END_RULE = 'end_rule' .
+END_SCHEMA = 'end_schema' .
+END_TYPE = 'end_type' .
+ENTITY = 'entity' .
+ENUMERATION = 'enumeration' .
+ESCAPE = 'escape' .
+EXISTS = 'exists' .
+EXP = 'exp' .
+FALSE = 'false' .
+FIXED = 'fixed' .
+FOR = 'for' .
+FORMAT = 'format' .
+FROM = 'from' .
+FUNCTION = 'function' .
+GENERIC = 'generic' .
+HIBOUND = 'hibound' .
+HIINDEX = 'hiindex' .
+IF = 'if' .
+IN = 'in' .
+INSERT = 'insert' .
+INTEGER = 'integer' .
+INVERSE = 'inverse' .
+LENGTH = 'length' .
+LIKE = 'like' .
+LIST = 'list' .
+LOBOUND = 'lobound' .
+LOCAL = 'local' .
+LOG = 'log' .
+LOG10 = 'log10' .
+LOG2 = 'log2' .
+LOGICAL = 'logical' .
+LOINDEX = 'loindex' .
+MOD = 'mod' .
+MODEL = 'model' .
+NOT = 'not' .
+NUMBER = 'number' .
+NVL = 'nvl' .
+ODD = 'odd' .
+OF = 'of' .
+ONEOF = 'oneof' .
+OPTIONAL = 'optional' .
+OR = 'or' .
+OTHERWISE = 'otherwise' .
+PI = 'pi' .
+PROCEDURE = 'procedure' .
+QUERY = 'query' .
+REAL = 'real' .
+REFERENCE = 'reference' .
+REMOVE = 'remove' .
+REPEAT = 'repeat' .
+RETURN = 'return' .
+ROLESOF = 'rolesof' .
+RULE = 'rule' .
+SCHEMA = 'schema' .
+SELECT = 'select' .
+SELF = 'self' .
+SET = 'set' .
+SIN = 'sin' .
+SIZEOF = 'sizeof' .
+SKIP = 'skip' .
+SQRT = 'sqrt' .
+STRING = 'string' .
+SUBTYPE = 'subtype' .
+SUPERTYPE = 'supertype' .
+TAN = 'tan' .
+THEN = 'then' .
+TO = 'to' .
+TRUE = 'true' .
+TYPE = 'type' .
+TYPEOF = 'typeof' .
+UNIQUE = 'unique' .
+UNKNOWN = 'unknown' .
+UNTIL = 'until' .
+USE = 'use' .
+USEDIN = 'usedin' .
+VALUE = 'value' .
+VALUE_IN = 'value_in' .
+VALUE_UNIQUE = 'value_unique' .
+VAR = 'var' .
+WHERE = 'where' .
+WHILE = 'while' .
+XOR = 'xor' .
+bit = '0' | '1' .
+digit = '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' .
+digits = digit { digit } .
+encoded_character = octet octet octet octet .
+hex_digit = digit | 'a' | 'b' | 'c' | 'd' | 'e' | 'f' .
+letter = 'a' | 'b' | 'c' | 'd' | 'e' | 'f' | 'g' | 'h' | 'i' | 'j' | 'k' | 'l' | 'm' | 'n' | 'o' | 'p' | 'q' | 'r' | 's' | 't' | 'u' | 'v' | 'w' | 'x' | 'y' | 'z' .
+lparen_not_star = '(' not_star .
+not_lparen_star = not_paren_star | ')' .
+not_paren_star = letter | digit | not_paren_star_special .
+not_paren_star_quote_special = '!' | '"' | '#' | '$' | '%' | '&' | '+' | ',' | '-' | '.' | '/' | ':' | ';' | '<' | '=' | '>' | '?' | '@' | '[' | '\' | ']' | '^' | '_' | '`' | '{' | '|' | '}' | '~' .
+not_paren_star_special = not_paren_star_quote_special | '''' .
+not_quote = not_paren_star_quote_special | letter | digit | '(' | ')' | '*' .
+not_rparen = not_paren_star | '*' | '(' .
+not_star = not_paren_star | '(' | ')' .
+octet = hex_digit hex_digit .
+special = not_paren_star_quote_special | '(' | ')' | '*' | '''' .
+star_not_rparen = '*' not_rparen .
+binary_literal = '%' bit { bit } .
+encoded_string_literal = '"' encoded_character { encoded_character } '"' .
+integer_literal = digits .
+real_literal = digits '.' [ digits ] [ 'e' [ sign ] digits ] .
+simple_id = letter { letter | digit | '_' } .
+simple_string_literal = \q { ( \q \q ) | not_quote | \s | \o } \q .
+embedded_remark = '(*' { not_lparen_star | lparen_not_star | star_not_rparen | embedded_remark } '*)' .
+remark = embedded_remark | tail_remark .
+tail_remark = '--' { \a | \s | \o } \n .
+attribute_ref = attribute_id .
+constant_ref = constant_id .
+entity_ref = entity_id .
+enumeration_ref = enumeration_id .
+function_ref = function_id .
+parameter_ref = parameter_id .
+procedure_ref = procedure_id .
+schema_ref = schema_id .
+type_label_ref = type_label_id .
+type_ref = type_id .
+variable_ref = variable_id .
+abstract_supertype_declaration = ABSTRACT SUPERTYPE [ subtype_constraint ] .
+actual_parameter_list = '(' parameter { ',' parameter } ')' .
+add_like_op = '+' | '-' | OR | XOR .
+aggregate_initializer = '[' [ element { ',' element } ] ']' .
+aggregate_source = simple_expression .
+aggregate_type = AGGREGATE [ ':' type_label ] OF parameter_type .
+aggregation_types = array_type | bag_type | list_type | set_type .
+algorithm_head = { declaration } [ constant_decl ] [ local_decl ] .
+alias_stmt = ALIAS variable_id FOR general_ref { qualifier } ';' stmt { stmt } END_ALIAS ';' .
+array_type = ARRAY bound_spec OF [ OPTIONAL ] [ UNIQUE ] base_type .
+assignment_stmt = general_ref { qualifier } ':=' expression ';' .
+attribute_decl = attribute_id | qualified_attribute .
+attribute_id = simple_id .
+attribute_qualifier = '.' attribute_ref .
+bag_type = BAG [ bound_spec ] OF base_type .
+base_type = aggregation_types | simple_types | named_types .
+binary_type = BINARY [ width_spec ] .
+boolean_type = BOOLEAN .
+bound_1 = numeric_expression .
+bound_2 = numeric_expression .
+bound_spec = '[' bound_1 ':' bound_2 ']' .
+built_in_constant = CONST_E | PI | SELF | '?' .
+built_in_function = ABS | ACOS | ASIN | ATAN | BLENGTH | COS | EXISTS | EXP | FORMAT | HIBOUND | HIINDEX | LENGTH | LOBOUND | LOINDEX | LOG | LOG2 | LOG10 | NVL | ODD | ROLESOF | SIN | SIZEOF | SQRT | TAN | TYPEOF | USEDIN | VALUE | VALUE_IN | VALUE_UNIQUE .
+built_in_procedure = INSERT | REMOVE .
+case_action = case_label { ',' case_label } ':' stmt .
+case_label = expression .
+case_stmt = CASE selector OF { case_action } [ OTHERWISE ':' stmt ] END_CASE ';' .
+compound_stmt = BEGIN stmt { stmt } END ';' .
+constant_body = constant_id ':' base_type ':=' expression ';' .
+constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+constant_factor = built_in_constant | constant_ref .
+constant_id = simple_id .
+constructed_types = enumeration_type | select_type .
+declaration = entity_decl | function_decl | procedure_decl | type_decl .
+derived_attr = attribute_decl ':' base_type ':=' expression ';' .
+derive_clause = DERIVE derived_attr { derived_attr } .
+domain_rule = [ label ':' ] logical_expression .
+element = expression [ ':' repetition ] .
+entity_body = { explicit_attr } [ derive_clause ] [ inverse_clause ] [ unique_clause ] [ where_clause ] .
+entity_constructor = entity_ref '(' [ expression { ',' expression } ] ')' .
+entity_decl = entity_head entity_body END_ENTITY ';' .
+entity_head = ENTITY entity_id [ subsuper ] ';' .
+entity_id = simple_id .
+enumeration_id = simple_id .
+enumeration_reference = [ type_ref '.' ] enumeration_ref .
+enumeration_type = ENUMERATION OF '(' enumeration_id { ',' enumeration_id } ')' .
+escape_stmt = ESCAPE ';' .
+explicit_attr = attribute_decl { ',' attribute_decl } ':' [ OPTIONAL ] base_type ';' .
+expression = simple_expression [ rel_op_extended simple_expression ] .
+factor = simple_factor [ '**' simple_factor ] .
+formal_parameter = parameter_id { ',' parameter_id } ':' parameter_type .
+function_call = ( built_in_function | function_ref ) [ actual_parameter_list ] .
+function_decl = function_head [ algorithm_head ] stmt { stmt } END_FUNCTION ';' .
+function_head = FUNCTION function_id [ '(' formal_parameter { ';' formal_parameter } ')' ] ':' parameter_type ';' .
+function_id = simple_id .
+generalized_types = aggregate_type | general_aggregation_types | generic_type .
+general_aggregation_types = general_array_type | general_bag_type | general_list_type | general_set_type .
+general_array_type = ARRAY [ bound_spec ] OF [ OPTIONAL ] [ UNIQUE ] parameter_type .
+general_bag_type = BAG [ bound_spec ] OF parameter_type .
+general_list_type = LIST [ bound_spec ] OF [ UNIQUE ] parameter_type .
+general_ref = parameter_ref | variable_ref .
+general_set_type = SET [ bound_spec ] OF parameter_type .
+generic_type = GENERIC [ ':' type_label ] .
+group_qualifier = '\' entity_ref .
+if_stmt = IF logical_expression THEN stmt { stmt } [ ELSE stmt { stmt } ] END_IF ';' .
+increment = numeric_expression .
+increment_control = variable_id ':=' bound_1 TO bound_2 [ BY increment ] .
+index = numeric_expression .
+index_1 = index .
+index_2 = index .
+index_qualifier = '[' index_1 [ ':' index_2 ] ']' .
+integer_type = INTEGER .
+interface_specification = reference_clause | use_clause .
+interval = '{' interval_low interval_op interval_item interval_op interval_high '}' .
+interval_high = simple_expression .
+interval_item = simple_expression .
+interval_low = simple_expression .
+interval_op = '<' | '<=' .
+inverse_attr = attribute_decl ':' [ ( SET | BAG ) [ bound_spec ] OF ] entity_ref FOR attribute_ref ';' .
+inverse_clause = INVERSE inverse_attr { inverse_attr } .
+label = simple_id .
+list_type = LIST [ bound_spec ] OF [ UNIQUE ] base_type .
+literal = binary_literal | integer_literal | logical_literal | real_literal | string_literal .
+local_decl = LOCAL local_variable { local_variable } END_LOCAL ';' .
+local_variable = variable_id { ',' variable_id } ':' parameter_type [ ':=' expression ] ';' .
+logical_expression = expression .
+logical_literal = FALSE | TRUE | UNKNOWN .
+logical_type = LOGICAL .
+multiplication_like_op = '*' | '/' | DIV | MOD | AND | '||' .
+named_types = entity_ref | type_ref .
+named_type_or_rename = named_types [ AS ( entity_id | type_id ) ] .
+null_stmt = ';' .
+number_type = NUMBER .
+numeric_expression = simple_expression .
+one_of = ONEOF '(' supertype_expression { ',' supertype_expression } ')' .
+parameter = expression .
+parameter_id = simple_id .
+parameter_type = generalized_types | named_types | simple_types .
+population = entity_ref .
+precision_spec = numeric_expression .
+primary = literal | ( qualifiable_factor { qualifier } ) .
+procedure_call_stmt = ( built_in_procedure | procedure_ref ) [ actual_parameter_list ] ';' .
+procedure_decl = procedure_head [ algorithm_head ] { stmt } END_PROCEDURE ';' .
+procedure_head = PROCEDURE procedure_id [ '(' [ VAR ] formal_parameter { ';' [ VAR ] formal_parameter } ')' ] ';' .
+procedure_id = simple_id .
+qualifiable_factor = attribute_ref | constant_factor | function_call | general_ref | population .
+qualified_attribute = SELF group_qualifier attribute_qualifier .
+qualifier = attribute_qualifier | group_qualifier | index_qualifier .
+query_expression = QUERY '(' variable_id '<*' aggregate_source '|' logical_expression ')' .
+real_type = REAL [ '(' precision_spec ')' ] .
+referenced_attribute = attribute_ref | qualified_attribute .
+reference_clause = REFERENCE FROM schema_ref [ '(' resource_or_rename { ',' resource_or_rename } ')' ] ';' .
+rel_op = '<' | '>' | '<=' | '>=' | '<>' | '=' | ':<>:' | ':=:' .
+rel_op_extended = rel_op | IN | LIKE .
+rename_id = constant_id | entity_id | function_id | procedure_id | type_id .
+repeat_control = [ increment_control ] [ while_control ] [ until_control ] .
+repeat_stmt = REPEAT repeat_control ';' stmt { stmt } END_REPEAT ';' .
+repetition = numeric_expression .
+resource_or_rename = resource_ref [ AS rename_id ] .
+resource_ref = constant_ref | entity_ref | function_ref | procedure_ref | type_ref .
+return_stmt = RETURN [ '(' expression ')' ] ';' .
+rule_decl = rule_head [ algorithm_head ] { stmt } where_clause END_RULE ';' .
+rule_head = RULE rule_id FOR '(' entity_ref { ',' entity_ref } ')' ';' .
+rule_id = simple_id .
+schema_body = { interface_specification } [ constant_decl ] { declaration | rule_decl } .
+schema_decl = SCHEMA schema_id ';' schema_body END_SCHEMA ';' .
+schema_id = simple_id .
+selector = expression .
+select_type = SELECT '(' named_types { ',' named_types } ')' .
+set_type = SET [ bound_spec ] OF base_type .
+sign = '+' | '-' .
+simple_expression = term { add_like_op term } .
+simple_factor = aggregate_initializer | entity_constructor | enumeration_reference | interval | query_expression | ( [ unary_op ] ( '(' expression ')' | primary ) ) .
+simple_types = binary_type | boolean_type | integer_type | logical_type | number_type | real_type | string_type .
+skip_stmt = SKIP ';' .
+stmt = alias_stmt | assignment_stmt | case_stmt | compound_stmt | escape_stmt | if_stmt | null_stmt | procedure_call_stmt | repeat_stmt | return_stmt | skip_stmt .
+string_literal = simple_string_literal | encoded_string_literal .
+string_type = STRING [ width_spec ] .
+subsuper = [ supertype_constraint ] [ subtype_declaration ] .
+subtype_constraint = OF '(' supertype_expression ')' .
+subtype_declaration = SUBTYPE OF '(' entity_ref { ',' entity_ref } ')' .
+supertype_constraint = abstract_supertype_declaration | supertype_rule .
+supertype_expression = supertype_factor { ANDOR supertype_factor } .
+supertype_factor = supertype_term { AND supertype_term } .
+supertype_rule = SUPERTYPE subtype_constraint .
+supertype_term = entity_ref | one_of | '(' supertype_expression ')' .
+syntax = schema_decl { schema_decl } .
+term = factor { multiplication_like_op factor } .
+type_decl = TYPE type_id '=' underlying_type ';' [ where_clause ] END_TYPE ';' .
+type_id = simple_id .
+type_label = type_label_id | type_label_ref .
+type_label_id = simple_id .
+unary_op = '+' | '-' | NOT .
+underlying_type = constructed_types | aggregation_types | simple_types | type_ref .
+unique_clause = UNIQUE unique_rule ';' { unique_rule ';' } .
+unique_rule = [ label ':' ] referenced_attribute { ',' referenced_attribute } .
+until_control = UNTIL logical_expression .
+use_clause = USE FROM schema_ref [ '(' named_type_or_rename { ',' named_type_or_rename } ')' ] ';' .
+variable_id = simple_id .
+where_clause = WHERE domain_rule ';' { domain_rule ';' } .
+while_control = WHILE logical_expression .
+width = numeric_expression .
+width_spec = '(' width ')' [ FIXED ] .

Added: trunk/src/apps/tool/doc/iso-10303-11--1994.bnf
===================================================================
--- trunk/src/apps/tool/doc/iso-10303-11--1994.bnf	                        (rev 0)
+++ trunk/src/apps/tool/doc/iso-10303-11--1994.bnf	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,321 @@
+;; iso-10303-11:1994
+
+  0 ABS = 'abs' .
+  1 ABSTRACT = 'abstract' .
+  2 ACOS = 'acos' .
+  3 AGGREGATE = 'aggregate' .
+  4 ALIAS = 'alias' .
+  5 AND = 'and' .
+  6 ANDOR = 'andor' .
+  7 ARRAY = 'array' .
+  8 AS = 'as' .
+  9 ASIN = 'asin' .
+ 10 ATAN = 'atan' .
+ 11 BAG = 'bag' .
+ 12 BEGIN = 'begin' .
+ 13 BINARY = 'binary' .
+ 14 BLENGTH = 'blength' .
+ 15 BOOLEAN = 'boolean' .
+ 16 BY = 'by' .
+ 17 CASE = 'case' .
+ 18 CONSTANT = 'constant' .
+ 19 CONST_E = 'const_e' .
+ 20 CONTEXT = 'context' .
+ 21 COS = 'cos' .
+ 22 DERIVE = 'derive' .
+ 23 DIV = 'div' .
+ 24 ELSE = 'else' .
+ 25 END = 'end' .
+ 26 END_ALIAS = 'end_alias' .
+ 27 END_CASE = 'end_case' .
+ 28 END_CONSTANT = 'end_constant' .
+ 29 END_CONTEXT = 'end_context' .
+ 30 END_ENTITY = 'end_entity' .
+ 31 END_FUNCTION = 'end_function' .
+ 32 END_IF = 'end_if' .
+ 33 END_LOCAL = 'end_local' .
+ 34 END_MODEL = 'end_model' .
+ 35 END_PROCEDURE = 'end_procedure' .
+ 36 END_REPEAT = 'end_repeat' .
+ 37 END_RULE = 'end_rule' .
+ 38 END_SCHEMA = 'end_schema' .
+ 39 END_TYPE = 'end_type' .
+ 40 ENTITY = 'entity' .
+ 41 ENUMERATION = 'enumeration' .
+ 42 ESCAPE = 'escape' .
+ 43 EXISTS = 'exists' .
+ 44 EXP = 'exp' .
+ 45 FALSE = 'false' .
+ 46 FIXED = 'fixed' .
+ 47 FOR = 'for' .
+ 48 FORMAT = 'format' .
+ 49 FROM = 'from' .
+ 50 FUNCTION = 'function' .
+ 51 GENERIC = 'generic' .
+ 52 HIBOUND = 'hibound' .
+ 53 HIINDEX = 'hiindex' .
+ 54 IF = 'if' .
+ 55 IN = 'in' .
+ 56 INSERT = 'insert' .
+ 57 INTEGER = 'integer' .
+ 58 INVERSE = 'inverse' .
+ 59 LENGTH = 'length' .
+ 60 LIKE = 'like' .
+ 61 LIST = 'list' .
+ 62 LOBOUND = 'lobound' .
+ 63 LOCAL = 'local' .
+ 64 LOG = 'log' .
+ 65 LOG10 = 'log10' .
+ 66 LOG2 = 'log2' .
+ 67 LOGICAL = 'logical' .
+ 68 LOINDEX = 'loindex' .
+ 69 MOD = 'mod' .
+ 70 MODEL = 'model' .
+ 71 NOT = 'not' .
+ 72 NUMBER = 'number' .
+ 73 NVL = 'nvl' .
+ 74 ODD = 'odd' .
+ 75 OF = 'of' .
+ 76 ONEOF = 'oneof' .
+ 77 OPTIONAL = 'optional' .
+ 78 OR = 'or' .
+ 79 OTHERWISE = 'otherwise' .
+ 80 PI = 'pi' .
+ 81 PROCEDURE = 'procedure' .
+ 82 QUERY = 'query' .
+ 83 REAL = 'real' .
+ 84 REFERENCE = 'reference' .
+ 85 REMOVE = 'remove' .
+ 86 REPEAT = 'repeat' .
+ 87 RETURN = 'return' .
+ 88 ROLESOF = 'rolesof' .
+ 89 RULE = 'rule' .
+ 90 SCHEMA = 'schema' .
+ 91 SELECT = 'select' .
+ 92 SELF = 'self' .
+ 93 SET = 'set' .
+ 94 SIN = 'sin' .
+ 95 SIZEOF = 'sizeof' .
+ 96 SKIP = 'skip' .
+ 97 SQRT = 'sqrt' .
+ 98 STRING = 'string' .
+ 99 SUBTYPE = 'subtype' .
+100 SUPERTYPE = 'supertype' .
+101 TAN = 'tan' .
+102 THEN = 'then' .
+103 TO = 'to' .
+104 TRUE = 'true' .
+105 TYPE = 'type' .
+106 TYPEOF = 'typeof' .
+107 UNIQUE = 'unique' .
+108 UNKNOWN = 'unknown' .
+109 UNTIL = 'until' .
+110 USE = 'use' .
+111 USEDIN = 'usedin' .
+112 VALUE = 'value' .
+113 VALUE_IN = 'value_in' .
+114 VALUE_UNIQUE = 'value_unique' .
+115 VAR = 'var' .
+116 WHERE = 'where' .
+117 WHILE = 'while' .
+118 XOR = 'xor' .
+119 bit = '0' | '1' .
+120 digit = '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' .
+121 digits = digit { digit } .
+122 encoded_character = octet octet octet octet .
+123 hex_digit = digit | 'a' | 'b' | 'c' | 'd' | 'e' | 'f' .
+124 letter = 'a' | 'b' | 'c' | 'd' | 'e' | 'f' | 'g' | 'h' | 'i' | 'j' | 'k' | 'l' | 'm' | 'n' | 'o' | 'p' | 'q' | 'r' | 's' | 't' | 'u' | 'v' | 'w' | 'x' | 'y' | 'z' .
+125 lparen_not_star = '(' not_star .
+126 not_lparen_star = not_paren_star | ')' .
+127 not_paren_star = letter | digit | not_paren_star_special .
+128 not_paren_star_quote_special = '!' | '"' | '#' | '$' | '%' | '&' | '+' | ',' | '-' | '.' | '/' | ':' | ';' | '<' | '=' | '>' | '?' | '@' | '[' | '\' | ']' | '^' | '_' | '`' | '{' | '|' | '}' | '~' .
+129 not_paren_star_special = not_paren_star_quote_special | '''' .
+130 not_quote = not_paren_star_quote_special | letter | digit | '(' | ')' | '*' .
+131 not_rparen = not_paren_star | '*' | '(' .
+132 not_star = not_paren_star | '(' | ')' .
+133 octet = hex_digit hex_digit .
+134 special = not_paren_star_quote_special | '(' | ')' | '*' | '''' .
+135 star_not_rparen = '*' not_rparen .
+136 binary_literal = '%' bit { bit } .
+137 encoded_string_literal = '"' encoded_character { encoded_character } '"' .
+138 integer_literal = digits .
+139 real_literal = digits '.' [ digits ] [ 'e' [ sign ] digits ] .
+140 simple_id = letter { letter | digit | '_' } .
+141 simple_string_literal = \q { ( \q \q ) | not_quote | \s | \o } \q .
+142 embedded_remark = '(*' { not_lparen_star | lparen_not_star | star_not_rparen | embedded_remark } '*)' .
+143 remark = embedded_remark | tail_remark .
+144 tail_remark = '--' { \a | \s | \o } \n .
+145 attribute_ref = attribute_id .
+146 constant_ref = constant_id .
+147 entity_ref = entity_id .
+148 enumeration_ref = enumeration_id .
+149 function_ref = function_id .
+150 parameter_ref = parameter_id .
+151 procedure_ref = procedure_id .
+152 schema_ref = schema_id .
+153 type_label_ref = type_label_id .
+154 type_ref = type_id .
+155 variable_ref = variable_id .
+156 abstract_supertype_declaration = ABSTRACT SUPERTYPE [ subtype_constraint ] .
+157 actual_parameter_list = '(' parameter { ',' parameter } ')' .
+158 add_like_op = '+' | '-' | OR | XOR .
+159 aggregate_initializer = '[' [ element { ',' element } ] ']' .
+160 aggregate_source = simple_expression .
+161 aggregate_type = AGGREGATE [ ':' type_label ] OF parameter_type .
+162 aggregation_types = array_type | bag_type | list_type | set_type .
+163 algorithm_head = { declaration } [ constant_decl ] [ local_decl ] .
+164 alias_stmt = ALIAS variable_id FOR general_ref { qualifier } ';' stmt { stmt } END_ALIAS ';' .
+165 array_type = ARRAY bound_spec OF [ OPTIONAL ] [ UNIQUE ] base_type .
+166 assignment_stmt = general_ref { qualifier } ':=' expression ';' .
+167 attribute_decl = attribute_id | qualified_attribute .
+168 attribute_id = simple_id .
+169 attribute_qualifier = '.' attribute_ref .
+170 bag_type = BAG [ bound_spec ] OF base_type .
+171 base_type = aggregation_types | simple_types | named_types .
+172 binary_type = BINARY [ width_spec ] .
+173 boolean_type = BOOLEAN .
+174 bound_1 = numeric_expression .
+175 bound_2 = numeric_expression .
+176 bound_spec = '[' bound_1 ':' bound_2 ']' .
+177 built_in_constant = CONST_E | PI | SELF | '?' .
+178 built_in_function = ABS | ACOS | ASIN | ATAN | BLENGTH | COS | EXISTS | EXP | FORMAT | HIBOUND | HIINDEX | LENGTH | LOBOUND | LOINDEX | LOG | LOG2 | LOG10 | NVL | ODD | ROLESOF | SIN | SIZEOF | SQRT | TAN | TYPEOF | USEDIN | VALUE | VALUE_IN | VALUE_UNIQUE .
+179 built_in_procedure = INSERT | REMOVE .
+180 case_action = case_label { ',' case_label } ':' stmt .
+181 case_label = expression .
+182 case_stmt = CASE selector OF { case_action } [ OTHERWISE ':' stmt ] END_CASE ';' .
+183 compound_stmt = BEGIN stmt { stmt } END ';' .
+184 constant_body = constant_id ':' base_type ':=' expression ';' .
+185 constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+186 constant_factor = built_in_constant | constant_ref .
+187 constant_id = simple_id .
+188 constructed_types = enumeration_type | select_type .
+189 declaration = entity_decl | function_decl | procedure_decl | type_decl .
+190 derived_attr = attribute_decl ':' base_type ':=' expression ';' .
+191 derive_clause = DERIVE derived_attr { derived_attr } .
+192 domain_rule = [ label ':' ] logical_expression .
+193 element = expression [ ':' repetition ] .
+194 entity_body = { explicit_attr } [ derive_clause ] [ inverse_clause ] [ unique_clause ] [ where_clause ] .
+195 entity_constructor = entity_ref '(' [ expression { ',' expression } ] ')' .
+196 entity_decl = entity_head entity_body END_ENTITY ';' .
+197 entity_head = ENTITY entity_id [ subsuper ] ';' .
+198 entity_id = simple_id .
+199 enumeration_id = simple_id .
+200 enumeration_reference = [ type_ref '.' ] enumeration_ref .
+201 enumeration_type = ENUMERATION OF '(' enumeration_id { ',' enumeration_id } ')' .
+202 escape_stmt = ESCAPE ';' .
+203 explicit_attr = attribute_decl { ',' attribute_decl } ':' [ OPTIONAL ] base_type ';' .
+204 expression = simple_expression [ rel_op_extended simple_expression ] .
+205 factor = simple_factor [ '**' simple_factor ] .
+206 formal_parameter = parameter_id { ',' parameter_id } ':' parameter_type .
+207 function_call = ( built_in_function | function_ref ) [ actual_parameter_list ] .
+208 function_decl = function_head [ algorithm_head ] stmt { stmt } END_FUNCTION ';' .
+209 function_head = FUNCTION function_id [ '(' formal_parameter { ';' formal_parameter } ')' ] ':' parameter_type ';' .
+210 function_id = simple_id .
+211 generalized_types = aggregate_type | general_aggregation_types | generic_type .
+212 general_aggregation_types = general_array_type | general_bag_type | general_list_type | general_set_type .
+213 general_array_type = ARRAY [ bound_spec ] OF [ OPTIONAL ] [ UNIQUE ] parameter_type .
+214 general_bag_type = BAG [ bound_spec ] OF parameter_type .
+215 general_list_type = LIST [ bound_spec ] OF [ UNIQUE ] parameter_type .
+216 general_ref = parameter_ref | variable_ref .
+217 general_set_type = SET [ bound_spec ] OF parameter_type .
+218 generic_type = GENERIC [ ':' type_label ] .
+219 group_qualifier = '\' entity_ref .
+220 if_stmt = IF logical_expression THEN stmt { stmt } [ ELSE stmt { stmt } ] END_IF ';' .
+221 increment = numeric_expression .
+222 increment_control = variable_id ':=' bound_1 TO bound_2 [ BY increment ] .
+223 index = numeric_expression .
+224 index_1 = index .
+225 index_2 = index .
+226 index_qualifier = '[' index_1 [ ':' index_2 ] ']' .
+227 integer_type = INTEGER .
+228 interface_specification = reference_clause | use_clause .
+229 interval = '{' interval_low interval_op interval_item interval_op interval_high '}' .
+230 interval_high = simple_expression .
+231 interval_item = simple_expression .
+232 interval_low = simple_expression .
+233 interval_op = '<' | '<=' .
+234 inverse_attr = attribute_decl ':' [ ( SET | BAG ) [ bound_spec ] OF ] entity_ref FOR attribute_ref ';' .
+235 inverse_clause = INVERSE inverse_attr { inverse_attr } .
+236 label = simple_id .
+237 list_type = LIST [ bound_spec ] OF [ UNIQUE ] base_type .
+238 literal = binary_literal | integer_literal | logical_literal | real_literal | string_literal .
+239 local_decl = LOCAL local_variable { local_variable } END_LOCAL ';' .
+240 local_variable = variable_id { ',' variable_id } ':' parameter_type [ ':=' expression ] ';' .
+241 logical_expression = expression .
+242 logical_literal = FALSE | TRUE | UNKNOWN .
+243 logical_type = LOGICAL .
+244 multiplication_like_op = '*' | '/' | DIV | MOD | AND | '||' .
+245 named_types = entity_ref | type_ref .
+246 named_type_or_rename = named_types [ AS ( entity_id | type_id ) ] .
+247 null_stmt = ';' .
+248 number_type = NUMBER .
+249 numeric_expression = simple_expression .
+250 one_of = ONEOF '(' supertype_expression { ',' supertype_expression } ')' .
+251 parameter = expression .
+252 parameter_id = simple_id .
+253 parameter_type = generalized_types | named_types | simple_types .
+254 population = entity_ref .
+255 precision_spec = numeric_expression .
+256 primary = literal | ( qualifiable_factor { qualifier } ) .
+257 procedure_call_stmt = ( built_in_procedure | procedure_ref ) [ actual_parameter_list ] ';' .
+258 procedure_decl = procedure_head [ algorithm_head ] { stmt } END_PROCEDURE ';' .
+259 procedure_head = PROCEDURE procedure_id [ '(' [ VAR ] formal_parameter { ';' [ VAR ] formal_parameter } ')' ] ';' .
+260 procedure_id = simple_id .
+261 qualifiable_factor = attribute_ref | constant_factor | function_call | general_ref | population .
+262 qualified_attribute = SELF group_qualifier attribute_qualifier .
+263 qualifier = attribute_qualifier | group_qualifier | index_qualifier .
+264 query_expression = QUERY '(' variable_id '<*' aggregate_source '|' logical_expression ')' .
+265 real_type = REAL [ '(' precision_spec ')' ] .
+266 referenced_attribute = attribute_ref | qualified_attribute .
+267 reference_clause = REFERENCE FROM schema_ref [ '(' resource_or_rename { ',' resource_or_rename } ')' ] ';' .
+268 rel_op = '<' | '>' | '<=' | '>=' | '<>' | '=' | ':<>:' | ':=:' .
+269 rel_op_extended = rel_op | IN | LIKE .
+270 rename_id = constant_id | entity_id | function_id | procedure_id | type_id .
+271 repeat_control = [ increment_control ] [ while_control ] [ until_control ] .
+272 repeat_stmt = REPEAT repeat_control ';' stmt { stmt } END_REPEAT ';' .
+273 repetition = numeric_expression .
+274 resource_or_rename = resource_ref [ AS rename_id ] .
+275 resource_ref = constant_ref | entity_ref | function_ref | procedure_ref | type_ref .
+276 return_stmt = RETURN [ '(' expression ')' ] ';' .
+277 rule_decl = rule_head [ algorithm_head ] { stmt } where_clause END_RULE ';' .
+278 rule_head = RULE rule_id FOR '(' entity_ref { ',' entity_ref } ')' ';' .
+279 rule_id = simple_id .
+280 schema_body = { interface_specification } [ constant_decl ] { declaration | rule_decl } .
+281 schema_decl = SCHEMA schema_id ';' schema_body END_SCHEMA ';' .
+282 schema_id = simple_id .
+283 selector = expression .
+284 select_type = SELECT '(' named_types { ',' named_types } ')' .
+285 set_type = SET [ bound_spec ] OF base_type .
+286 sign = '+' | '-' .
+287 simple_expression = term { add_like_op term } .
+288 simple_factor = aggregate_initializer | entity_constructor | enumeration_reference | interval | query_expression | ( [ unary_op ] ( '(' expression ')' | primary ) ) .
+289 simple_types = binary_type | boolean_type | integer_type | logical_type | number_type | real_type | string_type .
+290 skip_stmt = SKIP ';' .
+291 stmt = alias_stmt | assignment_stmt | case_stmt | compound_stmt | escape_stmt | if_stmt | null_stmt | procedure_call_stmt | repeat_stmt | return_stmt | skip_stmt .
+292 string_literal = simple_string_literal | encoded_string_literal .
+293 string_type = STRING [ width_spec ] .
+294 subsuper = [ supertype_constraint ] [ subtype_declaration ] .
+295 subtype_constraint = OF '(' supertype_expression ')' .
+296 subtype_declaration = SUBTYPE OF '(' entity_ref { ',' entity_ref } ')' .
+297 supertype_constraint = abstract_supertype_declaration | supertype_rule .
+298 supertype_expression = supertype_factor { ANDOR supertype_factor } .
+299 supertype_factor = supertype_term { AND supertype_term } .
+300 supertype_rule = SUPERTYPE subtype_constraint .
+301 supertype_term = entity_ref | one_of | '(' supertype_expression ')' .
+302 syntax = schema_decl { schema_decl } .
+303 term = factor { multiplication_like_op factor } .
+304 type_decl = TYPE type_id '=' underlying_type ';' [ where_clause ] END_TYPE ';' .
+305 type_id = simple_id .
+306 type_label = type_label_id | type_label_ref .
+307 type_label_id = simple_id .
+308 unary_op = '+' | '-' | NOT .
+309 underlying_type = constructed_types | aggregation_types | simple_types | type_ref .
+310 unique_clause = UNIQUE unique_rule ';' { unique_rule ';' } .
+311 unique_rule = [ label ':' ] referenced_attribute { ',' referenced_attribute } .
+312 until_control = UNTIL logical_expression .
+313 use_clause = USE FROM schema_ref [ '(' named_type_or_rename { ',' named_type_or_rename } ')' ] ';' .
+314 variable_id = simple_id .
+315 where_clause = WHERE domain_rule ';' { domain_rule ';' } .
+316 while_control = WHILE logical_expression .
+317 width = numeric_expression .
+318 width_spec = '(' width ')' [ FIXED ] .

Added: trunk/src/apps/tool/doc/iso-10303-11--2004-raw.bnf
===================================================================
--- trunk/src/apps/tool/doc/iso-10303-11--2004-raw.bnf	                        (rev 0)
+++ trunk/src/apps/tool/doc/iso-10303-11--2004-raw.bnf	2008-05-23 16:24:04 UTC (rev 12)
@@ -0,0 +1,344 @@
+;; iso-10303-11:2004 (no numbers)
+
+ABS = 'abs' .
+ABSTRACT = 'abstract' .
+ACOS = 'acos' .
+AGGREGATE = 'aggregate' .
+ALIAS = 'alias' .
+AND = 'and' .
+ANDOR = 'andor' .
+ARRAY = 'array' .
+AS = 'as' .
+ASIN = 'asin' .
+ATAN = 'atan' .
+BAG = 'bag' .
+BASED_ON = 'based_on' .
+BEGIN = 'begin' .
+BINARY = 'binary' .
+BLENGTH = 'blength' .
+BOOLEAN = 'boolean' .
+BY = 'by' .
+CASE = 'case' .
+CONSTANT = 'constant' .
+CONST_E = 'const_e' .
+COS = 'cos' .
+DERIVE = 'derive' .
+DIV = 'div' .
+ELSE = 'else' .
+END = 'end' .
+END_ALIAS = 'end_alias' .
+END_CASE = 'end_case' .
+END_CONSTANT = 'end_constant' .
+END_ENTITY = 'end_entity' .
+END_FUNCTION = 'end_function' .
+END_IF = 'end_if' .
+END_LOCAL = 'end_local' .
+END_PROCEDURE = 'end_procedure' .
+END_REPEAT = 'end_repeat' .
+END_RULE = 'end_rule' .
+END_SCHEMA = 'end_schema' .
+END_SUBTYPE_CONSTRAINT = 'end_subtype_constraint' .
+END_TYPE = 'end_type' .
+ENTITY = 'entity' .
+ENUMERATION = 'enumeration' .
+ESCAPE = 'escape' .
+EXISTS = 'exists' .
+EXTENSIBLE = 'extensible' .
+EXP = 'exp' .
+FALSE = 'false' .
+FIXED = 'fixed' .
+FOR = 'for' .
+FORMAT = 'format' .
+FROM = 'from' .
+FUNCTION = 'function' .
+GENERIC = 'generic' .
+GENERIC_ENTITY = 'generic_entity' .
+HIBOUND = 'hibound' .
+HIINDEX = 'hiindex' .
+IF = 'if' .
+IN = 'in' .
+INSERT = 'insert' .
+INTEGER = 'integer' .
+INVERSE = 'inverse' .
+LENGTH = 'length' .
+LIKE = 'like' .
+LIST = 'list' .
+LOBOUND = 'lobound' .
+LOCAL = 'local' .
+LOG = 'log' .
+LOG10 = 'log10' .
+LOG2 = 'log2' .
+LOGICAL = 'logical' .
+LOINDEX = 'loindex' .
+MOD = 'mod' .
+NOT = 'not' .
+NUMBER = 'number' .
+NVL = 'nvl' .
+ODD = 'odd' .
+OF = 'of' .
+ONEOF = 'oneof' .
+OPTIONAL = 'optional' .
+OR = 'or' .
+OTHERWISE = 'otherwise' .
+PI = 'pi' .
+PROCEDURE = 'procedure' .
+QUERY = 'query' .
+REAL = 'real' .
+REFERENCE = 'reference' .
+REMOVE = 'remove' .
+RENAMED = 'renamed' .
+REPEAT = 'repeat' .
+RETURN = 'return' .
+ROLESOF = 'rolesof' .
+RULE = 'rule' .
+SCHEMA = 'schema' .
+SELECT = 'select' .
+SELF = 'self' .
+SET = 'set' .
+SIN = 'sin' .
+SIZEOF = 'sizeof' .
+SKIP = 'skip' .
+SQRT = 'sqrt' .
+STRING = 'string' .
+SUBTYPE = 'subtype' .
+SUBTYPE_CONSTRAINT = 'subtype_constraint' .
+SUPERTYPE = 'supertype' .
+TAN = 'tan' .
+THEN = 'then' .
+TO = 'to' .
+TOTAL_OVER = 'total_over' .
+TRUE = 'true' .
+TYPE = 'type' .
+TYPEOF = 'typeof' .
+UNIQUE = 'unique' .
+UNKNOWN = 'unknown' .
+UNTIL = 'until' .
+USE = 'use' .
+USEDIN = 'usedin' .
+VALUE = 'value' .
+VALUE_IN = 'value_in' .
+VALUE_UNIQUE = 'value_unique' .
+VAR = 'var' .
+WHERE = 'where' .
+WHILE = 'while' .
+WITH = 'with' .
+XOR = 'xor' .
+bit = '0' | '1' .
+digit = '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' .
+digits = digit { digit } .
+encoded_character = octet octet octet octet .
+hex_digit = digit | 'a' | 'b' | 'c' | 'd' | 'e' | 'f' .
+letter = 'a' | 'b' | 'c' | 'd' | 'e' | 'f' | 'g' | 'h' | 'i' | 'j' | 'k' | 'l' | 'm' | 'n' | 'o' | 'p' | 'q' | 'r' | 's' | 't' | 'u' | 'v' | 'w' | 'x' | 'y' | 'z' .
+lparen_then_not_lparen_star = '(' { '(' } not_lparen_star { not_lparen_star } .
+not_lparen_star = not_paren_star | ')' .
+not_paren_star = letter | digit | not_paren_star_special .
+not_paren_star_quote_special = '!' | '"' | '#' | '$' | '%' | '&' | '+' | ',' | '-' | '.' | '/' | ':' | ';' | '<' | '=' | '>' | '?' | '@' | '[' | '\' | ']' | '^' | '_' | '`' | '{' | '|' | '}' | '~' .
+not_paren_star_special = not_paren_star_quote_special | '''' .
+not_quote = not_paren_star_quote_special | letter | digit | '(' | ')' | '*' .
+not_rparen_star = not_paren_star | '(' .
+octet = hex_digit hex_digit .
+special = not_paren_star_quote_special | '(' | ')' | '*' | '''' .
+not_rparen_star_then_rparen = not_rparen_star { not_rparen_star } ')' { ')' } .
+binary_literal = '%' bit { bit } .
+encoded_string_literal = '"' encoded_character { encoded_character } '"' .
+integer_literal = digits .
+real_literal = integer_literal | ( digits '.' [ digits ] [ 'e' [ sign ] digits ] ) .
+simple_id =...
 
[truncated message content]

[Step-toybox-commits] SF.net SVN: step-toybox: [11] trunk/src/apps/tool/doc/

[<cla...@us...>]

Revision: 11
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=11&view=rev
Author:   clanning
Date:     2008-05-23 09:18:00 -0700 (Fri, 23 May 2008)

Log Message:
-----------
directory for documentation

Added Paths:
-----------
    trunk/src/apps/tool/doc/


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Step-toybox-commits] SF.net SVN: step-toybox: [10] trunk/src/apps/tool/gen/

[<cla...@us...>]

Revision: 10
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=10&view=rev
Author:   clanning
Date:     2008-05-23 09:16:36 -0700 (Fri, 23 May 2008)

Log Message:
-----------
directory for data generators

Added Paths:
-----------
    trunk/src/apps/tool/gen/


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Step-toybox-commits] SF.net SVN: step-toybox: [9] trunk/src/apps/tool/

[<cla...@us...>]

Revision: 9
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=9&view=rev
Author:   clanning
Date:     2008-05-23 09:13:05 -0700 (Fri, 23 May 2008)

Log Message:
-----------
New application directory for EXPRESS Tool

Added Paths:
-----------
    trunk/src/apps/tool/


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Step-toybox-commits] SF.net SVN: step-toybox: [8] trunk/src/libs/parser11

[<cla...@us...>]

Revision: 8
          http://step-toybox.svn.sourceforge.net/step-toybox/?rev=8&view=rev
Author:   clanning
Date:     2008-04-20 17:49:16 -0700 (Sun, 20 Apr 2008)

Log Message:
-----------
More development updates

Modified Paths:
--------------
    trunk/src/libs/parser11/00readme.txt
    trunk/src/libs/parser11/00todo.txt
    trunk/src/libs/parser11/readtable.lisp
    trunk/src/libs/parser11/system.lisp

Added Paths:
-----------
    trunk/src/libs/parser11/built-ins.lisp
    trunk/src/libs/parser11/declarations.lisp
    trunk/src/libs/parser11/macros.lisp
    trunk/src/libs/parser11/parser1.lisp
    trunk/src/libs/parser11/statements.lisp
    trunk/src/libs/parser11/top-level.lisp

Modified: trunk/src/libs/parser11/00readme.txt
===================================================================
--- trunk/src/libs/parser11/00readme.txt	2008-04-18 03:30:40 UTC (rev 7)
+++ trunk/src/libs/parser11/00readme.txt	2008-04-21 00:49:16 UTC (rev 8)
@@ -5,3 +5,8 @@
 
 This is the new EXPRESS v2 compliant parser.
 
+
+
+Need a well defined interface for calling the parser:
+o  pass it the name of the EXPRESS file to read
+o  it returns a list of the schema objects that were found in the file

Modified: trunk/src/libs/parser11/00todo.txt
===================================================================
--- trunk/src/libs/parser11/00todo.txt	2008-04-18 03:30:40 UTC (rev 7)
+++ trunk/src/libs/parser11/00todo.txt	2008-04-21 00:49:16 UTC (rev 8)
@@ -3,3 +3,11 @@
 			    Part 11 Parser
 			      Version 2
 
+o  Need a well defined interface for calling the parser:
+   o  pass it the name of the EXPRESS file to read
+   o  it returns a list of the schema objects that were found in the file
+o  Documentation should describe the objects which are returned
+o  need to update info on built-ins to include
+   o  value for constants
+   o  args & returned value for functions
+   o  args for procedures

Added: trunk/src/libs/parser11/built-ins.lisp
===================================================================
--- trunk/src/libs/parser11/built-ins.lisp	                        (rev 0)
+++ trunk/src/libs/parser11/built-ins.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -0,0 +1,153 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: P11I; Base: 10 -*-
+
+#-Genera
+(in-package :P11I)
+
+;;; Copyright (c) 2008    Craig Lanning
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without restriction,
+;;; including without limitation the rights to use, copy, modify,
+;;; merge, publish, distribute, sublicense, and/or sell copies of the
+;;; Software, and to permit persons to whom the Software is furnished
+;;; to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
+;;; ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+;;; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;;;-----------------------------------------------------------------------
+
+
+;;;
+;;; Built-In items
+;;;
+
+;;; ***** Not really sure what to do with these *****
+
+;;; Constants
+
+;; p11:CONST_E
+;; a p11:REAL value representing the mathematical value 'e', the base
+;; of the natural logarithm function (ln).  Its value is given by the
+;; summation of (i!^-1) with i from 0 to infinity
+
+;; indeterminate (?)
+
+;; false (.F.)
+
+;; p11:PI	3.1415926...  (need a calculation)
+;; a p11:REAL value representing the mathematical value pi, the ratio
+;; of a circle's circumference to its diameter
+
+;; p11:SELF	this is just a place holder
+;; refers to the current entity instance or type value.
+
+;; true (.T.)
+
+;; unknown (.U.)
+
+
+;;; Functions
+
+;; 15.1 Abs - arithmetic function
+;; FUNCTION p11:ABS		(v:NUMBER) : NUMBER;
+
+;; 15.2 ACos - arithmetic function
+;; FUNCTION p11:ACOS		(v:NUMBER) : REAL;
+
+;; 15.3 ASin - arithmetic function
+;; FUNCTION p11:ASIN		(v:NUMBER) : REAL;
+
+;; 15.4 ATan - arithmetic function
+;; FUNCTION p11:ATAN		(v1:NUMBER; v2:NUMBER) : REAL;
+
+;; 15.5 BLength - binary function
+;; FUNCTION p11:BLENGTH		(v:BINARY) : INTEGER;
+
+;; 15.6 Cos - arithmetic function
+;; FUNCTION p11:COS		(v:NUMBER) : REAL;
+
+;; 15.7 Exists - generic function
+;; FUNCTION p11:EXISTS		(v:GENERIC) : BOOLEAN;
+
+;; 15.8 Exp - arithmetic function
+;; FUNCTION p11:EXP		(v:NUMBER) : REAL;
+
+;; 15.9 Format - generic function
+;; FUNCTION p11:FORMAT		(n:NUMBER; f:STRING) : STRING;
+
+;; 15.10 HiBound - arithmetic function
+;; FUNCTION p11:HIBOUND		(v:AGGREGATE OF GENERIC) : INTEGER;
+
+;; 15.11 HiIndex - arithmetic function
+;; FUNCTION p11:HIINDEX		(v:AGGREGATE OF GENERIC) : INTEGER;
+
+;; 15.12 Length - string function
+;; FUNCTION p11:LENGTH		(v:STRING) : INTEGER;
+
+;; 15.13 LoBound - arithmetic function
+;; FUNCTION p11:LOBOUND		(v:AGGREGATE OF GENERIC) : INTEGER;
+
+;; 15.14 Log - arithmetic function
+;; FUNCTION p11:LOG		(v:NUMBER) : REAL;
+
+;; 15.15 Log2 - arithmetic function
+;; FUNCTION p11:LOG2		(v:NUMBER) : REAL;
+
+;; 15.16 Log10 - arithmetic function
+;; FUNCTION p11:LOG10		(v:NUMBER) : REAL;
+
+;; 15.17 LoIndex - arithmetic function
+;; FUNCTION p11:LOINDEX		(v:AGGREGATE OF GENERIC) : INTEGER;
+
+;; 15.18 NVL - null value function
+;; FUNCTION p11:NVL		(v:GENERIC:GEN1; SUBSTITUTE:GENERIC:GEN1) : GENERIC:GEN1;
+
+;; 15.19 Odd - arithmetic function
+;; FUNCTION p11:ODD		(v:INTEGER) : LOGICAL;
+
+;; 15.20 RolesOf - general function
+;; FUNCTION p11:ROLESOF		(v:GENERIC_ENTITY) : SET OF STRING;
+
+;; 15.21 Sin - arithmetic function
+;; FUNCTION p11:SIN		(v:NUMBER) : REAL;
+
+;; 15.22 SizeOf - aggregate function
+;; FUNCTION p11:SIZEOF		(v:AGGREGATE OF GENERIC) : INTEGER;
+
+;; 15.23 Sqrt - arithmetic function
+;; FUNCTION p11:SQRT		(v:NUMBER) : REAL;
+
+;; 15.24 Tan - arithmetic function
+;; FUNCTION p11:TAN		(v:NUMBER) : REAL;
+
+;; 15.25 TypeOf - generial function
+;; FUNCTION p11:TYPEOF		(v:GENERIC) : SET OF STRING;
+
+;; 15.26 UsedIn - generial function
+;; FUNCTION p11:USEDIN		(t:GENERIC_ENTITY; R:STRING) : BAG OF GENERIC_ENTITY;
+
+;; 15.27 Value - arithmetic function
+;; FUNCTION p11:VALUE		(v:STRING) : NUMBER;
+
+;; 15.28 Value_in - membership function
+;; FUNCTION p11:VALUE_IN	(c:AGGREGATE OF GENERIC:GEN; v:GENERIC:GEN) : LOGICAL;
+
+;; 15.29 Value_unique - uniqueness function
+;; FUNCTION p11:VALUE_UNIQUE	(v:AGGREGATE OF GENERIC) : LOGICAL;
+
+;;; Procedures
+
+;; 16.1 Insert
+;; PROCEDURE p11:INSERT		(VAR L:LIST OF GENERIC:GEN; E:GENERIC:GEN; P:INTEGER);
+
+;; 16.2 Remove
+;; PROCEDURE p11:REMOVE		(VAR L:LIST OF GENERIC; P:INTEGER);

Added: trunk/src/libs/parser11/declarations.lisp
===================================================================
--- trunk/src/libs/parser11/declarations.lisp	                        (rev 0)
+++ trunk/src/libs/parser11/declarations.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -0,0 +1,157 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: P11I; Base: 10 -*-
+
+#-Genera
+(in-package :P11I)
+
+;;; Copyright (c) 2008    Craig Lanning
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without restriction,
+;;; including without limitation the rights to use, copy, modify,
+;;; merge, publish, distribute, sublicense, and/or sell copies of the
+;;; Software, and to permit persons to whom the Software is furnished
+;;; to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
+;;; ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+;;; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;;;-----------------------------------------------------------------------
+
+
+;;; schema_decl = SCHEMA schema_id [ schema_version_id ] ';' schema_body END_SCHEMA ';' .
+;;; schema_version_id = string_literal .
+;;; schema_body = { interface_specification } [ constant_decl ] { declaration | rule_decl } .
+;;; interface_specification = reference_clause | use_clause .
+;;; reference_clause = REFERENCE FROM schema_ref [ '(' resource_or_rename { ',' resource_or_rename } ')' ] ';' .
+;;; use_clause = USE FROM schema_ref [ '(' named_type_or_rename { ',' named_type_or_rename } ')' ] ';' .
+;;; constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+;;; constant_body = constant_id ':' instantiable_type ':=' expression ';' .
+;;; declaration = entity_decl | function_decl | procedure_decl | subtype_constraint_decl | type_decl .
+(define-object p11:schema ()
+  id					; simple_id
+  version				; OPTIONAL string
+  interfaces				; REFERENCE FROM and USE FROM
+  constants
+  declarations				; TYPE, ENTITY, FUNCTION, PROCEDURE, RULE, SUBTYPE_CONSTRAINT
+  )
+
+;;; constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+
+;;; constant_body = constant_id ':' instantiable_type ':=' expression ';' .
+(define-object p11:constant ()
+  id					; simple_id
+  instantiable-type
+  expression
+  )
+
+;;; type_decl = TYPE type_id '=' underlying_type ';' [ where_clause ] END_TYPE ';' .
+;;; underlying_type = concrete_types | constructed_types .
+;;; concrete_types = aggregation_types | simple_types | type_ref .
+;;; constructed_types = enumeration_type | select_type .
+;;; where_clause = WHERE domain_rule ';' { domain_rule ';' } .
+(define-object p11:type ()
+  id					; simple_id
+  underlying
+  wheres				; OPT [1:?]
+  )
+
+;;; entity_decl = entity_head entity_body END_ENTITY ';' .
+;;; entity_head = ENTITY entity_id subsuper ';' .
+;;; subsuper = [ supertype_constraint ] [ subtype_declaration ] .
+;;; supertype_constraint = abstract_entity_declaration | abstract_supertype_declaration | supertype_rule .
+;;; abstract_entity_declaration = ABSTRACT .
+;;; abstract_supertype_declaration = ABSTRACT SUPERTYPE [ subtype_constraint ] .
+;;; supertype_constraint = abstract_entity_declaration | abstract_supertype_declaration | supertype_rule .
+;;; supertype_rule = SUPERTYPE subtype_constraint .
+;;; subtype_declaration = SUBTYPE OF '(' entity_ref { ',' entity_ref } ')' .
+;;; entity_body = { explicit_attr } [ derive_clause ] [ inverse_clause ] [ unique_clause ] [ where_clause ] .
+(define-object p11:entity ()
+  id					; simple_id
+  abstract-p
+  supertype
+  subtype
+  attrs					; [0:?]
+  derives				; OPT [1:?]
+  inverses				; OPT [1:?]
+  uniques				; OPT [1:?]
+  wheres				; OPT [1:?]
+  )
+
+;;; function_decl = function_head algorithm_head stmt { stmt } END_FUNCTION ';' .
+;;; function_head = FUNCTION function_id [ '(' formal_parameter { ';' formal_parameter } ')' ] ':' parameter_type ';' .
+;;; algorithm_head = { declaration } [ constant_decl ] [ local_decl ] .
+;;; declaration = entity_decl | function_decl | procedure_decl | subtype_constraint_decl | type_decl .
+;;; constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+;;; local_decl = LOCAL local_variable { local_variable } END_LOCAL ';' .
+;;; stmt = alias_stmt | assignment_stmt | case_stmt | compound_stmt | escape_stmt | if_stmt | null_stmt
+;;;      | procedure_call_stmt | repeat_stmt | return_stmt | skip_stmt .
+(define-object p11:function ()
+  id					; simple_id
+  parameters				; list of formal_parameter
+  return-type
+  declarations				; ENTITY, FUNCTION, PROCEDURE, SUBTYPE_CONSTRAINT, TYPE
+  constants
+  locals
+  stmts					; [1:?]
+  )
+
+;;; procedure_decl = procedure_head algorithm_head { stmt } END_PROCEDURE ';' .
+;;; procedure_head = PROCEDURE procedure_id [ '(' [ VAR ] formal_parameter { ';' [ VAR ] formal_parameter } ')' ] ';' .
+;;; algorithm_head = { declaration } [ constant_decl ] [ local_decl ] .
+;;; declaration = entity_decl | function_decl | procedure_decl | subtype_constraint_decl | type_decl .
+;;; constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+;;; local_decl = LOCAL local_variable { local_variable } END_LOCAL ';' .
+;;; stmt = alias_stmt | assignment_stmt | case_stmt | compound_stmt | escape_stmt | if_stmt | null_stmt
+;;;      | procedure_call_stmt | repeat_stmt | return_stmt | skip_stmt .
+(define-object p11:procedure ()
+  id					; simple_id
+  parameters				; list of formal_parameter
+  declarations				; ENTITY, FUNCTION, PROCEDURE, SUBTYPE_CONSTRAINT, TYPE
+  constants
+  locals
+  stmts					; [0:?]
+  )
+
+;;; rule_decl = rule_head algorithm_head { stmt } where_clause END_RULE ';' .
+;;; rule_head = RULE rule_id FOR '(' entity_ref { ',' entity_ref } ')' ';' .
+;;; algorithm_head = { declaration } [ constant_decl ] [ local_decl ] .
+;;; declaration = entity_decl | function_decl | procedure_decl | subtype_constraint_decl | type_decl .
+;;; constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+;;; local_decl = LOCAL local_variable { local_variable } END_LOCAL ';' .
+;;; stmt = alias_stmt | assignment_stmt | case_stmt | compound_stmt | escape_stmt | if_stmt | null_stmt
+;;;      | procedure_call_stmt | repeat_stmt | return_stmt | skip_stmt .
+;;; where_clause = WHERE domain_rule ';' { domain_rule ';' } .
+(define-object p11:rule ()
+  id					; simple-id
+  entities				; list of entity_ref
+  declarations				; ENTITY, FUNCTION, PROCEDURE, SUBTYPE_CONSTRAINT, TYPE
+  constants
+  locals
+  stmts					; [0:?]
+  wheres
+  )
+
+;;; subtype_constraint_decl = subtype_constraint_head subtype_constraint_body END_SUBTYPE_CONSTRAINT ';' .
+;;; subtype_constraint_head = SUBTYPE_CONSTRAINT subtype_constraint_id FOR entity_ref ';' .
+;;; subtype_constraint_body = [ abstract_supertype ] [ total_over ] [ supertype_expression ';' ] .
+;;; abstract_supertype = ABSTRACT SUPERTYPE ';' .
+;;; total_over = TOTAL_OVER '(' entity_ref { ',' entity_ref } ')' ';' .
+;;; supertype_expression = supertype_factor { ANDOR supertype_factor } .
+;;; supertype_factor = supertype_term { AND supertype_term } .
+;;; supertype_term = entity_ref | one_of | '(' supertype_expression ')' .
+;;; one_of = ONEOF '(' supertype_expression { ',' supertype_expression } ')' .
+(define-object p11:subtype_constraint ()
+  id					; simple-id
+  entity-ref
+  abstract-p
+  total-over
+  supertype
+  )

Added: trunk/src/libs/parser11/macros.lisp
===================================================================
--- trunk/src/libs/parser11/macros.lisp	                        (rev 0)
+++ trunk/src/libs/parser11/macros.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -0,0 +1,48 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: P11I; Base: 10 -*-
+
+#-Genera
+(in-package :P11I)
+
+;;; Copyright (c) 2008    Craig Lanning
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without restriction,
+;;; including without limitation the rights to use, copy, modify,
+;;; merge, publish, distribute, sublicense, and/or sell copies of the
+;;; Software, and to permit persons to whom the Software is furnished
+;;; to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
+;;; ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+;;; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;;;-----------------------------------------------------------------------
+
+
+(defun kintern (string) (intern (string string) :keyword))
+
+(defun sintern (format &rest args) (intern (apply #'format nil format args)))
+
+
+(defmacro define-object (name superclasses &body slots)
+  (setf slots (loop for slot in slots
+		collect (if (listp slot) slot (list slot))))
+  `(progn
+    (defclass ,name (,@(or superclasses '(object)))
+      (,@(loop for (sname . options) in slots
+	   collect `(,sname :initarg ,(kintern sname)
+		     :accessor ,sname)))
+      )))
+
+(defmacro defparser ()
+  `(progn
+
+    )
+  )

Added: trunk/src/libs/parser11/parser1.lisp
===================================================================
--- trunk/src/libs/parser11/parser1.lisp	                        (rev 0)
+++ trunk/src/libs/parser11/parser1.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -0,0 +1,214 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: P11I; Base: 10 -*-
+
+#-Genera
+(in-package :P11I)
+
+;;; Copyright (c) 2008    Craig Lanning
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without restriction,
+;;; including without limitation the rights to use, copy, modify,
+;;; merge, publish, distribute, sublicense, and/or sell copies of the
+;;; Software, and to permit persons to whom the Software is furnished
+;;; to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
+;;; ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+;;; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;;;-----------------------------------------------------------------------
+
+
+;; iso-10303-11:2004 (no numbers) (Ed 2)
+
+;abstract_entity_declaration = ABSTRACT .
+;abstract_supertype = ABSTRACT SUPERTYPE ';' .
+;abstract_supertype_declaration = ABSTRACT SUPERTYPE [ subtype_constraint ] .
+;actual_parameter_list = '(' parameter { ',' parameter } ')' .
+;add_like_op = '+' | '-' | OR | XOR .
+;aggregate_initializer = '[' [ element { ',' element } ] ']' .
+;aggregate_source = simple_expression .
+;aggregate_type = AGGREGATE [ ':' type_label ] OF parameter_type .
+;aggregation_types = array_type | bag_type | list_type | set_type .
+;algorithm_head = { declaration } [ constant_decl ] [ local_decl ] .
+;alias_stmt = ALIAS variable_id FOR general_ref { qualifier } ';' stmt { stmt } END_ALIAS ';' .
+;array_type = ARRAY bound_spec OF [ OPTIONAL ] [ UNIQUE ] instantiable_type .
+;assignment_stmt = general_ref { qualifier } ':=' expression ';' .
+;attribute_decl = attribute_id | redeclared_attribute .
+;attribute_id = simple_id .
+;attribute_qualifier = '.' attribute_ref .
+;bag_type = BAG [ bound_spec ] OF instantiable_type .
+;binary_type = BINARY [ width_spec ] .
+;boolean_type = BOOLEAN .
+;bound_1 = numeric_expression .
+;bound_2 = numeric_expression .
+;bound_spec = '[' bound_1 ':' bound_2 ']' .
+;built_in_constant = CONST_E | PI | SELF | '?' .
+;built_in_function = ABS | ACOS | ASIN | ATAN | BLENGTH | COS | EXISTS | EXP | FORMAT | HIBOUND
+;                  | HIINDEX | LENGTH | LOBOUND | LOINDEX | LOG | LOG2 | LOG10 | NVL | ODD
+;                  | ROLESOF | SIN | SIZEOF | SQRT | TAN | TYPEOF | USEDIN | VALUE | VALUE_IN
+;                  | VALUE_UNIQUE .
+;built_in_procedure = INSERT | REMOVE .
+;case_action = case_label { ',' case_label } ':' stmt .
+;case_label = expression .
+;case_stmt = CASE selector OF { case_action } [ OTHERWISE ':' stmt ] END_CASE ';' .
+;compound_stmt = BEGIN stmt { stmt } END ';' .
+;concrete_types = aggregation_types | simple_types | type_ref .
+;constant_body = constant_id ':' instantiable_type ':=' expression ';' .
+;constant_decl = CONSTANT constant_body { constant_body } END_CONSTANT ';' .
+;constant_factor = built_in_constant | constant_ref .
+;constant_id = simple_id .
+;constructed_types = enumeration_type | select_type .
+;declaration = entity_decl | function_decl | procedure_decl | subtype_constraint_decl | type_decl .
+;derived_attr = attribute_decl ':' parameter_type ':=' expression ';' .
+;derive_clause = DERIVE derived_attr { derived_attr } .
+;domain_rule = [ rule_label_id ':' ] expression .
+;element = expression [ ':' repetition ] .
+;entity_body = { explicit_attr } [ derive_clause ] [ inverse_clause ] [ unique_clause ] [ where_clause ] .
+;entity_constructor = entity_ref '(' [ expression { ',' expression } ] ')' .
+;entity_decl = entity_head entity_body END_ENTITY ';' .
+;entity_head = ENTITY entity_id subsuper ';' .
+;entity_id = simple_id .
+;enumeration_extension = BASED_ON type_ref [ WITH enumeration_items ] .
+;enumeration_id = simple_id .
+;enumeration_items = '(' enumeration_id { ',' enumeration_id } ')' .
+;enumeration_reference = [ type_ref '.' ] enumeration_ref .
+;enumeration_type = [ EXTENSIBLE ] ENUMERATION [ ( OF enumeration_items ) | enumeration_extension ] .
+;escape_stmt = ESCAPE ';' .
+;explicit_attr = attribute_decl { ',' attribute_decl } ':' [ OPTIONAL ] parameter_type ';' .
+;expression = simple_expression [ rel_op_extended simple_expression ] .
+;factor = simple_factor [ '**' simple_factor ] .
+;formal_parameter = parameter_id { ',' parameter_id } ':' parameter_type .
+;function_call = ( built_in_function | function_ref ) [ actual_parameter_list ] .
+;function_decl = function_head algorithm_head stmt { stmt } END_FUNCTION ';' .
+;function_head = FUNCTION function_id [ '(' formal_parameter { ';' formal_parameter } ')' ] ':' parameter_type ';' .
+;function_id = simple_id .
+;generalized_types = aggregate_type | general_aggregation_types | generic_entity_type | generic_type .
+;general_aggregation_types = general_array_type | general_bag_type | general_list_type | general_set_type .
+;general_array_type = ARRAY [ bound_spec ] OF [ OPTIONAL ] [ UNIQUE ] parameter_type .
+;general_bag_type = BAG [ bound_spec ] OF parameter_type .
+;general_list_type = LIST [ bound_spec ] OF [ UNIQUE ] parameter_type .
+;general_ref = parameter_ref | variable_ref .
+;general_set_type = SET [ bound_spec ] OF parameter_type .
+;generic_entity_type = GENERIC_ENTITY [ ':' type_label ] .
+;generic_type = GENERIC [ ':' type_label ] .
+;group_qualifier = '\' entity_ref .
+;if_stmt = IF logical_expression THEN stmt { stmt } [ ELSE stmt { stmt } ] END_IF ';' .
+;increment = numeric_expression .
+;increment_control = variable_id ':=' bound_1 TO bound_2 [ BY increment ] .
+;index = numeric_expression .
+;index_1 = index .
+;index_2 = index .
+;index_qualifier = '[' index_1 [ ':' index_2 ] ']' .
+;instantiable_type = concrete_types | entity_ref .
+;integer_type = INTEGER .
+;interface_specification = reference_clause | use_clause .
+;interval = '{' interval_low interval_op interval_item interval_op interval_high '}' .
+;interval_high = simple_expression .
+;interval_item = simple_expression .
+;interval_low = simple_expression .
+;interval_op = '<' | '<=' .
+;inverse_attr = attribute_decl ':' [ ( SET | BAG ) [ bound_spec ] OF ] entity_ref FOR
+;               [ entity_ref '.' ] attribute_ref ';' .
+;inverse_clause = INVERSE inverse_attr { inverse_attr } .
+;list_type = LIST [ bound_spec ] OF [ UNIQUE ] instantiable_type .
+;literal = binary_literal | logical_literal | real_literal | string_literal .
+;local_decl = LOCAL local_variable { local_variable } END_LOCAL ';' .
+;local_variable = variable_id { ',' variable_id } ':' parameter_type [ ':=' expression ] ';' .
+;logical_expression = expression .
+;logical_literal = FALSE | TRUE | UNKNOWN .
+;logical_type = LOGICAL .
+;multiplication_like_op = '*' | '/' | DIV | MOD | AND | '||' .
+;named_types = entity_ref | type_ref .
+;named_type_or_rename = named_types [ AS ( entity_id | type_id ) ] .
+;null_stmt = ';' .
+;number_type = NUMBER .
+;numeric_expression = simple_expression .
+;one_of = ONEOF '(' supertype_expression { ',' supertype_expression } ')' .
+;parameter = expression .
+;parameter_id = simple_id .
+;parameter_type = generalized_types | named_types | simple_types .
+;population = entity_ref .
+;precision_spec = numeric_expression .
+;primary = literal | ( qualifiable_factor { qualifier } ) .
+;procedure_call_stmt = ( built_in_procedure | procedure_ref ) [ actual_parameter_list ] ';' .
+;procedure_decl = procedure_head algorithm_head { stmt } END_PROCEDURE ';' .
+;procedure_head = PROCEDURE procedure_id [ '(' [ VAR ] formal_parameter { ';' [ VAR ] formal_parameter } ')' ] ';' .
+;procedure_id = simple_id .
+;qualifiable_factor = attribute_ref | constant_factor | function_call | general_ref | population .
+;qualified_attribute = SELF group_qualifier attribute_qualifier .
+;qualifier = attribute_qualifier | group_qualifier | index_qualifier .
+;query_expression = QUERY '(' variable_id '<*' aggregate_source '|' logical_expression ')' .
+;real_type = REAL [ '(' precision_spec ')' ] .
+;redeclared_attribute = qualified_attribute [ RENAMED attribute_id ] .
+;referenced_attribute = attribute_ref | qualified_attribute .
+;reference_clause = REFERENCE FROM schema_ref [ '(' resource_or_rename { ',' resource_or_rename } ')' ] ';' .
+;rel_op = '<' | '>' | '<=' | '>=' | '<>' | '=' | ':<>:' | ':=:' .
+;rel_op_extended = rel_op | IN | LIKE .
+;rename_id = constant_id | entity_id | function_id | procedure_id | type_id .
+;repeat_control = [ increment_control ] [ while_control ] [ until_control ] .
+;repeat_stmt = REPEAT repeat_control ';' stmt { stmt } END_REPEAT ';' .
+;repetition = numeric_expression .
+;resource_or_rename = resource_ref [ AS rename_id ] .
+;resource_ref = constant_ref | entity_ref | function_ref | procedure_ref | type_ref .
+;return_stmt = RETURN [ '(' expression ')' ] ';' .
+;rule_decl = rule_head algorithm_head { stmt } where_clause END_RULE ';' .
+;rule_head = RULE rule_id FOR '(' entity_ref { ',' entity_ref } ')' ';' .
+;rule_id = simple_id .
+;rule_label_id = simple_id .
+;schema_body = { interface_specification } [ constant_decl ] { declaration | rule_decl } .
+;schema_decl = SCHEMA schema_id [ schema_version_id ] ';' schema_body END_SCHEMA ';' .
+;schema_id = simple_id .
+;schema_version_id = string_literal .
+;selector = expression .
+;select_extension = BASED_ON type_ref [ WITH select_list ] .
+;select_list = '(' named_types { ',' named_types } ')' .
+;select_type = [ EXTENSIBLE [ GENERIC_ENTITY ] ] SELECT [ select_list | select_extension ] .
+;set_type = SET [ bound_spec ] OF instantiable_type .
+;sign = '+' | '-' .
+;simple_expression = term { add_like_op term } .
+;simple_factor = aggregate_initializer | entity_constructor | enumeration_reference | interval
+;              | query_expression | ( [ unary_op ] ( '(' expression ')' | primary ) ) .
+;simple_types = binary_type | boolean_type | integer_type | logical_type | number_type | real_type | string_type .
+;skip_stmt = SKIP ';' .
+;stmt = alias_stmt | assignment_stmt | case_stmt | compound_stmt | escape_stmt | if_stmt
+;     | null_stmt | procedure_call_stmt | repeat_stmt | return_stmt | skip_stmt .
+;string_literal = simple_string_literal | encoded_string_literal .
+;string_type = STRING [ width_spec ] .
+;subsuper = [ supertype_constraint ] [ subtype_declaration ] .
+;subtype_constraint = OF '(' supertype_expression ')' .
+;subtype_constraint_body = [ abstract_supertype ] [ total_over ] [ supertype_expression ';' ] .
+;subtype_constraint_decl = subtype_constraint_head subtype_constraint_body END_SUBTYPE_CONSTRAINT ';' .
+;subtype_constraint_head = SUBTYPE_CONSTRAINT subtype_constraint_id FOR entity_ref ';' .
+;subtype_constraint_id = simple_id .
+;subtype_declaration = SUBTYPE OF '(' entity_ref { ',' entity_ref } ')' .
+;supertype_constraint = abstract_entity_declaration | abstract_supertype_declaration | supertype_rule .
+;supertype_expression = supertype_factor { ANDOR supertype_factor } .
+;supertype_factor = supertype_term { AND supertype_term } .
+;supertype_rule = SUPERTYPE subtype_constraint .
+;supertype_term = entity_ref | one_of | '(' supertype_expression ')' .
+;syntax = schema_decl { schema_decl } .
+;term = factor { multiplication_like_op factor } .
+;total_over = TOTAL_OVER '(' entity_ref { ',' entity_ref } ')' ';' .
+;type_decl = TYPE type_id '=' underlying_type ';' [ where_clause ] END_TYPE ';' .
+;type_id = simple_id .
+;type_label = type_label_id | type_label_ref .
+;type_label_id = simple_id .
+;unary_op = '+' | '-' | NOT .
+;underlying_type = concrete_types | constructed_types .
+;unique_clause = UNIQUE unique_rule ';' { unique_rule ';' } .
+;unique_rule = [ rule_label_id ':' ] referenced_attribute { ',' referenced_attribute } .
+;until_control = UNTIL logical_expression .
+;use_clause = USE FROM schema_ref [ '(' named_type_or_rename { ',' named_type_or_rename } ')' ] ';' .
+;variable_id = simple_id .
+;where_clause = WHERE domain_rule ';' { domain_rule ';' } .
+;while_control = WHILE logical_expression .
+;width = numeric_expression .
+;width_spec = '(' width ')' [ FIXED ] .

Modified: trunk/src/libs/parser11/readtable.lisp
===================================================================
--- trunk/src/libs/parser11/readtable.lisp	2008-04-18 03:30:40 UTC (rev 7)
+++ trunk/src/libs/parser11/readtable.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -192,7 +192,7 @@
   (case (peek-char t stream t nil t)
     (#\| (read-char stream t nil t)		;eat #\|
      :vbar-vbar)				; '||'
-    (t char))					; '|'
+    (t char)))					; '|'
 
 (defun EXP-TILDA (stream char)
   ;; ~ ~~

Added: trunk/src/libs/parser11/statements.lisp
===================================================================
--- trunk/src/libs/parser11/statements.lisp	                        (rev 0)
+++ trunk/src/libs/parser11/statements.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -0,0 +1,91 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: P11I; Base: 10 -*-
+
+#-Genera
+(in-package :P11I)
+
+;;; Copyright (c) 2008    Craig Lanning
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without restriction,
+;;; including without limitation the rights to use, copy, modify,
+;;; merge, publish, distribute, sublicense, and/or sell copies of the
+;;; Software, and to permit persons to whom the Software is furnished
+;;; to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
+;;; ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+;;; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;;;-----------------------------------------------------------------------
+
+
+;;; stmt = alias_stmt | assignment_stmt | case_stmt | compound_stmt | escape_stmt | if_stmt
+;;;      | null_stmt | procedure_call_stmt | repeat_stmt | return_stmt | skip_stmt .
+
+;;; alias_stmt = ALIAS variable_id FOR general_ref { qualifier } ';' stmt { stmt } END_ALIAS ';' .
+(define-object alias_stmt (stmt)
+  id					; simple_id
+  general-ref
+  qualifiers
+  stmts
+  )
+
+;;; assignment_stmt = general_ref { qualifier } ':=' expression ';' .
+(define-object assignment_stmt (stmt)
+  general-ref
+  qualifiers
+  expression
+  )
+
+;;; case_stmt = CASE selector OF { case_action } [ OTHERWISE ':' stmt ] END_CASE ';' .
+(define-object case_stmt (stmt)
+  selector
+  actions				; [0:?]
+  otherwise-stmt
+  )
+
+;;; compound_stmt = BEGIN stmt { stmt } END ';' .
+(define-object compound_stmt (stmt)
+  stmts					; [1:?]
+  )
+
+;;; escape_stmt = ESCAPE ';' .
+(define-object escape_stmt (stmt) )
+
+;;; if_stmt = IF logical_expression THEN stmt { stmt } [ ELSE stmt { stmt } ] END_IF ';' .
+(define-object if_stmt (stmt)
+  conditional				; logical expression
+  then-stmts				; [1:?]
+  else-stmts				; OPT [1:?]
+  )
+
+;;; null_stmt = ';' .
+(define-object null_stmt (stmt) )
+
+;;; procedure_call_stmt = ( built_in_procedure | procedure_ref ) [ actual_parameter_list ] ';' .
+(define-object procedure_call_stmt (stmt)
+  procedure-ref
+  parameters
+  )
+
+;;; repeat_stmt = REPEAT repeat_control ';' stmt { stmt } END_REPEAT ';' .
+;;; repeat_control = [ increment_control ] [ while_control ] [ until_control ] .
+;;; increment_control = variable_id ':=' bound_1 TO bound_2 [ BY increment ] .
+;;; while_control = WHILE logical_expression .
+;;; until_control = UNTIL logical_expression .
+(define-object repeat_stmt (stmt)
+  inc-control
+  while-control
+  until-control
+  stmts					; [1:?]
+  )
+
+;;; skip_stmt = SKIP ';' .
+(define-object skip_stmt (stmt) )

Modified: trunk/src/libs/parser11/system.lisp
===================================================================
--- trunk/src/libs/parser11/system.lisp	2008-04-18 03:30:40 UTC (rev 7)
+++ trunk/src/libs/parser11/system.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -28,7 +28,41 @@
 
 ;;; System definition goes here
 
+;(defsystem :part-11-parser
+;    (:pathname "stoys:libs;parser11;"
+;	       )
+;  (:module package (:type :lisp-read-only))
+;
+;  (:serial
+;   package
+;   "globals" "readtable"
+;   (:dependent "macros"
+;     (:serial
+;      "declarations" "statements"))
+;   "built-ins"
+;   "top-level"))
+
 ;;; File order is:
 ;;;   package.lisp
 ;;;   globals.lisp
 ;;;   readtable.lisp
+;;;   macros.lisp
+;;;   declarations.lisp
+;;;   statements.lisp
+
+;;;   built-ins.lisp
+
+;;;   top-level.lisp
+
+(load "package" :print nil :verbose t)
+
+(defun compile-load (name)
+  (when (or (null (file-write-date (format nil "~A.fasl" name)))
+	    (> (file-write-date (format nil "~A.lisp" name))
+	       (file-write-date (format nil "~A.fasl" name))))
+    (compile-file name :print nil :verbose t))
+  (load name :print nil :verbose t))
+
+(loop for name in '("globals" "readtable" "macros" "declarations"
+		    "statements" "built-ins" "top-level")
+  do (compile-load name))

Added: trunk/src/libs/parser11/top-level.lisp
===================================================================
--- trunk/src/libs/parser11/top-level.lisp	                        (rev 0)
+++ trunk/src/libs/parser11/top-level.lisp	2008-04-21 00:49:16 UTC (rev 8)
@@ -0,0 +1,36 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: P11I; Base: 10 -*-
+
+#-Genera
+(in-package :P11I)
+
+;;; Copyright (c) 2008    Craig Lanning
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without restriction,
+;;; including without limitation the rights to use, copy, modify,
+;;; merge, publish, distribute, sublicense, and/or sell copies of the
+;;; Software, and to permit persons to whom the Software is furnished
+;;; to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
+;;; ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+;;; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;;;-----------------------------------------------------------------------
+
+
+;;;
+;;; This contains the top-level interface
+;;;
+
+
+(defun load-express (path)
+  (setf path (pathname path))
+  )


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.