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

modules/map.dt

@@ -141,6 +141,24 @@ must also implement `LessThanComparable`.
               (< (@: p1 first)
                  (@: p2 first))))))))
 
+    (def copy-functions (var auto (p DNode)
+      (if copy-disabled-3
+          (qq do (def setf-copy-disabled (fn extern bool ((dst (Map (uq Tk) (uq Tv)))))))
+          (qq do
+            (def setf-copy-init (fn extern bool ((dst (p (Map (uq Tk) (uq Tv))))
+                                                 (src (p (Map (uq Tk) (uq Tv)))))
+              (init (@ (:@ dst set)))
+              (let ((b \ (begin (@ (:@ src set))))
+                    (e \ (end   (@ (:@ src set)))))
+                (for true (!= b e) (setv b (successor b))
+                  (insert (@ (:@ dst set)) (@ (source b)))))
+              true))
+
+            (def setf-copy-assign (fn extern bool ((dst (p (Map (uq Tk) (uq Tv))))
+                                                   (src (p (Map (uq Tk) (uq Tv)))))
+              (clear (@ (:@ dst set)))
+              (setf-copy-init dst src)))))))
+
     (qq do
 
     (using-namespace std.macros
@@ -507,7 +525,7 @@ must also implement `LessThanComparable`.
       (let ((np (value-type (nullptr (Map (uq Tk) (uq Tv))))))
         (setf (: np first) ((uq tvw-1) key))
         (setf (: np second) ((uq tvw-2) value))
-        (insert (@ mapp) ((uq tvw-3) np)))))
+        (insert (@ mapp) (move np)))))
 
     #|
     @fn find
@@ -523,7 +541,7 @@ must also implement `LessThanComparable`.
                                (key  ((uq tpw-1) (uq Tk))))
       (let ((temp (value-type (nullptr (Map (uq Tk) (uq Tv))))))
         (setf (: temp first) ((uq tvw-1) key))
-        (let ((myiter \ (find (@ (:@ mapp set)) temp))
+        (let ((myiter \ (find (@ (:@ mapp set)) (move temp)))
               (itn    (Iterator (Map (uq Tk) (uq Tv)))))
           (setf (: itn mapp) mapp)
           (setf (: itn setiter) myiter)
@@ -580,7 +598,7 @@ must also implement `LessThanComparable`.
                                    (key ((uq tpw-1) (uq Tk))))
       (let ((temp (value-type (nullptr (Map (uq Tk) (uq Tv))))))
         (setf (: temp first) ((uq tvw-1) key))
-        (let ((lb \ (lower-bound (@ (:@ mapp set)) temp)))
+        (let ((lb \ (lower-bound (@ (:@ mapp set)) (move temp))))
           ((Iterator (Map (uq Tk) (uq Tv))) ((mapp mapp)
                               (setiter lb)))))))
 
@@ -597,23 +615,25 @@ must also implement `LessThanComparable`.
                                    (key  ((uq tpw-1) (uq Tk))))
       (let ((temp (value-type (nullptr (Map (uq Tk) (uq Tv))))))
         (setf (: temp first) ((uq tvw-1) key))
-        (let ((lb \ (upper-bound (@ (:@ mapp set)) temp)))
+        (let ((lb \ (upper-bound (@ (:@ mapp set)) (move temp))))
           ((Iterator (Map (uq Tk) (uq Tv))) ((mapp mapp)
                               (setiter lb)))))))
 
-    (def setf-copy-init (fn extern bool ((dst (p (Map (uq Tk) (uq Tv))))
-                                         (src (p (Map (uq Tk) (uq Tv)))))
+    (def setf-move-init (fn extern bool ((dst (p (Map (uq Tk) (uq Tv))))
+                                         (src (rv-ref (Map (uq Tk) (uq Tv)))))
       (init (@ (:@ dst set)))
       (let ((b \ (begin (@ (:@ src set))))
             (e \ (end   (@ (:@ src set)))))
         (for true (!= b e) (setv b (successor b))
-          (insert (@ (:@ dst set)) (@ (source b)))))
+          (insert (@ (:@ dst set)) (move (@ (source b))))))
       true))
 
-    (def setf-copy-assign (fn extern bool ((dst (p (Map (uq Tk) (uq Tv))))
-                                           (src (p (Map (uq Tk) (uq Tv)))))
+    (def setf-move-assign (fn extern bool ((dst (p (Map (uq Tk) (uq Tv))))
+                                           (src (rv-ref (Map (uq Tk) (uq Tv)))))
       (clear (@ (:@ dst set)))
-      (setf-copy-init dst src)))
+      (setf-move-init dst (move (@ src)))))
+
+    (uq copy-functions)
 
     (implement Type (Map (uq Tk) (uq Tv)))
     (instantiate swap (Map (uq Tk) (uq Tv)))
@@ -628,10 +648,8 @@ must also implement `LessThanComparable`.
                        (!= b2 e2))
                   (do (setv b1 (successor b1))
                       (setv b2 (successor b2)))
-          (let ((v1 \ (@ (source b1)))
-                (v2 \ (@ (source b2))))
-            (and (not (both-= v1 v2))
-                 (return false))))
+          (and (not (both-= (@ (source b1)) (@ (source b2))))
+               (return false)))
         (and (= b1 e1) (= b2 e2)))))
 
     (def < (fn extern bool ((map1 (ref (Map (uq Tk) (uq Tv))))

t/014container/021map-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/map-rv.dt -o map-rv `;
+is_deeply(\@res, [], 'No compilation errors');
+@res = `./map-rv`;
+is($?, 0, 'Program executed successfully');
+
+chomp for @res;
+
+is_deeply(\@res, [
+'2 2',
+'3 3',
+'4 4',
+],
+    'Got correct results');
+
+`rm map-rv`;
+
+1;

t/src/map-rv.dt

@@ -0,0 +1,66 @@
+(import cstdio)
+(import unistd)
+(import macros)
+(import unique-ptr)
+(import map)
+(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 Map int (UniquePtr int))
+
+(def main
+  (fn extern-c int (void)
+    (let ((map    (Map int (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, 2).
+      (insert map 2 (move myptr2))
+      ; (2, 2), (3, 3).
+      (insert map 3 (move myptr3))
+      ; (1, 1), (2, 2), (3, 3).
+      (insert map 1 (move myptr1))
+      ; (2, 2), (3, 3).
+      (erase (begin map))
+      ; (2, 2), (3, 3), (4, 4).
+      (insert map 4 (move myptr4))
+
+      (while (not (empty map))
+        (let ((b1 \ (@ (get (@:@ (source (begin map)) second))))
+              (b2 \ (@:@ (source (begin map)) first)))
+          (erase (begin map))
+          (printf "%d %d\n" b2 b1)))
+      0)))