[MLton-commit] r4851

Matthew Fluet fluet at mlton.org
Mon Nov 20 18:52:59 PST 2006


Merge trunk revisions 4811:4850 into x86_64 branch
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/Makefile
A   mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-darwin/
A   mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-darwin/c-types.sml
U   mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
U   mlton/branches/on-20050822-x86_64-branch/bin/mmake
U   mlton/branches/on-20050822-x86_64-branch/bin/msed
U   mlton/branches/on-20050822-x86_64-branch/mllex/Makefile
U   mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
U   mlton/branches/on-20050822-x86_64-branch/mlton/cm/cm.sml
U   mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sml
U   mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
_U  mlton/branches/on-20050822-x86_64-branch/mlyacc/
U   mlton/branches/on-20050822-x86_64-branch/mlyacc/.ignore
U   mlton/branches/on-20050822-x86_64-branch/mlyacc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile
U   mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
U   mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U   mlton/branches/on-20050822-x86_64-branch/util/cmcat/cmcat.sml

----------------------------------------------------------------------

Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile	2006-11-21 02:52:35 UTC (rev 4851)
@@ -440,8 +440,8 @@
 		; do 							\
 		$(CP) "$(SRC)/regression/$$f.sml" "$(TEXM)/"; 		\
 	done
-	$(GZIP) -c "$(LEX)/$(LEX).ps" >"$(TDOC)/$(LEX).ps.gz"
-	$(GZIP) -c "$(YACC)/$(YACC).ps" >"$(TDOC)/$(YACC).ps.gz"
+	$(CP) $(LEX)/$(LEX).pdf $(TDOC)
+	$(CP) $(YACC)/$(YACC).pdf $(TDOC)
 	find "$(TDOC)/" -name .svn -type d | xargs rm -rf
 	find "$(TDOC)/" -name .ignore -type f | xargs rm -rf
 	find "$(TEXM)/" -name .svn -type d | xargs rm -rf

Added: mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-darwin/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-darwin/c-types.sml	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-darwin/c-types.sml	2006-11-21 02:52:35 UTC (rev 4851)
@@ -0,0 +1,132 @@
+(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+
+(* C *)
+structure C_Bool = WordToBool (type t = Word8.word val zero: t = 0wx0 val one: t = 0wx1)
+structure C_Char = struct open Int8 type t = int end
+functor C_Char_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_SChar = struct open Int8 type t = int end
+functor C_SChar_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_UChar = struct open Word8 type t = word end
+functor C_UChar_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word8 (A)
+structure C_Short = struct open Int16 type t = int end
+functor C_Short_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_SShort = struct open Int16 type t = int end
+functor C_SShort_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_UShort = struct open Word16 type t = word end
+functor C_UShort_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_Int = struct open Int32 type t = int end
+functor C_Int_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SInt = struct open Int32 type t = int end
+functor C_SInt_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UInt = struct open Word32 type t = word end
+functor C_UInt_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Long = struct open Int32 type t = int end
+functor C_Long_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SLong = struct open Int32 type t = int end
+functor C_SLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_ULong = struct open Word32 type t = word end
+functor C_ULong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_LongLong = struct open Int64 type t = int end
+functor C_LongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_SLongLong = struct open Int64 type t = int end
+functor C_SLongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_ULongLong = struct open Word64 type t = word end
+functor C_ULongLong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Float = struct open Real32 type t = real end
+functor C_Float_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real32 (A)
+structure C_Double = struct open Real64 type t = real end
+functor C_Double_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real64 (A)
+structure C_Size = struct open Word32 type t = word end
+functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+structure C_Pointer = struct open Word32 type t = word end
+functor C_Pointer_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_String = struct open Word32 type t = word end
+functor C_String_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_StringArray = struct open Word32 type t = word end
+functor C_StringArray_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* Generic integers *)
+structure C_Fd = C_Int
+functor C_Fd_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Signal = C_Int
+functor C_Signal_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Status = C_Int
+functor C_Status_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Sock = C_Int
+functor C_Sock_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+
+(* C99 *)
+structure C_Ptrdiff = struct open Int32 type t = int end
+functor C_Ptrdiff_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_Intmax = struct open Int64 type t = int end
+functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_UIntmax = struct open Word64 type t = word end
+functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Intptr = struct open Int32 type t = int end
+functor C_Intptr_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UIntptr = struct open Word32 type t = word end
+functor C_UIntptr_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <dirent.h> *)
+structure C_DirP = struct open Word32 type t = word end
+functor C_DirP_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <poll.h> *)
+structure C_NFds = struct open Word32 type t = word end
+functor C_NFds_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <resource.h> *)
+structure C_RLim = struct open Int64 type t = int end
+functor C_RLim_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+
+(* from <sys/types.h> *)
+structure C_Clock = struct open Word32 type t = word end
+functor C_Clock_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Dev = struct open Int32 type t = int end
+functor C_Dev_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_GId = struct open Word32 type t = word end
+functor C_GId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Id = struct open Word32 type t = word end
+functor C_Id_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_INo = struct open Word32 type t = word end
+functor C_INo_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Mode = struct open Word16 type t = word end
+functor C_Mode_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_NLink = struct open Word16 type t = word end
+functor C_NLink_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_Off = struct open Int64 type t = int end
+functor C_Off_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_PId = struct open Int32 type t = int end
+functor C_PId_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SSize = struct open Int32 type t = int end
+functor C_SSize_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SUSeconds = struct open Int32 type t = int end
+functor C_SUSeconds_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_Time = struct open Int32 type t = int end
+functor C_Time_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UId = struct open Word32 type t = word end
+functor C_UId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <sys/socket.h> *)
+structure C_Socklen = struct open Word32 type t = word end
+functor C_Socklen_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <termios.h> *)
+structure C_CC = struct open Word8 type t = word end
+functor C_CC_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word8 (A)
+structure C_Speed = struct open Int32 type t = int end
+functor C_Speed_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_TCFlag = struct open Word32 type t = word end
+functor C_TCFlag_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from "gmp.h" *)
+structure C_MPLimb = struct open Word32 type t = word end
+functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+

