HOL-OCL
/
su4sml
1
0
Fork 0
Code Issues Pull Requests Releases Activity

first functional integreation of the OCL parser and type-checker (and some minor cleanup) 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6597 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Achim D. Brucker 2007-06-13 05:55:41 +00:00
parent a6093e684c
commit febca88ad6
16 changed files with 7560 additions and 422 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/ROOT.ML
View File

@ -113,7 +113,13 @@ use "rep_secure.sml";
use "rep_su2holocl.sml";
(* ******************************************************** *)
(* codegen-module, developed by Raphael Eidenbenz *)
(* OCL parser and type-checker *)
OS.FileSys.chDir "ocl_parser";
use "ROOT.ML";
OS.FileSys.chDir "..";
(* ******************************************************** *)
(* codegen-module *)
OS.FileSys.chDir "codegen";
use "ROOT.ML";
OS.FileSys.chDir "..";

1
src/ocl_parser/ROOT.ML
View File

@ -39,3 +39,4 @@ use "ocl.grm.sml";
use "parser.sml";
use "fix_types.sml";
use "model_import.sml";
infix THEN;

64
src/ocl_parser/isar/isar_setup.sml
View File

@ -1,64 +0,0 @@
(*****************************************************************************
* HOL-OCL - a shallow embedding of OCL into Isabelle/HOL
*
* model_import. - main "ROOT.ML" file for HOL-OCL
* Copyright (C) 2006,2007 Achim D. Brucker <achim@brucker.ch>
*
* This file is part of HOL-OCL.
*
* HOL-OCL is free software; you can redistribute it and/or modify it under
* the terms of the GNU General Public License as published by the Free
* Software Foundation; either version 2 of the License, or (at your option)
* any later version.
*
* HOL-OCL is distributed in the hope that it will be useful, but WITHOUT ANY
* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
* details.
*
* You should have received a copy of the GNU General Public License along
* with this program; if not, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*****************************************************************************)
OS.FileSys.chDir "..";
use "ROOT.ML";
OS.FileSys.chDir "isar";
structure isar_import_setup =
struct
structure P = OuterParse and K = OuterKeyword;
fun load_xmiOclT ((xmiFile,oclFile),excludedPackages) thy =
let
fun load_mds xmiFile oclFile thy =
let
val model = map Rep.normalize (ModelImport.import xmiFile oclFile excludedPackages)
val thy = rep_encoder.add_classifiers model thy;
in
thy
end
val thy = load_mds xmiFile oclFile thy
in
thy
end
val load_xmiOclP =
OuterSyntax.command "import_model" "import UML/OCL specification"
OuterKeyword.thy_script
((P.name -- (Scan.optional P.name "")
-- (Scan.optional (P.$$$ "[" |-- P.list1 P.name --| P.$$$ "]") [] ))
>> (fn((xmi,ocl),exPackages) =>
(Toplevel.theory ( fn thy => load_xmiOclT ((xmi,ocl),exPackages) thy))))
val _ = OuterSyntax.add_parsers [load_xmiOclP];
end

70
src/ocl_parser/isar/test.thy
View File

@ -1,70 +0,0 @@
theory test
imports
OCL
begin
welcome
ML{*
use "isar_setup.sml";
*}
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/company/company.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/company/company.ocl"
*)
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/ebank/ebank.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/ebank/ebank.ocl"
*)
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/encoding_example/encoding_example.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/encoding_example/encoding_example.ocl"
*)
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/isp/isp.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/isp/isp.ocl"
*)
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/royals_and_loyals/royals_and_loyals.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/royals_and_loyals/royals_and_loyals.ocl"
*)
welcome
(*
holocl_params [op_semantics=invoke]
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/simple/simple.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/simple/simple.ocl"
*)
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/stack/stack.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/stack/stack.ocl"
*)
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/digraph/digraph.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/digraph/digraph.ocl"
*)
welcome
(*
import_model "/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/vehicles/vehicles.zargo"
"/home/brucker/infsec/teaching/theses/semesterarbeiten/2006_mkrucker_ocl/examples/vehicles/vehicles.ocl"
*)
welcome
end

90
src/ocl_parser/ocl.grm.sig Normal file
View File

