tisp

tiny lisp
git clone git://edryd.org/tisp
Log | Files | Refs | LICENSE

commit f32f47079eb2759ab3179a23d63561fb93412468
parent 986b2ccf3da263fd9a15044392fa1ae74b0cd618
Author: Ed van Bruggen <edvb@uw.edu>
Date:   Thu, 19 Mar 2020 01:47:00 -0700

Add get primitive to access properties of types

Diffstat:
test.c | 14++++++++++++++
tisp.c | 44++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 58 insertions(+), 0 deletions(-)

diff --git a/test.c b/test.c @@ -126,6 +126,20 @@ char *tests[][2] = { { "(cond ((= 1 2) 1) (\"foo\" 2) (else 3))", "2" }, { "(cond (() (+ 1 2)))", "#<void>" }, + { "get", NULL }, + { "(get \"hello\" 'len)", "5" }, + { "(get 'drinky-poo 'len)", "10" }, + { "(get (cons 1 2) 'car)", "1" }, + { "(get (cons 'jamie 'mr-t) 'cdr)", "mr-t" }, + { "(get '(dirty-burger freedom-35) 'cdr)", "(freedom-35)" }, + { "(get '(1 2 3 4) 'cdr)", "(2 3 4)" }, + { "(get '(2 4 6) 'car)", "2" }, + { "(get 3 'num)", "3" }, + { "(get 83 'den)", "1" }, + { "(get 3/2 'den)", "2" }, + { "(get 10/15 'den)", "3" }, + { "(get 9/2 'num)", "9" }, + { "eq", NULL }, { "(=)", "t" }, { "(= 1)", "t" }, diff --git a/tisp.c b/tisp.c @@ -901,6 +901,48 @@ prim_type(Tsp st, Hash env, Val args) return mk_str(st, type_str(v->t)); } +/* get a property of given value */ +static Val +prim_get(Tsp st, Hash env, Val args) +{ + Val v, prop; + tsp_arg_num(args, "get", 2); + if (!(v = tisp_eval(st, env, car(args)))) + return NULL; + if (!(prop = tisp_eval(st, env, cadr(args)))) + return NULL; + tsp_arg_type(prop, "get", SYMBOL); + switch (v->t) { + case FUNCTION: + case MACRO: + if (!strncmp(prop->v.s, "body", 4)) + return v->v.f.body; + if (!strncmp(prop->v.s, "args", 4)) + return v->v.f.args; + break; + case INTEGER: + case RATIO: + if (!strncmp(prop->v.s, "num", 3)) + return mk_int(v->v.n.num); + if (!strncmp(prop->v.s, "den", 3)) + return mk_int(v->v.n.den); + break; + case PAIR: + if (!strncmp(prop->v.s, "car", 3)) + return v->v.p.car; + if (!strncmp(prop->v.s, "cdr", 3)) + return v->v.p.cdr; + break; + case STRING: + case SYMBOL: + if (!strncmp(prop->v.s, "len", 3)) + return mk_int(strlen(v->v.s)); + default: break; + } + tsp_warnf("get: can not access %s from type %s", + prop->v.s, type_str(v->t)); +} + /* creates new tisp lambda function */ static Val prim_lambda(Tsp st, Hash env, Val args) @@ -920,6 +962,7 @@ prim_macro(Tsp st, Hash env, Val args) /* creates new variable of given name and value * if pair is given as name of variable, creates function with the car as the * function name and the cdr the function arguments */ +/* TODO if var not func error if more than 2 args */ static Val prim_define(Tsp st, Hash env, Val args) { @@ -1089,6 +1132,7 @@ tisp_env_init(size_t cap) tsp_env_name_fn(=, eq); tsp_env_fn(cond); tsp_env_fn(type); + tsp_env_fn(get); tsp_env_fn(lambda); tsp_env_fn(macro); tsp_env_fn(define);