Moved system dependent code from coclmain to CoclSystemDependent

main/Unix/CoclSystemDependent.dcl

@@ -22,5 +22,10 @@ SystemDependentDevices :: [a]
 SystemDependentInitialIO :: [a]
 
 ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
-
 set_compiler_id :: Int -> Int
+
+:: CompileFun st
+    :== ([{#Char}] st -> (Bool, st))
+   
+compiler_loop :: (CompileFun *st) *st -> (!Bool, !*st)
+

main/Unix/CoclSystemDependent.icl

@@ -2,11 +2,13 @@
 implementation module CoclSystemDependent
 
 import StdEnv
+import StdDebug
+import ArgEnv
+import ipc
+from filesystem import ensureDirectoryExists
 
-// import for filesystem
-import code from "cDirectory.o" // Unix
+import code from "cDirectory.o"
 import code from "ipc.o"
-from filesystem import ensureDirectoryExists
 
 PathSeparator
 	:==	':'
@@ -21,10 +23,102 @@ SystemDependentInitialIO :: [a]
 SystemDependentInitialIO
 		=	[]
 
+set_compiler_id :: Int -> Int
+set_compiler_id compiler_id = compiler_id
+
 ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
 // returned bool: now there is such a subfolder
 ensureCleanSystemFilesExists path env
 	= ensureDirectoryExists path env
 
-set_compiler_id :: Int -> Int
-set_compiler_id compiler_id = compiler_id
+:: CompileFun st
+	:==	([{#Char}] st -> (Bool, st))
+	
+compiler_loop :: (CompileFun *st) *st -> (!Bool, !*st)
+compiler_loop compile compile_state
+	| length commandArgs==3 && commandArgs!!0=="--pipe"
+		# commands_name= (commandArgs!!1);
+		# results_name= (commandArgs!!2);
+		= (True,compile_loop compile commands_name results_name compile_state)
+		# (r,compile_state)=compile commandArgs compile_state
+		= (r,compile_state)
+	where
+		commandArgs
+			=	tl [arg \\ arg <-: getCommandLine]
+// ... Unix
+
+string_to_args string
+	= string_to_args 0;
+	where
+		l=size string;
+		
+		string_to_args i
+			# end_spaces_i=skip_spaces i;
+			| end_spaces_i==l
+				= []
+			| string.[end_spaces_i]=='"'
+				# next_double_quote_i=skip_to_double_quote (end_spaces_i+1)
+				| next_double_quote_i>=l
+					= [string % (end_spaces_i,l-1)]
+					# arg=string % (end_spaces_i+1,next_double_quote_i-1);
+					= [arg : string_to_args (next_double_quote_i+1)];
+				# space_i=skip_to_space (end_spaces_i+1)
+				| space_i>=l
+					= [string % (end_spaces_i,l-1)]
+					# arg=string % (end_spaces_i,space_i-1);
+					= [arg : string_to_args (space_i+1)];
+
+		skip_spaces i
+			| i>=l
+				= l;
+			# c=string.[i];
+			| c==' ' || c=='\t'
+				= skip_spaces (i+1);
+				= i;
+
+		skip_to_space i
+			| i>=l
+				= l;
+			# c=string.[i];
+			| c==' ' || c=='\t'
+				= i;
+				= skip_to_space (i+1);
+
+		skip_to_double_quote i
+			| i>=l
+				= l;
+			# c=string.[i];
+			| c=='"'
+				= i;
+				= skip_to_double_quote (i+1);
+
+
+compile_loop :: (CompileFun *st) {#Char} {#Char} *st -> *st
+compile_loop compile commands results compile_state
+	# r=open_pipes commands results;
+	| r<>0
+		= abort ("compile_loop\n");
+	=	compile_files compile compile_state
+
+compile_files :: (CompileFun *st) *st -> *st
+compile_files compile compile_state
+	# n = get_command_length;
+	| n==(-1)
+		= abort "compile_files 1";
+	# string=createArray n '\0';
+	# r=get_command string;
+	| r<>0
+		= abort ("compile_files 2 ");
+	# args=string_to_args (string % (0,size string-2))
+	= case args of
+		["cocl":cocl_args]
+			# (ok,compile_state)=compile cocl_args compile_state
+			# result=if ok 0(-1);
+			# r=send_result result
+			| r<>0
+				-> abort "compile_files 3";
+				-> compile_files compile compile_state
+		["quit"]
+			-> trace_n "quiting" compile_state;
+		_
+				-> abort "compile_files 4"

main/coclmain.icl

@@ -7,6 +7,7 @@ import StdEnv
 import StdDebug
 import ArgEnv
 import set_return_code
+import CoclSystemDependent
 
 import compile
 
@@ -78,131 +79,14 @@ coclMain  testArgs world
 
 CoclArgsFile :== "coclargs.txt"
 
-/*
-import thread_message;
-
-import code from "thread_message.obj";
-*/
-
-// compiler driver
-
-/* Windows
-compiler symbol_table files
-	# dcl_cache = empty_cache symbol_table
-	| length commandArgs==2 && commandArgs!!0=="-ide"
-		# wm_number=get_message_number;
-		# thread_id=hex_to_int (commandArgs!!1);
-		= (True,compile_files compile dcl_cache thread_id wm_number files)
-		# (r,dcl_cache,files)=compile commandArgs dcl_cache files
-		= (r,files)
-	where
-		commandArgs
-			=	tl [arg \\ arg <-: getCommandLine]
-*/
 // Unix
+compile2 args (cache, files)
+	# (r, cache, files)
+		=	compile args cache files
+	= (r, (cache, files))
+
 compiler symbol_table files
 	# dcl_cache = empty_cache symbol_table
-	| length commandArgs==3 && commandArgs!!0=="--pipe"
-		# commands_name= (commandArgs!!1);
-		# results_name= (commandArgs!!2);
-		= (True,compile_loop compile dcl_cache commands_name results_name files)
-		# (r,dcl_cache,files)=compile commandArgs dcl_cache files
-		= (r,files)
-	where
-		commandArgs
-			=	tl [arg \\ arg <-: getCommandLine]
-// ... Unix
-
-hex_to_int :: {#Char} -> Int
-hex_to_int s
-	= hex_to_int 0 0;
-	where
-		l=size s;
-
-		hex_to_int i n
-			| i==l
-				= n;
-				# c=s.[i];
-				# i=i+1;
-				# n=n<<4;
-				| c<='9'
-					= hex_to_int i (n bitor (toInt c-toInt '0'));
-					= hex_to_int i (n bitor (toInt c-(toInt 'A'-10)));
-
-string_to_args string
-	= string_to_args 0;
-	where
-		l=size string;
-		
-		string_to_args i
-			# end_spaces_i=skip_spaces i;
-			| end_spaces_i==l
-				= []
-			| string.[end_spaces_i]=='"'
-				# next_double_quote_i=skip_to_double_quote (end_spaces_i+1)
-				| next_double_quote_i>=l
-					= [string % (end_spaces_i,l-1)]
-					# arg=string % (end_spaces_i+1,next_double_quote_i-1);
-					= [arg : string_to_args (next_double_quote_i+1)];
-				# space_i=skip_to_space (end_spaces_i+1)
-				| space_i>=l
-					= [string % (end_spaces_i,l-1)]
-					# arg=string % (end_spaces_i,space_i-1);
-					= [arg : string_to_args (space_i+1)];
-
-		skip_spaces i
-			| i>=l
-				= l;
-			# c=string.[i];
-			| c==' ' || c=='\t'
-				= skip_spaces (i+1);
-				= i;
-
-		skip_to_space i
-			| i>=l
-				= l;
-			# c=string.[i];
-			| c==' ' || c=='\t'
-				= i;
-				= skip_to_space (i+1);
-
-		skip_to_double_quote i
-			| i>=l
-				= l;
-			# c=string.[i];
-			| c=='"'
-				= i;
-				= skip_to_double_quote (i+1);
-
-// Unix
-import ipc
-import code from "ipc.o"
-
-compile_loop compile cache commands results files
-	# r=open_pipes commands results;
-	| r<>0
-		= abort ("compile_loop\n");
-	=	compile_files compile cache files
-	
-
-compile_files compile cache files
-	# n = get_command_length;
-	| n==(-1)
-		= abort "compile_files 1";
-	# string=createArray n '\0';
-	# r=get_command string;
-	| r<>0
-		= abort ("compile_files 2 ");
-	# args=string_to_args (string % (0,size string-2))
-	= case args of
-		["cocl":cocl_args]
-			# (ok,cache,files)=compile cocl_args cache files
-			# result=if ok 0(-1);
-			# r=send_result result
-			| r<>0
-				-> abort "compile_files 3";
-				-> compile_files compile cache files
-		["quit"]
-			-> trace_n "quiting" files;
-		_
-				-> abort "compile_files 4"
+	# (r,(_,files))
+		=	compiler_loop compile2 (dcl_cache, files)
+	= (r, files)

main/compile.icl

@@ -91,6 +91,9 @@ parseCommandLine [arg1=:"-RE", errorPath : args] options
 parseCommandLine [arg1=:"-RAE", errorPath : args] options
 	# (args,modules,options)=	parseCommandLine args {options & errorPath = stripQuotes errorPath, errorMode = FAppendText}
 	= ([arg1,errorPath:args],modules,options)
+/* RWS FIXME: "-id" option is only used for the Mac version
+   and should be moved elsewhere
+*/
 parseCommandLine ["-id",compiler_id_string : args] options
 	# compiler_id=toInt compiler_id_string
 	| set_compiler_id compiler_id==compiler_id