Modified: mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/mlton-script	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/bin/mlton-script	2006-11-21 02:52:35 UTC (rev 4851)
@@ -67,10 +67,6 @@
 # You may need to add a line with -link-opt '-L/path/to/libgmp' so
 # that the linker can find libgmp.
 
-if [ -d '/sw/lib' ]; then
-        darwinLinkOpts='-L/sw/lib'
-fi
-
 doit "$lib" \
         -cc "$gcc"                                               \
         -cc-opt "-I$lib/include"                                 \
@@ -79,7 +75,7 @@
         -mlb-path-map "$lib/mlb-path-map"                        \
         -target-as-opts amd64 '-m32 -mtune=opteron'              \
         -target-cc-opts amd64 '-m32 -mtune=opteron'              \
-        -target-cc-opts darwin '-I/sw/include'                   \
+        -target-cc-opts darwin '-I/opt/local/include -I/sw/include' \
         -target-cc-opts freebsd '-I/usr/local/include'           \
         -target-cc-opts netbsd '-I/usr/pkg/include'              \
         -target-cc-opts openbsd '-I/usr/local/include'           \
@@ -97,7 +93,7 @@
         -target-link-opts aix '-lgmp'                            \
         -target-link-opts amd64 '-m32'                           \
         -target-link-opts cygwin '-lgmp'                         \
-        -target-link-opts darwin "$darwinLinkOpts -lgmp"         \
+        -target-link-opts darwin '-L/opt/local/lib -L/sw/lib -lgmp' \
         -target-link-opts freebsd '-L/usr/local/lib/ -lgmp'      \
         -target-link-opts hpux '-lgmp'                           \
         -target-link-opts linux '-lgmp'                          \

Modified: mlton/branches/on-20050822-x86_64-branch/bin/mmake
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/mmake	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/bin/mmake	2006-11-21 02:52:35 UTC (rev 4851)
@@ -9,6 +9,8 @@
 
 if gmake -v >/dev/null 2>&1; then
         make='gmake'
