commit 3d6cbd0df238759360eaaea926bee5c8e28896c5
parent 7509006b42ebe497f58b3587360d107ef51a09e2
Author: Ed van Bruggen <edvb@uw.edu>
Date: Tue, 14 Jul 2020 01:17:29 -0700
Rename tibs folder to tib, split up lib.tsp
lib.tsp is now core.tsp for the main langauge definition which most
programs need, math.tsp for math functions and constants, and io.tsp for
input/output functions
Diffstat:
| Makefile | | | 6 | +++--- |
| tib/core.tsp | | | 309 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| tib/doc.tsp | | | 74 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| tib/io.c | | | 164 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| tib/io.tsp | | | 18 | ++++++++++++++++++ |
| tib/math.c | | | 294 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| tib/math.tsp | | | 60 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| tib/repl.tsp | | | 15 | +++++++++++++++ |
| tib/string.c | | | 128 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| tib/time.c | | | 54 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| tibs/doc.tsp | | | 74 | -------------------------------------------------------------------------- |
| tibs/io.c | | | 162 | ------------------------------------------------------------------------------- |
| tibs/lib.tsp | | | 387 | ------------------------------------------------------------------------------- |
| tibs/math.c | | | 294 | ------------------------------------------------------------------------------- |
| tibs/repl.tsp | | | 15 | --------------- |
| tibs/string.c | | | 128 | ------------------------------------------------------------------------------- |
| tibs/time.c | | | 54 | ------------------------------------------------------ |
17 files changed, 1119 insertions(+), 1117 deletions(-)
diff --git a/Makefile b/Makefile
@@ -10,10 +10,10 @@ endif
EXE = tisp
SRC = tisp.c main.c
-TIB = tibs/math.c tibs/io.c tibs/time.c tibs/string.c
+TIB = tib/math.c tib/io.c tib/time.c tib/string.c
OBJ = $(SRC:.c=.o) $(TIB:.c=.o)
-LIB = tibs/libtibmath.so tibs/libtibio.so
-TSP = tibs/lib.tsp tibs/doc.tsp tibs/repl.tsp
+LIB = tib/libtibmath.so tib/libtibio.so
+TSP = tib/core.tsp tib/io.tsp tib/math.tsp tib/doc.tsp tib/repl.tsp
all: options $(EXE)
diff --git a/tib/core.tsp b/tib/core.tsp
@@ -0,0 +1,309 @@
+(define (list . lst) lst)
+
+(define defmacro
+ (macro (args . body)
+ (list 'define (car args) (list 'macro (cdr args) . body))))
+
+;;; CXR
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+(define (caaar x) (car (car (car x))))
+(define (caadr x) (car (car (cdr x))))
+(define (cadar x) (car (cdr (car x))))
+(define (caddr x) (car (cdr (cdr x))))
+(define (cdaar x) (cdr (car (car x))))
+(define (cdadr x) (cdr (car (cdr x))))
+(define (cddar x) (cdr (cdr (car x))))
+(define (cdddr x) (cdr (cdr (cdr x))))
+(define (caaaar x) (car (car (car (car x)))))
+(define (caaadr x) (car (car (car (cdr x)))))
+(define (caadar x) (car (car (cdr (car x)))))
+(define (caaddr x) (car (car (cdr (cdr x)))))
+(define (cadaar x) (car (cdr (car (car x)))))
+(define (cadadr x) (car (cdr (car (cdr x)))))
+(define (caddar x) (car (cdr (cdr (car x)))))
+(define (cadddr x) (car (cdr (cdr (cdr x)))))
+(define (cdaaar x) (cdr (car (car (car x)))))
+(define (cdaadr x) (cdr (car (car (cdr x)))))
+(define (cdadar x) (cdr (car (cdr (car x)))))
+(define (cdaddr x) (cdr (car (cdr (cdr x)))))
+(define (cddaar x) (cdr (cdr (car (car x)))))
+(define (cddadr x) (cdr (cdr (car (cdr x)))))
+(define (cdddar x) (cdr (cdr (cdr (car x)))))
+(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
+
+;;; Types
+(define (any? x) t)
+(define (void? x) (= (typeof x) "void"))
+(define (nil? x) (= (typeof x) "nil"))
+(define empty? nil?)
+(define (integer? x) (= (typeof x) "integer"))
+(define (decimal? x) (= (typeof x) "decimal"))
+(define (ratio? x) (= (typeof x) "ratio"))
+(define (string? x) (= (typeof x) "string"))
+(define (symbol? x) (= (typeof x) "symbol"))
+(define (primitive? x) (= (typeof x) "primitive"))
+(define (function? x) (= (typeof x) "function"))
+(define (macro? x) (= (typeof x) "macro"))
+(define (pair? x) (= (typeof x) "pair"))
+(define (atom? x) (not (pair? x)))
+(define (cons? x) (and (pair? x) (not (pair? (cdr x)))))
+(define (list? x) (if (pair? x) (list? (cdr x)) (not x)))
+(define (boolean? x) (or (= x t) (nil? x)))
+(define (true? x) (= x t))
+(define false? nil?)
+(define (procedure? x) (or (primitive? x) (or (function? x) (macro? x))))
+(define (rational? x) (or (integer? x) (ratio? x)))
+(define (number? x) (or (rational? x) (decimal? x)))
+
+(define (bool x) (if x t nil))
+; TODO handle string and sym
+(define (pair x)
+ (cond
+ ((rational? x)
+ (cons (numerator x)
+ (denominator x)))
+ ((decimal? x)
+ (cons (integer (truncate x))
+ (- x (truncate x))))
+ ((or (void? x) (nil? x) (pair? x)) x)
+ (else (list x))))
+
+(defmacro (assert expr)
+ `(unless ,expr
+ (error 'assert "assertion " ',expr " failed")))
+
+; TODO support any sized list n depending on size of optional val
+(define (default n val)
+ (cond
+ ((nil? n) val)
+ ((and (pair? n) (nil? (cdr n)))
+ (car n))
+ (else (error 'default "expected only 1 optional argument"))))
+
+;;; Control Flow
+; TODO if b = pair and car b = else use cdr b
+(defmacro (if con a b)
+ (list 'cond (list con a) (list t b)))
+(define else t)
+(defmacro (when con . body)
+ (list 'cond (list con (cons 'do body))))
+(defmacro (unless con . body)
+ (list 'cond (list (list not con) (cons 'do body))))
+
+(defmacro (let vars . body)
+ (list (list* 'lambda ()
+ (append
+ (map
+ (lambda (x)
+ (list* 'define (car x) (cdr x)))
+ vars)
+ body))))
+
+(defmacro (recur proc vars . body)
+ (list 'let
+ (list*
+ (list proc (list* 'lambda (map car vars) body))
+ vars)
+ (list* proc (map car vars))))
+
+(defmacro (switch val . body)
+ (list* 'cond (map
+ (lambda (line)
+ `((= ,val ,(car line)) ,(cadr line)))
+ body)))
+
+; TODO allow for improper lists
+(defmacro (quasiquote x)
+ (define (check x)
+ (unless (and (pair? (cdr x)) (nil? (cddr x)))
+ (error (car x) "invalid form " x)))
+ (define (quasicons a d)
+ (if (pair? d)
+ (if (= (car d) 'quote)
+ (if (and (pair? a) (= (car a) 'quote))
+ (list 'quote (list* (cadr a) (cadr d)))
+ (if (nil? (cadr d))
+ (list 'list a)
+ (list list* a d)))
+ (if (member (car d) '(list list*))
+ (list* (car d) a (cdr d))
+ (list list* a d)))
+ (list list* a d)))
+ (recur f ((x x))
+ (cond
+ ((atom? x) (list 'quote x))
+ ((= (car x) 'unquote)
+ (check x)
+ (cadr x))
+ (else (quasicons (f (car x)) (f (cdr x)))))))
+
+(defmacro (unquote x) (list error ''unquote "called outside of quasiquote"))
+
+;;; Logic
+(define true t)
+(define false ())
+(define (not x)
+ (if x nil t))
+; TODO logic func many arguments
+; Use a macro so arguments aren't evaluated all at once
+(defmacro (and a b)
+ (list 'if a b nil))
+(defmacro (nand a b)
+ (list 'not (list 'and a b)))
+(defmacro (or a b)
+ (list 'if a a b))
+(defmacro (nor a b)
+ (list 'not (list 'or a b)))
+
+;;; Lists
+(define (list* . lst)
+ (if (cdr lst)
+ (cons (car lst) (apply list* (cdr lst)))
+ (car lst)))
+
+(define (do . body) (last body))
+(define (do0 . body) (car body))
+
+(define (length lst)
+ (recur f ((lst lst) (x 0))
+ (if lst
+ (f (cdr lst) (+ x 1))
+ x)))
+
+(define (last lst)
+; recur loop ((lst lst) (n (if n (car n) 0)))
+ (if (cdr lst)
+ (last (cdr lst))
+ (car lst)))
+
+; TODO make nth generic for list str vec, made up of list-ref vec-ref str-ref
+(define (nth lst n)
+ (cond
+ ((atom? lst)
+ (error 'nth "index of list out of bounds"))
+ ((<= n 0) (car lst))
+ (else (nth (cdr lst) (- n 1)))))
+
+; TODO diff name head/tail since conflicts w/ unix
+; TODO support negative numers like unix tail/head to count from end backwards
+(define (head lst n)
+ (cond
+ ((<= n 0) nil)
+ ((atom? lst)
+ (error 'name "index of list out of bounds"))
+ (else (cons (car lst) (head (cdr lst) (- n 1))))))
+
+(define (tail lst n)
+ (cond
+ ((<= n 0) lst)
+ ((atom? lst)
+ (error 'tail "index of list out of bounds"))
+ (else (tail (cdr lst) (- n 1)))))
+
+(define (count x lst)
+ (cond ((nil? lst) 0)
+ ((atom? lst) (error 'count "expected proper list"))
+ ((= x (car lst)) (+ 1 (count x (cdr lst))))
+ (else (count x (cdr lst)))))
+
+; TODO many args
+(define (apply proc args)
+ (eval (map (lambda (x) ; prevent args from being evaluated twice
+ (list 'quote x))
+ (cons proc args))))
+
+; TODO many lsts for proc w/ multi arguments
+(define (map proc lst)
+ (if lst
+ (cons (proc (car lst))
+ (map proc (cdr lst)))
+ nil))
+
+(define (filter proc lst)
+ (cond
+ ((not (pair? lst)) nil)
+ ((proc (car lst)) (cons (car lst) (filter proc (cdr lst))))
+ (else (filter proc (cdr lst)))))
+
+(define (compose . procs)
+ (cond
+ ((nil? procs) (lambda x x))
+ ((nil? (cdr procs)) (car procs))
+ (else
+ (lambda x
+ ((car procs) (apply (apply compose (cdr procs)) x))))))
+
+(define (reverse l)
+ (recur f ((in l) (out nil))
+ (if (pair? in)
+ (f (cdr in) (cons (car in) out))
+ out)))
+
+; TODO accept many lists to append
+(define (append x y)
+ (cond
+ ((pair? x) (cons (car x) (append (cdr x) y)))
+ ((nil? x) y)
+ (else (error 'append "expected proper list"))))
+
+(define (zip x y)
+ (cond ((and (nil? x) (nil? y)) nil)
+ ((or (nil? x) (nil? y)) (error 'zip "given lists of unequal length"))
+ ((and (pair? x) (pair? y))
+ (cons (cons (car x) (car y))
+ (zip (cdr x) (cdr y))))))
+
+; TODO assoc optional equal? arg
+(define (assoc key table)
+ (cond ((nil? table) nil)
+ ((= key (caar table)) (car table))
+ (else (assoc key (cdr table)))))
+
+(define (memp proc lst)
+ (cond ((nil? lst) nil)
+ ((proc (car lst)) lst)
+ (else (memp proc (cdr lst)))))
+
+(define (member mem lst)
+ (memp (lambda (x) (= mem x)) lst))
+
+; define English list element accessors
+(define rest cdr) ; TODO first and rest are generics for list, vec, str types
+(define first car)
+(let (((def name count)
+ (list 'define (list name 'x) (list 'nth 'x count))))
+ (recur f ((n 1)
+ (lst '(second third forth fifth sixth seventh eighth ninth tenth)))
+ (when lst
+ (eval (def (car lst) n))
+ (f (+ n 1) (cdr lst)))))
+
+;;; Stacks
+(define (push stack val)
+ (cons val stack))
+
+(defmacro (push! stack val)
+ `(set! ,stack (push ,stack ,val)))
+
+(define pop cdr)
+
+(defmacro (pop! stack)
+ `(do0
+ (peek ,stack)
+ (set! ,stack (pop ,stack))))
+
+(define peek car)
+
+(define (swap stack)
+ (let ((x (peek stack))
+ (y (peek (pop stack))))
+ (push (push (pop (pop stack)) x) y)))
+
+; TODO swap! use gen sym instead of x and y ?
+(defmacro (swap! stack)
+ `(let ((x (pop! ,stack))
+ (y (pop! ,stack)))
+ (set! ,stack (push (push ,stack x) y))))
diff --git a/tib/doc.tsp b/tib/doc.tsp
@@ -0,0 +1,74 @@
+(define docstr-reg
+ '((car
+ "(car lst)"
+ "return first element of list")
+ (cdr
+ "(cdr lst)"
+ "return rest of list after first element")
+ (cons
+ "(cons a d)"
+ "create new pair with a car of a and cdr of d")
+ (quote
+ "(quote expr)"
+ "return expression unevaluated")
+ (void
+ "(void)"
+ "return void type")
+ (eval
+ "(eval expr)"
+ "evaluate expression, can be dangerous to use in practice")
+ (=
+ "(= . vals)"
+ "return boolean depending on if multiple values are all equal")
+ (cond
+ "(cond . (expr . body))"
+ "conditional statement")
+ (typeof
+ "(typeof val)"
+ "return a string stating the argument's type")
+ (get
+ "(get val prop)"
+ "get the property of the given value depending on its type")
+ (lambda
+ "(lambda args . body)"
+ "create anonymous function")
+ (macro
+ "(macro args . body)"
+ "create anonymous macro")
+ (define
+ "(define var . val)"
+ "(define (func . args) . body)"
+ "creates new variable with value, or create new function if argument list given"
+ "if value for variable is not given, make it a self-evaluating symbol")
+ (set!
+ "(set! var val)"
+ "change the variable var to val")
+ (load
+ "(load lib)"
+ "loads the library given as a string")
+ (error
+ "(error func msg)"
+ "throw error, print message with function name given as symbol")
+ (version
+ "(version)"
+ "return string of tisp's version number")))
+
+(define (doc proc)
+ "get documentation of function supplied by its doc string"
+ (unless (procedure? proc)
+ (error 'doc "documentation only exists for procedures"))
+ (define (lookup proc)
+ (recur f ((docstr docstr-reg))
+ (cond ((nil? docstr)
+ (error 'doc (get proc 'name) ": no documentation found"))
+ ((= (caar docstr) (get proc 'name))
+ (map disp (cdar docstr)))
+ (else (f (cdr docstr))))))
+ (if (or (function? proc) (macro? proc))
+ (let ((docstr (car (get proc 'body))))
+ (if (string? docstr)
+ (disp (cons (get proc 'name) (get proc 'args)) "\n"
+ docstr)
+ (lookup proc)))
+ (lookup proc))
+ (void))
diff --git a/tib/io.c b/tib/io.c
@@ -0,0 +1,164 @@
+/* zlib License
+ *
+ * Copyright (c) 2017-2020 Ed van Bruggen
+ *
+ * This software is provided 'as-is', without any express or implied
+ * warranty. In no event will the authors be held liable for any damages
+ * arising from the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software
+ * in a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <fcntl.h>
+
+#include "../tisp.h"
+
+/* write all arguemnts to given file, or stdout/stderr, without newline */
+/* first argument is file name, second is option to append file */
+static Val
+prim_write(Tsp st, Hash env, Val args)
+{
+ Val v;
+ FILE *f;
+ const char *mode = "w";
+ tsp_arg_min(args, "write", 2);
+ if (!(v = tisp_eval_list(st, env, args)))
+ return NULL;
+
+ /* if second argument is true, append file don't write over */
+ if (!nilp(cadr(v)))
+ mode = "a";
+ /* first argument can either be the symbol stdout or stderr,
+ * or the file as a string */
+ if (car(v)->t == SYMBOL)
+ f = !strncmp(car(v)->v.s, "stdout", 7) ? stdout : stderr;
+ else if (car(v)->t != STRING)
+ tsp_warnf("write: expected file name as string, received %s",
+ type_str(car(v)->t));
+ else if (!(f = fopen(car(v)->v.s, mode)))
+ tsp_warnf("write: could not load file '%s'", car(v)->v.s);
+ if (f == stderr && strncmp(car(v)->v.s, "stderr", 7))
+ tsp_warn("write: expected file name as string, "
+ "or symbol stdout/stderr");
+
+ for (v = cddr(v); !nilp(v); v = cdr(v))
+ tisp_print(f, car(v));
+ if (f == stdout || f == stderr)
+ fflush(f);
+ else
+ fclose(f);
+ return st->none;
+}
+
+/* return string of given file or read from stdin */
+static Val
+prim_read(Tsp st, Hash env, Val args)
+{
+ Val v;
+ char *file, *fname = NULL; /* read from stdin by default */
+ if (list_len(args) > 1)
+ tsp_warnf("read: expected 0 or 1 argument, received %d", list_len(args));
+ if (list_len(args) == 1) { /* if file name given as string, read it */
+ if (!(v = tisp_eval(st, env, car(args))))
+ return NULL;
+ tsp_arg_type(v, "read", STRING);
+ fname = v->v.s;
+ }
+ if (!(file = tisp_read_file(fname)))
+ return st->nil;
+ return mk_str(st, file);
+}
+
+/* parse string as tisp expression, return (quit) if given nil */
+/* TODO parse more than 1 expression */
+static Val
+prim_parse(Tsp st, Hash env, Val args)
+{
+ Val v;
+ char *file = st->file;
+ size_t filec = st->filec;
+ tsp_arg_num(args, "parse", 1);
+ if (!(v = tisp_eval(st, env, car(args))))
+ return NULL;
+ if (nilp(v))
+ return mk_pair(mk_sym(st, "quit"), st->nil);
+ tsp_arg_type(v, "parse", STRING);
+ st->file = v->v.s;
+ st->filec = 0;
+ v = tisp_read(st);
+ /* for (; tsp_fget(st) && (v = tisp_read(st));) ; */
+ st->file = file;
+ st->filec = filec;
+ return v ? v : st->none;
+ /* return tisp_parse_file(st, v->v.s); */
+}
+
+/* save value as binary file to be quickly read again */
+static Val
+prim_save(Tsp st, Hash env, Val args)
+{
+ Val v;
+ char *fname;
+ FILE *f;
+ tsp_arg_min(args, "save", 2);
+ if (!(v = tisp_eval_list(st, env, args)))
+ return NULL;
+ tsp_arg_type(cadr(v), "save", STRING);
+ fname = cadr(v)->v.s;
+ if (!(f = fopen(fname, "wb")))
+ tsp_warnf("save: could not load file '%s'", fname);
+ if (!(fwrite(&*car(v), sizeof(struct Val), 1, f))) {
+ fclose(f);
+ tsp_warnf("save: could not save file '%s'", fname);
+ }
+ fclose(f);
+ return car(v);
+}
+
+/* return read binary value previously saved */
+static Val
+prim_open(Tsp st, Hash env, Val args)
+{
+ FILE *f;
+ char *fname;
+ struct Val v;
+ Val ret;
+ if (!(ret = malloc(sizeof(struct Val)))) {
+ fprintf(stderr, "malloc: ");
+ perror(NULL);
+ exit(1);
+ }
+ tsp_arg_min(args, "open", 1);
+ if (!(args = tisp_eval_list(st, env, args)))
+ return NULL;
+ tsp_arg_type(car(args), "save", STRING);
+ fname = car(args)->v.s;
+ if (!(f = fopen(fname, "rb")))
+ tsp_warnf("save: could not load file '%s'", fname);
+ while (fread(&v, sizeof(struct Val), 1, f)) ;
+ fclose(f);
+ memcpy(ret, &v, sizeof(struct Val));
+ return ret;
+}
+
+void
+tib_env_io(Tsp st)
+{
+ tsp_env_fn(write);
+ tsp_env_fn(read);
+ tsp_env_fn(parse);
+ tsp_env_fn(save);
+ tsp_env_fn(open);
+}
diff --git a/tib/io.tsp b/tib/io.tsp
@@ -0,0 +1,18 @@
+(define (run file) (eval (parse (read file))))
+(define (print . str) (apply write (list* 'stdout nil str)))
+(define (newline . file)
+ (if (or (nil? file) (nil? (cdr file)))
+ (write (car (or file '(stdout))) file "\n")
+ (error 'newline "only zero or one file can be given")))
+
+(define (display . str)
+ (map (lambda (s)
+ (cond
+ ((string? s) (print "\"" s "\""))
+ ((true? s) (print s)) ; don't print 't since it's self evaluating
+ ((symbol? s) (print "'" s))
+ ((pair? s) (print "'" s))
+ (else (print s))))
+ str))
+(define (displayln . str) (apply display str) (newline))
+(define (println . str) (apply print str) (newline))
diff --git a/tib/math.c b/tib/math.c
@@ -0,0 +1,294 @@
+/* zlib License
+ *
+ * Copyright (c) 2017-2020 Ed van Bruggen
+ *
+ * This software is provided 'as-is', without any express or implied
+ * warranty. In no event will the authors be held liable for any damages
+ * arising from the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software
+ * in a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+#include <assert.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "../tisp.h"
+
+#define EVAL_CHECK(A, V, NAME, TYPE) do { \
+ if (!(A = tisp_eval(st, vars, V))) \
+ return NULL; \
+ tsp_arg_type(A, NAME, TYPE); \
+} while(0)
+
+static Val
+prim_numerator(Tsp st, Hash vars, Val args)
+{
+ Val a;
+ tsp_arg_num(args, "numerator", 1);
+ EVAL_CHECK(a, car(args), "numerator", RATIONAL);
+ return mk_int(num(a));
+}
+
+static Val
+prim_denominator(Tsp st, Hash vars, Val args)
+{
+ Val a;
+ tsp_arg_num(args, "denominator", 1);
+ EVAL_CHECK(a, car(args), "denominator", RATIONAL);
+ return mk_int(den(a));
+}
+
+/* wrapper functions to be returned by mk_num, all need same arguments */
+static Val
+create_int(double num, double den)
+{
+ assert(den == 1);
+ return mk_int(num);
+}
+
+static Val
+create_dec(double num, double den)
+{
+ assert(den == 1);
+ return mk_dec(num);
+}
+
+static Val
+create_rat(double num, double den)
+{
+ return mk_rat(num, den);
+}
+
+/* return pointer to one of the preceding functions depending on what
+ * number should be created by the following arithmetic functions
+ * force arg is used to force number to one type:
+ * 0 -> no force, 1 -> force ratio/int, 2 -> force decimal */
+static Val
+(*mk_num(Type a, Type b, int force))(double, double)
+{
+ if (force == 1)
+ return &create_rat;
+ if (force == 2)
+ return &create_dec;
+ if (a & DECIMAL || b & DECIMAL)
+ return &create_dec;
+ if (a & RATIO || b & RATIO)
+ return &create_rat;
+ return &create_int;
+}
+
+#define PRIM_ROUND(NAME, FORCE) \
+static Val \
+prim_##NAME(Tsp st, Hash vars, Val args) \
+{ \
+ Val a; \
+ tsp_arg_num(args, #NAME, 1); \
+ EVAL_CHECK(a, car(args), #NAME, NUMBER); \
+ return (mk_num(a->t, a->t, FORCE))(NAME(num(a)/den(a)), 1.); \
+}
+
+/* define int and dec as identity functions to use them in the same macro */
+#define integer(X) (X)
+PRIM_ROUND(integer, 1)
+#undef integer
+#define decimal(X) (X)
+PRIM_ROUND(decimal, 2)
+#undef decimal
+PRIM_ROUND(round, 0)
+PRIM_ROUND(floor, 0)
+PRIM_ROUND(ceil, 0)
+
+static Val
+prim_add(Tsp st, Hash vars, Val args)
+{
+ Val a, b;
+ tsp_arg_num(args, "+", 2);
+ EVAL_CHECK(a, car(args), "+", NUMBER);
+ EVAL_CHECK(b, car(cdr(args)), "+", NUMBER);
+ if (a->t & DECIMAL || b->t & DECIMAL)
+ return mk_dec((num(a)/den(a)) + (num(b)/den(b)));
+ return (mk_num(a->t, b->t, 0))
+ (num(a) * den(b) + den(a) * num(b),
+ den(a) * den(b));
+}
+
+static Val
+prim_sub(Tsp st, Hash vars, Val args)
+{
+ Val a, b;
+ int len = list_len(args);
+ if (len != 2 && len != 1)
+ tsp_warnf("-: expected 1 or 2 arguments, recieved %d", len);
+ EVAL_CHECK(a, car(args), "-", NUMBER);
+ if (len == 1) {
+ b = a;
+ a = mk_int(0);
+ } else {
+ EVAL_CHECK(b, car(cdr(args)), "-", NUMBER);
+ }
+ if (a->t & DECIMAL || b->t & DECIMAL)
+ return mk_dec((num(a)/den(a)) - (num(b)/den(b)));
+ return (mk_num(a->t, b->t, 0))
+ (num(a) * den(b) - den(a) * num(b),
+ den(a) * den(b));
+}
+
+static Val
+prim_mul(Tsp st, Hash vars, Val args)
+{
+ Val a, b;
+ tsp_arg_num(args, "*", 2);
+ EVAL_CHECK(a, car(args), "*", NUMBER);
+ EVAL_CHECK(b, car(cdr(args)), "*", NUMBER);
+ if (a->t & DECIMAL || b->t & DECIMAL)
+ return mk_dec((num(a)/den(a)) * (num(b)/den(b)));
+ return (mk_num(a->t, b->t, 0))(num(a) * num(b), den(a) * den(b));
+
+}
+
+static Val
+prim_div(Tsp st, Hash vars, Val args)
+{
+ Val a, b;
+ int len = list_len(args);
+ if (len != 2 && len != 1)
+ tsp_warnf("/: expected 1 or 2 arguments, recieved %d", len);
+ EVAL_CHECK(a, car(args), "/", NUMBER);
+ if (len == 1) {
+ b = a;
+ a = mk_int(1);
+ } else {
+ EVAL_CHECK(b, car(cdr(args)), "/", NUMBER);
+ }
+ if (a->t & DECIMAL || b->t & DECIMAL)
+ return mk_dec((num(a)/den(a)) / (num(b)/den(b)));
+ return (mk_num(a->t, b->t, 1))(num(a) * den(b), den(a) * num(b));
+}
+
+static Val
+prim_mod(Tsp st, Hash vars, Val args)
+{
+ Val a, b;
+ tsp_arg_num(args, "mod", 2);
+ EVAL_CHECK(a, car(args), "mod", INTEGER);
+ EVAL_CHECK(b, car(cdr(args)), "mod", INTEGER);
+ if (num(b) == 0)
+ tsp_warn("division by zero");
+ return mk_int((int)num(a) % abs((int)num(b)));
+}
+
+/* TODO if given function as 2nd arg run it on first arg */
+static Val
+prim_pow(Tsp st, Hash vars, Val args)
+{
+ double bnum, bden;
+ Val b, p;
+ tsp_arg_num(args, "pow", 2);
+ EVAL_CHECK(b, car(args), "pow", EXPRESSION);
+ EVAL_CHECK(p, car(cdr(args)), "pow", EXPRESSION);
+ bnum = pow(num(b), num(p)/den(p));
+ bden = pow(den(b), num(p)/den(p));
+ if ((bnum == (int)bnum && bden == (int)bden) ||
+ b->t & DECIMAL || p->t & DECIMAL)
+ return mk_num(b->t, p->t, 0)(bnum, bden);
+ return mk_pair(mk_sym(st, "^"), mk_pair(b, mk_pair(p, st->nil)));
+}
+
+#define PRIM_COMPARE(NAME, OP) \
+static Val \
+prim_##NAME(Tsp st, Hash vars, Val args) \
+{ \
+ Val v; \
+ if (!(v = tisp_eval_list(st, vars, args))) \
+ return NULL; \
+ if (list_len(v) != 2) \
+ return st->t; \
+ tsp_arg_type(car(v), #OP, NUMBER); \
+ tsp_arg_type(car(cdr(v)), #OP, NUMBER); \
+ return ((num(car(v))*den(car(cdr(v)))) OP \
+ (num(car(cdr(v)))*den(car(v)))) ? \
+ st->t : st->nil; \
+}
+
+PRIM_COMPARE(lt, <)
+PRIM_COMPARE(gt, >)
+PRIM_COMPARE(lte, <=)
+PRIM_COMPARE(gte, >=)
+
+#define PRIM_TRIG(NAME) \
+static Val \
+prim_##NAME(Tsp st, Hash vars, Val args) \
+{ \
+ Val v; \
+ tsp_arg_num(args, #NAME, 1); \
+ EVAL_CHECK(v, car(args), #NAME, EXPRESSION); \
+ if (v->t & DECIMAL) \
+ return mk_dec(NAME(num(v))); \
+ return mk_pair(mk_sym(st, #NAME), mk_pair(v, st->nil)); \
+}
+
+PRIM_TRIG(sin)
+PRIM_TRIG(cos)
+PRIM_TRIG(tan)
+PRIM_TRIG(sinh)
+PRIM_TRIG(cosh)
+PRIM_TRIG(tanh)
+PRIM_TRIG(asin)
+PRIM_TRIG(acos)
+PRIM_TRIG(atan)
+PRIM_TRIG(asinh)
+PRIM_TRIG(acosh)
+PRIM_TRIG(atanh)
+PRIM_TRIG(exp)
+PRIM_TRIG(log)
+
+void
+tib_env_math(Tsp st)
+{
+ tsp_env_fn(numerator);
+ tsp_env_fn(denominator);
+
+ tsp_env_fn(integer);
+ tsp_env_fn(decimal);
+ tsp_env_fn(floor);
+ tsp_env_fn(ceil);
+ tsp_env_fn(round);
+
+ tsp_env_name_fn(+, add);
+ tsp_env_name_fn(-, sub);
+ tsp_env_name_fn(*, mul);
+ tsp_env_name_fn(/, div);
+ tsp_env_fn(mod);
+ tsp_env_name_fn(^, pow);
+
+ tsp_env_name_fn(<, lt);
+ tsp_env_name_fn(>, gt);
+ tsp_env_name_fn(<=, lte);
+ tsp_env_name_fn(>=, gte);
+
+ tsp_env_fn(sin);
+ tsp_env_fn(cos);
+ tsp_env_fn(tan);
+ tsp_env_fn(sinh);
+ tsp_env_fn(cosh);
+ tsp_env_fn(tanh);
+ tsp_env_name_fn(arcsin, asin);
+ tsp_env_name_fn(arccos, acos);
+ tsp_env_name_fn(arctan, atan);
+ tsp_env_name_fn(arcsinh, asinh);
+ tsp_env_name_fn(arccosh, acosh);
+ tsp_env_name_fn(arctanh, atanh);
+ tsp_env_fn(exp);
+ tsp_env_fn(log);
+}
diff --git a/tib/math.tsp b/tib/math.tsp
@@ -0,0 +1,60 @@
+;;; Constants
+(define pi (* 4 (arctan 1.)))
+(define tau (* 2 pi))
+(define e (exp 1.))
+
+;;; Functions
+(define (inc x) (+ x 1))
+(define (dec x) (- x 1))
+(define (truncate x) (* (floor (abs x)) (sgn x)))
+(define (sqr x) (* x x))
+(define (cube x) (* x (* x x)))
+(define (root b p) (^ b (/ p)))
+(define (sqrt x) (root x 2))
+(define (cbrt x) (root x 3))
+(define (logb b x) (/ (log x) (log b)))
+(define (log10 x) (logb 10. x))
+
+(defmacro (++ x . n)
+ `(set! ,x (+ ,x ,(default n 1))))
+(defmacro (-- x . n)
+ `(set! ,x (- ,x ,(default n 1))))
+
+; inverse trig functions
+(define (csc x) (/ (sin x)))
+(define (arccsc x) (/ (arcsin x)))
+(define (csch x) (/ (sinh x)))
+(define (arccsch x) (/ (arcsinh x)))
+(define (sec x) (/ (cos x)))
+(define (arcsec x) (/ (arccos x)))
+(define (sech x) (/ (cosh x)))
+(define (arcsech x) (/ (arccosh x)))
+(define (cot x) (/ (tan x)))
+(define (arccot x) (/ (arctan x)))
+(define (coth x) (/ (tanh x)))
+(define (arccoth x) (/ (arctanh x)))
+
+(define (abs x) (if (>= x 0) x (- x)))
+(define (sgn x) (if (= x 0) x (/ (abs x) x)))
+; TODO many args
+(define (max a b) (if (> a b) a b))
+(define (min a b) (if (< a b) a b))
+
+(define (positive? x) (> x 0))
+(define (negative? x) (< x 0))
+(define (zero? x) (= x 0))
+(define (even? x) (= (mod x 2) 0))
+(define (odd? x) (= (mod x 2) 1))
+
+(define (dot v w)
+ (if v
+ (+ (* (car v) (car w))
+ (dot (cdr v) (cdr w)))
+ 0))
+(define (norm v) (sqrt (dot v v)))
+
+(define (! n)
+ (if (= n 1)
+ 1
+ (* n (! (- n 1)))))
+
diff --git a/tib/repl.tsp b/tib/repl.tsp
@@ -0,0 +1,15 @@
+(define (repl)
+ (print "> ")
+ (let ((expr (parse (read))))
+ (unless (and (pair? expr) (= (car expr) 'quit))
+ ; TODO push! ans to stack of outputs
+ (let ((ans (eval expr)))
+ (unless (void? ans)
+ (displayln ans))
+ (repl)))))
+
+;; simple repl, only requires io.c tib
+(define (repl-simple)
+ (write 'stdout nil "> ")
+ (write 'stdout nil (eval (parse (read))) "\n")
+ (repl-simple))
diff --git a/tib/string.c b/tib/string.c
@@ -0,0 +1,128 @@
+/* zlib License
+ *
+ * Copyright (c) 2017-2020 Ed van Bruggen
+ *
+ * This software is provided 'as-is', without any express or implied
+ * warranty. In no event will the authors be held liable for any damages
+ * arising from the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software
+ * in a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "../tisp.h"
+
+typedef Val (*MkFn)(Tsp, char*);
+
+/* TODO string tib: lower upper strpos strsub */
+
+/* TODO simplify by using fmemopen/funopen and tisp_print */
+static Val
+val_string(Tsp st, Val args, MkFn mk_fn)
+{
+ Val v;
+ char s[43], *ret = calloc(1, sizeof(char));
+ int len = 1;
+ for (; !nilp(args); args = cdr(args)) {
+ v = car(args);
+ switch (v->t) {
+ case NONE:
+ len += 5;
+ ret = realloc(ret, len*sizeof(char));
+ strcat(ret, "void");
+ break;
+ case NIL:
+ len += 4;
+ ret = realloc(ret, len*sizeof(char));
+ strcat(ret, "nil");
+ break;
+ case INTEGER:
+ snprintf(s, 21, "%d", (int)v->v.n.num);
+ len += strlen(s);
+ s[len] = '\0';
+ ret = realloc(ret, len*sizeof(char));
+ strcat(ret, s);
+ break;
+ case DECIMAL:
+ snprintf(s, 17, "%.15g", v->v.n.num);
+ len += strlen(s);
+ s[len] = '\0';
+ ret = realloc(ret, len*sizeof(char));
+ strcat(ret, s);
+ break;
+ case RATIO:
+ snprintf(s, 43, "%d/%d", (int)v->v.n.num, (int)v->v.n.den);
+ len += strlen(s);
+ s[len] = '\0';
+ ret = realloc(ret, len*sizeof(char));
+ strcat(ret, s);
+ break;
+ case STRING:
+ case SYMBOL:
+ len += strlen(v->v.s);
+ ret = realloc(ret, len*sizeof(char));
+ strcat(ret, v->v.s);
+ break;
+ case PAIR:
+ default:
+ tsp_warnf("could not convert type %s into string", type_str(v->t));
+ }
+ }
+ v = mk_fn(st, ret);
+ free(ret);
+ return v;
+}
+
+/* TODO string and symbol: multi arguments to concat */
+static Val
+prim_string(Tsp st, Hash env, Val args)
+{
+ Val v;
+ tsp_arg_min(args, "string", 1);
+ if (!(v = tisp_eval_list(st, env, args)))
+ return NULL;
+ return val_string(st, v, mk_str);
+}
+
+static Val
+prim_symbol(Tsp st, Hash env, Val args)
+{
+ Val v;
+ tsp_arg_min(args, "symbol", 1);
+ if (!(v = tisp_eval_list(st, env, args)))
+ return NULL;
+ return val_string(st, v, mk_sym);
+}
+
+static Val
+prim_strlen(Tsp st, Hash env, Val args)
+{
+ Val v;
+ tsp_arg_num(args, "symbol", 1);
+ if (!(v = tisp_eval(st, env, car(args))))
+ return NULL;
+ if (!(v->t & (STRING|SYMBOL)))
+ tsp_warnf("strlen: expected string or symbol, received %s",
+ type_str(v->t));
+ return mk_int(strlen(v->v.s));
+}
+
+void
+tib_env_string(Tsp st)
+{
+ tsp_env_fn(symbol);
+ tsp_env_fn(string);
+ tsp_env_fn(strlen);
+}
diff --git a/tib/time.c b/tib/time.c
@@ -0,0 +1,54 @@
+/* zlib License
+ *
+ * Copyright (c) 2017-2020 Ed van Bruggen
+ *
+ * This software is provided 'as-is', without any express or implied
+ * warranty. In no event will the authors be held liable for any damages
+ * arising from the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software
+ * in a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#include "../tisp.h"
+
+/* return number of seconds since 1970 (unix time stamp) */
+static Val
+prim_time(Tsp st, Hash env, Val args)
+{
+ tsp_arg_num(args, "time", 0);
+ return mk_int(time(NULL));
+}
+
+/* return time taken to run command given */
+static Val
+prim_timeit(Tsp st, Hash env, Val args)
+{
+ Val v;
+ clock_t t;
+ tsp_arg_num(args, "timeit", 1);
+ t = clock();
+ if (!(v = tisp_eval(st, env, car(args))))
+ return NULL;
+ t = clock() - t;
+ return mk_dec(((double)t)/CLOCKS_PER_SEC);
+}
+
+void
+tib_env_time(Tsp st)
+{
+ tsp_env_fn(time);
+ tsp_env_fn(timeit);
+}
diff --git a/tibs/doc.tsp b/tibs/doc.tsp
@@ -1,74 +0,0 @@
-(define docstr-reg
- '((car
- "(car lst)"
- "return first element of list")
- (cdr
- "(cdr lst)"
- "return rest of list after first element")
- (cons
- "(cons a d)"
- "create new pair with a car of a and cdr of d")
- (quote
- "(quote expr)"
- "return expression unevaluated")
- (void
- "(void)"
- "return void type")
- (eval
- "(eval expr)"
- "evaluate expression, can be dangerous to use in practice")
- (=
- "(= . vals)"
- "return boolean depending on if multiple values are all equal")
- (cond
- "(cond . (expr . body))"
- "conditional statement")
- (typeof
- "(typeof val)"
- "return a string stating the argument's type")
- (get
- "(get val prop)"
- "get the property of the given value depending on its type")
- (lambda
- "(lambda args . body)"
- "create anonymous function")
- (macro
- "(macro args . body)"
- "create anonymous macro")
- (define
- "(define var . val)"
- "(define (func . args) . body)"
- "creates new variable with value, or create new function if argument list given"
- "if value for variable is not given, make it a self-evaluating symbol")
- (set!
- "(set! var val)"
- "change the variable var to val")
- (load
- "(load lib)"
- "loads the library given as a string")
- (error
- "(error func msg)"
- "throw error, print message with function name given as symbol")
- (version
- "(version)"
- "return string of tisp's version number")))
-
-(define (doc proc)
- "get documentation of function supplied by its doc string"
- (unless (procedure? proc)
- (error 'doc "documentation only exists for procedures"))
- (define (lookup proc)
- (recur f ((docstr docstr-reg))
- (cond ((nil? docstr)
- (error 'doc (get proc 'name) ": no documentation found"))
- ((= (caar docstr) (get proc 'name))
- (map disp (cdar docstr)))
- (else (f (cdr docstr))))))
- (if (or (function? proc) (macro? proc))
- (let ((docstr (car (get proc 'body))))
- (if (string? docstr)
- (disp (cons (get proc 'name) (get proc 'args)) "\n"
- docstr)
- (lookup proc)))
- (lookup proc))
- (void))
diff --git a/tibs/io.c b/tibs/io.c
@@ -1,162 +0,0 @@
-/* zlib License
- *
- * Copyright (c) 2017-2020 Ed van Bruggen
- *
- * This software is provided 'as-is', without any express or implied
- * warranty. In no event will the authors be held liable for any damages
- * arising from the use of this software.
- *
- * Permission is granted to anyone to use this software for any purpose,
- * including commercial applications, and to alter it and redistribute it
- * freely, subject to the following restrictions:
- *
- * 1. The origin of this software must not be misrepresented; you must not
- * claim that you wrote the original software. If you use this software
- * in a product, an acknowledgment in the product documentation would be
- * appreciated but is not required.
- * 2. Altered source versions must be plainly marked as such, and must not be
- * misrepresented as being the original software.
- * 3. This notice may not be removed or altered from any source distribution.
- */
-#include <string.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <fcntl.h>
-
-#include "../tisp.h"
-
-/* write all arguemnts to given file, or stdout/stderr, without newline */
-/* first argument is file name, second is option to append file */
-static Val
-prim_write(Tsp st, Hash env, Val args)
-{
- Val v;
- FILE *f;
- const char *mode = "w";
- tsp_arg_min(args, "write", 2);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
-
- /* if second argument is true, append file don't write over */
- if (!nilp(cadr(v)))
- mode = "a";
- /* first argument can either be the symbol stdout or stderr,
- * or the file as a string */
- if (car(v)->t == SYMBOL)
- f = !strncmp(car(v)->v.s, "stdout", 7) ? stdout : stderr;
- else if (car(v)->t != STRING)
- tsp_warnf("write: expected file name as string, received %s",
- type_str(car(v)->t));
- else if (!(f = fopen(car(v)->v.s, mode)))
- tsp_warnf("write: could not load file '%s'", car(v)->v.s);
- if (f == stderr && strncmp(car(v)->v.s, "stderr", 7))
- tsp_warn("write: expected file name as string, "
- "or symbol stdout/stderr");
-
- for (v = cddr(v); !nilp(v); v = cdr(v))
- tisp_print(f, car(v));
- if (f == stdout || f == stderr)
- fflush(f);
- else
- fclose(f);
- return st->none;
-}
-
-/* return string of given file or read from stdin */
-static Val
-prim_read(Tsp st, Hash env, Val args)
-{
- Val v;
- char *file, *fname = NULL; /* read from stdin by default */
- if (list_len(args) > 1)
- tsp_warnf("read: expected 0 or 1 argument, received %d", list_len(args));
- if (list_len(args) == 1) { /* if file name given as string, read it */
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- tsp_arg_type(v, "read", STRING);
- fname = v->v.s;
- }
- if (!(file = tisp_read_file(fname)))
- return st->nil;
- return mk_str(st, file);
-}
-
-/* parse string as tisp expression, return (quit) if given nil */
-/* TODO parse more than 1 expression */
-static Val
-prim_parse(Tsp st, Hash env, Val args)
-{
- Val v;
- char *file = st->file;
- size_t filec = st->filec;
- tsp_arg_num(args, "parse", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- if (nilp(v))
- return mk_pair(mk_sym(st, "quit"), st->nil);
- tsp_arg_type(v, "parse", STRING);
- st->file = v->v.s;
- st->filec = 0;
- v = tisp_read(st);
- st->file = file;
- st->filec = filec;
- return v ? v : st->none;
-}
-
-/* save value as binary file to be quickly read again */
-static Val
-prim_save(Tsp st, Hash env, Val args)
-{
- Val v;
- char *fname;
- FILE *f;
- tsp_arg_min(args, "save", 2);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- tsp_arg_type(cadr(v), "save", STRING);
- fname = cadr(v)->v.s;
- if (!(f = fopen(fname, "wb")))
- tsp_warnf("save: could not load file '%s'", fname);
- if (!(fwrite(&*car(v), sizeof(struct Val), 1, f))) {
- fclose(f);
- tsp_warnf("save: could not save file '%s'", fname);
- }
- fclose(f);
- return car(v);
-}
-
-/* return read binary value previously saved */
-static Val
-prim_open(Tsp st, Hash env, Val args)
-{
- FILE *f;
- char *fname;
- struct Val v;
- Val ret;
- if (!(ret = malloc(sizeof(struct Val)))) {
- fprintf(stderr, "malloc: ");
- perror(NULL);
- exit(1);
- }
- tsp_arg_min(args, "open", 1);
- if (!(args = tisp_eval_list(st, env, args)))
- return NULL;
- tsp_arg_type(car(args), "save", STRING);
- fname = car(args)->v.s;
- if (!(f = fopen(fname, "rb")))
- tsp_warnf("save: could not load file '%s'", fname);
- while (fread(&v, sizeof(struct Val), 1, f)) ;
- fclose(f);
- memcpy(ret, &v, sizeof(struct Val));
- return ret;
-}
-
-void
-tib_env_io(Tsp st)
-{
- tsp_env_fn(write);
- tsp_env_fn(read);
- tsp_env_fn(parse);
- tsp_env_fn(save);
- tsp_env_fn(open);
-}
diff --git a/tibs/lib.tsp b/tibs/lib.tsp
@@ -1,387 +0,0 @@
-(define (list . lst) lst)
-
-(define defmacro
- (macro (args . body)
- (list 'define (car args) (list 'macro (cdr args) . body))))
-
-;;; CXR
-(define (caar x) (car (car x)))
-(define (cadr x) (car (cdr x)))
-(define (cdar x) (cdr (car x)))
-(define (cddr x) (cdr (cdr x)))
-(define (caaar x) (car (car (car x))))
-(define (caadr x) (car (car (cdr x))))
-(define (cadar x) (car (cdr (car x))))
-(define (caddr x) (car (cdr (cdr x))))
-(define (cdaar x) (cdr (car (car x))))
-(define (cdadr x) (cdr (car (cdr x))))
-(define (cddar x) (cdr (cdr (car x))))
-(define (cdddr x) (cdr (cdr (cdr x))))
-(define (caaaar x) (car (car (car (car x)))))
-(define (caaadr x) (car (car (car (cdr x)))))
-(define (caadar x) (car (car (cdr (car x)))))
-(define (caaddr x) (car (car (cdr (cdr x)))))
-(define (cadaar x) (car (cdr (car (car x)))))
-(define (cadadr x) (car (cdr (car (cdr x)))))
-(define (caddar x) (car (cdr (cdr (car x)))))
-(define (cadddr x) (car (cdr (cdr (cdr x)))))
-(define (cdaaar x) (cdr (car (car (car x)))))
-(define (cdaadr x) (cdr (car (car (cdr x)))))
-(define (cdadar x) (cdr (car (cdr (car x)))))
-(define (cdaddr x) (cdr (car (cdr (cdr x)))))
-(define (cddaar x) (cdr (cdr (car (car x)))))
-(define (cddadr x) (cdr (cdr (car (cdr x)))))
-(define (cdddar x) (cdr (cdr (cdr (car x)))))
-(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
-
-;;; Types
-(define (any? x) t)
-(define (void? x) (= (typeof x) "void"))
-(define (nil? x) (= (typeof x) "nil"))
-(define empty? nil?)
-(define (integer? x) (= (typeof x) "integer"))
-(define (decimal? x) (= (typeof x) "decimal"))
-(define (ratio? x) (= (typeof x) "ratio"))
-(define (string? x) (= (typeof x) "string"))
-(define (symbol? x) (= (typeof x) "symbol"))
-(define (primitive? x) (= (typeof x) "primitive"))
-(define (function? x) (= (typeof x) "function"))
-(define (macro? x) (= (typeof x) "macro"))
-(define (pair? x) (= (typeof x) "pair"))
-(define (atom? x) (not (pair? x)))
-(define (cons? x) (and (pair? x) (not (pair? (cdr x)))))
-(define (list? x) (if (pair? x) (list? (cdr x)) (not x)))
-(define (boolean? x) (or (= x t) (nil? x)))
-(define (true? x) (= x t))
-(define false? nil?)
-(define (procedure? x) (or (primitive? x) (or (function? x) (macro? x))))
-(define (rational? x) (or (integer? x) (ratio? x)))
-(define (number? x) (or (rational? x) (decimal? x)))
-
-(define (bool x) (if x t nil))
-; TODO handle string and sym
-(define (pair x)
- (cond
- ((rational? x)
- (cons (numerator x)
- (denominator x)))
- ((decimal? x)
- (cons (integer (truncate x))
- (- x (truncate x))))
- ((or (void? x) (nil? x) (pair? x)) x)
- (else (list x))))
-
-(defmacro (assert expr)
- `(unless ,expr
- (error 'assert "assertion " ',expr " failed")))
-
-; TODO support any sized list n depending on size of optional val
-(define (default n val)
- (cond
- ((nil? n) val)
- ((and (pair? n) (nil? (cdr n)))
- (car n))
- (else (error 'default "expected only 1 optional argument"))))
-
-;;; Control Flow
-; TODO if b = pair and car b = else use cdr b
-(defmacro (if con a b)
- (list 'cond (list con a) (list t b)))
-(define else t)
-(defmacro (when con . body)
- (list 'cond (list con (cons 'do body))))
-(defmacro (unless con . body)
- (list 'cond (list (list not con) (cons 'do body))))
-
-(defmacro (let vars . body)
- (list (list* 'lambda ()
- (append
- (map
- (lambda (x)
- (list* 'define (car x) (cdr x)))
- vars)
- body))))
-
-(defmacro (recur proc vars . body)
- (list 'let
- (list*
- (list proc (list* 'lambda (map car vars) body))
- vars)
- (list* proc (map car vars))))
-
-(defmacro (switch val . body)
- (list* 'cond (map
- (lambda (line)
- `((= ,val ,(car line)) ,(cadr line)))
- body)))
-
-; TODO allow for improper lists
-(defmacro (quasiquote x)
- (define (check x)
- (unless (and (pair? (cdr x)) (nil? (cddr x)))
- (error (car x) "invalid form " x)))
- (define (quasicons a d)
- (if (pair? d)
- (if (= (car d) 'quote)
- (if (and (pair? a) (= (car a) 'quote))
- (list 'quote (list* (cadr a) (cadr d)))
- (if (nil? (cadr d))
- (list 'list a)
- (list list* a d)))
- (if (member (car d) '(list list*))
- (list* (car d) a (cdr d))
- (list list* a d)))
- (list list* a d)))
- (recur f ((x x))
- (cond
- ((atom? x) (list 'quote x))
- ((= (car x) 'unquote)
- (check x)
- (cadr x))
- (else (quasicons (f (car x)) (f (cdr x)))))))
-
-(defmacro (unquote x) (list error ''unquote "called outside of quasiquote"))
-
-;;; Logic
-(define true t)
-(define false ())
-(define (not x)
- (if x nil t))
-; TODO logic func many arguments
-; Use a macro so arguments aren't evaluated all at once
-(defmacro (and a b)
- (list 'if a b nil))
-(defmacro (nand a b)
- (list 'not (list 'and a b)))
-(defmacro (or a b)
- (list 'if a a b))
-(defmacro (nor a b)
- (list 'not (list 'or a b)))
-
-;;; Lists
-(define (list* . lst)
- (if (cdr lst)
- (cons (car lst) (apply list* (cdr lst)))
- (car lst)))
-
-(define (do . body) (last body))
-(define (do0 . body) (car body))
-
-(define (length lst)
- (recur f ((lst lst) (x 0))
- (if lst
- (f (cdr lst) (+ x 1))
- x)))
-
-(define (last lst)
-; recur loop ((lst lst) (n (if n (car n) 0)))
- (if (cdr lst)
- (last (cdr lst))
- (car lst)))
-
-; TODO make nth generic for list str vec, made up of list-ref vec-ref str-ref
-(define (nth lst n)
- (cond
- ((atom? lst)
- (error 'nth "index of list out of bounds"))
- ((<= n 0) (car lst))
- (else (nth (cdr lst) (- n 1)))))
-
-; TODO diff name head/tail since conflicts w/ unix
-; TODO support negative numers like unix tail/head to count from end backwards
-(define (head lst n)
- (cond
- ((<= n 0) nil)
- ((atom? lst)
- (error 'name "index of list out of bounds"))
- (else (cons (car lst) (head (cdr lst) (- n 1))))))
-
-(define (tail lst n)
- (cond
- ((<= n 0) lst)
- ((atom? lst)
- (error 'tail "index of list out of bounds"))
- (else (tail (cdr lst) (- n 1)))))
-
-(define (count x lst)
- (cond ((nil? lst) 0)
- ((atom? lst) (error 'count "expected proper list"))
- ((= x (car lst)) (+ 1 (count x (cdr lst))))
- (else (count x (cdr lst)))))
-
-; TODO many args
-(define (apply proc args)
- (eval (map (lambda (x) ; prevent args from being evaluated twice
- (list 'quote x))
- (cons proc args))))
-
-; TODO many lsts for proc w/ multi arguments
-(define (map proc lst)
- (if lst
- (cons (proc (car lst))
- (map proc (cdr lst)))
- nil))
-
-(define (filter proc lst)
- (cond
- ((not (pair? lst)) nil)
- ((proc (car lst)) (cons (car lst) (filter proc (cdr lst))))
- (else (filter proc (cdr lst)))))
-
-(define (compose . procs)
- (cond
- ((nil? procs) (lambda x x))
- ((nil? (cdr procs)) (car procs))
- (else
- (lambda x
- ((car procs) (apply (apply compose (cdr procs)) x))))))
-
-(define (reverse l)
- (recur f ((in l) (out nil))
- (if (pair? in)
- (f (cdr in) (cons (car in) out))
- out)))
-
-; TODO accept many lists to append
-(define (append x y)
- (cond
- ((pair? x) (cons (car x) (append (cdr x) y)))
- ((nil? x) y)
- (else (error 'append "expected proper list"))))
-
-(define (zip x y)
- (cond ((and (nil? x) (nil? y)) nil)
- ((or (nil? x) (nil? y)) (error 'zip "given lists of unequal length"))
- ((and (pair? x) (pair? y))
- (cons (cons (car x) (car y))
- (zip (cdr x) (cdr y))))))
-
-; TODO assoc optional equal? arg
-(define (assoc key table)
- (cond ((nil? table) nil)
- ((= key (caar table)) (car table))
- (else (assoc key (cdr table)))))
-
-(define (memp proc lst)
- (cond ((nil? lst) nil)
- ((proc (car lst)) lst)
- (else (memp proc (cdr lst)))))
-
-(define (member mem lst)
- (memp (lambda (x) (= mem x)) lst))
-
-; define English list element accessors
-(define rest cdr) ; TODO first and rest are generics for list, vec, str types
-(define first car)
-(let (((def name count)
- (list 'define (list name 'x) (list 'nth 'x count))))
- (recur f ((n 1)
- (lst '(second third forth fifth sixth seventh eighth ninth tenth)))
- (when lst
- (eval (def (car lst) n))
- (f (+ n 1) (cdr lst)))))
-
-;;; Stacks
-(define (push stack val)
- (cons val stack))
-
-(defmacro (push! stack val)
- `(set! ,stack (push ,stack ,val)))
-
-(define pop cdr)
-
-(defmacro (pop! stack)
- `(do0
- (peek ,stack)
- (set! ,stack (pop ,stack))))
-
-(define peek car)
-
-(define (swap stack)
- (let ((x (peek stack))
- (y (peek (pop stack))))
- (push (push (pop (pop stack)) x) y)))
-
-; TODO swap! use gen sym instead of x and y ?
-(defmacro (swap! stack)
- `(let ((x (pop! ,stack))
- (y (pop! ,stack)))
- (set! ,stack (push (push ,stack x) y))))
-
-;;; Math
-(define pi (* 4 (arctan 1.)))
-(define tau (* 2 pi))
-(define e (exp 1.))
-
-(define (inc x) (+ x 1))
-(define (dec x) (- x 1))
-(define (truncate x) (* (floor (abs x)) (sgn x)))
-(define (sqr x) (* x x))
-(define (cube x) (* x (* x x)))
-(define (root b p) (^ b (/ p)))
-(define (sqrt x) (root x 2))
-(define (cbrt x) (root x 3))
-(define (logb b x) (/ (log x) (log b)))
-(define (log10 x) (logb 10. x))
-
-(defmacro (++ x . n)
- `(set! ,x (+ ,x ,(default n 1))))
-(defmacro (-- x . n)
- `(set! ,x (- ,x ,(default n 1))))
-
-; inverse trig functions
-(define (csc x) (/ (sin x)))
-(define (arccsc x) (/ (arcsin x)))
-(define (csch x) (/ (sinh x)))
-(define (arccsch x) (/ (arcsinh x)))
-(define (sec x) (/ (cos x)))
-(define (arcsec x) (/ (arccos x)))
-(define (sech x) (/ (cosh x)))
-(define (arcsech x) (/ (arccosh x)))
-(define (cot x) (/ (tan x)))
-(define (arccot x) (/ (arctan x)))
-(define (coth x) (/ (tanh x)))
-(define (arccoth x) (/ (arctanh x)))
-
-(define (abs x) (if (>= x 0) x (- x)))
-(define (sgn x) (if (= x 0) x (/ (abs x) x)))
-; TODO many args
-(define (max a b) (if (> a b) a b))
-(define (min a b) (if (< a b) a b))
-
-(define (positive? x) (> x 0))
-(define (negative? x) (< x 0))
-(define (zero? x) (= x 0))
-(define (even? x) (= (mod x 2) 0))
-(define (odd? x) (= (mod x 2) 1))
-
-(define (dot x y)
- (if x
- (+ (* (car x) (car y))
- (dot (cdr x) (cdr y)))
- 0))
-
-(define (! n)
- (if (= n 1)
- 1
- (* n (! (- n 1)))))
-
-;;; IO
-(define (run file) (eval (parse (read file))))
-(define (print . str) (apply write (list* 'stdout nil str)))
-(define (newline . file)
- (if (or (nil? file) (nil? (cdr file)))
- (write (car (or file '(stdout))) file "\n")
- (error 'newline "only zero or one file can be given")))
-
-(define (display . str)
- (map (lambda (s)
- (cond
- ((string? s) (print "\"" s "\""))
- ((true? s) (print s)) ; don't print 't since it's self evaluating
- ((symbol? s) (print "'" s))
- ((pair? s) (print "'" s))
- (else (print s))))
- str))
-(define (displayln . str) (apply display str) (newline))
-(define (println . str) (apply print str) (newline))
diff --git a/tibs/math.c b/tibs/math.c
@@ -1,294 +0,0 @@
-/* zlib License
- *
- * Copyright (c) 2017-2020 Ed van Bruggen
- *
- * This software is provided 'as-is', without any express or implied
- * warranty. In no event will the authors be held liable for any damages
- * arising from the use of this software.
- *
- * Permission is granted to anyone to use this software for any purpose,
- * including commercial applications, and to alter it and redistribute it
- * freely, subject to the following restrictions:
- *
- * 1. The origin of this software must not be misrepresented; you must not
- * claim that you wrote the original software. If you use this software
- * in a product, an acknowledgment in the product documentation would be
- * appreciated but is not required.
- * 2. Altered source versions must be plainly marked as such, and must not be
- * misrepresented as being the original software.
- * 3. This notice may not be removed or altered from any source distribution.
- */
-#include <assert.h>
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-#include "../tisp.h"
-
-#define EVAL_CHECK(A, V, NAME, TYPE) do { \
- if (!(A = tisp_eval(st, vars, V))) \
- return NULL; \
- tsp_arg_type(A, NAME, TYPE); \
-} while(0)
-
-static Val
-prim_numerator(Tsp st, Hash vars, Val args)
-{
- Val a;
- tsp_arg_num(args, "numerator", 1);
- EVAL_CHECK(a, car(args), "numerator", RATIONAL);
- return mk_int(num(a));
-}
-
-static Val
-prim_denominator(Tsp st, Hash vars, Val args)
-{
- Val a;
- tsp_arg_num(args, "denominator", 1);
- EVAL_CHECK(a, car(args), "denominator", RATIONAL);
- return mk_int(den(a));
-}
-
-/* wrapper functions to be returned by mk_num, all need same arguments */
-static Val
-create_int(double num, double den)
-{
- assert(den == 1);
- return mk_int(num);
-}
-
-static Val
-create_dec(double num, double den)
-{
- assert(den == 1);
- return mk_dec(num);
-}
-
-static Val
-create_rat(double num, double den)
-{
- return mk_rat(num, den);
-}
-
-/* return pointer to one of the preceding functions depending on what
- * number should be created by the following arithmetic functions
- * force arg is used to force number to one type:
- * 0 -> no force, 1 -> force ratio/int, 2 -> force decimal */
-static Val
-(*mk_num(Type a, Type b, int force))(double, double)
-{
- if (force == 1)
- return &create_rat;
- if (force == 2)
- return &create_dec;
- if (a & DECIMAL || b & DECIMAL)
- return &create_dec;
- if (a & RATIO || b & RATIO)
- return &create_rat;
- return &create_int;
-}
-
-#define PRIM_ROUND(NAME, FORCE) \
-static Val \
-prim_##NAME(Tsp st, Hash vars, Val args) \
-{ \
- Val a; \
- tsp_arg_num(args, #NAME, 1); \
- EVAL_CHECK(a, car(args), #NAME, NUMBER); \
- return (mk_num(a->t, a->t, FORCE))(NAME(num(a)/den(a)), 1.); \
-}
-
-/* define int and dec as identity functions to use them in the same macro */
-#define integer(X) (X)
-PRIM_ROUND(integer, 1)
-#undef integer
-#define decimal(X) (X)
-PRIM_ROUND(decimal, 2)
-#undef decimal
-PRIM_ROUND(round, 0)
-PRIM_ROUND(floor, 0)
-PRIM_ROUND(ceil, 0)
-
-static Val
-prim_add(Tsp st, Hash vars, Val args)
-{
- Val a, b;
- tsp_arg_num(args, "+", 2);
- EVAL_CHECK(a, car(args), "+", NUMBER);
- EVAL_CHECK(b, car(cdr(args)), "+", NUMBER);
- if (a->t & DECIMAL || b->t & DECIMAL)
- return mk_dec((num(a)/den(a)) + (num(b)/den(b)));
- return (mk_num(a->t, b->t, 0))
- (num(a) * den(b) + den(a) * num(b),
- den(a) * den(b));
-}
-
-static Val
-prim_sub(Tsp st, Hash vars, Val args)
-{
- Val a, b;
- int len = list_len(args);
- if (len != 2 && len != 1)
- tsp_warnf("-: expected 1 or 2 arguments, recieved %d", len);
- EVAL_CHECK(a, car(args), "-", NUMBER);
- if (len == 1) {
- b = a;
- a = mk_int(0);
- } else {
- EVAL_CHECK(b, car(cdr(args)), "-", NUMBER);
- }
- if (a->t & DECIMAL || b->t & DECIMAL)
- return mk_dec((num(a)/den(a)) - (num(b)/den(b)));
- return (mk_num(a->t, b->t, 0))
- (num(a) * den(b) - den(a) * num(b),
- den(a) * den(b));
-}
-
-static Val
-prim_mul(Tsp st, Hash vars, Val args)
-{
- Val a, b;
- tsp_arg_num(args, "*", 2);
- EVAL_CHECK(a, car(args), "*", NUMBER);
- EVAL_CHECK(b, car(cdr(args)), "*", NUMBER);
- if (a->t & DECIMAL || b->t & DECIMAL)
- return mk_dec((num(a)/den(a)) * (num(b)/den(b)));
- return (mk_num(a->t, b->t, 0))(num(a) * num(b), den(a) * den(b));
-
-}
-
-static Val
-prim_div(Tsp st, Hash vars, Val args)
-{
- Val a, b;
- int len = list_len(args);
- if (len != 2 && len != 1)
- tsp_warnf("/: expected 1 or 2 arguments, recieved %d", len);
- EVAL_CHECK(a, car(args), "/", NUMBER);
- if (len == 1) {
- b = a;
- a = mk_int(1);
- } else {
- EVAL_CHECK(b, car(cdr(args)), "/", NUMBER);
- }
- if (a->t & DECIMAL || b->t & DECIMAL)
- return mk_dec((num(a)/den(a)) / (num(b)/den(b)));
- return (mk_num(a->t, b->t, 1))(num(a) * den(b), den(a) * num(b));
-}
-
-static Val
-prim_mod(Tsp st, Hash vars, Val args)
-{
- Val a, b;
- tsp_arg_num(args, "mod", 2);
- EVAL_CHECK(a, car(args), "mod", INTEGER);
- EVAL_CHECK(b, car(cdr(args)), "mod", INTEGER);
- if (num(b) == 0)
- tsp_warn("division by zero");
- return mk_int((int)num(a) % abs((int)num(b)));
-}
-
-/* TODO if given function as 2nd arg run it on first arg */
-static Val
-prim_pow(Tsp st, Hash vars, Val args)
-{
- double bnum, bden;
- Val b, p;
- tsp_arg_num(args, "pow", 2);
- EVAL_CHECK(b, car(args), "pow", EXPRESSION);
- EVAL_CHECK(p, car(cdr(args)), "pow", EXPRESSION);
- bnum = pow(num(b), num(p)/den(p));
- bden = pow(den(b), num(p)/den(p));
- if ((bnum == (int)bnum && bden == (int)bden) ||
- b->t & DECIMAL || p->t & DECIMAL)
- return mk_num(b->t, p->t, 0)(bnum, bden);
- return mk_pair(mk_sym(st, "^"), mk_pair(b, mk_pair(p, st->nil)));
-}
-
-#define PRIM_COMPARE(NAME, OP) \
-static Val \
-prim_##NAME(Tsp st, Hash vars, Val args) \
-{ \
- Val v; \
- if (!(v = tisp_eval_list(st, vars, args))) \
- return NULL; \
- if (list_len(v) != 2) \
- return st->t; \
- tsp_arg_type(car(v), #OP, NUMBER); \
- tsp_arg_type(car(cdr(v)), #OP, NUMBER); \
- return ((num(car(v))*den(car(cdr(v)))) OP \
- (num(car(cdr(v)))*den(car(v)))) ? \
- st->t : st->nil; \
-}
-
-PRIM_COMPARE(lt, <)
-PRIM_COMPARE(gt, >)
-PRIM_COMPARE(lte, <=)
-PRIM_COMPARE(gte, >=)
-
-#define PRIM_TRIG(NAME) \
-static Val \
-prim_##NAME(Tsp st, Hash vars, Val args) \
-{ \
- Val v; \
- tsp_arg_num(args, #NAME, 1); \
- EVAL_CHECK(v, car(args), #NAME, EXPRESSION); \
- if (v->t & DECIMAL) \
- return mk_dec(NAME(num(v))); \
- return mk_pair(mk_sym(st, #NAME), mk_pair(v, st->nil)); \
-}
-
-PRIM_TRIG(sin)
-PRIM_TRIG(cos)
-PRIM_TRIG(tan)
-PRIM_TRIG(sinh)
-PRIM_TRIG(cosh)
-PRIM_TRIG(tanh)
-PRIM_TRIG(asin)
-PRIM_TRIG(acos)
-PRIM_TRIG(atan)
-PRIM_TRIG(asinh)
-PRIM_TRIG(acosh)
-PRIM_TRIG(atanh)
-PRIM_TRIG(exp)
-PRIM_TRIG(log)
-
-void
-tib_env_math(Tsp st)
-{
- tsp_env_fn(numerator);
- tsp_env_fn(denominator);
-
- tsp_env_fn(integer);
- tsp_env_fn(decimal);
- tsp_env_fn(floor);
- tsp_env_fn(ceil);
- tsp_env_fn(round);
-
- tsp_env_name_fn(+, add);
- tsp_env_name_fn(-, sub);
- tsp_env_name_fn(*, mul);
- tsp_env_name_fn(/, div);
- tsp_env_fn(mod);
- tsp_env_name_fn(^, pow);
-
- tsp_env_name_fn(<, lt);
- tsp_env_name_fn(>, gt);
- tsp_env_name_fn(<=, lte);
- tsp_env_name_fn(>=, gte);
-
- tsp_env_fn(sin);
- tsp_env_fn(cos);
- tsp_env_fn(tan);
- tsp_env_fn(sinh);
- tsp_env_fn(cosh);
- tsp_env_fn(tanh);
- tsp_env_name_fn(arcsin, asin);
- tsp_env_name_fn(arccos, acos);
- tsp_env_name_fn(arctan, atan);
- tsp_env_name_fn(arcsinh, asinh);
- tsp_env_name_fn(arccosh, acosh);
- tsp_env_name_fn(arctanh, atanh);
- tsp_env_fn(exp);
- tsp_env_fn(log);
-}
diff --git a/tibs/repl.tsp b/tibs/repl.tsp
@@ -1,15 +0,0 @@
-(define (repl)
- (print "> ")
- (let ((expr (parse (read))))
- (unless (and (pair? expr) (= (car expr) 'quit))
- ; TODO push! ans to stack of outputs
- (let ((ans (eval expr)))
- (unless (void? ans)
- (displayln ans))
- (repl)))))
-
-;; simple repl, only requires io c library
-(define (repl-simple)
- (write 'stdout nil "> ")
- (write 'stdout nil (eval (parse (read))) "\n")
- (repl-simple))
diff --git a/tibs/string.c b/tibs/string.c
@@ -1,128 +0,0 @@
-/* zlib License
- *
- * Copyright (c) 2017-2020 Ed van Bruggen
- *
- * This software is provided 'as-is', without any express or implied
- * warranty. In no event will the authors be held liable for any damages
- * arising from the use of this software.
- *
- * Permission is granted to anyone to use this software for any purpose,
- * including commercial applications, and to alter it and redistribute it
- * freely, subject to the following restrictions:
- *
- * 1. The origin of this software must not be misrepresented; you must not
- * claim that you wrote the original software. If you use this software
- * in a product, an acknowledgment in the product documentation would be
- * appreciated but is not required.
- * 2. Altered source versions must be plainly marked as such, and must not be
- * misrepresented as being the original software.
- * 3. This notice may not be removed or altered from any source distribution.
- */
-#include <string.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-#include "../tisp.h"
-
-typedef Val (*MkFn)(Tsp, char*);
-
-/* TODO string tib: lower upper strpos strsub */
-
-/* TODO simplify by using fmemopen/funopen and tisp_print */
-static Val
-val_string(Tsp st, Val args, MkFn mk_fn)
-{
- Val v;
- char s[43], *ret = calloc(1, sizeof(char));
- int len = 1;
- for (; !nilp(args); args = cdr(args)) {
- v = car(args);
- switch (v->t) {
- case NONE:
- len += 5;
- ret = realloc(ret, len*sizeof(char));
- strcat(ret, "void");
- break;
- case NIL:
- len += 4;
- ret = realloc(ret, len*sizeof(char));
- strcat(ret, "nil");
- break;
- case INTEGER:
- snprintf(s, 21, "%d", (int)v->v.n.num);
- len += strlen(s);
- s[len] = '\0';
- ret = realloc(ret, len*sizeof(char));
- strcat(ret, s);
- break;
- case DECIMAL:
- snprintf(s, 17, "%.15g", v->v.n.num);
- len += strlen(s);
- s[len] = '\0';
- ret = realloc(ret, len*sizeof(char));
- strcat(ret, s);
- break;
- case RATIO:
- snprintf(s, 43, "%d/%d", (int)v->v.n.num, (int)v->v.n.den);
- len += strlen(s);
- s[len] = '\0';
- ret = realloc(ret, len*sizeof(char));
- strcat(ret, s);
- break;
- case STRING:
- case SYMBOL:
- len += strlen(v->v.s);
- ret = realloc(ret, len*sizeof(char));
- strcat(ret, v->v.s);
- break;
- case PAIR:
- default:
- tsp_warnf("could not convert type %s into string", type_str(v->t));
- }
- }
- v = mk_fn(st, ret);
- free(ret);
- return v;
-}
-
-/* TODO string and symbol: multi arguments to concat */
-static Val
-prim_string(Tsp st, Hash env, Val args)
-{
- Val v;
- tsp_arg_min(args, "string", 1);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- return val_string(st, v, mk_str);
-}
-
-static Val
-prim_symbol(Tsp st, Hash env, Val args)
-{
- Val v;
- tsp_arg_min(args, "symbol", 1);
- if (!(v = tisp_eval_list(st, env, args)))
- return NULL;
- return val_string(st, v, mk_sym);
-}
-
-static Val
-prim_strlen(Tsp st, Hash env, Val args)
-{
- Val v;
- tsp_arg_num(args, "symbol", 1);
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- if (!(v->t & (STRING|SYMBOL)))
- tsp_warnf("strlen: expected string or symbol, received %s",
- type_str(v->t));
- return mk_int(strlen(v->v.s));
-}
-
-void
-tib_env_string(Tsp st)
-{
- tsp_env_fn(symbol);
- tsp_env_fn(string);
- tsp_env_fn(strlen);
-}
diff --git a/tibs/time.c b/tibs/time.c
@@ -1,54 +0,0 @@
-/* zlib License
- *
- * Copyright (c) 2017-2020 Ed van Bruggen
- *
- * This software is provided 'as-is', without any express or implied
- * warranty. In no event will the authors be held liable for any damages
- * arising from the use of this software.
- *
- * Permission is granted to anyone to use this software for any purpose,
- * including commercial applications, and to alter it and redistribute it
- * freely, subject to the following restrictions:
- *
- * 1. The origin of this software must not be misrepresented; you must not
- * claim that you wrote the original software. If you use this software
- * in a product, an acknowledgment in the product documentation would be
- * appreciated but is not required.
- * 2. Altered source versions must be plainly marked as such, and must not be
- * misrepresented as being the original software.
- * 3. This notice may not be removed or altered from any source distribution.
- */
-#include <stdio.h>
-#include <stdlib.h>
-#include <time.h>
-
-#include "../tisp.h"
-
-/* return number of seconds since 1970 (unix time stamp) */
-static Val
-prim_time(Tsp st, Hash env, Val args)
-{
- tsp_arg_num(args, "time", 0);
- return mk_int(time(NULL));
-}
-
-/* return time taken to run command given */
-static Val
-prim_timeit(Tsp st, Hash env, Val args)
-{
- Val v;
- clock_t t;
- tsp_arg_num(args, "timeit", 1);
- t = clock();
- if (!(v = tisp_eval(st, env, car(args))))
- return NULL;
- t = clock() - t;
- return mk_dec(((double)t)/CLOCKS_PER_SEC);
-}
-
-void
-tib_env_time(Tsp st)
-{
- tsp_env_fn(time);
- tsp_env_fn(timeit);
-}
