From 799f761befcf2ca3dac3d73a4dfa4996c59bc3c0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 24 Nov 2008 12:31:40 -0600
Subject: [PATCH] state-tables vocab is no longer necessary

---
 basis/state-tables/authors.txt               |   1 -
 basis/state-tables/state-tables-tests.factor |  56 ---------
 basis/state-tables/state-tables.factor       | 123 -------------------
 3 files changed, 180 deletions(-)
 delete mode 100644 basis/state-tables/authors.txt
 delete mode 100644 basis/state-tables/state-tables-tests.factor
 delete mode 100644 basis/state-tables/state-tables.factor

diff --git a/basis/state-tables/authors.txt b/basis/state-tables/authors.txt
deleted file mode 100644
index 7c1b2f2279..0000000000
--- a/basis/state-tables/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Doug Coleman
diff --git a/basis/state-tables/state-tables-tests.factor b/basis/state-tables/state-tables-tests.factor
deleted file mode 100644
index b86c4f57d9..0000000000
--- a/basis/state-tables/state-tables-tests.factor
+++ /dev/null
@@ -1,56 +0,0 @@
-USING: kernel state-tables tools.test ;
-IN: state-tables.tests
-
-: test-table
-    <table>
-    "a" "c" "z" <entry> over set-entry
-    "a" "o" "y" <entry> over set-entry
-    "a" "l" "x" <entry> over set-entry
-    "b" "o" "y" <entry> over set-entry
-    "b" "l" "x" <entry> over set-entry
-    "b" "s" "u" <entry> over set-entry ;
-
-[
-    T{
-        table
-        f
-        H{ 
-            { "a" H{ { "l" "x" } { "c" "z" } { "o" "y" } } }
-            { "b" H{ { "l" "x" } { "s" "u" } { "o" "y" } } }
-        }
-        H{ { "l" t } { "s" t } { "c" t } { "o" t } }
-        f
-        H{ }
-    }
-] [ test-table ] unit-test
-
-[ "x" t ] [ "a" "l" test-table get-entry ] unit-test
-[ "har" t ] [
-    "a" "z" "har" <entry> test-table [ set-entry ] keep
-    >r "a" "z" r> get-entry
-] unit-test
-
-: vector-test-table
-    <vector-table>
-    "a" "c" "z" <entry> over add-entry
-    "a" "c" "r" <entry> over add-entry
-    "a" "o" "y" <entry> over add-entry
-    "a" "l" "x" <entry> over add-entry
-    "b" "o" "y" <entry> over add-entry
-    "b" "l" "x" <entry> over add-entry
-    "b" "s" "u" <entry> over add-entry ;
-
-[
-T{ vector-table f
-    H{ 
-        { "a"
-            H{ { "l" "x" } { "c" V{ "z" "r" } } { "o" "y" } } }
-        { "b"
-            H{ { "l" "x" } { "s" "u" } { "o" "y" } } }
-    }
-    H{ { "l" t } { "s" t } { "c" t } { "o" t } }
-    f
-    H{ }
-}
-] [ vector-test-table ] unit-test
-
diff --git a/basis/state-tables/state-tables.factor b/basis/state-tables/state-tables.factor
deleted file mode 100644
index ecb258c163..0000000000
--- a/basis/state-tables/state-tables.factor
+++ /dev/null
@@ -1,123 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces make sequences vectors assocs accessors ;
-IN: state-tables
-
-TUPLE: table rows columns start-state final-states ;
-TUPLE: entry row-key column-key value ;
-
-GENERIC: add-entry ( entry table -- )
-
-: make-table ( class -- obj )
-    new
-        H{ } clone >>rows
-        H{ } clone >>columns
-        H{ } clone >>final-states ;
-
-: <table> ( -- obj )
-    table make-table ;
-
-C: <entry> entry
-
-: (add-row) ( row-key table -- row )
-    2dup rows>> at* [
-        2nip
-    ] [
-        drop H{ } clone [ -rot rows>> set-at ] keep
-    ] if ;
-
-: add-row ( row-key table -- )
-    (add-row) drop ;
-
-: add-column ( column-key table -- )
-    t -rot columns>> set-at ;
-
-: set-row ( row row-key table -- )
-    rows>> set-at ;
-
-: lookup-row ( row-key table -- row/f ? )
-    rows>> at* ;
-
-: row-exists? ( row-key table -- ? )
-    lookup-row nip ;
-
-: lookup-column ( column-key table -- column/f ? )
-    columns>> at* ;
-
-: column-exists? ( column-key table -- ? )
-    lookup-column nip ;
-
-ERROR: no-row key ;
-ERROR: no-column key ;
-
-: get-row ( row-key table -- row )
-    dupd lookup-row [
-        nip
-    ] [
-        drop no-row
-    ] if ;
-
-: get-column ( column-key table -- column )
-    dupd lookup-column [
-        nip
-    ] [
-        drop no-column
-    ] if ;
-
-: get-entry ( row-key column-key table -- obj ? )
-    swapd lookup-row [
-        at*
-    ] [
-        2drop f f
-    ] if ;
-
-: (set-entry) ( entry table -- value column-key row )
-    [ >r column-key>> r> add-column ] 2keep
-    dupd >r row-key>> r> (add-row)
-    >r [ value>> ] keep column-key>> r> ;
-
-: set-entry ( entry table -- )
-    (set-entry) set-at ;
-
-: delete-entry ( entry table -- )
-    >r [ column-key>> ] [ row-key>> ] bi r>
-    lookup-row [ delete-at ] [ 2drop ] if ;
-
-: swap-rows ( row-key1 row-key2 table -- )
-    [ tuck get-row >r get-row r> ] 3keep
-    >r >r rot r> r> [ set-row ] keep set-row ;
-
-: member?* ( obj obj -- bool )
-    2dup = [ 2drop t ] [ member? ] if ;
-
-: find-by-column ( column-key data table -- seq )
-    swapd 2dup lookup-column 2drop 
-    [
-        rows>> [
-            pick swap at* [ 
-                >r pick r> member?* [ , ] [ drop ] if
-            ] [ 
-                2drop
-            ] if 
-        ] assoc-each
-    ] { } make 2nip ;
-
-
-TUPLE: vector-table < table ;
-: <vector-table> ( -- obj )
-    vector-table make-table ;
-
-: add-hash-vector ( value key hash -- )
-    2dup at* [
-        dup vector? [
-            2nip push
-        ] [
-            V{ } clone [ push ] keep
-            -rot >r >r [ push ] keep r> r> set-at
-        ] if
-    ] [
-        drop set-at
-    ] if ;
- 
-M: vector-table add-entry ( entry table -- )
-    (set-entry) add-hash-vector ;