implement environment setcompiler and codegen in cpm

cpm/CpmLogic.icl

@@ -244,18 +244,18 @@ doProjectAction _          _  _   _    world             =
  * Execute environment-specific actions
  */
 doEnvironmentAction :: String String EnvironmentAction *World -> *World
-doEnvironmentAction cleanhome  pwd  ListEnvironments                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
+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
+doEnvironmentAction cleanhome pwd (RemoveEnvironment en) world
 	= withEnvironment cleanhome en (\_ w->(Just [], w)) world
-doEnvironmentAction cleanhome  pwd  (ShowEnvironment en) world 
+doEnvironmentAction cleanhome pwd (ShowEnvironment en) world 
 	= withEnvironment cleanhome en (\e w->(Nothing, showLines (printEnvironment e) w)) world
 where
 	printEnvironment e =
@@ -282,34 +282,36 @@ where
 			CompilePers = "pers"
 		, "Processor: " +++ toString e.target_proc
 		]
-doEnvironmentAction cleanhome  pwd  (ExportEnvironment en fp) world
+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
+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
+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
+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 = 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> [<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
+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
@@ -328,6 +330,10 @@ withEnvironment cleanhome envname envf
 				(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
  */