diff --git a/runtime/Std.i b/runtime/Std.i index 4c858a8e0..dbb03e7e0 100644 --- a/runtime/Std.i +++ b/runtime/Std.i @@ -48,3 +48,4 @@ F,disableGC; F,random; F,time; F,rawTag; +F,compareTags; diff --git a/runtime/runtime.c b/runtime/runtime.c index adb5dd616..b43264d8f 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -67,6 +67,7 @@ void __post_gc_subst () {} # define ARRAY_TAG 0x00000003 # define SEXP_TAG 0x00000005 # define CLOSURE_TAG 0x00000007 +# define UNBOXED_TAG 0x00000009 // Not actually a tag; used to return from LrawTag # define LEN(x) ((x & 0xFFFFFFF8) >> 3) # define TAG(x) (x & 0x00000007) @@ -175,11 +176,34 @@ void *global_sysargs; // Gets a raw tag extern int LrawTag (void *p) { - ASSERT_UNBOXED ("rawTag, 0", p); + if (UNBOXED(p)) return UNBOXED_TAG; return TAG(TO_DATA(p)->tag); } +// Compare sexprs tags +extern int LcompareTags (void *p, void *q) { + data *pd, *qd; + + ASSERT_BOXED ("compareTags, 0", p); + ASSERT_BOXED ("compareTags, 1", q); + + pd = TO_DATA(p); + qd = TO_DATA(q); + + if (TAG(pd->tag) == SEXP_TAG && TAG(qd->tag) == SEXP_TAG) { + return + #ifndef DEBUG_PRINT + (TO_SEXP(p)->tag) - (TO_SEXP(q)->tag); + #else + (GET_SEXP_TAG(TO_SEXP(p)->tag)) - (GET_SEXP_TAG(TO_SEXP(p)->tag)); + #endif + } + else failure ("not a sexpr in compareTags: %d, %d\n", TAG(pd->tag), TAG(qd->tag)); + + return 0; // never happens +} + // Functional synonym for built-in operator ":"; void* Ls__Infix_58 (void *p, void *q) { void *res; diff --git a/src/version.ml b/src/version.ml index 8599b52b5..8d39065ce 100644 --- a/src/version.ml +++ b/src/version.ml @@ -1 +1 @@ -let version = "Version 1.00, c29ab4901, Sun Aug 2 23:56:21 2020 +0300" +let version = "Version 1.00, c3671a0a3, Tue Aug 4 15:11:14 2020 +0300" diff --git a/stdlib/regression/test30.lama b/stdlib/regression/test30.lama index 42fd36114..1a9bd7800 100644 --- a/stdlib/regression/test30.lama +++ b/stdlib/regression/test30.lama @@ -47,29 +47,34 @@ fun eq (x, y) { fi esac } + + fun eqargs (x, y, from) { + local continue = true; + + if x.length != y.length + then false + else + for local i = from;, i - if x.length == y.length - then - local continue = true; - - for local i = 0;, i x == y - | [#string, #string] -> compare (x, y) == 0 - | [#unboxed, #array] -> false - | [#array, #unboxed] -> false - | _ -> failure ("eq not supported: %s, %s", x.string, y.string) - esac + else + if rawTag (x) != rawTag (y) then false + else + case x of + #array -> eqargs (x, y, 0) + | #fun -> if x[0] == y[0] then eqargs (x, y, 1) else false fi + | #sexp -> if compareTags (x, y) == 0 then eqargs (x, y, 0) else false fi + | _ -> compare (x, y) == 0 + esac + fi fi }