Christmas cleanup 2023 (#158)

* preparation for tuple-flattening * some module reuse * install df-files * test binary install * test repl after binary install * avoid writing lnk-files if they already exist * word63 pretty-printing
melsman · Dec 29, 2023 · e01603d · e01603d
1 parent f6cfd56
commit e01603d
Show file tree

Hide file tree

Showing 32 changed files with 743 additions and 291 deletions.
diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
@@ -149,6 +149,20 @@ jobs:
         run: |
           make mlkit_bin_dist
 
+      - name: Install binary distribution and test it
+        run: |
+          mkdir -p ${{ env.RUNHOME }}/tmp
+          cp dist/mlkit-bin-dist-${{ env.OS }}.tgz ${{ env.RUNHOME }}/tmp/
+          cd ${{ env.RUNHOME }}/tmp/
+          tar xzf mlkit-bin-dist-${{ env.OS }}.tgz
+          cd mlkit-bin-dist-${{ env.OS }}
+          sudo make install
+          cd ${{ env.RUNHOME }}
+          rm -rf ${{ env.RUNHOME }}/.mlkit ${{ env.RUNHOME }}/tmp
+          SML_LIB=/usr/local/lib/mlkit /usr/local/bin/mlkit --version
+          SML_LIB=/usr/local/lib/mlkit /usr/local/bin/smltojs --version
+          echo "val a = 10+32; :quit;" | SML_LIB=/usr/local/lib/mlkit /usr/local/bin/mlkit
+
       - name: Test bootstrapping
         run: |
           make bootstrap

diff --git a/Makefile.in b/Makefile.in
@@ -96,7 +96,7 @@ install_smltojs_basislibs:
 	$(MKDIR) $(LIBDIR)/basis
 	$(INSTALLDATA) -p js/basis/*.{sml,sig,mlb} $(LIBDIR)/basis
 	$(MKDIR) $(LIBDIR)/basis/MLB/Js/
-	$(INSTALLDATA) -p js/basis/MLB/Js/*.{d,eb,eb1,lnk,js} $(LIBDIR)/basis/MLB/Js
+	$(INSTALLDATA) -p js/basis/MLB/Js/*.{d,eb,eb1,lnk,js,df} $(LIBDIR)/basis/MLB/Js
 
 .PHONY: install_mlkit_basislibs
 install_mlkit_basislibs:
@@ -110,10 +110,10 @@ install_mlkit_basislibs:
 	$(MKDIR) $(LIBDIR)/basis/io/MLB/RI_GC
 	$(MKDIR) $(LIBDIR)/basis/io/MLB/RI_GC_PROF
 	$(MKDIR) $(LIBDIR)/basis/io/MLB/RI_PROF
-	$(INSTALLDATA) -p basis/MLB/RI/*.{d,eb,eb1,lnk,o} $(LIBDIR)/basis/MLB/RI
-	$(INSTALLDATA) -p basis/MLB/RI_GC/*.{d,eb,eb1,lnk,o} $(LIBDIR)/basis/MLB/RI_GC
-	$(INSTALLDATA) -p basis/MLB/RI_PROF/*.{d,eb,eb1,lnk,o,rev} $(LIBDIR)/basis/MLB/RI_PROF
-	$(INSTALLDATA) -p basis/MLB/RI_GC_PROF/*.{d,eb,eb1,lnk,o,rev} $(LIBDIR)/basis/MLB/RI_GC_PROF
+	$(INSTALLDATA) -p basis/MLB/RI/*.{d,eb,eb1,lnk,o,df} $(LIBDIR)/basis/MLB/RI
+	$(INSTALLDATA) -p basis/MLB/RI_GC/*.{d,eb,eb1,lnk,o,df} $(LIBDIR)/basis/MLB/RI_GC
+	$(INSTALLDATA) -p basis/MLB/RI_PROF/*.{d,eb,eb1,lnk,o,rev,df} $(LIBDIR)/basis/MLB/RI_PROF
+	$(INSTALLDATA) -p basis/MLB/RI_GC_PROF/*.{d,eb,eb1,lnk,o,rev,df} $(LIBDIR)/basis/MLB/RI_GC_PROF
 	$(INSTALLDATA) -p basis/io/MLB/RI/*.{d,eb,eb1,lnk,o} $(LIBDIR)/basis/io/MLB/RI
 	$(INSTALLDATA) -p basis/io/MLB/RI_GC/*.{d,eb,eb1,lnk,o} $(LIBDIR)/basis/io/MLB/RI_GC
 	$(INSTALLDATA) -p basis/io/MLB/RI_PROF/*.{d,eb,eb1,lnk,o,rev} $(LIBDIR)/basis/io/MLB/RI_PROF

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,11 @@
 ## MLKit NEWS
 
+* mael 2023-12-29: Cleanup and ensurance that mlkit does not write
+  into the installation directory when the repl is launched or when
+  linking with compiled versions of the SML Basis Library (PR #158).
+
+* mael 2023-12-29: MacOS Sonoma / Xcode 15 support.
+
 ### MLKit version 4.7.7 is released
 
 * mael 2023-12-15: Cleanup and various optimisation improvements

diff --git a/basis/OS_PATH.sml b/basis/OS_PATH.sml
@@ -8,13 +8,13 @@ signature OS_PATH =
     val parentArc  : string
     val currentArc : string
     val fromString : string -> {isAbs : bool,
-			        vol : string,
-			        arcs : string list
-			       }
+                                vol : string,
+                                arcs : string list
+                               }
     val toString   : {isAbs : bool,
-		      vol : string,
-		      arcs : string list
-		     } -> string
+                      vol : string,
+                      arcs : string list
+                     } -> string
 
     val validVolume  : {isAbs: bool, vol: string} -> bool
 
@@ -62,16 +62,16 @@ etc.
 
 Here are some examples for Unix paths:
 
-    path 	fromString path
-    ""  	{isAbs=false, vol="", arcs=[]}
-    "/" 	{isAbs=true, vol="", arcs=[""]}
-    "//" 	{isAbs=true, vol="", arcs=["", ""]}
-    "a" 	{isAbs=false, vol="", arcs=["a"]}
-    "/a" 	{isAbs=true, vol="", arcs=["a"]}
-    "//a" 	{isAbs=true, vol="", arcs=["","a"]}
-    "a/" 	{isAbs=false, vol="", arcs=["a", ""]}
-    "a//" 	{isAbs=false, vol="", arcs=["a", "", ""]}
-    "a/b" 	{isAbs=false, vol="", arcs=["a", "b"]}
+    path        fromString path
+    ""          {isAbs=false, vol="", arcs=[]}
+    "/"         {isAbs=true, vol="", arcs=[""]}
+    "//"        {isAbs=true, vol="", arcs=["", ""]}
+    "a"         {isAbs=false, vol="", arcs=["a"]}
+    "/a"        {isAbs=true, vol="", arcs=["a"]}
+    "//a"       {isAbs=true, vol="", arcs=["","a"]}
+    "a/"        {isAbs=false, vol="", arcs=["a", ""]}
+    "a//"       {isAbs=false, vol="", arcs=["a", "", ""]}
+    "a/b"       {isAbs=false, vol="", arcs=["a", "b"]}
 
 
 [toString {isAbs, vol, arcs}] makes a string out of a path represented
@@ -108,30 +108,30 @@ result of getParent will also be canonical.
 
 Here are some examples for Unix paths:
 
-    path 	getParent path
-    "/" 	"/"
-    "a" 	"."
-    "a/" 	"a/.."
-    "a///" 	"a///.."
-    "a/b" 	"a"
-    "a/b/" 	"a/b/.."
-    ".." 	"../.."
-    "." 	".."
-    "" 	".."
+    path        getParent path
+    "/"         "/"
+    "a"         "."
+    "a/"        "a/.."
+    "a///"      "a///.."
+    "a/b"       "a"
+    "a/b/"      "a/b/.."
+    ".."        "../.."
+    "."         ".."
+    ""  ".."
 
 [splitDirFile path] splits the string path path into its directory and
 file parts, where the file part is defined to be the last arc. The
 file will be "", if the last arc is "".
 
 Here are some examples for Unix paths:
 
-    path 	splitDirFile path
-    ""  	{dir = "", file = ""}
-    "." 	{dir = "", file = "."}
-    "b" 	{dir = "", file = "b"}
-    "b/" 	{dir = "b", file = ""}
-    "a/b" 	{dir = "a", file = "b"}
-    "/a" 	{dir = "/", file = "a"}
+    path        splitDirFile path
+    ""          {dir = "", file = ""}
+    "."         {dir = "", file = "."}
+    "b"         {dir = "", file = "b"}
+    "b/"        {dir = "b", file = ""}
+    "a/b"       {dir = "a", file = "b"}
+    "/a"        {dir = "/", file = "a"}
 
 [joinDirFile {dir, file}] creates a whole path out of a directory and
 a file by extending the path dir with the arc file. If the string file
@@ -156,15 +156,15 @@ base part.
 
 Here are some examples for Unix paths:
 
-    path 	splitBaseExt path
-    ""  	{base = "", ext = NONE}
-    ".login" 	{base = ".login", ext = NONE}
-    "/.login" 	{base = "/.login", ext = NONE}
-    "a" 	{base = "a", ext = NONE}
-    "a." 	{base = "a.", ext = NONE}
-    "a.b" 	{base = "a", ext = SOME "b"}
-    "a.b.c" 	{base = "a.b", ext = SOME "c"}
-    ".news/comp" 	{base = ".news/comp", ext = NONE}
+    path        splitBaseExt path
+    ""          {base = "", ext = NONE}
+    ".login"    {base = ".login", ext = NONE}
+    "/.login"   {base = "/.login", ext = NONE}
+    "a"         {base = "a", ext = NONE}
+    "a."        {base = "a.", ext = NONE}
+    "a.b"       {base = "a", ext = SOME "b"}
+    "a.b.c"     {base = "a.b", ext = SOME "c"}
+    ".news/comp"        {base = ".news/comp", ext = NONE}
 
 [joinBaseExt {base, ext}] returns an arc composed of the base name and
 the extension (if different from NONE). It is a left inverse of
@@ -224,20 +224,20 @@ greater than String.maxSize.
 
 Here are some examples for Unix paths:
 
-    path 	relativeTo 	mkRelative{path, relativeTo}
-    "a/b" 	"/c/d" 	"a/b"
-    "/" 	"/a/b/c" 	"../../.."
-    "/a/b/" 	"/a/c" 	"../b/"
-    "/a/b" 	"/a/c" 	"../b"
-    "/a/b/" 	"/a/c/" 	"../b/"
-    "/a/b" 	"/a/c/" 	"../b"
-    "/" 	"/" 	"."
-    "/" 	"/." 	"."
-    "/" 	"/.." 	"."
-    "/a/b/../c" 	"/a/d" 	"../b/../c"
-    "/a/b" 	"/c/d" 	"../../a/b"
-    "/c/a/b" 	"/c/d" 	"../a/b"
-    "/c/d/a/b" 	"/c/d" 	"a/b"
+    path        relativeTo      mkRelative{path, relativeTo}
+    "a/b"       "/c/d"  "a/b"
+    "/"         "/a/b/c"        "../../.."
+    "/a/b/"     "/a/c"  "../b/"
+    "/a/b"      "/a/c"  "../b"
+    "/a/b/"     "/a/c/"         "../b/"
+    "/a/b"      "/a/c/"         "../b"
+    "/"         "/"     "."
+    "/"         "/."    "."
+    "/"         "/.."   "."
+    "/a/b/../c"         "/a/d"  "../b/../c"
+    "/a/b"      "/c/d"  "../../a/b"
+    "/c/a/b"    "/c/d"  "../a/b"
+    "/c/d/a/b"  "/c/d"  "a/b"
 
 [isAbsolute path]
 [isRelative path]

diff --git a/basis/repl.sml b/basis/repl.sml
@@ -394,7 +394,7 @@ fun pretty_exported (i:int) : int =
                       | C ([], "word8") => ("0wx" ^ Word8.toString (prim("unsafe_cast", v)), z_base)
                       | C ([], "word31") => ("0wx" ^ Word31.toString (prim("unsafe_cast", v)), z_base)
                       | C ([], "word32") => ("0wx" ^ Word32.toString (prim("unsafe_cast", v)), z_base)
-(*                      | C ([], "word63") => ("0wx" ^ Word63.toString (prim("unsafe_cast", v)), z_base) *)
+                      | C ([], "word63") => ("0wx" ^ Word63.toString (prim("unsafe_cast", v)), z_base)
                       | C ([], "word64") => ("0wx" ^ Word64.toString (prim("unsafe_cast", v)), z_base)
                       | C ([], "word") => ("0wx" ^ Word.toString (prim("unsafe_cast", v)), z_base)
                       | C ([], "real") => (Real.toString (prim("unsafe_cast", v)), z_base)

diff --git a/src/Common/EfficientElab/ElabTopdec.sml b/src/Common/EfficientElab/ElabTopdec.sml
@@ -303,15 +303,9 @@ structure ElabTopdec: ELABTOPDEC  =
      * -------------------------------------------- *)
 
     local
-      structure VIdSet = OrderSet(struct type t = Ident.id
-                                         val lt = fn (x,y) => Ident.< (x,y)
-                                  end)
-      structure TyConSet = OrderSet(struct type t = TyCon.tycon
-                                           val lt = fn (x,y) => TyCon.< (x,y)
-                                    end)
-      structure StrIdSet = OrderSet(struct type t = StrId.strid
-                                           val lt = fn (x,y) => StrId.< (x,y)
-                                    end)
+      structure VIdSet = Ident.Set
+      structure TyConSet = TyCon.Set
+      structure StrIdSet = StrId.Set
     in
       type ids = StrIdSet.Set * TyConSet.Set * VIdSet.Set
       val ids_empty = (StrIdSet.empty, TyConSet.empty, VIdSet.empty)

diff --git a/src/Common/FUNID.sig b/src/Common/FUNID.sig
@@ -3,13 +3,10 @@
 signature FUNID =
   sig
     eqtype funid
-
-    val mk_FunId: string -> funid	(* NEW PARSER *)
-    and pr_FunId: funid -> string
-
-    val < : funid * funid -> bool	(* Used for top-level printout *)
-
-    val pu : funid Pickle.pu
+    val mk_FunId : string -> funid              (* NEW PARSER *)
+    and pr_FunId : funid -> string
+    val <        : funid * funid -> bool        (* Used for top-level printout *)
+    val pu       : funid Pickle.pu
 
     structure Map : MONO_FINMAP where type dom = funid
   end
diff --git a/src/Common/IDENT.sig b/src/Common/IDENT.sig
@@ -5,74 +5,71 @@ signature IDENT =
     eqtype strid
 
     eqtype longid
-    val pr_longid : longid -> string
+    val pr_longid       : longid -> string
 
     eqtype id
-    val inventId: unit -> id
-    val invent_named_id: string -> id
-    and pr_id : id -> string
+    val inventId        : unit -> id
+    val invent_named_id : string -> id
+    and pr_id           : id -> string
 
-    val mk_Id: string -> id			(* NEW PARSER *)
-    val mk_LongId: string list -> longid	(* NEW PARSER *)
-    val inventLongId: unit -> longid		(* NEW PARSER *)
-    val idToLongId: id -> longid
+    val mk_Id           : string -> id                 (* NEW PARSER *)
+    val mk_LongId       : string list -> longid        (* NEW PARSER *)
+    val inventLongId    : unit -> longid               (* NEW PARSER *)
+    val idToLongId      : id -> longid
 
-    val unqualified: longid -> bool
-    val decompose: longid -> strid list * id
-    val decompose0: longid -> id
-    val implode_LongId : strid list * id -> longid
+    val unqualified     : longid -> bool
+    val decompose       : longid -> strid list * id
+    val decompose0      : longid -> id
+    val implode_LongId  : strid list * id -> longid
 
-    val < : id * id -> bool
+    val <               : id * id -> bool
 
    (* Identifiers needed for derived form conversion. *)
-
-    val id_NIL: id
-    val id_CONS: id
-    val id_TRUE: id
-    val id_FALSE: id
-    val id_REF: id
-    val id_PRIM: id
-    val id_EXPORT: id
-    val id_IT: id
-
-    val id_QUOTE : id
-    val id_ANTIQUOTE : id
-
-    val id_INTINF : id
+    val id_NIL          : id
+    val id_CONS         : id
+    val id_TRUE         : id
+    val id_FALSE        : id
+    val id_REF          : id
+    val id_PRIM         : id
+    val id_EXPORT       : id
+    val id_IT           : id
+    val id_QUOTE        : id
+    val id_ANTIQUOTE    : id
+    val id_INTINF       : id
 
     (* Identifiers needed for initial environment - because of overloading *)
-    val id_ABS: id
-    val id_NEG: id
-    val id_DIV: id
-    val id_MOD: id
-    val id_PLUS: id
-    val id_MINUS: id
-    val id_MUL: id
-    val id_LESS: id
-    val id_GREATER: id
-    val id_LESSEQ: id
-    val id_GREATEREQ: id
-
-    val resetRegions: id
-    val forceResetting: id
-
-    (*exception constructors in the initial basis which are not declared in
-     the prelude:*)
-
-    val id_Div : id
-    val id_Match : id
-    val id_Bind : id
-    val id_Overflow : id
-    val id_Interrupt : id
-    val id_Subscript : id
-    val id_Size : id
+    val id_ABS          : id
+    val id_NEG          : id
+    val id_DIV          : id
+    val id_MOD          : id
+    val id_PLUS         : id
+    val id_MINUS        : id
+    val id_MUL          : id
+    val id_LESS         : id
+    val id_GREATER      : id
+    val id_LESSEQ       : id
+    val id_GREATEREQ    : id
+
+    val resetRegions    : id
+    val forceResetting  : id
+
+    (* Exception constructors in the initial basis that are not
+       declared in the prelude *)
+
+    val id_Div          : id
+    val id_Match        : id
+    val id_Bind         : id
+    val id_Overflow     : id
+    val id_Interrupt    : id
+    val id_Subscript    : id
+    val id_Size         : id
 
     (* Bogus identifier *)
-    val bogus: longid
+    val bogus           : longid
 
-    val reset : unit -> unit   (* resets counter to initial counter. *)
-    val pu : id Pickle.pu
+    val reset           : unit -> unit   (* resets counter to initial counter. *)
+    val pu              : id Pickle.pu
 
     structure Map : MONO_FINMAP where type dom = id
-
+    structure Set : KIT_MONO_SET where type elt = id
   end