1
0
mirror of https://github.com/janet-lang/janet synced 2025-01-10 23:50:26 +00:00

Merge branch 'master' of github.com:janet-lang/janet

This commit is contained in:
Calvin Rose 2019-09-05 21:10:50 -04:00
commit fcd203c646
13 changed files with 391 additions and 51 deletions

View File

@ -1,15 +1,20 @@
# Changelog # Changelog
All notable changes to this project will be documented in this file. All notable changes to this project will be documented in this file.
## Unreleased ## 1.3.0 - 2019-09-05
- Add `get-in`, `put-in`, `update-in`, and `freeze` to core.
- Add `jpm run rule` and `jpm rules` to jpm to improve utility and discoverability of jpm.
- Remove `cook` module and move `path` module to https://github.com/janet-lang/path.git.
The functionality in `cook` is now bundled directly in the `jpm` script.
- Add `buffer/format` and `string/format` format flags `Q` and `q` to print colored and - Add `buffer/format` and `string/format` format flags `Q` and `q` to print colored and
non-colored single-line values, similar to `P` and `p`. non-colored single-line values, similar to `P` and `p`.
- Change default repl to print long sequences on one line. - Change default repl to print long sequences on one line and color stacktraces if color is enabled.
- Add `backmatch` pattern for PEGs. - Add `backmatch` pattern for PEGs.
- jpm detects if not in a Developer Command prompt on windows for a better error message. - jpm detects if not in a Developer Command prompt on windows for a better error message.
- jpm install git submodules in dependencies - jpm install git submodules in dependencies
- Change default fiber stack limit to the maximum value of a 32 bit signed integer. - Change default fiber stack limit to the maximum value of a 32 bit signed integer.
- Some bug fixes with `jpm` - Some bug fixes with `jpm`
- Fix bugs with pegs.
- Add `os/arch` to get ISA that janet was compiled for - Add `os/arch` to get ISA that janet was compiled for
- Add color to stacktraces via `(dyn :err-color)` - Add color to stacktraces via `(dyn :err-color)`

View File

