mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
eval: refactor file, line, and column; Debug: better trace
This commit is contained in:
parent
e8db8aabe3
commit
76d86f13e1
@ -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")
|
||||
|
@ -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)))
|
||||
|
43
src/Eval.hs
43
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)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user