
#CMD meth Vec "access" len "return length of the Vec" TYPE Num NAME _len PARAMS 
#CMD meth Vec "access" at: "get element at index a, modulo length of Vec" TYPE Pro NAME at_ PARAMS {Num a}
#CMD meth Vec "access" at:put:  "put element b at given a, modulo length of Vec" TYPE void NAME at_put_ PARAMS {Num a} { Pro b}
#CMD meth Vec "access" append:,ap: "add new element ato end of Vec" TYPE void NAME append_ PARAMS {Pro a}


#new JavaMeth(terp.tObj, "equals:", "") {
#  public Obj apply(Frame f, Pro r, Pro[] args) {
#    assert args.length == 1;
#    return r.equals(args[0]) ? terp.instTrue : terp.instFalse;
#  }
#};


proc wrap {file} {
  set f [open $file]
  while {[gets $f line] >= 0} {
    if [regexp {^// =(.*)} [string trim $line] - cmd] {
      puts stderr "Triggers on <$line>"
      while {[gets $f line2] >= 0} {
        if [regexp {^//(.*)} [string trim $line2] - cmd2] {
          append cmd " $cmd2"
        } else {
          break
        }
      }

      set verb [lindex $cmd 0]
      puts stderr "Verb is <$verb>"
      puts stderr "Cmd is <$cmd>"

      if {$verb == "meth"} {
        puts stderr "Got meth."

        set cls [lindex $cmd 1]
        set group [lindex $cmd 2]
        set kws [lindex $cmd 3]
        set remark [lindex $cmd 4]

        set kw [split $kws ","]
        set kw0 [lindex $kw 0]
        set kw1 [lindex $kw 1]

        set decl $line2
        while {[gets $f line3] >= 0} {
          append decl " " $line3
          if [regexp {\}$} [string trim $line3] - cmd2] {
            break
          }
        }
        #gets $f line3
        #gets $f line4
        #set decl "$line2 $line3 $line4"
        if [regexp {\s*public\s+(static\s+)?(\w+)\s+(\w+)\s*[(]([^{}]*)[)]} $decl - static type name params] {
           set pp [split $params ","]
           puts "    // CMD $cmd TYPE $type NAME $name PARAMS $pp"
           puts "    // CLS $cls GROUP \"$group\" METH $kws REMARK \"$remark\""
	   puts ""
	   # puts "new JavaMeth(terp.t$cls, \"$kw0\", \"$kw1\"# #"
	   puts "    new JavaMeth(terp.wrap.wrap$cls, \"$kw0\", \"$kw1\") {"
	   puts "      public Pro apply(Frame f, Pro r, Pro\[\] args) {"
	   if [string match *Cls $cls] {
	     if ![string match static* $static] {error "Should be static"}
	     set call "[string range $cls 0 end-3].$name (terp"  ;# Drop the trailing Cls.
	     set pp [lrange $pp 1 end]  ;# Pop off Terp.
	     set comma ","
	   } else {
	     if {$static != ""} {error "Should not be static"}
	     puts "      $cls self = ($cls) r;"
	     set call "self.$name ("
	     set comma ""
	   }
	   set i 0
	   foreach p $pp {
	     set atype [lindex $p 0]
	     set aname [lindex $p 1]
	     append call "$comma"
	     set c [format "%c" [expr 97+$i]]
             if {$atype eq "String"} {
               # Special String case.
	       puts "        Str $c = (Str) args\[$i\];"
	       append call "$c.str"
             } elseif {$atype eq "int"} {
               # Special int case.
	       puts "        Num $c = (Num) args\[$i\];"
	       append call "$c.toNearestInt()"
             } elseif {$atype eq "double"} {
               # Special double case.
	       puts "        Num $c = (Num) args\[$i\];"
	       append call "$c.num"
             } else {
               # Normal TerseTalk types.
	       puts "        $atype $c = ($atype) args\[$i\];"
	       append call "$c"
             }
	     incr i
	     set comma ", "
	   }
	   append call ")"
	   if {$type == "void"} {
	     puts "        $call;"
	     puts "        return self;"
	   } elseif {$type == "String"} {
	     puts "        String z = $call;"
	     puts "        return (z == null) ? terp.instNil : terp.newStr(z);"
	   } elseif {$type == "int"} {
	     puts "        return terp.newNum($call);"
	   } elseif {$type == "double"} {
	     puts "        return terp.newNum($call);"
	   } else {
	     puts "        return $call;"
	   }
	   puts "      }"
	   puts "    };"
	   puts ""
        } else {
          error "Did not find public meth pattern for <$decl>."
        }


      } elseif {$verb == "cls"} {
        set category [lindex $cmd 1]
        set cls [lindex $cmd 2]
        set supercls [lindex $cmd 3]
        set instvars [lindex $cmd 4]
        set vv [split $instvars ","]

        append ::slots [subst {
  public Cls wrap${cls}Cls;
  public Cls wrap${cls};
        }]

        if [string length $supercls] {
          append ::installClasses [subst {
    this.wrap${cls}Cls = terp.clss.get("[string tolower ${cls}Cls]");
    if (this.wrap${cls}Cls == null) {
      this.wrap${cls}Cls = new Cls(terp.tMetaclsCls, terp, "${cls}Cls", this.wrap${supercls}Cls);
    }
    this.wrap$cls      = terp.clss.get("[string tolower $cls]");
    if (this.wrap$cls == null) {
      this.wrap${cls} = new Cls(this.wrap${cls}Cls, terp, "${cls}", this.wrap${supercls});
    }
          }]
	}

        if [llength $vv] {
            append ::installClasses [subst {
    this.wrap${cls}.eval("self defineInstanceVars: '$vv'");
            }]
	}

      } else {
        error "Dont understand method decl <$decl> after <$cmd>"
      }
    }
  }
}

puts "package terse.vm;

import java.util.Arrays;
import java.util.HashMap;
import java.util.ArrayList;
import java.util.regex.Pattern;

import terse.vm.Cls.JavaMeth;
import terse.vm.Cls.StrMeth;
import terse.vm.Expr.Seq;
import terse.vm.Expr.Send;
import terse.vm.Terp.Frame;

import terse.vm.Pro.Blk;
import terse.vm.Pro.Buf;
import terse.vm.Pro.Dict;
import terse.vm.Pro.Undefined;
import terse.vm.Pro.Num;
import terse.vm.Pro.Obj;
import terse.vm.Pro.Str;
import terse.vm.Pro.Sys;
import terse.vm.Pro.Vec;
import terse.vm.Usr.Tmp;

public class Wrap extends Static \{

  public void installMethods(final Terp terp) \{

"

wrap Pro.java

puts "
  \}
"

puts "
  public void installClasses(final Terp terp) {
    wrapProCls = terp.tProCls;
    wrapPro = terp.tPro;

    $::installClasses
  }
  $::slots
"

puts "
\}
"
