camlspotter avatar camlspotter committed 98c0f8b

ocaml-4.00.0+beta2-12699

Comments (0)

Files changed (94)

0scripts/0CHECKOUT-SVN-specific

+#!/bin/sh
+# rev 11110
+VERSION=4.00
+hg update -C ocaml-svn-copy
+/bin/rm -rf [A-z]* \#*
+svn co http://caml.inria.fr/svn/ocaml/version/$VERSION/
+(cd $VERSION; tar cf - .) | tar xvf -
+/bin/rm -rf $VERSION
+hg rm `hg status | grep '^!' | awk '{ print $2 }'`
+hg add [A-z]*
+echo OCaml $VERSION svn source is copied. Now ready to commit.
 - New tool: ocamloptp, the equivalent of ocamlcp for the native-code compiler.
 
 OCamldoc:
+- PR#5645: ocamldoc doesn't handle module/type substitution in signatures
 - PR#5544: improve HTML output (less formatting in html code)
 - PR#5522: allow refering to record fields and variant constructors
 - fix PR#5419 (error message in french)
     . Fixed behavior of generic hash function w.r.t. -0.0 and NaN (PR#5222)
     . Added optional "random" parameter to Hashtbl.create to randomize
       collision patterns and improve security (PR#5572, CVE-2012-0839)
-    . Added "randomize" function and "R" parameter to OCAMLRUNPARAMS
+    . Added "randomize" function and "R" parameter to OCAMLRUNPARAM
       to turn randomization on by default (PR#5572, CVE-2012-0839)
     . Added new functorial interface "MakeSeeded" to support randomization
       with user-provided seeded hash functions.
 - PR#3571: in Bigarrays, call msync() before unmapping to commit changes
 - PR#4292: various documentation problems
 - PR#4511, PR#4838: local modules remove polymorphism
-- PR#4549: Filename.dirname is not handling multiple / on Unix
+* PR#4549: Filename.dirname is not handling multiple / on Unix
 - PR#4688: (Windows) special floating-point values aren't converted to strings
   correctly
 - PR#4697: Unix.putenv leaks memory on failure
 - PR#4892: Array.set could raise "out of bounds" before evaluating 3rd arg
 - PR#4937: camlp4 incorrectly handles optional arguments if 'option' is
   redefined
-- PR#5024: camlp4r now handles underscores in irrefutable patern matching of
-           records
+- PR#5024: camlp4r now handles underscores in irrefutable pattern matching of
+  records
 - PR#5064, PR#5485: try to ensure that 4K words of stack are available
   before calling into C functions, raising a Stack_overflow exception
   otherwise.  This reduces (but does not eliminate) the risk of
   segmentation faults due to stack overflow in C code
+- PR#5073: wrong location for 'Unbound record field label' error
 - PR#5084: sub-sub-module building fails for native code compilation
 - PR#5120: fix the output function of Camlp4.Debug.formatter
+- PR#5131: compilation of custom runtime with g++ generates lots of warnings
+- PR#5137: caml-types-explore does not work
 - PR#5159: better documentation of type Lexing.position
 - PR#5171: Map.join does more comparisons than needed
 - PR#5176: emacs mode: stack overflow in regexp matcher
 - PR#5179: port OCaml to mingw-w64
 - PR#5211: updated Genlex documentation to state that camlp4 is mandatory for
   'parser' keyword and associated notation
+- PR#5218: use $(MAKE) instead of "make" in Makefiles
 - PR#5224: confusing error message in non-regular type definition
 - PR#5231: camlp4: fix parsing of <:str_item< type t = $x$ >>
+- PR#5233: finaliser on weak array gives dangling pointers (crash)
 - PR#5238, PR#5277: Sys_error when getting error location
 - PR#5261, PR#5497: Ocaml source-code examples are not "copy-paste-able"
+* PR#5279: executable name is not initialized properly in caml_startup_code
 - PR#5290: added hash functions for channels, nats, mutexes, conditions
 - PR#5295: OS threads: problem with caml_c_thread_unregister()
 - PR#5301: camlp4r and exception equal to another one with parameters
 - PR#5309: Queue.add is not thread/signal safe
 - PR#5310: Ratio.create_ratio/create_normalized_ratio have misleading names
 - PR#5311: better message for warning 23
+* PR#5312: command-line arguments @reponsefile auto-expansion feature
+  removed from the Windows OCaml runtime, to avoid conflicts with "-w @..."
 - PR#5313: ocamlopt -g misses optimizations
 - PR#5316: objinfo now shows ccopts/ccobjs/force_link when applicable
 - PR#5318: segfault on stack overflow when reading marshaled data
 - PR#5616: move ocamlbuild documentation to the reference manual
 - PR#5619: Uncaught CType.Unify exception in the compiler
 - PR#5620: invalid printing of type manifest (camlp4 revised syntax)
+- PR#5637: invalid printing of anonymous type parameters (camlp4 revised syntax)
+- PR#5643: issues with .cfi and .loc directives generated by ocamlopt -g
+- PR#5644: Stream.count broken when used with Sapp or Slazy nodes
+- PR#5647: Cannot use install_printer in debugger
+- PR#5651: printer for abstract data type (camlp4 revised syntax)
+- PR#5655: ocamlbuild doesn't pass cflags when building C stubs
+- PR#5661: fixes for the test suite
+- PR#5671: initialization of compare_ext field in caml_final_custom_operations()
+- PR#5677: do not use "value" as identifier (genprintval.ml)
 - problem with printing of string literals in camlp4 (reported on caml-list)
 - emacs mode: colorization of comments and strings now works correctly
 - problem with forall and method (reported on caml-list on 2011-07-26)
 - PR#5215: marshalling of dynlinked closure
 - PR#5236: new '%revapply' primitive with the semantics 'revapply x f = f x',
     and '%apply' with semantics 'apply f x = f x'.
+- PR#5255: natdynlink detection on powerpc, hurd, sparc
 - PR#5295: OS threads: problem with caml_c_thread_unregister()
 - PR#5297: compiler now checks existence of builtin primitives
 - PR#5329: (Windows) more efficient Unix.select if all fd's are sockets
+- PR#5357: warning for useless open statements
 - PR#5358: first class modules don't allow "with type" declarations for types
   in sub-modules
 - PR#5385: configure: emit a warning when MACOSX_DEPLOYMENT_TARGET is set
 - PR#5420: Unix.openfile share mode (Windows)
 - PR#5421: Unix: do not leak fds in various open_proc* functions
 - PR#5434: implement Unix.times in win32unix (partially)
-- PR#5437: warning for useless open statements
 - PR#5438: new warnings for unused declarations
 - PR#5439: upgrade config.guess and config.sub
 - PR#5445 and others: better printing of types with user-provided names
 - PR#5555: add function Hashtbl.reset to resize the bucket table to
   its initial size.
 - PR#5586: increase UNIX_BUFFER_SIZE to 64KiB
+- PR#5597: register names for instrtrace primitives in embedded bytecode
 - PR#5599: Add warn() tag in ocamlbuild to control -w compiler switch
+- PR#5628: add #remove_directory and Topdirs.remove_directory to remove
+  a directory from the load path
+- PR#5636: in system threads library, issue with linking of pthread_atfork
+- PR#5666: C includes don't provide a revision number
 - ocamldebug: ability to inspect values that contain code pointers
 - ocamldebug: new 'environment' directive to set environment variables
   for debuggee
   For Sun Solaris with the "acc" compiler:
     ./configure -cc "acc -fast" -libs "-lucb"
 
+  For Sun Solaris on Sparc 64bit, to compile natively (32bit only)
+    ./configure -cc "gcc -m32" -as "as -32" -aspp "gcc -m32 -c"
+
   For AIX 4.3 with the IBM compiler xlc:
     ./configure -cc "xlc_r -D_AIX43 -Wl,-bexpall,-brtl -qmaxmem=8192"
 
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 12511 2012-05-30 13:29:48Z lefessan $
+# $Id: Makefile 12692 2012-07-10 15:20:34Z doligez $
 
 # The main Makefile
 
 toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa
 
 otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/natdynlink.ml
-	cd otherlibs/dynlink && make allopt
+	cd otherlibs/dynlink && $(MAKE) allopt
 
 # The configuration file
 
 
 package-macosx:
 	sudo rm -rf package-macosx/root
-	make PREFIX="`pwd`"/package-macosx/root install
+	$(MAKE) PREFIX="`pwd`"/package-macosx/root install
 	tools/make-package-macosx
 	sudo rm -rf package-macosx/root
 
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile.nt 12511 2012-05-30 13:29:48Z lefessan $
+# $Id: Makefile.nt 12692 2012-07-10 15:20:34Z doligez $
 
 # The main Makefile
 
 	cp ocamlc.opt $(BINDIR)/ocamlc.opt$(EXE)
 	cp ocamlopt.opt $(BINDIR)/ocamlopt.opt$(EXE)
 	cp lex/ocamllex.opt $(BINDIR)/ocamllex.opt$(EXE)
-	cp compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.a \
-	 compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.a \
-	 compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.a \
+	cp compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.$(A) \
+	 compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.$(A) \
+	 compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.$(A) \
 	 $(COMPLIBDIR)
 
 clean:: partialclean
 toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa
 
 otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/natdynlink.ml
-	cd otherlibs/dynlink && make allopt
+	cd otherlibs/dynlink && $(MAKE) allopt
 
 
 # The configuration file
 compilerlibs/ocamlcommon.cmxa: $(COMMON:.cmo=.cmx)
 	$(CAMLOPT) -a -o $@ $(COMMON:.cmo=.cmx)
 partialclean::
-	rm -f compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.a
+	rm -f compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.$(A)
 
 # The bytecode compiler compiled with the native-code compiler
 
 compilerlibs/ocamlbytecomp.cmxa: $(BYTECOMP:.cmo=.cmx)
 	$(CAMLOPT) -a -o $@ $(BYTECOMP:.cmo=.cmx)
 partialclean::
-	rm -f compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.a
+	rm -f compilerlibs/ocamlbytecomp.cmxa compilerlibs/ocamlbytecomp.$(A)
 
 ocamlc.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa $(BYTESTART:.cmo=.cmx)
 	$(CAMLOPT) $(LINKFLAGS) -ccopt "$(BYTECCLINKOPTS)" -o ocamlc.opt \
 compilerlibs/ocamloptcomp.cmxa: $(ASMCOMP:.cmo=.cmx)
 	$(CAMLOPT) -a -o $@ $(ASMCOMP:.cmo=.cmx)
 partialclean::
-	rm -f compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.a
+	rm -f compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamloptcomp.$(A)
 
 ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa $(OPTSTART:.cmo=.cmx)
 	$(CAMLOPT) $(LINKFLAGS) -o ocamlopt.opt \
-4.00.0+beta2
+4.00.0+dev20_2012-06-04
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
 
-# $Id: VERSION 12567 2012-06-04 17:01:09Z doligez $
+# $Id: VERSION 12568 2012-06-04 17:02:56Z doligez $

asmcomp/amd64/emit.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit.mlp 12448 2012-05-12 09:49:40Z xleroy $ *)
+(* $Id: emit.mlp 12664 2012-07-09 08:35:23Z lefessan $ *)
 
 (* Emission of x86-64 (AMD 64) assembly code *)
 
         if alloc then begin
           `	{load_symbol_addr s}, %rax\n`;
           `	{emit_call "caml_c_call"}\n`;
-          record_frame i.live i.dbg
+          record_frame i.live i.dbg;
+          `	{load_symbol_addr "caml_young_ptr"}, %r11\n`;
+          `	movq    (%r11), %r15\n`;
         end else begin
           `	{emit_call s}\n`
         end

asmcomp/debuginfo.ml

   dinfo_char_end = 0
 }
 
+(* PR#5643: cannot use (==) because Debuginfo values are marshalled *)
 let is_none t =
-  t == none
+  t = none
 
 let to_string d =
-  if d == none
+  if d = none
   then ""
   else Printf.sprintf "{%s:%d,%d-%d}"
            d.dinfo_file d.dinfo_line d.dinfo_char_start d.dinfo_char_end

asmcomp/debuginfo.mli

 
 type kind = Dinfo_call | Dinfo_raise
 
-type t = {
+type t = private {
   dinfo_kind: kind;
   dinfo_file: string;
   dinfo_line: int;

asmcomp/emitaux.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emitaux.ml 12448 2012-05-12 09:49:40Z xleroy $ *)
+(* $Id: emitaux.ml 12699 2012-07-11 15:26:15Z lefessan $ *)
 
 (* Common functions for emitting assembly code *)
 
   let x = Int32.bits_of_float (float_of_string f) in
   emit_printf "\t%s\t0x%lx\n" directive x
 
-(* Emit debug information *)
-
-(* This assoc list is expected to be very short *)
-let file_pos_nums =
-  (ref [] : (string * int) list ref)
-
-(* Number of files *)
-let file_pos_num_cnt = ref 1
-
-(* Reset debug state at beginning of asm file *)
-let reset_debug_info () =
-  file_pos_nums := [];
-  file_pos_num_cnt := 1
-
-(* We only diplay .file if the file has not been seen before. We
-   display .loc for every instruction. *)
-let emit_debug_info dbg =
-  if !Clflags.debug && not (Debuginfo.is_none dbg) then (
-    let line = dbg.Debuginfo.dinfo_line in
-    let file_name = dbg.Debuginfo.dinfo_file in
-    let file_num =
-      try List.assoc file_name !file_pos_nums
-      with Not_found ->
-        let file_num = !file_pos_num_cnt in
-        incr file_pos_num_cnt;
-        emit_string "	.file	";
-        emit_int file_num; emit_char '	';
-        emit_string_literal file_name; emit_char '\n';
-        file_pos_nums := (file_name,file_num) :: !file_pos_nums;
-        file_num in
-    emit_string "	.loc	";
-    emit_int file_num; emit_char '	';
-    emit_int line; emit_char '\n'
-  )
-
 (* Record live pointers at call points *)
 
 type frame_descr =
       lbl in
   let emit_frame fd =
     a.efa_label fd.fd_lbl;
-    a.efa_16 (if fd.fd_debuginfo == Debuginfo.none
+    a.efa_16 (if Debuginfo.is_none fd.fd_debuginfo
               then fd.fd_frame_size
               else fd.fd_frame_size + 1);
     a.efa_16 (List.length fd.fd_live_offset);
     List.iter a.efa_16 fd.fd_live_offset;
     a.efa_align Arch.size_addr;
-    if fd.fd_debuginfo != Debuginfo.none then begin
+    if not (Debuginfo.is_none fd.fd_debuginfo) then begin
       let d = fd.fd_debuginfo in
       let line = min 0xFFFFF d.dinfo_line
       and char_start = min 0xFF d.dinfo_char_start
 (* CFI directives *)
 
 let is_cfi_enabled () =
-  !Clflags.debug && Config.asm_cfi_supported
+  Config.asm_cfi_supported
 
 let cfi_startproc () =
   if is_cfi_enabled () then
   begin
     emit_string "	.cfi_adjust_cfa_offset	"; emit_int n; emit_string "\n";
   end
- 
+
+(* Emit debug information *)
+
+(* This assoc list is expected to be very short *)
+let file_pos_nums =
+  (ref [] : (string * int) list ref)
+
+(* Number of files *)
+let file_pos_num_cnt = ref 1
+
+(* Reset debug state at beginning of asm file *)
+let reset_debug_info () =
+  file_pos_nums := [];
+  file_pos_num_cnt := 1
+
+(* We only diplay .file if the file has not been seen before. We
+   display .loc for every instruction. *)
+let emit_debug_info dbg =
+  if is_cfi_enabled () &&
+    !Clflags.debug && not (Debuginfo.is_none dbg) then begin
+    let line = dbg.Debuginfo.dinfo_line in
+    assert (line <> 0); (* clang errors out on zero line numbers *)
+    let file_name = dbg.Debuginfo.dinfo_file in
+    let file_num =
+      try List.assoc file_name !file_pos_nums
+      with Not_found ->
+        let file_num = !file_pos_num_cnt in
+        incr file_pos_num_cnt;
+        emit_string "	.file	";
+        emit_int file_num; emit_char '	';
+        emit_string_literal file_name; emit_char '\n';
+        file_pos_nums := (file_name,file_num) :: !file_pos_nums;
+        file_num in
+    emit_string "	.loc	";
+    emit_int file_num; emit_char '	';
+    emit_int line; emit_char '\n'
+  end

asmcomp/power/arch.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arch.ml 12187 2012-02-24 10:13:02Z xleroy $ *)
+(* $Id: arch.ml 12583 2012-06-07 12:19:23Z xleroy $ *)
 
 (* Specific operations for the PowerPC processor *)
 
 
 (* Behavior of division *)
 
-let division_crashes_on_overflow = false
+let division_crashes_on_overflow = true
 
 (* Operations on addressing modes *)
 

asmcomp/printlinear.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printlinear.ml 12179 2012-02-21 17:41:02Z xleroy $ *)
+(* $Id: printlinear.ml 12610 2012-06-17 08:15:25Z xleroy $ *)
 
 (* Pretty-printing of linearized machine code *)
 
   | Lraise ->
       fprintf ppf "raise %a" reg i.arg.(0)
   end;
-  if i.dbg != Debuginfo.none then
+  if not (Debuginfo.is_none i.dbg) then
     fprintf ppf " %s" (Debuginfo.to_string i.dbg)
 
 let rec all_instr ppf i =
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: amd64.S 12179 2012-02-21 17:41:02Z xleroy $ */
+/* $Id: amd64.S 12664 2012-07-09 08:35:23Z lefessan $ */
 
 /* Asm part of the runtime system, AMD64 processor */
 /* Must be preprocessed by cpp */
 
 #if defined(SYS_macosx)
 
-#define LBL(x) L##x	
+#define LBL(x) L##x
 #define G(r) _##r
 #define GREL(r) _##r@GOTPCREL
 #define GCALL(r) _##r
         name:
 
 #elif defined(SYS_mingw64)
-	
-#define LBL(x) .L##x	
+
+#define LBL(x) .L##x
 #define G(r) r
 #undef  GREL
 #define GCALL(r) r
 
 #else
 
-#define LBL(x) .L##x	
+#define LBL(x) .L##x
 #define G(r) r
 #define GREL(r) r@GOTPCREL
 #define GCALL(r) r@PLT
 #define CFI_ENDPROC
 #define CFI_ADJUST(n)
 #endif
-        
+
 #if defined(__PIC__) && !defined(SYS_mingw64)
 
 /* Position-independent operations on global variables. */
 	popq    %r11
 
 #else
-        
+
 /* Non-PIC operations on global variables.  Slightly faster. */
 
 #define STORE_VAR(srcreg,dstlabel) \
 
 #endif
 
-/* Save and restore all callee-save registers on stack.  
+/* Save and restore all callee-save registers on stack.
    Keep the stack 16-aligned. */
 
-#if defined(SYS_mingw64)	
+#if defined(SYS_mingw64)
 
 /* Win64 API: callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 */
 
         popq    %rbp; \
         popq    %rbx
 
-#endif	
+#endif
 
 #ifdef SYS_mingw64
    /* Calls from OCaml to C must reserve 32 bytes of extra stack space */
-#  define PREPARE_FOR_C_CALL subq $32, %rsp	
+#  define PREPARE_FOR_C_CALL subq $32, %rsp
 #  define CLEANUP_AFTER_C_CALL addq $32, %rsp
 #else
 #  define PREPARE_FOR_C_CALL
         popq    %r12
         STORE_VAR(%r12, caml_last_return_address)
         STORE_VAR(%rsp, caml_bottom_of_stack)
+        pushq    %r12
 #ifndef SYS_mingw64
     /* Touch the stack to trigger a recoverable segfault
        if insufficient space remains */
     /* Call the function (address in %rax) */
     /* No need to PREPARE_FOR_C_CALL since the caller already
        reserved the stack space if needed (cf. amd64/proc.ml) */
-        call    *%rax
-    /* Reload alloc ptr */
-	LOAD_VAR(caml_young_ptr, %r15)
-    /* Return to caller */
-	pushq	%r12
-	ret
+        jmp    *%rax
 
 /* Start the OCaml program */
 

Binary file modified.

Binary file modified.

Binary file modified.

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: dll.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: dll.ml 12661 2012-07-07 11:41:17Z scherer $ *)
 
 (* Handling of dynamically-linked libraries *)
 
 let add_path dirs =
   search_path := dirs @ !search_path
 
+let remove_path dirs =
+  search_path := List.filter (fun d -> not (List.mem d dirs)) !search_path
+
 (* Extract the name of a DLLs from its external name (xxx.so or -lxxx) *)
 
 let extract_dll_name file =
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: dll.mli 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: dll.mli 12661 2012-07-07 11:41:17Z scherer $ *)
 
 (* Handling of dynamically-linked libraries *)
 
 (* Add the given directories at the head of the search path for DLLs *)
 val add_path: string list -> unit
 
