mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Fixed: 'assert' macro. Also -- reporting of errors in expanded macros now works.
This commit is contained in:
parent
b55bdd8e38
commit
9d36c9e220
@ -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))))
|
||||
|
@ -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)))
|
||||
|
@ -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)))
|
||||
|
16
src/Eval.hs
16
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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user