aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/builtins.c30
-rw-r--r--src/interp.c13
-rw-r--r--src/interp.h1
-rw-r--r--src/parser.c8
-rw-r--r--src/primitives.c42
5 files changed, 52 insertions, 42 deletions
diff --git a/src/builtins.c b/src/builtins.c
index 5ed285a..58873ef 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -7,7 +7,7 @@ SExpRef builtin_list(Interp *interp, SExpRef args) {
}
SExpRef builtin_car(Interp *interp, SExpRef args) {
- if (lisp_length(interp, args) != 1) {
+ if (LENGTH(args) != 1) {
return new_error(interp, "car: wrong argument number.\n");
}
if (ERRORP(args)) return args;
@@ -15,7 +15,7 @@ SExpRef builtin_car(Interp *interp, SExpRef args) {
}
SExpRef builtin_show(Interp *interp, SExpRef args) {
- if (lisp_length(interp, args) != 1) {
+ if (LENGTH(args) != 1) {
return new_error(interp, "show wrong argument number.\n");
}
lisp_print(interp, CAR(args), stdout);
@@ -23,14 +23,14 @@ SExpRef builtin_show(Interp *interp, SExpRef args) {
}
SExpRef builtin_cdr(Interp *interp, SExpRef args) {
- if (lisp_length(interp, args) != 1) {
+ if (LENGTH(args) != 1) {
return new_error(interp, "cdr: wrong argument number.\n");
}
return CDR(CAR(args));
}
SExpRef builtin_cons(Interp *interp, SExpRef args) {
- if (lisp_length(interp, args) != 2) {
+ if (LENGTH(args) != 2) {
return new_error(interp, "cons: wrong argument number.\n");
}
return CONS(CAR(args), CADR(args));
@@ -149,7 +149,7 @@ SExpRef builtin_sub(Interp *interp, SExpRef args) {
}
cur = CDR(cur);
}
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len == 1) {
SExp num = *REF(CAR(args));
if (num.type == kIntegerSExp) {
@@ -175,7 +175,7 @@ SExpRef builtin_div(Interp *interp, SExpRef args) {
}
cur = CDR(cur);
}
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len == 1) {
SExp num = *REF(CAR(args));
if (num.type == kIntegerSExp) {
@@ -201,7 +201,7 @@ SExpRef builtin_idiv(Interp *interp, SExpRef args) {
}
cur = CDR(cur);
}
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len == 2) {
SExp num = raw_idiv(*REF(CAR(args)), *REF(CADR(args)));
ret = new_sexp(interp);
@@ -220,7 +220,7 @@ SExpRef builtin_mod(Interp *interp, SExpRef args) {
}
cur = CDR(cur);
}
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len == 2) {
SExp num = raw_mod(*REF(CAR(args)), *REF(CADR(args)));
ret = new_sexp(interp);
@@ -231,14 +231,14 @@ SExpRef builtin_mod(Interp *interp, SExpRef args) {
}
SExpRef builtin_not(Interp *interp, SExpRef args) {
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len != 1) return new_error(interp, "not: wrong argument number.\n");
if (TRUEP(CAR(args))) return interp->f;
return interp->t;
}
SExpRef builtin_num_equal(Interp *interp, SExpRef args) {
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len != 2) return new_error(interp, "=: wrong argument number.\n");
SExpRef lhs = CAR(args);
SExpRef rhs = CADR(args);
@@ -267,7 +267,7 @@ SExpRef builtin_num_equal(Interp *interp, SExpRef args) {
}
SExpRef builtin_num_neq(Interp *interp, SExpRef args) {
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len != 2) return new_error(interp, "/=: wrong argument number.\n");
SExpRef lhs = CAR(args);
SExpRef rhs = CADR(args);
@@ -296,7 +296,7 @@ SExpRef builtin_num_neq(Interp *interp, SExpRef args) {
}
SExpRef builtin_gt(Interp *interp, SExpRef args) {
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len != 2) return new_error(interp, ">: wrong argument number.\n");
SExpRef lhs = CAR(args);
SExpRef rhs = CADR(args);
@@ -325,7 +325,7 @@ SExpRef builtin_gt(Interp *interp, SExpRef args) {
}
SExpRef builtin_lt(Interp *interp, SExpRef args) {
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len != 2) return new_error(interp, "<: wrong argument number.\n");
SExpRef lhs = CAR(args);
SExpRef rhs = CADR(args);
@@ -354,7 +354,7 @@ SExpRef builtin_lt(Interp *interp, SExpRef args) {
}
SExpRef builtin_ge(Interp *interp, SExpRef args) {
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len != 2) return new_error(interp, ">=: wrong argument number.\n");
SExpRef lhs = CAR(args);
SExpRef rhs = CADR(args);
@@ -390,7 +390,7 @@ SExpRef builtin_gcstat(Interp *interp, SExpRef args) {
}
SExpRef builtin_le(Interp *interp, SExpRef args) {
- int args_len = lisp_length(interp, args);
+ int args_len = LENGTH(args);
if (args_len != 2) return new_error(interp, "<=: wrong argument number.\n");
SExpRef lhs = CAR(args);
SExpRef rhs = CADR(args);
diff --git a/src/interp.c b/src/interp.c
index 8aa4329..6f7871c 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -449,11 +449,16 @@ end:
int lisp_length(Interp *interp, SExpRef lst) {
int cnt = 0;
- while (REF(lst)->type == kPairSExp) {
- cnt++;
- lst = CDR(lst);
+ if (VALTYPE(lst) == kPairSExp) {
+ while (REF(lst)->type == kPairSExp) {
+ cnt++;
+ lst = CDR(lst);
+ }
+ return cnt;
+ } else if (VALTYPE(lst) == kStringSExp) {
+ return strlen(REF(lst)->str);
}
- return cnt;
+ return 1;
}
static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
diff --git a/src/interp.h b/src/interp.h
index 0564ee0..2daa29d 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -44,6 +44,7 @@ void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn);
#define REF(_x) (Interp_ref(interp, (_x)))
#define CONS(_x, _y) (lisp_cons(interp, (_x), (_y)))
#define NILP(_x) (lisp_nilp(interp, (_x)))
+#define LENGTH(_x) (lisp_length(interp, (_x)))
#define EVAL(_x) (lisp_eval(interp, (_x)))
#define TRUEP(_x) (lisp_truep(interp, (_x)))
#define ERRORP(_x) (REF((_x))->type == kErrSExp)
diff --git a/src/parser.c b/src/parser.c
index cc41d76..c692794 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -231,8 +231,8 @@ ParseResult parse_list(Parser *parser) {
ret = parse_sexp(parser);
if (ParseResult_is_err(ret)) goto end;
SExpRefVector_push_back(&elems, ret.val);
- ret = expect_space_or_end(parser);
- if (ParseResult_is_err(ret)) goto end;
+ // ret = expect_space_or_end(parser);
+ // if (ParseResult_is_err(ret)) goto end;
skip_spaces(parser);
}
// dot
@@ -256,6 +256,9 @@ static char *read_token(Parser *parser) {
while (!isspace(Parser_peek(parser))
&& Parser_peek(parser) != EOF
&& Parser_peek(parser) != ')'
+ && Parser_peek(parser) != '('
+ && Parser_peek(parser) != '"'
+ && (i == 0 || Parser_peek(parser) != '#')
&& i < BUFSIZE - 1) {
parser->token_buf[i] = Parser_getchar(parser);
i++;
@@ -281,6 +284,7 @@ static bool is_symbol_init(char c) {
if (c == '^') return true;
if (c == '_') return true;
if (c == '~') return true;
+ if (c < 0) return true;
return false;
}
diff --git a/src/primitives.c b/src/primitives.c
index 1cee577..6efa018 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -5,7 +5,7 @@
SExpRef primitive_if(Interp *interp, SExpRef args) {
SExpRef cond, tb, fb;
- if (lisp_length(interp, args) != 3) goto error;
+ if (LENGTH(args) != 3) goto error;
cond = CAR(args);
tb = CADR(args);
fb = CADDR(args);
@@ -21,12 +21,12 @@ error:
SExpRef primitive_cond(Interp *interp, SExpRef args) {
SExpRef pair, condition, exp, iter;
- if (lisp_length(interp, args) < 1) goto error;
+ if (LENGTH(args) < 1) goto error;
iter = args;
while (!NILP(iter)) {
pair = CAR(iter);
if (!lisp_check_list(interp, pair)) goto error;
- if (lisp_length(interp, pair) != 2) goto error;
+ if (LENGTH(pair) != 2) goto error;
condition = CAR(pair);
exp = CADR(pair);
condition = EVAL(condition);
@@ -54,7 +54,7 @@ SExpRef primitive_progn(Interp *interp, SExpRef args) {
SExpRef primitive_setq(Interp *interp, SExpRef args) {
SExpRef name, exp, value;
- if (lisp_length(interp, args) != 2) goto error;
+ if (LENGTH(args) != 2) goto error;
name = CAR(args);
exp = CADR(args);
if (REF(name)->type != kSymbolSExp) goto error;
@@ -84,7 +84,7 @@ SExpRef primitive_let(Interp *interp, SExpRef args) {
SExpRef binding, iter, bindings, env, x,
val, body, ret, exp;
- if (lisp_length(interp, args) < 1) goto error;
+ if (LENGTH(args) < 1) goto error;
bindings = CAR(args);
env = new_env(interp);
REF(env)->env.parent = CAR(interp->stack);
@@ -93,7 +93,7 @@ SExpRef primitive_let(Interp *interp, SExpRef args) {
while (!NILP(iter)) {
x = CAR(iter);
if (!lisp_check_list(interp, x)) goto error;
- if (lisp_length(interp, x) != 2) goto error;
+ if (LENGTH(x) != 2) goto error;
if (REF(CAR(x))->type != kSymbolSExp) goto error;
if (is_binding_repeat(interp, CAR(x), env)) goto error;
binding = new_binding(interp, CAR(x), NIL);
@@ -133,7 +133,7 @@ error:
SExpRef primitive_while(Interp *interp, SExpRef args) {
SExpRef ret, pred, body, cond, iter, x;
- if (lisp_length(interp, args) < 2) goto error;
+ if (LENGTH(args) < 2) goto error;
ret = NIL;
pred = CAR(args);
body = CDR(args);
@@ -156,7 +156,7 @@ error:
SExpRef primitive_lambda(Interp *interp, SExpRef args) {
SExpRef env, param, body;
- if (lisp_length(interp, args) < 2) goto error;
+ if (LENGTH(args) < 2) goto error;
env = CAR(interp->stack);
param = CAR(args);
body = CDR(args);
@@ -168,7 +168,7 @@ error:
SExpRef primitive_defun(Interp *interp, SExpRef args) {
SExpRef name, param, body, function;
- if (lisp_length(interp, args) < 3) goto error;
+ if (LENGTH(args) < 3) goto error;
if (CAR(interp->stack).idx != interp->top_level.idx) {
return new_error(interp, "defun: functions can only be defined in top level.\n");
}
@@ -185,7 +185,7 @@ error:
SExpRef primitive_defmacro(Interp *interp, SExpRef args) {
SExpRef param, name, body, macro;
- if (lisp_length(interp, args) < 3) goto error;
+ if (LENGTH(args) < 3) goto error;
if (CAR(interp->stack).idx != interp->top_level.idx) {
return new_error(interp, "defmacro: macros can only be defined in top level.\n");
}
@@ -203,7 +203,7 @@ error:
SExpRef primitive_defvar(Interp *interp, SExpRef args) {
SExpRef name, exp, val;
- if (lisp_length(interp, args) != 2) goto error;
+ if (LENGTH(args) != 2) goto error;
if (CAR(interp->stack).idx != interp->top_level.idx) {
return new_error(interp, "defvar: functions can only be defined in top level.\n");
}
@@ -219,7 +219,7 @@ error:
}
SExpRef primitive_function(Interp *interp, SExpRef args) {
- if (lisp_length(interp, args) != 1) goto error;
+ if (LENGTH(args) != 1) goto error;
if (VALTYPE(CAR(args)) != kSymbolSExp) goto error;
return lisp_lookup_func(interp, REF(CAR(args))->str);
error:
@@ -256,7 +256,7 @@ static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
}
SExpRef primitive_funcall(Interp *interp, SExpRef args) {
- if (lisp_length(interp, args) < 1) goto error;
+ if (LENGTH(args) < 1) goto error;
args = lisp_eval_args(interp, args);
if (ERRORP(args)) return args;
return lisp_apply(interp, CAR(args), CDR(args));
@@ -265,14 +265,14 @@ error:
}
SExpRef primitive_quote(Interp *interp, SExpRef args) {
- if (lisp_length(interp, args) != 1) return new_error(interp, "quote: syntax error.\n");
+ if (LENGTH(args) != 1) return new_error(interp, "quote: syntax error.\n");
return CAR(args);
}
SExpRef primitive_macroexpand1(Interp *interp, SExpRef args) {
SExpRef macro;
- if (lisp_length(interp, args) != 1) goto error;
+ if (LENGTH(args) != 1) goto error;
args = CAR(args);
if (VALTYPE(CAR(args)) != kSymbolSExp) goto error;
macro = lisp_lookup_func(interp, REF(CAR(args))->str);
@@ -285,7 +285,7 @@ error:
SExpRef primitive_apply(Interp *interp, SExpRef args) {
SExpRef ret;
- if (lisp_length(interp, args) != 2) goto error;
+ if (LENGTH(args) != 2) goto error;
args = lisp_eval_args(interp, args);
if (ERRORP(args)) return args;
if (!lisp_check_list(interp, CADR(args))) goto error;
@@ -307,7 +307,7 @@ static SExpRef quasi_impl(Interp *interp, SExpRef obj, bool *slicing) {
if (VALTYPE(obj) != kPairSExp) return obj;
if (VALTYPE(CAR(obj)) == kSymbolSExp
&& strcmp("unquote", REF(CAR(obj))->str) == 0) {
- if (lisp_length(interp, obj) != 2) {
+ if (LENGTH(obj) != 2) {
return new_error(interp, "unquote: syntax error.\n");
}
return EVAL(CADR(obj));
@@ -316,7 +316,7 @@ static SExpRef quasi_impl(Interp *interp, SExpRef obj, bool *slicing) {
&& strcmp("slicing-unquote", REF(CAR(obj))->str) == 0) {
lst = EVAL(CADR(obj));
if (ERRORP(lst)) return lst;
- if (lisp_length(interp, obj) != 2) {
+ if (LENGTH(obj) != 2) {
return new_error(interp, "slicing-unquote: syntax error.\n");
}
if (!lisp_check_list(interp, lst)) {
@@ -355,7 +355,7 @@ static SExpRef quasi_on_list(Interp *interp, SExpRef lst) {
SExpRef primitive_quasi(Interp *interp, SExpRef args) {
SExpRef ret;
- if (lisp_length(interp, args) != 1) return new_error(interp, "quasiquote: syntax error.\n");
+ if (LENGTH(args) != 1) return new_error(interp, "quasiquote: syntax error.\n");
bool slicing;
ret = quasi_impl(interp, CAR(args), &slicing);
if (slicing) return new_error(interp, "quasiquote: syntax error.\n");
@@ -365,7 +365,7 @@ SExpRef primitive_quasi(Interp *interp, SExpRef args) {
SExpRef primitive_and(Interp *interp, SExpRef args) {
SExpRef ret;
SExpRef i = args;
- if (lisp_length(interp, args) < 1) return new_error(interp, "and: syntax error.\n");
+ if (LENGTH(args) < 1) return new_error(interp, "and: syntax error.\n");
while (!NILP(i)) {
ret = EVAL(CAR(i));
if (!TRUEP(ret)) return ret;
@@ -378,7 +378,7 @@ SExpRef primitive_or(Interp *interp, SExpRef args) {
SExpRef ret;
SExpRef i = args;
- if (lisp_length(interp, args) < 1) return new_error(interp, "or: syntax error.\n");
+ if (LENGTH(args) < 1) return new_error(interp, "or: syntax error.\n");
while (!NILP(i)) {
ret = EVAL(CAR(i));
if (TRUEP(ret)) return ret;
generated by cgit v1.0 at 2025-12-29 19:17:49 +0000