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:
parent
3e1f031576
commit
e047b39a87
76
lib/pp.dst
Normal file
76
lib/pp.dst
Normal 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)))))
|
@ -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 []
|
||||||
|
@ -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++]);
|
||||||
|
@ -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}
|
||||||
};
|
};
|
||||||
|
@ -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}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -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));
|
||||||
|
}
|
||||||
|
@ -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);
|
||||||
|
@ -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))
|
||||||
|
)
|
||||||
|
@ -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 '\'':
|
||||||
|
Loading…
x
Reference in New Issue
Block a user