/interpreter/tags/reactive-pattern-matching/src/edu/vub/at/objects/natives/AGCase.java

http://ambienttalk.googlecode.com/ · Java · 141 lines · 81 code · 29 blank · 31 comment · 14 complexity · 9ca936569021db51712f7a39ae4bba84 MD5 · raw file

  1. /**
  2. * AmbientTalk/2 Project
  3. * AGCase.java created on Jul 6, 2008 at 12:31:50 PM
  4. * (c) Programming Technology Lab, 2006 - 2007
  5. * Authors: Tom Van Cutsem & Stijn Mostinckx
  6. *
  7. * Permission is hereby granted, free of charge, to any person
  8. * obtaining a copy of this software and associated documentation
  9. * files (the "Software"), to deal in the Software without
  10. * restriction, including without limitation the rights to use,
  11. * copy, modify, merge, publish, distribute, sublicense, and/or
  12. * sell copies of the Software, and to permit persons to whom the
  13. * Software is furnished to do so, subject to the following
  14. * conditions:
  15. *
  16. * The above copyright notice and this permission notice shall be
  17. * included in all copies or substantial portions of the Software.
  18. *
  19. * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  20. * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  21. * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  22. * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  23. * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  24. * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  25. * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  26. * OTHER DEALINGS IN THE SOFTWARE.
  27. */
  28. package edu.vub.at.objects.natives;
  29. import edu.vub.at.exceptions.InterpreterException;
  30. import edu.vub.at.exceptions.XArityMismatch;
  31. import edu.vub.at.exceptions.XIllegalArgument;
  32. import edu.vub.at.objects.ATAbstractGrammar;
  33. import edu.vub.at.objects.ATBoolean;
  34. import edu.vub.at.objects.ATContext;
  35. import edu.vub.at.objects.ATObject;
  36. import edu.vub.at.objects.ATTable;
  37. import edu.vub.at.objects.ATTypeTag;
  38. import edu.vub.at.objects.grammar.ATApplication;
  39. import edu.vub.at.objects.grammar.ATAssignVariable;
  40. import edu.vub.at.objects.grammar.ATClosureLiteral;
  41. import edu.vub.at.objects.grammar.ATSymbol;
  42. import edu.vub.at.objects.natives.grammar.NATAbstractGrammar;
  43. /**
  44. * @author smostinc
  45. *
  46. */
  47. public class AGCase extends NATAbstractGrammar {
  48. private ATSymbol bindingForm_ = null;
  49. private ATSymbol typeName_ = null;
  50. private ATTable arguments_ = NATTable.EMPTY;
  51. private ATAbstractGrammar pattern_;
  52. private ATClosureLiteral consequence_;
  53. public AGCase(ATAbstractGrammar pattern, ATClosureLiteral consequence) throws InterpreterException {
  54. if (pattern instanceof ATAssignVariable) {
  55. ATAssignVariable assignment = (ATAssignVariable) pattern;
  56. bindingForm_ = assignment.base_name();
  57. pattern = assignment.base_valueExpression();
  58. }
  59. if(pattern instanceof ATSymbol) {
  60. typeName_ = pattern.asSymbol();
  61. } else if(pattern instanceof ATApplication) {
  62. ATApplication application = (ATApplication) pattern;
  63. typeName_ = application.base_function().asSymbol();
  64. arguments_ = application.base_arguments();
  65. }
  66. pattern_ = pattern;
  67. consequence_ = consequence;
  68. }
  69. public NATText meta_print() throws InterpreterException {
  70. return NATText.atValue(
  71. "case " + (bindingForm_==null?"":(bindingForm_.toString() + " := ")) +
  72. pattern_.meta_print().javaValue + " => " + consequence_.meta_print().javaValue);
  73. }
  74. public ATBoolean base_isApplicable(ATContext theContext, ATObject theObjectToBeMatched) throws InterpreterException {
  75. ATTypeTag theTypeTag = theContext.base_lexicalScope().impl_callField(typeName_).asTypeTag();
  76. return theObjectToBeMatched.meta_isTaggedAs(theTypeTag);
  77. }
  78. public ATObject base_attemptToExecute(ATObject theObjectToBeMatched, ATContext theContext) throws InterpreterException {
  79. ATTypeTag theTypeTag = theContext.base_lexicalScope().impl_callField(typeName_).asTypeTag();
  80. ATTable theArguments = NATTable.EMPTY;
  81. NATCallframe bindings = new NATCallframe(theContext.base_lexicalScope());
  82. if(bindingForm_ != null)
  83. bindings.meta_defineField(bindingForm_, theObjectToBeMatched);
  84. if(theTypeTag instanceof NATPatternType) {
  85. NATPatternType thePattern = (NATPatternType) theTypeTag;
  86. theArguments = thePattern.base_unapply(theObjectToBeMatched).asTable();
  87. }
  88. ATObject[] parameters = arguments_.asNativeTable().elements_;
  89. ATObject[] arguments = theArguments.asNativeTable().elements_;
  90. if(parameters.length != arguments.length)
  91. throw new XArityMismatch(theTypeTag.base_typeName().toString(), parameters.length, arguments.length);
  92. for (int i = 0; i < parameters.length; i++) {
  93. ATObject parameter = parameters[i];
  94. ATObject argument = arguments[i];
  95. if(parameter instanceof ATSymbol) {
  96. ATSymbol theVariableName = parameter.asSymbol();
  97. if(! bindings.hasLocalField(theVariableName)) {
  98. bindings.meta_defineField((ATSymbol)parameter, argument);
  99. continue;
  100. } else {
  101. parameter = bindings.getLocalField(theVariableName);
  102. }
  103. }
  104. if(/* parameter != argument */
  105. !parameter.base__opeql__opeql_(argument).asNativeBoolean().javaValue) {
  106. throw new XIllegalArgument("No valid match since " + parameter + " != " + argument);
  107. }
  108. }
  109. NATContext theExtendedContext = new NATContext(bindings, theContext.base_receiver());
  110. return consequence_.meta_eval(theExtendedContext).asClosure().base_apply(NATTable.EMPTY);
  111. }
  112. }