Merge pull request #254 from melt-umn/feature/reflection

Direct support for terminals in reflection library, introduce Silver construction extension

grammars/core/Either.sv

@@ -1,5 +1,10 @@
 grammar core;
 
+synthesized attribute fromLeft<a> :: a;
+synthesized attribute fromRight<a> :: a;
+synthesized attribute isLeft :: Boolean;
+synthesized attribute isRight :: Boolean;
+
 {--
  - The basic sum type, counterpart to Pair.
  -
@@ -8,17 +13,24 @@ grammar core;
  - expected return value is the second.
  - e.g. Either<String Tree>
  -}
-nonterminal Either<a b>;
-
+nonterminal Either<a b> with fromLeft<a>, fromRight<b>, isLeft, isRight;
 
 abstract production left
 top::Either<a b> ::= value::a
 {
+  top.fromLeft = value;
+  top.fromRight = error("fromRight accessed on a Either that was actually left!");
+  top.isLeft = true;
+  top.isRight = false;
 }
 
 abstract production right
 top::Either<a b> ::= value::b
 {
+  top.fromLeft = error("fromRight accessed on a Either that was actually left!");
+  top.fromRight = value;
+  top.isLeft = false;
+  top.isRight = true;
 }
 
 

grammars/core/reflect/AST.sv

@@ -9,6 +9,10 @@ abstract production nonterminalAST
 top::AST ::= prodName::String children::ASTs annotations::NamedASTs
 {}
 
+abstract production terminalAST
+top::AST ::= terminalName::String lexeme::String location::Location
+{}
+
 abstract production listAST
 top::AST ::= vals::ASTs
 {}

grammars/silver/composed/Default/Main.sv

@@ -24,6 +24,8 @@ parser svParse::Root {
   silver:extension:doc;
   silver:extension:functorattrib;
   silver:extension:monad;
+  silver:extension:reflection;
+  silver:extension:silverconstruction;
 --  silver:extension:concreteSyntaxForTrees ;
 
   silver:modification:let_fix;

grammars/silver/definition/core/QName.sv

@@ -43,6 +43,17 @@ top::QName ::= id::Name ':' qn::QName
   top.lookupAttribute = decorate customLookup("attribute", getAttrDcl(top.name, top.env), top.name, top.location) with {};
 }
 
+abstract production qNameError
+top::QName ::= msg::[Message]
+{
+  top.name = "err";
+  top.pp = "<err>";
+
+  top.lookupValue = decorate errorLookup(msg) with {};
+  top.lookupType = decorate errorLookup(msg) with {};
+  top.lookupAttribute = decorate errorLookup(msg) with {};
+}
+
 nonterminal QNameLookup with fullName, typerep, errors, dcls, dcl, dclBoundVars, found;
 
 synthesized attribute lookupValue :: Decorated QNameLookup occurs on QName;
@@ -73,6 +84,17 @@ top::QNameLookup ::= kindOfLookup::String dcls::[DclInfo] name::String l::Locati
      else [err(l, "Ambiguous reference to " ++ kindOfLookup ++ " '" ++ name ++ "'. Possibilities are:\n" ++ printPossibilities(top.dcls))]);
 }
 
+abstract production errorLookup
+top::QNameLookup ::= msg::[Message]
+{
+  top.dcls = [];
+  top.found = true;
+  top.fullName = "err";
+  top.typerep = errorType();
+  top.dclBoundVars = [];
+  top.errors := msg;
+}
+
 function printPossibilities
 String ::= lst::[DclInfo]
 {

grammars/silver/definition/type/syntax/TypeExpr.sv

@@ -33,6 +33,18 @@ function addNewLexicalTyVars
                   addNewLexicalTyVars(gn, sl, tail(l));
 }
 
