From 134d9a5b02ce91c53ad61262d3758d85443239a4 Mon Sep 17 00:00:00 2001 From: Jorge Acereda Date: Sun, 28 Jun 2020 19:53:43 +0200 Subject: [PATCH] Implement load-stack. --- app/Main.hs | 1 + core/Dynamic.carp | 13 +++++++++---- src/Commands.hs | 9 +++++---- src/Eval.hs | 13 ++++++++----- src/Project.hs | 2 ++ src/StartingEnv.hs | 16 ++++++++++++++-- test/add-c.carp | 9 +++++++++ test/csquare.c | 3 +++ test/csquare.h | 1 + 9 files changed, 52 insertions(+), 15 deletions(-) create mode 100644 test/add-c.carp create mode 100644 test/csquare.c create mode 100644 test/csquare.h diff --git a/app/Main.hs b/app/Main.hs index 2d9da28f..75ea0935 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -71,6 +71,7 @@ defaultProject = , projectForceReload = False , projectPkgConfigFlags = [] , projectCModules = [] + , projectLoadStack = [] } -- | Starting point of the application. diff --git a/core/Dynamic.carp b/core/Dynamic.carp index 08feec5e..504b2ddf 100644 --- a/core/Dynamic.carp +++ b/core/Dynamic.carp @@ -50,8 +50,13 @@ (add-cflag (pkg-config pkg "--cflags")) (add-lib (pkg-config pkg "--libs")))) +(defndynamic current-file [] + (car (Project.get-config "load-stack"))) + +(defndynamic relative-to [path relpath] + (Dynamic.String.concat [(Dynamic.Path.directory path) + "/" + relpath])) + (defndynamic add-c [relpath] - (eval (list 'Project.config "cmod" - (Dynamic.String.concat [(Dynamic.String.absolute (Dynamic.String.directory (file))) - "/" - relpath])))) + (Project.config "cmod" (relative-to (current-file) relpath))) diff --git a/src/Commands.hs b/src/Commands.hs index a239d31a..361a41d1 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -151,6 +151,7 @@ commandProjectGetConfig ctx [xobj@(XObj (Str key) _ _)] = "cflag" -> Right $ Str $ show $ projectCFlags proj "libflag" -> Right $ Str $ show $ projectLibFlags proj "pkgconfigflag" -> Right $ Arr $ xstr . Str <$> projectPkgConfigFlags proj + "load-stack" -> Right $ Arr $ xstr . Str <$> projectLoadStack proj "prompt" -> Right $ Str $ projectPrompt proj "search-path" -> Right $ Str $ show $ projectCarpSearchPaths proj "print-ast" -> Right $ Bol $ projectPrintTypedAST proj @@ -752,15 +753,15 @@ simpleFromNum (Num IntTy num) = show (round num :: Int) simpleFromNum (Num LongTy num) = show (round num :: Int) simpleFromNum (Num _ num) = show num -commandStringDirectory :: CommandCallback -commandStringDirectory ctx [a] = +commandPathDirectory :: CommandCallback +commandPathDirectory ctx [a] = return $ case a of XObj (Str s) _ _ -> (ctx, Right (XObj (Str (takeDirectory s)) (Just dummyInfo) (Just StringTy))) _ -> evalError ctx ("Can't call `directory` with " ++ pretty a) (info a) -commandStringAbsolute :: CommandCallback -commandStringAbsolute ctx [a] = +commandPathAbsolute :: CommandCallback +commandPathAbsolute ctx [a] = case a of XObj (Str s) _ _ -> do abs <- makeAbsolute s diff --git a/src/Eval.hs b/src/Eval.hs index 6658514a..b06f5907 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -638,9 +638,14 @@ loadInternal ctx xobj path i reloadMode = do files' = if canonicalPath `elem` (map fst files) then files else files ++ [(canonicalPath, reloadMode)] - proj' = proj { projectFiles = files', projectAlreadyLoaded = canonicalPath : alreadyLoaded } + prevStack = projectLoadStack proj + proj' = proj { projectFiles = files' + , projectAlreadyLoaded = canonicalPath : alreadyLoaded + , projectLoadStack = canonicalPath : prevStack + } newCtx <- liftIO $ executeString True False (ctx { contextProj = proj' }) contents canonicalPath - return (newCtx, dynamicNil) + + return (newCtx { contextProj = (contextProj newCtx) { projectLoadStack = prevStack } }, dynamicNil) where frozenPaths proj = if projectForceReload proj @@ -702,9 +707,7 @@ loadInternal ctx xobj path i reloadMode = do _ <- liftIO $ setCurrentDirectory cur doGitLoad path fpath else do - _ <- liftIO $ readProcessWithExitCode "git" ["init"] "" - _ <- liftIO $ readProcessWithExitCode "git" ["remote", "add", "origin", path] "" - (x0, _, stderr0) <- liftIO $ readProcessWithExitCode "git" ["fetch", "--all", "--tags"] "" + (x0, _, stderr0) <- liftIO $ readProcessWithExitCode "git" ["clone", "--recurse-submodules", path, "."] "" case x0 of ExitFailure _ -> do _ <- liftIO $ setCurrentDirectory cur diff --git a/src/Project.hs b/src/Project.hs index fd6e89bf..7e5eac63 100644 --- a/src/Project.hs +++ b/src/Project.hs @@ -34,6 +34,7 @@ data Project = Project { projectTitle :: String , projectBalanceHints :: Bool , projectForceReload :: Bool -- Setting this to true will make the `load-once` command work just like `load`. , projectCModules :: [FilePath] + , projectLoadStack :: [FilePath] } projectFlags :: Project -> String @@ -70,6 +71,7 @@ instance Show Project where , "Balance Hints: " ++ showB projectBalanceHints , "Force Reload: " ++ showB projectForceReload , "C modules:\n " ++ joinIndented projectCModules + , "Load stack:\n "++ joinIndented projectLoadStack ] where showB b = if b then "true" else "false" joinIndented = joinWith "\n " diff --git a/src/StartingEnv.hs b/src/StartingEnv.hs index f4cb4dfe..1b286bbc 100644 --- a/src/StartingEnv.hs +++ b/src/StartingEnv.hs @@ -254,6 +254,7 @@ dynamicModule = Env { envBindings = bindings ++ [("String", Binder emptyMeta (XObj (Mod dynamicStringModule) Nothing Nothing)) ,("Symbol", Binder emptyMeta (XObj (Mod dynamicSymModule) Nothing Nothing)) ,("Project", Binder emptyMeta (XObj (Mod dynamicProjectModule) Nothing Nothing)) + ,("Path", Binder emptyMeta (XObj (Mod dynamicPathModule) Nothing Nothing)) ] -- | A submodule of the Dynamic module. Contains functions for working with strings in the repl or during compilation. @@ -270,8 +271,6 @@ dynamicStringModule = Env { envBindings = bindings , addCommand (SymPath path "slice") 3 commandSubstring "creates a substring from a beginning index to an end index." "(String.slice \"hello\" 1 3) ; => \"ell\"" , addCommand (SymPath path "length") 1 commandStringLength "gets the length of a string." "(String.length \"hi\") ; => 2" , addCommand (SymPath path "concat") 1 commandStringConcat "concatenates a list of strings together." "(String.concat [\"hi \" \"there\"]) ; => \"hi there\"" - , addCommand (SymPath path "directory") 1 commandStringDirectory "takes the basename of a string taken to be a filepath.\n\nHistorical note: this is a command because it used to power one of the `include` macros." "(String.directory \"dir/file\") ; => \"dir\"" - , addCommand (SymPath path "absolute") 1 commandStringAbsolute "converts a filepath to absolute." "(String.absolute \"dir/file\") ; => \"/home/foo/dir/file\"" ] -- | A submodule of the Dynamic module. Contains functions for working with symbols in the repl or during compilation. @@ -302,6 +301,19 @@ dynamicProjectModule = Env { envBindings = bindings , addCommand (SymPath path "get-config") 1 commandProjectGetConfig "gets a project config value under a key." "(Project.get-config \"paren-balance-hints\")" ] +-- | A submodule of the Dynamic module. Contains functions for working with paths. +dynamicPathModule :: Env +dynamicPathModule = Env { envBindings = bindings + , envParent = Nothing + , envModuleName = Just "Path" + , envUseModules = [] + , envMode = ExternalEnv + , envFunctionNestingLevel = 0 } + where path = ["Dynamic", "Path"] + bindings = Map.fromList [ addCommand (SymPath path "directory") 1 commandPathDirectory "takes the basename of a string taken to be a filepath.\n\nHistorical note: this is a command because it used to power one of the `include` macros." "(String.directory \"dir/file\") ; => \"dir\"" + , addCommand (SymPath path "absolute") 1 commandPathAbsolute "converts a filepath to absolute." "(String.absolute \"dir/file\") ; => \"/home/foo/dir/file\"" + ] + -- | The global environment before any code is run. startingGlobalEnv :: Bool -> Env startingGlobalEnv noArray = diff --git a/test/add-c.carp b/test/add-c.carp new file mode 100644 index 00000000..994ae58c --- /dev/null +++ b/test/add-c.carp @@ -0,0 +1,9 @@ +(load "Test.carp") +(use Test) +(add-c "csquare.c") + +(relative-include "csquare.h") +(register csquare (Fn [Int] Int)) + +(deftest test + (assert-equal test (csquare 2) 4 "add-c works")) diff --git a/test/csquare.c b/test/csquare.c new file mode 100644 index 00000000..45162ccb --- /dev/null +++ b/test/csquare.c @@ -0,0 +1,3 @@ +int csquare(int a) { + return a * a; +} diff --git a/test/csquare.h b/test/csquare.h new file mode 100644 index 00000000..94d86fa4 --- /dev/null +++ b/test/csquare.h @@ -0,0 +1 @@ +int csquare(int);