Commit 99209c4d authored by John van Groningen's avatar John van Groningen

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

Resolve "cpm environment options"

Closes #2

See merge request !15
parents e7a90301 508ecbf4
Pipeline #21084 passed with stage
in 55 seconds
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
......
......@@ -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
......@@ -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
......
......@@ -2,3 +2,4 @@ implementation module AbsSyn
:: FilePath:==Pathname
from PmTypes import ::Pathname,::Output
from StdMaybe import :: Maybe
......@@ -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
......
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);
......
......@@ -4,3 +4,4 @@ import PmEnvironment
readIDEEnvs :: !String !String !*World -> *([Target], *World)
writeIDEEnvs :: !String !String ![Target] !*World -> *(Bool, *World)
......@@ -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
......@@ -4,3 +4,4 @@ import PmEnvironment
readIDEEnvs :: !String !String !*World -> *([Target], *World)
writeIDEEnvs :: !String !String ![Target] !*World -> *(Bool, *World)
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment