diff --git a/core/Dynamic.carp b/core/Dynamic.carp index 5b1c382f..90af91bc 100644 --- a/core/Dynamic.carp +++ b/core/Dynamic.carp @@ -32,10 +32,10 @@ ;; The following functions are not put into a module for now: (defndynamic add-cflag [flag] - (Project.config "cflag" flag)) + (eval (list 'Project.config "cflag" flag))) (defndynamic add-lib [lib] - (Project.config "libflag" lib)) + (eval (list 'Project.config "libflag" lib))) (defndynamic pkg-config [pkg flags] (Dynamic.String.join ["`pkg-config " pkg " " flags "`"])) diff --git a/core/Macros.carp b/core/Macros.carp index 02feca2d..ac98cf85 100644 --- a/core/Macros.carp +++ b/core/Macros.carp @@ -224,38 +224,40 @@ (defmacro mac-only [:rest forms] (if (= "darwin" (os)) - (cons (quote do) forms) + (eval (cons (quote do) forms)) ())) (defmacro linux-only [:rest forms] (if (= "linux" (os)) - (cons (quote do) forms) + (eval (cons (quote do) forms)) ())) (defmacro windows-only [:rest forms] (if (Dynamic.or (= "windows" (os)) (= "mingw32" (os))) - (cons (quote do) forms) + (eval (cons (quote do) forms)) ())) (defmacro not-on-windows [:rest forms] (if (not (Dynamic.or (= "windows" (os)) (= "mingw32" (os)))) - (cons (quote do) forms) + (eval (cons (quote do) forms)) ())) (defndynamic use-all-fn [names] (if (= (length names) 0) (macro-error "Trying to call use-all without arguments") - (if (= (length names) 1) - (list (list 'use (car names))) - (cons (list 'use (car names)) (use-all-fn (cdr names))))));(use-all (cdr names)))))) + (do + (eval (list 'use (car names))) + (if (= (length names) 1) + () + (use-all-fn (cdr names)))))) (defmacro use-all [:rest names] - (cons 'do (use-all-fn names))) + (use-all-fn names)) (defmacro load-and-use [name] - (list 'do - (list 'load (str name ".carp")) - (list 'use name))) + (do + (eval (list 'load (str name ".carp"))) + (eval (list 'use name)))) (defmacro when [condition form] (list 'if condition form (list))) diff --git a/core/SDLHelper.h b/core/SDLHelper.h index 01431604..994641db 100644 --- a/core/SDLHelper.h +++ b/core/SDLHelper.h @@ -1,4 +1,4 @@ -#include +#include // Event SDL_Event SDL_Event_init() { diff --git a/src/Commands.hs b/src/Commands.hs index 3cbb54f0..51842c75 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -119,7 +119,7 @@ commandProjectConfig ctx [xobj@(XObj (Str key) _ _), value] = do _ -> Left ("Project.config can't understand the key '" ++ key ++ "' at " ++ prettyInfoFromXObj xobj ++ ".") case newProj of Left errorMessage -> presentError ("[CONFIG ERROR] " ++ errorMessage) (ctx, dynamicNil) - Right ok -> return (ctx, dynamicNil) + Right ok -> return (ctx {contextProj=ok}, dynamicNil) commandProjectConfig ctx [faultyKey, _] = presentError ("First argument to 'Project.config' must be a string: " ++ pretty faultyKey) (ctx, dynamicNil) diff --git a/src/Eval.hs b/src/Eval.hs index 86e17445..7963dcfb 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -816,6 +816,26 @@ primitiveEval _ ctx [val] = do Left err -> return (newCtx, Left err) Right ok -> eval newCtx ok +dynamicOrMacro :: Context -> Obj -> Ty -> String -> XObj -> XObj -> IO (Context, Either EvalError XObj) +dynamicOrMacro ctx pat ty name params body = do + (ctx', exp) <- macroExpand ctx body + case exp of + Right expanded -> + dynamicOrMacroWith ctx' (\path -> [XObj pat Nothing Nothing, XObj (Sym path Symbol) Nothing Nothing, params, expanded]) ty name body + Left err -> return (ctx, exp) + +primitiveDefndynamic :: Primitive +primitiveDefndynamic _ ctx [XObj (Sym (SymPath [] name) _) _ _, params, body] = + dynamicOrMacro ctx Dynamic DynamicTy name params body +primitiveDefndynamic _ ctx [notName, params, body] = + argumentErr ctx "defndynamic" "a name" "first" notName + +primitiveDefmacro :: Primitive +primitiveDefmacro _ ctx [XObj (Sym (SymPath [] name) _) _ _, params, body] = + dynamicOrMacro ctx Macro MacroTy name params body +primitiveDefmacro _ ctx [notName, params, body] = + argumentErr ctx "defmacro" "a name" "first" notName + primitives :: Map.Map SymPath Primitive primitives = Map.fromList [ makePrim "quote" 1 "(quote x) ; where x is an actual symbol" (\_ ctx [x] -> return (ctx, Right x)) diff --git a/src/Primitives.hs b/src/Primitives.hs index 8f39ef34..47defae0 100644 --- a/src/Primitives.hs +++ b/src/Primitives.hs @@ -259,22 +259,6 @@ dynamicOrMacroWith ctx producer ty name body = do meta = existingMeta globalEnv elem return (ctx { contextGlobalEnv = envInsertAt globalEnv path (Binder meta elem) }, dynamicNil) -dynamicOrMacro :: Context -> Obj -> Ty -> String -> XObj -> XObj -> IO (Context, Either EvalError XObj) -dynamicOrMacro ctx pat ty name params body = - dynamicOrMacroWith ctx (\path -> [XObj pat Nothing Nothing, XObj (Sym path Symbol) Nothing Nothing, params, body]) ty name body - -primitiveDefndynamic :: Primitive -primitiveDefndynamic _ ctx [XObj (Sym (SymPath [] name) _) _ _, params, body] = - dynamicOrMacro ctx Dynamic DynamicTy name params body -primitiveDefndynamic _ ctx [notName, params, body] = - argumentErr ctx "defndynamic" "a name" "first" notName - -primitiveDefmacro :: Primitive -primitiveDefmacro _ ctx [XObj (Sym (SymPath [] name) _) _ _, params, body] = - dynamicOrMacro ctx Macro MacroTy name params body -primitiveDefmacro _ ctx [notName, params, body] = - argumentErr ctx "defmacro" "a name" "first" notName - primitiveType :: Primitive primitiveType _ ctx [x@(XObj (Sym path@(SymPath [] name) _) _ _)] = do let env = contextGlobalEnv ctx diff --git a/src/TypeError.hs b/src/TypeError.hs index 9e439326..09b64e30 100644 --- a/src/TypeError.hs +++ b/src/TypeError.hs @@ -399,5 +399,5 @@ makeEvalError ctx err msg info = case info of Just okInfo -> machineReadableInfo fppl okInfo ++ " " ++ msg Nothing -> msg - in (ctx, Left (EvalError messageWhenChecking [] fppl info)) -- Passing no history to avoid appending it at the end in 'show' instance for EvalError + in (ctx, Left (EvalError messageWhenChecking [] fppl Nothing)) -- Passing no history to avoid appending it at the end in 'show' instance for EvalError _ -> (ctx, Left (EvalError msg history fppl info))