IdeState.icl 8.2 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2
implementation module IdeState

3
import StdMisc, StdList
Diederik van Arkel's avatar
Diederik van Arkel committed
4 5
import StdPathname
import UtilStrictLists
Diederik van Arkel's avatar
Diederik van Arkel committed
6 7
from PmAbcMagic import :: ABCCache, AC_Init
from PmProject import :: Project, PR_GetTarget
Diederik van Arkel's avatar
Diederik van Arkel committed
8 9 10 11 12 13
import PmCompilerOptions
import typewin
import PmEnvironment
import logfile
import set_return_code
import PmFileInfo
14
from PmCleanSystem import ::CompilerProcessIds,NoCompilerProcessIds
Diederik van Arkel's avatar
Diederik van Arkel committed
15

16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
appPLoc f gst
	# s = f gst.ls
	:== {gst & ls=s}

accPLoc f gst
	# (r,s) = f gst.ls
	:== (r,{gst & ls=s})

instance FileSystem GeneralSt where
	fopen fName fMode pState
		# (b,f,w) = fopen fName fMode pState.gst_world
		# pState = {pState & gst_world=w}
		= (b,f,pState)
	fclose file pState
		# (b,w) = fclose file pState.gst_world
		# pState = {pState & gst_world=w}
		= (b,pState)
	stdio pState
		# (f,w) = stdio pState.gst_world
		# pState = {pState & gst_world=w}
		= (f,pState)
	sfopen fName fMode pState
		# (b,f,w) = sfopen fName fMode pState.gst_world
		# pState = {pState & gst_world=w}
		= (b,f,pState)

instance FileEnv GeneralSt where
	accFiles accfun io
		# (x,w) = accFiles accfun io.gst_world
		= (x,{io & gst_world=w})
	appFiles appfun io
		= {io & gst_world = appFiles appfun io.gst_world}

Diederik van Arkel's avatar
Diederik van Arkel committed
49 50 51
:: *General =
	{ prefs			:: !Prefs
	, project		:: !Project
52
	, cache			:: !*(Maybe *ABCCache)
Diederik van Arkel's avatar
Diederik van Arkel committed
53 54 55
	, fi_cache		:: !(Maybe FileInfoCache)
	, pr_path		:: !Pathname			// proj_path
	, stup			:: !Pathname			// appl_path
56
	, g_compiler_process_ids :: !CompilerProcessIds
Diederik van Arkel's avatar
Diederik van Arkel committed
57 58 59 60 61
	, pm_targets	:: ![Target]
	, pm_curtarg	:: !Int
	, logfile		:: !*File
	}

62 63
initGeneral :: !Bool !CompilerOptions !String !String !Project ![Target] !*File -> *General
initGeneral be_verb comp_opts application_path project_path project targets logfile
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
64
	| isNothing target_index	= abort ("Unable to find project environment for target '" +++ target_name +++ "' in available environments.\n")
Diederik van Arkel's avatar
Diederik van Arkel committed
65 66 67 68 69 70 71
	=
	{ prefs			= prefs
	, project		= project
	, cache			= Just AC_Init
	, fi_cache		= Just FI_EmptyCache
	, pr_path		= project_path
	, stup			= application_path
72
	, g_compiler_process_ids=NoCompilerProcessIds
Diederik van Arkel's avatar
Diederik van Arkel committed
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
	, pm_targets	= targets
	, pm_curtarg	= fromJust target_index
	, logfile		= logfile
	}
where
	prefs =
		{ be_verbose			= be_verb
		, compopts				= comp_opts
		, edwintabs				= (4,True,False,True,True)
		, number_of_processes	= 1
		}
	target_name	= PR_GetTarget project
	target_index = findIndex 0 target_name targets

	findIndex x name [] = Nothing
	findIndex x name [t=:{target_name=n}:ns]
		| n == name = Just x
		= findIndex (inc x) name ns

:: Prefs =
	{ be_verbose			:: !Bool
	, compopts				:: !CompilerOptions
	, edwintabs				:: !(Int,Bool,Bool,Bool,Bool)	// tabsize, autotab, showtabs, showlinenos, showsyncol
	, number_of_processes	:: !Int
	}

:: ErrPrefs		= ErrPrefs
:: SrcPrefs		= SrcPrefs
:: NewlinePrefs	= NwlPrefs

