[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]

[augeas-devel] augeas: master - Syntax for recursive lenses



Gitweb:        http://git.fedorahosted.org/git/augeas.git?p=augeas.git;a=commitdiff;h=9b44eb7452d95bab287d6be69240d611dfbe833c
Commit:        9b44eb7452d95bab287d6be69240d611dfbe833c
Parent:        d83582a24aeaa344bc383d1a4c4247b0fc3f9c84
Author:        David Lutterkort <lutter redhat com>
AuthorDate:    Fri Dec 18 15:44:50 2009 -0800
Committer:     David Lutterkort <lutter 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);



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]