diff options
Diffstat (limited to 'stdlib')
43 files changed, 559 insertions, 0 deletions
diff --git a/stdlib/arg.ml b/stdlib/arg.ml index 3726760f4..0d214b7a9 100644 --- a/stdlib/arg.ml +++ b/stdlib/arg.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + type spec = String of (string -> unit) | Int of (int -> unit) diff --git a/stdlib/arg.mli b/stdlib/arg.mli index 57ce2b3ab..fa31aa357 100644 --- a/stdlib/arg.mli +++ b/stdlib/arg.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Arg]: parsing of command line arguments *) (* This module provides a general mechanism for extracting options and diff --git a/stdlib/array.ml b/stdlib/array.ml index 62c475d22..a3c8779f0 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Array operations *) external length : 'a array -> int = "%array_length" diff --git a/stdlib/array.mli b/stdlib/array.mli index 17e59e1a3..de301b69c 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Array]: array operations *) external length : 'a array -> int = "%array_length" diff --git a/stdlib/char.ml b/stdlib/char.ml index 348c5683c..43ccdef71 100644 --- a/stdlib/char.ml +++ b/stdlib/char.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Character operations *) external code: char -> int = "%identity" diff --git a/stdlib/char.mli b/stdlib/char.mli index 6d7b53565..099c63237 100644 --- a/stdlib/char.mli +++ b/stdlib/char.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Char]: character operations *) external code: char -> int = "%identity" diff --git a/stdlib/filename.ml b/stdlib/filename.ml index af63af08f..d749c1943 100644 --- a/stdlib/filename.ml +++ b/stdlib/filename.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + let check_suffix name suff = String.length name >= String.length suff & String.sub name (String.length name - String.length suff) (String.length suff) diff --git a/stdlib/filename.mli b/stdlib/filename.mli index 91363bde8..39b19bc16 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Filename]: operations on file names *) val current_dir_name : string diff --git a/stdlib/format.ml b/stdlib/format.ml index 34d3cb12f..e60c0c2c0 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Tokens are one of the following : *) type pp_token = diff --git a/stdlib/format.mli b/stdlib/format.mli index 1425b4868..e5a976c6b 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Format]: pretty printing *) (* This module implements a pretty-printing facility to format text diff --git a/stdlib/gc.ml b/stdlib/gc.ml index 163e6867e..d07be8361 100644 --- a/stdlib/gc.ml +++ b/stdlib/gc.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + type stat = { minor_words : int; promoted_words : int; diff --git a/stdlib/gc.mli b/stdlib/gc.mli index ea0ed5f1b..15753dd46 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Gc]: memory management control and statistics *) type stat = { diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml index de55ae63d..3d466ec4f 100644 --- a/stdlib/hashtbl.ml +++ b/stdlib/hashtbl.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Hash tables *) (* We do dynamic hashing, and we double the size of the table when diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index 9bde6fed4..324ca3d68 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Hashtbl]: hash tables and hash functions *) (* Hash tables are hashed association tables, with in-place modification. *) diff --git a/stdlib/header.c b/stdlib/header.c index aba20e62a..1169a02a1 100644 --- a/stdlib/header.c +++ b/stdlib/header.c @@ -1,3 +1,16 @@ +/***********************************************************************/ +/* */ +/* Caml Special Light */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1995 Institut National de Recherche en Informatique et */ +/* Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + char * runtime_name = "cslrun"; char * errmsg = "Cannot exec cslrun.\n"; diff --git a/stdlib/lexing.ml b/stdlib/lexing.ml index 2f467f652..d5832fb5f 100644 --- a/stdlib/lexing.ml +++ b/stdlib/lexing.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* The run-time library for lexers generated by camllex *) type lexbuf = diff --git a/stdlib/lexing.mli b/stdlib/lexing.mli index 2c4c53da1..6729c9ec1 100644 --- a/stdlib/lexing.mli +++ b/stdlib/lexing.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Lexing]: the run-time library for lexers generated by [camllex] *) (*** Lexer buffers *) diff --git a/stdlib/list.ml b/stdlib/list.ml index f761e138f..ccc1aee74 100644 --- a/stdlib/list.ml +++ b/stdlib/list.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* List operations *) let rec length = function diff --git a/stdlib/list.mli b/stdlib/list.mli index 14cff7949..a649bff2f 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [List]: list operations *) val length : 'a list -> int diff --git a/stdlib/map.ml b/stdlib/map.ml index 40ebdfaef..1e7338bf2 100644 --- a/stdlib/map.ml +++ b/stdlib/map.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + module type OrderedType = sig type t diff --git a/stdlib/map.mli b/stdlib/map.mli index aaf21834b..99b2dd2db 100644 --- a/stdlib/map.mli +++ b/stdlib/map.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Map]: association tables over ordered types *) (* This module implements applicative association tables, also known as diff --git a/stdlib/obj.ml b/stdlib/obj.ml index 8fe21c7f6..af7ac7b7d 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Operations on internal representations of values *) type t diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 602ea4b7c..a37e8a266 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Obj]: operations on internal representations of values *) (* Not for the casual user. *) diff --git a/stdlib/parsing.ml b/stdlib/parsing.ml index 446ee2665..57abf7365 100644 --- a/stdlib/parsing.ml +++ b/stdlib/parsing.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* The parsing engine *) open Lexing diff --git a/stdlib/parsing.mli b/stdlib/parsing.mli index 62201b2c9..31ebb048c 100644 --- a/stdlib/parsing.mli +++ b/stdlib/parsing.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Parsing]: the run-time library for parsers generated by [camlyacc]*) val symbol_start : unit -> int diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml index 18b80e251..277cb8087 100644 --- a/stdlib/pervasives.ml +++ b/stdlib/pervasives.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Exceptions *) external raise : exn -> 'a = "%raise" diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 01c7ba174..6628df82e 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Pervasives]: the initially opened module *) (* This module provides the built-in types (numbers, booleans, diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml index 6d00535bb..ffb0b2451 100644 --- a/stdlib/printexc.ml +++ b/stdlib/printexc.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + let print_exn = function Out_of_memory -> prerr_string "Out of memory\n" diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli index 864f1ac84..4c6c027e8 100644 --- a/stdlib/printexc.mli +++ b/stdlib/printexc.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Printexc]: a catch-all exception handler *) val catch: ('a -> 'b) -> 'a -> 'b diff --git a/stdlib/printf.ml b/stdlib/printf.ml index 34f0b5438..cc49e0c0d 100644 --- a/stdlib/printf.ml +++ b/stdlib/printf.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + external format_int: string -> int -> string = "format_int" external format_float: string -> float -> string = "format_float" diff --git a/stdlib/printf.mli b/stdlib/printf.mli index 2a2251357..d167bfd96 100644 --- a/stdlib/printf.mli +++ b/stdlib/printf.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Printf]: formatting printing functions *) val fprintf: out_channel -> ('a, out_channel, unit) format -> 'a diff --git a/stdlib/queue.ml b/stdlib/queue.ml index 977a26338..c239865ea 100644 --- a/stdlib/queue.ml +++ b/stdlib/queue.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + exception Empty type 'a queue_cell = diff --git a/stdlib/queue.mli b/stdlib/queue.mli index 45fcb2c1e..3c5323963 100644 --- a/stdlib/queue.mli +++ b/stdlib/queue.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Queues]: queues *) (* This module implements queues (FIFOs), with in-place modification. *) diff --git a/stdlib/set.ml b/stdlib/set.ml index f0434f265..e7aa9d643 100644 --- a/stdlib/set.ml +++ b/stdlib/set.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Sets over ordered types *) module type OrderedType = diff --git a/stdlib/set.mli b/stdlib/set.mli index 53debbca2..899226127 100644 --- a/stdlib/set.mli +++ b/stdlib/set.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Set]: sets over ordered types *) (* This module implements the set data structure, given a total ordering diff --git a/stdlib/sort.ml b/stdlib/sort.ml index 1b694bfff..d4b6ad0b1 100644 --- a/stdlib/sort.ml +++ b/stdlib/sort.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Merging and sorting *) let rec merge order l1 l2 = diff --git a/stdlib/sort.mli b/stdlib/sort.mli index 1378d0720..a64d7db99 100644 --- a/stdlib/sort.mli +++ b/stdlib/sort.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Sort]: sorting and merging lists *) val list : ('a -> 'a -> bool) -> 'a list -> 'a list diff --git a/stdlib/stack.ml b/stdlib/stack.ml index 8b1710cdd..c1f27b245 100644 --- a/stdlib/stack.ml +++ b/stdlib/stack.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + type 'a t = { mutable c : 'a list } exception Empty diff --git a/stdlib/stack.mli b/stdlib/stack.mli index 03463a1ec..ad10e1037 100644 --- a/stdlib/stack.mli +++ b/stdlib/stack.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Stack]: stacks *) (* This modl implements stacks (LIFOs), with in-place modification. *) diff --git a/stdlib/string.ml b/stdlib/string.ml index 4365f9d04..771813bed 100644 --- a/stdlib/string.ml +++ b/stdlib/string.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* String operations *) external length : string -> int = "%string_length" diff --git a/stdlib/string.mli b/stdlib/string.mli index fe1b2497c..7fe385f4e 100644 --- a/stdlib/string.mli +++ b/stdlib/string.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [String]: string operations *) external length : string -> int = "%string_length" diff --git a/stdlib/sys.ml b/stdlib/sys.ml index 79a40d9b3..40958323e 100644 --- a/stdlib/sys.ml +++ b/stdlib/sys.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* System interface *) external get_argv: unit -> string array = "sys_get_argv" diff --git a/stdlib/sys.mli b/stdlib/sys.mli index 3fb694d2b..59c2079bc 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Module [Sys]: system interface *) val argv: string array |