made copyfile.icl compile

author: Camil Staps 2016-11-10 12:19:49 +0000
committer: Camil Staps 2016-11-10 12:19:49 +0000
commit: 12d40570b34a04d7f1c542f8c1d42371512d2e45 (patch)
tree: f6fa4e3d21d374559bde6f29fb23ebad3a761d51
parent: Made reverse, revtwice and sieve compile (diff)
1 files changed, 583 insertions, 11 deletions
diff --git a/copyfile.icl b/copyfile.icl
index 8cf70f2..872c2d1 100644
--- a/copyfile.icl
+++ b/copyfile.icl
@@ -7,37 +7,39 @@ Run the program using the "Basic Values Only" option.
 
 */
 
-import StdEnv, StdFile
+import _SystemArray
+
+//import StdEnv, StdFile
 
 Start::*World -> *File
 Start world =  fwrites "\nGoodbye.\n" stdinout`
-where 
+where
 	(stdinout`,_)	= accFiles (CommandLoop stdinout) world`
 	(stdinout ,world`)	= stdio world
-		
+
 
 CommandLoop::*File *Files -> (*File,*Files)
 CommandLoop stdio files =  CommandLoop` stdio` files`
-where 
+where
 	(files`,stdio`)	= Copy files stdio
-		
+
 
 CommandLoop`::*File *Files -> (*File,*Files)
 CommandLoop` stdio files
 	| answer<>'y' && answer<>'Y'	=  (stdio2,files)
 									=  CommandLoop` stdio` files`
-where 
+where
 	(files`,stdio`)	= Copy files stdio2
 	answer         	= FirstChar answ
 	(answ  ,stdio2)	= freadline stdio1
 	stdio1         	= fwrites "\nCopy another file (y/n)? " stdio
-		
+
 
 Copy::*Files *File -> (*Files,*File)
 Copy files io
 	| source == dest	=  (files, fwrites "\nCopying succeeded.\n" io4)
 						=  CopyFile (StripNewline source) (StripNewline dest) files io4
-where 
+where
 	(dest,io4)		= freadline io3
 	io3				= fwrites "\nDestination file: " io2
 	(source,io2)	= freadline io1
@@ -51,7 +53,7 @@ CopyFile source dest files io
 	|	not dclose	= 	(files4,alert4)
 	|	not sclose	= 	(files4,alert5)
 					= 	(files4,alert6)
-where 
+where
 	(sclose,files4)         	= fclose sfile` files3
 	(dclose,files3)         	= fclose dfile` files2
 	(io_error,sfile`,dfile`)	= CopyFiles sfile dfile
@@ -64,13 +66,13 @@ where
 	alert4	= fwrites "Copying failed.\nDestination file could not be closed.\n"  io
 	alert5	= fwrites "Copying failed.\nSource file could not be closed.\n"  io
 	alert6	= fwrites "\nCopying succeeded.\n" io
-		
+
 
 CopyFiles::*File *File -> (Bool, *File, *File)
 CopyFiles source dest
 	| srcend || wrterror	=  (wrterror,source1,dest1)
 							=  CopyFiles source2 (fwritec byte dest1)
-where 
+where
 	(_,byte,source2)	= freadc source1
 	(srcend,source1)    	= fend source
 	(wrterror,dest1)    	= ferror dest
@@ -82,3 +84,573 @@ StripNewline str =  str % (0, size str - 2)
 FirstChar::String -> Char
 FirstChar "" =  ' '
 FirstChar str =  str.[0]
