sjs/lake
1
0
Fork 0
mirror of https://github.com/samsonjs/lake.git synced 2026-03-25 08:55:49 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

improve parser, add numeric = primitive

Browse source 
- parse symbols such as "+" ,"-", and "1+"
- parse 'quoted expressions
This commit is contained in:
Sami Samhuri 2011-04-20 16:09:01 -07:00
parent 619a2ed04e
commit ccab787366
5 changed files with 239 additions and 165 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

149
lake.c
View file

@ -27,143 +27,19 @@ static LakeBool _F = { { TYPE_BOOL, sizeof(LakeBool) }, FALSE };
LakeBool *T = &_T;
LakeBool *F = &_F;
static LakeVal *prim_nullP(LakeList *args)
char *type_name(LakeVal *expr)
{
LakeVal *val = list_shift(args);
LakeBool *is_null = IS(TYPE_LIST, val) && LIST_N(LIST(val)) == 0 ? T : F;
return VAL(is_null);
static char *type_names[9] = { "nil", "symbol", "boolean", "integer", "string", "list",
"dotted-list", "primitive", "function"
};
return type_names[expr->type];
}
static LakeVal *prim_pairP(LakeList *args)
void print(LakeVal *expr)
{
LakeVal *val = list_shift(args);
LakeBool *is_pair = IS(TYPE_LIST, val) && LIST_N(LIST(val)) > 0 ? T : F;
return VAL(is_pair);
}
static LakeVal *prim_not(LakeList *args)
{
LakeVal *val = list_shift(args);
LakeBool *not = IS_FALSE(val) ? T : F;
return VAL(not);
}
static LakeVal *prim_add(LakeList *args)
{
int result = 0;
size_t n = LIST_N(args);
size_t i;
for (i = 0; i < n; ++i) {
LakeVal *v = LIST_VAL(args, i);
if (!IS(TYPE_INT, v)) {
ERR("argument %zu is not an integer: %s", i, repr(v));
return NULL;
}
result += INT_VAL(INT(v));
}
return VAL(int_from_c(result));
}
static LakeVal *prim_sub(LakeList *args)
{
size_t n = LIST_N(args);
if (n < 1) {
ERR("- requires at least one argument");
return NULL;
}
int result = 0;
size_t i;
for (i = 0; i < n; ++i) {
LakeVal *v = LIST_VAL(args, i);
if (!IS(TYPE_INT, v)) {
ERR("argument %zu is not an integer: %s", i, repr(v));
return NULL;
}
result -= INT_VAL(INT(v));
}
return VAL(int_from_c(result));
}
static LakeVal *prim_mul(LakeList *args)
{
int result = 1;
size_t n = LIST_N(args);
size_t i;
for (i = 0; i < n; ++i) {
LakeVal *v = LIST_VAL(args, i);
if (!IS(TYPE_INT, v)) {
ERR("argument %zu is not an integer: %s", i, repr(v));
return NULL;
}
result *= INT_VAL(INT(v));
}
return VAL(int_from_c(result));
}
#define DIVIDE_BY_ZERO() ERR("divide by zero")
static LakeVal *prim_div(LakeList *args)
{
size_t n = LIST_N(args);
if (n < 1) {
ERR("/ requires at least one argument");
return NULL;
}
LakeVal *v = LIST_VAL(args, 0);
if (!IS(TYPE_INT, v)) {
ERR("argument 0 is not an integer: %s", repr(v));
return NULL;
}
int result = INT_VAL(INT(v));
if (n == 1) {
if (result == 0) {
DIVIDE_BY_ZERO();
return NULL;
}
result = 1 / result;
}
else {
size_t i;
for (i = 1; i < n; ++i) {
v = LIST_VAL(args, i);
if (!IS(TYPE_INT, v)) {
ERR("argument %zu is not an integer: %s", i, repr(v));
return NULL;
}
int val = INT_VAL(INT(v));
if (val == 0) {
DIVIDE_BY_ZERO();
return NULL;
}
result /= val;
}
}
return VAL(int_from_c(result));
}
static Env *primitive_bindings(void)
{
#define DEFINE(name, fn, arity) env_define(env, sym_intern(name), VAL(prim_make(name, arity, fn)))
Env *env = env_toplevel();
DEFINE("null?", prim_nullP, 1);
DEFINE("pair?", prim_pairP, 1);
DEFINE("not", prim_not, 1);
DEFINE("+", prim_add, ARITY_VARARGS);
DEFINE("-", prim_sub, ARITY_VARARGS);
DEFINE("*", prim_mul, ARITY_VARARGS);
DEFINE("/", prim_div, ARITY_VARARGS);
return env;
}
void print(LakeVal *val)
{
puts(repr(val));
/* printf("[%s]\n", type_name(expr)); */
printf("%s\n", repr(expr));
}
static LakeVal *prompt_read(char *prompt)
@ -260,6 +136,10 @@ char *repr(LakeVal *expr)
s = dlist_repr(DLIST(expr));
break;
case TYPE_PRIM:
s = prim_repr(PRIM(expr));
break;
case TYPE_FN:
s = fn_repr(FN(expr));
break;
@ -276,7 +156,8 @@ int main (int argc, char const *argv[])
{
if (argc == 1) {
run_repl();
} else {
}
else {
run_one_then_repl(argc, argv);
}
return 0;

3
list.c
View file

@ -80,7 +80,8 @@ LakeVal *list_set(LakeList *list, size_t i, LakeVal *val)
{
if (i >= 0 && i < list->n) {
list->vals[i] = val;
} else {
}
else {
ERR("list_set: index %zu is out of bounds (%zu)", i, list->n);
}
return NULL;

91
parse.c
View file

@ -23,6 +23,7 @@ struct context {
char *s;
size_t n;
size_t i;
size_t mark;
};
typedef struct context Ctx;
@ -30,7 +31,7 @@ static LakeVal *_parse_expr(Ctx *ctx);
LakeVal *parse_expr(char *s, size_t n)
{
Ctx ctx = { s, n, 0 };
Ctx ctx = { s, n, 0, 0 };
LakeVal *result = _parse_expr(&ctx);
if (ctx.i < ctx.n) {
char *trailing = ctx.s + ctx.i;
@ -70,26 +71,21 @@ static char ch(Ctx *ctx, char expected)
DIE("parse error, expected '%c' got '%c'", expected, c);
}
static int maybe_spaces(Ctx *ctx)
static void mark(Ctx *ctx)
{
char *p;
while ((p = strchr(" \r\n\t", peek(ctx))) != NULL) {
consume1(ctx);
}
return 1;
ctx->mark = ctx->i;
}
/*
static int whitespace(Ctx *ctx)
static void backtrack(Ctx *ctx)
{
int result = 0;
char *p;
while ((p = strchr(" \r\n\t", peek(ctx))) != NULL) {
consume1(ctx);
result = 1;
}
return result;
ctx->i = ctx->mark;
}
*/
static gboolean is_space(c)
{
return strchr(" \r\n\t", c) != NULL;
}
static gboolean is_letter(char c)
{
return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z');
@ -105,6 +101,16 @@ static gboolean is_digit(char c)
return c >= '0' && c <= '9';
}
static gboolean is_sym_char(char c)
{
return is_letter(c) || is_symbol(c) || is_digit(c);
}
static gboolean is_newline(char c)
{
return c == '\n' || c == '\r';
}
static char *parse_while(Ctx *ctx, gboolean (*is_valid)(char))
{
size_t n = 8;
@ -126,27 +132,41 @@ static char *parse_while(Ctx *ctx, gboolean (*is_valid)(char))
return s;
}
static int maybe_spaces(Ctx *ctx)
{
while (is_space(peek(ctx))) {
consume1(ctx);
}
return 1;
}
static LakeVal *parse_int(Ctx *ctx)
{
mark(ctx);
int n = 0;
char c = peek(ctx);
char sign = c == '-' ? -1 : 1;
if (c == '-' || c == '+') {
consume1(ctx);
/* if not followed by a digit it's a symbol */
if (!is_digit(peek(ctx))) {
backtrack(ctx);
return NULL;
}
}
while (is_digit(c = peek(ctx))) {
n *= 10;
n += c - '0';
consume1(ctx);
}
/* if we're looking at a symbol character bail, it's not a number */
if (is_sym_char(peek(ctx))) {
backtrack(ctx);
return NULL;
}
return VAL(int_from_c(sign * n));
}
static gboolean is_sym_char(char c)
{
return is_letter(c) || is_symbol(c) || is_digit(c);
}
static LakeVal *parse_sym(Ctx *ctx)
{
LakeVal *val;
@ -161,9 +181,11 @@ static LakeVal *parse_sym(Ctx *ctx)
s[i] = '\0';
if (g_strcmp0(s, "#t") == 0) {
val = VAL(T);
} else if (g_strcmp0(s, "#f") == 0) {
}
else if (g_strcmp0(s, "#f") == 0) {
val = VAL(F);
} else {
}
else {
val = VAL(sym_intern(s));
}
return val;
@ -231,7 +253,7 @@ static LakeVal* parse_list(Ctx *ctx)
char c;
while ((c = peek(ctx)) != ')') {
if (c == PARSE_EOF) {
printf("error: end of input while parsing list");
ERR("end of input while parsing list");
list_free(list);
ctx-> i = ctx->n;
return NULL;
@ -263,9 +285,18 @@ static LakeVal* parse_list(Ctx *ctx)
return VAL(list);
}
static LakeVal *parse_quoted(Ctx *ctx)
{
ch(ctx, '\'');
LakeList *list = list_make();
list_append(list, VAL(sym_intern("quote")));
list_append(list, _parse_expr(ctx));
return VAL(list);
}
static gboolean is_not_newline(char c)
{
return !(c == '\n' || c == '\r');
return !is_newline(c);
}
static void parse_comment(Ctx *ctx)
@ -277,8 +308,12 @@ static LakeVal *_parse_expr(Ctx *ctx)
{
LakeVal *result = NULL;
char c = peek(ctx);
if (c >= '0' && c <= '9') {
/* try to parse a number, if that fails parse a symbol */
if ((c >= '0' && c <= '9') || c == '-' || c == '+') {
result = VAL(parse_int(ctx));
if (result == NULL) {
result = parse_sym(ctx);
}
}
else if (is_letter(c) || is_symbol(c)) {
result = parse_sym(ctx);
@ -286,11 +321,9 @@ static LakeVal *_parse_expr(Ctx *ctx)
else if (c == '"') {
result = parse_str(ctx);
}
/* TODO: quote
else if (c == '\'') {
result = parse_quoted(ctx);
}
*/
else if (c == '(') {
result = parse_list(ctx);
}

156
primitive.c
View file

@ -7,6 +7,9 @@
*
*/
#include <glib.h>
#include <stdlib.h>
#include "env.h"
#include "lake.h"
#include "primitive.h"
@ -25,4 +28,155 @@ LakePrimitive *prim_make(char *name, int arity, lake_fn fn)
prim->arity = arity;
prim->fn = fn;
return prim;
}
}
char *prim_repr(LakePrimitive *prim)
{
return g_strdup_printf("<#primitive:%s(%d)>", prim->name, prim->arity);
}
static LakeVal *prim_nullP(LakeList *args)
{
LakeVal *val = list_shift(args);
LakeBool *is_null = IS(TYPE_LIST, val) && LIST_N(LIST(val)) == 0 ? T : F;
return VAL(is_null);
}
static LakeVal *prim_pairP(LakeList *args)
{
LakeVal *val = list_shift(args);
LakeBool *is_pair = IS(TYPE_LIST, val) && LIST_N(LIST(val)) > 0 ? T : F;
return VAL(is_pair);
}
static LakeVal *prim_not(LakeList *args)
{
LakeVal *val = list_shift(args);
LakeBool *not = IS_FALSE(val) ? T : F;
return VAL(not);
}
#define ENSURE_INT(x, i) do { \
if (!IS(TYPE_INT, x)) { \
ERR("argument %zu is not an integer: %s", i, repr(x)); \
return NULL; \
} \
} while (0)
static LakeVal *prim_add(LakeList *args)
{
int result = 0;
size_t n = LIST_N(args);
size_t i;
for (i = 0; i < n; ++i) {
LakeVal *v = LIST_VAL(args, i);
ENSURE_INT(v, i);
result += INT_VAL(INT(v));
}
return VAL(int_from_c(result));
}
static LakeVal *prim_sub(LakeList *args)
{
size_t n = LIST_N(args);
if (n < 1) {
ERR("- requires at least one argument");
return NULL;
}
int result = 0;
size_t i;
for (i = 0; i < n; ++i) {
LakeVal *v = LIST_VAL(args, i);
ENSURE_INT(v, i);
result -= INT_VAL(INT(v));
}
return VAL(int_from_c(result));
}
static LakeVal *prim_mul(LakeList *args)
{
int result = 1;
size_t n = LIST_N(args);
size_t i;
for (i = 0; i < n; ++i) {
LakeVal *v = LIST_VAL(args, i);
ENSURE_INT(v, i);
result *= INT_VAL(INT(v));
}
return VAL(int_from_c(result));
}
#define DIVIDE_BY_ZERO() ERR("divide by zero")
static LakeVal *prim_div(LakeList *args)
{
size_t n = LIST_N(args);
if (n < 1) {
ERR("/ requires at least one argument");
return NULL;
}
LakeVal *v = LIST_VAL(args, 0);
ENSURE_INT(v, (size_t)0);
int result = INT_VAL(INT(v));
if (n == 1) {
if (result == 0) {
DIVIDE_BY_ZERO();
return NULL;
}
result = 1 / result;
}
else {
size_t i;
for (i = 1; i < n; ++i) {
v = LIST_VAL(args, i);
ENSURE_INT(v, i);
int val = INT_VAL(INT(v));
if (val == 0) {
DIVIDE_BY_ZERO();
return NULL;
}
result /= val;
}
}
return VAL(int_from_c(result));
}
static LakeVal *prim_int_eq(LakeList *args)
{
gboolean result = TRUE;
size_t n = LIST_N(args);
size_t i;
int curr, prev;
for (i = 0; i < n; ++i) {
LakeVal *v = LIST_VAL(args, i);
ENSURE_INT(v, i);
curr = INT_VAL(INT(v));
if (i > 0) {
result = result && curr == prev;
}
prev = INT_VAL(INT(v));
}
return VAL(bool_from_int(result));
}
Env *primitive_bindings(void)
{
#define DEFINE(name, fn, arity) env_define(env, sym_intern(name), VAL(prim_make(name, arity, fn)))
Env *env = env_toplevel();
DEFINE("null?", prim_nullP, 1);
DEFINE("pair?", prim_pairP, 1);
DEFINE("not", prim_not, 1);
DEFINE("+", prim_add, ARITY_VARARGS);
DEFINE("-", prim_sub, ARITY_VARARGS);
DEFINE("*", prim_mul, ARITY_VARARGS);
DEFINE("/", prim_div, ARITY_VARARGS);
DEFINE("=", prim_int_eq, ARITY_VARARGS);
return env;
}

5
primitive.h
View file

@ -10,6 +10,11 @@
#ifndef _LAKE_PRIMITIVE_H
#define _LAKE_PRIMITIVE_H 1
#include "env.h"
#include "lake.h"
LakePrimitive *prim_make(char *name, int arity, lake_fn fn);
char *prim_repr(LakePrimitive *prim);
Env *primitive_bindings(void);
#endif