diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 81712f96..6311e487 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1657,7 +1657,7 @@ :env - the environment to compile against - default is the current env\n\t :source - string path of source for better errors - default is \"\"\n\t :on-compile-error - callback when compilation fails - default is bad-compile\n\t - :compile-only - only compile the source, do not execute it - default is false\n\t + :evaluator - callback that executes thunks. Signature is (evaluator thunk source env where)\n\t :on-status - callback when a value is evaluated - default is debug/stacktrace\n\t :fiber-flags - what flags to wrap the compilation fiber with. Default is :ia.\n\t :expander - an optional function that is called on each top level form before being compiled." @@ -1669,15 +1669,15 @@ :on-compile-error on-compile-error :on-parse-error on-parse-error :fiber-flags guard - :compile-only compile-only + :evaluator evaluator :source where :expander expand} opts) (default env (fiber/getenv (fiber/current))) (default chunks (fn [buf p] (getline "" buf))) - (default compile-only false) (default onstatus debug/stacktrace) (default on-compile-error bad-compile) (default on-parse-error bad-parse) + (default evaluator (fn evaluate [x &] (x))) (default where "") # Are we done yet? @@ -1695,7 +1695,7 @@ (fn [] (def res (compile source env where)) (if (= (type res) :function) - (unless compile-only (res)) + (evaluator res source env where) (do (set good false) (def {:error err :line line :column column :fiber errf} res) @@ -1890,7 +1890,8 @@ (def {:exit exit-on-error :source source :env env - :compile-only compile-only} (table ;args)) + :expander expander + :evaluator evaluator} (table ;args)) (def f (if (= (type path) :core/file) path (file/open path :rb))) @@ -1913,7 +1914,8 @@ (when (not= (fiber/status f) :dead) (debug/stacktrace f x) (if exit-on-error (os/exit 1)))) - :compile-only compile-only + :evaluator evaluator + :expander expander :source (or source (if (= f path) "" path))}) (when (not= f path) (file/close f)) env) diff --git a/src/core/compile.c b/src/core/compile.c index 1929298d..e6b9de64 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -454,7 +454,6 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) { break; case JANET_CFUNCTION: case JANET_ABSTRACT: - case JANET_NIL: break; case JANET_KEYWORD: if (min_arity == 0) { diff --git a/src/mainclient/init.janet b/src/mainclient/init.janet index 4030ca1e..5892aa65 100644 --- a/src/mainclient/init.janet +++ b/src/mainclient/init.janet @@ -63,6 +63,21 @@ (def h (get handlers n)) (if h (h i) (do (print "unknown flag -" n) ((get handlers "h"))))) + (def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true}) + (def- importers {'import true 'import* true 'use true 'dofile true 'require true}) + (defn- evaluator + [thunk source env where] + (if *compile-only* + (when (tuple? source) + (cond + (safe-forms (source 0)) (thunk) + (importers (source 0)) + (do + (let [[l c] (tuple/sourcemap source) + newtup (tuple/setmap (tuple ;source :evaluator evaluator) l c)] + ((compile newtup env where)))))) + (thunk))) + # Process arguments (var i 0) (def lenargs (length args)) @@ -72,7 +87,7 @@ (+= i (dohandler (string/slice arg 1 2) i)) (do (set *no-file* false) - (dofile arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*) + (dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator) (set i lenargs)))) (when (and (not *compile-only*) (or *should-repl* *no-file*))