+(* Remove the given directories from the search path for DLLs *)
+val remove_path: string list -> unit
+
 (* Initialization for separate compilation.
    Initialize the DLL search path to the directories given in the
    environment variable CAML_LD_LIBRARY_PATH, plus contents of ld.conf file

bytecomp/symtable.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: symtable.ml 11306 2011-12-13 17:50:08Z frisch $ *)
+(* $Id: symtable.ml 12629 2012-06-21 15:55:03Z doligez $ *)
 
 (* To assign numbers to globals and primitives *)
 
     fprintf outchan "  %s,\n" prim.(i)
   done;
   fprintf outchan "  (primitive) 0 };\n";
-  fprintf outchan "char * caml_names_of_builtin_cprim[] = {\n";
+  fprintf outchan "const char * caml_names_of_builtin_cprim[] = {\n";
   for i = 0 to Array.length prim - 1 do
     fprintf outchan "  \"%s\",\n" prim.(i)
   done;

bytecomp/translcore.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: translcore.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: translcore.ml 12681 2012-07-10 08:33:16Z garrigue $ *)
 
 (* Translation from typed abstract syntax to lambda terms,
    for the core language *)
       [pat, exp]
   | (pat, exp) :: _ when bindings <> [] ->
       let param = name_pattern "param" pat_expr_list in
