gen-repl.stanza

;; See license.txt for details about licensing.

defpackage gen-repl :
  import core
  import collections
  import utils
  import stz/ids
  import stz/pkg
  import stz/tl-ir
  import stz/pl-ir
  import stz/kl-ir
  import stz/tgt-ir
  import stz/primitives

;; TODO: HANDLE AMBIGUOUS REFS WITH ANONYMOUS FUNCTION
;; TODO: HANDLE TARGS WITH ANONYMOUS FUNCTION

var stanza-dir = "Users/jrb/stanza"

defn pkg-pathname (build-name:String, pkg-name:Symbol) :
  ;; val stanza-dir = default<String>(get-env("STANZADIR"), "/Users/jrb/stanza")
  val path = if contains?(["clib", "core", "collections", "math", "reader", "stz/algorithms", "parser", "macro-utils"], to-string $ pkg-name) : string-join([stanza-dir "/pkgs"]) else : build-name
  val filename = replace(to-string $ pkg-name, '/', '$')
  string-join([path "/" filename ".pkg"])

defn visit-imports (s:OutputStream, build-name:String, pkg-name:Symbol) -> HashSet<Symbol> :
  ;; println-all(["IMPORT PKG-NAME " pkg-name])
  val pkg = load-package(pkg-pathname(build-name, pkg-name))
  val directs = HashSet<Symbol>()
  val symbols = HashSet<Symbol>()
  defn include-import? (imp:Symbol) :
    not (imp == `clib or (pkg-name == "core" and contains?([`collections `core], imp)) or (pkg-name == "collections" and contains?([`collections], imp)))
  for ipkg in imports(ids(pkg)) do :
    val imp = package(ipkg)
    add(directs, imp)
    if include-import?(imp) :
      val pkg-imported = load-package(pkg-pathname(build-name, imp))
      val excludes = HashSet<Symbol>()
      val my-symbols = HashSet<Symbol>()
      defn check-import (name:Symbol) :
        add(excludes, name) when symbols[name]
        add(my-symbols, name)
      for imp in declarations(ids(pkg-imported)) do :
        match(id(imp)) :
          (id:TypeId|LSTypeId|ValId|LSValId|VarId|LSVarId) :
            check-import(name(id)) when visibility(id) is Public
          (id) : false
      print(s, "  import %_" % [imp])
      for sym in my-symbols do :
        add(symbols, sym)
      if length(excludes) > 0 :
        println(s, " with:")
        for i in excludes do :
          println(s, "    prefix(%_) => @@" % [i])
      else :
        println(s, "")
  directs

defstruct FnEntry :
  fid:LSFnId|FnId|MultiId
  type-names:IntTable<Symbol>

