incomplete

1 files changed, 126 insertions, 44 deletions

diff --git a/challenge-209/paulo-custodio/forth/ch-2.fs b/challenge-209/paulo-custodio/forth/ch-2.fs
index 769c05f32d..52fb1ce824 100644
--- a/challenge-209/paulo-custodio/forth/ch-2.fs
+++ b/challenge-209/paulo-custodio/forth/ch-2.fs
@@ -31,50 +31,50 @@
 \           ["A", "a3@a.com"],
 \           ["B", "b1@b.com", "b2@b.com"] ]
 
-\ string list: word with length, dwords with each string pointer and length
-: str_list_new ( -- lst )
+\ mails list: word with length, dwords with each string pointer and length
+: emails_new ( -- lst )
 	CELL ALLOCATE THROW 0 OVER !
 ;
 
-: str_list_delete ( lst -- )
+: emails_delete ( lst -- )
 	FREE THROW
 ;
 
-: str_list_size ( lst -- size )
+: emails_size ( lst -- size )
 	@
 ;
 
-: str_list[] ( lst idx -- addr )
+: emails[] ( lst idx -- addr )
 	SWAP CELL + SWAP CELLS 2* + 
 ;
 
-: str_list_resize ( lst size -- lst )
+: emails_resize ( lst size -- lst )
 	2* CELLS CELL + RESIZE THROW
 ;
 
-: str_list_push { addr len lst -- lst }
-	lst lst str_list_size 1+ str_list_resize TO lst 
-	addr len  lst  lst str_list_size  str_list[]  2!
+: emails_push { addr len lst -- lst }
+	lst lst emails_size 1+ emails_resize TO lst 
+	addr len  lst  lst emails_size  emails[]  2!
 	1 lst +!
 	lst
 ;
 
-: str_list_type { lst -- }
-	lst str_list_size  0 ?DO
-		lst I str_list[] 2@ TYPE SPACE
+: emails_type { lst -- }
+	lst emails_size  0 ?DO
+		lst I emails[] 2@ TYPE SPACE
 	LOOP
 ;
 
-: str_list_sort { lst -- }
-	lst str_list_size 1 > IF
-		lst str_list_size 1- 0 ?DO
-			lst str_list_size I 1+ ?DO
-				lst J str_list[] 2@
-				lst I str_list[] 2@
+: emails_sort { lst -- }
+	lst emails_size 1 > IF
+		lst emails_size 1- 0 ?DO
+			lst emails_size I 1+ ?DO
+				lst J emails[] 2@
+				lst I emails[] 2@
 				2OVER 2OVER
 				COMPARE 0> IF 
-					lst J str_list[] 2!
-					lst I str_list[] 2!
+					lst J emails[] 2!
+					lst I emails[] 2!
 				ELSE
 					2DROP 2DROP
 				THEN
@@ -83,17 +83,17 @@
 	THEN
 ;
 
-: str_list_uniq { lst -- }
-	lst str_list_size 1 > IF
-		lst str_list_sort
+: emails_uniq { lst -- }
+	lst emails_size 1 > IF
+		lst emails_sort
 		0 { i }
-		BEGIN i  lst str_list_size 1- < WHILE
-			lst i str_list[] 2@
-			lst i 1+ str_list[] 2@
+		BEGIN i  lst emails_size 1- < WHILE
+			lst i emails[] 2@
+			lst i 1+ emails[] 2@
 			COMPARE 0= IF		\ remove next entry
-				lst i 1+ str_list[]  
-				lst i str_list[]  
-				lst str_list_size i - 1- CELLS 2*
+				lst i 1+ emails[]  
+				lst i emails[]  
+				lst emails_size i - 1- CELLS 2*
 				MOVE
 				-1 lst +!
 			ELSE
@@ -103,18 +103,100 @@
 	THEN
 ;
 
-		
-str_list_new VALUE lst
-lst 64 dump
-next-arg lst str_list_push TO lst
-next-arg lst str_list_push TO lst
-next-arg lst str_list_push TO lst
-next-arg lst str_list_push TO lst
-next-arg lst str_list_push TO lst
-lst 64 dump
-lst str_list_type CR
-lst str_list_uniq
-lst str_list_type CR
-lst 64 dump
-
-~~ bye
+: emails_merge { lst1 lst2 -- lst1 }
+	lst2 emails_size 0 ?DO
+		lst2 I emails[] 2@
+		lst1 emails_push TO lst1
+	LOOP
+	lst1 emails_uniq
+	lst1
+;
+
+\ account: DCELL with name, CELL with emails
+: acc.name ( acc -- addr ) ;
+: acc.emails ( acc -- addr ) 2 CELLS + ;
+: acc.emails[] ( acc idx -- addr ) acc.emails emails[] ;
+
+: acc_new { name-addr len -- acc }
+	3 CELLS ALLOCATE THROW { acc }
+	name-addr len acc acc.name 2!
+	emails_new acc acc.emails !
+	acc
+;
+
+: acc_delete { acc -- }
+	acc acc.emails emails_delete
+	acc FREE THROW
+;
+
+: acc.emails_push { addr len acc -- }
+	addr len acc acc.emails @ emails_push 
+	acc acc.emails !
+;
+
+: acc.type { acc -- }
+	acc acc.name 2@ TYPE SPACE
+	acc acc.emails @ emails_type CR
+;
+
+: acc_merge { acc acc2 -- }
+	acc acc.emails @ 
+	acc2 acc.emails @ 
+	emails_merge
+	acc acc.emails !
+;
+
+\ accounts: CELL with count, CELLS with pointers to accounts
+: accs_new ( -- accs )
+	CELL ALLOCATE THROW
+	0 OVER !
+;
+
+: accs_size ( accs -- size )
+	@
+;
+
+: accs[] ( accs idx -- addr ) 
+	SWAP CELL + SWAP CELLS + 
+;
+
+: accs_resize ( accs size -- accs )
+	1+ CELLS RESIZE THROW
+;
+
+: accs_push { addr-name len accs -- accs }
+	accs accs accs_size 1+ accs_resize TO accs 
+	addr-name len acc_new  accs accs_size accs[] !
+	1 accs +!
+	accs
+;
+
+: accs_type { accs -- }
+	accs accs_size 0 ?DO
+		accs I accs[] @ acc.name 2@ TYPE SPACE
+	LOOP
+;
+
+
+accs_new VALUE accs
+S" A" accs accs_push TO accs
+accs acc.type
+~~ BYE
+
+next-arg acc acc.emails_push
+next-arg acc acc.emails_push
+next-arg acc acc.emails_push
+next-arg acc acc.emails_push
+next-arg acc acc.emails_push
+
+acc acc.type
+
+S" B" acc_new VALUE acc2
+S" 123" acc2 acc.emails_push
+S" 456" acc2 acc.emails_push
+S" 789" acc2 acc.emails_push
+acc2 acc.type
+
+acc acc2 acc_merge
+acc acc.type
+