input.stanza

;See License.txt for details about licensing.

defpackage stz/input :
  import core
  import collections
  import stz/il-ir
  import stz/dl-ir
  import stz/visibility
  import stz/dump-to-log
  import stz/absolute-info
  import stz/timing-log-api
  import stz/list-to-tree

;============================================================
;======================= Timers =============================
;============================================================

val IL-IR = TimerLabel("IL-IR")
val READ-TO-IL = TimerLabel(IL-IR, suffix("Read to IL"))
val CHECK-IL = TimerLabel(IL-IR, suffix("Check IL"))

;============================================================
;======================== Driver ============================
;============================================================

public defn to-ipackages (form, base-dir:String|False, default-imports:Tuple<IImport>) -> Tuple<IPackage> :
  within log-time(IL-IR) :
    val e = within log-time(READ-TO-IL) :
      within with-base-dir(base-dir) :
        read-iexp(form)
    within log-time(CHECK-IL) :
      check(e,false)
    val packages = split-packages(process-nodocs(e), default-imports)
    ;do(dump{_, "logs"}, packages)
    packages

public defn to-il (form, allow-pure-expressions?:True|False) -> IExp :
  within log-time(IL-IR) :
    val e = within log-time(READ-TO-IL) :
      read-iexp(form)
    within log-time(CHECK-IL) :
      check(e, allow-pure-expressions?)
    process-nodocs(e)

;============================================================
;========== Exported Types from IPackage ====================
;============================================================

public defn exported-types (ps:Tuple<IPackage>) :
  val types = HashSet<TypeId>()
  for p in ps do :
    for e in seq-cat(top-level-exps, exps(p)) do :
      match(e:IDefType|ILSDefType) :
        add(types, TypeId(name(p), name!(e)))
  types

;============================================================
;===================== Base Directory =======================
;============================================================

;Fluid variable for base directory.
var BASE-DIR:String|False = false

;Use the given directory as the base directory.
;If dir is False, then add-base-dir returns false.
defn with-base-dir<?T> (body:() -> ?T, dir:String|False) -> T :
  let-var BASE-DIR = dir :
    body()

;If there is a base directory provided then return the AbsoluteFileInfo.
defn add-base-dir (info:FileInfo|False) -> AbsoluteFileInfo|False :
  match(info:FileInfo, BASE-DIR:String) :
    AbsoluteFileInfo(info, BASE-DIR)

;============================================================
;==================== Reader ================================
;============================================================

defn Begin (e:IExp, es:List<IExp>, info:False|AbsoluteFileInfo) :
   Begin(cons(e, es), info)

defn ScopeBegin (e:IExp, es:List<IExp>, info:False|AbsoluteFileInfo) :
   ScopeBegin(cons(e, es), info)

defn name-args (e:IExp) -> [IExp, List<IExp>] :
   match(e) :
      (e:IOf) : [class(e), args(e)]
      (e) : [e, List()]

defn ls-name-args (e:IExp) -> [IExp, List<IExp>] :
   match(e) :
      (e:ILSOfT) : [class(e), args(e)]
      (e) : [e, List()]