+      let name = Ident.name param in
       let exp =
         { exp with exp_loc = loc; exp_desc =
           Texp_match
             ({exp with exp_type = pat.pat_type; exp_desc =
-              Texp_ident (Path.Pident param, mknoloc (Longident.Lident "param"),
+              Texp_ident (Path.Pident param, mknoloc (Longident.Lident name),
                           {val_type = pat.pat_type; val_kind = Val_reg;
                            Types.val_loc = Location.none;
                           })},
              pat_expr_list, partial) }
       in
       push_defaults loc bindings
-        [{pat with pat_desc = Tpat_var (param, mknoloc "param")}, exp] Total
+        [{pat with pat_desc = Tpat_var (param, mknoloc name)}, exp] Total
   | _ ->
       pat_expr_list
 
           cl_loc = e.exp_loc;
           cl_type = Cty_signature cty;
           cl_env = e.exp_env }
-  | Texp_poly (exp, _ )
-  | Texp_newtype (_, exp)
-    -> transl_exp exp
 
 and transl_list expr_list =
   List.map transl_exp expr_list
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 12567 2012-06-04 17:01:09Z doligez $
+# $Id: Makefile 12566 2012-06-04 16:33:59Z doligez $
 
 include Makefile.common
 

byterun/compact.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: compact.c 12524 2012-05-31 11:50:51Z doligez $ */
+/* $Id: compact.c 12621 2012-06-20 15:39:09Z doligez $ */
 
 #include <string.h>
 
 
 void caml_compact_heap (void)
 {
-  uintnat target_size;
+  uintnat target_size, live;
 
   do_compaction ();
   /* Compaction may fail to shrink the heap to a reasonable size
   /* We compute:
      freewords = caml_fl_cur_size          (exact)
      heapsize = caml_heap_size             (exact)
-     usedwords = heap_size - freewords
-     target_size = usedwords * (1 + caml_percent_free / 100)
+     live = heap_size - freewords
+     target_size = live * (1 + caml_percent_free / 100)
+                 = live / 100 * (100 + caml_percent_free)
+     We add 1 to live/100 to make sure it isn't 0.
 
      We recompact if target_size < heap_size / 2
   */
-  target_size = (caml_stat_heap_size - Bsize_wsize (caml_fl_cur_size))
-                * (100 + caml_percent_free) / 100;
+  live = caml_stat_heap_size - Bsize_wsize (caml_fl_cur_size);
+  target_size = (live / 100 + 1) * (100 + caml_percent_free);
   target_size = caml_round_heap_chunk_size (target_size);
   if (target_size < caml_stat_heap_size / 2){
     char *chunk;
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: custom.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: custom.c 12658 2012-07-06 16:44:24Z xleroy $ */
 
 #include <string.h>
 
   ops->hash = custom_hash_default;
   ops->serialize = custom_serialize_default;
   ops->deserialize = custom_deserialize_default;
+  ops->compare_ext = custom_compare_ext_default;
   l = caml_stat_alloc(sizeof(struct custom_operations_list));
   l->ops = ops;
   l->next = custom_ops_final_table;

byterun/dynlink.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: dynlink.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: dynlink.c 12677 2012-07-09 14:15:48Z doligez $ */
 
 /* Dynamic loading of C primitives. */
 
 {
   int i;
   caml_ext_table_init(&caml_prim_table, 0x180);
-  for (i = 0; caml_builtin_cprim[i] != 0; i++)
+#ifdef DEBUG
+  caml_ext_table_init(&caml_prim_name_table, 0x180);
+#endif
+  for (i = 0; caml_builtin_cprim[i] != 0; i++) {
     caml_ext_table_add(&caml_prim_table, (void *) caml_builtin_cprim[i]);
+#ifdef DEBUG
+    caml_ext_table_add(&caml_prim_name_table, strdup(caml_names_of_builtin_cprim[i]));
+#endif
+}
 }
 
 #endif /* NATIVE_CODE */
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: io.c 12149 2012-02-10 16:15:24Z doligez $ */
+/* $Id: io.c 12641 2012-06-25 12:02:16Z lefessan $ */
 
 /* Buffered input/output. */
 
   do {
     caml_enter_blocking_section();
     retcode = read(fd, p, n);
+#if defined(_WIN32)
+    if (retcode == -1 && errno == ENOMEM && n > 16384){
+      retcode = read(fd, p, 16384);
+    }
+#endif
     caml_leave_blocking_section();
   } while (retcode == -1 && errno == EINTR);
   if (retcode == -1) caml_sys_io_error(NO_ARG);

byterun/major_gc.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: major_gc.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: major_gc.c 12625 2012-06-21 13:43:03Z doligez $ */
 
 #include <limits.h>
 
           weak_prev = &Field (cur, 0);
           work -= Whsize_hd (hd);
         }else{
-          /* Subphase_weak1 is done.  Start removing dead weak arrays. */
+          /* Subphase_weak1 is done.
+             Handle finalised values and start removing dead weak arrays. */
+          gray_vals_cur = gray_vals_ptr;
+          caml_final_update ();
+          gray_vals_ptr = gray_vals_cur;
           caml_gc_subphase = Subphase_weak2;
           weak_prev = &caml_weak_list_head;
         }
           }
           work -= 1;
         }else{
-          /* Subphase_weak2 is done.  Handle finalised values. */
-          gray_vals_cur = gray_vals_ptr;
-          caml_final_update ();
-          gray_vals_ptr = gray_vals_cur;
+          /* Subphase_weak2 is done.  Go to Subphase_final. */
           caml_gc_subphase = Subphase_final;
         }
       }

