Initial data commit

Task/Catamorphism/Forth/catamorphism-1.fth

@@ -0,0 +1,5 @@
+: lowercase? ( c -- f )
+  [char] a [ char z 1+ ] literal within ;
+
+: char-upcase ( c -- C )
+  dup lowercase? if bl xor then ;

Task/Catamorphism/Forth/catamorphism-2.fth

@@ -0,0 +1,19 @@
+: string-at ( c-addr u +n -- c )
+  nip + c@ ;
+: string-at! ( c-addr u +n c -- )
+  rot drop  -rot  + c! ;
+
+: type-lowercase ( c-addr u -- )
+  dup 0 ?do
+    2dup i string-at  dup lowercase?  if emit else drop then
+  loop  2drop ;
+
+: upcase ( 'string' -- 'STRING' )
+  dup 0 ?do
+    2dup 2dup  i string-at  char-upcase  i swap string-at!
+  loop ;
+
+: count-lowercase ( c-addr u -- n )
+  0 -rot dup 0 ?do
+    2dup i string-at  lowercase? if rot 1+ -rot then
+  loop  2drop ;

Task/Catamorphism/Forth/catamorphism-3.fth

@@ -0,0 +1,8 @@
+: next-char ( a +n -- a' n' c -1 )  ( a 0 -- 0 )
+  dup if 2dup  1 /string  2swap drop c@ true
+  else 2drop 0 then ;
+
+: type-lowercase ( c-addr u -- )
+  begin next-char while
+    dup lowercase? if emit else drop then
+  repeat ;

Task/Catamorphism/Forth/catamorphism-4.fth

@@ -0,0 +1,17 @@
+: each-char[ ( c-addr u -- )
+  postpone BOUNDS postpone ?DO
+  postpone I postpone C@ ;  immediate
+
+  \ interim code: ( c -- )
+
+: ]each-char ( -- )
+  postpone LOOP ;  immediate
+
+: type-lowercase ( c-addr u -- )
+  each-char[ dup lowercase? if emit else drop then ]each-char ;
+
+: upcase ( 'string' -- 'STRING' )
+  2dup each-char[ char-upcase i c! ]each-char ;
+
+: count-lowercase ( c-addr u -- n )
+  0 -rot each-char[ lowercase? if 1+ then ]each-char ;

Task/Catamorphism/Forth/catamorphism-5.fth

@@ -0,0 +1,17 @@
+: each-char ( c-addr u xt -- )
+  {: xt :}  bounds ?do
+    i c@ xt execute
+  loop ;
+
+: type-lowercase ( c-addr u -- )
+  [: dup lowercase? if emit else drop then ;]
+  each-char ;
+
+\ producing a new string
+: upcase ( 'string' -- 'STRING' )
+  dup cell+ allocate throw -rot
+  [: ( new-string-addr c -- new-string-addr )
+    upcase over c+! ;] each-char  $@ ;
+
+: count-lowercase ( c-addr u -- n )
+  0 -rot [: lowercase? if 1+ then ;] each-char ;