Implement load-stack.

app/Main.hs

@@ -71,6 +71,7 @@ defaultProject =
           , projectForceReload = False
           , projectPkgConfigFlags = []
           , projectCModules = []
+          , projectLoadStack = []
           }
 
 -- | Starting point of the application.

core/Dynamic.carp

@@ -50,8 +50,13 @@
     (add-cflag (pkg-config pkg "--cflags"))
     (add-lib (pkg-config pkg "--libs"))))
 
-(defndynamic add-c [relpath]
-  (eval (list 'Project.config "cmod"
-              (Dynamic.String.concat [(Dynamic.String.absolute (Dynamic.String.directory (file)))
+(defndynamic current-file []
+  (car (Project.get-config "load-stack")))
+
+(defndynamic relative-to [path relpath]
+  (Dynamic.String.concat [(Dynamic.Path.directory path)
                           "/"
-                                      relpath]))))
+                          relpath]))
+
+(defndynamic add-c [relpath]
+  (Project.config "cmod" (relative-to (current-file) relpath)))

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

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

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    "

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 =

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"))

test/csquare.c

@@ -0,0 +1,3 @@
+int csquare(int a) {
+    return a * a;
+}

test/csquare.h

@@ -0,0 +1 @@
+int csquare(int);