@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/digest.mli

@@ -0,0 +1,68 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** MD5 message digest.
+
+   This module provides functions to compute 128-bit 'digests' of
+   arbitrary-length strings or files. The digests are of cryptographic
+   quality: it is very hard, given a digest, to forge a string having
+   that digest. The algorithm used is MD5. This module should not be
+   used for secure and sensitive cryptographic applications. For these
+   kind of applications more recent and stronger cryptographic
+   primitives should be used instead.
+*)
+
+type t = string
+(** The type of digests: 16-character strings. *)
+
+val compare : t -> t -> int
+(** The comparison function for 16-character digest, with the same
+    specification as {!Pervasives.compare} and the implementation
+    shared with {!String.compare}. Along with the type [t], this
+    function [compare] allows the module [Digest] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}.
+    @since 4.00.0 *)
+
+val equal : t -> t -> bool
+(** The equal function for 16-character digest.
+    @since 4.03.0 *)
+
+val string : string -> t
+(** Return the digest of the given string. *)
+
+val bytes : bytes -> t
+(** Return the digest of the given byte sequence.
+    @since 4.02.0 *)
+
+val substring : string -> int -> int -> t
+(** [Digest.substring s ofs len] returns the digest of the substring
+   of [s] starting at index [ofs] and containing [len] characters. *)
+
+val subbytes : bytes -> int -> int -> t
+(** [Digest.subbytes s ofs len] returns the digest of the subsequence
+    of [s] starting at index [ofs] and containing [len] bytes.
+    @since 4.02.0 *)
+
+
+val to_hex : t -> string
+(** Return the printable hexadecimal representation of the given digest.
+    Raise [Invalid_argument] if the argument is not exactly 16 bytes.
+ *)
+
+val from_hex : string -> t
+(** Convert a hexadecimal representation back into the corresponding digest.
+   Raise [Invalid_argument] if the argument is not exactly 32 hexadecimal
+   characters.
+   @since 4.00.0 *)

package/lib/ocaml/dom.ml

