[MOREL-69] Add 'compute' clause, for monoid comprehensions

Fixes #69

README.md

@@ -131,6 +131,7 @@ Implemented:
     `exception Option`,
     `datatype 'a option = NONE | SOME of 'a`,
     `getOpt`, `isSome`, `valOf`, `filter`, `join`, `app`,
+    `flatten`, `valOf`,
     `map`, `mapPartial`, `compose`, `composePartial`
   * [String](https://smlfamily.github.io/Basis/string.html):
     `eqtype char`,
@@ -143,6 +144,13 @@ Implemented:
     `maxLen`, `fromList`, `tabulate`, `length`, `sub`, `update`, `concat`,
     `appi`, `app`, `mapi`, `map`, `foldli`, `foldri`, `foldl`, `foldr`,
     `findi`, `find`, `exists`, `all`, `collate`
+* Non-basis built-ins:
+  * Interact:
+    `use`
+  * Relational:
+    `count`, `only`, `max`, `min`, `sum`
+  * System:
+    `env`, `plan`, `set`, `show`, `unset`
 
 Not implemented:
 * `type`, `eqtype`, `exception`
@@ -203,18 +211,19 @@ In the relational extensions, `group` and `compute` expressions also use
 implicit labels. For instance,
 ```
 from e in emps
-group e.deptno compute sum of e.salary, count
+  group e.deptno compute sum of e.salary, count
 ```
 is short-hand for
 ```
 from e in emps
-group deptno = e.deptno compute sum = sum of e.salary, count = count
+  group deptno = e.deptno compute sum = sum of e.salary, count = count
 ```
 and both expressions have type `{count:int,deptno:int,sum:int} list`.
 
 ### Relational extensions
 
-The `from` expression (and associated `in`, `where` and `yield` keywords)
+The `from` expression (and associated `in`, `join`, `where`,
+`group`, `compute`, `order` and `yield` keywords)
 is a language extension to support relational algebra.
 It iterates over a list and generates another list.
 
@@ -262,7 +271,8 @@ You can iterate over more than one collection, and therefore generate
 a join or a cartesian product:
 
 ```
-from e in emps, d in depts
+from e in emps,
+    d in depts
   where e.deptno = d.deptno
   yield {e.id, e.deptno, ename = e.name, dname = d.name};
 ```
@@ -277,21 +287,21 @@ let
     | in_ e (h :: t) = e = h orelse (in_ e t)
 in
   from e in emps
-  where in_ e.deptno (from d in depts
-                where d.name = "Engineering"
-                yield d.deptno)
-  yield e.name
+    where in_ e.deptno (from d in depts
+        where d.name = "Engineering"
+        yield d.deptno)
+    yield e.name
 end;
 
 let
   fun exists [] = false
     | exists (hd :: tl) = true
 in
   from e in emps
-  where exists (from d in depts
-                where d.deptno = e.deptno
-                andalso d.name = "Engineering")
-  yield e.name
+    where exists (from d in depts
+        where d.deptno = e.deptno
+        andalso d.name = "Engineering")
+    yield e.name
 end;
 ```
 
@@ -300,6 +310,20 @@ correlated (references the `e` variable from the enclosing query)
 and skips the `yield` clause (because it doesn't matter which columns
 the sub-query returns, just whether it returns any rows).
 
+There are now built-in operators `elem` and `exists`, so you can write
+```
+from e in emps
+  where e.deptno elem (from d in depts
+      where d.name = "Engineering"
+      yield d.deptno)
+  yield e.name;
+
+from e in emps
+  where exists (from d in depts
+      where d.deptno = e.deptno
+      andalso d.name = "Engineering");
+```
+
 ## More information
 
 * License: <a href="LICENSE">Apache License, Version 2.0</a>

docs/reference.md

@@ -37,8 +37,8 @@ just because they take effort to build.
 Contributions are welcome!
 
 In Morel but not Standard ML:
-* `from` expression with `where`, `group`, `order`, `yield` clauses
-  (and `compute`, `desc` sub-clauses)
+* `from` expression with `join`, `where`, `group`, `compute`, `order`, `yield`
+  clauses
 * `union`, `except`, `intersect`, `elem`, `notElem` operators
 * "*lab* `=`" is optional in `exprow`
 
@@ -152,6 +152,8 @@ In Standard ML but not in Morel:
     | <b>group</b> <i>groupKey<sub>1</sub></i> <b>,</b> ... <b>,</b> <i>groupKey<sub>g</sub></i>
       [ <b>compute</b> <i>agg<sub>1</sub></i> <b>,</b> ... <b>,</b> <i>agg<sub>a</sub></i> ]
                                 group clause (<i>g</i> &ge; 0, <i>a</i> &ge; 1)
+    | <b>compute</b> <i>agg<sub>1</sub></i> <b>,</b> ... <b>,</b> <i>agg<sub>a</sub></i>
+                                compute clause (<i>a</i> &gt; 1)
     | <b>order</b> <i>orderItem<sub>1</sub></i> <b>,</b> ... <b>,</b> <i>orderItem<sub>o</sub></i>
                                 order clause (<i>o</i> &ge; 1)
     | <b>yield</b> <i>exp</i>

src/main/java/net/hydromatic/morel/ast/Ast.java

@@ -98,6 +98,7 @@ AstWriter unparse(AstWriter w, int left, int right) {
   /** Literal pattern, the pattern analog of the {@link Literal} expression.
    *
    * <p>For example, "0" in "fun fact 0 = 1 | fact n = n * fact (n - 1)".*/
+  @SuppressWarnings("rawtypes")
   public static class LiteralPat extends Pat {
     public final Comparable value;
 
@@ -147,8 +148,7 @@ public static class WildcardPat extends Pat {
     }
 
     @Override public boolean equals(Object o) {
-      return o == this
-          || o instanceof WildcardPat;
+      return o instanceof WildcardPat;
     }
 
     public Pat accept(Shuttle shuttle) {
@@ -764,6 +764,7 @@ AstWriter unparse(AstWriter w, int left, int right) {
   }
 
   /** Parse tree node of a literal (constant). */
+  @SuppressWarnings("rawtypes")
   public static class Literal extends Exp {
     public final Comparable value;
 
@@ -1476,10 +1477,24 @@ boolean record = true;
           record = nextFields.size() != 1;
           break;
 
+        case COMPUTE:
+          final Compute compute = (Compute) step;
+          final List<Aggregate> aggregates2 = compute.aggregates;
+
+          // The type of
+          //   from emps as e compute c = sum of e3
+          // is the same as the type of
+          //   {a = e1, b = e2, c = sum (map (fn e => e3) [])}
+          nextFields.clear();
+          aggregates2.forEach(aggregate -> nextFields.add(aggregate.id));
+          fields = nextFields;
+          record = fields.size() != 1;
+          break;
+
         case GROUP:
           final Group group = (Group) step;
-          final ImmutableList<Pair<Id, Exp>> groupExps = group.groupExps;
-          final ImmutableList<Aggregate> aggregates = group.aggregates;
+          final List<Pair<Id, Exp>> groupExps = group.groupExps;
+          final List<Aggregate> aggregates = group.aggregates;
 
           // The type of
           //   from emps as e group by a = e1, b = e2 compute c = sum of e3
@@ -1547,6 +1562,14 @@ public From copy(List<FromStep> steps, @Nullable Exp implicitYieldExp) {
           ? this
           : ast.from(pos, steps, implicitYieldExp);
     }
+
+    /** Returns whether this {@code from} expression ends with a {@code compute}
+     * step. If so, it is a <em>monoid</em> comprehension, not a <em>monad</em>
+     * comprehension, and its type is a scalar value (or record), not a list. */
+    public boolean isCompute() {
+      return !steps.isEmpty()
+          && steps.get(steps.size() - 1).op == Op.COMPUTE;
+    }
   }
 
   /** A step in a {@code from} expression - {@code where}, {@code group}
@@ -1734,16 +1757,52 @@ public enum Direction {
     DESC
   }
 
+  /** A {@code compute} or {@code group} clause in a {@code from} expression. */
+  abstract static class AbstractCompute extends FromStep {
+    public final ImmutableList<Aggregate> aggregates;
+
+    AbstractCompute(Pos pos, Op op, ImmutableList<Aggregate> aggregates) {
+      super(pos, op);
+      this.aggregates = aggregates;
+    }
+
+    @Override AstWriter unparse(AstWriter w, int left, int right) {
+      Ord.forEach(aggregates, (aggregate, i) ->
+          w.append(i == 0 ? " compute " : ", ")
+              .append(aggregate, 0, 0));
+      return w;
+    }
+  }
+
+  /** A {@code compute} clause in a {@code from} expression. */
+  public static class Compute extends AbstractCompute {
+    Compute(Pos pos, ImmutableList<Aggregate> aggregates) {
+      super(pos, Op.COMPUTE, aggregates);
+    }
+
+    @Override public AstNode accept(Shuttle shuttle) {
+      return shuttle.visit(this);
+    }
+
+    @Override public void accept(Visitor visitor) {
+      visitor.visit(this);
+    }
+
+    public Compute copy(List<Aggregate> aggregates) {
+      return this.aggregates.equals(aggregates)
+          ? this
+          : ast.compute(pos, aggregates);
+    }
+  }
+
   /** A {@code group} clause in a {@code from} expression. */
-  public static class Group extends FromStep {
+  public static class Group extends AbstractCompute {
     public final ImmutableList<Pair<Id, Exp>> groupExps;
-    public final ImmutableList<Aggregate> aggregates;
 
     Group(Pos pos, ImmutableList<Pair<Id, Exp>> groupExps,
         ImmutableList<Aggregate> aggregates) {
-      super(pos, Op.GROUP);
+      super(pos, Op.GROUP, aggregates);
       this.groupExps = groupExps;
-      this.aggregates = aggregates;
     }
 
     @Override AstWriter unparse(AstWriter w, int left, int right) {
@@ -1753,10 +1812,7 @@ public static class Group extends FromStep {
               .append(id, 0, 0)
               .append(" = ")
               .append(exp, 0, 0));
-      Ord.forEach(aggregates, (aggregate, i) ->
-          w.append(i == 0 ? " compute " : ", ")
-              .append(aggregate, 0, 0));
-      return w;
+      return super.unparse(w, 0, right);
     }
 
     @Override public AstNode accept(Shuttle shuttle) {

src/main/java/net/hydromatic/morel/ast/AstBuilder.java

@@ -133,6 +133,7 @@ public Ast.Pat idPat(Pos pos, String name) {
     }
   }
 
+  @SuppressWarnings("rawtypes")
   public Ast.LiteralPat literalPat(Pos pos, Op op, Comparable value) {
     return new Ast.LiteralPat(pos, op, value);
   }
@@ -450,6 +451,10 @@ public Ast.OrderItem orderItem(Pos pos, Ast.Exp exp, Ast.Direction direction) {
     return new Ast.OrderItem(pos, exp, direction);
   }
 
+  public Ast.Compute compute(Pos pos, List<Ast.Aggregate> aggregates) {
+    return new Ast.Compute(pos, ImmutableList.copyOf(aggregates));
+  }
+
   public Ast.Group group(Pos pos, List<Pair<Ast.Id, Ast.Exp>> groupExps,
       List<Ast.Aggregate> aggregates) {
     return new Ast.Group(pos, ImmutableList.copyOf(groupExps),

src/main/java/net/hydromatic/morel/ast/Op.java

@@ -127,6 +127,7 @@ public enum Op {
   INNER_JOIN(" join "),
   WHERE,
   GROUP,
+  COMPUTE,
   ORDER,
   ORDER_ITEM,
   YIELD,

src/main/java/net/hydromatic/morel/ast/Shuttle.java

@@ -41,20 +41,23 @@ public Shuttle(TypeSystem typeSystem) {
   protected <E extends AstNode> List<E> visitList(List<E> nodes) {
     final List<E> list = new ArrayList<>();
     for (E node : nodes) {
+      //noinspection unchecked
       list.add((E) node.accept(this));
     }
     return list;
   }
 
   protected <K, E extends AstNode> Map<K, E> visitMap(Map<K, E> nodes) {
     final Map<K, E> map = new LinkedHashMap<>();
+    //noinspection unchecked
     nodes.forEach((k, v) -> map.put(k, (E) v.accept(this)));
     return map;
   }
 
   protected <K, E extends AstNode> SortedMap<K, E> visitSortedMap(
       SortedMap<K, E> nodes) {
     final SortedMap<K, E> map = new TreeMap<>(nodes.comparator());
+    //noinspection unchecked
     nodes.forEach((k, v) -> map.put(k, (E) v.accept(this)));
     return map;
   }
@@ -235,6 +238,10 @@ protected AstNode visit(Ast.Yield yield) {
     return ast.yield(yield.pos, yield.exp.accept(this));
   }
 
+  protected AstNode visit(Ast.Compute compute) {
+    return ast.compute(compute.pos, compute.aggregates);
+  }
+
   protected AstNode visit(Ast.Group group) {
     return ast.group(group.pos, group.groupExps, group.aggregates);
   }
@@ -349,7 +356,7 @@ protected Core.Pat visit(Core.RecordPat recordPat) {
   }
 
   protected Core.Exp visit(Core.Fn fn) {
-    return fn.copy((Core.IdPat) fn.idPat.accept(this), fn.exp.accept(this));
+    return fn.copy(fn.idPat.accept(this), fn.exp.accept(this));
   }
 
   protected Core.Exp visit(Core.Case caseOf) {

src/main/java/net/hydromatic/morel/ast/Visitor.java

@@ -205,6 +205,10 @@ protected void visit(Ast.Yield yield) {
     yield.exp.accept(this);
   }
 
+  protected void visit(Ast.Compute compute) {
+    compute.aggregates.forEach(this::accept);
+  }
+
   protected void visit(Ast.Group group) {
     group.groupExps.forEach(p -> {
       p.left.accept(this);