Introduce Any.gistseen

This method allows a developer to easily create a .gist method that is aware of self-referential structures (such can occur with arrays, lists, hashes and pairs). This replaces the ad-hoc code found so far.
rakudo · Nov 25, 2015 · 2e38ba6 · 2e38ba6
1 parent 8ef5a59
commit 2e38ba6
Show file tree

Hide file tree

Showing 6 changed files with 45 additions and 104 deletions.
diff --git a/src/core/Any.pm b/src/core/Any.pm
@@ -176,6 +176,26 @@ my class Any { # declared in BOOTSTRAP
             !! self
     }
 
+    method gistseen(Any:D: $id, $gist) {
+        if %*gistseen -> $gistseen {
+            my $WHICH := self.WHICH;
+            if $gistseen.AT-KEY($WHICH) -> \semaphore {
+                semaphore = 2;
+                "{$id}_{self.WHERE}";
+            }
+            else {
+                $gistseen.AT-KEY($WHICH) = 1;
+                $gistseen.DELETE-KEY($WHICH) == 2
+                  ?? "(\\{$id}_{self.WHERE} = $gist())"
+                  !! $gist()
+            }
+        }
+        else {
+            my %*gistseen = :TOP;
+            self.gistseen($id,$gist)
+        }
+    }
+
     # auto-vivifying
     proto method push(|) is nodal {*}
     multi method push(Any:U \SELF: |values) {

diff --git a/src/core/Array.pm b/src/core/Array.pm
@@ -708,24 +708,7 @@ my class Array { # declared in BOOTSTRAP
     }
 
     multi method gist(Array:D:) {
-        if %*gistseen -> $gistseen {
-            my $WHICH := self.WHICH;
-            if $gistseen.AT-KEY($WHICH) -> \semaphore {
-                semaphore = 2;
-                "Array_{self.WHERE}";
-            }
-            else {
-                $gistseen.AT-KEY($WHICH) = 1;
-                my $result = self.map({.gist}).join(' ');
-                $gistseen.DELETE-KEY($WHICH) == 2
-                  ?? "(\\Array_{self.WHERE} = [$result])"
-                  !! "[$result]"
-            }
-        }
-        else {
-            my %*gistseen = :TOP;
-            self.gist
-        }
+        self.gistseen('Array', { '[' ~ self.map({.gist}).join(' ') ~ ']' } )
     }
 
     multi method WHICH(Array:D:) {

diff --git a/src/core/Hash.pm b/src/core/Hash.pm
@@ -54,30 +54,15 @@ my class Hash { # declared in BOOTSTRAP
     }
 
     multi method gist(Hash:D:) {
-        if %*gistseen -> $gistseen {
-            my $WHICH := self.WHICH;
-            if $gistseen.AT-KEY($WHICH) -> \semaphore {
-                semaphore = 2;
-                "Hash_{self.WHERE}";
-            }
-            else {
-                $gistseen.AT-KEY($WHICH) = 1;
-                my $result = self.pairs.sort.map( -> $elem {
-                    given ++$ {
-                        when 101 { '...' }
-                        when 102 { last }
-                        default  { $elem.gist }
-                    }
-                } ).join: ', ';
-                $gistseen.DELETE-KEY($WHICH) == 2
-                  ?? "(\\Hash_{self.WHERE} = $result)"
-                  !! $result
-            }
-        }
-        else {
-            my %*gistseen = :TOP;
-            self.gist
-        }
+        self.gistseen('Hash', {
+            self.pairs.sort.map( -> $elem {
+                given ++$ {
+                    when 101 { '...' }
+                    when 102 { last }
+                    default  { $elem.gist }
+                }
+            } ).join: ', '
+        })
     }
 
     multi method DUMP(Hash:D: :$indent-step = 4, :%ctx?) {

diff --git a/src/core/List.pm b/src/core/List.pm
@@ -569,30 +569,15 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP
     }
 
     multi method gist(List:D:) {
-        if %*gistseen -> $gistseen {
-            my $WHICH := self.WHICH;
-            if $gistseen.AT-KEY($WHICH) -> \semaphore {
-                semaphore = 2;
-                "List_{self.WHERE}";
-            }
-            else {
-                $gistseen.AT-KEY($WHICH) = 1;
-                my $result = self.map( -> $elem {
-                    given ++$ {
-                        when 101 { '...' }
-                        when 102 { last }
-                        default  { $elem.gist }
-                    }
-                }).join(' ');
-                $gistseen.DELETE-KEY($WHICH) == 2
-                  ?? "(\\List_{self.WHERE} = ($result))"
-                  !! "($result)"
-            }
-        }
-        else {
-            my %*gistseen = :TOP;
-            self.gist
-        }
+        self.gistseen('List', {
+            '(' ~ self.map( -> $elem {
+                given ++$ {
+                    when 101 { '...' }
+                    when 102 { last }
+                    default  { $elem.gist }
+                }
+            }).join(' ') ~ ')'
+        })
     }
 
     multi method perl(List:D \SELF:) {

diff --git a/src/core/Pair.pm b/src/core/Pair.pm
@@ -36,26 +36,11 @@ my class Pair does Associative {
     multi method Str(Pair:D:) { $!key ~ "\t" ~ $!value }
 
     multi method gist(Pair:D:) {
-        if %*gistseen -> $gistseen {
-            my $WHICH := self.WHICH;
-            if $gistseen.AT-KEY($WHICH) -> \semaphore {
-                semaphore = 2;
-                "Pair_{self.WHERE}";
-            }
-            else {
-                $gistseen.AT-KEY($WHICH) = 1;
-                my $result = nqp::istype($!key, Pair)
-                  ?? '(' ~ $!key.gist ~ ') => ' ~ $!value.gist
-                  !! $!key.gist ~ ' => ' ~ $!value.gist;
-                $gistseen.DELETE-KEY($WHICH) == 2
-                  ?? "(\\Pair_{self.WHERE} = $result)"
-                  !! $result
-            }
-        }
-        else {
-            my %*gistseen = :TOP;
-            self.gist
-        }
+        self.gistseen('Pair', {
+            nqp::istype($!key, Pair)
+              ?? '(' ~ $!key.gist ~ ') => ' ~ $!value.gist
+              !! $!key.gist ~ ' => ' ~ $!value.gist;
+        })
     }
 
     multi method perl(Pair:D: :$arglist) {

diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm
@@ -448,24 +448,7 @@ my class Rakudo::Internals {
         }
 
         multi method gist(::?CLASS:D:) {
-            if %*gistseen -> $gistseen {
-                my $WHICH := self.WHICH;
-                if $gistseen.AT-KEY($WHICH) -> \semaphore {
-                    semaphore = 2;
-                    "Array_{self.WHERE}";
-                }
-                else {
-                    $gistseen.AT-KEY($WHICH) = 1;
-                    my $result = self!gist([], self.shape);
-                    $gistseen.DELETE-KEY($WHICH) == 2
-                      ?? "(\\Array_{self.WHERE} = $result)"
-                      !! $result
-                }
-            }
-            else {
-                my %*gistseen = :TOP;
-                self.gist
-            }
+            self.gistseen('Array', { self!gist([], self.shape) })
         }
         method !gist(@path, @dims) {
             if @dims.elems == 1 {