Merge branch '2-wip-cpm-environment-options' into 'master'

Resolve "cpm environment options"

Closes #2

See merge request !15

CpmLinux.prj

-Version: 1.4
+Version: 1.5
 Global
 	ProjectRoot:	.
 	Target:	StdEnv
 	Exec:	{Project}/cpm/cpm
+	ByteCode:	
 	CodeGen
 		CheckStacks:	False
 		CheckIndexes:	True
+		OptimiseABC:	False
+		GenerateByteCode:	False
 	Application
 		HeapSize:	67108864
 		StackSize:	5242880
@@ -40,6 +43,7 @@ Global
 		ResourceSource:	
 		GenerateDLL:	False
 		ExportedNames:	
+		StripByteCode:	False
 	Paths
 		Path:	{Project}*cpm
 		Path:	{Project}*cpm*Posix
@@ -51,8 +55,6 @@ Global
 		Path:	{Application}*lib*ArgEnv
 		Path:	{Application}*lib*StdLib
 		Path:	{Application}*lib*Directory
-	OtherPaths
-		Path:	{Application}*lib*StdEnv
 	Precompile:	
 	Postlink:	
 MainModule

Pm/PmEnvironment.dcl

@@ -35,6 +35,7 @@ EnvsFileName :== "IDEEnvs"
 	
 getEnvironments :: !String !String !*env -> *([Target],*env) | FileSystem, FileEnv env
 openEnvironments	:: !String !String !*env -> *([Target],*env) | FileEnv env