@@ -0,0 +1,296 @@
+type _baseClass
+
+type animation (* Web Animations API *)
+
+(* TODO: Should we bother with this indirection?
+(* core *)
+type domString = string
+type domTimestamp = float
+*)
+
+(* css *)
+type cssStyleDeclaration
+type cssStyleSheet
+
+(* events (early) *)
+type 'a eventTarget_like
+type eventTarget = _baseClass eventTarget_like
+
+(* nodes *)
+type 'a _node
+type 'a node_like = 'a _node eventTarget_like
+type node = _baseClass node_like
+type _attr
+type attr = _attr node_like
+type 'a _characterData
+type 'a characterData_like = 'a _characterData node_like
+type characterData = _baseClass characterData_like
+type _cdataSection
+type cdataSection = _cdataSection characterData_like
+type _comment
+type comment = _comment characterData_like
+type 'a _document
+type 'a document_like = 'a _document node_like
+type document = _baseClass document_like
+type _documentFragment
+type documentFragment = _documentFragment node_like
+type _documentType
+type documentType = _documentType node_like
+type domImplementation
+type 'a _element
+type 'a element_like = 'a _element node_like
+type element = _baseClass element_like
+type htmlCollection
+type htmlFormControlsCollection
+type htmlOptionsCollection
+type intersectionObserver
+type intersectionObserverEntry
+type mutationObserver
+type mutationRecord
+type performanceObserver
+type performanceObserverEntryList
+type reportingObserver
+type reportingObserverOptions
+type resizeObserver
+type resizeObserverEntry
+type namedNodeMap
+type nodeList
+type radioNodeList
+type processingInstruction
+type _shadowRoot
+type shadowRoot = _shadowRoot node_like
+type _text
+type text = _text characterData_like
+
+(* geometry *)
+type domRect
+
+(* html *)
+type dataTransfer (* Drag and Drop API *)
+type domStringMap
+type history
+type _htmlDocument
+type htmlDocument = _htmlDocument document_like
+type 'a _htmlElement
+type 'a htmlElement_like = 'a _htmlElement element_like
+type htmlElement = _baseClass htmlElement_like
+type _htmlAnchorElement
+type htmlAnchorElement = _htmlAnchorElement htmlElement_like
+type _htmlAreaElement
+type htmlAreaElement = _htmlAreaElement htmlElement_like
+type _htmlAudioElement
+type htmlAudioElement = _htmlAudioElement htmlElement_like
+type _htmlBaseElement
+type htmlBaseElement = _htmlBaseElement htmlElement_like
+type _htmlBodyElement
+type htmlBodyElement = _htmlBodyElement htmlElement_like
+type _htmlBrElement
+type htmlBrElement = _htmlBrElement htmlElement_like
+type _htmlButtonElement
+type htmlButtonElement = _htmlButtonElement htmlElement_like
+type _htmlCanvasElement
+type htmlCanvasElement = _htmlCanvasElement htmlElement_like
+type _htmlDataElement
+type htmlDataElement = _htmlDataElement htmlElement_like
+type _htmlDataListElement
+type htmlDataListElement = _htmlDataListElement htmlElement_like
+type _htmlDialogElement
+type htmlDialogElement = _htmlDialogElement htmlElement_like
+type _htmlDivElement
+type htmlDivElement = _htmlDivElement htmlElement_like
+type _htmlDlistElement
+type htmlDlistElement = _htmlDlistElement htmlElement_like
+type _htmlEmbedElement
+type htmlEmbedElement = _htmlEmbedElement htmlElement_like
+type _htmlFieldSetElement
+type htmlFieldSetElement = _htmlFieldSetElement htmlElement_like
+type _htmlFormElement
+type htmlFormElement = _htmlFormElement htmlElement_like
+type _htmlHeadElement
+type htmlHeadElement = _htmlHeadElement htmlElement_like
+type _htmlHeadingElement
+type htmlHeadingElement = _htmlHeadingElement htmlElement_like
+type _htmlHrElement
+type htmlHrElement = _htmlHrElement htmlElement_like
+type _htmlHtmlElement
+type htmlHtmlElement = _htmlHtmlElement htmlElement_like
+type _htmlIframeElement
+type htmlIframeElement = _htmlIframeElement htmlElement_like
+type _htmlImageElement
+type htmlImageElement = _htmlImageElement htmlElement_like
+type _htmlInputElement
+type htmlInputElement = _htmlInputElement htmlElement_like
+type _htmlLabelElement
+type htmlLabelElement = _htmlLabelElement htmlElement_like
+type _htmlLegendElement
+type htmlLegendElement = _htmlLegendElement htmlElement_like
+type _htmlLiElement
+type htmlLiElement = _htmlLiElement htmlElement_like
+type _htmlLinkElement
+type htmlLinkElement = _htmlLinkElement htmlElement_like
+type _htmlMapElement
+type htmlMapElement = _htmlMapElement htmlElement_like
+type _htmlMediaElement
+type htmlMediaElement = _htmlMediaElement htmlElement_like
+type _htmlMenuElement
+type htmlMenuElement = _htmlMenuElement htmlElement_like
+type _htmlMetaElement
+type htmlMetaElement = _htmlMetaElement htmlElement_like
+type _htmlMeterElement
+type htmlMeterElement = _htmlMeterElement htmlElement_like
+type _htmlModElement
+type htmlModElement = _htmlModElement htmlElement_like
+type _htmlOListElement
+type htmlOListElement = _htmlOListElement htmlElement_like
+type _htmlObjectElement
+type htmlObjectElement = _htmlObjectElement htmlElement_like
+type _htmlOptGroupElement
+type htmlOptGroupElement = _htmlOptGroupElement htmlElement_like
+type _htmlOptionElement
+type htmlOptionElement = _htmlOptionElement htmlElement_like
+type _htmlOutputElement
+type htmlOutputElement = _htmlOutputElement htmlElement_like
+type _htmlParagraphElement
+type htmlParagraphElement = _htmlParagraphElement htmlElement_like
+type _htmlParamElement
+type htmlParamElement = _htmlParamElement htmlElement_like
+type _htmlPreElement
+type htmlPreElement = _htmlPreElement htmlElement_like
+type _htmlProgressElement
+type htmlProgressElement = _htmlProgressElement htmlElement_like
+type _htmlQuoteElement
+type htmlQuoteElement = _htmlQuoteElement htmlElement_like
+type _htmlScriptElement
+type htmlScriptElement = _htmlScriptElement htmlElement_like
+type _htmlSelectElement
+type htmlSelectElement = _htmlSelectElement htmlElement_like
+type _htmlSlotElement
+type htmlSlotElement = _htmlSlotElement htmlElement_like
+type _htmlSourceElement
+type htmlSourceElement = _htmlSourceElement htmlElement_like
+type _htmlSpanElement
+type htmlSpanElement = _htmlSpanElement htmlElement_like
+type _htmlStyleElement
+type htmlStyleElement = _htmlStyleElement htmlElement_like
+type _htmlTableCaptionElement
+type htmlTableCaptionElement = _htmlTableCaptionElement htmlElement_like
+type _htmlTableCellElement
+type htmlTableCellElement = _htmlTableCellElement htmlElement_like
+type _htmlTableColElement
+type htmlTableColElement = _htmlTableColElement htmlElement_like
+type _htmlTableDataCellElement
+type htmlTableDataCellElement = _htmlTableDataCellElement htmlElement_like
+type _htmlTableElement
+type htmlTableElement = _htmlTableElement htmlElement_like
+type _htmlTableHeaderCellElement
+type htmlTableHeaderCellElement = _htmlTableHeaderCellElement htmlElement_like
+type _htmlTableRowElement
+type htmlTableRowElement = _htmlTableRowElement htmlElement_like
+type _htmlTableSectionElement
+type htmlTableSectionElement = _htmlTableSectionElement htmlElement_like
+type _htmlTextAreaElement
+type htmlTextAreaElement = _htmlTextAreaElement htmlElement_like
+type _htmlTimeElement
+type htmlTimeElement = _htmlTimeElement htmlElement_like
+type _htmlTitleElement
+type htmlTitleElement = _htmlTitleElement htmlElement_like
+type _htmlTrackElement
+type htmlTrackElement = _htmlTrackElement htmlElement_like
+type _htmlUlistElement
+type htmlUlistElement = _htmlUlistElement htmlElement_like
+type _htmlUnknownElement
+type htmlUnknownElement = _htmlUnknownElement htmlElement_like
+type _htmlVideoElement
+type htmlVideoElement = _htmlVideoElement htmlElement_like
+type location
+type window
+type _xmlDocument
+type xmlDocument = _xmlDocument document_like
+
+(* events *)
+type 'a event_like
+type event = _baseClass event_like
+type 'a _uiEvent
+type 'a uiEvent_like = 'a _uiEvent event_like
+type uiEvent = _baseClass uiEvent_like
+type _animationEvent
+type animationEvent = _animationEvent event_like
+type _beforeUnloadEvent
+type beforeUnloadEvent = _beforeUnloadEvent event_like
+type _clipboardEvent
+type clipboardEvent = _clipboardEvent event_like
+type _closeEvent
+type closeEvent = _closeEvent event_like
+type _compositionEvent
+type compositionEvent = _compositionEvent uiEvent_like
+type _customEvent
+type customEvent = _customEvent event_like
+type _dragEvent
+type dragEvent = _dragEvent event_like
+type _errorEvent
+type errorEvent = _errorEvent event_like
+type _focusEvent
+type focusEvent = _focusEvent uiEvent_like
+type _idbVersionChangeEvent
+type idbVersionChangeEvent = _idbVersionChangeEvent event_like
+type _inputEvent
+type inputEvent = _inputEvent uiEvent_like
+type _keyboardEvent
+type keyboardEvent = _keyboardEvent uiEvent_like
+type 'a _mouseEvent
+type 'a mouseEvent_like = 'a _mouseEvent uiEvent_like
+type mouseEvent = _baseClass mouseEvent_like
+type _pageTransitionEvent
+type pageTransitionEvent = _pageTransitionEvent event_like
+type _pointerEvent
+type pointerEvent = _pointerEvent mouseEvent_like
+type _popStateEvent
+type popStateEvent = _popStateEvent event_like
+type _progressEvent
+type progressEvent = _progressEvent event_like
+type _relatedEvent
+type relatedEvent = _relatedEvent event_like
+type _storageEvent
+type storageEvent = _storageEvent event_like
+type _svgZoomEvent
+type svgZoomEvent = _svgZoomEvent event_like
+type _timeEvent
+type timeEvent = _timeEvent event_like
+type _touchEvent
+type touchEvent = _touchEvent uiEvent_like
+type _trackEvent
+type trackEvent = _trackEvent event_like
+type _transitionEvent
+type transitionEvent = _transitionEvent event_like
+type _webGlContextEvent
+type webGlContextEvent = _webGlContextEvent event_like
+type _wheelEvent
+type wheelEvent = _wheelEvent uiEvent_like
+
+(* ranges *)
+type range
+
+(* selection (TODO: move out of dom?) *)
+type selection
+
+(* sets *)
+type domTokenList
+type domSettableTokenList
+
+(* traversal *)
+type nodeFilter = {
+  acceptNode: element -> int (* return type should be NodeFilter.action, but that would create a cycle *)
+}
+type nodeIterator
+type treeWalker
+
+(* SVG *)
+type svgRect
+type svgPoint
+
+(* special *)
+type eventPointerId
+
+
+module Storage = Dom_storage
+module Storage2 = Dom_storage2