+elif gnumake -v >/dev/null 2>&1; then
+        make='gnumake'
 elif make -v 2>&1 | grep -q GNU; then
         make=`which make`
 else

Modified: mlton/branches/on-20050822-x86_64-branch/bin/msed
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/msed	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/bin/msed	2006-11-21 02:52:35 UTC (rev 4851)
@@ -9,6 +9,8 @@
 
 if gsed --version >/dev/null 2>&1; then
         sed='gsed'
+elif gnused --version >/dev/null 2>&1; then
+        sed='gnused'
 elif sed --version 2>&1 | grep -q GNU; then
         sed=`which sed`
 else

Modified: mlton/branches/on-20050822-x86_64-branch/mllex/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mllex/Makefile	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mllex/Makefile	2006-11-21 02:52:35 UTC (rev 4851)
@@ -47,7 +47,7 @@
 	../bin/clean
 
 .PHONY: docs
-docs: mllex.ps
+docs: mllex.pdf
 
 .PHONY: test
 test: $(NAME)

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/Makefile	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/Makefile	2006-11-21 02:52:35 UTC (rev 4851)
@@ -18,7 +18,7 @@
 UP = upgrade-basis.sml
 PATH = $(BIN):$(shell echo $$PATH)
 
-FLAGS = @MLton ram-slop 0.7 gc-summary $(RUNTIME_ARGS) --
+FLAGS = @MLton max-heap 640m ram-slop 0.7 gc-summary $(RUNTIME_ARGS) --
 
 ifeq (self, $(shell if [ -x "$(BIN)/mlton" ]; then echo self; fi))
   # We're compiling MLton with itself, so don't use any stubs.

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/cm/cm.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/cm/cm.sml	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/cm/cm.sml	2006-11-21 02:52:35 UTC (rev 4851)
@@ -73,17 +73,20 @@
                                         List.push (files, finalize m')
                                   in
                                      Control.checkFile
-                                     (m, fail, fn () =>
-                                      case File.suffix m of
-                                         SOME "cm" =>
-                                            loop (m, 0, relativize)
-                                       | SOME "sml" => sml ()
-                                       | SOME "sig" => sml ()
-                                       | SOME "fun" => sml ()
-                                       | SOME "ML" => sml ()
-                                       | _ =>
-                                            fail (concat ["MLton can't process ",
-                                                          m]))
+                                     (m,
+                                      {fail = fail,
+                                       name = m,
+                                       ok = fn () =>
+                                       case File.suffix m of
+                                          SOME "cm" =>
+                                             loop (m, 0, relativize)
+                                        | SOME "sml" => sml ()
+                                        | SOME "sig" => sml ()
+                                        | SOME "fun" => sml ()
+                                        | SOME "ML" => sml ()
+                                        | _ =>
+                                             fail (concat ["MLton can't process ",
+                                                           m])})
                                   end
                           end)
                 end)

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sig	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sig	2006-11-21 02:52:35 UTC (rev 4851)
@@ -32,7 +32,9 @@
       (*------------------------------------*)
       (*          Error Reporting           *)
       (*------------------------------------*)
-      val checkFile: File.t * (string -> 'a) * (unit -> 'a) -> 'a
+      val checkFile: File.t * {fail: string -> 'a,
+                               name: string,
+                               ok: unit -> 'a} -> 'a
       val checkForErrors: string -> unit
       val error: Region.t * Layout.t * Layout.t -> unit
       val errorStr: Region.t * string -> unit

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sml	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control.sml	2006-11-21 02:52:35 UTC (rev 4851)
@@ -235,15 +235,15 @@
       then die (concat ["compilation aborted: ", name, " reported errors"])
    else ()
 
-fun checkFile (f: File.t, error: string -> 'a, k: unit -> 'a): 'a =
-   let
-      fun check (test, msg, k) =
-         if not (test f)
-            then error (concat ["File ", f, " ", msg])
-         else k ()
+fun checkFile (f: File.t, {fail: string -> 'a, name, ok: unit -> 'a}): 'a = let
+   fun check (test, msg, k) =
+      if test f then
+         k ()
+      else
+         fail (concat ["File ", name, " ", msg])
    in
       check (File.doesExist, "does not exist", fn () =>
-             check (File.canRead, "cannot be read", k))
+             check (File.canRead, "cannot be read", ok))
    end
 
 (*---------------------------------------------------*)

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun	2006-11-21 02:52:35 UTC (rev 4851)
@@ -216,63 +216,67 @@
                        ("fileUse", File.layout fileUse),
                        ("relativize", Option.layout Dir.layout relativize)])
          regularize