+
+// ---
+
+FReadText	:== 0	//	read from a text file
+FWriteText	:== 1	//	write to a text file
+FAppendText :== 2	//	append to an existing text file
+FReadData	:== 3	//	read from a data file
+FWriteData	:== 4	//	write to a data file
+FAppendData :== 5	//	append to an existing data file
+
+//	Seek modes
+
+FSeekSet :== 0		//	new position is the seek offset
+FSeekCur :== 1		//	new position is the current position plus the seek offset
+FSeekEnd :== 2		//	new position is the size of the file plus the seek offset
+
+::	* Files = Files;
+
+class FileSystem f where
+	fopen		:: !{#Char} !Int !*f -> (!Bool,!*File,!*f)
+	/*	Opens a file for the first time in a certain mode (read, write or append, text or data).
+		The boolean output parameter reports success or failure. */
+	fclose		:: !*File !*f -> (!Bool,!*f)
+	stdio		:: !*f -> (!*File,!*f)
+	/*	Open the 'Console' for reading and writing. */
+	sfopen		:: !{#Char} !Int !*f -> (!Bool,!File,!*f)
+	/*	With sfopen a file can be opened for reading more than once.
+		On a file opened by sfopen only the operations beginning with sf can be used.
+		The sf... operations work just like the corresponding f... operations.
+		They can't be used for files opened with fopen or freopen. */
+
+instance FileSystem Files
+where
+	fopen :: !{#Char} !Int !*Files -> (!Bool,!*File,!*Files)
+	fopen s i w
+		# (b,f) = fopen_ s i;
+		= (b,f,w);
+
+	fclose :: !*File !*Files -> (!Bool,!*Files)
+	fclose f w
+		# b = fclose_ f
+		= (b,w);
+
+	stdio :: !*Files -> (!*File,!*Files)
+	stdio w
+		# f = stdio_
+		= (f,w);
+
+	sfopen :: !{#Char} !Int !*Files -> (!Bool,!File,!*Files)
+	sfopen s i w
+		# (b,f) = sfopen_ s i
+		= (b,f,w)
+
+instance FileSystem World
+where
+	fopen::!{#Char} !Int !*World -> (!Bool,!*File,!*World)
+	fopen s i w
+		# (b,f) = fopen_ s i;
+		= (b,f,w);
+
+	fclose :: !*File !*World -> (!Bool,!*World)
+	fclose f w
+		# b = fclose_ f
+		= (b,w);
+
+	stdio::!*World -> (!*File,!*World)
+	stdio w
+		# f = stdio_
+		= (f,w);
+	sfopen::!{#Char} !Int !*World -> (!Bool,!File,!*World)
+	sfopen s i w
+		# (b,f) = sfopen_ s i
+		= (b,f,w)
+
+fopen_ ::!{#Char} !Int -> (!Bool,!*File)
+fopen_ s i = code inline {
+	.d 1 1 i
+		jsr	openF
+	.o 0 3 b f
+	}
+
+fclose_ :: !*File -> Bool
+fclose_ f = code inline {
+	.d 0 2 f
+		jsr	closeF
+	.o 0 1 b
+	}
+
+/*	Open the 'Console' for reading and writing. */
+stdio_ :: *File
+stdio_ = code inline {
+	.d 0 0
+		jsr	stdioF
+	.o 0 2 f
+	}
+
+sfopen_ ::!{#Char} !Int -> (!Bool,!File)
+sfopen_ s i
+= code inline {
+	.d 1 1 i
+		jsr	openSF
+	.o 0 3 b f
+	}
+
+/*
+	openfiles::!*World -> (!*Files,!*World)
+	openfiles world
+	| (1 bitand w) == 0
+		=	OpenFiles2 (StoreWorld (w bitor 1) world)
+		=	abort "openfiles: This world doesn't contain files"
+			where  w = LoadWorld world
+
+	OpenFiles2::!*World -> (!*Files,!*World)
+	OpenFiles2 w
+	= code inline {
+		pushI 0
+	}
+
+	LoadWorld :: !World -> Int;
+	LoadWorld w = code inline {
+		pushI_a 0
+		pop_a 1
+	};
+
+	StoreWorld :: !Int !World -> *World;
+	StoreWorld i w = code inline {
+		fillI_b 0 1
+		pop_b 1
+		pop_a 1
+	};
+
+	closefiles::!*Files !*World -> *World
+	closefiles f world
+	=	CloseFiles2 f (StoreWorld ((LoadWorld world) bitand (-2)) world)
+
+	CloseFiles2::!*Files !*World -> *World
+	CloseFiles2 f w
+	= code inline {
+		pop_b 1
+		fill_a 0 1
+		pop_a 1
+	}
+*/
+
+freopen::!*File !Int -> (!Bool,!*File)
+/*	Re-opens an open file in a possibly different mode.
+	The boolean indicates whether the file was successfully closed before reopening. */
+freopen f m
+	= code inline {
+		.d 0 3 f i
+			jsr reopenF
+		.o 0 3 b f
+	}
+
+//	Input. The boolean output parameter reports success or failure of the operations.
+
+freadc::!*File -> (!Bool,!Char,!*File)
+/*	Reads a character from a text file or a byte from a datafile. */
+freadc f
+	= code inline {
+		.d 0 2 f
+			jsr	readFC
+		.o 0 4 b c f
+	}
+
+freadi::!*File -> (!Bool,!Int,!*File)
+/*	Reads an integer from a textfile by skipping spaces, tabs and newlines and
+	then reading digits, which may be preceeded by a plus or minus sign.
+	From a datafile freadi will just read four bytes (a Clean Int). */
+freadi f
+	= code inline {
+		.d 0 2 f
+			jsr	readFI
+		.o 0 4 b i f
+	}
+
+freadr::!*File -> (!Bool,!Real,!*File)
+/*	Reads a real from a textfile by skipping spaces, tabs and newlines and then
+	reading a character representation of a real number.
+	From a datafile freadr will just read eight bytes (a Clean Real). */
+freadr f
+	= code inline {
+		.d 0 2 f
+			jsr	readFR
+		.o 0 5 b r f
+	}
+
+freads::!*File !Int -> (!*{#Char},!*File)
+/*	Reads n characters from a text or data file, which are returned as a {#Char}.
+	If the file doesn't contain n characters the file will be read to the end
+	of the file. An empty {#Char} is returned if no characters can be read. */
+freads f l
+	= code inline {
+		.d 0 3 f i
+			jsr readFS
+		.o 1 2 f
+	}
+
+freadsubstring :: !Int !Int !*{#Char} !*File -> (!Int,!*{#Char},!*File)
+	/*
+	Reads n characters from a text or data file, which are returned in the string s
+	at positions i..i+n-1. If the file doesn't contain n characters the file will
+	be read to the end of the file, and the part of the string s that could not be
+	read will not be changed. The number of characters read, the modified string
+	and the file are returned.
+	*/
+freadsubstring i n s f
+	= code {
+		.inline freadsubstring
+		.d 1 4 i i f
+			jsr readFString
+		.o 1 3 i f
+		.end
+	}
+
+freadline::!*File -> (!*{#Char},!*File)
+/*	Reads a line from a textfile. (including a newline character, except for the last
+	line) freadline cannot be used on data files. */
+freadline f
+	= code inline {
+		.d 0 2 f
+			jsr readLineF
+		.o 1 2 f
+	}
+
+//	Output. Use FError to check for write errors.
+
+fwritec::!Char !*File -> *File
+/*	Writes a character to a textfile.
+	To a datafile fwritec writes one byte (a Clean Char). */
+fwritec c f
+	= code inline {
+		.d 0 3 c f
+			jsr writeFC
+		.o 0 2 f
+	}
+
+fwritei::!Int !*File -> *File
+/*	Writes an integer (its textual representation) to a text file.
+	To a datafile fwritec writes four bytes (a Clean Int). */
+fwritei i f
+	= code inline {
+		.d 0 3 i f
+			jsr writeFI
+		.o 0 2 f
+	}
+
+fwriter::!Real !*File -> *File
+/*	Writes a real (its textual representation) to a text file.
+	To a datafile fwriter writes eight bytes (a Clean Real). */
+fwriter r f
+	= code inline {
+		.d 0 4 r f
+			jsr writeFR
+		.o 0 2 f
+	}
+
+fwrites::!{#Char} !*File -> *File
+/*	Writes a {#Char} to a text or data file. */
+fwrites s f
+	= code inline {
+		.d 1 2 f
+			jsr writeFS
+		.o 0 2 f
+	}
+
+fwritesubstring :: !Int !Int !{#Char} !*File -> *File
+/*	Writes the characters at positions i..i+n-1 of string s to a text or data file. */
+fwritesubstring i n s f
+	= code {
+		.inline fwritesubstring
+		.d 1 4 i i f
+			jsr writeFString
+		.o 0 2 f
+		.end
+	}
+
+//	Tests
+
+fend::!*File -> (!Bool,!*File)
+/*	Tests for end-of-file. */
+fend f
+	= code inline {
+		.d 0 2 f
+			jsr endF
+		.o 0 3 b f
+	}
+
+ferror::!*File -> (!Bool,!*File)
+/*	Has an error occurred during previous file I/O operations? */
+ferror f
+	= code inline {
+		.d 0 2 f
+			jsr errorF
+		.o 0 3 b f
+	}
+
+fposition::!*File -> (!Int,!*File)
+/*	returns the current position of the file pointer as an integer.
+	This position can be used later on for the fseek function. */
+fposition f
+	= code inline {
+		.d 0 2 f
+			jsr positionF
+		.o 0 3 i f
+	}
+
+fseek::!*File !Int !Int -> (!Bool,!*File)
+/*	Move to a different position in the file, the first integer argument is the offset,
+	the second argument is a seek mode. (see above). True is returned if successful. */
+fseek f p m
+	= code inline {
+		.d 0 4 f i i
+			jsr seekF
+		.o 0 3 b f
+	}
+
+
+//	Predefined files.
+
+stderr::   *File
+/*	Open the 'Errors' file for writing only. May be opened more than once. */
+stderr
+	= code inline {
+		.d 0 0
+			jsr	stderrF
+		.o 0 2 f
+	}
+
+sfreadc::!File -> (!Bool,!Char,!File)
+sfreadc f
+	= code inline {
+		.d 0 2 f
+			jsr	readSFC
+		.o 0 4 b c f
+	}
+
+sfreadi::!File -> (!Bool,!Int,!File)
+sfreadi f
+	= code inline {
+		.d 0 2 f
+			jsr	readSFI
+		.o 0 4 b i f
+	}
+
+sfreadr::!File -> (!Bool,!Real,!File)
+sfreadr f
+	= code inline {
+		.d 0 2 f
+			jsr	readSFR
+		.o 0 5 b r f
+	}
+
+
+sfreads::!File !Int -> (!*{#Char},!File)
+sfreads f i
+	= code inline {
+		.d 0 3 f i
+			jsr readSFS
+		.o 1 2 f
+	}
+
+sfreadline::!File -> (!*{#Char},!File)
+sfreadline f
+	= code inline {
+		.d 0 2 f
+			jsr readLineSF
+		.o 1 2 f
+	}
+
+sfseek::!File !Int !Int -> (!Bool,!File)
+sfseek f i1 i2
+	= code inline {
+		.d 0 4 f i i
+			jsr seekSF
+		.o 0 3 b f
+	}
+
+/*	Change a file so that from now it can only be used with sfF... operations. */
+fshare::!*File -> File
+fshare f
+	= code inline {
+		.d 0 2 f
+			jsr shareF
+		.o 0 2 f
+	}
+
+/*	The functions sfend and sfposition work like fend and fposition, but don't return a
+	new file on which other operations can continue. They can be used for files opened
+	with sfopen or after fshare, and in guards for files opened with fopen or freopen. */
+sfend::!File -> Bool
+sfend f
+	= code inline {
+		.d 0 2 f
+			jsr endSF
+		.o 0 1 b
+	}
+
+sfposition::!File -> Int
+sfposition f
+	= code inline {
+		.d 0 2 f
+			jsr positionSF
+		.o 0 1 i
+	}
+
+class (<<<) infixl a :: !*File !a -> *File
+
+instance <<< Int where
+//  (<<<) file i = fwritei i file
+ (<<<) file i = code inline {
+		push_b 2
+		update_b 2 3
+		update_b 1 2
+		update_b 0 1
+		pop_b 1
+	.d 0 3 i f
+		jsr writeFI
+	.o 0 2 f
+  }
+
+instance <<< Char where
+//  (<<<) file c = fwritec c file
+ (<<<) file c = code inline {
+		push_b 2
+		update_b 2 3
+		update_b 1 2
+		update_b 0 1
+		pop_b 1
+	.d 0 3 c f
+		jsr writeFC
+	.o 0 2 f
+  }
+
+instance <<< {#Char} where
+//  (<<<) file s = fwrites s file
+ (<<<) file s = code inline {
+	.d 1 2 f
+		jsr writeFS
+	.o 0 2 f
+  }
+
+instance <<< Real where
+//  (<<<) file r = fwriter r file
+ (<<<) file r = code inline {
+		push_b 3
+		push_b 3
+		update_b 3 5
+		update_b 2 4
+		update_b 1 3
+		update_b 0 2
+		pop_b 2
+	.d 0 4 r f
+		jsr writeFR
+	.o 0 2 f
+  }
+
+//	Access to the file system:
+
+class FileEnv env where
+	accFiles :: !.(*Files -> (.x,*Files)) !*env -> (!.x,!*env)
+	appFiles :: !.(*Files -> *Files)      !*env -> *env
+
+instance FileEnv World where
+	accFiles :: !.(*Files -> (.x,*Files)) !*World -> (!.x,!*World)
+	accFiles accfun world
+		#! files=create_files
+		   (r,files) = accfun files
+		= do_files2 files r world
+		where
+			do_files2 :: !*Files !.x !*World -> (!.x,!*World)
+			do_files2 filesRWS r world
+			 = (r,world)
+
+	appFiles :: !.(*Files -> *Files) !*World -> *World
+	appFiles appfun world
+		#! files1=create_files
+// RWS ...		#! files=appfun files
+		   files=appfun files1
+// .. RWS
+		=  do_files files world
+		where
+			do_files :: !*Files !*World -> *World
+			do_files filesRWS world
+			 = code inline {
+				fill_a 1 2
+				pop_a 2
+			 }
+
+create_files :== Files;
+
+not :: !Bool -> Bool
+not	a
+	= code inline {
+			notB
+	}
+
+(&&) infixr 3 :: !Bool Bool -> Bool
+(&&) a b
+	= code {
+		push_b 0
+		jmp_false l1
+		pop_b 1
+		jsr_eval 0
+		pushB_a 0
+		pop_a 1
+	.d 0 1 b
+		rtn
+	:l1
+		pop_a 1
+	.d 0 1 b
+		rtn
+	}
+
+(||) infixr 2 :: !Bool Bool -> Bool
+(||) a b
+	= code {
+		push_b 0
+		jmp_true l2
+		pop_b 1
+		jsr_eval 0
+		pushB_a 0
+		pop_a 1
+	.d 0 1 b
+		rtn
+	:l2
+		pop_a 1
+	.d 0 1 b
+		rtn
+	}
+
+class (==) infix  4	a	:: !a	!a	->	Bool			//	True if arg1 is equal to arg2
+
+instance ==	Char
+where
+ (==) ::!Char !Char -> Bool
+ (==) a b
+	= code inline {
+			eqC
+	}
+
+class Eq a | == a
+where
+  (<>) infix  4 :: !a	!a	->	Bool | Eq a
+  (<>) x y :== not (x == y)
+
+(-) infixl 6 :: !Int !Int -> Int
+(-) a b = code inline {
+	subI
+}
+
+class (%)  infixl 9	a	:: !a !(!Int,!Int)	-> a		//	Slice a part from arg1
+instance % {#Char}
+where
+ (%) ::!{#Char} !(!Int,!Int) -> {#Char}
+ (%) str (a,b)
+	= code inline {
+		.d 1 2 ii
+			jsr sliceAC
+		.o 1 0
+	}
+instance == {#Char}
+where
+ (==) :: !{#Char} !{#Char} -> Bool
+ (==) a b
+	= code inline {
+		.d 2 0
+			jsr eqAC
+		.o 0 1 b
+	}
author	Camil Staps	2016-11-10 12:19:49 +0000
committer	Camil Staps	2016-11-10 12:19:49 +0000
commit	12d40570b34a04d7f1c542f8c1d42371512d2e45 (patch)
tree	f6fa4e3d21d374559bde6f29fb23ebad3a761d51
parent	Made reverse, revtwice and sieve compile (diff)