[augeas-devel] augeas: master - Syntax for recursive lenses
David Lutterkort
lutter at fedoraproject.org
Fri Jan 15 01:31:39 UTC 2010
Gitweb: http://git.fedorahosted.org/git/augeas.git?p=augeas.git;a=commitdiff;h=9b44eb7452d95bab287d6be69240d611dfbe833c
Commit: 9b44eb7452d95bab287d6be69240d611dfbe833c
Parent: d83582a24aeaa344bc383d1a4c4247b0fc3f9c84
Author: David Lutterkort <lutter at redhat.com>
AuthorDate: Fri Dec 18 15:44:50 2009 -0800
Committer: David Lutterkort <lutter at redhat.com>
CommitterDate: Thu Jan 14 14:48:38 2010 -0800
Syntax for recursive lenses
Add a 'let rec' construct; the syntax should be considered experimental and
might be changed to some other form of expressing recursion.
With recursive lenses, we can't do the bottom-up typechecking that we do
for regular lenses; we need to consider the whole lens at once. This is
achieved by inserting a callback to lns_check_rec when we parse 'let rec
ident = exp'.
* src/builtin.c (lns_check_rec_glue): new function
* src/lexer.l: new token LETREC
* src/parser.y: add syntax rule for LETREC and desugar it into a call to
lns_check_rec
* src/syntax.h: make free_term available, constant for name
of let_check_rec within the interpreter
* src/syntax.c (free_term): now extern, not static
---
src/builtin.c | 13 ++++++++++
src/lexer.l | 5 ++++
src/parser.y | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
src/syntax.c | 2 +-
src/syntax.h | 4 +++
5 files changed, 91 insertions(+), 2 deletions(-)
diff --git a/src/builtin.c b/src/builtin.c
index e68a840..1d61a7a 100644
--- a/src/builtin.c
+++ b/src/builtin.c
@@ -433,6 +433,16 @@ static struct value *sys_read_file(struct info *info, struct value *n) {
return v;
}
+/* V_LENS -> V_LENS */
+static struct value *lns_check_rec_glue(struct info *info,
+ struct value *l, struct value *r) {
+ assert(l->tag == V_LENS);
+ assert(r->tag == V_LENS);
+ int check = info->error->aug->flags & AUG_TYPE_CHECK;
+
+ return lns_check_rec(info, l->lens, r->lens, check);
+}
+
struct module *builtin_init(struct error *error) {
struct module *modl = module_create("Builtin");
int r;
@@ -469,6 +479,9 @@ struct module *builtin_init(struct error *error) {
DEFINE_NATIVE(modl, "excl", 1, xform_excl, T_STRING, T_FILTER);
DEFINE_NATIVE(modl, "transform", 2, xform_transform, T_LENS, T_FILTER,
T_TRANSFORM);
+ DEFINE_NATIVE(modl, LNS_CHECK_REC_NAME,
+ 2, lns_check_rec_glue, T_LENS, T_LENS, T_LENS);
+
/* System functions */
struct module *sys = module_create("Sys");
modl->next = sys;
diff --git a/src/lexer.l b/src/lexer.l
index cda014d..66637e1 100644
--- a/src/lexer.l
+++ b/src/lexer.l
@@ -70,6 +70,8 @@ static char *regexp_literal(const char *s, int len) {
DIGIT [0-9]
UID [A-Z][A-Za-z0-9_]*
LID [a-z][A-Za-z0-9_]*
+LETREC let[ \t]+rec
+WS [ \t\n]
QID {UID}\.{LID}
ARROW ->
@@ -112,6 +114,9 @@ ARROW ->
[|*?+()=:;\.\[\]{}-] return yytext[0];
module return KW_MODULE;
+
+ {LETREC}/{WS} return KW_LET_REC;
+
let return KW_LET;
string return KW_STRING;
regexp return KW_REGEXP;
diff --git a/src/parser.y b/src/parser.y
index f39be59..604b003 100644
--- a/src/parser.y
+++ b/src/parser.y
@@ -69,7 +69,7 @@ typedef struct info YYLTYPE;
/* Keywords */
%token KW_MODULE
%token KW_AUTOLOAD
-%token KW_LET KW_IN
+%token KW_LET KW_LET_REC KW_IN
%token KW_STRING
%token KW_REGEXP
%token KW_LENS
@@ -122,6 +122,8 @@ static void augl_error(struct info *locp, struct term **term,
static struct term *make_bind(char *ident, struct term *params,
struct term *exp, struct term *decls,
struct info *locp);
+ static struct term *make_bind_rec(char *ident, struct term *exp,
+ struct term *decls, struct info *locp);
static struct term *make_let(char *ident, struct term *params,
struct term *exp, struct term *body,
struct info *locp);
@@ -174,6 +176,11 @@ decls: KW_LET LIDENT param_list '=' exp decls
LOC_MERGE(@1, @1, @5);
$$ = make_bind($2, $3, $5, $6, &@1);
}
+ | KW_LET_REC LIDENT '=' exp decls
+ {
+ LOC_MERGE(@1, @1, @4);
+ $$ = make_bind_rec($2, $4, $5, &@1);
+ }
| KW_TEST test_exp '=' exp decls
{
LOC_MERGE(@1, @1, @4);
@@ -404,6 +411,66 @@ static struct term *make_bind(char *ident, struct term *params,
return decls;
}
+static struct term *make_bind_rec(char *ident, struct term *exp,
+ struct term *decls, struct info *locp) {
+ /* Desugar let rec IDENT = EXP as
+ * let IDENT =
+ * let RLENS = (lns_make_rec) in
+ * lns_check_rec ((lambda IDENT: EXP) RLENS) RLENS
+ * where RLENS is a brandnew recursive lens.
+ *
+ * That only works since we know that 'let rec' is only defined for lenses,
+ * not general purposes functions, i.e. we know that IDENT has type 'lens'
+ *
+ * The point of all this is that we make it possible to put a recursive
+ * lens (which is a placeholder for the actual recursion) into arbitrary
+ * places in some bigger lens and then have LNS_CHECK_REC rattle through
+ * to do the special-purpose typechecking.
+ */
+ char *id;
+ struct info *info = exp->info;
+ struct term *lambda = NULL, *rlens = NULL;
+ struct term *app1 = NULL, *app2 = NULL, *app3 = NULL;
+
+ id = strdup(ident);
+ if (id == NULL) goto error;
+
+ lambda = make_param(id, make_base_type(T_LENS), ref(info));
+ if (lambda == NULL) goto error;
+ id = NULL;
+
+ build_func(lambda, exp);
+
+ rlens = make_term(A_VALUE, ref(exp->info));
+ if (rlens == NULL) goto error;
+ rlens->value = lns_make_rec(ref(exp->info));
+ if (rlens->value == NULL) goto error;
+ rlens->type = make_base_type(T_LENS);
+
+ app1 = make_app_term(lambda, rlens, ref(info));
+ if (app1 == NULL) goto error;
+
+ id = strdup(LNS_CHECK_REC_NAME);
+ if (id == NULL) goto error;
+ app2 = make_app_ident(id, app1, ref(info));
+ if (app2 == NULL) goto error;
+ id = NULL;
+
+ app3 = make_app_term(app2, ref(rlens), ref(info));
+ if (app3 == NULL) goto error;
+
+ return make_bind(ident, NULL, app3, decls, locp);
+
+ error:
+ free(id);
+ unref(lambda, term);
+ unref(rlens, term);
+ unref(app1, term);
+ unref(app2, term);
+ unref(app3, term);
+ return NULL;
+}
+
static struct term *make_let(char *ident, struct term *params,
struct term *exp, struct term *body,
struct info *locp) {
diff --git a/src/syntax.c b/src/syntax.c
index 9f3e2a2..0e2f9b7 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -155,7 +155,7 @@ static void free_param(struct param *param) {
free(param);
}
-static void free_term(struct term *term) {
+void free_term(struct term *term) {
if (term == NULL)
return;
assert(term->ref == 0);
diff --git a/src/syntax.h b/src/syntax.h
index 067eba8..de5806a 100644
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -225,6 +225,7 @@ void free_type(struct type *type);
* arguments without incrementing. Caller owns returned objects.
*/
struct term *make_term(enum term_tag tag, struct info *info);
+void free_term(struct term *term);
struct term *make_param(char *name, struct type *type, struct info *info);
struct value *make_value(enum value_tag tag, struct info *info);
struct term *make_app_term(struct term *func, struct term *arg,
@@ -275,6 +276,9 @@ struct module *builtin_init(struct error *);
int load_module_file(struct augeas *aug, const char *filename);
+/* The name of the builtin function that checks recursive lenses */
+#define LNS_CHECK_REC_NAME "lns_check_rec"
+
int interpreter_init(struct augeas *aug);
struct lens *lens_lookup(struct augeas *aug, const char *qname);
More information about the augeas-devel
mailing list