1
0
mirror of https://github.com/janet-lang/janet synced 2025-06-06 16:44:12 +00:00

More work on self hosting the client program.

This commit is contained in:
Calvin Rose 2018-02-07 13:19:34 -05:00
parent 3e1f031576
commit e047b39a87
9 changed files with 214 additions and 69 deletions

76
lib/pp.dst Normal file
View File

@ -0,0 +1,76 @@
#
# Copyright (c) 2017 Calvin Rose
#
# 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.
#
# Define a simple pretty printer
(def pp (do
(defn pp-seq [pp seen buf a start end]
(if (get seen a)
(buffer-push-string buf "<cycle>")
(do
(put seen a true)
(def len (length a))
(buffer-push-string buf start)
(for [i 0 len]
(when (not= i 0) (buffer-push-string buf " "))
(pp seen buf (get a i)))
(buffer-push-string buf end)
))
buf)
(defn pp-dict [pp seen buf a start end]
(if (get seen a)
(buffer-push-string buf "<cycle>")
(do
(put seen a true)
(var k (next a nil))
(buffer-push-string buf start)
(while k
(def v (get a k))
(pp seen buf k)
(buffer-push-string buf " ")
(pp seen buf v)
(varset! k (next a k))
(when k (buffer-push-string buf " "))
)
(buffer-push-string buf end)
))
buf)
(def _printers {
:array (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]"))
:tuple (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
:table (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}"))
:struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
})
(defn _default_printer [pp seen buf x]
(buffer-push-string buf (string x))
buf)
(defn pp1 [seen buf x]
(def pmaybe (get _printers (type x)))
(def p (if pmaybe pmaybe _default_printer))
(p pp1 seen buf x))
(fn [x] (print (pp1 @{} @"" x)))))

View File

@ -9,6 +9,9 @@
[cond & body] [cond & body]
(tuple 'if cond (tuple-prepend body 'do))) (tuple 'if cond (tuple-prepend body 'do)))
(defmacro or [x y] (tuple 'if x true y))
(defmacro and [x y] (tuple 'if x y false))
(def identity (fn [x] x)) (def identity (fn [x] x))
(def seq (do (def seq (do
@ -79,60 +82,6 @@
(tuple 'varset! sym (tuple '+ sym 1)) (tuple 'varset! sym (tuple '+ sym 1))
))) )))
(def pp (do
(defn pp-seq [pp seen buf a start end]
(if (get seen a)
(buffer-push-string buf "<cycle>")
(do
(put seen a true)
(def len (length a))
(buffer-push-string buf start)
(for [i 0 len]
(when (not= i 0) (buffer-push-string buf " "))
(pp seen buf (get a i)))
(buffer-push-string buf end)
))
buf)
(defn pp-dict [pp seen buf a start end]
(if (get seen a)
(buffer-push-string buf "<cycle>")
(do
(put seen a true)
(var k (next a nil))
(buffer-push-string buf start)
(while k
(def v (get a k))
(pp seen buf k)
(buffer-push-string buf " ")
(pp seen buf v)
(varset! k (next a k))
(when k (buffer-push-string buf " "))
)
(buffer-push-string buf end)
))
buf)
(def _printers {
:array (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]"))
:tuple (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
:table (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}"))
:struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
})
(defn _default_printer [pp seen buf x]
(buffer-push-string buf (string x))
buf)
(defn pp1 [seen buf x]
(def pmaybe (get _printers (type x)))
(def p (if pmaybe pmaybe _default_printer))
(p pp1 seen buf x))
(fn [x] (print (pp1 @{} @"" x)))
))
(defn pairs [x] (defn pairs [x]
(var lastkey (next x nil)) (var lastkey (next x nil))
{ {
@ -163,17 +112,14 @@
ret) ret)
}) })
# Handle errors
(defn onerr [t e] (defn onerr [t e]
(print (string t " error: " e))) (print (string t " error: " e)))
(var *read* nil) (var *read* nil)
(var *onvalue* identity) (var *onvalue* identity)
# Cache for require
(def require-loading @{}) (def require-loading @{})
# Create a char stream from a function that gets input
(defn char-stream [getchunk ondone] (defn char-stream [getchunk ondone]
(fiber (fn [parent] (fiber (fn [parent]
(def buf @"") (def buf @"")
@ -186,7 +132,6 @@
(transfer parent (get buf i)))) (transfer parent (get buf i))))
(ondone)))) (ondone))))
# Convert a charstream into a value
(defn val-stream [chars] (defn val-stream [chars]
(fiber (fn [parent] (fiber (fn [parent]
(var up parent) (var up parent)
@ -197,9 +142,7 @@
(if (= s :full) (if (= s :full)
(varset! up (transfer up (parser-produce p))) (varset! up (transfer up (parser-produce p)))
(if (= s :error) (if (= s :error)
# Parse error
(onerr "parse" (parser-error p)) (onerr "parse" (parser-error p))
# Normal state, get next char
(parser-byte p (transfer chars me)))))))) (parser-byte p (transfer chars me))))))))
(defn require [path] (defn require [path]
@ -208,7 +151,7 @@
(def oldread *read*) (def oldread *read*)
(def oldonvalue *onvalue*) (def oldonvalue *onvalue*)
(def f (file-open path)) (def f (file-open path))
(def getter (fn [buf] (file-read f 1024 buf))) (def getter (fn [buf] (file-read f 1024 buf) buf))
(def cs (char-stream getter (fn [] (def cs (char-stream getter (fn []
(put require-loading path nil) (put require-loading path nil)
(file-close f) (file-close f)
@ -234,7 +177,19 @@
(describe ret))) (describe ret)))
(varset! *read* (fn [] (transfer vs (fiber-current))))) (varset! *read* (fn [] (transfer vs (fiber-current)))))
# Main loop (defn dostring [str]
(def oldread *read*)
(def cs (char-stream (fn [buf]
(buffer-push-string buf str)
(buffer-push-string buf "\n")
buf)
(fn []
(varset! *read* oldread)
nil)))
(def vs (val-stream cs))
(varset! *onvalue* identity)
(varset! *read* (fn [] (transfer vs (fiber-current)))))
(defn init-loop [] (defn init-loop []
(while *read* (while *read*
(def wrapper (fiber (fn [] (def wrapper (fiber (fn []

View File

@ -30,6 +30,7 @@ int dst_dobytes(DstTable *env, const uint8_t *bytes, int32_t len) {
DstParser parser; DstParser parser;
int errflags = 0; int errflags = 0;
int32_t index = 0; int32_t index = 0;
int dudeol = 0;
dst_parser_init(&parser, DST_PARSEFLAG_SOURCEMAP); dst_parser_init(&parser, DST_PARSEFLAG_SOURCEMAP);
for (;;) { for (;;) {
@ -56,9 +57,19 @@ int dst_dobytes(DstTable *env, const uint8_t *bytes, int32_t len) {
printf("internal parse error: %s\n", dst_parser_error(&parser)); printf("internal parse error: %s\n", dst_parser_error(&parser));
break; break;
case DST_PARSE_PENDING: case DST_PARSE_PENDING:
if (index >= len) if (index >= len) {
printf("internal parse error: unexpected end of source\n"); if (dudeol) {
/* fallthrough */ errflags |= 0x04;
printf("internal parse error: unexpected end of source\n");
return errflags;
} else {
dudeol = 1;
dst_parser_consume(&parser, '\n');
}
} else {
dst_parser_consume(&parser, bytes[index++]);
}
break;
case DST_PARSE_ROOT: case DST_PARSE_ROOT:
if (index >= len) return errflags; if (index >= len) return errflags;
dst_parser_consume(&parser, bytes[index++]); dst_parser_consume(&parser, bytes[index++]);

View File

@ -55,6 +55,7 @@ static const DstReg cfuns[] = {
{"type", dst_core_type}, {"type", dst_core_type},
{"next", dst_core_next}, {"next", dst_core_next},
{"hash", dst_core_hash}, {"hash", dst_core_hash},
{"string-slice", dst_core_string_slice},
{"exit", dst_core_exit}, {"exit", dst_core_exit},
{NULL, NULL} {NULL, NULL}
}; };

View File

@ -187,11 +187,46 @@ static int cfun_clear(DstArgs args) {
return dst_return(args, args.v[0]); return dst_return(args, args.v[0]);
} }
static int cfun_slice(DstArgs args) {
const uint8_t *data;
int32_t len, start, end;
DstBuffer *ret;
if (args.n < 1 || !dst_chararray_view(args.v[0], &data, &len))
return dst_throw(args, "expected buffer/string");
/* Get start */
if (args.n < 2) {
start = 0;
} else if (dst_checktype(args.v[1], DST_INTEGER)) {
start = dst_unwrap_integer(args.v[1]);
} else {
return dst_throw(args, "expected integer");
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (dst_checktype(args.v[2], DST_INTEGER)) {
end = dst_unwrap_integer(args.v[2]);
} else {
return dst_throw(args, "expected integer");
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;
if (end >= start) {
ret = dst_buffer(end - start);
memcpy(ret->data, data + start, end - start);
ret->count = end - start;
} else {
ret = dst_buffer(0);
}
return dst_return(args, dst_wrap_buffer(ret));
}
static const DstReg cfuns[] = { static const DstReg cfuns[] = {
{"buffer-push-byte", cfun_u8}, {"buffer-push-byte", cfun_u8},
{"buffer-push-integer", cfun_int}, {"buffer-push-integer", cfun_int},
{"buffer-push-string", cfun_chars}, {"buffer-push-string", cfun_chars},
{"buffer-clear", cfun_clear}, {"buffer-clear", cfun_clear},
{"buffer-slice", cfun_slice},
{NULL, NULL} {NULL, NULL}
}; };

View File

@ -270,3 +270,35 @@ int dst_core_hash(DstArgs args) {
if (args.n != 1) return dst_throw(args, "expected 1 argument"); if (args.n != 1) return dst_throw(args, "expected 1 argument");
return dst_return(args, dst_wrap_integer(dst_hash(args.v[0]))); return dst_return(args, dst_wrap_integer(dst_hash(args.v[0])));
} }
int dst_core_string_slice(DstArgs args) {
const uint8_t *data;
int32_t len, start, end;
const uint8_t *ret;
if (args.n < 1 || !dst_chararray_view(args.v[0], &data, &len))
return dst_throw(args, "expected buffer/string");
/* Get start */
if (args.n < 2) {
start = 0;
} else if (dst_checktype(args.v[1], DST_INTEGER)) {
start = dst_unwrap_integer(args.v[1]);
} else {
return dst_throw(args, "expected integer");
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (dst_checktype(args.v[2], DST_INTEGER)) {
end = dst_unwrap_integer(args.v[2]);
} else {
return dst_throw(args, "expected integer");
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;
if (end >= start) {
ret = dst_string(data + start, end - start);
} else {
ret = dst_cstring("");
}
return dst_return(args, dst_wrap_string(ret));
}

View File

@ -93,6 +93,7 @@ int dst_core_gcinterval(DstArgs args);
int dst_core_type(DstArgs args); int dst_core_type(DstArgs args);
int dst_core_next(DstArgs args); int dst_core_next(DstArgs args);
int dst_core_hash(DstArgs args); int dst_core_hash(DstArgs args);
int dst_core_string_slice(DstArgs args);
/* Initialize builtin libraries */ /* Initialize builtin libraries */
int dst_lib_io(DstArgs args); int dst_lib_io(DstArgs args);

View File

@ -1,7 +1,37 @@
(print (string "Dst " VERSION " Copyright (C) 2017-2018 Calvin Rose")) (do
(var dorepl false)
(var nofile true)
# Flag handlers
(def handlers {
"h" (fn []
(print "usage: " (get args 0) " [options] scripts...")
(print "Options are:")
(print " -h Show this help")
(print " -v Print the version string")
(print " -r Enter the repl after running all scripts")
(exit 0))
"v" (fn [] (print VERSION) (exit 0))
"r" (fn [] (varset! dorepl true))
})
(defn dohandler [n]
(def h (get handlers n))
(if h (h) (print "unknown flag -" n)))
# Process arguments # Process arguments
(for [i 0 (length args)] (def nargs (length args))
(print (get args i))) (for [i 1 nargs]
(def arg (get args i))
(if (= "-" (string-slice arg 0 1))
(dohandler (string-slice arg 1 2))
(do
(varset! nofile false)
(require arg)
(init-loop))))
(init-repl) (when (or dorepl nofile)
(print (string "Dst " VERSION " Copyright (C) 2017-2018 Calvin Rose"))
(init-repl))
)

View File

@ -420,6 +420,10 @@ static int root(DstParser *p, DstParseState *state, uint8_t c) {
switch (c) { switch (c) {
default: default:
if (is_whitespace(c)) return 1; if (is_whitespace(c)) return 1;
if (!is_symbol_char(c)) {
p->error = "unexpected character";
return 1;
}
pushstate(p, tokenchar, 0); pushstate(p, tokenchar, 0);
return 0; return 0;
case '\'': case '\'':