@ -253,7 +253,7 @@ dist: build/janet-dist.tar.gz
build/janet-%.tar.gz: $(JANET_TARGET) \ build/janet-%.tar.gz: $(JANET_TARGET) \
src/include/janet.h src/conf/janetconf.h \ src/include/janet.h src/conf/janetconf.h \
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \ jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
build/doc.html README.md build/janet.c build/doc.html README.md build/janet.c
tar -czvf $@ $^ tar -czvf $@ $^
@ -301,6 +301,7 @@ install: $(JANET_TARGET) build/janet.pc
cp -rf auxbin/* '$(BINDIR)' cp -rf auxbin/* '$(BINDIR)'
mkdir -p '$(MANPATH)' mkdir -p '$(MANPATH)'
cp janet.1 '$(MANPATH)' cp janet.1 '$(MANPATH)'
cp jpm.1 '$(MANPATH)'
mkdir -p '$(PKG_CONFIG_PATH)' mkdir -p '$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc' cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
-ldconfig $(LIBDIR) -ldconfig $(LIBDIR)
@ -312,6 +313,7 @@ uninstall:
-rm -rf '$(LIBDIR)'/libjanet.* -rm -rf '$(LIBDIR)'/libjanet.*
-rm '$(PKG_CONFIG_PATH)/janet.pc' -rm '$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(MANPATH)/janet.1' -rm '$(MANPATH)/janet.1'
-rm '$(MANPATH)/jpm.1'
# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here # -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
################# #################

View File

@ -29,14 +29,9 @@ install:
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars32.bat" - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars32.bat"
- build_win test-install - build_win test-install
- set janet_outname=%appveyor_repo_tag_name% - set janet_outname=%appveyor_repo_tag_name%
- if "%janet_outname%"=="" set janet_outname=v1.2.0 - if "%janet_outname%"=="" set janet_outname=v1.3.0
build: off build: off
only_commits:
files:
- appveyor.yml
- src/
artifacts: artifacts:
- name: janet.c - name: janet.c
path: dist\janet.c path: dist\janet.c

View File

@ -95,13 +95,13 @@
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath))) (def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH") (def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
(if-let [j JANET_MODPATH] (if-let [j (dyn :syspath)]
(string j "/../../include/janet")))) (string j "/../../include/janet"))))
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
(if-let [j JANET_MODPATH] (if-let [j (dyn :syspath)]
(string j "/../../bin")))) (string j "/../../bin"))))
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH") (def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
(if-let [j JANET_MODPATH] (if-let [j (dyn :syspath)]
(string j "/..")))) (string j "/.."))))
# #
@ -499,7 +499,9 @@ int main(int argc, const char **argv) {
"Create an absolute path. Does not resolve . and .. (useful for "Create an absolute path. Does not resolve . and .. (useful for
generating entries in install manifest file)." generating entries in install manifest file)."
[path] [path]
(if (string/has-prefix? absprefix) (if (if is-win
(peg/match '(+ "\\" (* (range "AZ" "az") ":\\")) path)
(string/has-prefix? "/" path))
path path
(string (os/cwd) sep path))) (string (os/cwd) sep path)))
@ -556,17 +558,29 @@ int main(int argc, const char **argv) {
(defn install-git (defn install-git
"Install a bundle from git. If the bundle is already installed, the bundle "Install a bundle from git. If the bundle is already installed, the bundle
is reinistalled (but not rebuilt if artifacts are cached)." is reinistalled (but not rebuilt if artifacts are cached)."
[repo] [repotab]
(def repo (if (string? repotab) repotab (repotab :repo)))
(def tag (unless (string? repotab) (repotab :tag)))
(def cache (find-cache)) (def cache (find-cache))
(os/mkdir cache) (os/mkdir cache)
(def id (filepath-replace repo)) (def id (filepath-replace repo))
(def module-dir (string cache sep id)) (def module-dir (string cache sep id))
(var fresh false)
(when (os/mkdir module-dir) (when (os/mkdir module-dir)
(set fresh true)
(os/execute ["git" "clone" repo module-dir] :p)) (os/execute ["git" "clone" repo module-dir] :p))
(def olddir (os/cwd)) (def olddir (os/cwd))
(os/cd module-dir)
(try (try
(with-dyns [:rules @{}] (with-dyns [:rules @{}
:modpath (abspath (dyn :modpath JANET_MODPATH))
:headerpath (abspath (dyn :headerpath JANET_HEADERPATH))
:libpath (abspath (dyn :libpath JANET_LIBPATH))
:binpath (abspath (dyn :binpath JANET_BINPATH))]
(os/cd module-dir)
(unless fresh
(os/execute ["git" "pull" "origin" "master"] :p))
(when tag
(os/execute ["git" "reset" "--hard" tag] :p))
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p) (os/execute ["git" "submodule" "update" "--init" "--recursive"] :p)
(import-rules "./project.janet") (import-rules "./project.janet")
(do-rule "install-deps") (do-rule "install-deps")
@ -782,6 +796,7 @@ on a project, or from anywhere to do operations on the global module cache (modp
Subcommands are: Subcommands are:
build : build all artifacts build : build all artifacts
help : show this help text
install (repo) : install artifacts. If a repo is given, install the contents of that install (repo) : install artifacts. If a repo is given, install the contents of that
git repository, assuming that the repository is a jpm project. If not, build git repository, assuming that the repository is a jpm project. If not, build
and install the current project. and install the current project.
@ -791,23 +806,27 @@ Subcommands are:
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet. test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
deps : install dependencies for the current project. deps : install dependencies for the current project.
clear-cache : clear the git cache. Useful for updating dependencies. clear-cache : clear the git cache. Useful for updating dependencies.
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
or (rule "ouput.file" [deps...] ...).
rules : list rules available with run.
Keys are: Keys are:
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) --modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH. --headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH.
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH. --binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH. --libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
--optimize : Optimization level for natives. Defaults to 2.
--compiler : C compiler to use for natives. Defaults to cc (cl on windows). --compiler : C compiler to use for natives. Defaults to cc (cl on windows).
--archiver : C compiler to use for static libraries. Defaults to ar (lib on windows). --archiver : C compiler to use for static libraries. Defaults to ar (lib on windows).
--linker : C linker to use for linking natives. Defaults to cc (link on windows). --linker : C linker to use for linking natives. Defaults to cc (link on windows).
--cflags : Extra compiler flags for native modules.
--lflags : Extra linker flags for native modules.
Flags are: Flags are:
--verbose : Print shell commands as they are executed. --verbose : Print shell commands as they are executed.
`)) `))
(defn- show-help
[]
(print help))
(defn- build (defn- build
[] []
(local-rule "build")) (local-rule "build"))
@ -836,14 +855,23 @@ Flags are:
[] []
(local-rule "install-deps")) (local-rule "install-deps"))
(defn- list-rules
[]
(import-rules "./project.janet")
(def ks (sort (seq [k :keys (dyn :rules)] k)))
(each k ks (print k)))
(def- subcommands (def- subcommands
{"build" build {"build" build
"clean" clean "clean" clean
"help" show-help
"install" install "install" install
"test" test "test" test
"help" help "help" help
"deps" deps "deps" deps
"clear-cache" clear-cache "clear-cache" clear-cache
"run" local-rule
"rules" list-rules
"uninstall" uninstall-cmd}) "uninstall" uninstall-cmd})
(def- args (tuple/slice (dyn :args) 1)) (def- args (tuple/slice (dyn :args) 1))

View File

@ -1,5 +1,5 @@
# Version # Version
!define VERSION "1.2.0" !define VERSION "1.3.0"
!define PRODUCT_VERSION "${VERSION}.0" !define PRODUCT_VERSION "${VERSION}.0"
VIProductVersion "${PRODUCT_VERSION}" VIProductVersion "${PRODUCT_VERSION}"
VIFileVersion "${PRODUCT_VERSION}" VIFileVersion "${PRODUCT_VERSION}"

176
jpm.1 Normal file
View File

@ -0,0 +1,176 @@
.TH JPM 1
.SH NAME
jpm \- the Janet Project Manager, a build tool for Janet
.SH SYNOPSIS
.B jpm
[\fB\-\-flag ...\fR]
[\fB\-\-option=value ...\fR]
.IR command
.IR args ...
.SH DESCRIPTION
jpm is the build tool that ships with a standard Janet install. It is
used for building Janet projects, installing dependencies, installing
projects, building native modules, and exporting your Janet project to a
standalone executable. Although not required for working with Janet, it
removes much of the boilerplate with installing dependencies and
building native modules. jpm requires only Janet to run, and uses git
to install dependencies (jpm will work without git installed).
.SH DOCUMENTATION
jpm has several subcommands, each used for managing either a single Janet project or
all Janet modules installed on the system. Global commands, those that manage modules
at the system level, do things like install and uninstall packages, as well as clear the cache.
More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html
.SH FLAGS
.TP
.BR \-\-verbose
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
.SH OPTIONS
.TP
.BR \-\-modpath=/some/path
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order.
.TP
.BR \-\-headerpath=/some/path
Set the path the jpm will include when building C source code. This lets
you specify the location of janet.h and janetconf.h on your system. On a
normal install, this option is not needed.
.TP
.BR \-\-binpath=/some/path
Set the path that jpm will install scripts and standalone executables to. Executables
defined via declare-execuatble or scripts declared via declare-binscript will be installed
here when jpm install is run. Defaults to $JANET_BINPATH, or a reasonable default for the system.
See JANET_BINPATH for more.
.TP
.BR \-\-libpath=/some/path
Sets the path jpm will use to look for libjanet.a for building standalone executables. libjanet.so
is \fBnot\fR used for building native modules or standalone executables, only
for linking into applications that want to embed janet as a dynamic module.
Linking statically might be a better idea, even in that case. Defaults to
$JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
.TP
.BR \-\-compiler=cc
Sets the compiler used for compiling native modules and standalone executables. Defaults
to cc.
.TP
.BR \-\-linker=ld
Sets the linker used to create native modules and executables.
.TP
.BR \-\-archiver=ar
Sets the command used for creating static libraries, use for linking into the standalone executable.
Native modules are compiled twice, once a normal native module (shared object), and once as an
archive.
.SH COMMANDS
.TP
.BR help
Shows the usage text and exits immediately.
.TP
.BR build
Builds all artifacts specified in the project.janet file in the current directory. Artifacts will
be created in the ./build/ directory.
.TP
.BR install\ [\fBrepo\fR]
When run with no arguments, installs all installable artifacts in the current project to
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
take an optional git repository URL and will install all artifacts in that repository instead.
When run with an argument, install does not need to be run from a jpm project directory.
.TP
.BR uninstall\ [\fBname\fR]
Uninstall a project installed with install. uninstall expects the name of the project, not the
repository url, path to installed file or executable name. The name of the project must be specified
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
the current project if installed.
.TP
.BR clean
Remove all artifacts created by jpm. This just deletes the build folder.
.TP
.BR test
Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test
is considered failing if it exits with a non-zero exit code.
.TP
.BR deps
Install all dependencies that this project requires recursively. jpm does not
resolve dependency issues, like conflicting versions of the same module are required, or
different modules with the same name. Dependencies are installed with git, so deps requires
git to be on the PATH.
.TP
.BR clear-cache
jpm caches git repositories that are needed to install modules from a remote
source in a global cache ($JANET_PATH/.cache). If these dependencies are out of
date or too large, clear-cache will remove the cache and jpm will rebuild it
when needed. clear-cache is a global command, so a project.janet is not
required.
.TP
.BR run\ [\fBrule\fR]
Run a given rule defined in project.janet. Project definitions files (project.janet) usually
contain a few artifact declarations, which set up rules that jpm can then resolve, or execute.
A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much
like make. run will run a single rule or build a single file.
.TP
.BR rules
List all rules that can be run via run. This is useful for exploring rules in the project.
.SH ENVIRONMENT
.B JANET_PATH
.RS
The location to look for Janet libraries. This is the only environment variable Janet needs to
find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time, which can be determined with (dyn :syspath)
.RE
.B JANET_MODPATH
.RS
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
set this to a different directory if you want to. Doing so would let you import Janet modules
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install
This variable is overwritten by the --modpath=/some/path if it is provided.
.RE
.B JANET_HEADERPATH
.RS
The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
to build native modules and standalone executables. If janet.h and janetconf.h are available as
default includes on your system, this value is not required. If not provided, will default to
(dyn :syspath)/../../include/janet. The --headerpath=/some/path will override this variable.
.RE
.B JANET_LIBPATH
.RS
Similar to JANET_HEADERPATH, this path is where jpm will look for
libjanet.a for creating standalong executables. This does not need to be
set on a normal install.
If not provided, this will default to (dyn :syspath)/../../lib.
The --libpath=/some/path will override this variable.
.RE
.B JANET_BINPATH
.RS
The directory where jpm will install binary scripts and executables to.
Defaults to
(dyn :syspath)/../../lib.
The --binpath=/some/path will override this variable.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

View File

@ -20,7 +20,7 @@
project('janet', 'c', project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'], default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.2.0') version : '1.3.0')
# Global settings # Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@ -228,6 +228,7 @@ janet_dep = declare_dependency(include_directories : incdir,
# Installation # Installation
install_man('janet.1') install_man('janet.1')
install_man('jpm.1')
install_headers(['src/include/janet.h', jconf], subdir: 'janet') install_headers(['src/include/janet.h', jconf], subdir: 'janet')
janet_binscripts = [ janet_binscripts = [
'auxbin/jpm' 'auxbin/jpm'

View File

@ -952,6 +952,58 @@
(put res (get keys i) (get vals i))) (put res (get keys i) (get vals i)))
res) res)
(defn get-in
"Access a value in a nested data structure. Looks into the data structure via
a sequence of keys."
[ds ks &opt dflt]
(var d ds)
(loop [k :in ks :while d] (set d (get d k)))
(or d dflt))
(defn update-in
"Update a value in a nested data structure by applying f to the current value.
Looks into the data structure via
a sequence of keys. Missing data structures will be replaced with tables. Returns
the modified, original data structure."
[ds ks f & args]
(var d ds)
(def len-1 (- (length ks) 1))
(if (< len-1 0) (error "expected at least 1 key in ks"))
(for i 0 len-1
(def k (get ks i))
(def v (get d k))
(if (= nil v)
(let [newv (table)]
(put d k newv)
(set d newv))
(set d v)))
(def last-key (get ks len-1))
(def last-val (get d last-key))
(put d last-key (f last-val ;args))
ds)
(defn put-in
"Put a value into a nested data structure.
Looks into the data structure via
a sequence of keys. Missing data structures will be replaced with tables. Returns
the modified, original data structure."
[ds ks v]
(var d ds)
(def len-1 (- (length ks) 1))
(if (< len-1 0) (error "expected at least 1 key in ks"))
(for i 0 len-1
(def k (get ks i))
(def v (get d k))
(if (= nil v)
(let [newv (table)]
(put d k newv)
(set d newv))
(set d v)))
(def last-key (get ks len-1))
(def last-val (get d last-key))
(put d last-key v)
ds)
(defn update (defn update
"Accepts a key argument and passes its associated value to a function. "Accepts a key argument and passes its associated value to a function.
The key is the re-associated to the function's return value. Returns the updated The key is the re-associated to the function's return value. Returns the updated
@ -1444,6 +1496,21 @@
[x y] [x y]
(not (deep-not= x y))) (not (deep-not= x y)))
(defn freeze
"Freeze an object (make it immutable) and do a deep copy, making
child values also immutable. Closures, fibers, and abstract types
will not be recursively frozen, but all other types will."
[x]
(case (type x)
:array (tuple/slice (map freeze x))
:tuple (tuple/slice (map freeze x))
:table (if-let [p (table/getproto x)]
(freeze (merge (table/clone p) x))
(struct ;(map freeze (kvs x))))
:struct (struct ;(map freeze (kvs x)))
:buffer (string x)
x))
(defn macex (defn macex
"Expand macros completely. "Expand macros completely.
on-binding is an optional callback whenever a normal symbolic binding on-binding is an optional callback whenever a normal symbolic binding

View File

@ -27,10 +27,10 @@
#define JANETCONF_H #define JANETCONF_H
#define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 2 #define JANET_VERSION_MINOR 3
#define JANET_VERSION_PATCH 0 #define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "" #define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.2.0" #define JANET_VERSION "1.3.0"
/* #define JANET_BUILD "local" */ /* #define JANET_BUILD "local" */

