[guru-lang] r533 committed - improved qlist_erase_ref/qlist_replace_ref by using new test_ref funct...

[guru...@googlecode.com]

Revision: 533
Author: kain.nomad
Date: Wed Aug 17 09:28:49 2011
Log: improved qlist_erase_ref/qlist_replace_ref by using new test_ref
function, which avoids "inc"ing and "dec"ing unowned objects just to
compare the references.

http://code.google.com/p/guru-lang/source/detail?r=533

Modified:
/branches/1.0/lib/qlist.g
/branches/1.0/lib/ref.g
/branches/1.0/lib/uniquew.g

=======================================
--- /branches/1.0/lib/qlist.g Wed Jul 27 02:38:39 2011
+++ /branches/1.0/lib/qlist.g Wed Aug 17 09:28:49 2011
@@ -1,18 +1,13 @@
Include "unique.g".
+Include "unique_owned.g".
Include "ref.g".
-Include "eqref.g".
+%Include "eqref.g".
Include trusted "word.g".

Inductive qlist : Fun(A:type).type :=
qnil : Fun(A:type).#unique <qlist A>
| qcons : Fun(A:type)(#unique a:A)(#unique l:<qlist A>). #unique <qlist A>.

-% temporarily added by Duckki
-Define primitive inspect_uniquew : Fun(spec A:type)(!#uniquew
a:A).#<unique_owned a> A :=
- fun(spec A:type)(a:A).a <<END
-#define ginspect_uniquew(a) a
-END.
-
Define qappend : Fun(A:type)(#unique l1 l2:<qlist A>). #unique <qlist A> :=
fun qappend(A:type)(#unique l1 l2:<qlist A>) : #unique <qlist A>.
match l1 with
@@ -33,17 +28,14 @@
ff
end
| qcons _ r l' =>
- let a = (read_ref A (inspect_uniquew <ref A> r)) in
- match (eqref A x a) with
+ match (test_ref A (inspect_uniquew <ref A> r) x) with
ff =>
do
- (consume_unowned A a)
(consume_uniquew <ref A> r)
(qlist_replace_ref A x y l')
end
| tt =>
do
- (consume_unowned A a)
(consume_uniquew <qlist <ref A>> l')
(write_ref_once A y r)
tt
@@ -59,10 +51,10 @@
match l with
qnil _ => (qnil <ref A>)
| qcons _ r l' =>
- let a = (read_ref A (inspect_unique <ref A> r)) in
- match (eqref A x a) with
+ match (test_ref A (inspect_unique <ref A> r) x) with
ff =>
match (get_uniquew <qlist <ref A>> l') with mk_get_uniquew_t _
l'_pinned l'_w =>
+ let a = (read_ref A (inspect_unique <ref A> r)) in
match (qlist_replace_ref A x a l'_w) with
ff =>
let l'' = (unpin_unique <qlist <ref A>> l'_pinned) in
@@ -76,13 +68,11 @@
end
| tt =>
do
- (consume_unowned A a)
(consume_unique <ref A> r)
l'
end
end
end
- .

Define qlength_word_h := fun qlength_word_h(A:type)(^#unique_owned
l:<qlist A>)(i:word) : word.
match l with
=======================================
--- /branches/1.0/lib/ref.g Sat Apr 23 12:04:54 2011
+++ /branches/1.0/lib/ref.g Wed Aug 17 09:28:49 2011
@@ -1,5 +1,6 @@
Include "uniquew.g".
Include "unique_owned.g".
+Include "bool.g"

Inductive ref : Fun(A:type).type :=
mk_ref : Fun(A:type)(#unowned a:A).#unique <ref A>.
@@ -38,3 +39,10 @@
return r;
}
END.
+
+Define primitive test_ref : Fun(spec A:type)(^#unique_owned r:<ref
A>)(!#unowned a:A).bool <<END
+inline unsigned gtest_ref(void* r, void* a) {
+ void* tmp = select_ref_mk_ref_a(r);
+ return (tmp == a)? gtt(): gff();
+}
+END.
=======================================
--- /branches/1.0/lib/uniquew.g Fri Aug 12 06:47:43 2011
+++ /branches/1.0/lib/uniquew.g Wed Aug 17 09:28:49 2011
@@ -5,6 +5,7 @@
% nodes.n

Include "unique.g".
+Include "unique_owned.g".

ResourceType uniquew with
Define primitive consume_uniquew : Fun(A:type)(^#uniquew x:A).void
@@ -50,3 +51,7 @@
}
END.

+Define primitive inspect_uniquew : Fun(spec A:type)(!#uniquew
a:A).#<unique_owned a> A :=
+ fun(spec A:type)(a:A).a <<END
+#define ginspect_uniquew(a) a
+END.