Skip to content
GitLab
Commit 00a354d3 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim
Browse files

Switch to hierarchical module imports 

Add "cpm make" command which builds all projects in the pwd
Fix path issues
Start implementing environment-related actions (currently not working)
Clean up
parent b8fb62d9
Hide whitespace changes
Inline Side-by-side
cpm/AbsSyn.dcl
View file @ 00a354d3
definition module AbsSyn
from FilePath import :: FilePath
from System.FilePath import :: FilePath
/**
* Datatypes
......@@ -9,6 +9,7 @@ from FilePath import :: FilePath
= Project FilePath ProjectAction
| Module String ModuleAction
| Environment EnvironmentAction
| CpmMake
| CpmHelp
:: ProjectAction
......@@ -16,7 +17,7 @@ from FilePath import :: FilePath
| ShowProject
| BuildProject Bool FilePath
| ProjectPath PathAction
//| SetProjectRoot String TODO: Not yet supported by PmProject
| SetRelativeRoot String
| SetTarget String
| SetExec String
| ProjectHelp
......@@ -29,10 +30,10 @@ from FilePath import :: FilePath
| PathHelp
:: PathDirection
= PathUp
| PathDown
| PathTop
| PathBottom
= MovePathUp
| MovePathDown
| MovePathTop
| MovePathBottom
:: ModuleAction
= CreateModule ModuleType
......@@ -43,4 +44,14 @@ from FilePath import :: FilePath
| LibraryModule
:: EnvironmentAction
= ShowEnvironment
= ListEnvironments
| ImportEnvironment FilePath
| RemoveEnvironment String
| ShowEnvironment String
| ExportEnvironment String
| CreateEnvironment String
| RenameEnvironment String String
| SetEnvironmentCompiler String String
| SetEnvironmentCodeGen String String
| EnvironmentHelp
// TODO: EnvironmentPaths, EnvironmentVersion, EnvironmentProcessor, Environment64BitProcessor
cpm/Cpm.icl
View file @ 00a354d3
......@@ -54,12 +54,14 @@ import UtilIO
/**
* Clean Platform imports
*/
import CommandLine, Environment, Func, List, Text
import System.CommandLine, System.Environment, System.Directory
import Data.Error, Data.Func, Data.List
import Text
/**
* Clean libraries imports
*/
import StdFile, StdString
import StdFile, StdString, StdMisc
/**
* Start function which reads the program arguments, starts the parser and
......@@ -67,10 +69,13 @@ import StdFile, StdString
*/
Start :: *World -> *World
Start world
# (cmd, world) = getCommandLine world
(pwd, world) = accFiles GetFullApplicationPath world
(ch, world) = case getEnvironmentVariable "CLEAN_HOME" world of
(Just ch, world) -> (ch, world)
(_, world) -> (pwd, world)
= doCpmAction ch pwd (startParse (fromString $ mkCl cmd)) world
# (cmd, world) = getCommandLine world
(mpwd, world) = getCurrentDirectory world
(cpmd, world) = accFiles GetFullApplicationPath world
(ch, world) = case getEnvironmentVariable "CLEAN_HOME" world of
(Just ch, world) -> (ch, world)
(_, world) -> (cpmd, world)
= case mpwd of
Ok pwd -> doCpmAction ch pwd (startParse (fromString $ mkCl cmd)) world
Error e -> abort "Failed to read current directory"
where mkCl cmd = concat (intersperse " " (tl [fromString arg \\ arg <- cmd]))
cpm/CpmLogic.dcl
View file @ 00a354d3
......@@ -13,7 +13,12 @@ from PmProject import :: Project
/**
* Execute a general CPM action
*/
doCpmAction :: String String .CpmAction *World -> .World
doCpmAction :: String String !.CpmAction !*World -> .World
/**
* Find all project files in the current working directory and build them
*/
doMake :: String !String !*World -> .World
/**
* Execute project-specific actions
......@@ -28,25 +33,29 @@ doProjectPathAction :: .String .String Project .PathAction *World -> .World
/**
* Execute module-related actions
*/
doModuleAction :: .String .String .ModuleAction *World -> .World
doModuleAction :: .String !.String !.ModuleAction !*World -> .World
/**
* Turn a project name into a project filename
*/
mkProjectFile :: !String -> String
/**
* Modify a project
*/
withProject :: String String .(Project -> Project) *World -> .World
withProject :: !String !String .(Project -> Project) *World -> .World
/**
* Collect all project paths in a list with an index prefixed
*/
showPaths :: Project -> .[String]
showPaths :: !Project -> .[String]
/**
* Modify the list of paths in a project given a modification function which
* takes a strict list of project paths and returns a strict list of project
* paths.
*/
doModPaths :: String String Project .([!String!] -> [!String!]) *World -> .World
doModPaths :: !String !String !Project .([!String!] -> [!String!]) *World -> .World
/**
* Open a project file
......@@ -62,18 +71,18 @@ saveProject :: !FilePath !Project !FilePath !*World -> *World
* Remove an item from a strict list at a given index. Abort execution if the
* index is out of bounds.
*/
rmStrictListIdx :: Int u:[!.a!] -> v:[!.a!], [u <= v]
rmStrictListIdx :: !Int u:[!.a!] -> v:[!.a!], [u <= v]
/**
* Move a path at a given index up or down the list of paths. Abort execution
* if the index is out of bounds.
*/
moveStrictListIdx :: .Int .PathDirection .[!a!] -> .[!a!]
moveStrictListIdx :: !.Int .PathDirection .[!a!] -> .[!a!]
/**
* Show an error message
*/
error :: String *World -> .World
error :: !String !*World -> .World
/**
* Show a help message
......
cpm/CpmLogic.icl
View file @ 00a354d3
......@@ -13,28 +13,45 @@ import IdeState, logfile, PmDriver, PmEnvironment, PmProject, set_return_code, U
/**
* Clean Platform imports
*/
import File, Error, FilePath, Func, List
import Text
import Data.Func, Data.Error, Data.List, Data.Void
import System.Directory, System.File, System.FilePath
/**
* Clean libraries imports
*/
import StdBool, StdEnum, StdMisc, StdTuple
/**
* Execute a general CPM action
*/
doCpmAction :: String String .CpmAction *World -> .World
doCpmAction cleanhome pwd (Project pn pa) world = doProjectAction cleanhome pwd pn pa world
doCpmAction cleanhome pwd (Module mn ma) world = doModuleAction cleanhome mn ma world
doCpmAction _ _ _ world =
doCpmAction :: String String !.CpmAction !*World -> .World
doCpmAction cleanhome pwd CpmMake world = doMake cleanhome pwd world
doCpmAction cleanhome pwd (Project pn pa) world = doProjectAction cleanhome pwd pn pa world
doCpmAction cleanhome pwd (Module mn ma) world = doModuleAction cleanhome mn ma world
doCpmAction cleanhome pwd (Environment ea) world = doEnvironmentAction cleanhome pwd ea world
doCpmAction _ _ _ world =
help "cpm <target>"
[ "Where <target> is one of the following:"
, " project <projectname> : project actions"
, " module <modulename> : module actions"
, " environment : environment actions"
, " make : build all projects in the current directory"
, ""
, "Execute `cpm <target> help` to get help for specific actions."] world
/**
* Find all project files in the current working directory and build them
*/
doMake :: String !String !*World -> .World
doMake cleanhome pwd world
# (mbErr, world) = readDirectory pwd world
= case mbErr of
Error _ -> error "Failed to read current directory" world
Ok entries -> case filter (\entry -> endsWith ".prj" entry) entries of
[] -> error ("No project file found in " +++ pwd) world
xs -> foldr (\pn -> doProjectAction cleanhome pwd pn (BuildProject False EnvsFileName)) world xs
/**
* Default compiler options. Currently it is a simple alias for
* forwards-compatibility.
......@@ -55,16 +72,15 @@ doProjectAction cleanhome pwd pn CreateProject world
= world
where basefilename = dropExtension pn
mainmodule = addExtension basefilename "icl"
projectfile = addExtension basefilename "prj"
projectfile = mkProjectFile basefilename //addExtension basefilename "prj"
edit_options = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
project = PR_SetRoot mainmodule edit_options compilerOptions prj
//Create project file using the Clean IDE libraries
//Create project file using the Clean IDE libraries
where prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions
doProjectAction cleanhome pwd pn ShowProject world
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# projectfile = mkProjectFile pn
# (project, world) = openProject cleanhome projectfile world
= showLines [ "Content of " +++ projectfile +++ ":"
, "ProjectRoot..: " +++ PR_GetRelativeRootDir project
......@@ -76,23 +92,22 @@ doProjectAction cleanhome pwd pn ShowProject world
] world
doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
# (envs, world) = openEnvironments cleanhome envsfile world
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path pwd) world
| not ok || err <> "" = error ("CPM failed while opening project: "+++.err+++."\n") world
# (ok, logfile, world) = openLogfile proj_path world
| not ok = error ("CPM failed while opening logfile.\n") world
# iniGeneral = initGeneral True compilerOptions pwd proj_path proj envs logfile
# {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# (envs, world) = openEnvironments cleanhome (cleanhome </> ideenvs) world
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path cleanhome) world
| not ok || err <> "" = error ("CPM failed while opening project: " +++ err +++ "\n") world
# iniGeneral = initGeneral True compilerOptions cleanhome proj_path proj envs stderr
# {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
= gst_world
where envsfile = cleanhome </> ideenvs
proj_path = GetLongPathName pn
where proj_path = GetLongPathName pn
doProjectAction cleanhome _ pn (ProjectPath pa) world
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# projectfile = mkProjectFile pn
# (project, world) = openProject cleanhome projectfile world
= doProjectPathAction cleanhome projectfile project pa world
doProjectAction cleanhome pwd pn (SetRelativeRoot target) world =
withProject cleanhome pn (PR_SetRelativeRootDir target) world
doProjectAction cleanhome pwd pn (SetTarget target) world =
withProject cleanhome pn (PR_SetTarget target) world
......@@ -111,12 +126,45 @@ doProjectAction _ _ _ _ world =
, " exec <execname> : set executable name to <execname>"
] 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
/**
* Turn a project name into a project filename
*/
mkProjectFile :: !String -> String
mkProjectFile pn = addExtension (dropExtension pn) "prj"
/**
* Modify a project
*/
withProject :: String String .(Project -> Project) *World -> .World
withProject :: !String !String .(Project -> Project) *World -> .World
withProject cleanhome pn f world
# projectfile = addExtension (dropExtension pn) "prj"
# projectfile = mkProjectFile pn
# (project, world) = openProject cleanhome projectfile world
= saveProject cleanhome (f project) projectfile world
......@@ -146,7 +194,7 @@ doProjectPathAction _ _ _ _ world =
/**
* Collect all project paths in a list with an index prefixed
*/
showPaths :: Project -> .[String]
showPaths :: !Project -> .[String]
showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
where f (n, p) = " [" +++ toString n +++ "] " +++ p
......@@ -155,7 +203,7 @@ showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
* takes a strict list of project paths and returns a strict list of project
* paths.
*/
doModPaths :: String String Project .([!String!] -> [!String!]) *World -> .World
doModPaths :: !String !String !Project .([!String!] -> [!String!]) *World -> .World
doModPaths cleanhome pn project f world
# world = saveProject cleanhome prj pn world
= showLines ["Successfully modified project paths"] world
......@@ -169,7 +217,7 @@ openProject :: !FilePath !FilePath !*World -> (!Project, !*World)
openProject cleanhome projectfile world
# ((prj, ok, err), world) = accFiles (ReadProjectFile projectfile cleanhome) world
| ok = (prj, world)
= abort err
= (prj, error err world)
/**
* Save a project back to its project file
......@@ -184,7 +232,7 @@ saveProject cleanhome prj projectfile world
* Remove an item from a strict list at a given index. Abort execution if the
* index is out of bounds.
*/
rmStrictListIdx :: Int u:[!.a!] -> v:[!.a!], [u <= v]
rmStrictListIdx :: !Int u:[!.a!] -> v:[!.a!], [u <= v]
rmStrictListIdx 0 (_ :! t) = t
rmStrictListIdx n (h :! t) | n > 0 = h :! (rmStrictListIdx (n - 1) t)
rmStrictListIdx n _ = abort ("Index " +++ toString n +++ " out of bounds")
......@@ -193,30 +241,30 @@ rmStrictListIdx n _ = abort ("Index " +++ toString n +++ " out
* Move a path at a given index up or down the list of paths. Abort execution
* if the index is out of bounds.
*/
moveStrictListIdx :: .Int .PathDirection .[!a!] -> .[!a!]
moveStrictListIdx :: !.Int .PathDirection .[!a!] -> .[!a!]
moveStrictListIdx i dir xs
| i < 0 || i > (LLength xs - 1) = abort ("Index " +++ toString i +++ " out of bounds")
| otherwise = ListToStrictList (msl dir (splitAt i (StrictListToList xs)))
where msl PathUp ([], xs) = xs
msl PathUp (xs, [x:ys]) = (init xs) ++ [x : (last xs) : ys]
msl PathDown ([], [x:y:ys]) = [y:x:ys]
msl PathDown (xs, []) = xs
msl PathDown (xs, [y]) = xs ++ [y]
msl PathDown (xs, [x:y:ys]) = xs ++ [y:x:ys]
msl PathTop (xs, []) = xs
msl PathTop (xs, [y:ys]) = [y:xs] ++ ys
msl PathBottom (xs, []) = xs
msl PathBottom (xs, [y:ys]) = xs ++ ys ++ [y]
where msl MovePathUp ([], xs) = xs
msl MovePathUp (xs, [x:ys]) = (init xs) ++ [x : (last xs) : ys]
msl MovePathDown ([], [x:y:ys]) = [y:x:ys]
msl MovePathDown (xs, []) = xs
msl MovePathDown (xs, [y]) = xs ++ [y]
msl MovePathDown (xs, [x:y:ys]) = xs ++ [y:x:ys]
msl MovePathTop (xs, []) = xs
msl MovePathTop (xs, [y:ys]) = [y:xs] ++ ys
msl MovePathBottom (xs, []) = xs
msl MovePathBottom (xs, [y:ys]) = xs ++ ys ++ [y]
/**
* Execute module-related actions
*/
doModuleAction :: .String .String .ModuleAction *World -> .World
doModuleAction cleanhome mn (CreateModule mt) world
doModuleAction :: .String !.String !.ModuleAction !*World -> .World
doModuleAction _ mn (CreateModule mt) world
# (dclexists, world) = fileExists dclnm world
| dclexists = dexerr world
| dclexists = error ("Definition module '" +++ dclnm +++ "' already exists.") world
# (iclexists, world) = fileExists iclnm world
| iclexists = iexerr world
| iclexists = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
= writeMods mt world
where basenm = dropExtension mn
dclnm = addExtension basenm "dcl"
......@@ -242,9 +290,6 @@ doModuleAction cleanhome mn (CreateModule mt) world
| isError me = error errmsg world
= world
dexerr world = error ("Definition module '" +++ dclnm +++ "' already exists.") world
iexerr world = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
doModuleAction _ _ _ world =
help "cpm module <modulename> <action>"
[ "Where <action> is one of the following"
......@@ -253,7 +298,7 @@ doModuleAction _ _ _ world =
/**
* Show an error message
*/
error :: String *World -> .World
error :: !String !*World -> .World
error message world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
......@@ -275,14 +320,11 @@ help cmd lines world = showLines lines` world
*/
showLines :: ![String] !*World -> *World
showLines lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (console, world) = stdio world
# console = seqSt (\s -> fwrites (s +++ "\n")) lines console
= snd $ fclose console world
// TODO: Use the version from BatchBuild
pinit :: .Bool *GeneralSt -> *GeneralSt
pinit force_rebuild ps
= BringProjectUptoDate force_rebuild cleanup ps
where
cleanup exepath bool1 bool2 ps
= abortLog False "" ps
pinit :: !.Bool !*GeneralSt -> *GeneralSt
pinit force_rebuild gst = BringProjectUptoDate force_rebuild cleanup gst
where cleanup exepath bool1 bool2 ps = abortLog False "" ps
cpm/Parser.dcl
View file @ 00a354d3
......@@ -8,7 +8,7 @@ import AbsSyn
/**
* Clean Platform imports
*/
from ParserCombinators import :: Parser, :: CParser, :: ParsResult, :: AltCont, :: XorCont, :: SucCont
from Text.ParserCombinators import :: Parser, :: CParser, :: ParsResult, :: AltCont, :: XorCont, :: SucCont
/**
......
cpm/Parser.icl
View file @ 00a354d3
......@@ -13,7 +13,8 @@ import PmEnvironment
/**
* Clean Platform imports
*/
import List, Maybe, ParserCombinators
import Data.List, Data.Maybe
import Text.ParserCombinators
/**
* Clean libraries imports
......@@ -30,7 +31,13 @@ pNotSpace = sp (<+> (satisfy (not o isWhite)))
* Top-level parser for CPM commands
*/
pCpm :: CParser Char CpmAction a
pCpm = pProject <|> pModule <!> (yield CpmHelp)
pCpm = pMake <|> pProject <|> pModule <!> (yield CpmHelp)
/**
* Parse the make command
*/
pMake :: CParser Char CpmAction a
pMake = spstrtok "make" <@ const CpmMake
/**
* Wrapper around the token parser that converts a Clean string to a list of
......@@ -39,27 +46,37 @@ pCpm = pProject <|> pModule <!> (yield CpmHelp)
spstrtok :: (String -> CParser Char [Char] a)
spstrtok = sptoken o fromString
/**
* Parser for boolean values
*/ // TODO: REmove?
//pBool :: CParser Char Bool a
//pBool = pConstCtr [("true", True), ("True", True), ("false", False), ("False", False)]
/**
* Parser for the project commands
*/
pProject :: CParser Char CpmAction a
pProject = spstrtok "project" &> (pProjectWithName <!> yield (Project "" ProjectHelp))
where pProjectWithName = pNotSpace <&> \pn -> pProjectAction <@ Project (toString pn)
pProjectAction = (spstrtok "create" <@ const CreateProject)
<|> (spstrtok "show" <@ const ShowProject)
<|> (spstrtok "build" &> pForce <&> \f -> pIDEEnvs <@ BuildProject f)
<|> (spstrtok "path" &> pPathAction)
//<|> (spstrtok "projectroot" &> pNotSpace <@ SetProjectRoot o toString)
<|> (spstrtok "target" &> identifier <@ SetTarget o toString)
<|> (spstrtok "exec" &> identifier <@ SetExec o toString)
pProjectAction = (spstrtok "create" <@ const CreateProject)
<|> (spstrtok "show" <@ const ShowProject)
<|> (spstrtok "build" &> pForce <&> \f -> pIDEEnvs <@ BuildProject f)
<|> (spstrtok "path" &> pPathAction)
<|> (spstrtok "root" &> pNotSpace <@ SetRelativeRoot o toString)
<|> (spstrtok "target" &> identifier <@ SetTarget o toString)
<|> (spstrtok "exec" &> identifier <@ SetExec o toString)
<!> (pHelp ProjectHelp)
/**
* Parser for the environment commands
*/
pEnvironment :: CParser Char CpmAction a
pEnvironment = spstrtok "environment" &> pEnvironmentAction <@ Environment
where pEnvironmentAction = (spstrtok "list" <@ const ListEnvironments)
<|> (spstrtok "import" &> pNotSpace <@ ImportEnvironment o toString)
<|> (spstrtok "create" &> identifier <@ CreateEnvironment o toString)
<|> (spstrtok "remove" &> identifier <@ RemoveEnvironment o toString)
<|> (spstrtok "show" &> identifier <@ ShowEnvironment o toString)
<|> (spstrtok "export" &> identifier <@ ExportEnvironment o toString)
<|> (spstrtok "rename" &> identifier <&> \en -> identifier <@ RenameEnvironment (toString en) o toString)
<|> (spstrtok "setcompiler" &> identifier <&> \en -> identifier <@ SetEnvironmentCompiler (toString en) o toString)
<|> (spstrtok "setcodegen" &> identifier <&> \en -> identifier <@ SetEnvironmentCodeGen (toString en) o toString)
<!> (pHelp EnvironmentHelp)
/**
* Parser for all path-related actions
*/
......@@ -71,7 +88,8 @@ pPathAction = pPathAction <@ ProjectPath
<|> (spstrtok "move" &> pPathDirection)
<!> (pHelp PathHelp)
pPathDirection = sp nat <&> \i -> pConstCtr dirOpts <@ MovePathAction i
dirOpts = [("up", PathUp), ("down", PathDown), ("top", PathTop), ("bottom", PathBottom)]
dirOpts = [ ("up", MovePathUp), ("down", MovePathDown)
, ("top", MovePathTop), ("bottom", MovePathBottom)]
/**
* Parser for constant mappings between text and constructors
......
Supports Markdown
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