package/lib/ocaml/dom_storage.ml

@@ -0,0 +1,22 @@
+type t = Dom_storage2.t
+
+external getItem : t -> string -> string option = "getItem" [@@send] [@@bs.return null_to_opt]
+let getItem s obj = obj |. getItem s 
+(* https://developer.mozilla.org/en-US/docs/Web/API/Storage/getItem 
+  If the key does not exist, `null` is returned
+*)
+
+external setItem : t -> string -> string -> unit = "setItem" [@@send]
+let setItem k v obj : unit = obj |. setItem k v 
+external removeItem : t -> string -> unit = "removeItem" [@@send]
+let removeItem s obj : unit = obj |. removeItem s 
+external clear : t -> unit = "clear" [@@send]
+external key : t -> int -> string option = "key" [@@send] [@@bs.return null_to_opt]
+(* A DOMString containing the name of the key. If the index does not exist, null is returned.
+  If the key does not exist, `null` is returned
+*)
+let key i obj : string option = obj |. key i 
+external length : t -> int = "length" [@@get]
+
+external localStorage : t = "localStorage" [@@val]
+external sessionStorage : t = "sessionStorage" [@@val]

package/lib/ocaml/dom_storage2.ml

@@ -0,0 +1,11 @@
+type t
+
+external getItem : t -> string -> string option = "getItem" [@@bs.send] [@@bs.return null_to_opt]
+external setItem : t -> string -> string -> unit = "setItem" [@@bs.send]
+external removeItem : t -> string -> unit = "removeItem" [@@bs.send]
+external clear : t -> unit = "clear" [@@bs.send]
+external key : t -> int -> string option = "key" [@@bs.send] [@@bs.return null_to_opt]
+external length : t -> int = "length" [@@bs.get]
+
+external localStorage : t = "localStorage" [@@bs.val]
+external sessionStorage : t = "sessionStorage" [@@bs.val]

