aboutsummaryrefslogtreecommitdiff
path: root/main
diff options
context:
space:
mode:
Diffstat (limited to 'main')
-rw-r--r--main/Windows/CoclSystemDependent.icl28
-rw-r--r--main/filesystem.dcl16
-rw-r--r--main/filesystem.icl89
3 files changed, 110 insertions, 23 deletions
diff --git a/main/Windows/CoclSystemDependent.icl b/main/Windows/CoclSystemDependent.icl
index a774ce5..5ef779f 100644
--- a/main/Windows/CoclSystemDependent.icl
+++ b/main/Windows/CoclSystemDependent.icl
@@ -2,7 +2,10 @@
implementation module CoclSystemDependent
import StdEnv
-//import code from "cDirectory.obj", library "directory_library" // Windows
+
+// import for filesystem
+import code from "cDirectory.obj", library "directory_library" // Windows
+from filesystem import ensureDirectoryExists
PathSeparator
:== ';'
@@ -20,28 +23,7 @@ SystemDependentInitialIO
ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
// returned bool: now there is such a subfolder
ensureCleanSystemFilesExists path env
- = (False,env)
-
-/* # path_c_string = path +++ "\0"
- (err_code, env) = createDirectoryC path_c_string env
- = (err_code==M_NoDirError || err_code==M_AlreadyExists, env)
-*/
-
-createDirectoryC :: !String !*env -> (!Int, !*env)
-createDirectoryC _ _
- = code
- {
- ccall createDirectoryC "S:I:A"
- }
-
-// createDirectoryC returns the following error codes:
-M_NoDirError :== 0
-M_OtherDirError :== -1
-M_DoesntExist :== -2
-M_BadName :== -3
-M_NotEnoughSpace :== -4
-M_AlreadyExists :== -5
-M_NoPermission :== -6
+ = ensureDirectoryExists path env
set_compiler_id :: Int -> Int
set_compiler_id compiler_id = compiler_id
diff --git a/main/filesystem.dcl b/main/filesystem.dcl
new file mode 100644
index 0000000..5100e70
--- /dev/null
+++ b/main/filesystem.dcl
@@ -0,0 +1,16 @@
+/*
+ module owner: Ronny Wichers Schreur
+
+ This module contains some file functions that are not in StdEnv
+ It uses the object file from Directory 1.1, but with a different
+ (stripped down) interface.
+*/
+definition module filesystem
+
+from StdFile import FileSystem, Files
+
+// return last modified time (local time) as "yyyymmddhhmmss" or "" on error
+fmodificationtime :: {#Char} !*env -> (!{#Char}, !*env) | FileSystem env
+
+// create a directory, if it doesn't exist already
+ensureDirectoryExists :: !{#Char} !*env -> (!Bool, !*env) | FileSystem env
diff --git a/main/filesystem.icl b/main/filesystem.icl
new file mode 100644
index 0000000..26040b8
--- /dev/null
+++ b/main/filesystem.icl
@@ -0,0 +1,89 @@
+/*
+ module owner: Ronny Wichers Schreur
+
+ This module contains some file functions that are not in StdEnv
+ It uses the object file from Directory 1.1, but with a different
+ (stripped down) interface.
+*/
+implementation module filesystem
+
+import StdEnv
+
+// the import code is in CoclSystemDependent, because it is system dependent
+
+// BEGIN copied from Directory.icl
+createDirectoryC :: !String !*env -> (!Int, !*env)
+createDirectoryC _ _
+ = code
+ {
+ ccall createDirectoryC "S:I:A"
+ }
+
+findSingleFileC :: !String !*env -> (!ErrCode, !*env)
+findSingleFileC _ _
+ = code
+ {
+ ccall findSingleFileC "S:I:A"
+ }
+
+:: ErrCode :== Int // <>0 <=> error
+:: DateTimeTuple :== (!DateTuple, !TimeTuple)
+:: DateTuple :== (!Int, !Int, !Int, !Int)
+:: TimeTuple :== (!Int, !Int, !Int)
+
+getCommonFileInfoC :: !Bool !*env
+ -> (!(!String, !(!Int, !Int), !DateTimeTuple, !Bool, !Bool), !*env)
+getCommonFileInfoC _ _
+ = code
+ {
+ ccall getCommonFileInfoC "I:VSIIIIIIIIIII:A"
+ }
+
+// createDirectoryC returns the following error codes:
+M_NoDirError :== 0
+M_OtherDirError :== -1
+M_DoesntExist :== -2
+M_BadName :== -3
+M_NotEnoughSpace :== -4
+M_AlreadyExists :== -5
+M_NoPermission :== -6
+
+// END copied from Directory.icl
+
+// return last modified time (local time) as "yyyymmddhhmmss" or "" on error
+fmodificationtime :: {#Char} !*env -> (!{#Char}, !*env) | FileSystem env
+fmodificationtime path env
+ # (result, env)
+ = findSingleFileC (path+++"\0") env
+ | result <> 0
+ = ("", env)
+ # ((_, _, lastModifiedTuple, _, _), env)
+ = getCommonFileInfoC False env
+ = (dateTimeTupleToString lastModifiedTuple, env)
+
+dateTimeTupleToString :: DateTimeTuple -> {#Char}
+dateTimeTupleToString ((year, month, day, _), (hours, minutes, seconds))
+ = string 4 year +++ string 2 month +++ string 2 day
+ +++ string 2 hours +++ string 2 minutes +++ string 2 seconds
+ where
+ string :: !Int !Int -> {#Char}
+ string minSize n
+ = pad (minSize - size s) +++ s
+ where
+ s
+ = toString n
+
+ pad :: Int -> {#Char}
+ pad n
+ | n > 0
+ = createArray n '0'
+ // otherwise
+ = ""
+ensureDirectoryExists :: !{#Char} !*env -> (!Bool, !*env) | FileSystem env
+// returned bool: now there is such a subfolder
+ensureDirectoryExists path env
+ # path_c_string = path +++ "\0"
+ (err_code, env) = createDirectoryC path_c_string env
+ = (err_code==M_NoDirError || err_code==M_AlreadyExists, env)
+
+