Changeset 827

Timestamp:

Aug 6, 2012 4:50:46 PM (12 years ago)

Author:

biz002

Message:

clojure/rascal integration consistency; rascal data pgf-based printer

RascalPp test case

make reval and rcall more consistent in clojure api;
both now return a value rather than a result

some addressing of the issue of VoidResult toString (in Rascal)
throwing a null pointer exception

rcall fix (clojure api)

try pgf based pp and groupings with large (magnolia ast) data structures

some clojure api cleanup

Location:

trunk/magnolia-eclipse

Files:

• src/org/magnolialang/pgf/FmtUtil.rsc (modified) (1 diff)
• src/org/magnolialang/pgf/Groupings.rsc (modified) (3 diffs)
• src/org/magnolialang/pgf/Token.rsc (modified) (4 diffs)
• src/org/magnolialang/pgf/engines/FmtEngine.rsc (modified) (6 diffs)
• src/org/magnolialang/pgf/tests/TestFmtEngine.rsc (modified) (1 diff)
• src/org/magnolialang/testutil/RascalEval.java (modified) (3 diffs)
• src/org/magnolialang/testutil/RascalExt.java (added)
• src/org/magnolialang/testutil/RascalPp.rsc (added)
• src/org/magnolialang/testutil/TestUtil.rsc (modified) (2 diffs)
• src/org/magnolialang/testutil/core.clj (modified) (8 diffs)
• test/org/magnolialang/test/core.clj (modified) (1 diff)

trunk/magnolia-eclipse/src/org/magnolialang/pgf/FmtUtil.rsc

@@ -88 +88 @@
 }
 
+/*
 public void main(list[str] args) {
   println(cat("forever {", indent(2), br, "(void)0;", dedent, br, "}"));
 }
+*/

trunk/magnolia-eclipse/src/org/magnolialang/pgf/Groupings.rsc

@@ -21 +21 @@
 }
 
