Add support for units of measure

src/arr/compiler/anf-loop-compiler.arr

@@ -330,7 +330,57 @@ fun is-function-flat(flatness-env :: FL.FEnv, fun-name :: String) -> Boolean:
   is-flat-enough(flatness-opt)
 end
 
+fun normalize-unit-help(u :: A.Unit, factor :: NumInteger, acc :: D.MutableStringDict<NumInteger>) -> D.MutableStringDict<NumInteger>:
+  cases (A.Unit) u block:
+    | u-one(_) => acc
+    | u-base(l, id) =>
+      acc.set-now(tostring(id), acc.get-now(tostring(id)).or-else(0) + factor)
+      acc
+    | u-mul(_, _, lhs, rhs) => normalize-unit-help(lhs, factor, normalize-unit-help(rhs, factor, acc))
+    | u-div(_, _, lhs, rhs) => normalize-unit-help(lhs, factor, normalize-unit-help(rhs, factor * -1, acc))
+    | u-pow(_, _, shadow u, n) => normalize-unit-help(u, n * factor, acc)
+    | u-paren(_, shadow u) => normalize-unit-help(u, factor, acc)
+  end
+end
+fun normalize-unit(u :: A.Unit) -> D.StringDict<NumInteger>:
+  normalize-unit-help(u, 1, [mutable-string-dict: ]).freeze()
+end
 
+fun compile-unit-help(u :: A.Unit) -> J.JExpr:
+  normalized = normalize-unit(u)
+  fields = normalized.fold-keys(
+    lam(key, acc):
+      power = normalized.get-value(key)
+      if power == 0:
+        acc
+      else:
+        val = if num-is-fixnum(power):
+          j-num(power)
+        else:
+          rt-method("makeNumberFromString", [clist: j-str(tostring(power))])
+        end
+        CL.concat-cons(j-field(key, val), acc)
+      end
+    end,
+    CL.concat-empty)
+
+  if fields.length() == 0:
+    rt-field("UNIT_ONE")
+  else:
+    j-obj(CL.concat-cons(j-field("$count", j-num(fields.length())), fields))
+  end
+end
+fun compile-unit(u :: A.Unit) -> J.JExpr:
+  cases (A.Unit) u block:
+    | u-base(l, id) =>
+      if A.is-s-underscore(id):
+        rt-field("UNIT_ANY")
+      else:
+        compile-unit-help(u)
+      end
+    | else => compile-unit-help(u)
+  end
+end
 
 fun compile-ann(ann :: A.Ann, visitor) -> DAG.CaseResults%(is-c-exp):
   cases(A.Ann) ann:
@@ -395,6 +445,12 @@ fun compile-ann(ann :: A.Ann, visitor) -> DAG.CaseResults%(is-c-exp):
         rt-method(pred-maker, [clist: compiled-base.exp, compiled-exp.exp, j-str(name)]),
         cl-append(compiled-base.other-stmts, compiled-exp.other-stmts)
         )
