st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 06:48:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Better eq

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-08-04 15:48:20 +03:00
parent c3671a0a38
commit f6d4a475b4
4 changed files with 51 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

1
runtime/Std.i
View file

@ -48,3 +48,4 @@ F,disableGC;
F,random;
F,time;
F,rawTag;
F,compareTags;

26
runtime/runtime.c
View file

@ -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;

2
src/version.ml
View file

@ -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"

39
stdlib/regression/test30.lama
View file

@ -48,29 +48,34 @@ fun eq (x, y) {
esac
}
fun eqargs (x, y, from) {
local continue = true;
if x.length != y.length
then false
else
for local i = from;, i<x.length && continue, i := i + 1 do
continue := eqrec (x[i], y[i])
od;
continue
fi
}
fun eqrec (x, y) {
if alreadyEq (x, y)
then true
else
case [x, y] of
[#array, #array] ->
if x.length == y.length
then
local continue = true;
for local i = 0;, i<x.length && continue, i := i + 1 do
continue := eqrec (x[i], y[i])
od;
continue
else false
fi
| [#unboxed, #unboxed] -> x == y
| [#string, #string] -> compare (x, y) == 0
| [#unboxed, #array] -> false
| [#array, #unboxed] -> false
| _ -> failure ("eq not supported: %s, %s", x.string, y.string)
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
}
eqrec (x, y)