@tellahq/rescript 10.1.4-republish-1 → 10.1.4-republish-2

package/lib/ocaml/parsing.ml

@@ -1,212 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
-(*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
-
-(* The parsing engine *)
-
-open Lexing
-
-(* Internal interface to the parsing engine *)
-
-type parser_env =
-  { mutable s_stack : int array;        (* States *)
-    mutable v_stack : Obj.t array;      (* Semantic attributes *)
-    mutable symb_start_stack : position array; (* Start positions *)
-    mutable symb_end_stack : position array;   (* End positions *)
-    mutable stacksize : int;            (* Size of the stacks *)
-    mutable stackbase : int;            (* Base sp for current parse *)
-    mutable curr_char : int;            (* Last token read *)
-    mutable lval : Obj.t;               (* Its semantic attribute *)
-    mutable symb_start : position;      (* Start pos. of the current symbol*)
-    mutable symb_end : position;        (* End pos. of the current symbol *)
-    mutable asp : int;                  (* The stack pointer for attributes *)
-    mutable rule_len : int;             (* Number of rhs items in the rule *)
-    mutable rule_number : int;          (* Rule number to reduce by *)
-    mutable sp : int;                   (* Saved sp for parse_engine *)
-    mutable state : int;                (* Saved state for parse_engine *)
-    mutable errflag : int }             (* Saved error flag for parse_engine *)
-
-type parse_tables =
-  { actions : (parser_env -> Obj.t) array;
-    transl_const : int array;
-    transl_block : int array;
-    lhs : string;
-    len : string;
-    defred : string;
-    dgoto : string;
-    sindex : string;
-    rindex : string;
-    gindex : string;
-    tablesize : int;
-    table : string;
-    check : string;
-    error_function : string -> unit;
-    names_const : string;
-    names_block : string }
-
-exception YYexit of Obj.t
-exception Parse_error
-
-type parser_input =
-    Start
-  | Token_read
-  | Stacks_grown_1
-  | Stacks_grown_2
-  | Semantic_action_computed
-  | Error_detected
-
-type parser_output =
-    Read_token
-  | Raise_parse_error
-  | Grow_stacks_1
-  | Grow_stacks_2
-  | Compute_semantic_action
-  | Call_error_function
-
-(* to avoid warnings *)
-let _ = [Read_token; Raise_parse_error; Grow_stacks_1; Grow_stacks_2;
-         Compute_semantic_action; Call_error_function]
-
-external parse_engine :
-    parse_tables -> parser_env -> parser_input -> Obj.t -> parser_output
-    = "?parse_engine"
-
-external set_trace: bool -> bool
-    = "?set_parser_trace"
-
-let env =
-  { s_stack = Array.make 100 0;
-    v_stack = Array.make 100 (Obj.repr ());
-    symb_start_stack = Array.make 100 dummy_pos;
-    symb_end_stack = Array.make 100 dummy_pos;
-    stacksize = 100;
-    stackbase = 0;
-    curr_char = 0;
-    lval = Obj.repr ();
-    symb_start = dummy_pos;
-    symb_end = dummy_pos;
-    asp = 0;
-    rule_len = 0;
-    rule_number = 0;
-    sp = 0;
-    state = 0;
-    errflag = 0 }
-
-let grow_stacks() =
-  let oldsize = env.stacksize in
-  let newsize = oldsize * 2 in
-  let new_s = Array.make newsize 0
-  and new_v = Array.make newsize (Obj.repr ())
-  and new_start = Array.make newsize dummy_pos
-  and new_end = Array.make newsize dummy_pos in
-    Array.blit env.s_stack 0 new_s 0 oldsize;
-    env.s_stack <- new_s;
-    Array.blit env.v_stack 0 new_v 0 oldsize;
-    env.v_stack <- new_v;
-    Array.blit env.symb_start_stack 0 new_start 0 oldsize;
-    env.symb_start_stack <- new_start;
-    Array.blit env.symb_end_stack 0 new_end 0 oldsize;
-    env.symb_end_stack <- new_end;
-    env.stacksize <- newsize
-
-let clear_parser() =
-  Array.fill env.v_stack 0 env.stacksize (Obj.repr ());
-  env.lval <- Obj.repr ()
-
-let current_lookahead_fun = ref (fun (_ : Obj.t) -> false)
-
-let yyparse tables start lexer lexbuf =
-  let rec loop cmd arg =
-    match parse_engine tables env cmd arg with
-      Read_token ->
-        let t = Obj.repr(lexer lexbuf) in
-        env.symb_start <- lexbuf.lex_start_p;
-        env.symb_end <- lexbuf.lex_curr_p;
-        loop Token_read t
-    | Raise_parse_error ->
-        raise Parse_error
-    | Compute_semantic_action ->
-        let (action, value) =
-          try
-            (Semantic_action_computed, tables.actions.(env.rule_number) env)
-          with Parse_error ->
-            (Error_detected, Obj.repr ()) in
-        loop action value
-    | Grow_stacks_1 ->
-        grow_stacks(); loop Stacks_grown_1 (Obj.repr ())
-    | Grow_stacks_2 ->
-        grow_stacks(); loop Stacks_grown_2 (Obj.repr ())
-    | Call_error_function ->
-        tables.error_function "syntax error";
-        loop Error_detected (Obj.repr ()) in
-  let init_asp = env.asp
-  and init_sp = env.sp
-  and init_stackbase = env.stackbase
-  and init_state = env.state
-  and init_curr_char = env.curr_char
-  and init_lval = env.lval
-  and init_errflag = env.errflag in
-  env.stackbase <- env.sp + 1;
-  env.curr_char <- start;
-  env.symb_end <- lexbuf.lex_curr_p;
-  try
-    loop Start (Obj.repr ())
-  with exn ->
-    let curr_char = env.curr_char in
-    env.asp <- init_asp;
-    env.sp <- init_sp;
-    env.stackbase <- init_stackbase;
-    env.state <- init_state;
-    env.curr_char <- init_curr_char;
-    env.lval <- init_lval;
-    env.errflag <- init_errflag;
-    match exn with
-      YYexit v ->
-        Obj.magic v
-    | _ ->
-        current_lookahead_fun :=
-          (fun tok ->
-             if
-                 (Js.typeof tok <> "number")
-            then tables.transl_block.(Obj.tag tok) = curr_char
-            else tables.transl_const.(Obj.magic tok) = curr_char);
-        raise exn
-
-let peek_val env n =
-  Obj.magic env.v_stack.(env.asp - n)
-
-let symbol_start_pos () =
-  let rec loop i =
-    if i <= 0 then env.symb_end_stack.(env.asp)
-    else begin
-      let st = env.symb_start_stack.(env.asp - i + 1) in
-      let en = env.symb_end_stack.(env.asp - i + 1) in
-      if st <> en then st else loop (i - 1)
-    end
-  in
-  loop env.rule_len
-
-let symbol_end_pos () = env.symb_end_stack.(env.asp)
-let rhs_start_pos n = env.symb_start_stack.(env.asp - (env.rule_len - n))
-let rhs_end_pos n = env.symb_end_stack.(env.asp - (env.rule_len - n))
-
-let symbol_start () = (symbol_start_pos ()).pos_cnum
-let symbol_end () = (symbol_end_pos ()).pos_cnum
-let rhs_start n = (rhs_start_pos n).pos_cnum
-let rhs_end n = (rhs_end_pos n).pos_cnum
-
-let is_current_lookahead tok =
-  (!current_lookahead_fun)(Obj.repr tok)
-
-let parse_error (_ : string) = ()

package/lib/ocaml/parsing.mli

@@ -1,105 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
-(*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
-
-(** The run-time library for parsers generated by [ocamlyacc]. *)
-
-val symbol_start : unit -> int
-(** [symbol_start] and {!Parsing.symbol_end} are to be called in the
-   action part of a grammar rule only. They return the offset of the
-   string that matches the left-hand side of the rule: [symbol_start()]
-   returns the offset of the first character; [symbol_end()] returns the
-   offset after the last character. The first character in a file is at
-   offset 0. *)
-
-val symbol_end : unit -> int
-(** See {!Parsing.symbol_start}. *)
-
-val rhs_start : int -> int
-(** Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but
-   return the offset of the string matching the [n]th item on the
-   right-hand side of the rule, where [n] is the integer parameter
-   to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. *)
-
-val rhs_end : int -> int
-(** See {!Parsing.rhs_start}. *)
-
-val symbol_start_pos : unit -> Lexing.position
-(** Same as [symbol_start], but return a [position] instead of an offset. *)
-
-val symbol_end_pos : unit -> Lexing.position
-(** Same as [symbol_end], but return a [position] instead of an offset. *)
-
-val rhs_start_pos : int -> Lexing.position
-(** Same as [rhs_start], but return a [position] instead of an offset. *)
-
-val rhs_end_pos : int -> Lexing.position
-(** Same as [rhs_end], but return a [position] instead of an offset. *)
-
-val clear_parser : unit -> unit
-(** Empty the parser stack. Call it just after a parsing function
-   has returned, to remove all pointers from the parser stack
-   to structures that were built by semantic actions during parsing.
-   This is optional, but lowers the memory requirements of the
-   programs. *)
-
-exception Parse_error
-(** Raised when a parser encounters a syntax error.
-   Can also be raised from the action part of a grammar rule,
-   to initiate error recovery. *)
-
-val set_trace: bool -> bool
-(** Control debugging support for [ocamlyacc]-generated parsers.
-    After [Parsing.set_trace true], the pushdown automaton that
-    executes the parsers prints a trace of its actions (reading a token,
-    shifting a state, reducing by a rule) on standard output.
-    [Parsing.set_trace false] turns this debugging trace off.
-    The boolean returned is the previous state of the trace flag.
-    @since 3.11.0
-*)
-
-(**/**)
-
-(** {1  } *)
-
-(** The following definitions are used by the generated parsers only.
-   They are not intended to be used directly by user programs. *)
-
-type parser_env
-
-type parse_tables =
-  { actions : (parser_env -> Obj.t) array;
-    transl_const : int array;
-    transl_block : int array;
-    lhs : string;
-    len : string;
-    defred : string;
-    dgoto : string;
-    sindex : string;
-    rindex : string;
-    gindex : string;
-    tablesize : int;
-    table : string;
-    check : string;
-    error_function : string -> unit;
-    names_const : string;
-    names_block : string }
-
-exception YYexit of Obj.t
-
-val yyparse :
-  parse_tables -> int -> (Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'b
-val peek_val : parser_env -> int -> 'a
-val is_current_lookahead : 'a -> bool
-val parse_error : string -> unit

package/lib/ocaml/pervasives.ml

@@ -1,297 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
-(*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
-
-(* type 'a option = None | Some of 'a *)
-
-(* Internal *)
-external __unsafe_cast : 'a -> 'b = "%identity"
-
-(* Exceptions *)
-
-external raise : exn -> 'a = "%raise"
-external raise_notrace : exn -> 'a = "%raise_notrace"
-
-let failwith s = raise(Failure s)
-let invalid_arg s = raise(Invalid_argument s)
-
-exception Exit
-
-(* Composition operators *)
-
-external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
-external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
-
-(* Debugging *)
-
-external __LOC__ : string = "%loc_LOC"
-external __FILE__ : string = "%loc_FILE"
-external __LINE__ : int = "%loc_LINE"
-external __MODULE__ : string = "%loc_MODULE"
-external __POS__ : string * int * int * int = "%loc_POS"
-
-external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
-external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
-external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
-
-(* Comparisons *)
-
-external ( = ) : 'a -> 'a -> bool = "%equal"
-external ( <> ) : 'a -> 'a -> bool = "%notequal"
-external ( < ) : 'a -> 'a -> bool = "%lessthan"
-external ( > ) : 'a -> 'a -> bool = "%greaterthan"
-external ( <= ) : 'a -> 'a -> bool = "%lessequal"
-external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
-external compare : 'a -> 'a -> int = "%compare"
-external min : 'a -> 'a -> 'a = "%bs_min"
-external max : 'a -> 'a -> 'a = "%bs_max"
-external ( == ) : 'a -> 'a -> bool = "%eq"
-external ( != ) : 'a -> 'a -> bool = "%noteq"
-
-(* Boolean operations *)
-
-external not : bool -> bool = "%boolnot"
-
-external ( && ) : bool -> bool -> bool = "%sequand"
-
-external ( || ) : bool -> bool -> bool = "%sequor"
-
-(* Integer operations *)
-
-external ( ~- ) : int -> int = "%negint"
-external ( ~+ ) : int -> int = "%identity"
-external succ : int -> int = "%succint"
-external pred : int -> int = "%predint"
-external ( + ) : int -> int -> int = "%addint"
-external ( - ) : int -> int -> int = "%subint"
-external ( * ) : int -> int -> int = "%mulint"
-external ( / ) : int -> int -> int = "%divint"
-external ( mod ) : int -> int -> int = "%modint"
-
-let abs x = if x >= 0 then x else -x
-
-external ( land ) : int -> int -> int = "%andint"
-external ( lor ) : int -> int -> int = "%orint"
-external ( lxor ) : int -> int -> int = "%xorint"
-
-let lnot x = x lxor (-1)
-
-external ( lsl ) : int -> int -> int = "%lslint"
-external ( lsr ) : int -> int -> int = "%lsrint"
-external ( asr ) : int -> int -> int = "%asrint"
-
-let max_int = (-1) lsr 1
-let min_int = max_int + 1
-
-(* Floating-point operations *)
-
-external ( ~-. ) : float -> float = "%negfloat"
-external ( ~+. ) : float -> float = "%identity"
-external ( +. ) : float -> float -> float = "%addfloat"
-external ( -. ) : float -> float -> float = "%subfloat"
-external ( *. ) : float -> float -> float = "%mulfloat"
-external ( /. ) : float -> float -> float = "%divfloat"
-
-external ( ** ) : float -> float -> float = "pow" [@@bs.val] [@@bs.scope "Math"]
-external exp : float -> float = "exp" [@@bs.val][@@bs.scope "Math"]
-external expm1 : float -> float = "?expm1_float" 
-
-external acos : float -> float =  "acos" [@@bs.val] [@@bs.scope "Math"]
-external asin : float -> float = "asin" [@@bs.val] [@@bs.scope "Math"]
-external atan : float -> float = "atan" [@@bs.val] [@@bs.scope "Math"]
-external atan2 : float -> float -> float = "atan2" [@@bs.val] [@@bs.scope "Math"]
-external hypot : float -> float -> float
-               = "?hypot_float"
-
-external cos : float -> float = "cos" [@@bs.val] [@@bs.scope "Math"]
-external cosh : float -> float = "cosh" [@@bs.val] [@@bs.scope "Math"]
-external log : float -> float =  "log" [@@bs.val] [@@bs.scope "Math"]
-external log10 : float -> float = "log10"[@@bs.val] [@@bs.scope "Math"]
-external log1p : float -> float = "log1p" [@@bs.val] [@@bs.scope "Math"]
-external sin : float -> float =  "sin" [@@bs.val] [@@bs.scope "Math"]
-external sinh : float -> float = "sinh" [@@bs.val] [@@bs.scope "Math"]
-external sqrt : float -> float =  "sqrt" [@@bs.val] [@@bs.scope "Math"]
-external tan : float -> float =  "tan" [@@bs.val] [@@bs.scope "Math"]
-external tanh : float -> float =  "tanh" [@@bs.val] [@@bs.scope "Math"]
-external ceil : float -> float =  "ceil" [@@bs.val] [@@bs.scope "Math"]
-external floor : float -> float =  "floor" [@@bs.val] [@@bs.scope "Math"]
-external abs_float : float -> float = "abs"[@@bs.val] [@@bs.scope "Math"]
-external copysign : float -> float -> float
-                  = "?copysign_float"
-external mod_float : float -> float -> float = "?fmod_float"
-external frexp : float -> float * int = "?frexp_float"
-external ldexp : float -> int -> float  =
-  "?ldexp_float" 
-external modf : float -> float * float = "?modf_float"
-external float : int -> float = "%floatofint"
-external float_of_int : int -> float = "%floatofint"
-external truncate : float -> int = "%intoffloat"
-external int_of_float : float -> int = "%intoffloat"
-
-
-let infinity = 0x1p2047
-let neg_infinity = -0x1p2047
-external nan : float = "NaN"
-[@@bs.val]  [@@bs.scope "Number"]
-let max_float = 1.79769313486231571e+308 (*0x1.ffff_ffff_ffff_fp+1023*)
-let min_float = 2.22507385850720138e-308 (* 0x1p-1022 *)
-let epsilon_float = 2.22044604925031308e-16 (* 0x1p-52 *)
-
-
-
-type fpclass =
-    FP_normal
-  | FP_subnormal
-  | FP_zero
-  | FP_infinite
-  | FP_nan
-
-let classify_float (x : float) : fpclass =   
-  if ([%raw{|isFinite|}] : _ -> _ [@bs]) x [@bs] then
-    if abs_float x >= (* 0x1p-1022 *) (* 2.22507385850720138e-308*) min_float  then
-      FP_normal
-    else if x <> 0. then FP_subnormal
-    else FP_zero
-  else
-  if ([%raw{|isNaN|}] : _ -> _ [@bs])  x [@bs] then
-    FP_nan
-  else FP_infinite  
-
-(* String and byte sequence operations -- more in modules String and Bytes *)
-
-external string_length : string -> int = "%string_length"
-
-
-external (^) : string -> string -> string = "#string_append"
-(* Character operations -- more in module Char *)
-
-external int_of_char : char -> int = "%identity"
-external unsafe_char_of_int : int -> char = "%identity"
-let char_of_int n =
-  if n < 0 || n > 255 then invalid_arg "char_of_int" else unsafe_char_of_int n
-
-(* Unit operations *)
-
-external ignore : 'a -> unit = "%ignore"
-
-(* Pair operations *)
-
-external fst : 'a * 'b -> 'a = "%field0"
-external snd : 'a * 'b -> 'b = "%field1"
-
-(* References *)
-
-type 'a ref = { mutable contents : 'a }
-external ref : 'a -> 'a ref = "%makemutable"
-external ( ! ) : 'a ref -> 'a = "%bs_ref_field0"
-external ( := ) : 'a ref -> 'a -> unit = "%bs_ref_setfield0"
-external incr : int ref -> unit = "%incr"
-external decr : int ref -> unit = "%decr"
-
-(* Result type *)
-
-type ('a, 'b) result = ('a, 'b) Belt.Result.t =
-  | Ok of 'a
-  | Error of 'b
-
-(* String conversion functions *)
-external format_float : string -> float -> string = "?format_float"
-
-let string_of_bool b =
-  if b then "true" else "false"
-let bool_of_string = function
-  | "true" -> true
-  | "false" -> false
-  | _ -> invalid_arg "bool_of_string"
-
-let bool_of_string_opt = function
-  | "true" -> Some true
-  | "false" -> Some false
-  | _ -> None
-
-
-external string_of_int : int -> string = "String" [@@bs.val]
-
-external int_of_string : string -> int = "?int_of_string"
-
-let int_of_string_opt s =
-  (* TODO: provide this directly as a non-raising primitive. *)
-  try Some (int_of_string s)
-  with Failure _ -> None
-
-external string_get : string -> int -> char = "%string_safe_get"
-
-let valid_float_lexem s =
-  let l = string_length s in
-  let rec loop i =
-    if i >= l then s ^ "." else
-    match string_get s i with
-    | '0' .. '9' | '-' -> loop (i + 1)
-    | _ -> s
-  in
-  loop 0
-
-let string_of_float f = valid_float_lexem (format_float "%.12g" f)
-
-external float_of_string : string -> float = "?float_of_string"
-
-let float_of_string_opt s =
-  (* TODO: provide this directly as a non-raising primitive. *)
-  try Some (float_of_string s)
-  with Failure _ -> None
-
-(* List operations -- more in module List *)
-
-let rec ( @ ) l1 l2 =
-  match l1 with
-    [] -> l2
-  | hd :: tl -> hd :: (tl @ l2)
-
-
-
-(* Output functions on standard output *)
-
-
-external print_endline : string -> unit = "log" 
-[@@bs.val] [@@bs.scope "console"]
-let print_newline () = print_endline ""
-
-(* Output functions on standard error *)
-
-
-external prerr_endline : string -> unit = "error" 
-[@@bs.val] [@@bs.scope "console"]    
-let prerr_newline () = prerr_endline ""
-
-let print_int (i : int) = print_endline (string_of_int i) 
-let print_float (i : float) = print_endline (string_of_float i)
-let print_string = print_endline
-
-(* Miscellaneous *)
-
-external sys_exit : int -> 'a = "?sys_exit"
-
-let exit_function = ref ignore
-
-let at_exit f =
-  let g = !exit_function in
-  exit_function := (fun () -> f(); g())
-
-let do_at_exit () = (!exit_function) ()
-
-let exit retcode =
-  do_at_exit ();
-  sys_exit retcode
-
-type int32 = int