+    | a-unit(l, base, u) =>
+      compiled-base = compile-ann(base, visitor)
+      compiled-unit = compile-unit(u)
+      c-exp(
+        rt-method("makeUnitAnn", [clist: compiled-base.exp, compiled-unit, visitor.get-loc(l)]),
+        cl-empty)
     | a-dot(l, m, field) =>
       c-exp(
         rt-method("getDotAnn", [clist:
@@ -1667,11 +1723,16 @@ compiler-visitor = {
   method a-srcloc(self, l, loc):
     c-exp(self.get-loc(loc), cl-empty)
   end,
-  method a-num(self, l :: Loc, n :: Number):
-    if num-is-fixnum(n):
+  method a-num(self, l :: Loc, n :: Number, u :: A.Unit) block:
+    if num-is-fixnum(n) and A.is-u-one(u):
       c-exp(j-parens(j-num(n)), cl-empty)
     else:
-      c-exp(rt-method("makeNumberFromString", [clist: j-str(tostring(n))]), cl-empty)
+      make-num-call = rt-method("makeNumberFromString", [clist: j-str(tostring(n))])
+      if A.is-u-one(u):
+        c-exp(make-num-call, cl-empty)
+      else:
+        c-exp(rt-method("addUnit", [clist: make-num-call, compile-unit(u)]), cl-empty)
+      end
     end
   end,
   method a-str(self, l :: Loc, s :: String):
@@ -1907,21 +1968,22 @@ remove-useless-if-visitor = N.default-map-visitor.{
 
 check:
   d = N.dummy-loc
+  u = A.u-one(d)
   true1 = N.a-if(d, N.a-bool(d, true),
-    N.a-lettable(d, N.a-val(d, N.a-num(d, 1))),
-    N.a-lettable(d, N.a-val(d, N.a-num(d, 2))))
-  true1.visit(remove-useless-if-visitor) is N.a-val(d, N.a-num(d, 1))
+    N.a-lettable(d, N.a-val(d, N.a-num(d, 1, u))),
+    N.a-lettable(d, N.a-val(d, N.a-num(d, 2, u))))
+  true1.visit(remove-useless-if-visitor) is N.a-val(d, N.a-num(d, 1, u))
 
   false4 = N.a-if(d, N.a-bool(d, false),
-    N.a-lettable(d, N.a-val(d, N.a-num(d, 3))),
-    N.a-lettable(d, N.a-val(d, N.a-num(d, 4))))
-  false4.visit(remove-useless-if-visitor) is N.a-val(d, N.a-num(d, 4))
+    N.a-lettable(d, N.a-val(d, N.a-num(d, 3, u))),
+    N.a-lettable(d, N.a-val(d, N.a-num(d, 4, u))))
+  false4.visit(remove-useless-if-visitor) is N.a-val(d, N.a-num(d, 4, u))
 
   N.a-if(d, N.a-id(d, A.s-name(d, "x")), N.a-lettable(d, true1), N.a-lettable(d, false4)
     ).visit(remove-useless-if-visitor)
     is N.a-if(d, N.a-id(d, A.s-name(d, "x")),
-    N.a-lettable(d, N.a-val(d, N.a-num(d, 1))),
-    N.a-lettable(d, N.a-val(d, N.a-num(d, 4))))
+    N.a-lettable(d, N.a-val(d, N.a-num(d, 1, u))),
+    N.a-lettable(d, N.a-val(d, N.a-num(d, 4, u))))
 
 end
 |#

src/arr/compiler/anf.arr

@@ -6,6 +6,7 @@ provide-types *
 import ast as A
 import srcloc as SL
 import file("ast-anf.arr") as N
+import string-dict as SD
 
 type Loc = SL.Srcloc
 
@@ -166,11 +167,14 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr:
           end)
 
       end)
-    | s-num(l, n) => k(N.a-val(l, N.a-num(l, n)))
+    | s-num(l, n, u) =>
+        k(N.a-val(l, N.a-num(l, n, u)))
       # num, den are exact ints, and s-frac desugars to the exact rational num/den
-    | s-frac(l, num, den) => k(N.a-val(l, N.a-num(l, num / den))) # Possibly unneeded if removed by desugar?
+    | s-frac(l, num, den, u) =>
+      k(N.a-val(l, N.a-num(l, num / den, u))) # Possibly unneeded if removed by desugar?
       # num, den are exact ints, and s-rfrac desugars to the roughnum fraction corresponding to num/den
-    | s-rfrac(l, num, den) => k(N.a-val(l, N.a-num(l, num-to-roughnum(num / den)))) # Possibly unneeded if removed by desugar?
+    | s-rfrac(l, num, den, u) =>
+      k(N.a-val(l, N.a-num(l, num-to-roughnum(num / den), u))) # Possibly unneeded if removed by desugar?
     | s-str(l, s) => k(N.a-val(l, N.a-str(l, s)))
     | s-undefined(l) => k(N.a-val(l, N.a-undefined(l)))
     | s-bool(l, b) => k(N.a-val(l, N.a-bool(l, b)))
@@ -342,7 +346,7 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr:
       N.a-let(
         l,
         bind(l, array-id),
-        N.a-prim-app(l, "makeArrayN", [list: N.a-num(l, values.length())], flat-prim-app),
+        N.a-prim-app(l, "makeArrayN", [list: N.a-num(l, values.length(), A.u-one(l))], flat-prim-app),
         anf-name-arr-rec(values, array-id, 0, lam():
           k(N.a-val(l, N.a-id(l, array-id)))
         end))

src/arr/compiler/ast-anf.arr

@@ -41,6 +41,9 @@ str-provide = PP.str("provide")
 str-as = PP.str("as")
 str-from = PP.str("from")
 str-newtype = PP.str("newtype ")
+str-percent = PP.str("%")
+str-caret = PP.str("^")
+str-space = PP.str(" ")
 
 dummy-loc = SL.builtin("dummy-location")
 is-s-provide-complete = A.is-s-provide-complete
@@ -461,9 +464,16 @@ data AVal:
   | a-srcloc(l :: Loc, loc :: Loc) with:
     method label(self): "a-srcloc" end,
     method tosource(self): PP.str(torepr(self.loc)) end
