mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Implement load-stack.
This commit is contained in:
parent
0d7533e887
commit
134d9a5b02
@ -71,6 +71,7 @@ defaultProject =
|
||||
, projectForceReload = False
|
||||
, projectPkgConfigFlags = []
|
||||
, projectCModules = []
|
||||
, projectLoadStack = []
|
||||
}
|
||||
|
||||
-- | Starting point of the application.
|
||||
|
@ -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)))
|
||||
|
@ -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
|
||||
|
13
src/Eval.hs
13
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
|
||||
|
@ -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 "
|
||||
|
@ -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 =
|
||||
|
9
test/add-c.carp
Normal file
9
test/add-c.carp
Normal file
@ -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"))
|
3
test/csquare.c
Normal file
3
test/csquare.c
Normal file
@ -0,0 +1,3 @@
|
||||
int csquare(int a) {
|
||||
return a * a;
|
||||
}
|
1
test/csquare.h
Normal file
1
test/csquare.h
Normal file
@ -0,0 +1 @@
|
||||
int csquare(int);
|
Loading…
Reference in New Issue
Block a user