From 1bb48ec9ea527b3bef19cf89f82a7429cbca09d7 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Wed, 9 Sep 2009 10:44:41 -0400 Subject: [PATCH 01/20] Changed Browser's "Up:" links to a traditional breadcrumbs list. Tweaked a few colors in the Factor UI. --- basis/help/help.factor | 16 +++++++++------- basis/help/markup/markup.factor | 8 +++++++- basis/help/stylesheet/stylesheet.factor | 5 +++-- basis/io/styles/styles-docs.factor | 7 +++++++ basis/io/styles/styles.factor | 3 +++ 5 files changed, 29 insertions(+), 10 deletions(-) diff --git a/basis/help/help.factor b/basis/help/help.factor index 6e09e298f4..c7e7f225dc 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -101,19 +101,21 @@ M: word set-article-parent swap "help-parent" set-word-prop ; : $navigation-table ( topic -- ) [ - [ help-path [ \ $links "Up:" $navigation-row ] unless-empty ] [ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ] [ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ] - tri + bi ] { } make [ $table ] unless-empty ; +: ($navigation) ( topic -- ) + help-path-style get [ + [ help-path [ reverse $breadcrumbs ] unless-empty ] + [ $navigation-table ] bi + ] with-style ; + : $title ( topic -- ) title-style get [ - title-style get [ - [ ($title) ] - [ help-path-style get [ $navigation-table ] with-style ] bi - ] with-nesting - ] with-style nl ; + [ ($title) ] [ ($navigation) ] bi + ] with-nested-style nl ; : print-topic ( topic -- ) >link diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 6e75adc8aa..c64f315d6d 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -205,8 +205,11 @@ ALIAS: $slot $snippet "Vocabulary" $heading nl dup ($vocab-link) ] when* ; +: (textual-list) ( seq quot sep -- ) + '[ _ print-element ] swap interleave ; inline + : textual-list ( seq quot -- ) - [ ", " print-element ] swap interleave ; inline + ", " (textual-list) ; inline : $links ( topics -- ) [ [ ($link) ] textual-list ] ($span) ; @@ -214,6 +217,9 @@ ALIAS: $slot $snippet : $vocab-links ( vocabs -- ) [ vocab ] map $links ; +: $breadcrumbs ( topics -- ) + [ [ ($link) ] " > " (textual-list) ] ($span) ; + : $see-also ( topics -- ) "See also" $heading $links ; diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor index 6c0b18e8e9..7f7975a652 100644 --- a/basis/help/stylesheet/stylesheet.factor +++ b/basis/help/stylesheet/stylesheet.factor @@ -30,10 +30,10 @@ H{ { font-style bold } } strong-style set-global SYMBOL: title-style H{ { font-name "sans-serif" } - { font-size 18 } + { font-size 20 } { font-style bold } { wrap-margin 500 } - { foreground COLOR: FactorDarkSlateBlue } + { foreground COLOR: gray20 } { page-color COLOR: FactorLightTan } { border-width 5 } } title-style set-global @@ -46,6 +46,7 @@ H{ { font-name "sans-serif" } { font-size 16 } { font-style bold } + { foreground COLOR: FactorDarkSlateBlue } } heading-style set-global SYMBOL: subsection-style diff --git a/basis/io/styles/styles-docs.factor b/basis/io/styles/styles-docs.factor index 8fcf12aae9..a952c05dbf 100755 --- a/basis/io/styles/styles-docs.factor +++ b/basis/io/styles/styles-docs.factor @@ -90,6 +90,13 @@ HELP: with-style { $notes "Details are in the documentation for " { $link make-span-stream } "." } $io-error ; +HELP: with-nested-style +{ $values { "style" assoc } { "quot" quotation } } +{ $description "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "." } +$nl +"This word is intended to be used when you have a single style assoc that contains both character and paragraph styles." +$io-error ; + ARTICLE: "formatted-stream-protocol" "Formatted stream protocol" "The " { $vocab-link "io.styles" } " vocabulary defines a protocol for output streams that support rich text." { $subsection stream-format } diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor index 2d25016919..108d4c9eb0 100644 --- a/basis/io/styles/styles.factor +++ b/basis/io/styles/styles.factor @@ -42,6 +42,9 @@ make-cell-stream stream-write-table ; [ output-stream get make-block-stream ] dip with-output-stream ; inline +: with-nested-style ( style quot -- ) + over [ with-nesting ] with-style ; inline + TUPLE: filter-writer stream ; CONSULT: output-stream-protocol filter-writer stream>> ; From 28b8703b5bb61b97a84ac3299f6b79612bd75e3e Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Wed, 9 Sep 2009 13:33:40 -0400 Subject: [PATCH 02/20] help.html: link color now matches help.stylesheet link color --- basis/help/html/stylesheet.css | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/help/html/stylesheet.css b/basis/help/html/stylesheet.css index ff657d634e..c56a19bc9a 100644 --- a/basis/help/html/stylesheet.css +++ b/basis/help/html/stylesheet.css @@ -1,4 +1,4 @@ -a:link { text-decoration: none; color: #00004c; } -a:visited { text-decoration: none; color: #00004c; } -a:active { text-decoration: none; color: #00004c; } -a:hover { text-decoration: underline; color: #00004c; } +a:link { text-decoration: none; color: #104e8b; } +a:visited { text-decoration: none; color: #104e8b; } +a:active { text-decoration: none; color: #104e8b; } +a:hover { text-decoration: underline; color: #104e8b; } From 5421f4fcb488b885393651c8f00dcc2c91ce2760 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Wed, 9 Sep 2009 15:27:49 -0400 Subject: [PATCH 03/20] prettyprint.stylesheet: USING/USE/IN are now dimmed out. Added documentation. --- .../stylesheet/stylesheet-docs.factor | 44 +++++++++++++++++++ .../prettyprint/stylesheet/stylesheet.factor | 28 +++++++++--- basis/prettyprint/stylesheet/summary.txt | 1 + 3 files changed, 67 insertions(+), 6 deletions(-) create mode 100644 basis/prettyprint/stylesheet/stylesheet-docs.factor create mode 100644 basis/prettyprint/stylesheet/summary.txt diff --git a/basis/prettyprint/stylesheet/stylesheet-docs.factor b/basis/prettyprint/stylesheet/stylesheet-docs.factor new file mode 100644 index 0000000000..4f7a7f2141 --- /dev/null +++ b/basis/prettyprint/stylesheet/stylesheet-docs.factor @@ -0,0 +1,44 @@ +! Copyright (C) 2009 Your name. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel words ; +IN: prettyprint.stylesheet + +HELP: effect-style +{ $values + { "effect" "an effect" } + { "style" "a style assoc" } +} +{ $description "The styling hook for stack effects" } ; + +HELP: string-style +{ $values + { "str" "a string" } + { "style" "a style assoc" } +} +{ $description "The styling hook for string literals" } ; + +HELP: vocab-style +{ $values + { "vocab" "a vocabulary specifier" } + { "style" "a style assoc" } +} +{ $description "The styling hook for vocab names" } ; + +HELP: word-style +{ $values + { "word" "a word" } + { "style" "a style assoc" } +} +{ $description "The styling hook for word names" } ; + +ARTICLE: "prettyprint.stylesheet" "Prettyprinter Formatted Output" +{ $vocab-link "prettyprint.stylesheet" } +$nl +"Control the way that the prettyprinter formats output based on object type. These hooks form a basic \"syntax\" highlighting system." +{ $subsection word-style } +{ $subsection string-style } +{ $subsection vocab-style } +{ $subsection effect-style } +; + +ABOUT: "prettyprint.stylesheet" diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor index 2be959cc9b..eaed7cba0c 100644 --- a/basis/prettyprint/stylesheet/stylesheet.factor +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -1,16 +1,32 @@ ! Copyright (C) 2009 Your name. ! See http://factorcode.org/license.txt for BSD license. -USING: colors.constants hashtables io.styles kernel namespaces -words words.symbol ; +USING: colors.constants combinators combinators.short-circuit +hashtables io.styles kernel namespaces sequences words +words.symbol ; IN: prettyprint.stylesheet + + : word-style ( word -- style ) dup "word-style" word-prop >hashtable [ [ [ presented set ] [ - [ parsing-word? ] [ delimiter? ] [ symbol? ] tri - or or [ COLOR: DarkSlateGray ] [ COLOR: black ] if - foreground set + { + { [ dup parsing-word? ] [ parsing-word-color ] } + { [ dup delimiter? ] [ drop COLOR: DarkSlateGray ] } + { [ dup symbol? ] [ drop COLOR: DarkSlateGray ] } + [ drop COLOR: black ] + } cond foreground set ] bi ] bind ] keep ; @@ -24,7 +40,7 @@ IN: prettyprint.stylesheet : vocab-style ( vocab -- style ) [ presented set - COLOR: cornsilk4 foreground set + dim-color foreground set ] H{ } make-assoc ; : effect-style ( effect -- style ) diff --git a/basis/prettyprint/stylesheet/summary.txt b/basis/prettyprint/stylesheet/summary.txt new file mode 100644 index 0000000000..39a50c8d9f --- /dev/null +++ b/basis/prettyprint/stylesheet/summary.txt @@ -0,0 +1 @@ +prettyprinter syntax highlighting and formatted output From a96e828d7cde5050b6a3b287ff906d655c24d1b8 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Wed, 9 Sep 2009 15:50:25 -0400 Subject: [PATCH 04/20] io.styles: renamed the 'border-width' style to 'inset'. inset takes a pair of 2 numbers (horizontal and vertical insets) --- basis/help/stylesheet/stylesheet.factor | 8 ++++---- basis/help/tips/tips.factor | 2 +- basis/html/streams/streams.factor | 5 +++-- basis/io/styles/styles-docs.factor | 8 ++++---- basis/io/styles/styles.factor | 2 +- basis/ui/gadgets/panes/panes.factor | 6 +++--- 6 files changed, 16 insertions(+), 15 deletions(-) diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor index 7f7975a652..c2e8e98476 100644 --- a/basis/help/stylesheet/stylesheet.factor +++ b/basis/help/stylesheet/stylesheet.factor @@ -35,7 +35,7 @@ H{ { wrap-margin 500 } { foreground COLOR: gray20 } { page-color COLOR: FactorLightTan } - { border-width 5 } + { inset { 5 5 } } } title-style set-global SYMBOL: help-path-style @@ -72,7 +72,7 @@ H{ SYMBOL: code-style H{ { page-color COLOR: FactorLightTan } - { border-width 5 } + { inset { 5 5 } } { wrap-margin f } } code-style set-global @@ -89,7 +89,7 @@ SYMBOL: warning-style H{ { page-color COLOR: gray90 } { border-color COLOR: red } - { border-width 5 } + { inset { 5 5 } } { wrap-margin 500 } } warning-style set-global @@ -97,7 +97,7 @@ SYMBOL: deprecated-style H{ { page-color COLOR: gray90 } { border-color COLOR: red } - { border-width 5 } + { inset { 5 5 } } { wrap-margin 500 } } deprecated-style set-global diff --git a/basis/help/tips/tips.factor b/basis/help/tips/tips.factor index 4685b6c517..8569be0b8f 100644 --- a/basis/help/tips/tips.factor +++ b/basis/help/tips/tips.factor @@ -30,7 +30,7 @@ SYMBOL: tip-of-the-day-style H{ { page-color COLOR: lavender } - { border-width 5 } + { inset { 5 5 } } { wrap-margin 500 } } tip-of-the-day-style set-global diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor index 49a9225402..26a3d5f391 100644 --- a/basis/html/streams/streams.factor +++ b/basis/html/streams/streams.factor @@ -99,7 +99,8 @@ M: html-span-stream dispose : border-css, ( border -- ) "border: 1px solid #" % hex-color, "; " % ; -: padding-css, ( padding -- ) "padding: " % # "px; " % ; +: padding-css, ( padding -- ) + first2 "padding: " % # "px " % # "px; " % ; CONSTANT: pre-css "white-space: pre; font-family: monospace;" @@ -108,7 +109,7 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace;" { { page-color bg-css, } { border-color border-css, } - { border-width padding-css, } + { inset padding-css, } } make-css ] [ wrap-margin swap at diff --git a/basis/io/styles/styles-docs.factor b/basis/io/styles/styles-docs.factor index a952c05dbf..19952b2b15 100755 --- a/basis/io/styles/styles-docs.factor +++ b/basis/io/styles/styles-docs.factor @@ -140,7 +140,7 @@ ARTICLE: "paragraph-styles" "Paragraph styles" "Paragraph styles for " { $link with-nesting } ":" { $subsection page-color } { $subsection border-color } -{ $subsection border-width } +{ $subsection inset } { $subsection wrap-margin } { $subsection presented } ; @@ -250,10 +250,10 @@ HELP: border-color { $code "H{ { border-color T{ rgba f 1 0 0 1 } } }\n[ \"A border\" write ] with-nesting nl" } } ; -HELP: border-width -{ $description "Paragraph style. Pixels between edge of text and border, an integer." } +HELP: inset +{ $description "Paragraph style. A pair of integers representing the number of pixels that the content should be inset from the border. The first number is the horizontal inset, and the second is the vertical inset." } { $examples - { $code "H{ { border-width 10 } }\n[ \"Some inset text\" write ] with-nesting nl" } + { $code "H{ { inset { 10 10 } } }\n[ \"Some inset text\" write ] with-nesting nl" } } ; HELP: wrap-margin diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor index 108d4c9eb0..a3a1d991f3 100644 --- a/basis/io/styles/styles.factor +++ b/basis/io/styles/styles.factor @@ -135,7 +135,7 @@ SYMBOL: image ! Paragraph styles SYMBOL: page-color SYMBOL: border-color -SYMBOL: border-width +SYMBOL: inset SYMBOL: wrap-margin ! Table styles diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 6f68c32ff0..50a609b897 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -242,11 +242,11 @@ MEMO: specified-font ( assoc -- font ) : apply-page-color-style ( style gadget -- style gadget ) page-color [ >>interior ] apply-style ; -: apply-border-width-style ( style gadget -- style gadget ) - border-width [ dup 2array ] apply-style ; +: apply-inset-style ( style gadget -- style gadget ) + inset [ ] apply-style ; : style-pane ( style pane -- pane ) - apply-border-width-style + apply-inset-style apply-border-color-style apply-page-color-style apply-presentation-style From 51f40e27271b0e8c2b9cc66e644ddd6737fa1e99 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Wed, 9 Sep 2009 16:33:40 -0400 Subject: [PATCH 05/20] vocabs.prettyprint: made the auto-use vocab box a little easier to read --- basis/colors/constants/factor-colors.txt | 1 + basis/vocabs/prettyprint/prettyprint.factor | 5 ++++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/colors/constants/factor-colors.txt b/basis/colors/constants/factor-colors.txt index 9d7649ab3d..c032aae5c4 100644 --- a/basis/colors/constants/factor-colors.txt +++ b/basis/colors/constants/factor-colors.txt @@ -1,4 +1,5 @@ ! Factor UI theme colors +243 242 234 FactorLightLightTan 227 226 219 FactorLightTan 172 167 147 FactorDarkTan 81 91 105 FactorLightSlateBlue diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor index 2813485da3..3c5059b5c0 100644 --- a/basis/vocabs/prettyprint/prettyprint.factor +++ b/basis/vocabs/prettyprint/prettyprint.factor @@ -4,6 +4,7 @@ USING: accessors arrays assocs colors colors.constants fry io io.styles kernel make math.order namespaces parser prettyprint.backend prettyprint.sections prettyprint.stylesheet sequences sets sorting vocabs vocabs.parser ; +FROM: io.styles => inset ; IN: vocabs.prettyprint : pprint-vocab ( vocab -- ) @@ -86,7 +87,9 @@ PRIVATE> "To avoid doing this in the future, add the following forms" print "at the top of the source file:" print nl ] with-style - { { page-color COLOR: FactorLightTan } } + { { page-color COLOR: FactorLightLightTan } + { border-color COLOR: FactorDarkTan } + { inset { 5 5 } } } [ manifest get pprint-manifest ] with-nesting nl nl ] print-use-hook set-global \ No newline at end of file From 6fdd005b5c0a19960bf06ab2779007569203fd94 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Wed, 9 Sep 2009 16:46:05 -0400 Subject: [PATCH 06/20] prettyprint.stylesheet: fixed an error found by help-lint --- basis/prettyprint/stylesheet/stylesheet.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor index eaed7cba0c..f04893fab3 100644 --- a/basis/prettyprint/stylesheet/stylesheet.factor +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -31,7 +31,7 @@ PRIVATE> ] bind ] keep ; -: string-style ( obj -- style ) +: string-style ( str -- style ) [ presented set COLOR: LightSalmon4 foreground set From e1979f5ad55aac4e043f801122e4bf144f739b99 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Thu, 10 Sep 2009 09:48:20 -0400 Subject: [PATCH 07/20] help browser: tweaked the colors based on user feedback. The USING: line should be easier to read now. I also decided to stop highlighting symbols. --- basis/help/help.factor | 5 +++- basis/help/stylesheet/stylesheet.factor | 12 ++++++---- .../prettyprint/stylesheet/stylesheet.factor | 23 ++++++++++--------- 3 files changed, 24 insertions(+), 16 deletions(-) diff --git a/basis/help/help.factor b/basis/help/help.factor index c7e7f225dc..214ff14632 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -99,12 +99,15 @@ M: word set-article-parent swap "help-parent" set-word-prop ; : $navigation-row ( content element label -- ) [ prefix 1array ] dip prefix , ; +: ($navigation-table) ( element -- ) + help-path-style get table-style set [ $table ] with-scope ; + : $navigation-table ( topic -- ) [ [ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ] [ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ] bi - ] { } make [ $table ] unless-empty ; + ] { } make [ ($navigation-table) ] unless-empty ; : ($navigation) ( topic -- ) help-path-style get [ diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor index c2e8e98476..2475fba0f6 100644 --- a/basis/help/stylesheet/stylesheet.factor +++ b/basis/help/stylesheet/stylesheet.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.styles namespaces colors colors.constants ; +USING: colors colors.constants io.styles literals namespaces ; IN: help.stylesheet SYMBOL: default-span-style @@ -34,12 +34,16 @@ H{ { font-style bold } { wrap-margin 500 } { foreground COLOR: gray20 } - { page-color COLOR: FactorLightTan } + { page-color COLOR: FactorLightLightTan } { inset { 5 5 } } } title-style set-global SYMBOL: help-path-style -H{ { font-size 10 } } help-path-style set-global +H{ + { font-size 10 } + { table-gap { 5 5 } } + { table-border $ transparent } +} help-path-style set-global SYMBOL: heading-style H{ @@ -71,7 +75,7 @@ H{ SYMBOL: code-style H{ - { page-color COLOR: FactorLightTan } + { page-color COLOR: FactorLightLightTan } { inset { 5 5 } } { wrap-margin f } } code-style set-global diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor index f04893fab3..fbd95ecbd2 100644 --- a/basis/prettyprint/stylesheet/stylesheet.factor +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -7,27 +7,28 @@ IN: prettyprint.stylesheet : word-style ( word -- style ) dup "word-style" word-prop >hashtable [ [ - [ presented set ] [ - { - { [ dup parsing-word? ] [ parsing-word-color ] } - { [ dup delimiter? ] [ drop COLOR: DarkSlateGray ] } - { [ dup symbol? ] [ drop COLOR: DarkSlateGray ] } - [ drop COLOR: black ] - } cond foreground set - ] bi + [ presented set ] [ word-color foreground set ] bi ] bind ] keep ; From 65e9c29a7bcd04b4cd3510805ded6feb363424c3 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Fri, 11 Sep 2009 20:35:56 -0400 Subject: [PATCH 08/20] io.styles: bailed out on the with-nested-styles combinator --- basis/help/help.factor | 6 ++++-- basis/io/styles/styles-docs.factor | 7 ------- basis/io/styles/styles.factor | 3 --- 3 files changed, 4 insertions(+), 12 deletions(-) diff --git a/basis/help/help.factor b/basis/help/help.factor index 214ff14632..e31c705e26 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -117,8 +117,10 @@ M: word set-article-parent swap "help-parent" set-word-prop ; : $title ( topic -- ) title-style get [ - [ ($title) ] [ ($navigation) ] bi - ] with-nested-style nl ; + title-style get [ + [ ($title) ] [ ($navigation) ] bi + ] with-nesting + ] with-style nl ; : print-topic ( topic -- ) >link diff --git a/basis/io/styles/styles-docs.factor b/basis/io/styles/styles-docs.factor index 19952b2b15..8d29cffb04 100755 --- a/basis/io/styles/styles-docs.factor +++ b/basis/io/styles/styles-docs.factor @@ -90,13 +90,6 @@ HELP: with-style { $notes "Details are in the documentation for " { $link make-span-stream } "." } $io-error ; -HELP: with-nested-style -{ $values { "style" assoc } { "quot" quotation } } -{ $description "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "." } -$nl -"This word is intended to be used when you have a single style assoc that contains both character and paragraph styles." -$io-error ; - ARTICLE: "formatted-stream-protocol" "Formatted stream protocol" "The " { $vocab-link "io.styles" } " vocabulary defines a protocol for output streams that support rich text." { $subsection stream-format } diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor index a3a1d991f3..b141d8d2f7 100644 --- a/basis/io/styles/styles.factor +++ b/basis/io/styles/styles.factor @@ -42,9 +42,6 @@ make-cell-stream stream-write-table ; [ output-stream get make-block-stream ] dip with-output-stream ; inline -: with-nested-style ( style quot -- ) - over [ with-nesting ] with-style ; inline - TUPLE: filter-writer stream ; CONSULT: output-stream-protocol filter-writer stream>> ; From 0e176d8de7027985592bf9d2349dfc0199f3d8a2 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Fri, 11 Sep 2009 21:45:03 -0400 Subject: [PATCH 09/20] prettyprint.stylesheet: more idiomatic Factor style (thanks Slava) --- .../prettyprint/stylesheet/stylesheet.factor | 63 +++++++++---------- 1 file changed, 29 insertions(+), 34 deletions(-) diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor index fbd95ecbd2..a593f23d99 100644 --- a/basis/prettyprint/stylesheet/stylesheet.factor +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -1,51 +1,46 @@ -! Copyright (C) 2009 Your name. +! Copyright (C) 2009 Keith Lazuka. ! See http://factorcode.org/license.txt for BSD license. -USING: colors.constants combinators combinators.short-circuit -hashtables io.styles kernel namespaces sequences words -words.symbol ; +USING: assocs colors.constants combinators +combinators.short-circuit hashtables io.styles kernel literals +namespaces sequences words words.symbol ; IN: prettyprint.stylesheet -: word-style ( word -- style ) - dup "word-style" word-prop >hashtable [ - [ - [ presented set ] [ word-color foreground set ] bi - ] bind - ] keep ; +GENERIC: word-style ( word -- style ) + +M: word word-style + [ presented associate ] + [ "word-style" word-prop >hashtable ] bi assoc-union ; + +M: highlighted-word word-style + call-next-method COLOR: DarkSlateGray foreground associate + swap assoc-union ; + + : string-style ( str -- style ) - [ - presented set - COLOR: LightSalmon4 foreground set - ] H{ } make-assoc ; + COLOR: LightSalmon4 colored-presentation-style ; : vocab-style ( vocab -- style ) - [ - presented set - dim-color foreground set - ] H{ } make-assoc ; + dim-color colored-presentation-style ; : effect-style ( effect -- style ) - [ - presented set - COLOR: DarkGreen foreground set - ] H{ } make-assoc ; \ No newline at end of file + COLOR: DarkGreen colored-presentation-style ; From 12446adfc248ad263ef621cfed00444cf305d1e6 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Fri, 11 Sep 2009 21:46:16 -0400 Subject: [PATCH 10/20] vocabs.prettyprint: fixed indentation --- basis/vocabs/prettyprint/prettyprint.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor index 3c5059b5c0..6b759dddde 100644 --- a/basis/vocabs/prettyprint/prettyprint.factor +++ b/basis/vocabs/prettyprint/prettyprint.factor @@ -87,9 +87,10 @@ PRIVATE> "To avoid doing this in the future, add the following forms" print "at the top of the source file:" print nl ] with-style - { { page-color COLOR: FactorLightLightTan } - { border-color COLOR: FactorDarkTan } - { inset { 5 5 } } } - [ manifest get pprint-manifest ] with-nesting + { + { page-color COLOR: FactorLightLightTan } + { border-color COLOR: FactorDarkTan } + { inset { 5 5 } } + } [ manifest get pprint-manifest ] with-nesting nl nl ] print-use-hook set-global \ No newline at end of file From 51dd22b119609289e76c5bbdaa9d76b2930c8075 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 12:57:15 -0500 Subject: [PATCH 11/20] math.floats.env.ppc: fix ppc-fp-traps>bit --- basis/math/floats/env/ppc/ppc.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/math/floats/env/ppc/ppc.factor b/basis/math/floats/env/ppc/ppc.factor index f834d4971a..c4c81471ca 100644 --- a/basis/math/floats/env/ppc/ppc.factor +++ b/basis/math/floats/env/ppc/ppc.factor @@ -31,14 +31,14 @@ CONSTANT: ppc-exception-flag>bit { +fp-inexact+ HEX: 0200,0000 } } -CONSTANT: ppc-fp-traps-bits HEX: f800 +CONSTANT: ppc-fp-traps-bits HEX: f8 CONSTANT: ppc-fp-traps>bit H{ - { +fp-invalid-operation+ HEX: 8000 } - { +fp-overflow+ HEX: 4000 } - { +fp-underflow+ HEX: 2000 } - { +fp-zero-divide+ HEX: 1000 } - { +fp-inexact+ HEX: 0800 } + { +fp-invalid-operation+ HEX: 80 } + { +fp-overflow+ HEX: 40 } + { +fp-underflow+ HEX: 20 } + { +fp-zero-divide+ HEX: 10 } + { +fp-inexact+ HEX: 08 } } CONSTANT: ppc-rounding-mode-bits HEX: 3 @@ -58,9 +58,9 @@ M: ppc-fpu-env (set-exception-flags) ( register exceptions -- register' ) [ ppc-exception-flag>bit >mask ppc-exception-flag-bits remask ] curry change-fpscr ; inline M: ppc-fpu-env (get-fp-traps) ( register -- exceptions ) - fpscr>> bitnot ppc-fp-traps>bit mask> ; inline + fpscr>> ppc-fp-traps>bit mask> ; inline M: ppc-fpu-env (set-fp-traps) ( register exceptions -- register' ) - [ ppc-fp-traps>bit >mask bitnot ppc-fp-traps-bits remask ] curry change-fpscr ; inline + [ ppc-fp-traps>bit >mask ppc-fp-traps-bits remask ] curry change-fpscr ; inline M: ppc-fpu-env (get-rounding-mode) ( register -- mode ) fpscr>> ppc-rounding-mode-bits mask ppc-rounding-mode>bit value-at ; inline From 78e5dfcc8b884f652f1a6dc7a4ad0e9365aa6a08 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 12:58:36 -0500 Subject: [PATCH 12/20] benchmark.euler186: remove this too --- extra/benchmark/euler186/euler186.factor | 7 ------- 1 file changed, 7 deletions(-) delete mode 100644 extra/benchmark/euler186/euler186.factor diff --git a/extra/benchmark/euler186/euler186.factor b/extra/benchmark/euler186/euler186.factor deleted file mode 100644 index 681ca0e269..0000000000 --- a/extra/benchmark/euler186/euler186.factor +++ /dev/null @@ -1,7 +0,0 @@ -IN: benchmark.euler186 -USING: kernel project-euler.186 ; - -: euler186-benchmark ( -- ) - euler186 2325629 assert= ; - -MAIN: euler186-benchmark From 7ae147c3bfd1a49933b551dc623fca3f6aec45a5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 13:24:45 -0500 Subject: [PATCH 13/20] tools.deploy.test: cut Windows some slack --- basis/tools/deploy/test/test.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) mode change 100644 => 100755 basis/tools/deploy/test/test.factor diff --git a/basis/tools/deploy/test/test.factor b/basis/tools/deploy/test/test.factor old mode 100644 new mode 100755 index 28916033d4..6a6f9cf8fd --- a/basis/tools/deploy/test/test.factor +++ b/basis/tools/deploy/test/test.factor @@ -12,7 +12,11 @@ IN: tools.deploy.test : small-enough? ( n -- ? ) [ "test.image" temp-file file-info size>> ] - [ cell 4 / * cpu ppc? [ 100000 + ] when ] bi* + [ + cell 4 / * + cpu ppc? [ 100000 + ] when + os windows? [ 150000 + ] when + ] bi* <= ; : run-temp-image ( -- ) From 74cebff3712ad6a2ea3aef74358ed99a0db8eff5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 13:25:31 -0500 Subject: [PATCH 14/20] windows.dinput.constants: fix load error --- basis/windows/dinput/constants/constants.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index e0bfafc5c4..b67b5fa08f 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -49,7 +49,7 @@ MEMO: heap-size* ( c-type -- n ) heap-size ; } cleave DIOBJECTDATAFORMAT ; -:: malloc-DIOBJECTDATAFORMAT-array ( struct array -- alien ) +:: make-DIOBJECTDATAFORMAT-array ( struct array -- alien ) [let | alien [ array length malloc-DIOBJECTDATAFORMAT-array ] | array [| args i | struct args @@ -60,7 +60,7 @@ MEMO: heap-size* ( c-type -- n ) heap-size ; : ( dwFlags dwDataSize struct rgodf-array -- alien ) [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip - [ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi + [ nip length ] [ make-DIOBJECTDATAFORMAT-array ] 2bi DIDATAFORMAT ; : initialize ( symbol quot -- ) From 3c55e7fe0c20d092045d727491d1abe5a6e671b6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 15:06:15 -0500 Subject: [PATCH 15/20] Add NAN: literal syntax for NANs with a payload --- basis/prettyprint/backend/backend.factor | 5 +++++ core/bootstrap/syntax.factor | 1 + core/math/math-docs.factor | 27 +++++++++++++++++++++++- core/parser/parser.factor | 5 ++++- core/syntax/syntax-docs.factor | 14 ++++++++++++ core/syntax/syntax.factor | 2 ++ 6 files changed, 52 insertions(+), 2 deletions(-) diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 90e2388934..f8bcb66b1e 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -47,6 +47,11 @@ M: method-body pprint* M: real pprint* number>string text ; +M: float pprint* + dup fp-nan? [ + \ NAN: [ fp-nan-payload >hex text ] pprint-prefix + ] [ call-next-method ] if ; + M: f pprint* drop \ f pprint-word ; : pprint-effect ( effect -- ) diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 906b73934e..57be2fb90f 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -33,6 +33,7 @@ IN: bootstrap.syntax "MAIN:" "MATH:" "MIXIN:" + "NAN:" "OCT:" "P\"" "POSTPONE:" diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index ab2a5ab8be..d98685fb48 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -277,7 +277,32 @@ HELP: fp-bitwise= { "x" float } { "y" float } { "?" boolean } } -{ $description "Compares two floating point numbers for bit equality." } ; +{ $description "Compares two floating point numbers for bit equality." } +{ $notes "Unlike " { $link = } " or " { $link number= } ", this word will consider NaNs with equal payloads to be equal, and positive zero and negative zero to be not equal." } +{ $examples + "Not-a-number equality:" + { $example + "USING: math prettyprint ;" + "0.0 0.0 / dup number= ." + "f" + } + { $example + "USING: math prettyprint ;" + "0.0 0.0 / dup fp-bitwise= ." + "t" + } + "Signed zero equality:" + { $example + "USING: math prettyprint ;" + "-0.0 0.0 fp-bitwise= ." + "f" + } + { $example + "USING: math prettyprint ;" + "-0.0 0.0 = ." + "t" + } +} ; HELP: fp-special? { $values { "x" real } { "?" "a boolean" } } diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 94eb0a865c..276030d770 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -99,8 +99,11 @@ M: f parse-quotation \ ] parse-until >quotation ; ERROR: bad-number ; +: scan-base ( base -- n ) + scan swap base> [ bad-number ] unless* ; + : parse-base ( parsed base -- parsed ) - scan swap base> [ bad-number ] unless* parsed ; + scan-base parsed ; SYMBOL: bootstrap-syntax diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index fd5590fde1..19e644cb68 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -72,6 +72,8 @@ ARTICLE: "syntax-floats" "Float syntax" { "Negative infinity" { $snippet "-1/0." } } { "Not-a-number" { $snippet "0/0." } } } +"A Not-a-number with an arbitrary payload can be parsed in:" +{ $subsection POSTPONE: NAN: } "More information on floats can be found in " { $link "floats" } "." ; ARTICLE: "syntax-complex-numbers" "Complex number syntax" @@ -603,6 +605,18 @@ HELP: BIN: { $description "Adds an integer read from an binary literal to the parse tree." } { $examples { $example "USE: prettyprint" "BIN: 100 ." "4" } } ; +HELP: NAN: +{ $syntax "NAN: payload" } +{ $values { "payload" "64-bit hexadecimal integer" } } +{ $description "Adds a floating point Not-a-Number literal to the parse tree." } +{ $examples + { $example + "USE: prettyprint" + "NAN: deadbeef ." + "NAN: deadbeef" + } +} ; + HELP: GENERIC: { $syntax "GENERIC: word ( stack -- effect )" } { $values { "word" "a new word to define" } } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index f01f90c027..16645e3342 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -73,6 +73,8 @@ IN: bootstrap.syntax "OCT:" [ 8 parse-base ] define-core-syntax "BIN:" [ 2 parse-base ] define-core-syntax + "NAN:" [ 16 scan-base parsed ] define-core-syntax + "f" [ f parsed ] define-core-syntax "t" "syntax" lookup define-singleton-class From a456f79f9c7cd34b9e01bf217f1db35bd4b62129 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 16:59:30 -0400 Subject: [PATCH 16/20] cpu-x86: clear the x87 stack when rewinding; fixes math.floats.env failures on Linux --- vm/cpu-x86.S | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S index 3f2626d405..09e742bed8 100644 --- a/vm/cpu-x86.S +++ b/vm/cpu-x86.S @@ -56,6 +56,11 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot)): ret DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)): + /* clear x87 stack, but preserve rounding mode and exception flags */ + sub $2,STACK_REG + fnstcw (STACK_REG) + fninit + fldcw (STACK_REG) /* rewind_to */ mov ARG1,STACK_REG jmp *QUOT_XT_OFFSET(ARG0) From 87c7f882ca71033b53ff9803e89df221354a99c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 16:05:05 -0500 Subject: [PATCH 17/20] db: fix with-book-db combinator in db tutorial --- basis/db/db-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 154d8961a2..a8b03398c7 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -254,7 +254,7 @@ ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial" { $code <" USING: db.sqlite db io.files ; : with-book-db ( quot -- ) - "book.db" temp-file swap with-db ;"> } + "book.db" temp-file swap with-db ; inline"> } "Now let's create the table manually:" { $code <" "create table books (id integer primary key, title text, author text, date_published timestamp, From 11f984e7343710406531ec13b40dfe86558a1943 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 16:24:07 -0500 Subject: [PATCH 18/20] math.floats: fix abs on floats; -0.0 abs should be 0.0 not -0.0 --- core/math/floats/floats-tests.factor | 8 ++++++++ core/math/floats/floats.factor | 8 ++++++-- core/math/math.factor | 2 +- 3 files changed, 15 insertions(+), 3 deletions(-) diff --git a/core/math/floats/floats-tests.factor b/core/math/floats/floats-tests.factor index de84346a58..220eb33960 100644 --- a/core/math/floats/floats-tests.factor +++ b/core/math/floats/floats-tests.factor @@ -67,3 +67,11 @@ unit-test [ t ] [ 0/0. 1.0 unordered? ] unit-test [ f ] [ 1.0 1.0 unordered? ] unit-test +[ t ] [ -0.0 fp-sign ] unit-test +[ t ] [ -1.0 fp-sign ] unit-test +[ f ] [ 0.0 fp-sign ] unit-test +[ f ] [ 1.0 fp-sign ] unit-test + +[ t ] [ -0.0 abs 0.0 fp-bitwise= ] unit-test +[ 1.5 ] [ -1.5 abs ] unit-test +[ 1.5 ] [ 1.5 abs ] unit-test diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor index aa55e2d0ee..9c49e99231 100644 --- a/core/math/floats/floats.factor +++ b/core/math/floats/floats.factor @@ -50,7 +50,7 @@ M: float fp-snan? M: float fp-infinity? dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ; inline -M: float next-float ( m -- n ) +M: float next-float double>bits dup -0.0 double>bits > [ 1 - bits>double ] [ ! negative non-zero dup -0.0 double>bits = [ drop 0.0 ] [ ! negative zero @@ -60,10 +60,14 @@ M: float next-float ( m -- n ) M: float unordered? [ fp-nan? ] bi@ or ; inline -M: float prev-float ( m -- n ) +M: float prev-float double>bits dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative dup 0.0 double>bits = [ drop -0.0 ] [ ! positive zero 1 - bits>double ! positive non-zero ] if ] if ; inline + +M: float fp-sign double>bits 63 bit? ; inline + +M: float abs double>bits 63 2^ bitnot bitand bits>double ; inline diff --git a/core/math/math.factor b/core/math/math.factor index 4fb39f93f7..900c1e1cee 100755 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -99,13 +99,13 @@ GENERIC: fp-qnan? ( x -- ? ) GENERIC: fp-snan? ( x -- ? ) GENERIC: fp-infinity? ( x -- ? ) GENERIC: fp-nan-payload ( x -- bits ) +GENERIC: fp-sign ( x -- ? ) M: object fp-special? drop f ; inline M: object fp-nan? drop f ; inline M: object fp-qnan? drop f ; inline M: object fp-snan? drop f ; inline M: object fp-infinity? drop f ; inline -M: object fp-nan-payload drop f ; inline : ( payload -- nan ) HEX: 7ff0000000000000 bitor bits>double ; inline From 1337f82ce649335898d4e9fc41a09b5dfb0eff42 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 16:33:42 -0500 Subject: [PATCH 19/20] math.order: better docs --- basis/math/functions/functions-docs.factor | 7 ++---- core/math/order/order-docs.factor | 28 +++++++++++++--------- 2 files changed, 19 insertions(+), 16 deletions(-) diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index 134cbd398c..d61ad9a14a 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -20,10 +20,6 @@ ARTICLE: "arithmetic-functions" "Arithmetic functions" "Computing additive and multiplicative inverses:" { $subsection neg } { $subsection recip } -"Minimum, maximum, clamping:" -{ $subsection min } -{ $subsection max } -{ $subsection clamp } "Complex conjugation:" { $subsection conjugate } "Tests:" @@ -41,7 +37,8 @@ ARTICLE: "arithmetic-functions" "Arithmetic functions" { $subsection truncate } { $subsection round } "Inexact comparison:" -{ $subsection ~ } ; +{ $subsection ~ } +"Numbers implement the " { $link "math.order" } ", therefore operations such as " { $link min } " and " { $link max } " can be used with numbers." ; ARTICLE: "power-functions" "Powers and logarithms" "Squares:" diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor index b2c2eeb973..707dd6b79f 100644 --- a/core/math/order/order-docs.factor +++ b/core/math/order/order-docs.factor @@ -44,39 +44,41 @@ HELP: compare } ; HELP: max -{ $values { "x" real } { "y" real } { "z" real } } -{ $description "Outputs the greatest of two real numbers." } ; +{ $values { "x" object } { "y" object } { "z" object } } +{ $description "Outputs the greatest of two ordered values." } +{ $notes "If one value is a floating point positive zero and the other is a negative zero, the result is undefined." } ; HELP: min -{ $values { "x" real } { "y" real } { "z" real } } -{ $description "Outputs the smallest of two real numbers." } ; +{ $values { "x" object } { "y" object } { "z" object } } +{ $description "Outputs the smallest of two ordered values." } +{ $notes "If one value is a floating point positive zero and the other is a negative zero, the result is undefined." } ; HELP: clamp -{ $values { "x" real } { "min" real } { "max" real } { "y" real } } +{ $values { "x" object } { "min" object } { "max" object } { "y" object } } { $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or outputs one of the endpoints." } ; HELP: between? -{ $values { "x" real } { "y" real } { "z" real } { "?" "a boolean" } } +{ $values { "x" object } { "y" object } { "z" real } { "?" "a boolean" } } { $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." } { $notes "As per the closed interval notation, the end-points are included in the interval." } ; HELP: before? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } } { $description "Tests if " { $snippet "obj1" } " comes before " { $snippet "obj2" } " using an intrinsic total order." } { $notes "Implemented using " { $link <=> } "." } ; HELP: after? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } } { $description "Tests if " { $snippet "obj1" } " comes after " { $snippet "obj2" } " using an intrinsic total order." } { $notes "Implemented using " { $link <=> } "." } ; HELP: before=? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } } { $description "Tests if " { $snippet "obj1" } " comes before or equals " { $snippet "obj2" } " using an intrinsic total order." } { $notes "Implemented using " { $link <=> } "." } ; HELP: after=? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } } { $description "Tests if " { $snippet "obj1" } " comes after or equals " { $snippet "obj2" } " using an intrinsic total order." } { $notes "Implemented using " { $link <=> } "." } ; @@ -100,7 +102,7 @@ ARTICLE: "math.order.example" "Linear order example" } ; ARTICLE: "math.order" "Linear order protocol" -"Some classes have an intrinsic order amongst instances:" +"Some classes define an intrinsic order amongst instances. This includes numbers, sequences (in particular, strings), and words." { $subsection <=> } { $subsection >=< } { $subsection compare } @@ -112,6 +114,10 @@ ARTICLE: "math.order" "Linear order protocol" { $subsection before? } { $subsection after=? } { $subsection before=? } +"Minimum, maximum, clamping:" +{ $subsection min } +{ $subsection max } +{ $subsection clamp } "Out of the above generic words, it suffices to implement " { $link <=> } " alone. The others may be provided as an optimization." { $subsection "math.order.example" } { $see-also "sequences-sorting" } ; From 9ccf5811b30074921912b54207a0e9dfda0f0388 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Sep 2009 18:15:16 -0500 Subject: [PATCH 20/20] vm: fix fp_trap_error() so that it can work properly in signal handlers --- vm/errors.cpp | 6 +++--- vm/mach_signal.cpp | 10 +++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/vm/errors.cpp b/vm/errors.cpp index 1dcee889a3..c9d2a94e56 100644 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -130,9 +130,9 @@ void divide_by_zero_error() general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL); } -void fp_trap_error() +void fp_trap_error(stack_frame *signal_callstack_top) { - general_error(ERROR_FP_TRAP,F,F,NULL); + general_error(ERROR_FP_TRAP,F,F,signal_callstack_top); } PRIMITIVE(call_clear) @@ -158,7 +158,7 @@ void misc_signal_handler_impl() void fp_signal_handler_impl() { - fp_trap_error(); + fp_trap_error(signal_callstack_top); } } diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp index 50a924f8e4..facf512b77 100644 --- a/vm/mach_signal.cpp +++ b/vm/mach_signal.cpp @@ -55,12 +55,12 @@ static void call_fault_handler( MACH_PROGRAM_COUNTER(thread_state) = (cell)memory_signal_handler_impl; } else if(exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV) - { + { MACH_PROGRAM_COUNTER(thread_state) = (cell)fp_signal_handler_impl; - } - else - { - signal_number = exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT; + } + else + { + signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT); MACH_PROGRAM_COUNTER(thread_state) = (cell)misc_signal_handler_impl; } }