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) {
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);
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;
}
ao_lisp_poly_string(car)));
else
return ao_lisp_error(AO_LISP_INVALID, "invalid args");
+
+ cons = ao_lisp_poly_cons(cons->cdr);
}
return ret;
}
}
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
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"
(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
(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))
(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)))
+ ;
+;
+