summaryrefslogtreecommitdiff
path: root/src/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/lisp')
-rw-r--r--src/lisp/ao_lisp_builtin.c36
-rw-r--r--src/lisp/ao_lisp_builtin.txt6
-rw-r--r--src/lisp/ao_lisp_const.lisp87
-rw-r--r--src/lisp/ao_lisp_make_builtin22
4 files changed, 117 insertions, 34 deletions
diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 6fc28820..d89404dc 100644
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -210,11 +210,17 @@ ao_lisp_do_set(struct ao_lisp_cons *cons)
ao_poly
ao_lisp_do_setq(struct ao_lisp_cons *cons)
{
+ ao_poly name;
if (!ao_lisp_check_argc(_ao_lisp_atom_setq, cons, 2, 2))
return AO_LISP_NIL;
+ name = cons->car;
+ if (ao_lisp_poly_type(name) != AO_LISP_ATOM)
+ return ao_lisp_error(AO_LISP_INVALID, "set! of non-atom");
+ if (!ao_lisp_atom_ref(ao_lisp_frame_current, name))
+ return ao_lisp_error(AO_LISP_INVALID, "atom not defined");
return ao_lisp__cons(_ao_lisp_atom_set,
ao_lisp__cons(ao_lisp__cons(_ao_lisp_atom_quote,
- ao_lisp__cons(cons->car, AO_LISP_NIL)),
+ ao_lisp__cons(name, AO_LISP_NIL)),
cons->cdr));
}
@@ -559,5 +565,33 @@ ao_lisp_do_not(struct ao_lisp_cons *cons)
return _ao_lisp_bool_false;
}
+ao_poly
+ao_lisp_do_listp(struct ao_lisp_cons *cons)
+{
+ ao_poly v;
+ if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+ return AO_LISP_NIL;
+ v = ao_lisp_arg(cons, 0);
+ for (;;) {
+ if (v == AO_LISP_NIL)
+ return _ao_lisp_bool_true;
+ if (ao_lisp_poly_type(v) != AO_LISP_CONS)
+ return _ao_lisp_bool_false;
+ v = ao_lisp_poly_cons(v)->cdr;
+ }
+}
+
+ao_poly
+ao_lisp_do_pairp(struct ao_lisp_cons *cons)
+{
+ ao_poly v;
+ if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+ return AO_LISP_NIL;
+ v = ao_lisp_arg(cons, 0);
+ if (ao_lisp_poly_type(v) == AO_LISP_CONS)
+ return _ao_lisp_bool_true;
+ return _ao_lisp_bool_false;
+}
+
#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 02320df0..2b891dba 100644
--- a/src/lisp/ao_lisp_builtin.txt
+++ b/src/lisp/ao_lisp_builtin.txt
@@ -11,7 +11,7 @@ lambda last
lambda length
nlambda quote
lambda set
-macro setq
+macro setq set!
nlambda cond
nlambda progn
nlambda while
@@ -22,7 +22,7 @@ lexpr minus -
lexpr times *
lexpr divide /
lexpr mod %
-lexpr equal =
+lexpr equal = eq? eqv?
lexpr less <
lexpr greater >
lexpr less_equal <=
@@ -38,3 +38,5 @@ lambda call_cc call/cc
lambda collect
lambda nullp null?
lambda not
+lambda listp list?
+lambda pairp pair?
diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp
index df277fce..37307a68 100644
--- a/src/lisp/ao_lisp_const.lisp
+++ b/src/lisp/ao_lisp_const.lisp
@@ -23,17 +23,17 @@
; having lots of output generated
;
-(setq def (macro (name val rest)
- (list
- 'progn
- (list
- 'set
- (list 'quote name)
- val)
- (list 'quote name)
- )
- )
- )
+(set (quote define) (macro (name val rest)
+ (list
+ 'progn
+ (list
+ 'set
+ (list 'quote name)
+ val)
+ (list 'quote name)
+ )
+ )
+ )
;
; A slightly more convenient form
@@ -42,9 +42,9 @@
; (defun <name> (<params>) s-exprs)
;
-(def defun (macro (name args exprs)
+(define defun (macro (name args exprs)
(list
- def
+ define
name
(cons 'lambda (cons args exprs))
)
@@ -69,6 +69,28 @@
(defun 1+ (x) (+ x 1))
(defun 1- (x) (- x 1))
+(define if (macro (test args)
+ (cond ((null? (cdr args))
+ (list
+ cond
+ (list test (car args)))
+ )
+ (else
+ (list
+ cond
+ (list test (car args))
+ (list 'else (cadr args))
+ )
+ )
+ )
+ )
+ )
+
+(if (> 3 2) 'yes)
+(if (> 3 2) 'yes 'no)
+(if (> 2 3) 'no 'yes)
+(if (> 2 3) 'no)
+
; define a set of local
; variables and then evaluate
; a list of sexprs
@@ -85,16 +107,16 @@
;
; e.g.
;
- ; (let ((x 1) (y)) (setq y (+ x 1)) y)
+ ; (let ((x 1) (y)) (set! y (+ x 1)) y)
-(def let (macro (vars exprs)
+(define let (macro (vars exprs)
((lambda (make-names make-exprs make-nils)
;
; make the list of names in the let
;
- (setq make-names (lambda (vars)
+ (set! make-names (lambda (vars)
(cond ((not (null? vars))
(cons (car (car vars))
(make-names (cdr vars))))
@@ -107,7 +129,7 @@
; pre-pended to the
; expressions to evaluate
- (setq make-exprs (lambda (vars exprs)
+ (set! make-exprs (lambda (vars exprs)
(cond ((not (null? vars)) (cons
(list set
(list quote
@@ -126,7 +148,7 @@
; the parameters to the lambda is a list
; of nils of the right length
- (setq make-nils (lambda (vars)
+ (set! make-nils (lambda (vars)
(cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
)
)
@@ -134,7 +156,7 @@
; prepend the set operations
; to the expressions
- (setq exprs (make-exprs vars exprs))
+ (set! exprs (make-exprs vars exprs))
; build the lambda.
@@ -153,11 +175,11 @@
; boolean operators
-(def or (lexpr (l)
+(define or (lexpr (l)
(let ((ret #f))
(while (not (null? l))
- (cond ((car l) (setq ret #t) (setq l ()))
- ((setq l (cdr l)))))
+ (cond ((car l) (set! ret #t) (set! l ()))
+ ((set! l (cdr l)))))
ret
)
)
@@ -167,14 +189,14 @@
(or #f #t)
-(def and (lexpr (l)
+(define and (lexpr (l)
(let ((ret #t))
(while (not (null? l))
(cond ((car l)
- (setq l (cdr l)))
+ (set! l (cdr l)))
(#t
- (setq ret #f)
- (setq l ()))
+ (set! ret #f)
+ (set! l ()))
)
)
ret
@@ -185,3 +207,16 @@
; execute to resolve macros
(and #t #f)
+
+(defun equal? (a b)
+ (cond ((eq? a b) #t)
+ ((and (pair? a) (pair? b))
+ (and (equal? (car a) (car b))
+ (equal? (cdr a) (cdr b)))
+ )
+ (else #f)
+ )
+ )
+
+(equal? '(a b c) '(a b c))
+(equal? '(a b c) '(a b b))
diff --git a/src/lisp/ao_lisp_make_builtin b/src/lisp/ao_lisp_make_builtin
index 5e98516c..b7b17cf4 100644
--- a/src/lisp/ao_lisp_make_builtin
+++ b/src/lisp/ao_lisp_make_builtin
@@ -3,7 +3,7 @@
typedef struct {
string type;
string c_name;
- string lisp_name;
+ string[*] lisp_names;
} builtin_t;
string[string] type_map = {
@@ -13,6 +13,16 @@ string[string] type_map = {
"macro" => "MACRO",
};
+string[*]
+make_lisp(string[*] tokens)
+{
+ string[...] lisp = {};
+
+ if (dim(tokens) < 3)
+ return (string[1]) { tokens[dim(tokens) - 1] };
+ return (string[dim(tokens)-2]) { [i] = tokens[i+2] };
+}
+
builtin_t
read_builtin(file f) {
string line = File::fgets(f);
@@ -21,7 +31,7 @@ read_builtin(file f) {
return (builtin_t) {
.type = dim(tokens) > 0 ? type_map[tokens[0]] : "#",
.c_name = dim(tokens) > 1 ? tokens[1] : "#",
- .lisp_name = dim(tokens) > 2 ? tokens[2] : tokens[1]
+ .lisp_names = make_lisp(tokens),
};
}
@@ -84,7 +94,7 @@ dump_arrayname(builtin_t[*] builtins) {
for (int i = 0; i < dim(builtins); i++) {
printf("\t[builtin_%s] = _ao_lisp_atom_",
builtins[i].c_name);
- cify_lisp(builtins[i].lisp_name);
+ cify_lisp(builtins[i].lisp_names[0]);
printf(",\n");
}
printf("};\n");
@@ -123,8 +133,10 @@ dump_consts(builtin_t[*] builtins) {
printf("#undef AO_LISP_BUILTIN_CONSTS\n");
printf("struct builtin_func funcs[] = {\n");
for (int i = 0; i < dim(builtins); i++) {
- printf ("\t{ .name = \"%s\", .args = AO_LISP_FUNC_%s, .func = builtin_%s },\n",
- builtins[i].lisp_name, builtins[i].type, builtins[i].c_name);
+ for (int j = 0; j < dim(builtins[i].lisp_names); j++) {
+ printf ("\t{ .name = \"%s\", .args = AO_LISP_FUNC_%s, .func = builtin_%s },\n",
+ builtins[i].lisp_names[j], builtins[i].type, builtins[i].c_name);
+ }
}
printf("};\n");
printf("#endif /* AO_LISP_BUILTIN_CONSTS */\n");
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 05:52:39 +0000