[master] add support for move-only types to set (#43)

modules/set.dt

@@ -79,6 +79,24 @@ must also implement `LessThanComparable`.
     (def nodetypenode (var auto (p DNode) (std.macros.mnfv mc nodetypename)))
     (register-type mc typename etypename)
 
+    (def copy-functions (var auto (p DNode)
+      (if copy-disabled
+          (qq do (def setf-copy-disabled (fn extern bool ((dst (Set (uq T)))))))
+	  (qq do
+            (def setf-copy-init (fn extern bool ((dst (p (Set (uq T))))
+                                                 (src (p (Set (uq T)))))
+              (init (@ dst))
+              (let ((b \ (begin (@ src)))
+                    (e \ (end   (@ src))))
+                (for true (!= b e) (setv b (successor b))
+                  (insert (@ dst) (@ (source b)))))
+              true))
+
+            (def setf-copy-assign (fn extern bool ((dst (p (Set (uq T))))
+                                                   (src (p (Set (uq T)))))
+              (clear (@ dst))
+              (setf-copy-init dst src)))))))
+
     (qq do
 
     (import derivations)
@@ -702,8 +720,8 @@ must also implement `LessThanComparable`.
               (setf (:@ newnodep right) (nullptr (uq nodetypenode)))
               (let ((cn    \ (get-root-node (@ setp)))
                     (newnp \ (nullptr (p (uq nodetypenode)))))
-                (while (!= ((uq tvw) newval) (@:@ cn value))
-                  (if (< ((uq tvw) newval) (@:@ cn value))
+                (while (!= (@:@ newnodep value) (@:@ cn value))
+                  (if (< (@:@ newnodep value) (@:@ cn value))
                       (do (if (null (@:@ cn left))
                               (do (setv newnp (:@ cn left))
                                   (break))
@@ -719,7 +737,7 @@ must also implement `LessThanComparable`.
                         (adjust-heights cn)
                         (rebalance setp cn false)
                         0)
-                    (do (setf (:@ cn value) ((uq tvw) newval)) 0))
+                    (do (setf (:@ cn value) (move (@:@ newnodep value))) 0))
                 (return true))))))
 
     #|
@@ -1023,19 +1041,21 @@ must also implement `LessThanComparable`.
           (setf (:@ set2 begin-node) bn1)
           (return))))
 
-    (def setf-copy-init (fn extern bool ((dst (p (Set (uq T))))
-                                         (src (p (Set (uq T)))))
+    (def setf-move-init (fn extern bool ((dst (p (Set (uq T))))
+                                         (src (rv-ref (Set (uq T)))))
       (init (@ dst))
       (let ((b \ (begin (@ src)))
             (e \ (end   (@ src))))
         (for true (!= b e) (setv b (successor b))
-          (insert (@ dst) (@ (source b)))))
+          (insert (@ dst) (move (@ (source b))))))
       true))
 
-    (def setf-copy-assign (fn extern bool ((dst (p (Set (uq T))))
-                                           (src (p (Set (uq T)))))
+    (def setf-move-assign (fn extern bool ((dst (p (Set (uq T))))
+                                           (src (rv-ref (Set (uq T)))))
       (clear (@ dst))
-      (setf-copy-init dst src)))
+      (setf-move-init dst (move (@ src)))))
+
+    (uq copy-functions)
 
     (implement Container (Set (uq T)))
     (implement Type (Set (uq T)))

t/014container/020set-rv.t

@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+$ENV{"DALE_TEST_ARGS"} ||= "";
+my $test_dir = $ENV{"DALE_TEST_DIR"} || ".";
+$ENV{PATH} .= ":.";
+
+use Data::Dumper;
+use Test::More tests => 3;
+
+my @res = `dalec $ENV{"DALE_TEST_ARGS"} -lm $test_dir/t/src/set-rv.dt -o set-rv `;
+is_deeply(\@res, [], 'No compilation errors');
+@res = `./set-rv`;
+is($?, 0, 'Program executed successfully');
+
+chomp for @res;
+
+is_deeply(\@res, [
+'2',
+'3',
+'4',
+],
+    'Got correct results');
+
+`rm set-rv`;
+
+1;

t/src/set-rv.dt

@@ -0,0 +1,68 @@
+(import cstdio)
+(import unistd)
+(import macros)
+(import unique-ptr)
+(import set)
+(import derivations)
+(import algorithms)
+
+(std.concepts.instantiate UniquePtr int)
+
+(def = (fn intern bool ((a (const (p int))) (b (const (p int))))
+  (= (@ a) (@ b))))
+(def < (fn intern bool ((a (const (p int))) (b (const (p int))))
+  (< (@ a) (@ b))))
+(def = (fn extern bool ((a (ref (const (UniquePtr int))))
+                        (b (ref (const (UniquePtr int)))))
+  (= (core-@:@ a pointer) (core-@:@ b pointer))))
+(def < (fn extern bool ((a (ref (const (UniquePtr int)))) 
+                        (b (ref (const (UniquePtr int)))))
+  (< (core-@:@ a pointer) (core-@:@ b pointer))))
+
+(std.concepts.instantiate relations (UniquePtr int))
+(std.concepts.instantiate swap (UniquePtr int))
+(std.concepts.implement Swappable (UniquePtr int))
+(std.concepts.implement EqualityComparable (UniquePtr int))
+(std.concepts.implement LessThanComparable (UniquePtr int))
+
+(std.concepts.instantiate Set (UniquePtr int))
+(std.concepts.instantiate Set int)
+
+(def main
+  (fn extern-c int (void)
+    (let (;(set (Set int))
+          (set    (Set (UniquePtr int)))
+          (myint1 \ (malloc' 1 int))
+          (myptr1 (UniquePtr int))
+          (myint2 \ (malloc' 1 int))
+          (myptr2 (UniquePtr int))
+          (myint3 \ (malloc' 1 int))
+          (myptr3 (UniquePtr int))
+          (myint4 \ (malloc' 1 int))
+          (myptr4 (UniquePtr int)))
+      (setf myint1 1)
+      (init myptr1 myint1)
+      (setf myint2 2)
+      (init myptr2 myint2)
+      (setf myint3 3)
+      (init myptr3 myint3)
+      (setf myint4 4)
+      (init myptr4 myint4)
+
+      ; 2.
+      (insert set (move myptr2))
+      ; 2, 3.
+      (insert set (move myptr3))
+      ; 1, 2, 3.
+      (insert set (move myptr1))
+      ; 2, 3.
+      (erase (begin set))
+      ; 2, 3, 4.
+      (insert set (move myptr4))
+
+      (let ((b \ (begin set))
+            (e \ (end set)))
+        (for true (!= b e) (setv b (successor b))
+          (let ((local \ (@ (get (@ (source b))))))
+            (printf "%d\n" local))))
+      0)))