From 74e8fea55a7cebaf9a672108708d81c3ece8e71b Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@teal-blue-28.dynamic2.rpi.edu>
Date: Wed, 28 Nov 2007 15:33:58 -0500
Subject: [PATCH 1/4] Inverse change

---
 extra/inverse/inverse.factor | 20 ++++----------------
 1 file changed, 4 insertions(+), 16 deletions(-)

diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index 4d85318c1b..bc9a3f9f60 100644
--- a/extra/inverse/inverse.factor
+++ b/extra/inverse/inverse.factor
@@ -4,15 +4,6 @@ tuples namespaces vectors bit-arrays byte-arrays strings sbufs
 math.functions macros ;
 IN: inverse
 
-: (repeat) ( from to quot -- )
-    pick pick >= [
-        3drop
-    ] [
-        [ swap >r call 1+ r> ] keep (repeat)
-    ] if ; inline
-
-: repeat ( n quot -- ) 0 -rot (repeat) ; inline
-
 TUPLE: fail ;
 : fail ( -- * ) \ fail construct-empty throw ;
 M: fail summary drop "Unification failed" ;
@@ -33,11 +24,6 @@ M: fail summary drop "Unification failed" ;
     >r dupd "pop-length" set-word-prop r>
     "pop-inverse" set-word-prop ;
 
-DEFER: [undo]
-
-: make-inverse ( word -- quot )
-    word-def [undo] ;
-
 TUPLE: no-inverse word ;
 : no-inverse ( word -- * ) \ no-inverse construct-empty throw ;
 M: no-inverse summary
@@ -70,9 +56,11 @@ M: no-inverse summary
 
 GENERIC: inverse ( revquot word -- revquot* quot )
 
+DEFER: [undo]
+
 M: word inverse
     dup "inverse" word-prop [ ]
-    [ dup primitive? [ no-inverse ] [ make-inverse ] if ] ?if ;
+    [ dup primitive? [ no-inverse ] [ word-def [undo] ] if ] ?if ;
 
 : undo-literal ( object -- quot )
     [ =/fail ] curry ;
@@ -100,7 +88,7 @@ M: pop-inverse inverse
 
 MACRO: undo ( quot -- ) [undo] ;
 
-! Inversions of selected words
+! Inverse of selected words
 
 \ swap [ swap ] define-inverse
 \ dup [ [ =/fail ] keep ] define-inverse

From 0fb6ce87e2714cb8bea0ed5db6a2ad6d7178a58c Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-24.local>
Date: Wed, 28 Nov 2007 22:52:22 -0500
Subject: [PATCH 2/4] RSS cleanups

---
 extra/rss/rss-tests.factor |  9 ++++++---
 extra/rss/rss.factor       | 29 +++++++++++++----------------
 2 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/extra/rss/rss-tests.factor b/extra/rss/rss-tests.factor
index 643c2ecf51..18aa8440b9 100644
--- a/extra/rss/rss-tests.factor
+++ b/extra/rss/rss-tests.factor
@@ -1,5 +1,9 @@
-USING: rss io.files tools.test ;
-IN: temporary
+USING: rss io kernel io.files tools.test ;
+
+: load-news-file ( filename -- feed )
+    #! Load an news syndication file and process it, returning
+    #! it as an feed tuple.
+    <file-reader> read-feed ;
 
 [ T{
     feed
@@ -34,4 +38,3 @@ IN: temporary
         }
     }
 } ] [ "extra/rss/atom.xml" resource-path load-news-file ] unit-test
-[ " &amp; &amp; hi" ] [ " & &amp; hi" &>&amp; ] unit-test
diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor
index 458f09642f..8a9be3f9f6 100644
--- a/extra/rss/rss.factor
+++ b/extra/rss/rss.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: rss
-USING: xml.utilities kernel promises parser-combinators assocs
+USING: xml.utilities kernel assocs
     strings sequences xml.data xml.writer
     io.streams.string combinators xml xml.entities io.files io
     http.client namespaces xml.generator hashtables ;
