enable compiler to create "Clean System Files" folder

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@325 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

2 files changed, 53 insertions, 11 deletions

diff --git a/main/Windows/CoclSystemDependent.icl b/main/Windows/CoclSystemDependent.icl
index dc1d17b..867bcd2 100644
--- a/main/Windows/CoclSystemDependent.icl
+++ b/main/Windows/CoclSystemDependent.icl
@@ -1,6 +1,9 @@
 // this is for Windows
 implementation module CoclSystemDependent
 
+import StdEnv
+import code from "cDirectory.obj",  library "directory_library" // Windows
+
 PathSeparator
 	:==	';'
 DirectorySeparator
@@ -13,3 +16,27 @@ SystemDependentDevices
 SystemDependentInitialIO :: [a]
 SystemDependentInitialIO
 		=	[]
+
+ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
+// returned bool: now there is such a subfolder
+ensureCleanSystemFilesExists path 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
+
diff --git a/main/compile.icl b/main/compile.icl
index 6e61466..ccc25fa 100644
--- a/main/compile.icl
+++ b/main/compile.icl
@@ -167,14 +167,8 @@ compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_s
 		=	fopen options.outPath options.outMode files
 	| not opened
 		=	abort ("couldn't open out file \"" +++ options.outPath +++ "\"\n")
-// MV ...
-	# tcl_path
-		= ((directoryName options.pathName) +++ "Clean System Files\\" +++ (baseName options.pathName) +++ ".tcl")
-	# (opened,tcl_file, files)
-		=	fopen tcl_path FWriteData files
-	| not opened
-		=	abort ("couldn't open file \"" +++ tcl_path +++ "\n")
-// ... MV
+	# (tcl_file, files)
+		= openTclFile options.pathName files
 	# (io, files)
 		=	stdio files
 //	  (moduleIdent, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
@@ -184,12 +178,10 @@ compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_s
 		=	frontEndInterface FrontEndPhaseAll moduleIdent options.searchPaths dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out tcl_file heaps 
 	# unique_copy_of_predef_symbols={predef_symbol\\predef_symbol<-:predef_symbols}
 
-// MV ...
 	# (closed, files)
 		=	fclose tcl_file files
 	| not closed
-		=	abort ("couldn't open tcl file \"" +++ options.pathName +++ "tcl\"\n")
-// ... MV
+		=	abort ("couldn't close tcl file \"" +++ options.pathName +++ "tcl\"\n")
 
 	# (closed, files)
 		=	fclose io files
@@ -246,3 +238,26 @@ compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_s
 		= (success,cache,files)
 		# cache={dcl_modules=dcl_modules,functions_and_macros=cached_functions_and_macros,predef_symbols=unique_copy_of_predef_symbols,hash_table=hash_table,heaps=heaps}
 		= (success,cache,files)
+
+
+openTclFile :: !String !*Files -> (!.File, !*Files)
+openTclFile icl_mod_pathname files
+	# csf_path
+		= directoryName icl_mod_pathname +++ "Clean System Files"
+	# tcl_path
+		= csf_path +++ {DirectorySeparator} +++ baseName icl_mod_pathname +++ ".tcl"
+	# (opened, tcl_file, files)
+		= fopen tcl_path FWriteData files
+	| opened
+		= (tcl_file, files)
+	// try again after creating Clean System Files folder
+	# (ok, files)
+		= ensureCleanSystemFilesExists csf_path files
+	| not ok
+		= abort ("can't create folder \"" +++ csf_path +++"\"\n")
+	# (opened, tcl_file, files)
+		= fopen tcl_path FWriteData files
+	| opened
+		=(tcl_file, files)
+	= abort ("couldn't open file \"" +++ tcl_path +++ "\"\n")
+