103
getPrefs :: !*GeneralSt -> (Prefs,*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
104 105
getPrefs ps = ps!ls.prefs

106
setPrefs :: Prefs !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
107 108
setPrefs prefs ps = {ps & ls.prefs = prefs}

109
getProject :: !*GeneralSt -> (Project,*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
110 111
getProject ps = ps!ls.project

112
setProject :: !Project !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
113 114
setProject project ps = {ps & ls.project = project}

115
getABCCache :: !*GeneralSt -> *(!*ABCCache,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
116 117
getABCCache ps = accPLoc (\p=:{cache = Just cache}->(cache,{p & cache = Nothing})) ps

118
setABCCache :: !*ABCCache !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
119 120
setABCCache cache ps = {ps & ls.cache = Just cache}

121
getFICache :: !*GeneralSt -> (FileInfoCache,*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
122 123
getFICache ps = accPLoc (\p=:{fi_cache = Just fi_cache}->(fi_cache,{p & fi_cache = Nothing})) ps

124
setFICache :: !FileInfoCache !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
125 126
setFICache ac ps = appPLoc (\p->{p & fi_cache = Just ac}) ps

127 128
getProjectFilePath :: !*GeneralSt -> (!Pathname,!*GeneralSt)
getProjectFilePath ps = ps!ls.pr_path
Diederik van Arkel's avatar
Diederik van Arkel committed
129

130 131
setProjectFilePath :: !Pathname !*GeneralSt -> *GeneralSt
setProjectFilePath path ps = {ps & ls.pr_path = path}
Diederik van Arkel's avatar
Diederik van Arkel committed
132

133
getStup :: !*GeneralSt -> (!Pathname,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
134 135 136 137
getStup ps = ps!ls.stup

//-- NOT YET IMPLEMENTED....

138
getTargets :: !*GeneralSt -> (![Target],!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
139 140
getTargets ps = accPLoc (\p=:{pm_targets}->(pm_targets,p)) ps

John van Groningen's avatar
John van Groningen committed
141
setTargets :: ![Target] !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
142 143
setTargets ts ps = appPLoc (\p->{p & pm_targets = ts}) ps

144
getCurrentTarget :: !*GeneralSt -> (!Int,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
145 146
getCurrentTarget ps = accPLoc (\p=:{pm_curtarg}->(pm_curtarg,p)) ps

John van Groningen's avatar
John van Groningen committed
147
setCurrentTarget :: !Int !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
148 149 150
setCurrentTarget tg ps
	= appPLoc (\p->{p & pm_curtarg = tg}) ps

151
getCurrentPaths :: !*GeneralSt -> (!(List Pathname),!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
152 153 154 155
getCurrentPaths ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_path,ps)

156
getCurrentDlibs :: !*GeneralSt -> (!(List String),!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
157 158 159 160
getCurrentDlibs ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_libs,ps)

161
getCurrentSlibs :: !*GeneralSt -> (!(List String),!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
162 163 164 165
getCurrentSlibs ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_stat,ps)

166
getCurrentObjts :: !*GeneralSt -> (!(List String),!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
167 168 169 170
getCurrentObjts ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_objs,ps)

171
getCurrentComp :: !*GeneralSt -> (!String,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
172 173 174 175
getCurrentComp ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_comp,ps)

176
getCurrentCgen :: !*GeneralSt -> (!String,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
177 178 179 180
getCurrentCgen ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_cgen,ps)

181 182 183 184 185 186 187 188 189 190 191 192 193 194 195
getCurrentAbcOpt :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentAbcOpt ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_abcopt,ps)

getCurrentBCgen :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBCgen ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_bcgen,ps)

getCurrentBClink :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBClink ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_bclink,ps)

196 197 198 199 200
getCurrentBCstrip :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBCstrip ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_bcstrip,ps)

201
getCurrentLink :: !*GeneralSt -> (!String,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
202 203 204 205
getCurrentLink ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_link,ps)

206
getCurrentDynl :: !*GeneralSt -> (!String,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
207 208 209 210
getCurrentDynl ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_dynl,ps)

211
getCurrentVers :: !*GeneralSt -> (!Int,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
212 213 214 215
getCurrentVers ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_vers,ps)

216
getCurrent64BitProcessor :: !*GeneralSt -> (!Bool,!*GeneralSt)
217 218 219 220
getCurrent64BitProcessor ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.env_64_bit_processor,ps)

221
getCurrentProc :: !*GeneralSt -> (!Processor,!*GeneralSt)
222 223 224 225
getCurrentProc ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_proc,ps)

226
getCurrentMeth :: !*GeneralSt -> (!CompileMethod,!*GeneralSt)
Diederik van Arkel's avatar
Diederik van Arkel committed
227 228 229 230
getCurrentMeth ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_meth,ps)

231
getCompilerProcessIds :: !*GeneralSt -> (!CompilerProcessIds,!*GeneralSt)
232 233
getCompilerProcessIds ps = accPLoc (\l -> l!g_compiler_process_ids) ps

234
setCompilerProcessIds :: !CompilerProcessIds !*GeneralSt -> *GeneralSt
235 236
setCompilerProcessIds compiler_project_ids ps = appPLoc (\l -> {l & g_compiler_process_ids = compiler_project_ids}) ps

237
getInteract  :: !*GeneralSt -> (!Bool,!*GeneralSt)
238 239
getInteract ps = (False,ps)

240
writeLog :: !String !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
241 242 243
writeLog message ps
	= appPLoc (\ls=:{logfile} -> {ls & logfile = writeLogfile message logfile}) ps

244
abortLog :: !Bool !String !*GeneralSt -> *GeneralSt
Diederik van Arkel's avatar
Diederik van Arkel committed
245 246 247 248 249 250 251 252
abortLog flag message ps
	# ps		= case message of
					""	-> ps
					_	-> appPLoc (\ls=:{logfile} -> {ls & logfile = writeLogfile message logfile}) ps
	# (lf,ps)	= accPLoc (\ls=:{logfile} -> (logfile,{ls & logfile = stderr})) ps
	# (ok,ps)	= closeLogfile lf ps
//	| not ok ...
	# ps = case flag of
253
		True	-> app_world_instead_of_ps (set_return_code_world (-1)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
254
		_		-> ps
255
	= {ps & gst_continue_or_stop=True}