Initial data commit

Task/Associative-array-Iteration/Forth/associative-array-iteration-1.fth

@@ -0,0 +1,22 @@
+include ffl/hct.fs
+include ffl/hci.fs
+
+\ Create hashtable and iterator in dictionary
+10     hct-create htable
+htable hci-create hiter
+
+\ Insert entries
+1 s" hello" htable hct-insert
+2 s" world" htable hct-insert
+3 s" !"     htable hct-insert
+
+: iterate
+  hiter hci-first
+  BEGIN
+  WHILE
+    ." key = " hiter hci-key type ." , value = " . cr
+    hiter hci-next
+  REPEAT
+;
+
+iterate

Task/Associative-array-Iteration/Forth/associative-array-iteration-2.fth

@@ -0,0 +1,137 @@
+\ Written in ANS-Forth; tested under VFX.
+\ Requires the novice package: http://www.forth.org/novice.html
+\ The following should already be done:
+\ include novice.4th
+\ include association.4th
+
+\ I would define high-level languages as those that allow programs to be written without explicit iteration. Iteration is a major source of bugs.
+\ The example from the FFL library doesn't hide iteration, whereas this example from the novice-package does.
+
+
+marker AssociationIteration.4th
+
+\ ******
+\ ****** The following defines a node in an association (each node is derived from ELEMENT).
+\ ******
+
+element
+    w field .inventor
+constant language           \ describes a programming language
+
+: init-language ( inventor name node -- node )
+    init-element >r
+    hstr r@ .inventor !
+    r> ;
+
+: new-language ( inventor name -- node )
+    language alloc
+    init-language ;
+
+: show-language ( count node -- )
+    >r
+    1+                      \ -- count+1
+    cr  r@ .key @ count colorless type  ." invented by: "  r@ .inventor @ count type
+    rdrop ;
+
+: show-languages-forward ( handle -- )
+    0                       \ -- handle count
+    swap .root @  ['] show-language  walk>
+    cr ." count: " .
+    cr ;
+
+: show-languages-backward ( handle -- )
+    0                       \ -- handle count
+    swap .root @  ['] show-language  <walk
+    cr ." count: " .
+    cr ;
+
+: kill-language-attachments ( node -- )
+    dup .inventor @  dealloc
+    kill-key ;
+
+: copy-language-attachments ( src dst -- )
+    over .inventor @  hstr
+    over .inventor !
+    copy-key ;
+
+
+\ ******
+\ ****** The following defines the association itself (the handle).
+\ ******
+
+association
+constant languages          \ describes a set of programming languages
+
+: init-languages ( record -- record )
+    >r
+    ['] compare  ['] kill-language-attachments  ['] copy-language-attachments
+    r> init-association ;
+
+: new-languages ( -- record )
+    languages alloc
+    init-languages ;
+
+
+\ ******
+\ ****** The following filters one association into another, including everything that matches a particular inventor.
+\ ******
+
+: <filter-inventor> { inventor handle new-handle node -- inventor handle new-handle }
+    inventor count  node .inventor @ count  compare  A=B = if
+        node handle dup-element  new-handle insert  then
+    inventor handle new-handle ;
+
+: filter-inventor ( inventor handle -- new-handle )
+    dup similar-association                             \ -- inventor handle new-handle
+    over .root @  ['] <filter-inventor>  walk>          \ -- inventor handle new-handle
+    nip nip ;
+
+\ ******
+\ ****** The following is a demonstration with some sample data.
+\ ******
+
+
+new-languages
+    c" Moore, Chuck"                c" Forth     "      new-language  over insert
+    c" Ichiah, Jean"                c" Ada       "      new-language  over insert
+    c" Wirth, Niklaus"              c" Pascal    "      new-language  over insert
+    c" Wirth, Niklaus"              c" Oberon    "      new-language  over insert
+    c" McCarthy, John"              c" Lisp      "      new-language  over insert
+    c" van Rossum, Guido"           c" Python    "      new-language  over insert
+    c" Gosling, Jim"                c" Java      "      new-language  over insert
+    c" Ierusalimschy, Roberto"      c" Lua       "      new-language  over insert
+    c" Matsumoto, Yukihiro"         c" Ruby      "      new-language  over insert
+    c" Pestov, Slava"               c" Factor    "      new-language  over insert
+    c" Gosling, James"              c" Java      "      new-language  over insert
+    c" Wirth, Niklaus"              c" Modula-2  "      new-language  over insert
+    c" Ritchie, Dennis"             c" C         "      new-language  over insert
+    c" Stroustrup, Bjarne"          c" C++       "      new-language  over insert
+constant some-languages
+
+
+cr .( everything in SOME-LANGUAGES ordered forward: )
+
+some-languages show-languages-forward
+
+
+cr .( everything in SOME-LANGUAGES ordered backward: )
+
+some-languages show-languages-backward
+
+
+cr .( everything in SOME-LANGUAGES invented by Wirth: )
+
+c" Wirth, Niklaus" some-languages filter-inventor           dup show-languages-forward  kill-association
+
+
+cr .( everything in SOME-LANGUAGES within 'F' and 'L': )
+
+c" F"  c" L"  some-languages  filter within                 dup show-languages-forward  kill-association
+
+
+cr .( everything in SOME-LANGUAGES not within 'F' and 'L': )
+
+c" F"  c" L"  some-languages  filter without                dup show-languages-forward  kill-association
+
+
+some-languages kill-association