View File

@ -445,7 +445,6 @@ tail:
typedef struct { typedef struct {
JanetTable *grammar; JanetTable *grammar;
JanetTable *memoized;
JanetTable *tags; JanetTable *tags;
Janet *constants; Janet *constants;
uint32_t *bytecode; uint32_t *bytecode;
@ -878,27 +877,54 @@ static const SpecialPair peg_specials[] = {
/* Compile a janet value into a rule and return the rule index. */ /* Compile a janet value into a rule and return the rule index. */
static uint32_t peg_compile1(Builder *b, Janet peg) { static uint32_t peg_compile1(Builder *b, Janet peg) {
/* Check for already compiled rules */
Janet check = janet_table_get(b->memoized, peg);
if (!janet_checktype(check, JANET_NIL)) {
uint32_t rule = (uint32_t) janet_unwrap_number(check);
return rule;
}
/* Keep track of the form being compiled for error purposes */ /* Keep track of the form being compiled for error purposes */
Janet old_form = b->form; Janet old_form = b->form;
JanetTable *old_grammar = b->grammar;
b->form = peg; b->form = peg;
/* Check depth */ /* Resolve keyword references */
if (b->depth-- == 0) { int i = JANET_RECURSION_GUARD;
peg_panic(b, "peg grammar recursed too deeply"); JanetTable *grammar = old_grammar;
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
peg = janet_table_get_ex(grammar, peg, &grammar);
if (!grammar)
peg_panic(b, "unknown rule");
b->form = peg;
b->grammar = grammar;
} }
if (i == 0)
peg_panic(b, "reference chain too deep");
/* Check cache - for tuples we check only the local cache, as
* in a different grammar, the same tuple can compile to a different
* rule - for example, (+ :a :b) depends on whatever :a and :b are bound to. */
Janet check = janet_checktype(peg, JANET_TUPLE)
? janet_table_rawget(grammar, peg)
: janet_table_get(grammar, peg);
if (!janet_checktype(check, JANET_NIL)) {
b->form = old_form;
b->grammar = old_grammar;
return (uint32_t) janet_unwrap_number(check);
}
/* Check depth */
if (b->depth-- == 0)
peg_panic(b, "peg grammar recursed too deeply");
/* The final rule to return */ /* The final rule to return */
uint32_t rule = janet_v_count(b->bytecode); uint32_t rule = janet_v_count(b->bytecode);
if (!janet_checktype(peg, JANET_KEYWORD) &&
!janet_checktype(peg, JANET_STRUCT)) { /* Add to cache. Do not cache structs, as we don't yet know
janet_table_put(b->memoized, peg, janet_wrap_number(rule)); * what rule they will return! We can just as effectively cache
* the structs main rule. */
if (!janet_checktype(peg, JANET_STRUCT)) {
JanetTable *which_grammar = grammar;
/* If we are a primitive pattern, add to the global cache (root grammar table) */
if (!janet_checktype(peg, JANET_TUPLE)) {
while (which_grammar->proto)
which_grammar = which_grammar->proto;
}
janet_table_put(which_grammar, peg, janet_wrap_number(rule));
} }
switch (janet_type(peg)) { switch (janet_type(peg)) {
@ -921,22 +947,22 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
emit_bytes(b, RULE_LITERAL, len, str); emit_bytes(b, RULE_LITERAL, len, str);
break; break;
} }
case JANET_KEYWORD: {
Janet check = janet_table_get(b->grammar, peg);
if (janet_checktype(check, JANET_NIL))
peg_panic(b, "unknown rule");
rule = peg_compile1(b, check);
break;
}
case JANET_STRUCT: { case JANET_STRUCT: {
JanetTable *grammar = janet_struct_to_table(janet_unwrap_struct(peg)); /* Build grammar table */
grammar->proto = b->grammar; const JanetKV *st = janet_unwrap_struct(peg);
b->grammar = grammar; JanetTable *new_grammar = janet_table(2 * janet_struct_capacity(st));
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main")); for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
if (janet_checktype(st[i].key, JANET_KEYWORD)) {
janet_table_put(new_grammar, st[i].key, st[i].value);
}
}
new_grammar->proto = grammar;
b->grammar = grammar = new_grammar;
/* Run the main rule */
Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
if (janet_checktype(main_rule, JANET_NIL)) if (janet_checktype(main_rule, JANET_NIL))
peg_panic(b, "grammar requires :main rule"); peg_panic(b, "grammar requires :main rule");
rule = peg_compile1(b, main_rule); rule = peg_compile1(b, main_rule);
b->grammar = grammar->proto;
break; break;
} }
case JANET_TUPLE: { case JANET_TUPLE: {
@ -963,6 +989,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
/* Increase depth again */ /* Increase depth again */
b->depth++; b->depth++;
b->form = old_form; b->form = old_form;
b->grammar = old_grammar;
return rule; return rule;
} }
@ -1189,7 +1216,6 @@ static Peg *make_peg(Builder *b) {
static Peg *compile_peg(Janet x) { static Peg *compile_peg(Janet x) {
Builder builder; Builder builder;
builder.grammar = janet_table(0); builder.grammar = janet_table(0);
builder.memoized = janet_table(0);
builder.tags = janet_table(0); builder.tags = janet_table(0);
builder.constants = NULL; builder.constants = NULL;
builder.bytecode = NULL; builder.bytecode = NULL;

View File

@ -137,6 +137,27 @@ Janet janet_table_get(JanetTable *t, Janet key) {
return janet_wrap_nil(); return janet_wrap_nil();
} }
/* Get a value out of the table, and record which prototype it was from. */
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
*which = t;
return bucket->value;
}
/* Check prototypes */
{
int i;
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
*which = t;
return bucket->value;
}
}
}
return janet_wrap_nil();
}
/* Get a value out of the table. Don't check prototype tables. */ /* Get a value out of the table. Don't check prototype tables. */
Janet janet_table_rawget(JanetTable *t, Janet key) { Janet janet_table_rawget(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key); JanetKV *bucket = janet_table_find(t, key);

View File

@ -1194,6 +1194,7 @@ JANET_API JanetTable *janet_table(int32_t capacity);
JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity); JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity);
JANET_API void janet_table_deinit(JanetTable *table); JANET_API void janet_table_deinit(JanetTable *table);
JANET_API Janet janet_table_get(JanetTable *t, Janet key); JANET_API Janet janet_table_get(JanetTable *t, Janet key);
JANET_API Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which);
JANET_API Janet janet_table_rawget(JanetTable *t, Janet key); JANET_API Janet janet_table_rawget(JanetTable *t, Janet key);
JANET_API Janet janet_table_remove(JanetTable *t, Janet key); JANET_API Janet janet_table_remove(JanetTable *t, Janet key);
JANET_API void janet_table_put(JanetTable *t, Janet key, Janet value); JANET_API void janet_table_put(JanetTable *t, Janet key, Janet value);

View File

@ -421,4 +421,22 @@
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled") (assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled")
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled") (assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled")
# Check for bad memoization (+ :a) should mean different things in different contexts.
(def redef-a
~{:a "abc"
:c (+ :a)
:main (* :c {:a "def" :main (+ :a)} -1)})
(check-match redef-a "abcdef" true)
(check-match redef-a "abcabc" false)
(check-match redef-a "defdef" false)
(def redef-b
~{:pork {:pork "beef" :main (+ -1 (* 1 :pork))}
:main :pork})
(check-match redef-b "abeef" true)
(check-match redef-b "aabeef" false)
(check-match redef-b "aaaaaa" false)
(end-suite) (end-suite)