Fixed: 'assert' macro. Also -- reporting of errors in expanded macros now works.

core/Debug.carp

@@ -34,12 +34,15 @@
 
   )
 
+;; HACK! This silences compiler errors about 'source-location' and 'source-path' being undefined.
+;; Actual calls to these special forms will be handled directly in the dynamic evaluator, see 'Eval.hs'.
+(defdynamic source-location [] "")
+(defdynamic source-path [] "")
+
 ;; Crash the program with an error message unless the expression evaluates to 'true'.
 (defmacro assert [expr]
   (list 'if (list '= true expr)
         ()
         (list 'do
-              (list 'IO.println (list 'ref
-                                      (list 'String.append (list 'String.copy "Assertion failed at ")
-                                            (list 'String.copy (source-location)))))
+              (list 'println* "Assertion '" (str expr) "' failed at " (list 'source-location))
               '(System.exit 1))))

examples/temp.carp

@@ -2,10 +2,5 @@
 ;; (Debug.sanitize-addresses)
 ;; (Project.config "print-ast" true)
 
-;; (defmacro asserts []
-;;   (list ))
-
-;; (list 'defn 'f [] (list 'copy (list 'source-path)))
-
 (defn main []
-  (assert false))
+  (assert (= 2 3)))

src/Commands.hs

@@ -637,3 +637,8 @@ commandMul [a, b] =
       else Left (EvalError ("Can't call * with " ++ pretty a ++ " and " ++ pretty b))
     _ ->
       Left (EvalError ("Can't call * with " ++ pretty a ++ " and " ++ pretty b))
+
+-- | TODO: Allow varargs
+commandStr :: CommandCallback
+commandStr [x] =
+  return (Right (XObj (Str (pretty x)) (Just dummyInfo) (Just StringTy)))

src/Eval.hs

@@ -57,7 +57,7 @@ eval env xobj =
         [XObj (Sym (SymPath [] "source-path") _) _ _] ->
           let file = case info listXObj of
                        Just info -> infoFile info
-                       Nothing -> ""
+                       Nothing -> "no info"
           in  return (Right (XObj (Str (file)) i t))
 
         XObj Do _ _ : rest ->
@@ -235,8 +235,12 @@ eval env xobj =
 
                        Right (XObj (Lst [XObj Macro _ _, _, XObj (Arr params) _ _, body]) _ _) ->
                          case checkMatchingNrOfArgs f params args of
-                           Left err -> return (Left err)
-                           Right () -> apply env body params args
+                           Left err ->
+                             return (Left err)
+                           Right () ->
+                             -- Replace info so that the macro which is called gets the source location info of the expansion site.
+                             let replacedBody = (replaceSourceInfoOnXObj (info xobj) body)
+                             in  apply env replacedBody params args
 
                        Right (XObj (Lst [XObj (Command callback) _ _, _]) _ _) ->
                          do evaledArgs <- fmap sequence (mapM (eval env) args)
@@ -364,11 +368,7 @@ executeCommand ctx@(Context env typeEnv pathStrings proj lastInput execMode) cmd
                    -- to make it stick in the environment.
                    -- To log the intermediate result:
                    -- putStrLnWithColor Yellow ("-> " ++ (pretty evaled))
-
-                   -- Replace info so that macros called at the top-level get the location of the expansion site.
-                   let evaledWithNewInfo = replaceSourceInfoOnXObj (info xobj) evaled
-
-                   (result', newCtx') <- runStateT (eval env evaledWithNewInfo) newCtx
+                   (result', newCtx') <- runStateT (eval env evaled) newCtx
                    case result' of
                      Left e ->
                        do putStrLnWithColor Red (show e)

src/Expand.hs

@@ -4,6 +4,7 @@ import Control.Monad.State.Lazy (StateT(..), runStateT, liftIO, modify, get, put
 import Control.Monad.State
 import Debug.Trace
 
+import Types
 import Obj
 import Util
 import Lookup

src/StartingEnv.hs

@@ -99,6 +99,7 @@ dynamicModule = Env { envBindings = bindings, envParent = Nothing, envModuleName
                     , addCommand "cons-last" 2 commandConsLast
                     , addCommand "append" 2 commandAppend
                     , addCommand "macro-error" 1 commandMacroError
+                    , addCommand "str" 1 commandStr
                     , addCommand "=" 2 commandEq
                     , addCommand "<" 2 commandLt
                     , addCommand ">" 2 commandGt