From 03a01984dd309c750e7544bdd807f77bad42e01d Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Thu, 11 Oct 2007 14:14:12 -0500
Subject: [PATCH] Refactor lsys string rewriting and interpretation

---
 extra/lsys/strings/interpret/interpret.factor | 35 ++++++++++++
 extra/lsys/strings/rewrite/rewrite.factor     | 36 ++++++++++++
 extra/lsys/strings/strings.factor             | 56 ++-----------------
 extra/lsys/tortoise/graphics/graphics.factor  |  7 ++-
 4 files changed, 81 insertions(+), 53 deletions(-)
 create mode 100644 extra/lsys/strings/interpret/interpret.factor
 create mode 100644 extra/lsys/strings/rewrite/rewrite.factor

diff --git a/extra/lsys/strings/interpret/interpret.factor b/extra/lsys/strings/interpret/interpret.factor
new file mode 100644
index 0000000000..bcd87ca137
--- /dev/null
+++ b/extra/lsys/strings/interpret/interpret.factor
@@ -0,0 +1,35 @@
+
+USING: kernel sequences quotations assocs math math.parser
+       combinators.lib vars lsys.strings ;
+
+IN: lsys.strings.interpret
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: command-table
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: exec-command ( string -- ) command-table> at >quotation call ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: command ( string -- command ) 1 head ;
+
+: parameter ( string -- parameter )
+  [ drop 2 ] [ length 1- ] [ ] tri subseq string>number ;
+
+: exec-command* ( string -- )
+  [ parameter ] [ command ] bi
+  command-table> at dup
+  [ 1 tail* call ] [ 3drop ] if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: (interpret) ( slice -- )
+  { { [ empty? ]     [ drop ] }
+    { [ has-param? ] [ next+rest* [ exec-command* ] [ (interpret) ] bi* ] }
+    { [ t ]          [ next+rest  [ exec-command  ] [ (interpret) ] bi* ] } }
+  switch ;
+
+: interpret ( string -- ) <flat-slice> (interpret) ;
diff --git a/extra/lsys/strings/rewrite/rewrite.factor b/extra/lsys/strings/rewrite/rewrite.factor
new file mode 100644
index 0000000000..18db67ec95
--- /dev/null
+++ b/extra/lsys/strings/rewrite/rewrite.factor
@@ -0,0 +1,36 @@
+
+USING: kernel sbufs strings sequences assocs math
+       combinators.lib vars lsys.strings ;
+
+IN: lsys.strings.rewrite
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: rules
+
+: lookup ( str -- str ) [ 1 head rules> at ] [ ] bi or ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: accum
+
+: push-next ( next -- ) lookup accum> push-all ;
+
+: (rewrite) ( slice -- )
+  { { [ empty? ]     [ drop ] }
+    { [ has-param? ] [ next+rest* [ push-next ] [ (rewrite) ] bi* ] }
+    { [ t ]	     [ next+rest  [ push-next ] [ (rewrite) ] bi* ] } }
+  switch ;
+
+: rewrite ( string -- string )
+  dup length 10 * <sbuf> >accum
+  <flat-slice> (rewrite)
+  accum> >string ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: result
+
+: iterate ( -- ) result> rewrite >result ;
+
+: iterations ( n -- ) [ iterate ] times ;
diff --git a/extra/lsys/strings/strings.factor b/extra/lsys/strings/strings.factor
index 64fe648146..3c9dfcab6c 100644
--- a/extra/lsys/strings/strings.factor
+++ b/extra/lsys/strings/strings.factor
@@ -1,60 +1,14 @@
 
-USING: kernel combinators math math.parser assocs sequences quotations vars ;
+USING: kernel sequences math combinators.lib ;
 
 IN: lsys.strings
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Lindenmayer string rewriting
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! Maybe use an array instead of a quot in the work of segment
+: has-param? ( slice -- ? ) { [ length 1 > ] [ second CHAR: ( = ] } <-&& ;
 
-VAR: rules
+: next+rest ( slice -- next rest ) [ 1 head ] [ 1 tail-slice ] bi ;
 
-: segment ( str -- seq )
-{ { [ dup "" = ] [ drop [ ] ] }
-  { [ dup length 1 = ] [ 1quotation ] }
-  { [ 1 over nth CHAR: ( = ]
-    [ CHAR: ) over index 1 +		! str i
-      2dup head				! str i head
-      -rot tail				! head tail
-      segment swap add* ] }
-  { [ t ] [ dup 1 head swap 1 tail segment swap add* ] } }
-cond ;
+: index-rest ( slice -- i ) CHAR: ) swap index 1+ ;
 
-: lookup ( str -- str ) dup 1 head rules> at dup [ nip ] [ drop ] if ;
-
-: rewrite ( str -- str ) segment [ lookup ] map concat ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: result
-
-: iterate ( -- ) result> rewrite >result ;
-
-: iterations ( n -- ) [ iterate ] times ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Lindenmayer string interpretation
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: command-table
-
-: segment-command ( seg -- command ) 1 head ;
-
-: segment-parameter ( seg -- parameter )
-dup length 1 - 2 swap rot subseq string>number ;
-
-: segment-parts ( seg -- param command )
-dup segment-parameter swap segment-command ;
-
-: exec-command ( str -- ) command-table> at dup [ call ] [ drop ] if ;
-
-: exec-command-with-param ( param command -- )
-command-table> at dup [ peek 1quotation call ] [ 2drop ] if ;
-
-: (interpret) ( seg -- )
-dup length 1 =
-[ exec-command ] [ segment-parts exec-command-with-param ] if ;
-
-: interpret ( str -- ) segment [ (interpret) ] each ;
+: next+rest* ( slice -- next rest ) dup index-rest [ head ] [ tail-slice ] 2bi ;
diff --git a/extra/lsys/tortoise/graphics/graphics.factor b/extra/lsys/tortoise/graphics/graphics.factor
index c212ab435d..d8429e7aaf 100644
--- a/extra/lsys/tortoise/graphics/graphics.factor
+++ b/extra/lsys/tortoise/graphics/graphics.factor
@@ -1,7 +1,10 @@
 
 USING: kernel math vectors sequences opengl.gl math.vectors
-math.matrices vars opengl self pos ori turtle lsys.tortoise
-lsys.strings ;
+       math.matrices vars opengl self pos ori turtle lsys.tortoise
+
+       lsys.strings.interpret ;
+
+       ! lsys.strings
 
 IN: lsys.tortoise.graphics