[MLton-commit] r6131
Vesa Karvonen
vesak at mlton.org
Wed Nov 7 17:01:44 PST 2007
Initial commit of UseLib.
----------------------------------------------------------------------
A mltonlib/trunk/org/mlton/vesak/use-lib/
A mltonlib/trunk/org/mlton/vesak/use-lib/unstable/
A mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh
A mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/
A mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/use-lib.sml
A mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/
A mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/export.sml
A mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/use-lib.sig
----------------------------------------------------------------------
Property changes on: mltonlib/trunk/org/mlton/vesak/use-lib/unstable
___________________________________________________________________
Name: svn:ignore
+ *.use
Added: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh
===================================================================
--- mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh 2007-11-07 14:14:07 UTC (rev 6130)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh 2007-11-08 01:01:44 UTC (rev 6131)
@@ -0,0 +1,48 @@
+#!/bin/bash
+
+# Copyright (C) 2007 Vesa Karvonen
+#
+# This code is released under the MLton license, a BSD-style license.
+# See the LICENSE file or http://mlton.org/License for details.
+
+set -e
+
+code="$(cat public/use-lib.sig detail/use-lib.sml public/export.sml)"
+
+function gen {
+ echo "(* Copyright (C) 2007 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(* WARNING: This file was generated by the $(basename $0) script. *)" > "$1.use"
+
+ echo "$code" \
+ | grep -v '^ *(\?\*' \
+ | sed -e "s/\\\$(SML_COMPILER)/\"$1\"/g" \
+ -e "s/\\\$(SILENT)/$(echo $2)/g" \
+ -e "s/\\\$(VERBOSE)/$(echo $3)/g" \
+ >> "$1.use"
+}
+
+gen polyml \
+ '(PolyML.get_print_depth () \
+ before PolyML.print_depth 0)' \
+ 'PolyML.print_depth'
+
+gen smlnj \
+ 'let \
+ open Control.Print \
+ in \
+ {depth = !printDepth, \
+ sigs = !signatures} \
+ before (printDepth := 0 \
+ ; signatures := 0) \
+ end' \
+ 'let \
+ open Control.Print \
+ in \
+ fn old => (printDepth := #depth old \
+ ; signatures := #sigs old) \
+ end'
Property changes on: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:eol-style
+ native
Added: 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-07 14:14:07 UTC (rev 6130)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/use-lib.sml 2007-11-08 01:01:44 UTC (rev 6131)
@@ -0,0 +1,80 @@
+(* Copyright (C) 2007 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure UseLib :> USE_LIB = struct
+ fun after (th, ef) =
+ ((case th () of v => fn () => (ef () ; v))
+ handle e => fn () => (ef () ; raise e)) ()
+
+ fun error strs = raise Fail (concat strs)
+
+ val vars : (string * string) list ref =
+ ref [("SML_COMPILER", $(SML_COMPILER))]
+
+ fun getVar var =
+ case List.find (fn (i, _) => i = var) (!vars)
+ of SOME (_, v) => v
+ | NONE =>
+ case OS.Process.getEnv var
+ of NONE => error ["Undefined variable: ", var]
+ | SOME v => v
+
+ fun expandVars path = let
+ fun outside os =
+ 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)
+ | c :: is => inside os (c::vs) is
+ | [] => error ["Unclosed variable reference"]
+ in
+ outside [] (explode path)
+ end
+
+ val using : string option ref = ref NONE
+ 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"]
+ | SOME path =>
+ if List.exists (fn p => path = p) (!loaded)
+ then ()
+ else if List.exists (fn p => path = p) (!loading)
+ then error ("Cyclic library dependency: " ::
+ 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 was = !loading
+ in
+ loading := path :: was
+ ; after (fn () =>
+ (app use reqs
+ ; app use self
+ ; loaded := path :: !loaded),
+ fn () => ($(VERBOSE) cv
+ ; loading := was
+ ; OS.FileSys.chDir cwd))
+ end
+end
Property changes on: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/use-lib.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/export.sml 2007-11-07 14:14:07 UTC (rev 6130)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/export.sml 2007-11-08 01:01:44 UTC (rev 6131)
@@ -0,0 +1,18 @@
+(* Copyright (C) 2007 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(** == Exported Signatures == *)
+
+signature USE_LIB = USE_LIB
+
+(** == Exported Structures == *)
+
+structure UseLib : USE_LIB = UseLib
+
+(** == Exported Top-Level Values == *)
+
+val lib = UseLib.lib
+val use = UseLib.use
Property changes on: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/export.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Added: 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-07 14:14:07 UTC (rev 6130)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/use-lib.sig 2007-11-08 01:01:44 UTC (rev 6131)
@@ -0,0 +1,20 @@
+(* Copyright (C) 2007 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature USE_LIB = sig
+ val lib : {reqs : string list,
+ self : string list} -> unit
+ (**
+ * Defines a library that depends on the {reqs} libraries and is
+ * implemented by the {self} files.
+ *)
+
+ val use : string -> unit
+ (**
+ * Loads the specified library or uses the specified source file.
+ * Environment variable references are allowed within the path.
+ *)
+end
Property changes on: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/public/use-lib.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list