Cosmetics; probably a fix for regexps

runtime/runtime.c

@@ -557,13 +557,7 @@ 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);
   
@@ -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,9 +725,6 @@ 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);
  
@@ -735,50 +734,57 @@ extern int Lcompare (void *p, void *q) {
   }
   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 (; i<la; i++) {
-      int c = Lcompare (((void**) a->contents)[i], ((void**) b->contents)[i]);
-      if (c != BOX(0)) return BOX(c);
-    }
+        for (; i<la; i++) {
+          int c = Lcompare (((void**) a->contents)[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);
   }
 }
 

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

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"

stdlib/Collection.lama

@@ -312,7 +312,8 @@ public fun lookupMemo (m, v) {
         | _ ->
           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

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
 }
 

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