From 5408191724437e1c996304ead256641e913f464a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 22 Mar 2009 18:37:28 -0500
Subject: [PATCH] xml: update XML-NS: for define-memoized stack effect change
 and get all unit tests to pass

---
 basis/xml/syntax/syntax.factor       | 14 +++++++-------
 basis/xml/tests/templating.factor    |  4 ++--
 basis/xml/tests/xmltest.factor       |  2 +-
 basis/xml/writer/writer-tests.factor |  2 +-
 4 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/basis/xml/syntax/syntax.factor b/basis/xml/syntax/syntax.factor
index 0f23aafa6e..abe0f90738 100644
--- a/basis/xml/syntax/syntax.factor
+++ b/basis/xml/syntax/syntax.factor
@@ -17,8 +17,8 @@ M: no-tag summary
     >alist swap '[ _ no-tag boa throw ] suffix
     '[ dup main>> _ case ] ;
 
-: define-tags ( word -- )
-    dup dup "xtable" word-prop compile-tags define ;
+: define-tags ( word effect -- )
+    [ dup dup "xtable" word-prop compile-tags ] dip define-declared ;
 
 :: define-tag ( string word quot -- )
     quot string word "xtable" word-prop set-at
@@ -27,16 +27,16 @@ M: no-tag summary
 PRIVATE>
 
 SYNTAX: TAGS:
-    CREATE
-    [ H{ } clone "xtable" set-word-prop ]
-    [ define-tags ] bi ;
+    CREATE complete-effect
+    [ drop H{ } clone "xtable" set-word-prop ]
+    [ define-tags ]
+    2bi ;
 
 SYNTAX: TAG:
     scan scan-word parse-definition define-tag ;
 
 SYNTAX: XML-NS:
-    CREATE-WORD (( string -- name )) over set-stack-effect
-    scan '[ f swap _ <name> ] define-memoized ;
+    CREATE-WORD scan '[ f swap _ <name> ] (( string -- name )) define-memoized ;
 
 <PRIVATE
 
diff --git a/basis/xml/tests/templating.factor b/basis/xml/tests/templating.factor
index 4861f86d7b..7f7d8d2891 100644
--- a/basis/xml/tests/templating.factor
+++ b/basis/xml/tests/templating.factor
@@ -2,8 +2,8 @@ USING: kernel xml sequences assocs tools.test io arrays namespaces fry
 accessors xml.data xml.traversal xml.writer generic sequences.deep multiline ;
 IN: xml.tests
 
-: sub-tag
-    T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" } ;
+CONSTANT: sub-tag
+    T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" }
 
 SYMBOL: ref-table
 
diff --git a/basis/xml/tests/xmltest.factor b/basis/xml/tests/xmltest.factor
index 532c1db29f..c41b05eb85 100644
--- a/basis/xml/tests/xmltest.factor
+++ b/basis/xml/tests/xmltest.factor
@@ -17,7 +17,7 @@ TUPLE: xml-test id uri sections description type ;
 : parse-tests ( xml -- tests )
     "TEST" tags-named [ >xml-test ] map ;
 
-: base "vocab:xml/tests/xmltest/" ;
+CONSTANT: base "vocab:xml/tests/xmltest/"
 
 MACRO: drop-output ( quot -- newquot )
     dup infer out>> '[ @ _ ndrop ] ;
diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor
index 421c2a2b5d..f19e845ab9 100644
--- a/basis/xml/writer/writer-tests.factor
+++ b/basis/xml/writer/writer-tests.factor
@@ -61,7 +61,7 @@ IN: xml.writer.tests
 [ "<foo>         bar            </foo>" string>xml pprint-xml>string ] unit-test
 [ "<foo'>" ] [ "<foo'>" <unescaped> xml>string ] unit-test
 
-: test-file "resource:basis/xml/writer/test.xml" ;
+CONSTANT: test-file "resource:basis/xml/writer/test.xml"
 
 [ ] [ "<?xml version='1.0' encoding='UTF-16BE'?><x/>" string>xml test-file utf8 [ write-xml ] with-file-writer ] unit-test
 [ "x" ] [ test-file file>xml body>> name>> main>> ] unit-test