-  | a-num(l :: Loc, n :: Number) with:
+  | a-num(l :: Loc, n :: Number, u :: A.Unit) with:
     method label(self): "a-num" end,
-    method tosource(self): PP.number(self.n) end
+    method tosource(self):
+      if A.is-u-one(self.u):
+        PP.number(self.n)
+      else:
+        PP.separate(str-percent,
+          [list: PP.number(self.n), PP.surround(INDENT, 0, PP.langle, self.u.tosource(), PP.rangle)])
+      end
+    end
   | a-str(l :: Loc, s :: String) with:
     method label(self): "a-str" end,
     method tosource(self): PP.str(torepr(self.s)) end
@@ -577,7 +587,7 @@ end
 fun strip-loc-val(val :: AVal):
   cases(AVal) val:
     | a-srcloc(_, l) => a-srcloc(dummy-loc, l)
-    | a-num(_, n) => a-num(dummy-loc, n)
+    | a-num(_, n, u) => a-num(dummy-loc, n, u)
     | a-str(_, s) => a-str(dummy-loc, s)
     | a-bool(_, b) => a-bool(dummy-loc, b)
     | a-undefined(_) => a-undefined(dummy-loc)
@@ -705,8 +715,8 @@ default-map-visitor = {
   method a-srcloc(self, l, loc):
     a-srcloc(l, loc)
   end,
-  method a-num(self, l :: Loc, n :: Number):
-    a-num(l, n)
+  method a-num(self, l :: Loc, n :: Number, u :: A.Unit):
+    a-num(l, n, u)
   end,
   method a-str(self, l :: Loc, s :: String):
     a-str(l, s)
@@ -761,6 +771,7 @@ fun freevars-ann-acc(ann :: A.Ann, seen-so-far :: NameDict<A.Name>) -> NameDict<
     | a-tuple(l, fields) => freevars-list-acc(fields, seen-so-far)
     | a-app(l, a, args) => freevars-list-acc(args, freevars-ann-acc(a, seen-so-far))
     | a-method-app(l, a, _, args) => freevars-list-acc(args, freevars-ann-acc(a, seen-so-far))
+    | a-unit(l, a, u) => freevars-ann-acc(a, seen-so-far)
     | a-pred(l, a, pred) =>
       name = cases(A.Expr) pred:
         | s-id(_, n) => n
@@ -811,7 +822,7 @@ where:
   x = n("x")
   y = n("y")
   freevars-e(
-      a-let(d, a-bind(d, x, A.a-blank), a-val(d, a-num(d, 4)),
+      a-let(d, a-bind(d, x, A.a-blank), a-val(d, a-num(d, 4, A.u-one(d))),
         a-lettable(d, a-val(d, a-id(d, y))))).keys-list() is [list: y.key()]
 end
 
@@ -968,7 +979,7 @@ fun freevars-v-acc(v :: AVal, seen-so-far :: NameDict<A.Name>) -> NameDict<A.Nam
       seen-so-far.set-now(id.key(), id)
       seen-so-far
     | a-srcloc(_, _) => seen-so-far
-    | a-num(_, _) => seen-so-far
+    | a-num(_, _, _) => seen-so-far
     | a-str(_, _) => seen-so-far
     | a-bool(_, _) => seen-so-far
     | a-undefined(_) => seen-so-far

src/arr/compiler/ast-util.arr

@@ -679,6 +679,7 @@ fun is-stateful-ann(ann :: A.Ann) -> Boolean:
     | a-record(_, fields) => fields.map(_.ann).all(is-stateful-ann)
     | a-tuple(_, fields) => fields.all(is-stateful-ann)
     | a-app(_, inner, args) => is-stateful-ann(inner)
+    | a-unit(_, _, _) => true # TODO(Benmusch, 4 Jun 2019): true for now. Could refine later
     | a-pred(_, _, _) => true # TODO(Oak, 21 Jan 2016): true for now. Could refine later
     | a-dot(_, _, _) => true # TODO(Oak, 7 Feb 2016): true for now. Could refine later
     | a-checked(_, _) => raise("NYI")
@@ -1041,6 +1042,9 @@ fun get-named-provides(resolved :: CS.NameResolution, uri :: URI, compile-env ::
       | a-pred(l, ann, exp) =>
         # TODO(joe): give more info than this to type checker?  only needed dynamically, right?
         ann-to-typ(ann)
+      | a-unit(l, ann, u) =>
+        # TODO(benmusch): needs to change if/when units are added to the type checker
+        ann-to-typ(ann)
       | a-dot(l, obj, field) =>
         maybe-b = resolved.type-bindings.get-now(obj.key())
         cases(Option) maybe-b:

src/arr/compiler/compile-structs.arr

@@ -670,6 +670,57 @@ data CompileError:
           ED.loc(self.loc),
           ED.text(" because its denominator is zero.")]]
     end
+  | invalid-unit-power(loc, power) with:
+    method render-fancy-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.text("Reading a "),
+          ED.highlight(ED.text("unit annotation"), [ED.locs: self.loc], 0),
+          ED.text(" errored:")],
+        ED.cmcode(self.loc),
+        [ED.para:
+          ED.text("The exponent "),
+          ED.embed(self.power),
+          ED.text(" is not allowed in unit expressions. "),
+          ED.text("Make sure to use a non-zero integer value.")]]
+    end,
+    method render-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.text("Pyret disallows units with the exponent")],
+        [ED.para:
+          ED.embed(self.power)],
+        [ED.para:
+          ED.text("at "),
+          ED.loc(self.loc),
+          ED.text(". Make sure to use a non-zero integer value.")]]
+    end
+  | one-as-power-base(loc, power) with:
+    method render-fancy-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.text("Reading a "),
+          ED.highlight(ED.text("unit annotation"), [ED.locs: self.loc], 0),
+          ED.text(" errored:")],
+        ED.cmcode(self.loc),
+        [ED.para:
+          ED.code(ED.text("1")),
+          ED.text(" is raised to the power "),
+          ED.embed(self.power),
+          ED.text(". One cannot be raised to a power")]]
+    end,
+    method render-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.code(ED.text("1")),
+          ED.text(" is raised to the power ")],
+        [ED.para:
+          ED.embed(self.power)],
+        [ED.para:
+          ED.text("at "),
+          ED.loc(self.loc),
+          ED.text(". One cannot be raised to a power")]]
+    end
   | mixed-binops(exp-loc, op-a-name, op-a-loc, op-b-name, op-b-loc) with:
     method render-fancy-reason(self):
       [ED.error:
@@ -700,6 +751,36 @@ data CompileError:
           ED.loc(self.op-b-loc),
           ED.text(". Use parentheses to group the operations and to make the order of operations clear.")]]
     end
