#lang scheme/base

(require srfi/13/string
         "../syntax/ast-core.ss"
         "../syntax/ast-utils.ss"
         "exceptions.ss"
         "value.ss")

(provide (except-out (all-defined-out) less-than? same-type? == ===))

;; 11.4.2
(define (js:void v)
  (void))

;; 11.4.1
(define (js:delete ref)
  (if (ref? ref)
      (delete-ref! ref)
      'true))

;; 11.4.3
(define (js:typeof v)
  (cond
    [(void? v) "undefined"]
    [(null? v) "object"]
    [(symbol? v) "boolean"]
    [(string? v) "string"]
    [(function? v) "function"]
    [(object? v) "object"]))

;; 11.8.6
(define (js:instanceof x y)
  (make-boolean (descendant-of? x y)))

;; 11.5.1
(define (js:* x y)
  (* (value->number x)
     (value->number y)))

;; 11.5.2
(define (js:/ x y)
  ;; try to lose some of Scheme's precision :)
  (let ([result (exact->inexact (/ (value->number x)
                                   (value->number y)))])
    (if (integer? result)
        (inexact->exact result)
        result)))

;; 11.6.1
(define js:+
  (case-lambda
    [(x) (value->number x)]
    [(x y)
     (let ([x (value->primitive x object->number)]
           [y (value->primitive y object->number)])
       (if (or (string? x) (string? y))
           (string-append (value->string x)
                          (value->string y))
           (+ (value->number x)
              (value->number y))))]))

;; 11.6.2
(define js:-
  (case-lambda
    [(x) (- (value->number x))]
    [(x y) (- (value->number x)
              (value->number y))]))

;; 11.5.3
(define (js:% x y)
  (let ([dividend (value->number x)]
        [divisor (value->number y)])
    ;; TODO: there's probably an easier way to do this with the Scheme library
    (cond
      [(or (NaN? dividend) (NaN? divisor) (infinite? dividend) (zero? divisor))
       NaN]
      [(and (not (infinite? dividend)) (infinite? divisor))
       x]
      [else
       (let* ([quotient (exact->inexact (/ dividend divisor))]
              [sign (if (negative? quotient) - +)]
              [magnitude (inexact->exact (floor (abs quotient)))])
         (- dividend (* divisor (sign magnitude))))])))

;; 11.7.1
(define (js:<< x y)
  (arithmetic-shift (value->int32 x)
                    (bitwise-and (value->uint32 y) #x1F)))

;; 11.7.2
(define (js:>> x y)
  (arithmetic-shift (value->int32 x)
                    (- (bitwise-and (value->uint32 y) #x1F))))

;; 11.7.3
(define (js:>>> x y)
  (arithmetic-shift (value->uint32 x)
                    (- (bitwise-and (value->uint32 y) #x1F))))

;; 11.10
(define (js:& x y)
  (bitwise-and (value->int32 x)
               (value->int32 y)))

;; 11.10
(define (js:^ x y)
  (bitwise-xor (value->int32 x)
               (value->int32 y)))

;; 11.10
(define (js:\| x y)
  (bitwise-ior (value->int32 x)
               (value->int32 y)))

;; 11.4.8
(define (js:~ x)
  (bitwise-not (value->int32 x)))

;; 11.4.9
(define (js:! x)
  (make-boolean (eq? (value->boolean x) 'false)))

;; 11.8.5
(define (less-than? x y)
  (let ([x (value->primitive x object->number)]
        [y (value->primitive y object->number)])
    (if (and (string? x) (string? y))
        (and (not (string-prefix? y x))
             (string-prefix? x y))
        (< (value->number x)
           (value->number y)))))

;; 11.8.1
(define (js:< x y)
  (make-boolean (less-than? x y)))

;; 11.8.2
(define (js:> x y)
  (make-boolean (less-than? y x)))

;; 11.8.3
(define (js:<= x y)
  (make-boolean (not (less-than? y x))))

;; 11.8.4
(define (js:>= x y)
  (make-boolean (not (less-than? x y))))

;; 11.8.7
(define (js:in x y)
  (unless (object? y)
    (raise-runtime-type-error here "object" (value->string y)))
  (make-boolean (has-property? y (value->string x))))

;; same-type? : value value -> boolean
(define (same-type? x y)
  (or (and (void? x) (void? y))
      (and (null? x) (null? y))
      (and (symbol? x) (symbol? y))
      (and (number? x) (number? y))
      (and (string? x) (string? y))
      (and (function? x) (function? y))
      (and (object? x) (object? y))))

;; 11.9.3
(define (== x y)
  (cond
    [(not (same-type? x y))
     (or (and (null? x) (void? y))
         (and (void? x) (null? y))
         (and (number? x) (string? y) (== x (value->number y)))
         (and (string? x) (number? y) (== (value->number x) y))
         (and (symbol? x) (== (value->number x) y))
         (and (symbol? y) (== x (value->number y)))
         (and (or (string? x) (number? x)) (object? y) (== x (value->primitive y)))
         (and (object? x) (or (string? y) (number? y)) (== (value->primitive x) y)))]
    [(void? x) #t]
    [(null? x) #t]
    [(number? x) (= x y)]
    [(string? x) (string=? x y)]
    [(symbol? x) (eq? x y)]
    [(object? x) (eq? x y)]))

;; 11.9.1
(define (js:== x y)
  (make-boolean (== x y)))

;; 11.9.2
(define (js:!= x y)
  (make-boolean (not (== x y))))

;; 11.9.6
(define (=== x y)
  (and (same-type? x y)
       (or (void? x)
           (null? x)
           (and (number? x) (= x y))
           (and (string? x) (string=? x y))
           (and (symbol? x) (eq? x y))
           (and (object? x) (eq? x y)))))

;; 11.9.4
(define (js:=== x y)
  (make-boolean (=== x y)))

;; 11.9.5
(define (js:!== x y)
  (make-boolean (not (=== x y))))

;; operator->syntax : (union infix-operator prefix-operator) -> syntax
(define (operator->syntax op)
  (if (or (infix-operator? op) (prefix-operator? op))
      (datum->syntax #'js:in (string->symbol (format "js:~a" op)))
      (error 'operator->syntax "bad operator")))