-      fun lexAndParseProg {fileAbs: File.t, fileUse: File.t, 
+      fun lexAndParseProg {fileAbs: File.t, fileOrig: File.t, fileUse: File.t, 
                            fail: String.t -> Ast.Program.t} =
          Ast.Basdec.Prog
          ({fileAbs = fileAbs, fileUse = fileUse},
           Promise.delay
           (fn () =>
            Control.checkFile
-           (fileUse, fail, fn () => FrontEnd.lexAndParseFile fileUse)))
+           (fileUse, {fail = fail,
+                      name = fileOrig,
+                      ok = fn () => FrontEnd.lexAndParseFile fileUse})))
       and lexAndParseMLB {relativize: Dir.t option,
                           seen: (File.t * File.t * Region.t) list,
-                          fileAbs: File.t, fileUse: File.t,
+                          fileAbs: File.t, fileOrig: File.t, fileUse: File.t,
                           fail: String.t -> Ast.Basdec.t, reg: Region.t} =
          Ast.Basdec.MLB
          ({fileAbs = fileAbs, fileUse = fileUse},
           Promise.delay
           (fn () =>
            Control.checkFile
-           (fileUse, fail, fn () =>
-            let
-               val seen' = (fileAbs, fileUse, reg) :: seen
-            in
-               if List.exists (seen, fn (fileAbs', _, _) => 
-                               String.equals (fileAbs, fileAbs'))
-                  then (let open Layout
-                        in 
-                           Control.error 
-                           (reg, seq [str "Basis forms a cycle with ", 
-                                      File.layout fileUse],
-                            align (List.map (seen', fn (_, f, r) => 
-                                             seq [Region.layout r, 
-                                                  str ": ", 
-                                                  File.layout f])))
-                           ; Ast.Basdec.empty
-                        end)
-               else 
-                  let
-                     val (_, basdec) =
-                        HashSet.lookupOrInsert
-                        (psi, String.hash fileAbs, fn (fileAbs', _) =>
-                         String.equals (fileAbs, fileAbs'), fn () =>
-                         let
-                            val cwd = OS.Path.dir fileAbs
-                            val basdec =
-                               Promise.delay
-                               (fn () =>
-                                wrapLexAndParse
-                                ({cwd = cwd,
-                                  relativize = relativize,
-                                  seen = seen'},
-                                 lexAndParseFile, fileUse))
-                         in
-                            (fileAbs, basdec)
-                         end)
-                  in
-                     Promise.force basdec
-                  end
-            end)))
+           (fileUse,
+            {fail = fail,
+             name = fileOrig,
+             ok = fn () => let
+                val seen' = (fileAbs, fileUse, reg) :: seen
+             in
+                if List.exists (seen, fn (fileAbs', _, _) => 
+                                String.equals (fileAbs, fileAbs'))
+                   then (let open Layout
+                   in 
+                            Control.error 
+                            (reg, seq [str "Basis forms a cycle with ", 
+                                       File.layout fileUse],
+                             align (List.map (seen', fn (_, f, r) => 
+                                              seq [Region.layout r, 
+                                                   str ": ", 
+                                                   File.layout f])))
+                            ; Ast.Basdec.empty
+                   end)
+                else 
+                   let
+                      val (_, basdec) =
+                         HashSet.lookupOrInsert
+                         (psi, String.hash fileAbs, fn (fileAbs', _) =>
+                          String.equals (fileAbs, fileAbs'), fn () =>
+                          let
+                             val cwd = OS.Path.dir fileAbs
+                             val basdec =
+                                Promise.delay
+                                (fn () =>
+                                 wrapLexAndParse
+                                 ({cwd = cwd,
+                                   relativize = relativize,
+                                   seen = seen'},
+                                  lexAndParseFile, fileUse))
+                          in
+                             (fileAbs, basdec)
+                          end)
+                   in
+                      Promise.force basdec
+                   end
+             end})))
       and lexAndParseProgOrMLB {cwd, relativize, seen}
                                (fileOrig: File.t, reg: Region.t) =
          let
@@ -289,23 +293,28 @@
                end
             val mlbExts = ["mlb"]
             val progExts = ["ML","fun","sig","sml"]
-            fun err () = fail (Ast.Basdec.Seq []) "has an unknown extension"
+            fun err () =
+               fail (Ast.Basdec.Seq [])
+               (concat ["File ", fileOrig, " has an unknown extension"])
          in
             case File.extension fileUse of
                NONE => err ()
              | SOME s =>
-                  if List.contains (mlbExts, s, String.equals)
-                     then lexAndParseMLB {relativize = relativize,
-                                          seen = seen,
-                                          fileAbs = fileAbs,
-                                          fileUse = fileUse,
-                                          fail = fail Ast.Basdec.empty,
-                                          reg = reg}
-                  else if List.contains (progExts, s, String.equals)
-                     then lexAndParseProg {fileAbs = fileAbs,
-                                           fileUse = fileUse,
-                                           fail = fail Ast.Program.empty}
-                  else err ()
+                  if List.contains (mlbExts, s, String.equals) then
+                     lexAndParseMLB {relativize = relativize,
+                                     seen = seen,
+                                     fileAbs = fileAbs,
+                                     fileOrig = fileOrig,
+                                     fileUse = fileUse,
+                                     fail = fail Ast.Basdec.empty,
+                                     reg = reg}
+                  else if List.contains (progExts, s, String.equals) then
+                     lexAndParseProg {fileAbs = fileAbs,
+                                      fileOrig = fileOrig,
+                                      fileUse = fileUse,
+                                      fail = fail Ast.Program.empty}
+                  else
+                     err ()
          end
       and wrapLexAndParse (state, lexAndParse, arg) =
          Ref.fluidLet

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun	2006-11-21 02:52:35 UTC (rev 4851)
@@ -1091,8 +1091,10 @@
                         Place.CM => compileCM input
                       | Place.SML =>
                            Control.checkFile
-                           (input, fn s => raise Fail s,
-                            fn () => compileSml [input])
+                           (input,
+                            {fail = fn s => raise Fail s,
+                             name = input,
+                             ok = fn () => compileSml [input]})
                       | Place.MLB => compileMLB input
                       | Place.Generated => compileCSO (input :: csoFiles)
                       | Place.O => compileCSO (input :: csoFiles)


Property changes on: mlton/branches/on-20050822-x86_64-branch/mlyacc
___________________________________________________________________
Name: svn:ignore
   - *.call-graph.dot
*.ssa
mlyacc
mlyacc.exe
mlyacc.ps
mlyacc.sml

   + *.call-graph.dot
*.ssa
mlyacc.pdf
mlyacc.ps
mlyacc.sml
mlyacc



Modified: mlton/branches/on-20050822-x86_64-branch/mlyacc/.ignore
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlyacc/.ignore	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlyacc/.ignore	2006-11-21 02:52:35 UTC (rev 4851)
@@ -1,6 +1,7 @@
 *.call-graph.dot
 *.ssa
-mlyacc
-mlyacc.exe
+mlyacc.pdf
 mlyacc.ps
 mlyacc.sml
+mlyacc
+

Modified: mlton/branches/on-20050822-x86_64-branch/mlyacc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlyacc/Makefile	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlyacc/Makefile	2006-11-21 02:52:35 UTC (rev 4851)
@@ -38,15 +38,21 @@
 doc/mlyacc.ps:
 	$(MAKE) -C doc mlyacc.ps
 
+doc/mlyacc.pdf:
+	$(MAKE) -C doc mlyacc.pdf
+
 mlyacc.ps: doc/mlyacc.ps
 	cp doc/mlyacc.ps .
 
+mlyacc.pdf: doc/mlyacc.pdf
+	cp doc/mlyacc.pdf .
+
 .PHONY: clean
 clean:
 	../bin/clean
 
 .PHONY: docs
-docs: mlyacc.ps
+docs: mlyacc.pdf
 
 .PHONY: test
 test: $(NAME)

Modified: mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile	2006-11-21 02:52:35 UTC (rev 4851)
@@ -6,7 +6,7 @@
  # See the file MLton-LICENSE for details.
  ##
 
-all: mlyacc.ps
+all: mlyacc.pdf
 
 html/index.html: $(TEX_FILES)
 	mkdir -p html

Modified: mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/debian/changelog	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/package/debian/changelog	2006-11-21 02:52:35 UTC (rev 4851)
@@ -1,3 +1,10 @@
+mlton (20061107-1) unstable; urgency=low
+
+  * new upstream version
+  * Use max-heap 640m instead of fixed-heap 512m.  hopefully closes: #396980
+
+ -- Stephen Weeks <sweeks at sweeks.com>  Tue, 07 Nov 2006 14:01:53 -0800
+
 mlton (20061026-1) unstable; urgency=low
 
   * new upstream version

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile	2006-11-21 02:52:35 UTC (rev 4851)
@@ -29,9 +29,9 @@
 
 ifeq ($(TARGET_ARCH), x86)
 ifeq ($(findstring $(GCC_MAJOR_VERSION), 3 4),$(GCC_MAJOR_VERSION))
-FLAGS += -falign-loops=2 -falign-jumps=2 -falign-functions=5
+OPTFLAGS += -falign-loops=2 -falign-jumps=2 -falign-functions=5
 else
-FLAGS += -malign-loops=2 -malign-jumps=2 -malign-functions=5
+OPTFLAGS += -malign-loops=2 -malign-jumps=2 -malign-functions=5
 endif
 ifeq ($(findstring $(GCC_VERSION), 3.3 3.4 4.0),$(GCC_VERSION))
 GCOPTFLAGS += --param max-inline-insns-single=1000
@@ -49,10 +49,10 @@
 ifeq ($(TARGET_ARCH), amd64)
 FLAGS += -m32
 ifeq ($(findstring $(GCC_MAJOR_VERSION), 3),$(GCC_MAJOR_VERSION))
-FLAGS += -mcpu=opteron
+OPTFLAGS += -mcpu=opteron
 endif
 ifeq ($(findstring $(GCC_MAJOR_VERSION), 4),$(GCC_MAJOR_VERSION))
-FLAGS += -mtune=opteron
+OPTFLAGS += -mtune=opteron
 endif
 ifeq ($(findstring $(GCC_VERSION), 3.4 4.0),$(GCC_VERSION))
 GCOPTFLAGS += --param inline-unit-growth=75 --param max-inline-insns-single=1000
@@ -65,6 +65,10 @@
 FLAGS += -m32 -mcpu=v8 -Wa,-xarch=v8plusa
 endif
 
+ifeq ($(TARGET_OS), darwin)
+FLAGS += -I/sw/include -I/opt/local/include
+endif
+
 ifeq ($(TARGET_OS), freebsd)
 FLAGS += -I/usr/local/include
 endif

Modified: mlton/branches/on-20050822-x86_64-branch/util/cmcat/cmcat.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/util/cmcat/cmcat.sml	2006-11-20 23:44:26 UTC (rev 4850)
+++ mlton/branches/on-20050822-x86_64-branch/util/cmcat/cmcat.sml	2006-11-21 02:52:35 UTC (rev 4851)
@@ -108,7 +108,7 @@
                fun closure () =
                   if List.length (!todo) = 0
                      then ()
-                     else DynamicWind.withEscape
+                     else Exn.withEscape
                           (fn esc =>
                            let
                               val (srcdescr,finish) = List.pop todo
@@ -640,7 +640,7 @@
                       then
                          (comments := true;
                           loop args)
-                   else if String.isPrefix {prefix = "-D", string = flag}
+                   else if String.hasPrefix (flag, {prefix = "-D"})
                       then
                          (defines := String.extract (flag, 2, NONE) :: !defines
                           ; loop args)




More information about the MLton-commit mailing list