package/lib/ocaml/filename.ml

@@ -0,0 +1,233 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Xavier Leroy and Damien Doligez, 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+let generic_quote quotequote s =
+  let l = String.length s in
+  let b = Buffer.create (l + 20) in
+  Buffer.add_char b '\'';
+  for i = 0 to l - 1 do
+    if s.[i] = '\''
+    then Buffer.add_string b quotequote
+    else Buffer.add_char b  s.[i]
+  done;
+  Buffer.add_char b '\'';
+  Buffer.contents b
+
+(* This function implements the Open Group specification found here:
+  [[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html
+  In step 1 of [[1]], we choose to return "." for empty input.
+    (for compatibility with previous versions of OCaml)
+  In step 2, we choose to process "//" normally.
+  Step 6 is not implemented: we consider that the [suffix] operand is
+    always absent.  Suffixes are handled by [chop_suffix] and [chop_extension].
+*)
+let generic_basename is_dir_sep current_dir_name name =
+  let rec find_end n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then find_end (n - 1)
+    else find_beg n (n + 1)
+  and find_beg n p =
+    if n < 0 then String.sub name 0 p
+    else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
+    else find_beg (n - 1) p
+  in
+  if name = ""
+  then current_dir_name
+  else find_end (String.length name - 1)
+
+(* This function implements the Open Group specification found here:
+  [[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html
+  In step 6 of [[2]], we choose to process "//" normally.
+*)
+let generic_dirname is_dir_sep current_dir_name name =
+  let rec trailing_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then trailing_sep (n - 1)
+    else base n
+  and base n =
+    if n < 0 then current_dir_name
+    else if is_dir_sep name n then intermediate_sep n
+    else base (n - 1)
+  and intermediate_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then intermediate_sep (n - 1)
+    else String.sub name 0 (n + 1)
+  in
+  if name = ""
+  then current_dir_name
+  else trailing_sep (String.length name - 1)
+
+module Unix = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "/"
+  let is_dir_sep s i = s.[i] = '/'
+  let is_relative n = String.length n < 1 || n.[0] <> '/'
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+  let check_suffix name suff =
+    String.length name >= String.length suff &&
+    String.sub name (String.length name - String.length suff)
+                    (String.length suff) = suff
+  let temp_dir_name =
+    try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
+  let quote = generic_quote "'\\''"
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
+end
+
+module Win32 = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "\\"
+  let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
+  let is_relative n =
+    (String.length n < 1 || n.[0] <> '/')
+    && (String.length n < 1 || n.[0] <> '\\')
+    && (String.length n < 2 || n.[1] <> ':')
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 2 || String.sub n 0 2 <> ".\\")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+    && (String.length n < 3 || String.sub n 0 3 <> "..\\")
+  let check_suffix name suff =
+   String.length name >= String.length suff &&
+   (let s = String.sub name (String.length name - String.length suff)
+                            (String.length suff) in
+    String.lowercase_ascii s = String.lowercase_ascii suff)
+  let temp_dir_name =
+    try Sys.getenv "TEMP" with Not_found -> "."
+  let quote s =
+    let l = String.length s in
+    let b = Buffer.create (l + 20) in
+    Buffer.add_char b '\"';
+    let rec loop i =
+      if i = l then Buffer.add_char b '\"' else
+      match s.[i] with
+      | '\"' -> loop_bs 0 i;
+      | '\\' -> loop_bs 0 i;
+      | c    -> Buffer.add_char b c; loop (i+1);
+    and loop_bs n i =
+      if i = l then begin
+        Buffer.add_char b '\"';
+        add_bs n;
+      end else begin
+        match s.[i] with
+        | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1);
+        | '\\' -> loop_bs (n+1) (i+1);
+        | _    -> add_bs n; loop i
+      end
+    and add_bs n = for _j = 1 to n do Buffer.add_char b '\\'; done
+    in
+    loop 0;
+    Buffer.contents b
+  let has_drive s =
+    let is_letter = function
+      | 'A' .. 'Z' | 'a' .. 'z' -> true
+      | _ -> false
+    in
+    String.length s >= 2 && is_letter s.[0] && s.[1] = ':'
+  let drive_and_path s =
+    if has_drive s
+    then (String.sub s 0 2, String.sub s 2 (String.length s - 2))
+    else ("", s)
+  let dirname s =
+    let (drive, path) = drive_and_path s in
+    let dir = generic_dirname is_dir_sep current_dir_name path in
+    drive ^ dir
+  let basename s =
+    let (_drive, path) = drive_and_path s in
+    generic_basename is_dir_sep current_dir_name path
+end
+
+module Cygwin = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let dir_sep = "/"
+  let is_dir_sep = Win32.is_dir_sep
+  let is_relative = Win32.is_relative
+  let is_implicit = Win32.is_implicit
+  let check_suffix = Win32.check_suffix
+  let temp_dir_name = Unix.temp_dir_name
+  let quote = Unix.quote
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
+end
+
+let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep,
+     is_relative, is_implicit, check_suffix, temp_dir_name, quote, basename,
+     dirname) =
+  match Sys.os_type with
+  | "Win32" ->
+      (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep,
+       Win32.is_dir_sep,
+       Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
+       Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname)
+  | "Cygwin" ->
+      (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep,
+       Cygwin.is_dir_sep,
+       Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
+       Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname)
+  | _ -> (* normally "Unix" *)
+      (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep,
+       Unix.is_dir_sep,
+       Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
+       Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname)
+
+let concat dirname filename =
+  let l = String.length dirname in
+  if l = 0 || is_dir_sep dirname (l-1)
+  then dirname ^ filename
+  else dirname ^ dir_sep ^ filename
+
+let chop_suffix name suff =
+  let n = String.length name - String.length suff in
+  if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n
+
+let extension_len name =
+  let rec check i0 i =
+    if i < 0 || is_dir_sep name i then 0
+    else if name.[i] = '.' then check i0 (i - 1)
+    else String.length name - i0
+  in
+  let rec search_dot i =
+    if i < 0 || is_dir_sep name i then 0
+    else if name.[i] = '.' then check i (i - 1)
+    else search_dot (i - 1)
+  in
+  search_dot (String.length name - 1)
+
+let extension name =
+  let l = extension_len name in
+  if l = 0 then "" else String.sub name (String.length name - l) l
+
+let chop_extension name =
+  let l = extension_len name in
+  if l = 0 then invalid_arg "Filename.chop_extension"
+  else String.sub name 0 (String.length name - l)
+
+let remove_extension name =
+  let l = extension_len name in
+  if l = 0 then name else String.sub name 0 (String.length name - l)
+
+
+let current_temp_dir_name = ref temp_dir_name
+
+let set_temp_dir_name s = current_temp_dir_name := s
+let get_temp_dir_name () = !current_temp_dir_name
+