js_long.ml

(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
 * Copyright (C) 2016 - Hongbo Zhang, Authors of ReScript 
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * In addition to the permissions granted to you by the LGPL, you may combine
 * or link a "work that uses the Library" with a publicly distributed version
 * of this file to produce a combined library or application, then distribute
 * that combined work under the terms of your choosing, with no requirement
 * to comply with the obligations normally placed on you by section 4 of the
 * LGPL version 3 (or the corresponding section of a later version of the LGPL
 * should you choose to use a later version).
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 * 
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)






module E = Js_exp_make
type int64_call = J.expression list -> J.expression  

let int64_call (fn : string) args  = 
  E.runtime_call Js_runtime_modules.int64 fn args 






(* below should  not depend on layout *)


let of_const (v : Int64.t) = 
  match v with
  | 0L -> 
    E.runtime_var_dot  Js_runtime_modules.int64 "zero"
  | 1L -> 
    E.runtime_var_dot  Js_runtime_modules.int64 "one"   
  | -1L ->  
    E.runtime_var_dot  Js_runtime_modules.int64 "neg_one"   
  | 9223372036854775807L ->
    E.runtime_var_dot  Js_runtime_modules.int64 "max_int"   
  | -9223372036854775808L ->
    E.runtime_var_dot  Js_runtime_modules.int64 "min_int"
  | _ -> 
    let unsigned_lo = E.uint32 (Int64.to_int32 v ) in 
    let hi = E.int (Int64.to_int32 (Int64.shift_right v 32)) in
    E.array Immutable [hi ;unsigned_lo] 
(* Assume the encoding of Int64 *)

let to_int32 args = 
  int64_call "to_int32" args
(* let get_lo x = E.array_index_by_int x 1l   *)
(* E.to_int32 @@ get_lo (Ext_list.singleton_exn args) *)


let of_int32 (args : J.expression list) = 
  match args with 
  | [{expression_desc = Number (Int {i}) ; _}] 
    -> 
    of_const (Int64.of_int32 i )
  | _ -> int64_call  "of_int32" args

let comp (cmp : Lam_compat.comparison) args = 
  E.runtime_call  Js_runtime_modules.caml_primitive
    (match cmp with 
     | Ceq -> "i64_eq"
     | Cneq -> "i64_neq"
     | Clt -> "i64_lt"
     | Cgt -> "i64_gt"
     | Cle -> "i64_le"
     | Cge -> "i64_ge") args 
let min args = 
  E.runtime_call Js_runtime_modules.caml_primitive "i64_min" args 
let max args = 
  E.runtime_call Js_runtime_modules.caml_primitive "i64_max" args   
  

let neg args = 
  int64_call "neg" args

let add args = 
  int64_call "add" args 

let sub args = 
  int64_call "sub" args

let mul args =  
  int64_call "mul" args

let div args =
  int64_call "div" args


(** Note if operands are not pure, we need hold shared value, 
    which is  a statement [var x = ... ; x ], it does not fit 
    current pipe-line fall back to a function call
*)
let bit_op  (* op : E.t -> E.t -> E.t*) runtime_call args = 
  int64_call runtime_call args 
(*disable optimizations relying on int64 representations
  this maybe outdated when we switch to bigint
*)
(* match args  with 
   | [l;r] -> 
   (* Int64 is a block in ocaml, a little more conservative in inlining *)
   if Js_analyzer.is_okay_to_duplicate l  &&
     Js_analyzer.is_okay_to_duplicate r then 
    make ~lo:(op (get_lo l) (get_lo r))
      ~hi:(op (get_hi l) (get_hi r))
   else 
   | _ -> assert false *)

let xor  = bit_op  "xor"
let or_ = bit_op  "or_"
let and_ = bit_op  "and_"


let lsl_ args = 
  int64_call "lsl_" args

let lsr_ args = 
  int64_call "lsr_" args

let asr_ args = 
  int64_call "asr_" args

let mod_ args = 
  int64_call "mod_" args


let swap args = 
  int64_call "swap" args

(* Safe constant propgation 
   {[
     Number.MAX_SAFE_INTEGER:
       Math.pow(2,53) - 1
   ]}
   {[
     Number.MIN_SAFE_INTEGER:
       - (Math.pow(2,53) -1)
   ]}
   Note that [Number._SAFE_INTEGER] is in ES6, 
   we can hard code this number without bringing browser issue.
*)
let of_float (args : J.expression list ) = 
  int64_call "of_float" args

let compare (args : J.expression list) = 
  int64_call "compare" args 

(* let of_string (args : J.expression list) = 
   int64_call "of_string" args  *)
(* let get64 = int64_call "get64" *)
let float_of_bits  =  int64_call "float_of_bits" 
let bits_of_float = int64_call "bits_of_float"


let equal_null args =   
  int64_call "equal_null" args  
let equal_undefined args =   
  int64_call "equal_undefined" args
let equal_nullable args =   
  int64_call "equal_nullable" args

let to_float (args : J.expression list ) = 
  match args with
  (* | [ {expression_desc  *)
  (*      = Caml_block (  *)
  (*          [lo =  *)
  (*           {expression_desc = Number (Int {i = lo; _}) }; *)
  (*           hi =  *)
  (*           {expression_desc = Number (Int {i = hi; _}) }; *)
  (*          ], _, _, _); _ }]  *)
  (*   ->  *)

  | [ _ ] -> 
    int64_call "to_float" args
  | _ -> 
    assert false