fpath.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
immutable class FILE_TYPES < $IS_EQ, $HASH
immutable class FILE_TYPES < $IS_EQ, $HASH is
-- This class provides a mapping from 'name' to a temporary code for
-- use in manipulating files whose contents are distinguished by a 'type'
-- denotation.
-- Version 1.4 Oct 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 10 Jun 96 kh Original
-- 19 Feb 97 kh Additions for string/char portability.
-- 16 Apr 97 kh Modified for INT to CARD, etc
-- 23 Jul 97 kh Higher level abstraction for diff OSs
-- 22 Oct 98 kh Reverted to 'string' identification.
include NUM_CODE
create -> code_create ;
private shared in_map : FMAP{STR,SAME} ;
private shared out_map : FMAP{SAME,STR} ;
private shared next : SAME ;
private init is
-- This routine creates the shared components of this class if
-- necessary. Note that next starts at 1 so that void tests can be carried out.
if void(in_map) then
in_map := FMAP{STR,SAME}::create ;
out_map := FMAP{SAME,STR}::create ;
next := 1
end
end ;
create(str : STR) : SAME
pre ~void(str)
post out_map.test(result)
is
--This routine returns the file type which corresponds to the given
-- string - if it exists - otherwise creates a new value which is returned.
init ;
if in_map.test(str) then
return in_map.get(str)
else
me : SAME := next ;
next := code_create((next.card + 1).binstr) ;
in_map := in_map.insert(str,me) ;
out_map := out_map.insert(me,str) ;
return me
end
end ;
kind(str : STR) : SAME
pre ~void(str)
post out_map.test(result)
is
--This routine returns the file type which corresponds to the given
-- string - if it exists - otherwise creates a new value which is returned.
-- It is merely a synonym for create above!
return create(str)
end ;
private card : CARD
pre ~void(self)
post (result > 0)
is
--This private routine 'converts' self to cardinal for addition, etc.
-- Note that the built-in code actually does nothing!
builtin CARD_CARD
end ;
hash : CARD
pre true -- irrespective of value of self
post true -- irrespective of result
is
--This is a hash function for use when mapping by this key. It merely
-- uses the library cardinal hash function.
return card.hash
end ;
str : STR
pre ~void(self)
post (in_map.get(result) = self)
is
--This routine returns the text name of the enumeration for
-- external representation, etc using the file system encoding and repertoire.
return STR::create(out_map.get(self),LIBCHARS::default)
end ;
end ; -- FILE_TYPES
immutable class PATH_KINDS < $ENUMS{PATH_KINDS}
immutable class PATH_KINDS < $ENUMS{PATH_KINDS} is
-- This class defines the identitities of the different kinds of file path component.
-- Version 1.0 Dec 2001. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 2 Dec 01 kh Original for FILE_PATH v2.0
include ENUM{PATH_KINDS} ;
private const val_count : CARD := 6 ;
-- The next routines provide the enumeration itself.
Kind : SAME is return enum(1) end ;
FS_Name : SAME is return enum(2) end ;
Root : SAME is return enum(3) end ;
Self : SAME is return enum(4) end ;
Parent : SAME is return enum(5) end ;
Ordinary : SAME is return enum(6) end ;
end ; -- PATH_KINDS
class PATH_COMP
class PATH_COMP is
-- This class defines the properties of a file path component. It is
-- solely for use in the implementation of the FILE_PATH class.
-- Version 1.0 Dec 2001. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 2 Dec 01 kh Original for FILE_PATH v2.0
attr kind : PATH_KINDS ;
readonly attr start : CARD ;
readonly attr length : CARD ;
create(sort : PATH_KINDS,start_idx : CARD,lgth : CARD) : SAME is
-- This routine creates a path component descriptor for use in the
-- FILE_PATH class.
me : SAME := new ;
me.kind := sort ;
me.start := start_idx ;
me.length := lgth ;
return me
end ;
copy : SAME is
-- This routine returns a copy of self.
return create(kind,start,length)
end ;
end ; -- PATH_COMP
class FILE_PATH < $IS_EQ
class FILE_PATH < $IS_EQ is
-- This abstraction is used for checking, breaking up and creating a
-- file name which is valid in the operating system concerned.
--
-- The file name string is deemed to consist of a sequence with the
-- following structure -- dependent in detail upon the operating system!
--
-- Note that the file kind may or may not be used by a file path to
-- form part of a string used to identify the file. This may be used
-- as a file type indicator where an operating system supports typed files.
-- Version 2.0 Dec 2001. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 2 Dec 01 kh Original because of unfixable bugs in 1.5
include COMPARABLE ;
private attr fname : FSTR ;
private attr comps : FLIST{PATH_COMP} ;
private attr kind_index : CARD ; -- in the last component (or nil)
inspect is
if void(self) then #OUT+"FILE_PATH void\n"; return; end;
#OUT+"FILE_PATH fname:"+fname.str+"\n";
#OUT+"comps (kind,start,length):";
loop
c::=comps.elt!;
#OUT+"("+c.kind.str+","+c.start.str+","+c.length.str+")";
end;
#OUT+"\n";
end;
private find(str : STR,start : CARD,buff : FSTR) : CARD is
-- This routine returns the index of the first appearance of the entire
-- string str in buff starting from the index start. CARD::nil is
-- returned if no such position is found. This is a specialised version
-- of the normal string search operation since it needs to operate with exact
-- code patterns as known to the underlying system rather than characters.
-- It must also work before all cultural data has been read in!
if buff.size < str.size then -- cannot be there!
return CARD::nil
end ;
limit : CARD := buff.size - str.size ;
loop
index : CARD := start.upto!(limit) ;
match : BOOL := true ;
loop
if buff.elt!(index).code /= str.elt!.code then -- code match!
match := false ;
break!
end
end ;
if match then
return index
end
end ;
return CARD::nil
end ;
is_valid_leaf(str : STR) : BOOL is
-- This predicate returns true if and only if the given string is
-- suitable to form a leaf name, otherwise false.
loop
loc_code : CHAR_CODE := str.elt!.code ;
loop
if loc_code = str.index_lib.Component_Separator.elt! then
return false
end
end
end ;
return true
end ;
private is_valid_token(str : STR) : BOOL is
-- This predicate returns true if and only if str is neither void
-- nor has the NUL character code as the first character.
return ~(void(str) or (str[0] = CHAR::null))
end;
private optional_starter(start : CARD,sort : PATH_KINDS,sep : STR) : CARD
pre ~void(self)
and (start < fname.size)
post (result <= fname.size)
is
--This private routine returns the next index to search from
if is_valid_token(sep) then
index : CARD := find(sep,start,fname) ;
if index.is_nil then
return start
else
loc_comp : PATH_COMP := PATH_COMP::create(sort,start,(index - start)) ;
comps := comps.push(loc_comp) ;
return index + sep.size
end
end ;
return start
end ;
private find_element(start : CARD) : CARD
pre ~void(self)
and (start < fname.size)
is
--This routine looks for an ordinary path component. It returns the
-- index in the string at which a search for a following component should be made.
sep : STR := fname.index_lib.Component_Separator.tgt_str ;
if is_valid_token(sep) then
index : CARD := find(sep,start,fname) ;
if index.is_nil then
index := fname.size
end ;
loc_val : STR := fname.substring(start,index - start).str ;
loc_kind : PATH_KINDS ;
if loc_val = fname.index_lib.Self_Name.tgt_str then
loc_kind := PATH_KINDS::Self
elsif loc_val = fname.index_lib.Parent_Name.tgt_str then
loc_kind := PATH_KINDS::Parent
else
loc_kind := PATH_KINDS::Ordinary
end ;
loc_comp : PATH_COMP := PATH_COMP::create(loc_kind,start,(index - start)) ;
comps := comps.push(loc_comp) ;
return index + sep.size
end ;
return start
end ;
private find_root(start : CARD) : CARD
pre ~void(self)
and (start < fname.size)
post (result <= fname.size)
is
-- This routine takes special action if - as in some systems - the root
-- 'name' and a component separator are identical, otherwise, because the
-- root separator cannot be null (because of parsing ambiguities), it sets
-- the 'kind' of the next path component to be Root - providing it is not
-- the first component.
loc_lib : LIBCHARS := fname.index_lib ;
loc_comp : PATH_COMP ;
if loc_lib.Root_Name = loc_lib.Component_Separator then -- this might be a root name
if fname[start] = loc_lib.Root_Name.tgt_str[0] then
loc_comp := PATH_COMP::create(PATH_KINDS::Root,start,0) ;
comps := comps.push(loc_comp) ;
return start + loc_lib.Root_Name.size
else
return start
end
else
count : CARD := comps.size ;
next : CARD := find_element(start) ;
if (comps.size > count)
and (comps.size > 1) then -- one there
loc_comp := comps.top ;
loc_str : STR := fname.substring(loc_comp.start,loc_comp.length).str ;
if loc_str = loc_lib.Root_Name.tgt_str then
loc_comp.kind := PATH_KINDS::Root
end ;
return next
else -- bad path
return CARD::nil
end
end
end ;
private find_leaf is
-- This routine looks for the index of the file 'kind' separator - if
-- there is one - but before doing so it discards any trailing component
-- separator!
last_comp : PATH_COMP := comps.top ;
fname.loc := last_comp.start + last_comp.length ; -- set path end!
sep : STR := fname.index_lib.Kind_Separator.tgt_str ;
kind_index : CARD := CARD::nil ; -- assume there is none!
start : CARD := last_comp.start ;
if is_valid_token(sep) then -- there might be one!
loop -- only the LAST one is kind sep
index : CARD := find(sep,start,fname) ;
if index.is_nil then
break!
else
start := index + sep.size ;
kind_index := start
end
end
end
end ;
private create(str : FSTR) : SAME
pre (str.size > 0)
post true
is
--This routine returns a file path constructed from the given
-- string (which may either be absolute or relative to some current working directory).
me : SAME := new ;
me.fname := str ;
me.comps:=#;
me.kind_index:=CARD::nil;
loc_lib : LIBCHARS := me.fname.index_lib ;
str_index : CARD := 0 ;
str_index := me.optional_starter(str_index,
PATH_KINDS::Kind,loc_lib.System_Separator.tgt_str) ;
str_index := me.optional_starter(str_index,
PATH_KINDS::FS_Name,loc_lib.Root_Separator.tgt_str) ;
str_index := me.find_root(str_index) ; -- not found if relative!
loop -- over remaining path elements
if str_index < me.fname.size then
str_index := me.find_element(str_index)
else
break!
end
end ;
if str_index.is_nil then
return void
else
me.find_leaf ; -- removes trailing sep if there!
return me
end
end ;
create( str : STR) : SAME
pre (str.size > 0)
post true
is
--This routine returns a file path constructed from the given
-- string (which may either be absolute or relative to some current working
-- directory).
return create(FSTR::create(str))
end ;
append( str : STR) : SAME
pre void(self)
or (fname.index_lib = str.index_lib)
post true
is
--This routine appends str to the current name -- providing that it is
-- a valid leaf name -- preceded by a Component_Separator.
if void(self) then
return create(str)
end ;
res : FSTR := fname.copy + fname.index_lib.Component_Separator.tgt_str ;
return create(res + str)
end ;
append(other : SAME) : SAME
pre ~void(other)
post true
is
-- This routine appends other to the current name preceded by a
-- Component_Separator.
loc_lib : LIBCHARS := fname.index_lib ;
if void(self) then
return other
else
return create(fname.copy + loc_lib.Component_Separator.tgt_str + other.fname.copy)
end
end ;
is_eq(other : SAME) : BOOL is
-- This predicate returns true if and only if other and self identify
-- the same file system object (if it were to exist). Note that the
-- definition implemented here requires that both be the same relative name
-- or the same absolute name, since while a relative name MAY indicate the
-- same entity as an absolute one, this is only valid while the current
-- directory happens to be the right one for that to be true!
return fname = other.fname
end ;
is_relative : BOOL is
-- This predicate returns true if and only if self is a relative path,
-- otherwise it is absolute and false is returned.
loop
if comps.elt!.kind = PATH_KINDS::Root then
return false
end
end ;
return true
end ;
absolute : SAME
pre ~void(self)
post ~result.is_relative
is
--This routine converts self into the absolute path by appending self
-- to the current directory. All 'parent' and 'self' components are replaced
-- by actual path component names where necessary.
res : SAME := create(FILE_SYS::current_dir) ; -- the starting point!
loop
loc_idx : CARD := 0.upto!(comps.size - 1) ;
loc_comp : PATH_COMP := comps.elt! ;
if (loc_comp.kind = PATH_KINDS::Root) then
res := create(root_name) -- Mmm! might have '.' or '..'?
elsif (loc_comp.kind = PATH_KINDS::Parent) then
res := res.head -- see head - never beyond root!
elsif (loc_comp.kind = PATH_KINDS::Self) then
-- nothing to do!
else
res := res.append(fname.substring(loc_comp.start,loc_comp.length).str)
end
end ;
return res
end ;
leaf : STR
pre ~void(self)
post ~void(result)
is
--This routine returns the leaf name component of self.
last : PATH_COMP := comps.top ;
return fname.substring(last.start,last.length).str
end ;
private current : SAME is
-- This routine returns the file path for the current directory.
loc_lib : LIBCHARS := fname.index_lib ;
return create(loc_lib.Self_Name.tgt_str)
end ;
private do_head : SAME is
-- This private routine carries out the actual leaf 'removal' to produce
-- the head of the path.
res : SAME := new ;
res.kind_index := CARD::nil ;
res.fname := fname.copy ;
res.comps:=#;
loop
(comps.size - 1).times! ;
res.comps := res.comps.push(comps.elt!.copy)
end ;
elem : PATH_COMP := res.comps.top ;
res.fname.loc := elem.start + elem.length ;
return res
end ;
head : SAME
pre ~void(self)
post true
is
-- This routine returns the full path except for the leaf name and its
-- preceding separator - unless :-
--
-- a. The full path is merely the root name when self is returned.
--
-- b. The path is relative and has only one path component, when
-- the current directory is returned.
if comps.top.kind = PATH_KINDS::Root then
if fname.loc = 0 then -- 'invisible' root name!
return create(fname.index_lib.Root_Name.tgt_str)
else
return create(fname)
end
elsif comps.size = 1 then -- just a leaf
return create(fname)
else -- more than one component
return do_head
end
end ;
fs_kind : STR
pre ~void(self)
post true
is
-- The string which is contained in the full path which represents the
-- kind of the file system. This may, of course, be void.
if comps[0].kind = PATH_KINDS::Kind then
return fname.substring(comps[0].start,comps[0].length).str
else
return void
end
end ;
kind : STR
pre ~void(self)
post true
is
--This routine returns the sub-string at the end of a leaf name (if
-- any) which conventionally identifies the type of contents in the
-- file. There is, of course, no necessary relationship between this
-- 'type' string and the actual file contents. If the string
-- returned is void, then no 'type' information is available. Note that
-- the OS-dependent type mechanism is allowed to produce the actual string.
if kind_index.is_nil then
return STR::create -- nothing there!
else
return FILE_SYS::file_type(fname.str,leaf)
end
end ;
kind(str : STR) : SAME
pre ~void(self)
and ~void(str)
and (fname.index_lib = str.index_lib)
post true
is
--This routine returns a new file path, the leaf component of which
-- has the specified 'type'. This replaces any kind string which may
-- have been present in self! Note that the actual type setting is done in
-- FILE_SYS, so that the OS-dependent mechanism of file 'typing' is used.
loc_label : FILE_LABEL := FILE_LABEL::create(fname.str) ;
if void(loc_label) then -- doesn't exist??
return void
elsif ~loc_label.is_file then
return self
end ;
return head.append(FILE_SYS::set_type(fname.str,leaf,str))
end ;
root_name : STR
pre ~void(self)
post true
is
--The string which is contained in the full path name representing the
-- name of the file-system or device (which may be merely 'anonymous').
elem : PATH_COMP ;
loop
loc_elem : PATH_COMP := comps.elt! ;
if loc_elem.kind = PATH_KINDS::Root then
elem := loc_elem ;
break!
end
end ;
if void(elem) -- this name is relative
or elem.length = 0 then -- no fs kind/name
return fname.index_lib.Root_Name.tgt_str
else
return fname.substring(0,(elem.start + elem.length)).str
end
end ;
fs_name : STR
pre ~void(self)
post true
is
--This is just another name for root_name!
return root_name
end ;
elt! : STR
pre ~void(self)
post true
is
--This iter yields a sequence of the component strings of fname,
-- ignoring any void file system or root name.
loop
loc_comp : PATH_COMP := comps.elt! ;
if loc_comp.length = 0 then
if loc_comp.kind = PATH_KINDS::Root then
yield fname.index_lib.Root_Name.tgt_str
else -- should never happen!
quit
end
else
yield fname.substring(loc_comp.start,loc_comp.length).str
end
end
end ;
separators! : STR
pre ~void(self)
post true
is
--This iter yields the sequence of separators in the path string,
-- ignoring any separator corresponding to a void entry.
if comps.size < 2 then
quit
end ;
loop
loc_idx : CARD := 0.upto!(comps.size - 2) ;
this : PATH_COMP := comps[loc_idx] ;
next : PATH_COMP := comps[loc_idx + 1] ;
start : CARD := this.start + this.length ;
yield fname.substring(start,next.start - start).str
end
end ;
str : STR
pre ~void(self)
post true -- result = fname
is
-- This routine provides a string representation of a file path. The
-- special case of an 'empty' root element only occurs where the root name
-- and a component separator are the same (ie the root name is effectively
-- invisible)!
if fname.loc = 0 then -- 'invisible' root name!
return fname.index_lib.Root_Name.tgt_str
else
return fname.str
end
end ;
end ; -- FILE_PATH
class SEARCH_PATH
class SEARCH_PATH is
-- This class of objects is the implementation of an operating system
-- search path. This is a list of directory paths to be searched for
-- some named entity.
-- Version 1.3 Oct 98. Copyright K Hopper,U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 10 Jun 96 kh Original
-- 19 Feb 97 kh Additions for string/char portability.
-- 16 Apr 97 kh Modified for INT to CARD, etc
-- 22 Oct 98 kh Added pre/post conditions
private attr directories : FLIST{FILE_PATH} ;
create(str : STR) : SAME
pre (str.size > 0)
post true
is
--This is the search path creation routine. It assumes that the string
-- passed is the Search_Separator separated list of strings to be separated
-- into the directory path list.
me : SAME := new ;
index : CARD := 0 ;
loc_path : FILE_PATH ;
sep_index : CARD ;
loc_lib : LIBCHARS := str.index_lib ;
sep : STR := loc_lib.Search_Separator.tgt_str ;
loop
sep_index := str.search(sep,index) ;
if sep_index.is_nil then -- this is the last one
sep_index := str.size
end ;
loc_str : STR := str.substring(index,sep_index - index) ;
loc_path := FILE_PATH::create(loc_str) ;
if void(loc_path) then -- this component is illegal!
return void
elsif loc_path.is_relative then
loc_path := loc_path.absolute
end ;
me.directories := me.directories.push(loc_path) ;
index := sep_index + sep.size ;
if index >= str.size then -- finished
return me
end
end
end ;
env_path(str : STR) : SAME
pre (str.size > 0)
post true
is
--This version of creation assumes that the string passed is the name of
-- some operating system environment variable whose value is the list of
-- strings forming the search path. If any element is not a valid file path
-- then void is returned.
loc : STR := OPSYS::get_env(str) ;
if loc.size = 0 then
return void
end ;
return create(loc)
end ;
elt! : FILE_PATH
pre true
post (void(self)
and (result = DIRECTORY::current.dirname))
or ~void(result)
is
--This iter yields the succession of directory names contained in
-- the list. In the special case where self is void, it yields the current
-- directory
if void(self) then
yield DIRECTORY::current.dirname ;
quit
end ;
loop
yield directories.elt!
end
end ;
end ; -- SEARCH_PATH