+tuple[value, Tseq] nil_accept_f(value v, Tseq s, str name) {
+  return <v, NilTseq()>;
+}
+
 Tseq nil_end_f(value v) { 
   return NilTseq();
@@ -26 +30 @@
 
 public Grouping newGrouping(str name) {
-  return Grouping(name, nil_begin_f, nil_put_f, nil_put_f,
+  return Grouping(name, nil_begin_f, nil_put_f, nil_accept_f,
                   nil_end_f, grpEofDefault);
 }
@@ -38 +42 @@
 }
 
+tuple[value, Tseq] tseq_accept_f(value v, Tseq s, str name) {
+  return <tseq(v, s), NilTseq()>;
+}
+
 Grouping makeGroup() {
   Grouping g = newGrouping("group");
   g.begin = tseq_begin_f;
   g.put = tseq_put_f;
-  g.accept = tseq_put_f;
+  g.accept = tseq_accept_f;
   // cannot use 'group' directly as it's an overload;
   // must resolve the overload here

trunk/magnolia-eclipse/src/org/magnolialang/pgf/Token.rsc

@@ -68 +68 @@
 
 Token eofTok = Eof();
-Tseq nilSeq = NilTseq();
+
+public Tseq nilTseq = NilTseq();
 
 public Tseq emptyTseq() {
-  return nilSeq;
+  return nilTseq;
 }
 
@@ -129 +130 @@
 public default tuple[Token, Tseq] tseqGet(x) {
   switch (x) {
-  case Token t: return <t, nilSeq>;
-  case str s: return <Text(s), nilSeq>;
-  case NilTseq(): return <eofTok, nilSeq>;
+  case Token t: return <t, nilTseq>;
+  case str s: return <Text(s), nilTseq>;
+  case NilTseq(): return <eofTok, nilTseq>;
   case ListTseq(lst): return tseqGetList(lst);
   case list[value] lst: return tseqGetList(lst);
   case LazyTseq(_, _): return tseqGetLazy(x);
-  case false: return <eofTok, nilSeq>;
+  case false: return <eofTok, nilTseq>;
   default:
     throw "attempt to tseqGet from unsupported value <x>";
@@ -152 +153 @@
     i += 1;
   }
-  return <eofTok, nilSeq>;
+  return <eofTok, nilTseq>;
 }
 
@@ -181 +182 @@
 // deprecated (use emptyTseq)
 public Tseq newTokenStream() {
-  return nilSeq;
+  return nilTseq;
 }
 

trunk/magnolia-eclipse/src/org/magnolialang/pgf/engines/FmtEngine.rsc

@@ -96 +96 @@
              value () begin,
              tuple[value, Tseq] (value, Token) put,
-             tuple[value, Tseq] (value, Token) accept,
+             tuple[value, Tseq] (value, Tseq, str) accept,
              Tseq (value) end,
              void (value, str) eof
@@ -154 +154 @@
     g_st = tg.st;
     <n_g_st, r> = g_type.accept(g_st, s, name);
-    n_grp = GrpSt(tg, n_g_st);
+    n_grp = GrpSt(g_type, n_g_st);
     n_st = FmtSt(st.cw, st.w, st.outDoc, st.inDoc,
                  st.k, st.lvStack, st.i, st.bt,
@@ -306 +306 @@
 public FmtSt newFmtSt(int w) {
   return newFmtSt(w, emptyTseq());
+}
+
+public FmtSt newFmtSt() {
+  return newFmtSt(80);
 }
 
@@ -442 +446 @@
 
 // Adds a token to input.
-public FmtSt put(FmtSt st, Token t) {
+public FmtSt write(FmtSt st, Token t) {
   return write(st, tseq(t));
 }
@@ -486 +490 @@
 }
 
+// st: pretty printing state
+public str pretty(FmtSt st) {
+  st = flush(drive(st));
+  return docToString(st.outDoc);
+}
+
 // w: output line width
 // ts: a (complete) input document 
 public str pretty(int w, Tseq ts) {
   FmtSt st = newFmtSt(w, ts);
-  st = flush(drive(st));
-  return docToString(st.outDoc);
+  return pretty(st);
 }
 
@@ -526 +535 @@
 public FmtSt prettyPrintFlush(FmtSt st) {
   return printBuffered(flush(prettyPrint(st)));
+}
+
+public FmtSt prettyPrintFlushLn(FmtSt st) {
+  st = prettyPrintFlush(st);
+  println("");
+  return st;
 }
 

trunk/magnolia-eclipse/src/org/magnolialang/pgf/tests/TestFmtEngine.rsc

@@ -1 +1 @@
 // run with rascal-src
+
+/*
+  (rimport "org::magnolialang::pgf::tests::TestFmtEngine")
+  (rcall "runTestFmtEngine")
+ */
 module org::magnolialang::pgf::tests::TestFmtEngine
 

trunk/magnolia-eclipse/src/org/magnolialang/testutil/RascalEval.java

@@ -33 +33 @@
 import org.rascalmpl.values.uptr.Factory;
 import org.rascalmpl.values.uptr.TreeAdapter;
+
+/*
+ * Calling toString() on a VoidResult gives a NullPointerException,
+ * which can cause trouble here and there.
+ * This is a more polite implementation.
+ * 
+ * public class VoidResult extends Result<VoidResult.Void> {
+ * abstract class Void implements IValue {}
+ * 
+ * public VoidResult(Type type, IEvaluatorContext ctx) {
+ * super(type, null, ctx);
+ * }
+ * 
+ * public String toString() {
+ * return getType().toString();
+ * }
+ * 
+ * public String toString(int length) {
+ * return toString();
+ * }
+ * }
+ */
 
 public class RascalEval {
@@ -83 +105 @@
         public IValue call(String name, Collection<IValue> args) {
                 //System.err.println("call " + name + " with " + args);
-                return evaluator.call(name, args.toArray(new IValue[] {}));
+                IValue[] arr = new IValue[] {};
+                if(args != null)
+                        arr = args.toArray(arr);
+                return evaluator.call(name, arr);
         }
 
@@ -99 +124 @@
 
         public static String resultToString(Result<IValue> value) {
-                if(value.getValue() == null) {
+                IValue v = value.getValue();
+                Type type = value.getType();
+
+                if(v == null || type == null) {
                         return "ok";
                 }
 
-                IValue v = value.getValue();
-                Type type = value.getType();
+                // Calling Result<IValue>.toString should be safe if both getValue
+                // and getType yield non-null.
+                String s = value.toString(LINE_LIMIT);
 
                 if(type.isAbstractDataType() && type.isSubtypeOf(Factory.Tree)) {
-                        return "`" + TreeAdapter.yield((IConstructor) v) + "`\n" + value.toString(LINE_LIMIT);
+                        return "`" + TreeAdapter.yield((IConstructor) v) + "`\n" + s;
                 }
 
-                return ((v != null) ? value.toString(LINE_LIMIT) : null);
+                return s;
         }
 

trunk/magnolia-eclipse/src/org/magnolialang/testutil/TestUtil.rsc

@@ -1 +1 @@
 module org::magnolialang::testutil::TestUtil
-
-import org::magnolialang::pgf::PrettyParseTree;
-import org::magnolialang::pgf::Token;
 
 import org::magnolialang::magnolia::MagnoliaFacts;
@@ -11 +8 @@
 import List;
 
-/** Dumps test data (token streams of Magnolia) as Rascal data
-    structures. */
-public Tseq mgModuleToTokens(str modName) {
-  name = strToName(modName);
-  tr = startTransaction();
-  //println(getFact(tr, #DefInfo, name));
-  pt = getFact(tr, #ParseTree, name).val;
-  //println(pt);
-  ts = prettyParseTree(emptyTseq(), pt);
-  //println(ts);
-  endTransaction(tr);
-  return ts;
+@doc{Call Java toString to turn a Rascal value into a string.}
+@javaClass{org.magnolialang.testutil.RascalExt}
+public java str javaToString(value v);
+
+@doc{Converts tuple field values to a list.}
+@javaClass{org.magnolialang.testutil.RascalExt}
+public java list[value] tupleToList(value tp);
+
+public void makeVoidResult() {
 }
+
+public int makeIntResult() {
+  return 1;
+}
+
+public int incIntResult(int x) {
+  return x + 1;
+}

trunk/magnolia-eclipse/src/org/magnolialang/testutil/core.clj

@@ -77 +77 @@
   (def rsc-evaluator (get-ric)))
         
-(defn rtostring [r]
+(defn result-to-string [r]
   (RascalEval/resultToString r))
 
@@ -83 +83 @@
 ;; E.g. (reval "registerCompiler")
 (defn reval [s]
-  (.eval rsc-evaluator s))
-
-;; Behaves better upon VoidResult.
+  (.getValue (.eval rsc-evaluator s)))
+
 (defn reval-str [s]
-  (rtostring (reval s)))
+  (result-to-string (.eval rsc-evaluator s)))
 
 ;; E.g. (reval-more "import org::magnolialang::tasks::Manager; getFact; 5;")
 (defn reval-more [s]
-  (.evalMore rsc-evaluator s))
+  (.getValue (.evalMore rsc-evaluator s)))
 
 (defn reval-more-str [s]
-  (rtostring (.evalMore rsc-evaluator s)))
+  (result-to-string (.evalMore rsc-evaluator s)))
 
 ;; E.g. (rimport "org::magnolialang::tasks::Manager")
@@ -107 +106 @@
 
 ;; This produces VoidResult, which
-;; org.rascalmpl.interpreter.result.Result.toString dislikes.
-;; E.g. (rtostring (make-rvoid))
-(defn make-rvoid []
-  (reval-more ";"))
+;; org.rascalmpl.interpreter.result.Result.toString dislikes
+;; (unless using a patched version of VoidResult).
+;; E.g. (result-to-string (make-rvoid))
+(defn make-void-result []
+  (.evalMore rsc-evaluator ";"))
 
 ;; For reloading Rascal modules individually.
@@ -134 +134 @@
     (.initialize parser))
   (def rsc-evaluator (get-ric))
-  (rimport "org::magnolialang::testutil::TestUtil"))
+  (rimport "org::magnolialang::testutil::TestUtil")
+  )
 
 (defn get-parser [s]
@@ -172 +173 @@
 
 (defn get-imploded-tree [s]
-  (let [state tu-state
-        lang mg-lang
-        modNameAst (.getNameAST lang s)]
-    (.getImplodedTree state modNameAst)))
+  (.getImplodedTree tu-state (get-name-ast s)))
 
 (defn rstring [s]
@@ -183 +181 @@
   (.bool org.magnolialang.terms.TermFactory/vf b))
 
