Sandbox Contributions part 1

lang/README.md

@@ -59,12 +59,12 @@ in Pyret development, read on:
 
 The easiest way to *run* a Pyret program from the command-line is:
 
-    $ ./src/scripts/phaseX <path-to-pyret-program-here> [command-line-args...]
+    $ ./src/scripts/phaseX [-v] <path-to-pyret-program-here> [command-line-args...]
 
 Where `X` is `0`, `A`, `B`, or `C`, indicating a phase (described below). For
 example:
 
-    $ ./src/scripts/phaseA src/scripts/show-compilation.arr examples/ahoy-world.arr
+    $ ./src/scripts/phaseA -v src/scripts/show-compilation.arr examples/ahoy-world.arr
 
 Alternatively, you can compile and run a standalone JavaScript file via:
 

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

@@ -801,9 +801,9 @@ end
 fun compile-anns(visitor, step, binds :: List<N.ABind>, entry-label):
   var cur-target = entry-label
   new-cases = for lists.fold(acc from cl-empty, b from binds):
-    if A.is-a-blank(b.ann) or A.is-a-any(b.ann) block:
+    if b.ann.is-ignorable() block:
       acc
-    else if A.is-a-tuple(b.ann) and b.ann.fields.all(lam(a): A.is-a-blank(a) or A.is-a-any(a) end):
+    else if A.is-a-tuple(b.ann) and b.ann.fields.all(lam(a): a.is-ignorable() end):
       new-label = visitor.make-label()
       new-case =
         j-case(cur-target,
@@ -861,7 +861,7 @@ fun compile-annotated-let(visitor, b :: BindType, compiled-e :: DAG.CaseResults%
       raise(string-append(string-append("Unknown ", b.value.label()), " in compile-annotated-let"))
     end
   shadow b = b.value
-  if A.is-a-blank(b.ann) or A.is-a-any(b.ann):
+  if b.ann.is-ignorable():
     c-block(
       j-block(
         cl-append(
@@ -872,7 +872,7 @@ fun compile-annotated-let(visitor, b :: BindType, compiled-e :: DAG.CaseResults%
         ),
       compiled-body.new-cases
       )
-  else if A.is-a-tuple(b.ann) and b.ann.fields.all(lam(a): A.is-a-blank(a) or A.is-a-any(a) end):
+  else if A.is-a-tuple(b.ann) and b.ann.fields.all(lam(a): a.is-ignorable() end):
     step = visitor.cur-step
     after-ann = visitor.make-label()
     after-ann-case = j-case(after-ann, j-block(compiled-body.block.stmts))
@@ -1833,7 +1833,7 @@ compiler-visitor = {
     fun make-variant-constructor(l2, base-id, brands-id, members, refl-name, refl-ref-fields-mask, refl-fields, constructor-id):
 
       nonblank-anns = for filter(m from members):
-        not(A.is-a-blank(m.bind.ann)) and not(A.is-a-any(m.bind.ann))
+        not(m.bind.ann.is-ignorable())
       end
       compiled-anns = for fold(acc from {anns: cl-empty, others: cl-empty}, m from nonblank-anns):
         compiled = compile-ann(m.bind.ann, none, self)

lang/src/arr/compiler/anf.arr

@@ -181,7 +181,7 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr:
         | link(f, r) =>
           cases(A.LetBind) f:
             | s-var-bind(l2, b, val) =>
-              if A.is-a-blank(b.ann) or A.is-a-any(b.ann):
+              if b.ann.is-ignorable():
                 anf-name(val, "var", lam(new-val):
                       N.a-var(l2, N.a-bind(l2, b.id, b.ann), N.a-val(new-val.l, new-val),
                         anf(A.s-let-expr(l, r, body, blocky), k))
@@ -202,13 +202,26 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr:
       end
 
     | s-letrec(l, binds, body, _) =>
-      let-binds = for map(b from binds):
-        A.s-var-bind(b.l, b.b, A.s-undefined(l))
+      undef-inits = for map(b from binds):
+        b-without-ann = A.s-bind(b.b.l, b.b.shadows, b.b.id, A.a-blank)
+        A.s-var-bind(b.l, b-without-ann, A.s-undefined(l))
       end
-      assigns = for map(b from binds):
-        A.s-assign(b.l, b.b.id, b.value)
-      end
-      anf(A.s-let-expr(l, let-binds, A.s-block(l, assigns + [list: body]), true), k)
+      { rev-tmp-binds; rev-assigns } = 
+        for fold({ tmp-binds-acc; assigns-acc } from { [list: ]; [list: ] }, b from binds):
+          if A.is-a-blank(b.b.ann) or A.is-a-any(b.b.ann):
+            new-assign = A.s-assign(b.l, b.b.id, b.value)
+            { tmp-binds-acc; link(new-assign, assigns-acc) }
+          else:
+            tmp-name-id = mk-id(b.l, "letrec_ann").id
+            b-with-tmp = A.s-bind(b.b.l, b.b.shadows, tmp-name-id, b.b.ann)
+            new-bind = A.s-let-bind(b.l, b-with-tmp, b.value)
+            new-assign = A.s-assign(b.l, b.b.id, A.s-id(b.l, tmp-name-id))
+            { link(new-bind, tmp-binds-acc); link(new-assign, assigns-acc) }
+          end
+        end
+      inner-let = A.s-let-expr(l, rev-tmp-binds.reverse(), 
+        A.s-block(l, rev-assigns.reverse() + [list: body]), true)
+      anf(A.s-let-expr(l, undef-inits, inner-let, false), k)
 
     | s-data-expr(l, data-name, data-name-t, params, mixins, variants, shared, _check-loc, _check) =>
       fun anf-member(member :: A.VariantMember):
@@ -299,7 +312,7 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr:
       anf(A.s-let-expr(l, bindings, A.s-id(l, name.id), false), k)
 
     | s-lam(l, name, params, args, ret, doc, body, _, _, _) =>
-      if A.is-a-blank(ret) or A.is-a-any(ret):
+      if ret.is-ignorable():
         k(N.a-lam(l, name, args.map(lam(a): N.a-bind(a.l, a.id, a.ann) end), ret, anf-term(body)))
       else:
         temp = mk-id(l, "ann_check_temp")
@@ -309,7 +322,7 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr:
                 A.s-id(l, temp.id), false))))
       end
     | s-method(l, name, params, args, ret, doc, body, _, _, _) =>
-      if A.is-a-blank(ret) or A.is-a-any(ret):
+      if ret.is-ignorable():
         k(N.a-method(l, name, args.map(lam(a): N.a-bind(a.l, a.id, a.ann) end), ret, anf-term(body)))
       else:
         temp = mk-id(l, "ann_check_temp")

lang/src/arr/compiler/resolve-scope.arr

@@ -1328,19 +1328,26 @@ fun resolve-names(p :: A.Program, thismodule-uri :: String, initial-env :: C.Com
             cases(Option) maybe-uri block:
               | none => # path must be a single element if there's no URI of a remote module
                         # e.g. provide: D end   NOT    provide: M.D end
-                data-expr = datatypes.get-value-now(path.first.toname())
-                maybe-add(provided-datatypes, data-expr.name, {l; none; data-expr.namet})
-                data-checker-name = A.make-checker-name(data-expr.name)
-                data-checker-vb = val-env.get-value(data-checker-name)
-                maybe-add(provided-values, data-checker-name, {l; none; data-checker-vb.atom})
-                data-alias-tb = type-env.get-value(data-expr.name)
-                maybe-add(provided-types, data-expr.name, {l; none; data-alias-tb.atom})
-                for each(v from data-expr.variants) block:
-                  variant-vb = val-env.get-value(v.name)
-                  checker-name = A.make-checker-name(v.name)
-                  variant-checker-vb = val-env.get-value(checker-name)
-                  maybe-add(provided-values, v.name, {l; none; variant-vb.atom})
-                  maybe-add(provided-values, checker-name, {l; none; variant-checker-vb.atom})
+
+                data-expr = datatypes.get-now(path.first.toname())
+                cases(Option) data-expr block:
+                  | some(shadow data-expr) =>
+                    maybe-add(provided-datatypes, data-expr.name, {l; none; data-expr.namet})
+                    data-checker-name = A.make-checker-name(data-expr.name)
+                    data-checker-vb = val-env.get-value(data-checker-name)
+                    maybe-add(provided-values, data-checker-name, {l; none; data-checker-vb.atom})
+                    data-alias-tb = type-env.get-value(data-expr.name)
+                    maybe-add(provided-types, data-expr.name, {l; none; data-alias-tb.atom})
+                    for each(v from data-expr.variants) block:
+                      variant-vb = val-env.get-value(v.name)
+                      checker-name = A.make-checker-name(v.name)
+                      variant-checker-vb = val-env.get-value(checker-name)
+                      maybe-add(provided-values, v.name, {l; none; variant-vb.atom})
+                      maybe-add(provided-values, checker-name, {l; none; variant-checker-vb.atom})
+                    end
+                  | none =>
+                    name-errors := link(C.unbound-id(A.s-id(l, A.s-name(l, path.last().toname()))), name-errors)
+                    { none; A.s-name(l, path.last().toname()) }
                 end
 
               | some(uri) =>

lang/src/arr/trove/ast.arr

@@ -1781,9 +1781,11 @@ data Ann:
   | a-blank with:
     method label(self): "a-blank" end,
     method tosource(self): str-any end,
+    method is-ignorable(self): true end,
   | a-any(l :: Loc) with:
     method label(self): "a-any" end,
     method tosource(self): str-any end,
+    method is-ignorable(self): true end,
   | a-name(l :: Loc, id :: Name) with:
     method label(self): "a-name" end,
     method tosource(self): self.id.tosource() end,
@@ -1848,10 +1850,13 @@ data Ann:
     method tosource(self): self.obj.tosource() + PP.str("." + self.field) end,
   | a-checked(checked :: Ann, residual :: Ann) with:
     method label(self): "a-checked" end,
-    method tosource(self): self.residual.tosource() end
+    method tosource(self): self.residual.tosource() end,
 sharing:
   method visit(self, visitor):
     self._match(visitor, lam(val): raise("No visitor field for " + self.label()) end)
+  end,
+  method is-ignorable(self):
+    false
   end
 end
 

lang/src/arr/trove/error.arr

@@ -718,18 +718,29 @@ data RuntimeError:
       else if src-available(self.loc):
         cases(O.Option) maybe-ast(self.loc):
           | some(ast) =>
-            shadow ast = cases(Any) ast:
-              | s-dot(_,_,_) => ast
-              | s-app(_,f,_) => f
+            if self.field == "load":
+              # load-table ... source: "..." end desugars to "...".load(...),
+              # so self.field is "load" and the pre-desugar AST is s-load-table.
+              [ED.error:
+                ed-intro("table loader expression", self.loc, -1, true),
+                ED.cmcode(self.loc),
+                [ED.para:
+                  ED.text("The source could not be loaded:")],
+                ED.embed(self.non-obj)]
+            else:
+              shadow ast = cases(Any) ast:
+                | s-dot(_,_,_) => ast
+                | s-app(_,f,_) => f
+              end
+              [ED.error:
+                ed-intro("field lookup expression", self.loc, -1, true),
+                ED.cmcode(self.loc),
+                [ED.para:
+                  ED.text("The "),
+                  ED.highlight(ED.text("left side"), [ED.locs: ast.obj.l], 0),
+                  ED.text(" was not an object:")],
+                ED.embed(self.non-obj)]
             end
-            [ED.error:
-              ed-intro("field lookup expression", self.loc, -1, true),
-              ED.cmcode(self.loc),
-              [ED.para:
-                ED.text("The "),
-                ED.highlight(ED.text("left side"), [ED.locs: ast.obj.l], 0),
-                ED.text(" was not an object:")],
-              ED.embed(self.non-obj)]
           | none =>
             [ED.error:
               ed-intro("field lookup expression", self.loc, -1, true),
@@ -2302,8 +2313,12 @@ data RuntimeError:
               else if src-available(loc):
                 cases(O.Option) maybe-ast(loc):
                   | some(ast) =>
-                    left-loc =  ast.left.l
-                    right-loc = ast.right.l
+                    {left-loc; right-loc} = cases(Any) ast:
+                      | s-op(_, _, _, left-expr, right-expr) =>
+                        {left-expr.l; right-expr.l}
+                      | s-app(_, _, args) =>
+                        {args.get(0).l; args.get(1).l}
+                    end
                     [ED.sequence:
                       ed-intro("equality comparison", loc, -1, true),
                       ED.cmcode(loc),

lang/src/scripts/run-phase

@@ -15,6 +15,16 @@ then
     exit 1
 fi
 
+VERBOSE=0
+if [ "$#" -gt 0 ] && [ "$1" = "-v" ]; then
+    VERBOSE=1
+    shift 1
+fi
+if [ "$#" -lt 1 ]; then
+  echo "Expecting 1 argument; received $#"
+  echo "Usage: $PHASE [-v] file.arr [args]"
+  exit 1
+fi
 PHASE="$SYMLINK_NAME"
 PYRET_JARR="build/$PHASE/pyret.jarr"
 FILE=$1
@@ -40,9 +50,16 @@ fi
 
 shift 1
 
-if [ "$#" -gt 0 ]
+if [ "$VERBOSE" = 1 ]
 then
-    $NODE $PYRET_JARR -no-display-progress --run $FILE - "$@"
+    PROGRESS_FLAG=""
 else
-    $NODE $PYRET_JARR -no-display-progress --run $FILE
+    PROGRESS_FLAG="-no-display-progress"
 fi
+
+if [ "$#" -gt 0 ]
+then
+    $NODE $PYRET_JARR $PROGRESS_FLAG --run $FILE - "$@"
+else
+    $NODE $PYRET_JARR $PROGRESS_FLAG --run $FILE
+fi

lang/src/scripts/show-compilation.arr

@@ -6,6 +6,7 @@ import parse-pyret as P
 import string-dict as SD
 import pprint as PP
 import pathlib as PL
+import render-error-display as RED
 import file("../../src/arr/compiler/desugar.arr") as D
 import file("../../src/arr/compiler/desugar-check.arr") as DC
 import ast as A
@@ -128,7 +129,18 @@ cases (C.ParsedArguments) parsed-options block:
         comp = cases(E.Either) compiled block:
           | left(v) =>
             println("Compilation failed")
-            {_; traces} = v
+            {loadables; traces} = v
+            errors = loadables
+              .filter(CL.is-error-compilation)
+              .map(_.result-printer)
+              .map(_.problems)
+              .foldr(_ + _, empty)
+
+            for each(err from errors) block:
+              println(to-repr(err))
+              println(RED.display-to-string(err.render-reason(), torepr, empty))
+            end
+
             traces.get-value-now(PL.basename(file, ""))
           | right(v) =>
             {_; traces} = v

lang/tests/pyret/regression/letrec-ann.arr

@@ -0,0 +1,7 @@
+check "https://github.com/brownplt/pyret-lang/issues/1700":
+  letrec n :: Number%(is-zero) = 10, is-zero = lam(x): x == 0 end: n end
+    raises "uninitialized-id"
+
+  letrec is-zero = lam(x): x == 0, n :: Number%(is-zero) = 10 end: n end
+    raises "type-mismatch"
+end

lang/tests/pyret/tests/test-modules.arr

@@ -481,3 +481,33 @@ end
   errs is%(error-with) "j"
 end
 
+check "https://github.com/brownplt/pyret-lang/issues/1790": 
+  m = make-fresh-module-testing-context() 
+  m.save-module("main.arr", ```
+provide:
+  data Foo
+end
+
+type Foo = {}
+```)
+
+  errs = m.compile-error-messages("main.arr")
+  errs is%(error-with) "Foo"
+end
+
+check "https://github.com/brownplt/pyret-lang/issues/1790": 
+  m = make-fresh-module-testing-context() 
+  m.save-module("main.arr", ```
+provide:
+  data Foo
+end
+
+data Bar:
+  | variant
+end
+```)
+
+  errs = m.compile-error-messages("main.arr")
+  errs is%(error-with) "Foo"
+end
+

vscode/.gitignore

@@ -3,3 +3,4 @@
 out
 dist
 node_modules
+build