diff options
| -rw-r--r-- | src/lisp/ao_lisp.h | 2 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_builtin.c | 105 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_builtin.txt | 8 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_const.lisp | 136 |
4 files changed, 240 insertions, 11 deletions
diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 9a48a445..341996c0 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -136,7 +136,7 @@ ao_lisp_is_const(ao_poly poly) { #define AO_LISP_IS_CONST(a) (ao_lisp_const <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_const + AO_LISP_POOL_CONST) #define AO_LISP_IS_POOL(a) (ao_lisp_pool <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_pool + AO_LISP_POOL) -#define AO_LISP_IS_INT(p) (ao_lisp_base_type(p) == AO_LISP_INT); +#define AO_LISP_IS_INT(p) (ao_lisp_poly_base_type(p) == AO_LISP_INT) void * ao_lisp_ref(ao_poly poly); diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index d89404dc..2c5608e7 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -277,6 +277,7 @@ ao_lisp_do_patom(struct ao_lisp_cons *cons) ao_poly ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) { + struct ao_lisp_cons *orig_cons = cons; ao_poly ret = AO_LISP_NIL; while (cons) { @@ -284,12 +285,29 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) uint8_t rt = ao_lisp_poly_type(ret); uint8_t ct = ao_lisp_poly_type(car); - cons = ao_lisp_poly_cons(cons->cdr); - - if (rt == AO_LISP_NIL) + if (cons == orig_cons) { ret = car; - - else if (rt == AO_LISP_INT && ct == AO_LISP_INT) { + if (cons->cdr == AO_LISP_NIL && ct == AO_LISP_INT) { + switch (op) { + case builtin_minus: + ret = ao_lisp_int_poly(-ao_lisp_poly_int(ret)); + break; + case builtin_divide: + switch (ao_lisp_poly_int(ret)) { + case 0: + return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "divide by zero"); + case 1: + break; + default: + ret = ao_lisp_int_poly(0); + break; + } + break; + default: + break; + } + } + } else if (rt == AO_LISP_INT && ct == AO_LISP_INT) { int r = ao_lisp_poly_int(ret); int c = ao_lisp_poly_int(car); @@ -308,11 +326,26 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "divide by zero"); r /= c; break; - case builtin_mod: + case builtin_quotient: if (c == 0) - return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "mod by zero"); + return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "quotient by zero"); + if (r % c != 0 && (c < 0) != (r < 0)) + r = r / c - 1; + else + r = r / c; + break; + case builtin_remainder: + if (c == 0) + return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "remainder by zero"); r %= c; break; + case builtin_modulo: + if (c == 0) + return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "modulo by zero"); + r %= c; + if ((r < 0) != (c < 0)) + r += c; + break; default: break; } @@ -324,6 +357,8 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) ao_lisp_poly_string(car))); else return ao_lisp_error(AO_LISP_INVALID, "invalid args"); + + cons = ao_lisp_poly_cons(cons->cdr); } return ret; } @@ -353,9 +388,21 @@ ao_lisp_do_divide(struct ao_lisp_cons *cons) } ao_poly -ao_lisp_do_mod(struct ao_lisp_cons *cons) +ao_lisp_do_quotient(struct ao_lisp_cons *cons) +{ + return ao_lisp_math(cons, builtin_quotient); +} + +ao_poly +ao_lisp_do_modulo(struct ao_lisp_cons *cons) { - return ao_lisp_math(cons, builtin_mod); + return ao_lisp_math(cons, builtin_modulo); +} + +ao_poly +ao_lisp_do_remainder(struct ao_lisp_cons *cons) +{ + return ao_lisp_math(cons, builtin_remainder); } ao_poly @@ -593,5 +640,45 @@ ao_lisp_do_pairp(struct ao_lisp_cons *cons) return _ao_lisp_bool_false; } +ao_poly +ao_lisp_do_numberp(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1)) + return AO_LISP_NIL; + if (AO_LISP_IS_INT(ao_lisp_arg(cons, 0))) + return _ao_lisp_bool_true; + return _ao_lisp_bool_false; +} + +ao_poly +ao_lisp_do_booleanp(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1)) + return AO_LISP_NIL; + if (ao_lisp_poly_type(ao_lisp_arg(cons, 0)) == AO_LISP_BOOL) + return _ao_lisp_bool_true; + return _ao_lisp_bool_false; +} + +ao_poly +ao_lisp_do_set_car(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 2, 2)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_led, cons, 0, AO_LISP_CONS, 0)) + return AO_LISP_NIL; + return ao_lisp_poly_cons(ao_lisp_arg(cons, 0))->car = ao_lisp_arg(cons, 1); +} + +ao_poly +ao_lisp_do_set_cdr(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 2, 2)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_led, cons, 0, AO_LISP_CONS, 0)) + return AO_LISP_NIL; + return ao_lisp_poly_cons(ao_lisp_arg(cons, 0))->cdr = ao_lisp_arg(cons, 1); +} + #define AO_LISP_BUILTIN_FUNCS #include "ao_lisp_builtin.h" diff --git a/src/lisp/ao_lisp_builtin.txt b/src/lisp/ao_lisp_builtin.txt index 2b891dba..b27985ff 100644 --- a/src/lisp/ao_lisp_builtin.txt +++ b/src/lisp/ao_lisp_builtin.txt @@ -21,7 +21,9 @@ lexpr plus + lexpr minus - lexpr times * lexpr divide / -lexpr mod % +lexpr modulo modulo % +lexpr remainder +lexpr quotient lexpr equal = eq? eqv? lexpr less < lexpr greater > @@ -40,3 +42,7 @@ lambda nullp null? lambda not lambda listp list? lambda pairp pair? +lambda numberp number? integer? +lambda booleanp boolean? +lambda set_car set-car! +lambda set_cdr set-cdr! diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index 37307a68..3ba6aaf5 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -69,6 +69,93 @@ (defun 1+ (x) (+ x 1)) (defun 1- (x) (- x 1)) +(define zero? (macro (value rest) + (list + eq? + value + 0) + ) + ) + +(zero? 1) +(zero? 0) +(zero? "hello") + +(define positive? (macro (value rest) + (list + > + value + 0) + ) + ) + +(positive? 12) +(positive? -12) + +(define negative? (macro (value rest) + (list + < + value + 0) + ) + ) + +(negative? 12) +(negative? -12) + +(defun abs (x) (cond ((>= x 0) x) + (else (- x))) + ) + +(abs 12) +(abs -12) + +(define max (lexpr (first rest) + (while (not (null? rest)) + (cond ((< first (car rest)) + (set! first (car rest))) + ) + (set! rest (cdr rest)) + ) + first) + ) + +(max 1 2 3) +(max 3 2 1) + +(define min (lexpr (first rest) + (while (not (null? rest)) + (cond ((> first (car rest)) + (set! first (car rest))) + ) + (set! rest (cdr rest)) + ) + first) + ) + +(min 1 2 3) +(min 3 2 1) + +(defun even? (x) (zero? (% x 2))) + +(even? 2) +(even? -2) +(even? 3) +(even? -1) + +(defun odd? (x) (not (even? x))) + +(odd? 2) +(odd? -2) +(odd? 3) +(odd? -1) + +(define exact? number?) +(defun inexact? (x) #f) + + ; (if <condition> <if-true>) + ; (if <condition> <if-true> <if-false) + (define if (macro (test args) (cond ((null? (cdr args)) (list @@ -208,6 +295,49 @@ (and #t #f) + +(define append (lexpr (args) + (let ((append-list (lambda (a b) + (cond ((null? a) b) + (else (cons (car a) (append-list (cdr a) b))) + ) + ) + ) + (append-lists (lambda (lists) + (cond ((null? lists) lists) + ((null? (cdr lists)) (car lists)) + (else (append-list (car lists) (append-lists (cdr lists)))) + ) + ) + ) + ) + (append-lists args) + ) + ) + ) + +(append '(a b c) '(d e f) '(g h i)) + +(defun reverse (list) + (let ((result ())) + (while (not (null? list)) + (set! result (cons (car list) result)) + (set! list (cdr list)) + ) + result) + ) + +(reverse '(1 2 3)) + +(define list-tail + (lambda (x k) + (if (zero? k) + x + (list-tail (cdr x) (- k 1))))) + +(list-tail '(1 2 3) 2) + ; recursive equality + (defun equal? (a b) (cond ((eq? a b) #t) ((and (pair? a) (pair? b)) @@ -220,3 +350,9 @@ (equal? '(a b c) '(a b c)) (equal? '(a b c) '(a b b)) + +;(define number->string (lexpr (arg opt) +; (let ((base (if (null? opt) 10 (car opt))) + ; +; + |