mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-10-31 07:33:01 +00:00
Code Issues 1 Releases Wiki Activity

More work on frontend.

Browse Source
This commit is contained in:
Calvin Rose
2024-05-09 22:22:38 -05:00
parent ef2dfcd7c3
commit 745567a2e0
5 changed files with 165 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
examples/sysir/frontend.janet
View File

@@ -51,16 +51,18 @@
(array/push into ~(type-prim ,name ,native-name))
(make-type name))
(add-prim-type 'float 'f32)
(add-prim-type 'double 'f64))
(add-prim-type 'double 'f64)
(add-prim-type 'boolean 'boolean))
(defn type-extract
"Given a symbol:type combination, extract the proper name and the type separately"
[combined-name &opt default-type]
(def parts (string/split ":" combined-name 0 1))
(def parts (string/split ":" combined-name 0 2))
(def [name tp] parts)
[(symbol name) (symbol (or tp default-type))])
(var do-binop nil)
(var do-comp nil)
(defn visit1
"Take in a form and compile code and put it into `into`. Return result slot."
@@ -92,6 +94,14 @@
'* (do-binop 'multiply args into)
'/ (do-binop 'divide args into)
# Comparison
'= (do-comp 'eq args into)
'not= (do-comp 'neq args into)
'< (do-comp 'lt args into)
'<= (do-comp 'lte args into)
'> (do-comp 'gt args into)
'>= (do-comp 'gte args into)
# Type hinting
'the
(do
@@ -111,7 +121,8 @@
(def [name tp] (type-extract full-name 'double))
(def result (visit1 value into))
(def slot (get-slot name))
(array/push into ~(bind ,slot ,tp))
(when tp
(array/push into ~(bind ,slot ,tp)))
(array/push into ~(move ,slot ,result))
slot)
@@ -146,6 +157,8 @@
(errorf "cannot compile %V" code)))
(varfn do-binop
"Emit a 'binary' op succh as (+ x y).
Extended to support any number of arguments such as (+ x y z ...)"
[opcode args into]
(var final nil)
(each arg args
@@ -161,14 +174,38 @@
right)))
(assert final))
(varfn do-comp
"Emit a comparison form such as (= x y z ...)"
[opcode args into]
(def result (get-slot))
(def needs-temp (> 2 (length args)))
(def temp-result (if needs-temp (get-slot) nil))
(array/push into ~(bind ,result boolean))
(when needs-temp
(array/push into ~(bind ,temp-result boolean)))
(var left nil)
(var first-compare true)
(each arg args
(def right (visit1 arg into))
(when left
(if first-compare
(array/push into ~(,opcode ,result ,left ,right))
(do
(array/push into ~(,opcode ,temp-result ,left ,right))
(array/push into ~(and ,result ,temp-result ,result))))
(set first-compare false))
(set left right))
result)
###
###
###
(def myprog
'(do
(def xyz (+ 1 2 3))
(def abc (* 4 5 6))
(def xyz:double (+ 1 2 3))
(def abc:double (* 4 5 6))
(def x:boolean (= 5 7))
(return (/ abc xyz))))
(defn dotest

6
src/core/gc.c
View File

@@ -132,7 +132,7 @@ static void janet_mark_many(const Janet *values, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
/* Mark only the keys from a sequence of key-value pairs */
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
@@ -141,7 +141,7 @@ static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
/* Mark only the values from a sequence of key-value pairs */
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
@@ -150,7 +150,7 @@ static void janet_mark_values(const JanetKV *kvs, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
/* Mark key-value pairs */
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {

14
src/core/net.c
View File

@@ -120,6 +120,18 @@ static void janet_net_socknoblock(JSock s) {
#endif
}
static void janet_net_nodelay(JanetStream *stream) {
int flag = 1;
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
stream->flags |= JANET_STREAM_BUFFERED;
}
static void janet_net_delay(JanetStream *stream) {
int flag = 0;
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
stream->flags &= ~JANET_STREAM_BUFFERED;
}
/* State machine for async connect */
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
@@ -953,6 +965,7 @@ struct sockopt_type {
/* List of supported socket options; The type JANET_POINTER is used
* for options that require special handling depending on the type. */
static const struct sockopt_type sockopt_type_list[] = {
{ "tcp-nodelay", IPPROTO_TCP, TCP_NODELAY, JANET_BOOLEAN },
{ "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
{ "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
{ "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
@@ -974,6 +987,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
"- :so-broadcast boolean\n"
"- :so-reuseaddr boolean\n"
"- :so-keepalive boolean\n"
"- :tcp-nodelay boolean\n"
"- :ip-multicast-ttl number\n"
"- :ip-add-membership string\n"
"- :ip-drop-membership string\n"

108
src/core/sysir.c
View File

@@ -31,7 +31,6 @@
* [x] named registers and types
* [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
* [ ] switch internal use of uint32_t everywhere to type struct wrappers for safety
* [ ] support for switch-case
* [ ] x86/x64 machine code target
* [ ] LLVM target
* [ ] target specific extensions - custom instructions and custom primitives
@@ -1075,9 +1074,112 @@ static JanetString rname(JanetSysIR *sysir, uint32_t regid) {
return name;
}
static int reg_is_unknown_type(JanetSysIR *sysir, uint32_t reg) {
JanetSysIRLinkage *linkage = sysir->linkage;
uint32_t t = sysir->types[reg];
return (linkage->type_defs[t].prim == JANET_PRIM_UNKNOWN);
}
static void janet_sysir_type_check(JanetSysIR *sysir) {
/* TODO: Simple forward type inference */
/* Simple forward type inference */
for (uint32_t i = 0; i < sysir->instruction_count; i++) {
JanetSysInstruction instruction = sysir->instructions[i];
switch (instruction.opcode) {
default:
break;
case JANET_SYSOP_MOVE:
if (reg_is_unknown_type(sysir, instruction.two.dest)) {
sysir->types[instruction.two.dest] = sysir->types[instruction.two.src];
}
if (reg_is_unknown_type(sysir, instruction.two.src)) {
sysir->types[instruction.two.src] = sysir->types[instruction.two.dest];
}
break;
case JANET_SYSOP_CAST:
tcheck_cast(sysir, instruction.two.dest, instruction.two.src);
break;
case JANET_SYSOP_POINTER_ADD:
case JANET_SYSOP_POINTER_SUBTRACT:
tcheck_pointer_math(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.rhs);
break;
case JANET_SYSOP_ADD:
case JANET_SYSOP_SUBTRACT:
case JANET_SYSOP_MULTIPLY:
case JANET_SYSOP_DIVIDE:
tcheck_number(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest]));
tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
break;
case JANET_SYSOP_BAND:
case JANET_SYSOP_BOR:
case JANET_SYSOP_BXOR:
tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest]));
tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
break;
case JANET_SYSOP_BNOT:
tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.two.src]));
tcheck_equal(sysir, instruction.two.dest, instruction.two.src);
break;
case JANET_SYSOP_SHL:
case JANET_SYSOP_SHR:
tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.lhs]));
tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
break;
case JANET_SYSOP_LOAD:
tcheck_pointer_equals(sysir, instruction.two.src, instruction.two.dest);
break;
case JANET_SYSOP_STORE:
tcheck_pointer_equals(sysir, instruction.two.dest, instruction.two.src);
break;
case JANET_SYSOP_GT:
case JANET_SYSOP_LT:
case JANET_SYSOP_EQ:
case JANET_SYSOP_NEQ:
case JANET_SYSOP_GTE:
case JANET_SYSOP_LTE:
/* TODO - allow arrays */
tcheck_number_or_pointer(sysir, sysir->types[instruction.three.lhs]);
tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
//tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
tcheck_boolean(sysir, sysir->types[instruction.three.dest]);
break;
case JANET_SYSOP_ADDRESS:
tcheck_pointer(sysir, sysir->types[instruction.two.dest]);
break;
case JANET_SYSOP_BRANCH:
tcheck_boolean(sysir, sysir->types[instruction.branch.cond]);
if (instruction.branch.to >= sysir->instruction_count) {
janet_panicf("label outside of range [0, %u), got %u", sysir->instruction_count, instruction.branch.to);
}
break;
case JANET_SYSOP_CONSTANT:
tcheck_constant(sysir, instruction.constant.dest, sysir->constants[instruction.constant.constant]);
break;
case JANET_SYSOP_CALL:
tcheck_pointer(sysir, sysir->types[instruction.call.callee]);
break;
case JANET_SYSOP_ARRAY_GETP:
tcheck_array_getp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs);
break;
case JANET_SYSOP_ARRAY_PGETP:
tcheck_array_pgetp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs);
break;
case JANET_SYSOP_FIELD_GETP:
tcheck_fgetp(sysir, instruction.field.r, instruction.field.st, instruction.field.field);
break;
case JANET_SYSOP_CALLK:
/* TODO - check function return type */
break;
}
/* Write back possibly modified instruction */
sysir->instructions[i] = instruction;
}
}
/* Assert no unknown types */
JanetSysIRLinkage *linkage = sysir->linkage;
@@ -1173,7 +1275,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
/* TODO - allow arrays */
tcheck_number_or_pointer(sysir, sysir->types[instruction.three.lhs]);
tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
//tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
tcheck_boolean(sysir, sysir->types[instruction.three.dest]);
break;
case JANET_SYSOP_ADDRESS:

1
src/include/janet.h
View File

@@ -584,6 +584,7 @@ typedef void *JanetAbstract;
#define JANET_STREAM_WRITABLE 0x400
#define JANET_STREAM_ACCEPTABLE 0x800
#define JANET_STREAM_UDPSERVER 0x1000
#define JANET_STREAM_BUFFERED 0x2000
#define JANET_STREAM_TOCLOSE 0x10000
typedef enum {