defn include-type? (name:Symbol) :
  true 
  ;; not (pkg-name == "sob/core/pcb" and contains?([`Element, `Package], name)) and
  ;; not (pkg-name == "sob/core/jitpcb" and contains?([`Signal], name)) and
  ;; not (pkg-name == "sob/core/sob" and contains?([`Type `Pad], name))

defn print-type (s:OutputStream, var-name, type-name) :
  if include-type?(to-symbol $ var-name) :
    println(s, "  eval-add-frame-type-binding(frame, `%~, eval-Type(`%~ fn (x) : x is %~, fn (x): x as %~))" %
                 [var-name, var-name, type-name, type-name])

defn visit (s:OutputStream, build-name:String, pkg-name:Symbol, directs:HashSet<Symbol>,
            type-visited?:HashSet<Symbol>, visited?:HashSet<Symbol>, visible?:HashSet<Symbol>,
            fns:HashTable<Symbol, List<FnEntry>>) -> False :
  val type-names = IntTable<Symbol>()
  val pkg = load-package(pkg-pathname(build-name, pkg-name))
  ;; val direct? = directs[pkg-name]
  val direct? = true
  defn ref? (x) : x is RefT
  defn public-type? (tt) :
    match(tt) :
      (t:TOf):
        match(type(t)) :
          (tv:TGradual) : key?(type-names, n(t))
          (tv:TTuple) : key?(type-names, n(t)) and all?(public-type?, types(tv))
      (t:TOr): public-type?(a(t)) and public-type?(b(t))
      (t:TAnd): public-type?(a(t)) and public-type?(b(t))
      (t:TArrow): all?(public-type?, types(a(t) as TTuple)) and public-type?(b(t))
      (t:TTuple): all?(public-type?, types(t))
      (t:RefT): public-type?(type(t))
      (t) : true
  defn include-function? (fid:LSFnId|FnId|MultiId) :
    match(fid) :
      (lfid:LSFnId) :
         not contains?([`next-int], name(fid)) and
           length(targs(fid)) == 0 and all?(ref?, a1(fid)) and ref?(a2(fid)) and all?(public-type?, a1(fid)) and public-type?(a2(fid))
    (rfid:FnId|MultiId) :
      val res = true and ;; all?(public-type?, a1(fid)) and public-type?(a2(fid)) and
        not contains?([`min `max], name(fid)) and
        not contains?([`minimum, `maximum], name(fid))
      ;; print-all([" (A1 " a1(fid) " = " all?(public-type?, a1(fid)) " A2 " a2(fid) " = " public-type?(a2(fid)) ") "])
      res
  for ipkg in imports(ids(pkg)) do :
    val imp = package(ipkg)
    ;; if not visited?[imp] :
    ;;   add(visited?, imp)
    ;;   visit(s, imp, directs, visited?, visible?, fns)
    for imp in imports(ipkg) do :
      match(id(imp)) :
        (tid:TypeId|LSTypeId) :
          type-names[n(imp)] = name(tid)
        (id) : false
  for decl in declarations(ids(pkg)) do :
    ;; println-all(["CONSIDERING " decl])
    match(id(decl)) :
      (vid:ValId|VarId) :
        if direct? and visibility(id(decl)) is Public and not visited?[name(vid)] :
          add(visited?, name(vid))
          println(s, "  eval-add-frame-binding(frame, `%~, %~)" % [name(vid), name(vid)])
      (vid:LSValId) :
        if direct? and type(vid) is RefT and visibility(id(decl)) is Public and not visited?[name(vid)]  :
          add(visited?, name(vid))
          println(s, "  eval-add-frame-binding(frame, `%~, %~)" % [name(vid), name(vid)])
      (tid:TypeId|LSTypeId) :
        type-names[n(decl)] = name(tid)
        if visibility(id(decl)) is Public and direct? and not type-visited?[name(tid)]  :
          add(type-visited?, name(tid))
          print-type(s, name(tid), name(tid))
      (id) : false
  for decl in declarations(ids(pkg)) do :
    ;; println-all(["LOOKING AT " decl])
    match(id(decl)) :
      (fid:FnId|MultiId) :
        ;; println-all(["  D? " direct? " V? " visible?[name(fid)] " IF? " include-function?(fid) " VIS " visibility(id(decl))])
        if (direct? or visible?[name(fid)]) and include-function?(fid) and visibility(id(decl)) is Public :
          add(visible?, name(fid))
          fns[name(fid)] = cons(FnEntry(fid, type-names), get?(fns, name(fid), List()))
      (fid:LSFnId) :
        if (direct? or visible?[name(fid)]) and include-function?(fid) and visibility(id(decl)) is Public :
          add(visible?, name(fid))
          fns[name(fid)] = cons(FnEntry(fid, type-names), get?(fns, name(fid), List()))
      (id) : false
  false

defn dump (build-name:String, pkg-name:String) :
  val filename = replace(pkg-name, '/', '$')
  val s = FileOutputStream(string-join([build-name "/eval-" filename ".stanza"]))
  println-all(s, ["defpackage eval-" pkg-name ":"])
  println-all(s, ["  import eval with:"])
  println-all(s, ["     prefix => eval-"])
  val directs = visit-imports(s, build-name, to-symbol $ pkg-name)
  println-all(s, [""])
  println-all(s, ["defn fab-pkg () :"])
  print-all(s, ["  val pkg = eval-Package(`" pkg-name ", [])"])
  println-all(s, ["  val frame = eval-frame(pkg)"])
  println-all(s, ["  val env = List(frame)"])
  val fns = HashTable<Symbol, List<FnEntry>>()
  val visited? = HashSet<Symbol>()
  val type-visited? = HashSet<Symbol>()
  val visible? = HashSet<Symbol>()
  for direct in directs do :
    visit(s, build-name, to-symbol $ direct, directs, type-visited?, visited?, visible?, fns)
  defn extra-ids () :
    ["`core/KeyValue" => "core/KeyValue"
     "`core/Range" => "core/Range"
     "`core/Generator" => "fn (thunk) : core/Generator<?>(thunk)"
     "`core/dynamic-wind" => "core/dynamic-wind",
     "`core/LabeledScope" => "fn (thunk) : core/LabeledScope<?>(thunk)"
     "`core/LabeledScope*" => "LabeledScope*"
     "`core/with-attempt" => "core/with-attempt"
     "`core/with-finally" => "core/with-finally"
     "`core/with-exception-handler" => "core/with-exception-handler"
     "`core/throw" => "core/throw"
     "`core/with-resource" => "core/with-resource"
     "`core/find!" => "core/find!"
     "`core/find" => "core/find"
     ;; "`core/Equalable" => "core/Equalable"
     "`core/filter" => "core/filter"
     "`core/fatal" => "core/fatal"
     "`core/cons" => "core/cons"
     "`core/append" => "core/append"
     "`core/List" => "core/List"
     "to-symbol(\"true\")" => "true",
     "to-symbol(\"false\")" => "false"]
  defn extra-types () :
    ["core/True" => "True", "core/False" => "False",
     "Int" => "Int", "Float" => "Float", "Double" => "Double", "Char" => "Char", "String" => "String" ]
  defn type-str (type-names:IntTable<Symbol>, tt) :
    ;; println-all(["T = " tt])
    match(tt) :
      (t:TOf):
        match(type(t)) :
          (tv:TGradual) : type-names[n(t)]
          (tv:TTuple) : type-names[n(t)] when length(types(tv)) == 0 else ("($of %_ %,)" % [ type-names[n(t)], seq(type-str{type-names, _}, types(tv)) ])
      (t:TOr): "($or %_ %_)" % [type-str(type-names, a(t)) type-str(type-names, b(t))]
      (t:TAnd):
        if a(t) is TGradual|UnknownT|TUVar|TVar|TCap :
          type-str(type-names, b(t))
        else if b(t) is TGradual|UnknownT|TUVar|TVar|TCap :
          type-str(type-names, a(t))
        else :
          "($and %_ %_)" % [type-str(type-names, a(t)) type-str(type-names, b(t))]
      (t:TArrow): "($-> (%,) %_)" % [seq(type-str{type-names, _}, types(a(t) as TTuple)), type-str(type-names, b(t))]
      (t:TTuple): "($tuple %,)" % [seq(type-str{type-names, _}, types(t))]
      (t:RefT): type-str(type-names, type(t))
      ;; (t:TCap) : "($C)"
      ;; (t:TPoly) : "($P)"
      ;; (t:TMixed) : "($M)"
      ;; (t:TBot) : "($B)"
      (t) : "($?)"      
  defn args-str (n:Int) : "(%,)" % [for i in 0 to n seq : string-join([" a" i])]
  defn args-tops-str (n:Int) : "(%,)" % [for i in 0 to n seq : string-join([" a" i ":?"])]
  defn args-types-str (type-names:IntTable<Symbol>,types:List) : "(%,)" % [for (t in types, i in 0 to false) seq : "a%_:%_" % [i, type-str(type-names, t)]]
  defn targs-str (n:Int) : "" when n == 0 else ("<%,>" % [for i in 0 to n seq : "?"])
  ;; println-all(["TYPES " to-tuple $ values(type-names)])
  for kv in extra-ids() do :
    println(s, "  eval-add-frame-binding(frame, %_, %_)" % [key(kv), value(kv)])
  for kv in extra-types() do :
    print-type(s, to-symbol $ key(kv), to-symbol $ value(kv))
  val counter = to-seq(0 to false)
  defn output-fs (fname:Symbol, fs:List<FnEntry>) :
    val anon = symbol-join(["f-" next(counter)])
    println-all(s, ["  val " anon " = "])
    val arities = unique(lazy-qsort(seq({ length(a1(fid(_))) }, fs)))
    println(s, "    multifn:")
    for n in arities do :
      println(s, "      %_:" % [args-tops-str(n)])
        if n > 0 : 
          println(s, "        match%_ :" % [args-str(n)])
        for fe in fs do :
          val [f,type-names] = [fid(fe), type-names(fe)]
          if length(a1(f)) == n :
            if n == 0 :
              println(s, "        %_%_()" % [fname, targs-str(length(targs(f)))])
            else :
              println(s, "          %_ : %_%_%_" % [args-types-str(type-names, a1(f)), fname, targs-str(length(targs(f))), args-str(length(a1(f)))])
    anon
  for fs in fns do :
    val fe = head(value(fs))
    val fid = fid(fe)
    val ntargs = length(targs(fid))
    val arity = length(a1(fid))
    if length(value(fs)) > 1 :
      val fname = output-fs(name(fid), value(fs))
      println(s, "  eval-add-frame-binding(frame, `%~, %~)" % [name(fid), fname])
    else :
      if ntargs > 0 :
        println(s, "  eval-add-frame-binding(frame, `%~, fn %_ : %~%_%_)" % [name(fid), args-str(arity), name(fid), targs-str(ntargs), args-str(arity)])
      else :
        println(s, "  eval-add-frame-binding(frame, `%~, %~)" % [name(fid), name(fid)])
  
  println-all(s, ["  false"])
  println-all(s, [""])
  println-all(s, ["fab-pkg()"])
  close(s)

defn main () :
  val args = command-line-arguments()
  stanza-dir = args[2]
  dump(args[1], args[3])
  
main()