+abstract production errorTypeExpr
+top::TypeExpr ::= e::[Message]
+{
+  top.pp = s"{- Errors:\n${foldMessages(e)} -}";
+
+  top.typerep = errorType();
+
+  top.errors := e;
+
+  top.lexicalTypeVariables = [];
+}
+
 abstract production typerepTypeExpr
 top::TypeExpr ::= t::Type
 {

grammars/silver/extension/reflection/BuiltinFunctions.sv

@@ -0,0 +1,56 @@
+grammar silver:extension:reflection;
+
+imports silver:definition:core;
+imports silver:definition:type;
+imports silver:definition:env;
+imports silver:extension:patternmatching;
+imports silver:modification:let_fix;
+
+terminal Deserialize_kwd 'deserialize' lexer classes {BUILTIN,RESERVED};
+
+{--
+ - This production deserializes a string to what it represents, in contrast to
+ - `reify` which "deserializes" an `AST` to what it represents, and in contrast to
+ - `deserializeAST` which deserializes a string to an `AST`.
+ - i.e. this function is `reify . deserializeAST` so to speak.
+ -
+ - This also has to be a built-in function because reification requires an
+ - explicit concrete type at its call site, which makes it difficult to write ordinary
+ - functions for. Something we might someday be able to solve with a typeclass?
+-}
+concrete production deserializeFunction
+top::Expr ::= 'deserialize' '(' fileName::Expr ',' text::Expr ')'
+{
+  top.pp = s"deserialize(${fileName.pp}, ${text.pp})";
+
+  local errCheck1::TypeCheck = check(fileName.typerep, stringType());
+  errCheck1.finalSubst = top.finalSubst;
+  local errCheck2::TypeCheck = check(text.typerep, stringType());
+  errCheck2.finalSubst = top.finalSubst;
+
+  fileName.downSubst = top.downSubst;
+  text.downSubst = fileName.upSubst;
+  errCheck1.downSubst = text.upSubst;
+  errCheck2.downSubst = errCheck1.upSubst;
+  --top.upSubst = errCheck2.upSubst;
+
+  local localErrors::[Message] =
+    (if errCheck1.typeerror
+     then [err(fileName.location, "First operand to 'deserialize(fileName, text)' must be a String, instead it is " ++ errCheck1.leftpp)]
+     else []) ++
+    (if errCheck2.typeerror
+     then [err(text.location, "Second operand to 'deserialize(fileName, text)' must be a String, instead it is " ++ errCheck2.leftpp)]
+     else []);
+
+  local fwrd::Expr =
+    Silver_Expr {
+      case deserializeAST($Expr {exprRef(fileName, location=builtin)}, $Expr {exprRef(text, location=builtin)}) of
+      | left(msg) -> left(msg)
+      | right(ast) -> reify(ast)
+      end
+    };
+
+  forwards to if !null(localErrors) then errorExpr(localErrors, location=top.location) else fwrd;
+}
+
+global builtin::Location = builtinLoc("reflection");

grammars/silver/extension/silverconstruction/Syntax.sv

@@ -0,0 +1,72 @@
+grammar silver:extension:silverconstruction;
+
+imports silver:langutil;
+imports silver:langutil:pp;
+
+imports silver:definition:core;
+imports silver:definition:env;
+imports silver:definition:type:syntax;
+imports silver:extension:list;
+
+concrete production silverExprLiteral
+top::Expr ::= 'Silver_Expr' LCurly_t ast::Expr RCurly_t
+{
+  top.pp = s"Silver_Expr {${ast.pp}}";
+  forwards to translate(top.location, reflect(new(ast)));
+}
+
+concrete production escapeExpr
+top::Expr ::= '$Expr' silver:definition:core:LCurly_t e::Expr silver:definition:core:RCurly_t
+{
+  top.pp = s"$$Expr{${e.pp}}";
+  forwards to
+    errorExpr(
+      [err(top.location, "$Expr should not occur outside of Silver_Expr")],
+      location=top.location);
+}
+
+concrete production escapeTypeExpr
+top::TypeExpr ::= '$TypeExpr' silver:definition:core:LCurly_t e::Expr silver:definition:core:RCurly_t
+{
+  top.pp = s"$$TypeExpr{${e.pp}}";
+  forwards to
+    errorTypeExpr(
+      [err(top.location, "$TypeExpr should not occur outside of Silver_Expr")],
+      location=top.location);
+}
+
+concrete production escapeQName
+top::QName ::= '$QName' silver:definition:core:LCurly_t e::Expr silver:definition:core:RCurly_t
+{
+  top.pp = s"$$QName{${e.pp}}";
+  forwards to
+    qNameError(
+      [err(top.location, "$QName should not occur outside of Silver_Expr")],
+      location=top.location);
+}
+
+concrete production escapeName
+top::Name ::= '$Name' silver:definition:core:LCurly_t e::Expr silver:definition:core:RCurly_t
+{
+  top.pp = s"$$Name{${e.pp}}";
+  -- TODO: [err(top.location, "$Name should not occur outside of Silver_Expr")]
+  forwards to name("err", top.location);
+}
+
+concrete production escape_qName
+top::QName ::= '$qName' silver:definition:core:LCurly_t e::Expr silver:definition:core:RCurly_t
+{
+  top.pp = s"$$qName{${e.pp}}";
+  forwards to
+    qNameError(
+      [err(top.location, "$qName should not occur outside of Silver_Expr")],
+      location=top.location);
+}
+
+concrete production escape_name
+top::Name ::= '$name' silver:definition:core:LCurly_t e::Expr silver:definition:core:RCurly_t
+{
+  top.pp = s"$$name{${e.pp}}";
+  -- TODO: [err(top.location, "$Name should not occur outside of Silver_Expr")]
+  forwards to name("err", top.location);
+}

grammars/silver/extension/silverconstruction/Terminals.sv

@@ -0,0 +1,13 @@
+grammar silver:extension:silverconstruction;
+
+marking terminal SilverExpr_t 'Silver_Expr' lexer classes {KEYWORD, RESERVED};
+
+temp_imp_ide_font font_escape color(160, 32, 240) bold italic;
+lexer class Escape font=font_escape;
+
+terminal EscapeExpr_t              '$Expr'              lexer classes {Escape};
+terminal EscapeTypeExpr_t          '$TypeExpr'          lexer classes {Escape};
+terminal EscapeQName_t             '$QName'             lexer classes {Escape};
+terminal EscapeName_t              '$Name'              lexer classes {Escape};
+terminal Escape_qName_t            '$qName'             lexer classes {Escape};
+terminal Escape_name_t             '$name'              lexer classes {Escape};