Permalink
Browse files

om.lists: add flat-once

  • Loading branch information...
1 parent e7f2b5f commit 3cc9642c26c3dc291535a74875c0a9eaa40677c3 @k7f committed Apr 1, 2012
Showing with 17 additions and 0 deletions.
  1. +8 −0 work/om/lists/lists-docs.factor
  2. +4 −0 work/om/lists/lists-tests.factor
  3. +5 −0 work/om/lists/lists.factor
View
8 work/om/lists/lists-docs.factor
@@ -38,6 +38,13 @@ HELP: x-append
{ $description "Appends lists or atoms together to form a new list." }
{ $notes "This function also works with additional elements." } ;
+HELP: flat-once
+{ $values
+ { "seq" sequence }
+ { "seq'" sequence }
+}
+{ $description "If all elements of the sequence are sequences themselves, outputs a copy of input with top level of nesting removed. Otherwise, if the first element of input is not a sequence, outputs the input sequence. Otherwise, throws an error." } ;
+
HELP: flat
{ $values
{ "seq" sequence }
@@ -137,6 +144,7 @@ OM-REFERENCE:
{ "last-n" last-n }
{ "first-n" first-n }
{ "x-append" x-append }
+{ "flat-once" flat-once }
{ "flat" flat }
{ "create-list" create-list }
{ "mat-trans" mat-trans }
View
4 work/om/lists/lists-tests.factor
@@ -36,6 +36,10 @@ IN: om.lists.tests
{ 1 2 3 } 4 { 5 6 7 } x-append
] unit-test
+[ { 1 { 2 } 3 { 4 { 5 } 6 } } ] [
+ { { 1 { 2 } } { 3 } { { 4 { 5 } 6 } } } flat-once
+] unit-test
+
[ { 1 2 3 4 5 6 } ] [
{ { 1 2 } 3 { { 4 5 } 6 } } f flat
] unit-test
View
5 work/om/lists/lists.factor
@@ -85,6 +85,11 @@ PRIVATE>
! ____
! flat
+GENERIC: flat-once ( seq -- seq' )
+
+M: sequence flat-once ( seq -- seq' )
+ dup first atom? [ concat ] unless ;
+
<PRIVATE
: (flat-new) ( seq -- seq' )
[ sum-lengths-with-atoms ] keep new-resizable ; inline

0 comments on commit 3cc9642

Please sign in to comment.