From ca3b425fc6d8ea6a16238264f0e5b6140435879b Mon Sep 17 00:00:00 2001 From: Adolfo SBH Date: Mon, 29 Aug 2016 13:58:23 +0100 Subject: [cs2as] - MiniOCL full. --- .../model/MiniOCL.ecore | 232 +++++++---- .../model/MiniOCLFull.cs2as | 263 ++++++++++++ .../model/MiniOCLFull.ocl | 238 +++++++++++ .../model/MiniOCLFullDisambiguation.ocl | 28 ++ .../model/MiniOCLFullHelpers.ocl | 29 ++ .../model/MiniOCLFullLookup.ocl | 450 +++++++++++++++++++++ 6 files changed, 1158 insertions(+), 82 deletions(-) create mode 100644 doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.cs2as create mode 100644 doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.ocl create mode 100644 doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullDisambiguation.ocl create mode 100644 doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullHelpers.ocl create mode 100644 doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullLookup.ocl diff --git a/doc/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore b/doc/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore index 3cfa7a949..ce2242b40 100644 --- a/doc/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore +++ b/doc/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore @@ -1,82 +1,150 @@ - - - -
-
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + +
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.cs2as b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.cs2as new file mode 100644 index 000000000..209ddd715 --- /dev/null +++ b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.cs2as @@ -0,0 +1,263 @@ +source cs : 'generated/MiniOCLCS.ecore#/' +target as : '/resource/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore#/' + +helpers { + as::Class { + commonSupertype(another : Class) : Class := + let allSupertypes = self->asOrderedSet()->closure(superClasses), + allOtherSupertypes = another->asOrderedSet()->closure(superClasses) + in allSupertypes->intersection(allOtherSupertypes)->any() ; + conformsTo(another : Class) : Boolean := + self = another or + superClasses->exists(conformsTo(another)); + } + + as::NameExpCS { + parentAsCallExpCS() : CallExpCS := + let container = self.oclContainer() + in if container.oclIsKindOf(CallExpCS) + then container.oclAsType(CallExpCS) + else null + endif; + isNavExpOfACallExpCS() : Boolean := + let parentCallExpCS = parentAsCallExpCS() + in parentCallExpCS <> null and parentCallExpCS.navExp = self; + } + +} + +disambiguation { + CollectionLiteralPartCS { + withoutLastExpression := last = null; + withLastExpression := last <> null; + } + + NameExpCS { -- Note: order of the disambiguation rules matters + isOpCallExpWithExplicitSource := + roundedBrackets <> null and isNavExpOfACallExpCS(); + isOpCallExpWithImplicitSource := + roundedBrackets <> null and not isNavExpOfACallExpCS(); + isPropCallExpWithExplicitSource := + roundedBrackets = null and isNavExpOfACallExpCS(); + isVariableExp := + roundedBrackets = null and not isNavExpOfACallExpCS() + and lookup(Variable, expName) <> null; + isPropCallExpWithImplicitSource := + roundedBrackets = null and not isNavExpOfACallExpCS() + and lookup(Property, expName) <> null; + } + + LetExpCS { + singleVarDecl := letVars->size() = 1; + multipleVarDecls := letVars->size() > 1; + } +} + +mappings { + create Root from RootCS { + ownedImports := imports.trace; + ownedPackages := packages.trace; + ownedConstraints := constraints.invariants.trace; + } + create Constraint from InvariantCS { + ownedSpecification := as::ExpressionInOCL { + ownedBody = exp.trace, + ownedSelfVar = as::Variable { name = 'self', + type = trace.constrainedElement } + }; + constrainedElement := lookup(Class, self.ConstraintsDefCS.typeRef); + } + create Package from PackageCS { + name := name; + ownedPackages := packages.trace; + ownedClasses := classifiers.trace; + } + create Operation from OperationCS { + name := name; + type := lookup(Class, resultType); + ownedParameters := parameters.trace; + ownedBodyExpression := as::ExpressionInOCL { + ownedBody = body.trace, + ownedSelfVar = as::Variable {name = 'self' , type = trace.owningClass } + }; + } + -- Expressions + refer CallExp from CallExpCS := + self.navExp.trace; + + create OperationCallExp from EqualityExpCS { + ownedSource := left.trace; + ownedArguments := right.trace; + referredOperation := lookupExported(Operation, trace.ownedSource.type, + opName, trace.ownedArguments); + } +-- TODO +-- create VariableExp from NameExpCS +-- when fall_back { +-- referredVariable := null; +-- type := lookup(Class, 'OclVoid'); +-- } + create VariableExp from NameExpCS + when isVariableExp { + referredVariable := lookup(Variable, expName); + type := trace.referredVariable.type; + } + create PropertyCallExp from NameExpCS + when isPropCallExpWithExplicitSource { + ownedSource := parentAsCallExpCS()._source.trace; + referredProperty := lookupExported(Property,trace.ownedSource.type,expName); + type := trace.referredProperty?.type; + } + create PropertyCallExp from NameExpCS + when isPropCallExpWithImplicitSource { + ownedSource := let referredVar = lookup(Variable, 'self') + in as::VariableExp { + referredVariable = referredVar, + type = referredVar.type + }; + referredProperty := lookupExported(Property,trace.ownedSource.type,expName); + type := trace.referredProperty?.type; + } + create OperationCallExp from NameExpCS + when isOpCallExpWithExplicitSource { + ownedSource := parentAsCallExpCS()._source.trace; + ownedArguments := roundedBrackets.args.trace; + referredOperation := lookupExported(Operation,trace.ownedSource.type, + expName, trace.ownedArguments); + type := trace.referredOperation?.type; + } + create OperationCallExp from NameExpCS + when isOpCallExpWithImplicitSource { + ownedSource := let referredVar = lookup(Variable, 'self') + in as::VariableExp { + referredVariable = referredVar, + type = referredVar.type + }; + ownedArguments := roundedBrackets.args.trace; + referredOperation:= lookupExported(Operation,trace.ownedSource.type, + expName, trace.ownedArguments); + type := trace.referredOperation?.type; + } + + create LetExp from LetExpCS + when singleVarDecl { + ownedVariable := letVars->at(1); + ownedIn := inExp; + type := inExpression.trace.type; + } + create LetExp from LetExpCS + when multipleVarDecls { + ownedVariable := letVars->first(); + ownedIn := letVars->excluding(letVars->first())->reverse() + ->iterate(x : LetVarCS; acc : OCLExpression = inExp.trace | + as::LetExp { + ownedVar = x.trace, + ownedIn = acc, + type = acc.type + }); + type := inExpression.trace.type; + } + + + create IterateExp from IterateExpCS { + ownedIterator := itVar.trace; + ownedResult := accVar.trace; + ownedBody := exp.trace; + type := trace.ownedResult.type; + } + + create IterationExp from CollectExpCS { + name := 'collect'; + ownedIterator := if itVar = null + then Variable { name='self', type=lookup(Class,'OclAny') } + else itVar.trace + endif; + ownedBody := exp.trace; + type := lookup(Class,'Collection'); + } + + create CollectionLiteralExp from CollectionLiteralExpCS { + kind := kind; + ownedParts := parts.trace; + type := lookup(Class,'Collection'); + } + create CollectionItem from CollectionLiteralPartCS + when withoutLastExpression { + ownedItem := first.trace; + type := trace.ownedItem.type; + } + create CollectionRange from CollectionLiteralPartCS + when withLastExpression { + ownedFirst := first; + ownedLast := last; + type := trace.ownedFirst.type; + } + +} + + + +name_resolution { + targets { + NamedElement using name scaped_with '_'; + Package qualifies Package using ownedPackages, + Class using ownedClasses; + Class qualifies Operation using ownedOperations, + Property using ownedProperties; + Operation filtered_by args : OrderedSet(OCLExpression) + when args->size() = ownedParameters->size() and + arguments->forAll(x | + let argIdx = arguments->indexOf(x) + in x.type.conformsTo(ownedParameters->at(argIdx).type)); + Property; + Variable; + } + + inputs { + PathElementCS using elementName; + qualifier PathNameCS using pathElements; + } + + providers { + Root { + in current_scope provides adding + Package using ownedPackages, exported ownedImports + Constraint using ownedConstraints; + } + + Package { + in current_scope provides occluding + Package using ownedPackages + Class using ownedClasses; + } + + Class { + vars allSuperClasses = self->closure(superClass); + + in current_scope provides occluding + Operation using ownedOperations occluding allSuperClasses.ownedOperations + Property using ownedProperties occluding allSuperClasses.ownedProperties; + + in exported_scope provides + Operation using ownedOperations occluding allSuperClasses.ownedOperations + Property using ownedProperties occluding allSuperClasses.ownedOperations; + } + + + Operation { + in current_scope provides occluding + Variable using ownedParameters; + } + + ExpressionInOCL { + in current_scope provides occluding + Variable using ownedSelfVar; + } + + LetExp { + in current_scope + for all excepting ownedVariable + provides occluding Variable using ownedVariable; + } + } +} \ No newline at end of file diff --git a/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.ocl b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.ocl new file mode 100644 index 000000000..21115d30f --- /dev/null +++ b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFull.ocl @@ -0,0 +1,238 @@ +import cs : 'generated/MiniOCLCS.ecore#/' +import as : '/resource/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore#/' +import 'MiniOCLFullHelpers.ocl' +import 'MiniOCLFullLookup.ocl' +import 'MiniOCLFullDisambiguation.ocl' +package cs + +context ExpCS +def : ast() : as::OCLExpression = + null + +context NavigationExpCS +def : ast() : as::CallExp = + null + +context RootCS +def : ast() : as::Root = +as::Root { + ownedImports = imports.ast(), +ownedPackages = packages.ast(), +ownedConstraints = constraints.invariants.ast() +} +context ImportCS +def : ast() : as::Import = + as::Import { + alias = if alias = null then null else alias endif, + uri = uri +} + +context InvariantCS +def : ast() : as::Constraint = +as::Constraint { + ownedSpecification = as::ExpressionInOCL { + ownedBody = exp.ast(), + ownedSelfVar = as::Variable { + name = ' self' , + type = ast().constrainedElement + } + }, +constrainedElement = ast().lookupClass(self.ConstraintsDefCS.typeRef) +} +context PackageCS +def : ast() : as::Package = +as::Package { + name = name, +ownedPackages = packages.ast(), +ownedClasses = classes.ast() +} +context ClassCS +def : ast() : as::Class = +as::Class { + name = name, +ownedProperties = properties.ast(), +ownedOperations = operations.ast(), +superClasses = if _extends->notEmpty() then _extends->collect(x | ast().lookupClass(x)) else OrderedSet { } endif +} +context OperationCS +def : ast() : as::Operation = +as::Operation { + name = name, +type = ast().lookupClass(resultRef), +ownedParameters = params.ast(), +ownedBodyExpression = as::ExpressionInOCL { + ownedBody = _body.ast(), + ownedSelfVar = as::Variable { + name = ' self' , + type = ast().owningClass + } + } +} +context PropertyCS +def : ast() : as::Property = +as::Property { + name = name, +lowerBound = computeLowerBound(), +upperBound = computeUpperBound(), +type = ast().lookupClass(typeRef) +} +context ParameterCS +def : ast() : as::Variable = +as::Variable { + name = name, +type = ast().lookupClass(typeRef) +} + +context CallExpCS +def : ast() : as::CallExp = +self.navExp.ast() +context EqualityExpCS +def : ast() : as::OperationCallExp = +as::OperationCallExp { + ownedSource = left.ast(), +ownedArguments = right.ast(), +referredOperation = ast().lookupOperationFrom(ast().ownedSource.type, opName, ast().ownedArguments) +} +context NameExpCS +def : ast() : as::OperationCallExp = +if isOpCallExpWithExplicitSource() +then as::OperationCallExp { + ownedSource = parentAsCallExpCS()._source.ast(), +ownedArguments = roundedBrackets.args.ast(), +referredOperation = ast().lookupOperationFrom(ast().ownedSource.type, expName, ast().ownedArguments), +type = ast().referredOperation ?. type +} +else + if isOpCallExpWithImplicitSource() + then as::OperationCallExp { + ownedSource = let referredVar = ast().lookupVariable(' self' ) + in as::VariableExp { + referredVariable = referredVar, + type = referredVar.type + } + , + ownedArguments = roundedBrackets.args.ast(), + referredOperation = ast().lookupOperationFrom(ast().ownedSource.type, expName, ast().ownedArguments), + type = ast().referredOperation ?. type + } + else + if isPropCallExpWithExplicitSource() + then as::PropertyCallExp { + ownedSource = parentAsCallExpCS()._source.ast(), + referredProperty = ast().lookupPropertyFrom(ast().ownedSource.type, expName), + type = ast().referredProperty ?. type + } + else + if isVariableExp() + then as::VariableExp { + referredVariable = ast().lookupVariable(expName), + type = ast().referredVariable.type + } + else + if isPropCallExpWithImplicitSource() + then as::PropertyCallExp { + ownedSource = let referredVar = ast().lookupVariable(' self' ) + in as::VariableExp { + referredVariable = referredVar, + type = referredVar.type + } + , + referredProperty = ast().lookupPropertyFrom(ast().ownedSource.type, expName), + type = ast().referredProperty ?. type + } + else + invalid + endif + endif + endif + endif +endif +context LetExpCS +def : ast() : as::LetExp = +if singleVarDecl() +then as::LetExp { + ownedVariable = letVars->at(1).ast(), +ownedIn = inExp.ast(), +type = inExp.ast().type +} +else + if multipleVarDecls() + then as::LetExp { + ownedVariable = letVars->first().ast(), + ownedIn = letVars->excluding(letVars->first())->reverse()->iterate(x : LetVarCS ; acc : as::OCLExpression = inExp.ast() | + as::LetExp { + ownedVariable = x.ast(), + ownedIn = acc, + type = acc.type + }), + type = inExp.ast().type + } + else + invalid + endif +endif +context LetVarCS +def : ast() : as::Variable = +as::Variable { + name = name, + ownedInitExp = initExp.ast(), + type = if typeRef <> null then ast().lookupClass(typeRef) else ast().ownedInitExp.type endif +} +context IterateExpCS +def : ast() : as::IterateExp = +as::IterateExp { + ownedIterator = itVar.ast(), +ownedResult = accVar.ast(), +ownedBody = exp.ast(), +type = ast().ownedResult.type +} +context CollectExpCS +def : ast() : as::IteratorExp = +as::IteratorExp { + iterator = ' collect' , +ownedIterator = if itVar = null then as::Variable { + name = ' self' , + type = ast().lookupClass(' OclAny' ) + } else itVar.ast() endif, +ownedBody = exp.ast(), +type = ast().lookupClass(' Collection' ) +} +context IteratorVarCS +def : ast() : as::Variable = +as::Variable { + name = itName, + type = if itType <> null then ast().lookupClass(itType) else ast().lookupClass(' OclAny' ) endif +} +context AccVarCS +def : ast() : as::Variable = +as::Variable { + name = accName, +ownedInitExp = accInitExp.ast(), +type = if accType <> null then ast().lookupClass(accType) else ast().ownedInitExp.type endif +} +context CollectionLiteralExpCS +def : ast() : as::CollectionLiteralExp = +as::CollectionLiteralExp { + kind = kind, +ownedParts = parts.ast(), +type = ast().lookupClass(' Collection' ) +} +context CollectionLiteralPartCS +def : ast() : as::CollectionItem = +if withoutLastExpression() +then as::CollectionItem { + ownedItem = first.ast(), +type = ast().ownedItem.type +} +else + if withLastExpression() + then as::CollectionRange { + ownedFirst = first, + ownedLast = last, + type = ast().ownedFirst.type + } + else + invalid + endif +endif +endpackage diff --git a/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullDisambiguation.ocl b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullDisambiguation.ocl new file mode 100644 index 000000000..c79a503ac --- /dev/null +++ b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullDisambiguation.ocl @@ -0,0 +1,28 @@ +import cs : 'generated/MiniOCLCS.ecore#/' +import as : '/resource/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore#/' +import 'MiniOCLFullHelpers.ocl' +import 'MiniOCLFullLookup.ocl' +package cs + +context CollectionLiteralPartCS +def : withoutLastExpression() : Boolean = + last = null +def : withLastExpression() : Boolean = + last <> null +context NameExpCS +def : isOpCallExpWithExplicitSource() : Boolean = + roundedBrackets <> null and isNavExpOfACallExpCS() +def : isOpCallExpWithImplicitSource() : Boolean = + roundedBrackets <> null and not isNavExpOfACallExpCS() +def : isPropCallExpWithExplicitSource() : Boolean = + roundedBrackets = null and isNavExpOfACallExpCS() +def : isVariableExp() : Boolean = + roundedBrackets = null and not isNavExpOfACallExpCS() and ast.lookupVariable(expName.pathElements->first()) <> null +def : isPropCallExpWithImplicitSource() : Boolean = + roundedBrackets = null and not isNavExpOfACallExpCS() and ast.lookupProperty(expName) <> null +context LetExpCS +def : singleVarDecl() : Boolean = + letVars->size() = 1 +def : multipleVarDecls() : Boolean = + letVars->size() > 1 +endpackage diff --git a/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullHelpers.ocl b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullHelpers.ocl new file mode 100644 index 000000000..932ebb9ce --- /dev/null +++ b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullHelpers.ocl @@ -0,0 +1,29 @@ +import cs : 'generated/MiniOCLCS.ecore#/' +import as : '/resource/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore#/' +package cs + +context cs::NameExpCS +def : parentAsCallExpCS() :CallExpCS = + let container = self.oclContainer() + in if container.oclIsKindOf(CallExpCS) then container.oclAsType(CallExpCS) else null endif +def : isNavExpOfACallExpCS() :Boolean = + let parentCallExpCS = parentAsCallExpCS() + in parentCallExpCS <> null and parentCallExpCS.navExp = self +context cs::PropertyCS +def : computeLowerBound() :Integer = + if multiplicity = null then 0 else if multiplicity.opt then 0 else if multiplicity.mult then 0 else if multiplicity.mandatory <> 0 then multiplicity.mandatory else multiplicity.lowerInt endif endif endif endif +def : computeUpperBound() :Integer = + if multiplicity = null then 1 else if multiplicity.opt then 1 else if multiplicity.mult then - 1 else if multiplicity.mandatory <> 0 then multiplicity.mandatory else if multiplicity.upperMult then - 1 else multiplicity.upperInt endif endif endif endif endif + +endpackage +package as + +context as::Class +def : commonSupertype(another : Class) :Class = + let allSupertypes = self->asOrderedSet()->closure(superClasses) + , allOtherSupertypes = another->asOrderedSet()->closure(superClasses) + in allSupertypes->intersection(allOtherSupertypes)->any(true) +def : conformsTo(another : Class) :Boolean = + self = another or superClasses->exists(conformsTo(another)) + +endpackage diff --git a/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullLookup.ocl b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullLookup.ocl new file mode 100644 index 000000000..7d207f3de --- /dev/null +++ b/doc/org.eclipse.qvtd.doc.minioclcs.xtext/model/MiniOCLFullLookup.ocl @@ -0,0 +1,450 @@ +import cs : 'generated/MiniOCLCS.ecore#/' +import as : '/resource/org.eclipse.qvtd.doc.miniocl/model/MiniOCL.ecore#/' +import '/resource/org.eclipse.qvtd.doc.miniocl/model/Lookup.ecore' +import 'MiniOCLFullHelpers.ocl' + +package ocl + +-- Domain specific default functionality +context OclElement +def : unqualified_env_Class() : lookup::LookupEnvironment[1] = + _unqualified_env_Class(null) +def : unqualified_env_Package() : lookup::LookupEnvironment[1] = + _unqualified_env_Package(null) +def : unqualified_env_Operation() : lookup::LookupEnvironment[1] = + _unqualified_env_Operation(null) +def : unqualified_env_Variable() : lookup::LookupEnvironment[1] = + _unqualified_env_Variable(null) +def : unqualified_env_NamedElement() : lookup::LookupEnvironment[1] = + _unqualified_env_NamedElement(null) +def : unqualified_env_Property() : lookup::LookupEnvironment[1] = + _unqualified_env_Property(null) + +def : _unqualified_env_Class(child : OclElement) : lookup::LookupEnvironment[1] = + parentEnv_Class() +def : _unqualified_env_Package(child : OclElement) : lookup::LookupEnvironment[1] = + parentEnv_Package() +def : _unqualified_env_Operation(child : OclElement) : lookup::LookupEnvironment[1] = + parentEnv_Operation() +def : _unqualified_env_Variable(child : OclElement) : lookup::LookupEnvironment[1] = + parentEnv_Variable() +def : _unqualified_env_NamedElement(child : OclElement) : lookup::LookupEnvironment[1] = + parentEnv_NamedElement() +def : _unqualified_env_Property(child : OclElement) : lookup::LookupEnvironment[1] = + parentEnv_Property() + +def : parentEnv_Class() : lookup::LookupEnvironment[1] = + let parent = oclContainer() in if parent = null then lookup::LookupEnvironment { } else parent._unqualified_env_Class(self) endif +def : parentEnv_Package() : lookup::LookupEnvironment[1] = + let parent = oclContainer() in if parent = null then lookup::LookupEnvironment { } else parent._unqualified_env_Package(self) endif +def : parentEnv_Operation() : lookup::LookupEnvironment[1] = + let parent = oclContainer() in if parent = null then lookup::LookupEnvironment { } else parent._unqualified_env_Operation(self) endif +def : parentEnv_Variable() : lookup::LookupEnvironment[1] = + let parent = oclContainer() in if parent = null then lookup::LookupEnvironment { } else parent._unqualified_env_Variable(self) endif +def : parentEnv_NamedElement() : lookup::LookupEnvironment[1] = + let parent = oclContainer() in if parent = null then lookup::LookupEnvironment { } else parent._unqualified_env_NamedElement(self) endif +def : parentEnv_Property() : lookup::LookupEnvironment[1] = + let parent = oclContainer() in if parent = null then lookup::LookupEnvironment { } else parent._unqualified_env_Property(self) endif + +def : _exported_env_Property(importer : OclElement) : lookup::LookupEnvironment[1] = + lookup::LookupEnvironment { } +def : _exported_env_Operation(importer : OclElement) : lookup::LookupEnvironment[1] = + lookup::LookupEnvironment { } + +def : _qualified_env_Class(qualifier : OclElement) : lookup::LookupEnvironment[1] = + lookup::LookupEnvironment { } +def : _qualified_env_Package(qualifier : OclElement) : lookup::LookupEnvironment[1] = + lookup::LookupEnvironment { } +def : _qualified_env_Operation(qualifier : OclElement) : lookup::LookupEnvironment[1] = + lookup::LookupEnvironment { } +def : _qualified_env_Property(qualifier : OclElement) : lookup::LookupEnvironment[1] = + lookup::LookupEnvironment { } +-- End of domain specific default functionality +endpackage + +package lookup +-- Some common lookup functionality +context LookupEnvironment +def : nestedEnv() : LookupEnvironment[1] = + LookupEnvironment { + parentEnv = self + } +-- End of common lookup functionality +endpackage + +package as + +context Visitable +-- NamedElement unqualified lookup +def : _lookupNamedElement(env : lookup::LookupEnvironment, nName : String) : OrderedSet(NamedElement) = +let foundNamedElement = env.namedElements->selectByKind(NamedElement)->select(name = nName) +in if foundNamedElement->isEmpty() and not (env.parentEnv = null) + then _lookupNamedElement(env.parentEnv, nName) + else foundNamedElement + endif + +-- Note: when calling this method, the source element of the argument passed to this method, will be the contextual +-- object on which error reports will be handled +def : _lookupUnqualifiedNamedElement(nName : String) : NamedElement[?] = +let foundNamedElement = _lookupNamedElement(unqualified_env_NamedElement(), nName) +in if foundNamedElement->isEmpty() + then null + else foundNamedElement->first() -- LookupVisitor will report ambiguous result + endif + +def : lookupNamedElement(nName : String) : NamedElement[?] = + _lookupUnqualifiedNamedElement(nName) +def : lookupNamedElement(aPathElementCS : cs::PathElementCS) : NamedElement[?] = + _lookupUnqualifiedNamedElement(aPathElementCS.elementName) +-- End of NamedElement unqualified lookup + + +context Package + +def : _lookupQualifiedPackage(pName : String) : Package[?] = + let foundPackage = _lookupPackage(_qualified_env_Package(), pName) + in if foundPackage->isEmpty() + then null + else foundPackage->first() + endif +def : _qualified_env_Package() : lookup::LookupEnvironment = + let env = lookup::LookupEnvironment{} + in env + .addElements(ownedPackages) +def : lookupQualifiedPackage(aPathElementCS : cs::PathElementCS) : Package[?] = + _lookupQualifiedPackage(aPathElementCS.elementName) + +def : _lookupQualifiedClass(cName : String) : Class[?] = + let foundClass = _lookupClass(_qualified_env_Class(), cName) + in if foundClass->isEmpty() + then null + else foundClass->first() + endif +def : _qualified_env_Class() : lookup::LookupEnvironment = + let env = lookup::LookupEnvironment{} + in env + .addElements(ownedClasses) +def : lookupQualifiedClass(aPathElementCS : cs::PathElementCS) : Class[?] = + _lookupQualifiedClass(aPathElementCS.elementName) +context Visitable +-- Package unqualified lookup +def : _lookupPackage(env : lookup::LookupEnvironment, pName : String) : OrderedSet(Package) = +let foundPackage = env.namedElements->selectByKind(Package)->select(name = pName) +in if foundPackage->isEmpty() and not (env.parentEnv = null) + then _lookupPackage(env.parentEnv, pName) + else foundPackage + endif + +-- Note: when calling this method, the source element of the argument passed to this method, will be the contextual +-- object on which error reports will be handled +def : _lookupUnqualifiedPackage(pName : String) : Package[?] = +let foundPackage = _lookupPackage(unqualified_env_Package(), pName) +in if foundPackage->isEmpty() + then null + else foundPackage->first() -- LookupVisitor will report ambiguous result + endif + +def : lookupPackage(pName : String) : Package[?] = + _lookupUnqualifiedPackage(pName) +def : lookupPackage(aPathElementCS : cs::PathElementCS) : Package[?] = + _lookupUnqualifiedPackage(aPathElementCS.elementName) +-- End of Package unqualified lookup + +-- Package qualified-name lookup +def : lookupPackage(aPathNameCS : cs::PathNameCS) : Package[?] = + lookupPackage(aPathNameCS .pathElements) + +def : lookupPackage(segments : OrderedSet(cs::PathElementCS)) : Package[?] = + if segments->size() = 1 + then lookupPackage(segments->first()) + else let qualifierSegments = segments->subOrderedSet(1,segments->size()-1), + qualifier = lookupPackage(qualifierSegments) + in qualifier?.lookupQualifiedPackage(segments->last()) + endif + +context Class + +def : _lookupQualifiedOperation(oName : String, args : OrderedSet(OCLExpression)) : Operation[?] = + let foundOperation = _lookupOperation(_qualified_env_Operation(), oName, args) + in if foundOperation->isEmpty() + then null + else foundOperation->first() + endif +def : _qualified_env_Operation() : lookup::LookupEnvironment = + let env = lookup::LookupEnvironment{} + in env + .addElements(ownedOperations) +def : lookupQualifiedOperation(aPathElementCS : cs::PathElementCS, args : OrderedSet(OCLExpression)) : Operation[?] = + _lookupQualifiedOperation(aPathElementCS.elementName, args) + +def : _lookupQualifiedProperty(pName : String) : Property[?] = + let foundProperty = _lookupProperty(_qualified_env_Property(), pName) + in if foundProperty->isEmpty() + then null + else foundProperty->first() + endif +def : _qualified_env_Property() : lookup::LookupEnvironment = + let env = lookup::LookupEnvironment{} + in env + .addElements(ownedProperties) +def : lookupQualifiedProperty(aPathElementCS : cs::PathElementCS) : Property[?] = + _lookupQualifiedProperty(aPathElementCS.elementName) +context Visitable +-- Class unqualified lookup +def : _lookupClass(env : lookup::LookupEnvironment, cName : String) : OrderedSet(Class) = +let foundClass = env.namedElements->selectByKind(Class)->select(name = cName) +in if foundClass->isEmpty() and not (env.parentEnv = null) + then _lookupClass(env.parentEnv, cName) + else foundClass + endif + +-- Note: when calling this method, the source element of the argument passed to this method, will be the contextual +-- object on which error reports will be handled +def : _lookupUnqualifiedClass(cName : String) : Class[?] = +let foundClass = _lookupClass(unqualified_env_Class(), cName) +in if foundClass->isEmpty() + then null + else foundClass->first() -- LookupVisitor will report ambiguous result + endif + +def : lookupClass(cName : String) : Class[?] = + _lookupUnqualifiedClass(cName) +def : lookupClass(aPathElementCS : cs::PathElementCS) : Class[?] = + _lookupUnqualifiedClass(aPathElementCS.elementName) +-- End of Class unqualified lookup + +-- Class qualified-name lookup +def : lookupClass(aPathNameCS : cs::PathNameCS) : Class[?] = + lookupClass(aPathNameCS .pathElements) + +def : lookupClass(segments : OrderedSet(cs::PathElementCS)) : Class[?] = + if segments->size() = 1 + then lookupClass(segments->first()) + else let qualifierSegments = segments->subOrderedSet(1,segments->size()-1), + qualifier = lookupPackage(qualifierSegments) + in qualifier?.lookupQualifiedClass(segments->last()) + endif + +context Operation + +def : _appliesFilter_Operation(args : OrderedSet(OCLExpression)) : Boolean = + args->size() = ownedParameters->size() and args->forAll(x | let argIdx = args->indexOf(x) + in x.type.conformsTo(ownedParameters->at(argIdx).type) + ) +context Visitable +-- Operation unqualified lookup +def : _lookupOperation(env : lookup::LookupEnvironment, oName : String, args : OrderedSet(OCLExpression)) : OrderedSet(Operation) = +let foundOperation = env.namedElements->selectByKind(Operation)->select(name = oName) + ->select(_appliesFilter_Operation(args)) +in if foundOperation->isEmpty() and not (env.parentEnv = null) + then _lookupOperation(env.parentEnv, oName, args) + else foundOperation + endif + +-- Note: when calling this method, the source element of the argument passed to this method, will be the contextual +-- object on which error reports will be handled +def : _lookupUnqualifiedOperation(oName : String, args : OrderedSet(OCLExpression)) : Operation[?] = +let foundOperation = _lookupOperation(unqualified_env_Operation(), oName, args) +in if foundOperation->isEmpty() + then null + else foundOperation->first() -- LookupVisitor will report ambiguous result + endif + +def : lookupOperation(oName : String, args : OrderedSet(OCLExpression)) : Operation[?] = + _lookupUnqualifiedOperation(oName, args) +def : lookupOperation(aPathElementCS : cs::PathElementCS, args : OrderedSet(OCLExpression)) : Operation[?] = + _lookupUnqualifiedOperation(aPathElementCS.elementName, args) +-- End of Operation unqualified lookup + +-- Operation qualified-name lookup +def : lookupOperation(aPathNameCS : cs::PathNameCS, args : OrderedSet(OCLExpression)) : Operation[?] = + lookupOperation(aPathNameCS .pathElements, args) + +def : lookupOperation(segments : OrderedSet(cs::PathElementCS), args : OrderedSet(OCLExpression)) : Operation[?] = + if segments->size() = 1 + then lookupOperation(segments->first(), args) + else let qualifierSegments = segments->subOrderedSet(1,segments->size()-1), + qualifier = lookupClass(qualifierSegments) + in qualifier?.lookupQualifiedOperation(segments->last(), args) + endif +context Visitable +-- Property unqualified lookup +def : _lookupProperty(env : lookup::LookupEnvironment, pName : String) : OrderedSet(Property) = +let foundProperty = env.namedElements->selectByKind(Property)->select(name = pName) +in if foundProperty->isEmpty() and not (env.parentEnv = null) + then _lookupProperty(env.parentEnv, pName) + else foundProperty + endif + +-- Note: when calling this method, the source element of the argument passed to this method, will be the contextual +-- object on which error reports will be handled +def : _lookupUnqualifiedProperty(pName : String) : Property[?] = +let foundProperty = _lookupProperty(unqualified_env_Property(), pName) +in if foundProperty->isEmpty() + then null + else foundProperty->first() -- LookupVisitor will report ambiguous result + endif + +def : lookupProperty(pName : String) : Property[?] = + _lookupUnqualifiedProperty(pName) +def : lookupProperty(aPathElementCS : cs::PathElementCS) : Property[?] = + _lookupUnqualifiedProperty(aPathElementCS.elementName) +-- End of Property unqualified lookup + +-- Property qualified-name lookup +def : lookupProperty(aPathNameCS : cs::PathNameCS) : Property[?] = + lookupProperty(aPathNameCS .pathElements) + +def : lookupProperty(segments : OrderedSet(cs::PathElementCS)) : Property[?] = + if segments->size() = 1 + then lookupProperty(segments->first()) + else let qualifierSegments = segments->subOrderedSet(1,segments->size()-1), + qualifier = lookupClass(qualifierSegments) + in qualifier?.lookupQualifiedProperty(segments->last()) + endif +context Visitable +-- Variable unqualified lookup +def : _lookupVariable(env : lookup::LookupEnvironment, vName : String) : OrderedSet(Variable) = +let foundVariable = env.namedElements->selectByKind(Variable)->select(name = vName) +in if foundVariable->isEmpty() and not (env.parentEnv = null) + then _lookupVariable(env.parentEnv, vName) + else foundVariable + endif + +-- Note: when calling this method, the source element of the argument passed to this method, will be the contextual +-- object on which error reports will be handled +def : _lookupUnqualifiedVariable(vName : String) : Variable[?] = +let foundVariable = _lookupVariable(unqualified_env_Variable(), vName) +in if foundVariable->isEmpty() + then null + else foundVariable->first() -- LookupVisitor will report ambiguous result + endif + +def : lookupVariable(vName : String) : Variable[?] = + _lookupUnqualifiedVariable(vName) +def : lookupVariable(aPathElementCS : cs::PathElementCS) : Variable[?] = + _lookupUnqualifiedVariable(aPathElementCS.elementName) +-- End of Variable unqualified lookup + +context Root +def : _unqualified_env_Package(child : ocl::OclElement) : lookup::LookupEnvironment = + parentEnv_Package() + .addElements(ownedPackages) + --TODO .addElements(ownedImports._exported_env(self).namedElements) + +context Package +def : _unqualified_env_Package(child : ocl::OclElement) : lookup::LookupEnvironment = + parentEnv_Package().nestedEnv() + .addElements(ownedPackages) + +def : _unqualified_env_Class(child : ocl::OclElement) : lookup::LookupEnvironment = + parentEnv_Class().nestedEnv() + .addElements(ownedClasses) + +context Class +def : _unqualified_env_Operation(child : ocl::OclElement) : lookup::LookupEnvironment = + let allSuperClasses = self->closure(superClasses) + in + parentEnv_Operation().nestedEnv() + .addElements(allSuperClasses.ownedOperations) + .nestedEnv() + .addElements(ownedOperations) + +def : _unqualified_env_Property(child : ocl::OclElement) : lookup::LookupEnvironment = + let allSuperClasses = self->closure(superClasses) + in + parentEnv_Property().nestedEnv() + .addElements(allSuperClasses.ownedProperties) + .nestedEnv() + .addElements(ownedProperties) + +def : _exported_env_Operation(importer : ocl::OclElement) : lookup::LookupEnvironment = + let allSuperClasses = self->closure(superClasses) + in + let env = lookup::LookupEnvironment {} + in env + .addElements(allSuperClasses.ownedOperations) + .nestedEnv() + .addElements(ownedOperations) + +def : _exported_env_Property(importer : ocl::OclElement) : lookup::LookupEnvironment = + let allSuperClasses = self->closure(superClasses) + in + let env = lookup::LookupEnvironment {} + in env + .addElements(allSuperClasses.ownedOperations) + .nestedEnv() + .addElements(ownedProperties) + + +def : _lookupExportedOperation(importer : ocl::OclElement, oName : String, args : OrderedSet(OCLExpression)) : Operation[?] = + let foundOperation = _lookupOperation(_exported_env_Operation(importer), oName, args) + in if foundOperation->isEmpty() + then null + else foundOperation->first() + endif + +def : lookupExportedOperation(importer : ocl::OclElement, aPathElementCS : cs::PathElementCS, args : OrderedSet(OCLExpression)) : Operation[?] = + _lookupExportedOperation(importer, aPathElementCS.elementName, args) + +def : _lookupExportedProperty(importer : ocl::OclElement, pName : String) : Property[?] = + let foundProperty = _lookupProperty(_exported_env_Property(importer), pName) + in if foundProperty->isEmpty() + then null + else foundProperty->first() + endif + +def : lookupExportedProperty(importer : ocl::OclElement, aPathElementCS : cs::PathElementCS) : Property[?] = + _lookupExportedProperty(importer, aPathElementCS.elementName) +context Visitable +-- Class exports Operation + +def : lookupOperationFrom(exporter : Class, aPathElementCS : cs::PathElementCS, args : OrderedSet(OCLExpression)) : Operation[?] = + exporter.lookupExportedOperation(self, aPathElementCS, args) + +def : lookupOperationFrom(exporter : Class, aPathNameCS : cs::PathNameCS, args : OrderedSet(OCLExpression)) : Operation[?] = + lookupOperationFrom(exporter, aPathNameCS.pathElements, args) + +def : lookupOperationFrom(exporter : Class, segments : OrderedSet(cs::PathElementCS), args : OrderedSet(OCLExpression)) : Operation[?] = + if segments->size() = 1 + then lookupOperationFrom(exporter, segments->first(), args) + else let qualifierSegments = segments->subOrderedSet(1,segments->size()-1), + qualifier = lookupClass(qualifierSegments) + in qualifier?.lookupQualifiedOperation(segments->last(), args) + endif +-- Class exports Property + +def : lookupPropertyFrom(exporter : Class, aPathElementCS : cs::PathElementCS) : Property[?] = + exporter.lookupExportedProperty(self, aPathElementCS) + +def : lookupPropertyFrom(exporter : Class, aPathNameCS : cs::PathNameCS) : Property[?] = + lookupPropertyFrom(exporter, aPathNameCS.pathElements) + +def : lookupPropertyFrom(exporter : Class, segments : OrderedSet(cs::PathElementCS)) : Property[?] = + if segments->size() = 1 + then lookupPropertyFrom(exporter, segments->first()) + else let qualifierSegments = segments->subOrderedSet(1,segments->size()-1), + qualifier = lookupClass(qualifierSegments) + in qualifier?.lookupQualifiedProperty(segments->last()) + endif +context Operation +def : _unqualified_env_Variable(child : ocl::OclElement) : lookup::LookupEnvironment = + parentEnv_Variable().nestedEnv() + .addElements(ownedParameters) + +context ExpressionInOCL +def : _unqualified_env_Variable(child : ocl::OclElement) : lookup::LookupEnvironment = + parentEnv_Variable().nestedEnv() + .addElement(ownedSelfVar) + +context LetExp +def : _unqualified_env_Variable(child : ocl::OclElement) : lookup::LookupEnvironment = + if not (ownedVariable->includes(child) + ) + then parentEnv_Variable().nestedEnv() + .addElement(ownedVariable) + + else parentEnv_Variable() + endif + +endpackage -- cgit v1.2.3