implement environment create .. for cpm

cpm/AbsSyn.dcl

@@ -2,6 +2,7 @@ definition module AbsSyn
 
 :: FilePath:==Pathname
 from PmTypes import ::Pathname,::Output
+from StdMaybe import :: Maybe
 
 /**
  * Datatypes
@@ -73,7 +74,7 @@ from PmTypes import ::Pathname,::Output
   |  RemoveEnvironment String
   |  ShowEnvironment String
   |  ExportEnvironment String FilePath
-  |  CreateEnvironment String
+  |  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

@@ -287,9 +287,12 @@ doEnvironmentAction cleanhome  pwd  (ExportEnvironment en fp) world
 where
 	exportEnvironment t world
 		# (ok, world) = saveEnvironments fp [t] world
-		| not ok = (Nothing, error "Error saving environment" world)
+		| not ok = (Nothing, error ("Error saving environment to " +++ fp) world)
 		= (Nothing, world)
-doEnvironmentAction cleanhome  pwd  (CreateEnvironment en)          world = error ("Not implemented") 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 = error ("Not implemented") world
@@ -297,15 +300,15 @@ doEnvironmentAction cleanhome  pwd  (SetEnvironmentCodeGen en cp)   world = erro
 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> <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>"
+    ,  "  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

cpm/Parser.icl

 implementation module Parser;
 
 import StdEnv;
+import StdMaybe;
 import AbsSyn;
 from PmEnvironment import EnvsFileName;
 from PmTypes import :: Output(..);
@@ -178,7 +179,8 @@ 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",s1,s2] = Environment (ExportEnvironment s1 s2);