@@ -62,23 +62,17 @@ C: <entry> entry
         children>string <entry>
     ] map <feed> ;
 
-: feed ( xml -- feed )
+: xml>feed ( xml -- feed )
     dup name-tag {
         { "RDF" [ rss1.0 ] }
         { "rss" [ rss2.0 ] }
         { "feed" [ atom1.0 ] }
     } case ;
 
-: read-feed ( string -- feed )
-    ! &>&amp; ! this will be uncommented when parser-combinators are fixed
-    [ string>xml ] with-html-entities feed ;
+: read-feed ( stream -- feed )
+    [ read-xml ] with-html-entities xml>feed ;
 
-: load-news-file ( filename -- feed )
-    #! Load an news syndication file and process it, returning
-    #! it as an feed tuple.
-    <file-reader> [ contents read-feed ] keep stream-close ;
-
-: news-get ( url -- feed )
+: download-feed ( url -- feed )
     #! Retrieve an news syndication file, return as a feed tuple.
     http-get rot 200 = [
         nip read-feed
@@ -90,7 +84,7 @@ C: <entry> entry
 : simple-tag, ( content name -- )
     [ , ] tag, ;
 
-: (generate-atom) ( entry -- )
+: entry, ( entry -- )
     "entry" [
         dup entry-title "title" simple-tag,
         "link" over entry-link "href" associate contained*,
@@ -98,9 +92,12 @@ C: <entry> entry
         entry-description "content" simple-tag,
     ] tag, ;
 
-: generate-atom ( feed -- xml )
-    "feed" [
+: feed>xml ( feed -- xml )
+    "feed" { { "xmlns" "http://www.w3.org/2005/Atom" } } [
         dup feed-title "title" simple-tag,
         "link" over feed-link "href" associate contained*,
-        feed-entries [ (generate-atom) ] each
-    ] make-xml ;
+        feed-entries [ entry, ] each
+    ] make-xml* ;
+
+: write-feed ( feed -- xml )
+    feed>xml write-xml ;

From b04c9201d0905bc3f5095924ea9531db576c14ed Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-24.local>
Date: Thu, 29 Nov 2007 12:06:52 -0500
Subject: [PATCH 3/4] Half-assed constant folding in extra/inverse

---
 extra/inverse/inverse.factor | 56 +++++++++++++++++++++++++-----------
 1 file changed, 39 insertions(+), 17 deletions(-)

diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index bc9a3f9f60..583ae610c0 100644
--- a/extra/inverse/inverse.factor
+++ b/extra/inverse/inverse.factor
@@ -1,7 +1,7 @@
 USING: kernel words inspector slots quotations sequences assocs
 math arrays inference effects shuffle continuations debugger
 tuples namespaces vectors bit-arrays byte-arrays strings sbufs
-math.functions macros ;
+math.functions macros combinators.private combinators ;
 IN: inverse
 
 TUPLE: fail ;
@@ -18,7 +18,7 @@ M: fail summary drop "Unification failed" ;
 : define-inverse ( word quot -- ) "inverse" set-word-prop ;
 
 : define-math-inverse ( word quot1 quot2 -- )
-    2array "math-inverse" set-word-prop ;
+    pick 1quotation 3array "math-inverse" set-word-prop ;
 
 : define-pop-inverse ( word n quot -- )
     >r dupd "pop-length" set-word-prop r>
@@ -40,10 +40,7 @@ M: no-inverse summary
     effect-in length 0 = and ;
 
 : assure-constant ( constant -- quot )
-    dup word? [
-        dup constant-word?
-        [ "Badly formed math inverse" throw ] unless
-    ] when 1quotation ;
+    dup word? [ "Badly formed math inverse" throw ] when 1quotation ;
 
 : swap-inverse ( math-inverse revquot -- revquot* quot )
     next assure-constant rot second [ swap ] swap 3compose ;
@@ -54,27 +51,52 @@ M: no-inverse summary
 : ?word-prop ( word/object name -- value/f )
     over word? [ word-prop ] [ 2drop f ] if ;
 
-GENERIC: inverse ( revquot word -- revquot* quot )
-
-DEFER: [undo]
-
-M: word inverse
-    dup "inverse" word-prop [ ]
-    [ dup primitive? [ no-inverse ] [ word-def [undo] ] if ] ?if ;
-
 : undo-literal ( object -- quot )
     [ =/fail ] curry ;
 
+PREDICATE: word normal-inverse "inverse" word-prop ;
+PREDICATE: word math-inverse "math-inverse" word-prop ;
+PREDICATE: word pop-inverse "pop-length" word-prop ;
+UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
+
+: inline-word ( word -- )
+    {
+        { [ dup word? not over symbol? or ] [ , ] }
+        { [ dup explicit-inverse? ] [ , ] }
+        { [ dup compound? over { if dispatch } member? not and ]
+          [ word-def [ inline-word ] each ] }
+        { [ drop t ] [ "Quotation is not invertible" throw ] }
+    } cond ;
+
+: math-exp? ( n n word -- ? )
+    { + - * / ^ } member? -rot [ number? ] 2apply and and ;
+
+: (fold-constants) ( quot -- )
+    dup length 3 < [ % ] [
+        dup first3 3dup math-exp?
+        [ execute , 3 ] [ 2drop , 1 ] if
+        tail-slice (fold-constants) 
+    ] if ;
+
+: fold-constants ( quot -- folded )
+    [ (fold-constants) ] [ ] make ;
+
+: do-inlining ( quot -- inlined-quot )
+    [ [ inline-word ] each ] [ ] make fold-constants ;
+
+GENERIC: inverse ( revquot word -- revquot* quot )
+
 M: object inverse undo-literal ;
 M: symbol inverse undo-literal ;
 
-PREDICATE: word math-inverse "math-inverse" word-prop ;
+M: normal-inverse inverse
+    "inverse" word-prop ;
+
 M: math-inverse inverse
     "math-inverse" word-prop
     swap next dup \ swap =
     [ drop swap-inverse ] [ pull-inverse ] if ;
 
-PREDICATE: word pop-inverse "pop-length" word-prop ;
 M: pop-inverse inverse
     [ "pop-length" word-prop cut-slice swap ] keep
     "pop-inverse" word-prop compose call ;
@@ -84,7 +106,7 @@ M: pop-inverse inverse
     [ unclip-slice inverse % (undo) ] if ;
 
 : [undo] ( quot -- undo )
-    reverse [ (undo) ] [ ] make ;
+    do-inlining reverse [ (undo) ] [ ] make ;
 
 MACRO: undo ( quot -- ) [undo] ;
 

From 33fecfef7d547ff7819325fab00a1e2d808dd69e Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-24.local>
Date: Thu, 29 Nov 2007 12:19:57 -0500
Subject: [PATCH 4/4] Fixed radians and steradians to be unitless

---
 extra/units/si/si.factor | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/extra/units/si/si.factor b/extra/units/si/si.factor
index c07ffb8423..9029d6bd35 100644
--- a/extra/units/si/si.factor
+++ b/extra/units/si/si.factor
@@ -38,8 +38,11 @@ IN: units.si
 : cd/m^2 { cd } { m m } <dimensioned> ;
 : kg/kg { kg } { kg } <dimensioned> ;
 
-: radians ( n -- radian ) { m } { m } <dimensioned> ;
-: sr ( n -- steradian ) { m m } { m m } <dimensioned> ;
+! Radians are really m/m, and steradians are m^2/m^2
+! but they need to be in reduced form here.
+: radians ( n -- radian ) scalar ;
+: sr ( n -- steradian ) scalar ;
+
 : Hz ( n -- hertz ) { } { s } <dimensioned> ;
 : N ( n -- newton ) { kg m } { s s } <dimensioned> ;
 : Pa ( n -- pascal ) { kg } { m s s } <dimensioned> ;