├── .gitignore ├── LICENSE ├── README.md └── src ├── VERSION ├── base64.c ├── base64.h ├── basic.c ├── basic.h ├── bn.c ├── bn.h ├── buf.c ├── buf.h ├── buf_str.c ├── buf_str.h ├── build ├── convert.c ├── convert.h ├── crypto.c ├── crypto.h ├── die.c ├── die.h ├── fexl ├── fexl.c ├── file.c ├── file.h ├── file_str.c ├── file_str.h ├── format.c ├── format.h ├── handy ├── lib ├── assoc.fxl ├── bool.fxl ├── date.fxl ├── format.fxl ├── hex.fxl ├── html.fxl ├── indent.fxl ├── list.fxl ├── main.fxl ├── math.fxl ├── read.fxl ├── read_csv.fxl ├── read_ssv.fxl ├── run.fxl └── time.fxl ├── lib_build ├── limit.c ├── limit.h ├── memory.c ├── memory.h ├── nacl.c ├── nacl.h ├── out ├── a1 ├── a2 ├── a3 ├── a4 ├── a5 ├── a8 ├── a9 ├── b10 ├── b11 ├── b12 ├── b13 ├── b14 ├── b15 ├── b16 ├── b17 ├── b18 ├── b19 ├── b20 ├── b21 ├── b22 ├── b23 ├── b24 ├── b44 ├── b45 ├── b46 ├── b47 ├── b48 ├── b49 ├── b50 ├── b51 ├── b53 ├── chars ├── crypto ├── date ├── get_byte ├── index_C ├── leak ├── mf ├── missing ├── partition ├── record ├── resolve ├── sat ├── sort ├── stats ├── stream └── syntax ├── parse.c ├── parse.h ├── report.c ├── report.h ├── sha256.c ├── sha256.h ├── sha512.c ├── sha512.h ├── show.c ├── show.h ├── str.c ├── str.h ├── stream.c ├── stream.h ├── test ├── a1.fxl ├── a2.fxl ├── a3.fxl ├── a4.fxl ├── a5.fxl ├── a8.fxl ├── a9.fxl ├── b10.fxl ├── b11.fxl ├── b12.fxl ├── b13.fxl ├── b14.fxl ├── b15.fxl ├── b16.fxl ├── b17.fxl ├── b18.fxl ├── b19.fxl ├── b20.fxl ├── b21.fxl ├── b22.fxl ├── b23.fxl ├── b24.fxl ├── b44.fxl ├── b45.fxl ├── b46.fxl ├── b47.fxl ├── b48.fxl ├── b49.fxl ├── b50.fxl ├── b51.fxl ├── b53.fxl ├── beer.fxl ├── big_hash.fxl ├── big_hash.out ├── chars.fxl ├── check ├── check.fxl ├── client.fxl ├── crypto.fxl ├── data.txt ├── date.fxl ├── get_byte.fxl ├── hailstone.fxl ├── hello.fxl ├── index_C.fxl ├── keystroke.fxl ├── leak.fxl ├── lib │ ├── b15 │ │ └── context.fxl │ ├── index │ │ ├── index.fxl │ │ └── render.fxl │ ├── index_C │ │ └── context.fxl │ └── render │ │ ├── C.fxl │ │ ├── base.fxl │ │ └── list.fxl ├── ls_bug │ ├── correct │ ├── dir │ │ ├── read.fxl │ │ ├── read_csv.fxl │ │ └── read_ssv.fxl │ └── try ├── mf.fxl ├── misc.fxl ├── partition.fxl ├── record.fxl ├── resolve.fxl ├── sat.fxl ├── server.fxl ├── show ├── show.fxl ├── sort.fxl ├── stats.fxl ├── stream.fxl ├── syntax.fxl ├── test.csv ├── test.fxl ├── test.ssv ├── utf8.fxl └── var.fxl ├── type_bn.c ├── type_bn.h ├── type_buf.c ├── type_buf.h ├── type_cmp.c ├── type_cmp.h ├── type_crypto.c ├── type_crypto.h ├── type_file.c ├── type_file.h ├── type_hex.c ├── type_hex.h ├── type_input.c ├── type_input.h ├── type_istr.c ├── type_istr.h ├── type_limit.c ├── type_limit.h ├── type_math.c ├── type_math.h ├── type_num.c ├── type_num.h ├── type_output.c ├── type_output.h ├── type_parse.c ├── type_parse.h ├── type_rand.c ├── type_rand.h ├── type_record.c ├── type_record.h ├── type_run.c ├── type_run.h ├── type_signal.c ├── type_signal.h ├── type_str.c ├── type_str.h ├── type_stream.c ├── type_stream.h ├── type_sym.c ├── type_sym.h ├── type_time.c ├── type_time.h ├── type_tuple.c ├── type_tuple.h ├── type_var.c ├── type_var.h ├── type_with.c ├── type_with.h ├── types.h ├── value.c └── value.h /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | /bin 3 | /obj 4 | /lib 5 | /notes 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT/X Consortium License 2 | 3 | Copyright 2023 Patrick Chkoreff 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a 6 | copy of this software and associated documentation files (the "Software"), 7 | to deal in the Software without restriction, including without limitation 8 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 9 | and/or sell copies of the Software, and to permit persons to whom the 10 | Software is furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 18 | THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 20 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 21 | DEALINGS IN THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /src/VERSION: -------------------------------------------------------------------------------- 1 | 39.9.0+1 2 | -------------------------------------------------------------------------------- /src/base64.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | 5 | #include 6 | 7 | // Reference: https://en.wikipedia.org/wiki/Base64 8 | // Reference: https://tools.ietf.org/html/rfc4648#section-10 9 | 10 | // Unpack a 6-bit sextet (0-63) to a printable base64 character. 11 | static const char *unpack_ch = 12 | "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; 13 | 14 | // Pack a printable base64 character to a 6-bit sextet (0-63). 15 | static u8 pack_ch(u8 ch) 16 | { 17 | if (ch >= 'A' && ch <= 'Z') return ch - 'A'; 18 | if (ch >= 'a' && ch <='z') return ch - 'a' + 26; 19 | if (ch >= '0' && ch <='9') return ch - '0' + 52; 20 | if (ch == '+') return 62; 21 | if (ch == '/') return 63; 22 | return 0; 23 | } 24 | 25 | // Unpack n bytes of raw data to base 64 characters. The "in" array holds the 26 | // raw data. The "out" array holds the NUL-terminated result, and its size in 27 | // bytes must be at least: 4*(n/3) + (n%3 == 0 ? 0 : 4) + 1. 28 | void unpack64(u8 *out, const u8 *in, u64 n) 29 | { 30 | const u64 n_group = n / 3; 31 | const u8 n_remain = n % 3; 32 | u64 i; 33 | 34 | for (i = 0; i < n_group; i++) 35 | { 36 | u8 c0 = in[3*i+0]; 37 | u8 c1 = in[3*i+1]; 38 | u8 c2 = in[3*i+2]; 39 | out[4*i+0] = unpack_ch[c0 >> 2]; 40 | out[4*i+1] = unpack_ch[((c0 & 3) << 4) | (c1 >> 4)]; 41 | out[4*i+2] = unpack_ch[((c1 & 15) << 2) | (c2 >> 6)]; 42 | out[4*i+3] = unpack_ch[c2 & 63]; 43 | } 44 | 45 | if (n_remain == 0) 46 | out[4*i+0] = 0; 47 | else 48 | { 49 | u8 c0 = in[3*i+0]; 50 | out[4*i+0] = unpack_ch[c0 >> 2]; 51 | if (n_remain == 1) 52 | { 53 | out[4*i+1] = unpack_ch[(c0 & 3) << 4]; 54 | out[4*i+2] = '='; 55 | } 56 | else 57 | { 58 | u8 c1 = in[3*i+1]; 59 | out[4*i+1] = unpack_ch[((c0 & 3) << 4) | (c1 >> 4)]; 60 | out[4*i+2] = unpack_ch[(c1 & 15) << 2]; 61 | } 62 | out[4*i+3] = '='; 63 | out[4*i+4] = 0; 64 | } 65 | } 66 | 67 | // Pack n bytes of base 64 characters to raw data. The "in" array holds the 68 | // base 64 characters. The "out" array holds the NUL-terminated result, and 69 | // its size in bytes must be at least: 3*(n/4) + (n%4 == 0 ? 0 : n%4-1) + 1. 70 | // 71 | // Note that n does NOT include any trailing padding characters ('='). The 72 | // caller should decrement n as needed to ignore padding. 73 | void pack64(u8 *out, const u8 *in, u64 n) 74 | { 75 | const u64 n_group = n / 4; 76 | const u8 n_remain = n % 4; 77 | u64 i; 78 | 79 | for (i = 0; i < n_group; i++) 80 | { 81 | u8 c0 = pack_ch(in[4*i+0]); 82 | u8 c1 = pack_ch(in[4*i+1]); 83 | u8 c2 = pack_ch(in[4*i+2]); 84 | u8 c3 = pack_ch(in[4*i+3]); 85 | out[3*i+0] = (c0 << 2) | (c1 >> 4); 86 | out[3*i+1] = ((c1 & 15) << 4) | (c2 >> 2); 87 | out[3*i+2] = ((c2 & 3) << 6) | (c3 & 63); 88 | } 89 | 90 | if (n_remain <= 1) 91 | out[3*i+0] = 0; 92 | else 93 | { 94 | u8 c0 = pack_ch(in[4*i+0]); 95 | u8 c1 = pack_ch(in[4*i+1]); 96 | out[3*i+0] = (c0 << 2) | (c1 >> 4); 97 | if (n_remain == 2) 98 | out[3*i+1] = 0; 99 | else 100 | { 101 | u8 c2 = pack_ch(in[4*i+2]); 102 | out[3*i+1] = ((c1 & 15) << 4) | (c2 >> 2); 103 | out[3*i+2] = 0; 104 | } 105 | } 106 | } 107 | -------------------------------------------------------------------------------- /src/base64.h: -------------------------------------------------------------------------------- 1 | extern void unpack64(u8 *out, const u8 *in, u64 n); 2 | extern void pack64(u8 *out, const u8 *in, u64 n); 3 | -------------------------------------------------------------------------------- /src/basic.h: -------------------------------------------------------------------------------- 1 | extern value QI; 2 | extern value QT; 3 | extern value QF; 4 | extern value QY; 5 | extern value Qvoid; 6 | extern value Qnull; 7 | extern value Qonce; 8 | extern value Qyield; 9 | extern value type_I(value f); 10 | extern value type_T(value f); 11 | extern value type_F(value f); 12 | extern value type_Y(value f); 13 | extern value type_void(value f); 14 | extern value type_pair(value f); 15 | extern value pair(value x, value y); 16 | extern value type_list(value f); 17 | extern value cons(value x, value y); 18 | extern value type_cons(value f); 19 | extern value type_null(value f); 20 | extern value type_eval(value f); 21 | extern value type_once(value f); 22 | extern value type_yield(value f); 23 | extern value yield(value x); 24 | extern value maybe(value x); 25 | extern value boolean(int x); 26 | extern value type_is_defined(value f); 27 | extern value type_is_undef(value f); 28 | extern value op_is_type(value f, type t); 29 | extern value type_is_void(value f); 30 | extern value type_is_good(value f); 31 | extern value type_is_bool(value f); 32 | extern value type_is_list(value f); 33 | extern value type_chain(value f); 34 | extern value Q0(type T); 35 | extern void beg_basic(void); 36 | extern void end_basic(void); 37 | -------------------------------------------------------------------------------- /src/bn.h: -------------------------------------------------------------------------------- 1 | struct bn 2 | { 3 | u32 sign; 4 | u32 nsd; 5 | u32 len; 6 | u32 vec[]; 7 | }; 8 | 9 | extern struct bn *bn_new(u64 n); 10 | extern void bn_free(struct bn *x); 11 | extern int bn_eq0(const struct bn *x); 12 | extern int bn_is_neg(const struct bn *x); 13 | extern struct bn *bn_neg(const struct bn *x); 14 | extern int bn_cmp(const struct bn *x, const struct bn *y); 15 | extern struct bn *bn_add(const struct bn *x, const struct bn *y); 16 | extern struct bn *bn_sub(const struct bn *x, const struct bn *y); 17 | extern struct bn *bn_mul(const struct bn *x, const struct bn *y); 18 | extern void bn_div 19 | ( 20 | const struct bn *x, 21 | const struct bn *y, 22 | struct bn **qp, 23 | struct bn **rp 24 | ); 25 | extern struct bn *bn_mod(const struct bn *x, const struct bn *y); 26 | extern struct bn *bn_from_dec(const char *s); 27 | extern string bn_to_dec(const struct bn *x); 28 | -------------------------------------------------------------------------------- /src/buf.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include // realloc 6 | #include // memcpy 7 | #include 8 | 9 | // Grow buffer by delta bytes. 10 | static void buf_grow(buffer buf, size_t delta) 11 | { 12 | size_t size = buf->size + delta; 13 | char *data = realloc(buf->data, size); 14 | 15 | if (data == NULL) die("Out of memory"); 16 | if (buf->data == 0) cur_blocks++; 17 | cur_bytes += delta; 18 | 19 | buf->size = size; 20 | buf->data = data; 21 | } 22 | 23 | // Ensure that the buffer has at least the needed capacity. 24 | static void buf_need(buffer buf, size_t need) 25 | { 26 | size_t room = buf->size - buf->len; // current room in buffer 27 | if (room < need) 28 | { 29 | const size_t base = 64; 30 | const size_t mark = 1048576; // 2^20 31 | 32 | // If size == 0 set the size to base. Otherwise increase the size by 33 | // 100% if size <= mark, or 50% if size > mark. 34 | 35 | size_t min_delta = need - room; 36 | size_t delta = buf->size; 37 | 38 | if (delta == 0) 39 | delta = base; 40 | else if (delta > mark) 41 | delta >>= 1; 42 | 43 | // In any case ensure at least the minimum needed. 44 | if (delta < min_delta) 45 | delta = min_delta; 46 | 47 | buf_grow(buf,delta); 48 | } 49 | } 50 | 51 | // Add a char to the buffer. 52 | void buf_add(buffer buf, char ch) 53 | { 54 | buf_need(buf,1); 55 | buf->data[buf->len++] = ch; 56 | } 57 | 58 | // Add chars to the buffer. 59 | void buf_addn(buffer buf, const char *str, size_t len) 60 | { 61 | buf_need(buf,len); 62 | memcpy(buf->data + buf->len,str,len); 63 | buf->len += len; 64 | } 65 | 66 | // Discard buffer contents. 67 | void buf_discard(buffer buf) 68 | { 69 | if (buf->data != 0) cur_blocks--; 70 | free(buf->data); 71 | cur_bytes -= buf->size; 72 | 73 | buf->len = 0; 74 | buf->size = 0; 75 | buf->data = 0; 76 | } 77 | -------------------------------------------------------------------------------- /src/buf.h: -------------------------------------------------------------------------------- 1 | typedef struct buffer *buffer; 2 | 3 | struct buffer 4 | { 5 | size_t len; 6 | size_t size; 7 | char *data; 8 | }; 9 | 10 | extern void buf_add(buffer buf, char ch); 11 | extern void buf_addn(buffer buf, const char *str, size_t len); 12 | extern void buf_discard(buffer buf); 13 | -------------------------------------------------------------------------------- /src/buf_str.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | 6 | #include 7 | #include // memcpy 8 | 9 | // Add a string to the buffer. 10 | void buf_put(buffer buf, string str) 11 | { 12 | buf_addn(buf,str->data,str->len); 13 | } 14 | 15 | // Clear the buffer and return its content in a string. 16 | string buf_clear(buffer buf) 17 | { 18 | string result = str_new(buf->len); 19 | memcpy(result->data,buf->data,buf->len); 20 | buf_discard(buf); 21 | return result; 22 | } 23 | -------------------------------------------------------------------------------- /src/buf_str.h: -------------------------------------------------------------------------------- 1 | extern void buf_put(buffer buf, string str); 2 | extern string buf_clear(buffer buf); 3 | -------------------------------------------------------------------------------- /src/build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | . ./lib_build 3 | 4 | make base64 5 | make basic 6 | make bn 7 | make buf 8 | make buf_str 9 | make convert 10 | make crypto 11 | make die 12 | make fexl 13 | make file 14 | make file_str 15 | make format 16 | make limit 17 | make memory 18 | make nacl 19 | make parse 20 | make report 21 | make sha256 22 | make sha512 23 | #make show # for dev 24 | make str 25 | make stream 26 | make type_bn 27 | make type_buf 28 | make type_cmp 29 | make type_crypto 30 | make type_file 31 | make type_hex 32 | make type_input 33 | make type_istr 34 | make type_limit 35 | make type_math 36 | make type_num 37 | make type_output 38 | make type_parse 39 | make type_rand 40 | make type_record 41 | make type_run 42 | make type_signal 43 | make type_stream 44 | make type_str 45 | make type_sym 46 | make type_time 47 | make type_tuple 48 | make type_var 49 | make type_with 50 | make value 51 | push -lm 52 | link fexl 53 | -------------------------------------------------------------------------------- /src/convert.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // strtod 4 | 5 | // I use the standard strtod(3) to convert a string to a double. Problem is, 6 | // that routine will succeed on "inf", "-inf", "nan", and "-nan". If those 7 | // always parsed as numeric values, it would be impossible to use any of those 8 | // names as a lambda symbol. Besides, the semantics of those values are ugly 9 | // and arcane. 10 | // 11 | // Consequently I do a couple of checks before calling strtod(3). The first 12 | // byte must be either a digit 0-9, or '-', '.', or '+'. If the first byte is 13 | // '-', the the second byte must be either a digit 0-9 or '.'. I'm pretty 14 | // certain that is the minimal constraint I can impose which makes strtod 15 | // succeed in all cases EXCEPT the ones mentioned above. 16 | 17 | int str0_double(const char *str, double *val) 18 | { 19 | char ch; 20 | if (str == 0) return 0; 21 | 22 | ch = str[0]; 23 | if (!(isdigit(ch) || ch == '-' || ch == '.' || ch == '+')) 24 | ch = 0; 25 | 26 | if (ch == '-') 27 | { 28 | ch = str[1]; 29 | if (!(isdigit(ch) || ch == '.')) 30 | ch = 0; 31 | } 32 | 33 | if (ch) 34 | { 35 | char *end; 36 | *val = strtod(str, &end); 37 | return (*end == '\0'); 38 | } 39 | else 40 | return 0; 41 | } 42 | -------------------------------------------------------------------------------- /src/convert.h: -------------------------------------------------------------------------------- 1 | extern int str0_double(const char *str, double *val); 2 | -------------------------------------------------------------------------------- /src/crypto.h: -------------------------------------------------------------------------------- 1 | extern void close_random(void); 2 | extern string str_random_bytes(unsigned long num_bytes); 3 | extern string str_random_nonce(void); 4 | extern string str_random_secret_key(void); 5 | extern string str_nacl_box_public(string secret_key); 6 | extern string str_nacl_box_prepare(string public_key, string secret_key); 7 | extern string str_nacl_box_seal(string text, string nonce, string key); 8 | extern string str_nacl_box_open(string crypt_text, string nonce, string key); 9 | extern string str_nacl_sign_public(string secret_key); 10 | extern string str_nacl_sign_seal(string text, string public_key, 11 | string secret_key); 12 | extern int str_nacl_sign_open(string text, string public_key, string signature); 13 | extern string str_sha256(string text); 14 | extern string str_sha512(string text); 15 | extern string str_pack64(string text); 16 | extern string str_unpack64(string text); 17 | extern string str_hmac_sha512(string text, string key); 18 | extern string str_hmac_sha256(string text, string key); 19 | -------------------------------------------------------------------------------- /src/die.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include // exit 6 | 7 | void die(const char *msg) 8 | { 9 | if (msg) 10 | { 11 | fput(stderr,msg);fnl(stderr); 12 | } 13 | exit(1); 14 | } 15 | -------------------------------------------------------------------------------- /src/die.h: -------------------------------------------------------------------------------- 1 | extern void die(const char *msg); 2 | -------------------------------------------------------------------------------- /src/fexl: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ./build || exit 3 | exec ../bin/fexl "$@" 4 | -------------------------------------------------------------------------------- /src/file.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include // strlen 7 | 8 | void fputd(FILE *fh, const char *data, unsigned long len) 9 | { 10 | size_t n = fwrite(data,1,len,fh); 11 | (void)n; 12 | } 13 | 14 | void fput(FILE *fh, const char *data) 15 | { 16 | fputd(fh,data,strlen(data)); 17 | } 18 | 19 | void fput_ch(FILE *fh, char ch) 20 | { 21 | fputd(fh,&ch,1); 22 | } 23 | 24 | void fput_long(FILE *fh, long x) 25 | { 26 | fput(fh,format_long(x)); 27 | } 28 | 29 | void fput_ulong(FILE *fh, unsigned long x) 30 | { 31 | fput(fh,format_ulong(x)); 32 | } 33 | 34 | void fput_double(FILE *fh, double x) 35 | { 36 | fput(fh,format_double(x)); 37 | } 38 | 39 | void fnl(FILE *fh) 40 | { 41 | fput_ch(fh,'\n'); 42 | } 43 | 44 | void put(const char *data) 45 | { 46 | fput(stdout,data); 47 | } 48 | 49 | void put_ch(char ch) 50 | { 51 | fput_ch(stdout,ch); 52 | } 53 | 54 | void put_long(long x) 55 | { 56 | fput_long(stdout,x); 57 | } 58 | 59 | void put_ulong(unsigned long x) 60 | { 61 | fput_ulong(stdout,x); 62 | } 63 | 64 | void put_double(double x) 65 | { 66 | fput_double(stdout,x); 67 | } 68 | 69 | void nl(void) 70 | { 71 | fnl(stdout); 72 | } 73 | -------------------------------------------------------------------------------- /src/file.h: -------------------------------------------------------------------------------- 1 | extern void fputd(FILE *fh, const char *data, unsigned long len); 2 | extern void fput(FILE *fh, const char *data); 3 | extern void fput_ch(FILE *fh, char ch); 4 | extern void fput_long(FILE *fh, long x); 5 | extern void fput_ulong(FILE *fh, unsigned long x); 6 | extern void fput_double(FILE *fh, double x); 7 | extern void fnl(FILE *fh); 8 | extern void put(const char *data); 9 | extern void put_ch(char ch); 10 | extern void put_long(long x); 11 | extern void put_ulong(unsigned long x); 12 | extern void put_double(double x); 13 | extern void nl(void); 14 | -------------------------------------------------------------------------------- /src/file_str.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | 7 | void fput_str(FILE *fh, string x) 8 | { 9 | fputd(fh,x->data,x->len); 10 | } 11 | 12 | void put_str(string x) 13 | { 14 | fput_str(stdout,x); 15 | } 16 | -------------------------------------------------------------------------------- /src/file_str.h: -------------------------------------------------------------------------------- 1 | extern void fput_str(FILE *fh, string x); 2 | extern void put_str(string x); 3 | -------------------------------------------------------------------------------- /src/format.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include // snprintf 5 | 6 | static char buf[100]; // Being careful here. 7 | 8 | const char *format_long(long x) 9 | { 10 | snprintf(buf, sizeof(buf), "%ld", x); 11 | return buf; 12 | } 13 | 14 | const char *format_ulong(unsigned long x) 15 | { 16 | snprintf(buf, sizeof(buf), "%lu", x); 17 | return buf; 18 | } 19 | 20 | const char *format_uint64_t(uint64_t x) 21 | { 22 | snprintf(buf, sizeof(buf), "%lu", x); 23 | return buf; 24 | } 25 | 26 | // I show 15 digits because that's what Perl does. I considered using limits.h 27 | // to determine a machine-specific precision. The problem is, DECIMAL_DIG (in 28 | // float.h) is only guaranteed to be at least 10, which is a pretty poor worst 29 | // case. 30 | // 31 | // https://en.wikipedia.org/wiki/Double-precision_floating-point_format 32 | const char *format_double(double x) 33 | { 34 | snprintf(buf, sizeof(buf), "%.15g", x); 35 | return buf; 36 | } 37 | -------------------------------------------------------------------------------- /src/format.h: -------------------------------------------------------------------------------- 1 | extern const char *format_long(long x); 2 | extern const char *format_ulong(unsigned long x); 3 | extern const char *format_uint64_t(uint64_t x); 4 | extern const char *format_double(double x); 5 | -------------------------------------------------------------------------------- /src/handy: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | .s() 4 | { 5 | if [ "$1" != "" ]; then 6 | grep -r -I "$1" ./* 7 | fi 8 | } 9 | 10 | .sw() 11 | { 12 | .s "\<$1\>" 13 | } 14 | 15 | # Search source for stray trailing white space 16 | .ss() 17 | { 18 | .s "\s$" 19 | } 20 | 21 | .todo() 22 | { 23 | .s "T""ODO" 24 | } 25 | 26 | .later() 27 | { 28 | .s "L""ATER" 29 | } 30 | 31 | alias .gs='git status' 32 | alias .gd='git diff' 33 | -------------------------------------------------------------------------------- /src/lib/assoc.fxl: -------------------------------------------------------------------------------- 1 | # (Sat 2018-07-28 In memoriam, Charlie the cat, thank you little friend.) 2 | 3 | \get_key= 4 | (\key @\\loop \list 5 | list void \pair\list 6 | pair \this_key\\this_val 7 | eq key this_key this_val; 8 | loop list 9 | ) 10 | 11 | \del_key= 12 | (\key @\\loop \list 13 | list [] \pair\list 14 | pair \this_key\\this_val 15 | eq key this_key list; 16 | \list=(loop list) 17 | [pair;list] 18 | ) 19 | 20 | \put_key= 21 | (\key\val 22 | @\\loop \list 23 | list [{key val}] \pair\list 24 | pair \this_key\\this_val 25 | eq key this_key [{this_key val};list]; 26 | \list=(loop list) 27 | [pair;list] 28 | ) 29 | 30 | \push_key= 31 | (\key\val\list 32 | [{key val};list] 33 | ) 34 | 35 | \update_key= 36 | (\key\update @\\loop \list 37 | list 38 | ( 39 | \val=(update void) 40 | [{key val}] 41 | ) 42 | \pair\list 43 | pair \this_key\\this_val 44 | eq key this_key 45 | ( 46 | \val=(update this_val) 47 | [{this_key val};list] 48 | ); 49 | \list=(loop list) 50 | [pair;list] 51 | ) 52 | 53 | \add_key= 54 | (\key\val 55 | update_key key (\total is_defined total (+ total val) val) 56 | ) 57 | 58 | \update_values= 59 | (\update 60 | map 61 | (\pair 62 | pair \key\\val 63 | \val=(update key val) 64 | {key val} 65 | ) 66 | ) 67 | 68 | # (sort_pairs list) Sort the list of pairs by key. 69 | \sort_pairs=(sort_all (\p p \k\_ k)) 70 | 71 | \put_default= 72 | (\key\dval\list 73 | \val=(get_key key list) 74 | is_defined val list; 75 | [{key dval};list] 76 | ) 77 | 78 | \name_columns= 79 | (@\\loop\keys\vals 80 | keys [] \key\keys 81 | vals [] \val\vals 82 | \tail=(loop keys vals) 83 | [{key val};tail] 84 | ) 85 | 86 | \make_assoc= 87 | (\extract\xs 88 | \xs=(map (\x \k=(extract x) {k x}) xs) 89 | combine_keys (\x\_ x) xs # Keep the first. 90 | ) 91 | 92 | def ":" get_key; # Handy synonym 93 | def "get_key" get_key; 94 | def "del_key" del_key; 95 | def "put_key" put_key; 96 | def "push_key" push_key; 97 | def "update_key" update_key; 98 | def "add_key" add_key; 99 | def "update_values" update_values; 100 | def "sort_pairs" sort_pairs; 101 | def "put_default" put_default; 102 | def "name_columns" name_columns; 103 | def "make_assoc" make_assoc; 104 | std 105 | -------------------------------------------------------------------------------- /src/lib/bool.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \and=(\\x\\y x y F) 3 | \or=(\\x\\y x T y) 4 | \not=(\\x x F T) 5 | 6 | def "and" and; 7 | def "not" not; 8 | def "or" or; 9 | std 10 | -------------------------------------------------------------------------------- /src/lib/hex.fxl: -------------------------------------------------------------------------------- 1 | # Map number 0-15 to one hex digit (lower-case). 2 | \hex_digit= 3 | (\n 4 | lt n 10 (chr (+ 48 n)); 5 | chr (+ 97 (- n 10)) 6 | ) 7 | 8 | # Map number 0-255 to two hex digits. 9 | \hex_byte= 10 | (\n 11 | \hi=(trunc; / n 16) 12 | \lo=(mod n 16) 13 | . (hex_digit hi) (hex_digit lo) 14 | ) 15 | 16 | # Map digit "0"-"9" or "a"-"f" or "A"-"F" to a decimal number 0-15. 17 | \hex_digit_to_dec= 18 | (\ch 19 | \n=(ord ch) 20 | and (ge n 48) (le n 57) (- n 48); # 0-9 21 | and (ge n 97) (le n 102) (- n 87); # a-f 22 | and (ge n 65) (le n 70) (- n 55); # A-F 23 | void 24 | ) 25 | 26 | # XOR two hex digit strings together. 27 | \xor_hex= 28 | (\x\y 29 | \xl=(map hex_digit_to_dec; str_bytes x) 30 | \yl=(map hex_digit_to_dec; str_bytes y) 31 | \zl=(list_combine xor xl yl) 32 | \zl=(map hex_digit zl) 33 | to_str zl 34 | ) 35 | 36 | \oct= 37 | (\str 38 | fold 39 | (\z\byte 40 | \digit= 41 | ( 42 | \n=(ord byte) 43 | and (ge n 48) (le n 57) (- n 48); 44 | void 45 | ) 46 | + digit (* 8 z) 47 | ) 48 | 0 49 | (str_bytes str) 50 | ) 51 | 52 | \hex= 53 | (\str 54 | fold 55 | (\z\byte 56 | \digit= 57 | ( 58 | \n=(ord byte) 59 | and (ge n 48) (le n 57) (- n 48); 60 | and (ge n 97) (le n 102) (+ 10; - n 97); 61 | and (ge n 65) (le n 70) (+ 10; - n 65); 62 | void 63 | ) 64 | + digit (* 16 z) 65 | ) 66 | 0 67 | (str_bytes str) 68 | ) 69 | 70 | def "hex_digit" hex_digit; 71 | def "hex_byte" hex_byte; 72 | def "hex_digit_to_dec" hex_digit_to_dec; 73 | def "xor_hex" xor_hex; 74 | def "oct" oct; 75 | def "hex" hex; 76 | std 77 | -------------------------------------------------------------------------------- /src/lib/html.fxl: -------------------------------------------------------------------------------- 1 | # Quote a character for embedding in HTML. 2 | \quote_ch= 3 | (\ch 4 | eq ch "&" "&" ; 5 | eq ch ~ "~ """ ; 6 | eq ch "<" "<" ; 7 | eq ch ">" ">" ; 8 | ch 9 | ) 10 | 11 | # LATER 20181230 Accelerate the quote_str function in C. 12 | 13 | # Quote a string for embedding in HTML. 14 | \quote_str=(str_map quote_ch) 15 | 16 | # Quote arbitrary data. 17 | \quote= 18 | (@\\quote\x 19 | is_str x (quote_str x); 20 | is_num x x; 21 | is_tuple x (list_to_tuple; map quote; tuple_to_list x); 22 | is_list x (map quote x); 23 | is_bool x x; 24 | void 25 | ) 26 | 27 | \colgroup= 28 | (\widths 29 | say "" 30 | each widths (\width say [""]) 31 | say "" 32 | ) 33 | 34 | \tag_enclosure= 35 | (\desc 36 | \beg=(to_str desc) 37 | \pos=(search beg " " 0) 38 | \end=(is_good pos (slice beg 0 pos) beg) 39 | { beg end } 40 | ) 41 | 42 | \_tag= 43 | (\desc\\body 44 | tag_enclosure desc \beg\end 45 | put ["<" beg ">"] 46 | body 47 | put [""] 48 | ) 49 | 50 | \tag= 51 | (\desc\\body 52 | tag_enclosure desc \beg\end 53 | put ["<" beg ">"] 54 | ( 55 | eq end "td" I; 56 | eq end "th" I; 57 | eq end "a" I; 58 | nl 59 | ) 60 | body 61 | put [""] 62 | nl 63 | ) 64 | 65 | \tr=(tag "tr") 66 | 67 | \put_quote_data=(render_data (\x put (quote x))) 68 | 69 | # https://en.wikipedia.org/wiki/Percent-encoding 70 | \uri_escape= 71 | (str_map \ch 72 | 73 | eq ch " " "+"; # Special rule for space 74 | 75 | \is_reserved= 76 | ( 77 | eq ch "!" T; 78 | eq ch "*" T; 79 | eq ch "'" T; 80 | eq ch "(" T; 81 | eq ch ")" T; 82 | eq ch ";" T; 83 | eq ch ":" T; 84 | eq ch "@" T; 85 | eq ch "&" T; 86 | eq ch "=" T; 87 | eq ch "+" T; 88 | eq ch "$" T; 89 | eq ch "," T; 90 | eq ch "/" T; 91 | eq ch "?" T; 92 | eq ch "#" T; 93 | eq ch "[" T; 94 | eq ch "]" T; 95 | eq ch "%" T; 96 | eq ch "\" T; # Need this otherwise browser treats same as slash. 97 | eq ch QU T; # Need this for quotes in path names. 98 | eq ch NL T; 99 | eq ch CR T; 100 | F 101 | ) 102 | 103 | is_reserved 104 | (. "%" (hex_byte (ord ch))) 105 | ch 106 | ) 107 | 108 | \uri_unescape= 109 | (\str 110 | \buf=buf_new 111 | \source=(readstr str) 112 | 113 | @\\loop 114 | \ch=(sget source) 115 | is_undef ch (buf_get buf); 116 | eq ch "+" 117 | ( 118 | buf_put buf " " 119 | loop 120 | ); 121 | eq ch "%" 122 | ( 123 | \x=(hex_digit_to_dec (sget source)) 124 | \y=(hex_digit_to_dec (sget source)) 125 | buf_put buf (chr; + (* 16 x) y) 126 | loop 127 | ); 128 | buf_put buf ch 129 | loop 130 | ) 131 | 132 | \make_url= 133 | (\params 134 | \params= 135 | (map_good 136 | (\pair pair \key\val 137 | \val=(is_num val (num_str val) val) 138 | eq val "" void; 139 | \q_key=(uri_escape key) 140 | \q_val=(uri_escape val) 141 | [q_key"="q_val] 142 | ) 143 | params) 144 | 145 | \url=(join "&" params) 146 | \url=(eq url "" "." (. "?" url)) 147 | url 148 | ) 149 | 150 | def "quote_ch" quote_ch; 151 | def "quote" quote; 152 | def "colgroup" colgroup; 153 | def "_tag" _tag; 154 | def "tag" tag; 155 | def "tr" tr; 156 | def "put_quote_data" put_quote_data; 157 | def "uri_escape" uri_escape; 158 | def "uri_unescape" uri_unescape; 159 | def "make_url" make_url; 160 | std 161 | -------------------------------------------------------------------------------- /src/lib/indent.fxl: -------------------------------------------------------------------------------- 1 | # Format data in a nested indented format. 2 | 3 | # Return true if the item is a scalar. 4 | \is_scalar= 5 | (\x 6 | is_str x T; 7 | is_num x T; 8 | is_bool x T; 9 | is_undef x T; 10 | F 11 | ) 12 | 13 | # (i_render_data put nl x) 14 | # Render x in an indented format using the given output functions. 15 | \i_render_data= 16 | (\put\\nl 17 | 18 | \render= 19 | (@\\render\top_prefix\x 20 | 21 | is_str x (put (fexl_quote x)); 22 | is_num x (put (num_str x)); 23 | is_bool x (put (x "T" "F")); 24 | is_undef x (put "void"); 25 | 26 | \show_items= 27 | ( 28 | \loop_nested= 29 | (\prefix 30 | @\\loop\xs 31 | xs (nl put top_prefix) \x 32 | nl put prefix 33 | render prefix x 34 | loop 35 | ) 36 | 37 | \xs 38 | xs () \x 39 | is_scalar x 40 | ( 41 | render top_prefix x 42 | @\\loop\xs 43 | xs () \x 44 | is_scalar x 45 | ( 46 | put " " # Separator between scalars 47 | render top_prefix x 48 | loop 49 | ) 50 | ( 51 | \prefix=(. top_prefix " ") # Indent at non-scalar 52 | \xt 53 | loop_nested prefix [x;xt] 54 | ) 55 | ) 56 | ( 57 | \xt 58 | loop_nested top_prefix [x;xt] 59 | ) 60 | ) 61 | 62 | is_tuple x (put "{" show_items (tuple_to_list x) put "}"); 63 | is_list x (put "[" show_items x put "]"); 64 | 65 | put "?" 66 | ) 67 | 68 | \x 69 | render "" x nl 70 | ) 71 | 72 | \say_data=(i_render_data put nl) 73 | \fsay_data=(\fh i_render_data (fput fh) (fnl fh)) 74 | \trace_data=(fsay_data stderr) 75 | 76 | \i_as_str= 77 | (\x 78 | \buf=buf_new 79 | \put=(buf_put buf) 80 | i_render_data put (put NL) x 81 | buf_get buf 82 | ) 83 | 84 | def "i_render_data" i_render_data; 85 | def "say_data" say_data; 86 | def "fsay_data" fsay_data; 87 | def "trace_data" trace_data; 88 | def "i_as_str" i_as_str; 89 | std 90 | -------------------------------------------------------------------------------- /src/lib/main.fxl: -------------------------------------------------------------------------------- 1 | # (check x d) = x if x is good, otherwise d. 2 | \check=(\x is_defined x x) 3 | # (default d x) = x if x is good, otherwise d. 4 | \default=(\\d\x is_defined x x d) 5 | 6 | \path_under=(\dir\name . (. dir "/") name) 7 | 8 | # Establish paths based on command arguments. 9 | \dir_base=(dirname; dirname; argv 0) 10 | \script_name=(default ""; argv 1) 11 | 12 | \trace=(fsay stderr) 13 | \error=(\msg trace msg die) 14 | 15 | # Define key to refer to a context. 16 | \defc= # LATER 20240820 deprecated 17 | (\key\cx 18 | @\\self 19 | def key self; 20 | cx 21 | ) 22 | 23 | # Define some extra functions. 24 | \std= 25 | ( 26 | 27 | # (if x y) = y if x is true, otherwise I. 28 | \if=(\\x\\y x y I) 29 | 30 | \dir_local=(dirname script_name) 31 | 32 | \NL=" 33 | " 34 | \TAB=" " 35 | \CR=(chr 13) 36 | \LF=NL 37 | \QU=~ "~ 38 | 39 | \run_benchmark= 40 | (\\show\\f 41 | fexl_benchmark f \val\steps\bytes 42 | show ["steps "steps" bytes "bytes] 43 | val 44 | ) 45 | 46 | \do_benchmark=(run_benchmark trace) 47 | \show_benchmark=(run_benchmark say) 48 | 49 | # Use a file in the directory which contains the user's script. 50 | \use=(\name parse_file; path_under dir_local name) 51 | \load=(\name\cx extend cx; use name) 52 | 53 | def "defc" defc; 54 | def "if" if; 55 | def "use" use; 56 | def "load" load; 57 | 58 | def "check" check; 59 | def "default" default; 60 | 61 | def "path_under" path_under; 62 | def "dir_base" dir_base; 63 | def "dir_local" dir_local; 64 | 65 | def "trace" trace; 66 | def "error" error; 67 | 68 | def "TAB" TAB; 69 | def "NL" NL; 70 | def "CR" CR; 71 | def "LF" LF; 72 | def "QU" QU; 73 | 74 | def "do_benchmark" do_benchmark; 75 | def "show_benchmark" show_benchmark; 76 | std 77 | ) 78 | 79 | # Load libraries into the standard context. 80 | \dir_lib=(path_under dir_base "src/lib") 81 | \use=(\name parse_file; path_under dir_lib name) 82 | \load=(\name\cx extend cx; use name) 83 | 84 | defc "std"; 85 | def "use_lib" use; # LATER 20241018 deprecate 86 | load "read_ssv.fxl"; 87 | load "read_csv.fxl"; 88 | load "read.fxl"; 89 | load "run.fxl"; 90 | load "date.fxl"; 91 | load "time.fxl"; 92 | load "html.fxl"; 93 | load "hex.fxl"; 94 | load "assoc.fxl"; 95 | load "indent.fxl"; 96 | load "format.fxl"; 97 | load "list.fxl"; 98 | load "math.fxl"; 99 | load "bool.fxl"; 100 | std 101 | -------------------------------------------------------------------------------- /src/lib/math.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \neg=(- 0) 3 | \max=(\x\y gt x y x y) 4 | \min=(\x\y lt x y x y) 5 | 6 | # Compute x modulo n. 7 | \mod=(\x\n - x; * n; trunc; / x n) 8 | 9 | \tau=(* 2 pi) 10 | 11 | \round2=(\x / (round (* 100 x)) 100) 12 | 13 | # Greatest common denominator for non-negative numbers. 14 | \bn_gcd= 15 | (@\\bn_gcd\a\b 16 | bn_eq0 a b; 17 | bn_eq0 b a; 18 | bn_lt a b 19 | (bn_gcd a (bn_mod b a)) 20 | (bn_gcd b (bn_mod a b)) 21 | ) 22 | 23 | def "neg" neg; 24 | def "max" max; 25 | def "min" min; 26 | def "mod" mod; 27 | def "tau" tau; 28 | def "round2" round2; 29 | def "bn_gcd" bn_gcd; 30 | std 31 | -------------------------------------------------------------------------------- /src/lib/read.fxl: -------------------------------------------------------------------------------- 1 | # Skip matching characters. 2 | \skip_match= 3 | (\\is_match 4 | @\\loop 5 | is_match (skip loop); 6 | ) 7 | 8 | # Collect characters up to an ending condition. 9 | \collect_to= 10 | (\\is_end 11 | \buf=buf_new 12 | @\\loop 13 | is_end (buf_get buf); 14 | buf_keep buf 15 | loop 16 | ) 17 | 18 | \read_file=(\name read_stream (fopen name "r")) 19 | 20 | \read_chars= 21 | ( 22 | \flatten= 23 | ( 24 | \buf=buf_new 25 | @\\loop\\xs 26 | xs (buf_get buf) \x\xs 27 | buf_put buf x 28 | loop xs 29 | ) 30 | \xs 31 | read_stream (flatten xs) 32 | ) 33 | 34 | def "skip_match" skip_match; 35 | def "collect_to" collect_to; 36 | def "read_chars" read_chars; 37 | def "read_file" read_file; 38 | std 39 | -------------------------------------------------------------------------------- /src/lib/read_csv.fxl: -------------------------------------------------------------------------------- 1 | # Parse the CSV (comma-separated value) format. 2 | # NOTE: https://www.ietf.org/rfc/rfc4180.txt 3 | # "Spaces are considered part of a field and should not be ignored." 4 | \get_plain_item= 5 | (\sep 6 | collect_to 7 | ( 8 | at_ch sep T; 9 | at_eol T; 10 | at_eof T; 11 | F 12 | ) 13 | ) 14 | 15 | # Get a quoted item. A single QU char is treated as end of string. Two QU 16 | # chars in a row are treated as a single QU character which appears in the 17 | # string. 18 | \\get_quote_item= 19 | ( 20 | skip 21 | \buf=buf_new 22 | @\\loop 23 | at_ch QU 24 | ( 25 | skip 26 | at_ch QU 27 | ( 28 | buf_keep buf 29 | loop 30 | ) 31 | (buf_get buf) 32 | ); 33 | at_eof void; 34 | buf_keep buf 35 | loop 36 | ) 37 | 38 | \get_item= 39 | (\sep 40 | at_ch QU get_quote_item; 41 | at_eof void; 42 | get_plain_item sep 43 | ) 44 | 45 | \get_row= 46 | (\sep 47 | @\\loop 48 | \item=(get_item sep) 49 | is_undef item void; 50 | at_ch sep 51 | ( 52 | skip 53 | \row=loop 54 | is_undef row [item] [item;row] 55 | ) 56 | [item] 57 | ) 58 | 59 | \get_rows= 60 | (\sep 61 | @\\loop 62 | skip_match at_eol 63 | \row=(get_row sep) 64 | is_undef row []; 65 | \rows=loop 66 | [row;rows] 67 | ) 68 | 69 | \parse=(\read\sep\x read x (get_rows sep)) 70 | 71 | # Use arbitrary separator. 72 | \read_xsv_string=(parse read_stream) 73 | \read_xsv_chars=(parse read_chars) 74 | \read_xsv_file=(parse read_file) 75 | 76 | # comma-separated 77 | \read_csv_string=(read_xsv_string ",") 78 | \read_csv_chars=(read_xsv_chars ",") 79 | \read_csv_file=(read_xsv_file ",") 80 | 81 | # tab-separated 82 | \read_tsv_string=(read_xsv_string TAB) 83 | \read_tsv_chars=(read_xsv_chars TAB) 84 | \read_tsv_file=(read_xsv_file TAB) 85 | 86 | def "read_xsv_string" read_xsv_string; 87 | def "read_xsv_chars" read_xsv_chars; 88 | def "read_xsv_file" read_xsv_file; 89 | def "read_csv_string" read_csv_string; 90 | def "read_csv_chars" read_csv_chars; 91 | def "read_csv_file" read_csv_file; 92 | def "read_tsv_string" read_tsv_string; 93 | def "read_tsv_chars" read_tsv_chars; 94 | def "read_tsv_file" read_tsv_file; 95 | std 96 | -------------------------------------------------------------------------------- /src/lib/read_ssv.fxl: -------------------------------------------------------------------------------- 1 | # Parse the SSV (space-separated value) format. 2 | \\get_plain_item= 3 | ( 4 | collect_to 5 | ( 6 | at_white T; 7 | at_ch QU T; 8 | at_ch "~" T; 9 | at_eof T; 10 | F 11 | ) 12 | ) 13 | 14 | \\get_quote_item= 15 | ( 16 | skip 17 | \buf=buf_new 18 | collect_to_ch buf QU (buf_get buf) void 19 | ) 20 | 21 | \\get_tilde_item= 22 | ( 23 | \buf=buf_new 24 | eq 1 (collect_tilde_string buf) (buf_get buf) void 25 | ) 26 | 27 | \\get_item= 28 | ( 29 | at_eof void; 30 | at_ch QU get_quote_item; 31 | at_ch "~" get_tilde_item; 32 | at_eol (skip void); 33 | get_plain_item 34 | ) 35 | 36 | \\get_row= 37 | (@\\loop 38 | skip_match (at_eol F; at_white) 39 | \item=get_item 40 | is_undef item void; 41 | \row=loop 42 | is_undef row [item] [item;row] 43 | ) 44 | 45 | \\get_rows= 46 | (@\\loop 47 | skip_white 48 | \row=get_row 49 | is_undef row []; 50 | \rows=loop 51 | [row;rows] 52 | ) 53 | 54 | \parse=(\read\x read x get_rows) 55 | 56 | \read_ssv_string=(parse read_stream) 57 | \read_ssv_chars=(parse read_chars) 58 | \read_ssv_file=(parse read_file) 59 | 60 | def "read_ssv_string" read_ssv_string; 61 | def "read_ssv_chars" read_ssv_chars; 62 | def "read_ssv_file" read_ssv_file; 63 | std 64 | -------------------------------------------------------------------------------- /src/lib/run.fxl: -------------------------------------------------------------------------------- 1 | # Run a child function with the given input. Collect the stdout as it runs, 2 | # and collect the stderr after it terminates. Return the output, error, and 3 | # status. 4 | \run_function= 5 | (\\child_fn\\input 6 | spawn child_fn \child_in\child_out\child_err 7 | 8 | fput child_in input 9 | fclose child_in 10 | 11 | \out=(file_content child_out) 12 | 13 | \status 14 | \err=(file_content child_err) 15 | { out err status } 16 | ) 17 | 18 | # Run the function (exec argv). 19 | \run_program= 20 | (\argv 21 | run_function (exec argv) 22 | ) 23 | 24 | # Run a function with the given input, returning the output as a string. If 25 | # there was any error, show that on stderr and die. 26 | \run_function_filter= 27 | (\\child_fn\\input 28 | run_function child_fn input \out\err\status 29 | if (ne status 0) (error err) 30 | out 31 | ) 32 | 33 | # Run (exec argv) as a filter. 34 | \run_filter= 35 | (\argv 36 | run_function_filter (exec argv) 37 | ) 38 | 39 | # Grab the output of a function, passing in null input. 40 | \grab_output= 41 | (\\child_fn 42 | run_function_filter child_fn "" 43 | ) 44 | 45 | # LATER 20230425 Use a pid file instead, because if you're running the browser 46 | # on the same machine as the server, this can kill the browser too. 47 | \stop_server= 48 | (\ip\port 49 | \argv=["/usr/bin/lsof" (to_str ["-i4TCP@"ip":"port]) "-t"] 50 | \out=(run_function (exec argv) "" \out\err\status out) 51 | \list_pid=(map str_num; filter (ne ""); split NL out) 52 | 53 | each list_pid 54 | (\pid 55 | kill pid 2 # SIGINT 56 | ) 57 | ) 58 | 59 | \run_server= 60 | (\option\ip\port\error_log\\interact 61 | 62 | \\start_server=(start_server ip port error_log interact) 63 | \\stop_server=(stop_server ip port) 64 | 65 | \ok= 66 | ( 67 | is_void option F; 68 | eq option "start" T; 69 | eq option "stop" T; 70 | F 71 | ) 72 | 73 | if (not ok) (error ~ Please specify either "start" or "stop".~) 74 | 75 | stop_server 76 | if (eq option "start") start_server 77 | ) 78 | 79 | def "run_function" run_function; 80 | def "run_program" run_program; 81 | def "run_function_filter" run_function_filter; 82 | def "run_filter" run_filter; 83 | def "grab_output" grab_output; 84 | def "stop_server" stop_server; 85 | def "run_server" run_server; 86 | std 87 | -------------------------------------------------------------------------------- /src/lib/time.fxl: -------------------------------------------------------------------------------- 1 | # Split a microtime value into {s u}, where s is the whole number of seconds 2 | # and u is the whole number of microseconds. 3 | \split_microtime= 4 | (\x 5 | \s_len=(- (length x) 6) 6 | \s=(str_num; slice x 0 s_len) 7 | \u=(str_num; slice x s_len 6) 8 | {s u} 9 | ) 10 | 11 | # Compute x minus y, where those are microtime values, returning the result 12 | # in microseconds. 13 | \subtract_microtime= 14 | (\x\y 15 | split_microtime x \xs\xu 16 | split_microtime y \yx\yu 17 | + (* 1000000 (- xs yx)) (- xu yu) 18 | ) 19 | 20 | # Show elapsed time on a function evaluation. 21 | \show_microtime= 22 | (\label\\fn 23 | \t0=microtime 24 | put ["time "label" = "] fflush stdout 25 | \v=fn 26 | \t1=microtime 27 | \elapse=(subtract_microtime t1 t0) 28 | say [elapse" us"] 29 | v 30 | ) 31 | 32 | \trace_elapsed= 33 | (\\fn 34 | \t0=microtime 35 | \v=fn 36 | \t1=microtime 37 | \elapse=(/ (subtract_microtime t1 t0) 1000000) 38 | trace ["elapsed "elapse" s"] 39 | v 40 | ) 41 | 42 | def "split_microtime" split_microtime; 43 | def "subtract_microtime" subtract_microtime; 44 | def "show_microtime" show_microtime; 45 | def "trace_elapsed" trace_elapsed; 46 | std 47 | -------------------------------------------------------------------------------- /src/lib_build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # These are common shell routines used by build scripts, sourced with ".". 3 | # These build scripts do follow header dependencies. 4 | 5 | # stale $target $source1 ... $sourceN 6 | # Return 1 if $target does not exist or is older than any $source. 7 | stale() 8 | { 9 | local target="$1"; shift 10 | if [ ! -e $target ]; then return 1; fi 11 | for source in "$@"; do 12 | if [ $source -nt $target ]; then return 1; fi 13 | done 14 | return 0 15 | } 16 | 17 | # Run a system command and exit if unsuccessful. 18 | run() 19 | { 20 | if [ $verbose ]; then echo $@; fi 21 | $@ 22 | local code=$? 23 | if [ $code -ne 0 ]; then exit $code; fi 24 | } 25 | 26 | # Get the list of header files that a C source file includes. 27 | get_headers() 28 | { 29 | local name=$1 30 | local file_c=$name.c 31 | 32 | grep -e "^#include <.*>" $file_c | 33 | sed 's/^#include <\(.*\)>.*$/\1/' | 34 | ( 35 | while read file_h; do 36 | echo -n "$file_h " 37 | done; 38 | ) 39 | } 40 | 41 | # Push a name onto the list of objects. 42 | push() 43 | { 44 | objects="$objects $1" 45 | } 46 | 47 | # Compile a source file if it's newer than the object file. 48 | # 49 | # I compile with -O3 because that enables -finline-functions. You can see 50 | # that by running "gcc -c -Q -O3 --help=optimizers". 51 | # 52 | # I do not use -ansi because somehow that makes a bunch of symbols in various 53 | # system header files invisible (e.g. fdopen, snprintf, etc.) 54 | 55 | compile() 56 | { 57 | local name="$1" 58 | local options="$2" 59 | 60 | local file_o=../obj/$name.o 61 | push $file_o 62 | 63 | local file_c=$name.c 64 | 65 | # Make sure header cache file obj/$name.dep is up to date. 66 | local file_dep=../obj/$name.dep 67 | 68 | stale $file_dep $file_c 69 | if [ $? -eq 1 ]; then 70 | local headers="$(get_headers $name)" 71 | echo $headers >$file_dep 72 | fi 73 | 74 | stale $file_o $file_c 75 | local update=$? 76 | 77 | if [ $update -eq 0 ]; then 78 | local headers="$(cat $file_dep)" 79 | stale $file_o $headers 80 | update=$? 81 | fi 82 | 83 | if [ $update -eq 1 ]; then 84 | # Append common options. 85 | options="$options -Wall -Werror -Wunused-parameter" 86 | 87 | # NOTE: On an older machine I cannot use -pedantic because that forbids 88 | # unnamed structs/unions and C++ style comments. 89 | #options="$options -pedantic" 90 | 91 | # The next option enforces ISO C90 compatibility. 92 | options="$options -Wdeclaration-after-statement" 93 | 94 | # This option saves the .i and .s files along with the .o file. 95 | #options="$options -save-temps=obj" 96 | 97 | run gcc -c $options -O3 -I . $file_c -o $file_o 98 | fi 99 | } 100 | 101 | # Make a normal object file. 102 | make() 103 | { 104 | local name="$1" 105 | compile $name "" 106 | } 107 | 108 | # Link the object files if any is newer than the executable file. 109 | link() 110 | { 111 | local name="$1" 112 | local file_e=../bin/$name 113 | stale $file_e $objects 114 | if [ $? -eq 1 ]; then 115 | run gcc -s $objects -o $file_e 116 | fi 117 | objects="" 118 | } 119 | 120 | erase() 121 | { 122 | rm -rf ../obj 123 | rm -rf ../bin 124 | } 125 | 126 | case "$1" in 127 | "") ;; 128 | "clean") erase ;; 129 | "erase") erase; exit ;; 130 | *) 131 | echo >&2 "Usage: $0 [ clean | erase ]" 132 | exit 2 133 | ;; 134 | esac 135 | 136 | mkdir -p ../obj 137 | mkdir -p ../bin 138 | -------------------------------------------------------------------------------- /src/limit.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include // perror 6 | 7 | // Set the soft limit for a resource. 8 | static void set_limit(int resource, unsigned long n) 9 | { 10 | struct rlimit rlim; 11 | 12 | if (getrlimit(resource,&rlim) < 0) 13 | { 14 | perror("getrlimit"); 15 | die(0); 16 | } 17 | 18 | rlim.rlim_cur = n; 19 | 20 | if (setrlimit(resource,&rlim) < 0) 21 | { 22 | perror("setrlimit"); 23 | die(0); 24 | } 25 | } 26 | 27 | // Set the CPU time limit in seconds. 28 | void limit_time(unsigned long n) 29 | { 30 | set_limit(RLIMIT_CPU,n); 31 | } 32 | 33 | // Set the maximum size of the process stack in bytes. 34 | void limit_stack(unsigned long n) 35 | { 36 | set_limit(RLIMIT_STACK,n); 37 | } 38 | 39 | // Set the maximum size of the process' virtual memory (address space) in 40 | // bytes. 41 | void limit_memory(unsigned long n) 42 | { 43 | set_limit(RLIMIT_AS,n); 44 | } 45 | -------------------------------------------------------------------------------- /src/limit.h: -------------------------------------------------------------------------------- 1 | extern void limit_time(unsigned long n); 2 | extern void limit_stack(unsigned long n); 3 | extern void limit_memory(unsigned long n); 4 | -------------------------------------------------------------------------------- /src/memory.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | #include // malloc free 7 | 8 | // Track the amount of memory used so I can detect memory leaks. Normally this 9 | // is impossible but I check it anyway in case of software error. 10 | unsigned long cur_blocks = 0; 11 | unsigned long cur_bytes = 0; 12 | 13 | // Return a new span of memory of size num_bytes, or die if not possible. 14 | void *new_memory(unsigned long num_bytes) 15 | { 16 | if (num_bytes == 0) die("NEW0"); 17 | { 18 | void *data = malloc(num_bytes); 19 | if (data == 0) 20 | die("The program ran out of memory."); 21 | cur_blocks++; 22 | cur_bytes += num_bytes; 23 | return data; 24 | } 25 | } 26 | 27 | // Free a previously allocated span of memory. 28 | void free_memory(void *data, unsigned long num_bytes) 29 | { 30 | if (!data) die("NFREE"); 31 | if (cur_blocks == 0 || cur_bytes < num_bytes) 32 | die("XFREE"); 33 | 34 | free(data); 35 | cur_blocks--; 36 | cur_bytes -= num_bytes; 37 | } 38 | 39 | // Detect any final memory leak, which should never happen. 40 | void end_memory(void) 41 | { 42 | if (cur_blocks || cur_bytes) 43 | { 44 | fput(stderr,"LEAK"); 45 | fput(stderr," ");fput_ulong(stderr,cur_blocks); 46 | fput(stderr," ");fput_ulong(stderr,cur_bytes); 47 | die(""); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /src/memory.h: -------------------------------------------------------------------------------- 1 | extern unsigned long cur_blocks; 2 | extern unsigned long cur_bytes; 3 | extern void *new_memory(unsigned long num_bytes); 4 | extern void free_memory(void *data, unsigned long num_bytes); 5 | extern void end_memory(void); 6 | -------------------------------------------------------------------------------- /src/nacl.h: -------------------------------------------------------------------------------- 1 | extern void nacl_box_public(u8 *pk, const u8 *sk); 2 | extern void nacl_box_prepare(u8 *k, const u8 *pk, const u8 *sk); 3 | extern int nacl_box_seal(u8 *c, const u8 *m, u64 d, const u8 *n, const u8 *k); 4 | extern int nacl_box_open(u8 *m, const u8 *c, u64 d, const u8 *n, const u8 *k); 5 | extern void nacl_sign_public(u8 *pk, const u8 *sk); 6 | extern void nacl_sign_seal(u8 *sm, const u8 *m, u64 n, const u8 *pk, 7 | const u8 *sk); 8 | extern int nacl_sign_open(u8 *m, const u8 *sm, u64 mlen, const u8 *pk); 9 | -------------------------------------------------------------------------------- /src/out/a2: -------------------------------------------------------------------------------- 1 | \out= 2 | ~1 3 | Hello 4 | Type some lines of input and I'll echo them back. 5 | Press Ctrl-D to stop. 6 | ch = 'a' 7 | ch = 'b' 8 | ch = 'c' 9 | ch = ' 10 | ' 11 | ch = 'd' 12 | ch = 'e' 13 | ch = 'f' 14 | ch = 'g' 15 | ch = ' 16 | ' 17 | ch = ' 18 | ' 19 | ch = 'h' 20 | ch = 'i' 21 | ch = 'j' 22 | ch = ' 23 | ' 24 | ch = 'å' 25 | ch = 'a' 26 | ch = 'b' 27 | ch = 'c' 28 | ch = 'ü' 29 | ch = 'd' 30 | ch = 'e' 31 | ch = 'f' 32 | ch = ' 33 | ' 34 | ch = 'ü' 35 | ch = 'ä' 36 | ch = ' ' 37 | ch = '1' 38 | ch = '≠' 39 | ch = '0' 40 | ch = ' ' 41 | ch = '包' 42 | ch = '子' 43 | ch = ' 44 | ' 45 | Get from string [abcåabcüdef封x] 46 | ch = 'a' 47 | ch = 'b' 48 | ch = 'c' 49 | ch = 'å' 50 | ch = 'a' 51 | ch = 'b' 52 | ch = 'c' 53 | ch = 'ü' 54 | ch = 'd' 55 | ch = 'e' 56 | ch = 'f' 57 | ch = '封' 58 | ch = 'x' 59 | String to list [abcåabcüdef封x] 60 | [ 61 | a 62 | b 63 | c 64 | å 65 | a 66 | b 67 | c 68 | ü 69 | d 70 | e 71 | f 72 | 封 73 | x 74 | ] 75 | Show logical characters in [AOOab~åüää≠封小xyz] 76 | ch = 'A' 77 | ch = 'O' 78 | ch = 'O' 79 | ch = 'a' 80 | ch = 'b' 81 | ch = '~' 82 | ch = 'å' 83 | ch = 'ü' 84 | ch = 'ä' 85 | ch = 'ä' 86 | ch = '≠' 87 | ch = '封' 88 | ch = '小' 89 | ch = 'x' 90 | ch = 'y' 91 | ch = 'z' 92 | Show individual hex bytes in [AOOab~åüää≠封小xyz] 93 | ch = '41' 94 | ch = '4f' 95 | ch = '4f' 96 | ch = '61' 97 | ch = '62' 98 | ch = '7e' 99 | ch = 'c3' 100 | ch = 'a5' 101 | ch = 'c3' 102 | ch = 'bc' 103 | ch = 'c3' 104 | ch = 'a4' 105 | ch = 'c3' 106 | ch = 'a4' 107 | ch = 'e2' 108 | ch = '89' 109 | ch = 'a0' 110 | ch = 'e5' 111 | ch = 'b0' 112 | ch = '81' 113 | ch = 'e5' 114 | ch = 'b0' 115 | ch = '8f' 116 | ch = '78' 117 | ch = '79' 118 | ch = '7a' 119 | Good bye. 120 | ~1 121 | \err= 122 | ~ 123 | ~ 124 | \status=0 125 | -------------------------------------------------------------------------------- /src/out/a3: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | hello 4 | This goes to stdout. 5 | x = 7 6 | This goes to stdout. 7 | x = 7 8 | bye 9 | ~ 10 | \err= 11 | ~ 12 | This goes to stderr. 13 | x = 7 14 | This goes to stderr. 15 | x = 7 16 | ~ 17 | \status=0 18 | -------------------------------------------------------------------------------- /src/out/a4: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | [ 4 | ] 5 | steps 8000011 bytes 480 6 | ~ 7 | \err= 8 | ~ 9 | ~ 10 | \status=0 11 | -------------------------------------------------------------------------------- /src/out/a5: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | begin 4 | TALK 5 | TALK 6 | TALK 7 | TALK 8 | end 9 | ~ 10 | \err= 11 | ~ 12 | ~ 13 | \status=0 14 | -------------------------------------------------------------------------------- /src/out/a8: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | == test_rand 4 | [ 5 | get 6 | 0.927291684284476 7 | get 8 | 0.471201063818858 9 | get 10 | 0.677796232364046 11 | ] 12 | [ 13 | 0.927291684284476 14 | 0.471201063818858 15 | 0.677796232364046 16 | ] 17 | [ 18 | 0.927291684284476 19 | 0.471201063818858 20 | 0.677796232364046 21 | ] 22 | == test_readstr 23 | BEG 24 | END 25 | xs = !!!["a" "b" "c"] 26 | xs = ["a" "b" "c"] 27 | ~ 28 | \err= 29 | ~ 30 | ~ 31 | \status=0 32 | -------------------------------------------------------------------------------- /src/out/a9: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | == test_1 4 | PING 5 | == test_2 6 | PING 7 | PING 8 | PING 9 | PING 10 | PING 11 | == test_3 12 | PING 13 | PING 14 | PING 15 | == test_4 16 | PING 17 | pong 18 | PING 19 | PING 20 | PING 21 | ~ 22 | \err= 23 | ~ 24 | ~ 25 | \status=0 26 | -------------------------------------------------------------------------------- /src/out/b10: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | [ get 23 get 61 get 62 get 63 get 64 get 65 get 66 get 67 get 68 get 69 get 6a get 6b get 6c get 6d get 6e get 6f ] 4 | [ 23 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f ] 5 | [ 23 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f ] 6 | 7 | [ get 70 get 71 get 72 get 73 get 74 get 75 get 76 get 77 get 78 get 79 get 7a get 0a get 23 get 61 get 62 get 63 ] 8 | [ 70 71 72 73 74 75 76 77 78 79 7a 0a 23 61 62 63 ] 9 | [ 70 71 72 73 74 75 76 77 78 79 7a 0a 23 61 62 63 ] 10 | 11 | get get get get get get get get get get get get get get get get 6465666768696a6b6c6d6e6f70717273 12 | 6465666768696a6b6c6d6e6f70717273 13 | 6465666768696a6b6c6d6e6f70717273 14 | 15 | get get get get get get get get get get get get get get get get 7475767778797a0a2361626364656667 16 | 7475767778797a0a2361626364656667 17 | 7475767778797a0a2361626364656667 18 | 19 | ~ 20 | \err= 21 | ~ 22 | ~ 23 | \status=0 24 | -------------------------------------------------------------------------------- /src/out/b12: -------------------------------------------------------------------------------- 1 | \out= 2 | ~3 3 | == test_csv 4 | [] 5 | [ 6 | [" -11.36" "12"] 7 | ["21" "22"] 8 | ["31" "32"] 9 | ["41" "42" "" "" ""] 10 | ["51" "52"] 11 | ["a b" "cd"] 12 | [~ ab c"hi"~ "3.14"] 13 | ["6"] 14 | ["33"] 15 | ] 16 | [ 17 | ["x"] 18 | ] 19 | [] 20 | [] 21 | [ 22 | ["a"] 23 | ] 24 | [ 25 | [~ a"b~] 26 | ] 27 | [ 28 | [~ a"~] 29 | ] 30 | [ 31 | [""] 32 | ] 33 | [ 34 | ["a"] 35 | ] 36 | [ 37 | ["a"] 38 | ] 39 | [ 40 | ["ab" "c"] 41 | ] 42 | [ 43 | ["12" "3" "" "4"] 44 | ["5" "6" "7"] 45 | [~ a b 46 | "hi" 47 | cd~ "3.14" "-48.7"] 48 | [~ abc,def"ghi"jklmnopqrstuvwxyz~] 49 | [" "] 50 | ] 51 | [ 52 | ["12" "3" "" "4"] 53 | ["5" "6" "7"] 54 | [~ a b 55 | "hi" 56 | cd~ "3.14" "-48.7"] 57 | [~ abc,def"ghi"jklmnopqrstuvwxyz~] 58 | [" "] 59 | ] 60 | == test_tsv 61 | [ 62 | ["12" "3" "" "4"] 63 | ["5" "6" "7"] 64 | [~ a b 65 | "hi" 66 | cd~ "3.14" "-48.7"] 67 | [~ abc,def"ghi"jklmnopqrstuvwxyz~] 68 | [" "] 69 | ] 70 | == test_ssv 71 | [] 72 | [ 73 | ["ab" "xzz" "d" "e" "f"] 74 | ["g" "hi"] 75 | ] 76 | [ 77 | ["ab" "c" "q"] 78 | ["d"] 79 | ] 80 | [ 81 | ["ab" "c"] 82 | ["x" "y"] 83 | ["z"] 84 | ] 85 | [ 86 | ["a" "x"] 87 | ["bc"] 88 | ["de" "f"] 89 | ] 90 | [ 91 | ["abcd"] 92 | ] 93 | [ 94 | ["a" "b" "xy" "z"] 95 | ["d" "d"] 96 | ] 97 | [ 98 | ["a" "bc"] 99 | ["d"] 100 | ] 101 | [ 102 | ["ab" "c d" "e" ~ f"g"h~ "ij" ~2 k"l"m~1n~2 "o" "p" "q" "r" "s"] 103 | ["tuv"] 104 | ] 105 | [ 106 | ["a" "b"] 107 | ] 108 | [ 109 | ["a"] 110 | ] 111 | [ 112 | ["a"] 113 | ] 114 | [] 115 | [] 116 | [] 117 | [] 118 | [ 119 | ["ab" "xzz" "d" "e" "f"] 120 | ["g" "hi"] 121 | ["ab" "c"] 122 | ["x" "y"] 123 | ["z"] 124 | ["a" "x"] 125 | ["a" "b" "c d" "e" ~ f"gh"~ "ij" ~2 k"l"m~1n~2 "o" "p" "q" "r" "s"] 126 | ["tuv"] 127 | ["a bb c" ~ x"y"z~ "21" "38.3" "-44"] 128 | ["aaaa" "Block of text here. 129 | Second line. 130 | " "another block 131 | second line"] 132 | ["1" "2" "3"] 133 | ["~a~ab~abc~abcd"] 134 | ] 135 | [ 136 | ["abcd~ABA" "x"] 137 | ["AAB~ABC" "y"] 138 | ] 139 | [ 140 | ["ab" "xzz" "d" "e" "f"] 141 | ["g" "hi"] 142 | ["ab" "c"] 143 | ["x" "y"] 144 | ["z"] 145 | ["a" "x"] 146 | ["a" "b" "c d" "e" ~ f"gh"~ "ij" ~2 k"l"m~1n~2 "o" "p" "q" "r" "s"] 147 | ["tuv"] 148 | ["a bb c" ~ x"y"z~ "21" "38.3" "-44"] 149 | ["aaaa" "Block of text here. 150 | Second line. 151 | " "another block 152 | second line"] 153 | ["1" "2" "3"] 154 | ["~a~ab~abc~abcd"] 155 | ] 156 | void 157 | == test_xsv 158 | [ 159 | ["12" "3" "" "4"] 160 | ["5" "6" "7"] 161 | [~ a b 162 | "hi" 163 | cd~ "3.14" "-48.7"] 164 | [~ abc|def"ghi"jklmnopqrstuvwxyz~] 165 | [" "] 166 | ] 167 | steps 35362 bytes 7168 168 | ~3 169 | \err= 170 | ~ 171 | ~ 172 | \status=0 173 | -------------------------------------------------------------------------------- /src/out/b13: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | == test_full 4 | name say : T 5 | name is_defined : T 6 | name std : T 7 | name + : T 8 | name @ : T 9 | name def : T 10 | name if : T 11 | name each : T 12 | name div : T 13 | name show_list : T 14 | name parse_file : T 15 | name use : T 16 | name void : T 17 | name dirname : T 18 | name hex_digit : T 19 | name read_ssv_file : T 20 | name read_csv_file : T 21 | name 2.5 : F 22 | name 0 : F 23 | name -3.56 : F 24 | name -3.56e-4 : F 25 | name -3.56e-4x : F 26 | name x : F 27 | == test_restricted 28 | name say : T 29 | name is_defined : T 30 | name std : F 31 | name + : F 32 | name @ : F 33 | name def : F 34 | name if : F 35 | name each : F 36 | name div : F 37 | name show_list : F 38 | name parse_file : F 39 | name use : F 40 | name void : F 41 | name dirname : F 42 | name hex_digit : F 43 | name read_ssv_file : F 44 | name read_csv_file : F 45 | name 2.5 : F 46 | name 0 : F 47 | name -3.56 : F 48 | name -3.56e-4 : F 49 | name -3.56e-4x : F 50 | name x : F 51 | == test_run_restricted 52 | I am Fred. 53 | 0.927291684284476 54 | 0.471201063818858 55 | I am Wilma. 56 | ~ 57 | \err= 58 | ~ 59 | ~ 60 | \status=0 61 | -------------------------------------------------------------------------------- /src/out/b14: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | directory src/lib 4 | [ 5 | assoc.fxl 6 | bool.fxl 7 | date.fxl 8 | format.fxl 9 | hex.fxl 10 | html.fxl 11 | indent.fxl 12 | list.fxl 13 | main.fxl 14 | math.fxl 15 | read.fxl 16 | read_csv.fxl 17 | read_ssv.fxl 18 | run.fxl 19 | time.fxl 20 | ] 21 | Created test/vector 22 | open (pos 0) 23 | seek_set 0 (pos 0) 24 | truncate 100 (pos 0) 25 | seek_set 10 (pos 10) 26 | write 26 bytes "abcdefghijklmnopqrstuvwxyz" (pos 36) 27 | seek_cur -3 (pos 33) 28 | write 3 bytes "XYZ" (pos 36) 29 | seek_end -20 (pos 80) 30 | write 5 bytes "12345" (pos 85) 31 | seek_set 10 (pos 10) 32 | read 16 bytes "abcdefghijklmnop" (pos 26) 33 | read 0 bytes "" (pos 26) 34 | read 10 bytes "qrstuvwXYZ" (pos 36) 35 | seek_end -3 (pos 97) 36 | write 3 bytes "ABC" (pos 100) 37 | seek_end -3 (pos 97) 38 | read 3 bytes "ABC" (pos 100) 39 | Removed test/vector 40 | = file 41 | get # 42 | get a 43 | at b 44 | at b 45 | get b 46 | get c 47 | at d 48 | get d 49 | at e 50 | at e 51 | get e 52 | get f 53 | get g 54 | at h 55 | = str 56 | get # 57 | get a 58 | at b 59 | at b 60 | get b 61 | get c 62 | at d 63 | get d 64 | at e 65 | at e 66 | get e 67 | get f 68 | get g 69 | at h 70 | ~ 71 | \err= 72 | ~ 73 | ~ 74 | \status=0 75 | -------------------------------------------------------------------------------- /src/out/b15: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | = test_0249 4 | index: 5 | [ 6 | {T "" "9972"} 7 | {T "a" "6870"} 8 | {F "bc" 9 | [ 10 | {F "bccc" 11 | [ 12 | {T "bccc" "5233"} 13 | {T "bcccda" "1618"} 14 | {F "bcccxyz" 15 | [ 16 | {T "bcccxyz" "3364"} 17 | {F "bcccxyza" 18 | [ 19 | {T "bcccxyza" "4610"} 20 | {T "bcccxyzabc" "3291"} 21 | ] 22 | } 23 | {T "bcccxyzb" "2173"} 24 | ] 25 | } 26 | ] 27 | } 28 | {T "bcda" "0724"} 29 | {T "bcqr" "1889"} 30 | ] 31 | } 32 | {T "d" "1974"} 33 | ] 34 | pairs: 35 | [ 36 | {"" "9972"} 37 | {"a" "6870"} 38 | {"bccc" "5233"} 39 | {"bcccda" "1618"} 40 | {"bcccxyz" "3364"} 41 | {"bcccxyza" "4610"} 42 | {"bcccxyzabc" "3291"} 43 | {"bcccxyzb" "2173"} 44 | {"bcda" "0724"} 45 | {"bcqr" "1889"} 46 | {"d" "1974"} 47 | ] 48 | delete: 49 | [ 50 | {T "abcdefg" "6674"} 51 | ] 52 | = test_5437 53 | pairs: GOOD 54 | get: GOOD 55 | = test_8924 56 | pairs: GOOD 57 | get: GOOD 58 | = test_3650 59 | pairs: GOOD 60 | get: GOOD 61 | = test_6051 62 | before delete: 63 | [ 64 | {T "" "3785"} 65 | {F "a" 66 | [ 67 | {F "aa" 68 | [ 69 | {T "aa" "8060"} 70 | {F "aaa" 71 | [ 72 | {T "aaaabc" "9114"} 73 | {F "aaabc" 74 | [ 75 | {T "aaabcc" "2014"} 76 | {T "aaabcd" "7679"} 77 | ] 78 | } 79 | {T "aaacde" "3161"} 80 | ] 81 | } 82 | ] 83 | } 84 | {F "abc" 85 | [ 86 | {T "abc" "7010"} 87 | {F "abcd" 88 | [ 89 | {T "abcd" "2936"} 90 | {F "abcde" 91 | [ 92 | {T "abcde" "7596"} 93 | {F "abcdef" 94 | [ 95 | {T "abcdef" "2039"} 96 | {T "abcdefg" "0825"} 97 | ] 98 | } 99 | ] 100 | } 101 | ] 102 | } 103 | ] 104 | } 105 | ] 106 | } 107 | {F "bba" 108 | [ 109 | {T "bba" "1569"} 110 | {F "bbab" 111 | [ 112 | {T "bbabc" "4682"} 113 | {T "bbabd" "1863"} 114 | ] 115 | } 116 | {F "bbac" 117 | [ 118 | {T "bbac" "8261"} 119 | {F "bbacd" 120 | [ 121 | {T "bbacd" "1553"} 122 | {T "bbacde" "6455"} 123 | {T "bbacdf" "3986"} 124 | ] 125 | } 126 | {T "bbacef" "9370"} 127 | ] 128 | } 129 | ] 130 | } 131 | {F "ca" 132 | [ 133 | {T "cab" "1546"} 134 | {F "cac" 135 | [ 136 | {T "cac" "7869"} 137 | {T "cacd" "1055"} 138 | ] 139 | } 140 | ] 141 | } 142 | {T "e" "1067"} 143 | ] 144 | pairs: 145 | [ 146 | {"" "3785"} 147 | {"aa" "8060"} 148 | {"aaaabc" "9114"} 149 | {"aaabcc" "2014"} 150 | {"aaabcd" "7679"} 151 | {"aaacde" "3161"} 152 | {"abc" "7010"} 153 | {"abcd" "2936"} 154 | {"abcde" "7596"} 155 | {"abcdef" "2039"} 156 | {"abcdefg" "0825"} 157 | {"bba" "1569"} 158 | {"bbabc" "4682"} 159 | {"bbabd" "1863"} 160 | {"bbac" "8261"} 161 | {"bbacd" "1553"} 162 | {"bbacde" "6455"} 163 | {"bbacdf" "3986"} 164 | {"bbacef" "9370"} 165 | {"cab" "1546"} 166 | {"cac" "7869"} 167 | {"cacd" "1055"} 168 | {"e" "1067"} 169 | ] 170 | 171 | after delete: 172 | [ 173 | {F "bba" 174 | [ 175 | {T "bba" "1569"} 176 | {F "bbab" 177 | [ 178 | {T "bbabc" "4682"} 179 | {T "bbabd" "1863"} 180 | ] 181 | } 182 | {T "bbacef" "9370"} 183 | ] 184 | } 185 | {T "cac" "7869"} 186 | ] 187 | pairs: 188 | [ 189 | {"bba" "1569"} 190 | {"bbabc" "4682"} 191 | {"bbabd" "1863"} 192 | {"bbacef" "9370"} 193 | {"cac" "7869"} 194 | ] 195 | 196 | = test_3215 197 | pairs: GOOD 198 | get: GOOD 199 | = test_0236 200 | pairs: GOOD 201 | get: GOOD 202 | = test_3517 203 | pairs: GOOD 204 | get: GOOD 205 | = test_2744 206 | [ 207 | {"d" "1974" void} 208 | {"bccc" "5233" "9999"} 209 | {"bcccxyz" "3364" void} 210 | ] 211 | steps 1224407 bytes 401664 212 | ~ 213 | \err= 214 | ~ 215 | ~ 216 | \status=0 217 | -------------------------------------------------------------------------------- /src/out/b16: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | = test_gpg_sha256 4 | result "E3B0C442 98FC1C14 9AFBF4C8 996FB924 27AE41E4 649B934C A495991B 7852B855" 5 | result "CA978112 CA1BBDCA FAC231B3 9A23DC4D A786EFF8 147C4E72 B9807785 AFEE48BB" 6 | result "BA7816BF 8F01CFEA 414140DE 5DAE2223 B00361A3 96177A9C B410FF61 F20015AD" 7 | result "248D6A61 D20638B8 E5C02693 0C3E6039 A33CE459 64FF2167 F6ECEDD4 19DB06C1" 8 | result "87CDEB38 0917879F CD4C3B86 9AD644CB C7CBC6FF 36B989CD 4FE0F812 3C13CA19" 9 | result "8169C725 EDD39F00 140FFCF5 7C45B9C5 143E2FFE 375869E4 CF280534 2715D2B1" 10 | result "FCC01087 70388F35 2679507F FCF73B79 716E81FF 5C20F9BF 5257AF73 7D001514" 11 | result "CDC76E5C 9914FB92 81A1C7E2 84D73E67 F1809A48 A497200E 046D39CC C7112CD0" 12 | ~ 13 | \err= 14 | ~ 15 | ~ 16 | \status=0 17 | -------------------------------------------------------------------------------- /src/out/b17: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | [ test_run_function 4 | out: 5 | [ 6 | hello 7 | x = 123 8 | bye 9 | ] 10 | err: 11 | [ 12 | complain 1 13 | complain 2 14 | ] 15 | status: good 16 | 17 | out: 18 | [ 19 | ] 20 | err: 21 | [ 22 | ] 23 | status: good 24 | 25 | out: 26 | [ 27 | hello 28 | ] 29 | err: 30 | [ 31 | oops 32 | ] 33 | status: fail 34 | 35 | out: 36 | [ 37 | ] 38 | err: 39 | [ 40 | The program ran out of memory. 41 | ] 42 | status: fail 43 | 44 | ] 45 | [ test_run_program 46 | out: 47 | [ 48 | hello 49 | x = 11703 50 | ] 51 | err: 52 | [ 53 | complain 54 | oops 55 | ] 56 | status: fail 57 | 58 | out: 59 | [ 60 | BEG 61 | END 62 | ] 63 | err: 64 | [ 65 | complain 66 | ] 67 | status: good 68 | 69 | ] 70 | [ test_big_output 71 | grabbed 200000 bytes 72 | ] 73 | ~ 74 | \err= 75 | ~ 76 | ~ 77 | \status=0 78 | -------------------------------------------------------------------------------- /src/out/b18: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | == benchmark nested 4 | inner: val 479 steps 8 bytes 96 5 | outer: val 479 steps 36 bytes 608 6 | == benchmark large list 7 | result: val 32768 steps 655606 bytes 1049696 8 | == benchmark negative memory usage 9 | result: val steps 2 bytes -9 10 | ~ 11 | \err= 12 | ~ 13 | ~ 14 | \status=0 15 | -------------------------------------------------------------------------------- /src/out/b19: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | {"7d13f23fa2b9a6fd" "1ba471e78e7bc03a"} 4 | {"7d13f23fa2b9a6fd" "ffff"} 5 | {"7d13f23fa2b9a6fd" "aaaaffff"} 6 | first = {"0000c12dede9cee5" "594e7168faab41af"} 7 | last = {"fff3334732f995ec" "d7a35717e00068d1"} 8 | = group_items 9 | xs = ["A" "b" "c" "b" "a" "a" "a" "B" "c" "d" "C" "b" "a" "a"] 10 | ys = [{"a" ["A" "a" "a" "a" "a" "a"]} {"b" ["b" "b" "B" "b"]} {"c" ["c" "c" "C"]} {"d" ["d"]}] 11 | = merge_keys 12 | xs = [{"a" 1} {"b" 2} {"d" 4} {"g" 7}] 13 | ys = [{"a" -1} {"c" -3} {"d" -4} {"e" -5} {"f" -6}] 14 | L = [{"b" 2} {"g" 7}] 15 | M = [{"a" {1 -1}} {"d" {4 -4}}] 16 | R = [{"c" -3} {"e" -5} {"f" -6}] 17 | = map_bytes_to_double 18 | [0 0 0 0 0 0 0] => 0 19 | [255 255 255 255 255 255 63] => 0.25 20 | [255 255 255 255 255 255 127] => 0.5 21 | [27 220 180 171 62 7 156] => 0.609485546989945 22 | [255 255 255 255 255 255 191] => 0.75 23 | [193 214 112 19 131 147 234] => 0.916313354727062 24 | [255 255 255 255 255 255 255] => 1 25 | steps 3517800 bytes 2888416 26 | ~ 27 | \err= 28 | ~ 29 | ~ 30 | \status=0 31 | -------------------------------------------------------------------------------- /src/out/b20: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | = test add 4 | x = 0 5 | y = 0 6 | z = 0 7 | 8 | x = 1 9 | y = 1 10 | z = 2 11 | 12 | x = 10002 13 | y = 10003 14 | z = 20005 15 | 16 | x = 12370356088 17 | y = 15123 18 | z = 12370371211 19 | 20 | x = 123470356088 21 | y = 15123 22 | z = 123470371211 23 | 24 | x = 26019123470356088 25 | y = 1049752133674165355933 26 | z = 1049778152797635712021 27 | 28 | x = 999999999999999999999999 29 | y = 999999999999999999999999 30 | z = 1999999999999999999999998 31 | 32 | x = 1111111111111111111111111111111111111111111111111 33 | y = 1111111111111111111111111111111111111111111111111 34 | z = 2222222222222222222222222222222222222222222222222 35 | 36 | = test mul 37 | x = 0 38 | y = 0 39 | z = 0 40 | 41 | x = 1 42 | y = 1 43 | z = 1 44 | 45 | x = 10002 46 | y = 10003 47 | z = 100050006 48 | 49 | x = 12370356088 50 | y = 15123 51 | z = 187076895118824 52 | 53 | x = 123470356088 54 | y = 15123 55 | z = 1867242195118824 56 | 57 | x = 26019123470356088 58 | y = 1049752133674165355933 59 | z = 27313630379337857282992990240773470104 60 | 61 | x = 999999999999999999999999 62 | y = 999999999999999999999999 63 | z = 999999999999999999999998000000000000000000000001 64 | 65 | x = 1111111111111111111111111111111111111111111111111 66 | y = 1111111111111111111111111111111111111111111111111 67 | z = 1234567901234567901234567901234567901234567901234320987654320987654320987654320987654320987654321 68 | 69 | 115792089237316195423570985008687907853269984665640564039457584007913129639936 70 | 78 71 | = test convert 72 | "0" "0" 73 | "1" "1" 74 | "1234" "1234" 75 | "9999" "9999" 76 | "00" "0" 77 | "1234567890123456789012" "1234567890123456789012" 78 | "1234567890" "1234567890" 79 | "000000123" "123" 80 | "" "0" 81 | "x" "0" 82 | "x1234" "0" 83 | "12345abc90123456789012" "12345" 84 | 85 | steps 2097 bytes 4256 86 | ~ 87 | \err= 88 | ~ 89 | ~ 90 | \status=0 91 | -------------------------------------------------------------------------------- /src/out/b21: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | === Test new rules for numeric constants 4 | = test good 5 | str_num "0" = 0 6 | str_num "-0" = -0 7 | str_num "123.4567" = 123.4567 8 | str_num "0123.4567" = 123.4567 9 | str_num "00123.4567" = 123.4567 10 | str_num "-00123.4567" = -123.4567 11 | str_num "0.5" = 0.5 12 | str_num ".5" = 0.5 13 | str_num "-.5" = -0.5 14 | str_num "+.5" = 0.5 15 | str_num "-.5e-2" = -0.005 16 | str_num "-.567E-2" = -0.00567 17 | str_num "-.567E+2" = -56.7 18 | str_num "-.567E2" = -56.7 19 | str_num "+.567E2" = 56.7 20 | str_num "-3.6" = -3.6 21 | str_num "+3.6" = 3.6 22 | str_num "+3." = 3 23 | str_num "+3" = 3 24 | str_num "+0" = 0 25 | 26 | = test bad 27 | str_num "" = void 28 | str_num "." = void 29 | str_num "-" = void 30 | str_num "+" = void 31 | str_num "--" = void 32 | str_num "-+" = void 33 | str_num "+-" = void 34 | str_num "+." = void 35 | str_num "4.8 5" = void 36 | str_num " 4.8" = void 37 | str_num "4.8 " = void 38 | str_num "-+3.6" = void 39 | str_num "+-3.6" = void 40 | str_num "-2.3x" = void 41 | str_num "3.6x" = void 42 | str_num "3.6 " = void 43 | str_num "inf" = void 44 | str_num "nan" = void 45 | str_num "-inf" = void 46 | str_num "-nan" = void 47 | 48 | ~ 49 | \err= 50 | ~ 51 | ~ 52 | \status=0 53 | -------------------------------------------------------------------------------- /src/out/b22: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | == test Fibonacci 4 | == 5 | fib 8 = 21 6 | fib 7 = 13 7 | fib 6 = 8 8 | fib 5 = 5 9 | fib 4 = 3 10 | fib 3 = 2 11 | fib 2 = 1 12 | fib 1 = 1 13 | fib 0 = 0 14 | == 15 | fib 54 = 86267571272 16 | fib 55 = 139583862445 17 | fib 56 = 225851433717 18 | fib 57 = 365435296162 19 | fib 58 = 591286729879 20 | fib 59 = 956722026041 21 | fib 60 = 1548008755920 22 | fib 61 = 2504730781961 23 | fib 62 = 4052739537881 24 | fib 63 = 6557470319842 25 | fib 64 = 10610209857723 26 | fib 65 = 17167680177565 27 | fib 66 = 27777890035288 28 | fib 67 = 44945570212853 29 | fib 68 = 72723460248141 30 | fib 69 = 117669030460994 31 | fib 70 = 190392490709135 32 | fib 71 = 308061521170129 33 | fib 72 = 498454011879264 34 | fib 73 = 806515533049393 35 | steps 3236 bytes 18944 36 | ~ 37 | \err= 38 | ~ 39 | ~ 40 | \status=0 41 | -------------------------------------------------------------------------------- /src/out/b23: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | ~ 4 | \err= 5 | ~ 6 | ~ 7 | \status=0 8 | -------------------------------------------------------------------------------- /src/out/b24: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | hi 4 | ~ 5 | \err= 6 | ~ 7 | ~ 8 | \status=1 9 | -------------------------------------------------------------------------------- /src/out/b44: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | 4 | steps 1900011 bytes 992 5 | 6 | steps 1900012 bytes 1056 7 | ~ 8 | \err= 9 | ~ 10 | ~ 11 | \status=0 12 | -------------------------------------------------------------------------------- /src/out/b45: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | = test_1 4 | x => 1 5 | 3 => whatever 6 | y => 2 7 | !q => qq 8 | z => z 9 | 10 | x => 1 11 | 3 => whatever 12 | y => 2 13 | !q => qq 14 | z => z 15 | 16 | x => 1 17 | 3 => whatever 18 | y => 2 19 | !q => qq 20 | z => z 21 | 22 | = test_2 23 | !==== 24 | with "x" 1; 25 | with "y" 2; 26 | with 3 "whatever"; 27 | with "q" "qq"; 28 | with "obj" 29 | ( 30 | with "a" 11; 31 | with "b" 22; 32 | with "c" ?; 33 | void 34 | ); 35 | with "list" 36 | [ 37 | 2 38 | "abc" 39 | void 40 | ( 41 | with "a" 47; 42 | with "b" 82; 43 | void 44 | ) 45 | ]; 46 | with "flag" T; 47 | with "tuple" 48 | { 49 | "a" 50 | 2 51 | [ 52 | { 53 | "c" 54 | 3 55 | } 56 | { 57 | "d" 58 | 4 59 | } 60 | ] 61 | ( 62 | with "x" 3; 63 | void 64 | ) 65 | }; 66 | ? 67 | ==== 68 | 2 69 | ==== 70 | "whatever" 71 | ==== 72 | with "a" 11; 73 | with "b" 22; 74 | with "c" ?; 75 | void 76 | ==== 77 | [ 78 | 2 79 | "abc" 80 | void 81 | ( 82 | with "a" 47; 83 | with "b" 82; 84 | void 85 | ) 86 | ] 87 | ==== 88 | "z" 89 | ==== 90 | 22 91 | ==== 92 | void 93 | ==== 94 | void 95 | steps 2868 bytes 4768 96 | ~ 97 | \err= 98 | ~ 99 | ~ 100 | \status=0 101 | -------------------------------------------------------------------------------- /src/out/b46: -------------------------------------------------------------------------------- 1 | \out= 2 | ~1 3 | [ 4 | {"0793" F "1b03" -0.00626248} 5 | {"5ac2" F "8ea2" 354.786772998} 6 | [ 7 | {"754b" F "5355" -298.39702075} 8 | {"93cf" 9 | [T F "47fd" 10 | {0.5 0.7} 11 | ] 12 | } 13 | ["a" "b" 14 | ["44f0" F void 0.16087] 15 | [ 16 | {"892a" T "b66f" 0.1509} 17 | {"08c4" F "26cd" -277.02636296} 18 | ] 19 | {"3773" T "eaaf" 0.47} 20 | {"f6c5" F "bbac" -862.881225} 21 | ] 22 | {"da65" F "40c7" -271.33529785} 23 | {"1ab2" F "1a75" 0.14143} 24 | ] 25 | {"04fc" F "9870" 0.08} 26 | {"5149" F "aec0" -146.35314} 27 | {"a" 28 | ["b" "c"] 29 | "d" 30 | } 31 | ] 32 | T 33 | length = 442 34 | == 35 | [{"a
b&e" "c" 3 ~ "hey"~} {"409b" F "9f11" -0.00626248} {"f092" T "a9&5" 354.786772998} void ["a" "b" "c" {2 4} 7 [1 {2 3} 4]]] 36 | == 37 | [ 38 | {"a<br>b&e" "c" 3 ""hey""} 39 | {"409b" F "9f11" -0.00626248} 40 | {"f092" T "a9&5" 354.786772998} 41 | void 42 | ["a" "b" "c" 43 | {2 4} 44 | 7 45 | [1 46 | {2 3} 47 | 4 48 | ] 49 | ] 50 | ] 51 | == 52 | [{"a<br>b&e" "c" 3 ~ "hey"~} {"409b" F "9f11" -0.00626248} {"f092" T "a9&5" 354.786772998} void ["a" "b" "c" {2 4} 7 [1 {2 3} 4]]] 53 | == 54 | [ 55 | {"a<br>b&e" "c" 3 ~ "hey"~} 56 | {"409b" F "9f11" -0.00626248} 57 | {"f092" T "a9&5" 354.786772998} 58 | void 59 | ["a" "b" "c" 60 | {2 4} 61 | 7 62 | [1 63 | {2 3} 64 | 4 65 | ] 66 | ] 67 | ] 68 | == 69 | [ 70 | ["a"(1) 71 | ["b"] 72 | [(2) 73 | ["c"] 74 | ] 75 | ] 76 | ] 77 | steps 34159 bytes 9312 78 | ~1 79 | \err= 80 | ~ 81 | ~ 82 | \status=0 83 | -------------------------------------------------------------------------------- /src/out/b47: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | [ 4 | {"e" 5} 5 | {"d" 4} 6 | {"a" 1} 7 | {"b" 2} 8 | {"c" 3} 9 | ] 10 | [ 11 | {"e" 5} 12 | {"a" 1} 13 | {"b" 2} 14 | ] 15 | [ 16 | {"e" 5} 17 | {"a" 10} 18 | {"b" 7} 19 | {"c" 21} 20 | ] 21 | [ 22 | {"e" 5} 23 | {"a" 10} 24 | {"b" 15} 25 | {"c" 21} 26 | ] 27 | [ 28 | {"d" 4} 29 | {"e" 5} 30 | {"a" 10} 31 | {"b" 15} 32 | {"c" 21} 33 | ] 34 | [ 35 | {"a" 1} 36 | {"b" 2} 37 | {"c" 3} 38 | ] 39 | [ 40 | {"a" 10} 41 | {"b" 15} 42 | {"c" 21} 43 | {"d" 4} 44 | {"e" 5} 45 | ] 46 | steps 5097 bytes 7040 47 | ~ 48 | \err= 49 | ~ 50 | ~ 51 | \status=0 52 | -------------------------------------------------------------------------------- /src/out/b51: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | = Direct substitution 4 | x = (CALC) 5 5 | x = (CALC) 5 6 | 7 | x = (CALC) 5 8 | x = (CALC) 5 9 | 10 | = Eager substitution 11 | (CALC) x = 5 12 | x = 5 13 | 14 | (CALC) x = 5 15 | x = 5 16 | 17 | ~ 18 | \err= 19 | ~ 20 | ~ 21 | \status=0 22 | -------------------------------------------------------------------------------- /src/out/b53: -------------------------------------------------------------------------------- 1 | \out= 2 | ~1 3 | [ test_1 4 | \out= 5 | ~ 6 | Hello 7 | line 1 8 | line 2 9 | I am Fred. 10 | I am Wilma. 11 | I am Fred. 12 | I am Wilma. 13 | Bye 14 | == 15 | I am Fred. 16 | I am Fred. 17 | ~ 18 | \err= 19 | ~ 20 | ~ 21 | \status=0 22 | ] 23 | [ test_2 24 | \out= 25 | ~ 26 | ~ 27 | \err= 28 | ~ 29 | Undefined symbol say on line 11 30 | Undefined symbol fred on line 14 31 | Undefined symbol wilma on line 14 32 | Undefined symbol fred on line 15 33 | Undefined symbol wilma on line 15 34 | Undefined symbol say on line 16 35 | Undefined symbol say on line 17 36 | Undefined symbol std on line 18 37 | ~ 38 | \status=1 39 | ] 40 | [ test_3 41 | \out= 42 | ~ 43 | ~ 44 | \err= 45 | ~ 46 | ~ 47 | \status=0 48 | ] 49 | ~1 50 | \err= 51 | ~ 52 | ~ 53 | \status=0 54 | -------------------------------------------------------------------------------- /src/out/chars: -------------------------------------------------------------------------------- 1 | \out= 2 | ~1 3 | == 4 | 封封aa小小 5 | T 6 | == 7 | 41 A 41 8 | 4f O 4f 9 | 4F O 4f 10 | 61 a 61 11 | 62 b 62 12 | 7e ~ 7e 13 | c3a5 å c3a5 14 | c3bc ü c3bc 15 | c3a4 ä c3a4 16 | C3A4 ä c3a4 17 | e289a0 ≠ e289a0 18 | e5b081 封 e5b081 19 | e5b08f 小 e5b08f 20 | e5b08161e5b08f 封a小 e5b08161e5b08f 21 | == 22 | 28b98aa5dac67e29a98d2920f91500b6 23 | 28b98aa5dac67e29a98d2920f91500b6 24 | 2 25 | 26 | 6600f 27 | ~1 28 | \err= 29 | ~ 30 | ~ 31 | \status=0 32 | -------------------------------------------------------------------------------- /src/out/date: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | count_days 20160208 20160301 = 22 4 | count_days 20160301 20160208 = -22 5 | count_days 20160208 20160229 = 21 6 | count_days 20160229 20160208 = -21 7 | count_days 20160229 20160229 = 0 8 | count_days 20160229 20160229 = 0 9 | count_days 20160228 20170228 = 366 10 | count_days 20170228 20160228 = -366 11 | count_days 20170228 20180228 = 365 12 | count_days 20180228 20170228 = -365 13 | count_days 20160229 20160208 = -21 14 | count_days 20160208 20160229 = 21 15 | add_days 20160208 0 = 20160208 check 0 good 16 | add_days 20160208 7 = 20160215 check 7 good 17 | add_days 20160208 21 = 20160229 check 21 good 18 | add_days 20160208 22 = 20160301 check 22 good 19 | add_days 20160208 23 = 20160302 check 23 good 20 | add_days 20160208 365 = 20170207 check 365 good 21 | add_days 20160101 365 = 20161231 check 365 good 22 | add_days 20170101 365 = 20180101 check 365 good 23 | add_days 20160301 -1 = 20160229 check -1 good 24 | add_days 20160302 -1 = 20160301 check -1 good 25 | add_days 20160302 -2 = 20160229 check -2 good 26 | add_days 20160302 -3 = 20160228 check -3 good 27 | add_days 20160302 -23 = 20160208 check -23 good 28 | add_days 20160302 -28 = 20160203 check -28 good 29 | add_days 20160302 -29 = 20160202 check -29 good 30 | add_days 20160302 -30 = 20160201 check -30 good 31 | add_days 20160302 -365 = 20150303 check -365 good 32 | dow 20160101 = 5 33 | dow 20160104 = 1 34 | dow 20160108 = 5 35 | dow 20160115 = 5 36 | dow 20160121 = 4 37 | dow 20160129 = 5 38 | dow 20160205 = 5 39 | dow 20160212 = 5 40 | dow 20160219 = 5 41 | dow 20160226 = 5 42 | dow 20160304 = 5 43 | dow 20160311 = 5 44 | dow 19631117 = 7 45 | dow 19631118 = 1 46 | dow 19631119 = 2 47 | dow 19631120 = 3 48 | dow 19631121 = 4 49 | dow 19631122 = 5 50 | dow 19631123 = 6 51 | dow 19631124 = 7 52 | 53 | dow 23000225 = 7 54 | dow 23000226 = 1 55 | dow 23000227 = 2 56 | dow 23000228 = 3 57 | dow 23000301 = 4 58 | 59 | dow 23040225 = 4 60 | dow 23040226 = 5 61 | dow 23040227 = 6 62 | dow 23040228 = 7 63 | dow 23040229 = 1 64 | dow 23040301 = 2 65 | dow 23040302 = 3 66 | dow 23040303 = 4 67 | dow 23040306 = 7 68 | 69 | 2 70 | void 71 | void 72 | void 73 | 74 | add_year 20000228 = 20010228 75 | add_year 20000229 = 20010229 76 | add_year 20150228 = 20160228 77 | add_year 20150301 = 20160301 78 | 79 | steps 15623 bytes 4928 80 | ~ 81 | \err= 82 | ~ 83 | ~ 84 | \status=0 85 | -------------------------------------------------------------------------------- /src/out/get_byte: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | [ 4 | ch 61 5 | ch 62 6 | ch 63 7 | ch 41 8 | ch 42 9 | ch 43 10 | ch 0a 11 | ch 6a 12 | ch 6a 13 | ch 6a 14 | ch 61 15 | ch e5 16 | ch b0 17 | ch 8f 18 | ch 0a 19 | ch c3 20 | ch a5 21 | ch c3 22 | ch bc 23 | ch c3 24 | ch a4 25 | ch e2 26 | ch 89 27 | ch a0 28 | ch 0a 29 | ch e5 30 | ch 8c 31 | ch 85 32 | ch e5 33 | ch ad 34 | ch 90 35 | ch 0a 36 | ] 37 | ~ 38 | \err= 39 | ~ 40 | ~ 41 | \status=0 42 | -------------------------------------------------------------------------------- /src/out/leak: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | ~ 4 | \err= 5 | ~ 6 | LEAK 1 32 7 | ~ 8 | \status=1 9 | -------------------------------------------------------------------------------- /src/out/mf: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | female 4 | 1 1 2 2 3 3 4 5 5 6 6 7 8 8 9 9 10 11 11 12 13 13 14 14 15 16 16 17 17 18 19 19 20 21 21 22 5 | male 6 | 0 0 1 2 2 3 4 4 5 6 6 7 7 8 9 9 10 11 11 12 12 13 14 14 15 16 16 17 17 18 19 19 20 20 21 22 7 | diff 8 | 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 9 | steps 5983 bytes 10944 10 | ~ 11 | \err= 12 | ~ 13 | ~ 14 | \status=0 15 | -------------------------------------------------------------------------------- /src/out/missing: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | ~ 4 | \err= 5 | ~ 6 | Could not open source file test/missing.fxl 7 | ~ 8 | \status=1 9 | -------------------------------------------------------------------------------- /src/out/partition: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | 0 1 4 | 1 1 5 | 2 2 6 | 3 3 7 | 4 5 8 | 5 7 9 | 6 11 10 | 7 15 11 | 8 22 12 | 9 30 13 | 10 42 14 | 11 56 15 | 12 77 16 | 13 101 17 | 14 135 18 | 15 176 19 | 16 231 20 | 17 297 21 | 18 385 22 | 19 490 23 | 20 627 24 | 100 190569292 25 | 200 3972999029388 26 | 269 974834369944625 27 | 270 1050197489931117 28 | 300 9253082936723602 29 | steps 1433883 bytes 3583592 30 | ~ 31 | \err= 32 | ~ 33 | ~ 34 | \status=0 35 | -------------------------------------------------------------------------------- /src/out/record: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | BEG 4 | = test_1 5 | !count 1 6 | a = void 7 | b = 2 8 | c = void 9 | d = void 10 | e = void 11 | 12 | = test_2 13 | !count 1 14 | a = void 15 | b = 222 16 | c = void 17 | d = void 18 | e = void 19 | 20 | = test_3 21 | !count 1 22 | a = void 23 | b = 22 24 | c = void 25 | d = void 26 | e = void 27 | 28 | = test_4 29 | count 4 30 | a = 1 31 | b = 2 32 | c = 33 33 | d = 44 34 | e = void 35 | 36 | = test_5 37 | count 5 38 | a = 1 39 | b = 2 40 | c = 33 41 | d = 44 42 | e = 5 43 | 44 | = test_6 45 | count 5 46 | a = 1 47 | b = 2 48 | c = 33 49 | d = 44 50 | e = 5 51 | 52 | = test_7 53 | obj_3043: 54 | count 3 55 | a = void 56 | b = 2 57 | c = 3 58 | d = 44 59 | e = void 60 | 61 | obj_8237: 62 | count 2 63 | a = void 64 | b = void 65 | c = void 66 | d = 44 67 | e = 5 68 | 69 | obj_7892: 70 | count 5 71 | a = 1 72 | b = 2 73 | c = 33 74 | d = 44 75 | e = 5 76 | 77 | = test_8 78 | count void 79 | a = 1 80 | b = 2 81 | c = 3 82 | d = void 83 | e = void 84 | 85 | steps 295 bytes 3808 86 | = test_9 87 | 0 88 | void 89 | count 4 90 | a = 1 91 | b = void 92 | c = 33 93 | d = 44 94 | e = 5 95 | 96 | at "x" = void 97 | at void = void 98 | at -1 = {"a" 1} 99 | at 2.6 = {"d" 44} 100 | at 99 = void 101 | at 0 = {"a" 1} 102 | at 1 = {"c" 33} 103 | at 2 = {"d" 44} 104 | at 3 = {"e" 5} 105 | at 4 = void 106 | [ 107 | {"a" 1} 108 | {"c" 33} 109 | {"d" 44} 110 | {"e" 5} 111 | ] 112 | [ 113 | {"a" 1} 114 | {"c" 33} 115 | {"d" 44} 116 | {"e" 5} 117 | ] 118 | steps 2244 bytes 5056 119 | = test_10 120 | = test_11 121 | CALC 122 | x = 5 123 | I am Fred. 124 | I am Wilma. 125 | 126 | NO xfred 127 | YES fred 128 | I am Fred. 129 | YES wilma 130 | I am Wilma. 131 | steps 108 bytes 736 132 | = test_12 133 | val = 0 134 | val = 3 135 | val = 4 136 | val = 8 137 | steps 133 bytes 3360 138 | 139 | val = 0 140 | val = 3 141 | val = 4 142 | val = 8 143 | steps 132 bytes 3360 144 | 145 | val = 0 146 | val = 3 147 | val = 4 148 | val = 8 149 | steps 132 bytes 3360 150 | 151 | val = 0 152 | val = 3 153 | val = 4 154 | val = 8 155 | steps 132 bytes 3360 156 | 157 | ~ 158 | \err= 159 | ~ 160 | ~ 161 | \status=0 162 | -------------------------------------------------------------------------------- /src/out/resolve: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | == test_0 4 | Evaluating the form. 5 | result void 6 | 7 | Evaluating the form. 8 | Evaluating the context. 9 | Hello 10 | result ok 11 | 12 | steps 63 bytes 320 13 | == test_1 14 | Evaluating the context. 15 | Evaluating the form. 16 | I am Fred. 17 | steps 69 bytes 448 18 | == test_2 19 | Evaluating the context. 20 | Evaluating the form. 21 | Hi 22 | 57 23 | T 24 | HEY: Fred says a 25 | Wilma says b 26 | Goodbye 27 | steps 122 bytes 864 28 | ~ 29 | \err= 30 | ~ 31 | ~ 32 | \status=0 33 | -------------------------------------------------------------------------------- /src/out/sat: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | SAT 0 T 4 | [ 5 | [] 6 | ] 7 | 8 | SAT 0 F 9 | [ 10 | ] 11 | 12 | SAT 2 (\a\b and a b) 13 | [ 14 | [TT] 15 | ] 16 | 17 | SAT 2 (\a\b or a b) 18 | [ 19 | [TT] 20 | [TF] 21 | [FT] 22 | ] 23 | 24 | SAT 2 (\a\b or (not a) b) 25 | [ 26 | [TT] 27 | [FT] 28 | [FF] 29 | ] 30 | 31 | SAT 4 (\a\b\c\d (and (or (and a d) c) (not (and b d)))) 32 | [ 33 | [TTTF] 34 | [TFTT] 35 | [TFTF] 36 | [TFFT] 37 | [FTTF] 38 | [FFTT] 39 | [FFTF] 40 | ] 41 | 42 | SAT 17 ... 43 | [ 44 | [TTFTTFTTFTFTTTTTT] 45 | ] 46 | 47 | steps 7062676 bytes 31968 48 | ~ 49 | \err= 50 | ~ 51 | ~ 52 | \status=0 53 | -------------------------------------------------------------------------------- /src/out/sort: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | [ 4 | am 5 | am 6 | amra 7 | amra 8 | angie 9 | angie 10 | babel 11 | babel 12 | blotch 13 | blotch 14 | bow 15 | bow 16 | crown 17 | crown 18 | dewar 19 | dewar 20 | eb 21 | eb 22 | expel 23 | expel 24 | flam 25 | flam 26 | gibby 27 | gibby 28 | grout 29 | grout 30 | haw 31 | haw 32 | jess 33 | jess 34 | jo 35 | jo 36 | perky 37 | perky 38 | piece 39 | piece 40 | polka 41 | polka 42 | qqqq 43 | qqqq 44 | revel 45 | revel 46 | ro 47 | ro 48 | rug 49 | rug 50 | scud 51 | scud 52 | sham 53 | sham 54 | skip 55 | skip 56 | subtly 57 | subtly 58 | than 59 | than 60 | ur 61 | ur 62 | when 63 | when 64 | ] 65 | [ 66 | am 67 | amra 68 | angie 69 | babel 70 | blotch 71 | bow 72 | crown 73 | dewar 74 | eb 75 | expel 76 | flam 77 | gibby 78 | grout 79 | haw 80 | jess 81 | jo 82 | perky 83 | piece 84 | polka 85 | qqqq 86 | revel 87 | ro 88 | rug 89 | scud 90 | sham 91 | skip 92 | subtly 93 | than 94 | ur 95 | when 96 | ] 97 | steps 10056862 bytes 16717248 98 | ~ 99 | \err= 100 | ~ 101 | ~ 102 | \status=0 103 | -------------------------------------------------------------------------------- /src/out/stats: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | Returns (Fund vs. Benchmark) 4 | [ 5 | -0.893261320594374 -16.5237724084178 6 | 6.64835461191322 -6.9561157796452 7 | -13.8899158690587 0.978424485700002 8 | -7.42083726309821 -8.2111801242236 9 | 3.17855669949858 -10.7457030721342 10 | -6.59786522873157 8.339651250948 11 | 3.48606686727264 9.923023093072 12 | -0.682005428813126 5.85688820982899 13 | -2.43289592602041 -0.0721674284340001 14 | -5.76926099972037 7.462686567164 15 | -3.05327482058277 3.69623655914 16 | -1.00636347251863 3.54288183192899 17 | 0.0782182723713332 -1.919465887753 18 | 3.38911087514397 6.15826419910701 19 | -0.217281242107792 1.903616872057 20 | -3.63498264210177 -3.6279618523252 21 | 5.61440844291543 3.12181187512801 22 | 3.24354516878298 6.08428967154699 23 | 7.33192779132095 1.548074232957 24 | 5.81561666835948 -7.9437964918725 25 | -0.406389365681947 -5.1775738228252 26 | -6.98223722952097 6.82798527091 27 | 12.3711679600035 -4.5006893834942 28 | 2.87384595849236 8.961534495205 29 | 1.8778094684559 3.823585084232 30 | 7.63391664696429 0 31 | -2.23667161458249 6.68185961713801 32 | 4.66224451477453 2.332735196104 33 | -0.788235453975683 3.473613894456 34 | -8.07078998275932 0.00806972240199322 35 | -0.978130017823486 2.896796578714 36 | -2.87636811199844 -1.1213927227102 37 | 7.97482267628187 -1.6892695693552 38 | 8.60965529420248 -2.000645369474 39 | 1.20791622426788 -5.4988475469213 40 | 4.76889077637657 -6.9425087108014 41 | 18.6283281925775 10.923897781522 42 | 6.11793431938426 -0.4135021097046 43 | -0.865787441111299 1.050758410304 44 | 1.07915664726004 4.63731656184501 45 | -2.01835813630018 4.33563071005001 46 | -7.11981744412673 3.218373146939 47 | 8.11806477589498 -0.669742521208505 48 | 9.52026643043675 -6.0008990110878 49 | -2.96600202876063 4.056746632661 50 | -1.69208852051672 1.17953431372499 51 | 4.09867474496914 2.50567751703299 52 | -2.61735286232427 2.54043275976701 53 | 2.73029144176504 -1.8221101908534 54 | -1.09948485009037 0.564847417839998 55 | 3.55118726143842 0.897220803850995 56 | -2.86508248957761 5.118565644881 57 | -7.10477189588519 1.27235213204999 58 | 6.12734042211471 3.796264855688 59 | 1.0860315129092 1.92358021460399 60 | 6.0154171502939 2.36230581589401 61 | 0.363614841755688 -1.33575818387059 62 | 4.08090354462769 5.167482361914 63 | 1.21137768806991 -2.9977033724163 64 | -4.4688306021859 3.16510903426801 65 | 7.9975253586303 4.626162580022 66 | 9.25002054235966 2.966982221196 67 | -1.12943348186301 2.58997645476 68 | -4.34278449974245 -3.5245901639344 69 | 1.80183112092489 4.55395072217499 70 | 10.3567603188175 0.828863968796001 71 | 3.07471154465189 0.693101225016002 72 | 5.12094831779006 2.321114134785 73 | 2.17648405452895 2.06508135168999 74 | -8.37189862985007 0.827713059473001 75 | ] 76 | Average Fund vs. Risk-Free Return 77 | 1.2668% 78 | Standard Deviation of Fund vs. Risk-Free Return 79 | 5.6103% 80 | Sharpe Ratio of Fund vs. Risk-Free Return 81 | 0.2258 82 | Standard Deviation of Fund vs. Benchmark Return 83 | 7.5759% 84 | Relative Standard Deviation 85 | 1.3504 86 | Modigliani risk-adjusted performance 87 | 1.7106% 88 | Sharpe Ratio of Fund vs. Benchmark 89 | 0.0275 90 | ~ 91 | \err= 92 | ~ 93 | ~ 94 | \status=0 95 | -------------------------------------------------------------------------------- /src/out/stream: -------------------------------------------------------------------------------- 1 | \out= 2 | ~ 3 | EMPTY 4 | line 1 5 | x = void 6 | x = void 7 | 8 | READ 9 | a(12)b(12)c(12)d(12) 10 | line = 1 11 | result = ["x" "y"] 12 | 13 | READ 14 | a(12)b(12)c(12)d(12) 15 | line = 1 16 | result = ["x" "y"] 17 | 18 | READ 19 | s(12)a(12)y(12) (12)"(12)H(12)e(12)l(12)l(12)o(12) (12)w(12)o(12)r(12)l(12)d(12)!(12)"(12) 20 | (12) 21 | line = 2 22 | result = ["x" "y"] 23 | 24 | result = void 25 | 26 | READ 27 | l(12)i(12)n(12)e(12) (12)1(12) 28 | (12)l(12)i(12)n(12)e(12) (12)2(12) 29 | (12)l(12)i(12)n(12)e(12) (12)3(12) 30 | line = 3 31 | result = ["x" "y"] 32 | 33 | steps 2988 bytes 3808 34 | 35 | TF 36 | TF 37 | 38 | FT 39 | TF 40 | 41 | FTF 42 | FTF 43 | FT 44 | TF 45 | DONE 46 | ~ 47 | \err= 48 | ~ 49 | ~ 50 | \status=0 51 | -------------------------------------------------------------------------------- /src/out/syntax: -------------------------------------------------------------------------------- 1 | \out= 2 | ~1 3 | \out= 4 | ~ 5 | ~ 6 | \err= 7 | ~ 8 | Lambda name cannot be a number on line 1 9 | ~ 10 | \status=1 11 | \out= 12 | ~ 13 | ~ 14 | \err= 15 | ~ 16 | Unclosed string on line 1 17 | ~ 18 | \status=1 19 | \out= 20 | ~ 21 | ~ 22 | \err= 23 | ~ 24 | Unclosed string on line 2 25 | ~ 26 | \status=1 27 | \out= 28 | ~ 29 | ~ 30 | \err= 31 | ~ 32 | Unclosed string on line 1 33 | ~ 34 | \status=1 35 | \out= 36 | ~ 37 | ~ 38 | \err= 39 | ~ 40 | Unclosed string on line 3 41 | ~ 42 | \status=1 43 | \out= 44 | ~ 45 | ~ 46 | \err= 47 | ~ 48 | Incomplete string terminator on line 1 49 | ~ 50 | \status=1 51 | \out= 52 | ~ 53 | ~ 54 | \err= 55 | ~ 56 | Unclosed string on line 1 57 | ~ 58 | \status=1 59 | \out= 60 | ~ 61 | ~ 62 | \err= 63 | ~ 64 | Incomplete string terminator on line 1 65 | ~ 66 | \status=1 67 | \out= 68 | ~ 69 | ~ 70 | \err= 71 | ~ 72 | Missing name declaration before '=' on line 1 73 | ~ 74 | \status=1 75 | \out= 76 | ~ 77 | ~ 78 | \err= 79 | ~ 80 | Missing name after '\' on line 1 81 | ~ 82 | \status=1 83 | \out= 84 | ~ 85 | ~ 86 | \err= 87 | ~ 88 | Missing definition on line 1 89 | ~ 90 | \status=1 91 | \out= 92 | ~ 93 | ~ 94 | \err= 95 | ~ 96 | Unclosed parenthesis on line 3 97 | ~ 98 | \status=1 99 | \out= 100 | ~ 101 | ~ 102 | \err= 103 | ~ 104 | Unclosed parenthesis on line 1 105 | ~ 106 | \status=1 107 | \out= 108 | ~ 109 | ~ 110 | \err= 111 | ~ 112 | Unclosed bracket on line 3 113 | ~ 114 | \status=1 115 | \out= 116 | ~ 117 | ~ 118 | \err= 119 | ~ 120 | Unclosed brace on line 3 121 | ~ 122 | \status=1 123 | \out= 124 | ~ 125 | ~ 126 | \err= 127 | ~ 128 | Extraneous input on line 2 129 | ~ 130 | \status=1 131 | \out= 132 | ~ 133 | ~ 134 | \err= 135 | ~ 136 | Undefined symbol a on line 2 137 | Undefined symbol b on line 2 138 | Undefined symbol c on line 2 139 | Undefined symbol b on line 2 140 | Undefined symbol c on line 2 141 | Undefined symbol d on line 2 142 | Undefined symbol a on line 3 143 | Undefined symbol b on line 3 144 | Undefined symbol c on line 3 145 | Undefined symbol b on line 3 146 | Undefined symbol c on line 3 147 | Undefined symbol d on line 3 148 | Undefined symbol x on line 5 149 | ~ 150 | \status=1 151 | \out= 152 | ~ 153 | ~ 154 | \err= 155 | ~ 156 | Undefined symbol a on line 1 157 | Undefined symbol a on line 2 158 | Undefined symbol c on line 2 159 | Undefined symbol c on line 3 160 | ~ 161 | \status=1 162 | \out= 163 | ~ 164 | ~ 165 | \err= 166 | ~ 167 | Could not open source file missing.fxl 168 | ~ 169 | \status=1 170 | ~1 171 | \err= 172 | ~ 173 | ~ 174 | \status=0 175 | -------------------------------------------------------------------------------- /src/parse.h: -------------------------------------------------------------------------------- 1 | extern value parse_fexl(value stream, value label); 2 | -------------------------------------------------------------------------------- /src/report.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | 7 | static void put_error_location(unsigned long line, const char *label) 8 | { 9 | fput(stderr," on line "); fput_ulong(stderr,line); 10 | if (label[0]) 11 | { 12 | fput(stderr," of ");fput(stderr,label); 13 | } 14 | fnl(stderr); 15 | } 16 | 17 | void fatal_error(const char *code, unsigned long line, const char *label) 18 | { 19 | fput(stderr,code); put_error_location(line,label); 20 | die(0); 21 | } 22 | 23 | void undefined_symbol(const char *name, unsigned long line, const char *label) 24 | { 25 | fput(stderr,"Undefined symbol "); fput(stderr,name); 26 | put_error_location(line,label); 27 | } 28 | -------------------------------------------------------------------------------- /src/report.h: -------------------------------------------------------------------------------- 1 | extern void fatal_error 2 | (const char *code, unsigned long line, const char *label); 3 | extern void undefined_symbol 4 | (const char *name, unsigned long line, const char *label); 5 | -------------------------------------------------------------------------------- /src/sha256.h: -------------------------------------------------------------------------------- 1 | extern void sha256(u8 digest[32], const u8 *data, u64 n_data_byte); 2 | -------------------------------------------------------------------------------- /src/sha512.h: -------------------------------------------------------------------------------- 1 | extern void sha512(u8 digest[64], const u8 *data, u64 n_data_byte); 2 | -------------------------------------------------------------------------------- /src/show.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | static const char *type_name(type t) 18 | { 19 | if (t == 0) return "A"; 20 | if (t == type_num) return "num"; 21 | if (t == type_str) return "str"; 22 | 23 | if (t == type_form) return "form"; 24 | if (t == type_quo) return "quo"; 25 | if (t == type_ref) return "ref"; 26 | 27 | if (t == type_T) return "T"; 28 | if (t == type_F) return "F"; 29 | if (t == type_I) return "I"; 30 | if (t == type_Y) return "Y"; 31 | if (t == type_once) return "once"; 32 | if (t == type_void) return "void"; 33 | if (t == type_yield) return "yield"; 34 | if (t == type_concat) return "concat"; 35 | if (t == type_say) return "say"; 36 | if (t == type_add) return "add"; 37 | if (t == type_mul) return "mul"; 38 | if (t == type_list) return "list"; 39 | if (t == type_D) return "D"; 40 | if (t == type_E) return "E"; 41 | if (t == type_value) return "value"; 42 | if (t == type_pair) return "pair"; 43 | if (t == type_null) return "null"; 44 | if (t == type_tuple) return "tuple"; 45 | if (t == type_assoc) return "assoc"; 46 | if (t == type_with) return "with"; 47 | if (t == type_def) return "def"; 48 | if (t == type_chain) return "::"; 49 | 50 | return "TYPE"; 51 | } 52 | 53 | // LATER 20231127 Use tilde notation if string has embedded quotes. 54 | static void put_quote(string x) 55 | { 56 | put_ch('"'); 57 | put_str(x); 58 | put_ch('"'); 59 | } 60 | 61 | static void limit_show(value f); 62 | 63 | static void put_data(value f) 64 | { 65 | if (f->T == type_num) 66 | put_double(f->v_double); 67 | else if (f->T == type_str) 68 | put_quote(f->v_ptr); 69 | else if (f->T == type_quo) 70 | limit_show(f->R); 71 | else if (f->T == type_ref) 72 | { 73 | put_quote(f->R->v_ptr); 74 | if (0) // Don't show the line number. 75 | { 76 | put_ch(' '); 77 | put_ulong(f->R->N); 78 | } 79 | } 80 | else 81 | put("DATA"); 82 | } 83 | 84 | static unsigned long max_depth; 85 | static unsigned long max_call; 86 | 87 | static void limit_show(value f) 88 | { 89 | if (max_call == 0 || max_depth == 0) 90 | { 91 | put_ch('_'); 92 | return; 93 | } 94 | 95 | max_call--; 96 | max_depth--; 97 | 98 | put_ch('['); 99 | put(type_name(f->T)); 100 | if (f->L) 101 | { 102 | put_ch(' '); 103 | if (f->L->N) 104 | { 105 | if (f->T != type_form) // Don't show the file name. 106 | { 107 | limit_show(f->L); 108 | put_ch(' '); 109 | } 110 | limit_show(f->R); 111 | } 112 | else 113 | put_data(f); 114 | } 115 | put_ch(']'); 116 | 117 | max_depth++; 118 | } 119 | 120 | void show_exp(value f) 121 | { 122 | max_depth = 12; 123 | max_call = 200; 124 | limit_show(f); 125 | } 126 | 127 | void show(const char *name, value f) 128 | { 129 | put(name);show_exp(f);nl(); 130 | } 131 | -------------------------------------------------------------------------------- /src/show.h: -------------------------------------------------------------------------------- 1 | extern void show_exp(value f); 2 | extern void show(const char *name, value f); 3 | -------------------------------------------------------------------------------- /src/str.h: -------------------------------------------------------------------------------- 1 | typedef struct string *string; 2 | 3 | struct string 4 | { 5 | unsigned long len; 6 | char data[]; 7 | }; 8 | 9 | extern string str_new(unsigned long len); 10 | extern string str_new_data(const char *data, unsigned long len); 11 | extern string str_new_data0(const char *data); 12 | extern string str_copy(string x); 13 | extern void str_free(string x); 14 | extern string str_concat(string x, string y); 15 | extern int str_cmp(string x, string y); 16 | extern int str_eq(string x, string y); 17 | extern string str_slice(string x, unsigned long pos, unsigned long len); 18 | extern unsigned long str_search(string x, string y, unsigned long offset); 19 | extern string dirname(string path); 20 | extern string basename(string path); 21 | extern unsigned long length_common(string x, string y); 22 | extern unsigned char char_width(unsigned char ch); 23 | -------------------------------------------------------------------------------- /src/stream.h: -------------------------------------------------------------------------------- 1 | extern int cur_ch; 2 | extern unsigned long cur_line; 3 | extern void skip(void); 4 | extern int at_white(void); 5 | extern void skip_white(void); 6 | extern void buf_keep(buffer buf); 7 | extern void skip_filler(void); 8 | extern int collect_to_white(buffer buf); 9 | extern int collect_to_ch(buffer buf, const char t_ch); 10 | extern int collect_string(buffer buf, const char *end, unsigned long len); 11 | extern int collect_tilde_string(buffer buf); 12 | extern value read_stream(value stream, value read); 13 | -------------------------------------------------------------------------------- /src/test/a2.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | # Echo the characters from the input. 5 | \echo= 6 | (\\get @\\loop 7 | \ch=get 8 | is_undef ch (); 9 | say ["ch = '" ch "'"] 10 | loop 11 | ) 12 | 13 | say "Hello" 14 | say "Type some lines of input and I'll echo them back." 15 | say "Press Ctrl-D to stop." 16 | echo (fget stdin) 17 | 18 | ( 19 | \str="abcåabcüdef封x" 20 | ( 21 | say ["Get from string [" str "]"] 22 | \in=(readstr str) 23 | echo (sget in) 24 | ) 25 | ( 26 | say ["String to list [" str "]"] 27 | show_list (str_chars str) 28 | ) 29 | ) 30 | 31 | ( 32 | \str="AOOab~åüää≠封小xyz" 33 | ( 34 | say ["Show logical characters in [" str "]"] 35 | \in=(readstr str) 36 | echo (sget in) 37 | ) 38 | ( 39 | say ["Show individual hex bytes in [" str "]"] 40 | \in=(readstr str) 41 | echo (\ch=(sgetc in) hex_byte; ord ch) 42 | ) 43 | ) 44 | 45 | say "Good bye." 46 | -------------------------------------------------------------------------------- /src/test/a3.fxl: -------------------------------------------------------------------------------- 1 | # 2 | say "hello" 3 | \x=(+ 4 3) 4 | 5 | \talk= 6 | (\out\label 7 | \put=(fput out) 8 | \say=(fsay out) 9 | \\nl=(fnl out) 10 | say ["This goes to "label"."] 11 | put ["x = " x] 12 | nl 13 | ) 14 | 15 | \\talk= 16 | ( 17 | talk stderr "stderr" 18 | talk stdout "stdout" 19 | ) 20 | 21 | talk 22 | talk 23 | say "bye" 24 | -------------------------------------------------------------------------------- /src/test/a4.fxl: -------------------------------------------------------------------------------- 1 | # 2 | show_benchmark; 3 | 4 | \\run= 5 | ( 6 | (@\\loop\x 7 | ge x 1000000 (); 8 | loop (+ 1 x) 9 | ) 1 10 | ) 11 | 12 | # Runs in constant space as expected. 13 | say "[" 14 | run 15 | say "]" 16 | -------------------------------------------------------------------------------- /src/test/a5.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value 3 | ( 4 | def "talk" (say "TALK"); 5 | std 6 | ) 7 | \; 8 | say "begin" 9 | talk 10 | talk 11 | talk 12 | talk 13 | say "end" 14 | -------------------------------------------------------------------------------- /src/test/a8.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \\test_rand= 3 | ( 4 | say "== test_rand" 5 | 6 | # This is an infinite list of random values, but it says "get" every time it 7 | # gets the next value. 8 | stream_get (say "get" rand) \\xs 9 | 10 | # This is the first three items of the infinite list. Note again that I use \\ 11 | # to avoid getting the first value right away. 12 | \\xs=(\= first 3 xs) 13 | 14 | \\show= 15 | ( 16 | say "[" 17 | each xs say 18 | say "]" 19 | ) 20 | 21 | seed_rand 0.1964 22 | show 23 | show 24 | show 25 | ) 26 | 27 | \\test_readstr= 28 | ( 29 | say "== test_readstr" 30 | 31 | \stream_string= 32 | (\str 33 | \fh=(readstr str) 34 | stream_get (put "!" sgetc fh) 35 | ) 36 | 37 | say "BEG" 38 | stream_string "abcdef" \\xs 39 | say "END" 40 | \\xs=(first 3 xs) 41 | say ["xs = "(as_str xs)] 42 | say ["xs = "(as_str xs)] 43 | ) 44 | 45 | test_rand 46 | test_readstr 47 | -------------------------------------------------------------------------------- /src/test/a9.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \\test_1= 3 | ( 4 | say "== test_1" # says PING 1 time 5 | \\ping=(\= say "PING") 6 | I 7 | ping 8 | ping 9 | ping 10 | ) 11 | 12 | \\test_2= 13 | ( 14 | say "== test_2" # says PING 5 times 15 | \\ping=(say "PING") 16 | \\other=(\= ping) 17 | \\talk=(ping other) 18 | \\talk=(talk talk) 19 | \\talk=(talk talk) 20 | talk 21 | ) 22 | 23 | \\test_3= 24 | ( 25 | say "== test_3" # says PING 3 times 26 | \\ping=(say "PING") 27 | \\talk=(\x=ping x) 28 | talk talk talk 29 | ) 30 | 31 | \\test_4= 32 | ( 33 | say "== test_4" # says PING pong PING PING PING 34 | \\ping=(say "PING") 35 | \\pong=(\= say "pong") 36 | \\talk=(ping pong) 37 | \\talk=(talk talk) 38 | \\talk=(talk talk) 39 | talk 40 | ) 41 | 42 | test_1 43 | test_2 44 | test_3 45 | test_4 46 | -------------------------------------------------------------------------------- /src/test/b10.fxl: -------------------------------------------------------------------------------- 1 | # Testing with a version that prints "get " when it reads a char. 2 | \fgetc= 3 | (\fh 4 | put "get " 5 | fgetc fh 6 | ) 7 | 8 | \\fh_entropy= 9 | (\= 10 | \source="/dev/urandom" # Normally you'd use this. 11 | \source="/dev/zero" # Tests all zeroes. 12 | 13 | # Testing with fixed file contents. 14 | \source=(path_under dir_base "src/test/data.txt") 15 | 16 | \fh=(fopen source "r") 17 | is_undef fh (error ["Could not open "source]); 18 | fh 19 | ) 20 | 21 | \\list_entropy=(stream_values (fgetc fh_entropy)) 22 | 23 | # Yield the next n bytes from the entropy source. The list is created only on 24 | # demand, and is also a _fixed_ list, so I can print it repeatedly and see the 25 | # same thing each time. 26 | \get_bytes=(\n yield; \= first n; list_entropy) 27 | 28 | \\get_random_id= 29 | ( 30 | get_bytes 16 \\bytes 31 | \bytes=(map (\ch hex_byte (ord ch)) bytes) 32 | to_str bytes 33 | ) 34 | 35 | \show= 36 | (\\xs 37 | put "[ " 38 | each xs (\x put [(hex_byte;ord x) " "]) 39 | say "]" 40 | ) 41 | 42 | \\show_bytes= 43 | ( 44 | get_bytes 16 \\bytes 45 | show bytes 46 | show bytes 47 | show bytes 48 | nl 49 | ) 50 | 51 | \\show_id= 52 | ( 53 | \x=get_random_id 54 | say x 55 | say x 56 | say x 57 | nl 58 | ) 59 | 60 | show_bytes 61 | show_bytes 62 | show_id 63 | show_id 64 | -------------------------------------------------------------------------------- /src/test/b12.fxl: -------------------------------------------------------------------------------- 1 | # Test reading CSV and SSV data. 2 | 3 | \try_read= 4 | (\read\in 5 | say_data (read in) 6 | ) 7 | 8 | \try_read_file= 9 | (\read\name 10 | try_read read (path_under dir_local name) 11 | ) 12 | 13 | \\test_csv= 14 | ( 15 | say "== test_csv" 16 | 17 | ( 18 | \try=(try_read read_csv_chars) 19 | try [] 20 | try 21 | [ 22 | " " "-" "1" "1" "." "3" "6" "," "1" "2" CR LF 23 | "2" "1" "," "2" "2" CR LF 24 | "3" "1" "," "3" "2" LF 25 | "4" "1" "," "4" "2" "," "," "," CR 26 | "5" "1" "," "5" "2" LF 27 | CR # blank row 28 | "a" " " "b" "," "c" "d" CR LF 29 | 30 | QU "a" "b" " " "c" QU QU "h" "i" QU QU QU "," 31 | QU "3" "." "1" "4" QU 32 | LF 33 | 34 | LF # blank row 35 | "6" LF 36 | "3" "3" # no terminating LF 37 | ] 38 | 39 | try ["x" LF] 40 | 41 | # Missing end quote 42 | try [QU] 43 | try [QU "a"] 44 | try ["a" "," QU "b"] 45 | 46 | # Embedded quote 47 | try ["a" QU "b"] 48 | try ["a" QU] 49 | 50 | # OK 51 | try [QU QU] 52 | try [QU "a" QU] 53 | try ["a" ","] 54 | try ["a" "b" "," "c" ","] 55 | ) 56 | 57 | ( 58 | \try=(try_read read_csv_string) 59 | 60 | try 61 | ~ 62 | 12,3,,4 63 | 5,6,7 64 | 65 | "a b 66 | ""hi"" 67 | cd","3.14",-48.7 68 | "abc,def""ghi""jklmnopqrstuvwxyz" 69 | 70 | 71 | ~ 72 | ) 73 | 74 | ( 75 | \try=(try_read_file read_csv_file) 76 | try "test.csv" 77 | ) 78 | ) 79 | 80 | \\test_tsv= 81 | ( 82 | say "== test_tsv" 83 | \try=(try_read read_tsv_string) 84 | 85 | try 86 | ~ 87 | 12 3 4 88 | 5 6 7 89 | 90 | "a b 91 | ""hi"" 92 | cd" "3.14" -48.7 93 | "abc,def""ghi""jklmnopqrstuvwxyz" 94 | 95 | 96 | ~ 97 | ) 98 | 99 | \\test_ssv= 100 | ( 101 | say "== test_ssv" 102 | 103 | ( 104 | \try=(try_read read_ssv_chars) 105 | try [] 106 | try ["a" "b" " " "x" "z" "z" " " "d" " " "e" " " "f" " " CR LF "g" " " "h" "i"] 107 | try ["a" "b" " " "c" " " "q" " " LF "d"] 108 | try [" " " " "a" "b" " " "c" LF CR TAB "x" TAB " " "y" LF LF "z"] 109 | 110 | try [" " "a" " " "x" TAB LF " " "b" "c" CR "d" "e" " " "f"] 111 | try [" " "a" "b" "c" "d" ] 112 | try ["a" " " "b" " " "x" "y" " " "z" LF "d" " " "d" ] 113 | 114 | try ["a" " " "b" "c" LF LF LF "d" CR LF CR LF] 115 | 116 | # Test jamming quoted strings back-to-back, though not recommended. 117 | # a b "c d" ~ e~~ f"gh"~ij ~END k"l"m~1n~ENDo~| p~|q"r"s 118 | # tuv 119 | try 120 | [ 121 | "a" "b" 122 | " " 123 | QU "c" " " "d" QU 124 | " " 125 | "~" " " "e" "~" 126 | "~" " " "f" QU "g" QU "h" "~" 127 | "i" "j" 128 | " " 129 | "~" "E" "N" "D" " " "k" QU "l" QU "m" "~" "1" "n" "~" "E" "N" "D" 130 | "o" 131 | "~" "|" " " "p" "~" "|" 132 | "q" QU "r" QU "s" 133 | LF 134 | "t" "u" "v" 135 | ] 136 | 137 | try ["a" QU "b" QU] 138 | try ["~" "E" "N" "D" " " "a" "~" "E" "N" "D"] 139 | 140 | # Test missing terminators. 141 | try ["a" QU "b"] 142 | try ["~"] 143 | try ["~" "E" "N" "D"] 144 | try ["~" "E" "N" "D" " "] 145 | try ["~" "E" "N" "D" " " "a" "~" "E" "N"] 146 | ) 147 | 148 | ( 149 | \try=(try_read read_ssv_string) 150 | try 151 | ~TEST 152 | ab xzz d e f 153 | g hi 154 | ab c 155 | x y 156 | 157 | 158 | z 159 | 160 | 161 | a x 162 | a b "c d" ~ e~~ f"gh"~ij ~END k"l"m~1n~ENDo~| p~|q"r"s 163 | tuv 164 | "a bb c" ~ x"y"z~ 21 38.3 -44 165 | "aaaa" ~ 166 | Block of text here. 167 | Second line. 168 | ~ ~END another block 169 | second line~END 170 | 1 2 3 171 | 172 | 173 | ~abcde ~a~ab~abc~abcd~abcde 174 | ~TEST 175 | 176 | # Test some tricky string terminators. 177 | try 178 | ~~ 179 | ~ABC abcd~ABA~ABC x 180 | ~ABCD AAB~ABC~ABCD y 181 | ~~ 182 | ) 183 | 184 | ( 185 | \try=(try_read_file read_ssv_file) 186 | try "test.ssv" 187 | try "missing" 188 | ) 189 | ) 190 | 191 | \\test_xsv= 192 | ( 193 | # Test with pipe delimiter. 194 | \try=(try_read (read_xsv_string "|")) 195 | say "== test_xsv" 196 | try 197 | ~ 198 | 12|3||4 199 | 5|6|7 200 | 201 | "a b 202 | ""hi"" 203 | cd"|"3.14"|-48.7 204 | "abc|def""ghi""jklmnopqrstuvwxyz" 205 | 206 | 207 | ~ 208 | ) 209 | 210 | show_benchmark; 211 | test_csv 212 | test_tsv 213 | test_ssv 214 | test_xsv 215 | -------------------------------------------------------------------------------- /src/test/b13.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \test_context= 3 | (\cx 4 | 5 | \try= 6 | (\name 7 | \val=(cx name) 8 | \ok=(is_defined val) 9 | say ["name "name" : "ok] 10 | ) 11 | 12 | try "say" 13 | try "is_defined" 14 | try "std" 15 | try "+" 16 | try "@" 17 | try "def" 18 | try "if" 19 | try "each" 20 | try "div" 21 | try "show_list" 22 | try "parse_file" 23 | try "use" 24 | try "void" 25 | try "dirname" 26 | try "hex_digit" 27 | try "read_ssv_file" 28 | try "read_csv_file" 29 | try "2.5" 30 | try "0" 31 | try "-3.56" 32 | try "-3.56e-4" 33 | try "-3.56e-4x" 34 | try "x" 35 | ) 36 | 37 | say "== test_full" 38 | test_context (load "test.fxl"; std) 39 | 40 | say "== test_restricted" 41 | test_context 42 | ( 43 | def "say" say; 44 | def "is_defined" is_defined; 45 | void 46 | ) 47 | 48 | ( 49 | say "== test_run_restricted" 50 | value 51 | ( 52 | # This context defines only 5 available functions. 53 | def "say" say; 54 | def "seed_rand" seed_rand; 55 | def "rand" rand; 56 | def "fred" (say "I am Fred."); 57 | def "wilma" (say "I am Wilma."); 58 | void 59 | ) 60 | \; 61 | 62 | seed_rand 0.1964 63 | fred 64 | say rand 65 | say rand 66 | wilma 67 | ) 68 | -------------------------------------------------------------------------------- /src/test/b14.fxl: -------------------------------------------------------------------------------- 1 | # NOTE If you fopen with "a+", you cannot seek, and output is always at end of 2 | # file. 3 | 4 | \show_base_dir= 5 | (\path 6 | say ["directory "path] 7 | \path=(path_under dir_base path) 8 | # Exclude hidden files. 9 | \names=(sort; filter (\x not; starts_with "." x); dir_names path) 10 | say "[" 11 | each names say 12 | say "]" 13 | ) 14 | 15 | \demo_seek= 16 | (\path 17 | \path=(path_under dir_local path) 18 | 19 | \fh= 20 | ( 21 | \fh=(mkfile path (oct "664")) # Create and open the file atomically. 22 | is_good fh (say ["Created "path] fh); 23 | \fh=(fopen path "r+") # Open the existing file. 24 | is_good fh (say ["Opened "path] fh); 25 | error ["Could not create or open "path] 26 | ) 27 | 28 | flock_ex fh 29 | 30 | \show_pos= 31 | (\label 32 | say [label" (pos "(ftell fh)")"] 33 | ) 34 | 35 | \seek= 36 | (\type\pos 37 | \fn= 38 | ( 39 | eq type "set" fseek_set; 40 | eq type "cur" fseek_cur; 41 | eq type "end" fseek_end; 42 | void 43 | ) 44 | \name=["seek_"type] 45 | \code=(fn fh pos) 46 | if (eq code -1) (error [name" failed"]) 47 | show_pos [name" "pos] 48 | ) 49 | 50 | \seek_set=(seek "set") 51 | \seek_cur=(seek "cur") 52 | \seek_end=(seek "end") 53 | 54 | \truncate= 55 | (\size 56 | \code=(ftruncate fh size) 57 | \name="truncate" 58 | if (eq code -1) (error [name" failed"]) 59 | show_pos [name" "size] 60 | ) 61 | 62 | \write= 63 | (\str 64 | fput fh str 65 | show_pos ["write "(length str)" bytes "(fexl_quote str)] 66 | ) 67 | 68 | \read= 69 | (\size 70 | \str=(fread fh size) 71 | show_pos ["read "(length str)" bytes "(fexl_quote str)] 72 | ) 73 | 74 | \sleep= 75 | (\n 76 | put ["sleep "n" ..."] fflush stdout 77 | sleep n 78 | nl 79 | ) 80 | 81 | \form 82 | value 83 | ( 84 | def "show_pos" show_pos; 85 | def "seek_set" seek_set; 86 | def "seek_cur" seek_cur; 87 | def "seek_end" seek_end; 88 | def "truncate" truncate; 89 | def "write" write; 90 | def "read" read; 91 | def "sleep" sleep; 92 | std 93 | ) 94 | form 95 | 96 | \code=(remove path) 97 | say [(eq code 0 "Removed" "Could not remove")" "path] 98 | fclose fh 99 | ) 100 | 101 | show_base_dir "src/lib" 102 | 103 | ( 104 | demo_seek "vector" \; 105 | show_pos "open" 106 | seek_set 0 107 | truncate 100 108 | seek_set 10 109 | write "abcdefghijklmnopqrstuvwxyz" 110 | if F (sleep 5) # Use this to test locking. 111 | seek_cur -3 112 | write "XYZ" 113 | seek_end -20 114 | write "12345" 115 | seek_set 10 116 | read 16 117 | read 0 118 | read 10 119 | seek_end -3 120 | write "ABC" 121 | seek_end -3 122 | read 10 123 | ) 124 | 125 | # Test the flook and slook functions. 126 | \\try_look= 127 | ( 128 | \run= 129 | (\\get\\look 130 | get 131 | get 132 | look 133 | look 134 | get 135 | get 136 | look 137 | get 138 | look 139 | look 140 | get 141 | get 142 | get 143 | look 144 | ) 145 | 146 | \try= 147 | (\\get\\look\\in 148 | 149 | \\get =(\ch=(get in) say ["get "ch]) 150 | \\look=(\ch=(look in) say ["at "ch]) 151 | 152 | run get look 153 | ) 154 | 155 | \\try_file= 156 | ( 157 | say "= file" 158 | \source=(path_under dir_base "src/test/data.txt") 159 | 160 | \fh=( 161 | \fh=(fopen source "r") 162 | if (is_undef fh) (error ["Could not open "source]) 163 | fh 164 | ) 165 | 166 | try fgetc flook fh 167 | ) 168 | 169 | \\try_str= 170 | ( 171 | say "= str" 172 | \str="#abcdefghijklmnopqrstuvwxyz" 173 | \in=(readstr str) 174 | try sgetc slook in 175 | ) 176 | 177 | try_file 178 | try_str 179 | ) 180 | 181 | try_look 182 | -------------------------------------------------------------------------------- /src/test/b16.fxl: -------------------------------------------------------------------------------- 1 | # Test run_filter. 2 | 3 | \\get_date=(trim_end_spaces; run_filter ["/bin/date"] "") 4 | 5 | # Calculate the message digest with a given algorithm, e.g. MD5, SHA1, SHA256, 6 | # etc. 7 | \gpg_digest= 8 | (\algo\str 9 | trim_end_spaces; 10 | run_filter 11 | ["/usr/bin/gpg" "--print-md" algo] 12 | str 13 | ) 14 | 15 | \gpg_sha256=(gpg_digest "sha256") 16 | 17 | #say ["date "(as_str get_date)] 18 | #say (run_filter ["/usr/bin/gpg" "--print-mds"] "") 19 | 20 | \\test_gpg_sha256= 21 | ( 22 | say "= test_gpg_sha256" 23 | \try= 24 | (\text\expect 25 | \result=(gpg_sha256 text) 26 | say ["result "(as_str result)] 27 | if (ne result expect) 28 | ( 29 | say ["expect "(as_str expect)] 30 | nl 31 | ) 32 | ) 33 | 34 | try 35 | "" 36 | "E3B0C442 98FC1C14 9AFBF4C8 996FB924 27AE41E4 649B934C A495991B 7852B855" 37 | 38 | try 39 | "a" 40 | "CA978112 CA1BBDCA FAC231B3 9A23DC4D A786EFF8 147C4E72 B9807785 AFEE48BB" 41 | 42 | try 43 | "abc" 44 | "BA7816BF 8F01CFEA 414140DE 5DAE2223 B00361A3 96177A9C B410FF61 F20015AD" 45 | 46 | try 47 | "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" 48 | "248D6A61 D20638B8 E5C02693 0C3E6039 A33CE459 64FF2167 F6ECEDD4 19DB06C1" 49 | 50 | try 51 | (repeat_str "z" 127) 52 | "87CDEB38 0917879F CD4C3B86 9AD644CB C7CBC6FF 36B989CD 4FE0F812 3C13CA19" 53 | 54 | try 55 | (repeat_str "z" 128) 56 | "8169C725 EDD39F00 140FFCF5 7C45B9C5 143E2FFE 375869E4 CF280534 2715D2B1" 57 | 58 | try 59 | (repeat_str "z" 256) 60 | "FCC01087 70388F35 2679507F FCF73B79 716E81FF 5C20F9BF 5257AF73 7D001514" 61 | 62 | try 63 | (repeat_str "a" 1000000) 64 | "CDC76E5C 9914FB92 81A1C7E2 84D73E67 F1809A48 A497200E 046D39CC C7112CD0" 65 | ) 66 | 67 | test_gpg_sha256 68 | -------------------------------------------------------------------------------- /src/test/b17.fxl: -------------------------------------------------------------------------------- 1 | # 2 | extend (load "test.fxl"; std) \; 3 | 4 | \show_result= 5 | ( 6 | \show= 7 | (\label\text 8 | say label 9 | say "[" 10 | put text 11 | say "]" 12 | ) 13 | 14 | \out\err\status 15 | show "out:" out 16 | show "err:" err 17 | # Showing status more portably here. Sometimes error codes on abnormal 18 | # termination can vary between systems. 19 | say ["status: "(eq status 0 "good" "fail")] 20 | nl 21 | ) 22 | 23 | \\test_run_function= 24 | ( 25 | run_test "test_run_function"; 26 | 27 | \try= 28 | (\\child_fn\input 29 | run_function child_fn input show_result 30 | ) 31 | 32 | try 33 | ( 34 | say "hello" 35 | trace "complain 1" 36 | \x=(value std; parse stdin "") 37 | say ["x = "(as_str x)] 38 | 39 | trace "complain 2" 40 | say "bye" 41 | ) 42 | "123" 43 | 44 | try 45 | ( 46 | ) 47 | "" 48 | 49 | try 50 | ( 51 | say "hello" 52 | error "oops" 53 | ) 54 | "" 55 | 56 | # Test running out of memory. 57 | try 58 | ( 59 | limit_memory 4000000 60 | limit_stack 1000000 61 | 62 | # Make a nasty function that consumes an unbounded amount of memory. 63 | \\inf= 64 | ( 65 | \S=(\\x\\y\\z x z; y z) # Define the "fusion" operator. 66 | @ S S S # Apply fixpoint to the fusion operator in a weird way. 67 | ) 68 | 69 | # Invoke that function. 70 | inf 71 | ) 72 | "" 73 | 74 | if F 75 | ( 76 | # Test running out of time. 77 | # This test is disabled to avoid slowing the test suite. 78 | try 79 | ( 80 | limit_time 1 81 | @ I 82 | ) 83 | "" 84 | ) 85 | ) 86 | 87 | \\test_run_program= 88 | ( 89 | run_test "test_run_program"; 90 | 91 | \try= 92 | (\code 93 | run_program [(argv 0)] code show_result 94 | ) 95 | 96 | try 97 | ~ 98 | say "hello" 99 | \x=(value std; parse stdin "") 100 | say ["x = "(as_str x)] 101 | trace "complain" 102 | error "oops" 103 | \# 104 | \a=(+ 246 3) 105 | \b=47 106 | (* a b) 107 | ~ 108 | 109 | try 110 | ~ 111 | say "BEG" 112 | trace "complain" 113 | say "END" 114 | ~ 115 | ) 116 | 117 | \\test_big_output= 118 | ( 119 | run_test "test_big_output"; 120 | \out=(grab_output; each (range 1 200000) (\_ put "x")) 121 | say ["grabbed "(length out)" bytes"] 122 | ) 123 | 124 | test_run_function 125 | test_run_program 126 | test_big_output 127 | -------------------------------------------------------------------------------- /src/test/b18.fxl: -------------------------------------------------------------------------------- 1 | # 2 | ( 3 | say "== benchmark nested" 4 | fexl_benchmark 5 | ( 6 | fexl_benchmark 7 | (/ (+ (* 27 34) (- 48 8)) 2) 8 | \val\steps\bytes 9 | say ["inner: val "val" steps "steps" bytes "bytes] 10 | val 11 | ) 12 | \val\steps\bytes 13 | say ["outer: val "val" steps "steps" bytes "bytes] 14 | ) 15 | 16 | ( 17 | say "== benchmark large list" 18 | fexl_benchmark 19 | ( 20 | \tower= 21 | (@\\loop\n\x 22 | le n 0 x; 23 | loop (- n 1) (append x x) 24 | ) 25 | 26 | \x=["a"] 27 | \x=(tower 15 x) 28 | list_length x 29 | ) 30 | \val\steps\bytes 31 | say ["result: val "val" steps "steps" bytes "bytes] 32 | ) 33 | 34 | ( 35 | # NOTE that it can't be negative any more because I call clear_free_list in 36 | # the benchmark routine. 37 | say "== benchmark negative memory usage" 38 | \v=var_new 39 | \x="" 40 | var_put v x 41 | fexl_benchmark (var_put v void) \val\steps\bytes 42 | say ["result: val "val" steps "steps" bytes "bytes] 43 | ) 44 | -------------------------------------------------------------------------------- /src/test/b19.fxl: -------------------------------------------------------------------------------- 1 | # Test assoc list. 2 | 3 | show_benchmark; 4 | 5 | \add_random_keys= 6 | (@\\loop\count\seed\obj 7 | le count 0 obj; 8 | \hash=(sha512 seed) 9 | \key=(unpack; slice hash 0 8) 10 | \val=(unpack; slice hash 32 8) 11 | \obj=(push_key key val obj) 12 | loop (- count 1) hash obj 13 | ) 14 | 15 | \\obj=(add_random_keys 8192 "abcd" []) 16 | \obj=(sort_pairs obj) 17 | 18 | ( 19 | \key="7d13f23fa2b9a6fd" 20 | \val=(get_key key obj) 21 | say_data {key val} 22 | \obj=(put_key key "ffff" obj) 23 | \val=(get_key key obj) 24 | say_data {key val} 25 | \obj=(update_key key (. "aaaa") obj) 26 | \val=(get_key key obj) 27 | say_data {key val} 28 | ) 29 | 30 | ( 31 | shift obj \pair\_ 32 | put "first = " 33 | say_data pair 34 | ) 35 | 36 | ( 37 | shift (reverse obj) \pair\_ 38 | put "last = " 39 | say_data pair 40 | ) 41 | 42 | ( 43 | # Test group items by lower-case. 44 | say "= group_items" 45 | \xs=["A" "b" "c" "b" "a" "a" "a" "B" "c" "d" "C" "b" "a" "a"] 46 | say ["xs = "(as_str xs)] 47 | \ys=(group_items lc xs) 48 | say ["ys = "(as_str ys)] 49 | ) 50 | 51 | ( 52 | say "= merge_keys" 53 | # Test merge_keys. 54 | \xs=[{"a" 1} {"b" 2} {"d" 4} {"g" 7}] 55 | \ys=[{"a" -1} {"c" -3} {"d" -4} {"e" -5} {"f" -6}] 56 | merge_keys (\x\y {x y}) xs ys \L\M\R 57 | say ["xs = "(as_str xs)] 58 | say ["ys = "(as_str ys)] 59 | say ["L = "(as_str L)] 60 | say ["M = "(as_str M)] 61 | say ["R = "(as_str R)] 62 | ) 63 | 64 | ( 65 | say "= map_bytes_to_double" 66 | \try= 67 | (\bytes 68 | \x=(map_bytes_to_double bytes) 69 | say [(as_str bytes)" => "x] 70 | ) 71 | try [0 0 0 0 0 0 0] # 0 72 | try [255 255 255 255 255 255 63] # 0.25 73 | try [255 255 255 255 255 255 127] # 0.5 74 | try [27 220 180 171 62 7 156] # 0.609485546989945 75 | try [255 255 255 255 255 255 191] # 0.75 76 | try [193 214 112 19 131 147 234] # 0.916313354727062 77 | try [255 255 255 255 255 255 255] # 1 78 | ) 79 | -------------------------------------------------------------------------------- /src/test/b20.fxl: -------------------------------------------------------------------------------- 1 | # 2 | #trace_elapsed; 3 | show_benchmark; 4 | 5 | \\test_bn= 6 | ( 7 | \\test_ops= 8 | ( 9 | \run_test= 10 | ( 11 | \show=(\k\v say [k" = "v]) 12 | 13 | \label\fn 14 | say ["= test "label] 15 | 16 | \try= 17 | (\x\y 18 | \x=(bn_from_dec x) 19 | \y=(bn_from_dec y) 20 | \z=(fn x y) 21 | show "x" x 22 | show "y" y 23 | show "z" z 24 | nl 25 | ) 26 | 27 | \try2=(\x try x x) 28 | 29 | try "0" "0" 30 | try "1" "1" 31 | try "10002" "10003" 32 | try "12370356088" "15123" 33 | try "123470356088" "15123" 34 | try "26019123470356088" "1049752133674165355933" 35 | try2 "999999999999999999999999" 36 | try2 "1111111111111111111111111111111111111111111111111" 37 | ) 38 | 39 | run_test "add" bn_add 40 | run_test "mul" bn_mul 41 | 42 | ( 43 | # Compute 2^256. 44 | \x=(bn_from_dec "2") # 2^1 45 | \x=(bn_mul x x) # 2^2 46 | \x=(bn_mul x x) # 2^4 47 | \x=(bn_mul x x) # 2^8 48 | \x=(bn_mul x x) # 2^16 49 | \x=(bn_mul x x) # 2^32 50 | \x=(bn_mul x x) # 2^64 51 | \x=(bn_mul x x) # 2^128 52 | \x=(bn_mul x x) # 2^256 53 | \s=(bn_to_dec x) 54 | say s 55 | say (length s) 56 | ) 57 | ) 58 | 59 | \\test_convert= 60 | ( 61 | \try= 62 | (\x 63 | \xn=(bn_from_dec x) 64 | \y=(bn_to_dec xn) 65 | say [(as_str x)" "(as_str y)] 66 | ) 67 | 68 | say "= test convert" 69 | try "0" 70 | try "1" 71 | try "1234" 72 | try "9999" 73 | try "00" 74 | try "1234567890123456789012" 75 | try "1234567890" 76 | try "000000123" 77 | # Test some errors. 78 | # LATER 20211110 These don't map to void anymore, but perhaps they should. 79 | try "" 80 | try "x" 81 | try "x1234" 82 | try "12345abc90123456789012" 83 | nl 84 | ) 85 | 86 | test_ops 87 | test_convert 88 | ) 89 | 90 | test_bn 91 | -------------------------------------------------------------------------------- /src/test/b21.fxl: -------------------------------------------------------------------------------- 1 | # 2 | say "=== Test new rules for numeric constants" 3 | 4 | \try= 5 | (\x 6 | \n=(str_num x) 7 | say ["str_num "QU x QU" = "(is_undef n "void" n)] 8 | ) 9 | 10 | say "= test good" 11 | try "0" 12 | try "-0" 13 | try "123.4567" 14 | try "0123.4567" 15 | try "00123.4567" 16 | try "-00123.4567" 17 | try "0.5" 18 | try ".5" 19 | try "-.5" 20 | try "+.5" 21 | try "-.5e-2" 22 | try "-.567E-2" 23 | try "-.567E+2" 24 | try "-.567E2" 25 | try "+.567E2" 26 | 27 | try "-3.6" 28 | try "+3.6" 29 | try "+3." # weird but whatever 30 | try "+3" 31 | try "+0" 32 | nl 33 | 34 | say "= test bad" 35 | try "" 36 | try "." 37 | try "-" 38 | try "+" 39 | try "--" 40 | try "-+" 41 | try "+-" 42 | try "+." 43 | 44 | try "4.8 5" 45 | try " 4.8" 46 | try "4.8 " 47 | 48 | try "-+3.6" 49 | try "+-3.6" 50 | try "-2.3x" 51 | try "3.6x" 52 | try "3.6 " 53 | try "inf" 54 | try "nan" 55 | 56 | # The worst. 57 | try "-inf" 58 | try "-nan" 59 | nl 60 | -------------------------------------------------------------------------------- /src/test/b22.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | say "== test Fibonacci" 5 | 6 | # (fib n) returns the nth Fibonacci number starting at 0. 7 | \fib= 8 | ( 9 | \memo=cache 10 | @\\fib\n 11 | le n 1 (eq n 1 1 0); 12 | memo n; 13 | + (fib (- n 1)) (fib (- n 2)) 14 | ) 15 | 16 | \try= 17 | (\x\y 18 | div 19 | each (range x y) \n 20 | say ["fib " n " = " (fib n)] 21 | ) 22 | 23 | show_benchmark; 24 | try 8 0 25 | try 54 73 # Show the last 20 that don't use "e" notation. 26 | -------------------------------------------------------------------------------- /src/test/b23.fxl: -------------------------------------------------------------------------------- 1 | # Ensure loading of all libraries. 2 | \_ 3 | say + - # core 4 | use if # extra 5 | and or not # bool 6 | neg max # math 7 | map sort_all # list 8 | as_str trim_spaces # format 9 | say_data # indent 10 | get_key put_key # assoc 11 | oct hex # hex 12 | tag tr # html 13 | trace_elapsed # time 14 | split_date day_of_week # date 15 | grab_output # run 16 | read_file # read 17 | read_csv_file # read_csv 18 | read_ssv_file # read_ssv 19 | -------------------------------------------------------------------------------- /src/test/b24.fxl: -------------------------------------------------------------------------------- 1 | # Test the "die" function. 2 | say "hi" 3 | die 4 | say "bye" 5 | -------------------------------------------------------------------------------- /src/test/b44.fxl: -------------------------------------------------------------------------------- 1 | # Infinite list of null strings. 2 | \\list=(@; cons "") 3 | \\list=(first 100000 list) 4 | 5 | ( 6 | show_benchmark; 7 | say list 8 | ) 9 | 10 | ( 11 | show_benchmark; 12 | fsay stdout list 13 | ) 14 | -------------------------------------------------------------------------------- /src/test/b45.fxl: -------------------------------------------------------------------------------- 1 | # Demonstrate built-in "with". 2 | 3 | # Convert a value to a string with no indentation. 4 | \val_str= 5 | ( 6 | # The single "=" above means I use the same buffer every time. 7 | \buf=buf_new 8 | \put=(buf_put buf) 9 | \\nl=(put NL) 10 | 11 | \show_key= 12 | (\key 13 | is_str key (put (fexl_quote key)); 14 | is_num key (put (num_str key)); 15 | put "?" 16 | ) 17 | 18 | \obj 19 | 20 | \\show_pairs= 21 | (@\\show_pairs\obj 22 | 23 | \\show_val= 24 | (@\\show_val\val 25 | 26 | is_obj val 27 | ( 28 | put "(" nl 29 | show_pairs val 30 | put ")" 31 | ); 32 | 33 | is_undef val (put "void"); 34 | is_num val (put (num_str val)); 35 | is_str val (put (fexl_quote val)); 36 | is_bool val (put (val "T" "F")); 37 | 38 | \\show_list= 39 | (\beg\val\end 40 | put beg nl 41 | each val (\item show_val item nl) 42 | put end 43 | ) 44 | 45 | is_list val (show_list "[" val "]"); 46 | is_tuple val (show_list "{" (tuple_to_list val) "}"); 47 | put "?" 48 | ) 49 | 50 | is_obj obj 51 | ( 52 | split_obj obj \key\val\obj 53 | 54 | put "with " 55 | show_key key 56 | 57 | ( 58 | is_list val nl; 59 | is_obj val nl; 60 | is_tuple val nl; 61 | put " " 62 | ) 63 | 64 | show_val val 65 | put ";" nl 66 | 67 | show_pairs obj 68 | ); 69 | show_val obj 70 | nl 71 | ) 72 | 73 | show_pairs obj 74 | buf_get buf 75 | ) 76 | 77 | show_benchmark; 78 | 79 | \obj= 80 | ( 81 | \q="q" 82 | 83 | with "x" (+ 0 1); 84 | with "y" 2; 85 | with 3 "whatever"; 86 | with q (put "!" . q q); 87 | with "obj" 88 | ( 89 | with "a" 11; 90 | with "b" 22; 91 | with "c" I; 92 | void 93 | ); 94 | with "list" 95 | [ 96 | 2 97 | "abc" 98 | void 99 | ( 100 | with "a" 47; 101 | with "b" 82; 102 | void 103 | ) 104 | ]; 105 | with "flag" (I I T); 106 | with "tuple" {"a" 2 [{"c" 3} {"d" 4}] (with "x" 3; void)}; 107 | (I I) 108 | ) 109 | 110 | \\test_1= 111 | ( 112 | say "= test_1" 113 | \try= 114 | (\x 115 | \y=(obj x) 116 | say [x" => "y] 117 | ) 118 | 119 | \\run= 120 | ( 121 | try "x" 122 | try 3 123 | try "y" 124 | try "q" 125 | try "z" 126 | nl 127 | ) 128 | 129 | run 130 | run 131 | run 132 | ) 133 | 134 | \\test_2= 135 | ( 136 | say "= test_2" 137 | \try= 138 | (\obj 139 | \str=(val_str obj) 140 | say "====" 141 | put str 142 | ) 143 | 144 | try obj 145 | try (obj "y") 146 | try (obj 3) 147 | try (obj "obj") 148 | try (obj "list") 149 | try (obj "z") 150 | try (obj "obj" "b") 151 | try (obj "obj" "z") 152 | try (I void) 153 | ) 154 | 155 | test_1 156 | test_2 157 | -------------------------------------------------------------------------------- /src/test/b46.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \list= 3 | [ 4 | {"0793" F "1b03" -0.00626248} 5 | {"5ac2" F "8ea2" 354.786772998} 6 | 7 | [ 8 | {"754b" F "5355" -298.39702075} 9 | {"93cf" [T F "47fd" {0.5 0.7}]} 10 | 11 | ["a" "b" 12 | ["44f0" F void 0.16087] 13 | 14 | [ 15 | {"892a" T "b66f" 0.1509} 16 | {"08c4" F "26cd" -277.02636296} 17 | ] 18 | 19 | {"3773" T "eaaf" 0.47} 20 | {"f6c5" F "bbac" -862.881225} 21 | ] 22 | 23 | {"da65" F "40c7" -271.33529785} 24 | {"1ab2" F "1a75" 0.14143} 25 | ] 26 | 27 | {"04fc" F "9870" 0.08} 28 | {"5149" F "aec0" -146.35314} 29 | {"a" ["b" "c"] "d"} 30 | ] 31 | 32 | show_benchmark; 33 | 34 | say_data list 35 | say (eq_data list list) 36 | 37 | \x=(i_as_str list) 38 | say ["length = "(length x)] 39 | 40 | \x= 41 | [ 42 | {"a
b&e" "c" 3 ~ "hey"~} 43 | {"409b" F "9f11" -0.00626248} 44 | {"f092" T "a9&5" 354.786772998} 45 | void 46 | ["a" "b" "c" {2 4} 7 [1 {2 3} 4]] 47 | ] 48 | 49 | say "==" 50 | put_data x nl 51 | 52 | say "==" 53 | fsay_data stdout (quote x) 54 | 55 | say "==" 56 | put_quote_data x nl 57 | 58 | say "==" 59 | i_render_data (\x put (quote x)) nl x 60 | 61 | # Ensure single evaluation of list items. 62 | say "==" 63 | say_data 64 | [ 65 | [ 66 | "a" 67 | (put "(1)" ["b"]) 68 | [ (put "(2)" ["c"]) ] 69 | ] 70 | ] 71 | -------------------------------------------------------------------------------- /src/test/b47.fxl: -------------------------------------------------------------------------------- 1 | # 2 | show_benchmark; 3 | 4 | \x=[] 5 | \x=(put_key "a" 0 x) 6 | \x=(put_key "b" 0 x) 7 | \x=(put_key "c" 0 x) 8 | 9 | \x=(put_key "a" 1 x) 10 | \x=(put_key "b" 2 x) 11 | \x=(put_key "c" 3 x) 12 | 13 | \x=(push_key "d" 4 x) 14 | \x=(push_key "e" 5 x) 15 | 16 | say_data x 17 | \x=(del_key "x" x) 18 | \x=(del_key "d" x) 19 | \x=(del_key "c" x) 20 | say_data x 21 | 22 | \x=(update_key "a" (* 10) x) 23 | \x=(update_key "b" (+ 5) x) 24 | \x=(add_key "c" 1 x) 25 | \x=(add_key "c" 20 x) 26 | say_data x 27 | 28 | \x= 29 | ( 30 | update_values 31 | (\key\val 32 | eq key "b" (+ 8 val); 33 | val 34 | ) 35 | x 36 | ) 37 | say_data x 38 | 39 | \x=(put_default "c" 0 x) 40 | \x=(put_default "d" 4 x) 41 | say_data x 42 | 43 | \y=(name_columns ["a" "b" "c"] [1 2 3]) 44 | say_data y 45 | 46 | \x=(sort_pairs x) 47 | say_data x 48 | -------------------------------------------------------------------------------- /src/test/b50.fxl: -------------------------------------------------------------------------------- 1 | # More big number tests. 2 | 3 | # Convert x to bn. 4 | \to_bn= 5 | (\x 6 | is_bn x x; 7 | is_str x (bn_from_dec x); 8 | is_num x (bn_from_dec; num_str x); 9 | void 10 | ) 11 | 12 | \op1=(\f\x f (to_bn x)) 13 | \op2=(\f\x\y f (to_bn x) (to_bn y)) 14 | 15 | # Redefine math operations. 16 | \is_neg=(op1 bn_is_neg) 17 | \neg=(op1 bn_neg) 18 | \+=(op2 bn_add) 19 | \-=(op2 bn_sub) 20 | \*=(op2 bn_mul) 21 | \/=(op2 bn_div) 22 | \mod=(op2 bn_mod) 23 | \gcd=(op2 bn_gcd) 24 | 25 | \\test_neg= 26 | ( 27 | say "= test_neg" 28 | 29 | \try= 30 | (\x 31 | \n=(neg x) 32 | say ["x = "x" "(is_neg x)] 33 | say ["n = "n" "(is_neg n)] 34 | nl 35 | ) 36 | 37 | try "0" 38 | try "12345678901234567890" 39 | try "-12345678901234567890" 40 | ) 41 | 42 | \\test_mod= 43 | ( 44 | say "= test_mod" 45 | 46 | \try= 47 | (\x\y 48 | \r=(mod x y) 49 | say ["x = "x] 50 | say ["y = "y] 51 | say ["r = "r] 52 | nl 53 | ) 54 | 55 | \try_remain= 56 | (\r\x\y 57 | \x=(+ r; * x y) 58 | try x y 59 | 60 | try (neg x) y 61 | try x (neg y) 62 | try (neg x) (neg y) 63 | ) 64 | 65 | show_benchmark; 66 | 67 | try 0 0 68 | try 5 0 69 | try_remain 3 6 4 70 | 71 | try_remain 72 | "676419180088961" 73 | "483821237146311133505379712529943563587985318719415739434420" 74 | "607409070885787798697231238307407918220381194430305060466216" 75 | 76 | try_remain 77 | "425145742545503" 78 | "807866304067976453998200530991202444816717925831816151952175" 79 | "472380607152644796929990208481229628125327307202280723444810" 80 | ) 81 | 82 | \\test_gcd= 83 | ( 84 | say "= test_gcd" 85 | 86 | \try= 87 | (\a\b 88 | \d=(gcd a b) 89 | say ["a = "a] 90 | say ["b = "b] 91 | say ["d = "d] 92 | nl 93 | ) 94 | 95 | \try_scale= 96 | (\d\x\y 97 | try (* d x) (* d y) 98 | ) 99 | 100 | show_benchmark; 101 | 102 | try 0 0 103 | try 33 0 104 | try 0 37 105 | try 33 27 106 | 107 | try 108 | "50860490530967516571516407928019598417864713724864677692680" 109 | "644100622841993554501404615178362907548620926258092121981762" 110 | 111 | try 112 | "644100622841993554501404615178362907548620926258092121981762" 113 | "644100622841993554501404615178362907548620926258092121981762" 114 | 115 | try 116 | "54275991115198175608185487523256592210742336399569676224470" 117 | "7642103907676325916847042230817601" 118 | 119 | try_scale 4 27 55 120 | try_scale 4 27 66 121 | 122 | try_scale 123 | "6560921" # prime 124 | "915576476760754300126302052277" # prime 125 | "605978786957295397256640766063" # prime 126 | 127 | try_scale 128 | "977668463783463" 129 | "529140713142509435817924385477685453040519148287032524280423" 130 | "202419417755773900762505824273593838156669421461250599902073" 131 | 132 | try_scale 133 | "71163795281382935382030235135765305428163093553988463832487" 134 | "30729177463681358262286046038410429463619174254425788284414" 135 | "500448635501697772947675570477918323912846582856880078653" 136 | 137 | try 138 | "86320705019595883540722848693944916952826792635" 139 | "1" 140 | 141 | try 142 | "86320705019595883540722848693944916952826792635" 143 | "0" 144 | 145 | try 146 | "177431137062530148707035590301" # prime 147 | "37" # prime 148 | 149 | try 150 | "134121159551089938749733980473" # prime 151 | "404266037114047" # prime 152 | 153 | try_scale 154 | "934251847319859309750839139790710181170853619816293829491849" 155 | "423970011031047" 156 | "063103847305188720070914890909414003867134634859996615370496" 157 | ) 158 | 159 | test_neg 160 | test_mod 161 | test_gcd 162 | say "END" 163 | -------------------------------------------------------------------------------- /src/test/b51.fxl: -------------------------------------------------------------------------------- 1 | # 2 | ( 3 | say "= Direct substitution" 4 | ( 5 | \\x=(put "(CALC) " + 2 3) 6 | say ["x = "x] 7 | say ["x = "x] 8 | nl 9 | ) 10 | ( 11 | \try= 12 | (\\x 13 | say ["x = "x] 14 | say ["x = "x] 15 | ) 16 | try (put "(CALC) " + 2 3) 17 | nl 18 | ) 19 | ) 20 | 21 | ( 22 | say "= Eager substitution" 23 | ( 24 | \x=(put "(CALC) " + 2 3) 25 | say ["x = "x] 26 | say ["x = "x] 27 | nl 28 | ) 29 | ( 30 | \try= 31 | (\x 32 | say ["x = "x] 33 | say ["x = "x] 34 | ) 35 | try (put "(CALC) " + 2 3) 36 | nl 37 | ) 38 | ) 39 | 40 | -------------------------------------------------------------------------------- /src/test/b53.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | \run_case= 5 | (\label\text 6 | run_test label (run_fexl_text text) 7 | ) 8 | 9 | ( 10 | run_case "test_1" 11 | ~ 12 | extend 13 | ( 14 | def "say" say; 15 | def "put" put; 16 | def "nl" nl; 17 | def "fred" (say "I am Fred."); 18 | def "wilma" (say "I am Wilma."); 19 | void 20 | ) 21 | \; 22 | say "Hello" 23 | put "line 1" nl 24 | put "line 2" nl 25 | fred wilma 26 | fred wilma 27 | say "Bye" 28 | say "==" 29 | std "fred" \\fred 30 | fred fred 31 | ~ 32 | ) 33 | 34 | ( 35 | run_case "test_2" 36 | ~ 37 | value 38 | ( 39 | #def "say" say; 40 | def "put" put; 41 | def "nl" nl; 42 | #def "fred" (say "I am Fred."); 43 | #def "wilma" (say "I am Wilma."); 44 | void 45 | ) 46 | \; 47 | say "Hello" 48 | put "line 1" nl 49 | put "line 2" nl 50 | fred wilma 51 | fred wilma 52 | say "Bye" 53 | say "==" 54 | std "fred" \\fred 55 | fred fred 56 | ~ 57 | ) 58 | 59 | ( 60 | # Here's a case where the form has no symbols, so I don't even bother to 61 | # evaluate the context. 62 | run_case "test_3" 63 | ~ 64 | value 65 | ( 66 | say "HEY" # not printed 67 | void 68 | ) 69 | \; 70 | () ["a" "b" 3.6] 71 | ~ 72 | ) 73 | -------------------------------------------------------------------------------- /src/test/beer.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \bottles= 3 | (\n\wall 4 | \\s=(eq n 1 "" "s") 5 | say [n " bottle"s " of beer" (wall (" on the wall") "")] 6 | ) 7 | 8 | \sing= 9 | (\n 10 | each (range n 1) \n 11 | bottles n T 12 | bottles n F 13 | say "Take one down, pass it around" 14 | bottles (- n 1) T 15 | nl 16 | ) 17 | sing 3 18 | -------------------------------------------------------------------------------- /src/test/big_hash.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | # Reference: https://www.di-mgt.com.au/sha_testvectors.html 5 | # Test the extremely-long message. 6 | 7 | # About 3.8s to buffer. 8 | \text=(show_microtime "buffer"; 9 | repeat_str 10 | "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno" 16777216) 11 | 12 | # Test sha512. 13 | ( 14 | # About 2.4s to hash. 15 | \hash=(show_microtime "sha512"; sha512 text) 16 | say "sha512" 17 | put "text = " say "(the extremely-long message)" 18 | put "hash = " show_hex hash 19 | nl 20 | ) 21 | # Test sha256. 22 | ( 23 | # About 3.5s to hash. 24 | \hash=(show_microtime "sha256"; sha256 text) 25 | say "sha256" 26 | put "text = " say "(the extremely-long message)" 27 | put "hash = " show_hex hash 28 | nl 29 | ) 30 | -------------------------------------------------------------------------------- /src/test/big_hash.out: -------------------------------------------------------------------------------- 1 | time buffer = 3820836 us 2 | time sha512 = 2386960 us 3 | sha512 4 | text = (the extremely-long message) 5 | hash = 64:[b47c933421ea2db149ad6e10fce6c7f93d0752380180ffd7f4629a712134831d77be6091b819ed352c2967a2e2d4fa5050723c9630691f1a05a7281dbe6c1086] 6 | 7 | time sha256 = 3529919 us 8 | sha256 9 | text = (the extremely-long message) 10 | hash = 32:[50e72a0e26442fe2552dc3938ac58658228c0cbfb1d2ca872ae435266fcd055e] 11 | 12 | -------------------------------------------------------------------------------- /src/test/chars.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | \try= 5 | (\str 6 | \raw=(pack str) 7 | \test=(unpack raw) 8 | say [str " " raw " " test] 9 | ) 10 | 11 | div 12 | \doubled=(str_map (\ch . ch ch) "封a小") 13 | say doubled 14 | say (is_str doubled) 15 | div 16 | #try "07" # BEL (beeps) 17 | try "41" # A 18 | try "4f" # O 19 | try "4F" # O 20 | try "61" # a 21 | try "62" # b 22 | try "7e" # ~ 23 | try "c3a5" # å 24 | try "c3bc" # ü 25 | try "c3a4" # ä 26 | try "C3A4" # ä 27 | try "e289a0" # ≠ 28 | try "e5b081" # 封 29 | try "e5b08f" # 小 30 | try "e5b08161e5b08f" # 封a小 31 | 32 | div 33 | \try=(\x\y say; xor_hex x y) 34 | 35 | try 36 | "b6688fbe173973c25c0d922d13ef6e33" 37 | "9ed1051bcdff0debf580bb0deafa6e85" 38 | 39 | try 40 | "B6688FbE173973C25C0D922D13EF6E33" 41 | "9ED1051BcdfF0DEBF580BB0DEAFA6E85" 42 | 43 | try "B" "9" 44 | try "" "" 45 | try "c3f0a" "a5f05" 46 | -------------------------------------------------------------------------------- /src/test/check: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ./fexl test/check.fxl $@ 3 | -------------------------------------------------------------------------------- /src/test/check.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \list_all= 3 | [ 4 | "a1" 5 | "a2" 6 | "a3" 7 | "a4" 8 | "a5" 9 | "a8" 10 | "a9" 11 | "b10" 12 | "b11" 13 | "b12" 14 | "b13" 15 | "b14" 16 | "b15" 17 | "b16" 18 | "b17" 19 | "b18" 20 | "b19" 21 | "b20" 22 | "b21" 23 | "b22" 24 | "b23" 25 | "b24" 26 | "syntax" 27 | "b44" 28 | "b45" 29 | "b46" 30 | "b47" 31 | "b48" 32 | "b49" 33 | "b50" 34 | "b51" 35 | "b53" 36 | "leak" 37 | "chars" 38 | "crypto" 39 | "date" 40 | "get_byte" 41 | "mf" 42 | "missing" 43 | "partition" 44 | "sat" 45 | "sort" 46 | "stats" 47 | "stream" 48 | "resolve" 49 | "record" 50 | "index_C" 51 | ] 52 | 53 | # Gather any individually specified tests. 54 | \list= 55 | ( 56 | (@\\loop\n 57 | \x=(argv n) 58 | is_undef x []; 59 | \n=(+ 1 n) 60 | [x;loop n] 61 | ) 2 62 | ) 63 | 64 | \list=(is_null list list_all list) 65 | 66 | # Run a shell command with no input. 67 | \sh=(\cmd run_program ["/bin/sh" "-c" (to_str cmd)] "") 68 | 69 | \\refresh= 70 | ( 71 | \_=(mkdir "new" (oct "775")) 72 | each list 73 | (\name 74 | say ["refresh "name" "] 75 | sh [(argv 0)" test/show.fxl "name" >new/"name] 76 | \out\err\status 77 | ) 78 | ) 79 | 80 | \\check= 81 | ( 82 | each list 83 | (\name 84 | put ["test "name" "] 85 | sh [(argv 0)" test/show.fxl "name" | diff - out/"name] 86 | \out\err\status 87 | eq 0 status 88 | (say "good") 89 | ( 90 | say "failed" 91 | put out 92 | put err 93 | ) 94 | ) 95 | ) 96 | 97 | trace_elapsed; 98 | #refresh 99 | check 100 | -------------------------------------------------------------------------------- /src/test/client.fxl: -------------------------------------------------------------------------------- 1 | # This client connects to the server created by test/server.fxl. 2 | 3 | # (inc_ch ch) Increments the character by calling the server. 4 | \inc_ch= 5 | ( 6 | \fh=(connect "127.0.0.1" 2186) 7 | if (is_undef fh) (error "Could not connect") 8 | \\ch 9 | \ch=(slice ch 0 1) 10 | is_undef ch void; 11 | eq ch "" ""; 12 | fput fh ch 13 | fgetc fh 14 | ) 15 | 16 | \\try= 17 | (\\ch 18 | \ch2=(inc_ch ch) 19 | say ["inc "(unpack ch)" = "(unpack ch2)] 20 | ) 21 | 22 | say "Enter chars: (Ctrl-D to quit)" 23 | (@\\loop 24 | set_alarm 30 25 | \ch=(fgetc stdin) 26 | is_undef ch (); 27 | try ch 28 | loop 29 | ) 30 | 31 | say "BYE" 32 | -------------------------------------------------------------------------------- /src/test/data.txt: -------------------------------------------------------------------------------- 1 | #abcdefghijklmnopqrstuvwxyz 2 | #abcdefghijklmnopqrstuvwxyz 3 | #abcdefghijklmnopqrstuvwxyz 4 | -------------------------------------------------------------------------------- /src/test/date.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \\test_count_days= 3 | ( 4 | \try= 5 | (\beg\end 6 | \count=(count_days beg end) 7 | say ["count_days " beg " " end " = " count] 8 | ) 9 | \try= 10 | (\beg\end 11 | try beg end 12 | try end beg 13 | ) 14 | 15 | try "20160208" "20160301" # 22 16 | try "20160208" "20160229" # 21 17 | try "20160229" "20160229" # 0 18 | try "20160228" "20170228" # 366 19 | try "20170228" "20180228" # 365 20 | try "20160229" "20160208" # -21 21 | ) 22 | 23 | \\test_add_days= 24 | ( 25 | \try= 26 | (\beg\count 27 | \date=(add_days beg count) 28 | \n=(count_days beg date) 29 | say ["add_days " beg " " count " = "date " check "n " " 30 | (eq n count "good" "BAD")] 31 | ) 32 | 33 | try "20160208" 0 34 | try "20160208" 7 35 | try "20160208" 21 36 | try "20160208" 22 37 | try "20160208" 23 38 | try "20160208" 365 39 | try "20160101" 365 40 | try "20170101" 365 41 | 42 | try "20160301" -1 43 | try "20160302" -1 44 | try "20160302" -2 45 | try "20160302" -3 46 | try "20160302" -23 47 | try "20160302" -28 48 | try "20160302" -29 49 | try "20160302" -30 50 | try "20160302" -365 51 | ) 52 | 53 | \\test_day_of_week= 54 | ( 55 | \try= 56 | (\date 57 | \n=(day_of_week date) 58 | say ["dow " date " = "n] 59 | ) 60 | 61 | try "20160101" 62 | try "20160104" 63 | try "20160108" 64 | try "20160115" 65 | try "20160121" 66 | try "20160129" 67 | try "20160205" 68 | try "20160212" 69 | try "20160219" 70 | try "20160226" 71 | try "20160304" 72 | try "20160311" 73 | 74 | try "19631117" 75 | 76 | try "19631118" 77 | try "19631119" 78 | try "19631120" 79 | try "19631121" 80 | try "19631122" 81 | try "19631123" 82 | try "19631124" 83 | nl 84 | try "23000225" 85 | try "23000226" 86 | try "23000227" 87 | try "23000228" 88 | try "23000301" 89 | nl 90 | try "23040225" 91 | try "23040226" 92 | try "23040227" 93 | try "23040228" 94 | try "23040229" 95 | try "23040301" 96 | try "23040302" 97 | try "23040303" 98 | try "23040306" 99 | nl 100 | 101 | say_data (dow 2023 11 14) 102 | # Try some errors. 103 | say_data (dow "2023" 11 14) 104 | say_data (dow 2023 "11" 14) 105 | say_data (dow 2023 11 "14") 106 | nl 107 | ) 108 | 109 | \\test_add_year= 110 | ( 111 | \try= 112 | (\date 113 | \x=(add_year date) 114 | say ["add_year " date " = "x] 115 | ) 116 | try "20000228" 117 | try "20000229" # LATER 118 | try "20150228" 119 | try "20150301" 120 | nl 121 | ) 122 | 123 | show_benchmark; 124 | test_count_days 125 | test_add_days 126 | test_day_of_week 127 | test_add_year 128 | -------------------------------------------------------------------------------- /src/test/get_byte.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \\echo= 3 | (@\\echo 4 | \ch=(fgetc stdin) 5 | is_undef ch (); 6 | say ["ch " (hex_byte; ord ch)] 7 | echo 8 | ) 9 | say "[" 10 | echo 11 | say "]" 12 | -------------------------------------------------------------------------------- /src/test/hailstone.fxl: -------------------------------------------------------------------------------- 1 | # divide even by 2 2 | # odd: multiply by 3 and add 1 3 | 4 | \is_even=(\x eq 0; mod x 2) 5 | 6 | # https://en.wikipedia.org/wiki/Collatz_conjecture 7 | # The "hailstone sequence" 8 | \hailstone= 9 | (@\\loop\x 10 | [x; le x 1 []; loop (is_even x (/ x 2) (+ 1; * x 3))] 11 | ) 12 | 13 | \try= 14 | (\x 15 | each (hailstone x) (\x say ["x = " x]) 16 | nl 17 | ) 18 | 19 | show_benchmark; 20 | 21 | #try 3 22 | #try 4 23 | #try 5 24 | #try 19 25 | try 23 26 | #try 27 27 | #try 6171 28 | #try 9780657631 29 | -------------------------------------------------------------------------------- /src/test/hello.fxl: -------------------------------------------------------------------------------- 1 | say "Hello world!" 2 | -------------------------------------------------------------------------------- /src/test/index_C.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "lib/index_C/context.fxl"; std) \; 3 | 4 | \try_pairs= 5 | (\pairs 6 | say "function:" 7 | compile_pairs pairs 8 | nl 9 | ) 10 | 11 | \\test_0870= 12 | ( 13 | say "= test_0870" 14 | 15 | try_pairs 16 | [ 17 | ] 18 | ) 19 | 20 | \\test_0745= 21 | ( 22 | say "= test_0745" 23 | 24 | try_pairs 25 | [ 26 | {"" "0273"} 27 | {"a" "4563"} 28 | {"ab" "9685"} 29 | {"abc" "5498"} 30 | {"bc" "8976"} 31 | ] 32 | ) 33 | 34 | \\test_1197= 35 | ( 36 | say "= test_1197" 37 | 38 | try_pairs 39 | [ 40 | {"" "3785"} 41 | {"aa" "8060"} 42 | {"aaaabc" "9114"} 43 | {"aaabcc" "2014"} 44 | {"aaabcd" "7679"} 45 | {"aaacde" "3161"} 46 | {"abc" "7010"} 47 | {"abcd" "2936"} 48 | {"abcde" "7596"} 49 | {"abcdef" "2039"} 50 | {"abcdefg" "0825"} 51 | {"bba" "1569"} 52 | {"bbabc" "4682"} 53 | {"bbabd" "1863"} 54 | {"bbac" "8261"} 55 | {"bbacd" "1553"} 56 | {"bbacde" "6455"} 57 | {"bbacdf" "3986"} 58 | {"bbacef" "9370"} 59 | {"cab" "1546"} 60 | {"cac" "7869"} 61 | {"cacd" "1055"} 62 | {"e" "1067"} 63 | ] 64 | ) 65 | 66 | test_0870 67 | test_0745 68 | test_1197 69 | -------------------------------------------------------------------------------- /src/test/keystroke.fxl: -------------------------------------------------------------------------------- 1 | # Echo the characters from the input. 2 | \echo= 3 | (\\get @\\loop 4 | \ch=get 5 | is_undef ch (); 6 | eq (ord ch) 4 (); 7 | say ["ch = "(unpack ch)] 8 | loop 9 | ) 10 | 11 | \\interact= 12 | ( 13 | set_alarm 20 14 | say "Press Ctrl-D to stop." 15 | echo (fget stdin) 16 | say "DONE" 17 | ) 18 | 19 | say "Press some keys and I'll show you what you typed." 20 | receive_keystrokes interact 21 | 22 | say "Enter some lines of input and I'll show you what you typed." 23 | interact 24 | -------------------------------------------------------------------------------- /src/test/leak.fxl: -------------------------------------------------------------------------------- 1 | # Deliberately create a cycle in memory, which is only possible with a var. 2 | \v=var_new 3 | var_put v v 4 | -------------------------------------------------------------------------------- /src/test/lib/b15/context.fxl: -------------------------------------------------------------------------------- 1 | # 2 | extend 3 | ( 4 | load "lib/index/index.fxl"; 5 | load "lib/index/render.fxl"; 6 | load "lib/render/list.fxl"; 7 | load "lib/render/base.fxl"; 8 | std 9 | ) 10 | \; 11 | 12 | \render_val= 13 | (\val 14 | is_defined val (fexl_quote val) "void" 15 | ) 16 | 17 | \say_pairs= 18 | ( 19 | say_list 20 | (\row 21 | row \key\val 22 | say ["{" (fexl_quote key) " " (render_val val) "}"] 23 | ) 24 | ) 25 | 26 | \say_errors= 27 | ( 28 | say_list 29 | (\row 30 | row \key\val\val2 31 | say ["{" (fexl_quote key)" " (render_val val)" "(render_val val2)"}"] 32 | ) 33 | ) 34 | 35 | def "say_pairs" say_pairs; 36 | def "say_errors" say_errors; 37 | std 38 | -------------------------------------------------------------------------------- /src/test/lib/index/render.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \say_index= 3 | (@\\say_index 4 | say_list 5 | (\row 6 | row \is_leaf\key\val 7 | is_leaf 8 | ( 9 | say ["{T "(fexl_quote key) " " (fexl_quote val) "}"] 10 | ) 11 | ( 12 | say ["{F "(fexl_quote key)] 13 | indent (say_index val) 14 | say "}" 15 | ) 16 | ) 17 | ) 18 | 19 | def "say_index" say_index; 20 | std 21 | -------------------------------------------------------------------------------- /src/test/lib/index_C/context.fxl: -------------------------------------------------------------------------------- 1 | # Compile an index into C code. 2 | extend 3 | ( 4 | load "lib/render/C.fxl"; 5 | load "lib/render/base.fxl"; 6 | load "lib/index/index.fxl"; 7 | std 8 | ) 9 | \; 10 | 11 | # Process all the rows in an index. 12 | \do_rows= 13 | (@\\do_rows \checked_bound\pos\rows 14 | rows () \row\rows 15 | row \is_leaf\key\val 16 | 17 | \\check_ch= 18 | ( 19 | \ch=(slice key pos 1) 20 | checked_bound () (say ["if (n <= "(num_str pos)") return 0;"]) 21 | say ["if (x["(num_str pos)"] == '"ch"')"] 22 | ) 23 | 24 | \len=(length key) 25 | 26 | is_leaf 27 | ( 28 | \\do_strncmp= 29 | ( 30 | say ["if (n == "(num_str len)" && strncmp(x," 31 | (fexl_quote key)",n) == 0)"] 32 | indent (say ["return "(fexl_quote val)";"]) 33 | ) 34 | 35 | lt pos len 36 | ( 37 | check_ch 38 | scope 39 | ( 40 | do_strncmp 41 | say "return 0;" 42 | ) 43 | do_rows T pos rows 44 | ); 45 | eq len 0 46 | ( 47 | # Optimize null key. 48 | say ["if (n == "(num_str pos)")"] 49 | indent (say ["return "(fexl_quote val)";"]) 50 | do_rows T pos rows 51 | ) 52 | ( 53 | do_strncmp 54 | do_rows checked_bound pos rows 55 | ) 56 | ) 57 | ( 58 | check_ch 59 | scope 60 | ( 61 | do_rows F len val 62 | say "return 0;" 63 | ) 64 | do_rows T pos rows 65 | ) 66 | ) 67 | 68 | # (compile_index index) 69 | # Return C code which implements the index. 70 | \compile_index= 71 | (\index 72 | say "const char *lookup(const char *x, unsigned long n)" 73 | scope 74 | ( 75 | index 76 | ( 77 | # Special case for empty index. 78 | say "(void)x;" 79 | say "(void)n;" 80 | ) 81 | (\_\_ 82 | do_rows F 0 index 83 | ) 84 | say "return 0;" 85 | ) 86 | ) 87 | 88 | # (index_put_pairs pairs index) 89 | # Put all the {key val} pairs into the index. 90 | \index_put_pairs= 91 | (@\\loop\pairs\index 92 | pairs index \pair\pairs 93 | pair \key\val 94 | \index=(index_put key val index) 95 | loop pairs index 96 | ) 97 | 98 | # (compile_pairs pairs) 99 | # Return C code which looks up the key value pairs. 100 | \compile_pairs= 101 | (\pairs 102 | \index=(index_put_pairs pairs []) 103 | compile_index index 104 | ) 105 | 106 | def "compile_index" compile_index; 107 | def "index_put_pairs" index_put_pairs; 108 | def "compile_pairs" compile_pairs; 109 | std 110 | -------------------------------------------------------------------------------- /src/test/lib/render/C.fxl: -------------------------------------------------------------------------------- 1 | # Rendering C code. 2 | 3 | # Indent content in a block enclosed with braces. 4 | \scope= 5 | (\\content 6 | indent 7 | ( 8 | say "{" 9 | content 10 | say "}" 11 | ) 12 | ) 13 | 14 | def "scope" scope; 15 | std 16 | -------------------------------------------------------------------------------- /src/test/lib/render/base.fxl: -------------------------------------------------------------------------------- 1 | # Indented output 2 | 3 | \v_put=var_new 4 | \v_nl=var_new 5 | \v_say=var_new 6 | \v_tab=var_new 7 | 8 | \\put=(var_get v_put) 9 | \\nl=(var_get v_nl ()) 10 | \\say=(var_get v_say) 11 | 12 | # Indent content with a new tab stop. 13 | \indent= 14 | (\\content 15 | \tab=(var_get v_tab) 16 | var_put v_tab (. tab TAB) 17 | content 18 | var_put v_tab tab 19 | ) 20 | 21 | # Slide over to the current tab stop. 22 | \\tab=(put (var_get v_tab)) 23 | 24 | # Redirect output functions to a file handle. 25 | \set_output_fh= 26 | (\fh 27 | var_put v_tab "" 28 | var_put v_put (fput fh) 29 | var_put v_nl (yield; fnl fh) 30 | var_put v_say 31 | (\x 32 | fput fh (var_get v_tab) 33 | fsay fh x 34 | ) 35 | ) 36 | 37 | # Run content with output functions sent to a file handle. 38 | \use_output_fh= 39 | (\fh\\content 40 | 41 | \save_tab=(var_get v_tab) 42 | \save_put=(var_get v_put) 43 | \save_nl=(var_get v_nl) 44 | \save_say=(var_get v_say) 45 | 46 | set_output_fh fh 47 | content 48 | 49 | var_put v_tab save_tab 50 | var_put v_put save_put 51 | var_put v_nl save_nl 52 | var_put v_say save_say 53 | ) 54 | 55 | set_output_fh stdout 56 | 57 | def "put" put; 58 | def "nl" nl; 59 | def "say" say; 60 | def "indent" indent; 61 | def "tab" tab; 62 | def "use_output_fh" use_output_fh; 63 | std 64 | -------------------------------------------------------------------------------- /src/test/lib/render/list.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \say_list= 3 | (\say_row\list 4 | say "[" 5 | each list say_row 6 | say "]" 7 | ) 8 | 9 | def "say_list" say_list; 10 | std 11 | -------------------------------------------------------------------------------- /src/test/ls_bug/correct: -------------------------------------------------------------------------------- 1 | read.fxl 2 | read_csv.fxl 3 | read_ssv.fxl 4 | -------------------------------------------------------------------------------- /src/test/ls_bug/dir/read.fxl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chkoreff/Fexl/a41b5befaf2420b04ccda6805a3d791364cdfbcd/src/test/ls_bug/dir/read.fxl -------------------------------------------------------------------------------- /src/test/ls_bug/dir/read_csv.fxl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chkoreff/Fexl/a41b5befaf2420b04ccda6805a3d791364cdfbcd/src/test/ls_bug/dir/read_csv.fxl -------------------------------------------------------------------------------- /src/test/ls_bug/dir/read_ssv.fxl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chkoreff/Fexl/a41b5befaf2420b04ccda6805a3d791364cdfbcd/src/test/ls_bug/dir/read_ssv.fxl -------------------------------------------------------------------------------- /src/test/ls_bug/try: -------------------------------------------------------------------------------- 1 | # NOTE: There's a bug in ls on many Linux systems I have tried. As it turns 2 | # out, there's also a corresponding bug in sort. 3 | # 4 | # You can run this test script as "./try". When the bugs are fixed, there 5 | # should be no output. 6 | # 7 | # The man page says: 8 | # "Sort entries alphabetically if none of -cftuvSUX nor --sort is specified." 9 | # 10 | # Consequently if I run "ls -1 dir" I would expect the entries to be sorted 11 | # alphabetically. However, on my machine I see this output: 12 | # 13 | # read_csv.fxl 14 | # read.fxl 15 | # read_ssv.fxl 16 | # 17 | # Clearly the "read.fxl" should appear first because '.' is less than '_'. So 18 | # ls is not strictly doing what the man page says above. The "read.fxl" is out 19 | # of order. 20 | # 21 | # Note that even piping the output through "sort" does not correct the order, 22 | # which implies a deeper problem in a library. Indeed, when I reported this 23 | # finding to the PopOS maintainers at System76, they replied: 24 | # 25 | # "I notified the Pop!_OS maintainers. They let me know that we are using GNU 26 | # coreutils 8.13. We will be changing to 9.xx soon. I showed them the bug, 27 | # and they were just as excited as I was about it. Such a strange bug, but 28 | # also I commend you for having the keen eye to catch something like this." 29 | 30 | # NOTE 20240229 I researched GNU coreutils and found this explanaton: 31 | # https://www.gnu.org/software/coreutils/faq/coreutils-faq.html#Sort-does-not-sort-in-normal-order_0021 32 | 33 | # The next line is the fix they give: 34 | export LC_ALL=C 35 | 36 | # Try ls by itself. 37 | ls -1 dir | diff - correct 38 | 39 | # Try ls with sort. 40 | ls -1 dir | sort | diff - correct 41 | -------------------------------------------------------------------------------- /src/test/mf.fxl: -------------------------------------------------------------------------------- 1 | # https://en.wikipedia.org/wiki/Hofstadter_sequence#Hofstadter_Female_and_Male_sequences 2 | 3 | # Splice two functions into a feedback loop. 4 | \splice=(\\f\\g @\\x f (g x)) 5 | 6 | # Create the base of a male/female function. 7 | \create= 8 | (\base 9 | \memo=cache 10 | \\other 11 | @\\this\n 12 | le n 0 base; 13 | memo n; 14 | - n (other (this (- n 1))) 15 | ) 16 | 17 | \f1=(create 1) 18 | \f0=(create 0) 19 | 20 | \male= (splice f0 f1) 21 | \female= (splice f1 f0) 22 | 23 | #trace_elapsed; 24 | show_benchmark; 25 | 26 | \max=35 27 | #\max=1000 28 | 29 | \show_sequence= 30 | (\label\f 31 | say label 32 | each (range 0 max) (\n put [(f n) " "]) 33 | nl 34 | ) 35 | 36 | show_sequence "female" female 37 | show_sequence "male" male 38 | show_sequence "diff" (\n - (female n) (male n)) 39 | -------------------------------------------------------------------------------- /src/test/misc.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | ( 5 | \n=time 6 | say ["time "n" "(localtime n)] 7 | 8 | \try= 9 | (\name 10 | say (as_str [name (readlink name) (file_size name) (localtime; mod_time name)]) 11 | ) 12 | 13 | \_=(remove "test/obj") 14 | \_=(symlink "../../obj" "test/obj") 15 | 16 | try "test/obj" 17 | try "test/var.fxl" 18 | try "nothing" 19 | try "value.c" 20 | 21 | \_=(remove "test/obj") 22 | nl 23 | ) 24 | 25 | ( 26 | say random_double 27 | say random_double 28 | say random_double 29 | nl 30 | ) 31 | 32 | ( 33 | usleep 100000 34 | 35 | say microtime 36 | say microtime 37 | 38 | nl 39 | show_hex random_nonce 40 | show_hex random_nonce 41 | 42 | nl 43 | show_hex random_secret_key 44 | show_hex random_secret_key 45 | 46 | nl 47 | show_hex (random_bytes 32) 48 | show_hex (random_bytes 16) 49 | show_hex (random_bytes 1) 50 | show_hex (random_bytes 0) 51 | nl 52 | ) 53 | 54 | ( 55 | run_process 56 | ( 57 | trace "ERR 0" 58 | put "abcdefghijklmnop" 59 | fflush stdout 60 | sleep 1 61 | put "qrstuvwxyz" 62 | fflush stdout 63 | trace "ERR 1" 64 | trace "ERR 2" 65 | ) 66 | 67 | \child_in\child_out 68 | 69 | (@\\loop 70 | \text=(fread child_out 4) 71 | eq text "" (); 72 | say ["read: "(as_str text)] 73 | loop 74 | ) 75 | 76 | \status 77 | say ["status = "(as_str status)] 78 | ) 79 | -------------------------------------------------------------------------------- /src/test/partition.fxl: -------------------------------------------------------------------------------- 1 | # This demo was inspired by the Mathologer on Youtube. 2 | 3 | \use_bn=T # Use big numbers if true. 4 | 5 | use_bn 6 | ( 7 | \add=bn_add 8 | \one=(bn_from_dec "1") 9 | \rep=bn_to_dec 10 | {add one rep} 11 | ) 12 | ( 13 | \add=+ 14 | \one=1 15 | \rep=I 16 | {add one rep} 17 | ) 18 | 19 | \add\one\rep 20 | 21 | \partition= 22 | ( 23 | \memo=(remember 2) 24 | @\\partition\n\m 25 | le n 1 one; 26 | le m 1 one; 27 | \m=(min n m) 28 | memo n m; 29 | add (partition (- n m) m) (partition n (- m 1)) 30 | ) 31 | 32 | # Calculate the number of distinct ways to partition n into a sum of numbers. 33 | \partition=(\n partition n n) 34 | 35 | \show= 36 | (\n 37 | \v=(partition n) 38 | say [n" "(rep v)] 39 | ) 40 | 41 | \show_range=(\i\j each (range i j) show) 42 | 43 | #trace_elapsed; 44 | show_benchmark; 45 | 46 | show_range 0 20 47 | show 100 48 | show 200 49 | show 269 # Max that gives exact result without big numbers. 50 | show 270 51 | show 300 52 | #show 600 # use_bn T 0.33s F 0.33s 53 | -------------------------------------------------------------------------------- /src/test/resolve.fxl: -------------------------------------------------------------------------------- 1 | # Test the extend function. 2 | 3 | \\test_0= 4 | ( 5 | \try= 6 | ( 7 | \\cx=(say "Evaluating the context." std) 8 | \\form 9 | \\form=(say "Evaluating the form." form) 10 | \result=(value cx form) 11 | say ["result "(is_undef result "void" "ok")] 12 | nl 13 | ) 14 | 15 | say "== test_0" 16 | show_benchmark; 17 | 18 | # Test with bad form. 19 | try 3 20 | # Test good. 21 | try (\; say "Hello") 22 | ) 23 | 24 | \\test_1= 25 | ( 26 | say "== test_1" 27 | show_benchmark; 28 | 29 | extend 30 | ( 31 | say "Evaluating the context." 32 | def "F" F; 33 | def "if" if; 34 | def "fred" (say "I am Fred."); 35 | std 36 | ) 37 | ( 38 | say "Evaluating the form." 39 | \; 40 | extend std \; 41 | extend std \; 42 | extend std \; 43 | 44 | if F std 45 | fred 46 | ) 47 | ) 48 | 49 | \\test_2= 50 | ( 51 | say "== test_2" 52 | show_benchmark; 53 | 54 | # Test fancy extended standard context. 55 | extend 56 | ( 57 | # Define std to include a few extra functions. 58 | say "Evaluating the context." 59 | \speaker=(\name \x put name put " says " say x) 60 | def "fred" (speaker "Fred"); 61 | def "wilma" (speaker "Wilma"); 62 | def "goodbye" (say "Goodbye"); 63 | std 64 | ); 65 | 66 | say "Evaluating the form." 67 | \; 68 | # Now override one of the definitions. Not extending this time. 69 | value 70 | ( 71 | def "fred" (put "HEY: " fred); 72 | std 73 | ) 74 | \; 75 | 76 | # Now run this program in the enhanced context. 77 | say "Hi" 78 | say (+ 32 (* 5 5)) 79 | say (is_void void) 80 | fred "a" 81 | wilma "b" 82 | goodbye 83 | ) 84 | 85 | test_0 86 | test_1 87 | test_2 88 | -------------------------------------------------------------------------------- /src/test/sat.fxl: -------------------------------------------------------------------------------- 1 | # (SAT n f) return a list of solutions for function f with n variables. 2 | \SAT= 3 | (@\\SAT\n\f 4 | le n 0 (f [[]] []); 5 | \try=(\x map (cons x) (SAT (- n 1) (f x))) 6 | append (try T) (try F) 7 | ) 8 | 9 | # Print the solutions. 10 | \show_solutions= 11 | (\\list 12 | say "[" 13 | each list 14 | (\vars 15 | put "[" (each vars put) put "]" nl 16 | ) 17 | say "]" 18 | ) 19 | 20 | # Demo function. 21 | \SAT= 22 | (\n\f 23 | \\list=(SAT n f) 24 | show_solutions list 25 | nl 26 | ) 27 | 28 | show_benchmark; 29 | 30 | say "SAT 0 T" 31 | SAT 0 T 32 | 33 | say "SAT 0 F" 34 | SAT 0 F 35 | 36 | say "SAT 2 (\a\b and a b)" 37 | SAT 2 (\a\b and a b) 38 | 39 | say "SAT 2 (\a\b or a b)" 40 | SAT 2 (\a\b or a b) 41 | 42 | say "SAT 2 (\a\b or (not a) b)" 43 | SAT 2 (\a\b or (not a) b) 44 | 45 | say "SAT 4 (\a\b\c\d (and (or (and a d) c) (not (and b d))))" 46 | SAT 4 (\a\b\c\d (and (or (and a d) c) (not (and b d)))) 47 | 48 | say "SAT 17 ..." 49 | SAT 17 50 | (\_1\_2\_3\_4\_5\_6\_7\_8\_9\_10\_11\_12\_13\_14\_15\_16\_17 51 | and (_1); 52 | and (_2); 53 | and (not _3); 54 | and (_4); 55 | and (_5); 56 | and (not _6); 57 | and (_7); 58 | and (_8); 59 | and (not _9); 60 | and (_10); 61 | and (not _11); 62 | and (_12); 63 | and (_13); 64 | and (_14); 65 | and (_15); 66 | and (_16); 67 | and (_17); 68 | T 69 | ) 70 | -------------------------------------------------------------------------------- /src/test/server.fxl: -------------------------------------------------------------------------------- 1 | # This server reads a single character, increments it, and sends that back to 2 | # the client. You can connect to this using test/client.fxl. 3 | 4 | run_server (argv 2) "127.0.0.1" 2186 "test/error_log" 5 | (@\\loop 6 | \ch=(fgetc stdin) 7 | is_undef ch (); 8 | if (eq ch "a") 9 | ( 10 | trace ["SAW: "(unpack ch)] 11 | ) 12 | \ch=(chr; + 1; ord ch) 13 | put ch 14 | loop 15 | ) 16 | -------------------------------------------------------------------------------- /src/test/show: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ./fexl test/show.fxl $1 3 | -------------------------------------------------------------------------------- /src/test/show.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | \name=(argv 2) 5 | is_undef name (error "Missing test name"); 6 | 7 | # Test interactive script. 8 | eq name "a2" 9 | ( 10 | run_fexl_file name 11 | ~ 12 | abc 13 | defg 14 | 15 | hij 16 | åabcüdef 17 | üä 1≠0 包子 18 | ~ 19 | ); 20 | 21 | # Test interactive script. 22 | eq name "get_byte" 23 | ( 24 | run_fexl_file name 25 | ~ 26 | abcABC 27 | jjja小 28 | åüä≠ 29 | 包子 30 | ~ 31 | ); 32 | 33 | # Other normal tests run here. 34 | run_fexl_file name "" 35 | -------------------------------------------------------------------------------- /src/test/sort.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | show_benchmark; 5 | 6 | # (tower f n x) is the result of applying f to x n times. 7 | \tower= 8 | (\f @\\loop\n\x 9 | le n 0 x; 10 | loop (- n 1) (f x) 11 | ) 12 | 13 | # Test restricted evaluation by defining only the necessary functions. 14 | value 15 | ( 16 | def "append" append; 17 | def "show_list" show_list; 18 | def "sort" sort; 19 | def "tower" tower; 20 | def "unique" unique; 21 | void 22 | ) 23 | \; 24 | # Here I test the sort. 25 | 26 | # A list of 30 random words from diceware.com. 27 | \list= 28 | [ 29 | "when" 30 | "scud" 31 | "gibby" 32 | "babel" 33 | "skip" 34 | "sham" 35 | "rug" 36 | "expel" 37 | "grout" 38 | "perky" 39 | "jo" 40 | "piece" 41 | "ro" 42 | "haw" 43 | "revel" 44 | "qqqq" 45 | "bow" 46 | "blotch" 47 | "flam" 48 | "than" 49 | "subtly" 50 | "jess" 51 | "angie" 52 | "dewar" 53 | "polka" 54 | "ur" 55 | "eb" 56 | "am" 57 | "amra" 58 | "crown" 59 | ] 60 | 61 | # The number of times to double the list for the unique sort. 62 | \N= 63 | ( 64 | # NOTE: If you time these you'll see that the sort time is O(N). 65 | #7 # 3840 words 66 | #9 # 15360 words 67 | #10 # 30720 words 68 | 11 # 61440 words 69 | #12 # 122880 words 70 | #13 # 245760 words 71 | #14 # 491520 words 72 | #15 # 983040 words 73 | ) 74 | 75 | # (exp_list n xs) Make 2^n copies of list xs. 76 | \exp_list=(tower (\x append x x)) 77 | 78 | \show=show_list 79 | 80 | # Make two copies of the list and sort it. 81 | show (sort; exp_list 1 list) 82 | 83 | # Make 2^N copies of the list and show only the unique entries. 84 | show (unique; exp_list N list) 85 | -------------------------------------------------------------------------------- /src/test/stream.fxl: -------------------------------------------------------------------------------- 1 | # Test stream operations. 2 | 3 | \\test_1= 4 | ( 5 | \\read= 6 | ( 7 | say "READ" 8 | (@\\loop 9 | at_eof (); 10 | put look 11 | skip 12 | 13 | # Test nested stream. 14 | if T 15 | ( 16 | put "(" 17 | ( 18 | \\fh=(readstr "12") 19 | read_stream fh; 20 | @\\loop 21 | at_eof (); 22 | put look 23 | skip 24 | loop 25 | ) 26 | put ")" 27 | ) 28 | loop 29 | ) 30 | nl 31 | say ["line = "line] 32 | ["x" "y"] # Return fixed result. 33 | ) 34 | 35 | \try= 36 | (\fh 37 | \result=(read_stream fh read) 38 | say ["result = "(as_str result)] 39 | nl 40 | ) 41 | 42 | # Test the default empty stream. 43 | \\test_empty= 44 | ( 45 | say "EMPTY" 46 | say ["line "line] 47 | \\try= 48 | ( 49 | say ["x = "(as_str look)] 50 | skip 51 | ) 52 | 53 | try 54 | try 55 | nl 56 | ) 57 | 58 | show_benchmark; 59 | test_empty 60 | try "abcd" 61 | try (readstr "abcd") 62 | try (fopen "test/hello.fxl" "r") 63 | try 32 # invalid source 64 | 65 | try 66 | ~ 67 | line 1 68 | line 2 69 | line 3~ 70 | ) 71 | 72 | \\test_2= 73 | ( 74 | ( 75 | # Empty stream 76 | nl 77 | read_stream ""; 78 | say [at_eof (at_ch "")] 79 | skip 80 | say [at_eof (at_ch "")] 81 | ) 82 | ( 83 | # Stream with a single NUL character 84 | nl 85 | read_stream (chr 0); 86 | say [at_eof (at_ch "")] 87 | skip 88 | say [at_eof (at_ch "")] 89 | ) 90 | ( 91 | # Stream with multiple characters 92 | nl 93 | read_stream "abc"; 94 | say [at_eof (at_ch "a") (at_ch "x")] 95 | skip 96 | say [at_eof (at_ch "b") (at_ch "x")] 97 | skip 98 | say [at_eof (at_ch "c")] 99 | skip 100 | say [at_eof (at_ch "c")] 101 | ) 102 | ) 103 | 104 | test_1 105 | test_2 106 | say "DONE" 107 | -------------------------------------------------------------------------------- /src/test/syntax.fxl: -------------------------------------------------------------------------------- 1 | # 2 | value (load "test.fxl"; std) \; 3 | 4 | \lparen="(" \rparen=")" 5 | \lbrace="{" \rbrace="]" 6 | \lbrack="[" \rbrack="]" 7 | 8 | # Testing various syntax errors. 9 | run_fexl_text "\3.14=pi say x3.14" 10 | run_fexl_text QU 11 | run_fexl_text [NL QU "a" NL "b"] 12 | run_fexl_text "~| a" 13 | run_fexl_text [NL NL "~END" NL "abc" "~EN"] 14 | run_fexl_text "~" 15 | run_fexl_text ["~" NL] 16 | run_fexl_text "~EN" 17 | run_fexl_text " = y" 18 | run_fexl_text "ab cd e\" 19 | run_fexl_text "\x=" 20 | run_fexl_text [lparen NL "a" NL lparen "b"] 21 | run_fexl_text [lparen NL "a" NL lparen "b" rparen] 22 | run_fexl_text [lbrack NL "a" NL lbrack "b"] 23 | run_fexl_text [lbrace NL "a" NL lbrace "b"] 24 | run_fexl_text ["(ab cd e)" NL rparen] 25 | 26 | run_fexl_text 27 | ~ 28 | say (+ 4 6) 29 | ( a b c ) ( b c d ) 30 | ( a b c ) ( b c d ) 31 | put (- 12 7.2) nl 32 | x 33 | ~ 34 | 35 | run_fexl_text 36 | ~ 37 | value (def "b" (say "b"); void); \; a b 38 | a c 39 | c 40 | ~ 41 | 42 | run_fexl_text ~ parse_file "missing.fxl" ~ 43 | -------------------------------------------------------------------------------- /src/test/test.csv: -------------------------------------------------------------------------------- 1 | 12,3,,4 2 | 5,6,7 3 | 4 | "a b 5 | ""hi"" 6 | cd","3.14",-48.7 7 | "abc,def""ghi""jklmnopqrstuvwxyz" 8 | 9 | 10 | -------------------------------------------------------------------------------- /src/test/test.fxl: -------------------------------------------------------------------------------- 1 | # 2 | \\div=(say "==") 3 | \show_list=(\xs say "[" (each xs say) say "]") 4 | 5 | \run_test= 6 | (\label\\code 7 | say ["[ "label] 8 | code 9 | say "]" 10 | ) 11 | 12 | \show_str= 13 | (\text 14 | is_undef text (say "void"); 15 | say [(length text)":"(as_str text)] 16 | ) 17 | 18 | \show_hex= 19 | (\bytes 20 | is_undef bytes (say "void"); 21 | say [(length bytes)":["(unpack bytes)"]"] 22 | ) 23 | 24 | \block_quote= 25 | (\x 26 | \term= 27 | ( 28 | \check=(\y is_void (search x y 0) y) 29 | check "~"; 30 | (@\\loop\count 31 | check (. "~"; num_str count); 32 | loop (+ 1 count) 33 | ) 1 34 | ) 35 | to_str [term NL x term] 36 | ) 37 | 38 | # Run a command and print its stdout, stderr, and exit status. 39 | \run_command= 40 | (\cmd\input 41 | \cmd=(to_str cmd) 42 | \argv=["/bin/sh" "-c" cmd] 43 | run_program argv input \out\err\status 44 | say "\out=" 45 | say (block_quote out) 46 | say "\err=" 47 | say (block_quote err) 48 | # Showing status more portably here. Sometimes error codes on abnormal 49 | # termination can vary between systems. 50 | \status= 51 | ( 52 | eq status 0 0; 53 | eq status 256 1; 54 | -1 55 | ) 56 | say ["\status="status] 57 | ) 58 | 59 | \run_fexl_file=(\name run_command [(argv 0)" test/"name".fxl"]) 60 | \run_fexl_text=(run_command [(argv 0)]) 61 | 62 | def "div" div; 63 | def "show_list" show_list; 64 | def "run_test" run_test; 65 | def "show_str" show_str; 66 | def "show_hex" show_hex; 67 | def "block_quote" block_quote; 68 | def "run_fexl_file" run_fexl_file; 69 | def "run_fexl_text" run_fexl_text; 70 | std 71 | -------------------------------------------------------------------------------- /src/test/test.ssv: -------------------------------------------------------------------------------- 1 | ab xzz d e f 2 | g hi 3 | ab c 4 | x y 5 | 6 | 7 | z 8 | 9 | 10 | a x 11 | a b "c d" ~ e~~ f"gh"~ij ~END k"l"m~1n~ENDo~| p~|q"r"s 12 | tuv 13 | "a bb c" ~ x"y"z~ 21 38.3 -44 14 | "aaaa" ~ 15 | Block of text here. 16 | Second line. 17 | ~ ~END another block 18 | second line~END 19 | 1 2 3 20 | 21 | 22 | ~abcde ~a~ab~abc~abcd~abcde 23 | -------------------------------------------------------------------------------- /src/test/utf8.fxl: -------------------------------------------------------------------------------- 1 | # Demonstrate UTF-8 chars. 2 | \f = "hej 3 | åabcüdef 4 | ghij 5 | üä 6 | 1≠0 7 | 封 8 | " 9 | 10 | \åabcüdef = "hej åabcüdef" 11 | \ghij = "hej ghij" 12 | \üä = "hej üä" 13 | \1≠0 = "hej 1≠0" 14 | 15 | put "f = " say f 16 | put "åabcüdef = " say åabcüdef 17 | put "ghij = " say ghij 18 | put "üä = " say üä 19 | put "1≠0 = " say 1≠0 20 | 21 | \vegetable="grönsak" 22 | \dessert="efterrätt" 23 | put "vegetable " say vegetable 24 | put "dessert " say dessert 25 | -------------------------------------------------------------------------------- /src/test/var.fxl: -------------------------------------------------------------------------------- 1 | # Demonstrate the use of vars to maintain an evolving state. 2 | 3 | ## Here is the "API". 4 | 5 | \v_list=var_new 6 | \v_count=var_new 7 | \v_map=var_new 8 | 9 | var_put v_list [] 10 | var_put v_count 0 11 | var_put v_map void 12 | 13 | \update= 14 | (\v\f 15 | \x=(var_get v) 16 | var_put v (f x) 17 | ) 18 | 19 | \push= 20 | (\v\x 21 | update v (cons x) 22 | ) 23 | 24 | \\pairs=(var_get v_list) 25 | \\count=(var_get v_count) 26 | 27 | \update_map= 28 | (\v\key\val 29 | update v 30 | (\map 31 | \x 32 | eq x key val; 33 | map x 34 | ) 35 | ) 36 | 37 | \add= 38 | (\v\n 39 | update v 40 | (\x 41 | \y=(+ n x) 42 | say [" add: " x " => " y] 43 | y 44 | ) 45 | ) 46 | 47 | \set= 48 | (\key\val 49 | say ["set " key " = " val] 50 | push v_list {key val} 51 | add v_count 1 52 | update_map v_map key val 53 | ) 54 | 55 | \\get=(var_get v_map) 56 | 57 | ## Now do some operations. 58 | 59 | \\show_pairs= 60 | ( 61 | \show_pair=(\pair pair \key\val say ["{ " key " " val " }"]) 62 | say "[" 63 | each pairs show_pair 64 | say "]" 65 | ) 66 | 67 | \show= 68 | (\key 69 | say ["get " key " = " (get key)] 70 | ) 71 | 72 | ( 73 | \\set_xyz= 74 | ( 75 | set "x" "3" 76 | set "y" "4" 77 | set "z" "5" 78 | ) 79 | 80 | \\set_q= 81 | ( 82 | set "q" "0" 83 | ) 84 | 85 | set_xyz 86 | set_xyz 87 | set_q 88 | show_pairs 89 | say ["count = " count] 90 | show "x" 91 | show "y" 92 | show "z" 93 | show "q" 94 | show "r" 95 | say "bye" 96 | ) 97 | -------------------------------------------------------------------------------- /src/type_bn.h: -------------------------------------------------------------------------------- 1 | extern value type_bn(value f); 2 | extern value type_bn_eq0(value f); 3 | extern value type_bn_is_neg(value f); 4 | extern value type_bn_neg(value f); 5 | extern value type_bn_cmp(value f); 6 | extern value type_bn_lt(value f); 7 | extern value type_bn_le(value f); 8 | extern value type_bn_eq(value f); 9 | extern value type_bn_ne(value f); 10 | extern value type_bn_ge(value f); 11 | extern value type_bn_gt(value f); 12 | extern value type_bn_from_dec(value f); 13 | extern value type_bn_to_dec(value f); 14 | extern value type_bn_add(value f); 15 | extern value type_bn_sub(value f); 16 | extern value type_bn_mul(value f); 17 | extern value type_bn_mod(value f); 18 | extern value type_bn_div(value f); 19 | extern value type_is_bn(value f); 20 | -------------------------------------------------------------------------------- /src/type_buf.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | value type_buf(value f) 14 | { 15 | return type_void(f); 16 | } 17 | 18 | static void clear_buf(value f) 19 | { 20 | buffer buf = f->v_ptr; 21 | buf_discard(buf); 22 | free_memory(buf,sizeof(struct buffer)); 23 | } 24 | 25 | // buf_new returns a new empty character buffer. 26 | value type_buf_new(value f) 27 | { 28 | static struct value clear = {{.N=0}, {.clear=clear_buf}}; 29 | buffer buf = new_memory(sizeof(struct buffer)); 30 | *buf = (struct buffer){0}; 31 | return V(type_buf,&clear,(value)buf); 32 | (void)f; 33 | } 34 | 35 | // (buf_put buf str) Appends the string to the buffer. 36 | value type_buf_put(value f) 37 | { 38 | if (f->L->L == 0) return keep(f); 39 | { 40 | value x = arg(f->L->R); 41 | value y = arg(f->R); 42 | if (x->T == type_buf && y->T == type_str) 43 | { 44 | buf_put(x->v_ptr,y->v_ptr); 45 | f = hold(QI); 46 | } 47 | else 48 | f = hold(Qvoid); 49 | drop(x); 50 | drop(y); 51 | return f; 52 | } 53 | } 54 | 55 | // (buf_get buf) Clear the buffer and return str, where str is the current 56 | // content of the buffer. 57 | value type_buf_get(value f) 58 | { 59 | value x = arg(f->R); 60 | if (x->T == type_buf) 61 | f = Qstr(buf_clear(x->v_ptr)); 62 | else 63 | f = hold(Qvoid); 64 | drop(x); 65 | return f; 66 | } 67 | -------------------------------------------------------------------------------- /src/type_buf.h: -------------------------------------------------------------------------------- 1 | extern value type_buf(value f); 2 | extern value type_buf_new(value f); 3 | extern value type_buf_put(value f); 4 | extern value type_buf_get(value f); 5 | -------------------------------------------------------------------------------- /src/type_cmp.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | static int num_cmp(double x, double y) 10 | { 11 | if (x < y) return -1; 12 | if (x > y) return 1; 13 | return 0; 14 | } 15 | 16 | static value op_cmp(value f, int op(int)) 17 | { 18 | if (f->L->L == 0) return keep(f); 19 | { 20 | value x = arg(f->L->R); 21 | value y = arg(f->R); 22 | if (x->T == type_num && y->T == type_num) 23 | f = boolean(op(num_cmp(x->v_double,y->v_double))); 24 | else if (x->T == type_str && y->T == type_str) 25 | f = boolean(op(str_cmp(x->v_ptr,y->v_ptr))); 26 | else 27 | f = hold(Qvoid); 28 | drop(x); 29 | drop(y); 30 | return f; 31 | } 32 | } 33 | 34 | // (compare x y LT EQ GT) 35 | // Compare the numbers or strings and return LT, EQ, or GT. 36 | value type_compare(value f) 37 | { 38 | if (f->L->L == 0) return keep(f); 39 | if (f->L->L->L == 0) return keep(f); 40 | if (f->L->L->L->L == 0) return keep(f); 41 | if (f->L->L->L->L->L == 0) return keep(f); 42 | { 43 | value x = arg(f->L->L->L->L->R); 44 | value y = arg(f->L->L->L->R); 45 | 46 | if (x->T == type_num && y->T == type_num) 47 | { 48 | double xn = x->v_double; 49 | double yn = y->v_double; 50 | 51 | if (xn < yn) 52 | f = hold(f->L->L->R); 53 | else if (xn == yn) 54 | f = hold(f->L->R); 55 | else 56 | f = hold(f->R); 57 | } 58 | else if (x->T == type_str && y->T == type_str) 59 | { 60 | int cmp = str_cmp(x->v_ptr,y->v_ptr); 61 | 62 | if (cmp < 0) 63 | f = hold(f->L->L->R); 64 | else if (cmp == 0) 65 | f = hold(f->L->R); 66 | else 67 | f = hold(f->R); 68 | } 69 | else 70 | f = hold(Qvoid); 71 | 72 | drop(x); 73 | drop(y); 74 | return f; 75 | } 76 | } 77 | 78 | static int lt(int x) { return x < 0; } 79 | static int le(int x) { return x <= 0; } 80 | static int eq(int x) { return x == 0; } 81 | static int ne(int x) { return x != 0; } 82 | static int ge(int x) { return x >= 0; } 83 | static int gt(int x) { return x > 0; } 84 | 85 | value type_lt(value f) { return op_cmp(f,lt); } 86 | value type_le(value f) { return op_cmp(f,le); } 87 | value type_eq(value f) { return op_cmp(f,eq); } 88 | value type_ne(value f) { return op_cmp(f,ne); } 89 | value type_ge(value f) { return op_cmp(f,ge); } 90 | value type_gt(value f) { return op_cmp(f,gt); } 91 | -------------------------------------------------------------------------------- /src/type_cmp.h: -------------------------------------------------------------------------------- 1 | extern value type_compare(value f); 2 | extern value type_lt(value f); 3 | extern value type_le(value f); 4 | extern value type_eq(value f); 5 | extern value type_ne(value f); 6 | extern value type_ge(value f); 7 | extern value type_gt(value f); 8 | -------------------------------------------------------------------------------- /src/type_crypto.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | value type_random_bytes(value f) 11 | { 12 | value x = arg(f->R); 13 | if (x->T == type_num) 14 | f = Qstr(str_random_bytes(get_ulong(x))); 15 | else 16 | f = hold(Qvoid); 17 | drop(x); 18 | return f; 19 | } 20 | 21 | value type_random_nonce(value f) 22 | { 23 | return Qstr(str_random_nonce()); 24 | (void)f; 25 | } 26 | 27 | value type_random_secret_key(value f) 28 | { 29 | return Qstr(str_random_secret_key()); 30 | (void)f; 31 | } 32 | 33 | value type_nacl_box_public(value f) 34 | { return op_str(f,str_nacl_box_public); } 35 | 36 | value type_nacl_box_prepare(value f) 37 | { return op_str2(f,str_nacl_box_prepare); } 38 | 39 | value type_nacl_box_seal(value f) 40 | { return op_str3(f,str_nacl_box_seal); } 41 | 42 | value type_nacl_box_open(value f) 43 | { return op_str3(f,str_nacl_box_open); } 44 | 45 | value type_nacl_sign_public(value f) 46 | { return op_str(f,str_nacl_sign_public); } 47 | 48 | value type_nacl_sign_seal(value f) 49 | { return op_str3(f,str_nacl_sign_seal); } 50 | 51 | value type_nacl_sign_open(value f) 52 | { 53 | if (f->L->L == 0) return keep(f); 54 | if (f->L->L->L == 0) return keep(f); 55 | { 56 | value x = arg(f->L->L->R); 57 | value y = arg(f->L->R); 58 | value z = arg(f->R); 59 | if (x->T == type_str && y->T == type_str && z->T == type_str) 60 | { 61 | string text = x->v_ptr; 62 | string public_key = y->v_ptr; 63 | string signature = z->v_ptr; 64 | f = boolean(str_nacl_sign_open(text,public_key,signature)); 65 | } 66 | else 67 | f = hold(Qvoid); 68 | drop(x); 69 | drop(y); 70 | drop(z); 71 | return f; 72 | } 73 | } 74 | 75 | value type_sha256(value f) { return op_str(f,str_sha256); } 76 | value type_sha512(value f) { return op_str(f,str_sha512); } 77 | value type_pack64(value f) { return op_str(f,str_pack64); } 78 | value type_unpack64(value f) { return op_str(f,str_unpack64); } 79 | 80 | value type_hmac_sha512(value f) 81 | { return op_str2(f,str_hmac_sha512); } 82 | value type_hmac_sha256(value f) 83 | { return op_str2(f,str_hmac_sha256); } 84 | -------------------------------------------------------------------------------- /src/type_crypto.h: -------------------------------------------------------------------------------- 1 | extern value type_random_bytes(value f); 2 | extern value type_random_nonce(value f); 3 | extern value type_random_secret_key(value f); 4 | extern value type_nacl_box_public(value f); 5 | extern value type_nacl_box_prepare(value f); 6 | extern value type_nacl_box_seal(value f); 7 | extern value type_nacl_box_open(value f); 8 | extern value type_nacl_sign_public(value f); 9 | extern value type_nacl_sign_seal(value f); 10 | extern value type_nacl_sign_open(value f); 11 | extern value type_sha256(value f); 12 | extern value type_sha512(value f); 13 | extern value type_pack64(value f); 14 | extern value type_unpack64(value f); 15 | extern value type_hmac_sha512(value f); 16 | extern value type_hmac_sha256(value f); 17 | -------------------------------------------------------------------------------- /src/type_file.h: -------------------------------------------------------------------------------- 1 | extern value Qstdin; 2 | extern value Qstdout; 3 | extern value Qstderr; 4 | extern value type_file(value f); 5 | extern value Qfile(FILE *fh); 6 | extern value type_fopen(value f); 7 | extern value type_fclose(value f); 8 | extern value type_fgetc(value f); 9 | extern value type_fget(value f); 10 | extern value type_clearerr(value f); 11 | extern value type_feof(value f); 12 | extern value type_flook(value f); 13 | extern value type_remove(value f); 14 | extern value type_is_newer(value f); 15 | extern value type_is_file(value f); 16 | extern value type_is_dir(value f); 17 | extern value type_flock_ex(value f); 18 | extern value type_flock_sh(value f); 19 | extern value type_flock_un(value f); 20 | extern value type_readlink(value f); 21 | extern value type_mkdir(value f); 22 | extern value type_rmdir(value f); 23 | extern value type_ftruncate(value f); 24 | extern value type_fseek_set(value f); 25 | extern value type_fseek_cur(value f); 26 | extern value type_fseek_end(value f); 27 | extern value type_ftell(value f); 28 | extern value type_fileno(value f); 29 | extern value type_fread(value f); 30 | extern value type_mkfile(value f); 31 | extern value type_dir_names(value f); 32 | extern value type_mod_time(value f); 33 | extern value type_file_size(value f); 34 | extern value type_symlink(value f); 35 | extern value type_rename(value f); 36 | extern void beg_file(void); 37 | extern void end_file(void); 38 | -------------------------------------------------------------------------------- /src/type_hex.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | 8 | // Map number 0-15 to a hex digit. 9 | static unsigned char nibble_to_hex(unsigned char n) 10 | { 11 | if (n < 10) 12 | return n + '0'; 13 | else 14 | return n - 10 + 'a'; 15 | } 16 | 17 | // Map hex digit to a number 0-15. 18 | static unsigned char hex_to_nibble(unsigned char n) 19 | { 20 | if (n >= 48 && n <= 57) // '0'-'9' 21 | return n - 48; 22 | else if (n >= 97 && n <= 102) // 'a'-'f' 23 | return n - 87; 24 | else if (n >= 65 && n <= 70) // 'A'-'F' 25 | return n - 55; 26 | else 27 | return 0; 28 | } 29 | 30 | static string unpack(string str_raw) 31 | { 32 | string str_hex = str_new(2 * str_raw->len); 33 | unsigned int pos; 34 | for (pos = 0; pos < str_raw->len; pos++) 35 | { 36 | unsigned char ch = str_raw->data[pos]; 37 | str_hex->data[2*pos] = nibble_to_hex(ch >> 4); 38 | str_hex->data[2*pos+1] = nibble_to_hex(ch & 15); 39 | } 40 | return str_hex; 41 | } 42 | 43 | static string pack(string str_hex) 44 | { 45 | string str_raw = str_new(str_hex->len / 2); 46 | unsigned int pos; 47 | for (pos = 0; pos < str_raw->len; pos++) 48 | { 49 | unsigned char hi = hex_to_nibble(str_hex->data[2*pos]); 50 | unsigned char lo = hex_to_nibble(str_hex->data[2*pos+1]); 51 | str_raw->data[pos] = (hi << 4) | lo; 52 | } 53 | return str_raw; 54 | } 55 | 56 | // Map raw bytes to their hexadecimal values. 57 | value type_unpack(value f) 58 | { 59 | value x = arg(f->R); 60 | if (x->T == type_str) 61 | f = Qstr(unpack(x->v_ptr)); 62 | else 63 | f = hold(Qvoid); 64 | drop(x); 65 | return f; 66 | } 67 | 68 | // Map a string specified in hexadecimal into the raw bytes. 69 | value type_pack(value f) 70 | { 71 | value x = arg(f->R); 72 | if (x->T == type_str) 73 | f = Qstr(pack(x->v_ptr)); 74 | else 75 | f = hold(Qvoid); 76 | drop(x); 77 | return f; 78 | } 79 | -------------------------------------------------------------------------------- /src/type_hex.h: -------------------------------------------------------------------------------- 1 | extern value type_unpack(value f); 2 | extern value type_pack(value f); 3 | -------------------------------------------------------------------------------- /src/type_input.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | 8 | value op_getc(value f, type t, input get) 9 | { 10 | value x = arg(f->R); 11 | if (x->T == t) 12 | { 13 | void *source = x->v_ptr; 14 | int ch = get(source); 15 | if (ch == -1) 16 | f = hold(Qvoid); 17 | else 18 | { 19 | char c = (char)ch; 20 | f = Qstr(str_new_data(&c,1)); 21 | } 22 | } 23 | else 24 | f = hold(Qvoid); 25 | drop(x); 26 | return f; 27 | } 28 | 29 | // Get the next UTF-8 character from the given input, or 0 if none. 30 | static string get_utf8(input get, void *source) 31 | { 32 | int ch = get(source); 33 | if (ch == -1) return 0; 34 | { 35 | char buf[6]; 36 | unsigned pos = 0; 37 | unsigned len = char_width(ch); 38 | 39 | if (len >= sizeof(buf)) 40 | len = sizeof(buf); 41 | 42 | while (1) 43 | { 44 | buf[pos++] = (char)ch; 45 | if (pos >= len) break; 46 | ch = get(source); 47 | if (ch == -1) return 0; 48 | } 49 | return str_new_data(buf,len); 50 | } 51 | } 52 | 53 | value op_get(value f, type t, input get) 54 | { 55 | value x = arg(f->R); 56 | if (x->T == t) 57 | { 58 | void *source = x->v_ptr; 59 | string ch = get_utf8(get,source); 60 | f = ch ? Qstr(ch) : hold(Qvoid); 61 | } 62 | else 63 | f = hold(Qvoid); 64 | drop(x); 65 | return f; 66 | } 67 | -------------------------------------------------------------------------------- /src/type_input.h: -------------------------------------------------------------------------------- 1 | typedef int (*input)(void *source); 2 | extern value op_getc(value f, type t, input get); 3 | extern value op_get(value f, type t, input get); 4 | -------------------------------------------------------------------------------- /src/type_istr.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | // An istr structure is used to iterate through a string. 11 | 12 | static struct istr *istr_new(value x) 13 | { 14 | struct istr *in = new_memory(sizeof(struct istr)); 15 | in->pos = 0; 16 | in->str = x; 17 | return in; 18 | } 19 | 20 | static void clear_istr(value f) 21 | { 22 | struct istr *in = f->v_ptr; 23 | drop(in->str); 24 | free_memory(in,sizeof(struct istr)); 25 | } 26 | 27 | value Qistr(value x) 28 | { 29 | static struct value clear = {{.N=0}, {.clear=clear_istr}}; 30 | return V(type_istr,&clear,(value)istr_new(x)); 31 | } 32 | 33 | int sgetc(struct istr *in) 34 | { 35 | string str = in->str->v_ptr; 36 | return in->pos < str->len ? (unsigned char)str->data[in->pos++] : -1; 37 | } 38 | 39 | static int slook(struct istr *in) 40 | { 41 | string str = in->str->v_ptr; 42 | return in->pos < str->len ? (unsigned char)str->data[in->pos] : -1; 43 | } 44 | 45 | value type_istr(value f) 46 | { 47 | return type_void(f); 48 | } 49 | 50 | // (readstr str) returns an iterator on the string. 51 | value type_readstr(value f) 52 | { 53 | value x = arg(f->R); 54 | if (x->T == type_str) 55 | f = Qistr(hold(x)); 56 | else 57 | f = hold(Qvoid); 58 | drop(x); 59 | return f; 60 | } 61 | 62 | // (sgetc in) returns the next single byte from the string, or void if none. 63 | value type_sgetc(value f) 64 | { 65 | return op_getc(f,type_istr,(input)sgetc); 66 | } 67 | 68 | // (sget in) returns the next UTF-8 character from the string, or void if none. 69 | value type_sget(value f) 70 | { 71 | return op_get(f,type_istr,(input)sgetc); 72 | } 73 | 74 | // (slook in) returns the next byte from the string without consuming it. 75 | value type_slook(value f) 76 | { 77 | value x = arg(f->R); 78 | if (x->T == type_istr) 79 | { 80 | int ch = slook(x->v_ptr); 81 | if (ch == -1) 82 | f = hold(Qvoid); 83 | else 84 | { 85 | char c = (char)ch; 86 | f = Qstr(str_new_data(&c,1)); 87 | } 88 | } 89 | else 90 | f = hold(Qvoid); 91 | drop(x); 92 | return f; 93 | } 94 | -------------------------------------------------------------------------------- /src/type_istr.h: -------------------------------------------------------------------------------- 1 | struct istr 2 | { 3 | unsigned long pos; 4 | value str; 5 | }; 6 | 7 | extern value Qistr(value x); 8 | extern int sgetc(struct istr *in); 9 | extern value type_istr(value f); 10 | extern value type_readstr(value f); 11 | extern value type_sgetc(value f); 12 | extern value type_sget(value f); 13 | extern value type_slook(value f); 14 | -------------------------------------------------------------------------------- /src/type_limit.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | static value op_limit(value f, void op(unsigned long)) 9 | { 10 | value x = arg(f->R); 11 | if (x->T == type_num) 12 | { 13 | op(get_ulong(x)); 14 | f = hold(QI); 15 | } 16 | else 17 | f = hold(Qvoid); 18 | drop(x); 19 | return f; 20 | } 21 | 22 | value type_limit_time(value f) 23 | { 24 | return op_limit(f,limit_time); 25 | } 26 | 27 | value type_limit_stack(value f) 28 | { 29 | return op_limit(f,limit_stack); 30 | } 31 | 32 | value type_limit_memory(value f) 33 | { 34 | return op_limit(f,limit_memory); 35 | } 36 | -------------------------------------------------------------------------------- /src/type_limit.h: -------------------------------------------------------------------------------- 1 | extern value type_limit_time(value f); 2 | extern value type_limit_stack(value f); 3 | extern value type_limit_memory(value f); 4 | -------------------------------------------------------------------------------- /src/type_math.c: -------------------------------------------------------------------------------- 1 | #include // pow fabs sqrt exp log sin cos M_PI 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | 8 | // Explicitly declare certain functions which are missing from math.h on some 9 | // machines. 10 | extern double round(double); 11 | extern double trunc(double); 12 | 13 | static value op_num(value f, double op(double)) 14 | { 15 | value x = arg(f->R); 16 | if (x->T == type_num) 17 | f = Qnum(op(x->v_double)); 18 | else 19 | f = hold(Qvoid); 20 | drop(x); 21 | return f; 22 | } 23 | 24 | static value op_num_num(value f, double op(double,double)) 25 | { 26 | if (f->L->L == 0) return keep(f); 27 | { 28 | value x = arg(f->L->R); 29 | value y = arg(f->R); 30 | if (x->T == type_num && y->T == type_num) 31 | f = Qnum(op(x->v_double,y->v_double)); 32 | else 33 | f = hold(Qvoid); 34 | drop(x); 35 | drop(y); 36 | return f; 37 | } 38 | } 39 | 40 | static double add(double x, double y) { return x + y; } 41 | static double sub(double x, double y) { return x - y; } 42 | static double mul(double x, double y) { return x * y; } 43 | static double div(double x, double y) { return x / y; } 44 | static double xor(double x, double y) { return (long)x ^ (long)y; } 45 | 46 | value type_add(value f) { return op_num_num(f,add); } 47 | value type_sub(value f) { return op_num_num(f,sub); } 48 | value type_mul(value f) { return op_num_num(f,mul); } 49 | value type_div(value f) { return op_num_num(f,div); } 50 | value type_pow(value f) { return op_num_num(f,pow); } 51 | value type_xor(value f) { return op_num_num(f,xor); } 52 | value type_round(value f) { return op_num(f,round); } 53 | value type_ceil(value f) { return op_num(f,ceil); } 54 | value type_trunc(value f) { return op_num(f,trunc); } 55 | value type_abs(value f) { return op_num(f,fabs); } 56 | value type_sqrt(value f) { return op_num(f,sqrt); } 57 | value type_exp(value f) { return op_num(f,exp); } 58 | value type_log(value f) { return op_num(f,log); } 59 | value type_sin(value f) { return op_num(f,sin); } 60 | value type_cos(value f) { return op_num(f,cos); } 61 | 62 | const double num_pi = M_PI; 63 | -------------------------------------------------------------------------------- /src/type_math.h: -------------------------------------------------------------------------------- 1 | extern value type_add(value f); 2 | extern value type_sub(value f); 3 | extern value type_mul(value f); 4 | extern value type_div(value f); 5 | extern value type_pow(value f); 6 | extern value type_xor(value f); 7 | extern value type_round(value f); 8 | extern value type_ceil(value f); 9 | extern value type_trunc(value f); 10 | extern value type_abs(value f); 11 | extern value type_sqrt(value f); 12 | extern value type_exp(value f); 13 | extern value type_log(value f); 14 | extern value type_sin(value f); 15 | extern value type_cos(value f); 16 | extern const double num_pi; 17 | -------------------------------------------------------------------------------- /src/type_num.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | static void clear_num(value f) 12 | { 13 | (void)f; 14 | } 15 | 16 | value type_num(value f) 17 | { 18 | return type_void(f); 19 | } 20 | 21 | value Qnum(double x) 22 | { 23 | static struct value clear = {{.N=0}, {.clear=clear_num}}; 24 | value f = new_value(); 25 | f->N = 1; 26 | f->T = type_num; 27 | f->L = &clear; 28 | f->v_double = x; 29 | return f; 30 | } 31 | 32 | value Qnum_str0(const char *name) 33 | { 34 | double x; 35 | if (str0_double(name,&x)) 36 | return Qnum(x); 37 | else 38 | return 0; 39 | } 40 | 41 | unsigned long get_ulong(value x) 42 | { 43 | double n = x->v_double; 44 | return n >= 0 ? n : 0; 45 | } 46 | 47 | value type_num_str(value f) 48 | { 49 | value x = arg(f->R); 50 | if (x->T == type_num) 51 | f = Qstr(str_new_data0(format_double(x->v_double))); 52 | else 53 | f = hold(Qvoid); 54 | drop(x); 55 | return f; 56 | } 57 | 58 | value type_is_num(value f) 59 | { 60 | return op_is_type(f,type_num); 61 | } 62 | -------------------------------------------------------------------------------- /src/type_num.h: -------------------------------------------------------------------------------- 1 | extern value type_num(value f); 2 | extern value Qnum(double x); 3 | extern value Qnum_str0(const char *name); 4 | extern unsigned long get_ulong(value x); 5 | extern value type_num_str(value f); 6 | extern value type_is_num(value f); 7 | -------------------------------------------------------------------------------- /src/type_output.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | 18 | value Qput; 19 | value Qnl; 20 | value Qfput; 21 | value Qfnl; 22 | 23 | static value op_put(FILE *fh, value f) 24 | { 25 | value x = arg(f->R); 26 | if (x->T == type_list) 27 | f = A(A(hold(f->L),hold(x->L)),A(hold(f->L),hold(x->R))); 28 | else 29 | { 30 | if (x->T == type_str) 31 | fput_str(fh,x->v_ptr); 32 | else if (x->T == type_num) 33 | fput_double(fh,x->v_double); 34 | else if (x->T == type_T && !x->L) 35 | fput_ch(fh,'T'); 36 | else if (x->T == type_F && !x->L) 37 | fput_ch(fh,'F'); 38 | else if (x->T == type_bn) 39 | { 40 | string s = bn_to_dec(x->v_ptr); 41 | fput_str(fh,s); 42 | str_free(s); 43 | } 44 | f = hold(QI); 45 | } 46 | drop(x); 47 | return f; 48 | } 49 | 50 | value type_put(value f) 51 | { 52 | return op_put(stdout,f); 53 | } 54 | 55 | value type_nl(value f) 56 | { 57 | fnl(stdout); 58 | return hold(QI); 59 | (void)f; 60 | } 61 | 62 | value type_say(value f) 63 | { 64 | return A(A(hold(Qput),hold(f->R)),hold(Qnl)); 65 | } 66 | 67 | value type_fput(value f) 68 | { 69 | if (f->L->L == 0) return keep(f); 70 | { 71 | value out = arg(f->L->R); 72 | if (out->T == type_file) 73 | f = op_put(out->v_ptr,f); 74 | else 75 | f = hold(Qvoid); 76 | drop(out); 77 | return f; 78 | } 79 | } 80 | 81 | value type_fnl(value f) 82 | { 83 | value out = arg(f->R); 84 | if (out->T == type_file) 85 | { 86 | fnl(out->v_ptr); 87 | f = hold(QI); 88 | } 89 | else 90 | f = hold(Qvoid); 91 | drop(out); 92 | return f; 93 | } 94 | 95 | value type_fsay(value f) 96 | { 97 | if (f->L->L == 0) return keep(f); 98 | return A(A(A(hold(Qfput),hold(f->L->R)),hold(f->R)), 99 | A(hold(Qfnl),hold(f->L->R))); 100 | } 101 | 102 | value type_fflush(value f) 103 | { 104 | value out = arg(f->R); 105 | if (out->T == type_file) 106 | { 107 | fflush(out->v_ptr); 108 | f = hold(QI); 109 | } 110 | else 111 | f = hold(Qvoid); 112 | drop(out); 113 | return f; 114 | } 115 | 116 | void beg_output(void) 117 | { 118 | Qput = Q(type_put); 119 | Qnl = Q0(type_nl); 120 | Qfput = Q(type_fput); 121 | Qfnl = Q(type_fnl); 122 | } 123 | 124 | void end_output(void) 125 | { 126 | drop(Qput); 127 | drop(Qnl); 128 | drop(Qfput); 129 | drop(Qfnl); 130 | } 131 | -------------------------------------------------------------------------------- /src/type_output.h: -------------------------------------------------------------------------------- 1 | extern value Qput; 2 | extern value Qnl; 3 | extern value Qfput; 4 | extern value Qfnl; 5 | extern value type_put(value f); 6 | extern value type_nl(value f); 7 | extern value type_say(value f); 8 | extern value type_fput(value f); 9 | extern value type_fnl(value f); 10 | extern value type_fsay(value f); 11 | extern value type_fflush(value f); 12 | extern void beg_output(void); 13 | extern void end_output(void); 14 | -------------------------------------------------------------------------------- /src/type_parse.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | 15 | // (parse stream label) Parse the stream, using the given label for any syntax 16 | // error messages, and return the resulting form. 17 | value type_parse(value f) 18 | { 19 | if (f->L->L == 0) return keep(f); 20 | { 21 | value label = arg(f->R); 22 | if (label->T == type_str) 23 | f = parse_fexl(arg(f->L->R),label); 24 | else 25 | f = hold(Qvoid); 26 | drop(label); 27 | return f; 28 | } 29 | } 30 | 31 | // Parse a named file. Note that if name designates a directory the fopen will 32 | // succeed, but it will behave like an empty file. 33 | static value parse_file(value name) 34 | { 35 | const char *name_s = str_data(name); 36 | FILE *fh = name_s[0] ? fopen(name_s,"r") : stdin; 37 | if (!fh) 38 | { 39 | fput(stderr,"Could not open source file "); 40 | fput(stderr,name_s);fnl(stderr); 41 | die(0); 42 | } 43 | return parse_fexl(Qfile(fh),name); 44 | } 45 | 46 | // (parse_file name) Parse the named file. 47 | value type_parse_file(value f) 48 | { 49 | value name = arg(f->R); 50 | if (name->T == type_str) 51 | f = parse_file(name); 52 | else 53 | f = hold(Qvoid); 54 | drop(name); 55 | return f; 56 | } 57 | -------------------------------------------------------------------------------- /src/type_parse.h: -------------------------------------------------------------------------------- 1 | extern value type_parse(value f); 2 | extern value type_parse_file(value f); 3 | -------------------------------------------------------------------------------- /src/type_rand.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include // srand rand RAND_MAX 5 | #include 6 | #include 7 | 8 | // Seed rand with an arbitrary number between 0 and 1. 9 | value type_seed_rand(value f) 10 | { 11 | value x = arg(f->R); 12 | if (x->T == type_num) 13 | { 14 | double seed = x->v_double * (double)RAND_MAX; 15 | srand(seed); 16 | f = hold(QI); 17 | } 18 | else 19 | f = hold(Qvoid); 20 | drop(x); 21 | return f; 22 | } 23 | 24 | // rand returns x, where x is a weakly pseudo-random number with a uniform 25 | // distribution over 0 <= x <= 1. 26 | value type_rand(value f) 27 | { 28 | return Qnum(((double)rand()) / ((double)RAND_MAX)); 29 | (void)f; 30 | } 31 | -------------------------------------------------------------------------------- /src/type_rand.h: -------------------------------------------------------------------------------- 1 | extern value type_seed_rand(value f); 2 | extern value type_rand(value f); 3 | -------------------------------------------------------------------------------- /src/type_record.h: -------------------------------------------------------------------------------- 1 | struct item 2 | { 3 | value key; 4 | value val; 5 | }; 6 | 7 | struct record 8 | { 9 | unsigned long count; 10 | unsigned long size; 11 | struct item *vec; 12 | }; 13 | 14 | extern value record_find(value obj, string key); 15 | extern value type_record(value f); 16 | extern void record_set(value obj, value key, value val); 17 | extern value record_empty(void); 18 | extern value type_empty(value f); 19 | extern value type_set(value f); 20 | extern value type_setf(value f); 21 | extern value type_SET(value f); 22 | extern value type_SETF(value f); 23 | extern value type_get(value f); 24 | extern value type_record_copy(value f); 25 | extern value type_record_count(value f); 26 | extern value type_record_item(value f); 27 | -------------------------------------------------------------------------------- /src/type_run.h: -------------------------------------------------------------------------------- 1 | extern int main_argc; 2 | extern const char **main_argv; 3 | extern value type_die(value f); 4 | extern value type_argv(value f); 5 | extern value type_sleep(value f); 6 | extern value type_usleep(value f); 7 | extern value type_run_process(value f); 8 | extern value type_spawn(value f); 9 | extern value type_start_server(value f); 10 | extern value type_kill(value f); 11 | extern value type_connect(value f); 12 | extern value type_exec(value f); 13 | extern value type_receive_keystrokes(value f); 14 | extern value type_fexl_benchmark(value f); 15 | -------------------------------------------------------------------------------- /src/type_signal.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include // sigaction etc. 5 | #include // perror 6 | #include // exit 7 | #include 8 | #include 9 | #include // alarm 10 | 11 | static void handle_signal(int signum) 12 | { 13 | (void)signum; 14 | } 15 | 16 | // Reference: 17 | // https://stackoverflow.com/questions/31784823/interrupting-open-with-sigalrm 18 | // 19 | // This sets a signal handler so it does not kill the process when the signal 20 | // happens, but instead interrupts any system call in progress such as fget or 21 | // fread. 22 | static void set_handler(int signum) 23 | { 24 | struct sigaction sigact; 25 | sigact.sa_handler = handle_signal; 26 | sigact.sa_flags = 0; // Override default SA_RESTART. 27 | sigemptyset(&sigact.sa_mask); 28 | if (sigaction(signum, &sigact, NULL) < 0) 29 | { 30 | perror("sigaction(2) error"); 31 | exit(1); 32 | } 33 | } 34 | 35 | void init_signal(void) 36 | { 37 | set_handler(SIGALRM); 38 | set_handler(SIGCHLD); 39 | } 40 | 41 | // (set_alarm seconds) 42 | // Set an alarm for the given number of seconds. This is used primarily by 43 | // server processes so they don't wait forever for input from the client. If 44 | // the alarm goes off it will interrupt the system call (fget, fread, etc.) and 45 | // the process can exit. 46 | value type_set_alarm(value f) 47 | { 48 | value x = arg(f->R); 49 | if (x->T == type_num) 50 | { 51 | alarm(get_ulong(x)); 52 | f = hold(QI); 53 | } 54 | else 55 | f = hold(Qvoid); 56 | drop(x); 57 | return f; 58 | } 59 | -------------------------------------------------------------------------------- /src/type_signal.h: -------------------------------------------------------------------------------- 1 | extern void init_signal(void); 2 | extern value type_set_alarm(value f); 3 | -------------------------------------------------------------------------------- /src/type_str.h: -------------------------------------------------------------------------------- 1 | extern value type_str(value f); 2 | extern value Qstr(string x); 3 | extern value Qstr0(const char *data); 4 | extern const char *str_data(value x); 5 | extern value op_str(value f, string op(string)); 6 | extern value op_str2(value f, string op(string,string)); 7 | extern value op_str3(value f, string op(string,string,string)); 8 | extern value type_concat(value f); 9 | extern value type_length(value f); 10 | extern value type_slice(value f); 11 | extern value type_search(value f); 12 | extern value type_str_num(value f); 13 | extern value type_ord(value f); 14 | extern value type_chr(value f); 15 | extern value type_char_width(value f); 16 | extern value type_dirname(value f); 17 | extern value type_basename(value f); 18 | extern value type_length_common(value f); 19 | extern value type_compare_at(value f); 20 | extern value type_is_str(value f); 21 | extern value op_argv(value f, value op(const char *const *argv)); 22 | -------------------------------------------------------------------------------- /src/type_stream.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | value type_at_eof(value f) 14 | { 15 | return boolean(cur_ch == -1); 16 | (void)f; 17 | } 18 | 19 | value type_at_white(value f) 20 | { 21 | return boolean(at_white()); 22 | (void)f; 23 | } 24 | 25 | value type_skip_white(value f) 26 | { 27 | skip_white(); 28 | return hold(QI); 29 | (void)f; 30 | } 31 | 32 | value type_at_eol(value f) 33 | { 34 | return boolean(cur_ch == '\n' || cur_ch == '\r'); 35 | (void)f; 36 | } 37 | 38 | value type_at_ch(value f) 39 | { 40 | value x = f->R; 41 | if (x->T == type_str) 42 | f = boolean(cur_ch == *str_data(x)); 43 | else 44 | f = hold(Qvoid); 45 | return f; 46 | } 47 | 48 | // Return the current character. 49 | value type_look(value f) 50 | { 51 | if (cur_ch < 0) 52 | return hold(Qvoid); 53 | else 54 | { 55 | char c = cur_ch; 56 | return Qstr(str_new_data(&c,1)); 57 | } 58 | (void)f; 59 | } 60 | 61 | // Skip to the next character. 62 | value type_skip(value f) 63 | { 64 | skip(); 65 | return hold(QI); 66 | (void)f; 67 | } 68 | 69 | // Return the current line number. 70 | value type_line(value f) 71 | { 72 | return Qnum(cur_line); 73 | (void)f; 74 | } 75 | 76 | value type_buf_keep(value f) 77 | { 78 | value x = arg(f->R); 79 | if (x->T == type_buf) 80 | { 81 | buf_keep(x->v_ptr); 82 | f = hold(QI); 83 | } 84 | else 85 | f = hold(Qvoid); 86 | drop(x); 87 | return f; 88 | } 89 | 90 | value type_collect_to_ch(value f) 91 | { 92 | if (f->L->L == 0) return keep(f); 93 | { 94 | value x = arg(f->L->R); 95 | value y = arg(f->R); 96 | if (x->T == type_buf && y->T == type_str) 97 | f = boolean(collect_to_ch(x->v_ptr,str_data(y)[0])); 98 | else 99 | f = hold(Qvoid); 100 | drop(x); 101 | drop(y); 102 | return f; 103 | } 104 | } 105 | 106 | value type_collect_tilde_string(value f) 107 | { 108 | value x = arg(f->R); 109 | if (x->T == type_buf) 110 | f = Qnum(collect_tilde_string(x->v_ptr)); 111 | else 112 | f = hold(Qvoid); 113 | drop(x); 114 | return f; 115 | } 116 | 117 | // (read_stream stream read) 118 | value type_read_stream(value f) 119 | { 120 | if (f->L->L == 0) return keep(f); 121 | return read_stream(arg(f->L->R),hold(f->R)); 122 | } 123 | -------------------------------------------------------------------------------- /src/type_stream.h: -------------------------------------------------------------------------------- 1 | extern value type_at_eof(value f); 2 | extern value type_at_white(value f); 3 | extern value type_skip_white(value f); 4 | extern value type_at_eol(value f); 5 | extern value type_at_ch(value f); 6 | extern value type_look(value f); 7 | extern value type_skip(value f); 8 | extern value type_line(value f); 9 | extern value type_buf_keep(value f); 10 | extern value type_collect_to_ch(value f); 11 | extern value type_collect_tilde_string(value f); 12 | extern value type_read_stream(value f); 13 | -------------------------------------------------------------------------------- /src/type_sym.h: -------------------------------------------------------------------------------- 1 | extern value type_quo(value f); 2 | extern value type_ref(value f); 3 | extern value quo(value val); 4 | extern value ref(string name, unsigned long line); 5 | extern value join(type t, value x, value y); 6 | extern value app(value x, value y); 7 | extern value lam(type type, string name, value exp); 8 | extern value type_form(value f); 9 | extern value Qform(value label, value exp); 10 | extern value type_D(value f); 11 | extern value type_E(value f); 12 | extern value type_is_closed(value f); 13 | extern value type_value(value f); 14 | extern value type_extend(value f); 15 | extern void beg_sym(void); 16 | extern void end_sym(void); 17 | -------------------------------------------------------------------------------- /src/type_time.c: -------------------------------------------------------------------------------- 1 | // The define ensures that strptime is accessible. 2 | #define _GNU_SOURCE 3 | #include 4 | #include 5 | #include 6 | 7 | #include 8 | #include 9 | 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | 16 | // Return the current time as the number of seconds since the Epoch, 17 | // 1970-01-01 00:00:00 +0000 (UTC). 18 | value type_time(value f) 19 | { 20 | time_t n; 21 | time(&n); 22 | return Qnum(n); 23 | (void)f; 24 | } 25 | 26 | static const char *time_format = "%Y-%m-%d %H:%M:%S"; 27 | 28 | // Format an epoch time as "YYYY-MM-DD HH:MM:SS". 29 | static value op_strftime(value f, 30 | struct tm *(*convert)(const time_t *)) 31 | { 32 | value x = arg(f->R); 33 | if (x->T == type_num) 34 | { 35 | time_t n = x->v_double; 36 | struct tm *tm = convert(&n); 37 | char buf[32]; 38 | strftime(buf,sizeof(buf),time_format,tm); 39 | f = Qstr0(buf); 40 | } 41 | else 42 | f = hold(Qvoid); 43 | drop(x); 44 | return f; 45 | } 46 | 47 | // Convert "YYYY-MM-DD HH:MM:SS" to an epoch time. 48 | static value op_strptime(value f, 49 | time_t (*convert)(struct tm *tm)) 50 | { 51 | value x = arg(f->R); 52 | if (x->T == type_str) 53 | { 54 | const char *str = str_data(x); 55 | struct tm tm; 56 | char *result = strptime(str,time_format,&tm); 57 | if (result) 58 | f = Qnum(convert(&tm)); 59 | else 60 | f = hold(Qvoid); 61 | } 62 | else 63 | f = hold(Qvoid); 64 | drop(x); 65 | return f; 66 | } 67 | 68 | // Convert epoch to string in local time zone. 69 | value type_localtime(value f) 70 | { 71 | return op_strftime(f,localtime); 72 | } 73 | 74 | // Convert epoch to string in UTC time zone. 75 | value type_gmtime(value f) 76 | { 77 | return op_strftime(f,gmtime); 78 | } 79 | 80 | // Convert string to epoch in local time zone. 81 | value type_timelocal(value f) 82 | { 83 | return op_strptime(f,timelocal); 84 | } 85 | 86 | // Convert string to epoch in UTC time zone. 87 | value type_timegm(value f) 88 | { 89 | return op_strptime(f,timegm); 90 | } 91 | 92 | static string microtime(void) 93 | { 94 | uint64_t n; 95 | struct timeval sys_time; 96 | gettimeofday(&sys_time,0); 97 | n = ((uint64_t)sys_time.tv_sec * 1000000) + sys_time.tv_usec; 98 | return str_new_data0(format_uint64_t(n)); 99 | } 100 | 101 | value type_microtime(value f) 102 | { 103 | return Qstr(microtime()); 104 | (void)f; 105 | } 106 | 107 | // 1:Mon 2:Tue 3:Wed 4:Thu 5:Fri 6:Sat 0:Sun 108 | static int get_dow(int y, int m, int d) 109 | { 110 | static int t[] = {0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4}; 111 | if (m < 3) 112 | y--; 113 | return (y + y/4 - y/100 + y/400 + t[m-1] + d) % 7; 114 | } 115 | 116 | // Return day of week for y,m,d. 117 | // 1:Mon 2:Tue 3:Wed 4:Thu 5:Fri 6:Sat 7:Sun 118 | value type_dow(value f) 119 | { 120 | if (f->L->L == 0) return keep(f); 121 | if (f->L->L->L == 0) return keep(f); 122 | { 123 | value a1 = arg(f->L->L->R); 124 | value a2 = arg(f->L->R); 125 | value a3 = arg(f->R); 126 | if (a1->T == type_num && a2->T == type_num && a3->T == type_num) 127 | { 128 | int y = a1->v_double; 129 | int m = a2->v_double; 130 | int d = a3->v_double; 131 | int dow = get_dow(y,m,d); 132 | if (dow == 0) dow = 7; 133 | f = Qnum(dow); 134 | } 135 | else 136 | f = hold(Qvoid); 137 | drop(a1); 138 | drop(a2); 139 | drop(a3); 140 | return f; 141 | } 142 | } 143 | -------------------------------------------------------------------------------- /src/type_time.h: -------------------------------------------------------------------------------- 1 | extern value type_time(value f); 2 | extern value type_localtime(value f); 3 | extern value type_gmtime(value f); 4 | extern value type_timelocal(value f); 5 | extern value type_timegm(value f); 6 | extern value type_microtime(value f); 7 | extern value type_dow(value f); 8 | -------------------------------------------------------------------------------- /src/type_tuple.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | 6 | value Qtuple; 7 | 8 | value type_tuple(value f) 9 | { 10 | value args = hold(f->L->R); 11 | value exp = hold(f->R); 12 | 13 | while (1) 14 | { 15 | args = eval(args); 16 | if (args->T == type_list) 17 | { 18 | exp = A(exp,hold(args->L)); 19 | args = tail(args); 20 | } 21 | else if (args->T == type_null) 22 | { 23 | drop(args); 24 | return exp; 25 | } 26 | else 27 | { 28 | drop(exp); 29 | drop(args); 30 | return hold(Qvoid); 31 | } 32 | } 33 | } 34 | 35 | value type_is_tuple(value f) 36 | { 37 | value x = arg(f->R); 38 | f = boolean(x->T == type_tuple || x->T == type_pair); 39 | drop(x); 40 | return f; 41 | } 42 | 43 | value type_tuple_to_list(value f) 44 | { 45 | value x = arg(f->R); 46 | if (x->T == type_tuple) 47 | f = hold(x->R); 48 | else if (x->T == type_pair) 49 | f = cons(hold(x->L),cons(hold(x->R),hold(Qnull))); 50 | else 51 | f = hold(Qvoid); 52 | drop(x); 53 | return f; 54 | } 55 | 56 | value type_list_to_tuple(value f) 57 | { 58 | return V(type_tuple,hold(Qtuple),hold(f->R)); 59 | } 60 | 61 | void beg_tuple(void) 62 | { 63 | Qtuple = Q(type_tuple); 64 | } 65 | 66 | void end_tuple(void) 67 | { 68 | drop(Qtuple); 69 | } 70 | -------------------------------------------------------------------------------- /src/type_tuple.h: -------------------------------------------------------------------------------- 1 | extern value Qtuple; 2 | extern value type_tuple(value f); 3 | extern value type_is_tuple(value f); 4 | extern value type_tuple_to_list(value f); 5 | extern value type_list_to_tuple(value f); 6 | extern void beg_tuple(void); 7 | extern void end_tuple(void); 8 | -------------------------------------------------------------------------------- /src/type_var.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | 6 | // A var is a mutable variable where you can put and get values. This can help 7 | // with things like caching, simulating a dynamic entity such as a file system 8 | // or human user, redefining print to capture output in a memory buffer, etc. 9 | 10 | value type_var(value f) 11 | { 12 | return type_void(f); 13 | } 14 | 15 | static void clear_var(value f) 16 | { 17 | drop(f->R); 18 | } 19 | 20 | // (var_new) Return a new variable with a void value. 21 | value type_var_new(value f) 22 | { 23 | static struct value clear = {{.N=0}, {.clear=clear_var}}; 24 | return V(type_var,&clear,hold(Qvoid)); 25 | (void)f; 26 | } 27 | 28 | // (var_get var) Return the current value of var. 29 | value type_var_get(value f) 30 | { 31 | value x = arg(f->R); 32 | if (x->T == type_var) 33 | f = hold(x->R); 34 | else 35 | f = hold(Qvoid); 36 | drop(x); 37 | return f; 38 | } 39 | 40 | // (var_getf var) Yield the current value of var. 41 | value type_var_getf(value f) 42 | { 43 | value x = arg(f->R); 44 | if (x->T == type_var) 45 | f = yield(hold(x->R)); 46 | else 47 | f = hold(Qvoid); 48 | drop(x); 49 | return f; 50 | } 51 | 52 | static value op_put(value f, value op(value)) 53 | { 54 | if (f->L->L == 0) return keep(f); 55 | { 56 | value x = arg(f->L->R); 57 | if (x->T == type_var) 58 | { 59 | value v = op(f->R); 60 | drop(x->R); 61 | x->R = v; 62 | f = hold(QI); 63 | } 64 | else 65 | f = hold(Qvoid); 66 | drop(x); 67 | return f; 68 | } 69 | } 70 | 71 | // (var_put var x) Put the value of x into var. 72 | value type_var_put(value f) 73 | { 74 | return op_put(f,arg); 75 | } 76 | 77 | // (var_putf var x) Put x into var. 78 | value type_var_putf(value f) 79 | { 80 | return op_put(f,hold); 81 | } 82 | 83 | value type_is_var(value f) 84 | { 85 | return op_is_type(f,type_var); 86 | } 87 | -------------------------------------------------------------------------------- /src/type_var.h: -------------------------------------------------------------------------------- 1 | extern value type_var(value f); 2 | extern value type_var_new(value f); 3 | extern value type_var_get(value f); 4 | extern value type_var_getf(value f); 5 | extern value type_var_put(value f); 6 | extern value type_var_putf(value f); 7 | extern value type_is_var(value f); 8 | -------------------------------------------------------------------------------- /src/type_with.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | static int cmp_key(value x, value y) 11 | { 12 | if (x->T == type_str && y->T == type_str) 13 | return str_eq(x->v_ptr,y->v_ptr); 14 | else if (x->T == type_num && y->T == type_num) 15 | return x->v_double == y->v_double; 16 | else 17 | return 0; 18 | } 19 | 20 | // Look up the value associated with a key. 21 | value type_assoc(value f) 22 | { 23 | value obj = f->L; 24 | value x = arg(f->R); 25 | while (1) 26 | { 27 | value key = obj->L->L; 28 | if (cmp_key(key,x)) 29 | { 30 | drop(x); 31 | return hold(obj->L->R); 32 | } 33 | 34 | obj = obj->R; 35 | if (obj->T != type_assoc) 36 | return A(hold(obj),x); 37 | } 38 | } 39 | 40 | value Qassoc(value key, value val, value obj) 41 | { 42 | return V(type_assoc,pair(key,val),obj); 43 | } 44 | 45 | /* 46 | (with key val obj) 47 | Return a function like obj but with key defined as val. 48 | 49 | \with=(\key\\val\obj \x eq x key val; obj x) 50 | */ 51 | value type_with(value f) 52 | { 53 | if (f->L->L == 0) return keep(f); 54 | if (f->L->L->L == 0) return keep(f); 55 | { 56 | value key = arg(f->L->L->R); 57 | value val = hold(f->L->R); 58 | value obj = hold(f->R = eval(f->R)); 59 | return Qassoc(key,val,obj); 60 | } 61 | } 62 | 63 | /* 64 | (def key val obj) 65 | \def=(\\key\\val with key (yield val)) 66 | */ 67 | value type_def(value f) 68 | { 69 | if (f->L->L == 0) return keep(f); 70 | f->T = type_with; 71 | f->R = yield(f->R); 72 | return hold(f); 73 | } 74 | 75 | value type_is_obj(value f) 76 | { 77 | return op_is_type(f,type_assoc); 78 | } 79 | 80 | // (split_obj obj next) = (next key val tail), where key and val are the first 81 | // pair in the object, and tail is the value following the first pair. 82 | value type_split_obj(value f) 83 | { 84 | if (f->L->L == 0) return keep(f); 85 | { 86 | value x = arg(f->L->R); 87 | if (x->T == type_assoc) 88 | { 89 | value key = hold(x->L->L); 90 | value val = hold(x->L->R); 91 | value obj = hold(x->R); 92 | value next = hold(f->R); 93 | f = A(A(A(next,key),val),obj); 94 | } 95 | else 96 | f = hold(Qvoid); 97 | drop(x); 98 | return f; 99 | } 100 | } 101 | 102 | /* 103 | (fetch v k x) 104 | Return the value at key k in index v. If no value, store the value of x in 105 | the index so you get the same value next time. 106 | 107 | \fetch= 108 | (\v\k\\x 109 | \y=(var_get v k) 110 | is_defined y y; 111 | \x=x 112 | var_put v (with k x; var_get v) 113 | x 114 | ) 115 | */ 116 | value type_fetch(value f) 117 | { 118 | if (f->L->L == 0) return keep(f); 119 | if (f->L->L->L == 0) return keep(f); 120 | { 121 | value v = arg(f->L->L->R); 122 | if (v->T == type_var) 123 | { 124 | value k = arg(f->L->R); 125 | value y = eval(A(hold(v->R),hold(k))); 126 | if (y->T != type_void) 127 | f = y; 128 | else 129 | { 130 | drop(y); 131 | f = arg(f->R); 132 | v->R = Qassoc(hold(k),hold(f),v->R); 133 | } 134 | drop(k); 135 | } 136 | else 137 | f = hold(Qvoid); 138 | drop(v); 139 | return f; 140 | } 141 | } 142 | -------------------------------------------------------------------------------- /src/type_with.h: -------------------------------------------------------------------------------- 1 | extern value type_assoc(value f); 2 | extern value Qassoc(value key, value val, value obj); 3 | extern value type_with(value f); 4 | extern value type_def(value f); 5 | extern value type_is_obj(value f); 6 | extern value type_split_obj(value f); 7 | extern value type_fetch(value f); 8 | -------------------------------------------------------------------------------- /src/types.h: -------------------------------------------------------------------------------- 1 | typedef uint8_t u8; 2 | typedef int32_t i32; 3 | typedef uint32_t u32; 4 | typedef uint64_t u64; 5 | typedef int64_t i64; 6 | -------------------------------------------------------------------------------- /src/value.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | /* 5 | The value structure is defined as follows. 6 | 7 | Let f be a pointer to a struct value. 8 | 9 | f->N is the reference count. 10 | 11 | f->T is the type, a C routine which reduces the value during evaluation. 12 | 13 | f->next links values on the free list after f->N drops to 0. 14 | 15 | Every value f is one of three classes: atom, data, or tree. 16 | 17 | 1. atom : (f->L == 0 && f->R == 0) 18 | 19 | An atom value is a primary function with no arguments. 20 | 21 | 2. data : (f->L != 0 && f->L->N == 0) 22 | 23 | A data value has data that resides in the union which follows f->L. The 24 | f->L->clear field is a function that frees the data when f->N drops to 0. 25 | 26 | 3. tree : (f->L != 0 && f->L->N > 0) 27 | 28 | A tree value is a combination of values f->L and f->R. 29 | 30 | The "discard" routine below succinctly reflects these rules. 31 | 32 | Note that on most machines, (sizeof(struct value) == 32). 33 | */ 34 | 35 | static value free_list = 0; 36 | 37 | value new_value(void) 38 | { 39 | value f = free_list; 40 | if (f) 41 | free_list = f->next; 42 | else 43 | f = new_memory(sizeof(struct value)); 44 | return f; 45 | } 46 | 47 | void recycle(value f) 48 | { 49 | f->next = free_list; 50 | free_list = f; 51 | } 52 | 53 | // Discard a value f with reference count 0. This drops the L and R fields of 54 | // a tree value, or calls the clear routine of a data value, and recycles it. 55 | static void discard(value f) 56 | { 57 | if (f->L) 58 | { 59 | if (f->L->N) 60 | { 61 | drop(f->L); 62 | drop(f->R); 63 | } 64 | else 65 | f->L->clear(f); 66 | } 67 | recycle(f); 68 | } 69 | 70 | // Increment the reference count. 71 | value hold(value f) 72 | { 73 | f->N++; 74 | return f; 75 | } 76 | 77 | // Decrement the reference count and discard if it drops to zero. 78 | void drop(value f) 79 | { 80 | if (--f->N == 0) 81 | discard(f); 82 | } 83 | 84 | void clear_free_list(void) 85 | { 86 | while (free_list) 87 | { 88 | value f = free_list; 89 | free_list = f->next; 90 | free_memory(f,sizeof(struct value)); 91 | } 92 | } 93 | 94 | void end_value(void) 95 | { 96 | clear_free_list(); 97 | end_memory(); 98 | } 99 | 100 | // Return a value of type T with the given left and right side. 101 | value V(type T, value L, value R) 102 | { 103 | value f = new_value(); 104 | f->N = 1; 105 | f->T = T; 106 | f->L = L; 107 | f->R = R; 108 | return f; 109 | } 110 | 111 | // Create an atom of type T. 112 | value Q(type T) 113 | { 114 | return V(T,0,0); 115 | } 116 | 117 | // Apply x to y. 118 | value A(value x, value y) 119 | { 120 | return V(0,x,y); 121 | } 122 | 123 | value keep(value f) 124 | { 125 | f->T = f->L->T; 126 | return hold(f); 127 | } 128 | 129 | unsigned long cur_steps; 130 | 131 | value tail(value f) 132 | { 133 | value x = hold(f->R); 134 | drop(f); 135 | return x; 136 | } 137 | 138 | static value step(value f) 139 | { 140 | value g; 141 | if (f->L->T) 142 | g = f->L; 143 | else if (f->N == 1) 144 | g = (f->L = eval(f->L)); 145 | else 146 | { 147 | g = eval(hold(f->L)); 148 | if (g == f->L) 149 | drop(g); 150 | else 151 | f = A(g,tail(f)); 152 | } 153 | 154 | g = g->T(f); 155 | drop(f); 156 | cur_steps++; 157 | return g; 158 | } 159 | 160 | // Reduce the value until done. 161 | value eval(value f) 162 | { 163 | while (f->T == 0) 164 | f = step(f); 165 | return f; 166 | } 167 | 168 | value arg(value f) 169 | { 170 | return eval(hold(f)); 171 | } 172 | -------------------------------------------------------------------------------- /src/value.h: -------------------------------------------------------------------------------- 1 | typedef struct value *value; 2 | typedef value (*type)(value f); 3 | 4 | struct value 5 | { 6 | union 7 | { 8 | unsigned long N; 9 | value next; 10 | }; 11 | union 12 | { 13 | type T; 14 | void (*clear)(value); 15 | }; 16 | value L; 17 | union 18 | { 19 | value R; 20 | void *v_ptr; 21 | double v_double; 22 | }; 23 | }; 24 | 25 | extern value new_value(void); 26 | extern void recycle(value f); 27 | extern value hold(value f); 28 | extern void drop(value f); 29 | extern void clear_free_list(void); 30 | extern void end_value(void); 31 | extern value V(type T, value L, value R); 32 | extern value Q(type T); 33 | extern value A(value x, value y); 34 | extern value keep(value f); 35 | extern unsigned long cur_steps; 36 | extern value tail(value f); 37 | extern value eval(value f); 38 | extern value arg(value f); 39 | --------------------------------------------------------------------------------