1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-07 02:53:02 +00:00

Compare commits

..

84 Commits

Author SHA1 Message Date
Calvin Rose
bedd9ccaa1 Verify working meson build on windows.
Using MSVC, no need for GNU tools.
2019-06-20 17:28:22 -04:00
Calvin Rose
a29e717fd7 Start working to a full meson build.
One build system instead of three for Make + Meson + build_win.bat.
2019-06-20 16:33:28 -04:00
Calvin Rose
522545287e Add janet_abstract_begin and janet_abstract_end
This will allow some one constructing an abstract to
only make it visible to the garbage collector after it
is in a valid state. If code in the constructing cfunction
panics before janet_abstract_end is called, the GC will not try
to mark the incomplete abstract type. This is often not needed through
careful programming, but should work well.
2019-06-20 12:37:57 -04:00
Calvin Rose
4b4fe80404 Be more complete with JANET_NO_SOURCEMAPS
This actually removed sourcemaps, not just
the top level annotation in bindings.
2019-06-20 11:55:52 -04:00
Calvin Rose
cf05ff610f Add some fixes for serializing complex grammars. 2019-06-19 23:23:27 -04:00
Calvin Rose
300124961f Change -c option to use dofile instead of require 2019-06-19 22:05:13 -04:00
Calvin Rose
7eb78c8028 Load jimage files before janet source files.
This should allow precompiled files to be placed
right next to the source files in the file system with
the expected behavior.
2019-06-19 20:18:44 -04:00
Calvin Rose
1a7691dade Flatten environment binding tables.
For some reason, these tables used prototypes. There
seems to be no need for this.
2019-06-19 20:07:40 -04:00
Calvin Rose
3b51501847 Update CHANGELOG.md 2019-06-19 19:52:41 -04:00
Calvin Rose
fc46030e7d Add options to not include docstrings in binary.
This lets us build a smaller binary. The minimal tested
binary on x86-64 (with -Os, -s, and all options that shrink binary size
        turned on) is about 240 kB.
