diff --git a/app/Main.hs b/app/Main.hs index 77c83efe..75ea0935 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -70,6 +70,8 @@ defaultProject = , projectGenerateOnly = False , projectForceReload = False , projectPkgConfigFlags = [] + , projectCModules = [] + , projectLoadStack = [] } -- | Starting point of the application. diff --git a/core/Dynamic.carp b/core/Dynamic.carp index 2e4f1f2d..504b2ddf 100644 --- a/core/Dynamic.carp +++ b/core/Dynamic.carp @@ -49,3 +49,14 @@ (do (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] + (Project.config "cmod" (relative-to (current-file) relpath))) diff --git a/src/Commands.hs b/src/Commands.hs index 0214f05f..361a41d1 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -10,6 +10,7 @@ import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..)) import System.Info (os) import System.Process (callCommand, spawnCommand, waitForProcess) import System.IO (openFile, hPutStr, hClose, utf8, hSetEncoding, IOMode(..)) +import System.Directory (makeAbsolute) import qualified Data.Map as Map import Parsing @@ -90,6 +91,8 @@ commandProjectConfig ctx [xobj@(XObj (Str key) _ _), value] = do return (proj { projectLibFlags = addIfNotPresent libflag (projectLibFlags proj) }) "pkgconfigflag" -> do pkgconfigflag <- unwrapStringXObj value return (proj { projectPkgConfigFlags = addIfNotPresent pkgconfigflag (projectPkgConfigFlags proj) }) + "cmod" -> do cmod <- unwrapStringXObj value + return (proj { projectCModules = addIfNotPresent cmod (projectCModules proj) }) "prompt" -> do prompt <- unwrapStringXObj value return (proj { projectPrompt = prompt }) "search-path" -> do searchPath <- unwrapStringXObj value @@ -148,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 @@ -226,8 +230,9 @@ commandBuild shutUp ctx args = do do let compiler = projectCompiler proj echoCompilationCommand = projectEchoCompilationCommand proj incl = projectIncludesToC proj - includeCorePath = " -I" ++ projectCarpDir proj ++ "/core/ " - flags = includeCorePath ++ projectFlags proj + includeCorePath = projectCarpDir proj ++ "/core/ " + cModules = projectCModules proj + flags = projectFlags proj outDir = projectOutDir proj outMain = outDir "main.c" outExe = outDir projectTitle proj @@ -240,7 +245,14 @@ commandBuild shutUp ctx args = do hClose outputHandle if generateOnly then return (ctx, dynamicNil) else case Map.lookup "main" (envBindings env) of - Just _ -> do let cmd = compiler ++ " " ++ outMain ++ " -o \"" ++ outExe ++ "\" " ++ flags + Just _ -> do let cmd = joinWithSpace $ [ compiler + , "-o" + , outExe + , "-I" + , includeCorePath + , flags + , outMain + ] ++ cModules liftIO $ do when echoCompilationCommand (putStrLn cmd) callCommand cmd when (execMode == Repl && not shutUp) (putStrLn ("Compiled to '" ++ outExe ++ "' (executable)")) @@ -381,6 +393,7 @@ commandHelp ctx [XObj(Str "interop") _ _] = putStrLn "(local-include ) - Include a local header file." putStrLn "(add-cflag ) - Add a cflag to the compilation step." putStrLn "(add-lib ) - Add a library flag to the compilation step." + putStrLn "(add-c ) - Add a C/ObjC/C++ module to the compilation step." return (ctx, dynamicNil) commandHelp ctx [XObj(Str "project") _ _] = @@ -389,6 +402,7 @@ commandHelp ctx [XObj(Str "project") _ _] = putStrLn "'cflag' - Add a flag to the compiler." putStrLn "'libflag' - Add a library flag to the compiler." putStrLn "'pkgconfigflag' - Add a flag to pkg-config invocations." + putStrLn "'cmod' - Add a C/ObjC/C++ module to the compiler invocation." putStrLn "'compiler' - Set what compiler should be run with the 'build' command." putStrLn "'title' - Set the title of the current project, will affect the name of the binary produced." putStrLn "'output-directory' - Where to put compiler artifacts, etc." @@ -739,13 +753,21 @@ 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) +commandPathAbsolute :: CommandCallback +commandPathAbsolute ctx [a] = + case a of + XObj (Str s) _ _ -> do + abs <- makeAbsolute s + pure $ (ctx, Right (XObj (Str abs) (Just dummyInfo) (Just StringTy))) + _ -> pure $ evalError ctx ("Can't call `absolute` with " ++ pretty a) (info a) + commandPlus :: CommandCallback commandPlus ctx [a, b] = return $ case (a, b) of diff --git a/src/Eval.hs b/src/Eval.hs index 875bce70..0591a439 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -641,9 +641,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 diff --git a/src/Project.hs b/src/Project.hs index df3d4fcd..7e5eac63 100644 --- a/src/Project.hs +++ b/src/Project.hs @@ -33,6 +33,8 @@ data Project = Project { projectTitle :: String , projectGenerateOnly :: Bool , 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 @@ -68,6 +70,8 @@ instance Show Project where , "Generate Only: " ++ showB projectGenerateOnly , "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 e016d96a..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,7 +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\"" ] -- | A submodule of the Dynamic module. Contains functions for working with symbols in the repl or during compilation. @@ -301,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);