From 9d0b8e811a53c6151be329734e47e4da89e23183 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Mon, 4 May 2020 02:45:34 +0300 Subject: [PATCH] Cosmetics; probably a fix for regexps --- runtime/runtime.c | 102 ++++++++++++++++++++++------------------- src/Language.ml | 2 +- src/version.ml | 2 +- stdlib/Collection.lama | 5 +- stdlib/Matcher.lama | 2 +- stdlib/Ostap.lama | 13 +++++- 6 files changed, 72 insertions(+), 54 deletions(-) diff --git a/runtime/runtime.c b/runtime/runtime.c index a10acd1b9..1a9006f07 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -556,17 +556,11 @@ extern void* Lsubstring (void *subj, int p, int l) { extern struct re_pattern_buffer *Lregexp (char *regexp) { regex_t *b = (regex_t*) malloc (sizeof (regex_t)); - - b->translate = 0; - b->fastmap = 0; - // A weird workaround: should be 0/0 in theory, - // but is does not work sometimes. The exact number is - // determined experimentally :(( - b->buffer = malloc (256); - b->allocated = 256; + + memset (b, 0, sizeof (regex_t)); int n = (int) re_compile_pattern (regexp, strlen (regexp), b); - + if (n != 0) { failure ("%", strerror (n)); }; @@ -575,11 +569,19 @@ extern struct re_pattern_buffer *Lregexp (char *regexp) { } extern int LregexpMatch (struct re_pattern_buffer *b, char *s, int pos) { + int res; + ASSERT_BOXED("regexpMatch:1", b); ASSERT_STRING("regexpMatch:2", s); ASSERT_UNBOXED("regexpMatch:3", pos); - - return BOX (re_match (b, s, LEN(TO_DATA(s)->tag), UNBOX(pos), 0)); + + res = re_match (b, s, LEN(TO_DATA(s)->tag), UNBOX(pos), 0); + + if (res) { + return BOX (res); + } + + return BOX (res); } extern void* Bstring (void*); @@ -723,62 +725,66 @@ extern int Lhash (void *p) { extern int Lcompare (void *p, void *q) { # define COMPARE_AND_RETURN(x,y) do if (x != y) return BOX(x - y); while (0) - if (q == 0 || p == 0) { - failure ("NULL pointer in Lcompare\n"); - } if (p == q) return BOX(0); - + if (UNBOXED(p)) { if (UNBOXED(q)) return BOX(UNBOX(p) - UNBOX(q)); else return BOX(-1); } else if (UNBOXED(q)) return BOX(1); else { - data *a = TO_DATA(p), *b = TO_DATA(q); - int ta = TAG(a->tag), tb = TAG(b->tag); - int la = LEN(a->tag), lb = LEN(b->tag); - int i; + if (is_valid_heap_pointer (p)) { + if (is_valid_heap_pointer (q)) { + data *a = TO_DATA(p), *b = TO_DATA(q); + int ta = TAG(a->tag), tb = TAG(b->tag); + int la = LEN(a->tag), lb = LEN(b->tag); + int i; - COMPARE_AND_RETURN (ta, tb); + COMPARE_AND_RETURN (ta, tb); - switch (ta) { - case STRING_TAG: - return BOX(strcmp (a->contents, b->contents)); + switch (ta) { + case STRING_TAG: + return BOX(strcmp (a->contents, b->contents)); - case CLOSURE_TAG: - COMPARE_AND_RETURN (((void**) a->contents)[0], ((void**) b->contents)[0]); - COMPARE_AND_RETURN (la, lb); - i = 1; - break; + case CLOSURE_TAG: + COMPARE_AND_RETURN (((void**) a->contents)[0], ((void**) b->contents)[0]); + COMPARE_AND_RETURN (la, lb); + i = 1; + break; - case ARRAY_TAG: - COMPARE_AND_RETURN (la, lb); - i = 0; - break; + case ARRAY_TAG: + COMPARE_AND_RETURN (la, lb); + i = 0; + break; - case SEXP_TAG: { + case SEXP_TAG: { #ifndef DEBUG_PRINT - int ta = TO_SEXP(p)->tag, tb = TO_SEXP(q)->tag; + int ta = TO_SEXP(p)->tag, tb = TO_SEXP(q)->tag; #else - int ta = GET_SEXP_TAG(TO_SEXP(p)->tag), tb = GET_SEXP_TAG(TO_SEXP(q)->tag); + int ta = GET_SEXP_TAG(TO_SEXP(p)->tag), tb = GET_SEXP_TAG(TO_SEXP(q)->tag); #endif - COMPARE_AND_RETURN (ta, tb); - COMPARE_AND_RETURN (la, lb); - i = 0; - break; - } + COMPARE_AND_RETURN (ta, tb); + COMPARE_AND_RETURN (la, lb); + i = 0; + break; + } - default: - failure ("invalid tag %d in compare *****\n", ta); - } + default: + failure ("invalid tag %d in compare *****\n", ta); + } - for (; icontents)[i], ((void**) b->contents)[i]); - if (c != BOX(0)) return BOX(c); - } + for (; icontents)[i], ((void**) b->contents)[i]); + if (c != BOX(0)) return BOX(c); + } - return BOX(0); + return BOX(0); + } + else return BOX(-1); + } + else if (is_valid_heap_pointer (q)) return BOX(1); + else return BOX (p - q); } } diff --git a/src/Language.ml b/src/Language.ml index 969513f82..c8a1c2a47 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -785,7 +785,7 @@ module Expr = | acc -> Call (Var "alt", [s; acc]) ) ss (Var "") }; - syntaxSeq[infix]: ss:syntaxBinding[infix]+ sema:(-"{" parse[infix][Val] -"}")? { + syntaxSeq[infix]: ss:syntaxBinding[infix]+ sema:(-"{" scope[infix][Val] -"}")? { let sema, ss = match sema with | Some s -> s, ss diff --git a/src/version.ml b/src/version.ml index 7f3af1320..3caa2ecaf 100644 --- a/src/version.ml +++ b/src/version.ml @@ -1 +1 @@ -let version = "Version 1.00, 690825f54, Sat Apr 11 21:09:51 2020 +0300" +let version = "Version 1.00, 423e4e772, Wed Apr 15 21:53:42 2020 +0300" diff --git a/stdlib/Collection.lama b/stdlib/Collection.lama index f10f6e55b..a604cec77 100644 --- a/stdlib/Collection.lama +++ b/stdlib/Collection.lama @@ -310,9 +310,10 @@ public fun lookupMemo (m, v) { case v of #string -> m ::= addMap (deref (m), v, v); v | _ -> - local vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac; + local vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac; for skip, i < v.length, i := i + 1 do - vc [i] := lookupMemo (m, vc [i]) + local vci = lookupMemo (m, vc [i]); + vc [i] := vci od; m ::= addMap (deref (m), vc, vc); vc diff --git a/stdlib/Matcher.lama b/stdlib/Matcher.lama index 5086e398b..4ce673f11 100644 --- a/stdlib/Matcher.lama +++ b/stdlib/Matcher.lama @@ -9,7 +9,7 @@ -- reporting public fun createRegexp (r, name) { local l = [regexp (r), name]; - --printf ("Created regexp %s: %x, %x\n", name, l, l[0]); +-- printf ("Created regexp %s: %x, %x\n", name, l, l[0]); l } diff --git a/stdlib/Ostap.lama b/stdlib/Ostap.lama index e7f74b9ae..e3f7fc6c1 100644 --- a/stdlib/Ostap.lama +++ b/stdlib/Ostap.lama @@ -173,6 +173,15 @@ public fun observe (name, f) { } } +public fun showStream (name) { + fun (k) { + fun (s) { + printf ("%s: %s\n", name, showMatcher (s)); + k (Succ ({}, s)) + } + } +} + fun createResult () { local errors = ref ({}), line = ref (0), @@ -182,8 +191,10 @@ fun createResult () { hasValue = ref (false); fun k (x) { + if log then printf ("Result: %s\n", x.string) fi; case x of - Succ (val, _) -> + Succ (val, s) -> + if log then printf ("Result stream: %s\n", showMatcher (s)) fi; if deref (hasValue) then failure (sprintf ("Ostap: ambiguous parsing (%s vs. %s)", deref (value).string, val.string)) else