Remove outdated, Windows-specific directory DataSources

src/libraries/OS-Windows/DataSources/SharedFile.dcl

-definition module DataSources.SharedFile
-
-import System.FilePath, Data.SharedDataSource
-
-sharedFile :: !FilePath !(String -> a) !(a -> String) -> Shared a *World

src/libraries/OS-Windows/DataSources/SharedFile.icl

-implementation module DataSources.SharedFile
-
-import System._WinBase, System._Pointer, StdInt, StdArray, StdBool, StdFunc, System.FilePath, Data.SharedDataSource
-import StdMisc
-
-sharedFile :: !FilePath !(String -> a) !(a -> String) -> Shared a *World
-sharedFile path str2b b2str = createBasicDataSource "sharedFile" path mkOps id const
-where
-	mkOps world
-		# (heap, world)	= getProcessHeap world
-		// check NULL
-		# (handle, world)	= createFileA
-								(packString path)
-								(GENERIC_READ + GENERIC_WRITE)
-								(FILE_SHARE_READ + FILE_SHARE_WRITE)
-								NULL
-								OPEN_ALWAYS
-								FILE_ATTRIBUTE_NORMAL
-								NULL
-								world
-		| handle == INVALID_HANDLE_VALUE = abort "create: invalid handle"
-		= (ops heap handle, world)
-		
-	ops heap handle =
-		{ read			= read
-		, write			= write
-		, getVersion	= getVersion
-		, lock			= lock
-		, lockExcl		= lockExcl
-		, unlock		= unlock
-		, close			= close
-		, addObserver	= addObserver
-		}
-	where
-		read world
-			# (len, world)		= getFileSize handle (packInt 0) world
-			// check INVALID_FILE_SIZE
-			# (pBuffer, world)	= heapAlloc heap 0 len world
-			// check NULL
-			# (ok, world)	= readFile handle pBuffer len (packInt 0) NULL world
-			| not ok = (Error "shared file: read error", world)
-			#! str = derefCharArray pBuffer len
-			# (ok, world)	= heapFree heap 0 pBuffer world
-			// check ok
-			# (ver, world) = getVersion world
-			| isError ver = (liftError ver, world)
-			= (Ok (str2b str, fromOk ver), world)
-			
-		write b world
-			# str	= b2str b
-			# len	= size str
-			# (pBuffer, world)	= heapAlloc heap 0 len world
-			// check NULL
-			# pBuffer	= writeCharArray pBuffer str
-			# (overlapped, world)	= heapAlloc heap HEAP_ZERO_MEMORY OVERLAPPED_SIZE_BYTES world
-			// check NULL
-			# (ok, world)	= writeFile handle pBuffer len (packInt 0) overlapped world
-			| not ok = (Error "shared file: write error", world)
-			# (ok, world)	= heapFree heap 0 overlapped world
-			// check ok
-			# (ok, world)	= heapFree heap 0 pBuffer world
-			// check ok
-			# (ok, world)	= setEndOfFile handle world
-			| not ok = (Error "shared file: set EOF error", world)
-			= (Ok (), world)
-			
-		getVersion world
-			# (len, world)		= getFileSize handle (packInt 0) world
-			// check INVALID_FILE_SIZE
-			= (Ok len, world)
-			
-		lock = lock` 0
-		lockExcl = lock` LOCKFILE_EXCLUSIVE_LOCK
-			
-		lock` flags	world
-			# (overlapped, world)	= heapAlloc heap HEAP_ZERO_MEMORY OVERLAPPED_SIZE_BYTES world
-			// check NULL
-			# (ok, world)		= lockFileEx
-									handle
-									flags
-									NULL
-									0
-									0xffff0000
-									overlapped
-									world
-			| not ok = abort "lock file error"
-			# (ok, world)	= heapFree heap 0 overlapped world
-			// check ok
-			= world
-			
-		addObserver obs world = world
-		
-		wait world
-			# world		= close (unlock world)
-			= world
-		
-		unlock world
-			# (ok, world)	= unlockFile handle 0 0 0 0xffff0000 world
-			| not ok = abort "unlock error"
-			= world
-			
-		close world
-			# (ok, world)		= closeHandle handle world
-			| not ok = abort "close error"
-			= world

src/libraries/OS-Windows/DataSources/SharedMemory.dcl

-definition module DataSources.SharedMemory
-
-import Data.SharedDataSource
-
-:: Memory :== Int
-
-sharedMemory :: !a !*envC -> (!Shared a *envS, !*envC) | MemoryEnv envC & MemoryEnv envS
-
-class MemoryEnv env
-where
-	accMemory :: !(*Memory -> (!a,!*Memory)) !*env -> (!a,!*env)
-	
-instance MemoryEnv World

src/libraries/OS-Windows/DataSources/SharedMemory.icl

-implementation module DataSources.SharedMemory
-
-import System._WinBase, System._Pointer, System._Unsafe, StdInt, StdTuple, StdString, StdArray, StdBool, StdFunc, System.FilePath, Data.SharedDataSource, dynamic_string
-import StdMisc
-
-/**
-* |--------------------------------------------|
-* | size | value ptr | version | observer list |
-* |--------------------------------------------|
-*         |                     |               |-------------------|
-*         |                      -------------> | observer 0 | next |
-*         V                                     |-------------------|
-*        |----------------------|                             |
-*        | dynamic value string |                              --> ...
-*        |----------------------|                 
-*        <-------- size -------->
-*/
-sharedMemory :: !a !*envC -> (!Shared a *envS, !*envC) | MemoryEnv envC & MemoryEnv envS
-sharedMemory v world
-	# (heap, world)	= getProcessHeap world
-	# initStr		= copy_to_string v
-	# sStr			= size initStr
-	# (mutx, world)	= createMutexA NULL False NULL world
-	// check ok
-	# (iptr, world)	= heapAlloc heap 0 (INT_SIZE * 4) world
-	# (vptr, world)	= heapAlloc heap 0 sStr world
-	# vptr			= writeCharArray vptr initStr
-	# iptr			= writeIntElemOffset iptr 0 sStr	// init size of dynamic string
-	# iptr			= writeIntElemOffset iptr 1 vptr	// init pointer to dynamic string
-	# iptr			= writeIntElemOffset iptr 2 0		// init version number
-	# iptr			= writeIntElemOffset iptr 3 NULL	// init linked list of observers
-	= (createBasicDataSource "sharedMemory" (toString iptr) (mkOps heap mutx iptr) id const, world)
-where
-	get str = fst (copy_from_string {c \\ c <-: str})
-	putback v _ = copy_to_string v
-	
-	mkOps heap mutx ptr env =
-		({ read			= read
-		, write			= write
-		, getVersion	= getVersion
-		, lock			= lock
-		, lockExcl		= lockExcl
-		, unlock		= unlock
-		, close			= close
-		, addObserver	= addObserver
-		}, env)
-	where
-		read world
-			# (sStr,ptr)	= readIntElemOffsetP ptr 0
-			# (vptr,ptr)	= readIntElemOffsetP ptr 1
-			# (ver,ptr)		= readIntElemOffsetP ptr 2
-			# str			= derefCharArray vptr sStr
-			# world			= forceEvalPointer ptr world
-			# world			= forceEval str world
-			= (Ok (fst (copy_from_string {c \\ c <-: str}), ver), world)
-			
-		write b world
-			# dstr			= copy_to_string b
-			# (vptr,ptr)	= readIntElemOffsetP ptr 1
-			# (ok, world)	= heapFree heap 0 vptr world
-			| not ok = (Error "writing to shared memory: error freeing memory", world)
-			# sStr			= size dstr
-			# (vptr, world)	= heapAlloc heap 0 sStr world
-			| vptr == NULL = (Error "writing to shared memory: error allocating memory", world)
-			# vptr			= writeCharArray vptr dstr
-			# ptr			= writeIntElemOffset ptr 0 sStr
-			# ptr			= writeIntElemOffset ptr 1 vptr
-			// increase version number
-			# ver			= readIntElemOffset ptr 2
-			# ptr			= writeIntElemOffset ptr 2 (inc ver)
-			// notify observers and empty list
-			# (wptr,ptr)	= readIntElemOffsetP ptr 3
-			# world			= notifyObservers wptr world
-			# ptr			= writeIntElemOffset ptr 3 NULL
-			= (Ok (), forceEvalPointer ptr world)
-		where
-			notifyObservers :: !Pointer !*env -> *env
-			notifyObservers wptr world
-				| wptr == NULL = world
-				# obs 			= readIntElemOffset wptr 0
-				# (_, world)	= setEvent obs world
-				# next 			= readIntElemOffset wptr 1
-				# world			= notifyObservers next world
-				# (ok, world)	= heapFree heap 0 wptr world
-				| not ok = abort "notifyWaiters: error freeing heap"
-				= world
-
-		getVersion world
-			= (Ok (readIntElemOffset ptr 2), world)
-		
-		addObserver observer world
-			# (nptr, world)	= heapAlloc heap 0 (INT_SIZE * 2) world
-			# optr			= readIntElemOffset ptr 3
-			# nptr			= writeIntElemOffset nptr 0 observer
-			# nptr			= writeIntElemOffset nptr 1 optr
-			# ptr			= writeIntElemOffset ptr 3 nptr
-			= forceEvalPointer ptr world
-			
-		lock = lock`
-		lockExcl = lock`
-		lock` world
-			# (r, world) = waitForSingleObject mutx INFINITE world
-			| r <> WAIT_OBJECT_0 = abort "shared memory: error getting lock"
-			= world
-		
-		unlock world
-			# (ok, world) = releaseMutex mutx world
-			| not ok = abort "shared memory: error releasing lock"
-			= world
-			
-		close world = world
-		
-instance MemoryEnv World
-where
-	accMemory accFunc env
-		# (a, mem) = accFunc 0
-		= (a,env)