inverse: Add `under`

diff --git a/basis/inverse/inverse-docs.factor b/basis/inverse/inverse-docs.factor
index adda3838cc03234966968c9b1cc791c5ad46824e..47b5e1184d38dba864d12e933eb58527dd004eab 100644 (file)
--- a/basis/inverse/inverse-docs.factor
+++ b/basis/inverse/inverse-docs.factor
@@ -48,6 +48,18 @@ HELP: switch
 "    } switch ;" }
 { $see-also undo } ;
 
+HELP: under
+{ $values { "invertible-quot" "" } { "quot" "" } }
+{ $description "Applies " { $snippet "invertible-quot" } ", then " { $snippet "quot" } " and finally the inverse of " { $snippet "invertible-quot" } "." }
+{ $examples
+    "Round a decimal number to two decimals:"
+    { $example
+        "USING: inverse math math.functions prettyprint ;"
+        "123.456 [ 100 * ] [ round ] under ."
+        "123.46"
+    }
+} ;
+
 ARTICLE: { "inverse" "intro" } "Invertible quotations"
 "The inverse vocab defines a way to 'undo' quotations, and builds a pattern matching framework on that basis. A quotation can be inverted by reversing it and inverting each word. To define the inverse for particular word, use"
 { $subsections

diff --git a/basis/inverse/inverse-tests.factor b/basis/inverse/inverse-tests.factor
index 04db91310840b134ae5052d09dc6bfc32c639974..c619156b8a0c950e4afffb29edb7bfa9270f82df 100644 (file)
--- a/basis/inverse/inverse-tests.factor
+++ b/basis/inverse/inverse-tests.factor
@@ -97,3 +97,5 @@ TUPLE: funny-tuple ;
 
 { 0 } [ { 1 2 } [ [ 1 + 2 ] { } output>sequence ] undo ] unit-test
 { { 0 1 } } [ 1 2 [ [ [ 1 + ] bi@ ] input<sequence ] undo ] unit-test
+
+{ 123.46 } [ 123.456 [ 100 * ] [ round ] under ] unit-test

diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor
index 3a442db48e512bae153aae5e4fc00e64df7fc870..33954c7634701a74a0ae6b8a0686f9fe815e1316 100644 (file)
--- a/basis/inverse/inverse.factor
+++ b/basis/inverse/inverse.factor
@@ -291,3 +291,6 @@ MACRO: switch ( quot-alist -- quot ) [switch] ;
 SYNTAX: INVERSE: scan-word parse-definition define-inverse ;
 
 SYNTAX: DUAL: scan-word scan-word define-dual ;
+
+MACRO: under ( reversible-quot quot -- quot )
+    over [undo] '[ @ @ @ ] ;