;Scope-level bodies include:
;  $defn, $defn*, $defmethod, $defmethod*, $fn, $fn*, $branch,
;  $ls-letexp, $ls-block, $ls-let, $ls-branch,
;  $ls-defn, $ls-extern-fn, $ls-defn*, $ls-defmethod, $ls-defmethod*,
#with-added-syntax(stz-reader-lang) :
   defreader read-iexp (e) -> IExp :
      ;Package Forms
      ($package name:e imports:e ...) :
         IDefPackage(name, imports, add-base-dir(info))
      ($import name:e prefixes:e ...) :
         IImportExp(name, false, prefixes, add-base-dir(info))
      ($forward name:e prefixes:e ...) :
         IImportExp(name, true, prefixes, add-base-dir(info))
      ($prefix-of (names:e ...) p:e) :
         IPrefixExp(names, p, add-base-dir(info))
      ($prefix p:e) :
         IPrefixExp(false, p, add-base-dir(info))
      ($only (names:e ...)) :
         IImportList(names, add-base-dir(info))
      ($public e:e es:e ...) :
         val es* = Begin(e, es, add-base-dir(info))
         IVisibility(es*, Public, add-base-dir(info))
      ($protected e:e es:e ...) :
         val es* = Begin(e, es, add-base-dir(info))
         IVisibility(es*, Protected, add-base-dir(info))
      ($private e:e es:e ...) :
         val es* = Begin(e, es, add-base-dir(info))
         IVisibility(es*, Private, add-base-dir(info))
      ;Stanza Declaration Forms
      ($doc string:e) :
        IDoc(string, add-base-dir(info))
      ($nodoc e:e) :
        INoDoc(e, add-base-dir(info))
      ($deftype name:e parent:e children:e ...) :
         val [name*, args*] = name-args(name)
         IDefType(name*, args*, parent, children, add-base-dir(info))
      ($defchild name:e parent:e) :
         val [name*, args*] = name-args(name)
         IDefChild(name*, args*, parent, add-base-dir(info))
      ($def name:e type:e value:e) :
         IDef(name, type, value, add-base-dir(info))
      ($defvar name:e type:e value:e) :
         IDefVar(name, type, value, add-base-dir(info))
      ($defn name:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [name*, targs*] = name-args(name)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         IDefn(false, name*, targs*, a1, a2, args, body, add-base-dir(info))
      ($defn* name:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [name*, targs*] = name-args(name)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         IDefn(true, name*, targs*, a1, a2, args, body, add-base-dir(info))
      ($defmulti name:e (a1:e ...) a2:e, (args:e ...)) :
         val [name*, targs*] = name-args(name)
         IDefmulti(name*, targs*, a1, a2, args, add-base-dir(info))
      ($defmethod name:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [name*, targs*] = name-args(name)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         IDefmethod(false, name*, false, targs*, a1, a2, args, body, add-base-dir(info))
      ($defmethod* name:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [name*, targs*] = name-args(name)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         IDefmethod(true, name*, false, targs*, a1, a2, args, body, add-base-dir(info))

      ;Argument specifiers
      ($optional name:e) :
         IOptional(name, add-base-dir(info))
      ($keyword name:e) :
         IKeyword(name, add-base-dir(info))
      ($optional-keyword name:e) :
         IOptionalKeyword(name, add-base-dir(info))
      ($rest name:e) :
         IRest(name, add-base-dir(info))

      ;Named arguments
      ($keywordarg name:e value:e) :
         IKeywordArg(name, value, add-base-dir(info))

      ;Stanza Expression Forms
      ($fn (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         IFn(false, a1, a2, args, body, add-base-dir(info))
      ($fn* (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         IFn(true, a1, a2, args, body, add-base-dir(info))
      ($multi f:e fs:e ...) :
         IMulti(cons(f, fs), add-base-dir(info))

      ($begin es:e ...) :
         Begin(es, add-base-dir(info))
      ($let e:e) :
         ILet(e, add-base-dir(info))
      ($match (es:e ...) bs:e ...) :
         IMatch(es, bs, add-base-dir(info))
      ($branch (args:e ...) (ts:e ...) body0:e bodyn:e ...) :
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         IBranch(ts, args, body, add-base-dir(info))
      ($new type:e methods:e ...) :
         INew(type, methods, add-base-dir(info))
      ($as exp:e type:e) :
         ICast(exp, type, add-base-dir(info))
      ($as? exp:e type:e) :
         IUpCast(exp, type, add-base-dir(info))
      ($set name:e exp:e) :
         ISet(name, exp, add-base-dir(info))
      ($do f:e args:e ...) :
         IDo(f, args, add-base-dir(info))
      ($prim f:e args:e ...) :
         IPrim(f, args, add-base-dir(info))
      ($tuple es:e ...) :
         ITuple(es, add-base-dir(info))
      ($quote v:?) :
         ILiteral(unwrap-all(v), INone(add-base-dir(info)), add-base-dir(info))
      ($none) :
         INone(add-base-dir(info))
      x :
         IVar(x, add-base-dir(info))
      v :
         ILiteral(v, INone(add-base-dir(info)), add-base-dir(info))

      ;Stanza Type Forms
      ($of name:e args:e ...) :
         IOf(name, args, add-base-dir(info))
      ($and a:e b:e) :
         IAnd(a, b, add-base-dir(info))
      ($or a:e b:e) :
         IOr(a, b, add-base-dir(info))
      ($-> (a1:e ...) a2:e) :
         IArrow(a1, a2, add-base-dir(info))
      ($cap x:e) :
         ICap(x, add-base-dir(info))
      ($void) :
         IVoid(add-base-dir(info))
      ($?) :
         IGradual(add-base-dir(info))

      ;LoStanza Expressions
      ($ls-new type:e args:e ...) :
         ILSNew(type, args, add-base-dir(info))
      ($ls-struct type:e args:e ...) :
         ILSStruct(type, args, add-base-dir(info))
      ($ls-addr exp:e) :
         ILSAddr(exp, false, add-base-dir(info))
      ($ls-addr! exp:e) :
         ILSAddr(exp, true, add-base-dir(info))
      ($ls-deref exp:e) :
         ILSDeref(exp, add-base-dir(info))
      ($ls-slot exp:e i:e) :
         ILSSlot(exp, i, add-base-dir(info))
      ($ls-field exp:e name:e) :
         ILSField(exp, name, add-base-dir(info))
      ($ls-do f:e args:e ...) :
         ILSDo(f, args, add-base-dir(info))
      ($ls-call-c f:e args:e ...) :
         ILSCallC(f, args, add-base-dir(info))
      ($ls-prim f:e args:e ...) :
         ILSPrim(f, args, add-base-dir(info))
      ($ls-sizeof type:e) :
         ILSSizeof(type, add-base-dir(info))
      ($ls-tagof name:e) :
         ILSTagof(name, add-base-dir(info))
      ($ls-as exp:e type:e) :
         ILSAs(exp, type, add-base-dir(info))
      ($ls-letexp e:e es:e ...) :
         val es* = flatten(cons(e, es))
         val empty = ScopeBegin(List(), add-base-dir(info))
         if empty?(es*) : ILSLetExp(empty, empty, add-base-dir(info))
         else : ILSLetExp(ScopeBegin(but-last(es*), add-base-dir(info)), last(es*), add-base-dir(info))
      ($ls-and a:e b:e) :
         ILSAnd(a, b, add-base-dir(info))
      ($ls-or a:e b:e) :
         ILSOr(a, b, add-base-dir(info))

      ;Commands
      ($ls-set x:e y:e) :
         ILSSet(x, y, add-base-dir(info))
      ($ls-labels blocks:e ...) :
         ILSLabels(blocks, add-base-dir(info))
      ($ls-block name:e (args:e ...) (ts:e ...) body0:e bodyn:e ...) :
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         ILSLabeledBlock(name, args, ts, body, add-base-dir(info))
      ($ls-goto name:e args:e ...) :
         ILSGoto(name, args, add-base-dir(info))
      ($ls-return e:e) :
         ILSReturn(e, add-base-dir(info))
      ($ls-let c:e cs:e ...) :
         val c* = ScopeBegin(c, cs, add-base-dir(info))
         ILSLet(c*, add-base-dir(info))
      ($ls-if p:e c:e a:e) :
         ILSIf(p, c, a, add-base-dir(info))
      ($ls-match (args:e ...) bs:e ...) :
         ILSMatch(args, bs, add-base-dir(info))
      ($ls-branch (args:e ...) (ts:e ...) body0:e bodyn:e ...) :
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         ILSBranch(ts, args, body, add-base-dir(info))
      ($ls-func x:e) :
         ILSFn(x, add-base-dir(info))

      ;Declarations
      ($ls-def name:e type:e exp:e) :
         ILSDef(name, type, exp, add-base-dir(info))
      ($ls-defvar name:e type:e exp:e) :
         ILSDefVar(name, type, exp, add-base-dir(info))
      ($ls-deffield mut:e type:e name:e) :
         ILSDefField(mut, type, name, add-base-dir(info))
      ($ls-deftype name:e parent:e (fs:e ...) fr:e) :
         val [name*, args*] = ls-name-args(name)
         ILSDefType(name*, args*, parent, fs, fr, add-base-dir(info))
      ($ls-defn name:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [name*, targs*] = ls-name-args(name)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         ILSDefn(false, name*, targs*, a1, a2, args, body, add-base-dir(info))
      ($ls-extern-fn name:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         ILSExternFn(name, a1, a2, args, body, add-base-dir(info))
      ($ls-defn* name:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [name*, targs*] = ls-name-args(name)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         ILSDefn(true, name*, targs*, a1, a2, args, body, add-base-dir(info))
      ($ls-defmethod multi:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [multi*, targs*] = ls-name-args(multi)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         ILSDefmethod(false, multi*, targs*, a1, a2, args, body, add-base-dir(info))
      ($ls-defmethod* multi:e (args:e ...) (a1:e ...) a2:e body0:e bodyn:e ...) :
         val [multi*, targs*] = ls-name-args(multi)
         val body = ScopeBegin(body0, bodyn, add-base-dir(info))
         ILSDefmethod(true, multi*, targs*, a1, a2, args, body, add-base-dir(info))
      ($ls-extern name:e type:e) :
         ILSExtern(name, type, add-base-dir(info))

      ;Types
      ($ls-byte) :
         ILSByteT(add-base-dir(info))
      ($ls-int) :
         ILSIntT(add-base-dir(info))
      ($ls-long) :
         ILSLongT(add-base-dir(info))
      ($ls-float) :
         ILSFloatT(add-base-dir(info))
      ($ls-double) :
         ILSDoubleT(add-base-dir(info))
      ($ls-?) :
         ILSUnknownT(add-base-dir(info))
      ($ls-of name:e args:e ...) :
         ILSOfT(name, args, add-base-dir(info))
      ($ls-ptr t:e) :
         ILSPtrT(t, add-base-dir(info))
      ($ls-ref t:e) :
         ILSRefT(t, add-base-dir(info))
      ($ls-fn (a1:e ...) ar:e a2:e) :
         ILSFnT(a1, ar, a2, add-base-dir(info))

;============================================================
;===================== Process INoDoc =======================
;============================================================

;In the given code:
;
;  doc: "myfunc"
;  nodoc: defn f ...
;  defn g ...
;
;The doc string should be pushed inwards to be right in front of
;'defn g' instead of in front of 'defn f'. This function pushes
;doc strings past 'nodoc' forms to the next applicable form.
;Handles nesting 'begin' and 'ivisibility' forms properly.

;Process all nodoc forms.
;Top-level docs are pushed past their nodoc expressions.
;Nested nodocs are removed.
defn process-nodocs (e:IExp) -> IExp :
  IBegin?(map(remove-nodoc, push-doc-past-nodoc(e)))  

;Process the input expression to remove all INoDoc forms
;and push IDoc forms past INoDoc forms.
defn push-doc-past-nodoc (input-expression:IExp) -> List<IExp> :

  ;Accumulate expressions and doc forms.
  val exp-items = Vector<ListItem<IExp>>()
  val doc-items = Vector<IDoc>()

  ;Loop through expression and emit ListItem into buffer.
  defn* loop (e:IExp) :
    match(e) :
      (e:IBegin) :
        do(loop, exps(e))
      (e:IVisibility) :
        add(exp-items, ListStart<IExp>(sub-exps{e, _}))
        loop(exp(e))
        add(exp-items, ListEnd<IExp>())
      (e:IDoc) :
        add(doc-items, e)
      (e:INoDoc) :
        add(exp-items, ListAtom<IExp>(exp(e)))
      (e) :
        for d in doc-items do :
          add(exp-items, ListAtom<IExp>(d))
        add(exp-items, ListAtom<IExp>(e))
        clear(doc-items)
  loop(input-expression)
  for d in doc-items do :
    add(exp-items, ListAtom<IExp>(d))

  ;Return IExps.
  process-items(exp-items)

;Remove any occurrences of nodoc form in expression.
defn remove-nodoc (e:IExp) -> IExp :
  match(e) :
    (e:INoDoc) : remove-nodoc(exp(e))
    (e) : map(remove-nodoc, e)

;Create an IBegin when necessary.
defn IBegin? (es:List<IExp>) -> IExp :
  if length(es) == 1 : head(es)
  else : IBegin(es, info(head(es)))

;Substitute the expressions in the given IVisibility exp.
defn sub-exps (v:IVisibility, es:List<IExp>) -> IVisibility :
  IVisibility(IBegin?(es), visibility(v), info(v))

;============================================================
;================ Splitting into Packages ===================
;============================================================

;The category of expression for an expression.
;- PackageDocExp: The IDoc preceding a new defpackage expression.
;- DefPackageExp: The defpackage expression itself.
;- WithinPackageExp: Another expression that belongs within a package.
defenum IExpPackageCategory :
  PackageDocExp
  DefPackageExp
  WithinPackageExp

defn split-packages (e:IExp,
                     default-imports:Tuple<IImport>) :
  ;Flatten sequence of expressions.
  val all-exps = Vector<IExp>()
  let loop (e:IExp = e) :
    match(e:IBegin) : do(loop, exps(e))
    else : add(all-exps, e)

  ;Categorize all the expressions.
  val exp-categories = Vector<IExpPackageCategory>()
  for i in 0 to length(all-exps) do :
    if all-exps[i] is IDefPackage :
      exp-categories[i] = DefPackageExp
      if i > 0 and all-exps[i - 1] is IDoc :
        exp-categories[i - 1] = PackageDocExp
    else :
      exp-categories[i] = WithinPackageExp

  ;Helper: Given that the first expression for a package
  ;is at index 'index', return all the expressions in the package.
  ;Also returns the ending index (exclusive) for the package.
  defn package-exps (index:Int) -> [List<IExp>, Int] :
    ;Find the ending index (exclusive) for this package.
    val end-index = for i in index to false find! :
      i >= length(all-exps) or
      exp-categories[i] != WithinPackageExp
    ;Retrieve all the expressions between index and end-index.
    val exps = to-list $ for i in index to end-index seq :
      all-exps[i]
    ;Return both the expressions and the end index.
    [exps, end-index]

  ;Group packages
  val packages = Vector<IPackage>()
  let loop (i:Int = 0) :
    if i < length(all-exps) :
      switch(exp-categories[i]) :
        ;Package with preceding IDoc form.
        PackageDocExp:
          val doc = all-exps[i] as IDoc
          val e = all-exps[i + 1] as IDefPackage
          val [exps, end] = package-exps(i + 2)
          val imports = to-tuple $ seq(to-iimport, imports(e) as List<IImportExp>)
          add(packages, IPackage(name!(e), doc, imports, [], exps, info(e)))
          loop(end)

        ;Package without preceding IDoc form.
        DefPackageExp:
          val e = all-exps[i] as IDefPackage
          val [exps, end] = package-exps(i + 1)
          val imports = to-tuple $ seq(to-iimport, imports(e) as List<IImportExp>)
          add(packages, IPackage(name!(e), false, imports, [], exps, info(e)))
          loop(end)

        ;Default package.
        WithinPackageExp:
          val [exps, end] = package-exps(i)
          val info = info(head(exps)) when not empty?(exps)
          val name = gensym(`default)
          add(packages, IPackage(name, false, default-imports, [], exps, info))
          loop(end)

  ;Return packages
  to-tuple(packages)

defn to-iimport (e:IImportExp) -> IImport :
  defn to-iprefix (e:IPrefixExp) :
    val names = match(names(e)) :
      (ns:List<IExp>) : to-tuple(seq(name!, ns))
      (ns:False) : false
    val prefix = to-string(name!(prefix(e)))
    IPrefix(names, prefix)
  val package = name!(package(e))
  val prefix = to-tuple $ seq(to-iprefix, filter-by<IPrefixExp>(directives(e)))
  ; Flatten all "only" directives into a single set
  val only-set =
    if any?({_ is IImportList}, directives(e)) :
      to-tuple $ to-hashset<Symbol> $
        for o in filter-by<IImportList>(directives(e)) seq-cat :
          seq(name!, names(o))      
  IImport(package, forward(e), only-set, prefix, info(e))

;============================================================
;================= Syntax Restrictions ======================
;============================================================

;                      Checker
;                      =======

#with-added-syntax(stz-check-lang) :
   public defcheck check (e:IExp,
                          allow-pure-top-level-expressions?:True|False) :
      ;======== Stanza Language ========
      pe("package level form") :
         IDefPackage:
            {name:v imports:(imp ...)}
            custom{ensure-unique-imports(e)}
         ILoadPackage: ()
         IBegin: {exps:(pe ...)}
         + te

      imp("import form") :
         IImportExp: {package:v directives:(pr ...)}

      pr("directive form") :
         IPrefixExp :
            if (names(e) is False) : {prefix:v}
            else : {names:(v ...) prefix:v}
         IImportList :
            {names:(v ...)}

      te("top level form") :
         IVisibility: {exp:te}
         IDoc:
            custom{ensure-doc-string(string(e))}
         INoDoc: {exp:te}           
         IDefType :
            {class:v args:(v ...) parent:pt? children:(dc ...)}
            custom{ensure-wellformed-children(e)}
         IDefmulti :
            {name:v targs:(targ ...) a1:(ct? ...) a2:t? args:(arg ...)}
            custom{ensure-ordered-targs(targs(e))}
            custom{ensure-capturing-position(targs(e), a1(e))}
         IDefmethod :
            {multi:v targs:(targ ...) a1:(ct? ...) a2:t? args:(arg ...) body:se}
            custom{ensure-no-this-param(e)}
            custom{ensure-ordered-targs(targs(e))}
            custom{ensure-matched-a1-args(info(e), a1(e), args(e))}
            custom{ensure-capturing-position(targs(e), a1(e))}
         IBegin: {exps:(te ...)}
         + tse
         + ltc
      tse("top level form") :
         + se*
         custom{
           if not allow-pure-top-level-expressions? :
             ensure-impure(e)}

      dc("type child form") :
         IDefChild: {name:v args:(v ...) parent:cpt}
      cpt("child parent type") :
         IOf: {class:v args:(t ...)}
         IVar: ()

      se("scope level form") :
         + se*
         custom{ensure-body(e)}
      se*("scope level form") :
         INoDoc: {exp:se*}
         IDef: {name:b type:t? value:e}
         IDefVar: {name:v type:t? value:e?}
         IDefn :
            {name:v targs:(targ ...) a1:(ct? ...) a2:t? args:(arg ...) body:se}
            custom{ensure-matched-a1-args(info(e), a1(e), args(e))}
            custom{ensure-ordered-targs(targs(e))}
            custom{ensure-capturing-position(targs(e), a1(e))}
         IBegin: {exps:(se*, se* ...)}
         + e

      e("expression") :
         ILet: {exp:se}
         IMulti:
           {funcs:(func func ...)}
           custom{ensure-unique-arities(funcs(e))}
         IBegin: {exps:(e e ...)}
         IMatch :
            {args:(e e ...) branches:(br br ...)}
            custom{ensure-branch-arity(e)}
         INew: {class:pt methods:(m ...)}
         IVar: ()
         ICast: {exp:e type:t}
         IUpCast: {exp:e type:t}
         ISet: {name:v value:e}
         IDo: {func:farg args:(arge ...)}
         IPrim: {op:v, args:(e ...)}
         ILiteral: custom{ensure-literal(e)}
         ITuple: {exps:(e ...)}
         + func

      arge("argument expression") :
         IKeywordArg: {name:v, value:e}
         + e

      e?("optional expression") :
         INone: ()
         + e

      func("function expression") :
         IFn :
            {a1:(t? ...) a2:t? args:(b ...) body:se}
            custom{ensure-matched-a1-args(info(e), a1(e), args(e))}

      farg("function argument") :
         IOf: {class:v args:(t ...)}
         + e

      br("branch expression") :
         IBranch :
            {types:(t? t? ...) args:(b b ...) body:se}
            custom{ensure-matched-a1-args(info(e), types(e), args(e))}

      m("method expression") :
         IDefmethod :
            {multi:v targs:(targ ...) a1:(ct? ...) a2:t? args:(arg ...) body:se}
            custom{ensure-matched-a1-args(info(e), a1(e), args(e))}
            custom{ensure-this-param(e)}
            custom{ensure-ordered-targs(targs(e))}
            custom{ensure-capturing-position(targs(e), a1(e))}

      arg("argument specifier") :
         IOptional: {name:b}
         IKeyword: {name:v}
         IOptionalKeyword: {name:v}
         IRest: {name:v}
         + b

      b("binder expression") :
         IVar: ()
         ITuple: {exps:(b ...)}

      pt("parent type") :
         IOf: {class:v args:(t ...)}
         IAnd: {a:pt b:pt}
         IVar: ()

      pt?("optional parent type") :
         INone: ()
         + pt

      ct("type") :
         IOf: {class:v args:(ct ...)}
         IAnd: {a:ct b:ct}
         IOr: {a:ct b:ct}
         IArrow: {a1:(ct ...) a2:ct}
         ICap: {name:v}
         IGradual: ()
         IVoid: ()
         IVar: ()
         ITuple: {exps:(ct ...)}

      ct?("optional type") :
         INone: ()
         + ct

      t("type") :
         + ct
         custom{ensure-no-cap(e)}
      t?("optional type") :
         INone: ()
         + t

      v("symbol") :
         IVar : ()

      targ("type argument") :
         ICap: {name:v}
         IVar: ()

      mut?("mutability field") :
         ILiteral : custom{ensure-boolean(e)}

      ldf("lostanza deffield") :
         ILSDefField: {mut:mut? name:v type:lt}

      ldf?("optional lostanza deffield") :
         INone: ()
         + ldf

      ;======== LoStanza Language ========
      ltc("LoStanza top level command") :
         + ltc*
         custom{ensure-no-return(e)}
      ltc*("LoStanza top level command") :
         IBegin: {exps:(ltc* ...)}
         ILSDef: {name:v type:lt exp:le}
         ILSDefVar: {name:v type:lt exp:le?}
         ILSDefType :
            {name:v args:(v ...) parent:t? fields:(ldf ...) rfield:ldf?}
         ILSExtern: {name:v type:lt}
         ILSDefn :
            {name:v targs:(targ ...) a1:(lct ...) a2:lt args:(larg ...) body:lc}
            custom{ensure-matched-a1-args(info(e), a1(e), args(e))}
            custom{ensure-ordered-targs(targs(e))}
            custom{ensure-return(body(e))}
            custom{ensure-capturing-position(targs(e), a1(e))}
         ILSExternFn :
            {name:v a1:(lt ...) a2:lt args:(v ...) body:lc}
            custom{ensure-return(body(e))}
         ILSDefmethod :
            {multi:v targs:(targ ...) a1:(lct ...) a2:lt args:(larg ...) body:lc}
            custom{ensure-matched-a1-args(info(e), a1(e), args(e))}
            custom{ensure-ordered-targs(targs(e))}
            custom{ensure-return(body(e))}
            custom{ensure-capturing-position(targs(e), a1(e))}

         ILSSet: {exp:lval value:le}
         ILSLet: {comm:lc}
         ILSLabels:
            {blocks:(blk ...)}
            custom{ensure-entry-block(info(e), blocks(e))}
         ILSIf: {pred:le conseq:lc alt:lc}
         ILSMatch: {args:(le le ...) branches:(lbr lbr ...)}
         + lcalls

      rf("LoStanza rest field") :
         INone: ()
         IVar: ()

      blk("LoStanza labeled block") :
         ILSLabeledBlock:
            {name:v args:(v ...) types:(lt ...) body:lc}
            custom{ensure-matched-a1-args(info(e), types(e), args(e))}

      lc("LoStanza command") :
         IBegin: {exps:(lc ...)}
         INoDoc: {exp:lc}
         ILSDef: {name:v type:lt? exp:le}
         ILSDefVar: {name:v type:lt exp:le?}
         ILSSet: {exp:lval value:le}
         ILSLet: {comm:lc}
         ILSIf: {pred:le conseq:lc alt:lc}
         ILSMatch: {args:(le le ...) branches:(lbr lbr ...)}
         ILSLabels:
            {blocks:(blk ...)}
            custom{ensure-entry-block(info(e), blocks(e))}
         ILSGoto: {name:v, args:(le ...)}         
         ILSReturn: {exp:le}         
         + lcalls

      lbr("LoStanza branch") :
         ILSBranch:
            {types:(lbt? ...) args:(v ...) body:lc}
            custom{ensure-matched-a1-args(info(e), types(e), args(e))}

      le("LoStanza expression") :
         ILSNew: {type:lclass args:(le ...)}
         ILSStruct: {type:lclass args:(le ...)}
         ILSAddr: {exp:lval}
         ILSDeref: {exp:lderef}
         ILSSlot: {exp:lderef index:le}
         ILSField: {exp:le name:v}
         ILSSizeof: {type:lt}
         ILSTagof: {name:v}
         ILSAs: {exp:le type:lt}
         ILSAnd: {a:le, b:le}
         ILSOr: {a:le, b:le}
         ILSLetExp: {comm:lc, exp:le}
         ILSFn: {ref:v}
         IVar: ()
         ILiteral: custom{ensure-ls-literal(e)}
         + lcalls
      lcalls("LoStanza call") :
         ILSDo: {func:ltfarg args:(large ...)}
         ILSPrim: {op:v args:(le ...)}
         ILSCallC: {func:lfarg args:(le ...)}

      large("LoStanza argument expression") :
         IKeywordArg: {name:v, value:le}
         + le

      ltfarg("LoStanza parameterized function argument") :
         ILSOfT: {class:v args:(t ...)}
         + lfarg

      lfarg("LoStanza function") :
         ILSDeref: {exp:lderef}
         ILSLetExp: {comm:lc, exp:lfarg}
         IVar: ()

      le?("optional LoStanza expression") :
         INone: ()
         + le

      lval("LoStanza lvalue expression") :
         IVar: ()
         ILSDeref: {exp:lderef}
         ILSSlot: {exp:lderef index:le}
         ILSField: {exp:le name:v}

      lderef("LoStanza dereference expression") :
         ILSAddr: {exp:lval}
         ILSNew: {type:lclass args:(le ...)}
         ILSDeref: {exp:lderef}
         ILSSlot: {exp:lderef index:le}
         ILSField: {exp:le name:v}
         ILSAs: {exp:lderef type:lt}
         ILSLetExp: {comm:lc, exp:lderef}
         IVar: ()
         + lcalls

      lclass("LoStanza object type") :
         ILSOfT: {class:v, args:(t ...)}
         IVar: ()

      larg("LoStanza argument specifier") :
         IOptional: {name:v}
         IKeyword: {name:v}
         IOptionalKeyword: {name:v}
         IRest: {name:v}
         + v

      lct("LoStanza argument type") :
         ILSByteT: ()
         ILSIntT: ()
         ILSLongT: ()
         ILSFloatT: ()
         ILSDoubleT: ()
         ILSUnknownT: ()
         ILSOfT: {class:v args:(ct ...)}
         ILSPtrT: {type:lct}
         ILSRefT: {type:ct}
         ILSFnT: {a1:(lt ...) ar:lt? a2:lct}
         IVar: ()
      lt("LoStanza type") :
         + lct
         custom{ensure-no-cap(e)}
      lt?("optional LoStanza type") :
         INone: ()
         + lt
      lbt?("LoStanza branch type") :
         ILSRefT: {type:t}
         INone: ()

defn var? (e:IExp, s:Symbol) :
   match(e) :
      (e:IVar) : name(e) == s
      (e) : false

;                   Error Checkers
;                   ==============

defn ensure-no-cap (e:IExp) :
   match(e) :
      (e:ICap) : stz/check-lang-engine/error!(info(e), "Capture variable ?%_ cannot be used in this context." % [name(e)])
      (e) : do(ensure-no-cap, e)

defn ensure-wellformed-children (e:IDefType) :
   if parent(e) is INone :
      for c in children(e) do :
         match(c) :
            (c:IDefChild) :
               val p = match(parent(c)) :
                  (p:IVar) : p
                  (p:IOf) : class(p)
                  (p) : false
               match(p, class(e)) :
                  (p:IVar, c:IVar) :
                     if name(p) != name(c) :
                        stz/check-lang-engine/error!(info(e), "Child declaration for type %_ cannot have %_ as specified parent." % [
                           class(e), p])
                  (p, c) : false
            (c) : false
   else if not empty?(children(e)) :
      stz/check-lang-engine/error!(info(e), "Type with parent cannot have child type declarations.")

defn ensure-ordered-targs (es:List<IExp>) :
   defn loop* (es:List<IExp>) :
      if not empty?(es) :
         match(head(es)) :
            (e:ICap) :
               if not all?({_ is ICap}, es) :
                  stz/check-lang-engine/error!(info(e), "Capture variables must appear after all explicit type arguments.")
            (e) : loop*(tail(es))
   loop*(es)

defn ensure-capturing-position (targs:List<IExp>, a1:List<IExp>) :
   defn captures? (x:Symbol, e:IExp) :
      match(e) :
         (e:ICap) : var?(name(e), x)
         (e) : any?(captures?{x, _}, subexps(e))
   defn ensure-captured? (info:False|AbsoluteFileInfo, x:Symbol) :
      val captured? = any?(captures?{x, _}, a1)
      if not captured? :
         stz/check-lang-engine/error!(info, "Captured type argument %_ has no capturing position." % [x])

   val cargs = filter({_ is ICap}, targs) as Seqable<ICap>
   for a in cargs do :
      val v = name(name(a) as IVar)
      ensure-captured?(info(a), v)

defn ensure-matched-a1-args (info:False|AbsoluteFileInfo, a1:List<IExp>, args:List<IExp>) :
   if length(a1) != length(args) :
      stz/check-lang-engine/error!(info, "The number of argument types do not match the number of arguments.")

defn ensure-no-this-param (e:IDefmethod) :
   if any?(var?{_, `this}, args(e)) :
      stz/check-lang-engine/error!(info(e), "Top level method cannot have a this argument.")

defn ensure-this-param (e:IDefmethod) :
   val n = count(var?{_, `this}, args(e))
   if n == 0 :
      stz/check-lang-engine/error!(info(e), "Instance method requires a this argument.")
   else if n > 1 :
      stz/check-lang-engine/error!(info(e), "Instance method cannot have multiple this arguments.")

defn pure-expression? (e:IExp) :
   e is IFn|IMulti|INew|IVar|ILiteral|ITuple

defn ensure-impure (e:IExp) :
   if pure-expression?(e) :
      stz/check-lang-engine/error!(info(e), "Expression %~ has no effect and is invalid in this context." % [e])

defn ensure-body (e:IExp) :
  ;Return flattened expressions, skipping nodoc forms.
  defn flattened-exps (e:IExp) :
    generate<IExp> :
      let loop (e:IExp = e) :
        match(e) :
          (e:IBegin) : do(loop, exps(e))
          (e:INoDoc) : loop(exp(e))
          (e) : yield(e)

  val es = flattened-exps(e)
  if empty?(es) :
    stz/check-lang-engine/error!(info(e), "No expressions in body.")
  else :
    let loop () :
      val e = next(es)
      ;Case: Last expression.
      if empty?(es) :
        if e is IDef|IDefVar|IDefn :
          stz/check-lang-engine/error!(info(e), "Declaration cannot be last expression in body.")
      ;Case: Not last expression.
      else :
        ensure-impure(e)
        loop()

defn ensure-branch-arity (e:IMatch) :
   val bs = branches(e) as List<IBranch>
   val n = length(args(e))
   for b in bs do :
      if length(args(b)) != n :
         stz/check-lang-engine/error!(info(b), "The number of branch arguments does not match number of arguments given to match.")

defn ensure-unique-imports (ipackage: IDefPackage) :
  ;Each entry, package => info, means that the package 'package' was already
  ;imported on line 'info'.
  val import-table = HashTable<Symbol,AbsoluteFileInfo|False>()

  for i in imports(ipackage) do :
    val name = package?(i)
    match(name:Symbol) :
      if key?(import-table,name) :
        ;Create the sentence describing where it was previously imported.
        val prev-info = import-table[name]
        val info-str =
          match(prev-info:AbsoluteFileInfo) : " It was previously imported at %_." % [/info(prev-info)]
          else : " It has already been imported."
        val msg = "Cannot import the package '%~' again.%_"
        stz/check-lang-engine/error!(info(i), msg % [name, info-str])        
      else :
        import-table[name] = info(i)

;Helper: Return the name of the package in IImportExp.
;If the expression is malformed then returns false.
defn package? (e:IExp) -> Symbol|False :
  match(e:IImportExp) :
    match(package(e)) :
      (p:IVar) : name(p)
      (p) : false

defn ensure-doc-string (e:IExp) :
   match(e) :
     (e:ILiteral) :
       if value(e) is-not String :
         stz/check-lang-engine/error!(info(e), "Doc String %~ is not a valid Stanza String." % [value(e)])
     (e) :
       stz/check-lang-engine/error!(info(e), "Doc String %~ is not a valid Stanza Literal String." % [e])

defn ensure-literal (e:ILiteral) :
   defn lit? (v) :
      match(v) :
         (v:Byte|Char|Int|Long|Float|Double|String|Symbol|True|False) : true
         (v:List) : all?(lit?, v)
         (v) : false
   if not lit?(value(e)) :
      stz/check-lang-engine/error!(info(e), "Value %~ is not a valid Stanza literal." % [value(e)])

defn ensure-no-return (body:IExp) :
   match(body) :
      (body:ILSDefn|ILSDefmethod|ILSExternFn) :
         false
      (body:ILSReturn) :
         stz/check-lang-engine/error!(info(body), "Invalid return statement in top level context.")
      (body) :
         do(ensure-no-return, body)

defn ensure-return (exp:IExp) :
   ;Apply function for every body in e
   defn do-last (f: IExp -> ?, e:IExp) :
      match(e) :
         (e:IBegin) :
            if empty?(exps(e)) : f(e)
            else : do-last(f, last(exps(e)))
         (e:ILSLet) :
            do-last(f, comm(e))
         (e:ILSLabels) :
            val bs = filter({_ is ILSLabeledBlock}, blocks(e))
            for b in bs as Seq<ILSLabeledBlock> do :
               do-last(f, body(b))
         (e:ILSIf) :
            do-last(f, conseq(e))
            do-last(f, alt(e))
         (e:ILSMatch) :
            val bs = filter({_ is ILSBranch}, branches(e))
            for b in bs as Seq<ILSBranch> do :
               do-last(f, body(b))
         (e) : f(e)

   ;Check last statement
   for e in exp do-last :
      match(e) :
         (e:ILSReturn|ILSGoto) : false
         (e) : stz/check-lang-engine/error!(info(e), "Return statement expected here for end of function body.")

defn ensure-entry-block (info:False|AbsoluteFileInfo, bs:List<IExp>) :
   if not empty?(bs) :
      match(head(bs)) :
         (b:ILSLabeledBlock) :
            if not empty?(args(b)) :
               stz/check-lang-engine/error!(info, "First block in labeled scope cannot take arguments.")
         (b) : false

defn ensure-ls-literal (e:ILiteral) :
   defn lit? (v) :
      v is Byte|Char|Int|Long|Float|Double|String|True|False
   if not lit?(value(e)) :
      stz/check-lang-engine/error!(info(e), "Value %~ is not a valid LoStanza literal." % [value(e)])

defn ensure-boolean (e:ILiteral) :
   if value(e) is-not True|False :
      stz/check-lang-engine/error!(info(e), "Value %~ is not a boolean." % [value(e)])

defn ensure-unique-arities (es:List<IExp>) :
   if all?({_ is IFn}, es) :
      val es = es as List<IFn>
      val arity-set = IntSet()
      for e in es do :
         val arity = length(a1(e))
         if not add(arity-set, arity) :
            val msg = "Multifn requires functions with different arities. There are \
                       multiple functions with arity %_." % [arity]
            stz/check-lang-engine/error!(info(e), msg)