+(defn rinteger [i]
+  ;; has other overloads
+  (.integer org.magnolialang.terms.TermFactory/vf i))
+
+(defn rprint [v annos?]
+  (println (.getValue (rcall "prettyRascalValue" v (rbool annos?)))))
+
+(defn rtostring [v]
+  (.getValue (rcall "javaToString" v)))
+
 (defn get-option-string-fact [s]
-  (let [state tu-state]
-    (.getOptionStringFact state (rstring s))))
-
-(defn mg-module-to-tokens [s]
-  (rcall "mgModuleToTokens" (rstring s)))
+  (.getOptionStringFact tu-state (rstring s)))
 
 (defn get-fact [type name]
-  (.getFact tu-state
-            type name))
-
-(defn get-def-info [s]
-  (get-fact MagnoliaFacts/Type_DefInfo
-            (get-name-ast s)))
-
-(defn get-flattened [s]
+  (.getFact tu-state type name))
+
+(defn get-fact-imploded-tree [s]
+  (get-fact MagnoliaFacts/Type_ImplodedTree (get-name-ast s)))
+
+(defn get-fact-flattened [s]
   (get-fact MagnoliaFacts/Type_Flattened (get-name-ast s)))
 
-(defn get-contents [s]
+(defn get-fact-type-checked [s]
+  (get-fact MagnoliaFacts/Type_TypeChecked (get-name-ast s)))
+
+(defn get-fact-def-info [s]
+  (get-fact MagnoliaFacts/Type_DefInfo (get-name-ast s)))
+
+(defn get-fact-contents [s]
   (get-fact MagnoliaFacts/Type_Contents (get-name-ast s)))
 
-(defn get-type-checked [s]
-  (get-fact MagnoliaFacts/Type_TypeChecked (get-name-ast s)))
-
 ;; E.g. (doseq [x (get-contents-seq "basic.Basic")]
-;;        (prn (ctor-get-val (get-simplified x))))
-(defn get-simplified [ast]
+;;        (prn (ctor-get-val (get-fact-simplified x))))
+(defn get-fact-simplified [ast]
   (get-fact MagnoliaFacts/Type_Simplified ast))
 
@@ -225 +230 @@
 ;; E.g. (doseq [x (get-contents-seq "basic.Basic")] (prn x))
 (defn get-contents-seq [s] ;; string -> seq
-  (iterator-seq (.iterator (ctor-get-val (get-contents s)))))
+  (iterator-seq (.iterator (ctor-get-val (get-fact-contents s)))))
 
 ;; E.g. (println (get-cxx-code "basic.Basic"))
@@ -235 +240 @@
   (println (.getValue
             (rcall "prettyMagnolia"
-                   (ctor-get-val (get-type-checked s))))))
+                   (ctor-get-val (get-fact-type-checked s))))))
 
 (defn run-pretty-magnolia [s rich?]

trunk/magnolia-eclipse/test/org/magnolialang/test/core.clj

@@ -55 +55 @@
   (rimport "org::magnolialang::pgf::tests::TestToken")
   (reval-str "runTestToken()"))
+
+(deftest test-rascal-pp
+  (rimport "org::magnolialang::testutil::RascalPp")
+  (rcall "runTestRascalPp")
+  (rprint (get-fact-imploded-tree "basic.Basic") false)
+  (rprint (get-fact-imploded-tree "basic.Basic") true))
+