byterun/startup.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: startup.c 12215 2012-03-10 01:46:37Z meyer $ */
+/* $Id: startup.c 12687 2012-07-10 12:11:46Z doligez $ */
 
 /* Start-up code */
 
 {
   value res;
   char* cds_file;
+  char * exe_name;
+#ifdef __linux__
+  static char proc_self_exe[256];
+#endif
 
   caml_init_ieee_floats();
   caml_init_custom_operations();
     strcpy(caml_cds_file, cds_file);
   }
   parse_camlrunparam();
+  exe_name = argv[0];
+#ifdef __linux__
+  if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0)
+    exe_name = proc_self_exe;
+#endif
   caml_external_raise = NULL;
   /* Initialize the abstract machine */
   caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
   caml_section_table_size = section_table_size;
   /* Initialize system libraries */
   caml_init_exceptions();
-  caml_sys_init("", argv);
+  caml_sys_init(exe_name, argv);
   /* Execute the program */
   caml_debugger(PROGRAM_START);
   res = caml_interprete(caml_start_code, caml_code_size);
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: win32.c 12242 2012-03-14 15:27:58Z xleroy $ */
+/* $Id: win32.c 12686 2012-07-10 11:34:39Z scherer $ */
 
 /* Win32-specific stuff */
 
 static void store_argument(char * arg);
 static void expand_argument(char * arg);
 static void expand_pattern(char * arg);
