mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-06-28 16:13:16 +00:00
Code Issues 1 Releases Wiki Activity

Cleanup boot.janet to be more like normal source code.

Browse Source 
Don't use `undef`, just use private defines.
This commit is contained in:
Calvin Rose 2021-01-31 09:08:39 -06:00
parent c9ea3ac304
commit d122a75efd
2 changed files with 90 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

225
src/boot/boot.janet
View File

@ -7,8 +7,6 @@
### ###
### ###
(def root-env "The root environment used to create environments with (make-env)" _env)
(def defn :macro (def defn :macro
``` ```
(defn name & more) (defn name & more)
@ -585,16 +583,6 @@
[& body] [& body]
(tuple fiber/new (tuple 'fn '[] ;body) :yi)) (tuple fiber/new (tuple 'fn '[] ;body) :yi))
(defmacro- undef
"Remove binding from root-env"
[& syms]
~(do ,;(seq [s :in syms] ~(put root-env ',s nil))))
(undef _env)
(undef loop1 check-indexed for-template for-var-template iterate-template
each-template range-template)
(defn sum (defn sum
"Returns the sum of xs. If xs is empty, returns 0." "Returns the sum of xs. If xs is empty, returns 0."
[xs] [xs]
@ -757,8 +745,6 @@
(defn even? "Check if x is even." [x] (= 0 (compare 0 (mod x 2)))) (defn even? "Check if x is even." [x] (= 0 (compare 0 (mod x 2))))
(defn odd? "Check if x is odd." [x] (= 0 (compare 1 (mod x 2)))) (defn odd? "Check if x is odd." [x] (= 0 (compare 1 (mod x 2))))
(undef compare-reduce)
### ###
### ###
### Indexed Combinators ### Indexed Combinators
@ -770,7 +756,7 @@
a a
(if (not= (> b a) (> b c)) b c))) (if (not= (> b a) (> b c)) b c)))
(defn sort-help [a lo hi by] (defn- sort-help [a lo hi by]
(when (< lo hi) (when (< lo hi)
(def pivot (def pivot
(median-of-three (in a hi) (in a lo) (median-of-three (in a hi) (in a lo)
@ -796,9 +782,6 @@
[a &opt by] [a &opt by]
(sort-help a 0 (- (length a) 1) (or by <))) (sort-help a 0 (- (length a) 1) (or by <)))
(undef median-of-three)
(undef sort-help)
(defn sort-by (defn sort-by
`Returns a new sorted array that compares elements by invoking `Returns a new sorted array that compares elements by invoking
a function on each element and comparing the result with <.` a function on each element and comparing the result with <.`
@ -1204,9 +1187,6 @@
(tuple/brackets ;x))) (tuple/brackets ;x)))
form)) form))
(undef walk-ind)
(undef walk-dict)
(defn postwalk (defn postwalk
`Do a post-order traversal of a data structure and call (f x) `Do a post-order traversal of a data structure and call (f x)
on every visitation.` on every visitation.`
@ -2033,10 +2013,11 @@
### ###
### ###
# Get boot options # Initialize syspath and header path
(def- boot/opts @{})
(each [k v] (partition 2 (tuple/slice boot/args 2)) (each [k v] (partition 2 (tuple/slice boot/args 2))
(put boot/opts k v)) (case k
"JANET_PATH" (setdyn :syspath v)
"JANET_HEADERPATH" (setdyn :headerpath v)))
(defn make-env (defn make-env
`Create a new environment table. The new environment `Create a new environment table. The new environment
@ -2331,9 +2312,6 @@
``` ```
@[]) @[])
(setdyn :syspath (boot/opts "JANET_PATH"))
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
(defn module/add-paths (defn module/add-paths
``` ```
Add paths to module/paths for a given loader such that Add paths to module/paths for a given loader such that
@ -2361,7 +2339,7 @@
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-is-dep]) (array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-is-dep])
# Version of fexists that works even with a reduced OS # Version of fexists that works even with a reduced OS
(defn fexists (defn- fexists
[path] [path]
(compif (dyn 'os/stat) (compif (dyn 'os/stat)
(= :file (os/stat path :mode)) (= :file (os/stat path :mode))
@ -2408,12 +2386,6 @@
str-parts (interpose "\n " paths)] str-parts (interpose "\n " paths)]
[nil (string "could not find module " path ":\n " ;str-parts)]))) [nil (string "could not find module " path ":\n " ;str-parts)])))
(undef fexists)
(undef mod-filter)
(undef check-relative)
(undef check-project-relative)
(undef check-is-dep)
(def module/loading (def module/loading
`Table mapping currently loading modules to true. Used to prevent `Table mapping currently loading modules to true. Used to prevent
circular dependencies.` circular dependencies.`
@ -2507,7 +2479,7 @@
m))) m)))
:image (fn image-loader [path &] (load-image (slurp path)))}) :image (fn image-loader [path &] (load-image (slurp path)))})
(defn require-1 (defn- require-1
[path args kargs] [path args kargs]
(def [fullpath mod-kind] (module/find path)) (def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind)) (unless fullpath (error mod-kind))
@ -2556,8 +2528,6 @@
(string (last (string/split "/" path)) "/"))) (string (last (string/split "/" path)) "/")))
(merge-module env newenv prefix ep)) (merge-module env newenv prefix ep))
(undef require-1)
(defmacro import (defmacro import
`Import a module. First requires the module, and then merges its `Import a module. First requires the module, and then merges its
symbols into the current environment, prepending a given prefix as needed. symbols into the current environment, prepending a given prefix as needed.
@ -2918,10 +2888,6 @@
(if-not found (if-not found
(print "documentation for value " x " not found."))) (print "documentation for value " x " not found.")))
(undef env-walk)
(undef print-index)
(undef print-module-entry)
### ###
### ###
### Debugger ### Debugger
@ -2967,71 +2933,67 @@
(in (.slots frame-idx) (or nth 0))) (in (.slots frame-idx) (or nth 0)))
# Conditional compilation for disasm # Conditional compilation for disasm
(def disasm-alias (if-let [x (root-env 'disasm)] (x :value))) (compwhen (dyn 'disasm)
(defn .disasm (defn .disasm
"Gets the assembly for the current function." "Gets the assembly for the current function."
[&opt n] [&opt n]
(def frame (.frame n)) (def frame (.frame n))
(def func (frame :function)) (def func (frame :function))
(disasm-alias func)) (disasm func))
(defn .bytecode (defn .bytecode
"Get the bytecode for the current function." "Get the bytecode for the current function."
[&opt n] [&opt n]
((.disasm n) :bytecode)) ((.disasm n) :bytecode))
(defn .ppasm (defn .ppasm
"Pretty prints the assembly for the current function" "Pretty prints the assembly for the current function"
[&opt n] [&opt n]
(def frame (.frame n)) (def frame (.frame n))
(def func (frame :function)) (def func (frame :function))
(def dasm (disasm-alias func)) (def dasm (disasm func))
(def bytecode (in dasm :bytecode)) (def bytecode (in dasm :bytecode))
(def pc (frame :pc)) (def pc (frame :pc))
(def sourcemap (in dasm :sourcemap)) (def sourcemap (in dasm :sourcemap))
(var last-loc [-2 -2]) (var last-loc [-2 -2])
(print "\n signal: " (.signal)) (print "\n signal: " (.signal))
(print " function: " (dasm :name) " [" (in dasm :source "") "]") (print " function: " (dasm :name) " [" (in dasm :source "") "]")
(when-let [constants (dasm :constants)] (when-let [constants (dasm :constants)]
(printf " constants: %.4q" constants)) (printf " constants: %.4q" constants))
(printf " slots: %.4q\n" (frame :slots)) (printf " slots: %.4q\n" (frame :slots))
(def padding (string/repeat " " 20)) (def padding (string/repeat " " 20))
(loop [i :range [0 (length bytecode)] (loop [i :range [0 (length bytecode)]
:let [instr (bytecode i)]] :let [instr (bytecode i)]]
(prin (if (= (tuple/type instr) :brackets) "*" " ")) (prin (if (= (tuple/type instr) :brackets) "*" " "))
(prin (if (= i pc) "> " " ")) (prin (if (= i pc) "> " " "))
(prinf "%.20s" (string (string/join (map string instr) " ") padding)) (prinf "%.20s" (string (string/join (map string instr) " ") padding))
(when sourcemap (when sourcemap
(let [[sl sc] (sourcemap i) (let [[sl sc] (sourcemap i)
loc [sl sc]] loc [sl sc]]
(when (not= loc last-loc) (when (not= loc last-loc)
(set last-loc loc) (set last-loc loc)
(prin " # line " sl ", column " sc)))) (prin " # line " sl ", column " sc))))
(print))
(print)) (print))
(print))
(defn .breakall (defn .breakall
"Set breakpoints on all instructions in the current function." "Set breakpoints on all instructions in the current function."
[&opt n] [&opt n]
(def fun (.fn n)) (def fun (.fn n))
(def bytecode (.bytecode n)) (def bytecode (.bytecode n))
(forv i 0 (length bytecode) (forv i 0 (length bytecode)
(debug/fbreak fun i)) (debug/fbreak fun i))
(print "Set " (length bytecode) " breakpoints in " fun)) (print "Set " (length bytecode) " breakpoints in " fun))
(defn .clearall (defn .clearall
"Clear all breakpoints on the current function." "Clear all breakpoints on the current function."
[&opt n] [&opt n]
(def fun (.fn n)) (def fun (.fn n))
(def bytecode (.bytecode n)) (def bytecode (.bytecode n))
(forv i 0 (length bytecode) (forv i 0 (length bytecode)
(debug/unfbreak fun i)) (debug/unfbreak fun i))
(print "Cleared " (length bytecode) " breakpoints in " fun)) (print "Cleared " (length bytecode) " breakpoints in " fun)))
(unless (get root-env 'disasm)
(undef .disasm .bytecode .breakall .clearall .ppasm))
(undef disasm-alias)
(defn .source (defn .source
"Show the source code for the function being debugged." "Show the source code for the function being debugged."
@ -3087,7 +3049,6 @@
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env))) (def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil)) (each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
(undef debugger-keys)
### ###
### ###
@ -3161,6 +3122,7 @@
### ###
(compwhen (dyn 'ev/go) (compwhen (dyn 'ev/go)
(defn net/close "Alias for ev/close." [stream] (ev/close stream)) (defn net/close "Alias for ev/close." [stream] (ev/close stream))
(defn ev/call (defn ev/call
@ -3212,9 +3174,7 @@
(,wait-for-fibers ,chan (,wait-for-fibers ,chan
,(seq [[i body] :pairs bodies] ,(seq [[i body] :pairs bodies]
~(,ev/go (,fiber/new (fn [] (put ,res ,i ,body)) :tp) nil ,chan))) ~(,ev/go (,fiber/new (fn [] (put ,res ,i ,body)) :tp) nil ,chan)))
,res))) ,res))))
(undef wait-for-fibers))
(compwhen (dyn 'net/listen) (compwhen (dyn 'net/listen)
(defn net/server (defn net/server
@ -3256,7 +3216,7 @@
(defn- use-2 [evaluator args] (defn- use-2 [evaluator args]
(each a args (import* (string a) :prefix "" :evaluator evaluator))) (each a args (import* (string a) :prefix "" :evaluator evaluator)))
(defn flycheck-evaluator (defn- flycheck-evaluator
``An evaluator function that is passed to `run-context` that lints (flychecks) code. ``An evaluator function that is passed to `run-context` that lints (flychecks) code.
This means code will parsed and compiled, macros executed, but the code will not be run. This means code will parsed and compiled, macros executed, but the code will not be run.
Used by `flycheck`.`` Used by `flycheck`.``
@ -3299,7 +3259,6 @@
### ###
### ###
# conditional compilation for reduced os # conditional compilation for reduced os
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&]))) (def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
@ -3425,23 +3384,6 @@
(setdyn :err-color (if *colorize* true)) (setdyn :err-color (if *colorize* true))
(repl getchunk nil env))))) (repl getchunk nil env)))))
(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias)
###
###
### Clean up
###
###
(do
(undef boot/opts undef)
(def load-dict (env-lookup root-env))
(put load-dict 'boot/config nil)
(put load-dict 'boot/args nil)
(each [k v] (pairs load-dict)
(if (number? v) (put load-dict k nil)))
(merge-into load-image-dict load-dict))
### ###
### ###
### Bootstrap ### Bootstrap
@ -3459,29 +3401,38 @@
(put into k (x k)))) (put into k (x k))))
into) into)
# Modify env based on some options. # Modify root-env to remove private symbols and
(loop [[k v] :pairs root-env # flatten nested tables.
(loop [[k v] :in (pairs root-env)
:when (symbol? k)] :when (symbol? k)]
(def flat (proto-flatten @{} v)) (def flat (proto-flatten @{} v))
(when (boot/config :no-docstrings) (when (boot/config :no-docstrings)
(put flat :doc nil)) (put flat :doc nil))
(when (boot/config :no-sourcemaps) (when (boot/config :no-sourcemaps)
(put flat :source-map nil)) (put flat :source-map nil))
(put root-env k flat)) (if (v :private)
(put root-env k nil)
(put root-env k flat)))
(put root-env 'boot/config nil) (put root-env 'boot/config nil)
(put root-env 'boot/args nil) (put root-env 'boot/args nil)
(def image (let [env-pairs (pairs (env-lookup root-env)) # Build dictionary for loading images
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs) (def load-dict (env-lookup root-env))
lookup (table ;(mapcat identity essential-pairs)) (each [k v] (pairs load-dict)
reverse-lookup (invert lookup)] (if (number? v) (put load-dict k nil)))
# Check no duplicate values (merge-into load-image-dict load-dict)
(def temp @{})
(eachp [k v] lookup (def image
(if (in temp v) (errorf "duplicate value: %v" v)) (let [env-pairs (pairs (env-lookup root-env))
(put temp v k)) essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
(marshal root-env reverse-lookup))) lookup (table ;(mapcat identity essential-pairs))
reverse-lookup (invert lookup)]
# Check no duplicate values
(def temp @{})
(eachp [k v] lookup
(if (in temp v) (errorf "duplicate value: %v" v))
(put temp v k))
(marshal root-env reverse-lookup)))
# Create amalgamation # Create amalgamation

3
src/core/corelib.c
View File

@ -1206,7 +1206,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"if native modules are compatible with the host program.")); "if native modules are compatible with the host program."));
/* Allow references to the environment */ /* Allow references to the environment */
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope.")); janet_def(env, "root-env", janet_wrap_table(env),
JDOC("The root environment used to create environments with (make-env)."));
janet_load_libs(env); janet_load_libs(env);
janet_gcroot(janet_wrap_table(env)); janet_gcroot(janet_wrap_table(env));