+openEnvironment :: !String *a -> *(([Target],.Bool,{#Char}),*a) | FileSystem a
 saveEnvironments	:: !String ![Target] !*env -> *(Bool,*env) | FileEnv env
 
 t_StdEnv :: Target

cpm/AbsSyn.dcl

@@ -2,6 +2,7 @@ definition module AbsSyn
 
 :: FilePath:==Pathname
 from PmTypes import ::Pathname,::Output
+from StdMaybe import :: Maybe
 
 /**
  * Datatypes
@@ -72,8 +73,8 @@ from PmTypes import ::Pathname,::Output
   |  ImportEnvironment FilePath
   |  RemoveEnvironment String
   |  ShowEnvironment String
-  |  ExportEnvironment String
-  |  CreateEnvironment String
+  |  ExportEnvironment String FilePath
+  |  CreateEnvironment String (Maybe String)
   |  RenameEnvironment String String
   |  SetEnvironmentCompiler String String
   |  SetEnvironmentCodeGen String String

cpm/AbsSyn.icl

@@ -2,3 +2,4 @@ implementation module AbsSyn
 
 :: FilePath:==Pathname
 from PmTypes import ::Pathname,::Output
+from StdMaybe import :: Maybe

cpm/CpmLogic.icl

@@ -244,28 +244,95 @@ doProjectAction _          _  _   _    world             =
  * Execute environment-specific actions
  */
 doEnvironmentAction :: String String EnvironmentAction *World -> *World
-doEnvironmentAction cleanhome  pwd  ListEnvironments                world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (ImportEnvironment ef)          world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (RemoveEnvironment en)          world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (ShowEnvironment en)            world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (ExportEnvironment en)          world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (CreateEnvironment en)          world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (RenameEnvironment en en`)      world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (SetEnvironmentCompiler en cp)  world = error ("Not implemented") world
-doEnvironmentAction cleanhome  pwd  (SetEnvironmentCodeGen en cp)   world = error ("Not implemented") world
-doEnvironmentAction _          _    _                               world =
-  help "cpm environment <action>"
-    [  "Where <action> is one of the following"
-    ,  "  list                                  : list all available environments"
-    ,  "  import <filepath>                     : import an environement from file <filepath>"
-    ,  "  create <envname>                      : create a new environment with name <envname>"
-    ,  "  remove <envname>                      : remove evironment <envname>"
-    ,  "  show <envname>                        : show environment <envname>"
-    ,  "  export <envname>                      : export environment <envname>"
-    ,  "  rename <envname> <envname`>           : rename environment <envname> to <envname`>"
-    ,  "  setcompiler <envname> <compilername>  : set compiler for <envname> to <compilername>"
-    ,  "  setcodegen <envname> <codegenname>    : set codegen for <envname> to <codegenname>"
-    ] world
+doEnvironmentAction cleanhome pwd ListEnvironments        world
+	= withEnvironments cleanhome (\ts w->(Nothing, showLines [t.target_name\\t<-ts] w)) world
+doEnvironmentAction cleanhome pwd (ImportEnvironment ef) world
+	= withEnvironments cleanhome importEnvironment world
+where
+	importEnvironment ts world
+		# ((ts`, ok, err), world) = openEnvironment ef world
+		| not ok = (Nothing, error err world)
+		= (Just (ts ++ ts`), world)
+doEnvironmentAction cleanhome pwd (RemoveEnvironment en) world
+	= withEnvironment cleanhome en (\_ w->(Just [], w)) world
+doEnvironmentAction cleanhome pwd (ShowEnvironment en) world 
+	= withEnvironment cleanhome en (\e w->(Nothing, showLines (printEnvironment e) w)) world
+where
+	printEnvironment e =
+		[ "Name: " +++ e.target_name
+		, "Paths: " +++ foldr (+++) "" ["\t" +++ t +++ "\n"\\t<|-e.target_path]
+		, "Dynamics libraries: \n" +++ foldr (+++) "" ["\t" +++ t +++ "\n"\\t<|-e.target_libs]
+		, "Object files: \n" +++ foldr (+++) "" ["\t" +++ t +++ "\n"\\t<|-e.target_objs]
+		, "Static libraries: \n" +++ foldr (+++) "" ["\t" +++ t +++ "\n"\\t<|-e.target_stat]
+		, "Compiler: " +++ e.target_comp
+		, "Code generator: " +++ e.target_cgen
+		, "ABC optimizer: " +++ e.target_abcopt
+		, "Bytecode generator: " +++ e.target_bcgen
+		, "Bytecode linker: " +++ e.target_bclink
+		, "Bytecode stripper: " +++ e.target_bcstrip
+		, "Bytecode prelink: " +++ e.target_bcprelink
+		, "Linker: " +++ e.target_link
+		, "Dynamic linker: " +++ e.target_dynl
+		, "ABC version: " +++ toString e.target_vers
+		, "64 bit processor: " +++ toString e.env_64_bit_processor
+		, "Redirect console: " +++ toString e.target_redc
+		, "Compile method: " +++ case e.target_meth of
+			CompileSync = "sync"
+			CompileAsync i = "async " +++ toString i
+			CompilePers = "pers"
+		, "Processor: " +++ toString e.target_proc
+		]
+doEnvironmentAction cleanhome pwd (ExportEnvironment en fp) world
+	= withEnvironment cleanhome en exportEnvironment world
+where
+	exportEnvironment t world
+		# (ok, world) = saveEnvironments fp [t] world
+		| not ok = (Nothing, error ("Error saving environment to " +++ fp) world)
+		= (Nothing, world)
+doEnvironmentAction cleanhome pwd (CreateEnvironment en Nothing) world
+	= withEnvironments cleanhome (\t w->(Just [{t_StdEnv & target_name=en}:t], w)) world
+doEnvironmentAction cleanhome pwd (CreateEnvironment en (Just en`)) world
+	= withEnvironment cleanhome en` (\t w->(Just [t, {t & target_name=en}], w)) world
+doEnvironmentAction cleanhome pwd (RenameEnvironment en en`)   world
+	= withEnvironment cleanhome en (\t w->(Just [{t & target_name=en`}], w)) world
+doEnvironmentAction cleanhome pwd (SetEnvironmentCompiler en cp) world
+	= modifyEnvironment cleanhome en (\t->{t & target_comp=cp}) world
+doEnvironmentAction cleanhome pwd (SetEnvironmentCodeGen en cp) world
+	= modifyEnvironment cleanhome en (\t->{t & target_cgen=cp}) world
+doEnvironmentAction _ _  _ world
+	= help "cpm environment <action>"
+		[ "Where <action> is one of the following"
+		, " list                 : list all available environments"
+		, " import <filepath>          : import an environement from file <filepath>"
+		, " create <envname> [<envname`>]    : create a new environment with name <envname> possibly inheriting all options from <envname`>"
+		, " remove <envname>           : remove evironment <envname>"
+		, " show <envname>            : show environment <envname>"
+		, " export <envname> <filepath>     : export environment <envname> to <filepath>"
+		, " rename <envname> <envname`>     : rename environment <envname> to <envname`>"
+		, " setcompiler <envname> <compilername> : set compiler for <envname> to <compilername>"
+		, " setcodegen <envname> <codegenname>  : set codegen for <envname> to <codegenname>"
+		] world
+
+withEnvironments :: String ([Target] *World -> (Maybe [Target], *World)) *World -> *World
+withEnvironments cleanhome envf world
+	# (envs, world) = uncurry envf (readIDEEnvs cleanhome EnvsFileName world)
+	| isNothing envs = world
+	# (ok, world) = writeIDEEnvs cleanhome EnvsFileName (fromJust envs) world
+	| not ok = error ("Error writing environment") world
+	= world
+
+withEnvironment :: String String (Target *World -> (Maybe [Target], *World)) -> (*World -> *World)
+withEnvironment cleanhome envname envf
+	= withEnvironments cleanhome \ts world->
+		case span (\s->s.target_name <> envname) ts of
+			(_, []) = (Nothing, error ("Environment " +++ envname +++ " not found") world)
+			(e, [t:es]) = case envf t world of
+				(Nothing, world) = (Nothing, world)
+				(Just ts, world) = (Just (flatten [e, ts, es]), world)
+
+modifyEnvironment :: String String (Target -> Target) -> (*World -> *World)
+modifyEnvironment cleanhome envname targetf
+	= withEnvironment cleanhome envname (\t w->(Just [targetf t], w))
 
 /**
  * Modify a project

cpm/Parser.icl

 implementation module Parser;
 
 import StdEnv;
+import StdMaybe;
 import AbsSyn;
 from PmEnvironment import EnvsFileName;
 from PmTypes import :: Output(..);
@@ -178,10 +179,11 @@ parse_Module _ module_name = Module "" ModuleHelp;
 parse_Environment :: ![String] -> CpmAction;
 parse_Environment ["list"] = Environment ListEnvironments;
 parse_Environment ["import",s] = Environment (ImportEnvironment s);
-parse_Environment ["create",s] = Environment (CreateEnvironment s);
+parse_Environment ["create",s] = Environment (CreateEnvironment s Nothing);
+parse_Environment ["create",s,s2] = Environment (CreateEnvironment s (Just s2));
 parse_Environment ["remove",s] = Environment (RemoveEnvironment s);
 parse_Environment ["show",s] = Environment (ShowEnvironment s);
-parse_Environment ["export",s] = Environment (ExportEnvironment s);
+parse_Environment ["export",s1,s2] = Environment (ExportEnvironment s1 s2);
 parse_Environment ["rename",s1,s2] = Environment (RenameEnvironment s1 s2);
 parse_Environment ["setcompiler",s1,s2] = Environment (SetEnvironmentCompiler s1 s2);
 parse_Environment ["setcodegen",s1,s2] = Environment (SetEnvironmentCodeGen s1 s2);

cpm/Posix/CpmPaths.dcl

@@ -4,3 +4,4 @@ import PmEnvironment
 
 readIDEEnvs :: !String !String !*World -> *([Target], *World)
 
+writeIDEEnvs :: !String !String ![Target] !*World -> *(Bool, *World)

cpm/Posix/CpmPaths.icl

@@ -11,3 +11,7 @@ append_dir_separator s
 readIDEEnvs :: !String !String !*World -> *([Target], *World)
 readIDEEnvs cleanhome ideenvs world
 	= openEnvironments cleanhome (append_dir_separator cleanhome+++"etc"+++DirSeparatorString+++ideenvs) world
+
+writeIDEEnvs :: !String !String ![Target] !*World -> *(Bool, *World)
+writeIDEEnvs cleanhome ideenvs envs world
+	= saveEnvironments (append_dir_separator cleanhome+++"etc"+++DirSeparatorString+++ideenvs) envs world

cpm/Windows/CpmPaths.dcl

@@ -4,3 +4,4 @@ import PmEnvironment
 
 readIDEEnvs :: !String !String !*World -> *([Target], *World)
 
+writeIDEEnvs :: !String !String ![Target] !*World -> *(Bool, *World)

cpm/Windows/CpmPaths.icl

@@ -12,3 +12,6 @@ readIDEEnvs :: !String !String !*World -> *([Target], *World)
 readIDEEnvs cleanhome ideenvs world
 	= openEnvironments cleanhome (append_dir_separator cleanhome+++"Config"+++DirSeparatorString+++ideenvs) world
 
+writeIDEEnvs :: !String !String ![Target] !*World -> *(Bool, *World)
+writeIDEEnvs cleanhome ideenvs envs world
+	= saveEnvironments (append_dir_separator cleanhome+++"Config"+++DirSeparatorString+++ideenvs) envs world