2019-06-19 19:43:38 -04:00
Calvin Rose
ff3bb66272 Add some test cases for module/expand-path 2019-06-19 12:48:29 -04:00
Calvin Rose
1ceaceada4 Fix doc generation. 2019-06-19 09:48:33 -04:00
Calvin Rose
19a0444f41 Appease MSVC 2019-06-19 09:45:56 -04:00
Calvin Rose
0102a72538 Update module/paths for saner defaults.
Relative imports will only check the paths
directly concerning relative imports.
2019-06-19 09:01:21 -04:00
Calvin Rose
9943bdd907 Update cook.janet and jpm
They should throw better error messages when project.janet
not found.
2019-06-19 00:48:57 -04:00
Calvin Rose
264c5bc02b Change default module/path.
Disallow loading directly with extension to be more
consistent and keep things simpler.
2019-06-19 00:34:15 -04:00
Calvin Rose
9ba8728176 Update module system.
Add relative imports and path normalization. This should
help towards a more composable build/dependency system.
2019-06-18 22:10:13 -04:00
Calvin Rose
8839731951 Update changelog. 2019-06-18 15:41:48 -04:00
Calvin Rose
e88a9af2f6 Add bytecode verification for peg unmarshaling. 2019-06-18 13:01:49 -04:00
Calvin Rose
a5e50a0f65 Fix windows getline. 2019-06-18 00:04:29 -04:00
Calvin Rose
7c35acca75 One more MSVC warning. 2019-06-17 23:53:38 -04:00
Calvin Rose
4bb57550c8 Silence some windows build warnings. 2019-06-17 23:50:39 -04:00
Calvin Rose
446ab037b0 Allow marshaling pegs. 2019-06-17 23:40:02 -04:00
Calvin Rose
4adfb9f2d3 Update changelog. 2019-06-17 22:46:38 -04:00
Calvin Rose
9c89d1c658 Inline yield when called with no arguments.
It was already inline when called with one argument.
2019-06-15 12:21:08 -04:00
Calvin Rose
3598f056bb Reformat capi.c 2019-06-15 11:04:24 -04:00
Calvin Rose
779fcf2d54 Merge pull request #124 from ALSchwalm/parse-state
Add support for getting more detailed parser state
2019-06-15 11:00:06 -04:00
Adam Schwalm
3bbc121c6a Add support for getting more detailed parser state 2019-06-15 07:37:01 -05:00
Calvin Rose
82edc19137 Update cook to take headers for natives.
This should help incremental building.
2019-06-13 00:41:20 -04:00
Calvin Rose
5689ef1af1 Add keyword flag utility for modules. 2019-06-12 12:05:48 -04:00
Calvin Rose
b4e25e5597 Add some string/check-set tests. 2019-06-10 14:11:07 -04:00
Calvin Rose
647139cdf9 Fix string/check-set.
Also change external unification identifier in match macro
to @. This means we can more easily match symbol literals.
2019-06-10 14:00:51 -04:00
Calvin Rose
6225f8d334 Fix defn docstring typo. 2019-06-09 09:18:16 -04:00
Calvin Rose
95eb54045f Update changelog. 2019-06-08 17:22:42 -04:00
Calvin Rose
43520ac67d Add parser/clone. (#120) 2019-06-08 17:16:36 -04:00
Calvin Rose
802a2d6b71 Add more dynamic bindings for printing. 2019-06-08 15:27:13 -04:00
Calvin Rose
d9a4ef05ac Update docstring format.
Also add :p flag to fiber/new, change implemntation of with-dyns, and
make meson build install static library by default.
2019-06-08 10:30:43 -04:00
Calvin Rose
f00a2770ef Follow meson guidlines for static/shared libs
Use only one library definition for faster builds.
2019-06-08 09:05:38 -04:00
Calvin Rose
b83fe146fa Add static library to meson build. 2019-06-07 23:11:34 -04:00
Calvin Rose
6249f03367 Add janet_dep to meson build file. 2019-06-07 22:42:09 -04:00
Calvin Rose
bfc00b67bd Merge pull request #123 from andrewchambers/stdlibfd
Add file/{fdopen,fileno} functions.
2019-06-07 19:31:41 -04:00
Andrew Chambers
2b7428ed2b Add file/{fdopen,fileno} functions. 2019-06-08 10:33:29 +12:00
Calvin Rose
64a80c57e3 Tables created via table_init cannot leak memory.
Before, if Janet paniced without calling table_deinit
on a table created via table_init, Janet leaked memory.
This changes tables so that tables created via table_init
us scratch memory for auto cleanup instead of normal
malloc/free.
2019-06-05 17:08:49 -04:00
Calvin Rose
efb2ab06cb Remove array_init and array_deinit
These functions made it very easy to create memory
leaks, and are better replaced with functions in vector.h or
simply using non-stack allocated arrays.
2019-06-05 16:19:51 -04:00
Calvin Rose
b082c8123e Update tm_language_gen. 2019-06-05 11:07:08 -04:00
Calvin Rose
cc1ff9125a Add b_lundef=false for meson build. 2019-06-04 23:58:04 -04:00
Calvin Rose
5734e02034 Update CHANGELOG.md 2019-06-03 10:55:26 -04:00
Calvin Rose
6e8beff0a0 Add optional argument to parser/where to set index.
DSLs that use the parser API can use this to more accurately
report source location.
2019-06-03 10:48:16 -04:00
Calvin Rose
c21eaa5474 Fix redefinition. 2019-06-02 20:09:16 -04:00
Calvin Rose
13667292c6 Expose signal, type, and status name arrays.
Makes it easier to print status stuff.
2019-06-02 20:05:17 -04:00
Calvin Rose
22eb8372dd Make meson build file do cross compilation. 2019-06-02 17:05:17 -04:00
Calvin Rose
1b7a9def25 Fix path separators. 2019-06-02 14:10:12 -04:00
Calvin Rose
d7954e6fe3 Update installers for path.janet 2019-06-02 13:30:52 -04:00
Calvin Rose
c20c9cd5d7 Merge branch 'master' of github.com:janet-lang/janet 2019-06-02 13:28:48 -04:00
Calvin Rose
46531d9a60 Add path.janet. 2019-06-02 13:26:51 -04:00
Calvin Rose
d9a366fbed Merge pull request #118 from ALSchwalm/all-bindings-env
Allow all-bindings and dynamics to search specific env
2019-06-02 12:08:38 -04:00
Adam Schwalm
64bf52372a Allow all-bindings and dynamics to search specific env 2019-06-02 10:12:46 -05:00
Calvin Rose
0a9715a94c Bump version to 1.0.0 2019-06-01 23:52:01 -04:00
Calvin Rose
c82aac1365 Refer to @ as atsign not ampersand. 2019-06-01 23:40:59 -04:00
Calvin Rose
e697cc3811 Make os/execute not leak memory on panics.
Since many calls can panic, it's best
to only use scratch memory for temporary values.
2019-06-01 23:38:10 -04:00
Calvin Rose
c150f2f2c1 Add scratch memory API.
This should make it easier to write
code that does not leak memory on panics.
2019-06-01 23:31:39 -04:00
Calvin Rose
0a54e1ed62 Fix installer. 2019-06-01 11:34:28 -04:00
Calvin Rose
b9daf41327 NSIS installer fix. 2019-06-01 10:43:40 -04:00
Calvin Rose
2d2bc436e6 Quick fix. 2019-06-01 10:40:59 -04:00
Calvin Rose
3d76d988c3 More work on installation and moving files around.
Move all installed libraries into auxlib.
Move all installed executable scripts into auxbin.
2019-06-01 10:38:28 -04:00
Calvin Rose
bea6dbbf3d Hint utf8 output on windows console. 2019-05-31 15:30:23 -04:00
Calvin Rose
e1bd24c2ab Make os/execute on windows closer to posix version 2019-05-31 15:02:44 -04:00
Calvin Rose
1f30ea66e9 Windows quick fix. 2019-05-31 13:45:39 -04:00
Calvin Rose
c43aaf8986 More work to os/execute.
Use environ when eflag not given. Also try to escape windows
command line strings correctly.
2019-05-31 13:44:14 -04:00
Calvin Rose
2acc81d1c5 Add noreturn attribute to panic functions. 2019-05-31 10:10:20 -04:00
Calvin Rose
26513a7a16 Update changelog 2019-05-30 19:33:09 -04:00
Calvin Rose
d005ac6888 Appease MSVC. 2019-05-30 19:21:11 -04:00
Calvin Rose
7fdb098a20 Add process.h. 2019-05-30 19:14:54 -04:00
Calvin Rose
a4a200e037 Spawn.h not found in windows. 2019-05-30 19:13:13 -04:00
Calvin Rose
15d95d8803 Windows include issue. 2019-05-30 18:50:52 -04:00
Calvin Rose
46950a8cb3 Convert os/execute to use posix_spawn. 2019-05-30 18:40:10 -04:00
Calvin Rose
4867cab569 Correct changelog date. 2019-05-29 22:21:06 -04:00
Calvin Rose
c8cf7c2445 Appease MSVC. 2019-05-29 22:12:24 -04:00
Calvin Rose
1b63215aad Remove extra functions. 2019-05-29 22:00:47 -04:00
Calvin Rose
bcbe42ab23 Add API version checking for modules.
Checking now actively implemented for dynamic modules
in a fully backwards compatible way.
2019-05-29 21:58:20 -04:00
Calvin Rose
c8c6419013 Update installer again. 2019-05-29 19:48:31 -04:00
Calvin Rose
e8516c29e0 Update installer and jpm to work better on windows. 2019-05-29 19:01:12 -04:00
Calvin Rose
12247bd958 Update installer. 2019-05-29 17:48:46 -04:00
Calvin Rose
9d30d5f6e3 Update installer. 2019-05-29 13:02:15 -04:00
55 changed files with 1940 additions and 843 deletions

View File

@@ -1,6 +1,33 @@
# Changelog
All notable changes to this project will be documented in this file.
## Unreleased
- Add `JANET_NO_DOCSTRINGS` and `JANET_NO_SOURCEMAPS` defines in janetconf.h
for shrinking binary size.
This seems to save about 50kB in most builds, so it's not usually worth it.
- Update module system to allow relative imports. The `:cur:` pattern
in `module/expand-path` will expand to the directory part of the current file, or
whatever the value of `(dyn :current-file)` is. The `:dir:` pattern gets
the directory part of the input path name.
- Remove `:native:` pattern in `module/paths`.
- Add `module/expand-path`
- Remove `module/*syspath*` and `module/*headerpath*` in favor of dynamic
bindings `:syspath` and `:headerpath`.
- Compiled PEGs can now be marshaled and unmarshaled.
- Change signature to `parser/state`
- Add `:until` verb to loop.
- Add `:p` flag to `fiber/new`.
- Add `file/{fdopen,fileno}` functions.
- Add `parser/clone` function.
- Add optional argument to `parser/where` to set parser byte index.
- Add optional `env` argument to `all-bindings` and `all-dynamics`.
- Add scratch memory C API functions for auto-released memory on next gc.
Scratch memory differs from normal GCed memory as it can also be freed normally
for better performance.
- Add API compatibility checking for modules. This will let native modules not load
when the host program is not of a compatible version or configuration.
- Change signature of `os/execute` to be much more flexible.
## 0.6.0 - 2019-05-29
- `file/close` returns exit code when closing file opened with `file/popen`.
- Add `os/rename`
@@ -83,7 +110,7 @@ All notable changes to this project will be documented in this file.
- Disallow NaNs as table or struct keys
- Update module resolution paths and format
## 0.3.0 - 2019-26-01
## 0.3.0 - 2019-01-26
- Add amalgamated build to janet for easier embedding.
- Add os/date function
- Add slurp and spit to core library.

View File

@@ -37,7 +37,7 @@ MANPATH?=$(PREFIX)/share/man/man1/
PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig
DEBUGGER=gdb
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fpic -O2 -fvisibility=hidden \
-DJANET_BUILD=$(JANET_BUILD)
LDFLAGS=-rdynamic
@@ -60,7 +60,7 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
##### Name Files #####
######################
JANET_HEADERS=src/include/janet.h src/include/janetconf.h
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
JANET_LOCAL_HEADERS=src/core/util.h \
src/core/state.h \
@@ -252,7 +252,7 @@ callgrind: $(JANET_TARGET)
dist: build/janet-dist.tar.gz
build/janet-%.tar.gz: $(JANET_TARGET) \
src/include/janet.h src/include/janetconf.h \
src/include/janet.h src/conf/janetconf.h \
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
build/doc.html README.md build/janet.c
tar -czvf $@ $^
@@ -299,10 +299,8 @@ install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc
cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a
ln -sf $(SONAME) $(LIBDIR)/libjanet.so
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
cp tools/cook.janet $(JANET_PATH)
cp tools/jpm $(BINDIR)/jpm
cp tools/highlight.janet $(JANET_PATH)
cp tools/bars.janet $(JANET_PATH)
cp -rf auxlib/* $(JANET_PATH)
cp -rf auxbin/* $(BINDIR)
mkdir -p $(MANPATH)
cp janet.1 $(MANPATH)
-ldconfig $(LIBDIR)

View File

@@ -17,11 +17,11 @@
(print `
Keys are:
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH or module/*syspath*
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or module/*headerpath*
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH or (dyn :syspath)
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or (dyn :headerpath)
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
--optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
--compiler : C compiler to use for natives. Defaults to $CC or cc.
--compiler : C compiler to use for natives. Defaults to $COMPILER or cc.
--linker : C linker to use for linking natives. Defaults to $LINKER or cc.
--cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set.
--lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
@@ -31,8 +31,10 @@ Keys are:
(def todo @[])
(each arg args
(if (string/has-prefix? "--" arg)
(let [[key value] (peg/match argpeg arg)]
(setdyn (keyword key) value))
(if-let [m (peg/match argpeg arg)]
(let [[key value] m]
(setdyn (keyword key) value))
(print "invalid argument " arg))
(array/push todo arg)))
(cook/import-rules "./project.janet")

View File

@@ -92,42 +92,54 @@
(unless phony target))
(def- _env (fiber/getenv (fiber/current)))
(defn- import-rules*
[path & args]
(def [realpath] (module/find path))
(defn import-rules
"Import another file that defines more cook rules. This ruleset
is merged into the current ruleset."
[path]
(def env (make-env))
(unless (os/stat path :mode)
(error (string "cannot open " path)))
(loop [k :keys _env :when (symbol? k)]
(unless ((_env k) :private) (put env k (_env k))))
(def currenv (fiber/getenv (fiber/current)))
(loop [k :keys currenv :when (keyword? k)]
(put env k (currenv k)))
(require path :env env ;args)
(dofile path :env env)
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
(defmacro import-rules
"Import another file that defines more cook rules. This ruleset
is merged into the current ruleset."
[path & args]
~(,import-rules* ,(string path) ,;args))
#
# Configuration
#
# Installation settings
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") module/*syspath*))
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH") module/*headerpath*))
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
(def JANET_HEADERPATH (os/getenv "JANET_HEADERPATH"))
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (unless is-win "/usr/local/bin")))
# Compilation settings
(def OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
(def CC (or (os/getenv "CC") (if is-win "cl" "cc")))
(def LD (or (os/getenv "LINKER") (if is-win "link" CC)))
(def LDFLAGS (or (os/getenv "LFLAGS")
(if is-win " /nologo"
(string " -shared"
(if is-mac " -undefined dynamic_lookup" "")))))
(def CFLAGS (or (os/getenv "CFLAGS") (if is-win "" " -std=c99 -Wall -Wextra -fpic")))
(def- OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
(def- COMPILER (or (os/getenv "COMPILER") (if is-win "cl" "cc")))
(def- LINKER (or (os/getenv "LINKER") (if is-win "link" COMPILER)))
(def- LFLAGS
(if-let [lflags (os/getenv "LFLAGS")]
(string/split " " lflags)
(if is-win ["/nologo" "/DLL"]
(if is-mac
["-shared" "-undefined" "dynamic_lookup"]
["-shared"]))))
(def- CFLAGS
(if-let [cflags (os/getenv "CFLAGS")]
(string/split " " cflags)
(if is-win
["/nologo"]
["-std=c99" "-Wall" "-Wextra" "-fpic"])))
# Some defaults
(def default-cflags CFLAGS)
(def default-lflags LFLAGS)
(def default-cc COMPILER)
(def default-ld LINKER)
(defn- opt
"Get an option, allowing overrides via dynamic bindings AND some
@@ -145,9 +157,7 @@
(defn shell
"Do a shell command"
[& args]
(def cmd (string/join args))
(print cmd)
(def res (os/shell cmd))
(def res (os/execute args :p))
(unless (zero? res)
(error (string "command exited with status " res))))
@@ -164,7 +174,10 @@
(defn copy
"Copy a file or directory recursively from one location to another."
[src dest]
(shell (if is-win "xcopy " "cp -rf ") src " " dest (if is-win " /h /y /t /e" "")))
(print "copying " src " to " dest "...")
(if is-win
(shell "xcopy" src dest "/y" "/e")
(shell "cp" "-rf" src dest)))
#
# C Compilation
@@ -223,39 +236,40 @@
(defn- getcflags
"Generate the c flags from the input options."
[opts]
(string (opt opts :cflags CFLAGS)
(if is-win " /I" " -I")
(opt opts :headerpath JANET_HEADERPATH)
(if is-win " /O" " -O")
(opt opts :optimize OPTIMIZE)))
@[;(opt opts :cflags CFLAGS)
(string (if is-win "/I" "-I") (opt opts :headerpath JANET_HEADERPATH))
(string (if is-win "/O" "-O") (opt opts :optimize OPTIMIZE))])
(defn- compile-c
"Compile a C file into an object file."
[opts src dest]
(def cc (opt opts :compiler CC))
(def cc (opt opts :compiler COMPILER))
(def cflags (getcflags opts))
(def defines (interpose " " (make-defines (opt opts :defines {}))))
(rule dest [src]
(def headers (or (opts :headers) []))
(rule dest [src ;headers]
(print "compiling " dest "...")
(if is-win
(shell cc " " ;defines " /nologo /c " cflags " /Fo" dest " " src)
(shell cc " -c " src " " ;defines " " cflags " -o " dest))))
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
(shell cc "-c" src ;defines ;cflags "-o" dest))))
(defn- link-c
"Link a number of object files together."
[opts target & objects]
(def ld (opt opts :linker LD))
(def ld (opt opts :linker LINKER))
(def cflags (getcflags opts))
(def lflags (opt opts :lflags LDFLAGS))
(def olist (string/join objects " "))
(def lflags (opt opts :lflags LFLAGS))
(rule target objects
(print "linking " target "...")
(if is-win
(shell ld " " lflags " /DLL /OUT:" target " " olist " " (opt opts :headerpath JANET_HEADERPATH) "\\janet.lib")
(shell ld " " cflags " -o " target " " olist " " lflags))))
(shell ld ;lflags (string "/OUT:" target) ;objects (string (opt opts :headerpath JANET_HEADERPATH) `\\janet.lib`))
(shell ld ;cflags `-o` target ;objects ;lflags))))
(defn- create-buffer-c
"Inline raw byte file as a c file."
[source dest name]
(rule dest [source]
(print "generating " dest "...")
(def f (file/open source :r))
(if (not f) (error (string "file " f " not found")))
(def out (file/open dest :w))
@@ -321,13 +335,30 @@
(each s sources
(install-rule s path)))
(defn declare-binscript
"Declare a janet file to be installed as an executable script."
(defn declare-bin
"Declare a generic file to be installed as an executable."
[&keys opts]
(def main (opts :main))
(def binpath (opt opts :binpath JANET_BINPATH))
(install-rule main binpath))
(defn declare-binscript
"Declare a janet file to be installed as an executable script. Creates
a shim on windows."
[&keys opts]
(def main (opts :main))
(def binpath (opt opts :binpath JANET_BINPATH))
(install-rule main binpath)
# Create a dud batch file when on windows.
(when is-win
(def name (last (string/split sep main)))
(def bat (string "@echo off\r\njanet %~dp0\\" name "%*"))
(def newname (string binpath sep name ".bat"))
(add-body "install"
(spit newname bat))
(add-body "uninstall"
(os/rm newname))))
(defn declare-archive
"Build a janet archive. This is a file that bundles together many janet
scripts into a janet image. This file can the be moved to any machine with

149
auxlib/path.janet Normal file
View File

@@ -0,0 +1,149 @@
### path.janet
###
### A library for path manipulation.
###
### Copyright 2019 © Calvin Rose
#
# Common
#
(def- ext-peg
(peg/compile ~{:back (> -1 (+ (* ($) (set "\\/.")) :back))
:main :back}))
(defn ext
"Get the file extension for a path."
[path]
(if-let [m (peg/match ext-peg path (length path))]
(let [i (m 0)]
(if (= (path i) 46)
(string/slice path (m 0) -1)))))
(defn- redef
"Redef a value, keeping all metadata."
[from to]
(setdyn (symbol to) (dyn (symbol from))))
#
# Generating Macros
#
(defmacro- decl-sep [pre sep] ~(def ,(symbol pre "/sep") ,sep))
(defmacro- decl-delim [pre d] ~(def ,(symbol pre "/delim") ,d))
(defmacro- decl-last-sep
[pre sep]
~(def- ,(symbol pre "/last-sep-peg")
(peg/compile ~{:back (> -1 (+ (* ,sep ($)) :back))
:main :back})))
(defmacro- decl-basename
[pre]
~(defn ,(symbol pre "/basename")
"Gets the base file name of a path."
[path]
(if-let [m (peg/match
,(symbol pre "/last-sep-peg")
path
(length path))]
(let [[p] m]
(string/slice path p -1))
path)))
(defmacro- decl-parts
[pre sep]
~(defn ,(symbol pre "/parts")
"Split a path into its parts."
[path]
(string/split ,sep path)))
(defmacro- decl-normalize
[pre sep lead]
~(defn ,(symbol pre "/normalize")
"Normalize a path. This removes . and .. in the
path, as well as empty path elements."
[path]
(def els (string/split ,sep path))
(def newparts @[])
(if (,(symbol pre "/abspath?") path) (array/push newparts ,lead))
(each part els
(case part
"" nil
"." nil
".." (array/pop newparts)
(array/push newparts part)))
(string/join newparts ,sep)))
(defmacro- decl-join
[pre sep]
~(defn ,(symbol pre "/join")
"Join path elements together."
[& els]
(,(symbol pre "/normalize") (string/join els ,sep))))
(defmacro- decl-abspath
[pre]
~(defn ,(symbol pre "/abspath")
"Coerce a path to be absolute."
[path]
(if (,(symbol pre "/abspath?") path)
path
(,(symbol pre "/join") (os/cwd) path))))
#
# Posix
#
(defn posix/abspath?
"Check if a path is absolute."
[path]
(string/has-prefix? "/" path))
(redef "ext" "posix/ext")
(decl-sep "posix" "/")
(decl-delim "posix" ":")
(decl-last-sep "posix" "/")
(decl-basename "posix")
(decl-parts "posix" "/")
(decl-normalize "posix" "/" "")
(decl-join "posix" "/")
(decl-abspath "posix")
#
# Windows
#
(def- abs-peg (peg/compile '(* (range "AZ") ":\\")))
(defn win32/abspath?
"Check if a path is absolute."
[path]
(peg/match abs-peg path))
(redef "ext" "win32/ext")
(decl-sep "win32" "\\")
(decl-delim "win32" ";")
(decl-last-sep "win32" "\\")
(decl-basename "win32")
(decl-parts "win32" "\\")
(decl-normalize "win32" "\\" "C:")
(decl-join "win32" "\\")
(decl-abspath "win32")
#
# Specialize for current OS
#
(def- syms
["ext"
"sep"
"delim"
"basename"
"abspath?"
"abspath"
"parts"
"normalize"
"join"])
(let [pre (if (= :windows (os/which)) "win32" "posix")]
(each sym syms
(redef (string pre "/" sym) sym)))

View File

@@ -16,7 +16,7 @@
@rem Set compile and link options here
@setlocal
@set JANET_COMPILE=cl /nologo /Isrc\include /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
@set JANET_LINK=link /nologo
mkdir build
@@ -128,13 +128,15 @@ copy build\janet.c dist\janet.c
copy janet.exe dist\janet.exe
copy LICENSE dist\LICENSE
copy README.md dist\README.md
copy janet.lib dist\janet.lib
copy janet.exp dist\janet.exp
copy src\include\janet.h dist\janet.h
copy src\include\janetconf.h dist\janetconf.h
copy tools\cook.janet dist\cook.janet
copy tools\highlight.janet dist\highlight.janet
copy tools\jpm dist\jpm
copy src\conf\janetconf.h dist\janetconf.h
copy auxlib\cook.janet dist\cook.janet
copy auxbin\jpm dist\jpm
copy tools\jpm.bat dist\jpm.bat
exit /b 0

View File

@@ -1,19 +1,51 @@
# Version
!define VERSION "1.0.0"
!define PRODUCT_VERSION "${VERSION}.0"
VIProductVersion "${PRODUCT_VERSION}"
VIFileVersion "${PRODUCT_VERSION}"
# Use the modern UI
!define MULTIUSER_EXECUTIONLEVEL Highest
!define MULTIUSER_MUI
!define MULTIUSER_INSTALLMODE_COMMANDLINE
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\Janet\${VERSION}"
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\Janet\${VERSION}"
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
# Includes
!include "MultiUser.nsh"
!include "MUI2.nsh"
!include ".\tools\EnvVarUpdate.nsh"
!include "LogicLib.nsh"
# Basics
Name "Janet"
OutFile "janet-installer.exe"
OutFile "janet-v${VERSION}-windows-installer.exe"
# Some Configuration
!define APPNAME "Janet"
!define DESCRIPTION "The Janet Programming Language"
!define HELPURL "http://janet-lang.org"
BrandingText "The Janet Programming Language"
# Macros for setting registry values
!define UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet-${VERSION}"
!macro WriteEnv key value
${If} $MultiUser.InstallMode == "AllUsers"
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}" "${value}"
${Else}
WriteRegExpandStr HKCU "Environment" "${key}" "${value}"
${EndIf}
!macroend
!macro DelEnv key
${If} $MultiUser.InstallMode == "AllUsers"
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}"
${Else}
DeleteRegValue HKCU "Environment" "${key}"
${EndIf}
!macroend
# MUI Configuration
!define MUI_ICON "assets\icon.ico"
@@ -21,142 +53,130 @@ OutFile "janet-installer.exe"
!define MUI_HEADERIMAGE
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
!define MUI_HEADERIMAGE_RIGHT
!define MUI_ABORTWARNING
# Show a welcome page first
!insertmacro MUI_PAGE_WELCOME
# License page
!insertmacro MUI_PAGE_LICENSE "LICENSE"
# Pick Install Directory
!insertmacro MULTIUSER_PAGE_INSTALLMODE
!insertmacro MUI_PAGE_DIRECTORY
!insertmacro MUI_PAGE_INSTFILES
page instfiles
# Done
!insertmacro MUI_PAGE_FINISH
# Need to set a language.
!insertmacro MUI_LANGUAGE "English"
function .onInit
setShellVarContext all
!insertmacro MULTIUSER_INIT
functionEnd
section "install"
section "Janet" BfWSection
createDirectory "$INSTDIR\Library"
createDirectory "$INSTDIR\C"
createDirectory "$INSTDIR\bin"
setOutPath $INSTDIR
createDirectory "$INSTDIR\docs"
setOutPath "$INSTDIR"
# Bin files
file /oname=bin\janet.exe dist\janet.exe
file /oname=logo.ico assets\icon.ico
file /oname=Library\cook.janet dist\cook.janet
file /oname=bin\jpm.janet auxbin\jpm
file /oname=bin\jpm.bat tools\jpm.bat
# Modules
file /oname=Library\cook.janet auxlib\cook.janet
file /oname=Library\path.janet auxlib\path.janet
# C headers
file /oname=C\janet.h dist\janet.h
file /oname=C\janetconf.h dist\janetconf.h
file /oname=C\janet.lib dist\janet.lib
file /oname=C\janet.exp dist\janet.exp
file /oname=C\janet.c dist\janet.c
file /oname=bin\jpm.janet dist\jpm
file /oname=bin\jpm.bat dist\jpm.bat
# Documentation
file /oname=docs\docs.html dist\doc.html
# Other
file README.md
file LICENSE
# Uninstaller - See function un.onInit and section "uninstall" for configuration
writeUninstaller "$INSTDIR\uninstall.exe"
# Start Menu
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\janet.exe" "" "$INSTDIR\logo.ico"
# HKLM (all users) vs HKCU (current user)
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH "$INSTDIR\Library"
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH "$INSTDIR\C"
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_BINPATH "$INSTDIR\bin"
WriteRegExpandStr HKCU "Environment" JANET_PATH "$INSTDIR\Library"
WriteRegExpandStr HKCU "Environment" JANET_HEADERPATH "$INSTDIR\C"
WriteRegExpandStr HKCU "Environment" JANET_BINPATH "$INSTDIR\bin"
# Start Menu
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
# Set up Environment variables
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
# Update path
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
# Registry information for add/remove programs
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayName" "Janet"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "UninstallString" "$INSTDIR\uninstall.exe"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "QuietUninstallString" "$INSTDIR\uninstall.exe /S"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "InstallLocation" "$INSTDIR"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayIcon" "$INSTDIR\logo.ico"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "Publisher" "Janet-Lang.org"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "HelpLink" "${HELPURL}"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "URLUpdateInfo" "${HELPURL}"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "URLInfoAbout" "${HELPURL}"
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayVersion" "0.6.0"
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "VersionMajor" 0
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "VersionMinor" 6
# There is no option for modifying or repairing the install
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "NoModify" 1
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "NoRepair" 1
# Set the INSTALLSIZE constant (!defined at the top of this script) so Add/Remove Programs can accurately report the size
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "EstimatedSize" 1000
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "0.6.0"
WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMajor" 0
WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMinor" 6
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
# Add uninstall
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
sectionEnd
# Uninstaller
function un.onInit
SetShellVarContext all
#Verify the uninstaller - last chance to back out
MessageBox MB_OKCANCEL "Permanantly remove Janet?" IDOK next
Abort
next:
!insertmacro MULTIUSER_UNINIT
functionEnd
section "uninstall"
# Remove Start Menu launcher
delete "$SMPROGRAMS\Janet.lnk"
# Remove files
delete $INSTDIR\logo.ico
delete $INSTDIR\C\janet.c
delete $INSTDIR\C\janet.h
delete $INSTDIR\C\janet.lib
delete $INSTDIR\C\janet.exp
delete $INSTDIR\C\janetconf.h
delete $INSTDIR\bin\jpm.janet
delete $INSTDIR\bin\jpm.bat
delete $INSTDIR\bin\janet.exe
delete "$INSTDIR\logo.ico"
delete "$INSTDIR\README.md"
delete "$INSTDIR\LICENSE"
rmdir /r "$INSTDIR\Library"
rmdir /r "$INSTDIR\bin"
rmdir /r "$INSTDIR\C"
rmdir /r "$INSTDIR\docs"
delete $INSTDIR\Library\cook.janet
# Remove env vars
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_BINPATH
DeleteRegValue HKCU "Environment" JANET_PATH
DeleteRegValue HKCU "Environment" JANET_HEADERPATH
DeleteRegValue HKCU "Environment" JANET_BINPATH
!insertmacro DelEnv JANET_PATH
!insertmacro DelEnv JANET_HEADERPATH
!insertmacro DelEnv JANET_BINPATH
# Unset PATH
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
# make sure windows knows about the change
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
# Always delete uninstaller as the last action
delete $INSTDIR\uninstall.exe
rmDir "$INSTDIR\Library"
rmDir "$INSTDIR\C"
rmDir "$INSTDIR\bin"
delete "$INSTDIR\uninstall.exe"
# Remove uninstaller information from the registry
DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet"
DeleteRegKey SHCTX "${UNINST_KEY}"
sectionEnd

View File

@@ -73,7 +73,7 @@ Don't execute a script, only compile it to check for errors. Useful for linting
.TP
.BR \-m\ syspath
Set the variable module/*syspath* to the string syspath so that Janet will load system modules
Set the dynamic binding :syspath to the string syspath so that Janet will load system modules
from a directory different than the default. The default is set when Janet is built, and defaults to
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.

View File

@@ -18,7 +18,9 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
project('janet', 'c', default_options : ['c_std=c99'])
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.0.0-dev')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -29,14 +31,47 @@ cc = meson.get_compiler('c')
m_dep = cc.find_library('m', required : false)
dl_dep = cc.find_library('dl', required : false)
# Some options
add_project_link_arguments('-rdynamic', language : 'c')
# Link options
if build_machine.system() != 'windows'
add_project_link_arguments('-rdynamic', language : 'c')
endif
# Generate custom janetconf.h
conf = configuration_data()
version_parts = meson.project_version().split('.')
last_parts = version_parts[2].split('-')
if last_parts.length() > 1
conf.set_quoted('JANET_VERSION_EXTRA', '-' + last_parts[1])
else
conf.set_quoted('JANET_VERSION_EXTRA', '')
endif
conf.set('JANET_VERSION_MAJOR', version_parts[0].to_int())
conf.set('JANET_VERSION_MINOR', version_parts[1].to_int())
conf.set('JANET_VERSION_PATCH', last_parts[0].to_int())
conf.set_quoted('JANET_VERSION', meson.project_version())
# Use options
conf.set_quoted('JANET_BUILD', get_option('git_hash'))
conf.set('JANET_NO_NANBOX', not get_option('nanbox'))
conf.set('JANET_SINGLE_THREADED', not get_option('single_threaded'))
conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules'))
conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
conf.set('JANET_NO_PEG', not get_option('peg'))
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
conf.set('JANET_STACK_MAX', get_option('stack_max'))
jconf = configure_file(output : 'janetconf.h',
configuration : conf)
# Include directories
incdir = include_directories('src/include')
incdir = include_directories(['src/include', '.'])
# Building generated sources
xxd = executable('xxd', 'tools/xxd.c')
xxd = executable('xxd', 'tools/xxd.c', native : true)
gen = generator(xxd,
output : '@BASENAME@.gen.c',
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
@@ -114,7 +149,8 @@ mainclient_src = [
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
include_directories : incdir,
c_args : '-DJANET_BOOTSTRAP',
dependencies : [m_dep, dl_dep])
dependencies : [m_dep, dl_dep],
native : true)
# Build core image
core_image = custom_target('core_image',
@@ -122,29 +158,38 @@ core_image = custom_target('core_image',
output : 'core_image.gen.c',
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
libjanet = shared_library('janet', core_src, core_image,
libjanet = library('janet', core_src, core_image,
include_directories : incdir,
dependencies : [m_dep, dl_dep],
install : true)
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep],
install : true)
janet_jpm = install_data('tools/jpm', install_dir : 'bin')
if meson.is_cross_build()
janet_nativeclient = executable('janet-native', core_src, core_image, init_gen, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep],
native : true)
else
janet_nativeclient = janet_mainclient
endif
# Documentation
docs = custom_target('docs',
input : ['tools/gendoc.janet'],
output : ['doc.html'],
capture : true,
command : [janet_mainclient, '@INPUT@'])
command : [janet_nativeclient, '@INPUT@'])
# Amalgamated source
amalg = custom_target('amalg',
input : ['tools/amalg.janet', core_headers, core_src, core_image],
output : ['janet.c'],
capture : true,
command : [janet_mainclient, '@INPUT@'])
command : [janet_nativeclient, '@INPUT@'])
# Amalgamated client
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
@@ -163,18 +208,25 @@ test_files = [
'test/suite6.janet'
]
foreach t : test_files
test(t, janet_mainclient, args : files([t]), workdir : meson.current_source_dir())
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
endforeach
# Repl
run_target('repl', command : [janet_mainclient])
run_target('repl', command : [janet_nativeclient])
# For use as meson subproject (wrap)
janet_dep = declare_dependency(include_directories : incdir,
link_with : libjanet)
# Installation
install_man('janet.1')
install_headers('src/include/janet.h', 'src/include/janetconf.h', subdir: 'janet')
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
janet_libs = [
'tools/bars.janet',
'tools/cook.janet',
'tools/highlight.janet'
'auxlib/cook.janet',
'auxlib/path.janet'
]
janet_binscripts = [
'auxbin/jpm'
]
install_data(sources : janet_libs, install_dir : janet_path)
install_data(sources : janet_binscripts, install_dir : 'bin')

17
meson_options.txt Normal file
View File

@@ -0,0 +1,17 @@
option('git_hash', type : 'string', value : 'meson')
option('single_threaded', type : 'boolean', value : false)
option('nanbox', type : 'boolean', value : true)
option('dynamic_modules', type : 'boolean', value : true)
option('docstrings', type : 'boolean', value : true)
option('sourcemaps', type : 'boolean', value : true)
option('reduced_os', type : 'boolean', value : true)
option('assembler', type : 'boolean', value : true)
option('peg', type : 'boolean', value : true)
option('typed_array', type : 'boolean', value : true)
option('int_types', type : 'boolean', value : true)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
option('max_macro_expand', type : 'integer', min : 1, max : 8000, value : 200)
option('stack_max', type : 'integer', min : 8096, max : 1000000000, value : 16384)

View File

@@ -52,8 +52,24 @@ int main(int argc, const char **argv) {
janet_array_push(args, janet_cstringv(argv[i]));
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
/* Add in options from janetconf.h so boot.janet can configure the image as needed. */
JanetTable *opts = janet_table(0);
#ifdef JANET_NO_DOCSTRINGS
janet_table_put(opts, janet_ckeywordv("no-docstrings"), janet_wrap_true());
#endif
#ifdef JANET_NO_SOURCEMAPS
janet_table_put(opts, janet_ckeywordv("no-sourcemaps"), janet_wrap_true());
#endif
janet_def(env, "process/config", janet_wrap_table(opts), "Boot options");
/* Run bootstrap script to generate core image */
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
const char *boot_file;
#ifdef JANET_NO_SOURCEMAPS
boot_file = NULL;
#else
boot_file = "boot.janet";
#endif
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
/* Deinitialize vm */
janet_deinit();

View File

@@ -8,7 +8,7 @@
###
(def defn :macro
"(def name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
"(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
(fn defn [name & more]
(def len (length more))
(def modifiers @[])
@@ -325,6 +325,7 @@
(keyword? binding)
(let [rest (loop1 body head (+ i 2))]
(case binding
:until ~(do (if ,verb (break) nil) ,rest)
:while ~(do (if ,verb nil (break)) ,rest)
:let ~(let ,verb (do ,rest))
:after ~(do ,rest ,verb nil)
@@ -387,6 +388,7 @@
where :modifier is one of a set of keywords, and argument is keyword dependent.
:modifier can be one of:\n\n
\t:while expression - breaks from the loop if expression is falsey.\n
\t:until expression - breaks from the loop if expression is truthy.\n
\t:let bindings - defines bindings inside the loop as passed to the let macro.\n
\t:before form - evaluates a form for a side effect before of the next inner loop.\n
\t:after form - same as :before, but the side effect happens after the next inner loop.\n
@@ -859,12 +861,10 @@
or signals, but the dynamic bindings will be properly
unset, as dynamic bindings are fiber local."
[bindings & body]
(with-syms [currenv env fib]
~(let [,currenv (,fiber/getenv (,fiber/current))
,env (,table/setproto (,table ,;bindings) ,currenv)
,fib (,fiber/new (fn [] ,;body) :)]
(,fiber/setenv ,fib ,env)
(,resume ,fib))))
(def dyn-forms
(seq [i :range [0 (length bindings) 2]]
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
(defn partial
"Partial function application."
@@ -1088,6 +1088,12 @@
[f & args]
(file/write stdout (buffer/format @"" f ;args)))
(defn pp
"Pretty print to stdout."
[x]
(print (buffer/format @"" (dyn :pretty-format "%p") x)))
###
###
### Pattern Matching
@@ -1126,8 +1132,8 @@
(put seen pattern true)
~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
(tuple? pattern)
(if (and (= (pattern 0) 'quote) (symbol? (pattern 1)))
(and (tuple? pattern) (= :parens (tuple/type pattern)))
(if (and (= (pattern 0) '@) (symbol? (pattern 1)))
# Unification with external values
~(if (= ,(pattern 1) ,expr) ,(onmatch) ,sentinel)
(match-1
@@ -1135,7 +1141,7 @@
(fn []
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
(array? pattern)
(indexed? pattern)
(do
(def len (length pattern))
(var i -1)
@@ -1406,11 +1412,6 @@
(set current (macex1 current)))
current)
(defn pp
"Pretty print to stdout."
[x]
(print (buffer/format @"" (dyn :pretty-format "%p") x)))
###
###
### Evaluation and Compilation
@@ -1577,42 +1578,39 @@
[image]
(unmarshal image (env-lookup _env)))
(def- nati (if (= :windows (os/which)) ".dll" ".so"))
(defn- check-. [x] (if (string/has-prefix? "." x) x))
(defn- not-check-. [x] (unless (string/has-prefix? "." x) x))
(def module/paths
"The list of paths to look for modules. The following
substitutions are preformed on each path. :sys: becomes
module/*syspath*, :name: becomes the last part of the module
name after the last /, and :all: is the module name literally.
:native: becomes the dynamic library file extension, usually dll
or so. Each element is a two element tuple, containing the path
"The list of paths to look for modules, templated for module/expand-path.
Each element is a two element tuple, containing the path
template and a keyword :source, :native, or :image indicating how
require should load files found at these paths.\n\nA tuple can also
contain a third element, specifying a filter that prevents module/find
from searching that path template if the filter doesn't match the input
path. The filter is often a file extension, including the period."
@[[":all:" :native (if (= (os/which) :windows) ".dll" ".so")]
[":all:" :image ".jimage"]
[":all:" :source]
["./:all:.janet" :source]
["./:all:/init.janet" :source]
[":sys:/:all:.janet" :source]
[":sys:/:all:/init.janet" :source]
["./:all:.:native:" :native]
["./:all:/:name:.:native:" :native]
[":sys:/:all:.:native:" :native]
["./:all:.jimage" :image]
[":sys:/:all:.jimage" :image]])
path. The filter can be a string or a predicate function, and
is often a file extension, including the period."
@[# Relative to (dyn :current-file "./."). Path must start with .
[":cur:/:all:.jimage" :image check-.]
[":cur:/:all:.janet" :source check-.]
[":cur:/:all:/init.janet" :source check-.]
[(string ":cur:/:all:" nati) :native check-.]
(var module/*syspath*
"The path where globally installed libraries are located.
The default is set at build time and is /usr/local/lib/janet on linux/posix, and
on Windows is the empty string."
(or (process/opts "JANET_PATH") ""))
# As a path from (os/cwd)
[":all:.jimage" :image not-check-.]
[":all:.janet" :source not-check-.]
[":all:/init.janet" :source not-check-.]
[(string ":all:" nati) :native not-check-.]
(var module/*headerpath*
"The path where the janet headers are installed. Useful for building
native modules or compiling code at runtime. Default on linux/posix is
/usr/local/include/janet, and on Windows is the empty string."
(or (process/opts "JANET_HEADERPATH") ""))
# System paths
[":sys:/:all:.jimage" :image not-check-.]
[":sys:/:all:.janet" :source not-check-.]
[":sys:/:all:/init.janet" :source not-check-.]
[(string ":sys:/:all:" nati) :native not-check-.]])
(setdyn :syspath (process/opts "JANET_PATH"))
(setdyn :headerpath (process/opts "JANET_HEADERPATH"))
# Version of fexists that works even with a reduced OS
(if-let [has-stat (_env 'os/stat)]
@@ -1628,14 +1626,6 @@
(file/close f)
res))))
(def nati (if (= :windows (os/which)) "dll" "so"))
(defn- expand-path-name
[template name path]
(->> template
(string/replace ":name:" name)
(string/replace ":sys:" module/*syspath*)
(string/replace ":native:" nati)
(string/replace ":all:" path)))
(defn- mod-filter
[x path]
(case (type x)
@@ -1649,8 +1639,6 @@
or image if the module is found, otherwise a tuple with nil followed by
an error message."
[path]
(def parts (string/split "/" path))
(def name (last parts))
(var ret nil)
(each [p mod-kind checker] module/paths
(when (mod-filter checker path)
@@ -1659,7 +1647,7 @@
(set ret [res mod-kind])
(break))
(do
(def fullpath (expand-path-name p name path))
(def fullpath (string (module/expand-path path p)))
(when (fexists fullpath)
(set ret [fullpath mod-kind])
(break))))))
@@ -1667,15 +1655,16 @@
(let [expander (fn [[t _ chk]]
(when (string? t)
(when (mod-filter chk path)
(expand-path-name t name path))))
(module/expand-path path t))))
paths (filter identity (map expander module/paths))
str-parts (interpose "\n " paths)]
[nil (string "could not find module " path ":\n " ;str-parts)])))
(put _env 'fexists nil)
(put _env 'nati nil)
(put _env 'expand-path-name nil)
(put _env 'mod-filter nil)
(put _env 'check-. nil)
(put _env 'not-check-. nil)
(def module/cache
"Table mapping loaded module identifiers to their environments."
@@ -1697,6 +1686,7 @@
path
(file/open path)))
(default env (make-env))
(put env :current-file (string path))
(defn chunks [buf _] (file/read f 2048 buf))
(defn bp [&opt x y]
(def ret (bad-parse x y))
@@ -1736,16 +1726,15 @@
module/paths, then the path as a raw file path. Returns the new environment
returned from compiling and running the file."
[path & args]
(if-let [check (get module/cache path)]
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(if-let [check (get module/cache fullpath)]
check
(do
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(def loader (module/loaders mod-kind))
(unless loader (error (string "module type " mod-kind " unknown")))
(def env (loader fullpath args))
(put module/cache fullpath env)
(put module/cache path env)
env)))
(defn import*
@@ -1789,7 +1778,7 @@
(default chunks (fn [buf p] (getline (string "repl:"
(parser/where p)
":"
(parser/state p) "> ")
(parser/state p :delimiters) "> ")
buf)))
(default onsignal (fn [f x]
(case (fiber/status f)
@@ -1807,7 +1796,7 @@ _fiber is bound to the suspended fiber
```)
(repl (fn [buf p]
(def status (parser/state p))
(def status (parser/state p :delimiters))
(def c (parser/where p))
(def prompt (string "debug[" level "]:" c ":" status "> "))
(getline prompt buf))
@@ -1819,8 +1808,8 @@ _fiber is bound to the suspended fiber
:source "repl"}))
(defn- env-walk
[pred]
(def env (fiber/getenv (fiber/current)))
[pred &opt env]
(default env (fiber/getenv (fiber/current)))
(def envs @[])
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
(def ret-set @{})
@@ -1831,14 +1820,16 @@ _fiber is bound to the suspended fiber
(sort (keys ret-set)))
(defn all-bindings
"Get all symbols available in the current environment."
[]
(env-walk symbol?))
"Get all symbols available in an enviroment. Defaults to the current
fiber's environment."
[&opt env]
(env-walk symbol? env))
(defn all-dynamics
"Get all dynamic bindings in the current fiber."
[]
(env-walk keyword?))
"Get all dynamic bindings in an environment. Defaults to the current
fiber's environment."
[&opt env]
(env-walk keyword? env))
# Clean up some extra defs
(put _env 'process/opts nil)
@@ -1852,7 +1843,29 @@ _fiber is bound to the suspended fiber
###
(do
(defn proto-flatten
"Flatten a table and it's prototypes into a single table."
[into x]
(when x
(proto-flatten into (table/getproto x))
(loop [k :keys x]
(put into k (x k))))
into)
(def env (fiber/getenv (fiber/current)))
# Modify env based on some options.
(loop [[k v] :pairs env
:when (symbol? k)]
(def flat (proto-flatten @{} v))
(when (process/config :no-docstrings)
(put flat :doc nil))
(when (process/config :no-sourcemaps)
(put flat :source-map nil))
(put env k flat))
(put env 'process/config nil)
(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))

View File

@@ -20,12 +20,17 @@
* IN THE SOFTWARE.
*/
/* Configure Janet. Edit this file to customize the build */
/* This is an example janetconf.h file. This will be usually generated
* by the build system. */
#ifndef JANETCONF_H
#define JANETCONF_H
#define JANET_VERSION "0.6.0"
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 0
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.0.0-dev"
/* #define JANET_BUILD "local" */
@@ -35,11 +40,17 @@
/* #define JANET_NO_NANBOX */
/* #define JANET_API __attribute__((visibility ("default"))) */
/* These settings should be specified before amalgamation is
* built. */
/* #define JANET_NO_DOCSTRINGS */
/* #define JANET_NO_SOURCEMAPS */
/* #define JANET_REDUCED_OS */
/* Other settings */
/* #define JANET_NO_ASSEMBLER */
/* #define JANET_NO_PEG */
/* #define JANET_NO_TYPED_ARRAY */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_REDUCED_OS */
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
/* #define JANET_RECURSION_GUARD 1024 */
/* #define JANET_MAX_PROTO_DEPTH 200 */

View File

@@ -26,10 +26,19 @@
#endif
/* Create new userdata */
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_NONE,
sizeof(JanetAbstractHead) + size);
header->size = size;
header->type = atype;
return (void *) & (header->data);
}
void *janet_abstract_end(void *x) {
janet_gc_settype((void *)(janet_gc_header(x)), JANET_MEMORY_ABSTRACT);
return x;
}
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
return janet_abstract_end(janet_abstract_begin(atype, size));
}

View File

@@ -28,8 +28,9 @@
#include <string.h>
/* Initializes an array */
JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
/* Creates a new array */
JanetArray *janet_array(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
Janet *data = NULL;
if (capacity > 0) {
data = (Janet *) malloc(sizeof(Janet) * capacity);
@@ -43,16 +44,6 @@ JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
return array;
}
void janet_array_deinit(JanetArray *array) {
free(array->data);
}
/* Creates a new array */
JanetArray *janet_array(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
return janet_array_init(array, capacity);
}
/* Creates a new array from n elements. */
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
@@ -273,7 +264,7 @@ static const JanetReg array_cfuns[] = {
},
{
"array/slice", cfun_array_slice,
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
JDOC("(array/slice arrtup &opt start end)\n\n"
"Takes a slice of array or tuple from start to end. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
"end of the array. By default, start is 0 and end is the length of the array. "
@@ -297,9 +288,10 @@ static const JanetReg array_cfuns[] = {
},
{
"array/remove", cfun_array_remove,
JDOC("(array/remove arr at [, n=1])\n\n"
JDOC("(array/remove arr at &opt n)\n\n"
"Remove up to n elements starting at index at in array arr. at can index from "
"the end of the array with a negative index, and n must be a non-negative integer. "
"By default, n is 1. "
"Returns the array.")
},
{NULL, NULL, NULL}

View File

@@ -346,8 +346,8 @@ static const JanetReg buffer_cfuns[] = {
},
{
"buffer/new-filled", cfun_buffer_new_filled,
JDOC("(buffer/new-filled count [, byte=0])\n\n"
"Creates a new buffer of length count filled with byte. "
JDOC("(buffer/new-filled count &opt byte)\n\n"
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
"Returns the new buffer.")
},
{
@@ -383,7 +383,7 @@ static const JanetReg buffer_cfuns[] = {
},
{
"buffer/slice", cfun_buffer_slice,
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
JDOC("(buffer/slice bytes &opt start end)\n\n"
"Takes a slice of a byte sequence from start to end. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
"end of the array. By default, start is 0 and end is the length of the buffer. "
@@ -411,7 +411,7 @@ static const JanetReg buffer_cfuns[] = {
},
{
"buffer/blit", cfun_buffer_blit,
JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\n\n"
JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
"Insert the contents of src into dest. Can optionally take indices that "
"indicate which part of src to copy into which part of dest. Indices can be "
"negative to index from the end of src or dest. Returns dest.")

View File

@@ -26,16 +26,6 @@
#include "fiber.h"
#endif
static JanetBuildConfig *api_build_config = &(JanetBuildConfig) {
.api_version = JANET_API_VERSION,
.single_threaded = JANET_SINGLE_THREADED_BIT,
.nanbox = JANET_NANBOX_BIT
};
const JanetBuildConfig *janet_build_config() {
return api_build_config;
}
void janet_panicv(Janet message) {
if (janet_vm_return_reg != NULL) {
*janet_vm_return_reg = message;
@@ -70,7 +60,7 @@ void janet_printf(const char *format, ...) {
va_start(args, format);
janet_formatb(&buffer, format, args);
va_end(args);
fwrite(buffer.data, buffer.count, 1, stdout);
fwrite(buffer.data, buffer.count, 1, janet_dynfile("out", stdout));
janet_buffer_deinit(&buffer);
}
@@ -260,6 +250,28 @@ void janet_setdyn(const char *name, Janet value) {
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
uint64_t ret = 0;
const uint8_t *keyw = janet_getkeyword(argv, n);
int32_t klen = janet_string_length(keyw);
int32_t flen = (int32_t) strlen(flags);
if (flen > 64) {
flen = 64;
}
for (int32_t j = 0; j < klen; j++) {
for (int32_t i = 0; i < flen; i++) {
if (((uint8_t) flags[i]) == keyw[j]) {
ret |= 1ULL << i;
goto found;
}
}
janet_panicf("unexpected flag %c, expected one of \"%s\"", (char) keyw[j], flags);
found:
;
}
return ret;
}
/* Some definitions for function-like macros */
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {

View File

@@ -35,6 +35,10 @@ static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 1;
}
static int maxarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) <= 1;
}
static int minarity2(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) >= 2;
@@ -115,7 +119,11 @@ static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_LENGTH, args[0]);
}
static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
return genericSSI(opts, JOP_SIGNAL, args[0], 3);
if (janet_v_count(args) == 0) {
return genericSSI(opts, JOP_SIGNAL, janetc_cslot(janet_wrap_nil()), 3);
} else {
return genericSSI(opts, JOP_SIGNAL, args[0], 3);
}
}
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
@@ -262,7 +270,7 @@ static const JanetFunOptimizer optimizers[] = {
{fixarity0, do_debug},
{fixarity1, do_error},
{minarity2, do_apply},
{fixarity1, do_yield},
{maxarity1, do_yield},
{fixarity2, do_resume},
{fixarity2, do_get},
{fixarity3, do_put},

View File

@@ -629,7 +629,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
}
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
janet_v__cnt(c->buffer) = scope->bytecode_start;
if (NULL != c->mapbuffer) {
if (NULL != c->mapbuffer && c->source) {
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
def->sourcemap = malloc(s);
if (NULL == def->sourcemap) {

View File

@@ -57,18 +57,176 @@ typedef void *Clib;
JanetModule janet_native(const char *name, const uint8_t **error) {
Clib lib = load_clib(name);
JanetModule init;
JanetModconf getter;
if (!lib) {
*error = janet_cstring(error_clib());
return NULL;
}
init = (JanetModule) symbol_clib(lib, "_janet_init");
if (!init) {
*error = janet_cstring("could not find _janet_init symbol");
*error = janet_cstring("could not find the _janet_init symbol");
return NULL;
}
getter = (JanetModconf) symbol_clib(lib, "_janet_mod_config");
if (!getter) {
*error = janet_cstring("could not find the _janet_mod_config symbol");
return NULL;
}
JanetBuildConfig modconf = getter();
JanetBuildConfig host = janet_config_current();
if (host.major != modconf.major ||
host.minor < modconf.minor ||
host.bits != modconf.bits) {
char errbuf[128];
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
*error = janet_cstring(errbuf);
return NULL;
}
return init;
}
static const char *janet_dyncstring(const char *name, const char *dflt) {
Janet x = janet_dyn(name);
if (janet_checktype(x, JANET_NIL)) return dflt;
if (!janet_checktype(x, JANET_STRING)) {
janet_panicf("expected string, got %v", x);
}
const uint8_t *jstr = janet_unwrap_string(x);
const char *cstr = (const char *)jstr;
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
janet_panicf("string %v contains embedded 0s");
}
return cstr;
}
static int is_path_sep(char c) {
#ifdef JANET_WINDOWS
if (c == '\\') return 1;
#endif
return c == '/';
}
/* Used for module system. */
static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
const char *input = janet_getcstring(argv, 0);
const char *template = janet_getcstring(argv, 1);
const char *curfile = janet_dyncstring("current-file", "");
const char *syspath = janet_dyncstring("syspath", "");
JanetBuffer *out = janet_buffer(0);
size_t tlen = strlen(template);
/* Calculate name */
const char *name = input + strlen(input);
while (name > input) {
if (is_path_sep(*(name - 1))) break;
name--;
}
/* Calculate dirpath from current file */
const char *curname = curfile + strlen(curfile);
while (curname > curfile) {
if (is_path_sep(*curname)) break;
curname--;
}
const char *curdir;
int32_t curlen;
if (curname == curfile) {
/* Current file has one or zero path segments, so
* we are in the . directory. */
curdir = ".";
curlen = 1;
} else {
/* Current file has 2 or more segments, so we
* can cut off the last segment. */
curdir = curfile;
curlen = (int32_t)(curname - curfile);
}
for (size_t i = 0; i < tlen; i++) {
if (template[i] == ':') {
if (strncmp(template + i, ":all:", 5) == 0) {
janet_buffer_push_cstring(out, input);
i += 4;
} else if (strncmp(template + i, ":cur:", 5) == 0) {
janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen);
i += 4;
} else if (strncmp(template + i, ":dir:", 5) == 0) {
janet_buffer_push_bytes(out, (const uint8_t *)input,
(int32_t)(name - input));
i += 4;
} else if (strncmp(template + i, ":sys:", 5) == 0) {
janet_buffer_push_cstring(out, syspath);
i += 4;
} else if (strncmp(template + i, ":name:", 6) == 0) {
janet_buffer_push_cstring(out, name);
i += 5;
} else {
janet_buffer_push_u8(out, (uint8_t) template[i]);
}
} else {
janet_buffer_push_u8(out, (uint8_t) template[i]);
}
}
/* Normalize */
uint8_t *scan = out->data;
uint8_t *print = scan;
uint8_t *scanend = scan + out->count;
int normal_section_count = 0;
int dot_count = 0;
while (scan < scanend) {
if (*scan == '.') {
if (dot_count >= 0) {
dot_count++;
} else {
*print++ = '.';
}
} else if (is_path_sep(*scan)) {
if (dot_count == 1) {
;
} else if (dot_count == 2) {
if (normal_section_count > 0) {
/* unprint last separator */
print--;
/* unprint last section */
while (print > out->data && !is_path_sep(*(print - 1)))
print--;
normal_section_count--;
} else {
*print++ = '.';
*print++ = '.';
*print++ = '/';
}
} else if (scan == out->data || dot_count != 0) {
while (dot_count > 0) {
--dot_count;
*print++ = '.';
}
if (scan > out->data) {
normal_section_count++;
}
*print++ = '/';
}
dot_count = 0;
} else {
dot_count = -1;
*print++ = *scan;
}
scan++;
}
out->count = (int32_t)(print - out->data);
return janet_wrap_buffer(out);
}
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
Janet value;
@@ -251,19 +409,21 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
}
static Janet janet_core_getline(int32_t argc, Janet *argv) {
FILE *in = janet_dynfile("in", stdin);
FILE *out = janet_dynfile("out", stdout);
janet_arity(argc, 0, 2);
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
if (argc >= 1) {
const char *prompt = (const char *) janet_getstring(argv, 0);
printf("%s", prompt);
fflush(stdout);
fprintf(out, "%s", prompt);
fflush(out);
}
{
buf->count = 0;
int c;
for (;;) {
c = fgetc(stdin);
if (feof(stdin) || c < 0) {
c = fgetc(in);
if (feof(in) || c < 0) {
break;
}
janet_buffer_push_u8(buf, (uint8_t) c);
@@ -290,7 +450,7 @@ static Janet janet_core_untrace(int32_t argc, Janet *argv) {
static const JanetReg corelib_cfuns[] = {
{
"native", janet_core_native,
JDOC("(native path [,env])\n\n"
JDOC("(native path &opt env)\n\n"
"Load a native module from the given path. The path "
"must be an absolute or relative path on the file system, and is "
"usually a .so file on Unix systems, and a .dll file on Windows. "
@@ -416,7 +576,7 @@ static const JanetReg corelib_cfuns[] = {
},
{
"next", janet_core_next,
JDOC("(next dict key)\n\n"
JDOC("(next dict &opt key)\n\n"
"Gets the next key in a struct or table. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if they data structure is not mutated "
@@ -432,14 +592,14 @@ static const JanetReg corelib_cfuns[] = {
},
{
"getline", janet_core_getline,
JDOC("(getline [, prompt=\"\" [, buffer=@\"\"]])\n\n"
JDOC("(getline &opt prompt buf)\n\n"
"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.")
JDOC("(dyn key &opt default)\n\n"
"Get a dynamic binding. Returns the default value (or nil) if no binding found.")
},
{
"setdyn", janet_core_setdyn,
@@ -456,6 +616,14 @@ static const JanetReg corelib_cfuns[] = {
JDOC("(untrace func)\n\n"
"Disables tracing on a function. Returns the function.")
},
{
"module/expand-path", janet_core_expand_path,
JDOC("(module/expand-path path template)\n\n"
"Expands a path template as found in module/paths for module/find. "
"This takes in a path (the argument to require) and a template string, template, "
"to expand the path to a path that can be "
"used for importing files.")
},
{NULL, NULL, NULL}
};
@@ -830,6 +998,9 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("The version number of the running janet program."));
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
JDOC("The build identifier of the running janet program."));
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
JDOC("The flag set of config options from janetconf.h which is used to check "
"if native modules are compatible with the host program."));
/* Allow references to the environment */
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));

View File

@@ -323,14 +323,14 @@ static const JanetReg debug_cfuns[] = {
},
{
"debug/fbreak", cfun_debug_fbreak,
JDOC("(debug/fbreak fun [,pc=0])\n\n"
JDOC("(debug/fbreak fun &opt pc)\n\n"
"Set a breakpoint in a given function. pc is an optional offset, which "
"is in bytecode instructions. fun is a function value. Will throw an error "
"if the offset is too large or negative.")
},
{
"debug/unfbreak", cfun_debug_unfbreak,
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
JDOC("(debug/unfbreak fun &opt pc)\n\n"
"Unset a breakpoint set with debug/fbreak.")
},
{

View File

@@ -391,6 +391,13 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
}
fiber->env = janet_vm_fiber->env;
break;
case 'p':
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(0);
}
fiber->env = janet_table(0);
fiber->env->proto = janet_vm_fiber->env;
break;
}
}
}
@@ -431,7 +438,7 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
static const JanetReg fiber_cfuns[] = {
{
"fiber/new", cfun_fiber_new,
JDOC("(fiber/new func [,sigmask])\n\n"
JDOC("(fiber/new func &opt sigmask)\n\n"
"Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber "
"when called. The mask is specified as a keyword where each character "
@@ -445,8 +452,11 @@ 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\n"
"\ti - inherit the environment from the current fiber (not related to signals)")
"\t0-9 - block a specific user signal\n\n"
"The sigmask argument also can take environment flags. If any mutually "
"exclusive flags are present, the last flag takes precedence.\n\n"
"\ti - inherit the environment from the current fiber\n"
"\tp - the environment table's prototype is the current environment table")
},
{
"fiber/status", cfun_fiber_status,

View File

@@ -39,6 +39,11 @@ JANET_THREAD_LOCAL Janet *janet_vm_roots;
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
/* Scratch Memory */
JANET_THREAD_LOCAL void **janet_scratch_mem;
JANET_THREAD_LOCAL size_t janet_scratch_cap;
JANET_THREAD_LOCAL size_t janet_scratch_len;
/* Helpers for marking the various gc types */
static void janet_mark_funcenv(JanetFuncEnv *env);
static void janet_mark_funcdef(JanetFuncDef *def);
@@ -257,10 +262,10 @@ static void janet_deinit_block(JanetGCObject *mem) {
janet_symbol_deinit(((JanetStringHead *) mem)->data);
break;
case JANET_MEMORY_ARRAY:
janet_array_deinit((JanetArray *) mem);
free(((JanetArray *) mem)->data);
break;
case JANET_MEMORY_TABLE:
janet_table_deinit((JanetTable *) mem);
free(((JanetTable *) mem)->data);
break;
case JANET_MEMORY_FIBER:
free(((JanetFiber *)mem)->data);
@@ -342,6 +347,13 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
return (void *)mem;
}
/* Free all allocated scratch memory */
static void janet_free_all_scratch(void) {
for (size_t i = 0; i < janet_scratch_len; i++)
free(janet_scratch_mem[i]);
janet_scratch_len = 0;
}
/* Run garbage collection */
void janet_collect(void) {
uint32_t i;
@@ -356,6 +368,7 @@ void janet_collect(void) {
}
janet_sweep();
janet_vm_next_collection = 0;
janet_free_all_scratch();
}
/* Add a root value to the GC. This prevents the GC from removing a value
@@ -429,6 +442,8 @@ void janet_clear_memory(void) {
current = next;
}
janet_vm_blocks = NULL;
janet_free_all_scratch();
free(janet_scratch_mem);
}
/* Primitives for suspending GC. */
@@ -438,3 +453,56 @@ int janet_gclock(void) {
void janet_gcunlock(int handle) {
janet_vm_gc_suspend = handle;
}
/* Scratch memory API */
void *janet_smalloc(size_t size) {
void *mem = malloc(size);
if (NULL == mem) {
JANET_OUT_OF_MEMORY;
}
if (janet_scratch_len == janet_scratch_cap) {
size_t newcap = 2 * janet_scratch_cap + 2;
void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
if (NULL == newmem) {
JANET_OUT_OF_MEMORY;
}
janet_scratch_cap = newcap;
janet_scratch_mem = newmem;
}
janet_scratch_mem[janet_scratch_len++] = mem;
return mem;
}
void *janet_srealloc(void *mem, size_t size) {
if (NULL == mem) return janet_smalloc(size);
if (janet_scratch_len) {
for (size_t i = janet_scratch_len - 1; ; i--) {
if (janet_scratch_mem[i] == mem) {
void *newmem = realloc(mem, size);
if (NULL == newmem) {
JANET_OUT_OF_MEMORY;
}
janet_scratch_mem[i] = newmem;
return newmem;
}
if (i == 0) break;
}
}
janet_exit("invalid janet_srealloc");
}
void janet_sfree(void *mem) {
if (NULL == mem) return;
if (janet_scratch_len) {
for (size_t i = janet_scratch_len - 1; ; i--) {
if (janet_scratch_mem[i] == mem) {
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
free(mem);
return;
}
if (i == 0) break;
}
}
janet_exit("invalid janet_sfree");
}

View File

@@ -32,6 +32,10 @@
#include "util.h"
#endif
#ifndef JANET_WINDOWS
#include <sys/wait.h>
#endif
#define IO_WRITE 1
#define IO_READ 2
#define IO_APPEND 4
@@ -160,6 +164,36 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
return f ? makef(f, flags) : janet_wrap_nil();
}
static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const int fd = janet_getinteger(argv, 0);
const uint8_t *fmode;
int flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
flags = checkflags(fmode);
} else {
fmode = (const uint8_t *)"r";
flags = IO_READ;
}
#ifdef JANET_WINDOWS
#define fdopen _fdopen
#endif
FILE *f = fdopen(fd, (const char *)fmode);
return f ? makef(f, flags) : janet_wrap_nil();
}
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
if (iof->flags & IO_CLOSED)
janet_panic("file is closed");
#ifdef JANET_WINDOWS
#define fileno _fileno
#endif
return janet_wrap_integer(fileno(iof->file));
}
/* Read up to n bytes into buffer. */
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
if (!(iof->flags & (IO_READ | IO_UPDATE)))
@@ -374,7 +408,7 @@ static const JanetReg io_cfuns[] = {
},
{
"file/open", cfun_io_fopen,
JDOC("(file/open path [,mode])\n\n"
JDOC("(file/open path &opt mode)\n\n"
"Open a file. path is an absolute or relative path, and "
"mode is a set of flags indicating the mode to open the file in. "
"mode is a keyword where each character represents a flag. If the file "
@@ -386,6 +420,26 @@ static const JanetReg io_cfuns[] = {
"\tb - open the file in binary mode (rather than text mode)\n"
"\t+ - append to the file instead of overwriting it")
},
{
"file/fdopen", cfun_io_fdopen,
JDOC("(file/fdopen fd &opt mode)\n\n"
"Create a file from an fd. fd is a platform specific file descriptor, and "
"mode is a set of flags indicating the mode to open the file in. "
"mode is a keyword where each character represents a flag. If the file "
"cannot be opened, returns nil, otherwise returns the new file handle. "
"Mode flags:\n\n"
"\tr - allow reading from the file\n"
"\tw - allow writing to the file\n"
"\ta - append to the file\n"
"\tb - open the file in binary mode (rather than text mode)\n"
"\t+ - append to the file instead of overwriting it")
},
{
"file/fileno", cfun_io_fileno,
JDOC("(file/fileno f)\n\n"
"Return the underlying file descriptor for the file as a number."
"The meaning of this number is platform specific.")
},
{
"file/close", cfun_io_fclose,
JDOC("(file/close f)\n\n"
@@ -395,7 +449,7 @@ static const JanetReg io_cfuns[] = {
},
{
"file/read", cfun_io_fread,
JDOC("(file/read f what [,buf])\n\n"
JDOC("(file/read f what &opt buf)\n\n"
"Read a number of bytes from a file into a buffer. A buffer can "
"be provided as an optional fourth argument, otherwise a new buffer "
"is created. 'what' can either be an integer or a keyword. Returns the "
@@ -419,7 +473,7 @@ static const JanetReg io_cfuns[] = {
},
{
"file/seek", cfun_io_fseek,
JDOC("(file/seek f [,whence [,n]])\n\n"
JDOC("(file/seek f &opt whence n)\n\n"
"Jump to a relative location in the file. 'whence' must be one of\n\n"
"\t:cur - jump relative to the current file location\n"
"\t:set - jump relative to the beginning of the file\n"
@@ -430,7 +484,7 @@ static const JanetReg io_cfuns[] = {
},
{
"file/popen", cfun_io_popen,
JDOC("(file/popen path [,mode])\n\n"
JDOC("(file/popen path &opt mode)\n\n"
"Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process "

View File

@@ -328,11 +328,11 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
const JanetAbstractType *at = janet_abstract_type(abstract);
if (at->marshal) {
MARK_SEEN();
JanetMarshalContext context = {st, NULL, flags, NULL};
pushbyte(st, LB_ABSTRACT);
marshal_one(st, janet_csymbolv(at->name), flags + 1);
push64(st, (uint64_t) janet_abstract_size(abstract));
MARK_SEEN();
at->marshal(abstract, &context);
} else {
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
@@ -535,7 +535,6 @@ void janet_marshal(
st.rreg = rreg;
janet_table_init(&st.seen, 0);
marshal_one(&st, x, flags);
/* Clean up. See comment in janet_unmarshal about autoreleasing memory on panics.*/
janet_table_deinit(&st.seen);
janet_v_free(st.seen_envs);
janet_v_free(st.seen_defs);
@@ -543,7 +542,7 @@ void janet_marshal(
typedef struct {
jmp_buf err;
JanetArray lookup;
Janet *lookup;
JanetTable *reg;
JanetFuncEnv **lookup_envs;
JanetFuncDef **lookup_defs;
@@ -849,7 +848,7 @@ static const uint8_t *unmarshal_one_fiber(
fiber->env = NULL;
/* Push fiber to seen stack */
janet_array_push(&st->lookup, janet_wrap_fiber(fiber));
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
int32_t frame = 0;
@@ -1009,10 +1008,11 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
if (at == NULL) return NULL;
if (at->unmarshal) {
void *p = janet_abstract(at, (size_t) read64(st, &data));
JanetMarshalContext context = {NULL, st, flags, data};
at->unmarshal(p, &context);
*out = janet_wrap_abstract(p);
return data;
JanetMarshalContext context = {NULL, st, flags, data};
janet_v_push(st->lookup, *out);
at->unmarshal(p, &context);
return context.data;
}
return NULL;
}
@@ -1071,7 +1071,7 @@ static const uint8_t *unmarshal_one(
memcpy(&u.bytes, data + 1, sizeof(double));
#endif
*out = janet_wrap_number(u.d);
janet_array_push(&st->lookup, *out);
janet_v_push(st->lookup, *out);
return data + 9;
}
case LB_STRING:
@@ -1104,7 +1104,7 @@ static const uint8_t *unmarshal_one(
memcpy(buffer->data, data, len);
*out = janet_wrap_buffer(buffer);
}
janet_array_push(&st->lookup, *out);
janet_v_push(st->lookup, *out);
return data + len;
}
case LB_FIBER: {
@@ -1121,7 +1121,7 @@ static const uint8_t *unmarshal_one(
def->environments_length * sizeof(JanetFuncEnv));
func->def = def;
*out = janet_wrap_function(func);
janet_array_push(&st->lookup, *out);
janet_v_push(st->lookup, *out);
for (int32_t i = 0; i < def->environments_length; i++) {
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
}
@@ -1146,7 +1146,7 @@ static const uint8_t *unmarshal_one(
JanetArray *array = janet_array(len);
array->count = len;
*out = janet_wrap_array(array);
janet_array_push(&st->lookup, *out);
janet_v_push(st->lookup, *out);
for (int32_t i = 0; i < len; i++) {
data = unmarshal_one(st, data, array->data + i, flags + 1);
}
@@ -1159,7 +1159,7 @@ static const uint8_t *unmarshal_one(
data = unmarshal_one(st, data, tup + i, flags + 1);
}
*out = janet_wrap_tuple(janet_tuple_end(tup));
janet_array_push(&st->lookup, *out);
janet_v_push(st->lookup, *out);
} else if (lead == LB_STRUCT) {
/* Struct */
JanetKV *struct_ = janet_struct_begin(len);
@@ -1170,16 +1170,16 @@ static const uint8_t *unmarshal_one(
janet_struct_put(struct_, key, value);
}
*out = janet_wrap_struct(janet_struct_end(struct_));
janet_array_push(&st->lookup, *out);
janet_v_push(st->lookup, *out);
} else if (lead == LB_REFERENCE) {
if (len < 0 || len >= st->lookup.count)
if (len < 0 || len >= janet_v_count(st->lookup))
janet_panicf("invalid reference %d", len);
*out = st->lookup.data[len];
*out = st->lookup[len];
} else {
/* Table */
JanetTable *t = janet_table(len);
*out = janet_wrap_table(t);
janet_array_push(&st->lookup, *out);
janet_v_push(st->lookup, *out);
if (lead == LB_TABLE_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
@@ -1216,17 +1216,14 @@ Janet janet_unmarshal(
st.end = bytes + len;
st.lookup_defs = NULL;
st.lookup_envs = NULL;
st.lookup = NULL;
st.reg = reg;
janet_array_init(&st.lookup, 0);
Janet out;
const uint8_t *nextbytes = unmarshal_one(&st, bytes, &out, flags);
if (next) *next = nextbytes;
/* Clean up - this should be auto released on panics, TODO. We should
* change the vector implementation to track allocations for auto release, and
* make st.lookup auto release as well, or move to heap. */
janet_array_deinit(&st.lookup);
janet_v_free(st.lookup_defs);
janet_v_free(st.lookup_envs);
janet_v_free(st.lookup);
return out;
}
@@ -1267,7 +1264,7 @@ static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
static const JanetReg marsh_cfuns[] = {
{
"marshal", cfun_marshal,
JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n"
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
"Marshal a janet value into a buffer and return the buffer. The buffer "
"can the later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal "
@@ -1277,7 +1274,7 @@ static const JanetReg marsh_cfuns[] = {
},
{
"unmarshal", cfun_unmarshal,
JDOC("(unmarshal buffer [,lookup])\n\n"
JDOC("(unmarshal buffer &opt lookup)\n\n"
"Unmarshal a janet value from a buffer. An optional lookup table "
"can be provided to allow for aliases to be resolved. Returns the value "
"unmarshalled from the buffer.")

View File

@@ -41,12 +41,15 @@
#include <direct.h>
#include <sys/utime.h>
#include <io.h>
#include <process.h>
#else
#include <spawn.h>
#include <utime.h>
#include <unistd.h>
#include <dirent.h>
#include <sys/types.h>
#include <sys/wait.h>
extern char **environ;
#endif
/* For macos */
@@ -88,7 +91,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
}
#ifdef JANET_REDUCED_OS
/* Provide a dud os/getenv so init.janet works, but nothing else */
/* Provide a dud os/getenv so boot.janet and init.janet work, but nothing else */
static Janet os_getenv(int32_t argc, Janet *argv) {
(void) argv;
@@ -99,97 +102,224 @@ static Janet os_getenv(int32_t argc, Janet *argv) {
#else
/* Provide full os functionality */
#ifdef JANET_WINDOWS
static Janet os_execute(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_buffer(10);
for (int32_t i = 0; i < argc; i++) {
const uint8_t *argstring = janet_getstring(argv, i);
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
if (i != argc - 1) {
janet_buffer_push_u8(buffer, ' ');
/* Get env for os_execute */
static char **os_execute_env(int32_t argc, const Janet *argv) {
char **envp = NULL;
if (argc > 2) {
JanetDictView dict = janet_getdictionary(argv, 2);
envp = janet_smalloc(sizeof(char *) * (dict.len + 1));
int32_t j = 0;
for (int32_t i = 0; i < dict.cap; i++) {
const JanetKV *kv = dict.kvs + i;
if (!janet_checktype(kv->key, JANET_STRING)) continue;
if (!janet_checktype(kv->value, JANET_STRING)) continue;
const uint8_t *keys = janet_unwrap_string(kv->key);
const uint8_t *vals = janet_unwrap_string(kv->value);
int32_t klen = janet_string_length(keys);
int32_t vlen = janet_string_length(vals);
/* Check keys has no embedded 0s or =s. */
int skip = 0;
for (int32_t k = 0; k < klen; k++) {
if (keys[k] == '\0' || keys[k] == '=') {
skip = 1;
break;
}
}
if (skip) continue;
char *envitem = janet_smalloc(klen + vlen + 2);
memcpy(envitem, keys, klen);
envitem[klen] = '=';
memcpy(envitem + klen + 1, vals, vlen);
envitem[klen + vlen + 1] = 0;
envp[j++] = envitem;
}
envp[j] = NULL;
}
janet_buffer_push_u8(buffer, 0);
/* Convert to wide chars */
wchar_t *sys_str = malloc(buffer->count * sizeof(wchar_t));
if (NULL == sys_str) {
JANET_OUT_OF_MEMORY;
}
int nwritten = MultiByteToWideChar(
CP_UTF8,
MB_PRECOMPOSED,
buffer->data,
buffer->count,
sys_str,
buffer->count);
if (nwritten == 0) {
free(sys_str);
janet_panic("could not create process");
}
STARTUPINFO si;
PROCESS_INFORMATION pi;
ZeroMemory(&si, sizeof(si));
si.cb = sizeof(si);
ZeroMemory(&pi, sizeof(pi));
// Start the child process.
if (!CreateProcess(NULL,
(LPSTR) sys_str,
NULL,
NULL,
FALSE,
0,
NULL,
NULL,
&si,
&pi)) {
free(sys_str);
janet_panic("could not create process");
}
free(sys_str);
// Wait until child process exits.
WaitForSingleObject(pi.hProcess, INFINITE);
// Close process and thread handles.
WORD status;
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
return janet_wrap_integer(status);
return envp;
}
#else
static Janet os_execute(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
const char **child_argv = malloc(sizeof(char *) * (argc + 1));
int status = 0;
if (NULL == child_argv) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < argc; i++) {
child_argv[i] = janet_getcstring(argv, i);
}
child_argv[argc] = NULL;
/* Fork child process */
pid_t pid = fork();
if (pid < 0) {
janet_panic("failed to execute");
} else if (pid == 0) {
if (-1 == execve(child_argv[0], (char **)child_argv, NULL)) {
exit(1);
/* Free memory from os_execute */
static void os_execute_cleanup(char **envp, const char **child_argv) {
#ifdef JANET_WINDOWS
(void) child_argv;
#else
janet_sfree((void *)child_argv);
#endif
if (NULL != envp) {
char **envitem = envp;
while (*envitem != NULL) {
janet_sfree(*envitem);
envitem++;
}
}
janet_sfree(envp);
}
#ifdef JANET_WINDOWS
/* Windows processes created via CreateProcess get only one command line argument string, and
* must parse this themselves. Each processes is free to do this however they like, but the
* standard parsing method is CommandLineToArgvW. We need to properly escape arguments into
* a single string of this format. Returns a buffer that can be cast into a c string. */
static JanetBuffer *os_exec_escape(JanetView args) {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < args.len; i++) {
const char *arg = janet_getcstring(args.items, i);
/* Push leading space if not first */
if (i) janet_buffer_push_u8(b, ' ');
/* Find first special character */
const char *first_spec = arg;
while (*first_spec) {
switch (*first_spec) {
case ' ':
case '\t':
case '\v':
case '\n':
case '"':
goto found;
case '\0':
janet_panic("embedded 0 not allowed in command line string");
default:
first_spec++;
break;
}
}
found:
/* Check if needs escape */
if (*first_spec == '\0') {
/* No escape needed */
janet_buffer_push_cstring(b, arg);
} else {
/* Escape */
janet_buffer_push_u8(b, '"');
for (const char *c = arg; ; c++) {
unsigned numBackSlashes = 0;
while (*c == '\\') {
c++;
numBackSlashes++;
}
if (*c == '"') {
/* Escape all backslashes and double quote mark */
int32_t n = 2 * numBackSlashes + 1;
janet_buffer_extra(b, n + 1);
memset(b->data + b->count, '\\', n);
b->count += n;
janet_buffer_push_u8(b, '"');
} else if (*c) {
/* Don't escape backslashes. */
int32_t n = numBackSlashes;
janet_buffer_extra(b, n + 1);
memset(b->data + b->count, '\\', n);
b->count += n;
janet_buffer_push_u8(b, *c);
} else {
/* we finished Escape all backslashes */
int32_t n = 2 * numBackSlashes;
janet_buffer_extra(b, n + 1);
memset(b->data + b->count, '\\', n);
b->count += n;
break;
}
}
janet_buffer_push_u8(b, '"');
}
}
janet_buffer_push_u8(b, 0);
return b;
}
#endif
static Janet os_execute(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
/* Get flags */
uint64_t flags = 0;
if (argc > 1) {
flags = janet_getflags(argv, 1, "ep");
}
/* Get environment */
char **envp = os_execute_env(argc, argv);
/* Get arguments */
JanetView exargs = janet_getindexed(argv, 0);
if (exargs.len < 1) {
janet_panic("expected at least 1 command line argument");
}
/* Result */
int status = 0;
#ifdef JANET_WINDOWS
JanetBuffer *buf = os_exec_escape(exargs);
if (buf->count > 1025) {
janet_panic("command line string too long");
}
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
char *cargv[2] = {(char *) buf->data, NULL};
/* Use _spawn family of functions. */
/* Windows docs say do this before any spawns. */
_flushall();
/* Use an empty env instead when envp is NULL to be consistent with other implementation. */
char *empty_env[1] = {NULL};
char **envp1 = (NULL == envp) ? empty_env : envp;
if (janet_flag_at(flags, 1) && janet_flag_at(flags, 0)) {
status = (int) _spawnvpe(_P_WAIT, path, cargv, envp1);
} else if (janet_flag_at(flags, 1)) {
status = (int) _spawnvp(_P_WAIT, path, cargv);
} else if (janet_flag_at(flags, 0)) {
status = (int) _spawnve(_P_WAIT, path, cargv, envp1);
} else {
status = (int) _spawnv(_P_WAIT, path, cargv);
}
os_execute_cleanup(envp, NULL);
/* Check error */
if (-1 == status) {
janet_panic(strerror(errno));
}
return janet_wrap_integer(status);
#else
const char **child_argv = janet_smalloc(sizeof(char *) * (exargs.len + 1));
for (int32_t i = 0; i < exargs.len; i++)
child_argv[i] = janet_getcstring(exargs.items, i);
child_argv[exargs.len] = NULL;
/* Coerce to form that works for spawn. I'm fairly confident no implementation
* of posix_spawn would modify the argv array passed in. */
char *const *cargv = (char *const *)child_argv;
/* Use posix_spawn to spawn new process */
pid_t pid;
if (janet_flag_at(flags, 1)) {
status = posix_spawnp(&pid,
child_argv[0], NULL, NULL, cargv,
janet_flag_at(flags, 0) ? envp : environ);
} else {
status = posix_spawn(&pid,
child_argv[0], NULL, NULL, cargv,
janet_flag_at(flags, 0) ? envp : environ);
}
/* Wait for child */
if (status) {
os_execute_cleanup(envp, child_argv);
janet_panic(strerror(status));
} else {
waitpid(pid, &status, 0);
}
free(child_argv);
return janet_wrap_integer(status);
}
os_execute_cleanup(envp, child_argv);
return janet_wrap_integer(WEXITSTATUS(status));
#endif
}
static Janet os_shell(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 1);
@@ -623,7 +753,7 @@ static Janet os_rename(int32_t argc, Janet *argv) {
static const JanetReg os_cfuns[] = {
{
"os/exit", os_exit,
JDOC("(os/exit x)\n\n"
JDOC("(os/exit &opt x)\n\n"
"Exit from janet with an exit code equal to x. If x is not an integer, "
"the exit with status equal the hash of x.")
},
@@ -643,13 +773,13 @@ static const JanetReg os_cfuns[] = {
#ifndef JANET_REDUCED_OS
{
"os/dir", os_dir,
JDOC("(os/dir dir [, array])\n\n"
JDOC("(os/dir dir &opt array)\n\n"
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
"with only the filename or directory name and no prefix.")
},
{
"os/stat", os_stat,
JDOC("(os/stat path [, tab|key])\n\n"
JDOC("(os/stat path &opt tab|key)\n\n"
"Gets information about a file or directory. Returns a table If the third argument is a keyword, returns "
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
"\t:dev - the device that the file is on\n"
@@ -668,7 +798,7 @@ static const JanetReg os_cfuns[] = {
},
{
"os/touch", os_touch,
JDOC("(os/touch path [, actime [, modtime]])\n\n"
JDOC("(os/touch path &opt actime modtime)\n\n"
"Update the access time and modification times for a file. By default, sets "
"times to the current time.")
},
@@ -695,15 +825,21 @@ static const JanetReg os_cfuns[] = {
},
{
"os/link", os_link,
JDOC("(os/link oldpath newpath [, symlink])\n\n"
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
"Create a symlink from oldpath to newpath. The 3 optional paramater "
"enables a hard link over a soft link. Does not work on Windows.")
},
{
"os/execute", os_execute,
JDOC("(os/execute program & args)\n\n"
"Execute a program on the system and pass it string arguments. Returns "
"the exit status of the program.")
JDOC("(os/execute args &opts flags env)\n\n"
"Execute a program on the system and pass it string arguments. Flags "
"is a keyword that modifies how the program will execute.\n\n"
"\t:e - enables passing an environment to the program. Without :e, the "
"current environment is inherited.\n"
"\t:p - allows searching the current PATH for the binary to execute. "
"Without this flag, binaries must use absolute paths.\n\n"
"env is a table or struct mapping environment variables to values. "
"Returns the exit status of the program.")
},
{
"os/shell", os_shell,
@@ -740,7 +876,7 @@ static const JanetReg os_cfuns[] = {
},
{
"os/date", os_date,
JDOC("(os/date [,time])\n\n"
JDOC("(os/date &opt time)\n\n"
"Returns the given time as a date struct, or the current time if no time is given. "
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
"\t:seconds - number of seconds [0-61]\n"

View File

@@ -144,6 +144,8 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
#define PFLAG_LONGSTRING 0x4000
#define PFLAG_READERMAC 0x8000
#define PFLAG_ATSYM 0x10000
#define PFLAG_COMMENT 0x20000
#define PFLAG_TOKEN 0x40000
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
JanetParseState s;
@@ -357,7 +359,12 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
(void) state;
if (c == '\n') p->statecount--;
if (c == '\n') {
p->statecount--;
p->bufcount = 0;
} else {
push_buf(p, c);
}
return 1;
}
@@ -443,7 +450,7 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
(void) state;
p->statecount--;
switch (c) {
@@ -465,8 +472,8 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
default:
break;
}
pushstate(p, tokenchar, 0);
push_buf(p, '@'); /* Push the leading ampersand that was dropped */
pushstate(p, tokenchar, PFLAG_TOKEN);
push_buf(p, '@'); /* Push the leading at-sign that was dropped */
return 0;
}
@@ -479,7 +486,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
p->error = "unexpected character";
return 1;
}
pushstate(p, tokenchar, 0);
pushstate(p, tokenchar, PFLAG_TOKEN);
return 0;
case '\'':
case ',':
@@ -491,10 +498,10 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
pushstate(p, stringchar, PFLAG_STRING);
return 1;
case '#':
pushstate(p, comment, 0);
pushstate(p, comment, PFLAG_COMMENT);
return 1;
case '@':
pushstate(p, ampersand, 0);
pushstate(p, atsign, PFLAG_ATSYM);
return 1;
case '`':
pushstate(p, longstring, PFLAG_LONGSTRING);
@@ -634,6 +641,51 @@ void janet_parser_deinit(JanetParser *parser) {
free(parser->states);
}
void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
/* Misc fields */
dest->flag = src->flag;
dest->pending = src->pending;
dest->lookback = src->lookback;
dest->offset = src->offset;
dest->error = src->error;
/* Keep counts */
dest->argcount = src->argcount;
dest->bufcount = src->bufcount;
dest->statecount = src->statecount;
/* Capacities are equal to counts */
dest->bufcap = dest->bufcount;
dest->statecap = dest->statecount;
dest->argcap = dest->argcount;
/* Deep cloned fields */
dest->args = NULL;
dest->states = NULL;
dest->buf = NULL;
if (dest->bufcap) {
dest->buf = malloc(dest->bufcap);
if (!dest->buf) goto nomem;
}
if (dest->argcap) {
dest->args = malloc(sizeof(Janet) * dest->argcap);
if (!dest->args) goto nomem;
}
if (dest->statecap) {
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
if (!dest->states) goto nomem;
}
memcpy(dest->buf, src->buf, dest->bufcap);
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
return;
nomem:
JANET_OUT_OF_MEMORY;
}
int janet_parser_has_more(JanetParser *parser) {
return !!parser->pending;
}
@@ -801,43 +853,179 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
}
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
janet_arity(argc, 1, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
return janet_wrap_integer(p->offset);
if (argc > 1) {
int32_t offset = janet_getinteger(argv, 1);
p->offset = offset;
return argv[0];
} else {
return janet_wrap_integer(p->offset);
}
}
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
uint8_t *buff, uint32_t bufcount) {
JanetTable *state = janet_table(0);
const uint8_t *buffer;
int add_buffer = 0;
const char *type = NULL;
if (s->flags & PFLAG_CONTAINER) {
JanetArray *container_args = janet_array(s->argn);
container_args->count = s->argn;
memcpy(container_args->data, args, sizeof(args[0])*s->argn);
janet_table_put(state, janet_ckeywordv("args"),
janet_wrap_array(container_args));
}
if (s->flags & PFLAG_PARENS || s->flags & PFLAG_SQRBRACKETS) {
if (s->flags & PFLAG_ATSYM) {
type = "array";
} else {
type = "tuple";
}
} else if (s->flags & PFLAG_CURLYBRACKETS) {
if (s->flags & PFLAG_ATSYM) {
type = "table";
} else {
type = "struct";
}
} else if (s->flags & PFLAG_STRING || s->flags & PFLAG_LONGSTRING) {
if (s->flags & PFLAG_BUFFER) {
type = "buffer";
} else {
type = "string";
}
add_buffer = 1;
} else if (s->flags & PFLAG_COMMENT) {
type = "comment";
add_buffer = 1;
} else if (s->flags & PFLAG_TOKEN) {
type = "token";
add_buffer = 1;
} else if (s->flags & PFLAG_ATSYM) {
type = "at";
} else if (s->flags & PFLAG_READERMAC) {
int c = s->flags & 0xFF;
type = (c == '\'') ? "quote" :
(c == ',') ? "unquote" :
(c == ';') ? "splice" :
(c == '~') ? "quasiquote" : "<reader>";
} else {
type = "root";
}
if (type) {
janet_table_put(state, janet_ckeywordv("type"),
janet_ckeywordv(type));
}
if (add_buffer) {
buffer = janet_string(buff, bufcount);
janet_table_put(state, janet_ckeywordv("buffer"), janet_wrap_string(buffer));
}
janet_table_put(state, janet_ckeywordv("start"),
janet_wrap_integer(s->start));
return janet_wrap_table(state);
}
struct ParserStateGetter {
const char *name;
Janet(*fn)(const JanetParser *p);
};
static Janet parser_state_delimiters(const JanetParser *_p) {
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
janet_parser_clone(_p, clone);
size_t i;
const uint8_t *str;
size_t oldcount;
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
oldcount = p->bufcount;
for (i = 0; i < p->statecount; i++) {
JanetParseState *s = p->states + i;
oldcount = clone->bufcount;
for (i = 0; i < clone->statecount; i++) {
JanetParseState *s = clone->states + i;
if (s->flags & PFLAG_PARENS) {
push_buf(p, '(');
push_buf(clone, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
push_buf(p, '[');
push_buf(clone, '[');
} else if (s->flags & PFLAG_CURLYBRACKETS) {
push_buf(p, '{');
push_buf(clone, '{');
} else if (s->flags & PFLAG_STRING) {
push_buf(p, '"');
push_buf(clone, '"');
} else if (s->flags & PFLAG_LONGSTRING) {
int32_t i;
for (i = 0; i < s->argn; i++) {
push_buf(p, '`');
push_buf(clone, '`');
}
}
}
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
p->bufcount = oldcount;
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
clone->bufcount = oldcount;
return janet_wrap_string(str);
}
static Janet parser_state_frames(const JanetParser *p) {
int32_t count = (int32_t) p->statecount;
JanetArray *states = janet_array(count);
states->count = count;
uint8_t *buf = p->buf;
Janet *args = p->args;
for (int32_t i = count - 1; i >= 0; --i) {
JanetParseState *s = p->states + i;
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
args -= s->argn;
}
return janet_wrap_array(states);
}
static const struct ParserStateGetter parser_state_getters[] = {
{"frames", parser_state_frames},
{"delimiters", parser_state_delimiters},
{NULL, NULL}
};
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *key = NULL;
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
if (argc == 2) {
key = janet_getkeyword(argv, 1);
}
if (key) {
/* Get one result */
for (const struct ParserStateGetter *sg = parser_state_getters;
sg->name != NULL; sg++) {
if (janet_cstrcmp(key, sg->name)) continue;
return sg->fn(p);
}
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
return janet_wrap_nil();
} else {
/* Put results in table */
JanetTable *tab = janet_table(0);
for (const struct ParserStateGetter *sg = parser_state_getters;
sg->name != NULL; sg++) {
janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(p));
}
return janet_wrap_table(tab);
}
}
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
janet_parser_clone(src, dest);
return janet_wrap_abstract(dest);
}
static const JanetMethod parser_methods[] = {
{"byte", cfun_parse_byte},
{"clone", cfun_parse_clone},
{"consume", cfun_parse_consume},
{"eof", cfun_parse_eof},
{"error", cfun_parse_error},
{"flush", cfun_parse_flush},
{"has-more", cfun_parse_has_more},
@@ -846,7 +1034,6 @@ static const JanetMethod parser_methods[] = {
{"state", cfun_parse_state},
{"status", cfun_parse_status},
{"where", cfun_parse_where},
{"eof", cfun_parse_eof},
{NULL, NULL}
};
@@ -861,7 +1048,14 @@ static const JanetReg parse_cfuns[] = {
"parser/new", cfun_parse_parser,
JDOC("(parser/new)\n\n"
"Creates and returns a new parser object. Parsers are state machines "
"that can receive bytes, and generate a stream of janet values. ")
"that can receive bytes, and generate a stream of janet values.")
},
{
"parser/clone", cfun_parse_clone,
JDOC("(parser/clone p)\n\n"
"Creates a deep clone of a parser that is identical to the input parser. "
"This cloned parser can be used to continue parsing from a good checkpoint "
"if parsing later fails. Returns a new parser.")
},
{
"parser/has-more", cfun_parse_has_more,
@@ -877,7 +1071,7 @@ static const JanetReg parse_cfuns[] = {
},
{
"parser/consume", cfun_parse_consume,
JDOC("(parser/consume parser bytes [, index])\n\n"
JDOC("(parser/consume parser bytes &opt index)\n\n"
"Input bytes into the parser and parse them. Will not throw errors "
"if there is a parse error. Starts at the byte index given by index. Returns "
"the number of bytes read.")
@@ -913,18 +1107,22 @@ static const JanetReg parse_cfuns[] = {
},
{
"parser/state", cfun_parse_state,
JDOC("(parser/state parser)\n\n"
"Returns a string representation of the internal state of the parser. "
"Each byte in the string represents a nested data structure. For example, "
JDOC("(parser/state parser &opt key)\n\n"
"Returns a representation of the internal state of the parser. If a key is passed, "
"only that information about the state is returned. Allowed keys are:\n\n"
"\t:delimiters - Each byte in the string represents a nested data structure. For example, "
"if the parser state is '([\"', then the parser is in the middle of parsing a "
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt."
"\t:frames - Each table in the array represents a 'frame' in the parser state. Frames "
"contain information about the start of the expression being parsed as well as the "
"type of that expression and some type-specific information.")
},
{
"parser/where", cfun_parse_where,
JDOC("(parser/where parser)\n\n"
JDOC("(parser/where parser &opt offset)\n\n"
"Returns the current line number and column number of the parser's location "
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
"in the byte stream as an index, counted from 0. "
"If offset is supplied, then the byte offset is updated to that new value.")
},
{
"parser/eof", cfun_parse_eof,

View File

@@ -447,7 +447,7 @@ static void builder_cleanup(Builder *b) {
janet_v_free(b->bytecode);
}
static void peg_panic(Builder *b, const char *msg) {
JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
builder_cleanup(b);
janet_panicf("grammar error in %p, %s", b->form, msg);
}
@@ -945,27 +945,28 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
typedef struct {
uint32_t *bytecode;
Janet *constants;
size_t bytecode_len;
uint32_t num_constants;
} Peg;
static int peg_mark(void *p, size_t size) {
(void) size;
Peg *peg = (Peg *)p;
for (uint32_t i = 0; i < peg->num_constants; i++)
janet_mark(peg->constants[i]);
if (NULL != peg->constants)
for (uint32_t i = 0; i < peg->num_constants; i++)
janet_mark(peg->constants[i]);
return 0;
}
static JanetAbstractType peg_type = {
"core/peg",
NULL,
peg_mark,
NULL,
NULL,
NULL,
NULL,
NULL
};
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
Peg *peg = (Peg *)p;
janet_marshal_size(ctx, peg->bytecode_len);
janet_marshal_int(ctx, (int32_t)peg->num_constants);
for (size_t i = 0; i < peg->bytecode_len; i++)
janet_marshal_int(ctx, (int32_t) peg->bytecode[i]);
for (uint32_t j = 0; j < peg->num_constants; j++)
janet_marshal_janet(ctx, peg->constants[j]);
}
/* Used to ensure that if we place several arrays in one memory chunk, each
* array will be correctly aligned */
@@ -974,6 +975,169 @@ static size_t size_padded(size_t offset, size_t size) {
return x - (x % size);
}
static void peg_unmarshal(void *p, JanetMarshalContext *ctx) {
char *mem = p;
Peg *peg = (Peg *)p;
peg->bytecode_len = janet_unmarshal_size(ctx);
peg->num_constants = (uint32_t) janet_unmarshal_int(ctx);
/* Calculate offsets. Should match those in make_peg */
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
size_t bytecode_size = peg->bytecode_len * sizeof(uint32_t);
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
Janet *constants = (Janet *)(mem + constants_start);
peg->bytecode = NULL;
peg->constants = NULL;
/* Ensure not too large */
if (constants_start + sizeof(Janet) * peg->num_constants > janet_abstract_size(p)) {
janet_panic("size mismatch");
}
for (size_t i = 0; i < peg->bytecode_len; i++)
bytecode[i] = (uint32_t) janet_unmarshal_int(ctx);
for (uint32_t j = 0; j < peg->num_constants; j++)
constants[j] = janet_unmarshal_janet(ctx);
/* After here, no panics except for the bad: label. */
/* Keep track at each index if an instruction was
* reference (0x01) or is in a main bytecode position
* (0x02). This lets us do a linear scan and not
* need to a depth first traversal. It is stricter
* than a dfs by not allowing certain kinds of unused
* bytecode. */
uint32_t blen = (int32_t) peg->bytecode_len;
uint32_t clen = peg->num_constants;
uint8_t *op_flags = calloc(1, blen);
if (NULL == op_flags) {
JANET_OUT_OF_MEMORY;
}
/* verify peg bytecode */
uint32_t i = 0;
while (i < blen) {
uint32_t instr = bytecode[i];
uint32_t *rule = bytecode + i;
op_flags[i] |= 0x02;
switch (instr & 0x1F) {
case RULE_LITERAL:
i += 2 + ((rule[1] + 3) >> 2);
break;
case RULE_NCHAR:
case RULE_NOTNCHAR:
case RULE_RANGE:
case RULE_POSITION:
/* [1 word] */
i += 2;
break;
case RULE_SET:
/* [8 words] */
i += 9;
break;
case RULE_LOOK:
/* [offset, rule] */
if (rule[2] >= blen) goto bad;
op_flags[rule[2]] |= 0x1;
i += 3;
break;
case RULE_CHOICE:
case RULE_SEQUENCE:
/* [len, rules...] */
{
uint32_t len = rule[1];
for (uint32_t j = 0; j < len; j++) {
if (rule[2 + j] >= blen) goto bad;
op_flags[rule[2 + j]] |= 0x1;
}
i += 2 + len;
}
break;
case RULE_IF:
case RULE_IFNOT:
/* [rule_a, rule_b (b if not a)] */
if (rule[1] >= blen) goto bad;
if (rule[2] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
op_flags[rule[2]] |= 0x01;
i += 3;
break;
case RULE_BETWEEN:
/* [lo, hi, rule] */
if (rule[3] >= blen) goto bad;
op_flags[rule[3]] |= 0x01;
i += 4;
break;
case RULE_ARGUMENT:
case RULE_GETTAG:
/* [searchtag, tag] */
i += 3;
break;
case RULE_CONSTANT:
/* [constant, tag] */
if (rule[1] >= clen) goto bad;
i += 3;
break;
case RULE_ACCUMULATE:
case RULE_GROUP:
case RULE_CAPTURE:
/* [rule, tag] */
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 3;
break;
case RULE_REPLACE:
case RULE_MATCHTIME:
/* [rule, constant, tag] */
if (rule[1] >= blen) goto bad;
if (rule[2] >= clen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 4;
break;
case RULE_ERROR:
case RULE_DROP:
case RULE_NOT:
/* [rule] */
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 2;
break;
default:
goto bad;
}
}
/* last instruction cannot overflow */
if (i != blen) goto bad;
/* Make sure all referenced instructions are actually
* in instruction positions. */
for (i = 0; i < blen; i++)
if (op_flags[i] == 0x01) goto bad;
/* Good return */
peg->bytecode = bytecode;
peg->constants = constants;
free(op_flags);
return;
bad:
free(op_flags);
janet_panic("invalid peg bytecode");
}
static const JanetAbstractType peg_type = {
"core/peg",
NULL,
peg_mark,
NULL,
NULL,
peg_marshal,
peg_unmarshal,
NULL
};
/* Convert Builder to Peg (Janet Abstract Value) */
static Peg *make_peg(Builder *b) {
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
@@ -988,6 +1152,7 @@ static Peg *make_peg(Builder *b) {
peg->num_constants = janet_v_count(b->constants);
memcpy(peg->bytecode, b->bytecode, bytecode_size);
memcpy(peg->constants, b->constants, constants_size);
peg->bytecode_len = janet_v_count(b->bytecode);
return peg;
}
@@ -1061,7 +1226,7 @@ static const JanetReg peg_cfuns[] = {
},
{
"peg/match", cfun_peg_match,
JDOC("(peg/match peg text [,start=0])\n\n"
JDOC("(peg/match peg text &opt start & args)\n\n"
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
"similar to those defined by LPeg, and have similar capabilities.")
@@ -1072,6 +1237,7 @@ static const JanetReg peg_cfuns[] = {
/* Load the peg module */
void janet_lib_peg(JanetTable *env) {
janet_core_cfuns(env, NULL, peg_cfuns);
janet_register_abstract_type(&peg_type);
}
#endif /* ifdef JANET_PEG */

View File

@@ -28,6 +28,7 @@
/* Run a string */
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
JanetParser parser;
FILE *errf = janet_dynfile("err", stderr);
int errflags = 0, done = 0;
int32_t index = 0;
Janet ret = janet_wrap_nil();
@@ -55,7 +56,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1;
}
} else {
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
fprintf(errf, "compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
errflags |= 0x02;
done = 1;
@@ -69,7 +70,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
break;
case JANET_PARSE_ERROR:
errflags |= 0x04;
fprintf(stderr, "parse error in %s: %s\n",
fprintf(errf, "parse error in %s: %s\n",
sourcePath, janet_parser_error(&parser));
done = 1;
break;

View File

@@ -278,12 +278,10 @@ static int varleaf(
JanetCompiler *c,
const uint8_t *sym,
JanetSlot s,
JanetTable *attr) {
JanetTable *reftab) {
if (c->scope->flags & JANET_SCOPE_TOP) {
/* Global var, generate var */
JanetSlot refslot;
JanetTable *reftab = janet_table(1);
reftab->proto = attr;
JanetArray *ref = janet_array(1);
janet_array_push(ref, janet_wrap_nil());
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
@@ -312,12 +310,10 @@ static int defleaf(
JanetCompiler *c,
const uint8_t *sym,
JanetSlot s,
JanetTable *attr) {
JanetTable *tab) {
if (c->scope->flags & JANET_SCOPE_TOP) {
JanetTable *tab = janet_table(2);
janet_table_put(tab, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
tab->proto = attr;
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));

View File

@@ -65,4 +65,9 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
/* Scratch memory */
extern JANET_THREAD_LOCAL void **janet_scratch_mem;
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
#endif /* JANET_STATE_H_defined */

View File

@@ -393,25 +393,20 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
janet_arity(argc, 2, 3);
janet_fixarity(argc, 2);
JanetByteView set = janet_getbytes(argv, 0);
JanetByteView str = janet_getbytes(argv, 1);
/* Populate set */
for (int32_t i = 0; i < set.len; i++) {
int index = set.bytes[i] >> 5;
uint32_t mask = 1 << (set.bytes[i] & 7);
uint32_t mask = 1 << (set.bytes[i] & 0x1F);
bitset[index] |= mask;
}
if (argc == 3) {
if (janet_getboolean(argv, 2)) {
for (int i = 0; i < 8; i++)
bitset[i] = ~bitset[i];
}
}
/* Check set */
if (str.len == 0) return janet_wrap_false();
for (int32_t i = 0; i < str.len; i++) {
int index = str.bytes[i] >> 5;
uint32_t mask = 1 << (str.bytes[i] & 7);
uint32_t mask = 1 << (str.bytes[i] & 0x1F);
if (!(bitset[index] & mask)) {
return janet_wrap_false();
}
@@ -524,7 +519,7 @@ static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
static const JanetReg string_cfuns[] = {
{
"string/slice", cfun_string_slice,
JDOC("(string/slice bytes [,start=0 [,end=(length str)]])\n\n"
JDOC("(string/slice bytes &opt start end)\n\n"
"Returns a substring from a byte sequence. The substring is from "
"index start inclusive to index end exclusive. All indexing "
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
@@ -542,7 +537,7 @@ static const JanetReg string_cfuns[] = {
},
{
"string/from-bytes", cfun_string_frombytes,
JDOC("(string/from-bytes &byte-vals)\n\n"
JDOC("(string/from-bytes & byte-vals)\n\n"
"Creates a string from integer params with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.")
},
@@ -618,7 +613,7 @@ static const JanetReg string_cfuns[] = {
},
{
"string/join", cfun_string_join,
JDOC("(string/join parts [,sep])\n\n"
JDOC("(string/join parts &opt sep)\n\n"
"Joins an array of strings into one string, optionally separated by "
"a separator string sep.")
},
@@ -630,19 +625,19 @@ static const JanetReg string_cfuns[] = {
},
{
"string/trim", cfun_string_trim,
JDOC("(string/trim str [,set])\n\n"
JDOC("(string/trim str &opt set)\n\n"
"Trim leading and trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.")
},
{
"string/triml", cfun_string_triml,
JDOC("(string/triml str [,set])\n\n"
JDOC("(string/triml str &opt set)\n\n"
"Trim leading whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.")
},
{
"string/trimr", cfun_string_trimr,
JDOC("(string/trimr str [,set])\n\n"
JDOC("(string/trimr str &opt set)\n\n"
"Trim trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.")
},

View File

@@ -27,14 +27,32 @@
#include <math.h>
#endif
/* Initialize a table */
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
#define JANET_TABLE_FLAG_STACK 0x10000
static void *janet_memalloc_empty_local(int32_t count) {
int32_t i;
void *mem = janet_smalloc(count * sizeof(JanetKV));
JanetKV *mmem = (JanetKV *)mem;
for (i = 0; i < count; i++) {
JanetKV *kv = mmem + i;
kv->key = janet_wrap_nil();
kv->value = janet_wrap_nil();
}
return mem;
}
static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, int stackalloc) {
JanetKV *data;
capacity = janet_tablen(capacity);
if (stackalloc) table->gc.flags = JANET_TABLE_FLAG_STACK;
if (capacity) {
data = (JanetKV *) janet_memalloc_empty(capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
if (stackalloc) {
data = janet_memalloc_empty_local(capacity);
} else {
data = (JanetKV *) janet_memalloc_empty(capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
}
table->data = data;
table->capacity = capacity;
@@ -48,15 +66,20 @@ JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
return table;
}
/* Initialize a table */
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
return janet_table_init_impl(table, capacity, 1);
}
/* Deinitialize a table */
void janet_table_deinit(JanetTable *table) {
free(table->data);
janet_sfree(table->data);
}
/* Create a new table */
JanetTable *janet_table(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
return janet_table_init(table, capacity);
return janet_table_init_impl(table, capacity, 0);
}
/* Find the bucket that contains the given key. Will also return
@@ -68,9 +91,15 @@ JanetKV *janet_table_find(JanetTable *t, Janet key) {
/* Resize the dictionary table. */
static void janet_table_rehash(JanetTable *t, int32_t size) {
JanetKV *olddata = t->data;
JanetKV *newdata = (JanetKV *) janet_memalloc_empty(size);
if (NULL == newdata) {
JANET_OUT_OF_MEMORY;
JanetKV *newdata;
int islocal = t->gc.flags & JANET_TABLE_FLAG_STACK;
if (islocal) {
newdata = (JanetKV *) janet_memalloc_empty_local(size);
} else {
newdata = (JanetKV *) janet_memalloc_empty(size);
if (NULL == newdata) {
JANET_OUT_OF_MEMORY;
}
}
int32_t i, oldcapacity;
oldcapacity = t->capacity;
@@ -84,7 +113,11 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
*newkv = *kv;
}
}
free(olddata);
if (islocal) {
janet_sfree(olddata);
} else {
free(olddata);
}
}
/* Get a value out of the table */

View File

@@ -508,41 +508,41 @@ static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
static const JanetReg ta_cfuns[] = {
{
"tarray/new", cfun_typed_array_new,
JDOC("(tarray/new type size [stride = 1 [offset = 0 [tarray | buffer]]] )\n\n"
JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
"Create new typed array.")
},
{
"tarray/buffer", cfun_typed_array_buffer,
JDOC("(tarray/buffer (array | size) )\n\n"
JDOC("(tarray/buffer array|size)\n\n"
"Return typed array buffer or create a new buffer.")
},
{
"tarray/length", cfun_typed_array_size,
JDOC("(tarray/length (array | buffer) )\n\n"
JDOC("(tarray/length array|buffer)\n\n"
"Return typed array or buffer size.")
},
{
"tarray/properties", cfun_typed_array_properties,
JDOC("(tarray/properties array )\n\n"
JDOC("(tarray/properties array)\n\n"
"Return typed array properties as a struct.")
},
{
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
JDOC("(tarray/copy-bytes src sindex dst dindex [count=1])\n\n"
"Copy count elements of src array from index sindex "
JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
"Copy count elements (default 1) of src array from index sindex "
"to dst array at position dindex "
"memory can overlap.")
},
{
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
JDOC("(tarray/swap-bytes src sindex dst dindex [count=1])\n\n"
"Swap count elements between src array from index sindex "
JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
"Swap count elements (default 1) between src array from index sindex "
"and dst array at position dindex "
"memory can overlap.")
},
{
"tarray/slice", cfun_typed_array_slice,
JDOC("(tarray/slice tarr [, start=0 [, end=(size tarr)]])\n\n"
JDOC("(tarray/slice tarr &opt start end)\n\n"
"Takes a slice of a typed array from start to end. The range is half "
"open, [start, end). Indexes can also be negative, indicating indexing "
"from the end of the end of the typed array. By default, start is 0 and end is "

View File

@@ -25,9 +25,6 @@
#include <stdio.h>
#include <errno.h>
#ifndef JANET_WINDOWS
#include <sys/wait.h>
#endif
#ifndef JANET_AMALG
#include <janet.h>

View File

@@ -151,7 +151,6 @@ Janet janet_get(Janet ds, Janet key) {
switch (janet_type(ds)) {
default:
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
value = janet_wrap_nil();
break;
case JANET_STRUCT:
value = janet_struct_get(janet_unwrap_struct(ds), key);
@@ -219,7 +218,6 @@ Janet janet_get(Janet ds, Janet key) {
value = (type->get)(janet_unwrap_abstract(ds), key);
} else {
janet_panicf("no getter for %v ", ds);
value = janet_wrap_nil();
}
break;
}
@@ -233,7 +231,6 @@ Janet janet_getindex(Janet ds, int32_t index) {
switch (janet_type(ds)) {
default:
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
value = janet_wrap_nil();
break;
case JANET_STRING:
case JANET_SYMBOL:
@@ -277,7 +274,6 @@ Janet janet_getindex(Janet ds, int32_t index) {
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
} else {
janet_panicf("no getter for %v ", ds);
value = janet_wrap_nil();
}
break;
}
@@ -289,7 +285,6 @@ int32_t janet_length(Janet x) {
switch (janet_type(x)) {
default:
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
return 0;
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD:
@@ -312,7 +307,6 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
default:
janet_panicf("expected %T, got %v",
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
break;
case JANET_ARRAY: {
JanetArray *array = janet_unwrap_array(ds);
if (index >= array->count) {
@@ -355,7 +349,6 @@ void janet_put(Janet ds, Janet key, Janet value) {
default:
janet_panicf("expected %T, got %v",
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
break;
case JANET_ARRAY: {
int32_t index;
JanetArray *array = janet_unwrap_array(ds);

View File

@@ -30,17 +30,10 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
int32_t min_needed = janet_v_count(v) + increment;
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
if (NULL != p) {
if (!v) p[1] = 0;
p[0] = m;
return p + 2;
} else {
{
JANET_OUT_OF_MEMORY;
}
return (void *)(2 * sizeof(int32_t));
}
int32_t *p = (int32_t *) janet_srealloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
if (!v) p[1] = 0;
p[0] = m;
return p + 2;
}
/* Convert a buffer to normal allocated memory (forget capacity) */

View File

@@ -33,16 +33,15 @@
*/
/* This is mainly used code such as the assembler or compiler, which
* need vector like data structures that are not garbage collected
* and used only from C */
* need vector like data structures that are only garbage collected in case
* of an error, and normally rely on malloc/free. */
#define janet_v_free(v) (((v) != NULL) ? (free(janet_v__raw(v)), 0) : 0)
#define janet_v_free(v) (((v) != NULL) ? (janet_sfree(janet_v__raw(v)), 0) : 0)
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
#define janet_v_flatten(v) (janet_v_flattenmem((v), sizeof(*(v))))
#define janet_v__raw(v) ((int32_t *)(v) - 2)
@@ -55,7 +54,6 @@
/* Actual functions defined in vector.c */
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize);
void *janet_v_copymem(void *v, int32_t itemsize);
void *janet_v_flattenmem(void *v, int32_t itemsize);
#endif

View File

@@ -906,6 +906,10 @@ int janet_init(void) {
janet_vm_roots = NULL;
janet_vm_root_count = 0;
janet_vm_root_capacity = 0;
/* Scratch memory */
janet_scratch_mem = NULL;
janet_scratch_len = 0;
janet_scratch_cap = 0;
/* Initialize registry */
janet_vm_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm_registry));

View File

@@ -31,8 +31,6 @@ extern "C" {
#include "janetconf.h"
#define JANET_API_VERSION 1
#ifndef JANET_VERSION
#define JANET_VERSION "latest"
#endif
@@ -154,6 +152,15 @@ extern "C" {
#endif
#endif
/* Tell complier some functions don't return */
#ifndef JANET_NO_RETURN
#ifdef JANET_WINDOWS
#define JANET_NO_RETURN __declspec(noreturn)
#else
#define JANET_NO_RETURN __attribute__ ((noreturn))
#endif
#endif
/* Prevent some recursive functions from recursing too deeply
* ands crashing (the parser). Instead, error out. */
#define JANET_RECURSION_GUARD 1024
@@ -186,26 +193,38 @@ extern "C" {
#endif
#endif
/* Runtime config constants */
#ifdef JANET_NO_NANBOX
#define JANET_NANBOX_BIT 0
#else
#define JANET_NANBOX_BIT 1
#define JANET_NANBOX_BIT 0x1
#endif
#ifdef JANET_SINGLE_THREADED
#define JANET_SINGLE_THREADED_BIT 1
#define JANET_SINGLE_THREADED_BIT 0x2
#else
#define JANET_SINGLE_THREADED_BIT 0
#endif
#define JANET_CURRENT_CONFIG_BITS \
(JANET_SINGLE_THREADED_BIT | \
JANET_NANBOX_BIT)
/* Represents the settings used to compile Janet, as well as the version */
typedef struct {
int api_version;
int single_threaded : 1;
int nanbox : 1;
unsigned major;
unsigned minor;
unsigned patch;
unsigned bits;
} JanetBuildConfig;
/* Get config of current compilation unit. */
#define janet_config_current() ((JanetBuildConfig){ \
JANET_VERSION_MAJOR, \
JANET_VERSION_MINOR, \
JANET_VERSION_PATCH, \
JANET_CURRENT_CONFIG_BITS })
/***** END SECTION CONFIG *****/
/***** START SECTION TYPES *****/
@@ -219,9 +238,9 @@ typedef struct {
#include <stdio.h>
/* Names of all of the types */
extern const char *const janet_type_names[16];
extern const char *const janet_signal_names[14];
extern const char *const janet_status_names[16];
JANET_API const char *const janet_type_names[16];
JANET_API const char *const janet_signal_names[14];
JANET_API const char *const janet_status_names[16];
/* Fiber signals */
typedef enum {
@@ -1086,8 +1105,6 @@ JANET_API void janet_debug_find(
/* Array functions */
JANET_API JanetArray *janet_array(int32_t capacity);
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
JANET_API JanetArray *janet_array_init(JanetArray *array, int32_t capacity);
JANET_API void janet_array_deinit(JanetArray *array);
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
JANET_API void janet_array_push(JanetArray *array, Janet x);
@@ -1202,10 +1219,13 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
JANET_API void *janet_abstract_end(void *);
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size); /* begin and end in one call */
/* Native */
typedef void (*JanetModule)(JanetTable *);
typedef JanetBuildConfig(*JanetModconf)(void);
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
/* Marshaling */
@@ -1252,6 +1272,8 @@ JANET_API Janet janet_getindex(Janet ds, int32_t index);
JANET_API int32_t janet_length(Janet x);
JANET_API void janet_put(Janet ds, Janet key, Janet value);
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
/* VM functions */
JANET_API int janet_init(void);
@@ -1261,6 +1283,11 @@ JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
/* Scratch Memory API */
JANET_API void *janet_smalloc(size_t size);
JANET_API void *janet_srealloc(void *mem, size_t size);
JANET_API void janet_sfree(void *mem);
/* C Library helpers */
typedef enum {
JANET_BINDING_NONE,
@@ -1276,23 +1303,19 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
/* New C API */
#define JANET_MODULE_ENTRY JANET_API void _janet_init
#define JANET_MODULE_ENTRY \
JANET_API JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_API void _janet_init
JANET_API int janet_api_version();
JANET_API const JanetBuildConfig *janet_build_config();
#define janet_api_compatible() \
((janet_api_build_config()->api_version == JANET_API_VERSION) \
&& (janet_api_build_config()->nanbox == JANET_NANBOX_BIT) \
&& (janet_api_build_config()->single_threaded == JANET_SINGLE_THREADED_BIT))
JANET_API void janet_panicv(Janet message);
JANET_API void janet_panic(const char *message);
JANET_API void janet_panics(const uint8_t *message);
JANET_API void janet_panicf(const char *format, ...);
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
JANET_NO_RETURN JANET_API void janet_panic(const char *message);
JANET_NO_RETURN JANET_API void janet_panics(const uint8_t *message);
JANET_NO_RETURN JANET_API void janet_panicf(const char *format, ...);
JANET_API void janet_printf(const char *format, ...);
JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
JANET_NO_RETURN JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
JANET_NO_RETURN JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
JANET_API void janet_fixarity(int32_t arity, int32_t fix);

View File

@@ -11,8 +11,8 @@
(var *colorize* true)
(var *compile-only* false)
(if-let [jp (os/getenv "JANET_PATH")] (set module/*syspath* jp))
(if-let [jp (os/getenv "JANET_HEADERPATH")] (set module/*headerpath* jp))
(if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
(if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
# Flag handlers
(def handlers :private
@@ -42,15 +42,15 @@
"q" (fn [&] (set *quiet* true) 1)
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
"n" (fn [&] (set *colorize* false) 1)
"m" (fn [i &] (set module/*syspath* (get process/args (+ i 1))) 2)
"m" (fn [i &] (setdyn :syspath (get process/args (+ i 1))) 2)
"c" (fn [i &]
(def e (require (get process/args (+ i 1))))
(def e (dofile (get process/args (+ i 1))))
(spit (get process/args (+ i 2)) (make-image e))
(set *no-file* false)
3)
"-" (fn [&] (set *handleopts* false) 1)
"l" (fn [i &]
(import* (get process/args (+ i 1))
(dofile (get process/args (+ i 1))
:prefix "" :exit *exit-on-error*)
2)
"e" (fn [i &]
@@ -71,7 +71,7 @@
(+= i (dohandler (string/slice arg 1 2) i))
(do
(set *no-file* false)
(import* arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
(dofile arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
(set i lenargs))))
(when (and (not *compile-only*) (or *should-repl* *no-file*))
@@ -80,7 +80,7 @@
(defn noprompt [_] "")
(defn getprompt [p]
(def offset (parser/where p))
(string "janet:" offset ":" (parser/state p) "> "))
(string "janet:" offset ":" (parser/state p :delimiters) "> "))
(def prompter (if *quiet* noprompt getprompt))
(defn getstdin [prompt buf]
(file/write stdout prompt)

View File

@@ -32,11 +32,12 @@ Janet janet_line_getter(int32_t argc, Janet *argv) {
}
static void simpleline(JanetBuffer *buffer) {
FILE *in = janet_dynfile("in", stdin);
buffer->count = 0;
int c;
for (;;) {
c = fgetc(stdin);
if (feof(stdin) || c < 0) {
c = fgetc(in);
if (feof(in) || c < 0) {
break;
}
janet_buffer_push_u8(buffer, (uint8_t) c);
@@ -56,7 +57,9 @@ void janet_line_deinit() {
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
fputs(p, stdout);
FILE *out = janet_dynfile("out", stdout);
fputs(p, out);
fflush(out);
simpleline(buffer);
}
@@ -450,6 +453,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
prompt = p;
buffer->count = 0;
historyi = 0;
FILE *out = janet_dynfile("out", stdout);
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
simpleline(buffer);
return;
@@ -463,12 +467,12 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
if (sigint_flag) {
raise(SIGINT);
} else {
fputc('\n', stdout);
fputc('\n', out);
}
return;
}
norawmode();
fputc('\n', stdout);
fputc('\n', out);
janet_buffer_ensure(buffer, len + 1, 2);
memcpy(buffer->data, buf, len);
buffer->data[len] = '\n';

View File

@@ -38,13 +38,14 @@ int main(int argc, char **argv) {
JanetArray *args;
JanetTable *env;
/* Enable color console on windows 10 console. */
/* Enable color console on windows 10 console and utf8 output. */
#ifdef _WIN32
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
SetConsoleMode(hOut, dwMode);
SetConsoleOutputCP(65001);
#endif
/* Set up VM */

View File

@@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(import ./helper :prefix "" :exit true)
(start-suite 0)
(assert (= 10 (+ 1 2 3 4)) "addition")

View File

@@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(import ./helper :prefix "" :exit true)
(start-suite 1)
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")

View File

@@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(import ./helper :prefix "" :exit true)
(start-suite 2)
# Buffer stuff

View File

@@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(import ./helper :prefix "" :exit true)
(start-suite 3)
(assert (= (length (range 10)) 10) "(range 10)")

View File

@@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(import ./helper :prefix "" :exit true)
(start-suite 4)
# some tests for string/format and buffer/format

View File

@@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(import ./helper :prefix "" :exit true)
(start-suite 5)
# some tests typed array

View File

@@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(import ./helper :prefix "" :exit true)
(start-suite 6)
# some tests for bigint
@@ -109,4 +109,57 @@
(comment 1 2 3)
(comment 1 2 3 4)
# Parser clone
(def p (parser/new))
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
(def p2 (parser/clone p))
(parser/consume p2 ") 1 ")
(parser/consume p ") 1 ")
(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
# String check-set
(assert (string/check-set "abc" "a") "string/check-set 1")
(assert (not (string/check-set "abc" "z")) "string/check-set 2")
(assert (string/check-set "abc" "abc") "string/check-set 3")
(assert (not (string/check-set "abc" "")) "string/check-set 4")
(assert (not (string/check-set "" "aabc")) "string/check-set 5")
# Marshal and unmarshal pegs
(def p (-> "abcd" peg/compile marshal unmarshal))
(assert (peg/match p "abcd") "peg marshal 1")
(assert (peg/match p "abcdefg") "peg marshal 2")
(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
# This should be valgrind clean.
(var pegi 3)
(defn marshpeg [p]
(assert (-> p peg/compile marshal unmarshal) (string "peg marshal " (++ pegi))))
(marshpeg '(* 1 2 (set "abcd") "asdasd" (+ "." 3)))
(marshpeg '(% (* (+ 1 2 3) (* "drop" "bear") '"hi")))
(marshpeg '(> 123 "abcd"))
(marshpeg '{:main (* 1 "hello" :main)})
(marshpeg '(range "AZ"))
(marshpeg '(if-not "abcdf" 123))
(marshpeg '(error ($)))
(marshpeg '(* "abcd" (constant :hi)))
(marshpeg ~(/ "abc" ,identity))
(marshpeg '(if-not "abcdf" 123))
(marshpeg ~(cmt "abcdf" ,identity))
(marshpeg '(group "abc"))
# Module path expansion
(setdyn :current-file "some-dir/some-file")
(defn test-expand [path temp]
(string (module/expand-path path temp)))
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")
(assert (= (test-expand "abc/def.txt" ":cur:/:dir:/sub/:name:") "some-dir/abc/sub/def.txt") "module/expand-path 4")
(assert (= (test-expand "/abc/../def.txt" ":all:") "/def.txt") "module/expand-path 5")
(assert (= (test-expand "abc/../def.txt" ":all:") "def.txt") "module/expand-path 6")
(assert (= (test-expand "../def.txt" ":all:") "../def.txt") "module/expand-path 7")
(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt") "module/expand-path 8")
(end-suite)

91
test/suite7.janet Normal file
View File

@@ -0,0 +1,91 @@
# Copyright (c) 2019 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite 7)
# Using a large test grammar
(def- core-env (table/getproto (fiber/getenv (fiber/current))))
(def- specials {'fn true
'var true
'do true
'while true
'def true
'splice true
'set true
'unquote true
'quasiquote true
'quote true
'if true})
(defn- check-number [text] (and (scan-number text) text))
(defn capture-sym
[text]
(def sym (symbol text))
[(if (or (core-env sym) (specials sym)) :coresym :symbol) text])
(def grammar
~{:ws (set " \v\t\r\f\n\0")
:readermac (set "';~,")
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
:token (some :symchars)
:hex (range "09" "af" "AF")
:escape (* "\\" (+ (set "ntrvzf0e\"\\")
(* "x" :hex :hex)
(error (constant "bad hex escape"))))
:comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
:symbol (/ ':token ,capture-sym)
:keyword (/ '(* ":" (any :symchars)) (constant :keyword))
:constant (/ '(+ "true" "false" "nil") (constant :constant))
:bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
:string (/ ':bytes (constant :string))
:buffer (/ '(* "@" :bytes) (constant :string))
:long-bytes {:delim (some "`")
:open (capture :delim :n)
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
:main (drop (* :open (any (if-not :close 1)) :close))}
:long-string (/ ':long-bytes (constant :string))
:long-buffer (/ '(* "@" :long-bytes) (constant :string))
:number (/ (cmt ':token ,check-number) (constant :number))
:raw-value (+ :comment :constant :number :keyword
:string :buffer :long-string :long-buffer
:parray :barray :ptuple :btuple :struct :dict :symbol)
:value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
:root (any :value)
:root2 (any (* :value :value))
:ptuple (* '"(" :root (+ '")" (error "")))
:btuple (* '"[" :root (+ '"]" (error "")))
:struct (* '"{" :root2 (+ '"}" (error "")))
:parray (* '"@" :ptuple)
:barray (* '"@" :btuple)
:dict (* '"@" :struct)
:main (+ :root (error ""))})
(def p (peg/compile grammar))
# Just make sure is valgrind clean.
(def p (-> p make-image load-image))
(assert (peg/match p "abc") "complex peg grammar 1")
(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
(end-suite)

View File

@@ -1,55 +0,0 @@
# A flexible templater for janet. Compiles
# templates to janet functions that produce buffers.
(defn template
"Compile a template string into a function"
[source]
# State for compilation machine
(def p (parser/new))
(def forms @[])
(defn parse-chunk
"Parse a string and push produced values to forms."
[chunk]
(parser/consume p chunk)
(while (parser/has-more p)
(array/push forms (parser/produce p)))
(if (= :error (parser/status p))
(error (parser/error p))))
(defn code-chunk
"Parse all the forms in str and return them
in a tuple prefixed with 'do."
[str]
(parse-chunk str)
true)
(defn string-chunk
"Insert string chunk into parser"
[str]
(parser/insert p str)
(parse-chunk "")
true)
# Run peg
(def grammar
~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}")
:main-chunk (drop (cmt '(any (if-not "{%" 1)) ,string-chunk))
:main (any (+ :code-chunk :main-chunk (error "")))})
(def parts (peg/match grammar source))
# Check errors in template and parser
(unless parts (error "invalid template syntax"))
(parse-chunk "\n")
(case (parser/status p)
:pending (error (string "unfinished parser state " (parser/state p)))
:error (error (parser/error p)))
# Make ast from forms
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
(def ctor (compile ast (fiber/getenv (fiber/current)) source))
(if-not (function? ctor)
(error (string "could not compile template")))
(ctor))

View File

@@ -104,6 +104,7 @@
# Generate parts and print them to stdout
(def parts (seq [[k entry]
:in (sort (pairs (table/getproto (fiber/getenv (fiber/current)))))
:when (symbol? k)
:when (and (get entry :doc) (not (get entry :private)))]
(emit-item k entry)))
(print

View File

@@ -1,198 +0,0 @@
# Copyright (C) Calvin Rose 2019
#
# Takes in a janet string and colorizes for multiple
# output formats.
# Constants for checking if symbols should be
# highlighted.
(def- core-env (table/getproto *env*))
(def- specials {'fn true
'var true
'do true
'while true
'def true
'splice true
'set true
'break true
'unquote true
'quasiquote true
'quote true
'if true})
(defn check-number [text] (and (scan-number text) text))
(defn- make-grammar
"Creates the grammar based on the paint function, which
colorizes fragments of text."
[paint]
(defn <-c
"Peg rule for capturing and coloring a rule."
[color what]
~(/ (<- ,what) ,(partial paint color)))
(defn color-symbol
"Color a symbol only if it is a core library binding or special."
[text]
(def sym (symbol text))
(def should-color (or (specials sym) (core-env sym)))
(paint (if should-color :coresym :symbol) text))
~{:ws (set " \t\r\f\n\v\0")
:readermac (set "';~,")
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
:token (some :symchars)
:hex (range "09" "af" "AF")
:escape (* "\\" (+ (set "ntrvzf0\"\\e")
(* "x" :hex :hex)
(error (constant "bad hex escape"))))
:comment ,(<-c :comment ~(* "#" (any (if-not (+ "\n" -1) 1))))
:symbol (/ ':token ,color-symbol)
:keyword ,(<-c :keyword ~(* ":" (any :symchars)))
:constant ,(<-c :constant ~(+ "true" "false" "nil"))
:bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
:string ,(<-c :string :bytes)
:buffer ,(<-c :string ~(* "@" :bytes))
:long-bytes {:delim (some "`")
:open (capture :delim :n)
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
:main (drop (* :open (any (if-not :close 1)) :close))}
:long-string ,(<-c :string :long-bytes)
:long-buffer ,(<-c :string ~(* "@" :long-bytes))
:number (/ (cmt ':token ,check-number) ,(partial paint :number))
:raw-value (+ :comment :constant :number :keyword
:string :buffer :long-string :long-buffer
:parray :barray :ptuple :btuple :struct :dict :symbol)
:value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
:root (any :value)
:root2 (any (* :value :value))
:ptuple (* '"(" :root (+ '")" (error "")))
:btuple (* '"[" :root (+ '"]" (error "")))
:struct (* '"{" :root2 (+ '"}" (error "")))
:parray (* '"@" :ptuple)
:barray (* '"@" :btuple)
:dict (* '"@" :struct)
:main (+ (% :root) (error ""))})
# Terminal syntax highlighting
(def- terminal-colors
{:number 32
:keyword 33
:string 35
:coresym 31
:constant 34
:comment 36})
(defn- terminal-paint
"Paint colors for ansi terminals"
[what str]
(def code (get terminal-colors what))
(if code (string "\e[" code "m" str "\e[0m") str))
# HTML syntax highlighting
(def- html-colors
{:number "j-number"
:keyword "j-keyword"
:string "j-string"
:coresym "j-coresym"
:constant "j-constant"
:comment "j-comment"
:line "j-line"})
(def- escapes
{38 "&amp;"
60 "&lt;"
62 "&gt;"
34 "&quot;"
39 "&#39;"
47 "&#47;"})
(def html-style
"Style tag to add to a page to highlight janet code"
```
<style type="text/css">
.j-main { color: white; background: #111; font-size: 1.4em; }
.j-number { color: #89dc76; }
.j-keyword { color: #ffd866; }
.j-string { color: #ab90f2; }
.j-coresym { color: #ff6188; }
.j-constant { color: #fc9867; }
.j-comment { color: darkgray; }
.j-line { color: gray; }
</style>
```)
(defn html-escape
"Escape special characters for HTML encoding."
[str]
(def buf @"")
(loop [byte :in str]
(if-let [rep (get escapes byte)]
(buffer/push-string buf rep)
(buffer/push-byte buf byte)))
buf)
(defn- html-paint
"Paint colors for HTML"
[what str]
(def color (get html-colors what))
(def escaped (html-escape str))
(if color
(string "<span class=\"" color "\">" escaped "</span>")
escaped))
# Create Pegs
(def- terminal-grammar (peg/compile (make-grammar terminal-paint)))
(def- html-grammar (peg/compile (make-grammar html-paint)))
# API
(defn ansi
"Highlight janet source code ANSI Termianl escape colors."
[source]
(0 (peg/match terminal-grammar source)))
(defn html
"Highlight janet source code and output HTML."
[source]
(string "<pre class=\"j-main\"><code>"
(0 (peg/match html-grammar source))
"</code></pre>"))
(defn html-file
"Highlight a janet file and print out a highlighted HTML version
of the file. Must provide a default title when creating the file."
[in-path out-path title &]
(default title in-path)
(def f (file/open in-path :r))
(def source (file/read f :all))
(file/close f)
(def markup (0 (peg/match html-grammar source)))
(def out (file/open out-path :w))
(file/write out
"<!doctype html><html><head><meta charset=\"UTF-8\">"
html-style
"<title>"
title
"</title></head>"
"<body class=\"j-main\"><pre>"
markup
"</pre></body></html>")
(file/close out))
(defn ansi-file
"Highlight a janet file and print the highlighted output to stdout."
[in-path]
(def f (file/open in-path :r))
(def source (file/read f :all))
(file/close f)
(def markup (0 (peg/match terminal-grammar source)))
(print markup))

View File

@@ -2,6 +2,25 @@
# Used to help build the tmLanguage grammar. Emits
# the entire .tmLanguage file for janet.
# Use dynamic binding and make this the first
# expression in the file to not pollute (all-bindings)
(setdyn :allsyms
(array/concat
@["break"
"def"
"do"
"var"
"set"
"fn"
"while"
"if"
"quote"
"quasiquote"
"unquote"
"splice"]
(all-bindings)))
(def allsyms (dyn :allsyms))
(def grammar-template
`````
<?xml version="1.0" encoding="UTF-8"?>
@@ -343,22 +362,6 @@
# Now we generate the bindings in the language.
(def- specials
@["break"
"def"
"do"
"var"
"set"
"fn"
"while"
"if"
"quote"
"quasiquote"
"unquote"
"splice"])
(def allsyms (array/concat @[] specials (all-bindings)))
(def- escapes
{(get "|" 0) `\|`
(get "-" 0) `\-`