-static void expand_diversion(char * filename);
 
 static void out_of_memory(void)
 {
 {
   char * p;
 
-  if (arg[0] == '@') {
-    expand_diversion(arg + 1);
-    return;
-  }
   for (p = arg; *p != 0; p++) {
     if (*p == '*' || *p == '?') {
       expand_pattern(arg);
   _findclose(handle);
 }
 
-static void expand_diversion(char * filename)
-{
-  struct _stat stat;
-  int fd;
-  char * buf, * endbuf, * p, * q, * s;
-  int inquote;
-
-  if (_stat(filename, &stat) == -1 ||
-      (fd = _open(filename, O_RDONLY | O_BINARY, 0)) == -1) {
-    fprintf(stderr, "Cannot open file %s\n", filename);
-    exit(2);
-  }
-  buf = (char *) malloc(stat.st_size + 1);
-  if (buf == NULL) out_of_memory();
-  _read(fd, buf, stat.st_size);
-  endbuf = buf + stat.st_size;
-  _close(fd);
-  for (p = buf; p < endbuf; /*nothing*/) {
-    /* Skip leading blanks */
-    while (p < endbuf && isspace(*p)) p++;
-    if (p >= endbuf) break;
-    s = p;
-    /* Skip to end of argument, taking quotes into account */
-    q = s;
-    inquote = 0;
-    while (p < endbuf) {
-      if (! inquote) {
-        if (isspace(*p)) break;
-        if (*p == '"') { inquote = 1; p++; continue; }
-        *q++ = *p++;
-      } else {
-        switch (*p) {
-          case '"':
-            inquote = 0; p++; continue;
-          case '\\':
-            if (p + 4 <= endbuf && strncmp(p, "\\\\\\\"", 4) == 0) {
-              p += 4; *q++ = '\\'; *q++ = '"'; continue;
-            }
-            if (p + 3 <= endbuf && strncmp(p, "\\\\\"", 3) == 0) {
-              p += 3; *q++ = '\\'; inquote = 0; continue;
-            }
-            if (p + 2 <= endbuf && p[1] == '"') {
-              p += 2; *q++ = '"'; continue;
-            }
-            /* fallthrough */
-        default:
-          *q++ = *p++;
-        }
-      }
-    }
-    /* Delimit argument and expand it */
-    *q++ = 0;
-    expand_argument(s);
-    p++;
-  }
-}
 
 CAMLexport void caml_expand_command_line(int * argcp, char *** argvp)
 {

camlp4/Camlp4/Printers/OCaml.ml

           "Cannot print %S this identifier does not respect OCaml lexing rules (%s)"
           str (Lexer.Error.to_string exn)) ];
 
-  value ocaml_char x =
-      match x with [ "'" -> "\\'" | c -> c ];
+  (* This is to be sure character literals are always escaped. *)
+  value ocaml_char x = Char.escaped (Struct.Token.Eval.char x);
 
   value rec get_expr_args a al =
     match a with
       | <:binding< $b1$ and $b2$ >> ->
           do { o#binding f b1; pp f o#andsep; o#binding f b2 }
       | <:binding< $p$ = $e$ >> ->
-          let (pl, e) =
+          let (pl, e') =
             match p with
             [ <:patt< ($_$ : $_$) >> -> ([], e)
             | _ -> expr_fun_args e ] in
-          match (p, e) with
-          [ (<:patt< $lid:_$ >>, <:expr< ($e$ : $t$) >>) ->
+          match (p, e') with
+          [ (<:patt< $lid:_$ >>, <:expr< ($e'$ : $t$) >>) ->
               pp f "%a :@ %a =@ %a"
-                (list o#fun_binding "@ ") [`patt p::pl] o#ctyp t o#expr e
-          | _ -> pp f "%a @[<0>%a=@]@ %a" o#simple_patt
-                    p (list' o#fun_binding "" "@ ") pl o#expr e ]
+                (list o#fun_binding "@ ") [`patt p::pl] o#ctyp t o#expr e'
+          | (<:patt< $lid:_$ >>, _) ->
+              pp f "%a @[<0>%a=@]@ %a" o#simple_patt
+                p (list' o#fun_binding "" "@ ") pl o#expr e'
+          | _ ->
+              pp f "%a =@ %a" o#simple_patt p o#expr e ]
       | <:binding< $anti:s$ >> -> o#anti f s ];
 
     method record_binding f bi =
     | <:expr< $int64:s$ >> -> o#numeric f s "L"
     | <:expr< $int32:s$ >> -> o#numeric f s "l"
     | <:expr< $flo:s$ >> -> o#numeric f s ""
-    | <:expr< $chr:s$ >> -> pp f "'%s'" s
+    | <:expr< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
     | <:expr< $id:i$ >> -> o#var_ident f i
     | <:expr< { $b$ } >> ->
         pp f "@[<hv0>@[<hv2>{%a@]@ }@]" o#record_binding b
     | <:patt< $int32:s$ >> -> o#numeric f s "l"
     | <:patt< $int:s$ >> -> o#numeric f s ""
     | <:patt< $flo:s$ >> -> o#numeric f s ""
-    | <:patt< $chr:s$ >> -> pp f "'%s'" s
+    | <:patt< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
     | <:patt< ~ $s$ >> -> pp f "~%s" s
     | <:patt< ` $uid:s$ >> -> pp f "`%a" o#var s
     | <:patt< # $i$ >> -> pp f "@[<2>#%a@]" o#ident i

camlp4/Camlp4Filters/Camlp4MetaGenerator.ml

        let bi = mk_meta m in
        <:module_expr<
         struct
-          value meta_string _loc s = $m.str$ _loc s;
+          value meta_string _loc s = $m.str$ _loc (safe_string_escaped s);
           value meta_int _loc s = $m.int$ _loc s;
           value meta_float _loc s = $m.flo$ _loc s;
-          value meta_char _loc s = $m.chr$ _loc s;
+          value meta_char _loc s = $m.chr$ _loc (String.escaped s);
           value meta_bool _loc =
             fun
             [ False -> $m_uid m "False"$

camlp4/Camlp4Top/Rprint.ml

 ;
 
 value type_parameter ppf (ty, (co, cn)) =
-  fprintf ppf "%s'%s" (if not cn then "+" else if not co then "-" else "")
+  fprintf ppf "%s%s%s"
+    (if not cn then "+" else if not co then "-" else "")
+    (if ty = "_" then "" else "'")
     ty
 ;
 
           print_kind ty2
     | ty -> print_kind ppf ty ]
   in
-  fprintf ppf "@[<2>@[<hv 2>@[%s %t@] =%a@]%a@]" kwd type_defined
-    print_types ty print_constraints constraints
+  match ty with
+  [ Otyp_abstract ->
+      fprintf ppf "@[<2>@[<hv 2>@[%s %t@]@]%a@]" kwd type_defined
+	print_constraints constraints
+  | _ ->
+      fprintf ppf "@[<2>@[<hv 2>@[%s %t@] =%a@]%a@]" kwd type_defined
+	print_types ty print_constraints constraints ]
 ;
 
 (* Phrases *)

camlp4/boot/Camlp4.ml

               
             let skip_opt_linefeed (__strm : _ Stream.t) =
               match Stream.peek __strm with
-              | Some '\010' -> (Stream.junk __strm; ())
+              | Some '\n' -> (Stream.junk __strm; ())
               | _ -> ()
               
             let chr c =
               
             let rec backslash (__strm : _ Stream.t) =
               match Stream.peek __strm with
-              | Some '\010' -> (Stream.junk __strm; '\010')
-              | Some '\013' -> (Stream.junk __strm; '\013')
+              | Some '\n' -> (Stream.junk __strm; '\n')
+              | Some '\r' -> (Stream.junk __strm; '\r')
               | Some 'n' -> (Stream.junk __strm; '\n')
               | Some 'r' -> (Stream.junk __strm; '\r')
               | Some 't' -> (Stream.junk __strm; '\t')
               
             let rec backslash_in_string strict store (__strm : _ Stream.t) =
               match Stream.peek __strm with
-              | Some '\010' -> (Stream.junk __strm; skip_indent __strm)
-              | Some '\013' ->
+              | Some '\n' -> (Stream.junk __strm; skip_indent __strm)
+              | Some '\r' ->
                   (Stream.junk __strm;
                    let s = __strm in (skip_opt_linefeed s; skip_indent s))
               | _ ->
                       
                     module Expr =
                       struct
-                        let meta_string _loc s = Ast.ExStr (_loc, s)
+                        let meta_string _loc s =
+                          Ast.ExStr (_loc, (safe_string_escaped s))
                           
                         let meta_int _loc s = Ast.ExInt (_loc, s)
                           
                         let meta_float _loc s = Ast.ExFlo (_loc, s)
                           
-                        let meta_char _loc s = Ast.ExChr (_loc, s)
+                        let meta_char _loc s =
+                          Ast.ExChr (_loc, (String.escaped s))
                           
                         let meta_bool _loc =
                           function
                       
                     module Patt =
                       struct
-                        let meta_string _loc s = Ast.PaStr (_loc, s)
+                        let meta_string _loc s =
+                          Ast.PaStr (_loc, (safe_string_escaped s))
                           
                         let meta_int _loc s = Ast.PaInt (_loc, s)
                           
                         let meta_float _loc s = Ast.PaFlo (_loc, s)
                           
-                        let meta_char _loc s = Ast.PaChr (_loc, s)
+                        let meta_char _loc s =
+                          Ast.PaChr (_loc, (String.escaped s))
                           
                         let meta_bool _loc =
                           function
                        "Cannot print %S this identifier does not respect OCaml lexing rules (%s)"
                        str (Lexer.Error.to_string exn))
               
-            let ocaml_char x = match x with | "'" -> "\\'" | c -> c
+            let ocaml_char x = Char.escaped (Struct.Token.Eval.char x)
               
             let rec get_expr_args a al =
               match a with
                       | Ast.ExInt64 (_, s) -> o#numeric f s "L"
                       | Ast.ExInt32 (_, s) -> o#numeric f s "l"
                       | Ast.ExFlo (_, s) -> o#numeric f s ""
-                      | Ast.ExChr (_, s) -> pp f "'%s'" s
+                      | Ast.ExChr (_, s) -> pp f "'%s'" (ocaml_char s)
                       | Ast.ExId (_, i) -> o#var_ident f i
                       | Ast.ExRec (_, b, (Ast.ExNil _)) ->
                           pp f "@[<hv0>@[<hv2>{%a@]@ }@]" o#record_binding b
                       | Ast.PaInt32 (_, s) -> o#numeric f s "l"
                       | Ast.PaInt (_, s) -> o#numeric f s ""
                       | Ast.PaFlo (_, s) -> o#numeric f s ""
-                      | Ast.PaChr (_, s) -> pp f "'%s'" s
+                      | Ast.PaChr (_, s) -> pp f "'%s'" (ocaml_char s)
                       | Ast.PaLab (_, s, (Ast.PaNil _)) -> pp f "~%s" s
                       | Ast.PaVrn (_, s) -> pp f "`%a" o#var s
                       | Ast.PaTyp (_, i) -> pp f "@[<2>#%a@]" o#ident i
                            else ())
                       | Ast.TyCol (_, t1, (Ast.TyMut (_, t2))) ->
                           pp f "@[%a :@ mutable %a@]" o#ctyp t1 o#ctyp t2
+                      | Ast.TyMan (_, t1, t2) ->
+                          pp f "@[<2>%a ==@ %a@]" o#simple_ctyp t1 o#ctyp t2
                       | t -> super#ctyp f t
                 method simple_ctyp =
                   fun f t ->

camlp4/boot/Camlp4Ast.ml

             value meta_loc = meta_loc_expr;
             module Expr =
               struct
-                value meta_string _loc s = Ast.ExStr _loc s;
+                value meta_string _loc s =
+                  Ast.ExStr _loc (safe_string_escaped s);
                 value meta_int _loc s = Ast.ExInt _loc s;
                 value meta_float _loc s = Ast.ExFlo _loc s;
-                value meta_char _loc s = Ast.ExChr _loc s;
+                value meta_char _loc s = Ast.ExChr _loc (String.escaped s);
                 value meta_bool _loc =
                   fun
                   [ False -> Ast.ExId _loc (Ast.IdUid _loc "False")
             value meta_loc = meta_loc_patt;
             module Patt =
               struct
-                value meta_string _loc s = Ast.PaStr _loc s;
+                value meta_string _loc s =
+                  Ast.PaStr _loc (safe_string_escaped s);
                 value meta_int _loc s = Ast.PaInt _loc s;
                 value meta_float _loc s = Ast.PaFlo _loc s;
-                value meta_char _loc s = Ast.PaChr _loc s;
+                value meta_char _loc s = Ast.PaChr _loc (String.escaped s);
                 value meta_bool _loc =
                   fun
                   [ False -> Ast.PaId _loc (Ast.IdUid _loc "False")

camlp4/boot/camlp4boot.ml

                     [ (None, (Some Camlp4.Sig.Grammar.RightA),
                        [ ([ Gram.Snterm
                               (Gram.Entry.obj
-                                 (labeled_ipatt :
-                                   'labeled_ipatt Gram.Entry.t));
+                                 (cvalue_binding :
+                                   'cvalue_binding Gram.Entry.t)) ],
+                          (Gram.Action.mk
+                             (fun (bi : 'cvalue_binding) (_loc : Gram.Loc.t)
+                                -> (bi : 'fun_binding))));
+                         ([ Gram.Stry
+                              (Gram.Snterm
+                                 (Gram.Entry.obj
+                                    (labeled_ipatt :
+                                      'labeled_ipatt Gram.Entry.t)));
                             Gram.Sself ],
                           (Gram.Action.mk
                              (fun (e : 'fun_binding) (p : 'labeled_ipatt)
                                    (Ast.McArr (_loc, p, (Ast.ExNil _loc), e))) :
                                   'fun_binding))));
                          ([ Gram.Stry
-                              (Gram.Snterm
-                                 (Gram.Entry.obj
-                                    (cvalue_binding :
-                                      'cvalue_binding Gram.Entry.t))) ],
-                          (Gram.Action.mk
-                             (fun (bi : 'cvalue_binding) (_loc : Gram.Loc.t)
-                                -> (bi : 'fun_binding))));
-                         ([ Gram.Stry
                               (Gram.srules fun_binding
                                  [ ([ Gram.Skeyword "("; Gram.Skeyword "type" ],
                                     (Gram.Action.mk

config/auto-aux/cfi.S

-.cfi_startproc
-.cfi_adjust_cfa_offset 8
-.cfi_endproc
+camlPervasives__loop_1128:
+        .file   1       "pervasives.ml"
+        .loc    1       193
+        .cfi_startproc
+        .cfi_adjust_cfa_offset 8
+        .cfi_endproc

config/auto-aux/tryassemble

 else
 $aspp -o tst $* 2> /dev/null || exit 100
 fi
+
+# test as also (if differs)
+if test "$aspp" != "$as"; then
+if test "$verbose" = yes; then
+echo "tryassemble: $as -o tst $*" >&2
+$as -o tst $* || exit 100
+else
+$as -o tst $* 2> /dev/null || exit 100
+fi
+fi
 #                                                                       #
 #########################################################################
 
-# $Id: configure 12567 2012-06-04 17:01:09Z doligez $
+# $Id: configure 12645 2012-06-26 15:33:50Z doligez $
 
 configure_options="$*"
 prefix=/usr/local
   case "$host" in
     *-*-cygwin*)                  natdynlink=true;;
     i[3456]86-*-linux*)           natdynlink=true;;
+    i[3456]86-*-gnu*)             natdynlink=true;;
     x86_64-*-linux*)              natdynlink=true;;
     i[3456]86-*-darwin[89].*)     natdynlink=true;;
     i[3456]86-*-darwin*)
         natdynlink=true
       fi;;
     x86_64-*-darwin*)             natdynlink=true;;
-    powerpc64-*-linux*)           natdynlink=true;;
-    sparc-*-linux*)               natdynlink=true;;
+    powerpc*-*-linux*)            natdynlink=true;;
+    sparc*-*-linux*)              natdynlink=true;;
     i686-*-kfreebsd*)             natdynlink=true;;
     x86_64-*-kfreebsd*)           natdynlink=true;;
     i[345]86-*-freebsd*)          natdynlink=true;;
 
 asm_cfi_supported=false
 
-export aspp
+export as aspp
 
 if sh ./tryassemble cfi.S; then
   echo "#define ASM_CFI_SUPPORTED" >> m.h
   asm_cfi_supported=true
+  echo "Assembler supports CFI"
+else
+  echo "Assembler does not support CFI"
 fi
 
 # Final twiddling of compiler options to work around known bugs

debugger/loadprinter.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: loadprinter.ml 11284 2011-11-24 09:02:48Z garrigue $ *)
+(* $Id: loadprinter.ml 12673 2012-07-09 12:40:51Z xclerc $ *)
 
 (* Loading and installation of user-defined printer functions *)
 
 
 (* Install, remove a printer (as in toplevel/topdirs) *)
 
+(* since 4.00, "topdirs.cmi" is not in the same directory as the standard
+  libray, so we load it beforehand as it cannot be found in the search path. *)
+let () =
+  let compiler_libs =
+    Filename.concat Config.standard_library "compiler-libs" in
+  let topdirs =
+    Filename.concat compiler_libs "topdirs.cmi" in
+  ignore (Env.read_signature "Topdirs" topdirs)
+
 let match_printer_type desc typename =
   let (printer_type, _) =
     try

debugger/printval.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: printval.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: printval.ml 12689 2012-07-10 14:54:19Z doligez $ *)
 
 (* To print values *)
 
 
 module EvalPath =
   struct
-    type value = Debugcom.Remote_value.t
+    type valu = Debugcom.Remote_value.t
     exception Error
     let rec eval_path = function
       Pident id ->

emacs/caml-types.el

 ;(*                                                                     *)
 ;(***********************************************************************)
 
-;(* $Id: caml-types.el 12149 2012-02-10 16:15:24Z doligez $ *)
+;(* $Id: caml-types.el 12695 2012-07-10 17:49:46Z doligez $ *)
 
 ; An emacs-lisp complement to the "-annot" option of ocamlc and ocamlopt.
 
  . One overlay delimits the largest region whose all subnodes
    are well-typed.
  . Another overlay delimits the current node under the mouse (whose type
-   annotation is beeing displayed).
+   annotation is being displayed).
 "
   (interactive "e")
   (set-buffer (window-buffer (caml-event-window event)))
                            target-pos
                            (vector target-file target-line target-bol cnum))
                      (save-excursion
-                       (setq node (caml-types-find-location "type"
-                                   target-pos () target-tree))
+                       (setq node (caml-types-find-location target-pos "type" ()
+							    target-tree))
                        (set-buffer caml-types-buffer)
                        (erase-buffer)
                        (cond
-                        (node
-                         (setq Left
-                               (caml-types-get-pos target-buf (elt node 0))
-                               Right
-                               (caml-types-get-pos target-buf (elt node 1)))
-                         (move-overlay
-                          caml-types-expr-ovl Left Right target-buf)
-                         (setq limits
-                               (caml-types-find-interval target-buf
-                                                         target-pos node)
-                               type (elt node 2))
-                         )
-                        (t
+			((null node)
                          (delete-overlay caml-types-expr-ovl)
                          (setq type "*no type information*")
                          (setq limits
                                (caml-types-find-interval
-                                target-buf target-pos target-tree))
+                                target-buf target-pos target-tree)))
+                        (t
+			 (let ((left
+				(caml-types-get-pos target-buf (elt node 0)))
+                               (right
+				(caml-types-get-pos target-buf (elt node 1))))
+                         (move-overlay
+                          caml-types-expr-ovl left right target-buf)
+                         (setq limits
+                               (caml-types-find-interval target-buf
+                                                         target-pos node)
+                               type (cdr (assoc "type" (elt node 2))))
                          ))
+			)
                        (setq mes (format "type: %s" type))
                        (insert type)
                        ))

ocamlbuild/ocaml_specific.ml

   atomize !Options.ocaml_cflags
 end;;
 
+flag ["c"; "compile"] begin
+  atomize !Options.ocaml_cflags
+end;;
+
 flag ["ocaml"; "link"] begin
   atomize !Options.ocaml_lflags
 end;;
 
+flag ["c"; "link"] begin
+  atomize !Options.ocaml_lflags
+end;;
+
 flag ["ocaml"; "ocamlyacc"] (atomize !Options.ocaml_yaccflags);;
 flag ["ocaml"; "menhir"] (atomize !Options.ocaml_yaccflags);;
 flag ["ocaml"; "doc"] (atomize !Options.ocaml_docflags);;

ocamldoc/Makefile

 #(*                                                                     *)
 #(***********************************************************************)
 
-# $Id: Makefile 12511 2012-05-30 13:29:48Z lefessan $
+# $Id: Makefile 12692 2012-07-10 15:20:34Z doligez $
 
 include ../config/Makefile
 
 generatorsopt: $(GENERATORS_CMXS)
 
 debug:
-	make OCAMLPP=""
+	$(MAKE) OCAMLPP=""
 
 $(OCAMLDOC): $(EXECMOFILES)
 	$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES)
 	$(OCAMLOPT) -o $@ -linkall unix.cmxa str.cmxa dynlink.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES)
 
 $(OCAMLDOC_LIBCMA): $(LIBCMOFILES)
-	$(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLCMOFILES) $(LIBCMOFILES)
+	$(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo $(LIBCMOFILES)
 $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES)
-	$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLCMXFILES) $(LIBCMXFILES)
+	$(OCAMLOPT) -a -o $@ $(LINKFLAGS)	$(OCAMLSRCDIR)/tools/depend.cmx $(LIBCMXFILES)
 
 manpages: stdlib_man/Pervasives.3o
 

ocamldoc/Makefile.nt

 #(*                                                                     *)
 #(***********************************************************************)
 
-# $Id: Makefile.nt 12553 2012-06-04 12:39:11Z protzenk $
+# $Id: Makefile.nt 12692 2012-07-10 15:20:34Z doligez $
 
 include ../config/Makefile
 
 exeopt: $(OCAMLDOC_OPT)
 libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI)
 debug:
-	make OCAMLPP=""
+	$(MAKE) OCAMLPP=""
 
 $(OCAMLDOC): $(EXECMOFILES)
 	$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES)

ocamldoc/odoc_name.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_name.ml 10643 2010-08-02 14:37:22Z doligez $ *)
+(* $Id: odoc_name.ml 12622 2012-06-21 05:46:28Z guesdon $ *)
 
 (** Representation of element names. *)
 
   | Some p -> p
 
 let from_longident = Odoc_misc.string_of_longident
+
+module Set = Set.Make (struct
+  type z = t
+  type t = z
+  let compare = String.compare
+end)

ocamldoc/odoc_name.mli

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_name.mli 10643 2010-08-02 14:37:22Z doligez $ *)
+(* $Id: odoc_name.mli 12622 2012-06-21 05:46:28Z guesdon $ *)
 
 (** Representation of element names. *)
 
 
 (** Get a name from a [Longident.t].*)
 val from_longident : Longident.t -> t
+
+(** Set of Name.t *)
+module Set : Set.S with type elt = t

ocamldoc/odoc_sig.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_sig.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: odoc_sig.ml 12622 2012-06-21 05:46:28Z guesdon $ *)
 
 (** Analysis of interface files. *)
 
           in
           Odoc_type.Type_record (List.map f l)
 
+    let erased_names_of_constraints constraints acc =
+      List.fold_right (fun (longident, constraint_) acc ->
+        match constraint_ with
+        | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ -> acc
+        | Parsetree.Pwith_typesubst _ | Parsetree.Pwith_modsubst _ ->
+          Name.Set.add (Name.from_longident longident.txt) acc)
+        constraints acc
+
+    let filter_out_erased_items_from_signature erased signature =
+      if Name.Set.is_empty erased then signature
+      else List.fold_right (fun sig_item acc ->
+        let take_item psig_desc = { sig_item with Parsetree.psig_desc } :: acc in
+        match sig_item.Parsetree.psig_desc with
+        | Parsetree.Psig_value (_, _)
+        | Parsetree.Psig_exception (_, _)
+        | Parsetree.Psig_open _
+        | Parsetree.Psig_include _
+        | Parsetree.Psig_class _
+        | Parsetree.Psig_class_type _ as tp -> take_item tp
+        | Parsetree.Psig_type types ->
+          (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) types with
+          | [] -> acc
+          | types -> take_item (Parsetree.Psig_type types))
+        | Parsetree.Psig_module (name, _)
+        | Parsetree.Psig_modtype (name, _) as m ->
+          if Name.Set.mem name.txt erased then acc else take_item m
+        | Parsetree.Psig_recmodule mods ->
+          (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) mods with
+          | [] -> acc
+          | mods -> take_item (Parsetree.Psig_recmodule mods)))
+        signature []
+
     (** Analysis of the elements of a class, from the information in the parsetree and in the class
        signature. @return the couple (inherited_class list, elements).*)
     let analyse_class_elements env current_class_name last_pos pos_limit
             (maybe_more, new_env, eles)
 
     (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
-    and analyse_module_type_kind env current_module_name module_type sig_module_type =
+    and analyse_module_type_kind
+      ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type =
       match module_type.Parsetree.pmty_desc with
         Parsetree.Pmty_ident longident ->
           let name =
 
       | Parsetree.Pmty_signature ast ->
           (
+           let ast = filter_out_erased_items_from_signature erased ast in
            (* we must have a signature in the module type *)
            match sig_module_type with
              Types.Mty_signature signat ->
                    mp_kind = mp_kind ;
                  }
                in
-               let k = analyse_module_type_kind env
+               let k = analyse_module_type_kind ~erased env
                    current_module_name
                    module_type2
                    body_module_type
                raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
           )
 
-      | Parsetree.Pmty_with (module_type2, _) ->
+      | Parsetree.Pmty_with (module_type2, constraints) ->
           (* of module_type * (Longident.t * with_constraint) list *)
           (
            let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let s = get_string_of_file loc_start loc_end in
-           let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in
+           let erased = erased_names_of_constraints constraints erased in
+           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in
+
            Module_type_with (k, s)
           )
 
           Module_type_typeof s
 
     (** analyse of a Parsetree.module_type and a Types.module_type.*)
-    and analyse_module_kind env current_module_name module_type sig_module_type =
+    and analyse_module_kind
+        ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type =
       match module_type.Parsetree.pmty_desc with
         Parsetree.Pmty_ident longident ->
           let k = analyse_module_type_kind env current_module_name module_type sig_module_type in
 
       | Parsetree.Pmty_signature signature ->
           (
+           let signature = filter_out_erased_items_from_signature erased signature in
            match sig_module_type with
              Types.Mty_signature signat ->
                Module_struct
                    mp_kind = mp_kind ;
                  }
                in
-               let k = analyse_module_kind env
+               let k = analyse_module_kind ~erased env
                    current_module_name
                    module_type2
                    body_module_type
                (* if we're here something's wrong *)
                raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
           )
-      | Parsetree.Pmty_with (module_type2, _) ->
+      | Parsetree.Pmty_with (module_type2, constraints) ->
           (*of module_type * (Longident.t * with_constraint) list*)
           (
            let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
            let s = get_string_of_file loc_start loc_end in
-           let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in
+           let erased = erased_names_of_constraints constraints erased in
+           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in
            Module_with (k, s)
           )
       | Parsetree.Pmty_typeof module_expr ->

ocamldoc/odoc_sig.mli

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: odoc_sig.mli 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: odoc_sig.mli 12622 2012-06-21 05:46:28Z guesdon $ *)
 
 (** The module for analysing a signature and source code and creating modules, classes, ..., elements.*)
 
 
       (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
       val analyse_module_type_kind :
-          Odoc_env.env -> Odoc_name.t ->
+          ?erased:Odoc_name.Set.t -> Odoc_env.env -> Odoc_name.t ->
             Parsetree.module_type -> Types.module_type ->
               Odoc_module.module_type_kind
 

otherlibs/bigarray/mmap_unix.c

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: mmap_unix.c 12326 2012-04-09 10:22:59Z xleroy $ */
+/* $Id: mmap_unix.c 12582 2012-06-07 12:17:44Z xleroy $ */
+
+/* Needed (under Linux at least) to get pwrite's prototype in unistd.h.
+   Must be defined before the first system .h is included. */
+#define _XOPEN_SOURCE 500
 
 #include <stddef.h>
 #include <string.h>

otherlibs/labltk/browser/searchpos.ml

 (*                                                                       *)
 (*************************************************************************)
 
-(* $Id: searchpos.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: searchpos.ml 12681 2012-07-10 08:33:16Z garrigue $ *)
 
 open Asttypes
 open StdLabels
       search_pos_class_structure ~pos cls
   | Texp_pack modexp ->
       search_pos_module_expr modexp ~pos
-  | _ -> assert false (* TODO ................................... *)
   end;
   add_found_str (`Exp(`Expr, exp.exp_type)) ~env:exp.exp_env ~loc:exp.exp_loc
   end

otherlibs/systhreads/Makefile

 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 11156 2011-07-27 14:17:02Z doligez $
+# $Id: Makefile 12585 2012-06-08 11:35:37Z xleroy $
 
 include ../../config/Makefile
 
 allopt: libthreadsnat.a threads.cmxa
 
 libthreads.a: $(BYTECODE_C_OBJS)
-	$(MKLIB) -o threads $(BYTECODE_C_OBJS)
+	$(MKLIB) -o threads $(BYTECODE_C_OBJS) -lpthread
 
 st_stubs_b.o: st_stubs.c st_posix.h
 	$(BYTECC) -O -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \

parsing/parser.mly

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: parser.mly 12511 2012-05-30 13:29:48Z lefessan $ */
+/* $Id: parser.mly 12638 2012-06-21 17:10:58Z frisch $ */
 
 /* The parser definition */
 
   | expr COMMA expr                             { [$3; $1] }
 ;
 record_expr:
-    simple_expr WITH lbl_expr_list opt_semi     { (Some $1, List.rev $3) }
-  | lbl_expr_list opt_semi                      { (None, List.rev $1) }
+    simple_expr WITH lbl_expr_list              { (Some $1, $3) }
+  | lbl_expr_list                               { (None, $1) }
 ;
 lbl_expr_list:
+     lbl_expr { [$1] }
+  |  lbl_expr SEMI lbl_expr_list { $1 :: $3 }
+  |  lbl_expr SEMI { [$1] }
+;
+lbl_expr:
     label_longident EQUAL expr
-      { [mkrhs $1 1,$3] }
+      { (mkrhs $1 1,$3) }
   | label_longident
-      { [mkrhs $1 1, exp_of_label $1 1] }
-  | lbl_expr_list SEMI label_longident EQUAL expr
-      { (mkrhs $3 3, $5) :: $1 }
-  | lbl_expr_list SEMI label_longident
-      { (mkrhs $3 3, exp_of_label $3 3) :: $1 }
+      { (mkrhs $1 1, exp_of_label $1 1) }
 ;
 field_expr_list:
     label EQUAL expr
       { mkpat(Ppat_variant($1, None)) }
   | SHARP type_longident
       { mkpat(Ppat_type (mkrhs $2 2)) }
-  | LBRACE lbl_pattern_list record_pattern_end RBRACE
-      { mkpat(Ppat_record(List.rev $2, $3)) }
-  | LBRACE lbl_pattern_list opt_semi error
+  | LBRACE lbl_pattern_list RBRACE
+      { let (fields, closed) = $2 in mkpat(Ppat_record(fields, closed)) }
+  | LBRACE lbl_pattern_list error
       { unclosed "{" 1 "}" 4 }
   | LBRACKET pattern_semi_list opt_semi RBRACKET
       { reloc_pat (mktailpat (List.rev $2)) }
   | pattern_semi_list SEMI pattern              { $3 :: $1 }
 ;
 lbl_pattern_list:
-    label_longident EQUAL pattern               { [(mkrhs $1 1, $3)] }
-  | label_longident                             { [(mkrhs $1 1, pat_of_label $1 1)] }
-  | lbl_pattern_list SEMI label_longident EQUAL pattern { (mkrhs $3 3, $5) :: $1 }
-  | lbl_pattern_list SEMI label_longident       { (mkrhs $3 3, pat_of_label $3 3) :: $1 }
+     lbl_pattern { [$1], Closed }
+  |  lbl_pattern SEMI { [$1], Closed }
+  |  lbl_pattern SEMI UNDERSCORE opt_semi { [$1], Open }
+  |  lbl_pattern SEMI lbl_pattern_list { let (fields, closed) = $3 in $1 :: fields, closed }
 ;
-record_pattern_end:
-    opt_semi                                    { Closed }
-  | SEMI UNDERSCORE opt_semi                    { Open }
+lbl_pattern:
+    label_longident EQUAL pattern
+      { (mkrhs $1 1,$3) }
+  | label_longident
+      { (mkrhs $1 1, pat_of_label $1 1) }
 ;
 
 /* Primitive declarations */
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: scanf.mli 12230 2012-03-13 16:10:02Z doligez $ *)
+(* $Id: scanf.mli 12571 2012-06-05 18:21:50Z doligez $ *)
 
 (** Formatted input functions. *)
 
 *)
 
 val close_in : in_channel -> unit;;
-(** Closes the [Pervasives.input_channel] associated with the given
+(** Closes the [Pervasives.in_channel] associated with the given
   [Scanning.in_channel] formatted input channel.
   @since 3.12.0
 *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: stream.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: stream.ml 12683 2012-07-10 10:01:57Z scherer $ *)
 
 (* The fields of type t are not mutable to preserve polymorphism of
    the empty stream. This is type safe because the empty stream is never
 and 'a data =
     Sempty
   | Scons of 'a * 'a data
-  | Sapp of 'a data * 'a data
-  | Slazy of 'a data Lazy.t
+  | Sapp of 'a data * 'a t
+  | Slazy of 'a t Lazy.t
   | Sgen of 'a gen
   | Sbuffio of buffio
 and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
   b.len <- input b.ic b.buff 0 (String.length b.buff); b.ind <- 0
 ;;
 
-let rec get_data count d = match d with
- (* Returns either Sempty or Scons(a, _) even when d is a generator
-    or a buffer. In those cases, the item a is seen as extracted from
- the generator/buffer.
- The count parameter is used for calling `Sgen-functions'.  *)
+let rec get_data s d = match d with
+ (* Only return a "forced stream", that is either Sempty or
+    Scons(a,_). If d is a generator or a buffer, the item a is seen as
+    extracted from the generator/buffer.
+    
+    Forcing also updates the "count" field of the delayed stream,
+    in the Sapp and Slazy cases (see slazy/lapp implementation below). *)
    Sempty | Scons (_, _) -> d
- | Sapp (d1, d2) ->
-     begin match get_data count d1 with
-       Scons (a, d11) -> Scons (a, Sapp (d11, d2))
-     | Sempty -> get_data count d2
+ | Sapp (d1, s2) ->
+     begin match get_data s d1 with
+       Scons (a, d11) -> Scons (a, Sapp (d11, s2))
+     | Sempty ->
+       set_count s s2.count;
+       get_data s s2.data
      | _ -> assert false
      end
- | Sgen {curr = Some None; func = _ } -> Sempty
- | Sgen ({curr = Some(Some a); func = f} as g) ->
+ | Sgen {curr = Some None; _ } -> Sempty
+ | Sgen ({curr = Some(Some a); _ } as g) ->
      g.curr <- None; Scons(a, d)
- | Sgen g ->
-     begin match g.func count with
+ | Sgen ({curr = None; _} as g) ->
+     (* Warning: anyone using g thinks that an item has been read *)
+     begin match g.func s.count with
        None -> g.curr <- Some(None); Sempty
-     | Some a -> Scons(a, d)
-         (* Warning: anyone using g thinks that an item has been read *)
+     | Some a ->
+       (* One must not update g.curr here, because there Scons(a,d)
+          result of get_data, if the outer stream s was a Sapp, will
+          be used to update the outer stream to Scons(a,s): there is
+          already a memoization process at the outer layer. If g.curr
+          was updated here, the saved element would be produced twice,
+          once by the outer layer, once by Sgen/g.curr. *)
+       Scons(a, d)
      end
  | Sbuffio b ->
      if b.ind >= b.len then fill_buff b;
        let r = Obj.magic (String.unsafe_get b.buff b.ind) in
        (* Warning: anyone using g thinks that an item has been read *)
        b.ind <- succ b.ind; Scons(r, d)
- | Slazy f -> get_data count (Lazy.force f)
+ | Slazy f ->
+   let s2 = Lazy.force f in
+   set_count s s2.count;
+   get_data s s2.data
 ;;
 
 let rec peek s =
    Sempty -> None
  | Scons (a, _) -> Some a
  | Sapp (_, _) ->
-     begin match get_data s.count s.data with
-       Scons(a, _) as d -> set_data s d; Some a
+     begin match get_data s s.data with
+     | Scons(a, _) as d -> set_data s d; Some a
      | Sempty -> None
      | _ -> assert false
      end
- | Slazy f -> set_data s (Lazy.force f); peek s
- | Sgen {curr = Some a} -> a
- | Sgen g -> let x = g.func s.count in g.curr <- Some x; x
+ | Slazy f ->
+   let s2 = Lazy.force f in
+   set_count s s2.count;
+   set_data s s2.data;
+   peek s
+ | Sgen {curr = Some a; _ } -> a
+ | Sgen ({curr = None; _ } as g) ->
+     let x = g.func s.count in
+     g.curr <- Some x; x
  | Sbuffio b ->
      if b.ind >= b.len then fill_buff b;
      if b.len == 0 then begin set_data s Sempty; None end
 
 (* Stream expressions builders *)
 
-let iapp i s = {count = 0; data = Sapp (i.data, s.data)};;
-let icons i s = {count = 0; data = Scons (i, s.data)};;
+(* In the slazy and lapp case, we can't statically predict the value
+   of the "count" field. We put a dummy 0 value, which will be updated
+   when the parameter stream is forced (see update code in [get_data]
+   and [peek]). *)
+
 let ising i = {count = 0; data = Scons (i, Sempty)};;
-
-let lapp f s =
-  {count = 0; data = Slazy (lazy(Sapp ((f ()).data, s.data)))}
-;;
-let lcons f s = {count = 0; data = Slazy (lazy(Scons (f (), s.data)))};;
-let lsing f = {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))};;
+let icons i s = {count = s.count - 1; data = Scons (i, s.data)};;
+let iapp i s = {count = i.count; data = Sapp (i.data, s)};;
 
 let sempty = {count = 0; data = Sempty};;
-let slazy f = {count = 0; data = Slazy (lazy(f ()).data)};;
+let slazy f = {count = 0; data = Slazy (lazy (f()))};;
+
+let lsing f = {count = 0; data = Slazy (lazy (ising (f())))};;
+let lcons f s = {count = 0; data = Slazy (lazy (icons (f()) s))};;
+let lapp f s = {count = 0; data = Slazy (lazy(iapp (f()) s))};;
 
 (* For debugging use *)
 
       print_string ", ";
       dump_data f d;
       print_string ")"
-  | Sapp (d1, d2) ->
+  | Sapp (d1, s2) ->
       print_string "Sapp (";
       dump_data f d1;
       print_string ", ";
-      dump_data f d2;
+      dump f s2;