parserImport XOCL; /****************************************************************************** * * * Object Patterns * * --------------------------- * * * * An object pattern consists of a class path and a sequence of patterns. The* * general form is C(p1,..,pn). A value matches an object pattern when it * * is an instance of C and when its slots match the patterns p1 to pn. In * * order for the slots to match, the class C must define a constructor of * * arity n. this constructor defines a sequence of attribute names which in * * turn define the mapping from the slots of the value to the patterns. * * * * ******************************************************************************/ import OCL; context OCL @Class Objectp extends Pattern @Attribute class : String end @Attribute names : Seq(String) end @Attribute slots : Seq(Pattern) end @Constructor(class,names,slots) end @Operation bind(value:Element,target:Element,env:Env::Env,imports:Seq(NameSpace)):Env::Env format(stdout,"Warning: Objectp::bind not implemented.~%"); env end @Operation lift():Performable let nameExps = SetExp("Seq",names->collect(name | StrExp(name))); slotExps = SetExp("Seq",slots->collect(slot | slot.lift())) in Apply(self.typeExp(),Seq{StrExp(class),nameExps,slotExps}) end end @Operation matchCode(value:Performable,success:Performable,fail:Performable):Performable // Produces code that matches a value... let matchClass = self.newVar(); matchCnstr = self.newVar(); classCode = names->iterate(n code = Var(class) | [| :: |]) in [| let = in // Check that the class exists... if = null or not .isKindOf(XCore::Class) then else // Check that the value is of the required type... if .isKindOf() then isEmpty then success else // Find a constructor with the appropriate arity... [| let = .getConstructor(size)>) in // If no constructor exists then fail... if = null then else // Else use the constructor to determine which slots // should match against which patterns... end end |] end> else end end end |] end end @Operation needsBacktrack():Boolean slots->exists(pattern | pattern.needsBacktrack()) end @Operation matchSlots(slots:Seq(Pattern),matchCnstr:Performable,value:Performable,index:Integer,success:Performable,fail:Performable):Performable // Produce code that matches the slot values against the patterns. // The constructor contains a sequence of names that determine which // slot values must match each pattern... if slots->isEmpty then success else let pattern = slots->head in let newVar = pattern.newVar() in [| let = .ref(,) in tail,matchCnstr, value, index+1, success, fail), fail)> end |] end end end end @Operation pprint(out) let index = 0 in format(out,"~S~{~;::~S~}(",Seq{class,names}); @For slot in slots do slot.pprint(out); index := index + 1; if index <> slots->size then format(out,",") end end; format(out,")") end end @Operation toSig() NamedType(Seq{class| names}).toSig() end end