1
This commit is contained in:
commit
bad822447f
6
.gitignore
vendored
Normal file
6
.gitignore
vendored
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
main.s
|
||||||
|
BQN
|
||||||
|
src/runtime
|
||||||
|
src/compiler
|
||||||
|
src/interp
|
||||||
|
c.bqn
|
||||||
2
asmBuild
Executable file
2
asmBuild
Executable file
@ -0,0 +1,2 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
clang -std=c11 -Wall -Wno-microsoft-anon-tag -fms-extensions -O3 -masm=intel -S src/main.c
|
||||||
2
build
Executable file
2
build
Executable file
@ -0,0 +1,2 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
clang -std=c11 -O3 -Wall -Wno-microsoft-anon-tag -fms-extensions -o BQN -lm src/main.c
|
||||||
42
cc.bqn
Executable file
42
cc.bqn
Executable file
@ -0,0 +1,42 @@
|
|||||||
|
#! /usr/bin/env dbqn
|
||||||
|
args←•args
|
||||||
|
return ← 1≡⊑args
|
||||||
|
args↓˜↩ return
|
||||||
|
"call with argument specifying path of mlochbaum/BQN!"!2≤≠args
|
||||||
|
path←(⊑args)∾"/src/"
|
||||||
|
args↓˜↩1
|
||||||
|
L ← {"m_vaB("∾(⍕≠𝕩)∾(∾","⊸∾¨𝕩)∾")"}
|
||||||
|
LI ← {"m_cai32("∾(⍕≠𝕩)∾",(i32[]){"∾(1↓∾","⊸∾¨𝕩)∾"})"}
|
||||||
|
# Escape the special characters that appear in BQN sources.
|
||||||
|
Esc←{
|
||||||
|
in ← (@+0‿9‿10‿13)∾"'""" # Null, Tab, LF, CR, and quotes
|
||||||
|
out ← "0tnr" # Whitespace characters changed to letters
|
||||||
|
i ← in⊐𝕩
|
||||||
|
𝕩 ↩ i ⊏⟜out⌾((i<≠out)⊸/) 𝕩 # Replace
|
||||||
|
∾(i<≠in) /⟜"\"⊸∾¨ 𝕩 # Insert \
|
||||||
|
}
|
||||||
|
Str ← "m_str32(U"""∾Esc∾""")"˜ # A BQN string
|
||||||
|
Char ← {"m_c32(U'"∾(Esc⥊𝕩)∾"')"} # A BQN character
|
||||||
|
Num ← {s←"-"/˜𝕩<0 ⋄ ∞⊸=∘|◶⟨"m_f64("∾")"∾˜s∾⍕∘| ⋄ "m_f64("∾s∾"1.0/0.0)"⟩𝕩} # Format number
|
||||||
|
|
||||||
|
F ← ⍕ # Format number
|
||||||
|
|
||||||
|
Import ← •Import path⊸∾
|
||||||
|
FChars ← •FChars path⊸∾
|
||||||
|
|
||||||
|
compile ← Import "c.bqn"
|
||||||
|
useInd ← "-i"≡⊑args ⋄ args↓˜↩useInd
|
||||||
|
Comp ← (3+useInd) ↑ ((<"inci(runtime["∾⍕∾"])"˙)¨↕62)⊸Compile
|
||||||
|
J ← ∾∾⟜\n¨
|
||||||
|
Fconst ← ≡◶⟨@⊸≤◶Num‿Char, Str, ⊑⟩
|
||||||
|
prov ← {"inci("∾𝕩∾")"}¨"bi_type"‿"bi_fill"‿"bi_log"‿"bi_grLen"‿"bi_grOrd"‿"bi_asrt"‿"bi_add"‿"bi_sub"‿"bi_mul"‿"bi_div"‿"bi_pow"‿"bi_floor"‿"bi_eq"‿"bi_le"‿"bi_fne"‿"bi_shape"‿"bi_pick"‿"bi_ud"‿"bi_tbl"‿"bi_scan"‿"bi_fillBy"‿"bi_val"
|
||||||
|
Fout ← {((≠𝕩)↑⟨LI F¨,L ·prov⊸∾⍟(𝕨⊣0) Fconst¨,L (LI F¨)¨,L (L F¨)¨⟩) {𝕎𝕩}¨ 𝕩}
|
||||||
|
Frun ← 1⊸Fout
|
||||||
|
Long ← {¯2↓∾𝕩∾¨<","∾\n}
|
||||||
|
•Out⍟(¬return) (⊑"r"‿"c"‿"f"‿"e"⊐⊏)◶⟨
|
||||||
|
{𝕩⋄ref‿len←Import "pr.bqn"⋄Long Frun len⊸↓⌾(1⊸⊑)Comp ref}
|
||||||
|
{𝕩⋄Long Fout Comp FChars "c.bqn"}
|
||||||
|
{𝕩⋄Long Fout Comp FChars "f.bqn"}
|
||||||
|
{𝕩⋄Long Fout Comp ⟨"Modify←GetHighlights←⊢⋄"⟩∾∾ (FChars ⊢)∘∾⟜".bqn"¨ "../svg"‿"e"}
|
||||||
|
¯1 ↓ · J L∘Fout∘Comp¨
|
||||||
|
⟩ args
|
||||||
2
debugBuild
Executable file
2
debugBuild
Executable file
@ -0,0 +1,2 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
clang -DDEBUG -std=c11 -g -Wall -Wno-microsoft-anon-tag -fms-extensions -o BQN -lm src/main.c
|
||||||
3
genRuntime
Executable file
3
genRuntime
Executable file
@ -0,0 +1,3 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
./cc.bqn $1 r > src/runtime
|
||||||
|
./cc.bqn $1 c > src/compiler
|
||||||
72
src/arith.c
Normal file
72
src/arith.c
Normal file
@ -0,0 +1,72 @@
|
|||||||
|
#include "h.h"
|
||||||
|
#include <math.h>
|
||||||
|
|
||||||
|
#define ffnx(name, expr, extra) B name(B t, B w, B x) { \
|
||||||
|
if (isF64(w) & isF64(x)) return m_f64(expr); \
|
||||||
|
extra \
|
||||||
|
return err(#name ": invalid arithmetic"); \
|
||||||
|
}
|
||||||
|
#define ffn(name, op, extra) ffnx(name, w.f op x.f, extra)
|
||||||
|
|
||||||
|
ffn(add_c2, +, {
|
||||||
|
if (isC32(w) & isF64(x)) return m_c32((u32)w.u + o2i(x));
|
||||||
|
if (isF64(w) & isC32(x)) return m_c32((u32)x.u + o2i(w));
|
||||||
|
})
|
||||||
|
ffn(sub_c2, -, {
|
||||||
|
if (isC32(w) & isF64(x)) return m_c32((u32)w.u - o2i(x));
|
||||||
|
if (isC32(w) & isC32(x)) return m_f64((u32)w.u - (i64)(u32)x.u);
|
||||||
|
})
|
||||||
|
ffn(mul_c2, *, {})
|
||||||
|
ffn(div_c2, /, {})
|
||||||
|
ffn(le_c2, <=, {
|
||||||
|
if (isC32(w) & isC32(x)) return m_f64(w.u<=x.u);
|
||||||
|
if (isF64(w) & isC32(x)) return m_f64(1);
|
||||||
|
if (isC32(w) & isF64(x)) return m_f64(0);
|
||||||
|
})
|
||||||
|
ffnx(pow_c2, pow(w.f,x.f), {})
|
||||||
|
ffnx(log_c2, log(x.f)/log(w.f), {})
|
||||||
|
|
||||||
|
#undef ffn
|
||||||
|
#undef ffnx
|
||||||
|
|
||||||
|
B decp_c1(B t, B x);
|
||||||
|
B eq_c2(B t, B w, B x) {
|
||||||
|
if(isF64(w)&isF64(x)) return m_i32(w.f==x.f);
|
||||||
|
if (w.u==x.u) return m_i32(1);
|
||||||
|
if (!isVal(w) | !isVal(x)) { dec(w);dec(x); return m_i32(0); }
|
||||||
|
if (v(w)->type!=v(x)->type) { dec(w);dec(x); return m_i32(0); }
|
||||||
|
B2B dcf = TI(w).decompose;
|
||||||
|
if (dcf == def_decompose) { dec(w);dec(x); return m_i32(0); }
|
||||||
|
w=dcf(w); B* wp = harr_ptr(w);
|
||||||
|
x=dcf(x); B* xp = harr_ptr(x);
|
||||||
|
if (o2i(wp[0])<=1) { dec(w);dec(x); return m_i32(0); }
|
||||||
|
i32 wia = a(w)->ia;
|
||||||
|
i32 xia = a(x)->ia;
|
||||||
|
if (wia != xia) { dec(w);dec(x); return m_i32(0); }
|
||||||
|
for (i32 i = 0; i<wia; i++) if(!o2i(eq_c2(t,inci(wp[i]),inci(xp[i]))))
|
||||||
|
{ dec(w);dec(x); return m_i32(0); }
|
||||||
|
dec(w);dec(x); return m_i32(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
B add_c1(B t, B x) { return x; }
|
||||||
|
B sub_c1(B t, B x) { if (isF64(x)) return m_f64( -x.f ); return err("negating non-number"); }
|
||||||
|
B mul_c1(B t, B x) { if (isF64(x)) return m_f64(x.f?x.f>0?1:-1:0); return err("getting sign of non-number"); }
|
||||||
|
B div_c1(B t, B x) { if (isF64(x)) return m_f64( 1/x.f ); return err("getting reciprocal of non-number"); }
|
||||||
|
B pow_c1(B t, B x) { if (isF64(x)) return m_f64( exp(x.f)); return err("getting exp of non-number"); }
|
||||||
|
B floor_c1(B t, B x) { if (isF64(x)) return m_f64(floor(x.f)); return err("getting floor of non-number"); }
|
||||||
|
B log_c1(B t, B x) { if (isF64(x)) return m_f64( log(x.f)); return err("getting log of non-number"); }
|
||||||
|
B eq_c1(B t, B x) { B r = m_i32(isArr(x)? a(x)->rank : 0); dec(x); return r; }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
|
||||||
|
B bi_add, bi_sub, bi_mul, bi_div, bi_pow, bi_floor, bi_eq, bi_le, bi_log;
|
||||||
|
void arith_init() { ba(add) ba(sub) ba(mul) ba(div) ba(pow) bm(floor) ba(eq) bd(le) ba(log) }
|
||||||
|
|
||||||
|
#undef ba
|
||||||
|
#undef bd
|
||||||
|
#undef bm
|
||||||
78
src/derv.c
Normal file
78
src/derv.c
Normal file
@ -0,0 +1,78 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
typedef struct Md1D { // F _md
|
||||||
|
struct Fun;
|
||||||
|
B m; // known to be Md1 at creation; kept as type B as refc-- might want to know tagged ptr info
|
||||||
|
B f;
|
||||||
|
} Md1D;
|
||||||
|
typedef struct Md2D { // F _md_ G
|
||||||
|
struct Fun;
|
||||||
|
B m;
|
||||||
|
B f, g;
|
||||||
|
} Md2D;
|
||||||
|
typedef struct Md2H { // _md_ G
|
||||||
|
struct Md1;
|
||||||
|
B m;
|
||||||
|
B g;
|
||||||
|
} Md2H;
|
||||||
|
typedef struct Fork {
|
||||||
|
struct Fun;
|
||||||
|
B f, g, h;
|
||||||
|
} Fork;
|
||||||
|
typedef struct Atop {
|
||||||
|
struct Fun;
|
||||||
|
B g, h;
|
||||||
|
} Atop;
|
||||||
|
|
||||||
|
void md1D_free(B x) { dec(c(Md1D,x)->m); dec(c(Md1D,x)->f); }
|
||||||
|
void md2D_free(B x) { dec(c(Md2D,x)->m); dec(c(Md2D,x)->f); dec(c(Md2D,x)->g); }
|
||||||
|
void md2H_free(B x) { dec(c(Md2H,x)->m); dec(c(Md2H,x)->g); }
|
||||||
|
void fork_free(B x) { dec(c(Fork,x)->f); dec(c(Fork,x)->g); dec(c(Fork,x)->h); }
|
||||||
|
void atop_free(B x) { dec(c(Atop,x)->g); dec(c(Atop,x)->h); }
|
||||||
|
|
||||||
|
void md1D_print(B x) { printf("(md1D ");print(c(Md1D,x)->f);printf(" ");print(c(Md1D,x)->m); printf(")"); }
|
||||||
|
void md2D_print(B x) { printf("(md2D ");print(c(Md2D,x)->f);printf(" ");print(c(Md2D,x)->m);printf(" ");print(c(Md2D,x)->g);printf(")"); }
|
||||||
|
void md2H_print(B x) { printf("(md2H "); print(c(Md2H,x)->m);printf(" ");print(c(Md2H,x)->g);printf(")"); }
|
||||||
|
void fork_print(B x) { printf("(fork ");print(c(Fork,x)->f);printf(" ");print(c(Fork,x)->g);printf(" ");print(c(Fork,x)->h);printf(")"); }
|
||||||
|
void atop_print(B x) { printf("(atop "); print(c(Atop,x)->g);printf(" ");print(c(Atop,x)->h);printf(")"); }
|
||||||
|
|
||||||
|
B md1D_c1(B t , B x) { return c(Md1,c(Md1D, t)->m)->c1(c(Md1D, t)->m, c(Md1D, t)->f, x); }
|
||||||
|
B md1D_c2(B t, B w, B x) { return c(Md1,c(Md1D, t)->m)->c2(c(Md1D, t)->m, c(Md1D, t)->f, w, x); }
|
||||||
|
B md2D_c1(B t , B x) { return c(Md2,c(Md2D, t)->m)->c1(c(Md2D, t)->m, c(Md2D, t)->f, c(Md2D, t)->g, x); }
|
||||||
|
B md2D_c2(B t, B w, B x) { return c(Md2,c(Md2D, t)->m)->c2(c(Md2D, t)->m, c(Md2D, t)->f, c(Md2D, t)->g, w, x); }
|
||||||
|
B atop_c1(B t , B x) { return c1(c(Atop,t)->g, c1(c(Atop,t)->h, x)); }
|
||||||
|
B atop_c2(B t, B w, B x) { return c1(c(Atop,t)->g, c2(c(Atop,t)->h, w, x)); }
|
||||||
|
B fork_c1(B t , B x) { B g=c1(c(Fork,t)->h, inci(x)); return c2(c(Fork,t)->g, c1(c(Fork,t)->f, x), g); }
|
||||||
|
B fork_c2(B t, B w, B x) { B g=c2(c(Fork,t)->h, inci(w), inci(x)); return c2(c(Fork,t)->g, c2(c(Fork,t)->f, w, x), g); }
|
||||||
|
B md2H_c1(B t, B f , B x) { return c(Md2,c(Md2H, t)->m)->c1(c(Md2H,t)->m, f, c(Md2H,t)->g, x); }
|
||||||
|
B md2H_c2(B t, B f, B w, B x) { return c(Md2,c(Md2H, t)->m)->c2(c(Md2H,t)->m, f, c(Md2H,t)->g, w, x); }
|
||||||
|
|
||||||
|
B md1D_decompose(B x) { B r=m_v3(m_i32(4),inci(c(Md1D,x)->f),inci(c(Md1D,x)->m) ); dec(x); return r; }
|
||||||
|
B md2D_decompose(B x) { B r=m_v4(m_i32(5),inci(c(Md2D,x)->f),inci(c(Md2D,x)->m), inci(c(Md2D,x)->g)); dec(x); return r; }
|
||||||
|
B md2H_decompose(B x) { B r=m_v3(m_i32(6), inci(c(Md2H,x)->m), inci(c(Md2H,x)->g)); dec(x); return r; }
|
||||||
|
B fork_decompose(B x) { B r=m_v4(m_i32(3),inci(c(Fork,x)->f),inci(c(Fork,x)->g), inci(c(Fork,x)->h)); dec(x); return r; }
|
||||||
|
B atop_decompose(B x) { B r=m_v3(m_i32(2), inci(c(Atop,x)->g), inci(c(Atop,x)->h)); dec(x); return r; }
|
||||||
|
|
||||||
|
// consume all args
|
||||||
|
B m_md1D(B m, B f ) { B r = mm_alloc(sizeof(Md1D), t_md1D, ftag(FUN_TAG)); c(Md1D,r)->f = f; c(Md1D,r)->m = m; c(Md1D,r)->c1=md1D_c1; c(Md1D,r)->c2=md1D_c2; c(Md1D,r)->id=pf_md1d; return r; }
|
||||||
|
B m_md2D(B m, B f, B g) { B r = mm_alloc(sizeof(Md2D), t_md2D, ftag(FUN_TAG)); c(Md2D,r)->f = f; c(Md2D,r)->m = m; c(Md2D,r)->g = g; c(Md2D,r)->c1=md2D_c1; c(Md2D,r)->c2=md2D_c2; c(Md2D,r)->id=pf_md2d; return r; }
|
||||||
|
B m_md2H(B m, B g) { B r = mm_alloc(sizeof(Md2H), t_md2H, ftag(MD1_TAG)); c(Md2H,r)->m = m; c(Md2H,r)->g = g; c(Md2H,r)->c1=md2H_c1; c(Md2H,r)->c2=md2H_c2; return r; }
|
||||||
|
B m_fork(B f, B g, B h) { B r = mm_alloc(sizeof(Fork), t_fork, ftag(FUN_TAG)); c(Fork,r)->f = f; c(Fork,r)->g = g; c(Fork,r)->h = h; c(Fork,r)->c1=fork_c1; c(Fork,r)->c2=fork_c2; c(Fork,r)->id=pf_fork; return r; }
|
||||||
|
B m_atop( B g, B h) { B r = mm_alloc(sizeof(Atop), t_atop, ftag(FUN_TAG)); c(Atop,r)->g = g; c(Atop,r)->h = h; c(Atop,r)->c1=atop_c1; c(Atop,r)->c2=atop_c2; c(Atop,r)->id=pf_atop; return r; }
|
||||||
|
|
||||||
|
// consume all args
|
||||||
|
B m1_d(B m, B f ) { if(isMd1(m)) return TI(m).m1_d(m, f ); return err("Interpreting non-1-modifier as 1-modifier"); }
|
||||||
|
B m2_d(B m, B f, B g) { if(isMd2(m)) return TI(m).m2_d(m, f, g); return err("Interpreting non-2-modifier as 2-modifier"); }
|
||||||
|
B m2_h(B m, B g) { return m_md2H(m, g); }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
void derv_init() {
|
||||||
|
ti[t_md1D].free = md1D_free; ti[t_md1D].print = md1D_print; ti[t_md1D].decompose = md1D_decompose;
|
||||||
|
ti[t_md2D].free = md2D_free; ti[t_md2D].print = md2D_print; ti[t_md2D].decompose = md2D_decompose;
|
||||||
|
ti[t_md2H].free = md2H_free; ti[t_md2H].print = md2H_print; ti[t_md2H].decompose = md2H_decompose;
|
||||||
|
ti[t_fork].free = fork_free; ti[t_fork].print = fork_print; ti[t_fork].decompose = fork_decompose;
|
||||||
|
ti[t_atop].free = atop_free; ti[t_atop].print = atop_print; ti[t_atop].decompose = atop_decompose;
|
||||||
|
ti[t_md1_def].m1_d = m_md1D;
|
||||||
|
ti[t_md2_def].m2_d = m_md2D;
|
||||||
|
}
|
||||||
441
src/h.h
Normal file
441
src/h.h
Normal file
@ -0,0 +1,441 @@
|
|||||||
|
#pragma once
|
||||||
|
#include <inttypes.h>
|
||||||
|
#include <stdbool.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <stddef.h>
|
||||||
|
#include <stdarg.h>
|
||||||
|
#define i8 int8_t
|
||||||
|
#define u8 uint8_t
|
||||||
|
#define i16 int16_t
|
||||||
|
#define u16 uint16_t
|
||||||
|
#define i32 int32_t
|
||||||
|
#define u32 uint32_t
|
||||||
|
#define i64 int64_t
|
||||||
|
#define u64 uint64_t
|
||||||
|
#define f64 double
|
||||||
|
#define I32_MAX ((i32)((1LL<<31)-1))
|
||||||
|
#define U16_MAX ((u16)-1)
|
||||||
|
#define UD __builtin_unreachable();
|
||||||
|
|
||||||
|
#ifdef DEBUG
|
||||||
|
#include<assert.h>
|
||||||
|
#define VALIDATE(x) validate(x) // preferred validating level
|
||||||
|
#else
|
||||||
|
#define assert(x) {if (!(x)) __builtin_unreachable();}
|
||||||
|
#define VALIDATE(x) x
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define fsizeof(T,F,E,n) (offsetof(T, F) + sizeof(E)*n) // type; FAM name; FAM type; amount
|
||||||
|
#define usz u32
|
||||||
|
#define ur u8
|
||||||
|
#define ftag(x) ((u64)(x) << 48)
|
||||||
|
#define tag(v, t) b(((u64)(v)) | ftag(t))
|
||||||
|
// .111111111110000000000000000000000000000000000000000000000000000 infinity
|
||||||
|
// .111111111111000000000000000000000000000000000000000000000000000 qNaN
|
||||||
|
// .111111111110nnn................................................ sNaN aka tagged aka not f64, if nnn≠0
|
||||||
|
// 0111111111110................................................... direct value with no need of refcounting
|
||||||
|
u16 C32_TAG = 0b0111111111110001; // 0111111111110001................00000000000ccccccccccccccccccccc char
|
||||||
|
u16 TAG_TAG = 0b0111111111110010; // 0111111111110010................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn special value (0=nothing, 1=undefined var, 2=bad header; 3=optimized out; 4=error?)
|
||||||
|
u16 VAR_TAG = 0b0111111111110011; // 0111111111110011ddddddddddddddddnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn variable reference
|
||||||
|
u16 I32_TAG = 0b0111111111110111; // 0111111111110111................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn 32-bit int; unused
|
||||||
|
u16 MD1_TAG = 0b1111111111110010; // 1111111111110010ppppppppppppppppppppppppppppppppppppppppppppp000 1-modifier
|
||||||
|
u16 MD2_TAG = 0b1111111111110011; // 1111111111110011ppppppppppppppppppppppppppppppppppppppppppppp000 2-modifier
|
||||||
|
u16 FUN_TAG = 0b1111111111110100; // 1111111111110100ppppppppppppppppppppppppppppppppppppppppppppp000 function
|
||||||
|
u16 NSP_TAG = 0b1111111111110101; // 1111111111110101ppppppppppppppppppppppppppppppppppppppppppppp000 namespace maybe?
|
||||||
|
u16 OBJ_TAG = 0b1111111111110110; // 1111111111110110ppppppppppppppppppppppppppppppppppppppppppppp000 custom object (e.g. bigints)
|
||||||
|
u16 ARR_TAG = 0b1111111111110111; // 1111111111110111ppppppppppppppppppppppppppppppppppppppppppppp000 array (everything else is an atom)
|
||||||
|
u16 VAL_TAG = 0b1111111111110 ; // 1111111111110................................................... pointer to Value, needs refcounting
|
||||||
|
|
||||||
|
enum Type {
|
||||||
|
/* 0*/ t_empty, // empty bucket placeholder
|
||||||
|
/* 1*/ t_fun_def, t_fun_block,
|
||||||
|
/* 3*/ t_md1_def, t_md1_block,
|
||||||
|
/* 5*/ t_md2_def, t_md2_block,
|
||||||
|
/* 7*/ t_noGC, // doesn't get visited, shouldn't be unallocated by gc
|
||||||
|
|
||||||
|
/* 8*/ t_fork, t_atop,
|
||||||
|
/*10*/ t_md1D, t_md2D, t_md2H,
|
||||||
|
|
||||||
|
/*13*/ t_harr, t_i32arr,
|
||||||
|
|
||||||
|
/*15*/ t_comp, t_block, t_body, t_scope,
|
||||||
|
|
||||||
|
|
||||||
|
Type_MAX
|
||||||
|
};
|
||||||
|
|
||||||
|
enum PrimFns {
|
||||||
|
pf_not,
|
||||||
|
pf_add, pf_sub, pf_mul, pf_div, pf_pow, pf_floor, pf_eq, pf_le, pf_log, // arith.c
|
||||||
|
pf_shape, pf_pick, pf_ud, pf_pair, pf_fne, pf_lt, pf_rt, // sfns.c
|
||||||
|
pf_fork, pf_atop, pf_md1d, pf_md2d, // derv.c
|
||||||
|
pf_type, pf_decp, pf_primInd, pf_glyph, pf_fill, pf_grLen, pf_grOrd, pf_asrt, // sysfn.c
|
||||||
|
};
|
||||||
|
char* format_pf(u8 u) {
|
||||||
|
switch(u) {
|
||||||
|
default: case pf_not: return"(unknown fn)";
|
||||||
|
case pf_add:return"+"; case pf_sub:return"-"; case pf_mul:return"×"; case pf_div:return"÷"; case pf_pow:return"⋆"; case pf_floor:return"⌊"; case pf_eq:return"="; case pf_le:return"≤"; case pf_log:return"⋆⁼";
|
||||||
|
case pf_shape:return"⥊"; case pf_pick:return"⊑"; case pf_ud:return"↕"; case pf_pair:return"{𝕨‿𝕩}"; case pf_fne:return"≢"; case pf_lt:return"⊣"; case pf_rt:return"⊢";
|
||||||
|
case pf_fork:return"(fork)"; case pf_atop:return"(atop)"; case pf_md1d:return"(derived 1-modifier)"; case pf_md2d:return"(derived 2-modifier)";
|
||||||
|
case pf_type:return"•Type"; case pf_decp:return"•Decompose"; case pf_primInd:return"•PrimInd"; case pf_glyph:return"•Glyph"; case pf_fill:return"•FillFn"; case pf_grLen:return"•GroupLen"; case pf_grOrd:return"•GroupOrd"; case pf_asrt:return"!"; }
|
||||||
|
}
|
||||||
|
enum PrimMd1 {
|
||||||
|
pm1_not,
|
||||||
|
pm1_tbl, pm1_scan, // md1.c
|
||||||
|
};
|
||||||
|
char* format_pm1(u8 u) {
|
||||||
|
switch(u) {
|
||||||
|
default: case pf_not: return"(unknown 1-modifier)";
|
||||||
|
case pm1_tbl: return"⌜"; case pm1_scan: return"`";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
typedef union B {
|
||||||
|
u64 u;
|
||||||
|
i64 s;
|
||||||
|
f64 f;
|
||||||
|
} B;
|
||||||
|
#define b(x) ((B)(x))
|
||||||
|
|
||||||
|
typedef struct Value {
|
||||||
|
i32 refc;
|
||||||
|
u16 flags; // incl GC stuff when that's a thing, possibly whether is sorted/a permutation/whatever, bucket size, etc
|
||||||
|
u8 type; // needed globally so refc-- and GC know what to visit
|
||||||
|
} Value;
|
||||||
|
typedef struct Arr {
|
||||||
|
struct Value;
|
||||||
|
ur rank;
|
||||||
|
usz ia;
|
||||||
|
usz* sh;
|
||||||
|
} Arr;
|
||||||
|
|
||||||
|
// memory manager
|
||||||
|
B mm_alloc(usz sz, u8 type, u64 tag);
|
||||||
|
void mm_free(Value* x);
|
||||||
|
void mm_visit(B x);
|
||||||
|
|
||||||
|
// some primitive actions
|
||||||
|
void dec(B x);
|
||||||
|
void inc(B x);
|
||||||
|
void ptr_dec(void* x);
|
||||||
|
void ptr_inc(void* x);
|
||||||
|
void print(B x);
|
||||||
|
B m_v1(B a );
|
||||||
|
B m_v2(B a, B b );
|
||||||
|
B m_v3(B a, B b, B c );
|
||||||
|
B m_v4(B a, B b, B c, B d);
|
||||||
|
#define c(T,x) ((T*)((x).u&0xFFFFFFFFFFFFull))
|
||||||
|
Value* v(B x) { return c(Value, x); }
|
||||||
|
Arr* a(B x) { return c(Arr , x); }
|
||||||
|
|
||||||
|
void print_vmStack();
|
||||||
|
#ifdef DEBUG
|
||||||
|
B validate(B x);
|
||||||
|
B recvalidate(B x);
|
||||||
|
#else
|
||||||
|
#define validate(x) x
|
||||||
|
#define recvalidate(x) x
|
||||||
|
#endif
|
||||||
|
B err(char* s) {
|
||||||
|
puts(s); fflush(stdout);
|
||||||
|
print_vmStack();
|
||||||
|
exit(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
// tag checks
|
||||||
|
#ifdef ATOM_I32
|
||||||
|
bool isI32(B x) { return (x.u>>48) == I32_TAG; }
|
||||||
|
#else
|
||||||
|
bool isI32(B x) { return false; }
|
||||||
|
#endif
|
||||||
|
bool isFun(B x) { return (x.u>>48) == FUN_TAG; }
|
||||||
|
bool isArr(B x) { return (x.u>>48) == ARR_TAG; }
|
||||||
|
bool isC32(B x) { return (x.u>>48) == C32_TAG; }
|
||||||
|
bool isVar(B x) { return (x.u>>48) == VAR_TAG; }
|
||||||
|
bool isMd1(B x) { return (x.u>>48) == MD1_TAG; }
|
||||||
|
bool isMd2(B x) { return (x.u>>48) == MD2_TAG; }
|
||||||
|
bool isMd (B x) { return (x.u>>49) ==(MD2_TAG>>1); }
|
||||||
|
bool isNsp(B x) { return (x.u>>48) == NSP_TAG; }
|
||||||
|
bool isObj(B x) { return (x.u>>48) == OBJ_TAG; }
|
||||||
|
// bool isVal(B x) { return ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0); }
|
||||||
|
// bool isF64(B x) { return ((x.u>>51&0xFFF) != 0xFFE) | ((x.u<<1)==(b(1.0/0.0).u<<1)); }
|
||||||
|
bool isVal(B x) { return (x.u - (((u64)VAL_TAG<<51) + 1)) < ((1ull<<51) - 1); } // ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0);
|
||||||
|
bool isF64(B x) { return (x.u<<1) - ((0xFFEull<<52) + 2) >= (1ull<<52) - 2; }
|
||||||
|
|
||||||
|
bool isAtm(B x) { return !isVal(x); }
|
||||||
|
|
||||||
|
// shape mess
|
||||||
|
typedef struct ShArr {
|
||||||
|
struct Value;
|
||||||
|
usz a[];
|
||||||
|
} ShArr;
|
||||||
|
usz* allocSh(ur r) {
|
||||||
|
assert(r>0);
|
||||||
|
B x = mm_alloc(fsizeof(ShArr, a, usz, r), t_noGC, ftag(OBJ_TAG));
|
||||||
|
return ((ShArr*)v(x))->a;
|
||||||
|
}
|
||||||
|
ShArr* shObj(B x) { return (ShArr*)((u64)a(x)->sh-offsetof(ShArr,a)); }
|
||||||
|
void decSh(B x) { if (a(x)->rank>1) ptr_dec(shObj(x)); }
|
||||||
|
|
||||||
|
void arr_shVec(B x, usz ia) {
|
||||||
|
a(x)->ia = ia;
|
||||||
|
a(x)->rank = 1;
|
||||||
|
a(x)->sh = &a(x)->ia;
|
||||||
|
}
|
||||||
|
usz* arr_shAlloc(B x, usz ia, usz r) {
|
||||||
|
a(x)->ia = ia;
|
||||||
|
a(x)->rank = r;
|
||||||
|
if (r>1) return a(x)->sh = allocSh(r);
|
||||||
|
a(x)->sh = &a(x)->ia;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
void arr_shCopy(B n, B o) { // copy shape from o to n
|
||||||
|
a(n)->ia = a(o)->ia;
|
||||||
|
ur r = a(n)->rank = a(o)->rank;
|
||||||
|
if (r<=1) {
|
||||||
|
a(n)->sh = &a(n)->ia;
|
||||||
|
} else {
|
||||||
|
a(n)->sh = a(o)->sh;
|
||||||
|
ptr_inc(shObj(o));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
bool shEq(B w, B x) { // assumes both are Arr
|
||||||
|
ur wr = a(w)->rank; usz* wsh = a(w)->sh;
|
||||||
|
ur xr = a(x)->rank; usz* xsh = a(x)->sh;
|
||||||
|
if (wr!=xr) return false;
|
||||||
|
if (wsh==xsh) return true;
|
||||||
|
return memcmp(wsh,xsh,wr*sizeof(usz))==0;
|
||||||
|
}
|
||||||
|
usz arr_csz(B x) {
|
||||||
|
ur xr = a(x)->rank;
|
||||||
|
if (xr<=1) return 1;
|
||||||
|
usz* sh = a(x)->sh;
|
||||||
|
usz r = 1;
|
||||||
|
for (i32 i = 1; i < xr; i++) r*= sh[i];
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
// make objects
|
||||||
|
B m_arr(usz min, u8 type) { return mm_alloc(min, type, ftag(ARR_TAG)); }
|
||||||
|
B m_f64(f64 n) { assert(isF64(b(n))); return b(n); } // assert just to make sure we're actually creating a float
|
||||||
|
B m_c32(i32 n) { return tag(n, C32_TAG); } // TODO check validity?
|
||||||
|
#ifdef ATOM_I32
|
||||||
|
B m_i32(i32 n) { return tag(n, I32_TAG); }
|
||||||
|
#else
|
||||||
|
B m_i32(i32 n) { return m_f64(n); }
|
||||||
|
#endif
|
||||||
|
B m_error() { return tag(4, TAG_TAG); }
|
||||||
|
B m_usz(usz n) { return n==(i32)n? m_i32(n) : m_f64(n); }
|
||||||
|
|
||||||
|
i32 o2i (B x) { if ((i32)x.f!=x.f) err("o2i"": expected integer"); return (i32)x.f; }
|
||||||
|
usz o2s (B x) { if ((usz)x.f!=x.f) err("o2s"": expected integer"); return (usz)x.f; }
|
||||||
|
i64 o2i64(B x) { if ((i64)x.f!=x.f) err("o2i64: expected integer"); return (i64)x.f; }
|
||||||
|
|
||||||
|
|
||||||
|
typedef void (*B2V)(B);
|
||||||
|
typedef B (*BS2B)(B, usz);
|
||||||
|
typedef B (* B2B)(B);
|
||||||
|
typedef B (* BB2B)(B, B);
|
||||||
|
typedef B (* BBB2B)(B, B, B);
|
||||||
|
typedef B (* BBBB2B)(B, B, B, B);
|
||||||
|
typedef B (*BBBBB2B)(B, B, B, B, B);
|
||||||
|
|
||||||
|
typedef struct TypeInfo {
|
||||||
|
B2V free; // expects refc==0
|
||||||
|
B2V visit; // for GC when that comes around
|
||||||
|
B2V print; // doesn't consume
|
||||||
|
BS2B get; // increments result, doesn't consume arg
|
||||||
|
BB2B m1_d; // consume all args
|
||||||
|
BBB2B m2_d; // consume all args
|
||||||
|
B2B decompose; // consumes; must return a HArr
|
||||||
|
} TypeInfo;
|
||||||
|
TypeInfo ti[Type_MAX];
|
||||||
|
#define TI(x) (ti[v(x)->type])
|
||||||
|
|
||||||
|
|
||||||
|
void do_nothing(B x) { }
|
||||||
|
B get_self(B x, usz n) { return x; }
|
||||||
|
void def_print(B x) { printf("(type %d)", v(x)->type); }
|
||||||
|
B def_m1_d(B m, B f ) { return err("cannot derive this"); }
|
||||||
|
B def_m2_d(B m, B f, B g) { return err("cannot derive this"); }
|
||||||
|
B def_decompose(B x) { return m_v2(m_i32((isFun(x)|isMd(x))? 0 : -1),x); }
|
||||||
|
|
||||||
|
B bi_nothing, bi_noVar, bi_badHdr, bi_optOut;
|
||||||
|
void hdr_init() {
|
||||||
|
for (i32 i = 0; i < Type_MAX; ++i) {
|
||||||
|
ti[i].visit = ti[i].free = do_nothing;
|
||||||
|
ti[i].get = get_self;
|
||||||
|
ti[i].print = def_print;
|
||||||
|
ti[i].m1_d = def_m1_d;
|
||||||
|
ti[i].m2_d = def_m2_d;
|
||||||
|
ti[i].decompose = def_decompose;
|
||||||
|
}
|
||||||
|
bi_nothing = tag(0, TAG_TAG);
|
||||||
|
bi_noVar = tag(1, TAG_TAG);
|
||||||
|
bi_badHdr = tag(2, TAG_TAG);
|
||||||
|
bi_optOut = tag(3, TAG_TAG);
|
||||||
|
}
|
||||||
|
|
||||||
|
bool isNothing(B b) { return b.u==bi_nothing.u; }
|
||||||
|
|
||||||
|
|
||||||
|
// refcount
|
||||||
|
void dec(B x) {
|
||||||
|
if (!isVal(VALIDATE(x))) return;
|
||||||
|
Value* vx = v(x);
|
||||||
|
assert(vx->refc>0);
|
||||||
|
if (!--vx->refc) {
|
||||||
|
// printf("freeing type %d: %p\n", vx->type, (void*)x.u);fflush(stdout);
|
||||||
|
ti[vx->type].free(x);
|
||||||
|
mm_free(vx);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
void inc (B x) { if (isVal(VALIDATE(x))) v(x)->refc++; }
|
||||||
|
B inci(B x) { inc(x); return x; }
|
||||||
|
void ptr_dec(void* x) { dec(tag(x, OBJ_TAG)); }
|
||||||
|
void ptr_inc(void* x) { inc(tag(x, OBJ_TAG)); }
|
||||||
|
bool reusable(B x) { return v(x)->refc==1; }
|
||||||
|
|
||||||
|
void printUTF8(u32 c) {
|
||||||
|
if (c<128) printf("%c", c);
|
||||||
|
else if (c<=0x07FF) printf("%c%c" , 0xC0| c>>6 , 0x80| (c &0x3F) );
|
||||||
|
else if (c<=0xFFFF) printf("%c%c%c" , 0xE0| c>>12, 0x80| (c>>6 &0x3F), 0x80| (c &0x3F) );
|
||||||
|
else printf("%c%c%c%c", 0xF0| c>>18, 0x80| (c>>12 &0x3F), 0x80| (c>>6 &0x3F), 0x80| (c&0x3F));
|
||||||
|
}
|
||||||
|
|
||||||
|
void print(B x) {
|
||||||
|
if (isF64(x)) {
|
||||||
|
printf("%g", x.f);
|
||||||
|
} else if (isC32(x)) {
|
||||||
|
if ((u32)x.u>=32) { printf("'"); printUTF8((u32)x.u); printf("'"); }
|
||||||
|
else printf("\\x%x", (u32)x.u);
|
||||||
|
} else if (isI32(x)) {
|
||||||
|
printf("%d", (i32)x.u);
|
||||||
|
} else if (isVal(x)) {
|
||||||
|
#ifdef DEBUG
|
||||||
|
if (isVal(x) && v(x)->refc<0) {printf("(FREED)"); exit(1);} else
|
||||||
|
#endif
|
||||||
|
TI(x).print(x);
|
||||||
|
}
|
||||||
|
else if (isVar(x)) printf("(var d=%d i=%d)", (u16)(x.u>>32), (i32)x.u);
|
||||||
|
else if (x.u==bi_nothing.u) printf("·");
|
||||||
|
else if (x.u==bi_optOut.u) printf("(value optimized out)");
|
||||||
|
else if (x.u==bi_noVar.u) printf("(unset variable placeholder)");
|
||||||
|
else if (x.u==bi_badHdr.u) printf("(bad header note)");
|
||||||
|
else printf("(todo tag %lx)", x.u>>48);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
typedef struct Fun {
|
||||||
|
struct Value;
|
||||||
|
u8 id;
|
||||||
|
BB2B c1;
|
||||||
|
BBB2B c2;
|
||||||
|
} Fun;
|
||||||
|
|
||||||
|
B c1_invalid(B f, B x) { return err("This function can't be called monadically"); }
|
||||||
|
B c2_invalid(B f, B w, B x) { return err("This function can't be called dyadically"); }
|
||||||
|
|
||||||
|
B c1(B f, B x) { // BQN-call f monadically; consumes x
|
||||||
|
if (isFun(f)) return VALIDATE(c(Fun,f)->c1(f, x));
|
||||||
|
dec(x);
|
||||||
|
if (isMd(f)) return err("Calling a modifier");
|
||||||
|
return inci(VALIDATE(f));
|
||||||
|
}
|
||||||
|
B c2(B f, B w, B x) { // BQN-call f dyadically; consumes w,x
|
||||||
|
if (isFun(f)) return VALIDATE(c(Fun,f)->c2(f, w, x));
|
||||||
|
dec(w);dec(x);
|
||||||
|
if (isMd(f)) return err("Calling a modifier");
|
||||||
|
return inci(VALIDATE(f));
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
typedef struct Md1 {
|
||||||
|
struct Value;
|
||||||
|
u8 id;
|
||||||
|
BBB2B c1; // f(m,f, x); consumes x
|
||||||
|
BBBB2B c2; // f(m,f,w,x); consumes w,x
|
||||||
|
} Md1;
|
||||||
|
typedef struct Md2 {
|
||||||
|
struct Value;
|
||||||
|
u8 id;
|
||||||
|
BBBB2B c1; // f(m,f,g, x); consumes x
|
||||||
|
BBBBB2B c2; // f(m,f,g,w,x); consumes w,x
|
||||||
|
} Md2;
|
||||||
|
|
||||||
|
|
||||||
|
void arr_print(B x) {
|
||||||
|
usz r = a(x)->rank;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
if (r!=1) {
|
||||||
|
if (r==0) {
|
||||||
|
printf("<");
|
||||||
|
print(xget(x,0));
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
usz* sh = a(x)->sh;
|
||||||
|
for (i32 i = 0; i < r; i++) {
|
||||||
|
if(i==0)printf("%d",sh[i]);
|
||||||
|
else printf("‿%d",sh[i]);
|
||||||
|
}
|
||||||
|
printf("⥊");
|
||||||
|
} else if (ia>0) {
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
B c = xget(x,i);
|
||||||
|
bool is = isC32(c);
|
||||||
|
dec(c);
|
||||||
|
if (!is) goto reg;
|
||||||
|
}
|
||||||
|
printf("\"");
|
||||||
|
for (usz i = 0; i < ia; i++) printUTF8((u32)xget(x,i).u); // c32, no need to decrement
|
||||||
|
printf("\"");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
reg:;
|
||||||
|
printf("⟨");
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
if (i!=0) printf(", ");
|
||||||
|
B c = xget(x,i);
|
||||||
|
print(c);
|
||||||
|
dec(c);
|
||||||
|
}
|
||||||
|
printf("⟩");
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#ifdef DEBUG
|
||||||
|
B validate(B x) {
|
||||||
|
if (!isVal(x)) return x;
|
||||||
|
if (v(x)->refc<=0 || (v(x)->refc>>28) == 'a') {
|
||||||
|
printf("bad refcount for type %d: %d; val=%p\nattempting to print: ", v(x)->type, v(x)->refc, (void*)x.u); fflush(stdout);
|
||||||
|
print(x); puts(""); fflush(stdout);
|
||||||
|
err("");
|
||||||
|
}
|
||||||
|
if (isArr(x)) {
|
||||||
|
ur r = a(x)->rank;
|
||||||
|
if (r<=1) assert(a(x)->sh == &a(x)->ia);
|
||||||
|
else validate(tag(shObj(x),OBJ_TAG));
|
||||||
|
}
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
B recvalidate(B x) {
|
||||||
|
validate(x);
|
||||||
|
if (isArr(x)) {
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
B c = xget(x,i);
|
||||||
|
assert(c.u!=x.u);
|
||||||
|
recvalidate(c);
|
||||||
|
dec(c);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
96
src/harr.c
Normal file
96
src/harr.c
Normal file
@ -0,0 +1,96 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
typedef struct HArr {
|
||||||
|
struct Arr;
|
||||||
|
B a[];
|
||||||
|
} HArr;
|
||||||
|
|
||||||
|
typedef struct HArr_p {
|
||||||
|
B b;
|
||||||
|
B* a;
|
||||||
|
HArr* c;
|
||||||
|
} HArr_p;
|
||||||
|
HArr_p harr_parts(B b) {
|
||||||
|
HArr* p = c(HArr,b);
|
||||||
|
return (HArr_p){.b = b, .a = p->a, .c = p};
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
HArr_p m_harrv(usz ia) {
|
||||||
|
B r = m_arr(fsizeof(HArr,a,B,ia), t_harr);
|
||||||
|
arr_shVec(r, ia);
|
||||||
|
return harr_parts(r);
|
||||||
|
}
|
||||||
|
|
||||||
|
HArr_p m_harrc(B x) { assert(isArr(x));
|
||||||
|
B r = m_arr(fsizeof(HArr,a,B,a(x)->ia), t_harr);
|
||||||
|
arr_shCopy(r, x);
|
||||||
|
return harr_parts(r);
|
||||||
|
}
|
||||||
|
|
||||||
|
HArr_p m_harrp(usz ia) { // doesn't write any shape/size info! be careful!
|
||||||
|
return harr_parts(m_arr(fsizeof(HArr,a,B,ia), t_harr));
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
B* harr_ptr(B x) {
|
||||||
|
assert(v(x)->type==t_harr);
|
||||||
|
return c(HArr,x)->a;
|
||||||
|
}
|
||||||
|
|
||||||
|
HArr* toHArr(B x) {
|
||||||
|
if (v(x)->type==t_harr) return c(HArr,x);
|
||||||
|
HArr_p r = m_harrc(x);
|
||||||
|
usz ia = r.c->ia;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (usz i = 0; i < ia; i++) r.a[i] = xget(x,i);
|
||||||
|
dec(x);
|
||||||
|
return r.c;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
B m_vaf64(usz sz, ...) {
|
||||||
|
va_list vargs;
|
||||||
|
va_start(vargs, sz);
|
||||||
|
HArr_p r = m_harrv(sz);
|
||||||
|
for (usz i = 0; i < sz; i++) r.a[i] = m_f64(va_arg(vargs, f64));
|
||||||
|
va_end(vargs);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
|
||||||
|
B m_vaB(usz sz, ...) {
|
||||||
|
va_list vargs;
|
||||||
|
va_start(vargs, sz);
|
||||||
|
HArr_p r = m_harrv(sz);
|
||||||
|
for (usz i = 0; i < sz; i++) r.a[i] = va_arg(vargs, B);
|
||||||
|
va_end(vargs);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
|
||||||
|
B m_v1(B a ) { HArr_p r = m_harrv(1); r.a[0] = a; return r.b; }
|
||||||
|
B m_v2(B a, B b ) { HArr_p r = m_harrv(2); r.a[0] = a; r.a[1] = b; return r.b; }
|
||||||
|
B m_v3(B a, B b, B c ) { HArr_p r = m_harrv(3); r.a[0] = a; r.a[1] = b; r.a[2] = c; return r.b; }
|
||||||
|
B m_v4(B a, B b, B c, B d) { HArr_p r = m_harrv(4); r.a[0] = a; r.a[1] = b; r.a[2] = c; r.a[3] = d; return r.b; }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
void harr_print(B x) {
|
||||||
|
arr_print(x);
|
||||||
|
}
|
||||||
|
B harr_get(B x, usz n) {
|
||||||
|
return inci(c(HArr,x)->a[n]);
|
||||||
|
}
|
||||||
|
void harr_free(B x) {
|
||||||
|
decSh(x);
|
||||||
|
B* p = harr_ptr(x);
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
for (usz i = 0; i < ia; i++) dec(p[i]);
|
||||||
|
}
|
||||||
|
|
||||||
|
void harr_init() {
|
||||||
|
ti[t_harr].free = harr_free;
|
||||||
|
ti[t_harr].print = harr_print;
|
||||||
|
ti[t_harr].get = harr_get;
|
||||||
|
}
|
||||||
61
src/i32arr.c
Normal file
61
src/i32arr.c
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
typedef struct I32Arr {
|
||||||
|
struct Arr;
|
||||||
|
i32 a[];
|
||||||
|
} I32Arr;
|
||||||
|
|
||||||
|
|
||||||
|
B m_i32arrv(usz ia) {
|
||||||
|
B r = m_arr(fsizeof(I32Arr,a,i32,ia), t_i32arr);
|
||||||
|
arr_shVec(r, ia);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B m_i32arrc(B x) { assert(isArr(x));
|
||||||
|
B r = m_arr(fsizeof(I32Arr,a,B,a(x)->ia), t_i32arr);
|
||||||
|
arr_shCopy(r, x);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B m_i32arrp(usz ia) { // doesn't write any shape/size info! be careful!
|
||||||
|
return m_arr(fsizeof(I32Arr,a,i32,ia), t_i32arr);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
i32* i32arr_ptr(B x) {
|
||||||
|
assert(v(x)->type==t_i32arr);
|
||||||
|
return c(I32Arr,x)->a;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
B m_vai32(usz sz, ...) {
|
||||||
|
va_list vargs;
|
||||||
|
va_start(vargs, sz);
|
||||||
|
B r = m_i32arrv(sz);
|
||||||
|
i32* rp = i32arr_ptr(r);
|
||||||
|
for (usz i = 0; i < sz; i++) rp[i] = va_arg(vargs, i32);
|
||||||
|
va_end(vargs);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
I32Arr* toI32Arr(B x) {
|
||||||
|
if (v(x)->type==t_i32arr) return c(I32Arr,x);
|
||||||
|
B r = m_i32arrc(x);
|
||||||
|
i32* rp = i32arr_ptr(r);
|
||||||
|
usz ia = a(r)->ia;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (usz i = 0; i < ia; i++) rp[i] = o2i(xget(x,i));
|
||||||
|
dec(x);
|
||||||
|
return c(I32Arr,r);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
void i32arr_free(B x) { decSh(x); }
|
||||||
|
void i32arr_print(B x) { arr_print(x); }
|
||||||
|
B i32arr_get(B x, usz n) { assert(v(x)->type==t_i32arr); return m_i32(c(I32Arr,x)->a[n]); }
|
||||||
|
|
||||||
|
void i32arr_init() {
|
||||||
|
ti[t_i32arr].free = i32arr_free;
|
||||||
|
ti[t_i32arr].print = i32arr_print;
|
||||||
|
ti[t_i32arr].get = i32arr_get;
|
||||||
|
}
|
||||||
|
|
||||||
166
src/main.c
Normal file
166
src/main.c
Normal file
@ -0,0 +1,166 @@
|
|||||||
|
// #define ATOM_I32
|
||||||
|
#ifdef DEBUG
|
||||||
|
// #define DEBUG_VM
|
||||||
|
#endif
|
||||||
|
// #define ALLOC_STAT
|
||||||
|
|
||||||
|
#include "h.h"
|
||||||
|
#include "mm.c"
|
||||||
|
#include "harr.c"
|
||||||
|
#include "i32arr.c"
|
||||||
|
#include "arith.c"
|
||||||
|
#include "sfns.c"
|
||||||
|
#include "md1.c"
|
||||||
|
#include "md2.c"
|
||||||
|
#include "sysfn.c"
|
||||||
|
#include "derv.c"
|
||||||
|
#include "vm.c"
|
||||||
|
#include "utf.c"
|
||||||
|
|
||||||
|
void pr(char* a, B b) {
|
||||||
|
printf("%s", a);
|
||||||
|
print(b);
|
||||||
|
puts("");
|
||||||
|
dec(b);
|
||||||
|
fflush(stdout);
|
||||||
|
}
|
||||||
|
|
||||||
|
Block* ca3(B b) {
|
||||||
|
B* ps = harr_ptr(b);
|
||||||
|
Block* r = compile(inci(ps[0]),inci(ps[1]),inci(ps[2]));
|
||||||
|
dec(b);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
B m_str8(char* s) {
|
||||||
|
u64 sz = strlen(s);
|
||||||
|
HArr_p r = m_harrv(sz);
|
||||||
|
for (u64 i = 0; i < sz; i++) r.a[i] = m_c32(s[i]);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
B m_str32(u32* s) {
|
||||||
|
u64 sz = 0;
|
||||||
|
while(s[sz])sz++;
|
||||||
|
HArr_p r = m_harrv(sz);
|
||||||
|
for (u64 i = 0; i < sz; i++) r.a[i] = m_c32(s[i]);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
B m_cai32(usz ia, i32* a) {
|
||||||
|
B r = m_i32arrv(ia);
|
||||||
|
i32* rp = i32arr_ptr(r);
|
||||||
|
for (usz i = 0; i < ia; i++) rp[i] = a[i];
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
__ssize_t getline (char **__restrict __lineptr, size_t *restrict n, FILE *restrict stream);
|
||||||
|
|
||||||
|
int main() {
|
||||||
|
hdr_init();
|
||||||
|
harr_init();
|
||||||
|
i32arr_init();
|
||||||
|
arith_init();
|
||||||
|
sfns_init();
|
||||||
|
md1_init();
|
||||||
|
md2_init();
|
||||||
|
sysfn_init();
|
||||||
|
derv_init();
|
||||||
|
comp_init();
|
||||||
|
|
||||||
|
|
||||||
|
// fake runtime
|
||||||
|
// B bi_N = bi_nothing;
|
||||||
|
// B runtime[] = {
|
||||||
|
// /* +-×÷⋆√⌊⌈|¬ */ bi_add, bi_sub , bi_mul , bi_div, bi_pow, bi_N , bi_floor, bi_N , bi_N, bi_N,
|
||||||
|
// /* ∧∨<>≠=≤≥≡≢ */ bi_N , bi_N , bi_N , bi_N , bi_N , bi_eq, bi_le , bi_N , bi_N, bi_fne,
|
||||||
|
// /* ⊣⊢⥊∾≍↑↓↕«» */ bi_lt , bi_rt , bi_shape, bi_N , bi_N , bi_N , bi_N , bi_ud , bi_N, bi_N,
|
||||||
|
// /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_N , bi_N , bi_N , bi_N , bi_N , bi_N , bi_pick , bi_N , bi_N, bi_N,
|
||||||
|
// /* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_N , bi_asrt , bi_N , bi_N , bi_N , bi_N , bi_tbl, bi_N, bi_N,
|
||||||
|
// /* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan, bi_N , bi_N , bi_N , bi_N , bi_N , bi_val, bi_N, bi_N,
|
||||||
|
// /* ⚇⍟ */ bi_N , bi_N
|
||||||
|
// };
|
||||||
|
// Block* c = ca3(
|
||||||
|
// #include "interp"
|
||||||
|
// );
|
||||||
|
// B interp = m_funBlock(c, 0); ptr_dec(c);
|
||||||
|
// pr("interpreted: ", interp);
|
||||||
|
|
||||||
|
Block* runtime_b = compile(
|
||||||
|
#include "runtime"
|
||||||
|
);
|
||||||
|
B rtRes = m_funBlock(runtime_b, 0); ptr_dec(runtime_b);
|
||||||
|
B rtObj = TI(rtRes).get(rtRes,0);
|
||||||
|
B rtFinish = TI(rtRes).get(rtRes,1);
|
||||||
|
B* runtime = toHArr(rtObj)->a;
|
||||||
|
runtimeLen = c(Arr,rtObj)->ia;
|
||||||
|
for (usz i = 0; i < runtimeLen; i++) {
|
||||||
|
if (isVal(runtime[i])) v(runtime[i])->flags|= i+1;
|
||||||
|
}
|
||||||
|
c1(rtFinish, m_v2(inci(bi_decp), inci(bi_primInd)));
|
||||||
|
|
||||||
|
// uncomment to use src/interp; needed for test.bqn
|
||||||
|
// Block* c = ca3(
|
||||||
|
// #include "interp"
|
||||||
|
// );
|
||||||
|
// B interp = m_funBlock(c, 0); ptr_dec(c);
|
||||||
|
// pr("result: ", interp);
|
||||||
|
// exit(0);
|
||||||
|
|
||||||
|
Block* comp_b = compile(
|
||||||
|
#include "compiler"
|
||||||
|
);
|
||||||
|
B comp = m_funBlock(comp_b, 0); ptr_dec(comp_b);
|
||||||
|
|
||||||
|
|
||||||
|
// uncomment to self-compile and use that for the REPL; expects a copy of mlochbaum/BQN/src/c.bqn to be at the execution directory
|
||||||
|
// char* c_src = 0;
|
||||||
|
// u64 c_len;
|
||||||
|
// FILE* f = fopen("c.bqn", "rb");
|
||||||
|
// if (f) {
|
||||||
|
// fseek(f, 0, SEEK_END);
|
||||||
|
// c_len = ftell(f);
|
||||||
|
// fseek(f, 0, SEEK_SET);
|
||||||
|
// c_src = malloc(c_len);
|
||||||
|
// if (c_src) fread(c_src, 1, c_len, f);
|
||||||
|
// fclose(f);
|
||||||
|
// } else {
|
||||||
|
// printf("couldn't read c.bqn\n");
|
||||||
|
// exit(1);
|
||||||
|
// }
|
||||||
|
// if (c_src) {
|
||||||
|
// B cbc = c2(comp, inci(rtObj), fromUTF8(c_src, c_len));
|
||||||
|
// Block* cbc_b = ca3(cbc);
|
||||||
|
// comp = m_funBlock(cbc_b, 0);
|
||||||
|
// free(c_src);
|
||||||
|
// }
|
||||||
|
|
||||||
|
|
||||||
|
while (true) { // exit by evaluating an empty expression
|
||||||
|
char* ln = NULL;
|
||||||
|
size_t gl = 0;
|
||||||
|
getline(&ln, &gl, stdin);
|
||||||
|
if (ln[0]==10) break;
|
||||||
|
B obj = fromUTF8(ln, strlen(ln));
|
||||||
|
B cbc = c2(comp, inci(rtObj), obj);
|
||||||
|
free(ln);
|
||||||
|
Block* cbc_b = ca3(cbc);
|
||||||
|
pr("", m_funBlock(cbc_b, 0));
|
||||||
|
}
|
||||||
|
|
||||||
|
dec(rtRes);
|
||||||
|
dec(comp);
|
||||||
|
|
||||||
|
#ifdef ALLOC_STAT
|
||||||
|
printf("ctrA←"); for (i64 j = 0; j < Type_MAX; j++) { if(j)printf("‿"); printf("%lu", ctr_a[j]); } printf("\n");
|
||||||
|
printf("ctrF←"); for (i64 j = 0; j < Type_MAX; j++) { if(j)printf("‿"); printf("%lu", ctr_f[j]); } printf("\n");
|
||||||
|
for(i64 i = 0; i < actrc; i++) {
|
||||||
|
u32* c = actrs[i];
|
||||||
|
bool any = false;
|
||||||
|
for (i64 j = 0; j < Type_MAX; j++) if (c[j]) any=true;
|
||||||
|
if (any) {
|
||||||
|
printf("%ld", i);
|
||||||
|
for (i64 j = 0; j < Type_MAX; j++) printf("‿%u", c[j]);
|
||||||
|
printf("\n");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
}
|
||||||
103
src/md1.c
Normal file
103
src/md1.c
Normal file
@ -0,0 +1,103 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
B tbl_c1(B t, B f, B x) {
|
||||||
|
if (!isArr(x)) return err("⌜: argument was atom");
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
HArr_p r = m_harrc(x);
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (usz i = 0; i < ia; i++) r.a[i] = c1(f, xget(x,i));
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
B tbl_c2(B t, B f, B w, B x) {
|
||||||
|
if (isArr(w) & isArr(x)) {
|
||||||
|
usz wia = a(w)->ia; ur wr = a(w)->rank;
|
||||||
|
usz xia = a(x)->ia; ur xr = a(x)->rank;
|
||||||
|
usz ria = wia*xia; ur rr = wr+xr;
|
||||||
|
if (rr<xr) return err("⌜: result rank too large");
|
||||||
|
HArr_p r = m_harrp(ria);
|
||||||
|
usz* rsh = arr_shAlloc(r.b, ria, rr);
|
||||||
|
if (rsh) {
|
||||||
|
memcpy(rsh , a(w)->sh, wr*sizeof(usz));
|
||||||
|
memcpy(rsh+wr, a(x)->sh, xr*sizeof(usz));
|
||||||
|
}
|
||||||
|
|
||||||
|
BS2B wget = TI(w).get;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
usz ri = 0;
|
||||||
|
for (usz wi = 0; wi < wia; wi++) {
|
||||||
|
B cw = wget(w,wi);
|
||||||
|
for (usz xi = 0; xi < xia; xi++) {
|
||||||
|
r.a[ri++] = c2(f, inci(cw), xget(x,xi));
|
||||||
|
}
|
||||||
|
dec(cw);
|
||||||
|
}
|
||||||
|
dec(w); dec(x);
|
||||||
|
return r.b;
|
||||||
|
} else return err("⌜: one argument was an atom");
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
B scan_c1(B t, B f, B x) {
|
||||||
|
if (!isArr(x)) return err("`: argument cannot be a scalar");
|
||||||
|
ur xr = a(x)->rank;
|
||||||
|
if (xr==0) return err("`: argument cannot be a scalar");
|
||||||
|
HArr_p r = m_harrc(x);
|
||||||
|
usz ia = r.c->ia;
|
||||||
|
if (ia==0) return r.b;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
if (xr==1) {
|
||||||
|
r.a[0] = xget(x,0);
|
||||||
|
for (usz i = 1; i < ia; i++) r.a[i] = c2(f, inci(r.a[i-1]), xget(x,i));
|
||||||
|
} else {
|
||||||
|
usz csz = arr_csz(x);
|
||||||
|
for (usz i = 0; i < csz; i++) r.a[i] = xget(x,i);
|
||||||
|
for (usz i = csz; i < ia; i++) r.a[i] = c2(f, inci(r.a[i-csz]), xget(x,i));
|
||||||
|
}
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
B scan_c2(B t, B f, B w, B x) {
|
||||||
|
if (!isArr(x)) return err("`: 𝕩 cannot be a scalar");
|
||||||
|
ur xr = a(x)->rank; usz* xsh = a(x)->sh; BS2B xget = TI(x).get;
|
||||||
|
if (isArr(w)) {
|
||||||
|
ur wr = a(w)->rank; usz* wsh = a(w)->sh; BS2B wget = TI(w).get;
|
||||||
|
if (xr==0) return err("`: 𝕩 cannot be a scalar");
|
||||||
|
if (wr+1 != xr) return err("`: shape of 𝕨 must match the cell of 𝕩");
|
||||||
|
if (memcmp(wsh, xsh+1, wr)) return err("`: shape of 𝕨 must match the cell of 𝕩");
|
||||||
|
HArr_p r = m_harrc(x);
|
||||||
|
usz ia = r.c->ia;
|
||||||
|
if (ia==0) return r.b;
|
||||||
|
usz csz = arr_csz(x);
|
||||||
|
for (usz i = 0; i < csz; i++) r.a[i] = c2(f, wget(w,i), xget(x,i));
|
||||||
|
for (usz i = csz; i < ia; i++) r.a[i] = c2(f, inci(r.a[i-csz]), xget(x,i));
|
||||||
|
dec(w);
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
} else {
|
||||||
|
if (xr!=1) return err("`: if 𝕨 is scalar, 𝕩 must be a vector");
|
||||||
|
HArr_p r = m_harrc(x);
|
||||||
|
usz ia = r.c->ia;
|
||||||
|
if (ia==0) return r.b;
|
||||||
|
B pr = r.a[0] = c2(f, w, xget(x,0));
|
||||||
|
for (usz i = 1; i < ia; i++) r.a[i] = pr = c2(f, inci(pr), xget(x,i));
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->id=pm1_##NAME;
|
||||||
|
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->id=pm1_##NAME;
|
||||||
|
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->id=pm1_##NAME;
|
||||||
|
|
||||||
|
void print_md1_def(B x) { printf("%s", format_pm1(c(Md1,x)->id)); }
|
||||||
|
|
||||||
|
B bi_tbl, bi_scan;
|
||||||
|
void md1_init() { ba(tbl) ba(scan)
|
||||||
|
ti[t_md1_def].print = print_md1_def;
|
||||||
|
}
|
||||||
|
|
||||||
|
#undef ba
|
||||||
|
#undef bd
|
||||||
|
#undef bm
|
||||||
20
src/md2.c
Normal file
20
src/md2.c
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
B val_c1(B t, B f, B g, B x) { return c1(f, x); }
|
||||||
|
B val_c2(B t, B f, B g, B w, B x) { return c2(g,w,x); }
|
||||||
|
|
||||||
|
B fillBy_c1(B t, B f, B g, B x) { return c1(f, x); }
|
||||||
|
B fillBy_c2(B t, B f, B g, B w, B x) { return c2(f,w,x); }
|
||||||
|
|
||||||
|
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2_def, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = NAME##_c2; c(Md2,bi_##NAME)->c1 = NAME##_c1;
|
||||||
|
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2_def, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = NAME##_c2; c(Md2,bi_##NAME)->c1 = c1_invalid;
|
||||||
|
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2_def, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = c2_invalid;c(Md2,bi_##NAME)->c1 = NAME##_c1;
|
||||||
|
|
||||||
|
B bi_val, bi_fillBy;
|
||||||
|
void md2_init() { ba(val) ba(fillBy) }
|
||||||
|
|
||||||
|
#undef ba
|
||||||
|
#undef bd
|
||||||
|
#undef bm
|
||||||
50
src/mm.c
Normal file
50
src/mm.c
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
#include "h.h"
|
||||||
|
#include<stdlib.h>
|
||||||
|
|
||||||
|
#ifdef ALLOC_STAT
|
||||||
|
u64* ctr_a = 0;
|
||||||
|
u64* ctr_f = 0;
|
||||||
|
u64 actrc = 21000;
|
||||||
|
u32** actrs;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
void* aalloc(usz sz) { // actual allocate
|
||||||
|
void* p = malloc(sz);
|
||||||
|
return p;
|
||||||
|
}
|
||||||
|
|
||||||
|
void* mm_allocN(usz sz, u8 type) {
|
||||||
|
Value* x = aalloc(sz);
|
||||||
|
#ifdef ALLOC_STAT
|
||||||
|
if (!actrs) {
|
||||||
|
actrs = malloc(sizeof(u32*)*actrc);
|
||||||
|
ctr_a = calloc(Type_MAX, sizeof(u64));
|
||||||
|
ctr_f = calloc(Type_MAX, sizeof(u64));
|
||||||
|
for (i32 i = 0; i < actrc; i++) actrs[i] = calloc(Type_MAX, sizeof(u32));
|
||||||
|
}
|
||||||
|
assert(type<Type_MAX);
|
||||||
|
actrs[(sz+3)/4>=actrc? actrc-1 : (sz+3)/4][type]++;
|
||||||
|
ctr_a[type]++;
|
||||||
|
#endif
|
||||||
|
#ifdef DEBUG
|
||||||
|
memset(x, 'a', sz);
|
||||||
|
#endif
|
||||||
|
x->refc = 1;
|
||||||
|
x->flags = 0;
|
||||||
|
x->type = type;
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
B mm_alloc(usz sz, u8 type, u64 tag) {
|
||||||
|
assert(tag>1LL<<16); // make sure it's `ftag`ged :|
|
||||||
|
return b((u64)mm_allocN(sz,type) | tag);
|
||||||
|
}
|
||||||
|
void mm_free(Value* x) {
|
||||||
|
#ifdef ALLOC_STAT
|
||||||
|
ctr_f[x->type]++;
|
||||||
|
x->refc = 0x61616161;
|
||||||
|
#endif
|
||||||
|
free(x);
|
||||||
|
}
|
||||||
|
void mm_visit(B x) {
|
||||||
|
|
||||||
|
}
|
||||||
116
src/sfns.c
Normal file
116
src/sfns.c
Normal file
@ -0,0 +1,116 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
B shape_c1(B t, B x) {
|
||||||
|
if (isArr(x)) {
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
if (reusable(x)) {
|
||||||
|
decSh(x);
|
||||||
|
arr_shVec(x, ia);
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
HArr_p r = m_harrv(ia);
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (i32 i = 0; i < ia; i++) r.a[i] = xget(x,i);
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
} else return err("reshaping non-array");
|
||||||
|
}
|
||||||
|
B shape_c2(B t, B w, B x) {
|
||||||
|
if (isArr(x)) {
|
||||||
|
if (!isArr(w)) return shape_c1(t, x);
|
||||||
|
BS2B wget = TI(w).get;
|
||||||
|
ur nr = a(w)->ia;
|
||||||
|
usz nia = a(x)->ia;
|
||||||
|
B r;
|
||||||
|
bool reuse = reusable(x);
|
||||||
|
if (reuse) {
|
||||||
|
r = x;
|
||||||
|
decSh(x);
|
||||||
|
} else {
|
||||||
|
HArr_p rg = m_harrp(nia);
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (usz i = 0; i < nia; i++) rg.a[i] = xget(x,i);
|
||||||
|
r = rg.b;
|
||||||
|
}
|
||||||
|
usz* sh = arr_shAlloc(r, nia, nr);
|
||||||
|
if (sh) for (i32 i = 0; i < nr; i++) sh[i] = o2i(wget(w,i));
|
||||||
|
if (!reuse) dec(x);
|
||||||
|
dec(w);
|
||||||
|
return r;
|
||||||
|
} else return err("reshaping non-array");
|
||||||
|
}
|
||||||
|
|
||||||
|
B pick_c1(B t, B x) {
|
||||||
|
if (!isArr(x)) return x;
|
||||||
|
// if (a(x)->ia==0) return err("⊑: called on empty array"); // no bounds check for now
|
||||||
|
B r = TI(x).get(x, 0);
|
||||||
|
dec(x);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B pick_c2(B t, B w, B x) {
|
||||||
|
usz wu = o2s(w);
|
||||||
|
if (isArr(x)) {
|
||||||
|
// if (wu >= a(x)->ia) err("⊑: 𝕨 is greater than length of 𝕩"); // no bounds check for now
|
||||||
|
B r = TI(x).get(x, wu);
|
||||||
|
dec(x);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
dec(x); return err("n⊑atom");
|
||||||
|
}
|
||||||
|
|
||||||
|
B ud_c1(B t, B x) {
|
||||||
|
usz xu = o2s(x);
|
||||||
|
if (xu<I32_MAX) {
|
||||||
|
B r = m_i32arrv(xu);
|
||||||
|
i32* pr = i32arr_ptr(r);
|
||||||
|
for (usz i = 0; i < xu; i++) pr[i] = i;
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
HArr_p r = m_harrv(xu);
|
||||||
|
for (usz i = 0; i < xu; i++) r.a[i] = m_f64(i);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
|
||||||
|
B pair_c1(B t, B x) { return m_v1( x); }
|
||||||
|
B pair_c2(B t, B w, B x) { return m_v2(w, x); }
|
||||||
|
|
||||||
|
B fne_c1(B t, B x) {
|
||||||
|
if (isArr(x)) {
|
||||||
|
ur xr = a(x)->rank;
|
||||||
|
usz* sh = a(x)->sh;
|
||||||
|
for (i32 i = 0; i < xr; i++) if (sh[i]>I32_MAX) {
|
||||||
|
HArr_p r = m_harrv(xr);
|
||||||
|
for (i32 j = 0; j < xr; j++) r.a[j] = m_f64(sh[j]);
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
B r = m_i32arrv(xr); i32* rp = i32arr_ptr(r);
|
||||||
|
for (i32 i = 0; i < xr; i++) rp[i] = sh[i];
|
||||||
|
dec(x);
|
||||||
|
return r;
|
||||||
|
} else {
|
||||||
|
dec(x);
|
||||||
|
return m_i32arrv(0);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
B lt_c1(B t, B x) { return x; }
|
||||||
|
B lt_c2(B t, B w, B x) { dec(x); return w; }
|
||||||
|
B rt_c1(B t, B x) { return x; }
|
||||||
|
B rt_c2(B t, B w, B x) { dec(w); return x; }
|
||||||
|
|
||||||
|
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
|
||||||
|
void print_fun_def(B x) { printf("%s", format_pf(c(Fun,x)->id)); }
|
||||||
|
|
||||||
|
B bi_shape, bi_pick, bi_ud, bi_pair, bi_fne, bi_lt, bi_rt;
|
||||||
|
void sfns_init() { ba(shape) ba(pick) bm(ud) ba(pair) bm(fne) ba(lt) ba(rt)
|
||||||
|
ti[t_fun_def].print = print_fun_def;
|
||||||
|
}
|
||||||
|
|
||||||
|
#undef ba
|
||||||
|
#undef bd
|
||||||
|
#undef bm
|
||||||
120
src/sysfn.c
Normal file
120
src/sysfn.c
Normal file
@ -0,0 +1,120 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
B type_c1(B t, B x) {
|
||||||
|
i32 r = -1;
|
||||||
|
if (isArr(x)) r = 0;
|
||||||
|
else if (isI32(x)) r = 1;
|
||||||
|
else if (isF64(x)) r = 1;
|
||||||
|
else if (isC32(x)) r = 2;
|
||||||
|
else if (isFun(x)) r = 3;
|
||||||
|
else if (isMd1(x)) r = 4;
|
||||||
|
else if (isMd2(x)) r = 5;
|
||||||
|
dec(x);
|
||||||
|
if (r==-1) return err("getting type");
|
||||||
|
return m_i32(r);
|
||||||
|
}
|
||||||
|
|
||||||
|
B decp_c1(B t, B x) {
|
||||||
|
if (!isVal(x)) return m_v2(m_i32(-1), x);
|
||||||
|
if (v(x)->flags) return m_v2(m_i32(0), x);
|
||||||
|
return TI(x).decompose(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
usz runtimeLen;
|
||||||
|
B primInd_c1(B t, B x) {
|
||||||
|
if (!isVal(x)) return m_i32(runtimeLen);
|
||||||
|
if (v(x)->flags) return m_i32(v(x)->flags-1);
|
||||||
|
return m_i32(runtimeLen);
|
||||||
|
}
|
||||||
|
|
||||||
|
B glyph_c1(B t, B x) {
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
|
||||||
|
B fill_c1(B t, B x) { dec(x); return m_f64(0); }
|
||||||
|
B fill_c2(B t, B w, B x) { dec(w); return x; }
|
||||||
|
|
||||||
|
B grLen_c1(B t, B x) {
|
||||||
|
i64 ria = -1;
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
i64 c = o2i64(xget(x, i));
|
||||||
|
if (c>ria) ria = c;
|
||||||
|
}
|
||||||
|
ria++;
|
||||||
|
HArr_p r = m_harrv(ria);
|
||||||
|
for (usz i = 0; i < ria; i++) r.a[i] = m_f64(0);
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
i64 n = o2i64(xget(x, i));
|
||||||
|
if (n>=0) r.a[n].f++;
|
||||||
|
}
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
B grLen_c2(B t, B w, B x) {
|
||||||
|
i64 ria = o2s(w)-1;
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
i64 c = o2i64(xget(x, i));
|
||||||
|
if (c>ria) ria = c;
|
||||||
|
}
|
||||||
|
ria++;
|
||||||
|
HArr_p r = m_harrv(ria);
|
||||||
|
for (usz i = 0; i < ria; i++) r.a[i] = m_f64(0);
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
i64 n = o2i64(xget(x, i));
|
||||||
|
if (n>=0) r.a[n].f++;
|
||||||
|
}
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
|
||||||
|
B grOrd_c2(B t, B w, B x) {
|
||||||
|
usz wia = a(w)->ia;
|
||||||
|
usz xia = a(x)->ia;
|
||||||
|
if (wia==0) return c1(bi_ud, m_i32(0));
|
||||||
|
if (xia==0) return x;
|
||||||
|
BS2B wget = TI(w).get;
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
usz tmp[wia];
|
||||||
|
tmp[0] = 0;
|
||||||
|
for (int i = 1; i < wia; i++) tmp[i] = tmp[i-1]+o2s(wget(w,i-1));
|
||||||
|
usz ria = tmp[wia-1]+o2s(wget(w,wia-1));
|
||||||
|
HArr_p r = m_harrv(ria);
|
||||||
|
for (usz i = 0; i < xia; i++) {
|
||||||
|
i64 c = o2i64(xget(x,i));
|
||||||
|
if (c>=0) r.a[tmp[c]++] = m_usz(i);
|
||||||
|
}
|
||||||
|
dec(w);
|
||||||
|
dec(x);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
|
||||||
|
B asrt_c1(B t, B x) {
|
||||||
|
if (isI32(x) && 1==(i32)x.u) return x;
|
||||||
|
if (isF64(x) && 1==x.f) return x;
|
||||||
|
dec(x);
|
||||||
|
return err("assertion error");
|
||||||
|
}
|
||||||
|
B asrt_c2(B t, B w, B x) {
|
||||||
|
if (isI32(x) && 1==(i32)x.u) return x;
|
||||||
|
if (isF64(x) && 1==x.f) return x;
|
||||||
|
dec(x);
|
||||||
|
printf("Assertion error: "); fflush(stdout); print(w); printf("\n");
|
||||||
|
dec(w);
|
||||||
|
return err("assertion error with message");
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME;
|
||||||
|
|
||||||
|
B bi_type, bi_decp, bi_primInd, bi_glyph, bi_fill, bi_grLen, bi_grOrd, bi_asrt;
|
||||||
|
void sysfn_init() { bm(type) bm(decp) bm(primInd) bm(glyph) ba(fill) ba(grLen) bd(grOrd) ba(asrt) }
|
||||||
|
|
||||||
|
#undef ba
|
||||||
|
#undef bd
|
||||||
|
#undef bm
|
||||||
27
src/utf.c
Normal file
27
src/utf.c
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
i32 utf8_len(u8 ch) {
|
||||||
|
if (ch<128) return 1;
|
||||||
|
if ((ch>>5)== 0b110) return 2;
|
||||||
|
if ((ch>>4)== 0b1110) return 3;
|
||||||
|
if ((ch>>3)==0b11110) return 4;
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
u32 utf8_p(u8* p) {
|
||||||
|
i32 len = utf8_len(*p);
|
||||||
|
switch (len) { default: UD;
|
||||||
|
case -1: return (u32)-1;
|
||||||
|
case 1: return *p;
|
||||||
|
case 2: return (0b11111&*p)<< 6 | (0b111111&p[1]);
|
||||||
|
case 3: return (0b1111 &*p)<<12 | (0b111111&p[2]) | (0b111111&p[1])<<6;
|
||||||
|
case 4: return (0b111 &*p)<<18 | (0b111111&p[3]) | (0b111111&p[2])<<6 | (0b111111&p[1])<<12;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
B fromUTF8(char* s, u64 len) {
|
||||||
|
u64 sz = 0;
|
||||||
|
u64 j;
|
||||||
|
for (j = 0; j < len; j+= utf8_len(s[j])) sz++;
|
||||||
|
if (j!=len) return err("invalid UTF-8");
|
||||||
|
HArr_p r = m_harrv(sz);
|
||||||
|
u64 p = 0;
|
||||||
|
for (u64 i = 0; i < len; i+= utf8_len(s[i])) r.a[p++] = m_c32(utf8_p((u8*)s+i)); // may read after end, eh
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
467
src/vm.c
Normal file
467
src/vm.c
Normal file
@ -0,0 +1,467 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
enum {
|
||||||
|
PUSH = 0, // N; push object from objs[N]
|
||||||
|
VARO = 1, // N; push variable with name strs[N]
|
||||||
|
VARM = 2, // N; push mutable variable with name strs[N]
|
||||||
|
ARRO = 3, // N; create a vector of top N items
|
||||||
|
ARRM = 4, // N; create a mutable vector of top N items
|
||||||
|
FN1C = 5, // monadic function call ⟨…,x,f ⟩ → F x
|
||||||
|
FN2C = 6, // dyadic function call ⟨…,x,f,w⟩ → w F x
|
||||||
|
OP1D = 7, // derive 1-modifier to function; ⟨…, _m,f⟩ → (f _m)
|
||||||
|
OP2D = 8, // derive 2-modifier to function; ⟨…,g,_m,f⟩ → (f _m_ g)
|
||||||
|
TR2D = 9, // derive 2-train aka atop; ⟨…, g,f⟩ → (f g)
|
||||||
|
TR3D = 10, // derive 3-train aka fork; ⟨…,h,g,f⟩ → (f g h)
|
||||||
|
SETN = 11, // set new; _ ←_; ⟨…,x, mut⟩ → mut←x
|
||||||
|
SETU = 12, // set upd; _ ↩_; ⟨…,x, mut⟩ → mut↩x
|
||||||
|
SETM = 13, // set mod; _ F↩_; ⟨…,x,F,mut⟩ → mut F↩x
|
||||||
|
POPS = 14, // pop object from stack
|
||||||
|
DFND = 15, // N; push dfns[N], derived to current scope
|
||||||
|
FN1O = 16, // optional monadic call (FN1C but checks for · at 𝕩)
|
||||||
|
FN2O = 17, // optional dyadic call (FN2C but checks for · at 𝕩 & 𝕨)
|
||||||
|
CHKV = 18, // throw error if top of stack is ·
|
||||||
|
TR3O = 19, // TR3D but creates an atop if F is ·
|
||||||
|
OP2H = 20, // derive 2-modifier to 1-modifier ⟨…,g,_m_⟩ → (_m_ g)
|
||||||
|
LOCO = 21, // N0,N1; push variable at depth N0 and position N1
|
||||||
|
LOCM = 22, // N0,N1; push mutable variable at depth N0 and position N1
|
||||||
|
VFYM = 23, // push a mutable version of ToS that fails if set to a non-equal value (for header assignment)
|
||||||
|
SETH = 24, // set header; acts like SETN, but it doesn't push to stack, and, instead of erroring in cases it would, it skips to the next body
|
||||||
|
RETN = 25, // returns top of stack
|
||||||
|
FLDO = 26, // N; get field objs[N] of ToS
|
||||||
|
FLDM = 27, // N; set field objs[N] from ToS
|
||||||
|
NSPM = 28, // N0,N1; create a destructible namespace from top N0 items, with the keys objs[N1]
|
||||||
|
RETD = 29, // return a namespace of exported items
|
||||||
|
SYSV = 30, // N; get system function N
|
||||||
|
};
|
||||||
|
|
||||||
|
i32* nextBC(i32* p) {
|
||||||
|
switch(*p) {
|
||||||
|
case PUSH: case DFND: case ARRO: case ARRM:
|
||||||
|
case VARO: case VARM: case FLDO: case FLDM:
|
||||||
|
case SYSV:
|
||||||
|
return p+2;
|
||||||
|
case FN1C: case FN2C: case FN1O: case FN2O:
|
||||||
|
case OP1D: case OP2D: case OP2H:
|
||||||
|
case TR2D: case TR3D: case TR3O:
|
||||||
|
case SETN: case SETU: case SETM: case SETH:
|
||||||
|
case POPS: case CHKV: case VFYM: case RETN: case RETD:
|
||||||
|
return p+1;
|
||||||
|
case LOCO: case LOCM: case NSPM:
|
||||||
|
return p+3;
|
||||||
|
default: return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
i32 stackDiff(i32* p) {
|
||||||
|
switch(*p) {
|
||||||
|
case PUSH: case VARO: case VARM: case DFND: case LOCO: case LOCM: case SYSV:
|
||||||
|
return 1;
|
||||||
|
case CHKV: case VFYM: case FLDO: case FLDM: case RETD:
|
||||||
|
return 0;
|
||||||
|
case FN1C: case OP1D: case TR2D: case SETN: case SETU: case POPS: case FN1O: case OP2H: case SETH: case RETN:
|
||||||
|
return -1;
|
||||||
|
case FN2C: case OP2D: case TR3D: case SETM: case FN2O: case TR3O:
|
||||||
|
return -2;
|
||||||
|
case ARRO: case ARRM: case NSPM:
|
||||||
|
return 1-p[1];
|
||||||
|
default: return 9999999;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
char* nameBC(i32* p) {
|
||||||
|
switch(*p) { default: return "(unknown)";
|
||||||
|
case PUSH:return "PUSH";case VARO:return "VARO";case VARM:return "VARM";case ARRO:return "ARRO";
|
||||||
|
case ARRM:return "ARRM";case FN1C:return "FN1C";case FN2C:return "FN2C";case OP1D:return "OP1D";
|
||||||
|
case OP2D:return "OP2D";case TR2D:return "TR2D";case TR3D:return "TR3D";case SETN:return "SETN";
|
||||||
|
case SETU:return "SETU";case SETM:return "SETM";case POPS:return "POPS";case DFND:return "DFND";
|
||||||
|
case FN1O:return "FN1O";case FN2O:return "FN2O";case CHKV:return "CHKV";case TR3O:return "TR3O";
|
||||||
|
case OP2H:return "OP2H";case LOCO:return "LOCO";case LOCM:return "LOCM";case VFYM:return "VFYM";
|
||||||
|
case SETH:return "SETH";case RETN:return "RETN";case FLDO:return "FLDO";case FLDM:return "FLDM";
|
||||||
|
case NSPM:return "NSPM";case RETD:return "RETD";case SYSV:return "SYSV";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
void printBC(i32* p) {
|
||||||
|
printf("%s", nameBC(p));
|
||||||
|
i32* n = nextBC(p);
|
||||||
|
p++;
|
||||||
|
i32 am = n-p;
|
||||||
|
i32 len = 0;
|
||||||
|
for (i32 i = 0; i < am; i++) printf(" %d", p[i]);
|
||||||
|
while(p!=n) {
|
||||||
|
i32 c = *p++;
|
||||||
|
i32 pow = 10;
|
||||||
|
i32 log = 1;
|
||||||
|
while (pow<=c) { pow*=10; log++; }
|
||||||
|
len+= log+1;
|
||||||
|
}
|
||||||
|
len = 6-len;
|
||||||
|
while(len-->0) printf(" ");
|
||||||
|
}
|
||||||
|
|
||||||
|
typedef struct Block Block;
|
||||||
|
typedef struct Body Body;
|
||||||
|
typedef struct Scope Scope;
|
||||||
|
|
||||||
|
typedef struct Comp {
|
||||||
|
struct Value;
|
||||||
|
B bc;
|
||||||
|
HArr* objs;
|
||||||
|
Block* blocks[];
|
||||||
|
} Comp;
|
||||||
|
|
||||||
|
typedef struct Block {
|
||||||
|
struct Value;
|
||||||
|
bool imm;
|
||||||
|
u8 ty;
|
||||||
|
Body* body;
|
||||||
|
} Block;
|
||||||
|
|
||||||
|
typedef struct Body {
|
||||||
|
struct Value;
|
||||||
|
Comp* comp;
|
||||||
|
// B* objs;
|
||||||
|
i32* bc; // pointer in comp->bc
|
||||||
|
u32 maxStack;
|
||||||
|
u16 varAm;
|
||||||
|
// HArr* vNames;
|
||||||
|
} Body;
|
||||||
|
|
||||||
|
typedef struct Scope {
|
||||||
|
struct Value;
|
||||||
|
u64 bcInd; // DEBUG: place of this in bytecode array
|
||||||
|
u16 varAm;
|
||||||
|
Scope* psc;
|
||||||
|
B vars[];
|
||||||
|
} Scope;
|
||||||
|
|
||||||
|
typedef struct FunBlock { struct Fun; Scope* sc; Block* bl; } FunBlock;
|
||||||
|
typedef struct Md1Block { struct Md1; Scope* sc; Block* bl; } Md1Block;
|
||||||
|
typedef struct Md2Block { struct Md2; Scope* sc; Block* bl; } Md2Block;
|
||||||
|
|
||||||
|
|
||||||
|
Block* compile(B bcq, B objs, B blocks) {
|
||||||
|
usz bam = a(blocks)->ia;
|
||||||
|
|
||||||
|
I32Arr* bca = toI32Arr(bcq);
|
||||||
|
i32* bc = bca->a;
|
||||||
|
usz bcl = bca->ia;
|
||||||
|
Comp* comp = mm_allocN(fsizeof(Comp,blocks,Block*,bam), t_comp);
|
||||||
|
comp->bc = tag(bca, ARR_TAG);
|
||||||
|
comp->objs = toHArr(objs);
|
||||||
|
B* blockDefs = toHArr(blocks)->a;
|
||||||
|
|
||||||
|
for (usz i = 0; i < bam; i++) {
|
||||||
|
B cbld = blockDefs[i];
|
||||||
|
if (a(cbld)->ia != 4) return c(Block,err("bad compile block")); // todo not cast errors here weirdly
|
||||||
|
BS2B bget = TI(cbld).get;
|
||||||
|
usz ty = o2s(bget(cbld,0)); if (ty<0|ty>2) return c(Block,err("bad block type"));
|
||||||
|
bool imm = o2s(bget(cbld,1)); // todo o2b or something
|
||||||
|
usz idx = o2s(bget(cbld,2)); if (idx>=bcl) return c(Block,err("oob bytecode index"));
|
||||||
|
usz vam = o2s(bget(cbld,3));
|
||||||
|
i32* cbc = bc+idx;
|
||||||
|
|
||||||
|
i32* scan = cbc;
|
||||||
|
i32 ssz = 0, mssz=0;
|
||||||
|
bool needsV0 = false;
|
||||||
|
while (*scan!=RETN & *scan!=RETD) {
|
||||||
|
ssz+= stackDiff(scan);
|
||||||
|
if (ssz>mssz) mssz = ssz;
|
||||||
|
if (*scan==LOCO|*scan==LOCM) { i32 d=scan[1]; i32 p=scan[2];
|
||||||
|
if (d>U16_MAX) return c(Block,err("LOC_ too deep"));
|
||||||
|
if (d==0 & p==0) needsV0 = true;
|
||||||
|
}
|
||||||
|
scan = nextBC(scan);
|
||||||
|
if (scan-bc >= bcl) return c(Block,err("no RETN/RETD found at end of bytecode"));
|
||||||
|
}
|
||||||
|
|
||||||
|
Body* body = mm_allocN(sizeof(Body), t_body);
|
||||||
|
body->comp = comp;
|
||||||
|
body->bc = cbc;
|
||||||
|
body->maxStack = mssz;
|
||||||
|
body->varAm = vam;
|
||||||
|
if (needsV0) body->flags|= 1;
|
||||||
|
|
||||||
|
Block* bl = mm_allocN(sizeof(Block), t_block);
|
||||||
|
bl->body = body;
|
||||||
|
bl->imm = imm;
|
||||||
|
bl->ty = ty;
|
||||||
|
comp->blocks[i] = bl;
|
||||||
|
}
|
||||||
|
|
||||||
|
Block* ret = c(Block,inci(tag(comp->blocks[0], OBJ_TAG)));
|
||||||
|
// TODO store blocks in each body, then decrement each of comp->blocks; also then move temp block list out of Comp as it's useless then
|
||||||
|
// for (usz i = 0; i < bam; i++) ptr_dec(comp->blocks[i]);
|
||||||
|
|
||||||
|
dec(blocks);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
Scope* scd(Scope* sc, u16 d) {
|
||||||
|
for (i32 i = 0; i < d; i++) sc = sc->psc;
|
||||||
|
return sc;
|
||||||
|
}
|
||||||
|
|
||||||
|
B v_set(Scope* sc, B s, B x, bool upd) { // frees s, consumes x, returns previous value
|
||||||
|
if (isVar(s)) {
|
||||||
|
sc = scd(sc, (u16)(s.u>>32));
|
||||||
|
B prev = sc->vars[(u32)s.u];
|
||||||
|
if (upd) {
|
||||||
|
if (prev.u==bi_noVar.u) return err("updating undefined variable");
|
||||||
|
dec(prev);
|
||||||
|
} else {
|
||||||
|
if (prev.u!=bi_noVar.u) return err("redefining variable");
|
||||||
|
}
|
||||||
|
sc->vars[(u32)s.u] = x;
|
||||||
|
} else {
|
||||||
|
assert(isArr(s) && v(s)->type==t_harr);
|
||||||
|
if (!shEq(s, x)) return err("spread assignment: mismatched shape");
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
B* sp = harr_ptr(s);
|
||||||
|
BS2B xget = TI(x).get;
|
||||||
|
for (u64 i = 0; i < ia; i++) v_set(sc, sp[i], xget(x,i), upd);
|
||||||
|
dec(s); dec(x);
|
||||||
|
}
|
||||||
|
return m_f64(0);
|
||||||
|
}
|
||||||
|
B v_get(Scope* sc, B s) { // get value representing s, replacing with bi_optOut; doesn't consume
|
||||||
|
if (isVar(s)) {
|
||||||
|
sc = scd(sc, (u16)(s.u>>32));
|
||||||
|
B r = sc->vars[(u32)s.u];
|
||||||
|
sc->vars[(u32)s.u] = bi_optOut;
|
||||||
|
return r;
|
||||||
|
} else {
|
||||||
|
assert(isArr(s) && v(s)->type==t_harr);
|
||||||
|
usz ia = a(s)->ia;
|
||||||
|
B* sp = harr_ptr(s);
|
||||||
|
HArr_p r = m_harrv(ia);
|
||||||
|
for (u64 i = 0; i < ia; i++) r.a[i] = v_get(sc, sp[i]);
|
||||||
|
return r.b;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// none consume anything consume
|
||||||
|
B m_funBlock(Block* bl, Scope* psc); // may return evaluated result, whatever
|
||||||
|
B m_md1Block(Block* bl, Scope* psc);
|
||||||
|
B m_md2Block(Block* bl, Scope* psc);
|
||||||
|
#ifdef DEBUG_VM
|
||||||
|
i32 bcDepth=-2;
|
||||||
|
i32* vmStack;
|
||||||
|
i32 bcCtr = 0;
|
||||||
|
#endif
|
||||||
|
B evalBC(Body* b, Scope* sc) {
|
||||||
|
#ifdef DEBUG_VM
|
||||||
|
bcDepth+= 2;
|
||||||
|
if (!vmStack) vmStack = malloc(400);
|
||||||
|
i32 stackNum = bcDepth>>1;
|
||||||
|
vmStack[stackNum] = -1;
|
||||||
|
printf("new eval\n");
|
||||||
|
#endif
|
||||||
|
B* objs = b->comp->objs->a;
|
||||||
|
Block** blocks = b->comp->blocks;
|
||||||
|
i32* bc = b->bc;
|
||||||
|
B stack[b->maxStack];
|
||||||
|
i32 sh = 0;
|
||||||
|
#define POP stack[--sh]
|
||||||
|
#define P(N) B N=POP;
|
||||||
|
#define ADD stack[sh++] =
|
||||||
|
while(true) {
|
||||||
|
#ifdef DEBUG_VM
|
||||||
|
i32* sbc = bc;
|
||||||
|
i32 bcPos = sbc-c(I32Arr,b->comp->bc)->a;
|
||||||
|
vmStack[stackNum] = bcPos;
|
||||||
|
for(i32 i = 0; i < bcDepth; i++) printf(" ");
|
||||||
|
printBC(sbc); printf("@%d << ", bcPos);
|
||||||
|
for (i32 i = 0; i < sh; i++) { if(i)printf(" ⋄ "); print(stack[i]); } puts(""); fflush(stdout);
|
||||||
|
bcCtr++;
|
||||||
|
for (i32 i = 0; i < sc->varAm; i++) validate(sc->vars[i]);
|
||||||
|
#endif
|
||||||
|
switch(*bc++) {
|
||||||
|
case POPS: dec(POP); break;
|
||||||
|
case PUSH: {
|
||||||
|
ADD inci(objs[*bc++]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case FN1C: { P(f)P(x)
|
||||||
|
ADD c1(f, x); dec(f);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case FN1O: { P(f)P(x)
|
||||||
|
ADD isNothing(x)? x : c1(f, x); dec(f);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case FN2C: { P(w)P(f)P(x)
|
||||||
|
ADD c2(f, w, x); dec(f);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case FN2O: { P(w)P(f)P(x)
|
||||||
|
if (isNothing(x)) { dec(w); ADD x; }
|
||||||
|
else ADD isNothing(w)? c1(f, x) : c2(f, w, x);
|
||||||
|
dec(f);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case ARRO: case ARRM: {
|
||||||
|
i32 sz = *bc++;
|
||||||
|
HArr_p r = m_harrv(sz);
|
||||||
|
for (i32 i = 0; i < sz; i++) r.a[sz-i-1] = POP;
|
||||||
|
ADD r.b;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case DFND: {
|
||||||
|
Block* bl = blocks[*bc++];
|
||||||
|
switch(bl->ty) { default: UD;
|
||||||
|
case 0: ADD m_funBlock(bl, sc); break;
|
||||||
|
case 1: ADD m_md1Block(bl, sc); break;
|
||||||
|
case 2: ADD m_md2Block(bl, sc); break;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case OP1D: { P(f)P(m) ADD m1_d (m,f ); break; }
|
||||||
|
case OP2D: { P(f)P(m)P(g) ADD m2_d (m,f,g); break; }
|
||||||
|
case OP2H: { P(m)P(g) ADD m2_h (m, g); break; }
|
||||||
|
case TR2D: { P(g)P(h) ADD m_atop( g,h); break; }
|
||||||
|
case TR3D: { P(f)P(g)P(h) ADD m_fork(f,g,h); break; }
|
||||||
|
case TR3O: { P(f)P(g)P(h)
|
||||||
|
if (isNothing(f)) { ADD m_atop(g,h); dec(f); }
|
||||||
|
else ADD m_fork(f,g,h);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case LOCM: { i32 d = *bc++; i32 p = *bc++;
|
||||||
|
ADD tag((u64)d<<32 | p, VAR_TAG);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case LOCO: { i32 d = *bc++; i32 p = *bc++;
|
||||||
|
ADD inci(scd(sc,d)->vars[p]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case SETN: { P(s) P(x) v_set(sc, s, inci(x), false); ADD x; break; }
|
||||||
|
case SETU: { P(s) P(x) v_set(sc, s, inci(x), true ); ADD x; break; }
|
||||||
|
case SETM: { P(s)P(f)P(x)
|
||||||
|
B w = v_get(sc, s);
|
||||||
|
B r = c2(f,w,x); dec(f);
|
||||||
|
v_set(sc, s, inci(r), true);
|
||||||
|
ADD r;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
// not implemented: VARO VARM CHKV VFYM SETH FLDO FLDM NSPM RETD SYSV
|
||||||
|
default: printf("todo %d\n", bc[-1]); bc++; break;
|
||||||
|
case RETN: goto end;
|
||||||
|
}
|
||||||
|
#ifdef DEBUG_VM
|
||||||
|
for(i32 i = 0; i < bcDepth; i++) printf(" ");
|
||||||
|
printBC(sbc); printf("@%ld: ", sbc-c(I32Arr,b->comp->bc)->a);
|
||||||
|
for (i32 i = 0; i < sh; i++) { if(i)printf(" ⋄ "); print(stack[i]); } puts(""); fflush(stdout);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
#undef P
|
||||||
|
#undef ADD
|
||||||
|
#undef POP
|
||||||
|
end:;
|
||||||
|
#ifdef DEBUG_VM
|
||||||
|
bcDepth-= 2;
|
||||||
|
#endif
|
||||||
|
assert(sh==1);
|
||||||
|
return stack[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
B actualExec(Block* bl, Scope* psc, u32 ga, ...) {
|
||||||
|
Body* bdy = bl->body;
|
||||||
|
Scope* sc = mm_allocN(fsizeof(Scope, vars, B, bdy->varAm), t_scope);
|
||||||
|
sc->psc = psc; if(psc)ptr_inc(psc);
|
||||||
|
u16 varAm = sc->varAm = bdy->varAm;
|
||||||
|
assert(varAm>=ga);
|
||||||
|
sc->bcInd = bdy->bc-c(I32Arr,bdy->comp->bc)->a;
|
||||||
|
i32 i = 0;
|
||||||
|
va_list vargs;
|
||||||
|
va_start(vargs, ga);
|
||||||
|
while (i<ga) sc->vars[i++] = va_arg(vargs, B);
|
||||||
|
while (i<varAm) sc->vars[i++] = bi_noVar;
|
||||||
|
va_end(vargs);
|
||||||
|
// if (ga & !(bdy->flags&1)) {
|
||||||
|
// B v0 = sc->vars[0];
|
||||||
|
// dec(v0); sc->vars[0] = bi_optOut; // prevent reference cycle; TODO more properly do this (or just remove, it doesn't seem to be doing much)
|
||||||
|
// }
|
||||||
|
B r = evalBC(bdy, sc);
|
||||||
|
ptr_dec(sc);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
B funBl_c1(B t, B x) { return actualExec(c(FunBlock, t)->bl, c(FunBlock, t)->sc, 3, inci(t), x, bi_nothing); }
|
||||||
|
B funBl_c2(B t, B w, B x) { return actualExec(c(FunBlock, t)->bl, c(FunBlock, t)->sc, 3, inci(t), x, w); }
|
||||||
|
B md1Bl_c1(B t, B f, B x) { return actualExec(c(Md1Block, t)->bl, c(Md1Block, t)->sc, 5, m_md1D(inci(t),inci(f) ), x, bi_nothing, inci(t), inci(f)); }
|
||||||
|
B md1Bl_c2(B t, B f, B w, B x) { return actualExec(c(Md1Block, t)->bl, c(Md1Block, t)->sc, 5, m_md1D(inci(t),inci(f) ), x, w , inci(t), inci(f)); }
|
||||||
|
B md2Bl_c1(B t, B f, B g, B x) { return actualExec(c(Md2Block, t)->bl, c(Md2Block, t)->sc, 6, m_md2D(inci(t),inci(f),inci(g)), x, bi_nothing, inci(t), inci(f), inci(g)); }
|
||||||
|
B md2Bl_c2(B t, B f, B g, B w, B x) { return actualExec(c(Md2Block, t)->bl, c(Md2Block, t)->sc, 6, m_md2D(inci(t),inci(f),inci(g)), x, w , inci(t), inci(f), inci(g)); }
|
||||||
|
B m_funBlock(Block* bl, Scope* psc) {
|
||||||
|
if (bl->imm) return actualExec(bl, psc, 0);
|
||||||
|
B r = mm_alloc(sizeof(FunBlock), t_fun_block, ftag(FUN_TAG));
|
||||||
|
c(FunBlock, r)->bl = bl; ptr_inc(bl);
|
||||||
|
c(FunBlock, r)->sc = psc; ptr_inc(psc);
|
||||||
|
c(FunBlock, r)->c1 = funBl_c1;
|
||||||
|
c(FunBlock, r)->c2 = funBl_c2;
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B m_md1Block(Block* bl, Scope* psc) {
|
||||||
|
B r = mm_alloc(sizeof(Md1Block), t_md1_block, ftag(MD1_TAG));
|
||||||
|
c(Md1Block, r)->bl = bl; ptr_inc(bl);
|
||||||
|
c(Md1Block, r)->sc = psc; ptr_inc(psc);
|
||||||
|
c(Md1Block, r)->c1 = md1Bl_c1;
|
||||||
|
c(Md1Block, r)->c2 = md1Bl_c2;
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B m_md2Block(Block* bl, Scope* psc) {
|
||||||
|
B r = mm_alloc(sizeof(Md2Block), t_md2_block, ftag(MD2_TAG));
|
||||||
|
c(Md2Block, r)->bl = bl; ptr_inc(bl);
|
||||||
|
c(Md2Block, r)->sc = psc; ptr_inc(psc);
|
||||||
|
c(Md2Block, r)->c1 = md2Bl_c1;
|
||||||
|
c(Md2Block, r)->c2 = md2Bl_c2;
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
void comp_free(B x) { Comp* c = c(Comp ,x); ptr_dec(c->objs); dec(c->bc); }
|
||||||
|
void body_free(B x) { Body* c = c(Body ,x); ptr_dec(c->comp); }
|
||||||
|
void block_free(B x) { Block* c = c(Block,x); ptr_dec(c->body); }
|
||||||
|
void scope_free(B x) {
|
||||||
|
Scope* c = c(Scope,x);
|
||||||
|
if (c->psc) ptr_dec(c->psc);
|
||||||
|
u16 am = c->varAm;
|
||||||
|
for (u32 i = 0; i < am; i++) dec(c->vars[i]);
|
||||||
|
}
|
||||||
|
void funBl_free(B x) { FunBlock* c = c(FunBlock,x); ptr_dec(c->sc); ptr_dec(c->bl); }
|
||||||
|
void md1Bl_free(B x) { Md1Block* c = c(Md1Block,x); ptr_dec(c->sc); ptr_dec(c->bl); }
|
||||||
|
void md2Bl_free(B x) { Md2Block* c = c(Md2Block,x); ptr_dec(c->sc); ptr_dec(c->bl); }
|
||||||
|
|
||||||
|
void comp_print (B x) { printf("(%p: comp)",v(x)); }
|
||||||
|
void body_print (B x) { printf("(%p: body varam=%d)",v(x),c(Body,x)->varAm); }
|
||||||
|
void block_print(B x) { printf("(%p: block for %p)",v(x),c(Block,x)->body); }
|
||||||
|
void scope_print(B x) { printf("(%p: scope; vars:",v(x));Scope*sc=c(Scope,x);for(u64 i=0;i<sc->varAm;i++){printf(" ");print(sc->vars[i]);}printf(")"); }
|
||||||
|
|
||||||
|
// void funBl_print(B x) { printf("(%p: function"" block bl=%p sc=%p)",v(x),c(FunBlock,x)->bl,c(FunBlock,x)->sc); }
|
||||||
|
// void md1Bl_print(B x) { printf("(%p: 1-modifier block bl=%p sc=%p)",v(x),c(Md1Block,x)->bl,c(Md1Block,x)->sc); }
|
||||||
|
// void md2Bl_print(B x) { printf("(%p: 2-modifier block bl=%p sc=%p)",v(x),c(Md2Block,x)->bl,c(Md2Block,x)->sc); }
|
||||||
|
// void funBl_print(B x) { printf("(%p: function"" block @%ld)",v(x),c(FunBlock,x)->bl->body->bc-c(I32Arr,c(FunBlock,x)->bl->body->comp->bc)->a); }
|
||||||
|
// void md1Bl_print(B x) { printf("(%p: 1-modifier block @%ld)",v(x),c(Md1Block,x)->bl->body->bc-c(I32Arr,c(Md1Block,x)->bl->body->comp->bc)->a); }
|
||||||
|
// void md2Bl_print(B x) { printf("(%p: 2-modifier block @%ld)",v(x),c(Md2Block,x)->bl->body->bc-c(I32Arr,c(Md2Block,x)->bl->body->comp->bc)->a); }
|
||||||
|
void funBl_print(B x) { printf("{function""}"); }
|
||||||
|
void md1Bl_print(B x) { printf("{1-modifier}"); }
|
||||||
|
void md2Bl_print(B x) { printf("{2-modifier}"); }
|
||||||
|
|
||||||
|
B block_decompose(B x) { return m_v2(m_i32(1), x); }
|
||||||
|
|
||||||
|
B bl_m1d(B m, B f ) { Md1Block* c = c(Md1Block,m); return c->bl->imm? actualExec(c(Md1Block, m)->bl, c(Md1Block, m)->sc, 2, m, f ) : m_md1D(m,f ); }
|
||||||
|
B bl_m2d(B m, B f, B g) { Md2Block* c = c(Md2Block,m); return c->bl->imm? actualExec(c(Md2Block, m)->bl, c(Md2Block, m)->sc, 3, m, f, g) : m_md2D(m,f,g); }
|
||||||
|
|
||||||
|
void comp_init() {
|
||||||
|
ti[t_comp ].free = comp_free; ti[t_comp ].print = comp_print;
|
||||||
|
ti[t_body ].free = body_free; ti[t_body ].print = body_print;
|
||||||
|
ti[t_block ].free = block_free; ti[t_block ].print = block_print;
|
||||||
|
ti[t_scope ].free = scope_free; ti[t_scope ].print = scope_print;
|
||||||
|
ti[t_fun_block].free = funBl_free; ti[t_fun_block].print = funBl_print; ti[t_fun_block].decompose = block_decompose;
|
||||||
|
ti[t_md1_block].free = md1Bl_free; ti[t_md1_block].print = md1Bl_print; ti[t_md1_block].decompose = block_decompose; ti[t_md1_block].m1_d=bl_m1d;
|
||||||
|
ti[t_md2_block].free = md2Bl_free; ti[t_md2_block].print = md2Bl_print; ti[t_md2_block].decompose = block_decompose; ti[t_md2_block].m2_d=bl_m2d;
|
||||||
|
}
|
||||||
|
|
||||||
|
void print_vmStack() {
|
||||||
|
#ifdef DEBUG_VM
|
||||||
|
printf("vm stack:");
|
||||||
|
for (i32 i = 0; i < (bcDepth>>1) + 1; i++) { printf(" %d", vmStack[i]); fflush(stdout); }
|
||||||
|
printf("\n"); fflush(stdout);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
29
test.bqn
Executable file
29
test.bqn
Executable file
@ -0,0 +1,29 @@
|
|||||||
|
#! /usr/bin/env dbqn
|
||||||
|
"usage: test.bqn path/to/mlochbaum/BQN ""$PATH"" [optional expressions to evaluate]"!2≤≠•args
|
||||||
|
path←0⊑•args
|
||||||
|
envP←1⊑•args
|
||||||
|
|
||||||
|
tests ← •FLines path∾"/test/cases/prim.bqn"
|
||||||
|
# tests ← •FLines path∾"/test/cases/identity.bqn"
|
||||||
|
# tests ← •FLines path∾"/test/cases/under.bqn"
|
||||||
|
# tests ← •FLines path∾"/test/cases/fill.bqn"
|
||||||
|
# tests ← •FLines "primLeft.bqn"
|
||||||
|
{tests↩𝕩}⍟(×≠) 2↓•args
|
||||||
|
|
||||||
|
('#'≠ ·⊑ ∾⟜"#")◶@‿{
|
||||||
|
'%'⊸∊◶{𝕤
|
||||||
|
•Out 𝕩
|
||||||
|
"src/interp" •FChars ⟨1,path,𝕩⟩ •Import "cc.bqn"
|
||||||
|
(×⊑)◶@‿{𝕤⋄•Out "############ Failed to compile! ############" ⋄ •Out¨1↓𝕩}{env⇐<"PATH="∾envP}•SH"./debugBuild"
|
||||||
|
code‿out‿err←•SH"./BQN"
|
||||||
|
•Out out
|
||||||
|
{𝕤⋄•Out"exit code "∾(⍕code) ⋄ •Out err}⍟(×code) err
|
||||||
|
}‿{𝕤
|
||||||
|
# •Out 𝕩
|
||||||
|
# "src/interp" •FChars ⟨1,path,3↓𝕩⟩ •Import "cc.bqn"
|
||||||
|
# (×⊑)◶@‿{𝕤⋄•Out "############ Failed to compile! ############" ⋄ •Out¨1↓𝕩}{env⇐<"PATH="∾envP}•SH"./debugBuild"
|
||||||
|
# code‿out‿err←•SH"./BQN"
|
||||||
|
# •Out out
|
||||||
|
# {𝕤⋄•Out"exit code "∾(⍕code) ⋄ •Out err}⍟(×code) err
|
||||||
|
}
|
||||||
|
}¨tests
|
||||||
Loading…
Reference in New Issue
Block a user