implementation module PmPath import StdClass,StdString, StdChar, StdBool, StdChar,StdInt, StdMisc,StdArray; import StdPathname from StdSystem import dirseparator import PmTypes import Platform import UtilStrictLists /* The name of the system directory */ SystemDir :== "Clean System Files"; //-- IsDefPathname :: !Pathname -> Bool; IsDefPathname name = equal_suffix ".dcl" name; IsImpPathname :: !Pathname -> Bool; IsImpPathname name = equal_suffix ".icl" name; IsABCPathname :: !Pathname -> Bool; IsABCPathname name = equal_suffix ".abc" name; IsPrjPathname :: !Pathname -> Bool; IsPrjPathname name = equal_suffix ".prj" name; MakeDefPathname :: !String -> Pathname; MakeDefPathname name = RemoveSuffix name +++ ".dcl"; MakeImpPathname :: !String -> Pathname; MakeImpPathname name = RemoveSuffix name +++ ".icl"; MakeABCPathname :: !String -> Pathname; MakeABCPathname name = RemoveSuffix name +++ ".abc"; MakeObjPathname :: !Processor !String -> Pathname; MakeObjPathname processor name = RemoveSuffix name +++ ProcessorSuffix processor /* | processor == CurrentProcessor // = RemoveSuffix name +++ ".o"; = RemoveSuffix name +++ ".xo"; | processor == MC68000 = RemoveSuffix name +++ ".obj0"; | processor == MC68020 = RemoveSuffix name +++ ".obj1"; | processor == MC68020_and_68881 = RemoveSuffix name +++ ".obj2"; = abort ("MakeObjPathname: " +++ toString processor +++ " : No such processor "); */ MakeProjectPathname :: !String -> Pathname; MakeProjectPathname name = RemoveSuffix name +++ ".prj"; MakeExecPathname :: !String -> Pathname; MakeExecPathname name = PlatformDependant (RemoveSuffix name+++".exe") // Win (RemoveSuffix name) // Mac MakeSystemPathname :: !Pathname -> Pathname; MakeSystemPathname pathname | equal_suffix SystemDir pathname = pathname | size pathname > 0 && pathname.[size pathname - 1] == dirseparator = pathname +++ SystemDir | otherwise = pathname +++ sep +++ SystemDir; where sep = toString dirseparator; MakeABCSystemPathname :: !Pathname -> Pathname MakeABCSystemPathname abcname = directory_name_plus_system_dir +++ sep +++ file +++ ".abc" where directory_name_plus_system_dir | equal_suffix SystemDir dir = dir; | size dir > 0 && dir.[size dir - 1] == dirseparator = dir +++ SystemDir; | otherwise = dir +++ sep +++ SystemDir; dir = RemoveFilename abcname; sep = toString dirseparator; file = RemovePath (RemoveSuffix abcname); MakeObjSystemPathname :: !Processor !Pathname -> Pathname MakeObjSystemPathname processor name = files_and_path (ProcessorSuffix processor) /* | processor == CurrentProcessor // = files_and_path ".o"; = files_and_path ".xo"; | processor == MC68000 = files_and_path ".obj0"; | processor == MC68020 = files_and_path ".obj1"; | processor == MC68020_and_68881 = files_and_path ".obj2"; = abort ("MakeObjSystemPathname: " +++ toString processor +++ " : No such processor "); */ where files_and_path extension = directory_name_plus_system_dir +++ sep +++ file+++extension directory_name_plus_system_dir | equal_suffix SystemDir dir = dir; | size dir > 0 && dir.[size dir - 1] == dirseparator = dir +++ SystemDir; | otherwise = dir +++ sep +++ SystemDir; dir = RemoveFilename name; sep = toString dirseparator; file = RemovePath (RemoveSuffix name); MakeAssemblySystemPathname :: !Pathname -> Pathname MakeAssemblySystemPathname abcname = directory_name_plus_system_dir +++ sep +++ file +++ suffix where directory_name_plus_system_dir | equal_suffix SystemDir dir = dir; | size dir > 0 && dir.[size dir - 1] == dirseparator = dir +++ SystemDir; | otherwise = dir +++ sep +++ SystemDir; dir = RemoveFilename abcname; sep = toString dirseparator; file = RemovePath (RemoveSuffix abcname); suffix = PlatformDependant ".s" // Win ".a" // Mac /* MakeABCSystemPathname :: !Pathname !Files -> (!Pathname,!Files); MakeABCSystemPathname abcname files = (directory_name_plus_system_dir +++ sep +++ file +++ ".abc",files); where directory_name_plus_system_dir | equal_suffix SystemDir dir = dir; = dir +++ sep +++ SystemDir; dir = RemoveFilename abcname; sep = toString dirseparator; file = RemovePath (RemoveSuffix abcname); MakeObjSystemPathname :: !Processor !Pathname !Files -> (!Pathname,!Files); MakeObjSystemPathname processor name files | processor == CurrentProcessor = files_and_path ".o"; | processor == MC68000 = files_and_path ".obj0"; | processor == MC68020 = files_and_path ".obj1"; | processor == MC68020_and_68881 = files_and_path ".obj2"; = abort ("MakeObjSystemPathname: " +++ toString processor +++ " : No such processor "); where files_and_path extension = (directory_name_plus_system_dir +++ sep +++ file+++extension,files); directory_name_plus_system_dir | equal_suffix SystemDir dir = dir; = dir +++ sep +++ SystemDir; dir = RemoveFilename name; sep = toString dirseparator; file = RemovePath (RemoveSuffix name); */ GetModuleName :: !Pathname -> Modulename; GetModuleName name = RemoveSuffix (RemovePath name); //== symPath :: !Pathname !Pathname !Pathname -> Pathname symPath ap pp l | size ap >= size pp // generate shortest symbolic path... # l = replace_prefix_path ap "{Application}" l l = replace_prefix_path pp "{Project}" l = l | otherwise # l = replace_prefix_path pp "{Project}" l l = replace_prefix_path ap "{Application}" l = l fulPath :: !Pathname !Pathname !Pathname -> Pathname fulPath ap pp l # l = replace_prefix_path "{Application}" ap l l = replace_prefix_path "{Project}" pp l // ensure full pathname is just that... | IsFullPathname l = l // if not put it in the project directory... = MakeFullPathname pp l get_separator_and_convert_path :: !Pathname -> (!Char,!Pathname) get_separator_and_convert_path path # prefix="{Project}" # prefix_size=size prefix # i=first_not_equal_character_index prefix path | i==prefix_size && size path>prefix_size = replace_prefix path.[prefix_size] path # prefix="{Application}" # prefix_size=size prefix # i=first_not_equal_character_index prefix path | i==prefix_size && size path>prefix_size = replace_prefix path.[prefix_size] path = (dirseparator,path) where replace_prefix separator path | separator==dirseparator = (separator,path) = (separator,replace_character_in_string separator dirseparator path) replace_character_in_string :: !Char !Char !{#Char} -> {#Char} replace_character_in_string old_c new_c string = {if (c==old_c) new_c c \\ c<-:string} first_not_equal_character_index s1 s2 #! max_index=if (size s1<=size s2) (size s1) (size s2) = first_not_equal_character_index 0 max_index s1 s2 where first_not_equal_character_index :: !Int !Int !{#Char} !{#Char} -> Int first_not_equal_character_index i n s1 s2 | i Pathname convert_path_separators path # (separator,path) = get_separator_and_convert_path path = path convert_exec_path_separators_and_extension :: !Pathname -> Pathname convert_exec_path_separators_and_extension path # (separator,path) = get_separator_and_convert_path path | separator==dirseparator = path | dirseparator=='\\' = path+++".exe" | separator=='\\' # l=size path | l>4 && path.[l-4]=='\\' && (path.[l-3]=='e' || path.[l-3]=='e') && (path.[l-2]=='x' || path.[l-2]=='x') && (path.[l-1]=='e' || path.[l-1]=='e') = path % (0,l-4) = path = path symPaths :: !Pathname !Pathname !(List Pathname) -> List Pathname symPaths ap pp l = Map (symPath ap pp) l fulPaths :: !Pathname !Pathname !(List Pathname) -> List Pathname fulPaths ap pp l = Map (fulPath ap pp) l symAppPath :: !Pathname !Pathname -> Pathname symAppPath ap p = replace_prefix_path ap "{Application}" p fulAppPath :: !Pathname !Pathname -> Pathname fulAppPath ap p = replace_prefix_path "{Application}" ap p symAppPaths :: !Pathname !(List Pathname) -> List Pathname symAppPaths ap l = Map (symAppPath ap) l fulAppPaths :: !Pathname !(List Pathname) -> List Pathname fulAppPaths ap l = Map (fulAppPath ap) l