[MLton-commit] r6139
Vesa Karvonen
vesak at mlton.org
Thu Nov 8 04:54:59 PST 2007
Introduced a trace facility to UseLib for creating flat use files.
Changed the syntax of variable references from $(VAR) to ${VAR}. This
matches the syntax of SML# 0.31, which is also the main motivation for the
trace facility.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/extensions.use
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/forget.use
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/extensions.use
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds.use
U mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
U mltonlib/trunk/com/ssh/random/unstable/detail/ml/polyml/random-dev.use
U mltonlib/trunk/com/ssh/random/unstable/detail/ml/smlnj/random-dev.use
U mltonlib/trunk/com/ssh/random/unstable/lib.use
U mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh
U mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/use-lib.sml
U mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/use-lib.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/extensions.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/extensions.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -4,6 +4,7 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-val () =
+UseLib.Trace.disabled
+(fn () =>
app use
- ["detail/ml/common/ext.sml"]
+ ["detail/ml/common/ext.sml"]) ;
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/forget.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/forget.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/polyml/forget.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -4,7 +4,8 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-val () =
+UseLib.Trace.disabled
+(fn () =>
(app PolyML.Compiler.forgetFunctor
["MkIntInfExt",
"MkIntegerExt",
@@ -18,4 +19,4 @@
"MkMonoArraySliceExt",
"MkTextExt"]
; app PolyML.Compiler.forgetStructure
- ["Ext"])
+ ["Ext"])) ;
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/extensions.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/extensions.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -4,6 +4,7 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-val () =
+UseLib.Trace.disabled
+(fn () =>
app use
- ["detail/ml/smlnj/ext.sml"]
+ ["detail/ml/smlnj/ext.sml"]) ;
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -4,7 +4,8 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-val () =
+UseLib.Trace.disabled
+(fn () =>
app (fn file => use ("detail/ml/smlnj/workarounds/"^file))
["mk-real-sane.fun",
"char.sig",
@@ -12,6 +13,6 @@
"reals.sml",
"string.sig",
"text.sig",
- "text.sml"]
+ "text.sml"]) ;
(* XXX Is there a way to "forget" top-level bindings in SML/NJ? *)
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -5,11 +5,11 @@
*)
lib {reqs = [],
- self = ["detail/ml/$(SML_COMPILER)/workarounds.use",
+ self = ["detail/ml/${SML_COMPILER}/workarounds.use",
"detail/ml/common/basis.sml",
- "detail/ml/$(SML_COMPILER)/basis.sml",
+ "detail/ml/${SML_COMPILER}/basis.sml",
"detail/bootstrap.sml",
- "detail/ml/$(SML_COMPILER)/extensions.use",
+ "detail/ml/${SML_COMPILER}/extensions.use",
"public/concept/bitwise.sig",
"public/concept/bounded.sig",
"public/concept/cased.sig",
@@ -50,7 +50,7 @@
"public/data/univ.sig",
"detail/data/univ-ref.sml",
"detail/data/univ-exn.sml",
- "detail/ml/$(SML_COMPILER)/univ.sml",
+ "detail/ml/${SML_COMPILER}/univ.sml",
"public/fn/bin-op.sig",
"detail/fn/bin-op.sml",
"public/fn/effect.sig",
@@ -110,9 +110,9 @@
"detail/numeric/mk-real-ext.fun",
"detail/numeric/mk-word-ext.fun",
"detail/ml/common/scalars.sml",
- "detail/ml/$(SML_COMPILER)/ints.sml",
- "detail/ml/$(SML_COMPILER)/reals.sml",
- "detail/ml/$(SML_COMPILER)/words.sml",
+ "detail/ml/${SML_COMPILER}/ints.sml",
+ "detail/ml/${SML_COMPILER}/reals.sml",
+ "detail/ml/${SML_COMPILER}/words.sml",
"public/sequence/list.sig",
"detail/sequence/list.sml",
"public/sequence/buffer.sig",
@@ -143,11 +143,11 @@
"detail/sequence/mk-mono-array-slice-ext.fun",
"detail/text/mk-text-ext.fun",
"detail/ml/common/mono-seqs.sml",
- "detail/ml/$(SML_COMPILER)/mono-vectors.sml",
- "detail/ml/$(SML_COMPILER)/mono-vector-slices.sml",
- "detail/ml/$(SML_COMPILER)/mono-arrays.sml",
- "detail/ml/$(SML_COMPILER)/mono-array-slices.sml",
- "detail/ml/$(SML_COMPILER)/texts.sml",
+ "detail/ml/${SML_COMPILER}/mono-vectors.sml",
+ "detail/ml/${SML_COMPILER}/mono-vector-slices.sml",
+ "detail/ml/${SML_COMPILER}/mono-arrays.sml",
+ "detail/ml/${SML_COMPILER}/mono-array-slices.sml",
+ "detail/ml/${SML_COMPILER}/texts.sml",
"public/sequence/stream.sig",
"detail/sequence/stream.sml",
"public/lazy/lazy.sig",
@@ -156,8 +156,8 @@
"public/io/text-io.sig",
"detail/io/text-io.sml",
"detail/concept/mk-word-flags.fun",
- "detail/ml/$(SML_COMPILER)/forget.use",
- "public/export/$(SML_COMPILER).sml",
+ "detail/ml/${SML_COMPILER}/forget.use",
+ "public/export/${SML_COMPILER}.sml",
"public/export/common.sml",
"public/export/top-level.sml",
"public/export/infixes.sml",
Modified: mltonlib/trunk/com/ssh/random/unstable/detail/ml/polyml/random-dev.use
===================================================================
--- mltonlib/trunk/com/ssh/random/unstable/detail/ml/polyml/random-dev.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/random/unstable/detail/ml/polyml/random-dev.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -5,4 +5,6 @@
*)
(* XXX implement better seed/useed for Poly/ML *)
-use "detail/ml/common/random-dev.sml" ;
+UseLib.Trace.disabled
+(fn () =>
+ use "detail/ml/common/random-dev.sml") ;
Modified: mltonlib/trunk/com/ssh/random/unstable/detail/ml/smlnj/random-dev.use
===================================================================
--- mltonlib/trunk/com/ssh/random/unstable/detail/ml/smlnj/random-dev.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/random/unstable/detail/ml/smlnj/random-dev.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -5,4 +5,6 @@
*)
(* XXX implement better seed/useed for SML/NJ *)
-use "detail/ml/common/random-dev.sml" ;
+UseLib.Trace.disabled
+(fn () =>
+ use "detail/ml/common/random-dev.sml") ;
Modified: mltonlib/trunk/com/ssh/random/unstable/lib.use
===================================================================
--- mltonlib/trunk/com/ssh/random/unstable/lib.use 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/com/ssh/random/unstable/lib.use 2007-11-08 12:54:58 UTC (rev 6139)
@@ -12,5 +12,5 @@
"detail/numerical-recipes.sml",
"detail/ranqd1-gen.sml",
"public/random-dev.sig",
- "detail/ml/$(SML_COMPILER)/random-dev.use",
+ "detail/ml/${SML_COMPILER}/random-dev.use",
"public/export.sml"]} ;
Modified: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh
===================================================================
--- mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh 2007-11-08 12:54:58 UTC (rev 6139)
@@ -20,10 +20,10 @@
echo "$code" \
| grep -v '^ *(\?\*' \
- | sed -e "s/\\\$(SML_COMPILER)/\"$1\"/g" \
- -e "s/\\\$(SILENT)/$(echo -n $2)/g" \
- -e "s/\\\$(VERBOSE)/$(echo -n $3)/g" \
- -e "s/\\\$(PRELUDE)/$(echo -n $4)/g" \
+ | sed -e "s/\\\${SML_COMPILER}/\"$1\"/g" \
+ -e "s/\\\${SILENT}/$(echo -n $2)/g" \
+ -e "s/\\\${VERBOSE}/$(echo -n $3)/g" \
+ -e "s/\\\${PRELUDE}/$(echo -n $4)/g" \
>> "$1.use"
echo "Wrote $1.use"
}
@@ -52,3 +52,8 @@
''
gen mosml '()' 'ignore' 'val () = load "OS" ;'
+
+if which poly > /dev/null ; then
+ echo 'PolyML.print_depth 0 ; use "polyml.use" ;' | poly -q
+ echo
+fi
Modified: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/use-lib.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/use-lib.sml 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/use-lib.sml 2007-11-08 12:54:58 UTC (rev 6139)
@@ -4,7 +4,7 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-$(PRELUDE)
+${PRELUDE}
structure UseLib :> USE_LIB = struct
fun after (th, ef) =
@@ -13,8 +13,7 @@
fun error strs = raise Fail (concat strs)
- val vars : (string * string) list ref =
- ref [("SML_COMPILER", $(SML_COMPILER))]
+ val vars = ref [("SML_COMPILER", ${SML_COMPILER})]
fun getVar var =
case List.find (fn (i, _) => i = var) (!vars)
@@ -26,11 +25,11 @@
fun expandVars path = let
fun outside os =
- fn #"$" :: #"(" :: is => inside os [] is
+ fn #"$" :: #"{" :: is => inside os [] is
| c :: is => outside (c::os) is
| [] => implode (rev os)
and inside os vs =
- fn #")" :: is => outside os (explode (getVar (implode (rev vs))) @ is)
+ fn #"}" :: is => outside os (explode (getVar (implode (rev vs))) @ is)
| c :: is => inside os (c::vs) is
| [] => error ["Unclosed variable reference"]
in
@@ -38,23 +37,59 @@
end
val using : string option ref = ref NONE
+
+ fun useNoTrace path = let
+ val path = expandVars path
+ val () = if OS.FileSys.access (path, [OS.FileSys.A_READ])
+ then ()
+ else error ["Unreadable file: ", path]
+ val path = OS.FileSys.fullPath path
+ val oldUsing = !using
+ in
+ using := SOME path
+ ; after (fn () => use path,
+ fn () => using := oldUsing)
+ end
+
+ structure Trace = struct
+ datatype t =
+ CHDIR of string
+ | USE of string
+ local
+ val theTrace : t list ref = ref []
+ val recTrace = ref false
+ fun scoped t th =
+ case !recTrace
+ of old => (recTrace := t
+ ; after (th, fn () => recTrace := old))
+ in
+ fun load path =
+ scoped true (fn () => (useNoTrace path
+ ; rev (!theTrace) before theTrace := []))
+
+ fun fmt {expandVars = e} = let
+ val expandVars = if e then expandVars else fn x => x
+ in
+ concat o List.concat o
+ map (fn CHDIR path =>
+ ["OS.FileSys.chDir \"", expandVars path, "\" ;\n"]
+ | USE path =>
+ ["use \"", expandVars path, "\" ;\n"])
+ end
+
+ fun disabled th = scoped false th
+
+ fun trace th = if !recTrace then theTrace := th () :: !theTrace else ()
+ end
+ end
+
+ open Trace
+
+ fun use path = (trace (fn () => USE path) ; useNoTrace path)
+
val loading : string list ref = ref []
val loaded : string list ref = ref []
- val use =
- fn path => let
- val path = expandVars path
- val () = if OS.FileSys.access (path, [OS.FileSys.A_READ])
- then ()
- else error ["Unreadable file: ", path]
- val path = OS.FileSys.fullPath path
- val old = !using
- in
- using := SOME path
- ; after (fn () => use path,
- fn () => using := old)
- end
-
fun lib {reqs, self} =
case !using
of NONE => error ["Current file unknown"]
@@ -66,17 +101,30 @@
foldl (fn (p, ps) => p::" -> "::ps) [path] (!loading))
else let
val cwd = OS.FileSys.getDir ()
- val () = OS.FileSys.chDir (OS.Path.dir path)
- val cv = $(SILENT)
+ val dir = OS.Path.dir path
+ val () = if dir <> cwd
+ then (OS.FileSys.chDir dir
+ ; trace (fn () => CHDIR (OS.Path.mkRelative
+ {path = dir,
+ relativeTo = cwd})))
+ else ()
+ val cv = ${SILENT}
val was = !loading
in
loading := path :: was
; after (fn () =>
- (app use reqs
+ (app useNoTrace reqs
; app use self
; loaded := path :: !loaded),
- fn () => ($(VERBOSE) cv
- ; loading := was
- ; OS.FileSys.chDir cwd))
+ fn () =>
+ (${VERBOSE} cv
+ ; loading := was
+ ; if dir <> cwd
+ then (OS.FileSys.chDir cwd
+ ; trace (fn () =>
+ CHDIR (OS.Path.mkRelative
+ {path = cwd,
+ relativeTo = dir})))
+ else ()))
end
end
Modified: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/use-lib.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/use-lib.sig 2007-11-08 02:28:40 UTC (rev 6138)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/use-lib.sig 2007-11-08 12:54:58 UTC (rev 6139)
@@ -4,6 +4,10 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
+(**
+ * Signature for the {UseLib} module that provides a simple {use} based
+ * library definition framework.
+ *)
signature USE_LIB = sig
val lib : {reqs : string list,
self : string list} -> unit
@@ -17,4 +21,22 @@
* Loads the specified library or uses the specified source file.
* Environment variable references are allowed within the path.
*)
+
+ (**
+ * Interface for recording flat traces of library loading.
+ *)
+ structure Trace : sig
+ datatype t =
+ CHDIR of string
+ | USE of string
+
+ val load : string -> t list
+ (** Load the specified library and return a trace. *)
+
+ val fmt : {expandVars : bool} -> t list -> string
+ (** Formats given trace as a flat use file. *)
+
+ val disabled : (unit -> 'a) -> 'a
+ (** Invoke thunk with trace disabled. *)
+ end
end
More information about the MLton-commit
mailing list