(module Object-composite mzscheme
  
  (require (lib "class.ss")
           (prefix c: (lib "contract.ss"))
           (lib "errortrace-lib.ss" "errortrace")
           (lib "Comparable.ss" "profj" "libs" "java" "lang")
           (lib "Serializable.ss" "profj" "libs" "java" "io"))
  (require "compile-lang-syntax.ss")    
  
  ;Runtime needed code
  (define (javaRuntime:convert-to-string data)
    (cond
      ((number? data) (make-java-string (number->string data)))
      ((boolean? data) 
       (make-java-string (if data "true" "false")))
      ((char? data) (make-java-string (string data)))
      ((is-a? data ObjectI) (send data toString))
      ((is-a? data object%) (make-java-string "SchemeObject"))
      (else (error 'JavaRuntime:Internal_Error:convert-to-string
                   (format "Convert to string given unsupported data: ~s" data)))))
  
  
;                                            
;         ;;         ;                       
;    ;;;   ;                            ;    
;   ;   ;  ;                            ;    
;   ;   ;  ;;;;   ;;;;    ;;;    ;;;   ;;;;; 
;   ;   ;  ;   ;     ;   ;   ;  ;   ;   ;    
;   ;   ;  ;   ;     ;   ;;;;;  ;       ;    
;   ;   ;  ;   ;     ;   ;      ;       ;    
;   ;   ;  ;   ;     ;   ;   ;  ;   ;   ;   ;
;    ;;;  ; ;;;      ;    ;;;    ;;;     ;;; 
;                    ;                       
;                    ;                       
;                 ;;;                        

  ;Object.java
  (provide ObjectI Object-Mix Object
           wrap-convert-assert-Object convert-assert-Object guard-convert-Object dynamic-Object/c static-Object/c)
  
  ;Object interface, and a mixin to create objects from.
  
  (define ObjectI
    (interface () Object-constructor clone equals-java.lang.Object finalize getClass
      hashCode notify notifyAll toString wait wait-long wait-long-int my-name
      equals hash-code to-string get-class))
  
  (define Object-Mix
    (lambda (parent)
      (class* parent (ObjectI)
        (inspect #f)
        (define/public (Object-constructor) (void))
        
        ;Needs to do something
        (define/public clone (lambda () void))
        
        (define/public (equals-java.lang.Object obj) (eq? this obj))
        (define/public (equals obj) (send this equals-java.lang.Object obj))
        
        ;Needs to do something
        (define/public (finalize) void)
        
        (public-final getClass get-class)
        (define (getClass)
          (error 'ProfessorJ:getClass 
                 (format "ProfessorJ does not support getClass calls. ~e" 
                         (send this toString))))
        (define (get-class) (getClass))
        
        (define/public (hashCode) (eq-hash-code this))
        (define/public (hash-code) (send this hashCode))
        
        ;Needs to do something when Threads more implemented
        (public-final notify |notifyAll|)
        (define (notify) void)
        (define (notifyAll) void)
        
        (define/public (my-name) "Object")
        (define/public (toString)
          (make-java-string (format "~a@~a" (send this my-name) (send this hashCode))))
        (define/public (to-string) (send this toString))
        
        (public-final wait wait-long wait-long-int)
        (define wait (lambda () void))
        (define wait-long (lambda (l) void))
        (define wait-long-int (lambda (l i) void))

        (define/public (field-names) null)
        (define/public (field-values) null)
        
        (define/public (fields-for-display)
          (let ((field-name-list (send this field-names))
                (field-value-list (send this field-values)))
            (lambda ()
              (if (null? field-name-list) 
                  #f
                  (begin0 (list (car field-name-list) (car field-value-list))
                          (set! field-name-list (cdr field-name-list))
                          (set! field-value-list (cdr field-value-list)))))))
        
        (super-instantiate ()))))
  
  (define Object (Object-Mix object%))
  
  (define (wrap-convert-assert-Object obj p n s c)
    (if (string? obj)
        (make-java-string string)
        (begin
          (c:contract (c:object-contract
                       (clone (c:-> c:any/c))
                       (equals-java.lang.Object (c:-> c:any/c c:any/c))
                       (finalize (c:-> c:any/c))
                       (getClass (c:-> c:any/c))
                       (hashCode (c:-> c:any/c))
                       (notify (c:-> c:any/c))
                       (notifyAll (c:-> c:any/c))
                       (toString (c:-> c:any/c))
                       (wait (c:-> c:any/c))
                       (wait-long (c:-> c:any/c c:any/c))
                       (wait-long-int (c:-> c:any/c c:any/c c:any/c))) obj p n s)
          (make-object convert-assert-Object obj p n s c))))
  
  (define convert-assert-Object
    (class object%
      
      (init w p n s c)
      (define-values (wrapped pos-blame neg-blame src cc-marks) (values null null null null null))
      (set! wrapped w)
      (set! pos-blame p)
      (set! neg-blame n)
      (set! src s)
      (set! cc-marks c)
      
      (define/public (clone) (send wrapped clone))        
      (define/public (equals-java.lang.Object obj)
        (let ((val (send wrapped equals-java.lang.Object 
                         (make-object guard-convert-Object obj pos-blame neg-blame src cc-marks))))
          (unless (boolean? val)
            (raise (make-exn:fail (string->immutable-string
                                   (format "~a broke ~a contract here; Object's equals expects boolean return, given ~a"
                                           pos-blame neg-blame val)) cc-marks)))
          val))
              
      (define/public (finalize) (send wrapped finalize))
      (define/public (getClass) (send wrapped getClass))

      (define/public (hashCode) 
        (let ((val (send wrapped hashCode)))
          (unless (integer? val)
            (raise (make-exn:fail (string->immutable-string
                                   (format "~a broke ~a contract here; Object's hashCode expects int return, given ~a"
                                           pos-blame neg-blame val)) cc-marks)))
          val))
      
      (define/public (notify) (send wrapped notify))
      (define/public (notifyAll) (send wrapped notifyAll))
      (define/public (toString)
        (let ((val (send wrapped toString)))
          (unless (string? val)
            (raise (make-exn:fail (string->immutable-string
                                   (format "~a broke ~a contract here: Object's toString expects String return, given ~a"
                                           pos-blame neg-blame val)) cc-marks)))
          (make-java-string val)))
      (define/public (wait) (send wrapped wait))
      (define/public (wait-long l) (send wrapped wait-long l))
      (define/public (wait-long-int l i) (send wrapped wait-long l i))
      (define/public (my-name) (send wrapped my-name))
      (define/public (field-names) (send wrapped field-names))
      (define/public (field-values) (send wrapped field-values))        
      (define/public (fields-for-display) (send wrapped fields-for-display))
      (super-instantiate ())))
  
  (define dynamic-Object/c
    (c:flat-named-contract "Object" (lambda (v) (is-a? v convert-assert-Object))))
     
  (define guard-convert-Object
    (class object%
      
      (init w p n s c)
      (define-values (wrapped pos-blame neg-blame src cc-marks) (values null null null null null))
      (set! wrapped w)
      (set! pos-blame p)
      (set! neg-blame n)
      (set! src s)
      (set! cc-marks s)
      
      (define/public (clone) (send wrapped clone))
      (define/public (equals-java.lang.Object . obj)
        (unless (= (length obj) 1)
          (raise (make-exn:fail:contract:arity
                  (string->immutable-string
                   (format "~a broke ~a contract here: Object's equals expects to be called with 1 argument, given ~n"
                           pos-blame neg-blame (length obj))) cc-marks)))
        (send wrapped equals-java.lang.Object (wrap-convert-assert-Object (car obj) pos-blame neg-blame src cc-marks)))
      (define/public (equals . obj)
        (unless (= (length obj) 1)
          (raise (make-exn:fail:contract:arity
                  (string->immutable-string
                   (format "~a broke ~a contract here: Object's equals expects to be called with 1 argument, given ~n"
                           pos-blame neg-blame (length obj))) cc-marks)))
        (send wrapped equals-java.lang.Object (wrap-convert-assert-Object (car obj) pos-blame neg-blame src cc-marks)))
      (define/public (finalize) (send wrapped finalize))
      (define/public (getClass) (send wrapped getClass))
      (define/public (get-class) (send wrapped getClass))
      (define/public (hashCode) (send wrapped hashCode))
      (define/public (hash-code) (send wrapped hashCode))
      (define/public (notify) (send wrapped notify))
      (define/public (notifyAll) (send wrapped notifyAll))
      (define/public (notify-all) (send wrapped notifyAll))        
      (define/public (toString)
        (send (send wrapped toString) get-mzscheme-string))
      (define/public (to-string) (send (send wrapped toString) get-mzscheme-string))
      (define/public (wait) (send wrapped wait))
      (define/public (wait-long . l)
        (unless (= (length l) 1)
          (raise (make-exn:fail:contract:arity
                  (string->immutable-string
                   (format "~a broke ~a contract here: Object's wait-long expects to be called with 1 argument, given ~n"
                           pos-blame neg-blame (length l))) cc-marks)))
        (unless (integer? (car l))
          (raise (make-exn:fail 
                  (string->immutable-string
                   (format "~a broke ~a contract here: Object's wait that takes a long argument expected long, given ~a"
                           pos-blame neg-blame (car l))) cc-marks)))
        (send wrapped wait-long (car l)))
      (define/public (wait-long-int . l) 
        (unless (= (length l) 2)
          (raise (make-exn:fail:contract:arity
                  (string->immutable-string
                   (format "~a broke ~a contract here: Object's wait-long-int expects to be called with 2 arguments, given ~n"
                           pos-blame neg-blame (length l))) cc-marks)))
        (unless (integer? (car l))
          (raise (make-exn:fail 
                  (string->immutable-string
                   (format "~a broke ~a contract here: Object's wait-long-int expected long, given ~a"
                           pos-blame neg-blame (car l))) cc-marks)))
        (unless (integer? (cadr l))
          (raise (make-exn:fail 
                  (string->immutable-string
                   (format "~a broke ~a contract here: Object's wait-long-int expected int, given ~a"
                           pos-blame neg-blame (cadr l))) cc-marks)))                
        (send wrapped wait-long (car l) (cadr l)))
      (define/public (my-name) (send wrapped my-name))
      (define/public (field-names) (send wrapped field-names))
      (define/public (field-values) (send wrapped field-values))        
      (define/public (fields-for-display) (send wrapped fields-for-display))
      (super-instantiate ())))
  
  (define static-Object/c
    (c:flat-named-contract "Object" (lambda (v) (is-a? v guard-convert-Object))))  
      
;                                     
;                                     
;   ;;;                               
;     ;                               
;    ; ;   ; ;;;  ; ;;;  ;;;;  ;;; ;;;
;    ; ;    ;      ;         ;  ;   ; 
;   ;;;;;   ;      ;      ;;;;  ;   ; 
;   ;   ;   ;      ;     ;   ;   ; ;  
;   ;   ;   ;      ;     ;   ;   ;;;  
;  ;;; ;;; ;;;;   ;;;;    ;;; ;   ;   
;                                 ;   
;                                 ;   
;                               ;;    

  ;;array implementation:
  (provide make-java-array is-java-array? make-runtime-type array->list)
  
  (define java-array
    (class* Object ()
      (inspect #f)
      (define array null)
      (define rt #f)
      (define/public (get-rt) rt)
      
      (define/private (check-runtime-type val)
        (if (<= (runtime-type-dim rt) 1)
            (if (symbol? (runtime-type-type rt))
                (case (runtime-type-type rt)
                  ((byte short int long) (and (number? val) (not (inexact? val))))
                  ((char) (char? val))
                  ((float double) (and (number? val) (inexact? val))))
                (is-a? val (runtime-type-type rt)))
            (and
             (is-a? val java-array)
             (= (sub1 (runtime-type-dim rt))
                (runtime-type-dim (send val get-rt)))
             (eq? (runtime-type-type rt) (runtime-type-type (send val get-rt))))))
      
      (define/public (check-prim-type type dim)
        (and (eq? (runtime-type-type rt) type)
             #;(= dim (runtime-type-dim rt))))
      (define/public (check-ref-type type dim)
        (and (eq? (runtime-type-type rt) type)
             #;(= dim (runtime-type-dim rt))))
      
      (define/private (default-val) 
        (if (and (= 1(runtime-type-dim rt)) (symbol? (runtime-type-type rt)))
            (case (runtime-type-type rt)
              ((byte short int long float double) 0)
              ((char) #\null)
              ((boolean) #f))
            null))

      (define/public (length) (vector-length array))
      
      (define/private (array-out-of-bounds i)
        (raise (create-java-exception ArrayIndexOutOfBoundsException
                                      (format "Array index out of bounds. Range is 0 to ~a, given ~a"
                                              (sub1 (vector-length array)) i)
                                      (lambda (obj msg)
                                        (send obj ArrayIndexOutOfBoundsException-constructor-java.lang.String msg))
                                      (current-continuation-marks))))
      
      (define/public (access index) 
        (when (or (< index 0) (>= index (length)))
          (array-out-of-bounds index))
        (vector-ref array index))
      
      (define/public (set index val)
        (when (or (< index 0) (>= index (length)))
          (array-out-of-bounds index))
        (if (check-runtime-type val)
            (vector-set! array index val)
            (raise (create-java-exception ArrayStoreException
                                          "Array given incompatible type"
                                          (lambda (obj msg) 
                                            (send obj ArrayStoreException-constructor-java.lang.String msg))
                                          (current-continuation-marks)))))
                                        
      (define/public (make-uninitialized size type)
        (when (< size 0)
          (raise (create-java-exception NegativeArraySizeException
                                        (format "Size for the array must be greater than 0, given ~a" size)
                                        (lambda (obj msg)
                                          (send obj NegativeArraySizeException-constructor-java.lang.String msg))
                                        (current-continuation-marks))))
        (set! rt type)
        (set! array (make-vector size (default-val))))
      
      (define/public (make-initialized type vals)
        (set! rt type)
        (set! array (list->vector vals)))
      
      (define/public (make-multi-dimension type size default-val)
        (set! rt type)
        (set! array (make-vector size default-val)))
      
      (define/public (make-uninit-multi type sizes)
        (set! rt type)
        (set! array 
              (if (null? (cdr sizes))
                  (make-vector (car sizes) (default-val))
                  (let ((vec (make-vector (car sizes))))
                    (let loop ((idx 0))
                      (unless (>= idx (car sizes))
                        (vector-set! vec idx (make-java-array (make-runtime-type (runtime-type-type type)
                                                                                 (sub1 (runtime-type-dim type)))
                                                              (cdr sizes) null))
                        (loop (add1 idx))))
                    vec))))
      
      (define/override (my-name) "array")
      
      (super-instantiate ())))
  
  (define (make-java-array type size vals)
    (let ((array (make-object java-array)))
      (cond
        ((list? size) (send array make-uninit-multi type size))
        ((null? vals) (send array make-uninitialized size type))
        ((list? vals) (send array make-initialized type vals))
        (else (send array make-multi-dimension type size vals)))
      array))
  
  (define (is-java-array? obj) (is-a? obj java-array))
  
  (define-struct runtime-type (type dim) (make-inspector))
  
  (define (array->list array start stop)
    (if (= start stop)
        null
        (cons (send array access start)
              (array->list array (add1 start) stop))))
  
  
;                                            
;                          ;                 
;    ;;;;   ;                                
;   ;   ;   ;                                
;   ;      ;;;;;  ; ;;;  ;;;   ; ;;;    ;;; ;
;   ;;;     ;      ;       ;    ;;  ;  ;   ; 
;     ;;;   ;      ;       ;    ;   ;  ;   ; 
;       ;   ;      ;       ;    ;   ;  ;   ; 
;   ;   ;   ;   ;  ;       ;    ;   ;  ;   ; 
;   ;;;;     ;;;  ;;;;   ;;;;; ;;;  ;;  ;;;; 
;                                          ; 
;                                          ; 
;                                       ;;;  

  ;;String.java
  (provide make-java-string String String-valueOf-java.lang.Object String-valueOf-char1 
           String-valueOf-char1-int-int String-copyValueOf-char1-int-int String-copyValueOf-char1
           String-valueOf-boolean String-valueOf-char String-valueOf-int String-valueOf-long 
           String-valueOf-float String-valueOf-double)
  
  (define (make-java-string s)
    (let ((obj (make-object String)))
      (send obj make-mzscheme-string s)
      obj))
  
  (define String
    (class* Object (Comparable Serializable)

      (inspect #f)
      ;private field containing scheme string
      (define text "")
      ;Accessor for scheme string
      (define/public (get-mzscheme-string) text)
      
      ;Constructors
      (define/public (String-constructor) (send this Object-constructor))      

      (define/public (String-constructor-java.lang.String string)
        (send this Object-constructor)
        (set! text (send string get-mzscheme-string)))    
      
      (define/public (String-constructor-char1 chars)
        (send this Object-constructor)
        (set! text (list->string (array->list chars 0 (send chars length)))))
    
      (define/public (String-constructor-char1-int-int chars offset count)
        (send this Object-constructor)
        (set! text (list->string (array->list chars offset count))))
    
      ;Does not take into account char-set: PROBLEM
      (define/public (String-constructor-byte1-int-int-java.lang.String ascii offset len char-set)
        (send this Object-constructor)
        (set! text (list->string (map integer->char (array->list ascii offset len)))))
      (define/public (|String-constructor-byte1-java.lang.String| ascii char-set)
        (send this Object-constructor)
        (set! text (list->string (map integer->char (array->list ascii 0 (send ascii length))))))
    
      ;currently broken until I figure out how to deal appropriately with hi bytes
      (define/public (String-constructor-byte1-int-int-int ascii hi offset count)
        (send this Object-constructor))
      (define/public (String-constructor-byte1-int ascii hi)
        (send this Object-constructor))
    
      (define/public (String-constructor-StringBuffer buffer)
        (send this Object-constructor)
        (set! text (substring (send (send buffer toString) get-mzscheme-string)
                              0 
                              (send buffer length))))
    
      ;Constructor to use when a string is constructed by ""
      (define/public (make-mzscheme-string str)
        (send this Object-constructor)
        (set! text str))
      
      (define/override (toString) this)
    
      ; -> int
      (define/public (length) (string-length text))
      ; int -> char
      (define/public  (charAt-int index) (string-ref text index))
      (define/public (char-at i) (charAt-int i))
    
      ;-> void
      (define/public (getChars-int-int-char1-int begin end dest i)
        (letrec ((build-char-array
                  (lambda (offset index)
                    (if (= offset end)
                        (void)
                        (begin
                          (send dest set index (string-ref text offset))
                          (build-char-array (add1 offset) (add1 index)))))))
          (build-char-array begin i)))
      (define/public (get-chars b e d i) (getChars-int-int-char1-int b e d i))
    
      ;Does not mess with charset
      (define/public (getBytes)
        (letrec ((array (make-java-array (make-runtime-type 'byte) (length) null))
                 (build-byte-array
                  (lambda (index)
                    (if (= index (length))
                        array
                        (begin
                          (send array set index (char->integer (string-ref text index)))
                          (build-byte-array (add1 index)))))))
          (build-byte-array 0)))
      (define/public (getBytes-java.lang.String charset)
        (getBytes))
    
      (define/public (getBytes-int-int-byte1-int begin end dest i)
        (letrec ((build-byte-array
                  (lambda (offset index)
                    (if (= offset end)
                        (void)
                        (begin
                          (send dest set index (char->integer (string-ref text offset)))
                          (build-byte-array (add1 offset) (add1 index)))))))
          (build-byte-array begin i)))

      (define/public (contentEquals-java.lang.StringBuffer buf)
        (equals-java.lang.Object (send buf toString)))
      (define/public (content-equals b) (contentEquals-java.lang.StringBuffer b))
    
      ;Object -> boolean
      (define/override (equals-java.lang.Object obj)
        (and (is-a? obj String)
             (equal? text (send (send obj toString) get-mzscheme-string))))
      
      ;Object -> boolean
      (define/public (equalsIgnoreCase-java.lang.String str)
        (string-ci=? text (send str get-mzscheme-string)))
      (define/public (equals-ignore-case s) (equalsIgnoreCase-java.lang.String s))

      ;find-diff-chars: int int string-> (values int int)
      (define/private (find-diff-chars i stop-length compare-string)
        (if (>= i stop-length)
            (values #f #f)
            (if (not (equal? (string-ref text i) (string-ref compare-string i)))
                (values (char->integer (string-ref text i)) (char->integer (string-ref compare-string i)))
                (find-diff-chars (add1 i) stop-length compare-string))))
      
      ;min: int int -> int
      (define/private (min x y)
        (cond
          ((= x y) x)
          ((< x y) x)
          (else y)))
      
      ;String -> int
      (define/public (compareTo-java.lang.String str)
        (let* ((string (send str get-mzscheme-string))
               (text-l (string-length text))
               (str-l (string-length string)))
          (cond
            ((equals-java.lang.Object str) 0)
            (else
             (let-values (((int-text int-str) (find-diff-chars 0 (min text-l str-l) string)))
               (if int-text
                   (- int-text int-str)
                   (- text-l str-l)))))))
  
      ;Object -> int: Throws ClassCastException
      (define/public (compareTo-java.lang.Object obj)
        (if (is-a? obj String)
            (compareTo-java.lang.String obj)
            (raise (create-java-exception ClassCastException
                                          (format "ClassCastException: Expected argument of class String given ~a"
                                                  (send (send obj toString) get-mzscheme-string))
                                          (lambda (obj msg) (send obj ClassCastException-constructor-String msg))
                                          (current-continuation-marks)))))
      
      ;String -> int
      (define/public (compareToIgnoreCase-java.lang.String str)
        (letrec ((string (send str get-mzscheme-string))
                 (find-diff-chars
                  (lambda (i)
                    (if (>= i (length text))
                        (error 'comparetostring "Opps, internal error")
                        (if (not (char-ci=? (string-ref text i) (string-ref string i)))
                            (values (char->integer (string-ref text i)) (char->integer (string-ref string i)))
                            (find-diff-chars (add1 i))))))
                 (text-l (string-length text))
                 (str-l (string-length string)))
          (cond
            ((equalsIgnoreCase-java.lang.String str) 0)
            ((string-ci<? text string) 
             (if (= text-l str-l)
                 (let-values (((int-text int-str) (find-diff-chars 0)))
                   (- int-text int-str))
                 (- text-l str-l)))                               
            ((string-ci>? text string) 
             (if (= text-l str-l)
                 (let-values (((int-text int-str) (find-diff-chars 0)))
                   (- int-text int-str))
                 (- text-l str-l))))))
      (define/public (compare->ignore-case s) (compareToIgnoreCase-java.lang.String s))
    
      ;int String int int -> boolean
      (define/public (regionMatches-int-java.lang.String-int-int toffset jstr ooffset len)
        (let ((str (send jstr get-mzscheme-string)))
          (and (not (negative? toffset))
               (not (negative? ooffset))
               (<= (+ toffset len) (string-length text))
               (<= (+ ooffset len) (string-length str))
               (string=? (substring text toffset (+ toffset len)) 
                         (substring str ooffset (+ ooffset len))))))
    
      ;.... -> boolean
      (define/public (regionMatches-boolean-int-java.lang.String-int-int case? toffset jstr ooffset len)
        (let ((str (send jstr get-mzscheme-string)))
          (and (not (negative? toffset))
               (not (negative? ooffset))
               (<= (+ toffset len) (string-length text))
               (<= (+ ooffset len) (string-length str))
               ((if case? string=? string-ci=?) (substring text toffset (+ toffset len)) 
                (substring str ooffset (+ ooffset len))))))
    
      ; .... -> boolean
      (define/public (startsWith-java.lang.String-int Jprefix offset)
        (let ((prefix (send Jprefix get-mzscheme-string)))
          (and (not (negative? offset))
               (<= (+ offset (string-length prefix)) (string-length text))
               (string=? prefix (substring text offset (+ offset (string-length prefix)))))))
    
      ;..... -> boolean
      (define/public (startsWith-java.lang.String Jprefix)
        (let ((prefix (send Jprefix get-mzscheme-string)))
          (and (<= (string-length prefix) (string-length text))
               (string=? prefix (substring text 0 (string-length prefix))))))     
          
      (define/public (endsWith-java.lang.String Jsuffix)
        (let ((suffix (send Jsuffix get-mzscheme-string)))
          (and (<= (string-length suffix) (string-length text))
               (string=? suffix (substring text (- (string-length text) (string-length suffix)) (string-length text))))))
      (define/public (ends-with s) (endsWith-java.lang.String s))
      
      ; -> int
      (define/override (hashCode)
        (let ((hash 0))
          (let loop ([index 0])
            (unless (>= index (string-length text))
              (set! hash (+ hash (* (char->integer (string-ref text index)) 
                                    (expt 31 (- (string-length text) (add1 index))))))
              (loop (add1 index))))
          hash))
    
    ; character int -> int
    (define/private (find-char ch pos)
      (if (>= pos (string-length text))
          -1
          (if (char=? ch (string-ref text pos))
              pos
              (find-char ch (add1 pos)))))
      
      ;character int int -> int
      (define/private (find-last-char ch pos lpos)
        (if (>= pos (string-length text))
            lpos
            (if (char=? ch (string-ref text pos))
                (find-last-char ch (add1 pos) pos)
                (find-last-char ch (add1 pos) lpos))))
      
      ; string int -> int
      (define/private (find-str sch-str str pos)
        (if (> (+ pos (string-length sch-str)) (string-length text))
            -1
            (if (startsWith-java.lang.String-int str pos)
                pos
                (find-str sch-str str (add1 pos)))))
    
      ; string int int -> int
      (define/private (find-last-string sch-str str pos lpos)
        (if (> (+ pos (string-length sch-str)) (string-length text))
            lpos
            (if (startsWith-java.lang.String-int str pos)
                (find-last-string sch-str str (add1 pos) pos)
                (find-last-string sch-str str (add1 pos) lpos))))
    
      (define/public (indexOf-int ch) (find-char (if (number? ch) (integer->char ch) ch) 0))
      (define/public (indexOf-int-int ch offset) (find-char (if (number? ch) (integer->char ch) ch) offset))
      (define/public (indexOf-java.lang.String str) (find-str (send str get-mzscheme-string) str 0))    
      (define/public (indexOf-java.lang.String-int str offset) (find-str (send str get-mzscheme-string) str offset))
      
      (define/public (lastIndexOf-int ch) 
        (find-last-char (if (number? ch) (integer->char ch) ch) 0 -1))
      (define/public (lastIndexOf-int-int ch offset) 
        (find-last-char (if (number? ch) (integer->char ch) ch) offset -1))
      (define/public (lastIndexOf-java.lang.String str) (find-last-string (send str get-mzscheme-string) str 0 -1))
      (define/public (lastIndexOf-java.lang.String-int str offset) (find-last-string (send str get-mzscheme-string) str offset -1))
    
      ;int -> String
      (define/public (substring-int index) 
        (substring-int-int index (sub1 (string-length text))))
    
      ;... -> String
      (define/public (substring-int-int begin end)
        (when (< begin 0) 
          (raise (make-runtime-error 
                  (format "First argument to substring must be greater than 0, given ~a." begin))))
        (when (>= begin (string-length text))
          (raise (make-runtime-error
                  (format "First argument to substring must be smaller than the string's length ~a, given ~a." (string-length text) begin))))
        (when (>= end (string-length text))
          (raise (make-runtime-error
                  (format "Second argument to substring must be smaller than the string's length ~a, given ~a." (string-length text) end))))
        (when (< end 0)
          (raise (make-runtime-error
                  (format "Second argument to substring must be greater than 0, given ~a." end))))
        (when (> begin end)
          (raise (make-runtime-error
                  (format "First argument to substring must be less than the second, given ~a and ~a." begin end))))
        (make-java-string (substring text begin end)))
    
      (define/public (subSequence-int-int begin end)
        (error 'subSequence "Internal Error: subsequence is unimplemented because charSequence is unimplemented"))
      (define/public (sub-sequence i j) (subSequence-int-int i j))
      
      ;String -> String
      (define/public (concat-java.lang.String Jstr)
        (let ((str (send Jstr get-mzscheme-string)))
          (make-java-string (string-append text str))))
      (define/public (concat s) (concat-java.lang.String s))
    
      ; .. -> String
      (define/public (replace-char-char old new)
        (let ((new-text (apply string-append (map string (string->list text)))))
          (let loop ([index 0])
            (let ((pos (find-char old index)))
              (unless (= -1 pos)
                (string-set! new-text pos new)
                (loop (add1 index)))))
          (make-java-string new-text)))
      (define/public (replace c1 c2) (replace-char-char c1 c2))
    
      ;Does not currently work. Needs to replace regex in text with replace and return new string; PROBLEM
      (define/public (replaceAll-java.lang.String-java.lang.String regex replace)
        (error 'replaceAll "Internal error: replaceAll is unimplemented at this time"))
      (define/public (replace-all s s2) (replaceAll-java.lang.String-java.lang.String s s2))
    
      (define/public (replaceFirst-java.lang.String-java.lang.String regex replace)
        (error 'replaceFirst "Internal error: replaceFirst is unimplemented at this time"))
      (define/public (replace-first s s2) (replaceFirst-java.lang.String-java.lang.String s s2))
    
      (define/public (matches-java.lang.String regex)
        (error 'matches "Internal error: matches is unimplemented at this time"))
      (define/public (matches s) (matches-java.lang.String s))
    
      (define/public (split-java.lang.String-int regex limit)
        (error 'split "Internal error: split is unimplemented at this time"))
      
      (define/public (split-java.lang.String regex)
        (error 'split "Internal error: split is unimplemented at this time"))
    
      ; -> String
      (define/public (toLowerCase)
        (make-java-string (apply string-append (map string (map char-downcase (string->list text))))))
    
      ;Does not take Locale into account
      (define/public (toLowerCase-java.util.Locale locale)
        (toLowerCase))
    
      (define/public (toUpperCase)
        (make-java-string (apply string-append (map string (map char-upcase (string->list text))))))
    
      ;Does not take Locale into account: Problem
      (define/public (toUpperCase-java.util.Locale locale)
        (toUpperCase))
    
      ;... -> String
      (define/public (trim)
        (error 'trim "Internal error: trim is unimplemented at this time."))
      
      (define/public (toCharArray) (make-java-array 'char 0 (string->list text)))
      (define/public (to-char-array) (toCharArray))
    
      ;PROBLEM I am not sure what the side effects of this should be in context! PROBLEM!
      (define/public intern  
        (lambda () this))
      
      (define/override (my-name) "String")      
      (super-instantiate ())))
  
  ;valueOf -> String
  (define (String-valueOf-java.lang.Object obj)
    (if (null? obj)
        (make-java-string "null")
        (send obj |toString|)))
  (define (String-valueOf-char1 data) 
    (make-java-string (list->string (array->list data 0 (send data length)))))

  ;Should throw exceptions
  (define (String-valueOf-char1-int-int data offset len)
    (make-java-string (list->string (array->list data offset len))))

  (define (String-valueOf-boolean b) (make-java-string (if b "true" "false")))
  (define (String-valueOf-char c) (make-java-string (string c)))
  (define (String-valueOf-int i) (make-java-string (number->string i)))
  (define (String-valueOf-long l) (make-java-string (number->string l)))
  (define (String-valueOf-float f) (make-java-string (number->string f)))
  (define (String-valueOf-double d) (make-java-string (number->string d)))
  
  ;copyValueOf -> String
  (define (String-copyValueOf-char1-int-int data offset count)
    (String-valueOf-char1-int-int data offset count))
  (define (String-copyValueOf-char1 data) (String-valueOf-char1 data))
  
  ;Comparator
  (define String-CASE_INSENSITIVE_ORDER null)
  
  
;                                                                 
;         ;;                                 ;;      ;;;          
;  ;;;;;;; ;                                  ;        ;          
;  ;  ;  ; ;                                  ;        ;          
;  ;  ;  ; ; ;;   ; ;;;   ;;;  ;;; ;;; ;;;;   ;;;;     ;     ;;;  
;     ;    ;;  ;   ;     ;   ;  ;   ;      ;  ;   ;    ;    ;   ; 
;     ;    ;   ;   ;     ;   ;  ; ; ;   ;;;;  ;   ;    ;    ;;;;; 
;     ;    ;   ;   ;     ;   ;  ; ; ;  ;   ;  ;   ;    ;    ;     
;     ;    ;   ;   ;     ;   ;   ; ;   ;   ;  ;   ;    ;    ;   ; 
;   ;;;;; ;;; ;;; ;;;;    ;;;    ; ;    ;;; ;; ;;;   ;;;;;;  ;;;  
;                                                                 
;                                                                 
;                                                                 
;Throwable and exceptions

  (provide Throwable (struct java:exception (object))
           exception-is-a? handle-exception create-java-exception)
  
  (define Throwable
    (class* Object (Serializable)
      
      (inspect #f)
      ;private fields
      ;message: String
      (define message (make-java-string ""))
      ;stack: continuation-mark-set
      (define stack null)
      ;java:exception
      (define exception null)
      ;cause: Throwable
      (define cause null)
      
      ;Constructors, set the stack and message
      (define/public (Throwable-constructor)
        (set! stack (current-continuation-marks))
        (send this Object-constructor))
                
      (define/public (Throwable-constructor-java.lang.String msg)
        (set! message msg)
        (set! stack (current-continuation-marks))
        (send this Object-constructor))
      
      (define/public (Throwable-constructor-java.lang.String-java.lang.Throwable msg cse)
        (set! message msg)
        (set! cause cse)
        (set! stack (current-continuation-marks))
        (send this Object-constructor))
      
      (define/public (Throwable-constructor-java.lang.Throwable cse)
        (set! message (if (null? cse) null (send cse toString)))
        (set! cause cse)
        (set! stack (current-continuation-marks))
        (send this Object-constructor))    
      
      (public-final set-exception! get-mzscheme-exception)
      ;Used to interoperate with mzscheme exceptions: set and get the current exception
      (define (set-exception! exn)
        (set! exception exn)
        (set! stack (exn-continuation-marks exn)))
      (define (get-mzscheme-exception) exception)

      ;Needs to throw exceptions. Needs to be callable only once per object
      (define/public (initCause-java.lang.Throwable cse)
        (set! cause cse)
        this)
      
      ; -> String
      (define/public (getMessage) message)
      (define/public (getCause) cause)
      (define/public (getLocalizedMessage) (send this getMessage))
      (define/public (get-message) (send this getMessage))
      (define/public (get-cause) (send this getCause))
      (define/public (get-localized-message) (send this getLocalizedMessage))
      
      (define/public (setStackTrace-java.lang.StackTraceElement1 elments)
        (error 'setStackTrace "Internal error: setStackTrace will not be implemented until strack trace element s implemented"))
      (define/public (getStackTrace)
        (error 'getStackTrace "Internal error: getStackTrace will not be implemented until StackTraceElement is implemented"))
      (define/public (set-stack-trace e) (send this setStackTrace-java.lang.StackTraceElement1 e))
      (define/public (get-stack-trace) (send this getStackTrace))
      
       ; -> string
      (define/override (toString)
        (if (null? message)
            (make-java-string (send this my-name))
            (make-java-string (format "~a: ~a" 
                                      (send this my-name) 
                                      (send (send this getMessage) get-mzscheme-string)))))
      
      ; -> void
      (define/public (printStackTrace)
        (print-error-trace (current-output-port)
                           (make-exn (string->immutable-string message) stack)))

      ;These functions do not work correctly yet, and won't until printStreams are implemented
      (define/public printStackTrace-PrintStream (lambda (printStream) void)) 
      (define/public printStackTrace-PrintWriter (lambda (pW) void))
      
      ;This function does nothing at this time
      (define/public (fillInStackTrace) this)
      (define/public (fill-in-stack-trace) (send this fillInStackTrace))
      
      ; -> string
      (define/override (my-name) "Throwable")
      
      (super-instantiate ())))
  
  ;(make-java-exception string continuation-mark-set Throwable)
  ;Where Throwable is an object descending from class Throwable
  (define-struct (java:exception exn) (object))

  ;exception-is-a?: class -> (exn -> bool)
  (define (exception-is-a? class)
    (lambda (exn)
      (is-a? (java:exception-object exn) class)))

  (define (handle-exception actions)
    (lambda (exn)
      (actions (java:exception-object exn))))
  
  ;PROBLEM: create java exception misused by String implementation
  (define (create-java-exception class msg constructor marks)
    (let* ((exn (make-object class))
           (str (make-java-string msg))
           (scheme-exn (make-java:exception (string->immutable-string msg) marks exn)))
      (constructor exn str)
      (send exn set-exception! scheme-exn)
      scheme-exn))
  
  (define (make-runtime-error t)
    (create-java-exception 
     RuntimeException (string->immutable-string t)
     (lambda (exn str)
       (send exn RuntimeException-constructor-java.lang.String
             (make-java-string str)))
     (current-continuation-marks)))
  
  (provide convert-assert-Throwable wrap-convert-assert-Throwable dynamic-Throwable/c 
           guard-convert-Throwable static-Throwable/c)
  
  (define (wrap-convert-assert-Throwable obj p n s c)
    (c:contract (c:object-contract
                 (init-cause (c:-> c:any/c c:any/c))
                 (get-message (c:-> c:any/c))
                 (get-cause (c:-> c:any/c))
                 (get-localized-message (c:-> c:any/c))
                 (setStackTrace-java.lang.StackTraceElement1 (c:-> c:any/c c:any/c))
                 (get-stack-trace (c:-> c:any/c))
                 (printStackTrace (c:-> c:any/c))
                 (printStackTrace-PrintStream (c:-> c:any/c c:any/c))
                 (printStackTrace-PrintWriter (c:-> c:any/c c:any/c))
                 (fill-in-stack-trace (c:-> c:any/c))
                 (clone (c:-> c:any/c))
                 (equals-java.lang.Object (c:-> c:any/c c:any/c))
                 (finalize (c:-> c:any/c))
                 (get-class (c:-> c:any/c))
                 (hash-code (c:-> c:any/c))
                 (notify (c:-> c:any/c))
                 (notify-all (c:-> c:any/c))
                 (to-string (c:-> c:any/c))
                 (wait (c:-> c:any/c))
                 (wait-long (c:-> c:any/c c:any/c))
                 (wait-long-int (c:-> c:any/c c:any/c c:any/c))) obj p n s)
    (make-object convert-assert-Throwable obj p n s c))
  
  (define convert-assert-Throwable
    (class convert-assert-Object

      (init w p n s c)
      (super-instantiate (w p n s c))
      
      (define-values  (wrapped pos-blame neg-blame src cc-marks) (values null null null null null))
      (set! wrapped w)
      (set! pos-blame p)
      (set! neg-blame n)
      (set! src s)
      (set! cc-marks c)

      (define/public (set-exception! exn) (send wrapped set-exception! exn))
      (define/public (get-mzscheme-exception) (send wrapped get-mzscheme-exception))
      (define/public (initCause-java.lang.Throwable cse)
        (wrap-convert-assert-Throwable
         (send wrapped initCause-java.lang.Throwable (make-object guard-convert-Throwable cse
                                                       pos-blame neg-blame src cc-marks)
               pos-blame neg-blame src cc-marks)))
      (define/public (getMessage) 
        (let ((val (send wrapped getMessage)))
          (if (string? val)
              (make-java-string val)
              (raise (make-exn:fail 
                      (string->immutable-string 
                       (format "~a broke ~a contract here; Throwable's getMessage expects string return, given ~a"
                               pos-blame neg-blame val)) cc-marks)))))
      (define/public (getCause) 
        (wrap-convert-assert-Throwable (send wrapped getCause)))        
      (define/public (getLocalizedMessage) 
        (let ((val (send wrapped getLocalizedMessage)))
          (if (string? val)
              (make-java-string val)
              (raise (make-exn:fail 
                      (string->immutable-string 
                       (format "~a broke ~a contract here; Throwable's getLocalizedMessage expects string return, given ~a"
                               pos-blame neg-blame val)) cc-marks)))))
      (define/public (setStackTrace-java.lang.StackTraceElement1 elements)
        (send wrapped setStackTrace-java.lang.StackTraceElement1 elements))
      (define/public (getStackTrace) (send wrapped getStackTrace))
      (define/public (printStackTrace)  (send wrapped printStackTrace))
      (define/public (printStackTrace-PrintStream printStream) (send wrapped printStackTrace-PrintStream)) 
      (define/public (printStackTrace-PrintWriter pW) (send wrapped printStackTrace-PrintWriter))
      (define/public (fillInStackTrace) (send wrapped fillInStackTrace))      
      ))
  
  (define dynamic-Throwable/c
    (c:flat-named-contract "Throwable" (lambda (v) (is-a? v convert-assert-Throwable))))
     
  (define guard-convert-Throwable
    (class guard-convert-Object

      (init w p n s c)
      (super-instantiate (w p n s c))
      (define-values (wrapped pos-blame neg-blame src cc-marks) (values null null null null null))
      (set! wrapped w)
      (set! pos-blame p)
      (set! neg-blame n)
      (set! src s)
      (set! cc-marks s)

      (define/public (set-exception! exn) (send wrapped set-exception! exn))
      (define/public (get-mzscheme-exception) (send wrapped get-mzscheme-exception))
      (define/public (initCause-java.lang.Throwable . cse)
        (unless (= 1 (length cse))
          (raise (make-exn:fail:contract:arity
                  (string->immutable-string
                   (format "~a broke ~a contract here: Throwable's initCause expects to be called with 1 argument, given ~n"
                           pos-blame neg-blame (length cse))) cc-marks)))
        (make-object guard-convert-Throwable
          (send wrapped initCause-java.lang.Throwable (wrap-convert-assert-Throwable (car cse)))))
      (define/public (init-cause . cse)
        (unless (= 1 (length cse))
          (raise (make-exn:fail:contract:arity
                  (string->immutable-string
                   (format "~a broke ~a contract here: Throwable's initCause expects to be called with 1 argument, given ~n"
                           pos-blame neg-blame (length cse))) cc-marks)))        
        (make-object guard-convert-Throwable
          (send wrapped initCause-java.lang.Throwable (wrap-convert-assert-Throwable (car cse) pos-blame neg-blame src cc-marks))
          pos-blame neg-blame src cc-marks))
      (define/public (getMessage) (send (send wrapped getMessage) get-mzscheme-string))
      (define/public (get-message) (send (send wrapped getMessage) get-mzscheme-string))
      (define/public (getCause) (make-object guard-convert-Throwable (send wrapped getCause) pos-blame neg-blame src cc-marks))
      (define/public (get-cause) (make-object guard-convert-Throwable
                                   (send wrapped getCause) pos-blame neg-blame src cc-marks))
      (define/public (getLocalizedMessage) (send (send wrapped getLocalizedMessage) get-mzscheme-string))
      (define/public (get-localized-message) (send (send wrapped getLocalizedMessage) get-mzscheme-string))
      (define/public (setStackTrace-java.lang.StackTraceElement1 elements)
        (send wrapped setStackTrace-java.lang.StackTraceElement1 elements))
      (define/public (set-stack-trace t) 
        (send wrapped setStackTrace-java.lang.StackTraceElement1 t))
      (define/public (getStackTrace) (send wrapped getStackTrace))
      (define/public (get-stack-trace) (send wrapped getStackTrace))
      (define/public (printStackTrace)  (send wrapped printStackTrace))
      (define/public (printStackTrace-PrintStream printStream) (send wrapped printStackTrace-PrintStream printStream))
      (define/public (printStackTrace-PrintWriter pW) (send wrapped printStackTrace-PrintWriter pW))
      (define/public (fillInStackTrace) (send wrapped fillInStackTrace))
      (define/public (fill-in-stack-trace) (send wrapped fillInStackTrace))
      
      ))
  
  (define static-Throwable/c
    (c:flat-named-contract "Throwable" (lambda (v) (is-a? v guard-convert-Throwable))))  
  
  (provide wrap-convert-assert-Class guard-convert-Class wrap-convert-assert-PrintString wrap-convert-assert-PrintWriter)
  
  (define (wrap-convert-assert-Class . args) (void))
  (define guard-convert-Class (class object% (super-new)))
  (define (wrap-convert-assert-PrintString . args) (void))
  (define (wrap-convert-assert-PrintWriter . args) (void))
  
  (compile-rest-of-lang (list "Object" "Throwable" "String" "Exception" "RuntimeException" "Comparable"))
  
  )