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

[augeas-devel] [PATCH] Generic square lens



Lens square now takes lenses instead of regular expressions as arguments, as follow:

  square left body right

The left and right lenses must accept the same language. The left lens can be
either key or del, while the right lens must be del.

This patch changes the semantic of the square lens and is thus not backward
compatible. Modules must be updated accordingly. The definition of the square
lens should now be definitive, and later addition may add support for
additionnal lenses for left and right sides.

  * builtin.c: change definition of the square lens.
  * get.c: adding two pointers to left and right strings to the state in order
    to verify that those values are matching. Key and del lenses leave values
    there if they are part of a square. A flag is added to the lens in order to
    know whether or not the lens is part if a square lens.
  * put.c: the variable state->override is used to indicate to a del part of a
    square lens that it should use the provided value instead of the saved
    string in the skel or the default value.
  * lens.c: change the lns_make_square to match the new structure. The left and
    right lenses must be copied to make sure the flag in_square do not
    apply to other references of the lens.
  * info.c: dump details of error if available.
  * Update httpd.aug and xml.aug witht the new square lens definition.
  * Update unit tests according to the new definition.

Signed-off-by: Francis Giraldeau <francis giraldeau gmail com>
---
 lenses/httpd.aug                              |    6 +-
 lenses/xml.aug                                |    8 +-
 src/builtin.c                                 |   13 +-
 src/get.c                                     |  193 +++++++++++++++++--------
 src/info.c                                    |    2 +
 src/info.h                                    |    1 +
 src/lens.c                                    |  141 +++++++++++++++---
 src/lens.h                                    |   15 +-
 src/put.c                                     |   72 +++++++--
 tests/modules/fail_square_consistency.aug     |    6 +
 tests/modules/fail_square_consistency_del.aug |    6 +
 tests/modules/fail_square_dup_key.aug         |    6 +
 tests/modules/fail_square_lens_type.aug       |    6 +
 tests/modules/pass_square.aug                 |  111 +++++---------
 tests/modules/pass_square_rec.aug             |  139 ++++++++++++++++++
 15 files changed, 545 insertions(+), 180 deletions(-)
 create mode 100644 tests/modules/fail_square_consistency.aug
 create mode 100644 tests/modules/fail_square_consistency_del.aug
 create mode 100644 tests/modules/fail_square_dup_key.aug
 create mode 100644 tests/modules/fail_square_lens_type.aug
 create mode 100644 tests/modules/pass_square_rec.aug

diff --git a/lenses/httpd.aug b/lenses/httpd.aug
index 49456a1..caea9b6 100644
--- a/lenses/httpd.aug
+++ b/lenses/httpd.aug
@@ -77,9 +77,11 @@ let directive = [ indent . label "directive" . store word .
                   (sep_spc . argv arg_dir)? . eol ]
 
 let section (body:lens) =
-    let h = (sep_spc . argv arg_sec)? . sep_osp .
+    let inner = (sep_spc . argv arg_sec)? . sep_osp .
              dels ">" . eol . body* . indent . dels "</" in
-        [ indent . dels "<" . square word h . del ">" ">" . eol ]
+    let kword = key word in
+    let dword = del word "a" in
+        [ indent . dels "<" . square kword inner dword . del ">" ">" . eol ]
 
 let rec content = section (content|directive|comment|empty)
 
diff --git a/lenses/xml.aug b/lenses/xml.aug
index 6bcbb54..50b1712 100644
--- a/lenses/xml.aug
+++ b/lenses/xml.aug
@@ -109,11 +109,15 @@ let text      = [ label "#text" . store text_re ]
 let cdata     = [ label "#CDATA" . dels "<![CDATA[" .
                   store (char* - (char* . "]]>" . char*)) . dels "]]>" ]
 
+(* the value of nmtoken_del is always the nmtoken_key string *)
+let nmtoken_key = key nmtoken
+let nmtoken_del = del nmtoken "a"
+
 let element (body:lens) =
     let h = attributes? . sep_osp . dels ">" . body* . dels "</" in
-        [ dels "<" . square nmtoken h . sep_osp . del_end ]
+        [ dels "<" . square nmtoken_key h nmtoken_del . sep_osp . del_end ]
 