+  | mixed-unit-ops(exp-loc, op-a-name, op-a-loc, op-b-name, op-b-loc) with:
+    method render-fancy-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.text("Reading this "),
+          ED.highlight(ED.text("unit"), [ED.locs: self.exp-loc], -1),
+          ED.text(" errored:")],
+        ED.cmcode(self.exp-loc),
+        [ED.para:
+          ED.text("The "),
+          ED.code(ED.highlight(ED.text(self.op-a-name),[list: self.op-a-loc], 0)),
+          ED.text(" operation is at the same level as the "),
+          ED.code(ED.highlight(ED.text(self.op-b-name),[list: self.op-b-loc], 1)),
+          ED.text(" operation.")],
+        [ED.para:
+          ED.text("Use parentheses to group the operations and to make the order of operations clear.")]]
+    end,
+    method render-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.text("Unit operators of different kinds cannot be mixed at the same level, but "),
+          ED.code(ED.text(self.op-a-name)),
+          ED.text(" is at "),
+          ED.loc(self.op-a-loc),
+          ED.text(" at the same level as "),
+          ED.code(ED.text(self.op-b-name)),
+          ED.text(" at "),
+          ED.loc(self.op-b-loc),
+          ED.text(". Use parentheses to group the operations and to make the order of operations clear.")]]
+    end
   | block-ending(l :: Loc, block-loc :: Loc, kind) with:
     method render-fancy-reason(self):
       [ED.error:
@@ -972,6 +1053,27 @@ data CompileError:
           ED.text(self.kind),
           ED.text(".")]]
     end
+  | underscore-as-unit(l :: Loc) with:
+    method render-fancy-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.text("The underscore "),
+          ED.code(ED.highlight(ED.text("_"), [ED.locs: self.l], 0)),
+          ED.text(" is invalid."),
+          ED.text(" Underscores can only be used in units when"),
+          ED.text(" they are an annotation and there is nothing else in the unit expression")]]
+    end,
+    method render-reason(self):
+      [ED.error:
+        [ED.para:
+          ED.text("The underscore "),
+          ED.code(ED.text("_")),
+          ED.text(" at "),
+          ED.loc(self.l),
+          ED.text(" is invalid."),
+          ED.text(" Underscores can only be used in units when"),
+          ED.text(" they are an annotation and there is nothing else in the unit expression")]]
+    end
   | underscore-as-pattern(l :: Loc) with:
     method render-fancy-reason(self):
       [ED.error: