tisp

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);