-let empty_element = [ dels "<" . key nmtoken . value "#empty" .
+let empty_element = [ dels "<" . nmtoken_key . value "#empty" .
                       attributes? . sep_osp . del /\/>[\r?\n]?/ "/>\n" ]
 
 let pi_instruction = [ dels "<?" . label "#pi" .
diff --git a/src/builtin.c b/src/builtin.c
index 792549e..a78ef29 100644
--- a/src/builtin.c
+++ b/src/builtin.c
@@ -87,13 +87,14 @@ static struct value *lns_counter(struct info *info, struct value *str) {
 }
 
 /* V_REGEXP -> V_LENS -> V_LENS */
-static struct value *lns_square(struct info *info, struct value *rxp,
-                                struct value *lns) {
-    assert(rxp->tag == V_REGEXP);
-    assert(lns->tag == V_LENS);
+static struct value *lns_square(struct info *info, struct value *l1,
+                                struct value *l2, struct value *l3) {
+    assert(l1->tag == V_LENS);
+    assert(l2->tag == V_LENS);
+    assert(l3->tag == V_LENS);
     int check = info->error->aug->flags & AUG_TYPE_CHECK;
 
-    return lns_make_square(ref(info), ref(rxp->regexp), ref(lns->lens), check);
+    return lns_make_square(ref(info), ref(l1->lens), ref(l2->lens), ref(l3->lens), check);
 }
 
 static struct value *make_exn_lns_error(struct info *info,
@@ -589,7 +590,7 @@ struct module *builtin_init(struct error *error) {
     DEFINE_NATIVE(modl, "label",   1, lns_label, T_STRING, T_LENS);
     DEFINE_NATIVE(modl, "seq",     1, lns_seq, T_STRING, T_LENS);
     DEFINE_NATIVE(modl, "counter", 1, lns_counter, T_STRING, T_LENS);
-    DEFINE_NATIVE(modl, "square",  2, lns_square, T_REGEXP, T_LENS, T_LENS);
+    DEFINE_NATIVE(modl, "square",  3, lns_square, T_LENS, T_LENS, T_LENS, T_LENS);
     /* Applying lenses (mostly for tests) */
     DEFINE_NATIVE(modl, "get",     2, lens_get, T_LENS, T_STRING, T_TREE);
     DEFINE_NATIVE(modl, "put",     3, lens_put, T_LENS, T_TREE, T_STRING,
diff --git a/src/get.c b/src/get.c
index c1e206c..b8e5195 100644
--- a/src/get.c
+++ b/src/get.c
@@ -50,7 +50,8 @@ struct state {
     struct seq       *seqs;
     char             *key;
     char             *value;     /* GET_STORE leaves a value here */
-    char             *square;    /* last L_DEL from L_SQUARE */
+    char             *square_left;
+    char             *square_right;
     struct lns_error *error;
     /* We use the registers from a regular expression match to keep track
      * of the substring we are currently looking at. REGS are the registers
@@ -73,8 +74,9 @@ struct state {
 struct frame {
     struct lens     *lens;
     char            *key;
-    char            *square;
     struct span     *span;
+    char            *square_left;
+    char            *square_right;
     union {
         struct { /* MGET */
             char        *value;
@@ -160,14 +162,12 @@ static struct skel *make_skel(struct lens *lens) {
 void free_skel(struct skel *skel) {
     if (skel == NULL)
         return;
-    if (skel->tag == L_CONCAT || skel->tag == L_STAR || skel->tag == L_MAYBE ||
-        skel->tag == L_SQUARE) {
-        while (skel->skels != NULL) {
-            struct skel *del = skel->skels;
-            skel->skels = del->next;
-            free_skel(del);
-        }
-    } else if (skel->tag == L_DEL) {
+    while (skel->skels != NULL) {
+        struct skel *del = skel->skels;
+        skel->skels = del->next;
+        free_skel(del);
+    }
+    if (skel->text != NULL) {
         free(skel->text);
     }
     free(skel);
@@ -393,9 +393,6 @@ static struct tree *get_del(struct lens *lens, struct state *state) {
         get_error(state, lens, "no match for del /%s/", pat);
         free(pat);
     }
-    if (lens->string == NULL) {
-        state->square = token(state);
-    }
     update_span(state->span, REG_START(state), REG_END(state));
     return NULL;
 }
@@ -723,28 +720,83 @@ static struct skel *parse_subtree(struct lens *lens, struct state *state,
     return make_skel(lens);
 }
 
+static int square_match(struct lens *lens, char *left, char *right) {
+    int cmp = 0;
+    struct lens *concat = NULL;
+
+    concat = lens->child;
+    if (left == NULL || right == NULL)
+        return cmp;
+    /*
+     * If either right or left lens is nocase, then ignore case when checking
+     * if both are matching
+     */
+    if (lens_child_first(concat)->ctype->nocase ||
+            lens_child_last(concat)->ctype->nocase) {
+        cmp = STRCASEEQ(left, right);
+    } else {
+        cmp = STREQ(left, right);
+    }
+    return cmp;
+}
+
+/*
+ * This function applies only for non-recursive lens, handling of recursive
+ * square is done in visit_exit().
+ */
 static struct tree *get_square(struct lens *lens, struct state *state) {
     ensure0(lens->tag == L_SQUARE, state->info);
 
+    char *sqr1 = NULL, *sqr2 = NULL;
+    struct lens *concat = lens->child;
     struct tree *tree = NULL;
-    char *key = NULL, *square = NULL;
+    uint old_nreg = state->nreg;
 
-    // get the child lens
-    tree = get_concat(lens->child, state);
+    /*
+     * When processing the first and last lens, keep the string to verify
+     * they match. Save sqr1 and sqr2 on the stack to support nested squares.
+     */
+    sqr1 = state->square_left;
+    sqr2 = state->square_right;
+    state->square_left = NULL;
+    state->square_left = NULL;
 
-    key = state->key;
-    square = state->square;
-    ensure0(key != NULL, state->info);
-    ensure0(square != NULL, state->info);
+    state->nreg += 1;
+    for (int i=0; i < concat->nchildren; i++) {
+        struct tree *t = NULL;
+        struct lens *curr = concat->children[i];
+        if (! REG_VALID(state)) {
+            get_error(state, curr,
+                      "Not enough components in square");
+            goto error;
+        }
+        t = get_lens(curr, state);
+        list_append(tree, t);
+        state->nreg += 1 + regexp_nsub(curr->ctype);
+    }
 
-    if (STRCASENEQ(key, square)) {
+    if (!square_match(lens, state->square_left, state->square_right)) {
         get_error(state, lens, "%s \"%s\" %s \"%s\"",
-                "Parse error: mismatched key in square lens, expecting", key,
-                "but got", square);
+            "Parse error: mismatched in square lens, expecting", state->square_left,
+            "but got", state->square_right);
+        goto error;
     }
 
-    FREE(state->square);
+
+ done:
+    state->nreg = old_nreg;
+    if (state->square_left != NULL)
+        FREE(state->square_left);
+    if (state->square_right != NULL)
+        FREE(state->square_right);
+    state->square_left = sqr1;
+    state->square_right = sqr2;
     return tree;
+
+ error:
+    free_tree(tree);
+    tree = NULL;
+    goto done;
 }
 
 static struct skel *parse_square(struct lens *lens, struct state *state,
@@ -753,6 +805,8 @@ static struct skel *parse_square(struct lens *lens, struct state *state,
     struct skel *skel, *sk;
 
     skel = parse_concat(lens->child, state, dict);
+    if (skel == NULL)
+        return NULL;
     sk = make_skel(lens);
     sk->skels = skel;
 
@@ -768,7 +822,7 @@ static void print_frames(struct rec_state *state) {
     for (int j = state->fused - 1; j >=0; j--) {
         struct frame *f = state->frames + j;
         for (int i=0; i < state->lvl; i++) fputc(' ', stderr);
-        fprintf(stderr, "%2d %s %s %s", j, f->key, f->value, f->square);
+        fprintf(stderr, "%2d %s %s %s %s", j, f->key, f->value, f->square_left, f->square_right);
         if (f->tree == NULL) {
             fprintf(stderr, " - ");
         } else {
@@ -837,10 +891,12 @@ static void get_terminal(struct frame *top, struct lens *lens,
     top->tree = get_lens(lens, state);
     top->key = state->key;
     top->value = state->value;
-    top->square = state->square;
+    top->square_left = state->square_left;
+    top->square_right = state->square_right;
     state->key = NULL;
     state->value = NULL;
-    state->square = NULL;
+    state->square_left = NULL;
+    state->square_right = NULL;
 }
 
 static void parse_terminal(struct frame *top, struct lens *lens,
@@ -906,12 +962,24 @@ static void visit_enter(struct lens *lens,
     return;
 }
 
+#define combine_assign(src, dst, rec_state)                            \
+    do {                                                               \
+        if (src != NULL) {                                             \
+            ensure(dst == NULL, rec_state->state->info);               \
+            dst = src;                                                 \
+        } \
+    } while (0)
+
 static void get_combine(struct rec_state *rec_state,
                         struct lens *lens, uint n) {
     struct tree *tree = NULL, *tail = NULL;
-    char *key = NULL, *value = NULL, *square = NULL;
+    char *key = NULL, *value = NULL;
+    char *squares[2];
+    int square_id = 0;
     struct frame *top = NULL;
 
+    squares[0] = NULL;
+    squares[1] = NULL;
     if (n > 0)
         top = top_frame(rec_state);
 
@@ -921,24 +989,23 @@ static void get_combine(struct rec_state *rec_state,
         if (tail != NULL)
             while (tail->next != NULL) tail = tail->next;
 
-        if (top->key != NULL) {
-            ensure(key == NULL, rec_state->state->info);
-            key = top->key;
-        }
-        if (top->value != NULL) {
-            ensure(value == NULL, rec_state->state->info);
-            value = top->value;
+        combine_assign(top->key, key, rec_state);
+        combine_assign(top->value, value, rec_state);
+        if (top->square_left != NULL) {
+            ensure(square_id < 2, rec_state->state->info);
+            squares[square_id++] = top->square_left;
         }
-        if (top->square != NULL) {
-            ensure(square == NULL, rec_state->state->info);
-            square = top->square;
+        if (top->square_right != NULL) {
+            ensure(square_id < 2, rec_state->state->info);
+            squares[square_id++] = top->square_right;
         }
     }
     top = push_frame(rec_state, lens);
     top->tree = tree;
     top->key = key;
     top->value = value;
-    top->square = square;
+    top->square_left = squares[0];
+    top->square_right = squares[1];
  error:
     return;
 }
@@ -1055,24 +1122,17 @@ static void visit_exit(struct lens *lens,
             parse_combine(rec_state, lens, n);
     } else if (lens->tag == L_SQUARE) {
         if (rec_state->mode == M_GET) {
-            char *key, *square;
-
-            key = top_frame(rec_state)->key;
-            square = top_frame(rec_state)->square;
-
-            ensure(key != NULL, state->info);
-            ensure(square != NULL, state->info);
-
-            // raise syntax error if they are not equals
-            if (STRCASENEQ(key, square)){
+            struct frame *top = top_frame(rec_state);
+            if (!square_match(lens, top->square_left, top->square_right)) {
                 get_error(state, lens, "%s \"%s\" %s \"%s\"",
-                        "Parse error: mismatched key in square lens, expecting",
-                        key, "but got", square);
-                state->error->pos = end - strlen(square);
+                        "Parse error: mismatched in square lens, expecting", top->square_left,
+                        "but got", top->square_right);
                 goto error;
             }
-
-            FREE(square);
+            if (top->square_left != NULL)
+                FREE(top->square_left);
+            if (top->square_right != NULL)
+                FREE(top->square_right);
             get_combine(rec_state, lens, 1);
         } else {
             parse_combine(rec_state, lens, 1);
@@ -1158,7 +1218,6 @@ static struct frame *rec_process(enum mode_t mode, struct lens *lens,
     for(i = 0; i < rec_state.fused; i++) {
         f = nth_frame(&rec_state, i);
         FREE(f->key);
-        FREE(f->square);
         if (mode == M_GET) {
             FREE(f->value);
             free_tree(f->tree);
@@ -1200,12 +1259,31 @@ static struct skel *parse_rec(struct lens *lens, struct state *state,
     return skel;
 }
 
+/*
+ * L_DEL and L_KEY leaves a value here in the get direction.
+ */
+static void record_square(struct lens *lens, struct state *state) {
+    if (! REG_MATCHED(state))
+        return;
+    if (!lens->in_square)
+        return;
+    if (state->square_left == NULL)
+        state->square_left = token(state);
+    else if (state->square_right == NULL)
+        state->square_right = token(state);
+    else
+        BUG_ON(true, state->info, "Error in record_square");
+ error:
+    return;
+}
+
 static struct tree *get_lens(struct lens *lens, struct state *state) {
     struct tree *tree = NULL;
 
     switch(lens->tag) {
     case L_DEL:
         tree = get_del(lens, state);
+        record_square(lens, state);
         break;
     case L_STORE:
         tree = get_store(lens, state);
@@ -1215,6 +1293,7 @@ static struct tree *get_lens(struct lens *lens, struct state *state) {
         break;
     case L_KEY:
         tree = get_key(lens, state);
+        record_square(lens, state);
         break;
     case L_LABEL:
         tree = get_label(lens, state);
@@ -1318,10 +1397,6 @@ struct tree *lns_get(struct info *info, struct lens *lens, const char *text,
         get_error(&state, lens, "get left unused value %s", state.value);
         free(state.value);
     }
-    if (state.square != NULL) {
-        get_error(&state, lens, "get left unused square %s", state.square);
-        free(state.square);
-    }
     if (partial && state.error == NULL) {
         get_error(&state, lens, "Get did not match entire input");
     }
diff --git a/src/info.c b/src/info.c
index fc5a17d..1095967 100644
--- a/src/info.c
+++ b/src/info.c
@@ -104,6 +104,8 @@ void print_info(FILE *out, struct info *info) {
                     info->last_line, info->last_column);
         }
     }
+    if (info->error != NULL && info->error->details != NULL)
+        fprintf(out, "\n%s\n", info->error->details);
 }
 
 void free_info(struct info *info) {
diff --git a/src/info.h b/src/info.h
index 1f38cdc..a08c15c 100644
--- a/src/info.h
+++ b/src/info.h
@@ -26,6 +26,7 @@
 #include <stdio.h>
 #include <stdint.h>
 #include <stdlib.h>
+#include "errcode.h"
 #include "ref.h"
 
 /* Reference-counted strings */
diff --git a/src/lens.c b/src/lens.c
index 0134996..728f788 100644
--- a/src/lens.c
+++ b/src/lens.c
@@ -50,6 +50,8 @@ static struct value * typecheck_union(struct info *,
                                       struct lens *l1, struct lens *l2);
 static struct value *typecheck_concat(struct info *,
                                       struct lens *l1, struct lens *l2);
+static struct value *typecheck_square(struct info *,
+                                      struct lens *l1, struct lens *l2);
 static struct value *typecheck_iter(struct info *info, struct lens *l);
 static struct value *typecheck_maybe(struct info *info, struct lens *l);
 
@@ -398,35 +400,51 @@ struct value *lns_make_maybe(struct info *info, struct lens *l, int check) {
     return make_lens_value(lens);
 }
 
+struct lens *lns_copy_prim(struct lens *lens, struct info *info) {
+    struct lens *ret = NULL;
+    struct value *val = NULL;
+
+    val = lns_make_prim(lens->tag, ref(info), ref(lens->regexp),
+            ref(lens->string));
+    ERR_NOMEM(val == NULL, info);
+    ret = ref(val->lens);
+    unref(val, value);
+ error:
+    return ret;
+}
+
 /* Build a square lens as
  *   key REG . lns . del REG MATCHED
  * where MATCHED is whatever the key lens matched (the inability to express
  * this with other lenses makes the square primitve necessary
  */
-struct value *lns_make_square(struct info *info,
-                              struct regexp *reg,
-                              struct lens *lns, int check) {
-    struct value *key = NULL, *del = NULL;
+struct value *lns_make_square(struct info *info, struct lens *l1,
+                              struct lens *l2, struct lens *l3, int check) {
+
     struct value *cnt1 = NULL, *cnt2 = NULL, *res = NULL;
-    struct lens *sqr = NULL;
+    struct lens *sqr = NULL, *l1_copy = NULL, *l3_copy = NULL;
+    struct value *val = NULL;
 
-    res = lns_make_prim(L_KEY, ref(info), ref(reg), NULL);
-    if (EXN(res))
-        goto error;
-    key = res;
+    /* supported types: L_KEY . body . L_DEL or L_DEL . body . L_DEL */
+    if (l3->tag != L_DEL || (l1->tag != L_DEL && l1->tag != L_KEY))
+        return make_exn_value(info, "Supported types: (key lns del) or (del lns del)");
 
-    res = lns_make_prim(L_DEL, ref(info), ref(reg), NULL);
-    if (EXN(res))
+    /* deepcopy l1 and l3 */
+    l1_copy = lns_copy_prim(l1, info);
+    ERR_NOMEM(l1_copy == NULL, info);
+    l3_copy = lns_copy_prim(l3, info);
+    ERR_NOMEM(l3_copy == NULL, info);
+
+    res = typecheck_square(info, l1, l3);
+    if (res != NULL)
         goto error;
-    del = res;
 
-    // typechecking is handled when concatenating lenses
-    res = lns_make_concat(ref(info), ref(key->lens), ref(lns), check);
+    /* do not increase ref of copies */
+    res = lns_make_concat(ref(info), l1_copy, ref(l2), check);
     if (EXN(res))
         goto error;
     cnt1 = res;
-
-    res = lns_make_concat(ref(info), ref(cnt1->lens), ref(del->lens), check);
+    res = lns_make_concat(ref(info), ref(cnt1->lens), l3_copy, check);
     if (EXN(res))
         goto error;
     cnt2 = res;
@@ -439,22 +457,30 @@ struct value *lns_make_square(struct info *info,
     sqr->recursive = cnt2->lens->recursive;
     sqr->rec_internal = cnt2->lens->rec_internal;
     sqr->consumes_value = cnt2->lens->consumes_value;
+    /* flag first and last child of concat to be under square lens
+     * Used to check if the string matched by these lenses are equals */
+    lens_child_first(sqr->child)->in_square = 1;
+    lens_child_last(sqr->child)->in_square = 1;
 
     res = make_lens_value(sqr);
     ERR_NOMEM(res == NULL, info);
     sqr = NULL;
 
- error:
+ done:
     unref(info, info);
-    unref(reg, regexp);
-    unref(lns, lens);
+    unref(l1, lens);
+    unref(l2, lens);
+    unref(l3, lens);
 
-    unref(key, value);
-    unref(del, value);
     unref(cnt1, value);
     unref(cnt2, value);
     unref(sqr, lens);
     return res;
+
+ error:
+    unref(l1_copy, lens);
+    unref(l3_copy, lens);
+    goto done;
 }
 
 /*
@@ -788,6 +814,73 @@ static struct value *typecheck_concat(struct info *info,
     return result;
 }
 
+static struct value *make_exn_square(struct info *info,
+        struct lens *l1, struct lens *l2, const char *msg) {
+
+    struct value *exn = make_exn_value(ref(info), "%s", "Inconsistency in lens square");
+    exn_printf_line(exn, "%s", msg);
+    char *fi = format_info(l1->info);
+    exn_printf_line(exn, "Left lens: %s", fi);
+    free(fi);
+    fi = format_info(l2->info);
+    exn_printf_line(exn, "Right lens: %s", fi);
+    free(fi);
+    return exn;
+}
+
+/* FIXME: avoid code duplication */
+static struct value *typecheck_square(struct info *info,
+        struct lens *l1, struct lens *l2) {
+    int r;
+    struct value *exn = NULL;
+    struct fa *fa1 = NULL, *fa2 = NULL;
+    struct regexp *r1 = ltype(l1, CTYPE);
+    struct regexp *r2 = ltype(l2, CTYPE);
+
+    if (r1 == NULL || r2 == NULL)
+        return NULL;
+
+    exn = regexp_to_fa(r1, &fa1);
+    if (exn != NULL)
+        goto done;
+
+    exn = regexp_to_fa(r2, &fa2);
+    if (exn != NULL)
+        goto done;
+
+    r = fa_equals(fa1, fa2);
+
+    if (r < 0) {
+        exn = make_exn_value(ref(info), "not enough memory");
+        if (exn != NULL) {
+            return exn;
+        } else {
+            ERR_REPORT(info, AUG_ENOMEM, NULL);
+            return info->error->exn;;
+        }
+    }
+
+    if (r == 0) {
+        exn = make_exn_square(info, l1, l2,
+                "Left and right lenses must accept the same language");
+        goto done;
+    }
+
+    /* check del create consistency */
+    if (l1->tag == L_DEL && l2->tag == L_DEL) {
+        if (!STREQ(l1->string->str, l2->string->str)) {
+            exn = make_exn_square(info, l1, l2,
+                    "Left and right lenses must have the same default value");
+            goto done;
+        }
+    }
+
+done:
+   fa_free(fa1);
+   fa_free(fa2);
+   return exn;
+}
+
 static struct value *
 ambig_iter_check(struct info *info, const char *msg,
                  enum lens_type typ, struct lens *l) {
@@ -1536,6 +1629,10 @@ static void rtn_rules(struct rtn *rtn, struct lens *l) {
         rtn_rules(rtn, l->body);
         RTN_BAIL(rtn);
         break;
+    case L_SQUARE:
+        add_trans(rtn, start, prod->end, l->child);
+        RTN_BAIL(rtn);
+        break;
     default:
         BUG_LENS_TAG(l);
         break;
@@ -2196,10 +2293,12 @@ void dump_lens(FILE *out, struct lens *lens){
         fprintf(out, "\\n");
     }
 
+    fprintf(out, "ref=%x\\n", lens->ref);
     fprintf(out, "recursive=%x\\n", lens->recursive);
     fprintf(out, "rec_internal=%x\\n", lens->rec_internal);
     fprintf(out, "consumes_value=%x\\n", lens->consumes_value);
     fprintf(out, "ctype_nullable=%x\\n", lens->ctype_nullable);
+    fprintf(out, "in_square=%x\\n", lens->in_square);
     fprintf(out, "\"];\n");
     switch(lens->tag){
     case L_DEL:
diff --git a/src/lens.h b/src/lens.h
index 62c2f77..bc5b5ec 100644
--- a/src/lens.h
+++ b/src/lens.h
@@ -82,6 +82,7 @@ struct lens {
     struct jmt               *jmt;    /* When recursive == 1, might have jmt */
     unsigned int              value : 1;
     unsigned int              key : 1;
+    unsigned int              in_square : 1;
     unsigned int              recursive : 1;
     unsigned int              consumes_value : 1;
     /* Whether we are inside a recursive lens or outside */
@@ -90,9 +91,6 @@ struct lens {
     union {
         /* Primitive lenses */
         struct {                   /* L_DEL uses both */
-            /* L_DEL string set to NULL means it belongs to parent L_SQUARE lens
-             * and the put and create copy the current key
-             */
             struct regexp *regexp; /* L_STORE, L_KEY */
             struct string *string; /* L_VALUE, L_LABEL, L_SEQ, L_COUNTER */
         };
@@ -143,8 +141,8 @@ struct value *lns_make_plus(struct info *, struct lens *,
                             int check);
 struct value *lns_make_maybe(struct info *, struct lens *,
                              int check);
-struct value *lns_make_square(struct info *, struct regexp *, struct lens *,
-                              int check);
+struct value *lns_make_square(struct info *, struct lens *, struct lens *,
+                              struct lens *lens, int check);
 
 /* Pretty-print a lens */
 char *format_lens(struct lens *l);
@@ -163,11 +161,10 @@ struct value *lns_check_rec(struct info *info,
 struct skel {
     struct skel *next;
     enum lens_tag tag;
-    union {
+    struct { /* L_SQUARE uses both, L_SUBTREE sets both to NULL */
         char        *text;    /* L_DEL */
         struct skel *skels;   /* L_CONCAT, L_STAR */
     };
-    /* Also tag == L_SUBTREE, with no data in the union */
 };
 
 struct lns_error {
@@ -241,6 +238,10 @@ void free_lens(struct lens *lens);
 #define ENCLEN(s) ((s) == NULL ? strlen(ENC_NULL) : strlen(s))
 #define ENCSTR(s) ((s) == NULL ? ENC_NULL : s)
 
+/* helper to access first and last child */
+#define lens_child_first(l) l->children[0]
+#define lens_child_last(l) l->children[l->nchildren - 1]
+
 /* Format an encoded level as
  *    { key1 = value1 } { key2 = value2 } .. { keyN = valueN }
  */
diff --git a/src/put.c b/src/put.c
index 56732d2..2aea9bf 100644
--- a/src/put.c
+++ b/src/put.c
@@ -59,6 +59,7 @@ struct state {
     struct split     *split;
     const char       *key;
     const char       *value;
+    const char       *override;
     struct dict      *dict;
     struct skel      *skel;
     char             *path;   /* Position in the tree, for errors */
@@ -468,11 +469,10 @@ static void put_del(ATTRIBUTE_UNUSED struct lens *lens, struct state *state) {
     assert(lens->tag == L_DEL);
     assert(state->skel != NULL);
     assert(state->skel->tag == L_DEL);
-    if (lens->string != NULL) {
-    fprintf(state->out, "%s", state->skel->text);
+    if (lens->in_square && state->override != NULL) {
+        fprintf(state->out, "%s", state->override);
     } else {
-    /* L_DEL with NULL string: replicate the current key */
-        fprintf(state->out, "%s", state->key);
+        fprintf(state->out, "%s", state->skel->text);
     }
 }
 
@@ -598,9 +598,33 @@ static void put_rec(struct lens *lens, struct state *state) {
 }
 
 static void put_square(struct lens *lens, struct state *state) {
+    assert(lens->tag == L_SQUARE);
     struct skel *oldskel = state->skel;
-    state->skel = state->skel->skels;
-    put_lens(lens->child, state);
+    struct split *oldsplit = state->split;
+    struct lens *concat = lens->child;
+    struct lens *left = concat->children[0];
+    struct split *split = split_concat(state, concat);
+
+    /* skels of concat is one depth more */
+    state->skel = state->skel->skels->skels;
+    set_split(state, split);
+    for (int i=0; i < concat->nchildren; i++) {
+        if (state->split == NULL) {
+            put_error(state, concat,
+                      "Not enough components in square");
+            list_free(split);
+            return;
+        }
+        struct lens *curr = concat->children[i];
+        if (i == (concat->nchildren - 1) && left->tag == L_KEY)
+            state->override = state->key;
+        put_lens(curr, state);
+        state->override = NULL;
+        state->skel = state->skel->next;
+        next_split(state);
+    }
+    list_free(split);
+    set_split(state, oldsplit);
     state->skel = oldskel;
 }
 
@@ -661,11 +685,10 @@ static void create_subtree(struct lens *lens, struct state *state) {
 
 static void create_del(struct lens *lens, struct state *state) {
     assert(lens->tag == L_DEL);
-    if (lens->string != NULL) {
-        print_escaped_chars(state->out, lens->string->str);
+    if (lens->in_square && state->override != NULL) {
+        print_escaped_chars(state->out, state->override);
     } else {
-        /* L_DEL with NULL string: replicate the current key */
-        print_escaped_chars(state->out, state->key);
+        print_escaped_chars(state->out, lens->string->str);
     }
 
 }
@@ -703,6 +726,33 @@ static void create_concat(struct lens *lens, struct state *state) {
     set_split(state, oldsplit);
 }
 
+static void create_square(struct lens *lens, struct state *state) {
+    assert(lens->tag == L_SQUARE);
+    struct lens *concat = lens->child;
+
+    struct split *oldsplit = state->split;
+    struct split *split = split_concat(state, concat);
+    struct lens *left = concat->children[0];
+
+    set_split(state, split);
+    for (int i=0; i < concat->nchildren; i++) {
+        if (state->split == NULL) {
+            put_error(state, concat,
+                      "Not enough components in square");
+            list_free(split);
+            return;
+        }
+        struct lens *curr = concat->children[i];
+        if (i == (concat->nchildren - 1) && left->tag == L_KEY)
+            state->override = state->key;
+        create_lens(curr, state);
+        state->override = NULL;
+        next_split(state);
+    }
+    list_free(split);
+    set_split(state, oldsplit);
+}
+
 static void create_quant_star(struct lens *lens, struct state *state) {
     assert(lens->tag == L_STAR);
     struct split *oldsplit = state->split;
@@ -777,7 +827,7 @@ static void create_lens(struct lens *lens, struct state *state) {
         create_rec(lens, state);
         break;
     case L_SQUARE:
-        create_concat(lens->child, state);
+        create_square(lens, state);
         break;
     default:
         assert(0);
diff --git a/tests/modules/fail_square_consistency.aug b/tests/modules/fail_square_consistency.aug
new file mode 100644
index 0000000..b1cc3db
--- /dev/null
+++ b/tests/modules/fail_square_consistency.aug
@@ -0,0 +1,6 @@
+module Fail_square_consistency =
+
+let left = key "a"
+let right = del "b" "b"
+let body = del "x" "x"
+let s = square left body right
diff --git a/tests/modules/fail_square_consistency_del.aug b/tests/modules/fail_square_consistency_del.aug
new file mode 100644
index 0000000..bff74e8
--- /dev/null
+++ b/tests/modules/fail_square_consistency_del.aug
@@ -0,0 +1,6 @@
+module Fail_square_consistency_del =
+
+let left = del /[ab]/ "a"
+let right = del /[ab]/ "b"
+let body = del "x" "x"
+let s = square left body right
diff --git a/tests/modules/fail_square_dup_key.aug b/tests/modules/fail_square_dup_key.aug
new file mode 100644
index 0000000..0e540da
--- /dev/null
+++ b/tests/modules/fail_square_dup_key.aug
@@ -0,0 +1,6 @@
+module Fail_square_dup_key =
+
+let left = key "a"
+let right = del "a" "a"
+let body = key "a"
+let s = square left body right
diff --git a/tests/modules/fail_square_lens_type.aug b/tests/modules/fail_square_lens_type.aug
new file mode 100644
index 0000000..f1099e3
--- /dev/null
+++ b/tests/modules/fail_square_lens_type.aug
@@ -0,0 +1,6 @@
+module Fail_square_lens_type =
+
+let left = [ key "a" ]
+let right = [ key "a" ]
+let body = del "x" "x"
+let s = square left body right
diff --git a/tests/modules/pass_square.aug b/tests/modules/pass_square.aug
index f41761d..fff56e9 100644
--- a/tests/modules/pass_square.aug
+++ b/tests/modules/pass_square.aug
@@ -8,17 +8,24 @@ let dels (s:string) = del s s
  *************************************************************************)
 
 (* Simplest square lens *)
-let s = store /[yz]/
-let sqr0 = [ square "x" s ] *
-test sqr0 get "xyxxyxxyx" = { "x" = "y" }{ "x" = "y" }{ "x" = "y" }
-test sqr0 put "xyx" after set "/x[3]" "z" = "xyxxzx"
+let s = store /[ab]/
+let sqr0 =
+	let k = key "x" in
+	let d = dels "x" in
+	[ square k s d ] *
+test sqr0 get "xaxxbxxax" = { "x" = "a" }{ "x" = "b" }{ "x" = "a" }
+test sqr0 put "xax" after set "/x[3]" "b" = "xaxxbx"
 
 (* test mismatch tag *)
 test sqr0 get "xya" = *
 
 (* Test regular expression matching with multiple groups *)
 let body = del /([f]+)([f]+)/ "ff" . del /([g]+)([g]+)/ "gg"
-let sqr1 = [ square /([a-b]*)([a-b]*)([a-b]*)/ body . del /([x]+)([x]+)/ "xx" ] *
+let sqr1 =
+	let k = key /([a-b]*)([a-b]*)([a-b]*)/ in
+	let d1 = del /([a-b]*)([a-b]*)([a-b]*)/ "a" in
+	let d2 = del /([x]+)([x]+)/ "xx" in
+	[ square k body d1 . d2 ] *
 
 test sqr1 get "aaffggaaxxbbffggbbxx" = { "aa" }{ "bb" }
 test sqr1 get "affggaxx" = { "a" }
@@ -26,10 +33,12 @@ test sqr1 put "affggaxx" after clear "/b" = "affggaxxbffggbxx"
 
 (* Test XML like elements up to depth 2 *)
 let b = del ">" ">" . del /[a-z ]*/ "" . del "</" "</"
-let xml = [ del "<" "<" . square /[a-z]+/ b . del ">" ">" ] *
+let open_tag = key /[a-z]+/
+let close_tag = del /[a-z]+/ "a"
+let xml = [ del "<" "<" . square open_tag b close_tag . del ">" ">" ] *
 
 let b2 = del ">" ">" . xml . del "</" "</"
-let xml2 = [ del "<" "<" . square /[a-z]+/ b2 . del ">" ">" ] *
+let xml2 = [ del "<" "<" . square open_tag b2 close_tag . del ">" ">" ] *
 
 test xml get "<a></a><b></b>" = { "a" }{ "b" }
 
@@ -49,72 +58,30 @@ test xml2 put "<a></a>" after clear "/x/y" = "<a></a><x><y></y></x>"
 (* test nested put of depth 3 : should fail *)
 test xml2 put "<a></a>" after clear "/x/y/z" = *
 
-(************************************************************************
- *                        Recursive square lens
- *************************************************************************)
-
-(* Basic element *)
-let xml_element (body:lens) =
-    let g = del ">" ">" . body . del "</" "</" in
-        [ del "<" "<" . square /[a-z]+/ g . del ">" ">" ] *
-
-let rec xml_rec = xml_element xml_rec
-
-test xml_rec get "<a><b><c><d><e></e></d></c></b></a>" =
-  { "a"
-    { "b"
-      { "c"
-        { "d"
-          { "e" }
-        }
-      }
-    }
-  }
-
-test xml_rec get "<a><b></b><c></c><d></d><e></e></a>" =
-  { "a"
-    { "b" }
-    { "c" }
-    { "d" }
-    { "e" }
-  }
-
-test xml_rec put "<a></a><b><c></c></b>" after clear "/x/y/z" = "<a></a><b><c></c></b><x><y><z></z></y></x>"
-
-(* mismatch tag *)
-test xml_rec get "<a></c>" = *
-test xml_rec get "<a><b></b></c>" = *
-test xml_rec get "<a><b></c></a>" = *
-
-(* test ctype_nullable and typecheck *)
-let rec z = [ square "ab" z? ]
-test z get "abab" = { "ab" }
-
-(* test tip handling when using store inside body *)
-let c (body:lens) =
-    let sto = store "c" . body* in
-        [ square "ab" sto ]
-
-let rec cc = c cc
-
-test cc get "abcabcabab" =
-  { "ab" = "c"
-    { "ab" = "c" }
-  }
-
-(* test correct put behavior *)
-let input3 = "aaxyxbbaaaxyxbb"
-let b3 = dels "y"
-let sqr3 = [ del /[a]*/ "a" . square /[x]/ b3 . del /[b]*/ "b" ]*
-test sqr3 get input3 = { "x" }{ "x" }
-test sqr3 put input3 after clear "/x[1]" = input3
-
-let b4 = del "x" "x"
-let rec sqr4 = [ del /[a]+/ "a" . square /[b]|[c]/ (b4|sqr4) ]
-test sqr4 put "aabaaacxcb" after rm "x" = "aabaaacxcb"
-
 (* matches can be case-insensitive *)
 let s5 = store /[yz]/
-let sqr5 = [ square /x/i s ] *
+let sqr5 =
+	let k = key /x/i in
+	let d = del /x/i "x" in
+	[ square k s5 d ] *
+test sqr5 get "xyX" = { "x" = "y" }
 test sqr5 get "xyXXyxXyx" = { "x" = "y" }{ "X" = "y" }{ "X" = "y" }
 test sqr5 put "xyX" after set "/x[3]" "z" = "xyxxzx"
+
+(* test concat multiple squares *)
+let rex = /[a-z]/
+let csqr =
+	let k = key rex in
+	let d = del rex "a" in
+	let e = dels "" in
+	[ square k e d . square d e d ] *
+
+test csqr get "aabbccdd" = { "a" } { "c" }
+test csqr put "aabb" after insa "z" "/a" = "aabbzzaa"
+
+(* test default square create values *)
+let create_square =
+	let d = dels "a" in
+	[ key "x" . square d d d ]*
+
+test create_square put "" after clear "/x" = "xaaa"
diff --git a/tests/modules/pass_square_rec.aug b/tests/modules/pass_square_rec.aug
new file mode 100644
index 0000000..a8711f6
--- /dev/null
+++ b/tests/modules/pass_square_rec.aug
@@ -0,0 +1,139 @@
+module Pass_square_rec =
+
+(*  Utilities lens *)
+let dels (s:string) = del s s
+
+(************************************************************************
+ *                        Recursive square lens
+ *************************************************************************)
+(* test square with left and right as dels *) 
+let lr (body:lens) =
+    let k = key "c" . body* in
+    let d = dels "ab" in
+        [ square d k d ]
+
+let rec lr2 = lr lr2
+
+test lr2 get "abcabcabab" =
+  { "c"
+    { "c" }
+  }
+
+let open_tag = key /[a-z]+/
+let close_tag = del /[a-z]+/ "a"
+
+(* Basic element *)
+let xml_element (body:lens) =
+    let g = del ">" ">" . body . del "</" "</" in
+        [ del "<" "<" . square open_tag g close_tag . del ">" ">" ] *
+
+let rec xml_rec = xml_element xml_rec
+
+test xml_rec get "<a><b><c><d><e></e></d></c></b></a>" =
+  { "a"
+    { "b"
+      { "c"
+        { "d"
+          { "e" }
+        }
+      }
+    }
+  }
+
+test xml_rec get "<a><b></b><c></c><d></d><e></e></a>" =
+  { "a"
+    { "b" }
+    { "c" }
+    { "d" }
+    { "e" }
+  }
+
+test xml_rec put "<a></a><b><c></c></b>" after clear "/x/y/z" = "<a></a><b><c></c></b><x><y><z></z></y></x>"
+
+(* mismatch tag *)
+test xml_rec get "<a></c>" = *
+test xml_rec get "<a><b></b></c>" = *
+test xml_rec get "<a><b></c></a>" = *
+
+
+(* test ctype_nullable and typecheck *)
+let rec z =
+	let k = key "ab" in
+	let d = dels "ab" in
+	[ square k z? d ]
+test z get "abab" = { "ab" }
+
+(* test tip handling when using store inside body *)
+let c (body:lens) =
+    let sto = store "c" . body* in
+    let d = dels "ab" in
+    let k = key "ab" in
+        [ square k sto d ]
+
+let rec cc = c cc
+
+test cc get "abcabcabab" =
+  { "ab" = "c"
+    { "ab" = "c" }
+  }
+
+(* test mixing regular and recursive lenses *)
+
+let reg1 = 
+	let k = key "y" in
+	let d = dels "y" in
+	let e = dels "" in
+	[ square k e d ]
+
+let reg2 = 
+	let k = key "y" in
+	let d = dels "y" in
+	[ square k reg1 d ]
+	
+let rec rec2 = 
+	let d1 = dels "x" in
+	let k1 = key "x" in
+	let body = reg2 | rec2 in
+	[ square k1 body d1 ]?
+
+test rec2 get "xyyyyx" = 
+  { "x"
+    { "y"
+      { "y" }
+    }
+  }
+
+test rec2 put "" after clear "/x/y/y" = "xyyyyx"
+
+(* test correct put behavior *)
+let input3 = "aaxyxbbaaaxyxbb"
+let b3 = dels "y"
+let sqr3 =
+	let k = key /[x]/ in
+	let d = dels "x" in
+	[ del /[a]*/ "a" . square k b3 d . del /[b]*/ "b" ]*
+test sqr3 get input3 = { "x" }{ "x" }
+test sqr3 put input3 after clear "/x[1]" = input3
+
+let b4 = dels "x"
+let rec sqr4 = 
+	let k = key /[b]|[c]/ in
+	let d = del /[b]|[c]/ "b" in
+	[ del /[a]+/ "a" . square k (b4|sqr4) d ]
+test sqr4 put "aabaaacxcb" after rm "x" = "aabaaacxcb"
+
+(* test concat multiple squares *)
+let rex = /[a-z]/
+let rec csqr =
+	let k = key rex in
+	let d = del rex "a" in
+	let e = dels "" in
+	[ square k e d . csqr* . square d e d ] 
+
+test csqr get "aabbccdd" = 
+  { "a"
+    { "b" }
+  }
+
+test csqr put "aabbccdd" after clear "/a" = "aabbccdd"
+test csqr put "aabb" after clear "/a/z" = "aazzaabb"
-- 
1.7.9.5


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