eval: refactor file, line, and column; Debug: better trace

core/Debug.carp

@@ -30,10 +30,11 @@
                 ())))
 
   (doc trace "Print the value of an expression to stdout, then return its value.")
-  (defn trace [x]
-    (do
-      (IO.println &(str &x))
-      x))
+  (defmacro trace [x]
+    (list 'let-do (array 'tmp x)
+      (list 'IO.println (list 'ref (list 'fmt "%s:%d:%d: %s" (file x) (line x) (column x) '&(str tmp))))
+      'tmp)
+  )
 
   (doc leak-array "Leak some memory. Useful for testing tools that detect leaks.")
   (register leak-array (Fn [a] ()) "Debug_leak_MINUS_array")

src/Commands.hs

@@ -760,25 +760,3 @@ saveDocs pathsAndEnvs =
          title = projectTitle proj
      liftIO (saveDocsForEnvs docsDir title pathsAndEnvs)
      return dynamicNil
-
-commandFile :: CommandCallback
-commandFile [XObj _ (Just info) _] =
-  return $ Right $ XObj (Str $ infoFile info) (Just dummyInfo) (Just StringTy)
-commandFile [obj] =
-  return (Left (EvalError ("No information about object " ++ pretty obj)))
-
-commandLine :: CommandCallback
-commandLine [XObj _ (Just info) _] =
-  return $ Right $ XObj (Num IntTy (fromIntegral (infoLine info)))
-                        (Just dummyInfo)
-                        (Just IntTy)
-commandLine [obj] =
-  return (Left (EvalError ("No information about object " ++ pretty obj)))
-
-commandColumn :: CommandCallback
-commandColumn [XObj _ (Just info) _] =
-  return $ Right $ XObj (Num IntTy (fromIntegral (infoColumn info)))
-                        (Just dummyInfo)
-                        (Just IntTy)
-commandColumn [obj] =
-  return (Left (EvalError ("No information about object " ++ pretty obj)))

src/Eval.hs

@@ -55,14 +55,43 @@ eval env xobj =
         [XObj (Sym (SymPath [] "quote") _) _ _, target] ->
           return (Right target)
 
-        [XObj (Sym (SymPath [] "source-location") _) _ _] ->
-          return (Right (XObj (Str (prettyInfoFromXObj listXObj)) i t))
+        [XObj (Sym (SymPath [] "file") _) _ _] ->
+          case i of
+            Just info -> return (Right (XObj (Str (infoFile info)) i t))
+            Nothing -> return (Left (EvalError ("No information about object " ++ pretty xobj)))
 
-        [XObj (Sym (SymPath [] "source-path") _) _ _] ->
-          let file = case info listXObj of
-                       Just info -> infoFile info
-                       Nothing -> "no info"
-          in  return (Right (XObj (Str (file)) i t))
+        [XObj (Sym (SymPath [] "line") _) _ _] ->
+          case i of
+            Just info ->
+              return (Right (XObj (Num IntTy (fromIntegral (infoLine info))) i t))
+            Nothing ->
+              return (Left (EvalError ("No information about object " ++ pretty xobj)))
+
+        [XObj (Sym (SymPath [] "column") _) _ _] ->
+          case i of
+            Just info ->
+              return (Right (XObj (Num IntTy (fromIntegral (infoColumn info))) i t))
+            Nothing ->
+              return (Left (EvalError ("No information about object " ++ pretty xobj)))
+
+        [XObj (Sym (SymPath [] "file") _) _ _, XObj _ infoToCheck _] ->
+          case infoToCheck of
+            Just info -> return (Right (XObj (Str (infoFile info)) i t))
+            Nothing -> return (Left (EvalError ("No information about object " ++ pretty xobj)))
+
+        [XObj (Sym (SymPath [] "line") _) _ _, XObj _ infoToCheck _] ->
+          case infoToCheck of
+            Just info ->
+              return (Right (XObj (Num IntTy (fromIntegral (infoLine info))) i t))
+            Nothing ->
+              return (Left (EvalError ("No information about object " ++ pretty xobj)))
+
+        [XObj (Sym (SymPath [] "column") _) _ _, XObj _ infoToCheck _] ->
+          case infoToCheck of
+            Just info ->
+              return (Right (XObj (Num IntTy (fromIntegral (infoColumn info))) i t))
+            Nothing ->
+              return (Left (EvalError ("No information about object " ++ pretty xobj)))
 
         XObj Do _ _ : rest ->
           do evaledList <- fmap sequence (mapM (eval env) rest)

src/StartingEnv.hs

@@ -210,9 +210,6 @@ dynamicModule = Env { envBindings = bindings
                     , addCommand "append" 2 commandAppend
                     , addCommand "macro-error" 1 commandMacroError
                     , addCommand "macro-log" 1 commandMacroLog
-                    , addCommand "file" 1 commandFile
-                    , addCommand "line" 1 commandLine
-                    , addCommand "column" 1 commandColumn
                     , addCommandConfigurable "str" Nothing commandStr
                     , addCommand "not" 1 commandNot
                     , addCommand "=" 2 commandEq