@ -0,0 +1,90 @@
signature OclParser_TOKENS =
sig
type ('a,'b) token
type svalue
val SIMPLE_NAME: (string) * 'a * 'a -> (svalue,'a) token
val STRING_LITERAL: (string) * 'a * 'a -> (svalue,'a) token
val REAL_LITERAL: (string) * 'a * 'a -> (svalue,'a) token
val INTEGER_LITERAL: (string) * 'a * 'a -> (svalue,'a) token
val NOT: (string) * 'a * 'a -> (svalue,'a) token
val LOG_IMPL: (string) * 'a * 'a -> (svalue,'a) token
val LOG_XOR: (string) * 'a * 'a -> (svalue,'a) token
val LOG_OR: (string) * 'a * 'a -> (svalue,'a) token
val LOG_AND: (string) * 'a * 'a -> (svalue,'a) token
val REL_LTE: (string) * 'a * 'a -> (svalue,'a) token
val REL_GTE: (string) * 'a * 'a -> (svalue,'a) token
val REL_LT: (string) * 'a * 'a -> (svalue,'a) token
val REL_GT: (string) * 'a * 'a -> (svalue,'a) token
val REL_NOTEQUAL: (string) * 'a * 'a -> (svalue,'a) token
val PLUS: (string) * 'a * 'a -> (svalue,'a) token
val SLASH: (string) * 'a * 'a -> (svalue,'a) token
val STAR: (string) * 'a * 'a -> (svalue,'a) token
val MINUS: (string) * 'a * 'a -> (svalue,'a) token
val OCLASTYPE: (string) * 'a * 'a -> (svalue,'a) token
val OCLISKINDOF: (string) * 'a * 'a -> (svalue,'a) token
val OCLISTYPEOF: (string) * 'a * 'a -> (svalue,'a) token
val ISUNIQUE: (string) * 'a * 'a -> (svalue,'a) token
val ONE: (string) * 'a * 'a -> (svalue,'a) token
val EXISTS: (string) * 'a * 'a -> (svalue,'a) token
val ANY: (string) * 'a * 'a -> (svalue,'a) token
val COLLECT: (string) * 'a * 'a -> (svalue,'a) token
val REJECT: (string) * 'a * 'a -> (svalue,'a) token
val SELECT: (string) * 'a * 'a -> (svalue,'a) token
val ITERATE: (string) * 'a * 'a -> (svalue,'a) token
val GUARD: (string) * 'a * 'a -> (svalue,'a) token
val VERTICAL_BAR: (string) * 'a * 'a -> (svalue,'a) token
val BRACE_CLOSE: (string) * 'a * 'a -> (svalue,'a) token
val BRACE_OPEN: (string) * 'a * 'a -> (svalue,'a) token
val PAREN_CLOSE: (string) * 'a * 'a -> (svalue,'a) token
val PAREN_OPEN: (string) * 'a * 'a -> (svalue,'a) token
val THEN: (string) * 'a * 'a -> (svalue,'a) token
val POST: (Context.ConditionType) * 'a * 'a -> (svalue,'a) token
val PRE: (Context.ConditionType) * 'a * 'a -> (svalue,'a) token
val PACKAGE: (string) * 'a * 'a -> (svalue,'a) token
val LET: (string) * 'a * 'a -> (svalue,'a) token
val INV: (string) * 'a * 'a -> (svalue,'a) token
val INIT: (Context.AttrOrAssoc) * 'a * 'a -> (svalue,'a) token
val IN: (string) * 'a * 'a -> (svalue,'a) token
val IF: (string) * 'a * 'a -> (svalue,'a) token
val TRUE: (string) * 'a * 'a -> (svalue,'a) token
val FORALL: (string) * 'a * 'a -> (svalue,'a) token
val FALSE: (string) * 'a * 'a -> (svalue,'a) token
val ENDPACKAGE: (string) * 'a * 'a -> (svalue,'a) token
val ENDIF: (string) * 'a * 'a -> (svalue,'a) token
val ELSE: (string) * 'a * 'a -> (svalue,'a) token
val DERIVE: (Context.AttrOrAssoc) * 'a * 'a -> (svalue,'a) token
val DEF: (string) * 'a * 'a -> (svalue,'a) token
val CONTEXT: (string) * 'a * 'a -> (svalue,'a) token
val BODY: (Context.ConditionType) * 'a * 'a -> (svalue,'a) token
val DBL_CARAT: (string) * 'a * 'a -> (svalue,'a) token
val CARAT: (string) * 'a * 'a -> (svalue,'a) token
val BRACKET_CLOSE: (string) * 'a * 'a -> (svalue,'a) token
val BRACKET_OPEN: (string) * 'a * 'a -> (svalue,'a) token
val TUPLE_TYPE: (string) * 'a * 'a -> (svalue,'a) token
val TUPLE: (string) * 'a * 'a -> (svalue,'a) token
val SET: (string) * 'a * 'a -> (svalue,'a) token
val ORDERED_SET: (string) * 'a * 'a -> (svalue,'a) token
val SEQUENCE: (string) * 'a * 'a -> (svalue,'a) token
val COLLECTION: (string) * 'a * 'a -> (svalue,'a) token
val BAG: (string) * 'a * 'a -> (svalue,'a) token
val AT_PRE: (string) * 'a * 'a -> (svalue,'a) token
val HASH: (string) * 'a * 'a -> (svalue,'a) token
val QUESTION_MARK: (string) * 'a * 'a -> (svalue,'a) token
val EQUALS: (string) * 'a * 'a -> (svalue,'a) token
val SEMI_COLON: (string) * 'a * 'a -> (svalue,'a) token
val DBL_COLON: (string) * 'a * 'a -> (svalue,'a) token
val COLON: (string) * 'a * 'a -> (svalue,'a) token
val DBL_DOT: (string) * 'a * 'a -> (svalue,'a) token
val DOT: (string) * 'a * 'a -> (svalue,'a) token
val ARROW_RIGHT: (string) * 'a * 'a -> (svalue,'a) token
val COMMA: (string) * 'a * 'a -> (svalue,'a) token
val TICK: (string) * 'a * 'a -> (svalue,'a) token
val EOF: 'a * 'a -> (svalue,'a) token
end
signature OclParser_LRVALS=
sig
structure Tokens : OclParser_TOKENS
structure ParserData:PARSER_DATA
sharing type ParserData.Token.token = Tokens.token
sharing type ParserData.svalue = Tokens.svalue
end

3466
src/ocl_parser/ocl.grm.sml Normal file
View File

File diff suppressed because it is too large Load Diff

3912
src/ocl_parser/ocl.lex.sml Normal file
View File

File diff suppressed because it is too large Load Diff

2
src/ocl_parser/parser.110.62.cm
View File

@ -5,7 +5,7 @@ Group is
$smlnj/smlnj-lib/smlnj-lib.cm
#else
#endif
../su4sml/src/su4sml.110.62.cm
../su4sml_core.110.62.cm
#if defined (NEW_CM)
$smlnj/basis/basis.cm

2
src/ocl_parser/parser.cm
View File

@ -5,7 +5,7 @@ Group is
$/smlnj-lib.cm
#else
#endif
../su4sml/src/su4sml.cm
../su4sml_core.cm
#if defined (NEW_CM)
$/basis.cm

19
src/ocl_parser/script.sml
View File

@ -1,19 +0,0 @@
(* simple script for debugging and testing *)
(* this script requires that the environment variable
SU4SML_HOME
points to the su4sml top-level directory (i.e., `pwd`/../su4sml")
*)
(* display settings: printDepth = 1000 *)
Control.Print.printDepth := 5000;
fun print_depth n =
(Control.Print.printDepth := n div 2;
Control.Print.printLength := n);
val model = ModelImport.import "../examples/ebank/ebank.xmi"
"../examples/ebank/ebank.manuel.ocl" [];

157
src/ocl_parser/test-suite.sml
View File

@ -1,157 +0,0 @@
type result = {
parse : bool,
preprocess : bool,
typecheck : bool,
update : bool,
msg : string
}
type testcase = {
name : string,
uml : string,
ocl : string,
result : result
}
val initResult = {
parse = false,
preprocess = false,
typecheck = false,
update = false,
msg = ""
}:result
val prefix = "../examples/"
val testcases = [
{
name = "Company",
uml = prefix^"company/company.zargo",
ocl = prefix^"company/company.ocl",
result = initResult
}:testcase,
{
name = "ebank (Manuel)",
uml = prefix^"ebank/ebank.zargo",
ocl = prefix^"ebank/ebank.ocl",
result = initResult
}:testcase,
{
name = "encoding_example",
uml = prefix^"encoding_example/encoding_example.zargo",
ocl = prefix^"encoding_example/encoding_example.ocl",
result = initResult
}:testcase,
{
name = "isp",
uml = prefix^"isp/isp.zargo",
ocl = prefix^"isp/isp.ocl",
result = initResult
}:testcase,
{
name = "Royals and Loyals",
uml = prefix^"royals_and_loyals/royals_and_loyals.zargo",
ocl = prefix^"royals_and_loyals/royals_and_loyals.ocl",
result = initResult
}:testcase,
{
name = "simple",
uml = prefix^"simple/simple.zargo",
ocl = prefix^"simple/simple.ocl",
result = initResult
}:testcase,
{
name = "stack",
uml = prefix^"stack/stack.zargo",
ocl = prefix^"stack/stack.ocl",
result = initResult
}:testcase,
{
name = "digraph",
uml = prefix^"digraph/digraph.zargo",
ocl = prefix^"digraph/digraph.ocl",
result = initResult
}:testcase,
{
name = "vehicles",
uml = prefix^"vehicles/vehicles.zargo",
ocl = prefix^"vehicles/vehicles.ocl",
result = initResult
}:testcase
]
fun test (tc:testcase) =
let
val xmi = ModelImport.parseUML (#uml tc)
handle _ => []
val ocl = ModelImport.parseOCL (#ocl tc)
handle _ => []
val OclParse = if ocl = [] then false else true
val (xmi,ocl) = ModelImport.removePackages (xmi,ocl) []
handle _ => ([],[])
val _ = print "### Preprocess Context List ###\n"
val fixed_ocl = Preprocessor.preprocess_context_list ocl ((OclLibrary.oclLib)@xmi)
handle _ => []
val OclPreprocess = if fixed_ocl = [] then false else true
val _ = print "### Finished Preprocess Context List ###\n\n"
val _ = print "### Type Checking ###\n"
val typed_cl = TypeChecker.check_context_list fixed_ocl ((OclLibrary.oclLib)@xmi)
handle _ => []
val OclTC = if typed_cl = [] then false else true
val _ = print "### Finished Type Checking ###\n\n"
val _ = print"### Updating Classifier List ###\n"
val model = Update_Model.gen_updated_classifier_list typed_cl ((OclLibrary.oclLib)@xmi)
handle _ => []
val modelUpdate = if model = [] then false else true
val _ = print "### Finished Updating Classifier List ###\n"
val model = ModelImport.removeOclLibrary model
in
{
name = #name tc,
uml = #uml tc,
ocl = #ocl tc,
result =
{
parse = OclParse,
preprocess = OclParse andalso OclPreprocess,
typecheck = OclParse andalso OclPreprocess andalso OclTC,
update = OclParse andalso OclPreprocess andalso OclTC andalso modelUpdate,
msg = ""
}:result
}:testcase
end
fun printResult (tc:testcase) =
let
fun printBool b = if b then "passed" else "FAILED"
val _ = print ("\n *** "^(#name tc)^" ***\n")
val res = (#result tc)
val _ = print (" parsing: "^(printBool (#parse res))^"\n")
val _ = print (" preprocess: "^(printBool (#preprocess res))^"\n")
val _ = print (" typecheck: "^(printBool (#typecheck res))^"\n")
val _ = print (" update: "^(printBool (#update res))^"\n\n")
val _ = print (" ==> overall: "^(printBool ((#parse res)
andalso (#preprocess res)
andalso (#typecheck res)
andalso (#update res)))^"\n")
in
()
end
val _ = (Ext_Library.log_level := 10);();
val testcases = map test testcases
val _ = map printResult testcases

31
src/ocl_parser/values.sml
View File

@ -1,31 +0,0 @@
open Rep_OclTerm;
open Rep_Core;
open OclLibrary;
open Context;
open OclLibrary;
val xmi = RepParser.readFile "../examples/company/company.xmi";
val untyped_model = (oclLib@xmi);
val ocl = OclParser.parse_contextlist "../examples/company/company.manuel.ocl";
val pp = Preprocessor.preprocess_context_list ocl xmi;
val c = Literal ("a",Classifier (["Company","Company"]));
val p = Literal ("b",Classifier (["Company","Person"]));
val j = Literal ("c",Classifier (["Company","Job"]));
val b = Literal ("d",Classifier (["Company","Bank"]));
val s = Literal ("s",String);
val i = Literal ("i",Integer);
val r = Literal ("r",Real);
val set = Literal ("set",Set(Integer));
val collection = Literal("collection",Collection(String));
val bag = Literal ("bag",Bag(Real));
val model = (oclLib@xmi);
val cc = get_classifier c model;
val cp = get_classifier p model;
val cj = get_classifier j model;
val cb = get_classifier b model;

40
src/su4sml.110.62.cm
View File

@ -1,40 +1,2 @@
Group is
#if(defined(SMLNJ_VERSION))
$smlnj/basis/basis.cm
$smlnj/compiler/current.cm
$smlnj/smlnj-lib/smlnj-lib.cm
#else
#endif
../lib/fxp/src/fxlib.110.62.cm
compiler/compiler_ext.sig
compiler/smlnj.sml
library.sml
listeq.sml
rep_ocl.sml
rep_state_machines.sml
rep_activity_graphs.sml
rep_core.sml
mds.sig
secure_uml.sml
component_uml.sml
rep_secure.sml
ocl_library.sml
rep.sml
rep_parser.sml
rep_su2holocl.sml
xmi_ocl.sml
xmi_core.sml
xmi_datatypes.sml
xmi_extension_mechanisms.sml
xmi_state_machines.sml
xmi_activity_graphs.sml
xmi.sml
xmi_parser.sml
xmltree.sml
xmltree_hooks.sml
xmltree_helper.sml
xmltree_parser.sml
xmltree_writer.sml
xmi_idtable.sml
ocl2string.sml
ocl2dresdenjava.sml
ocl_parser/parser.110.62.cm

40
src/su4sml.cm
View File

@ -1,40 +1,2 @@
Group is
#if(defined(SMLNJ_VERSION))
$/basis.cm
$smlnj/compiler/current.cm
$/smlnj-lib.cm
#else
#endif
../lib/fxp/src/fxlib.cm
compiler/compiler_ext.sig
compiler/smlnj.sml
library.sml
listeq.sml
rep_ocl.sml
rep_state_machines.sml
rep_activity_graphs.sml
rep_core.sml
mds.sig
secure_uml.sml
component_uml.sml
rep_secure.sml
ocl_library.sml
rep.sml
rep_parser.sml
rep_su2holocl.sml
xmi_ocl.sml
xmi_core.sml
xmi_datatypes.sml
xmi_extension_mechanisms.sml
xmi_state_machines.sml
xmi_activity_graphs.sml
xmi.sml
xmi_parser.sml
xmltree.sml
xmltree_hooks.sml
xmltree_helper.sml
xmltree_parser.sml
xmltree_writer.sml
xmi_idtable.sml
ocl2string.sml
ocl2dresdenjava.sml
ocl_parser/parser.cm

40
src/su4sml_core.110.62.cm Normal file
View File

@ -0,0 +1,40 @@
Group is
#if(defined(SMLNJ_VERSION))
$smlnj/basis/basis.cm
$smlnj/compiler/current.cm
$smlnj/smlnj-lib/smlnj-lib.cm
#else
#endif
../lib/fxp/src/fxlib.110.62.cm
compiler/compiler_ext.sig
compiler/smlnj.sml
library.sml
listeq.sml
rep_ocl.sml
rep_state_machines.sml
rep_activity_graphs.sml
rep_core.sml
mds.sig
secure_uml.sml
component_uml.sml
rep_secure.sml
ocl_library.sml
rep.sml
rep_parser.sml
rep_su2holocl.sml
xmi_ocl.sml
xmi_core.sml
xmi_datatypes.sml
xmi_extension_mechanisms.sml
xmi_state_machines.sml
xmi_activity_graphs.sml
xmi.sml
xmi_parser.sml
xmltree.sml
xmltree_hooks.sml
xmltree_helper.sml
xmltree_parser.sml
xmltree_writer.sml
xmi_idtable.sml
ocl2string.sml
ocl2dresdenjava.sml

40
src/su4sml_core.cm Normal file
View File

@ -0,0 +1,40 @@
Group is
#if(defined(SMLNJ_VERSION))
$/basis.cm
$smlnj/compiler/current.cm
$/smlnj-lib.cm
#else
#endif
../lib/fxp/src/fxlib.cm
compiler/compiler_ext.sig
compiler/smlnj.sml
library.sml
listeq.sml
rep_ocl.sml
rep_state_machines.sml
rep_activity_graphs.sml
rep_core.sml
mds.sig
secure_uml.sml
component_uml.sml
rep_secure.sml
ocl_library.sml
rep.sml
rep_parser.sml
rep_su2holocl.sml
xmi_ocl.sml
xmi_core.sml
xmi_datatypes.sml
xmi_extension_mechanisms.sml
xmi_state_machines.sml
xmi_activity_graphs.sml
xmi.sml
xmi_parser.sml
xmltree.sml
xmltree_hooks.sml
xmltree_helper.sml
xmltree_parser.sml
xmltree_writer.sml
xmi_idtable.sml
ocl2string.sml
ocl2dresdenjava.sml