mirror of
https://github.com/janet-lang/janet
synced 2024-12-25 07:50:27 +00:00
Many changes for adding dynamic (fiber-level) scope.
- Allow passing a table to fibers, which make fiber level scope easier. - Add fiber/getenv, fiber/setenv, dyn, and setdyn - Remove meta, *env*, and *doc-width* - Some functions changed dignatures, and no longer take an env
This commit is contained in:
Calvin Rose
parent
7527142549
commit
2d7df6b78e
@ -14,5 +14,5 @@
|
||||
(map keys (keys solutions)))
|
||||
|
||||
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
|
||||
(print "3sum of " (string/pretty arr) ":")
|
||||
(print (string/pretty (sum3 arr)))
|
||||
(printf "3sum of %P: " arr)
|
||||
(printf "%P\n" (sum3 arr))
|
||||
|
||||
@ -7,8 +7,6 @@
|
||||
###
|
||||
###
|
||||
|
||||
(var *env* "The current environment." _env)
|
||||
|
||||
(def defn :macro
|
||||
"(def name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
|
||||
(fn defn [name & more]
|
||||
@ -64,14 +62,14 @@
|
||||
"Dynamically create a global def."
|
||||
[name value]
|
||||
(def name* (symbol name))
|
||||
(put *env* name* @{:value value})
|
||||
(setdyn name* @{:value value})
|
||||
nil)
|
||||
|
||||
(defn varglobal
|
||||
"Dynamically create a global var."
|
||||
[name init]
|
||||
(def name* (symbol name))
|
||||
(put *env* name* @{:ref @[init]})
|
||||
(setdyn name* @{:ref @[init]})
|
||||
nil)
|
||||
|
||||
# Basic predicates
|
||||
@ -216,7 +214,7 @@
|
||||
(let [[[err fib]] catch
|
||||
f (gensym)
|
||||
r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,body) :e)
|
||||
~(let [,f (,fiber/new (fn [] ,body) :ie)
|
||||
,r (resume ,f)]
|
||||
(if (= (,fiber/status ,f) :error)
|
||||
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
||||
@ -414,12 +412,12 @@
|
||||
"Create a generator expression using the loop syntax. Returns a fiber
|
||||
that yields all values inside the loop in order. See loop for details."
|
||||
[head & body]
|
||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body))))))
|
||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [] ...body))."
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [] ...body) :yi)."
|
||||
[& body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body)))
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
||||
|
||||
(defn sum
|
||||
"Returns the sum of xs. If xs is empty, returns 0."
|
||||
@ -1068,6 +1066,12 @@
|
||||
(file/close f)
|
||||
nil)
|
||||
|
||||
(defn printf
|
||||
"Print formatted strings to stdout, followed by
|
||||
a new line."
|
||||
[f & args]
|
||||
(file/write stdout (buffer/format @"" f ;args)))
|
||||
|
||||
###
|
||||
###
|
||||
### Pattern Matching
|
||||
@ -1173,15 +1177,11 @@
|
||||
###
|
||||
###
|
||||
|
||||
(var *doc-width*
|
||||
"Width in columns to print documentation."
|
||||
80)
|
||||
|
||||
(defn doc-format
|
||||
"Reformat text to wrap at a given line."
|
||||
[text]
|
||||
|
||||
(def maxcol (- *doc-width* 8))
|
||||
(def maxcol (- (dyn :doc-width 80) 8))
|
||||
(var buf @" ")
|
||||
(var word @"")
|
||||
(var current 0)
|
||||
@ -1217,8 +1217,8 @@
|
||||
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment."
|
||||
[env sym]
|
||||
(def x (get env sym))
|
||||
[sym]
|
||||
(def x (dyn sym))
|
||||
(if (not x)
|
||||
(print "symbol " sym " not found.")
|
||||
(do
|
||||
@ -1241,7 +1241,7 @@
|
||||
(defmacro doc
|
||||
"Shows documentation for the given symbol."
|
||||
[sym]
|
||||
~(,doc* *env* ',sym))
|
||||
~(,doc* ',sym))
|
||||
|
||||
###
|
||||
###
|
||||
@ -1320,7 +1320,7 @@
|
||||
(defn dotup [t]
|
||||
(def h (get t 0))
|
||||
(def s (get specs h))
|
||||
(def entry (or (get *env* h) {}))
|
||||
(def entry (or (dyn h) {}))
|
||||
(def m (entry :value))
|
||||
(def m? (entry :macro))
|
||||
(cond
|
||||
@ -1390,7 +1390,7 @@
|
||||
(defn pp
|
||||
"Pretty print to stdout."
|
||||
[x]
|
||||
(print (buffer/format @"" "%p" x)))
|
||||
(print (buffer/format @"" (dyn :pretty-format "%p") x)))
|
||||
|
||||
###
|
||||
###
|
||||
@ -1436,11 +1436,11 @@
|
||||
opts is a table or struct of options. The options are as follows:\n\n\t
|
||||
:chunks - callback to read into a buffer - default is getline\n\t
|
||||
:on-parse-error - callback when parsing fails - default is bad-parse\n\t
|
||||
:env - the environment to compile against - default is *env*\n\t
|
||||
:env - the environment to compile against - default is the current env\n\t
|
||||
:source - string path of source for better errors - default is \"<anonymous>\"\n\t
|
||||
:on-compile-error - callback when compilation fails - default is bad-compile\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 :a."
|
||||
:fiber-flags - what flags to wrap the compilation fiber with. Default is :ia."
|
||||
[opts]
|
||||
|
||||
(def {:env env
|
||||
@ -1450,7 +1450,7 @@
|
||||
:on-parse-error on-parse-error
|
||||
:fiber-flags guard
|
||||
:source where} opts)
|
||||
(default env *env*)
|
||||
(default env (fiber/getenv (fiber/current)))
|
||||
(default chunks getline)
|
||||
(default onstatus debug/stacktrace)
|
||||
(default on-compile-error bad-compile)
|
||||
@ -1463,7 +1463,7 @@
|
||||
# The parser object
|
||||
(def p (parser/new))
|
||||
|
||||
# Evaluate 1 source form
|
||||
# Evaluate 1 source form in a protected manner
|
||||
(defn eval1 [source]
|
||||
(var good true)
|
||||
(def f
|
||||
@ -1481,13 +1481,11 @@
|
||||
err))
|
||||
(on-compile-error msg errf where))))
|
||||
(or guard :a)))
|
||||
(fiber/setenv f env)
|
||||
(def res (resume f nil))
|
||||
(when good (if going (onstatus f res))))
|
||||
|
||||
(def oldenv *env*)
|
||||
(set *env* env)
|
||||
|
||||
# Run loop
|
||||
# Loop
|
||||
(def buf @"")
|
||||
(while going
|
||||
(buffer/clear buf)
|
||||
@ -1504,21 +1502,18 @@
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(on-parse-error p where))))
|
||||
|
||||
# Check final parser state
|
||||
(while (parser/has-more p)
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(on-parse-error p where))
|
||||
|
||||
(set *env* oldenv)
|
||||
|
||||
env)
|
||||
|
||||
(defn eval-string
|
||||
"Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use run-context."
|
||||
[str &opt env]
|
||||
[str]
|
||||
(var state (string str))
|
||||
(defn chunks [buf _]
|
||||
(def ret state)
|
||||
@ -1527,26 +1522,24 @@
|
||||
(buffer/push-string buf str)
|
||||
(buffer/push-string buf "\n")))
|
||||
(var returnval nil)
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
(run-context {:chunks chunks
|
||||
:on-compile-error (fn [msg errf &]
|
||||
(error (string "compile error: " msg)))
|
||||
:on-parse-error (fn [p x]
|
||||
(error (string "parse error: " (parser/error p))))
|
||||
:fiber-flags :
|
||||
:fiber-flags :i
|
||||
:on-status (fn [f val]
|
||||
(if-not (= (fiber/status f) :dead)
|
||||
(error val))
|
||||
(set returnval val))
|
||||
:source "eval"})
|
||||
:source "eval-string"})
|
||||
returnval)
|
||||
|
||||
(defn eval
|
||||
"Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use run-context."
|
||||
[form &opt env]
|
||||
(default env *env*)
|
||||
(def res (compile form env "eval"))
|
||||
[form]
|
||||
(def res (compile form (fiber/getenv (fiber/current)) "eval"))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
(error (res :error))))
|
||||
@ -1605,7 +1598,7 @@
|
||||
(defn module/find
|
||||
"Try to match a module or path name from the patterns in module/paths.
|
||||
Returns a tuple (fullpath kind) where the kind is one of :source, :native,
|
||||
or image if the module is found, otherise a tuple with nil followed by
|
||||
or image if the module is found, otherwise a tuple with nil followed by
|
||||
an error message."
|
||||
[path]
|
||||
(def parts (string/split "/" path))
|
||||
@ -1684,10 +1677,10 @@
|
||||
env)))
|
||||
|
||||
(defn import*
|
||||
"Import a module into a given environment table. This is the
|
||||
functional form of (import ...) that expects and explicit environment
|
||||
table."
|
||||
[env path & args]
|
||||
"Function form of import. Same parameters, but the path
|
||||
and other symbol parameters should be strings instead."
|
||||
[path & args]
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def {:as as
|
||||
:prefix prefix
|
||||
:export ep} (table ;args))
|
||||
@ -1709,39 +1702,30 @@
|
||||
x
|
||||
(string x)))
|
||||
args))
|
||||
(tuple import* '*env* (string path) ;argm))
|
||||
(tuple import* (string path) ;argm))
|
||||
|
||||
(defn repl
|
||||
"Run a repl. The first parameter is an optional function to call to
|
||||
get a chunk of source code that should return nil for end of file.
|
||||
The second parameter is a function that is called when a signal is
|
||||
caught. fmt is a format string used to print results, and defaults to
|
||||
\"%.20P\""
|
||||
[&opt chunks onsignal fmt]
|
||||
caught."
|
||||
[&opt chunks onsignal]
|
||||
(def newenv (make-env))
|
||||
(default fmt "%.20P")
|
||||
(default onsignal (fn [f x]
|
||||
(case (fiber/status f)
|
||||
:dead (do
|
||||
(put newenv '_ @{:value x})
|
||||
(print (buffer/format @"" fmt x)))
|
||||
(pp x)
|
||||
(put newenv '_ @{:value x}))
|
||||
(debug/stacktrace f x))))
|
||||
(run-context {:env newenv
|
||||
:chunks chunks
|
||||
:on-status onsignal
|
||||
:source "repl"}))
|
||||
|
||||
(defmacro meta
|
||||
"Add metadata to the current environment."
|
||||
[& args]
|
||||
(def opts (table ;args))
|
||||
(loop [[k v] :pairs opts]
|
||||
(put *env* k v)))
|
||||
|
||||
(defn all-bindings
|
||||
"Get all symbols available in the current environment."
|
||||
[&opt env]
|
||||
(default env *env*)
|
||||
[]
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
||||
(def symbol-set @{})
|
||||
@ -1762,12 +1746,12 @@
|
||||
###
|
||||
|
||||
(do
|
||||
|
||||
(def image (let [env-pairs (pairs (env-lookup *env*))
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def image (let [env-pairs (pairs (env-lookup env))
|
||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||
lookup (table ;(mapcat identity essential-pairs))
|
||||
reverse-lookup (invert lookup)]
|
||||
(marshal *env* reverse-lookup)))
|
||||
(marshal env reverse-lookup)))
|
||||
|
||||
# Create C source file that contains images a uint8_t buffer. This
|
||||
# can be compiled and linked statically into the main janet library
|
||||
|
||||
@ -69,6 +69,29 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
return init;
|
||||
}
|
||||
|
||||
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
Janet value;
|
||||
if (janet_vm_fiber->env) {
|
||||
value = janet_table_get(janet_vm_fiber->env, argv[0]);
|
||||
} else {
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
if (argc == 2 && janet_checktype(value, JANET_NIL)) {
|
||||
return argv[1];
|
||||
}
|
||||
return value;
|
||||
}
|
||||
|
||||
static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(2);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, argv[0], argv[1]);
|
||||
return argv[1];
|
||||
}
|
||||
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
@ -419,6 +442,16 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
"dyn", janet_core_dyn,
|
||||
JDOC("(dyn key [, default=nil])\n\n"
|
||||
"Get a dynamic binding. Returns the default value if no binding found.")
|
||||
},
|
||||
{
|
||||
"setdyn", janet_core_setdyn,
|
||||
JDOC("(setdyn key value)\n\n"
|
||||
"Set a dynamic binding. Returns value.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@ -35,6 +35,7 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->stacktop = JANET_FRAME_SIZE;
|
||||
fiber->child = NULL;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD;
|
||||
fiber->env = NULL;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
|
||||
@ -293,6 +294,25 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return fiber->env ?
|
||||
janet_wrap_table(fiber->env) :
|
||||
janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||
fiber->env = NULL;
|
||||
} else {
|
||||
fiber->env = janet_gettable(argv, 1);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
@ -333,6 +353,12 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
case 'y':
|
||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 'i':
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(0);
|
||||
}
|
||||
fiber->env = janet_vm_fiber->env;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -388,7 +414,8 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\te - block error signals\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal")
|
||||
"\t0-9 - block a specific user signal\n"
|
||||
"\ti - inherit the environment from the current fiber")
|
||||
},
|
||||
{
|
||||
"fiber/status", cfun_fiber_status,
|
||||
@ -420,6 +447,18 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.")
|
||||
},
|
||||
{
|
||||
"fiber/getenv", cfun_fiber_getenv,
|
||||
JDOC("(fiber/getenv fiber)\n\n"
|
||||
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||
"set yet.")
|
||||
},
|
||||
{
|
||||
"fiber/setenv", cfun_fiber_setenv,
|
||||
JDOC("(fiber/setenv fiber table)\n\n"
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@ -236,6 +236,9 @@ recur:
|
||||
i = frame->prevframe;
|
||||
}
|
||||
|
||||
if (fiber->env)
|
||||
janet_mark_table(fiber->env);
|
||||
|
||||
/* Explicit tail recursion */
|
||||
if (fiber->child) {
|
||||
fiber = fiber->child;
|
||||
|
||||
@ -249,6 +249,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
}
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 28)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 30)
|
||||
|
||||
/* Marshal a fiber */
|
||||
@ -256,6 +257,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
MARSH_STACKCHECK;
|
||||
int32_t fflags = fiber->flags;
|
||||
if (fiber->child) fflags |= JANET_FIBER_FLAG_HASCHILD;
|
||||
if (fiber->env) fflags |= JANET_FIBER_FLAG_HASENV;
|
||||
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE)
|
||||
janet_panic("cannot marshal alive fiber");
|
||||
pushint(st, fflags);
|
||||
@ -282,6 +284,9 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
j = i - JANET_FRAME_SIZE;
|
||||
i = frame->prevframe;
|
||||
}
|
||||
if (fiber->env) {
|
||||
marshal_one(st, janet_wrap_table(fiber->env), flags + 1);
|
||||
}
|
||||
if (fiber->child)
|
||||
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
|
||||
}
|
||||
@ -837,6 +842,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->maxstack = 0;
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
fiber->env = NULL;
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
janet_array_push(&st->lookup, janet_wrap_fiber(fiber));
|
||||
@ -934,6 +940,15 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
janet_panic("fiber has too many stackframes");
|
||||
}
|
||||
|
||||
/* Check for fiber env */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
|
||||
Janet envv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
fiber->env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
/* Check for child fiber */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
Janet fiberv;
|
||||
|
||||
@ -47,6 +47,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
|
||||
@ -645,6 +645,7 @@ struct JanetFiber {
|
||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||
int32_t capacity;
|
||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||
JanetTable *env; /* Dynamic bindings table (usually current environment). */
|
||||
Janet *data;
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
};
|
||||
|
||||
@ -46,7 +46,7 @@
|
||||
3)
|
||||
"-" (fn [&] (set *handleopts* false) 1)
|
||||
"l" (fn [i &]
|
||||
(import* *env* (get process/args (+ i 1))
|
||||
(import* (get process/args (+ i 1))
|
||||
:prefix "" :exit *exit-on-error*)
|
||||
2)
|
||||
"e" (fn [i &]
|
||||
@ -67,7 +67,7 @@
|
||||
(+= i (dohandler (string/slice arg 1 2) i))
|
||||
(do
|
||||
(set *no-file* false)
|
||||
(import* *env* arg :prefix "" :exit *exit-on-error*)
|
||||
(import* arg :prefix "" :exit *exit-on-error*)
|
||||
(set i lenargs))))
|
||||
|
||||
(when (or *should-repl* *no-file*)
|
||||
@ -86,4 +86,5 @@
|
||||
(defn getchunk [buf p]
|
||||
(getter (prompter p) buf))
|
||||
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||
(repl getchunk onsig (if *colorize* "%.20P" "%.20p"))))
|
||||
(setdyn :pretty-format (if *colorize* "%.20P" "%.20p"))
|
||||
(repl getchunk onsig)))
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
# Copyright 2017-2019 (C) Calvin Rose
|
||||
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
(setdyn :pretty-format "%.20P")
|
||||
|
||||
(fiber/new (fn webrepl []
|
||||
(repl (fn get-line [buf p]
|
||||
|
||||
@ -140,7 +140,7 @@
|
||||
|
||||
# Marshal
|
||||
|
||||
(def um-lookup (env-lookup *env*))
|
||||
(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
|
||||
(def m-lookup (invert um-lookup))
|
||||
|
||||
(defn testmarsh [x msg]
|
||||
@ -182,7 +182,7 @@
|
||||
# Large functions
|
||||
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||
(def f (compile ['do ;manydefs] *env*))
|
||||
(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
|
||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||
|
||||
# Some higher order functions and macros
|
||||
|
||||
@ -49,7 +49,7 @@
|
||||
# Make ast from forms
|
||||
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
|
||||
|
||||
(def ctor (compile ast *env* source))
|
||||
(def ctor (compile ast (fiber/getenv (fiber/current)) source))
|
||||
(if-not (function? ctor)
|
||||
(error (string "could not compile template")))
|
||||
(ctor))
|
||||
|
||||
@ -103,7 +103,7 @@
|
||||
|
||||
# Generate parts and print them to stdout
|
||||
(def parts (seq [[k entry]
|
||||
:in (sort (pairs (table/getproto *env*)))
|
||||
:in (sort (pairs (table/getproto (fiber/getenv (fiber/current)))))
|
||||
:when (and (get entry :doc) (not (get entry :private)))]
|
||||
(emit-item k entry)))
|
||||
(print
|
||||
|
||||
Loading…
Reference in New Issue
Block a user