all: fixes for new evaluator

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 "`"]))

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")
+    (do
+      (eval (list 'use (car names)))
       (if (= (length names) 1)
-      (list (list 'use (car names)))
-      (cons (list 'use (car names)) (use-all-fn (cdr names))))));(use-all (cdr names))))))
+        ()
+        (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)))

core/SDLHelper.h

@@ -1,4 +1,4 @@
-#include <SDL.h>
+#include <SDL2/SDL.h>
 
 // Event
 SDL_Event SDL_Event_init() {

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)
 

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))

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

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))