From 6322ee6bed6d09e0087e4e88aea51690b34bba07 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Sat, 4 Jan 2020 21:50:14 +0300 Subject: [PATCH] Assertions in runtime --- runtime/runtime.c | 104 ++++++++++++++++++++++++------ stdlib/Collection.expr | 141 ----------------------------------------- stdlib/Matcher.expr | 99 +++++++++++++++++++++++++---- 3 files changed, 171 insertions(+), 173 deletions(-) delete mode 100644 stdlib/Collection.expr diff --git a/runtime/runtime.c b/runtime/runtime.c index 7ed2216d2..2443a92e7 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -63,7 +63,24 @@ void __post_gc_subst () {} # define UNBOXED(x) (((int) (x)) & 0x0001) # define UNBOX(x) (((int) (x)) >> 1) -# define BOX(x) ((((int) (x)) << 1) | 0x0001) +# define BOX(x) ((((int) (x)) << 1) | 0x0001) + +static void vfailure (char *s, va_list args) { + fprintf (stderr, "*** FAILURE: "); + vfprintf (stderr, s, args); // vprintf (char *, va_list) <-> printf (char *, ...) + exit (255); +} + +static void failure (char *s, ...) { + va_list args; + + va_start (args, s); + vfailure (s, args); +} + +# define ASSERT_BOXED(memo, x) do if (UNBOXED(x)) failure ("boxed value expected in %s\n", memo); while (0) +# define ASSERT_UNBOXED(memo, x) do if (!UNBOXED(x)) failure ("unboxed value expected in %s\n", memo); while (0) +# define ASSERT_STRING(memo, x) do if (!UNBOXED(x) && TAG(TO_DATA(x)->tag) != STRING_TAG) failure ("sting value expected in %s\n", memo); while (0) typedef struct { int tag; @@ -79,6 +96,9 @@ extern void* alloc (size_t); extern int Blength (void *p) { data *a = (data*) BOX (NULL); + + ASSERT_BOXED(".length", p); + a = TO_DATA(p); return BOX(LEN(a->tag)); } @@ -107,19 +127,6 @@ char* de_hash (int n) { return ++p; } -static void vfailure (char *s, va_list args) { - fprintf (stderr, "*** FAILURE: "); - vfprintf (stderr, s, args); // vprintf (char *, va_list) <-> printf (char *, ...) - exit (255); -} - -static void failure (char *s, ...) { - va_list args; - - va_start (args, s); - vfailure (s, args); -} - typedef struct { char *contents; int ptr; @@ -291,15 +298,25 @@ static void stringcat (void *p) { extern int LmatchSubString (char *subj, char *patt, int pos) { data *p = TO_DATA(patt); - int n = LEN (p->tag); + int n; + ASSERT_STRING("matchSubString:1", subj); + ASSERT_STRING("matchSubString:2", patt); + ASSERT_UNBOXED("matchSubString:3", pos); + + n = LEN (p->tag); + return BOX(strncmp (subj + UNBOX(pos), patt, n) == 0); } extern void* Lsubstring (void *subj, int p, int l) { data *d = TO_DATA(subj); int pp = UNBOX (p), ll = UNBOX (l); - + + ASSERT_STRING("substring:1", subj); + ASSERT_UNBOXED("substring:2", p); + ASSERT_UNBOXED("substring:3", l); + if (pp + ll <= LEN(d->tag)) { data *r; @@ -331,6 +348,10 @@ extern struct re_pattern_buffer *Lregexp (char *regexp) { } extern int LregexpMatch (struct re_pattern_buffer *b, char *s, int pos) { + 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)); } @@ -391,6 +412,10 @@ extern int Lcompare (void *p, void *q) { extern void* Belem (void *p, int i) { data *a = (data *)BOX(NULL); + + ASSERT_BOXED(".elem:1", p); + ASSERT_UNBOXED(".elem:2", i); + a = TO_DATA(p); i = UNBOX(i); @@ -405,6 +430,8 @@ extern void* LmakeString (int length) { int n = UNBOX(length); data *r; + ASSERT_UNBOXED("makeStrig", length); + __pre_gc () ; r = (data*) alloc (n + 1 + sizeof (int)); @@ -419,7 +446,7 @@ extern void* LmakeString (int length) { extern void* Bstring (void *p) { int n = strlen (p); void *s; - + __pre_gc (); s = LmakeString (BOX(n)); @@ -433,6 +460,8 @@ extern void* Bstring (void *p) { extern void* Lstringcat (void *p) { void *s; + ASSERT_BOXED("stringcat", p); + __pre_gc (); createStringBuf (); @@ -469,7 +498,7 @@ extern void* Bclosure (int n, void *entry, ...) { int i = BOX(0), ai = BOX(0); data *r = (data*) BOX (NULL); - + __pre_gc (); #ifdef DEBUG_PRINT @@ -566,6 +595,7 @@ extern void* Bsexp (int n, ...) { extern int Btag (void *d, int t, int n) { data *r = (data *) BOX (NULL); + if (UNBOXED(d)) return BOX(0); else { r = TO_DATA(d); @@ -580,6 +610,7 @@ extern int Btag (void *d, int t, int n) { extern int Barray_patt (void *d, int n) { data *r = BOX(NULL); + if (UNBOXED(d)) return BOX(0); else { r = TO_DATA(d); @@ -590,6 +621,9 @@ extern int Barray_patt (void *d, int n) { extern int Bstring_patt (void *x, void *y) { data *rx = (data *) BOX (NULL), *ry = (data *) BOX (NULL); + + ASSERT_STRING(".string_patt:2", y); + if (UNBOXED(x)) return BOX(0); else { rx = TO_DATA(x); ry = TO_DATA(y); @@ -633,6 +667,9 @@ extern int Bsexp_tag_patt (void *x) { } extern void* Bsta (void *v, int i, void *x) { + ASSERT_BOXED(".sta:3", x); + ASSERT_UNBOXED(".sta:2", i); + if (TAG(TO_DATA(x)->tag) == STRING_TAG)((char*) x)[UNBOX(i)] = (char) UNBOX(v); else ((int*) x)[UNBOX(i)] = v; @@ -674,6 +711,9 @@ extern void* /*Lstrcat*/ Li__Infix_4343 (void *a, void *b) { data *db = (data*) BOX (NULL); data *d = (data*) BOX (NULL); + ASSERT_STRING("++:1", a); + ASSERT_STRING("++:2", b); + da = TO_DATA(a); db = TO_DATA(b); @@ -697,6 +737,7 @@ extern void* Lsprintf (char * fmt, ...) { va_list args; void *s; + ASSERT_STRING("sprintf:1", fmt); va_start (args, fmt); fix_unboxed (fmt, args); @@ -719,6 +760,9 @@ extern void* Lsprintf (char * fmt, ...) { extern void Lfprintf (FILE *f, char *s, ...) { va_list args = (va_list) BOX (NULL); + ASSERT_BOXED("fprintf:1", f); + ASSERT_STRING("fprintf:2", s); + va_start (args, s); fix_unboxed (s, args); @@ -730,6 +774,8 @@ extern void Lfprintf (FILE *f, char *s, ...) { extern void Lprintf (char *s, ...) { va_list args = (va_list) BOX (NULL); + ASSERT_STRING("printf:1", s); + va_start (args, s); fix_unboxed (s, args); @@ -739,8 +785,13 @@ extern void Lprintf (char *s, ...) { } extern FILE* Lfopen (char *f, char *m) { - FILE* h = fopen (f, m); + FILE* h; + ASSERT_STRING("fopen:1", f); + ASSERT_STRING("fopen:2", m); + + h = fopen (f, m); + if (h) return h; @@ -748,6 +799,8 @@ extern FILE* Lfopen (char *f, char *m) { } extern void Lfclose (FILE *f) { + ASSERT_BOXED("fclose", f); + fclose (f); } @@ -768,8 +821,12 @@ extern void* LreadLine () { } extern void* Lfread (char *fname) { - FILE *f = fopen (fname, "r"); + FILE *f; + ASSERT_STRING("fread", fname); + + f = fopen (fname, "r"); + if (f) { if (fseek (f, 0l, SEEK_END) >= 0) { long size = ftell (f); @@ -788,7 +845,12 @@ extern void* Lfread (char *fname) { } extern void Lfwrite (char *fname, char *contents) { - FILE *f = fopen (fname, "w"); + FILE *f; + + ASSERT_STRING("fwrite:1", fname); + ASSERT_STRING("fwrite:2", contents); + + f = fopen (fname, "w"); if (f) { if (fprintf (f, "%s", contents) < 0); diff --git a/stdlib/Collection.expr b/stdlib/Collection.expr deleted file mode 100644 index 38e6de5fb..000000000 --- a/stdlib/Collection.expr +++ /dev/null @@ -1,141 +0,0 @@ --- MNode (key, list of values, balance factor, left subtree, right subtree) --- balance factor = height (left subtree) - height (right subtree) -fun insert (m, k, v) { - fun rot (left, node) { - return - if left - then case node of - MNode (k, v, _, l, MNode (rk, rv, _, ll, rr)) -> - MNode (rk, rv, 0, MNode (k, v, 0, l, ll), rr) - esac - else case node of - MNode (k, v, _, MNode (lk, lv, _, ll, rr), r) -> - MNode (lk, lv, 0, ll, MNode (k, v, 0, rr, r)) - esac - fi - } - - fun factor (x) { - return x [2] - } - - fun inner (m, k, v) { - return - case m of - {} -> [true, MNode (k, {v}, 0, {}, {})] - | MNode (kk, vv, bf, l, r) -> - local c = compare (k, kk); - if c == 0 - then [false, MNode (kk, v : vv, bf, l, r)] - else if c < 0 - then - case inner (l, k, v) of - [true, ll] -> if bf < 0 - then [false, MNode (kk, vv, bf + 1, ll, r)] - elif bf == 1 - then if ll.factor > 0 - then [false, rot (false, MNode (kk, vv, bf, ll, r))] - else [false, rot (false, MNode (kk, vv, bf, rot (true, ll), r))] - fi - else [true, MNode (kk, vv, bf + 1, ll, r)] - fi - | [false, ll] -> [false, MNode (kk, vv, bf, ll, r)] - esac - else - case inner (r, k, v) of - [true, rr] -> if bf > 0 - then [false, MNode (kk, vv, bf - 1, l, rr)] - elif bf == -1 - then if rr.factor < 0 - then [false, rot (true, MNode (kk, vv, bf, l, rr))] - else [false, rot (true, MNode (kk, vv, bf, l, rot (false, rr)))] - fi - else [true, MNode (kk, vv, bf - 1, l, rr)] - fi - | [false, rr] -> [false, MNode (kk, vv, bf, l, rr)] - esac - fi - fi - esac - } - - return m.inner (k, v).snd -} - -fun find (m, k) { - return - case m of - {} -> None - | MNode (kk, vv, _, l, r) -> - local c = compare (k, kk); - if c == 0 - then case vv of v : _ -> Some (v) | _ -> None esac - else find (if c < 0 then l else r fi, k) - fi - esac -} - -fun remove (m, k) { - return - case m of - {} -> m - | MNode (kk, vv, bf, l, r) -> - local c = compare (k, kk); - if c == 0 - then case vv of {} -> m | _ : vt -> MNode (kk, vt, l, r) esac - else if c < 0 - then MNode (kk, vv, bf, remove (l, k), r) - else MNode (kk, vv, bf, l, remove (r, k)) - fi - fi - esac -} - -fun validate (t) { - fun inner (t, verify) { - return - case t of - {} -> 0 - | MNode (k, _, bf, l, r) -> - if verify (k) - then - local lh = validate (l, fun (x) {return x < k}), - rh = validate (r, fun (x) {return x > k}); - - if bf == lh - rh - then 1 + if lh > rh then lh else rh fi - else failure ("Balance violation on key %s\n", k.string) - fi - else failure ("Order violation on key %s\n", k.string) - fi - esac - } - - inner (t, fun (x) {return true}) -} - -local tree = {}, i; - -for i := 100, i >= 1, i := i-1 do - validate (tree); - tree := insert (tree, i, i); - printf ("Inserting: %s\n", i.string); - printf ("Result : %s\n", tree.string) -od; - -tree := {}; - -for i := 1, i <= 100, i := i+2 do - validate (tree); - tree := insert (tree, i, i); - printf ("Inserting: %s\n", i.string); - printf ("Result : %s\n", tree.string) -od; - -for i := 2, i <= 100, i := i+2 do - validate (tree); - tree := insert (tree, i, i); - printf ("Inserting: %s\n", i.string); - printf ("Result : %s\n", tree.string) -od - diff --git a/stdlib/Matcher.expr b/stdlib/Matcher.expr index aad845e89..fe48885e8 100644 --- a/stdlib/Matcher.expr +++ b/stdlib/Matcher.expr @@ -1,7 +1,6 @@ -- (C) Dmitry Boulytchev, St. Petersburg State University, JetBrains Research, 2020 -- Matcher: simple string matching library. - -- Create a regular expression representation. -- Arguments: -- r --- a string representation for regular expression (as per GNU regexp) @@ -30,9 +29,19 @@ fun matcherCreate (buf, pos, line, col) { return buf.length - pos } - -- Moves the position pointer on given number of characters within one line (i.e. + -- Moves the position pointer on given number of characters. fun shift (n) { - return matcherCreate (buf, pos + n, line, col + n) + local i, l = line, c = col; + + for i := pos, i < n, i := i+1 do + case buf [i] of + '\n' -> l := l + 1; c := 1 + | '\t' -> c := c + 8 + | _ -> c := c + 1 + esac + od; + + return matcherCreate (buf, pos + n, l, c) } fun matchString (s) { @@ -53,7 +62,7 @@ fun matcherCreate (buf, pos, line, col) { else Fail (sprintf ("%s expected at %d:%d", r[1], line, col)) fi } - + fun eof () { return rest () == 0 } @@ -70,7 +79,7 @@ fun show (m) { return m [0] () } -fun eof (m) { +fun endOf (m) { return m [1] () } @@ -78,11 +87,13 @@ fun matchString (m, s) { return m [2] (s) } +-- Matches against a regexp fun matchRegexp (m, r) { return m [3] (r) } -fun matcherInit (buf) { +-- Creates a fresh matcher from a string buffer +public fun matcherInit (buf) { return matcherCreate (buf, 0, 1, 1) } @@ -90,10 +101,76 @@ fun matcherInit (buf) { --} -local m = matcherInit ("abc"); +local m = matcherInit (" -- asdasdakm ,m.,msd .,m.,asd\n \n\n abc"); + +local + lident = createRegexp ("[a-z][a-zA-Z_]*", "lowercase identifier"), + uident = createRegexp ("[A-Z][a-zA-Z_]*", "uppercase identifier"), + ws = createRegexp ("\\([ \t\n]\\|--[^\n]*\n\\)*", "whitespace"), + str = createRegexp ("""\([^""]\|""""\)*""", "string literal"), + decimal = createRegexp ("[0-9]+", "decimal literal"), + chr = createRegexp ("'[^']'", "character literal"); + +fun token (s) { + return fun (m) {return m.matchString (s)} +} + +fun lid (m) { + return m.matchRegexp (lident) +} + +fun uid (m) { + return m.matchRegexp (uident) +} + +fun const (m) { + return m.matchRegexp (decimal) +} + +infixl "@" before "*" (p, f) { + return fun (m) { + return + case p (m) of + Succ (m, x) -> Succ (m, f (x)) + | err -> err + esac + } +} + +infixr "|>" after "!!" (l, r) { + return fun (m) { + return + case l (m) of + Succ (m, s) -> r (s) (m) + | err -> err + esac + } +} + +infixr "||" after "|>" (l, r) { + return fun (m) { + return + case l (m) of + s@Succ (_, _) -> s + | err -> r (m) + esac + } +} + +local expr = lid @ fun (s) {return Lid (s)} || + const @ fun (s) {return Dec (s)}, + assn = lid |> fun (id) {return token (":=") |> fun (s) {return expr @ fun (e) {return Assn (id, e)}}}; + +printf ("%s\n", assn (matcherInit ("x:=3")).string) + +--local ident = createRegexp ("[a-z][a-zA-Z_]*", "identifier"); +--local ws = createRegexp ("[ \n\t]+", "whitespace"); + +--local ws = createRegexp ("\\([ \t\n]\\|--[^\n]*\n\\)*", "whitespace"); + +--local str = createRegexp ("""\([^""]\|""""\)*""", "string literal"); +--local lineComment = createRegexp ("--[^\n]*\n", "line comment"); + +--printf ("ws: %s\n", case m.matchRegexp (ws) of Succ (m, s) -> "(" ++ m.show ++ ", " ++ s ++ ")" | Fail (err) -> err.string esac); -local ident = createRegexp ("[a-z][a-zA-Z_]*", "identifier"); -local ws = createRegexp ("[ \n\t]+", "whitespace"); -local str = createRegexp ("""\([^""]\|""""\)*""", "string literal"); -printf ("ident: %s\n", case m.matchRegexp (ident) of Succ (m, s) -> "(" ++ m.show ++ ", " ++ s ++ ")" | Fail (err) -> err.string esac)