Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/compiler/PervEnv/Win32/os-path.sml
ViewVC logotype

View of /sml/trunk/src/compiler/PervEnv/Win32/os-path.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (download) (annotate)
Wed Mar 11 21:00:18 1998 UTC (22 years, 4 months ago)
Original Path: sml/branches/SMLNJ/src/compiler/PervEnv/Win32/os-path.sml
File size: 1724 byte(s)
This commit was manufactured by cvs2svn to create branch 'SMLNJ'.
(* os-path.sml
 *
 * COPYRIGHT (c) 1996 Bell Laboratories.
 *
 * Win32 implementation of the OS.Path structure.
 *
 *)

structure OS_Path = OS_PathFn (
  struct
      structure W32G = Win32_General
      structure C = Char
      structure S = String
      structure SS = Substring

      exception Path

      datatype arc_kind = Null | Parent | Current | Arc of string

      fun classify "" = Null
	| classify "." = Current
	| classify ".." = Parent
	| classify a = Arc a

      val parentArc  = ".."
      val currentArc = "."

      val volSepChar = #":"

      val arcSepChar = W32G.arcSepChar
      val arcSep = S.str arcSepChar

      fun volPresent vol = 
          (String.size vol >= 2) andalso
	  (C.isAlpha(S.sub(vol,0)) andalso (S.sub(vol,1) = volSepChar))

      fun validVolume (_,vol) = 
	  (SS.isEmpty vol) orelse volPresent(SS.string vol)

      val emptySS    = SS.all ""

      fun splitPath (vol, s) = 
	  if (SS.size s >= 1) andalso (SS.sub(s, 0) = arcSepChar) then
	       (true, vol, SS.triml 1 s)
	  else (false, vol, s)

      fun splitVolPath "" = (false, emptySS, emptySS)
	| splitVolPath s = 
	  if volPresent s then splitPath (SS.splitAt (SS.all s, 2))
	  else splitPath (emptySS, SS.all s)

      fun joinVolPath arg = 
	  let fun checkVol vol = if (volPresent vol) then vol else raise Path
	      fun aux (true,"","") = arcSep
		| aux (true,"",s) = arcSep^s
		| aux (true,vol,"") = (checkVol vol)^arcSep
		| aux (true,vol,s) = (checkVol vol)^arcSep^s
		| aux (false,"",s) = s
		| aux (false,vol,"") = checkVol vol
		| aux (false,vol,s) = (checkVol vol)^s
	  in  aux arg
	  end
  end);



(*
 * $Log: os-path.sml,v $
 * Revision 1.1.1.1  1997/01/14 01:38:26  george
 *   Version 109.24
 *
 *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0