From e41a7bb6d626bf7d27cec95205403ba5af30c97f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 19 Mar 2009 16:48:32 -0500 Subject: [PATCH 01/43] site-watcher works again --- extra/site-watcher/db/db.factor | 9 +++++++-- extra/site-watcher/site-watcher-tests.factor | 7 ------- extra/site-watcher/site-watcher.factor | 19 ++++++++++--------- 3 files changed, 17 insertions(+), 18 deletions(-) diff --git a/extra/site-watcher/db/db.factor b/extra/site-watcher/db/db.factor index 0c62c7f791..a1a85f825f 100644 --- a/extra/site-watcher/db/db.factor +++ b/extra/site-watcher/db/db.factor @@ -65,9 +65,9 @@ TUPLE: reporting-site email url up? changed? last-up? error last-error ; update-tuple ; : sites-to-report ( -- seq ) - "select account.email, site.url, site.up, site.changed, site.last_up, site.error, site.last_error from account, site, watching_site where account.account_name = watching_site.account_name and site.site_id = watching_site.site_id and site.changed = '1'" sql-query + "select users.email, site.url, site.up, site.changed, site.last_up, site.error, site.last_error from users, site, watching_site where users.username = watching_site.account_name and site.site_id = watching_site.site_id and site.changed = '1'" sql-query [ [ reporting-site boa ] input dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ; @@ -90,3 +90,8 @@ PRIVATE> : watching-sites ( username -- sites ) f select-tuples [ site-id>> site new swap >>site-id select-tuple ] map ; + +: site-watcher-path ( -- path ) "site-watcher.db" temp-file ; inline + +: with-site-watcher-db ( quot -- ) + site-watcher-path swap with-db ; inline diff --git a/extra/site-watcher/site-watcher-tests.factor b/extra/site-watcher/site-watcher-tests.factor index 68a4a440f6..dde5e65e7e 100644 --- a/extra/site-watcher/site-watcher-tests.factor +++ b/extra/site-watcher/site-watcher-tests.factor @@ -5,13 +5,6 @@ site-watcher.private kernel db io.directories io.files.temp continuations db.sqlite site-watcher.db.private ; IN: site-watcher.tests -: site-watcher-path ( -- path ) "site-watcher.db" temp-file ; inline - -[ site-watcher-path delete-file ] ignore-errors - -: with-sqlite-db ( quot -- ) - site-watcher-path swap with-db ; inline - :: fake-sites ( -- seq ) [ account ensure-table diff --git a/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor index 29a66afb13..4808e7c7eb 100644 --- a/extra/site-watcher/site-watcher.factor +++ b/extra/site-watcher/site-watcher.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alarms arrays calendar combinators -combinators.smart continuations debugger http.client -init io.streams.string kernel locals math math.parser -namespaces sequences site-watcher.db site-watcher.db.private smtp ; +combinators.smart continuations debugger http.client fry +init io.streams.string kernel locals math math.parser db +namespaces sequences site-watcher.db site-watcher.db.private +smtp ; IN: site-watcher SYMBOL: site-watcher-from @@ -44,13 +45,13 @@ SYMBOL: running-site-watcher PRIVATE> -: watch-sites ( -- ) - find-sites check-sites sites-to-report send-reports ; +: watch-sites ( db -- ) + [ find-sites check-sites sites-to-report send-reports ] with-db ; -: run-site-watcher ( -- ) - running-site-watcher get [ - [ watch-sites ] site-watcher-frequency get every - running-site-watcher set-global +: run-site-watcher ( db -- ) + [ running-site-watcher get ] dip '[ + [ _ watch-sites ] site-watcher-frequency get every + running-site-watcher set ] unless ; : stop-site-watcher ( -- ) From ece2eabc39ad424823437fe718bfbb27808aed7d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 19 Mar 2009 16:48:46 -0500 Subject: [PATCH 02/43] call init-db and run-site-watcher from webapps.site-watcher --- extra/webapps/site-watcher/site-watcher.factor | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/extra/webapps/site-watcher/site-watcher.factor b/extra/webapps/site-watcher/site-watcher.factor index af07ccebbb..e220cff1d4 100644 --- a/extra/webapps/site-watcher/site-watcher.factor +++ b/extra/webapps/site-watcher/site-watcher.factor @@ -122,10 +122,12 @@ CONSTANT: site-list-url URL" $site-watcher-app/" site-watcher-db main-responder set-global -: start-site-watcher ( -- ) - start-server ; - : init-db ( -- ) site-watcher-db [ { site account watching-site } [ ensure-table ] each - ] with-db ; \ No newline at end of file + ] with-db ; + +: start-site-watcher ( -- ) + init-db + site-watcher-db run-site-watcher + start-server ; From 54df6bee59a5ef9ba127564ef3cd85b397764cae Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 19 Mar 2009 17:05:08 -0500 Subject: [PATCH 03/43] ping every 5 minutes, not every 10 seconds --- extra/site-watcher/site-watcher.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor index 4808e7c7eb..114cdf3259 100644 --- a/extra/site-watcher/site-watcher.factor +++ b/extra/site-watcher/site-watcher.factor @@ -11,7 +11,7 @@ SYMBOL: site-watcher-from "factor-site-watcher@gmail.com" site-watcher-from set-global SYMBOL: site-watcher-frequency -10 seconds site-watcher-frequency set-global +5 minutes site-watcher-frequency set-global SYMBOL: running-site-watcher [ f running-site-watcher set-global ] "site-watcher" add-init-hook From 054a2e5b7c02eda05de4c67eeb1b169b06c15b44 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Mar 2009 20:40:39 -0500 Subject: [PATCH 04/43] add word to parse robots.txt visit-time --- basis/calendar/format/format.factor | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index 916d3499fe..c2e95f2a9e 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -46,6 +46,11 @@ IN: calendar.format : read-0000 ( -- n ) 4 read string>number ; +: hhmm>timestamp ( hhmm -- timestamp ) + [ + 0 0 0 read-00 read-00 0 instant + ] with-string-reader ; + GENERIC: day. ( obj -- ) M: integer day. ( n -- ) From c626cab383a9f8db56a8de2caee4e0dfe222a47d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Mar 2009 21:56:48 -0500 Subject: [PATCH 05/43] a robots.txt parser --- extra/robots/authors.txt | 1 + extra/robots/robots-tests.factor | 334 +++++++++++++++++++++++++++++++ extra/robots/robots.factor | 68 +++++++ extra/robots/robots.txt | 279 ++++++++++++++++++++++++++ 4 files changed, 682 insertions(+) create mode 100644 extra/robots/authors.txt create mode 100644 extra/robots/robots-tests.factor create mode 100644 extra/robots/robots.factor create mode 100644 extra/robots/robots.txt diff --git a/extra/robots/authors.txt b/extra/robots/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/robots/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/robots/robots-tests.factor b/extra/robots/robots-tests.factor new file mode 100644 index 0000000000..a590d9eee0 --- /dev/null +++ b/extra/robots/robots-tests.factor @@ -0,0 +1,334 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: calendar io.encodings.utf8 io.files robots tools.test ; +IN: robots.tests + +[ +{ "http://www.chiplist.com/sitemap.txt" } +{ + T{ rules + { user-agents V{ "*" } } + { allows V{ } } + { disallows + V{ + "/cgi-bin/" + "/scripts/" + "/ChipList2/scripts/" + "/ChipList2/styles/" + "/ads/" + "/ChipList2/ads/" + "/advertisements/" + "/ChipList2/advertisements/" + "/graphics/" + "/ChipList2/graphics/" + } + } + { visit-time + { + T{ timestamp { hour 2 } } + T{ timestamp { hour 5 } } + } + } + { request-rate 1 } + { crawl-delay 1 } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "UbiCrawler" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "DOC" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Zao" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "sitecheck.internetseer.com" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Zealbot" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "MSIECrawler" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "SiteSnagger" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "WebStripper" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "WebCopier" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Fetch" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Offline Explorer" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Teleport" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "TeleportPro" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "WebZIP" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "linko" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "HTTrack" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Microsoft.URL.Control" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Xenu" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "larbin" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "libwww" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "ZyBORG" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "Download Ninja" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "wget" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "grub-client" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "k2spider" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "NPBot" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents V{ "WebReaper" } } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } + T{ rules + { user-agents + V{ + "abot" + "ALeadSoftbot" + "BeijingCrawler" + "BilgiBot" + "bot" + "botlist" + "BOTW Spider" + "bumblebee" + "Bumblebee" + "BuzzRankingBot" + "Charlotte" + "Clushbot" + "Crawler" + "CydralSpider" + "DataFountains" + "DiamondBot" + "Dulance bot" + "DYNAMIC" + "EARTHCOM.info" + "EDI" + "envolk" + "Exabot" + "Exabot-Images" + "Exabot-Test" + "exactseek-pagereaper" + "Exalead NG" + "FANGCrawl" + "Feed::Find" + "flatlandbot" + "Gigabot" + "GigabotSiteSearch" + "GurujiBot" + "Hatena Antenna" + "Hatena Bookmark" + "Hatena RSS" + "HatenaScreenshot" + "Helix" + "HiddenMarket" + "HyperEstraier" + "iaskspider" + "IIITBOT" + "InfociousBot" + "iVia" + "iVia Page Fetcher" + "Jetbot" + "Kolinka Forum Search" + "KRetrieve" + "LetsCrawl.com" + "Lincoln State Web Browser" + "Links4US-Crawler" + "LOOQ" + "Lsearch/sondeur" + "MapoftheInternet.com" + "NationalDirectory" + "NetCarta_WebMapper" + "NewsGator" + "NextGenSearchBot" + "ng" + "nicebot" + "NP" + "NPBot" + "Nudelsalat" + "Nutch" + "OmniExplorer_Bot" + "OpenIntelligenceData" + "Oracle Enterprise Search" + "Pajaczek" + "panscient.com" + "PeerFactor 404 crawler" + "PeerFactor Crawler" + "PlantyNet" + "PlantyNet_WebRobot" + "plinki" + "PMAFind" + "Pogodak!" + "QuickFinder Crawler" + "Radiation Retriever" + "Reaper" + "RedCarpet" + "ScorpionBot" + "Scrubby" + "Scumbot" + "searchbot" + "Seeker.lookseek.com" + "SeznamBot" + "ShowXML" + "snap.com" + "snap.com beta crawler" + "Snapbot" + "SnapPreviewBot" + "sohu" + "SpankBot" + "Speedy Spider" + "Speedy_Spider" + "SpeedySpider" + "spider" + "SquigglebotBot" + "SurveyBot" + "SynapticSearch" + "T-H-U-N-D-E-R-S-T-O-N-E" + "Talkro Web-Shot" + "Tarantula" + "TerrawizBot" + "TheInformant" + "TMCrawler" + "TridentSpider" + "Tutorial Crawler" + "Twiceler" + "unwrapbot" + "URI::Fetch" + "VengaBot" + "Vonna.com b o t" + "Vortex" + "Votay bot" + "WebAlta Crawler" + "Webbot" + "Webclipping.com" + "WebCorp" + "Webinator" + "WIRE" + "WISEbot" + "Xerka WebBot" + "XSpider" + "YodaoBot" + "Yoono" + "yoono" + } + } + { allows V{ } } + { disallows V{ "/" } } + { unknowns H{ } } + } +} +] [ "vocab:robots/robots.txt" utf8 file-contents parse-robots.txt ] unit-test diff --git a/extra/robots/robots.factor b/extra/robots/robots.factor new file mode 100644 index 0000000000..1b2422f06e --- /dev/null +++ b/extra/robots/robots.factor @@ -0,0 +1,68 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors http.client kernel unicode.categories +sequences urls splitting combinators splitting.monotonic +combinators.short-circuit assocs unicode.case arrays +math.parser calendar.format make ; +IN: robots + +! visit-time is GMT, request-rate is pages/second +! crawl-rate is seconds +TUPLE: rules user-agents allows disallows +visit-time request-rate crawl-delay unknowns ; + +robots.txt-url ( url -- url' ) + >url URL" robots.txt" derive-url ; + +: get-robots.txt ( url -- headers robots.txt ) + >robots.txt-url http-get ; + +: normalize-robots.txt ( string -- sitemaps seq ) + string-lines + [ [ blank? ] trim ] map + [ "#" head? not ] filter harvest + [ ":" split1 [ [ blank? ] trim ] bi@ [ >lower ] dip ] { } map>assoc + [ first "sitemap" = ] partition [ values ] dip + [ + { + [ [ first "user-agent" = ] bi@ and ] + [ nip first "user-agent" = not ] + } 2|| + ] monotonic-split ; + +: ( -- rules ) + rules new + V{ } clone >>user-agents + V{ } clone >>allows + V{ } clone >>disallows + H{ } clone >>unknowns ; + +: add-user-agent ( rules agent -- rules ) over user-agents>> push ; +: add-allow ( rules allow -- rules ) over allows>> push ; +: add-disallow ( rules disallow -- rules ) over disallows>> push ; + +: parse-robots.txt-line ( rules seq -- rules ) + first2 swap { + { "user-agent" [ add-user-agent ] } + { "allow" [ add-allow ] } + { "disallow" [ add-disallow ] } + { "crawl-delay" [ string>number >>crawl-delay ] } + { "request-rate" [ string>number >>request-rate ] } + { + "visit-time" [ "-" split1 [ hhmm>timestamp ] bi@ 2array + >>visit-time + ] } + [ pick unknowns>> push-at ] + } case ; + +PRIVATE> + +: parse-robots.txt ( string -- sitemaps rules-seq ) + normalize-robots.txt [ + [ dup ] dip [ parse-robots.txt-line drop ] with each + ] map ; + +: robots ( url -- sitemaps rules-seq ) + get-robots.txt nip parse-robots.txt ; diff --git a/extra/robots/robots.txt b/extra/robots/robots.txt new file mode 100644 index 0000000000..bbaaee69e1 --- /dev/null +++ b/extra/robots/robots.txt @@ -0,0 +1,279 @@ + + +# robots.txt + +Sitemap: http://www.chiplist.com/sitemap.txt + +User-Agent: * + +Disallow: /cgi-bin/ +Disallow: /scripts/ +Disallow: /ChipList2/scripts/ +#Disallow: /styles/ +Disallow: /ChipList2/styles/ + +Disallow: /ads/ +Disallow: /ChipList2/ads/ +Disallow: /advertisements/ +Disallow: /ChipList2/advertisements/ + +Disallow: /graphics/ +Disallow: /ChipList2/graphics/ + +#Disallow: /ChipList1/ + + +# robots.txt for http://www.wikipedia.org/ and friends +# +# Please note: There are a lot of pages on this site, and there are +# some misbehaved spiders out there that go _way_ too fast. If you're +# irresponsible, your access to the site may be blocked. + +# Inktomi's "Slurp" can read a minimum delay between hits; if your +# bot supports such a thing using the 'Crawl-delay' or another +# instruction, please let us know. + +# *at least* 1 second please. preferably more :D +#User-agent: * +Crawl-delay: 1 +Request-rate: 1/1 +Visit-time: 0200-0500 + +# Crawlers that are kind enough to obey, but which we'd rather not have +# unless they're feeding search engines. +User-agent: UbiCrawler +Disallow: / + +User-agent: DOC +Disallow: / + +User-agent: Zao +Disallow: / + +# Some bots are known to be trouble, particularly those designed to copy +# entire sites. Please obey robots.txt. +User-agent: sitecheck.internetseer.com +Disallow: / + +User-agent: Zealbot +Disallow: / + +User-agent: MSIECrawler +Disallow: / + +User-agent: SiteSnagger +Disallow: / + +User-agent: WebStripper +Disallow: / + +User-agent: WebCopier +Disallow: / + +User-agent: Fetch +Disallow: / + +User-agent: Offline Explorer +Disallow: / + +User-agent: Teleport +Disallow: / + +User-agent: TeleportPro +Disallow: / + +User-agent: WebZIP +Disallow: / + +User-agent: linko +Disallow: / + +User-agent: HTTrack +Disallow: / + +User-agent: Microsoft.URL.Control +Disallow: / + +User-agent: Xenu +Disallow: / + +User-agent: larbin +Disallow: / + +User-agent: libwww +Disallow: / + +User-agent: ZyBORG +Disallow: / + +User-agent: Download Ninja +Disallow: / + +# +# Sorry, wget in its recursive mode is a frequent problem. +# Please read the man page and use it properly; there is a +# --wait option you can use to set the delay between hits, +# for instance. +# +User-agent: wget +Disallow: / + +# +# The 'grub' distributed client has been *very* poorly behaved. +# +User-agent: grub-client +Disallow: / + +# +# Doesn't follow robots.txt anyway, but... +# +User-agent: k2spider +Disallow: / + +# +# Hits many times per second, not acceptable +# http://www.nameprotect.com/botinfo.html +User-agent: NPBot +Disallow: / + +# A capture bot, downloads gazillions of pages with no public benefit +# http://www.webreaper.net/ +User-agent: WebReaper +Disallow: / + + +# Provided courtesy of http://browsers.garykeith.com. +# Created on February 13, 2008 at 7:39:00 PM GMT. +# +# Place this file in the root public folder of your website. +# It will stop the following bots from indexing your website. +# +User-agent: abot +User-agent: ALeadSoftbot +User-agent: BeijingCrawler +User-agent: BilgiBot +User-agent: bot +User-agent: botlist +User-agent: BOTW Spider +User-agent: bumblebee +User-agent: Bumblebee +User-agent: BuzzRankingBot +User-agent: Charlotte +User-agent: Clushbot +User-agent: Crawler +User-agent: CydralSpider +User-agent: DataFountains +User-agent: DiamondBot +User-agent: Dulance bot +User-agent: DYNAMIC +User-agent: EARTHCOM.info +User-agent: EDI +User-agent: envolk +User-agent: Exabot +User-agent: Exabot-Images +User-agent: Exabot-Test +User-agent: exactseek-pagereaper +User-agent: Exalead NG +User-agent: FANGCrawl +User-agent: Feed::Find +User-agent: flatlandbot +User-agent: Gigabot +User-agent: GigabotSiteSearch +User-agent: GurujiBot +User-agent: Hatena Antenna +User-agent: Hatena Bookmark +User-agent: Hatena RSS +User-agent: HatenaScreenshot +User-agent: Helix +User-agent: HiddenMarket +User-agent: HyperEstraier +User-agent: iaskspider +User-agent: IIITBOT +User-agent: InfociousBot +User-agent: iVia +User-agent: iVia Page Fetcher +User-agent: Jetbot +User-agent: Kolinka Forum Search +User-agent: KRetrieve +User-agent: LetsCrawl.com +User-agent: Lincoln State Web Browser +User-agent: Links4US-Crawler +User-agent: LOOQ +User-agent: Lsearch/sondeur +User-agent: MapoftheInternet.com +User-agent: NationalDirectory +User-agent: NetCarta_WebMapper +User-agent: NewsGator +User-agent: NextGenSearchBot +User-agent: ng +User-agent: nicebot +User-agent: NP +User-agent: NPBot +User-agent: Nudelsalat +User-agent: Nutch +User-agent: OmniExplorer_Bot +User-agent: OpenIntelligenceData +User-agent: Oracle Enterprise Search +User-agent: Pajaczek +User-agent: panscient.com +User-agent: PeerFactor 404 crawler +User-agent: PeerFactor Crawler +User-agent: PlantyNet +User-agent: PlantyNet_WebRobot +User-agent: plinki +User-agent: PMAFind +User-agent: Pogodak! +User-agent: QuickFinder Crawler +User-agent: Radiation Retriever +User-agent: Reaper +User-agent: RedCarpet +User-agent: ScorpionBot +User-agent: Scrubby +User-agent: Scumbot +User-agent: searchbot +User-agent: Seeker.lookseek.com +User-agent: SeznamBot +User-agent: ShowXML +User-agent: snap.com +User-agent: snap.com beta crawler +User-agent: Snapbot +User-agent: SnapPreviewBot +User-agent: sohu +User-agent: SpankBot +User-agent: Speedy Spider +User-agent: Speedy_Spider +User-agent: SpeedySpider +User-agent: spider +User-agent: SquigglebotBot +User-agent: SurveyBot +User-agent: SynapticSearch +User-agent: T-H-U-N-D-E-R-S-T-O-N-E +User-agent: Talkro Web-Shot +User-agent: Tarantula +User-agent: TerrawizBot +User-agent: TheInformant +User-agent: TMCrawler +User-agent: TridentSpider +User-agent: Tutorial Crawler +User-agent: Twiceler +User-agent: unwrapbot +User-agent: URI::Fetch +User-agent: VengaBot +User-agent: Vonna.com b o t +User-agent: Vortex +User-agent: Votay bot +User-agent: WebAlta Crawler +User-agent: Webbot +User-agent: Webclipping.com +User-agent: WebCorp +User-agent: Webinator +User-agent: WIRE +User-agent: WISEbot +User-agent: Xerka WebBot +User-agent: XSpider +User-agent: YodaoBot +User-agent: Yoono +User-agent: yoono +Disallow: / + + From 55bb5f0cd4e2183e0a9d60a1e50864d243cd867a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 20 Mar 2009 22:40:46 -0500 Subject: [PATCH 06/43] fix typo in example --- extra/spider/spider-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/spider/spider-docs.factor b/extra/spider/spider-docs.factor index 41dd13e918..cdbd5e7e09 100644 --- a/extra/spider/spider-docs.factor +++ b/extra/spider/spider-docs.factor @@ -23,7 +23,7 @@ HELP: slurp-heap-while ARTICLE: "spider-tutorial" "Spider tutorial" "To create a new spider, call the " { $link } " word with a link to the site you wish to spider." -{ $code <" "http://concatentative.org" "> } +{ $code <" "http://concatenative.org" "> } "The max-depth is initialized to 0, which retrieves just the initial page. Let's initialize it to something more fun:" { $code <" 1 >>max-depth "> } "Now the spider will retrieve the first page and all the pages it links to in the same domain." $nl From c0154c1391ee51a5cdc38d38d7518453336664ee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 03:17:35 -0500 Subject: [PATCH 07/43] Change (:) to parse effect immediately, and remove ( parsing word --- basis/functors/functors-tests.factor | 2 +- basis/functors/functors.factor | 36 +++++++++++++--------------- basis/locals/locals.factor | 4 ++-- basis/locals/parser/parser.factor | 15 ++++++------ basis/macros/macros.factor | 13 +++++----- basis/memoize/memoize.factor | 9 ++++--- basis/peg/peg.factor | 4 ++-- core/bootstrap/syntax.factor | 1 - core/effects/parser/parser.factor | 10 ++++---- core/parser/parser.factor | 7 ++++-- core/sequences/sequences.factor | 2 +- core/syntax/syntax.factor | 9 ++----- core/vocabs/parser/parser.factor | 4 ++-- extra/descriptive/descriptive.factor | 7 +++--- 14 files changed, 60 insertions(+), 63 deletions(-) diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index df008d52bd..b4417532b4 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -13,7 +13,7 @@ WHERE TUPLE: B { value T } ; -C: B +C: B ( T -- B ) ;FUNCTOR diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 58c9edaf0c..d69233b8d1 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -14,9 +14,9 @@ IN: functors : scan-param ( -- obj ) scan-object literalize ; -: define* ( word def effect -- ) pick set-word define-declared ; +: define* ( word def -- ) over set-word define ; -: define-syntax* ( word def -- ) over set-word define-syntax ; +: define-declared* ( word def effect -- ) pick set-word define-declared ; TUPLE: fake-quotation seq ; @@ -41,7 +41,12 @@ M: object fake-quotations> ; : parse-definition* ( accum -- accum ) parse-definition >fake-quotations parsed \ fake-quotations> parsed ; -: DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ; +: parse-declared* ( accum -- accum ) + "(" expect ")" parse-effect + [ parse-definition* ] dip + parsed ; + +: DEFINE* ( accum -- accum ) \ define-declared* parsed ; SYNTAX: `TUPLE: scan-param parsed @@ -57,31 +62,28 @@ SYNTAX: `TUPLE: \ define-tuple-class parsed ; SYNTAX: `M: - effect off scan-param parsed scan-param parsed \ create-method-in parsed parse-definition* - DEFINE* ; + \ define* parsed ; SYNTAX: `C: - effect off scan-param parsed scan-param parsed - [ [ boa ] curry ] over push-all - DEFINE* ; + "(" expect ")" parse-effect + [ [ [ boa ] curry ] over push-all ] dip parsed + \ define-declared* parsed ; SYNTAX: `: - effect off scan-param parsed - parse-definition* - DEFINE* ; + parse-declared* + \ define-declared* parsed ; SYNTAX: `SYNTAX: - effect off scan-param parsed parse-definition* - \ define-syntax* parsed ; + \ define-syntax parsed ; SYNTAX: `INSTANCE: scan-param parsed @@ -90,9 +92,6 @@ SYNTAX: `INSTANCE: SYNTAX: `inline [ word make-inline ] over push-all ; -SYNTAX: `( - ")" parse-effect effect set ; - : (INTERPOLATE) ( accum quot -- accum ) [ scan interpolate-locals ] dip '[ _ with-string-writer @ ] parsed ; @@ -118,7 +117,6 @@ DEFER: ;FUNCTOR delimiter { "INSTANCE:" POSTPONE: `INSTANCE: } { "SYNTAX:" POSTPONE: `SYNTAX: } { "inline" POSTPONE: `inline } - { "(" POSTPONE: `( } } ; : push-functor-words ( -- ) @@ -133,9 +131,9 @@ DEFER: ;FUNCTOR delimiter [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) 1quotation pop-functor-words ; -: (FUNCTOR:) ( -- word def ) +: (FUNCTOR:) ( -- word def effect ) CREATE-WORD [ parse-functor-body ] parse-locals-definition ; PRIVATE> -SYNTAX: FUNCTOR: (FUNCTOR:) define ; +SYNTAX: FUNCTOR: (FUNCTOR:) define-declared ; diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index e6b363c209..9e26a8caaa 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. +! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. USING: lexer macros memoize parser sequences vocabs vocabs.loader words kernel namespaces locals.parser locals.types @@ -17,7 +17,7 @@ SYNTAX: [let* parse-let* over push-all ; SYNTAX: [wlet parse-wlet over push-all ; -SYNTAX: :: (::) define ; +SYNTAX: :: (::) define-declared ; SYNTAX: M:: (M::) define ; diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index d987e2c91d..3417d67e09 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -103,18 +103,19 @@ M: lambda-parser parse-quotation ( -- quotation ) "|" expect "|" parse-wbindings (parse-lambda) ?rewrite-closures ; -: parse-locals ( -- vars assoc ) +: parse-locals ( -- effect vars assoc ) "(" expect ")" parse-effect - word [ over "declared-effect" set-word-prop ] when* + dup in>> [ dup pair? [ first ] when ] map make-locals ; -: parse-locals-definition ( word reader -- word quot ) +: parse-locals-definition ( word reader -- word quot effect ) [ parse-locals ] dip ((parse-lambda)) - [ "lambda" set-word-prop ] - [ rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ] 2bi ; inline + [ nip "lambda" set-word-prop ] + [ nip rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ] + [ drop nip ] 3tri ; inline -: (::) ( -- word def ) +: (::) ( -- word def effect ) CREATE-WORD [ parse-definition ] parse-locals-definition ; @@ -123,5 +124,5 @@ M: lambda-parser parse-quotation ( -- quotation ) CREATE-METHOD [ [ parse-definition ] - parse-locals-definition + parse-locals-definition drop ] with-method-definition ; \ No newline at end of file diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 4869601588..f64c88388a 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -6,15 +6,16 @@ IN: macros > 1 ; +: real-macro-effect ( effect -- effect' ) + in>> 1 ; PRIVATE> -: define-macro ( word definition -- ) - [ "macro" set-word-prop ] - [ over real-macro-effect memoize-quot [ call ] append define ] - 2bi ; +: define-macro ( word definition effect -- ) + real-macro-effect + [ drop "macro" set-word-prop ] + [ [ memoize-quot [ call ] append ] keep define-declared ] + 3bi ; SYNTAX: MACRO: (:) define-macro ; diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor index 2c0cd357db..4e10fc3de4 100644 --- a/basis/memoize/memoize.factor +++ b/basis/memoize/memoize.factor @@ -34,11 +34,10 @@ M: too-many-arguments summary PRIVATE> -: define-memoized ( word quot -- ) - [ H{ } clone ] dip - [ pick stack-effect make-memoizer define ] - [ nip "memo-quot" set-word-prop ] - [ drop "memoize" set-word-prop ] +: define-memoized ( word quot effect -- ) + [ drop "memo-quot" set-word-prop ] + [ 2drop H{ } clone "memoize" set-word-prop ] + [ [ [ dup "memoize" word-prop ] 2dip make-memoizer ] keep define-declared ] 3tri ; SYNTAX: MEMO: (:) define-memoized ; diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index febcde5b25..98c92159ec 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -618,7 +618,7 @@ ERROR: parse-failed input word ; SYNTAX: PEG: (:) - [let | def [ ] word [ ] | + [let | effect [ ] def [ ] word [ ] | [ [ [let | compiled-def [ def call compile ] | @@ -626,7 +626,7 @@ SYNTAX: PEG: dup compiled-def compiled-parse [ ast>> ] [ word parse-failed ] ?if ] - word swap define + word swap effect define-declared ] ] with-compilation-unit ] over push-all diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 6e6812e25c..022bcba3b5 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -9,7 +9,6 @@ IN: bootstrap.syntax "!" "\"" "#!" - "(" "((" ":" ";" diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index 04dc42712c..2cc2e9f0a7 100644 --- a/core/effects/parser/parser.factor +++ b/core/effects/parser/parser.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: lexer sets sequences kernel splitting effects -combinators arrays parser ; +combinators arrays ; IN: effects.parser DEFER: parse-effect @@ -12,9 +12,9 @@ ERROR: bad-effect ; scan [ nip ] [ = ] 2bi [ drop f ] [ dup { f "(" "((" } member? [ bad-effect ] [ ":" ?tail [ - scan-word { - { \ ( [ ")" parse-effect ] } - [ ] + scan { + { "(" [ ")" parse-effect ] } + { f [ ")" unexpected-eof ] } } case 2array ] when ] if @@ -28,4 +28,4 @@ ERROR: bad-effect ; [ ] [ "Stack effect declaration must contain --" throw ] if ; : parse-call( ( accum word -- accum ) - [ ")" parse-effect parsed ] dip parsed ; \ No newline at end of file + [ ")" parse-effect ] dip 2array over push-all ; \ No newline at end of file diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 1f4d377b27..62177ec0c7 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -4,7 +4,7 @@ USING: arrays definitions generic assocs kernel math namespaces sequences strings vectors words words.symbol quotations io combinators sorting splitting math.parser effects continuations io.files vocabs io.encodings.utf8 source-files classes hashtables compiler.errors -compiler.units accessors sets lexer vocabs.parser slots ; +compiler.units accessors sets lexer vocabs.parser effects.parser slots ; IN: parser : location ( -- loc ) @@ -132,7 +132,10 @@ M: f parse-quotation \ ] parse-until >quotation ; : parse-definition ( -- quot ) \ ; parse-until >quotation ; -: (:) ( -- word def ) CREATE-WORD parse-definition ; +: (:) ( -- word def effect ) + CREATE-WORD + "(" expect ")" parse-effect + parse-definition swap ; ERROR: bad-number ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 144b417f04..f352705e85 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -176,7 +176,7 @@ PRIVATE> 3 swap bounds-check nip first4-unsafe ; flushable : ?nth ( n seq -- elt/f ) - 2dup bounds-check? [ nth-unsafe ] [ 2drop f ] if ; flushable + 2dup bounds-check? [ nth-unsafe ] [ 2drop f ] if ; inline MIXIN: virtual-sequence GENERIC: virtual-seq ( seq -- seq' ) diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 47a45f6e4e..1cf627a1a9 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -111,7 +111,7 @@ IN: bootstrap.syntax "delimiter" [ word t "delimiter" set-word-prop ] define-core-syntax "SYNTAX:" [ - (:) define-syntax + CREATE-WORD parse-definition define-syntax ] define-core-syntax "SYMBOL:" [ @@ -142,7 +142,7 @@ IN: bootstrap.syntax ] define-core-syntax ":" [ - (:) define + (:) define-declared ] define-core-syntax "GENERIC:" [ @@ -220,11 +220,6 @@ IN: bootstrap.syntax scan-object forget ] define-core-syntax - "(" [ - ")" parse-effect - word dup [ set-stack-effect ] [ 2drop ] if - ] define-core-syntax - "((" [ "))" parse-effect parsed ] define-core-syntax diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 35feae34bb..e8783c0dbe 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Daniel Ehrenberg, Bruno Deferrari, +! Copyright (C) 2007, 2009 Daniel Ehrenberg, Bruno Deferrari, ! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs hashtables kernel namespaces sequences @@ -56,4 +56,4 @@ SYMBOL: in dup string? [ "Vocabulary name must be a string" throw ] unless ; : set-in ( name -- ) - check-vocab-string dup in set create-vocab (use+) ; + check-vocab-string dup in set create-vocab (use+) ; \ No newline at end of file diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index ed412ee445..869158bf72 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -19,9 +19,10 @@ M: descriptive-error summary [ recover ] 2curry ; PRIVATE> -: define-descriptive ( word def -- ) - [ "descriptive-definition" set-word-prop ] - [ dupd [descriptive] define ] 2bi ; +: define-descriptive ( word def effect -- ) + [ drop "descriptive-definition" set-word-prop ] + [ [ dupd [descriptive] ] dip define-declared ] + 3bi ; SYNTAX: DESCRIPTIVE: (:) define-descriptive ; From 52cac7fd4e979ada22842872a374d1aff4a173ca Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 17:47:48 -0500 Subject: [PATCH 08/43] alien.structs: simplify logic and remove dead code --- basis/alien/structs/fields/fields.factor | 38 ++++-------------------- basis/alien/structs/structs-tests.factor | 2 +- basis/alien/structs/structs.factor | 22 +++++++------- 3 files changed, 17 insertions(+), 45 deletions(-) diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor index 0477683442..7e2d4615b5 100644 --- a/basis/alien/structs/fields/fields.factor +++ b/basis/alien/structs/fields/fields.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel kernel.private math namespaces make sequences strings words effects combinators alien.c-types ; @@ -6,28 +6,6 @@ IN: alien.structs.fields TUPLE: field-spec name offset type reader writer ; -: reader-effect ( type spec -- effect ) - [ 1array ] [ name>> 1array ] bi* ; - -PREDICATE: slot-reader < word "reading" word-prop >boolean ; - -: set-reader-props ( class spec -- ) - 2dup reader-effect - over reader>> - swap "declared-effect" set-word-prop - reader>> swap "reading" set-word-prop ; - -: writer-effect ( type spec -- effect ) - name>> swap 2array 0 ; - -PREDICATE: slot-writer < word "writing" word-prop >boolean ; - -: set-writer-props ( class spec -- ) - 2dup writer-effect - over writer>> - swap "declared-effect" set-word-prop - writer>> swap "writing" set-word-prop ; - : reader-word ( class name vocab -- word ) [ "-" glue ] dip create ; @@ -55,17 +33,13 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ; : define-struct-slot-word ( word quot spec effect -- ) [ offset>> prefix ] dip define-inline ; -: define-getter ( type spec -- ) - [ set-reader-props ] keep - [ reader>> ] - [ type>> c-type-getter-boxer ] - [ ] tri +: define-getter ( spec -- ) + [ reader>> ] [ type>> c-type-getter-boxer ] [ ] tri (( c-ptr -- value )) define-struct-slot-word ; -: define-setter ( type spec -- ) - [ set-writer-props ] keep +: define-setter ( spec -- ) [ writer>> ] [ type>> c-setter ] [ ] tri (( value c-ptr -- )) define-struct-slot-word ; -: define-field ( type spec -- ) - [ define-getter ] [ define-setter ] 2bi ; +: define-field ( spec -- ) + [ define-getter ] [ define-setter ] bi ; diff --git a/basis/alien/structs/structs-tests.factor b/basis/alien/structs/structs-tests.factor index 8bc570c448..231f1bd428 100755 --- a/basis/alien/structs/structs-tests.factor +++ b/basis/alien/structs/structs-tests.factor @@ -24,7 +24,7 @@ os winnt? cpu x86? and [ ] when ] when -: MAX_FOOS 30 ; +CONSTANT: MAX_FOOS 30 C-STRUCT: foox { { "int" MAX_FOOS } "x" } ; diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index ec9080690a..b618e7974b 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs generic hashtables kernel kernel.private math namespaces parser sequences strings words libc fry @@ -56,10 +56,10 @@ M: struct-type stack-size : (define-struct) ( name size align fields -- ) [ [ align ] keep ] dip struct-type new - swap >>fields - swap >>align - swap >>size - swap typedef ; + swap >>fields + swap >>align + swap >>size + swap typedef ; : make-fields ( name vocab fields -- fields ) [ first2 ] with with map ; @@ -68,12 +68,11 @@ M: struct-type stack-size [ c-type-align ] [ max ] map-reduce ; : define-struct ( name vocab fields -- ) - [ - [ 2drop ] [ make-fields ] 3bi - [ struct-offsets ] keep - [ [ type>> ] map compute-struct-align ] keep - [ (define-struct) ] keep - ] [ 2drop '[ _ swap define-field ] ] 3bi each ; + [ 2drop ] [ make-fields ] 3bi + [ struct-offsets ] keep + [ [ type>> ] map compute-struct-align ] keep + [ (define-struct) ] keep + [ define-field ] each ; : define-union ( name members -- ) [ expand-constants ] map @@ -83,4 +82,3 @@ M: struct-type stack-size : offset-of ( field struct -- offset ) c-types get at fields>> [ name>> = ] with find nip offset>> ; - From 51f9da378c01c34599e579a27baa6c164796ee5f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 17:50:13 -0500 Subject: [PATCH 09/43] bootstrap.image: when serializing a tuple whose tuple layout doesn't exist in the target, throw an error instead of generating an image which crashes the VM on startup. Fix some inference warnings --- basis/bootstrap/image/image.factor | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index a2621f4c32..504afae018 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -95,10 +95,10 @@ CONSTANT: -1-offset 9 SYMBOL: sub-primitives : make-jit ( quot rc rt offset -- quad ) - [ { } make ] 3dip 4array ; inline + [ [ call( -- ) ] { } make ] 3dip 4array ; : jit-define ( quot rc rt offset name -- ) - [ make-jit ] dip set ; inline + [ make-jit ] dip set ; : define-sub-primitive ( quot rc rt offset word -- ) [ make-jit ] dip sub-primitives get set-at ; @@ -398,9 +398,14 @@ M: byte-array ' ] emit-object ; ! Tuples +ERROR: tuple-removed class ; + +: require-tuple-layout ( word -- layout ) + dup tuple-layout [ ] [ tuple-removed ] ?if ; + : (emit-tuple) ( tuple -- pointer ) [ tuple-slots ] - [ class transfer-word tuple-layout ] bi prefix [ ' ] map + [ class transfer-word require-tuple-layout ] bi prefix [ ' ] map tuple type-number dup [ emit-seq ] emit-object ; : emit-tuple ( tuple -- pointer ) From 2f4e2735eade43157cee165d4ee17c70911a2625 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 17:50:53 -0500 Subject: [PATCH 10/43] Fix compile errors in compiler tests so that they actually test the compiler instead of being useless --- basis/compiler/tests/intrinsics.factor | 6 ++--- basis/compiler/tests/optimizer.factor | 26 +++++++++---------- .../tree/cleanup/cleanup-tests.factor | 2 +- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 6c6d580c87..93860db924 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -270,7 +270,7 @@ cell 8 = [ ] when ! Some randomized tests -: compiled-fixnum* fixnum* ; +: compiled-fixnum* ( a b -- c ) fixnum* ; [ ] [ 10000 [ @@ -281,7 +281,7 @@ cell 8 = [ ] times ] unit-test -: compiled-fixnum>bignum fixnum>bignum ; +: compiled-fixnum>bignum ( a -- b ) fixnum>bignum ; [ bignum ] [ 0 compiled-fixnum>bignum class ] unit-test @@ -293,7 +293,7 @@ cell 8 = [ ] times ] unit-test -: compiled-bignum>fixnum bignum>fixnum ; +: compiled-bignum>fixnum ( a -- b ) bignum>fixnum ; [ ] [ 10000 [ diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index b5cb0ddbdb..3aed47ae7e 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -13,7 +13,7 @@ M: array xyz xyz ; [ t ] [ \ xyz optimized>> ] unit-test ! Test predicate inlining -: pred-test-1 +: pred-test-1 ( a -- b c ) dup fixnum? [ dup integer? [ "integer" ] [ "nope" ] if ] [ @@ -24,7 +24,7 @@ M: array xyz xyz ; TUPLE: pred-test ; -: pred-test-2 +: pred-test-2 ( a -- b c ) dup tuple? [ dup pred-test? [ "pred-test" ] [ "nope" ] if ] [ @@ -33,7 +33,7 @@ TUPLE: pred-test ; [ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-2 ] unit-test -: pred-test-3 +: pred-test-3 ( a -- b c ) dup pred-test? [ dup tuple? [ "pred-test" ] [ "nope" ] if ] [ @@ -42,14 +42,14 @@ TUPLE: pred-test ; [ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-3 ] unit-test -: inline-test +: inline-test ( a -- b ) "nom" = ; [ t ] [ "nom" inline-test ] unit-test [ f ] [ "shayin" inline-test ] unit-test [ f ] [ 3 inline-test ] unit-test -: fixnum-declarations >fixnum 24 shift 1234 bitxor ; +: fixnum-declarations ( a -- b ) >fixnum 24 shift 1234 bitxor ; [ ] [ 1000000 fixnum-declarations . ] unit-test @@ -61,13 +61,13 @@ TUPLE: pred-test ; ! regression -: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline -: bad-kill-2 bad-kill-1 drop ; +: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline recursive +: bad-kill-2 ( a b -- c d ) bad-kill-1 drop ; [ 3 ] [ t bad-kill-2 ] unit-test ! regression -: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline +: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline recursive : the-test ( -- x y ) 2 dup (the-test) ; [ 2 0 ] [ the-test ] unit-test @@ -77,7 +77,7 @@ TUPLE: pred-test ; < [ 6 1 (double-recursion) 3 2 (double-recursion) - ] when ; inline + ] when ; inline recursive : double-recursion ( -- ) 0 2 (double-recursion) ; @@ -85,7 +85,7 @@ TUPLE: pred-test ; ! regression : double-label-1 ( a b c -- d ) - [ f double-label-1 ] [ swap nth-unsafe ] if ; inline + [ f double-label-1 ] [ swap nth-unsafe ] if ; inline recursive : double-label-2 ( a -- b ) dup array? [ ] [ ] if 0 t double-label-1 ; @@ -100,7 +100,7 @@ GENERIC: void-generic ( obj -- * ) ! regression : branch-fold-regression-0 ( m -- n ) - t [ ] [ 1+ branch-fold-regression-0 ] if ; inline + t [ ] [ 1+ branch-fold-regression-0 ] if ; inline recursive : branch-fold-regression-1 ( -- m ) 10 branch-fold-regression-0 ; @@ -224,7 +224,7 @@ USE: binary-search.private ] unit-test ! Regression -: empty-compound ; +: empty-compound ( -- ) ; : node-successor-f-bug ( x -- * ) [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ; @@ -293,7 +293,7 @@ HINTS: recursive-inline-hang-3 array ; ! Wow : counter-example ( a b c d -- a' b' c' d' ) - dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline + dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline recursive : counter-example' ( -- a' b' c' d' ) 1 2 3.0 3 counter-example ; diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index e451694f48..2ed68934a7 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -90,7 +90,7 @@ M: object xyz ; [ swap [ call 1+ ] dip ] keep (i-repeat) ] if ; inline recursive -: i-repeat [ { integer } declare ] dip 0 -rot (i-repeat) ; inline +: i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline [ t ] [ [ [ dup xyz drop ] i-repeat ] \ xyz inlined? From 0ffc9247cce245f77724560fd44911d2432e5b26 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 17:53:06 -0500 Subject: [PATCH 11/43] words: Fix compile errors in unit tests, remove ?word-name word and replace its usages with present --- basis/help/markup/markup.factor | 4 ++-- core/words/words-tests.factor | 22 +++++++++++----------- core/words/words.factor | 5 +---- extra/ctags/ctags.factor | 4 ++-- extra/ctags/etags/etags.factor | 4 ++-- 5 files changed, 18 insertions(+), 21 deletions(-) diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 8ea36d62fb..a80d386638 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -4,7 +4,7 @@ USING: accessors arrays definitions generic io kernel assocs hashtables namespaces make parser prettyprint sequences strings io.styles vectors words math sorting splitting classes slots fry sets vocabs help.stylesheet help.topics vocabs.loader quotations -combinators see ; +combinators see present ; IN: help.markup PREDICATE: simple-element < array @@ -276,7 +276,7 @@ M: f ($instance) $snippet ; : values-row ( seq -- seq ) - unclip \ $snippet swap ?word-name 2array + unclip \ $snippet swap present 2array swap dup first word? [ \ $instance prefix ] when 2array ; : $values ( element -- ) diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 52a20ba48a..305541119b 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -50,8 +50,8 @@ SYMBOL: a-symbol ! See if redefining a generic as a colon def clears some ! word props. -GENERIC: testing -"IN: words.tests : testing ;" eval +GENERIC: testing ( a -- b ) +"IN: words.tests : testing ( -- ) ;" eval [ f ] [ \ testing generic? ] unit-test @@ -106,7 +106,7 @@ DEFER: calls-a-gensym ! regression GENERIC: freakish ( x -- y ) -: bar freakish ; +: bar ( x -- y ) freakish ; M: array freakish ; [ t ] [ \ bar \ freakish usage member? ] unit-test @@ -116,7 +116,7 @@ DEFER: x [ ] [ "no-loc" "words.tests" create drop ] unit-test [ f ] [ "no-loc" "words.tests" lookup where ] unit-test -[ ] [ "IN: words.tests : no-loc-2 ;" eval ] unit-test +[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval ] unit-test [ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test [ ] [ "IN: words.tests : test-last ( -- ) ;" eval ] unit-test @@ -146,11 +146,11 @@ SYMBOL: quot-uses-b [ forget ] with-compilation-unit ] when* -[ "IN: words.tests : undef-test ; << undef-test >>" eval ] +[ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval ] [ error>> undefined? ] must-fail-with [ ] [ - "IN: words.tests GENERIC: symbol-generic" eval + "IN: words.tests GENERIC: symbol-generic ( -- )" eval ] unit-test [ ] [ @@ -161,7 +161,7 @@ SYMBOL: quot-uses-b [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test [ ] [ - "IN: words.tests GENERIC: symbol-generic" + "IN: words.tests GENERIC: symbol-generic ( a -- b )" "symbol-generic-test" parse-stream drop ] unit-test @@ -174,14 +174,14 @@ SYMBOL: quot-uses-b [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test ! Regressions -[ ] [ "IN: words.tests : decl-forget-test ; foldable" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval ] unit-test [ t ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test -[ ] [ "IN: words.tests : decl-forget-test ;" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval ] unit-test [ f ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test -[ ] [ "IN: words.tests : decl-forget-test ; flushable" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval ] unit-test [ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test -[ ] [ "IN: words.tests : decl-forget-test ;" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval ] unit-test [ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test [ { } ] diff --git a/core/words/words.factor b/core/words/words.factor index c255c00eae..b101350db0 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -169,8 +169,7 @@ CONSTANT: reset-on-redefine { "inferred-effect" "cannot-infer" } ] if ; : define-declared ( word def effect -- ) - pick swap "declared-effect" set-word-prop - define ; + [ nip swap set-stack-effect ] [ drop define ] 3bi ; : make-inline ( word -- ) t "inline" set-word-prop ; @@ -258,6 +257,4 @@ M: word hashcode* M: word literalize ; -: ?word-name ( word -- name ) dup word? [ name>> ] when ; - : xref-words ( -- ) all-words [ xref ] each ; diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor index 38160de0e9..393c932482 100644 --- a/extra/ctags/ctags.factor +++ b/extra/ctags/ctags.factor @@ -6,7 +6,7 @@ USING: arrays kernel sequences io io.files io.backend io.encodings.ascii math.parser vocabs definitions -namespaces make words sorting ; +namespaces make words sorting present ; IN: ctags : ctag-word ( ctag -- word ) @@ -20,7 +20,7 @@ IN: ctags : ctag ( seq -- str ) [ - dup ctag-word ?word-name % + dup ctag-word present % "\t" % dup ctag-path normalize-path % "\t" % diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor index 9fe63e914e..40c0b791cf 100644 --- a/extra/ctags/etags/etags.factor +++ b/extra/ctags/etags/etags.factor @@ -5,7 +5,7 @@ ! Alfredo Beaumont USING: kernel sequences sorting assocs words prettyprint ctags io.encodings.ascii io.files math math.parser namespaces make -strings shuffle io.backend arrays ; +strings shuffle io.backend arrays present ; IN: ctags.etags : etag-at ( key hash -- vector ) @@ -36,7 +36,7 @@ IN: ctags.etags : etag ( lines seq -- str ) [ - dup first ?word-name % + dup first present % 1 HEX: 7f % second dup number>string % 1 CHAR: , % From e0d48e3ab6b45e97b555360376b463be83c53a45 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 17:59:40 -0500 Subject: [PATCH 12/43] New utility word: complete-effect --- basis/constructors/constructors.factor | 2 +- basis/functors/functors.factor | 4 ++-- basis/locals/parser/parser.factor | 2 +- core/effects/parser/parser.factor | 3 +++ core/parser/parser.factor | 2 +- 5 files changed, 8 insertions(+), 5 deletions(-) diff --git a/basis/constructors/constructors.factor b/basis/constructors/constructors.factor index 8cfeb83910..7a98cd5e0a 100644 --- a/basis/constructors/constructors.factor +++ b/basis/constructors/constructors.factor @@ -18,6 +18,6 @@ MACRO: set-slots ( slots -- quot ) SYNTAX: CONSTRUCTOR: scan-word [ name>> "<" ">" surround create-in ] keep - "(" expect ")" parse-effect + complete-effect parse-definition define-constructor ; \ No newline at end of file diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index d69233b8d1..309154fb49 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -42,7 +42,7 @@ M: object fake-quotations> ; parse-definition >fake-quotations parsed \ fake-quotations> parsed ; : parse-declared* ( accum -- accum ) - "(" expect ")" parse-effect + complete-effect [ parse-definition* ] dip parsed ; @@ -71,7 +71,7 @@ SYNTAX: `M: SYNTAX: `C: scan-param parsed scan-param parsed - "(" expect ")" parse-effect + complete-effect [ [ [ boa ] curry ] over push-all ] dip parsed \ define-declared* parsed ; diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index 3417d67e09..5e9bdfbed6 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -104,7 +104,7 @@ M: lambda-parser parse-quotation ( -- quotation ) (parse-lambda) ?rewrite-closures ; : parse-locals ( -- effect vars assoc ) - "(" expect ")" parse-effect + complete-effect dup in>> [ dup pair? [ first ] when ] map make-locals ; diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index 2cc2e9f0a7..b9cb0ddcc9 100644 --- a/core/effects/parser/parser.factor +++ b/core/effects/parser/parser.factor @@ -27,5 +27,8 @@ ERROR: bad-effect ; parse-effect-tokens { "--" } split1 dup [ ] [ "Stack effect declaration must contain --" throw ] if ; +: complete-effect ( -- effect ) + "(" expect ")" parse-effect ; + : parse-call( ( accum word -- accum ) [ ")" parse-effect ] dip 2array over push-all ; \ No newline at end of file diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 62177ec0c7..871f7c5321 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -134,7 +134,7 @@ M: f parse-quotation \ ] parse-until >quotation ; : (:) ( -- word def effect ) CREATE-WORD - "(" expect ")" parse-effect + complete-effect parse-definition swap ; ERROR: bad-number ; From 4fc2182ac87de8f2490a093e093dbbf12e2f815f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 18:00:26 -0500 Subject: [PATCH 13/43] define-generic and define-simple-generic now take stack effect parameters; math-combination is a singleton instead of a tuple --- core/bootstrap/syntax.factor | 1 + core/generic/generic-docs.factor | 4 +-- core/generic/generic-tests.factor | 4 +-- core/generic/generic.factor | 23 ++++++++++++------ core/generic/math/math.factor | 2 +- core/generic/parser/parser.factor | 7 ++++-- core/generic/standard/standard-docs.factor | 4 +-- core/generic/standard/standard-tests.factor | 10 -------- core/generic/standard/standard.factor | 10 +++++--- core/slots/slots.factor | 27 ++++++++++++++------- core/syntax/syntax-docs.factor | 4 +-- core/syntax/syntax.factor | 25 ++++++++++--------- 12 files changed, 68 insertions(+), 53 deletions(-) diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 022bcba3b5..6e6812e25c 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -9,6 +9,7 @@ IN: bootstrap.syntax "!" "\"" "#!" + "(" "((" ":" ";" diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor index 613dbf72a4..b90bcc8fc1 100644 --- a/core/generic/generic-docs.factor +++ b/core/generic/generic-docs.factor @@ -1,6 +1,6 @@ USING: help.markup help.syntax words classes classes.algebra definitions kernel alien sequences math quotations -generic.standard generic.math combinators prettyprint ; +generic.standard generic.math combinators prettyprint effects ; IN: generic ARTICLE: "method-order" "Method precedence" @@ -115,7 +115,7 @@ HELP: make-generic $low-level-note ; HELP: define-generic -{ $values { "word" word } { "combination" "a method combination" } } +{ $values { "word" word } { "effect" effect } { "combination" "a method combination" } } { $description "Defines a generic word. A method combination is an object which responds to the " { $link perform-combination } " generic word." } { $contract "The method combination quotation is called each time the generic word has to be updated (for example, when a method is added), and thus must be side-effect free." } ; diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index aea7875b20..aadc44833f 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -186,7 +186,7 @@ M: f generic-forget-test-3 ; [ f ] [ f generic-forget-test-3 ] unit-test -: a-word ; +: a-word ( -- ) ; GENERIC: a-generic ( a -- b ) @@ -196,7 +196,7 @@ M: integer a-generic a-word ; [ t ] [ "m" get \ a-word usage memq? ] unit-test -[ ] [ "IN: generic.tests : a-generic ;" eval ] unit-test +[ ] [ "IN: generic.tests : a-generic ( -- ) ;" eval ] unit-test [ f ] [ "m" get \ a-word usage memq? ] unit-test diff --git a/core/generic/generic.factor b/core/generic/generic.factor index ef1ca6f1ab..c78c88eef0 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -185,13 +185,22 @@ M: sequence update-methods ( class seq -- ) [ changed-generic ] [ remake-generic drop ] 2bi ] with each ; -: define-generic ( word combination -- ) - over "combination" word-prop over = [ drop ] [ - 2dup "combination" set-word-prop - over "methods" word-prop values forget-all - over H{ } clone "methods" set-word-prop - dupd define-default-method - ] if remake-generic ; +: define-generic ( word combination effect -- ) + [ nip swap set-stack-effect ] + [ + drop + 2dup [ "combination" word-prop ] dip = [ 2drop ] [ + { + [ "combination" set-word-prop ] + [ drop "methods" word-prop values forget-all ] + [ drop H{ } clone "methods" set-word-prop ] + [ define-default-method ] + } + 2cleave + ] if + ] + [ 2drop remake-generic ] + 3tri ; M: generic subwords [ diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index 738c011a48..8d4610dabe 100644 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -72,7 +72,7 @@ SYMBOL: picker \ dispatch , ] [ ] make ; inline -TUPLE: math-combination ; +SINGLETON: math-combination M: math-combination make-default-method drop default-math-method ; diff --git a/core/generic/parser/parser.factor b/core/generic/parser/parser.factor index bf9cdb19f5..ce048c41da 100644 --- a/core/generic/parser/parser.factor +++ b/core/generic/parser/parser.factor @@ -1,12 +1,15 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: parser kernel words generic namespaces ; +USING: parser kernel words generic namespaces effects.parser ; IN: generic.parser ERROR: not-in-a-method-error ; : CREATE-GENERIC ( -- word ) CREATE dup reset-word ; +: (GENERIC:) ( quot -- ) + [ CREATE-GENERIC ] dip call complete-effect define-generic ; inline + : create-method-in ( class generic -- method ) create-method dup set-word dup save-location ; diff --git a/core/generic/standard/standard-docs.factor b/core/generic/standard/standard-docs.factor index ec2e78c48d..6e788eb947 100644 --- a/core/generic/standard/standard-docs.factor +++ b/core/generic/standard/standard-docs.factor @@ -1,5 +1,5 @@ USING: generic help.markup help.syntax sequences math -math.parser ; +math.parser effects ; IN: generic.standard HELP: no-method @@ -28,7 +28,7 @@ HELP: hook-combination } ; HELP: define-simple-generic -{ $values { "word" "a word" } } +{ $values { "word" "a word" } { "effect" effect } } { $description "Defines a generic word with the " { $link standard-combination } " method combination and a dispatch position of 0." } ; { standard-combination hook-combination } related-words diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index 2cd64ac9f4..a6269135f4 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -280,16 +280,6 @@ M: growable call-next-hooker call-next-method "growable " prepend ; V{ } my-var [ call-next-hooker ] with-variable ] unit-test -GENERIC: no-stack-effect-decl - -M: hashtable no-stack-effect-decl ; -M: vector no-stack-effect-decl ; -M: sbuf no-stack-effect-decl ; - -[ ] [ \ no-stack-effect-decl see ] unit-test - -[ ] [ \ no-stack-effect-decl def>> . ] unit-test - ! Cross-referencing with generic words TUPLE: xref-tuple-1 ; TUPLE: xref-tuple-2 < xref-tuple-1 ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index f9fe3a6e9e..5dbc0d17a1 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -24,7 +24,7 @@ M: quotation engine>quot ERROR: no-method object generic ; : error-method ( word -- quot ) - picker swap [ no-method ] curry append ; + [ picker ] dip [ no-method ] curry append ; : push-method ( method specializer atomic assoc -- ) [ @@ -56,7 +56,7 @@ ERROR: no-method object generic ; : find-default ( methods -- quot ) #! Side-effects methods. - object bootstrap-word swap delete-at* [ + [ object bootstrap-word ] dip delete-at* [ drop generic get "default-method" word-prop mangle-method ] unless ; @@ -104,8 +104,10 @@ PREDICATE: standard-generic < generic PREDICATE: simple-generic < standard-generic "combination" word-prop #>> zero? ; -: define-simple-generic ( word -- ) - T{ standard-combination f 0 } define-generic ; +CONSTANT: simple-combination T{ standard-combination f 0 } + +: define-simple-generic ( word effect -- ) + [ simple-combination ] dip define-generic ; : with-standard ( combination quot -- quot' ) [ #>> (dispatch#) ] dip with-variable ; inline diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 71c2bdcc90..46fd325fa5 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -21,7 +21,7 @@ PREDICATE: writer-method < method-body "writing" word-prop ; object bootstrap-word >>class ; : define-typecheck ( class generic quot props -- ) - [ dup define-simple-generic create-method ] 2dip + [ create-method ] 2dip [ [ props>> ] [ drop ] [ ] tri* update ] [ drop define ] 3bi ; @@ -36,7 +36,6 @@ PREDICATE: writer-method < method-body "writing" word-prop ; : reader-word ( name -- word ) ">>" append "accessors" create - dup (( object -- value )) "declared-effect" set-word-prop dup t "reader" set-word-prop ; : reader-props ( slot-spec -- assoc ) @@ -46,13 +45,18 @@ PREDICATE: writer-method < method-body "writing" word-prop ; t "flushable" set ] H{ } make-assoc ; +: define-reader-generic ( name -- ) + reader-word (( object -- value )) define-simple-generic ; + : define-reader ( class slot-spec -- ) - [ name>> reader-word ] [ reader-quot ] [ reader-props ] tri - define-typecheck ; + [ nip name>> define-reader-generic ] + [ + [ name>> reader-word ] [ reader-quot ] [ reader-props ] tri + define-typecheck + ] 2bi ; : writer-word ( name -- word ) "(>>" ")" surround "accessors" create - dup (( value object -- )) "declared-effect" set-word-prop dup t "writer" set-word-prop ; ERROR: bad-slot-value value class ; @@ -92,9 +96,14 @@ ERROR: bad-slot-value value class ; : writer-props ( slot-spec -- assoc ) "writing" associate ; +: define-writer-generic ( name -- ) + writer-word (( object value -- )) define-simple-generic ; + : define-writer ( class slot-spec -- ) - [ name>> writer-word ] [ writer-quot ] [ writer-props ] tri - define-typecheck ; + [ nip name>> define-writer-generic ] [ + [ name>> writer-word ] [ writer-quot ] [ writer-props ] tri + define-typecheck + ] 2bi ; : setter-word ( name -- word ) ">>" prepend "accessors" create ; @@ -134,8 +143,8 @@ ERROR: bad-slot-value value class ; : define-protocol-slot ( name -- ) { - [ reader-word define-simple-generic ] - [ writer-word define-simple-generic ] + [ define-reader-generic ] + [ define-writer-generic ] [ define-setter ] [ define-changer ] } cleave ; diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 9609b4ffee..79aeee5b55 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -508,8 +508,8 @@ HELP: P" HELP: ( { $syntax "( inputs -- outputs )" } { $values { "inputs" "a list of tokens" } { "outputs" "a list of tokens" } } -{ $description "Declares the stack effect of the most recently defined word, storing a new " { $link effect } " instance in the " { $snippet "\"declared-effect\"" } " word property." } -{ $notes "All words except those only pushing literals on the stack must have a stack effect declaration. See " { $link "effect-declaration" } " for details." } ; +{ $description "A stack effect declaration. This is treated as a comment unless it appears inside a word definition." } +{ $see-also "effect-declaration" } ; HELP: (( { $syntax "(( inputs -- outputs ))" } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 1cf627a1a9..bcf9decdf3 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -127,6 +127,11 @@ IN: bootstrap.syntax ";" parse-tokens [ create-class-in define-singleton-class ] each ] define-core-syntax + + "DEFER:" [ + scan current-vocab create + [ fake-definition ] [ set-word ] [ [ undefined ] define ] tri + ] define-core-syntax "ALIAS:" [ CREATE-WORD scan-word define-alias @@ -136,32 +141,24 @@ IN: bootstrap.syntax CREATE scan-object define-constant ] define-core-syntax - "DEFER:" [ - scan current-vocab create - [ fake-definition ] [ set-word ] [ [ undefined ] define ] tri - ] define-core-syntax - ":" [ (:) define-declared ] define-core-syntax "GENERIC:" [ - CREATE-GENERIC define-simple-generic + [ simple-combination ] (GENERIC:) ] define-core-syntax "GENERIC#" [ - CREATE-GENERIC - scan-word define-generic + [ scan-word ] (GENERIC:) ] define-core-syntax "MATH:" [ - CREATE-GENERIC - T{ math-combination } define-generic + [ math-combination ] (GENERIC:) ] define-core-syntax "HOOK:" [ - CREATE-GENERIC scan-word - define-generic + [ scan-word ] (GENERIC:) ] define-core-syntax "M:" [ @@ -220,6 +217,10 @@ IN: bootstrap.syntax scan-object forget ] define-core-syntax + "(" [ + ")" parse-effect drop + ] define-core-syntax + "((" [ "))" parse-effect parsed ] define-core-syntax From 5408191724437e1c996304ead256641e913f464a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 18:37:28 -0500 Subject: [PATCH 14/43] 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 _ ] define-memoized ; + CREATE-WORD scan '[ f swap _ ] (( string -- name )) define-memoized ; 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 [ " bar " string>xml pprint-xml>string ] unit-test [ "" ] [ "" xml>string ] unit-test -: test-file "resource:basis/xml/writer/test.xml" ; +CONSTANT: test-file "resource:basis/xml/writer/test.xml" [ ] [ "" string>xml test-file utf8 [ write-xml ] with-file-writer ] unit-test [ "x" ] [ test-file file>xml body>> name>> main>> ] unit-test From ccdef3594986d4ea888eb2b61c6e8e6620b14f33 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Mar 2009 19:25:55 -0500 Subject: [PATCH 15/43] inline everything so stuff compiles --- extra/html/parser/analyzer/analyzer.factor | 4 ++-- extra/html/parser/parser.factor | 2 +- extra/html/parser/state/state.factor | 18 +++++++++--------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index abe830c3fa..b344ce160f 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -46,7 +46,7 @@ TUPLE: link attributes clickable ; : find-between-all ( vector quot -- seq ) dupd '[ _ [ closing?>> not ] bi and ] find-all - [ first2 find-between* ] with map ; + [ first2 find-between* ] with map ; inline : remove-blank-text ( vector -- vector' ) [ @@ -113,7 +113,7 @@ TUPLE: link attributes clickable ; [ clickable>> [ bl bl text>> print ] each nl ] bi ; : find-by-text ( seq quot -- tag ) - [ dup name>> text = ] prepose find drop ; + [ dup name>> text = ] prepose find drop ; inline : find-opening-tags-by-name ( name seq -- seq ) [ [ name>> = ] [ closing?>> not ] bi and ] with find-all ; diff --git a/extra/html/parser/parser.factor b/extra/html/parser/parser.factor index c445b708c5..60e5ddbf54 100644 --- a/extra/html/parser/parser.factor +++ b/extra/html/parser/parser.factor @@ -137,7 +137,7 @@ SYMBOL: tagstack ] when ; : tag-parse ( quot -- vector ) - V{ } clone tagstack [ string-parse ] with-variable ; + V{ } clone tagstack [ string-parse ] with-variable ; inline : parse-html ( string -- vector ) [ (parse-html) tagstack get ] tag-parse ; diff --git a/extra/html/parser/state/state.factor b/extra/html/parser/state/state.factor index cda601866e..1b3f188a78 100644 --- a/extra/html/parser/state/state.factor +++ b/extra/html/parser/state/state.factor @@ -5,22 +5,22 @@ IN: html.parser.state TUPLE: state string i ; -: get-i ( -- i ) state get i>> ; +: get-i ( -- i ) state get i>> ; inline : get-char ( -- char ) - state get [ i>> ] [ string>> ] bi ?nth ; + state get [ i>> ] [ string>> ] bi ?nth ; inline : get-next ( -- char ) - state get [ i>> 1+ ] [ string>> ] bi ?nth ; + state get [ i>> 1+ ] [ string>> ] bi ?nth ; inline : next ( -- ) - state get [ 1+ ] change-i drop ; + state get [ 1+ ] change-i drop ; inline : string-parse ( string quot -- ) - [ 0 state boa state ] dip with-variable ; + [ 0 state boa state ] dip with-variable ; inline : short* ( n seq -- n' seq ) - over [ nip dup length swap ] unless ; + over [ nip dup length swap ] unless ; inline : skip-until ( quot: ( -- ? ) -- ) get-char [ @@ -30,12 +30,12 @@ TUPLE: state string i ; : take-until ( quot: ( -- ? ) -- ) get-i [ skip-until ] dip get-i - state get string>> subseq ; + state get string>> subseq ; inline : string-matches? ( string circular -- ? ) - get-char over push-growing-circular sequence= ; + get-char over push-growing-circular sequence= ; inline : take-string ( match -- string ) dup length [ 2dup string-matches? ] take-until nip - dup length rot length 1- - head next ; + dup length rot length 1- - head next ; inline From 6080c6e734161a1ba81495d3e929de82f756ad97 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 20:16:31 -0500 Subject: [PATCH 16/43] Fix stack effect redefinition --- basis/alien/c-types/c-types-tests.factor | 2 +- basis/compiler/compiler.factor | 9 +++-- basis/compiler/tests/redefine2.factor | 4 ++- .../tree/cleanup/cleanup-tests.factor | 2 +- core/classes/classes.factor | 19 +++++++---- core/classes/tuple/tuple-tests.factor | 33 ++++++++++++++----- core/classes/tuple/tuple.factor | 5 ++- core/compiler/units/units.factor | 2 ++ core/definitions/definitions.factor | 13 +++++--- core/generic/generic.factor | 3 +- core/words/words.factor | 6 ++-- 11 files changed, 64 insertions(+), 34 deletions(-) diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 40171f56e7..988dc180e0 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -4,7 +4,7 @@ sequences system libc alien.strings io.encodings.utf8 ; \ expand-constants must-infer -: xyz 123 ; +CONSTANT: xyz 123 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index c8e1e5fd0f..04c1a9c55f 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -35,11 +35,14 @@ SYMBOLS: +optimized+ +unoptimized+ ; [ usage [ word? ] filter ] [ compiled-usage keys ] if [ queue-compile ] each ; -: ripple-up? ( word status -- ? ) - swap "compiled-status" word-prop [ = not ] keep and ; +: ripple-up? ( status word -- ? ) + [ + [ nip changed-effects get key? ] + [ "compiled-status" word-prop eq? not ] 2bi or + ] keep "compiled-status" word-prop and ; : save-compiled-status ( word status -- ) - [ dupd ripple-up? [ ripple-up ] [ drop ] if ] + [ over ripple-up? [ ripple-up ] [ drop ] if ] [ "compiled-status" set-word-prop ] 2bi ; diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor index d6e90187fe..5a28b28261 100644 --- a/basis/compiler/tests/redefine2.factor +++ b/basis/compiler/tests/redefine2.factor @@ -1,12 +1,14 @@ IN: compiler.tests USING: compiler compiler.units tools.test math parser kernel sequences sequences.private classes.mixin generic definitions -arrays words assocs eval ; +arrays words assocs eval words.symbol ; DEFER: redefine2-test [ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval ] unit-test +[ t ] [ \ redefine2-test symbol? ] unit-test + [ t ] [ redefine2-test new sequence? ] unit-test [ 3 ] [ 0 redefine2-test new nth-unsafe ] unit-test diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 2ed68934a7..7de092d84a 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ; [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2) ] if ; inline recursive -: annotate-entry-test-2 0 -rot (annotate-entry-test-2) ; inline +: annotate-entry-test-2 ( from to -- ) 0 -rot (annotate-entry-test-2) ; inline [ f ] [ [ { bignum } declare annotate-entry-test-2 ] diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 888eac7645..eded33beed 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays definitions assocs kernel kernel.private slots.private namespaces make sequences strings words words.symbol @@ -126,14 +126,19 @@ M: sequence implementors [ implementors ] gather ; } spread ] H{ } make-assoc ; +: ?define-symbol ( word -- ) + dup deferred? [ define-symbol ] [ drop ] if ; + : (define-class) ( word props -- ) [ - dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless - dup reset-class - dup deferred? [ dup define-symbol ] when - dup redefined - dup props>> - ] dip assoc-union >>props + { + [ dup class? [ drop ] [ [ implementors-map+ ] [ new-class ] bi ] if ] + [ reset-class ] + [ ?define-symbol ] + [ redefined ] + [ ] + } cleave + ] dip [ assoc-union ] curry change-props dup predicate-word [ 1quotation "predicate" set-word-prop ] [ swap "predicating" set-word-prop ] diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index f27d24e39d..fa2df4e312 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -4,7 +4,8 @@ namespaces quotations sequences.private classes continuations generic.standard effects classes.tuple classes.tuple.private arrays vectors strings compiler.units accessors classes.algebra calendar prettyprint io.streams.string splitting summary -columns math.order classes.private slots slots.private eval see ; +columns math.order classes.private slots slots.private eval see +words.symbol ; IN: classes.tuple.tests TUPLE: rect x y w h ; @@ -62,7 +63,7 @@ TUPLE: predicate-test ; C: predicate-test -: predicate-test drop f ; +: predicate-test ( a -- ? ) drop f ; [ t ] [ predicate-test? ] unit-test @@ -97,7 +98,7 @@ TUPLE: size-test a b c d ; size-test tuple-layout second = ] unit-test -GENERIC: +GENERIC: ( a -- b ) TUPLE: yo-momma ; @@ -123,7 +124,7 @@ TUPLE: loc-recording ; TUPLE: forget-robustness ; -GENERIC: forget-robustness-generic +GENERIC: forget-robustness-generic ( a -- b ) M: forget-robustness forget-robustness-generic ; @@ -493,7 +494,7 @@ must-fail-with [ t ] [ "z" accessor-exists? ] unit-test [ [ ] ] [ - "IN: classes.tuple.tests GENERIC: forget-accessors-test" + "IN: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b )" "forget-accessors-test" parse-stream ] unit-test @@ -508,7 +509,7 @@ TUPLE: another-forget-accessors-test ; [ [ ] ] [ - "IN: classes.tuple.tests GENERIC: another-forget-accessors-test" + "IN: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b )" "another-forget-accessors-test" parse-stream ] unit-test @@ -567,7 +568,7 @@ GENERIC: break-me ( obj -- ) [ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" eval ] unit-test -[ ] [ "IN: classes.tuple.tests : subclass-reset-test ;" "subclass-reset-test" parse-stream drop ] unit-test +[ ] [ "IN: classes.tuple.tests : subclass-reset-test ( -- ) ;" "subclass-reset-test" parse-stream drop ] unit-test [ f ] [ subclass-reset-test-1 tuple-class? ] unit-test [ f ] [ subclass-reset-test-2 tuple-class? ] unit-test @@ -666,7 +667,7 @@ DEFER: error-y [ ] [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test -[ ] [ "IN: classes.tuple.tests GENERIC: error-y" eval ] unit-test +[ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" eval ] unit-test [ f ] [ \ error-y tuple-class? ] unit-test @@ -730,4 +731,18 @@ SLOT: kex ] unit-test [ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test -[ f ] [ \ change-slot-test \ kex>> method "reading" word-prop ] unit-test \ No newline at end of file +[ f ] [ \ change-slot-test \ kex>> method "reading" word-prop ] unit-test + +DEFER: redefine-tuple-twice + +[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test + +[ t ] [ \ redefine-tuple-twice symbol? ] unit-test + +[ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" eval ] unit-test + +[ t ] [ \ redefine-tuple-twice deferred? ] unit-test + +[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test + +[ t ] [ \ redefine-tuple-twice symbol? ] unit-test \ No newline at end of file diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index a01c9db53e..fb7a073205 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -247,8 +247,7 @@ M: tuple-class update-class bi ] each-subclass ] - [ define-new-tuple-class ] - 3bi ; + [ define-new-tuple-class ] 3bi ; : tuple-class-unchanged? ( class superclass slots -- ? ) [ [ superclass ] [ bootstrap-word ] bi* = ] @@ -275,7 +274,7 @@ M: word (define-tuple-class) M: tuple-class (define-tuple-class) 3dup tuple-class-unchanged? - [ 3drop ] [ redefine-tuple-class ] if ; + [ 2drop ?define-symbol ] [ redefine-tuple-class ] if ; : thrower-effect ( slots -- effect ) [ dup array? [ first ] when ] map { "*" } ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index eac288a079..afa05f9442 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -148,6 +148,7 @@ GENERIC: definitions-changed ( assoc obj -- ) [ H{ } clone changed-definitions set H{ } clone changed-generics set + H{ } clone changed-effects set H{ } clone outdated-generics set H{ } clone outdated-tuples set H{ } clone new-classes set @@ -158,6 +159,7 @@ GENERIC: definitions-changed ( assoc obj -- ) [ H{ } clone changed-definitions set H{ } clone changed-generics set + H{ } clone changed-effects set H{ } clone outdated-generics set H{ } clone forgotten-definitions set H{ } clone outdated-tuples set diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index 3fa30b63ee..434b133b3f 100644 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -1,13 +1,11 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: definitions USING: kernel sequences namespaces assocs graphs math math.order ; +IN: definitions ERROR: no-compilation-unit definition ; -SYMBOL: inlined-dependency -SYMBOL: flushed-dependency -SYMBOL: called-dependency +SYMBOLS: inlined-dependency flushed-dependency called-dependency ; : set-in-unit ( value key assoc -- ) [ set-at ] [ no-compilation-unit ] if* ; @@ -17,6 +15,11 @@ SYMBOL: changed-definitions : changed-definition ( defspec -- ) inlined-dependency swap changed-definitions get set-in-unit ; +SYMBOL: changed-effects + +: changed-effect ( word -- ) + dup changed-effects get set-in-unit ; + SYMBOL: changed-generics SYMBOL: outdated-generics diff --git a/core/generic/generic.factor b/core/generic/generic.factor index c78c88eef0..8380a41207 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -199,8 +199,7 @@ M: sequence update-methods ( class seq -- ) 2cleave ] if ] - [ 2drop remake-generic ] - 3tri ; + [ 2drop remake-generic ] 3tri ; M: generic subwords [ diff --git a/core/words/words.factor b/core/words/words.factor index b101350db0..cfdcd4517f 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -164,8 +164,10 @@ CONSTANT: reset-on-redefine { "inferred-effect" "cannot-infer" } : set-stack-effect ( effect word -- ) 2dup "declared-effect" word-prop = [ 2drop ] [ swap + [ drop changed-effect ] [ "declared-effect" set-word-prop ] - [ drop dup primitive? [ dup redefined ] unless drop ] 2bi + [ drop dup primitive? [ drop ] [ redefined ] if ] + 2tri ] if ; : define-declared ( word def effect -- ) @@ -192,7 +194,7 @@ M: word reset-word { "unannotated-def" "parsing" "inline" "recursive" "foldable" "flushable" "reading" "writing" "reader" - "writer" "declared-effect" "delimiter" + "writer" "delimiter" } reset-props ; GENERIC: subwords ( word -- seq ) From 75452c842f89bc588d9588c62f4aa9426b1a2acb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 21:37:42 -0500 Subject: [PATCH 17/43] cpu.ppc.bootstrap: update for syntax change --- basis/cpu/ppc/bootstrap.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index ebee48de5f..ec7bf8f341 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -11,8 +11,8 @@ big-endian on 4 jit-code-format set -: ds-reg 29 ; -: rs-reg 30 ; +CONSTANT: ds-reg 29 +CONSTANT: rs-reg 30 : factor-area-size ( -- n ) 4 bootstrap-cells ; From 0a8fb3e5f39222ce9d0bd445c654340bedb3069c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 21:38:06 -0500 Subject: [PATCH 18/43] xml.syntax: update for syntax change --- basis/xml/syntax/syntax.factor | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/basis/xml/syntax/syntax.factor b/basis/xml/syntax/syntax.factor index abe0f90738..f39592036c 100644 --- a/basis/xml/syntax/syntax.factor +++ b/basis/xml/syntax/syntax.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: words assocs kernel accessors parser sequences summary -lexer splitting combinators locals xml.data memoize sequences.deep -xml.data xml.state xml namespaces present arrays generalizations strings -make math macros multiline inverse combinators.short-circuit -sorting fry unicode.categories ; +USING: words assocs kernel accessors parser effects.parser +sequences summary lexer splitting combinators locals xml.data +memoize sequences.deep xml.data xml.state xml namespaces present +arrays generalizations strings make math macros multiline +inverse combinators.short-circuit sorting fry unicode.categories +effects ; IN: xml.syntax SYNTAX: TAGS: - CREATE complete-effect + CREATE-WORD complete-effect [ drop H{ } clone "xtable" set-word-prop ] [ define-tags ] 2bi ; From 69bf52c2a6d7030f7fd6f8899b793bd9ba2876f9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 21:38:36 -0500 Subject: [PATCH 19/43] adsoda, 4DNav: fix compile errors exposed by stronger static checking --- extra/4DNav/4DNav.factor | 2 +- extra/adsoda/adsoda.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/4DNav/4DNav.factor b/extra/4DNav/4DNav.factor index ee37b33fbf..aae0b40d38 100755 --- a/extra/4DNav/4DNav.factor +++ b/extra/4DNav/4DNav.factor @@ -172,7 +172,7 @@ VAR: present-space swap call space-ensure-solids >present-space update-model-projections - update-observer-projections ; + update-observer-projections ; inline : rotation-4D ( m -- ) '[ _ [ [ middle-of-space dup vneg ] keep diff --git a/extra/adsoda/adsoda.factor b/extra/adsoda/adsoda.factor index ec77501b8f..4042528eba 100755 --- a/extra/adsoda/adsoda.factor +++ b/extra/adsoda/adsoda.factor @@ -60,7 +60,7 @@ t to: remove-hidden-solids? : dimension ( array -- x ) length 1- ; inline : last ( seq -- x ) [ dimension ] [ nth ] bi ; inline : change-last ( seq quot -- ) - [ [ dimension ] keep ] dip change-nth ; + [ [ dimension ] keep ] dip change-nth ; inline ! ------------------------------------------------------------- ! light @@ -445,7 +445,7 @@ TUPLE: space name dimension solids ambient-color lights ; : space-apply ( space m quot -- space ) curry [ map ] curry [ dup solids>> ] dip - [ call ] [ drop ] recover drop ; + [ call ] [ 2drop ] recover drop ; inline : space-transform ( space m -- space ) [ solid-transform ] space-apply ; : space-translate ( space v -- space ) From 353788190dba1d3687bac7becfedba83cd03614c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 21:42:01 -0500 Subject: [PATCH 20/43] promises: fix for syntax change and simplify a little bit --- extra/promises/promises-docs.factor | 22 ++++---------------- extra/promises/promises.factor | 31 ++++++----------------------- 2 files changed, 10 insertions(+), 43 deletions(-) diff --git a/extra/promises/promises-docs.factor b/extra/promises/promises-docs.factor index 4e8dc9a9a2..d416842ef5 100755 --- a/extra/promises/promises-docs.factor +++ b/extra/promises/promises-docs.factor @@ -1,34 +1,20 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. - USING: help.markup help.syntax ; IN: promises HELP: promise { $values { "quot" { $quotation "( -- X )" } } { "promise" "a promise object" } } -{ $description "Creates a promise to return a value. When forced this quotation is called and the value returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } -{ $see-also force promise-with promise-with2 } ; - -HELP: promise-with -{ $values { "value" "an object" } { "quot" { $quotation "( value -- X )" } } { "promise" "a promise object" } } -{ $description "Creates a promise to return a value. When forced this quotation is called with the given value on the stack and the result returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } -{ $see-also force promise promise-with2 } ; - -HELP: promise-with2 -{ $values { "value1" "an object" } { "value2" "an object" } { "quot" { $quotation "( value1 value2 -- X )" } } { "promise" "a promise object" } } -{ $description "Creates a promise to return a value. When forced this quotation is called with the given values on the stack and the result returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } -{ $see-also force promise promise-with2 } ; +{ $description "Creates a promise to return a value. When forced this quotation is called and the value returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } ; HELP: force { $values { "promise" "a promise object" } { "value" "a factor object" } } -{ $description "Calls the quotation associated with the promise if it has not been called before, and returns the value. If the promise has been forced previously, returns the value from the previous call." } -{ $see-also promise promise-with promise-with2 } ; +{ $description "Calls the quotation associated with the promise if it has not been called before, and returns the value. If the promise has been forced previously, returns the value from the previous call." } ; HELP: LAZY: -{ $syntax "LAZY: word definition... ;" } +{ $syntax "LAZY: word ( stack -- effect ) definition... ;" } { $values { "word" "a new word to define" } { "definition" "a word definition" } } { $description "Creates a lazy word in the current vocabulary. When executed the word will return a " { $link promise } " that when forced, executes the word definition. Any values on the stack that are required by the word definition are captured along with the promise." } { $examples { $example "USING: arrays sequences prettyprint promises ;" "IN: scratchpad" "LAZY: zeroes ( -- pair ) 0 zeroes 2array ;" "zeroes force second force first ." "0" } -} -{ $see-also force promise-with promise-with2 } ; +} ; diff --git a/extra/promises/promises.factor b/extra/promises/promises.factor index 60b4418c3f..c3951f46ba 100755 --- a/extra/promises/promises.factor +++ b/extra/promises/promises.factor @@ -1,41 +1,22 @@ ! Copyright (C) 2004, 2006 Chris Double, Matthew Willis. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel sequences math vectors arrays namespaces -make quotations parser effects stack-checker words accessors ; +USING: arrays kernel sequences math arrays namespaces +parser effects generalizations fry words accessors ; IN: promises TUPLE: promise quot forced? value ; -: promise ( quot -- promise ) - f f \ promise boa ; - -: promise-with ( value quot -- promise ) - curry promise ; - -: promise-with2 ( value1 value2 quot -- promise ) - 2curry promise ; +: promise ( quot -- promise ) f f \ promise boa ; : force ( promise -- value ) - #! Force the given promise leaving the value of calling the - #! promises quotation on the stack. Re-forcing the promise - #! will return the same value and not recall the quotation. dup forced?>> [ dup quot>> call( -- value ) >>value t >>forced? ] unless value>> ; -: stack-effect-in ( quot word -- n ) - stack-effect [ ] [ infer ] ?if in>> length ; - -: make-lazy-quot ( word quot -- quot ) - [ - dup , - swap stack-effect-in \ curry % - \ promise , - ] [ ] make ; +: make-lazy-quot ( quot effect -- quot ) + in>> length '[ _ _ ncurry promise ] ; SYNTAX: LAZY: - CREATE-WORD - dup parse-definition - make-lazy-quot define ; + (:) [ make-lazy-quot ] [ 2nip ] 3bi define-declared ; From 9ebd9c8d01d563ff081803de9126b4d69d2e3a2a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 21:42:15 -0500 Subject: [PATCH 21/43] Add unit test for regression --- basis/compiler/tests/redefine15.factor | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 basis/compiler/tests/redefine15.factor diff --git a/basis/compiler/tests/redefine15.factor b/basis/compiler/tests/redefine15.factor new file mode 100644 index 0000000000..797460a411 --- /dev/null +++ b/basis/compiler/tests/redefine15.factor @@ -0,0 +1,20 @@ +USING: compiler.units words tools.test math kernel ; +IN: compiler.tests.redefine15 + +DEFER: word-1 + +: word-2 ( a -- b ) word-1 ; + +[ \ word-1 [ ] (( a -- b )) define-declared ] with-compilation-unit + +[ "a" ] [ "a" word-2 ] unit-test + +: word-3 ( a -- b ) 1 + ; + +: word-4 ( a -- b c ) 0 swap word-3 swap 1+ ; + +[ 1 1 ] [ 0 word-4 ] unit-test + +[ \ word-3 [ [ 2 + ] bi@ ] (( a b -- c d )) define-declared ] with-compilation-unit + +[ 2 3 ] [ 0 word-4 ] unit-test \ No newline at end of file From ccc4c417251994338f6d56d56e4d07909b4005a3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 21:42:23 -0500 Subject: [PATCH 22/43] Add promises unit tests --- extra/promises/promises-tests.factor | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 extra/promises/promises-tests.factor diff --git a/extra/promises/promises-tests.factor b/extra/promises/promises-tests.factor new file mode 100644 index 0000000000..79e7dc570e --- /dev/null +++ b/extra/promises/promises-tests.factor @@ -0,0 +1,7 @@ +IN: promises.tests +USING: promises math tools.test ; + +LAZY: lazy-test ( a -- b ) 1 + ; + +{ 1 1 } [ lazy-test ] must-infer-as +[ 3 ] [ 2 lazy-test force ] unit-test \ No newline at end of file From 723bfab0304d8fa449d81f866c7f0bf4643bd203 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 00:34:02 -0500 Subject: [PATCH 23/43] Fixing unit tests for syntax change --- basis/bit-vectors/bit-vectors-tests.factor | 2 +- basis/byte-vectors/byte-vectors-tests.factor | 2 +- basis/calendar/calendar-tests.factor | 2 +- basis/cocoa/cocoa-tests.factor | 2 +- basis/db/tuples/tuples-tests.factor | 6 +- basis/delegate/delegate-tests.factor | 8 +- basis/fry/fry-tests.factor | 2 +- basis/furnace/actions/actions-tests.factor | 2 +- basis/furnace/furnace-tests.factor | 2 +- basis/furnace/sessions/sessions-tests.factor | 8 +- basis/hash2/hash2-tests.factor | 2 +- basis/help/crossref/crossref-tests.factor | 4 +- .../help/definitions/definitions-tests.factor | 6 +- basis/help/markup/markup-tests.factor | 2 +- basis/html/templates/chloe/chloe-tests.factor | 6 +- basis/http/http-tests.factor | 10 +-- basis/io/backend/unix/unix-tests.factor | 8 +- basis/io/encodings/utf16n/utf16n-tests.factor | 2 +- basis/io/streams/duplex/duplex-tests.factor | 4 +- basis/listener/listener-tests.factor | 2 +- basis/locals/locals-tests.factor | 10 +-- basis/macros/macros-tests.factor | 10 ++- basis/macros/macros.factor | 4 +- basis/models/models-tests.factor | 2 +- basis/models/range/range-tests.factor | 2 +- basis/persistent/heaps/heaps-tests.factor | 4 +- basis/prettyprint/prettyprint-tests.factor | 18 ++-- basis/serialize/serialize-tests.factor | 6 +- .../annotations/annotations-tests.factor | 2 +- basis/tools/crossref/crossref-tests.factor | 2 +- basis/tools/walker/walker-tests.factor | 2 +- basis/ui/gadgets/buttons/buttons-tests.factor | 4 +- basis/ui/gadgets/gadgets-tests.factor | 4 +- basis/ui/gadgets/panes/panes-tests.factor | 2 +- basis/ui/operations/operations-tests.factor | 2 +- basis/ui/tools/listener/listener-tests.factor | 2 +- basis/urls/urls-tests.factor | 4 +- core/classes/singleton/singleton-tests.factor | 2 +- core/combinators/combinators-tests.factor | 2 +- core/continuations/continuations-tests.factor | 8 +- core/destructors/destructors-tests.factor | 6 +- core/io/test/no-trailing-eol.factor | 2 +- core/kernel/kernel-tests.factor | 12 +-- core/parser/parser-tests.factor | 78 ++++++++-------- core/vocabs/loader/loader-tests.factor | 2 +- core/vocabs/loader/test/d/d.factor | 2 +- extra/advice/advice-tests.factor | 2 +- extra/descriptive/descriptive.factor | 89 ++++++++++--------- extra/infix/infix-tests.factor | 2 - extra/lint/lint-tests.factor | 2 +- extra/math/analysis/analysis-tests.factor | 3 +- extra/multi-methods/tests/canonicalize.factor | 8 +- extra/multi-methods/tests/legacy.factor | 2 +- extra/sequences/n-based/n-based-tests.factor | 2 +- extra/svg/svg-tests.factor | 2 +- extra/units/units-tests.factor | 4 +- 56 files changed, 196 insertions(+), 196 deletions(-) diff --git a/basis/bit-vectors/bit-vectors-tests.factor b/basis/bit-vectors/bit-vectors-tests.factor index 31327999e7..41efdbd0d2 100644 --- a/basis/bit-vectors/bit-vectors-tests.factor +++ b/basis/bit-vectors/bit-vectors-tests.factor @@ -3,7 +3,7 @@ USING: tools.test bit-vectors vectors sequences kernel math ; [ 0 ] [ 123 length ] unit-test -: do-it +: do-it ( seq -- ) 1234 swap [ [ even? ] dip push ] curry each ; [ t ] [ diff --git a/basis/byte-vectors/byte-vectors-tests.factor b/basis/byte-vectors/byte-vectors-tests.factor index 9a100d9795..bd7510c95f 100644 --- a/basis/byte-vectors/byte-vectors-tests.factor +++ b/basis/byte-vectors/byte-vectors-tests.factor @@ -4,7 +4,7 @@ prettyprint ; [ 0 ] [ 123 length ] unit-test -: do-it +: do-it ( seq -- seq ) 123 [ over push ] each ; [ t ] [ diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor index 00d5730745..b6d8e74072 100644 --- a/basis/calendar/calendar-tests.factor +++ b/basis/calendar/calendar-tests.factor @@ -148,7 +148,7 @@ IN: calendar.tests [ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test [ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test -: checktime+ now dup clone [ rot time+ drop ] keep = ; +: checktime+ ( duration -- ? ) now dup clone [ rot time+ drop ] keep = ; [ t ] [ 5 seconds checktime+ ] unit-test diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index d77435a8ad..4b5af2e39d 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -13,7 +13,7 @@ CLASS: { [ gc "x" set 2drop ] } ; -: test-foo +: test-foo ( -- ) Foo -> alloc -> init dup 1.0 2.0 101.0 102.0 -> foo: -> release ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index af77ce6ac1..50d7f044d1 100644 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -285,7 +285,7 @@ paste "PASTE" [ test-cascade ] test-postgresql [ test-restrict ] test-postgresql -: test-repeated-insert +: test-repeated-insert ( -- ) [ ] [ person ensure-table ] unit-test [ ] [ person1 get insert-tuple ] unit-test [ person1 get insert-tuple ] must-fail ; @@ -458,7 +458,7 @@ TUPLE: bignum-test id m n o ; swap >>n swap >>m ; -: test-bignum +: test-bignum ( -- ) bignum-test "BIGNUM_TEST" { { "id" "ID" +db-assigned-id+ } @@ -478,7 +478,7 @@ TUPLE: bignum-test id m n o ; TUPLE: secret n message ; C: secret -: test-random-id +: test-random-id ( -- ) secret "SECRET" { { "n" "ID" +random-id+ system-random-generator } diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index 9bf07a5330..cf822b40a3 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -41,13 +41,13 @@ M: hello bing hello-test ; [ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" ] [ [ baz see ] with-string-writer ] unit-test -GENERIC: one +GENERIC: one ( a -- b ) M: integer one ; -GENERIC: two +GENERIC: two ( a -- b ) M: integer two ; -GENERIC: three +GENERIC: three ( a -- b ) M: integer three ; -GENERIC: four +GENERIC: four ( a -- b ) M: integer four ; PROTOCOL: alpha one two ; diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor index 7189450394..d240e6f233 100644 --- a/basis/fry/fry-tests.factor +++ b/basis/fry/fry-tests.factor @@ -34,7 +34,7 @@ sequences eval accessors ; { "a" "b" "c" } swap map ] unit-test -: funny-dip '[ [ @ ] dip ] call ; inline +: funny-dip ( obj quot -- ) '[ [ @ ] dip ] call ; inline [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test diff --git a/basis/furnace/actions/actions-tests.factor b/basis/furnace/actions/actions-tests.factor index 60a526fb24..cefeda0481 100644 --- a/basis/furnace/actions/actions-tests.factor +++ b/basis/furnace/actions/actions-tests.factor @@ -7,7 +7,7 @@ IN: furnace.actions.tests [ "a" param "b" param [ string>number ] bi@ + ] >>display "action-1" set -: lf>crlf "\n" split "\r\n" join ; +: lf>crlf ( string -- string' ) "\n" split "\r\n" join ; STRING: action-request-test-1 GET http://foo/bar?a=12&b=13 HTTP/1.1 diff --git a/basis/furnace/furnace-tests.factor b/basis/furnace/furnace-tests.factor index c591b848ec..1d5aa43c7b 100644 --- a/basis/furnace/furnace-tests.factor +++ b/basis/furnace/furnace-tests.factor @@ -4,7 +4,7 @@ http.server furnace furnace.utilities tools.test kernel namespaces accessors io.streams.string urls xml.writer ; TUPLE: funny-dispatcher < dispatcher ; -: funny-dispatcher new-dispatcher ; +: ( -- dispatcher ) funny-dispatcher new-dispatcher ; TUPLE: base-path-check-responder ; diff --git a/basis/furnace/sessions/sessions-tests.factor b/basis/furnace/sessions/sessions-tests.factor index 14cdce3811..b325c778cf 100644 --- a/basis/furnace/sessions/sessions-tests.factor +++ b/basis/furnace/sessions/sessions-tests.factor @@ -6,7 +6,7 @@ io.streams.string io.files io.files.temp io.directories splitting destructors sequences db db.tuples db.sqlite continuations urls math.parser furnace furnace.utilities ; -: with-session +: with-session ( session quot -- ) [ [ [ save-session-after ] [ session set ] bi ] dip call ] with-destructors ; inline @@ -22,7 +22,7 @@ M: foo call-responder* "x" [ 1+ ] schange "x" sget number>string "text/html" ; -: url-responder-mock-test +: url-responder-mock-test ( -- ) [ "GET" >>method @@ -34,7 +34,7 @@ M: foo call-responder* [ write-response-body drop ] with-string-writer ] with-destructors ; -: sessions-mock-test +: sessions-mock-test ( -- ) [ "GET" >>method @@ -45,7 +45,7 @@ M: foo call-responder* [ write-response-body drop ] with-string-writer ] with-destructors ; -: +: ( -- action ) [ [ ] "text/plain" exit-with ] >>display ; diff --git a/basis/hash2/hash2-tests.factor b/basis/hash2/hash2-tests.factor index 5f1f072736..6f97c7c3d5 100644 --- a/basis/hash2/hash2-tests.factor +++ b/basis/hash2/hash2-tests.factor @@ -4,7 +4,7 @@ IN: hash2.tests [ t ] [ 1 2 { 1 2 } 2= ] unit-test [ f ] [ 1 3 { 1 2 } 2= ] unit-test -: sample-hash +: sample-hash ( -- ) 5 dup 2 3 "foo" roll set-hash2 dup 4 2 "bar" roll set-hash2 diff --git a/basis/help/crossref/crossref-tests.factor b/basis/help/crossref/crossref-tests.factor index 47c3105436..2e01330d73 100644 --- a/basis/help/crossref/crossref-tests.factor +++ b/basis/help/crossref/crossref-tests.factor @@ -4,7 +4,7 @@ definitions assocs sequences kernel namespaces parser arrays io.streams.string continuations debugger compiler.units eval ; [ ] [ - "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval + "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval ] unit-test [ $subsection ] [ @@ -23,7 +23,7 @@ io.streams.string continuations debugger compiler.units eval ; ] unit-test [ ] [ - "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval + "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval ] unit-test [ ] [ diff --git a/basis/help/definitions/definitions-tests.factor b/basis/help/definitions/definitions-tests.factor index 5d83afae88..7bb66eca02 100644 --- a/basis/help/definitions/definitions-tests.factor +++ b/basis/help/definitions/definitions-tests.factor @@ -7,7 +7,7 @@ IN: help.definitions.tests [ [ 4 ] [ - "IN: help.definitions.tests USING: help.syntax ; : hello ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" "foo" + "IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -20,7 +20,7 @@ IN: help.definitions.tests ] unit-test [ 2 ] [ - "IN: help.definitions.tests USING: help.syntax ; : hello ; ARTICLE: \"hello\" \"world\" ;" "foo" + "IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; ARTICLE: \"hello\" \"world\" ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -32,7 +32,7 @@ IN: help.definitions.tests "hello" "help.definitions.tests" lookup "help" word-prop ] unit-test - [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ; HELP: xxx ;" eval ] unit-test + [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval ] unit-test [ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test diff --git a/basis/help/markup/markup-tests.factor b/basis/help/markup/markup-tests.factor index 74bc45d36c..9b928f3691 100644 --- a/basis/help/markup/markup-tests.factor +++ b/basis/help/markup/markup-tests.factor @@ -11,7 +11,7 @@ TUPLE: blahblah quux ; [ ] [ \ >>quux print-topic ] unit-test [ ] [ \ blahblah? print-topic ] unit-test -: fooey "fooey" throw ; +: fooey ( -- * ) "fooey" throw ; [ ] [ \ fooey print-topic ] unit-test diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor index 86f86a8468..fd786d355d 100644 --- a/basis/html/templates/chloe/chloe-tests.factor +++ b/basis/html/templates/chloe/chloe-tests.factor @@ -5,7 +5,7 @@ splitting unicode.categories furnace accessors html.templates.chloe.compiler ; IN: html.templates.chloe.tests -: run-template +: run-template ( quot -- string ) with-string-writer [ "\r\n\t" member? not ] filter "?>" split1 nip ; inline @@ -37,7 +37,7 @@ IN: html.templates.chloe.tests ] run-template ] unit-test -: test4-aux? t ; +: test4-aux? ( -- ? ) t ; [ "True" ] [ [ @@ -45,7 +45,7 @@ IN: html.templates.chloe.tests ] run-template ] unit-test -: test5-aux? f ; +: test5-aux? ( -- ? ) f ; [ "" ] [ [ diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 0d4282b1d7..bc906fad44 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -13,7 +13,7 @@ IN: http.tests [ "application/octet-stream" binary ] [ "application/octet-stream" parse-content-type ] unit-test -: lf>crlf "\n" split "\r\n" join ; +: lf>crlf ( string -- string' ) "\n" split "\r\n" join ; STRING: read-request-test-1 POST /bar HTTP/1.1 @@ -180,14 +180,14 @@ accessors namespaces threads http.server.responses http.server.redirection furnace.redirection http.server.dispatchers db.tuples ; -: add-quit-action +: add-quit-action ( responder -- responder ) [ stop-this-server "Goodbye" "text/html" ] >>display "quit" add-responder ; -: test-db-file "test.db" temp-file ; +: test-db-file ( -- path ) "test.db" temp-file ; -: test-db test-db-file ; +: test-db ( -- db ) test-db-file ; [ test-db-file delete-file ] ignore-errors @@ -268,7 +268,7 @@ test-db [ test-httpd ] unit-test -: 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ; +: 404? ( response -- ? ) [ download-failed? ] [ response>> code>> 404 = ] bi and ; ! This should give a 404 not an infinite redirect loop [ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with diff --git a/basis/io/backend/unix/unix-tests.factor b/basis/io/backend/unix/unix-tests.factor index 2e94d7a2df..ed054d7958 100644 --- a/basis/io/backend/unix/unix-tests.factor +++ b/basis/io/backend/unix/unix-tests.factor @@ -5,7 +5,7 @@ io.streams.duplex destructors make io.launcher ; IN: io.backend.unix.tests ! Unix domain stream sockets -: socket-server "unix-domain-socket-test" temp-file ; +: socket-server ( -- path ) "unix-domain-socket-test" temp-file ; [ [ socket-server delete-file ] ignore-errors @@ -33,8 +33,8 @@ yield ] { } make ] unit-test -: datagram-server "unix-domain-datagram-test" temp-file ; -: datagram-client "unix-domain-datagram-test-2" temp-file ; +: datagram-server ( -- path ) "unix-domain-datagram-test" temp-file ; +: datagram-client ( -- path ) "unix-domain-datagram-test-2" temp-file ; ! Unix domain datagram sockets [ datagram-server delete-file ] ignore-errors @@ -104,7 +104,7 @@ datagram-client [ ] [ "d" get dispose ] unit-test ! Test error behavior -: another-datagram "unix-domain-datagram-test-3" temp-file ; +: another-datagram ( -- path ) "unix-domain-datagram-test-3" temp-file ; [ another-datagram delete-file ] ignore-errors diff --git a/basis/io/encodings/utf16n/utf16n-tests.factor b/basis/io/encodings/utf16n/utf16n-tests.factor index 5e7d1af8f5..9f3f35ff2a 100644 --- a/basis/io/encodings/utf16n/utf16n-tests.factor +++ b/basis/io/encodings/utf16n/utf16n-tests.factor @@ -2,7 +2,7 @@ USING: accessors alien.c-types kernel io.encodings.utf16 io.streams.byte-array tools.test ; IN: io.encodings.utf16n -: correct-endian +: correct-endian ( obj -- ? ) code>> little-endian? [ utf16le = ] [ utf16be = ] if ; [ t ] [ B{ } utf16n correct-endian ] unit-test diff --git a/basis/io/streams/duplex/duplex-tests.factor b/basis/io/streams/duplex/duplex-tests.factor index 860702c563..4903db2b1b 100644 --- a/basis/io/streams/duplex/duplex-tests.factor +++ b/basis/io/streams/duplex/duplex-tests.factor @@ -5,13 +5,13 @@ IN: io.streams.duplex.tests ! Test duplex stream close behavior TUPLE: closing-stream < disposable ; -: closing-stream new ; +: ( -- stream ) closing-stream new ; M: closing-stream dispose* drop ; TUPLE: unclosable-stream ; -: unclosable-stream new ; +: ( -- stream ) unclosable-stream new ; M: unclosable-stream dispose "Can't close me!" throw ; diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor index 00f1cca678..0616794939 100644 --- a/basis/listener/listener-tests.factor +++ b/basis/listener/listener-tests.factor @@ -50,7 +50,7 @@ SYNTAX: hello "Hi" print ; [ [ ] [ - "IN: listener.tests : hello\n\"world\" ;" parse-interactive + "IN: listener.tests : hello ( -- )\n\"world\" ;" parse-interactive drop ] unit-test ] with-file-vocabs diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 558fa78494..8e3b59fe69 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -192,14 +192,14 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ; DEFER: xyzzy [ ] [ - "IN: locals.tests USE: math GENERIC: xyzzy M: integer xyzzy ;" + "IN: locals.tests USE: math GENERIC: xyzzy ( a -- b ) M: integer xyzzy ;" "lambda-generic-test" parse-stream drop ] unit-test [ 10 ] [ 10 xyzzy ] unit-test [ ] [ - "IN: locals.tests USE: math USE: locals GENERIC: xyzzy M:: integer xyzzy ( n -- ) 5 ;" + "IN: locals.tests USE: math USE: locals GENERIC: xyzzy ( a -- b ) M:: integer xyzzy ( n -- x ) 5 ;" "lambda-generic-test" parse-stream drop ] unit-test @@ -245,7 +245,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; [ 5 ] [ 1 next-method-test ] unit-test -: no-with-locals-test { 1 2 3 } [| x | x 3 + ] map ; +: no-with-locals-test ( -- seq ) { 1 2 3 } [| x | x 3 + ] map ; [ { 4 5 6 } ] [ no-with-locals-test ] unit-test @@ -259,7 +259,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; :: a-word-with-locals ( a b -- ) ; -: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" ; +CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" [ ] [ new-definition eval ] unit-test @@ -268,7 +268,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; new-definition = ] unit-test -: method-definition "USING: locals locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n" ; +CONSTANT: method-definition "USING: locals locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n" GENERIC: method-with-locals ( x -- y ) diff --git a/basis/macros/macros-tests.factor b/basis/macros/macros-tests.factor index 7d93ce8a9e..91aa6880e6 100644 --- a/basis/macros/macros-tests.factor +++ b/basis/macros/macros-tests.factor @@ -2,16 +2,22 @@ IN: macros.tests USING: tools.test macros math kernel arrays vectors io.streams.string prettyprint parser eval see ; -MACRO: see-test ( a b -- c ) + ; +MACRO: see-test ( a b -- quot ) + ; -[ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- c ) + ;\n" ] +[ t ] [ \ see-test macro? ] unit-test + +[ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" ] [ [ \ see-test see ] with-string-writer ] unit-test +[ t ] [ \ see-test macro? ] unit-test + [ t ] [ "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval [ \ see-test see ] with-string-writer = ] unit-test +[ f ] [ \ see-test macro? ] unit-test + [ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval ] unit-test diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index f64c88388a..a86b711340 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -7,14 +7,14 @@ IN: macros > 1 ; + in>> { "quot" } ; PRIVATE> : define-macro ( word definition effect -- ) real-macro-effect - [ drop "macro" set-word-prop ] [ [ memoize-quot [ call ] append ] keep define-declared ] + [ drop "macro" set-word-prop ] 3bi ; SYNTAX: MACRO: (:) define-macro ; diff --git a/basis/models/models-tests.factor b/basis/models/models-tests.factor index 67155b8303..f875fa3140 100644 --- a/basis/models/models-tests.factor +++ b/basis/models/models-tests.factor @@ -4,7 +4,7 @@ IN: models.tests TUPLE: model-tester hit? ; -: model-tester new ; +: ( -- model-tester ) model-tester new ; M: model-tester model-changed nip t >>hit? drop ; diff --git a/basis/models/range/range-tests.factor b/basis/models/range/range-tests.factor index 50c0365728..e9119e8452 100644 --- a/basis/models/range/range-tests.factor +++ b/basis/models/range/range-tests.factor @@ -3,7 +3,7 @@ USING: arrays generic kernel math models namespaces sequences assocs tools.test models.range ; ! Test -: setup-range 0 0 0 255 ; +: setup-range ( -- range ) 0 0 0 255 ; ! clamp-value should not go past range ends [ 0 ] [ -10 setup-range clamp-value ] unit-test diff --git a/basis/persistent/heaps/heaps-tests.factor b/basis/persistent/heaps/heaps-tests.factor index cecd6dab53..3a1f910532 100644 --- a/basis/persistent/heaps/heaps-tests.factor +++ b/basis/persistent/heaps/heaps-tests.factor @@ -1,9 +1,9 @@ USING: persistent.heaps tools.test ; IN: persistent.heaps.tests -: test-input +CONSTANT: test-input { { "hello" 3 } { "goodbye" 2 } { "whatever" 5 } - { "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } } ; + { "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } } [ { { "baz" -7 } { "bar" -1 } { "bing" 0 } { "foo" 1 } diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index aaaf6b80d1..7e37aa0da5 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -63,7 +63,7 @@ unit-test [ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] with-string-writer ] unit-test -: blah +: blah ( a a a a a a a a a a a a a a a a a a a a -- ) drop drop drop @@ -102,7 +102,7 @@ unit-test ] keep = ] with-scope ; -GENERIC: method-layout +GENERIC: method-layout ( a -- b ) M: complex method-layout "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" @@ -135,7 +135,7 @@ M: object method-layout ; [ \ method-layout see-methods ] with-string-writer "\n" split ] unit-test -: soft-break-test +: soft-break-test ( -- str ) { "USING: kernel math sequences strings ;" "IN: prettyprint.tests" @@ -152,7 +152,7 @@ M: object method-layout ; DEFER: parse-error-file -: another-soft-break-test +: another-soft-break-test ( -- str ) { "USING: make sequences ;" "IN: prettyprint.tests" @@ -166,7 +166,7 @@ DEFER: parse-error-file check-see ] unit-test -: string-layout +: string-layout ( -- str ) { "USING: accessors debugger io kernel ;" "IN: prettyprint.tests" @@ -187,7 +187,7 @@ DEFER: parse-error-file \ send soft "break-after" set-word-prop -: final-soft-break-test +: final-soft-break-test ( -- str ) { "USING: kernel sequences ;" "IN: prettyprint.tests" @@ -202,7 +202,7 @@ DEFER: parse-error-file "final-soft-break-layout" final-soft-break-test check-see ] unit-test -: narrow-test +: narrow-test ( -- str ) { "USING: arrays combinators continuations kernel sequences ;" "IN: prettyprint.tests" @@ -218,7 +218,7 @@ DEFER: parse-error-file "narrow-layout" narrow-test check-see ] unit-test -: another-narrow-test +: another-narrow-test ( -- str ) { "IN: prettyprint.tests" ": another-narrow-layout ( -- obj )" @@ -326,7 +326,7 @@ INTERSECTION: intersection-see-test sequence number ; TUPLE: started-out-hustlin' ; -GENERIC: ended-up-ballin' +GENERIC: ended-up-ballin' ( a -- b ) M: started-out-hustlin' ended-up-ballin' ; inline diff --git a/basis/serialize/serialize-tests.factor b/basis/serialize/serialize-tests.factor index 99c6d0e255..d23c8be84b 100644 --- a/basis/serialize/serialize-tests.factor +++ b/basis/serialize/serialize-tests.factor @@ -7,7 +7,7 @@ sequences math prettyprint parser classes math.constants io.encodings.binary random assocs serialize.private ; IN: serialize.tests -: test-serialize-cell +: test-serialize-cell ( a -- ? ) 2^ random dup binary [ serialize-cell ] with-byte-writer binary [ deserialize-cell ] with-byte-reader = ; @@ -27,7 +27,7 @@ TUPLE: serialize-test a b ; C: serialize-test -: objects +CONSTANT: objects { f t @@ -52,7 +52,7 @@ C: serialize-test << 1 [ 2 ] curry parsed >> { { "a" "bc" } { "de" "fg" } } H{ { "a" "bc" } { "de" "fg" } } - } ; + } : check-serialize-1 ( obj -- ? ) "=====" print diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor index 7e377aedd9..f47852aca7 100644 --- a/basis/tools/annotations/annotations-tests.factor +++ b/basis/tools/annotations/annotations-tests.factor @@ -2,7 +2,7 @@ USING: tools.test tools.annotations tools.time math parser eval io.streams.string kernel strings ; IN: tools.annotations.tests -: foo ; +: foo ( -- ) ; \ foo watch [ ] [ foo ] unit-test diff --git a/basis/tools/crossref/crossref-tests.factor b/basis/tools/crossref/crossref-tests.factor index d4f2fea2e5..d08a17fd02 100755 --- a/basis/tools/crossref/crossref-tests.factor +++ b/basis/tools/crossref/crossref-tests.factor @@ -3,7 +3,7 @@ tools.crossref tools.test parser namespaces source-files generic definitions ; IN: tools.crossref.tests -GENERIC: foo +GENERIC: foo ( a b -- c ) M: integer foo + ; diff --git a/basis/tools/walker/walker-tests.factor b/basis/tools/walker/walker-tests.factor index f802676583..3a5877c286 100644 --- a/basis/tools/walker/walker-tests.factor +++ b/basis/tools/walker/walker-tests.factor @@ -36,7 +36,7 @@ IN: tools.walker.tests [ 2 2 fixnum+ ] test-walker ] unit-test -: foo 2 2 fixnum+ ; +: foo ( -- x ) 2 2 fixnum+ ; [ { 8 } ] [ [ foo 4 fixnum+ ] test-walker diff --git a/basis/ui/gadgets/buttons/buttons-tests.factor b/basis/ui/gadgets/buttons/buttons-tests.factor index 6d1706ee74..0aa12f7279 100644 --- a/basis/ui/gadgets/buttons/buttons-tests.factor +++ b/basis/ui/gadgets/buttons/buttons-tests.factor @@ -5,9 +5,9 @@ IN: ui.gadgets.buttons.tests TUPLE: foo-gadget ; -: com-foo-a ; +: com-foo-a ( -- ) ; -: com-foo-b ; +: com-foo-b ( -- ) ; \ foo-gadget "toolbar" f { { f com-foo-a } diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor index baeb320447..03219c66fd 100644 --- a/basis/ui/gadgets/gadgets-tests.factor +++ b/basis/ui/gadgets/gadgets-tests.factor @@ -119,14 +119,14 @@ M: mock-gadget ungraft* [ { f f } ] [ "g" get graft-state>> ] unit-test ] with-variable - : add-some-children + : add-some-children ( gadget -- gadget ) 3 [ over >>model "g" get over add-gadget drop swap 1+ number>string set ] each ; - : status-flags + : status-flags ( -- seq ) { "g" "1" "2" "3" } [ get graft-state>> ] map prune ; : notify-combo ( ? ? -- ) diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor index 2947ce242d..0c47af0214 100644 --- a/basis/ui/gadgets/panes/panes-tests.factor +++ b/basis/ui/gadgets/panes/panes-tests.factor @@ -5,7 +5,7 @@ help.stylesheet splitting tools.test.ui models math summary inspector accessors help.topics see ; IN: ui.gadgets.panes.tests -: #children "pane" get children>> length ; +: #children ( -- n ) "pane" get children>> length ; [ ] [ "pane" set ] unit-test diff --git a/basis/ui/operations/operations-tests.factor b/basis/ui/operations/operations-tests.factor index fe7a8b52c5..4612ea79b0 100644 --- a/basis/ui/operations/operations-tests.factor +++ b/basis/ui/operations/operations-tests.factor @@ -3,7 +3,7 @@ USING: ui.operations ui.commands prettyprint kernel namespaces tools.test ui.gadgets ui.gadgets.editors parser io io.streams.string math help help.markup accessors ; -: my-pprint pprint ; +: my-pprint ( obj -- ) pprint ; [ drop t ] \ my-pprint [ ] f operation boa "op" set diff --git a/basis/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor index cd56dd876e..63df55b71a 100644 --- a/basis/ui/tools/listener/listener-tests.factor +++ b/basis/ui/tools/listener/listener-tests.factor @@ -68,7 +68,7 @@ IN: ui.tools.listener.tests [ ] [ >>output "interactor" set ] unit-test -: text "Hello world.\nThis is a test." ; +CONSTANT: text "Hello world.\nThis is a test." [ ] [ text "interactor" get set-editor-string ] unit-test diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index cac206bf3c..74eea9506c 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -2,7 +2,7 @@ IN: urls.tests USING: urls urls.private tools.test arrays kernel assocs present accessors ; -: urls +CONSTANT: urls { { T{ url @@ -80,7 +80,7 @@ arrays kernel assocs present accessors ; } "ftp://slava:secret@ftp.kernel.org/" } - } ; + } urls [ [ 1array ] [ [ >url ] curry ] bi* unit-test diff --git a/core/classes/singleton/singleton-tests.factor b/core/classes/singleton/singleton-tests.factor index d9011ad776..9d0bb7d16f 100644 --- a/core/classes/singleton/singleton-tests.factor +++ b/core/classes/singleton/singleton-tests.factor @@ -13,7 +13,7 @@ GENERIC: zammo ( obj -- str ) SINGLETON: word-and-singleton -: word-and-singleton 3 ; +: word-and-singleton ( -- x ) 3 ; [ t ] [ \ word-and-singleton word-and-singleton? ] unit-test [ 3 ] [ word-and-singleton ] unit-test diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index be7d93873e..76f9f63c49 100644 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -288,7 +288,7 @@ CONSTANT: case-const-2 2 } case ] unit-test -: do-not-call "do not call" throw ; +: do-not-call ( -- * ) "do not call" throw ; : test-case-6 ( obj -- value ) { diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor index d5bd0da663..34a4ed2879 100644 --- a/core/continuations/continuations-tests.factor +++ b/core/continuations/continuations-tests.factor @@ -3,7 +3,7 @@ continuations debugger parser memory arrays words kernel.private accessors eval ; IN: continuations.tests -: (callcc1-test) +: (callcc1-test) ( -- ) [ 1- dup ] dip ?push over 0 = [ "test-cc" get continue-with ] when (callcc1-test) ; @@ -59,10 +59,10 @@ IN: continuations.tests ! : callstack-overflow callstack-overflow f ; ! [ callstack-overflow ] must-fail -: don't-compile-me { } [ ] each ; +: don't-compile-me ( -- ) { } [ ] each ; -: foo callstack "c" set 3 don't-compile-me ; -: bar 1 foo 2 ; +: foo ( -- ) callstack "c" set 3 don't-compile-me ; +: bar ( -- a b ) 1 foo 2 ; [ 1 3 2 ] [ bar ] unit-test diff --git a/core/destructors/destructors-tests.factor b/core/destructors/destructors-tests.factor index e09a88aee4..f9d0770d02 100644 --- a/core/destructors/destructors-tests.factor +++ b/core/destructors/destructors-tests.factor @@ -21,7 +21,7 @@ T{ dispose-dummy } "b" set TUPLE: dummy-obj destroyed? ; -: dummy-obj new ; +: ( -- obj ) dummy-obj new ; TUPLE: dummy-destructor obj ; @@ -30,10 +30,10 @@ C: dummy-destructor M: dummy-destructor dispose ( obj -- ) obj>> t >>destroyed? drop ; -: destroy-always +: destroy-always ( obj -- ) &dispose drop ; -: destroy-later +: destroy-later ( obj -- ) |dispose drop ; [ t ] [ diff --git a/core/io/test/no-trailing-eol.factor b/core/io/test/no-trailing-eol.factor index 959f145bf5..e6ac5760aa 100644 --- a/core/io/test/no-trailing-eol.factor +++ b/core/io/test/no-trailing-eol.factor @@ -1,4 +1,4 @@ IN: io.tests USE: math -: foo 2 2 + ; +: foo ( -- x ) 2 2 + ; FORGET: foo \ No newline at end of file diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index 4d725e57f8..63346f4701 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -21,21 +21,21 @@ IN: kernel.tests [ ] [ :c ] unit-test -: overflow-d 3 overflow-d ; +: overflow-d ( -- ) 3 overflow-d ; [ overflow-d ] [ { "kernel-error" 12 f f } = ] must-fail-with [ ] [ :c ] unit-test -: (overflow-d-alt) 3 ; +: (overflow-d-alt) ( -- ) 3 ; -: overflow-d-alt (overflow-d-alt) overflow-d-alt ; +: overflow-d-alt ( -- ) (overflow-d-alt) overflow-d-alt ; [ overflow-d-alt ] [ { "kernel-error" 12 f f } = ] must-fail-with [ ] [ [ :c ] with-string-writer drop ] unit-test -: overflow-r 3 load-local overflow-r ; +: overflow-r ( -- ) 3 load-local overflow-r ; [ overflow-r ] [ { "kernel-error" 14 f f } = ] must-fail-with @@ -99,7 +99,7 @@ IN: kernel.tests [ ] [ :c ] unit-test ! Doesn't compile; important -: foo 5 + 0 [ ] each ; +: foo ( a -- b ) 5 + 0 [ ] each ; [ drop foo ] must-fail [ ] [ :c ] unit-test @@ -115,7 +115,7 @@ IN: kernel.tests [ loop ] must-fail ! Discovered on Windows -: total-failure-1 "" [ ] map unimplemented ; +: total-failure-1 ( -- ) "" [ ] map unimplemented ; [ total-failure-1 ] must-fail diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 2616e5fadb..3ba414fe6b 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -27,7 +27,7 @@ IN: parser.tests [ "hello world" ] [ - "IN: parser.tests : hello \"hello world\" ;" + "IN: parser.tests : hello ( -- str ) \"hello world\" ;" eval "USE: parser.tests hello" eval ] unit-test @@ -78,12 +78,8 @@ IN: parser.tests [ T{ effect f { "a" "b" } { "d" } f } ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test - [ ] [ "IN: parser.tests : effect-parsing-test ;" eval ] unit-test - - [ f ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test - ! Funny bug - [ 2 ] [ "IN: parser.tests : \0. 2 ; \0." eval ] unit-test + [ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval ] unit-test [ "IN: parser.tests : missing-- ( a b ) ;" eval ] must-fail @@ -110,7 +106,7 @@ IN: parser.tests [ ] [ "USE: parser.tests foo" eval ] unit-test - "IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ;" eval + "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval [ t ] [ "USE: parser.tests \\ foo" eval @@ -120,7 +116,7 @@ IN: parser.tests ! Test smudging [ 1 ] [ - "IN: parser.tests : smudge-me ;" "foo" + "IN: parser.tests : smudge-me ( -- ) ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -129,7 +125,7 @@ IN: parser.tests [ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test [ ] [ - "IN: parser.tests : smudge-me-more ;" "foo" + "IN: parser.tests : smudge-me-more ( -- ) ;" "foo" parse-stream drop ] unit-test @@ -137,7 +133,7 @@ IN: parser.tests [ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test [ 3 ] [ - "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ; M: string smudge-me ;" "foo" + "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -151,7 +147,7 @@ IN: parser.tests ] unit-test [ 2 ] [ - "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ;" "foo" + "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -190,7 +186,7 @@ IN: parser.tests [ ] [ "a" source-files get delete-at 2 [ - "IN: parser.tests DEFER: x : y x ; : x y ;" + "IN: parser.tests DEFER: x : y ( -- ) x ; : x ( -- ) y ;" "a" parse-stream drop ] times ] unit-test @@ -198,7 +194,7 @@ IN: parser.tests "a" source-files get delete-at [ - "IN: parser.tests : x ; : y 3 throw ; this is an error" + "IN: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error" "a" parse-stream ] [ source-file-error? ] must-fail-with @@ -207,7 +203,7 @@ IN: parser.tests ] unit-test [ f ] [ - "IN: parser.tests : x ;" + "IN: parser.tests : x ( -- ) ;" "a" parse-stream drop "y" "parser.tests" lookup @@ -215,18 +211,18 @@ IN: parser.tests ! Test new forward definition logic [ ] [ - "IN: axx : axx ;" + "IN: axx : axx ( -- ) ;" "axx" parse-stream drop ] unit-test [ ] [ - "USE: axx IN: bxx : bxx ; : cxx axx bxx ;" + "USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;" "bxx" parse-stream drop ] unit-test ! So we move the bxx word to axx... [ ] [ - "IN: axx : axx ; : bxx ;" + "IN: axx : axx ( -- ) ; : bxx ( -- ) ;" "axx" parse-stream drop ] unit-test @@ -234,7 +230,7 @@ IN: parser.tests ! And reload the file that uses it... [ ] [ - "USE: axx IN: bxx : cxx axx bxx ;" + "USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;" "bxx" parse-stream drop ] unit-test @@ -243,17 +239,17 @@ IN: parser.tests ! Turning a generic into a non-generic could cause all ! kinds of funnyness [ ] [ - "IN: ayy USE: kernel GENERIC: ayy M: object ayy ;" + "IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;" "ayy" parse-stream drop ] unit-test [ ] [ - "IN: ayy USE: kernel : ayy ;" + "IN: ayy USE: kernel : ayy ( -- ) ;" "ayy" parse-stream drop ] unit-test [ ] [ - "IN: azz TUPLE: my-class ; GENERIC: a-generic" + "IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )" "azz" parse-stream drop ] unit-test @@ -263,7 +259,7 @@ IN: parser.tests ] unit-test [ ] [ - "IN: azz GENERIC: a-generic" + "IN: azz GENERIC: a-generic ( a -- b )" "azz" parse-stream drop ] unit-test @@ -273,12 +269,12 @@ IN: parser.tests ] unit-test [ ] [ - "IN: parser.tests : ; : bogus ;" + "IN: parser.tests : ( -- ) ; : bogus ( -- ) ;" "bogus-error" parse-stream drop ] unit-test [ ] [ - "IN: parser.tests TUPLE: bogus-error ; C: bogus-error : bogus ;" + "IN: parser.tests TUPLE: bogus-error ; C: bogus-error : bogus ( -- ) ;" "bogus-error" parse-stream drop ] unit-test @@ -298,7 +294,7 @@ IN: parser.tests ] unit-test [ - "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test?" + "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b )" "removing-the-predicate" parse-stream ] [ error>> error>> error>> redefine-error? ] must-fail-with @@ -313,7 +309,7 @@ IN: parser.tests ] unit-test [ - "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;" + "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ( -- ) ;" "redefining-a-class-3" parse-stream drop ] [ error>> error>> error>> redefine-error? ] must-fail-with @@ -338,7 +334,7 @@ IN: parser.tests ] [ error>> error>> error>> no-word-error? ] must-fail-with [ - "IN: parser.tests : foo ; TUPLE: foo ;" + "IN: parser.tests : foo ( -- ) ; TUPLE: foo ;" "redefining-a-class-4" parse-stream drop ] [ error>> error>> error>> redefine-error? ] must-fail-with @@ -369,7 +365,7 @@ IN: parser.tests 2 [ [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" "redefining-a-class-5" parse-stream drop ] unit-test @@ -381,14 +377,14 @@ IN: parser.tests [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" "redefining-a-class-5" parse-stream drop ] unit-test [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" "redefining-a-class-7" parse-stream drop ] unit-test @@ -438,7 +434,7 @@ IN: parser.tests { "IN: parser.tests" "USING: math arrays ;" - "GENERIC: change-combination" + "GENERIC: change-combination ( a -- b )" "M: integer change-combination 1 ;" "M: array change-combination 2 ;" } "\n" join "change-combination-test" parse-stream drop @@ -448,7 +444,7 @@ IN: parser.tests { "IN: parser.tests" "USING: math arrays ;" - "GENERIC# change-combination 1" + "GENERIC# change-combination 1 ( a -- b )" "M: integer change-combination 1 ;" "M: array change-combination 2 ;" } "\n" join "change-combination-test" parse-stream drop @@ -467,7 +463,7 @@ IN: parser.tests ] unit-test [ [ ] ] [ - "IN: parser.tests : staging-problem-test-1 1 ; : staging-problem-test-2 staging-problem-test-1 ;" + "IN: parser.tests : staging-problem-test-1 ( -- ) 1 ; : staging-problem-test-2 ( -- ) staging-problem-test-1 ;" "staging-problem-test" parse-stream ] unit-test @@ -476,7 +472,7 @@ IN: parser.tests [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test [ [ ] ] [ - "IN: parser.tests << : staging-problem-test-1 1 ; >> : staging-problem-test-2 staging-problem-test-1 ;" + "IN: parser.tests << : staging-problem-test-1 ( -- ) 1 ; >> : staging-problem-test-2 ( -- ) staging-problem-test-1 ;" "staging-problem-test" parse-stream ] unit-test @@ -495,7 +491,7 @@ IN: parser.tests ! Bogus error message DEFER: blahy -[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ; TUPLE: blahy < tuple ; : blahy ;" eval ] +[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval ] [ error>> error>> def>> \ blahy eq? ] must-fail-with [ ] [ f lexer set f file set "Hello world" note. ] unit-test @@ -510,7 +506,7 @@ SYMBOLS: a b c ; DEFER: blah -[ ] [ "IN: parser.tests GENERIC: blah" eval ] unit-test +[ ] [ "IN: parser.tests GENERIC: blah ( -- )" eval ] unit-test [ ] [ "IN: parser.tests SYMBOLS: blah ;" eval ] unit-test [ f ] [ \ blah generic? ] unit-test @@ -523,13 +519,13 @@ DEFER: blah1 must-fail-with IN: qualified.tests.foo -: x 1 ; -: y 5 ; +: x ( -- a ) 1 ; +: y ( -- a ) 5 ; IN: qualified.tests.bar -: x 2 ; -: y 4 ; +: x ( -- a ) 2 ; +: y ( -- a ) 4 ; IN: qualified.tests.baz -: x 3 ; +: x ( -- a ) 3 ; QUALIFIED: qualified.tests.foo QUALIFIED: qualified.tests.bar diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 4241999bcd..87531caee4 100644 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -132,7 +132,7 @@ IN: vocabs.loader.tests "vocabs.loader.test.d" vocab source-loaded?>> ] unit-test -: forget-junk +: forget-junk ( -- ) [ { "2" "a" "b" "d" "e" "f" } [ diff --git a/core/vocabs/loader/test/d/d.factor b/core/vocabs/loader/test/d/d.factor index e4f1c02a3a..a07695f1c3 100644 --- a/core/vocabs/loader/test/d/d.factor +++ b/core/vocabs/loader/test/d/d.factor @@ -1,3 +1,3 @@ IN: vocabs.loader.test.d -: foo iterate-next ; \ No newline at end of file +: foo ( -- ) iterate-next ; \ No newline at end of file diff --git a/extra/advice/advice-tests.factor b/extra/advice/advice-tests.factor index be16150c2e..a141489a0f 100644 --- a/extra/advice/advice-tests.factor +++ b/extra/advice/advice-tests.factor @@ -7,7 +7,7 @@ IN: advice.tests [ [ ad-do-it ] must-fail - : foo "foo" ; + : foo ( -- str ) "foo" ; \ foo make-advised { "bar" "foo" } [ diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index 869158bf72..ba3438e37d 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -1,44 +1,45 @@ -USING: words kernel sequences locals locals.parser -locals.definitions accessors parser namespaces continuations -summary definitions generalizations arrays ; -IN: descriptive - -ERROR: descriptive-error args underlying word ; - -M: descriptive-error summary - word>> "The " swap name>> " word encountered an error." - 3append ; - -> rethrower - [ recover ] 2curry ; -PRIVATE> - -: define-descriptive ( word def effect -- ) - [ drop "descriptive-definition" set-word-prop ] - [ [ dupd [descriptive] ] dip define-declared ] - 3bi ; - -SYNTAX: DESCRIPTIVE: (:) define-descriptive ; - -PREDICATE: descriptive < word - "descriptive-definition" word-prop ; - -M: descriptive definer drop \ DESCRIPTIVE: \ ; ; - -M: descriptive definition - "descriptive-definition" word-prop ; - -SYNTAX: DESCRIPTIVE:: (::) define-descriptive ; - -INTERSECTION: descriptive-lambda descriptive lambda-word ; - -M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ; - -M: descriptive-lambda definition - "lambda" word-prop body>> ; +USING: words kernel sequences locals locals.parser +locals.definitions accessors parser namespaces continuations +summary definitions generalizations arrays ; +IN: descriptive + +ERROR: descriptive-error args underlying word ; + +M: descriptive-error summary + word>> "The " swap name>> " word encountered an error." + 3append ; + +> rethrower [ recover ] 2curry ; + +PRIVATE> + +: define-descriptive ( word def effect -- ) + [ drop "descriptive-definition" set-word-prop ] + [ [ [ dup ] 2dip [descriptive] ] keep define-declared ] + 3bi ; + +SYNTAX: DESCRIPTIVE: (:) define-descriptive ; + +PREDICATE: descriptive < word + "descriptive-definition" word-prop ; + +M: descriptive definer drop \ DESCRIPTIVE: \ ; ; + +M: descriptive definition + "descriptive-definition" word-prop ; + +SYNTAX: DESCRIPTIVE:: (::) define-descriptive ; + +INTERSECTION: descriptive-lambda descriptive lambda-word ; + +M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ; + +M: descriptive-lambda definition + "lambda" word-prop body>> ; diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor index 7e8e2dfcc9..5e3d5d67cb 100644 --- a/extra/infix/infix-tests.factor +++ b/extra/infix/infix-tests.factor @@ -31,8 +31,6 @@ IN: infix.tests [ f ] [ 2 \ gcd check-word ] unit-test ! multiple return values [ f ] [ 1 \ drop check-word ] unit-test ! no return value [ f ] [ 1 \ lcm check-word ] unit-test ! takes 2 args -: no-stack-effect-declared + ; -[ 0 \ no-stack-effect-declared check-word ] must-fail : qux ( -- x ) 2 ; [ t ] [ 0 \ qux check-word ] unit-test diff --git a/extra/lint/lint-tests.factor b/extra/lint/lint-tests.factor index e2ca8816d9..70035f1854 100644 --- a/extra/lint/lint-tests.factor +++ b/extra/lint/lint-tests.factor @@ -9,6 +9,6 @@ IN: lint.tests : lint2 ( n -- n' ) 1 + ; ! 1+ [ { [ 1 + ] } ] [ \ lint2 lint ] unit-test -: lint3 dup -rot ; ! tuck +: lint3 ( a b -- b a b ) dup -rot ; ! tuck [ { { lint3 { [ dup -rot ] } } } ] [ \ lint3 lint-word ] unit-test diff --git a/extra/math/analysis/analysis-tests.factor b/extra/math/analysis/analysis-tests.factor index 5b537c2621..1c11162a68 100644 --- a/extra/math/analysis/analysis-tests.factor +++ b/extra/math/analysis/analysis-tests.factor @@ -2,8 +2,7 @@ USING: kernel math math.functions tools.test math.analysis math.constants ; IN: math.analysis.tests -: eps - .00000001 ; +CONSTANT: eps .00000001 [ t ] [ -9000000000000000000000000000000000000000000 gamma 1/0. = ] unit-test [ t ] [ -1.5 gamma 2.363271801207344 eps ~ ] unit-test diff --git a/extra/multi-methods/tests/canonicalize.factor b/extra/multi-methods/tests/canonicalize.factor index 991551c009..91982de95c 100644 --- a/extra/multi-methods/tests/canonicalize.factor +++ b/extra/multi-methods/tests/canonicalize.factor @@ -4,11 +4,11 @@ kernel strings ; [ { POSTPONE: f integer } ] [ { f integer } canonicalize-specializer-0 ] unit-test -: setup-canon-test +: setup-canon-test ( -- ) 0 args set V{ } clone hooks set ; -: canon-test-1 +: canon-test-1 ( -- seq ) { integer { cpu x86 } sequence } canonicalize-specializer-1 ; [ { { -2 integer } { -1 sequence } { cpu x86 } } ] [ @@ -36,12 +36,12 @@ kernel strings ; ] with-scope ] unit-test -: example-1 +CONSTANT: example-1 { { { { cpu x86 } { os linux } } "a" } { { { cpu ppc } } "b" } { { string { os windows } } "c" } - } ; + } [ { diff --git a/extra/multi-methods/tests/legacy.factor b/extra/multi-methods/tests/legacy.factor index f4bd0a00b2..b6d732643f 100644 --- a/extra/multi-methods/tests/legacy.factor +++ b/extra/multi-methods/tests/legacy.factor @@ -1,7 +1,7 @@ IN: multi-methods.tests USING: math strings sequences tools.test ; -GENERIC: legacy-test +GENERIC: legacy-test ( a -- b ) M: integer legacy-test sq ; M: string legacy-test " hey" append ; diff --git a/extra/sequences/n-based/n-based-tests.factor b/extra/sequences/n-based/n-based-tests.factor index 7ee5bd649f..eed5540cb3 100644 --- a/extra/sequences/n-based/n-based-tests.factor +++ b/extra/sequences/n-based/n-based-tests.factor @@ -3,7 +3,7 @@ USING: kernel accessors assocs sequences sequences.n-based tools.test ; IN: sequences.n-based.tests -: months +: months ( -- assoc ) V{ "January" "February" diff --git a/extra/svg/svg-tests.factor b/extra/svg/svg-tests.factor index 932904eff4..71b30cd175 100644 --- a/extra/svg/svg-tests.factor +++ b/extra/svg/svg-tests.factor @@ -106,7 +106,7 @@ STRING: test-svg-string ; -: test-svg-path +: test-svg-path ( -- obj ) test-svg-string string>xml body>> children-tags first ; [ { T{ moveto f { -1.0 -1.0 } f } T{ lineto f { 2.0 2.0 } t } } ] diff --git a/extra/units/units-tests.factor b/extra/units/units-tests.factor index 9b450ed18b..96497b8bbc 100755 --- a/extra/units/units-tests.factor +++ b/extra/units/units-tests.factor @@ -15,7 +15,7 @@ IN: units.tests [ t ] [ 1 m 2 m 3 m 3array d-product 6 m^3 = ] unit-test [ t ] [ 3 m d-recip 1/3 { } { m } = ] unit-test -: km/L km 1 L d/ ; -: mpg miles 1 gallons d/ ; +: km/L ( n -- d ) km 1 L d/ ; +: mpg ( n -- d ) miles 1 gallons d/ ; [ t ] [ 100 10 / km/L [ mpg ] undo 23 1 ~ ] unit-test From 5a9dbc2c0f1e47fd937893f6372e2d7e4f0a190c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 01:18:24 -0500 Subject: [PATCH 24/43] Remove useless declarations --- basis/environment/environment-docs.factor | 6 +++--- basis/farkup/farkup-docs.factor | 2 +- basis/help/syntax/syntax.factor | 12 ++++-------- basis/io/encodings/strict/strict-docs.factor | 4 ++-- basis/io/files/unique/unique-docs.factor | 8 ++++---- basis/lists/lists-docs.factor | 4 ---- 6 files changed, 14 insertions(+), 22 deletions(-) diff --git a/basis/environment/environment-docs.factor b/basis/environment/environment-docs.factor index b48a7a01ad..0f88181f28 100644 --- a/basis/environment/environment-docs.factor +++ b/basis/environment/environment-docs.factor @@ -17,7 +17,7 @@ HELP: (set-os-envs) { $notes "In most cases, use " { $link set-os-envs } " instead." } ; -HELP: os-env ( key -- value ) +HELP: os-env { $values { "key" string } { "value" string } } { $description "Looks up the value of a shell environment variable." } { $examples @@ -39,14 +39,14 @@ HELP: set-os-envs "Names and values of environment variables are operating system-specific. Windows NT allows values up to 32766 characters in length." } ; -HELP: set-os-env ( value key -- ) +HELP: set-os-env { $values { "value" string } { "key" string } } { $description "Set an environment variable." } { $notes "Names and values of environment variables are operating system-specific." } ; -HELP: unset-os-env ( key -- ) +HELP: unset-os-env { $values { "key" string } } { $description "Unset an environment variable." } { $notes diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor index 8c6b07a01c..036f0d667a 100644 --- a/basis/farkup/farkup-docs.factor +++ b/basis/farkup/farkup-docs.factor @@ -9,7 +9,7 @@ HELP: write-farkup { $values { "string" string } } { $description "Parse a Farkup string and writes the resulting HTML to " { $link output-stream } "." } ; -HELP: parse-farkup ( string -- farkup ) +HELP: parse-farkup { $values { "string" string } { "farkup" "a Farkup syntax tree node" } } { $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ; diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor index 044768aec2..1844d18d94 100644 --- a/basis/help/syntax/syntax.factor +++ b/basis/help/syntax/syntax.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel parser sequences words help help.topics namespaces vocabs definitions compiler.units @@ -7,17 +7,13 @@ IN: help.syntax SYNTAX: HELP: scan-word bootstrap-word - dup set-word - dup >link save-location - \ ; parse-until >array swap set-word-help ; + [ >link save-location ] [ [ \ ; parse-until >array ] dip set-word-help ] bi ; SYNTAX: ARTICLE: location [ - \ ; parse-until >array [ first2 ] keep 2 tail
+ \ ; parse-until >array [ first2 ] [ 2 tail ] bi
over add-article >link ] dip remember-definition ; SYNTAX: ABOUT: - in get vocab - dup changed-definition - scan-object >>help drop ; + in get vocab scan-object >>help changed-definition ; diff --git a/basis/io/encodings/strict/strict-docs.factor b/basis/io/encodings/strict/strict-docs.factor index b7edec2de7..d93c5dd24e 100644 --- a/basis/io/encodings/strict/strict-docs.factor +++ b/basis/io/encodings/strict/strict-docs.factor @@ -3,6 +3,6 @@ USING: help.syntax help.markup ; IN: io.encodings.strict -HELP: strict ( encoding -- strict-encoding ) -{ $values { "encoding" "an encoding descriptor" } { "strict-encoding" "a strict encoding descriptor" } } +HELP: strict ( code -- strict ) +{ $values { "code" "an encoding descriptor" } { "strict" "a strict encoding descriptor" } } { $description "Makes an encoding strict, that is, in the presence of a malformed code point, an error is thrown. Note that the existence of a replacement character in a file (U+FFFD) also throws an error." } ; diff --git a/basis/io/files/unique/unique-docs.factor b/basis/io/files/unique/unique-docs.factor index b8a4431a73..74fc045032 100644 --- a/basis/io/files/unique/unique-docs.factor +++ b/basis/io/files/unique/unique-docs.factor @@ -23,7 +23,7 @@ HELP: unique-retries { unique-length unique-retries } related-words -HELP: make-unique-file ( prefix suffix -- path ) +HELP: make-unique-file { $values { "prefix" "a string" } { "suffix" "a string" } { "path" "a pathname string" } } { $description "Creates a file that is guaranteed not to exist in the directory stored in " { $link current-temporary-directory } ". The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } @@ -31,18 +31,18 @@ HELP: make-unique-file ( prefix suffix -- path ) { unique-file make-unique-file cleanup-unique-file } related-words -HELP: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- ) +HELP: cleanup-unique-file { $values { "prefix" "a string" } { "suffix" "a string" } { "quot" "a quotation" } } { $description "Creates a file with " { $link make-unique-file } " and calls the quotation with the path name on the stack." } { $notes "The unique file will be deleted after calling this word." } ; -HELP: unique-directory ( -- path ) +HELP: unique-directory { $values { "path" "a pathname string" } } { $description "Creates a directory in the value in " { $link current-temporary-directory } " that is guaranteed not to exist in and returns the full pathname." } { $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ; -HELP: cleanup-unique-directory ( quot -- ) +HELP: cleanup-unique-directory { $values { "quot" "a quotation" } } { $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." } { $notes "The directory will be deleted after calling this word, even if an error is thrown in the quotation. This combinator is like " { $link with-unique-directory } " but does not delete the directory." } ; diff --git a/basis/lists/lists-docs.factor b/basis/lists/lists-docs.factor index c03a869ebd..8782c3d9b4 100644 --- a/basis/lists/lists-docs.factor +++ b/basis/lists/lists-docs.factor @@ -83,10 +83,6 @@ HELP: nil? { nil nil? } related-words -HELP: list? ( object -- ? ) -{ $values { "object" "an object" } { "?" "a boolean" } } -{ $description "Returns true if the object conforms to the list protocol." } ; - { 1list 2list 3list } related-words HELP: 1list From 356bff6424b6ce3d1e75900b9d56a1749eca1bec Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 01:18:39 -0500 Subject: [PATCH 25/43] kernel doesn't need to depend on classes.tuple.private --- core/kernel/kernel.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 52529892f4..56f19595cb 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel.private slots.private math.private -classes.tuple.private ; +USING: kernel.private slots.private math.private ; IN: kernel DEFER: dip From a3e05d8ecc3497e0bd248c2c0a86f1472fc21cdd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 03:03:44 -0500 Subject: [PATCH 26/43] Add stack declarations to primitives during bootstrap now that ( is just a comment and won't affect HELP: anymore --- core/bootstrap/primitives.factor | 393 +++++++++++++++---------------- 1 file changed, 196 insertions(+), 197 deletions(-) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 48aae3667e..ed64571582 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -36,7 +36,7 @@ H{ } clone sub-primitives set "syntax" vocab vocab-words bootstrap-syntax set { dictionary new-classes - changed-definitions changed-generics + changed-definitions changed-generics changed-effects outdated-generics forgotten-definitions root-cache source-files update-map implementors-map } [ H{ } clone swap set ] each @@ -48,9 +48,9 @@ init-caches dummy-compiler compiler-impl set -call -call -call +call( -- ) +call( -- ) +call( -- ) ! After we execute bootstrap/layouts num-types get f builtins set @@ -335,205 +335,204 @@ tuple (( quot1 quot2 -- compose )) define-declared ! Sub-primitive words -: make-sub-primitive ( word vocab -- ) - create - dup reset-word - dup 1quotation define ; +: make-sub-primitive ( word vocab effect -- ) + [ create dup 1quotation ] dip define-declared ; { - { "(execute)" "words.private" } - { "(call)" "kernel.private" } - { "both-fixnums?" "math.private" } - { "fixnum+fast" "math.private" } - { "fixnum-fast" "math.private" } - { "fixnum*fast" "math.private" } - { "fixnum-bitand" "math.private" } - { "fixnum-bitor" "math.private" } - { "fixnum-bitxor" "math.private" } - { "fixnum-bitnot" "math.private" } - { "fixnum-mod" "math.private" } - { "fixnum-shift-fast" "math.private" } - { "fixnum/i-fast" "math.private" } - { "fixnum/mod-fast" "math.private" } - { "fixnum<" "math.private" } - { "fixnum<=" "math.private" } - { "fixnum>" "math.private" } - { "fixnum>=" "math.private" } - { "drop" "kernel" } - { "2drop" "kernel" } - { "3drop" "kernel" } - { "dup" "kernel" } - { "2dup" "kernel" } - { "3dup" "kernel" } - { "rot" "kernel" } - { "-rot" "kernel" } - { "dupd" "kernel" } - { "swapd" "kernel" } - { "nip" "kernel" } - { "2nip" "kernel" } - { "tuck" "kernel" } - { "over" "kernel" } - { "pick" "kernel" } - { "swap" "kernel" } - { "eq?" "kernel" } - { "tag" "kernel.private" } - { "slot" "slots.private" } - { "get-local" "locals.backend" } - { "load-local" "locals.backend" } - { "drop-locals" "locals.backend" } -} [ make-sub-primitive ] assoc-each + { "(execute)" "words.private" (( word -- )) } + { "(call)" "kernel.private" (( quot -- )) } + { "both-fixnums?" "math.private" (( x y -- ? )) } + { "fixnum+fast" "math.private" (( x y -- z )) } + { "fixnum-fast" "math.private" (( x y -- z )) } + { "fixnum*fast" "math.private" (( x y -- z )) } + { "fixnum-bitand" "math.private" (( x y -- z )) } + { "fixnum-bitor" "math.private" (( x y -- z )) } + { "fixnum-bitxor" "math.private" (( x y -- z )) } + { "fixnum-bitnot" "math.private" (( x -- y )) } + { "fixnum-mod" "math.private" (( x y -- z )) } + { "fixnum-shift-fast" "math.private" (( x y -- z )) } + { "fixnum/i-fast" "math.private" (( x y -- z )) } + { "fixnum/mod-fast" "math.private" (( x y -- z w )) } + { "fixnum<" "math.private" (( x y -- ? )) } + { "fixnum<=" "math.private" (( x y -- z )) } + { "fixnum>" "math.private" (( x y -- ? )) } + { "fixnum>=" "math.private" (( x y -- ? )) } + { "drop" "kernel" (( x -- )) } + { "2drop" "kernel" (( x y -- )) } + { "3drop" "kernel" (( x y z -- )) } + { "dup" "kernel" (( x -- x x )) } + { "2dup" "kernel" (( x y -- x y x y )) } + { "3dup" "kernel" (( x y z -- x y z x y z )) } + { "rot" "kernel" (( x y z -- y z x )) } + { "-rot" "kernel" (( x y z -- z x y )) } + { "dupd" "kernel" (( x y -- x x y )) } + { "swapd" "kernel" (( x y z -- y x z )) } + { "nip" "kernel" (( x y -- y )) } + { "2nip" "kernel" (( x y z -- z )) } + { "tuck" "kernel" (( x y -- y x y )) } + { "over" "kernel" (( x y -- x y x )) } + { "pick" "kernel" (( x y z -- x y z x )) } + { "swap" "kernel" (( x y -- y x )) } + { "eq?" "kernel" (( obj1 obj2 -- ? )) } + { "tag" "kernel.private" (( object -- n )) } + { "slot" "slots.private" (( obj m -- value )) } + { "get-local" "locals.backend" (( n -- obj )) } + { "load-local" "locals.backend" (( obj -- )) } + { "drop-locals" "locals.backend" (( n -- )) } +} [ first3 make-sub-primitive ] each ! Primitive words -: make-primitive ( word vocab n -- ) - [ create dup reset-word ] dip - [ do-primitive ] curry [ ] like define ; +: make-primitive ( word vocab n effect -- ) + [ + [ create dup reset-word ] dip + [ do-primitive ] curry + ] dip define-declared ; { - { "bignum>fixnum" "math.private" } - { "float>fixnum" "math.private" } - { "fixnum>bignum" "math.private" } - { "float>bignum" "math.private" } - { "fixnum>float" "math.private" } - { "bignum>float" "math.private" } - { "" "math.private" } - { "string>float" "math.private" } - { "float>string" "math.private" } - { "float>bits" "math" } - { "double>bits" "math" } - { "bits>float" "math" } - { "bits>double" "math" } - { "" "math.private" } - { "fixnum+" "math.private" } - { "fixnum-" "math.private" } - { "fixnum*" "math.private" } - { "fixnum/i" "math.private" } - { "fixnum/mod" "math.private" } - { "fixnum-shift" "math.private" } - { "bignum=" "math.private" } - { "bignum+" "math.private" } - { "bignum-" "math.private" } - { "bignum*" "math.private" } - { "bignum/i" "math.private" } - { "bignum-mod" "math.private" } - { "bignum/mod" "math.private" } - { "bignum-bitand" "math.private" } - { "bignum-bitor" "math.private" } - { "bignum-bitxor" "math.private" } - { "bignum-bitnot" "math.private" } - { "bignum-shift" "math.private" } - { "bignum<" "math.private" } - { "bignum<=" "math.private" } - { "bignum>" "math.private" } - { "bignum>=" "math.private" } - { "bignum-bit?" "math.private" } - { "bignum-log2" "math.private" } - { "byte-array>bignum" "math" } - { "float=" "math.private" } - { "float+" "math.private" } - { "float-" "math.private" } - { "float*" "math.private" } - { "float/f" "math.private" } - { "float-mod" "math.private" } - { "float<" "math.private" } - { "float<=" "math.private" } - { "float>" "math.private" } - { "float>=" "math.private" } - { "" "words" } - { "word-xt" "words" } - { "getenv" "kernel.private" } - { "setenv" "kernel.private" } - { "(exists?)" "io.files.private" } - { "gc" "memory" } - { "gc-stats" "memory" } - { "save-image" "memory" } - { "save-image-and-exit" "memory" } - { "datastack" "kernel" } - { "retainstack" "kernel" } - { "callstack" "kernel" } - { "set-datastack" "kernel" } - { "set-retainstack" "kernel" } - { "set-callstack" "kernel" } - { "exit" "system" } - { "data-room" "memory" } - { "code-room" "memory" } - { "micros" "system" } - { "modify-code-heap" "compiler.units" } - { "dlopen" "alien" } - { "dlsym" "alien" } - { "dlclose" "alien" } - { "" "byte-arrays" } - { "(byte-array)" "byte-arrays" } - { "" "alien" } - { "alien-signed-cell" "alien.accessors" } - { "set-alien-signed-cell" "alien.accessors" } - { "alien-unsigned-cell" "alien.accessors" } - { "set-alien-unsigned-cell" "alien.accessors" } - { "alien-signed-8" "alien.accessors" } - { "set-alien-signed-8" "alien.accessors" } - { "alien-unsigned-8" "alien.accessors" } - { "set-alien-unsigned-8" "alien.accessors" } - { "alien-signed-4" "alien.accessors" } - { "set-alien-signed-4" "alien.accessors" } - { "alien-unsigned-4" "alien.accessors" } - { "set-alien-unsigned-4" "alien.accessors" } - { "alien-signed-2" "alien.accessors" } - { "set-alien-signed-2" "alien.accessors" } - { "alien-unsigned-2" "alien.accessors" } - { "set-alien-unsigned-2" "alien.accessors" } - { "alien-signed-1" "alien.accessors" } - { "set-alien-signed-1" "alien.accessors" } - { "alien-unsigned-1" "alien.accessors" } - { "set-alien-unsigned-1" "alien.accessors" } - { "alien-float" "alien.accessors" } - { "set-alien-float" "alien.accessors" } - { "alien-double" "alien.accessors" } - { "set-alien-double" "alien.accessors" } - { "alien-cell" "alien.accessors" } - { "set-alien-cell" "alien.accessors" } - { "alien-address" "alien" } - { "set-slot" "slots.private" } - { "string-nth" "strings.private" } - { "set-string-nth-fast" "strings.private" } - { "set-string-nth-slow" "strings.private" } - { "resize-array" "arrays" } - { "resize-string" "strings" } - { "" "arrays" } - { "begin-scan" "memory" } - { "next-object" "memory" } - { "end-scan" "memory" } - { "size" "memory" } - { "die" "kernel" } - { "fopen" "io.streams.c" } - { "fgetc" "io.streams.c" } - { "fread" "io.streams.c" } - { "fputc" "io.streams.c" } - { "fwrite" "io.streams.c" } - { "fflush" "io.streams.c" } - { "fclose" "io.streams.c" } - { "" "kernel" } - { "(clone)" "kernel" } - { "" "strings" } - { "array>quotation" "quotations.private" } - { "quotation-xt" "quotations" } - { "" "classes.tuple.private" } - { "profiling" "tools.profiler.private" } - { "become" "kernel.private" } - { "(sleep)" "threads.private" } - { "" "classes.tuple.private" } - { "callstack>array" "kernel" } - { "innermost-frame-quot" "kernel.private" } - { "innermost-frame-scan" "kernel.private" } - { "set-innermost-frame-quot" "kernel.private" } - { "call-clear" "kernel" } - { "resize-byte-array" "byte-arrays" } - { "dll-valid?" "alien" } - { "unimplemented" "kernel.private" } - { "gc-reset" "memory" } - { "jit-compile" "quotations" } - { "load-locals" "locals.backend" } - { "check-datastack" "kernel.private" } -} -[ [ first2 ] dip make-primitive ] each-index + { "bignum>fixnum" "math.private" (( x -- y )) } + { "float>fixnum" "math.private" (( x -- y )) } + { "fixnum>bignum" "math.private" (( x -- y )) } + { "float>bignum" "math.private" (( x -- y )) } + { "fixnum>float" "math.private" (( x -- y )) } + { "bignum>float" "math.private" (( x -- y )) } + { "" "math.private" (( a b -- a/b )) } + { "string>float" "math.private" (( str -- n/f )) } + { "float>string" "math.private" (( n -- str )) } + { "float>bits" "math" (( x -- n )) } + { "double>bits" "math" (( x -- n )) } + { "bits>float" "math" (( n -- x )) } + { "bits>double" "math" (( n -- x )) } + { "" "math.private" (( x y -- z )) } + { "fixnum+" "math.private" (( x y -- z )) } + { "fixnum-" "math.private" (( x y -- z )) } + { "fixnum*" "math.private" (( x y -- z )) } + { "fixnum/i" "math.private" (( x y -- z )) } + { "fixnum/mod" "math.private" (( x y -- z w )) } + { "fixnum-shift" "math.private" (( x y -- z )) } + { "bignum=" "math.private" (( x y -- ? )) } + { "bignum+" "math.private" (( x y -- z )) } + { "bignum-" "math.private" (( x y -- z )) } + { "bignum*" "math.private" (( x y -- z )) } + { "bignum/i" "math.private" (( x y -- z )) } + { "bignum-mod" "math.private" (( x y -- z )) } + { "bignum/mod" "math.private" (( x y -- z w )) } + { "bignum-bitand" "math.private" (( x y -- z )) } + { "bignum-bitor" "math.private" (( x y -- z )) } + { "bignum-bitxor" "math.private" (( x y -- z )) } + { "bignum-bitnot" "math.private" (( x -- y )) } + { "bignum-shift" "math.private" (( x y -- z )) } + { "bignum<" "math.private" (( x y -- ? )) } + { "bignum<=" "math.private" (( x y -- ? )) } + { "bignum>" "math.private" (( x y -- ? )) } + { "bignum>=" "math.private" (( x y -- ? )) } + { "bignum-bit?" "math.private" (( n x -- ? )) } + { "bignum-log2" "math.private" (( x -- n )) } + { "byte-array>bignum" "math" (( x -- y )) } + { "float=" "math.private" (( x y -- ? )) } + { "float+" "math.private" (( x y -- z )) } + { "float-" "math.private" (( x y -- z )) } + { "float*" "math.private" (( x y -- z )) } + { "float/f" "math.private" (( x y -- z )) } + { "float-mod" "math.private" (( x y -- z )) } + { "float<" "math.private" (( x y -- ? )) } + { "float<=" "math.private" (( x y -- ? )) } + { "float>" "math.private" (( x y -- ? )) } + { "float>=" "math.private" (( x y -- ? )) } + { "" "words" (( name vocab -- word )) } + { "word-xt" "words" (( word -- start end )) } + { "getenv" "kernel.private" (( n -- obj )) } + { "setenv" "kernel.private" (( obj n -- )) } + { "(exists?)" "io.files.private" (( path -- ? )) } + { "gc" "memory" (( -- )) } + { "gc-stats" "memory" f } + { "save-image" "memory" (( path -- )) } + { "save-image-and-exit" "memory" (( path -- )) } + { "datastack" "kernel" (( -- ds )) } + { "retainstack" "kernel" (( -- rs )) } + { "callstack" "kernel" (( -- cs )) } + { "set-datastack" "kernel" (( ds -- )) } + { "set-retainstack" "kernel" (( rs -- )) } + { "set-callstack" "kernel" (( cs -- )) } + { "exit" "system" (( n -- )) } + { "data-room" "memory" (( -- cards generations )) } + { "code-room" "memory" (( -- code-free code-total )) } + { "micros" "system" (( -- us )) } + { "modify-code-heap" "compiler.units" (( alist -- )) } + { "dlopen" "alien" (( path -- dll )) } + { "dlsym" "alien" (( name dll -- alien )) } + { "dlclose" "alien" (( dll -- )) } + { "" "byte-arrays" (( n -- byte-array )) } + { "(byte-array)" "byte-arrays" (( n -- byte-array )) } + { "" "alien" (( displacement c-ptr -- alien )) } + { "alien-signed-cell" "alien.accessors" f } + { "set-alien-signed-cell" "alien.accessors" f } + { "alien-unsigned-cell" "alien.accessors" f } + { "set-alien-unsigned-cell" "alien.accessors" f } + { "alien-signed-8" "alien.accessors" f } + { "set-alien-signed-8" "alien.accessors" f } + { "alien-unsigned-8" "alien.accessors" f } + { "set-alien-unsigned-8" "alien.accessors" f } + { "alien-signed-4" "alien.accessors" f } + { "set-alien-signed-4" "alien.accessors" f } + { "alien-unsigned-4" "alien.accessors" f } + { "set-alien-unsigned-4" "alien.accessors" f } + { "alien-signed-2" "alien.accessors" f } + { "set-alien-signed-2" "alien.accessors" f } + { "alien-unsigned-2" "alien.accessors" f } + { "set-alien-unsigned-2" "alien.accessors" f } + { "alien-signed-1" "alien.accessors" f } + { "set-alien-signed-1" "alien.accessors" f } + { "alien-unsigned-1" "alien.accessors" f } + { "set-alien-unsigned-1" "alien.accessors" f } + { "alien-float" "alien.accessors" f } + { "set-alien-float" "alien.accessors" f } + { "alien-double" "alien.accessors" f } + { "set-alien-double" "alien.accessors" f } + { "alien-cell" "alien.accessors" f } + { "set-alien-cell" "alien.accessors" f } + { "alien-address" "alien" (( c-ptr -- addr )) } + { "set-slot" "slots.private" (( value obj n -- )) } + { "string-nth" "strings.private" (( n string -- ch )) } + { "set-string-nth-fast" "strings.private" (( ch n string -- )) } + { "set-string-nth-slow" "strings.private" (( ch n string -- )) } + { "resize-array" "arrays" (( n array -- newarray )) } + { "resize-string" "strings" (( n str -- newstr )) } + { "" "arrays" (( n elt -- array )) } + { "begin-scan" "memory" (( -- )) } + { "next-object" "memory" (( -- obj )) } + { "end-scan" "memory" (( -- )) } + { "size" "memory" (( obj -- n )) } + { "die" "kernel" (( -- )) } + { "fopen" "io.streams.c" (( path mode -- alien )) } + { "fgetc" "io.streams.c" (( alien -- ch/f )) } + { "fread" "io.streams.c" (( n alien -- str/f )) } + { "fputc" "io.streams.c" (( ch alien -- )) } + { "fwrite" "io.streams.c" (( string alien -- )) } + { "fflush" "io.streams.c" (( alien -- )) } + { "fclose" "io.streams.c" (( alien -- )) } + { "" "kernel" (( obj -- wrapper )) } + { "(clone)" "kernel" (( obj -- newobj )) } + { "" "strings" (( n ch -- string )) } + { "array>quotation" "quotations.private" (( array -- quot )) } + { "quotation-xt" "quotations" (( quot -- xt )) } + { "" "classes.tuple.private" (( layout -- tuple )) } + { "profiling" "tools.profiler.private" (( ? -- )) } + { "become" "kernel.private" (( old new -- )) } + { "(sleep)" "threads.private" (( us -- )) } + { "" "classes.tuple.private" (( ... layout -- tuple )) } + { "callstack>array" "kernel" (( callstack -- array )) } + { "innermost-frame-quot" "kernel.private" (( callstack -- quot )) } + { "innermost-frame-scan" "kernel.private" (( callstack -- n )) } + { "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) } + { "call-clear" "kernel" (( quot -- )) } + { "resize-byte-array" "byte-arrays" (( n byte-array -- newbyte-array )) } + { "dll-valid?" "alien" (( dll -- ? )) } + { "unimplemented" "kernel.private" (( -- * )) } + { "gc-reset" "memory" (( -- )) } + { "jit-compile" "quotations" (( quot -- )) } + { "load-locals" "locals.backend" (( ... n -- )) } + { "check-datastack" "kernel.private" (( array in# out# -- ? )) } +} [ [ first3 ] dip swap make-primitive ] each-index ! Bump build number "build" "kernel" create build 1+ [ ] curry (( -- n )) define-declared From b3080178c6d07718c24f1a03c85c5d8f48d67023 Mon Sep 17 00:00:00 2001 From: Philipp Winkler Date: Mon, 23 Mar 2009 12:39:03 -0700 Subject: [PATCH 27/43] Add a missing step to the tutorial. --- basis/help/tutorial/tutorial.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/help/tutorial/tutorial.factor b/basis/help/tutorial/tutorial.factor index 7ec155881b..26812947c0 100644 --- a/basis/help/tutorial/tutorial.factor +++ b/basis/help/tutorial/tutorial.factor @@ -62,7 +62,9 @@ ARTICLE: "first-program-test" "Testing your first program" "" ": palindrome? ( str -- ? ) dup reverse = ;" } -"We will now test our new word in the listener. First, push a string on the stack:" +"We will now test our new word in the listener. First we have add the palindrome vocabulary to the listener's vocabulary search path:" +{ $code "USE: palindrome"} +"Next, push a string on the stack:" { $code "\"hello\"" } "Note that the stack display in the listener now shows this string. Having supplied the input, we call our word:" { $code "palindrome?" } @@ -132,6 +134,8 @@ $nl $nl "We modify " { $snippet "palindrome?" } " to first apply " { $snippet "normalize" } " to its input:" { $code ": palindrome? ( str -- ? ) normalize dup reverse = ;" } +"Factor compiles the file from the top down. So, be sure to place the definition for " { $snippet "normalize" } " above the definition for " { $snippet "palindrome?" } "." +$nl "Now if you press " { $command tool "common" refresh-all } ", the source file should reload without any errors. You can run unit tests again, and this time, they will all pass:" { $code "\"palindrome\" test" } ; From 8385e9d9f5668c92ac210f0d306919818ce0ad81 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 17:12:41 -0500 Subject: [PATCH 28/43] Fixing compile errors, test failures and help lint failures --- basis/grouping/grouping-docs.factor | 3 +-- basis/help/cookbook/cookbook.factor | 17 +++++++---------- basis/lists/lazy/lazy-docs.factor | 2 +- basis/lists/lazy/lazy.factor | 2 +- basis/math/bitwise/bitwise-docs.factor | 4 ++-- basis/memoize/memoize-docs.factor | 6 +++--- {extra => basis}/promises/authors.txt | 0 {extra => basis}/promises/promises-docs.factor | 0 {extra => basis}/promises/promises-tests.factor | 0 {extra => basis}/promises/promises.factor | 0 {extra => basis}/promises/summary.txt | 0 {extra => basis}/promises/tags.txt | 0 basis/refs/refs-docs.factor | 4 ++-- basis/refs/refs.factor | 4 ++-- basis/see/see-docs.factor | 2 +- basis/stack-checker/stack-checker-docs.factor | 4 ++-- basis/stack-checker/stack-checker-tests.factor | 2 +- basis/ui/commands/commands-docs.factor | 2 +- core/math/math-docs.factor | 2 +- core/memory/memory-tests.factor | 4 ++-- core/strings/strings-docs.factor | 6 +++--- core/strings/strings.factor | 2 +- core/syntax/syntax-docs.factor | 2 +- core/words/words-docs.factor | 6 +++--- extra/24-game/24-game.factor | 2 +- extra/animations/animations-docs.factor | 2 +- extra/animations/animations.factor | 2 +- extra/ctags/ctags-docs.factor | 2 +- extra/ctags/ctags.factor | 2 +- extra/literals/literals-docs.factor | 6 +++--- extra/multi-methods/multi-methods.factor | 13 ++++++------- extra/newfx/newfx.factor | 8 ++++---- extra/sequences/n-based/n-based-docs.factor | 4 ++-- 33 files changed, 55 insertions(+), 60 deletions(-) rename {extra => basis}/promises/authors.txt (100%) rename {extra => basis}/promises/promises-docs.factor (100%) rename {extra => basis}/promises/promises-tests.factor (100%) rename {extra => basis}/promises/promises.factor (100%) rename {extra => basis}/promises/summary.txt (100%) rename {extra => basis}/promises/tags.txt (100%) diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index e4ad97abd0..50ffa65474 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -97,8 +97,7 @@ HELP: { $example "USING: grouping sequences math prettyprint kernel ;" "IN: scratchpad" - ": share-price" - " { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;" + "CONSTANT: share-price { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 }" "" "share-price 4 [ [ sum ] [ length ] bi / ] map ." "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }" diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index d6693cd94f..2cc19f87dd 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -121,16 +121,16 @@ $nl "sequences" } ; -ARTICLE: "cookbook-variables" "Variables cookbook" -"Before using a variable, you must define a symbol for it:" -{ $code "SYMBOL: name" } +ARTICLE: "cookbook-variables" "Dynamic variables cookbook" "A symbol is a word which pushes itself on the stack when executed. Try it:" { $example "SYMBOL: foo" "foo ." "foo" } +"Before using a variable, you must define a symbol for it:" +{ $code "SYMBOL: name" } "Symbols can be passed to the " { $link get } " and " { $link set } " words to read and write variable values:" -{ $example "\"Slava\" name set" "name get print" "Slava" } +{ $unchecked-example "\"Slava\" name set" "name get print" "Slava" } "If you set variables inside a " { $link with-scope } ", their values will be lost after leaving the scope:" -{ $example - ": print-name name get print ;" +{ $unchecked-example + ": print-name ( -- ) name get print ;" "\"Slava\" name set" "[" " \"Diana\" name set" @@ -139,11 +139,8 @@ ARTICLE: "cookbook-variables" "Variables cookbook" "\"Here, the name is \" write print-name" "There, the name is Diana\nHere, the name is Slava" } -{ $curious - "Variables are dynamically-scoped in Factor." -} { $references - "There is a lot more to be said about variables and namespaces." + "There is a lot more to be said about dynamically-scoped variables and namespaces." "namespaces" } ; diff --git a/basis/lists/lazy/lazy-docs.factor b/basis/lists/lazy/lazy-docs.factor index 08fe3bbcba..c46d3251a9 100644 --- a/basis/lists/lazy/lazy-docs.factor +++ b/basis/lists/lazy/lazy-docs.factor @@ -108,7 +108,7 @@ HELP: lappend { $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } ; HELP: lfrom-by -{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "list" "a lazy list of integers" } } +{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "lazy-from-by" "a lazy list of integers" } } { $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." } ; HELP: lfrom diff --git a/basis/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor index 139f6726e8..64a3f099a0 100644 --- a/basis/lists/lazy/lazy.factor +++ b/basis/lists/lazy/lazy.factor @@ -203,7 +203,7 @@ M: lazy-append nil? ( lazy-append -- bool ) TUPLE: lazy-from-by n quot ; -C: lfrom-by lazy-from-by ( n quot -- list ) +C: lfrom-by lazy-from-by : lfrom ( n -- list ) [ 1+ ] lfrom-by ; diff --git a/basis/math/bitwise/bitwise-docs.factor b/basis/math/bitwise/bitwise-docs.factor index 358c984276..fca06526e0 100644 --- a/basis/math/bitwise/bitwise-docs.factor +++ b/basis/math/bitwise/bitwise-docs.factor @@ -139,8 +139,8 @@ HELP: flags { $examples { $example "USING: math.bitwise kernel prettyprint ;" "IN: scratchpad" - ": MY-CONSTANT HEX: 1 ; inline" - "{ HEX: 20 MY-CONSTANT BIN: 100 } flags .h" + "CONSTANT: x HEX: 1" + "{ HEX: 20 x BIN: 100 } flags .h" "25" } } ; diff --git a/basis/memoize/memoize-docs.factor b/basis/memoize/memoize-docs.factor index a6f78970c8..cfb5cffb37 100644 --- a/basis/memoize/memoize-docs.factor +++ b/basis/memoize/memoize-docs.factor @@ -1,10 +1,10 @@ -! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg. +! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup ; +USING: help.syntax help.markup words quotations effects ; IN: memoize HELP: define-memoized -{ $values { "word" "the word to be defined" } { "quot" "a quotation" } } +{ $values { "word" word } { "quot" quotation } { "effect" effect } } { $description "defines the given word at runtime as one which memoizes its output given a particular input" } { $notes "A maximum of four input and four output arguments can be used" } { $see-also POSTPONE: MEMO: } ; diff --git a/extra/promises/authors.txt b/basis/promises/authors.txt similarity index 100% rename from extra/promises/authors.txt rename to basis/promises/authors.txt diff --git a/extra/promises/promises-docs.factor b/basis/promises/promises-docs.factor similarity index 100% rename from extra/promises/promises-docs.factor rename to basis/promises/promises-docs.factor diff --git a/extra/promises/promises-tests.factor b/basis/promises/promises-tests.factor similarity index 100% rename from extra/promises/promises-tests.factor rename to basis/promises/promises-tests.factor diff --git a/extra/promises/promises.factor b/basis/promises/promises.factor similarity index 100% rename from extra/promises/promises.factor rename to basis/promises/promises.factor diff --git a/extra/promises/summary.txt b/basis/promises/summary.txt similarity index 100% rename from extra/promises/summary.txt rename to basis/promises/summary.txt diff --git a/extra/promises/tags.txt b/basis/promises/tags.txt similarity index 100% rename from extra/promises/tags.txt rename to basis/promises/tags.txt diff --git a/basis/refs/refs-docs.factor b/basis/refs/refs-docs.factor index b6f222cce9..a219f0ba8b 100644 --- a/basis/refs/refs-docs.factor +++ b/basis/refs/refs-docs.factor @@ -37,14 +37,14 @@ HELP: key-ref { $class-description "Instances of this class identify a key in an associative structure. New key references are created by calling " { $link } "." } ; HELP: -{ $values { "key" object } { "assoc" "an assoc" } { "ref" key-ref } } +{ $values { "assoc" "an assoc" } { "key" object } { "key-ref" key-ref } } { $description "Creates a reference to a key stored in an assoc." } ; HELP: value-ref { $class-description "Instances of this class identify a value associated to a key in an associative structure. New value references are created by calling " { $link } "." } ; HELP: -{ $values { "key" object } { "assoc" "an assoc" } { "ref" value-ref } } +{ $values { "assoc" "an assoc" } { "key" object } { "value-ref" value-ref } } { $description "Creates a reference to the value associated with " { $snippet "key" } " in " { $snippet "assoc" } "." } ; { get-ref set-ref delete-ref } related-words diff --git a/basis/refs/refs.factor b/basis/refs/refs.factor index 5f21dad776..0164a1ea57 100644 --- a/basis/refs/refs.factor +++ b/basis/refs/refs.factor @@ -12,11 +12,11 @@ GENERIC: get-ref ( ref -- obj ) GENERIC: set-ref ( obj ref -- ) TUPLE: key-ref < ref ; -C: key-ref ( assoc key -- ref ) +C: key-ref M: key-ref get-ref key>> ; M: key-ref set-ref >ref< rename-at ; TUPLE: value-ref < ref ; -C: value-ref ( assoc key -- ref ) +C: value-ref M: value-ref get-ref >ref< at ; M: value-ref set-ref >ref< set-at ; diff --git a/basis/see/see-docs.factor b/basis/see/see-docs.factor index 755d4ac9bc..cea2592bc2 100644 --- a/basis/see/see-docs.factor +++ b/basis/see/see-docs.factor @@ -25,7 +25,7 @@ HELP: definer { $examples { $example "USING: definitions prettyprint ;" "IN: scratchpad" - ": foo ; \\ foo definer . ." + ": foo ( -- ) ; \\ foo definer . ." ";\nPOSTPONE: :" } { $example "USING: definitions prettyprint ;" diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor index 088fab34d0..28090918bb 100644 --- a/basis/stack-checker/stack-checker-docs.factor +++ b/basis/stack-checker/stack-checker-docs.factor @@ -33,9 +33,9 @@ $nl "A general rule of thumb is that any word which applies " { $link call } " or " { $link curry } " to one of its inputs must be declared " { $link POSTPONE: inline } "." $nl "Here is an example where the stack effect cannot be inferred:" -{ $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." } +{ $code ": foo ( -- n quot ) 0 [ + ] ;" "[ foo reduce ] infer." } "However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":" -{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } +{ $example ": foo ( -- n quot ) 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } "Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:" { $example "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 3d8c2cdd8c..117b6845b8 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -292,7 +292,7 @@ DEFER: bar [ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with -: m' dup curry call ; inline +: m' ( quot -- ) dup curry call ; inline [ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with diff --git a/basis/ui/commands/commands-docs.factor b/basis/ui/commands/commands-docs.factor index 81a4096aab..b576f173b6 100644 --- a/basis/ui/commands/commands-docs.factor +++ b/basis/ui/commands/commands-docs.factor @@ -54,7 +54,7 @@ HELP: command-name { $example "USING: io ui.commands ;" "IN: scratchpad" - ": com-my-command ;" + ": com-my-command ( -- ) ;" "\\ com-my-command command-name write" "My Command" } diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 101557d0cf..f79dcb5481 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -307,7 +307,7 @@ HELP: find-last-integer { $notes "This word is used to implement " { $link find-last } "." } ; HELP: byte-array>bignum -{ $values { "byte-array" byte-array } { "n" integer } } +{ $values { "x" byte-array } { "y" bignum } } { $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ; ARTICLE: "division-by-zero" "Division by zero" diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor index 11a6a9d8a9..995c7e6064 100644 --- a/core/memory/memory-tests.factor +++ b/core/memory/memory-tests.factor @@ -15,9 +15,9 @@ IN: memory.tests [ [ ] instances ] must-infer ! Code GC wasn't kicking in when needed -: leak-step 800000 f 1quotation call drop ; +: leak-step ( -- ) 800000 f 1quotation call drop ; -: leak-loop 100 [ leak-step ] times ; +: leak-loop ( -- ) 100 [ leak-step ] times ; [ ] [ leak-loop ] unit-test diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor index c5ca2b129f..2aa8ef421c 100644 --- a/core/strings/strings-docs.factor +++ b/core/strings/strings-docs.factor @@ -26,17 +26,17 @@ ABOUT: "strings" HELP: string { $description "The class of fixed-length character strings. See " { $link "syntax-strings" } " for syntax and " { $link "strings" } " for general information." } ; -HELP: string-nth ( n string -- ch ) +HELP: string-nth { $values { "n" fixnum } { "string" string } { "ch" "the character at the " { $snippet "n" } "th index" } } { $description "Unsafe string accessor, used to define " { $link nth } " on strings." } { $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link nth } " instead." } ; -HELP: set-string-nth ( ch n string -- ) +HELP: set-string-nth { $values { "ch" "a character" } { "n" fixnum } { "string" string } } { $description "Unsafe string mutator, used to define " { $link set-nth } " on strings." } { $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link set-nth } " instead." } ; -HELP: ( n ch -- string ) +HELP: { $values { "n" "a positive integer specifying string length" } { "ch" "an initial character" } { "string" string } } { $description "Creates a new string with the given length and all characters initially set to " { $snippet "ch" } "." } ; diff --git a/core/strings/strings.factor b/core/strings/strings.factor index 7e4c80d4ae..ffcefab78b 100644 --- a/core/strings/strings.factor +++ b/core/strings/strings.factor @@ -17,7 +17,7 @@ IN: strings : rehash-string ( str -- ) 1 over sequence-hashcode swap set-string-hashcode ; inline -: set-string-nth ( ch n str -- ) +: set-string-nth ( ch n string -- ) pick HEX: 7f fixnum<= [ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 79aeee5b55..6a7e8116cd 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -180,7 +180,7 @@ HELP: delimiter HELP: SYNTAX: { $syntax "SYNTAX: foo ... ;" } { $description "Defines a parsing word." } -{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< SYNTAX: HELLO \"Hello parser!\" print ; >>\n: world HELLO ;" "Hello parser!" } } ; +{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< SYNTAX: HELLO \"Hello parser!\" print ; >>\n: world ( -- ) HELLO ;" "Hello parser!" } } ; HELP: inline { $syntax ": foo ... ; inline" } diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 63b58bf9d5..1ad6928acb 100644 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -165,7 +165,7 @@ HELP: execute ( word -- ) { $values { "word" word } } { $description "Executes a word." } { $examples - { $example "USING: kernel io words ;" "IN: scratchpad" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" } + { $example "USING: kernel io words ;" "IN: scratchpad" ": twice ( word -- ) dup execute execute ;\n: hello ( -- ) \"Hello\" print ;\n\\ hello twice" "Hello\nHello" } } ; HELP: deferred @@ -273,8 +273,8 @@ HELP: bootstrap-word { $values { "word" word } { "target" word } } { $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ; -HELP: parsing-word? ( obj -- ? ) -{ $values { "obj" object } { "?" "a boolean" } } +HELP: parsing-word? +{ $values { "object" object } { "?" "a boolean" } } { $description "Tests if an object is a parsing word declared by " { $link POSTPONE: SYNTAX: } "." } { $notes "Outputs " { $link f } " if the object is not a word." } ; diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor index f22ca001f4..19928b2e0b 100644 --- a/extra/24-game/24-game.factor +++ b/extra/24-game/24-game.factor @@ -57,7 +57,7 @@ DEFER: check-status [ dup quit? [ quit-game ] [ repeat ] if ] if ; : build-quad ( -- array ) 4 [ 10 random ] replicate >array ; -: 24-able? ( vector -- t/f ) [ makes-24? ] with-datastack first ; +: 24-able? ( quad -- t/f ) [ makes-24? ] with-datastack first ; : 24-able ( -- vector ) build-quad dup 24-able? [ drop build-quad ] unless ; : set-commands ( -- ) { + - * / rot swap q } commands set ; : play-game ( -- ) set-commands 24-able repeat ; diff --git a/extra/animations/animations-docs.factor b/extra/animations/animations-docs.factor index 000c0ce4cc..c875feab83 100644 --- a/extra/animations/animations-docs.factor +++ b/extra/animations/animations-docs.factor @@ -29,7 +29,7 @@ HELP: reset-progress ( -- ) "a loop which makes use of " { $link progress } "." } ; -HELP: progress ( -- time ) +HELP: progress { $values { "time" "an integer" } } { $description "Gives the time elapsed since the last time" diff --git a/extra/animations/animations.factor b/extra/animations/animations.factor index 8ac4abe1fa..a5c7dbdde4 100644 --- a/extra/animations/animations.factor +++ b/extra/animations/animations.factor @@ -9,7 +9,7 @@ SYMBOL: sleep-period : reset-progress ( -- ) millis last-loop set ; ! : my-progress ( -- progress ) millis -: progress ( -- progress ) millis last-loop get - reset-progress ; +: progress ( -- time ) millis last-loop get - reset-progress ; : progress-peek ( -- progress ) millis last-loop get - ; : set-end ( duration -- end-time ) duration>milliseconds millis + ; : loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor index b984cdce54..0377808dca 100644 --- a/extra/ctags/ctags-docs.factor +++ b/extra/ctags/ctags-docs.factor @@ -36,7 +36,7 @@ HELP: ctags-write ( seq path -- ) { $notes { $snippet "tags" } " file will contain a single line: if\\t/path/to/factor/extra/unix/unix.factor\\t91" } ; -HELP: ctag-strings ( alist -- seq ) +HELP: ctag-strings { $values { "alist" "an association list" } { "seq" sequence } } { $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." } diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor index 393c932482..e351fbf793 100644 --- a/extra/ctags/ctags.factor +++ b/extra/ctags/ctags.factor @@ -27,7 +27,7 @@ IN: ctags ctag-lineno number>string % ] "" make ; -: ctag-strings ( seq1 -- seq2 ) +: ctag-strings ( alist -- seq ) [ ctag ] map ; : ctags-write ( seq path -- ) diff --git a/extra/literals/literals-docs.factor b/extra/literals/literals-docs.factor index 6525264f6a..0d61dcb467 100644 --- a/extra/literals/literals-docs.factor +++ b/extra/literals/literals-docs.factor @@ -21,7 +21,7 @@ CONSTANT: five 5 USING: kernel literals prettyprint ; IN: scratchpad -<< : seven-eleven 7 11 ; >> +<< : seven-eleven ( -- a b ) 7 11 ; >> { $ seven-eleven } . "> "{ 7 11 }" } @@ -37,7 +37,7 @@ HELP: $[ USING: kernel literals math prettyprint ; IN: scratchpad -<< : five 5 ; >> +<< CONSTANT: five 5 >> { $[ five dup 1+ dup 2 + ] } . "> "{ 5 6 8 }" } @@ -51,7 +51,7 @@ ARTICLE: "literals" "Interpolating code results into literal values" USING: kernel literals math prettyprint ; IN: scratchpad -<< : five 5 ; >> +<< CONSTANT: five 5 >> { $ five $[ five dup 1+ dup 2 + ] } . "> "{ 5 5 6 8 }" } { $subsection POSTPONE: $ } diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index ec069a4894..17f0de120e 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences vectors classes classes.algebra combinators arrays words assocs parser namespaces make definitions prettyprint prettyprint.backend prettyprint.custom quotations generalizations debugger io compiler.units kernel.private effects accessors hashtables sorting shuffle -math.order sets see ; +math.order sets see effects.parser ; IN: multi-methods ! PART I: Converting hook specializers @@ -214,17 +214,16 @@ M: no-method error. [ "multi-method-specializer" word-prop ] [ "multi-method-generic" word-prop ] bi prefix ; -: define-generic ( word -- ) - dup "multi-methods" word-prop [ - drop - ] [ +: define-generic ( word effect -- ) + over set-stack-effect + dup "multi-methods" word-prop [ drop ] [ [ H{ } clone "multi-methods" set-word-prop ] [ update-generic ] bi ] if ; ! Syntax -SYNTAX: GENERIC: CREATE define-generic ; +SYNTAX: GENERIC: CREATE-WORD complete-effect define-generic ; : parse-method ( -- quot classes generic ) parse-definition [ 2 tail ] [ second ] [ first ] tri ; diff --git a/extra/newfx/newfx.factor b/extra/newfx/newfx.factor index 4169050e6f..bf7955fa84 100644 --- a/extra/newfx/newfx.factor +++ b/extra/newfx/newfx.factor @@ -140,11 +140,11 @@ METHOD: as-mutate { object object assoc } set-at ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: filter-of ( quot seq -- seq ) swap filter ; +: filter-of ( quot seq -- seq ) swap filter ; inline ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: map-over ( quot seq -- seq ) swap map ; +: map-over ( quot seq -- seq ) swap map ; inline ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -242,7 +242,7 @@ METHOD: as-mutate { object object assoc } set-at ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: purge ( seq quot -- seq ) [ not ] compose filter ; +: purge ( seq quot -- seq ) [ not ] compose filter ; inline : purge! ( seq quot -- seq ) - dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ; + dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ; inline diff --git a/extra/sequences/n-based/n-based-docs.factor b/extra/sequences/n-based/n-based-docs.factor index 6c56300f6d..852fe59d8b 100644 --- a/extra/sequences/n-based/n-based-docs.factor +++ b/extra/sequences/n-based/n-based-docs.factor @@ -10,7 +10,7 @@ HELP: USING: assocs prettyprint kernel sequences.n-based ; IN: scratchpad -: months +: months ( -- assoc ) { "January" "February" @@ -36,7 +36,7 @@ HELP: n-based-assoc USING: assocs prettyprint kernel sequences.n-based ; IN: scratchpad -: months +: months ( -- assoc ) { "January" "February" From ed26f1921fdeffa537969b71209a2f66739197b3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 18:25:18 -0500 Subject: [PATCH 29/43] Condomization wraps lambdas in condoms to protect them from macro-transmitted diseases. cond, case and other macros work better now if lambdas appear where quotations are expected --- basis/locals/locals-tests.factor | 61 ++++++++++++++++++++++++++- basis/locals/macros/macros.factor | 7 ++- basis/macros/expander/expander.factor | 22 ++++++++-- 3 files changed, 84 insertions(+), 6 deletions(-) diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 8e3b59fe69..8e61e39faf 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel namespaces arrays strings prettyprint io.streams.string parser accessors generic eval combinators combinators.short-circuit combinators.short-circuit.smart math.order math.functions -definitions compiler.units fry lexer words.symbol see ; +definitions compiler.units fry lexer words.symbol see multiline ; IN: locals.tests :: foo ( a b -- a a ) a a ; @@ -392,6 +392,65 @@ ERROR: punned-class x ; [ 9 ] [ 3 big-case-test ] unit-test +! Dan found this problem +: littledan-case-problem-1 ( a -- b ) + { + { t [ 3 ] } + { f [ 4 ] } + [| x | x 12 + { "howdy" } nth ] + } case ; + +\ littledan-case-problem-1 must-infer + +[ "howdy" ] [ -12 \ littledan-case-problem-1 def>> call ] unit-test +[ "howdy" ] [ -12 littledan-case-problem-1 ] unit-test + +:: littledan-case-problem-2 ( a -- b ) + a { + { t [ a not ] } + { f [ 4 ] } + [| x | x a - { "howdy" } nth ] + } case ; + +\ littledan-case-problem-2 must-infer + +[ "howdy" ] [ -12 \ littledan-case-problem-2 def>> call ] unit-test +[ "howdy" ] [ -12 littledan-case-problem-2 ] unit-test + +:: littledan-cond-problem-1 ( a -- b ) + a { + { [ dup 0 < ] [ drop a not ] } + { [| y | y y 0 > ] [ drop 4 ] } + [| x | x a - { "howdy" } nth ] + } cond ; + +\ littledan-cond-problem-1 must-infer + +[ f ] [ -12 \ littledan-cond-problem-1 def>> call ] unit-test +[ 4 ] [ 12 \ littledan-cond-problem-1 def>> call ] unit-test +[ "howdy" ] [ 0 \ littledan-cond-problem-1 def>> call ] unit-test +[ f ] [ -12 littledan-cond-problem-1 ] unit-test +[ 4 ] [ 12 littledan-cond-problem-1 ] unit-test +[ "howdy" ] [ 0 littledan-cond-problem-1 ] unit-test + +/* +:: littledan-case-problem-3 ( a quot -- b ) + a { + { t [ a not ] } + { f [ 4 ] } + quot + } case ; inline + +[ f ] [ t [ ] littledan-case-problem-3 ] unit-test +[ 144 ] [ 12 [ sq ] littledan-case-problem-3 ] unit-test +[| | [| a | a ] littledan-case-problem-3 ] must-infer + +: littledan-case-problem-4 ( a -- b ) + [ 1 + ] littledan-case-problem-3 ; + +\ littledan-case-problem-4 must-infer +*/ + GENERIC: lambda-method-forget-test ( a -- b ) M:: integer lambda-method-forget-test ( a -- b ) ; diff --git a/basis/locals/macros/macros.factor b/basis/locals/macros/macros.factor index 7bde67a792..2b52c53eb5 100644 --- a/basis/locals/macros/macros.factor +++ b/basis/locals/macros/macros.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. +! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs kernel locals.types macros.expander ; +USING: accessors assocs kernel locals.types macros.expander fry ; IN: locals.macros M: lambda expand-macros clone [ expand-macros ] change-body ; @@ -14,3 +14,6 @@ M: binding-form expand-macros M: binding-form expand-macros* expand-macros literal ; +M: lambda condomize? drop t ; + +M: lambda condomize '[ @ ] ; \ No newline at end of file diff --git a/basis/macros/expander/expander.factor b/basis/macros/expander/expander.factor index cdd2b49d9c..25f754e92a 100644 --- a/basis/macros/expander/expander.factor +++ b/basis/macros/expander/expander.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private namespaces make quotations accessors words continuations vectors effects math -generalizations fry ; +generalizations fry arrays ; IN: macros.expander GENERIC: expand-macros ( quot -- quot' ) @@ -17,7 +17,23 @@ SYMBOL: stack [ delete-all ] bi ; -: literal ( obj -- ) stack get push ; +GENERIC: condomize? ( obj -- ? ) + +M: array condomize? [ condomize? ] any? ; + +M: callable condomize? [ condomize? ] any? ; + +M: object condomize? drop f ; + +GENERIC: condomize ( obj -- obj' ) + +M: array condomize [ condomize ] map ; + +M: callable condomize [ condomize ] map ; + +M: object condomize ; + +: literal ( obj -- ) dup condomize? [ condomize ] when stack get push ; GENERIC: expand-macros* ( obj -- ) From 3d97e4c82e40584b6f7a13e1c4f2accdebcd3931 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Mar 2009 19:00:23 -0500 Subject: [PATCH 30/43] delete factor/ every time after a build is finished. you can easily check it out by knowing the git-id --- extra/mason/build/build.factor | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index 706dc12616..90ca1d31ff 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -5,6 +5,8 @@ io.files io.launcher mason.child mason.cleanup mason.common mason.help mason.release mason.report namespaces prettyprint ; IN: mason.build +QUALIFIED: continuations + : create-build-dir ( -- ) now datestamp stamp set build-dir make-directory ; @@ -21,10 +23,11 @@ IN: mason.build create-build-dir enter-build-dir clone-builds-factor - record-id - build-child - upload-help - release - cleanup ; + [ + record-id + build-child + upload-help + release + ] [ cleanup ] [ ] continuations:cleanup ; -MAIN: build \ No newline at end of file +MAIN: build From f8d7fec17f21f5f64aad55003a35bc24cdc6fd3a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 19:23:18 -0500 Subject: [PATCH 31/43] Faster PEG compile times; inline less, use execute( instead --- basis/peg/parsers/parsers.factor | 4 +-- basis/peg/peg.factor | 56 ++++++++++++++++---------------- 2 files changed, 30 insertions(+), 30 deletions(-) diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor index aadbbaff16..93f407681e 100644 --- a/basis/peg/parsers/parsers.factor +++ b/basis/peg/parsers/parsers.factor @@ -9,14 +9,14 @@ TUPLE: just-parser p1 ; CONSTANT: just-pattern [ - execute dup [ + dup [ dup remaining>> empty? [ drop f ] unless ] when ] M: just-parser (compile) ( parser -- quot ) - p1>> compile-parser just-pattern curry ; + p1>> compile-parser-quot just-pattern compose ; : just ( parser -- parser ) just-parser boa wrap-peg ; diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 98c92159ec..ce34beb725 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -116,7 +116,7 @@ TUPLE: peg-head rule-id involved-set eval-set ; #! Evaluate a rule, return an ast resulting from it. #! Return fail if the rule failed. The rule has #! stack effect ( -- parse-result ) - pos get swap execute process-rule-result ; inline + pos get swap execute( -- parse-result ) process-rule-result ; inline : memo ( pos id -- memo-entry ) #! Return the result from the memo cache. @@ -244,14 +244,15 @@ TUPLE: peg-head rule-id involved-set eval-set ; : with-packrat ( input quot -- result ) #! Run the quotation with a packrat cache active. - swap [ - input set + [ + swap input set 0 pos set f lrstack set V{ } clone error-stack set H{ } clone \ heads set H{ } clone \ packrat set - ] H{ } make-assoc swap bind ; inline + call + ] with-scope ; inline GENERIC: (compile) ( peg -- quot ) @@ -264,20 +265,16 @@ GENERIC: (compile) ( peg -- quot ) ] if ; : execute-parser ( word -- result ) - pos get apply-rule process-parser-result ; inline - -: parser-body ( parser -- quot ) - #! Return the body of the word that is the compiled version - #! of the parser. - gensym 2dup swap peg>> (compile) (( -- result )) define-declared - swap dupd id>> "peg-id" set-word-prop - [ execute-parser ] curry ; + pos get apply-rule process-parser-result ; : preset-parser-word ( parser -- parser word ) gensym [ >>compiled ] keep ; : define-parser-word ( parser word -- ) - swap parser-body (( -- result )) define-declared ; + #! Return the body of the word that is the compiled version + #! of the parser. + 2dup swap peg>> (compile) (( -- result )) define-declared + swap id>> "peg-id" set-word-prop ; : compile-parser ( parser -- word ) #! Look to see if the given parser has been compiled. @@ -292,19 +289,22 @@ GENERIC: (compile) ( peg -- quot ) preset-parser-word [ define-parser-word ] keep ] if* ; +: compile-parser-quot ( parser -- quot ) + compile-parser [ execute-parser ] curry ; + SYMBOL: delayed : fixup-delayed ( -- ) #! Work through all delayed parsers and recompile their #! words to have the correct bodies. delayed get [ - call( -- parser ) compile-parser 1quotation (( -- result )) define-declared + call( -- parser ) compile-parser-quot (( -- result )) define-declared ] assoc-each ; : compile ( parser -- word ) [ H{ } clone delayed [ - compile-parser fixup-delayed + compile-parser-quot (( -- result )) define-temp fixup-delayed ] with-variable ] with-compilation-unit ; @@ -411,8 +411,8 @@ M: seq-parser (compile) ( peg -- quot ) [ [ input-slice V{ } clone ] % [ - parsers>> unclip compile-parser 1quotation [ parse-seq-element ] curry , - [ compile-parser 1quotation [ merge-errors ] compose [ parse-seq-element ] curry , ] each + parsers>> unclip compile-parser-quot [ parse-seq-element ] curry , + [ compile-parser-quot [ merge-errors ] compose [ parse-seq-element ] curry , ] each ] { } make , \ 1&& , ] [ ] make ; @@ -421,8 +421,8 @@ TUPLE: choice-parser parsers ; M: choice-parser (compile) ( peg -- quot ) [ [ - parsers>> [ compile-parser ] map - unclip 1quotation , [ 1quotation [ merge-errors ] compose , ] each + parsers>> [ compile-parser-quot ] map + unclip , [ [ merge-errors ] compose , ] each ] { } make , \ 0|| , ] [ ] make ; @@ -438,7 +438,7 @@ TUPLE: repeat0-parser p1 ; ] if* ; inline recursive M: repeat0-parser (compile) ( peg -- quot ) - p1>> compile-parser 1quotation '[ + p1>> compile-parser-quot '[ input-slice V{ } clone _ swap (repeat) ] ; @@ -452,7 +452,7 @@ TUPLE: repeat1-parser p1 ; ] if* ; M: repeat1-parser (compile) ( peg -- quot ) - p1>> compile-parser 1quotation '[ + p1>> compile-parser-quot '[ input-slice V{ } clone _ swap (repeat) repeat1-empty-check ] ; @@ -462,7 +462,7 @@ TUPLE: optional-parser p1 ; [ input-slice f ] unless* ; M: optional-parser (compile) ( peg -- quot ) - p1>> compile-parser 1quotation '[ @ check-optional ] ; + p1>> compile-parser-quot '[ @ check-optional ] ; TUPLE: semantic-parser p1 quot ; @@ -474,7 +474,7 @@ TUPLE: semantic-parser p1 quot ; ] if ; inline M: semantic-parser (compile) ( peg -- quot ) - [ p1>> compile-parser 1quotation ] [ quot>> ] bi + [ p1>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-semantic ] ; TUPLE: ensure-parser p1 ; @@ -483,7 +483,7 @@ TUPLE: ensure-parser p1 ; [ ignore ] [ drop f ] if ; M: ensure-parser (compile) ( peg -- quot ) - p1>> compile-parser 1quotation '[ input-slice @ check-ensure ] ; + p1>> compile-parser-quot '[ input-slice @ check-ensure ] ; TUPLE: ensure-not-parser p1 ; @@ -491,7 +491,7 @@ TUPLE: ensure-not-parser p1 ; [ drop f ] [ ignore ] if ; M: ensure-not-parser (compile) ( peg -- quot ) - p1>> compile-parser 1quotation '[ input-slice @ check-ensure-not ] ; + p1>> compile-parser-quot '[ input-slice @ check-ensure-not ] ; TUPLE: action-parser p1 quot ; @@ -503,12 +503,12 @@ TUPLE: action-parser p1 quot ; ] if ; inline M: action-parser (compile) ( peg -- quot ) - [ p1>> compile-parser 1quotation ] [ quot>> ] bi '[ @ _ check-action ] ; + [ p1>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ; TUPLE: sp-parser p1 ; M: sp-parser (compile) ( peg -- quot ) - p1>> compile-parser 1quotation '[ + p1>> compile-parser-quot '[ input-slice [ blank? ] trim-head-slice input-from pos set @ ] ; @@ -527,7 +527,7 @@ M: box-parser (compile) ( peg -- quot ) #! to produce the parser to be compiled. #! This differs from 'delay' which calls #! it at run time. - quot>> call( -- parser ) compile-parser 1quotation ; + quot>> call( -- parser ) compile-parser-quot ; PRIVATE> From 6f4e5b4bd9fd4f66f040c779fac0537c34bbda46 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 19:25:10 -0500 Subject: [PATCH 32/43] Move synopsis* from definitions to see --- basis/see/see-docs.factor | 5 ++++- basis/see/see.factor | 2 ++ core/definitions/definitions-docs.factor | 4 ++-- core/generic/generic-docs.factor | 2 +- 4 files changed, 9 insertions(+), 4 deletions(-) diff --git a/basis/see/see-docs.factor b/basis/see/see-docs.factor index cea2592bc2..6d51b42a86 100644 --- a/basis/see/see-docs.factor +++ b/basis/see/see-docs.factor @@ -50,6 +50,9 @@ $nl "Printing a definition:" { $subsection see } "Printing the methods defined on a generic word or class (see " { $link "objects" } "):" -{ $subsection see-methods } ; +{ $subsection see-methods } +"Definition specifiers implementing the " { $link "definition-protocol" } " should also implement the " { $emphasis "see protocol" } ":" +{ $subsection see* } +{ $subsection synopsis* } ; ABOUT: "see" \ No newline at end of file diff --git a/basis/see/see.factor b/basis/see/see.factor index 041a72ea0e..32f49499db 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -10,6 +10,8 @@ prettyprint.sections sequences sets sorting strings summary words words.symbol ; IN: see +GENERIC: synopsis* ( defspec -- ) + GENERIC: see* ( defspec -- ) : see ( defspec -- ) see* nl ; diff --git a/core/definitions/definitions-docs.factor b/core/definitions/definitions-docs.factor index 80da7daa31..b53ab28cbc 100644 --- a/core/definitions/definitions-docs.factor +++ b/core/definitions/definitions-docs.factor @@ -13,9 +13,9 @@ $nl "Definitions can answer a sequence of definitions they directly depend on:" { $subsection uses } "Definitions must implement a few operations used for printing them in source form:" -{ $subsection synopsis* } { $subsection definer } -{ $subsection definition } ; +{ $subsection definition } +{ $see-also "see" } ; ARTICLE: "definition-crossref" "Definition cross referencing" "A common cross-referencing system is used to track definition usages:" diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor index b90bcc8fc1..06a8fa87a3 100644 --- a/core/generic/generic-docs.factor +++ b/core/generic/generic-docs.factor @@ -62,7 +62,7 @@ ARTICLE: "method-combination" "Custom method combination" { { $link POSTPONE: HOOK: } { $link hook-combination } } { { $link POSTPONE: MATH: } { $link math-combination } } } -"Developing a custom method combination requires that a parsing word calling " { $link define-generic } " be defined; additionally, it is a good idea to implement the definition protocol words " { $link definer } " and " { $link synopsis* } " on the class of words having this method combination, to properly support developer tools." +"Developing a custom method combination requires that a parsing word calling " { $link define-generic } " be defined; additionally, it is a good idea to implement the " { $link "definition-protocol" } " on the class of words having this method combination, to properly support developer tools." $nl "The combination quotation passed to " { $link define-generic } " has stack effect " { $snippet "( word -- quot )" } ". It's job is to call various introspection words, including at least obtaining the set of methods defined on the generic word, then combining these methods in some way to produce a quotation." { $see-also "generic-introspection" } ; From 919f544d6420bbf3bc7a7485fee94dbcf20ff9fb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 19:25:17 -0500 Subject: [PATCH 33/43] cocoa.messages: cleanup --- basis/cocoa/messages/messages.factor | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index f71b9f3f56..65bb2c02ef 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -22,15 +22,13 @@ SYMBOL: super-message-senders message-senders [ H{ } clone ] initialize super-message-senders [ H{ } clone ] initialize -: cache-stub ( method function hash -- ) - [ - over get [ 2drop ] [ over [ sender-stub ] dip set ] if - ] bind ; +: cache-stub ( method assoc function -- ) + '[ _ sender-stub ] cache drop ; : cache-stubs ( method -- ) - dup - "objc_msgSendSuper" super-message-senders get cache-stub - "objc_msgSend" message-senders get cache-stub ; + [ super-message-senders get "objc_msgSendSuper" cache-stub ] + [ message-senders get "objc_msgSend" cache-stub ] + bi ; : ( receiver -- super ) "objc-super" [ From d42486f078bbaffb2f2f85bfd7f65c69e9091162 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Mar 2009 20:09:01 -0500 Subject: [PATCH 34/43] check pango-1.0 --- build-support/factor.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build-support/factor.sh b/build-support/factor.sh index c5be9f8957..61450dacb4 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -142,7 +142,7 @@ check_X11_libraries() { check_library_exists GLU check_library_exists GL check_library_exists X11 - check_library_exists pango + check_library_exists pango-1.0 } check_libraries() { From f061b0531167f949eaeb887332e2662616f9aac0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Mar 2009 20:32:57 -0500 Subject: [PATCH 35/43] make ecdsa unportable for now --- extra/ecdsa/tags.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 extra/ecdsa/tags.txt diff --git a/extra/ecdsa/tags.txt b/extra/ecdsa/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/ecdsa/tags.txt @@ -0,0 +1 @@ +unportable From 688452fa3d78b1ce6406f7aedcfb3403b5a3b815 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 23 Mar 2009 20:36:44 -0500 Subject: [PATCH 36/43] make multimethods tests pass --- extra/multi-methods/tests/definitions.factor | 2 +- extra/multi-methods/tests/syntax.factor | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/multi-methods/tests/definitions.factor b/extra/multi-methods/tests/definitions.factor index 64363af428..240c9f86d7 100644 --- a/extra/multi-methods/tests/definitions.factor +++ b/extra/multi-methods/tests/definitions.factor @@ -26,7 +26,7 @@ DEFER: fake DEFER: testing - [ ] [ \ testing define-generic ] unit-test + [ ] [ \ testing (( -- )) define-generic ] unit-test [ t ] [ \ testing generic? ] unit-test ] with-compilation-unit diff --git a/extra/multi-methods/tests/syntax.factor b/extra/multi-methods/tests/syntax.factor index 9d9c80b214..cc073099d8 100644 --- a/extra/multi-methods/tests/syntax.factor +++ b/extra/multi-methods/tests/syntax.factor @@ -3,7 +3,7 @@ USING: multi-methods tools.test math sequences namespaces system kernel strings definitions prettyprint debugger arrays hashtables continuations classes assocs accessors see ; -GENERIC: first-test +GENERIC: first-test ( -- ) [ t ] [ \ first-test generic? ] unit-test @@ -13,7 +13,7 @@ SINGLETON: paper INSTANCE: paper thing SINGLETON: scissors INSTANCE: scissors thing SINGLETON: rock INSTANCE: rock thing -GENERIC: beats? +GENERIC: beats? ( obj1 obj2 -- ? ) METHOD: beats? { paper scissors } t ; METHOD: beats? { scissors rock } t ; @@ -34,7 +34,7 @@ METHOD: beats? { thing thing } f ; SYMBOL: some-var -GENERIC: hook-test +GENERIC: hook-test ( -- obj ) METHOD: hook-test { array { some-var array } } reverse ; METHOD: hook-test { { some-var array } } class ; @@ -57,7 +57,7 @@ TUPLE: busted-1 ; TUPLE: busted-2 ; INSTANCE: busted-2 busted TUPLE: busted-3 ; -GENERIC: busted-sort +GENERIC: busted-sort ( obj1 obj2 -- obj1 obj2 ) METHOD: busted-sort { busted-1 busted-2 } ; METHOD: busted-sort { busted-2 busted-3 } ; From 7a4a7474e86ca80a5cb1eea60b527f0296e9b28c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 22:33:05 -0500 Subject: [PATCH 37/43] Fix site-watcher tests --- extra/site-watcher/site-watcher-tests.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/extra/site-watcher/site-watcher-tests.factor b/extra/site-watcher/site-watcher-tests.factor index dde5e65e7e..62233587d9 100644 --- a/extra/site-watcher/site-watcher-tests.factor +++ b/extra/site-watcher/site-watcher-tests.factor @@ -2,11 +2,14 @@ ! See http://factorcode.org/license.txt for BSD license. USING: db.tuples locals site-watcher site-watcher.db site-watcher.private kernel db io.directories io.files.temp -continuations db.sqlite site-watcher.db.private ; +continuations site-watcher.db.private db.sqlite +sequences tools.test ; IN: site-watcher.tests +[ "site-watcher.db" temp-file delete-file ] ignore-errors + :: fake-sites ( -- seq ) - [ + "site-watcher.db" temp-file [ account ensure-table site ensure-table watching-site ensure-table @@ -17,5 +20,6 @@ IN: site-watcher.tests "erg@factorcode.org" "http://asdfasdfasdfasdfqwerqqq.com" watch-site f select-tuples - ] with-sqlite-db ; + ] with-db ; +[ f ] [ fake-sites empty? ] unit-test \ No newline at end of file From 862223fa79f68cd883e3d776613c853f79034cc3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 22:36:51 -0500 Subject: [PATCH 38/43] Fix bunny deployment --- basis/tools/deploy/shaker/shaker.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index a729e40e2a..55433299ad 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -204,7 +204,8 @@ IN: tools.deploy.shaker ] when ; : strip-vocab-globals ( except names -- words ) - [ child-vocabs [ words ] map concat ] map concat swap diff ; + [ child-vocabs [ words ] map concat ] map concat + swap [ first2 lookup ] map sift diff ; : stripped-globals ( -- seq ) [ @@ -245,7 +246,8 @@ IN: tools.deploy.shaker strip-dictionary? [ "libraries" "alien" lookup , - { } { "cpu" "compiler" } strip-vocab-globals % + { { "yield-hook" "compiler.utilities" } } + { "cpu" "compiler" } strip-vocab-globals % { gensym From 53369cf5ff497cec81b1208e1d639ba648a04678 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Mar 2009 23:15:53 -0500 Subject: [PATCH 39/43] Round mouse co-ordinates --- basis/cocoa/views/views.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index 0b8346db4b..3c60a6a7c1 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -89,4 +89,4 @@ PRIVATE> -> locationInWindow f -> convertPoint:fromView: [ CGPoint-x ] [ CGPoint-y ] bi ] [ drop -> frame CGRect-h ] 2bi - swap - 2array ; + swap - [ >integer ] bi@ 2array ; From c6837fbe3ed1b7f98d1d4905da88ed91efee82df Mon Sep 17 00:00:00 2001 From: sheeple Date: Tue, 24 Mar 2009 01:07:38 -0500 Subject: [PATCH 40/43] Update cpu-ppc.S for quotation layout change --- vm/cpu-ppc.S | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/cpu-ppc.S b/vm/cpu-ppc.S index 30b61b5c0c..8b3141218b 100755 --- a/vm/cpu-ppc.S +++ b/vm/cpu-ppc.S @@ -45,7 +45,7 @@ multiply_overflow: /* Note that the XT is passed to the quotation in r11 */ #define CALL_OR_JUMP_QUOT \ - lwz r11,9(r3) /* load quotation-xt slot */ XX \ + lwz r11,17(r3) /* load quotation-xt slot */ XX \ #define CALL_QUOT \ CALL_OR_JUMP_QUOT XX \ From 5d3c2c874a91c24b96f3d862a41371ebd45cca47 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Tue, 24 Mar 2009 03:58:11 -0500 Subject: [PATCH 41/43] Get game-input to load on Windows --- basis/ui/backend/windows/windows.factor | 2 +- basis/windows/dinput/constants/constants.factor | 2 +- basis/windows/dinput/dinput.factor | 6 +++--- extra/game-input/dinput/dinput.factor | 4 ++-- extra/game-input/game-input.factor | 2 +- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 54d9ed456a..80dd313e85 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -354,7 +354,7 @@ H{ } clone wm-handlers set-global : add-wm-handler ( quot wm -- ) dup array? - [ [ execute add-wm-handler ] with each ] + [ [ execute( -- wm ) add-wm-handler ] with each ] [ wm-handlers get-global set-at ] if ; [ handle-wm-close 0 ] WM_CLOSE add-wm-handler diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index 314fb167e3..cd1033d418 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -832,7 +832,7 @@ SYMBOLS: define-keyboard-format-constant define-hid-keyboard-format-constant ; -: define-constants +: define-constants ( -- ) define-guid-constants define-format-constants ; diff --git a/basis/windows/dinput/dinput.factor b/basis/windows/dinput/dinput.factor index 1cd22beb75..dc544858b6 100755 --- a/basis/windows/dinput/dinput.factor +++ b/basis/windows/dinput/dinput.factor @@ -27,15 +27,15 @@ TYPEDEF: void* LPDIENUMEFFECTSCALLBACKW [ "BOOL" { "LPCDIEFFECTINFOW" "LPVOID" } "stdcall" ] dip alien-callback ; inline TYPEDEF: void* LPDIENUMCREATEDEFFECTOBJECTSCALLBACK -: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK +: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK ( quot -- callback ) [ "BOOL" { "LPDIRECTINPUTEFFECT" "LPVOID" } "stdcall" ] dip alien-callback ; inline TYPEDEF: void* LPDIENUMEFFECTSINFILECALLBACK -: LPDIENUMEFFECTSINFILECALLBACK +: LPDIENUMEFFECTSINFILECALLBACK ( quot -- callback ) [ "BOOL" { "LPCDIFILEEFFECT" "LPVOID" } "stdcall" ] dip alien-callback ; inline TYPEDEF: void* LPDIENUMDEVICEOBJECTSCALLBACKW -: LPDIENUMDEVICEOBJECTSCALLBACKW +: LPDIENUMDEVICEOBJECTSCALLBACKW ( quot -- callback ) [ "BOOL" { "LPCDIDEVICEOBJECTINSTANCEW" "LPVOID" } "stdcall" ] dip alien-callback ; inline diff --git a/extra/game-input/dinput/dinput.factor b/extra/game-input/dinput/dinput.factor index c6004a8221..a2beaf6d9b 100755 --- a/extra/game-input/dinput/dinput.factor +++ b/extra/game-input/dinput/dinput.factor @@ -2,10 +2,10 @@ USING: windows.dinput windows.dinput.constants parser alien.c-types windows.ole32 namespaces assocs kernel arrays vectors windows.kernel32 windows.com windows.dinput shuffle windows.user32 windows.messages sequences combinators locals -math.rectangles ui.windows accessors math windows alien +math.rectangles accessors math windows alien alien.strings io.encodings.utf16 io.encodings.utf16n continuations byte-arrays game-input.dinput.keys-array -game-input ; +game-input ui.backend.windows ; IN: game-input.dinput SINGLETON: dinput-game-input-backend diff --git a/extra/game-input/game-input.factor b/extra/game-input/game-input.factor index 46e3ba9e8d..6efe31861a 100755 --- a/extra/game-input/game-input.factor +++ b/extra/game-input/game-input.factor @@ -35,7 +35,7 @@ PRIVATE> ] when ; : with-game-input ( quot -- ) - open-game-input [ close-game-input ] [ ] cleanup ; + open-game-input [ close-game-input ] [ ] cleanup ; inline TUPLE: controller handle ; TUPLE: controller-state x y z rx ry rz slider pov buttons ; From 637d06a4f85066c70142a0c9d52552601b1bdc65 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 24 Mar 2009 04:11:08 -0500 Subject: [PATCH 42/43] Add silly 'tip of the day' feature, and 'recently visited' list to UI browser home page --- basis/bootstrap/help/help.factor | 2 +- basis/bootstrap/tools/tools.factor | 1 - .../apropos/apropos-docs.factor | 6 ++- basis/help/apropos/apropos-tests.factor | 4 ++ basis/{tools => help}/apropos/apropos.factor | 8 +++- basis/help/handbook/handbook.factor | 14 +++---- basis/help/help-docs.factor | 1 + basis/help/home/authors.txt | 1 + basis/help/home/home-docs.factor | 19 +++++++++ basis/help/home/home.factor | 40 +++++++++++++++++++ basis/help/html/html.factor | 2 +- basis/help/tips/authors.txt | 1 + basis/help/tips/tips-docs.factor | 27 +++++++++++++ basis/help/tips/tips.factor | 38 ++++++++++++++++++ .../browser => help/vocabs}/authors.txt | 0 .../browser => help/vocabs}/summary.txt | 0 .../vocabs/browser => help/vocabs}/tags.txt | 0 .../vocabs/vocabs-docs.factor} | 2 +- basis/help/vocabs/vocabs-tests.factor | 5 +++ .../vocabs/vocabs.factor} | 17 ++++---- basis/tools/apropos/apropos-tests.factor | 4 -- .../tools/vocabs/browser/browser-tests.factor | 5 --- basis/ui/gadgets/editors/editors-docs.factor | 6 ++- basis/ui/tools/browser/browser.factor | 19 ++++----- basis/ui/tools/deploy/deploy-docs.factor | 4 +- .../listener/completion/completion.factor | 2 +- basis/ui/tools/listener/listener-docs.factor | 22 +++++++++- basis/ui/tools/listener/listener.factor | 22 +++++----- .../tools/operations/operations-docs.factor | 8 ++++ basis/ui/tools/operations/operations.factor | 4 +- basis/ui/tools/profiler/profiler-docs.factor | 11 +++++ basis/ui/tools/profiler/profiler.factor | 2 + basis/ui/tools/tools-docs.factor | 5 ++- core/parser/parser.factor | 2 +- core/strings/strings-docs.factor | 2 +- extra/demos/demos.factor | 2 +- extra/fuel/help/help.factor | 2 +- extra/galois-talk/galois-talk.factor | 2 +- .../google-tech-talk/google-tech-talk.factor | 2 +- extra/otug-talk/otug-talk.factor | 2 +- extra/vpri-talk/vpri-talk.factor | 2 +- 41 files changed, 245 insertions(+), 73 deletions(-) rename basis/{tools => help}/apropos/apropos-docs.factor (60%) create mode 100644 basis/help/apropos/apropos-tests.factor rename basis/{tools => help}/apropos/apropos.factor (94%) create mode 100644 basis/help/home/authors.txt create mode 100644 basis/help/home/home-docs.factor create mode 100644 basis/help/home/home.factor create mode 100644 basis/help/tips/authors.txt create mode 100644 basis/help/tips/tips-docs.factor create mode 100644 basis/help/tips/tips.factor rename basis/{tools/vocabs/browser => help/vocabs}/authors.txt (100%) rename basis/{tools/vocabs/browser => help/vocabs}/summary.txt (100%) rename basis/{tools/vocabs/browser => help/vocabs}/tags.txt (100%) rename basis/{tools/vocabs/browser/browser-docs.factor => help/vocabs/vocabs-docs.factor} (94%) create mode 100644 basis/help/vocabs/vocabs-tests.factor rename basis/{tools/vocabs/browser/browser.factor => help/vocabs/vocabs.factor} (96%) delete mode 100644 basis/tools/apropos/apropos-tests.factor delete mode 100644 basis/tools/vocabs/browser/browser-tests.factor create mode 100644 basis/ui/tools/operations/operations-docs.factor create mode 100644 basis/ui/tools/profiler/profiler-docs.factor diff --git a/basis/bootstrap/help/help.factor b/basis/bootstrap/help/help.factor index c3e74f7863..553b91a6ae 100644 --- a/basis/bootstrap/help/help.factor +++ b/basis/bootstrap/help/help.factor @@ -5,7 +5,7 @@ IN: bootstrap.help : load-help ( -- ) "help.lint" require - "tools.vocabs.browser" require + "help.vocabs" require "alien.syntax" require "compiler" require diff --git a/basis/bootstrap/tools/tools.factor b/basis/bootstrap/tools/tools.factor index c6ec7f0b99..b0afe4a1d9 100644 --- a/basis/bootstrap/tools/tools.factor +++ b/basis/bootstrap/tools/tools.factor @@ -14,7 +14,6 @@ IN: bootstrap.tools "tools.time" "tools.threads" "tools.vocabs" - "tools.vocabs.browser" "tools.vocabs.monitor" "editors" } [ require ] each diff --git a/basis/tools/apropos/apropos-docs.factor b/basis/help/apropos/apropos-docs.factor similarity index 60% rename from basis/tools/apropos/apropos-docs.factor rename to basis/help/apropos/apropos-docs.factor index b50b51b84f..4d774a75cb 100644 --- a/basis/tools/apropos/apropos-docs.factor +++ b/basis/help/apropos/apropos-docs.factor @@ -1,6 +1,8 @@ -IN: tools.apropos -USING: help.markup help.syntax strings ; +IN: help.apropos +USING: help.markup help.syntax strings help.tips ; HELP: apropos { $values { "str" string } } { $description "Lists all words, vocabularies and help articles whose name contains a subsequence equal to " { $snippet "str" } ". Results are ranked using a simple distance algorithm." } ; + +TIP: "Use " { $link apropos } " to search for words, vocabularies and help articles." ; \ No newline at end of file diff --git a/basis/help/apropos/apropos-tests.factor b/basis/help/apropos/apropos-tests.factor new file mode 100644 index 0000000000..3dbda475de --- /dev/null +++ b/basis/help/apropos/apropos-tests.factor @@ -0,0 +1,4 @@ +IN: help.apropos.tests +USING: help.apropos tools.test ; + +[ ] [ "swp" apropos ] unit-test diff --git a/basis/tools/apropos/apropos.factor b/basis/help/apropos/apropos.factor similarity index 94% rename from basis/tools/apropos/apropos.factor rename to basis/help/apropos/apropos.factor index c7126c10d0..b241db4c0e 100644 --- a/basis/tools/apropos/apropos.factor +++ b/basis/help/apropos/apropos.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs fry help.markup help.topics io kernel make math math.parser namespaces sequences sorting -summary tools.completion tools.vocabs tools.vocabs.browser +summary tools.completion tools.vocabs help.vocabs vocabs words unicode.case help ; -IN: tools.apropos +IN: help.apropos : $completions ( seq -- ) dup [ word? ] all? [ words-table ] [ @@ -67,5 +67,9 @@ M: apropos article-name article-title ; M: apropos article-content search>> 1array \ $apropos prefix ; +M: apropos >link ; + +INSTANCE: apropos topic + : apropos ( str -- ) print-topic ; diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index e048b66b7c..ed2a14a2f2 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -4,7 +4,7 @@ prettyprint.backend prettyprint.custom kernel.private io generic math system strings sbufs vectors byte-arrays quotations io.streams.byte-array classes.builtin parser lexer classes.predicate classes.union classes.intersection -classes.singleton classes.tuple tools.vocabs.browser math.parser +classes.singleton classes.tuple help.vocabs math.parser accessors ; IN: help.handbook @@ -278,11 +278,7 @@ ARTICLE: "handbook-library-reference" "Library reference" "This index only includes articles from loaded vocabularies. To explore more vocabularies, see " { $link "vocab-index" } "." { $index [ "handbook" orphan-articles remove ] } ; -ARTICLE: "handbook" "Factor documentation" -"Welcome to Factor." -$nl -"Explore the code base:" -{ $subsection "vocab-index" } +ARTICLE: "handbook" "Factor handbook" "Learn the language:" { $subsection "cookbook" } { $subsection "first-program" } @@ -290,11 +286,13 @@ $nl { $subsection "handbook-environment-reference" } { $subsection "ui" } { $subsection "handbook-library-reference" } -"The below indices only include articles from loaded vocabularies. To explore more vocabularies, see " { $link "vocab-index" } "." +"Explore loaded libraries:" { $subsection "article-index" } { $subsection "primitive-index" } { $subsection "error-index" } { $subsection "type-index" } -{ $subsection "class-index" } ; +{ $subsection "class-index" } +"Explore the code base:" +{ $subsection "vocab-index" } ; ABOUT: "handbook" diff --git a/basis/help/help-docs.factor b/basis/help/help-docs.factor index 733199fc60..547ee871aa 100644 --- a/basis/help/help-docs.factor +++ b/basis/help/help-docs.factor @@ -127,6 +127,7 @@ ARTICLE: "help" "Help system" { $subsection "browsing-help" } { $subsection "writing-help" } { $subsection "help.lint" } +{ $subsection "tips-of-the-day" } { $subsection "help-impl" } ; IN: help diff --git a/basis/help/home/authors.txt b/basis/help/home/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/help/home/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/help/home/home-docs.factor b/basis/help/home/home-docs.factor new file mode 100644 index 0000000000..d4d8a6206d --- /dev/null +++ b/basis/help/home/home-docs.factor @@ -0,0 +1,19 @@ +IN: help.home +USING: help.markup help.syntax ; + +ARTICLE: "help.home" "Factor documentation" +{ $heading "Starting points" } +{ $list + { $link "ui-listener" } + { $link "handbook" } + { $link "vocab-index" } +} +{ $heading "Recently visited" } +{ $table + { "Words" "Articles" "Vocabs" } + { { $recent recent-words } { $recent recent-articles } { $recent recent-vocabs } } +} print-element +{ $heading "Recent searches" } +{ $recent-searches } ; + +ABOUT: "help.home" \ No newline at end of file diff --git a/basis/help/home/home.factor b/basis/help/home/home.factor new file mode 100644 index 0000000000..b1b938cb45 --- /dev/null +++ b/basis/help/home/home.factor @@ -0,0 +1,40 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays compiler.units fry hashtables help.topics io +kernel math namespaces sequences sets help.vocabs +help.apropos vocabs help.markup ; +IN: help.home + +SYMBOLS: recent-words recent-articles recent-vocabs recent-searches ; + +CONSTANT: recent-count 10 + +{ recent-words recent-articles recent-vocabs recent-searches } +[ [ V{ } clone ] initialize ] each + +GENERIC: add-recent-where ( obj -- obj symbol ) + +M: link add-recent-where recent-articles ; +M: word-link add-recent-where recent-words ; +M: vocab-spec add-recent-where recent-vocabs ; +M: apropos add-recent-where recent-searches ; +M: object add-recent-where f ; + +: $recent ( element -- ) + first get [ nl ] [ 1array $pretty-link ] interleave ; + +: $recent-searches ( element -- ) + drop recent-searches get [ nl ] [ ($link) ] interleave ; + +: redisplay-recent-page ( -- ) + "help.home" >link dup associate + notify-definition-observers ; + +: expire ( seq -- ) + [ length recent-count - [ 0 > ] keep ] keep + '[ 0 _ _ delete-slice ] when ; + +: add-recent ( obj -- ) + add-recent-where dup + [ get [ adjoin ] [ expire ] bi ] [ 2drop ] if + redisplay-recent-page ; \ No newline at end of file diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index cbeb8b362e..66d864b2a0 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -3,7 +3,7 @@ USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary io.files io.files.temp io.directories html.streams help kernel assocs sequences make words accessors arrays help.topics vocabs -tools.vocabs tools.vocabs.browser namespaces prettyprint io +tools.vocabs help.vocabs namespaces prettyprint io vocabs.loader serialize fry memoize unicode.case math.order sorting debugger html xml.syntax xml.writer ; IN: help.html diff --git a/basis/help/tips/authors.txt b/basis/help/tips/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/help/tips/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/help/tips/tips-docs.factor b/basis/help/tips/tips-docs.factor new file mode 100644 index 0000000000..7148b25a37 --- /dev/null +++ b/basis/help/tips/tips-docs.factor @@ -0,0 +1,27 @@ +IN: help.tips +USING: help.markup help.syntax debugger ; + +TIP: "To look at the most recent error, run " { $link :error } ". To look at the most recent error's callstack, run " { $link :c } "." ; + +TIP: "Learn to use " { $link "dataflow-combinators" } "." ; + +TIP: "Learn to use " { $link "editor" } " to be able to jump to the source code for word definitions from the listener." ; + +TIP: "Check out " { $url "http://concatenative.org/wiki/view/Factor/FAQ" } " to get answers to frequently-asked questions." ; + +TIP: "Drop by the " { $snippet "#concatenative" } " IRC channel on " { $snippet "irc.freenode.net" } " some time." ; + +TIP: "You can write documentation for your own code using the " { $link "help" } "." ; + +TIP: "You can write graphical applications using the " { $link "ui" } "." ; + +ARTICLE: "all-tips-of-the-day" "All tips of the day" +{ $tips-of-the-day } ; + +ARTICLE: "tips-of-the-day" "Tips of the day" +"The " { $vocab-link "help.tips" } " vocabulary provides a facility for displaying tips of the day in the " { $link "ui-listener" } ". Tips are defined with a parsing word:" +{ $subsection POSTPONE: TIP: } +"All tips defined so far:" +{ $subsection "all-tips-of-the-day" } ; + +ABOUT: "tips-of-the-day" \ No newline at end of file diff --git a/basis/help/tips/tips.factor b/basis/help/tips/tips.factor new file mode 100644 index 0000000000..8d173ce533 --- /dev/null +++ b/basis/help/tips/tips.factor @@ -0,0 +1,38 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: parser arrays namespaces sequences random help.markup kernel io +io.styles colors.constants ; +IN: help.tips + +SYMBOL: tips + +tips [ V{ } clone ] initialize + +SYNTAX: TIP: parse-definition >array tips get push ; + +: a-tip ( -- tip ) tips get random ; + +SYMBOL: tip-of-the-day-style + +H{ + { page-color COLOR: lavender } + { border-width 5 } + { wrap-margin 500 } +} tip-of-the-day-style set-global + +: $tip-of-the-day ( element -- ) + drop + [ + tip-of-the-day-style get + [ + last-element off + "Tip of the day" $heading a-tip print-element nl + "— " print-element "all-tips-of-the-day" ($link) + ] + with-nesting + ] ($heading) ; + +: tip-of-the-day. ( -- ) { $tip-of-the-day } print-content nl ; + +: $tips-of-the-day ( element -- ) + drop tips get [ nl nl ] [ print-element ] interleave ; \ No newline at end of file diff --git a/basis/tools/vocabs/browser/authors.txt b/basis/help/vocabs/authors.txt similarity index 100% rename from basis/tools/vocabs/browser/authors.txt rename to basis/help/vocabs/authors.txt diff --git a/basis/tools/vocabs/browser/summary.txt b/basis/help/vocabs/summary.txt similarity index 100% rename from basis/tools/vocabs/browser/summary.txt rename to basis/help/vocabs/summary.txt diff --git a/basis/tools/vocabs/browser/tags.txt b/basis/help/vocabs/tags.txt similarity index 100% rename from basis/tools/vocabs/browser/tags.txt rename to basis/help/vocabs/tags.txt diff --git a/basis/tools/vocabs/browser/browser-docs.factor b/basis/help/vocabs/vocabs-docs.factor similarity index 94% rename from basis/tools/vocabs/browser/browser-docs.factor rename to basis/help/vocabs/vocabs-docs.factor index 723c4ac483..5f1a97205e 100644 --- a/basis/tools/vocabs/browser/browser-docs.factor +++ b/basis/help/vocabs/vocabs-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax io strings ; -IN: tools.vocabs.browser +IN: help.vocabs ARTICLE: "vocab-tags" "Vocabulary tags" { $all-tags } ; diff --git a/basis/help/vocabs/vocabs-tests.factor b/basis/help/vocabs/vocabs-tests.factor new file mode 100644 index 0000000000..f03e0b3337 --- /dev/null +++ b/basis/help/vocabs/vocabs-tests.factor @@ -0,0 +1,5 @@ +IN: help.vocabs.tests +USING: help.vocabs tools.test help.markup help vocabs ; + +[ ] [ { $vocab "scratchpad" } print-content ] unit-test +[ ] [ "classes" vocab print-topic ] unit-test \ No newline at end of file diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/help/vocabs/vocabs.factor similarity index 96% rename from basis/tools/vocabs/browser/browser.factor rename to basis/help/vocabs/vocabs.factor index c9ade7aae2..13bb0cdf3e 100644 --- a/basis/tools/vocabs/browser/browser.factor +++ b/basis/help/vocabs/vocabs.factor @@ -6,17 +6,16 @@ classes.singleton classes.tuple classes.union combinators definitions effects fry generic help help.markup help.stylesheet help.topics io io.files io.pathnames io.styles kernel macros make namespaces prettyprint sequences sets sorting summary -tools.vocabs vocabs vocabs.loader words words.symbol -combinators.smart definitions.icons ; -IN: tools.vocabs.browser +tools.vocabs vocabs vocabs.loader words words.symbol definitions.icons ; +IN: help.vocabs + +: $pretty-link ( element -- ) + [ first definition-icon 1array $image " " print-element ] + [ $definition-link ] + bi ; : <$pretty-link> ( definition -- element ) - [ - [ definition-icon 1array \ $image prefix ] - [ drop " " ] - [ 1array \ $definition-link prefix ] - tri - ] output>array ; + 1array \ $pretty-link prefix ; : vocab-row ( vocab -- row ) [ <$pretty-link> ] [ vocab-summary ] bi 2array ; diff --git a/basis/tools/apropos/apropos-tests.factor b/basis/tools/apropos/apropos-tests.factor deleted file mode 100644 index 96ce9d3186..0000000000 --- a/basis/tools/apropos/apropos-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -IN: tools.apropos.tests -USING: tools.apropos tools.test ; - -[ ] [ "swp" apropos ] unit-test diff --git a/basis/tools/vocabs/browser/browser-tests.factor b/basis/tools/vocabs/browser/browser-tests.factor deleted file mode 100644 index 385d1b2d46..0000000000 --- a/basis/tools/vocabs/browser/browser-tests.factor +++ /dev/null @@ -1,5 +0,0 @@ -IN: tools.vocabs.browser.tests -USING: tools.vocabs.browser tools.test help.markup help vocabs ; - -[ ] [ { $vocab "scratchpad" } print-content ] unit-test -[ ] [ "classes" vocab print-topic ] unit-test \ No newline at end of file diff --git a/basis/ui/gadgets/editors/editors-docs.factor b/basis/ui/gadgets/editors/editors-docs.factor index 244e36d640..0ad37cb10f 100644 --- a/basis/ui/gadgets/editors/editors-docs.factor +++ b/basis/ui/gadgets/editors/editors-docs.factor @@ -1,6 +1,6 @@ USING: documents help.markup help.syntax ui.gadgets ui.gadgets.scrollers models strings ui.commands -ui.text colors fonts ; +ui.text colors fonts help.tips ; IN: ui.gadgets.editors HELP: editor @@ -109,4 +109,8 @@ ARTICLE: "ui.gadgets.editors" "Editor gadgets" "Editors edit " { $emphasis "documents" } ":" { $subsection "documents" } ; +TIP: "Editor gadgets support undo and redo; press " { $command editor "editing" com-undo } " and " { $command editor "editing" com-redo } "." ; + +TIP: "Learn the keyboard shortcuts used in " { $link "ui.gadgets.editors" } "." ; + ABOUT: "ui.gadgets.editors" diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 078ece6546..e1dcba9910 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: debugger help help.topics help.crossref kernel models compiler.units -assocs words vocabs accessors fry combinators.short-circuit -sequences models models.history tools.apropos combinators -ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers -ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs +USING: debugger help help.topics help.crossref help.home kernel +models compiler.units assocs words vocabs accessors fry +combinators.short-circuit namespaces sequences models +models.history help.apropos combinators ui.commands ui.gadgets +ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks +ui.gestures ui.gadgets.buttons ui.gadgets.packs ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar ui.gadgets.glass ui.gadgets.borders ui.tools.common ui.tools.browser.popups ui ; @@ -15,8 +16,8 @@ TUPLE: browser-gadget < tool pane scroller search-field popup ; { 650 400 } browser-gadget set-tool-dim : show-help ( link browser-gadget -- ) - model>> dup add-history - [ >link ] dip set-model ; + [ >link ] [ model>> ] bi* + [ [ add-recent ] [ add-history ] bi* ] [ set-model ] 2bi ; : ( browser-gadget -- gadget ) model>> [ '[ _ print-topic ] try ] ; @@ -96,7 +97,7 @@ M: browser-gadget focusable-child* search-field>> ; : com-forward ( browser -- ) model>> go-forward ; -: com-documentation ( browser -- ) "handbook" swap show-help ; +: com-documentation ( browser -- ) "help.home" swap show-help ; : browser-help ( -- ) "ui-browser" com-browse ; @@ -113,7 +114,7 @@ browser-gadget "toolbar" f { over [ show-help ] [ 2drop ] if ; : navigate ( browser quot -- ) - '[ control-value @ ] keep ?show-help ; + '[ control-value @ ] keep ?show-help ; inline : com-up ( browser -- ) [ article-parent ] navigate ; diff --git a/basis/ui/tools/deploy/deploy-docs.factor b/basis/ui/tools/deploy/deploy-docs.factor index e625d26c60..b0a2fb6cf9 100644 --- a/basis/ui/tools/deploy/deploy-docs.factor +++ b/basis/ui/tools/deploy/deploy-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax ; +USING: help.markup help.syntax help.tips ; IN: ui.tools.deploy HELP: deploy-tool @@ -14,4 +14,6 @@ $nl "Alternatively, right-click on a vocabulary presentation in the UI and choose " { $strong "Deploy tool" } " from the resulting popup menu." { $see-also "tools.deploy" } ; +TIP: "Generate stand-alone applications from vocabularies with the " { $link "ui.tools.deploy" } "." ; + ABOUT: "ui.tools.deploy" diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index 0f357cb0af..022a2daabf 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -3,7 +3,7 @@ USING: accessors arrays assocs calendar colors colors.constants documents documents.elements fry kernel words sets splitting math math.vectors models.delay models.arrow combinators.short-circuit -parser present sequences tools.completion tools.vocabs.browser generic +parser present sequences tools.completion help.vocabs generic generic.standard.engines.tuple fonts definitions.icons ui.images ui.commands ui.operations ui.gadgets ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables diff --git a/basis/ui/tools/listener/listener-docs.factor b/basis/ui/tools/listener/listener-docs.factor index caff45e40e..afe890b9c5 100644 --- a/basis/ui/tools/listener/listener-docs.factor +++ b/basis/ui/tools/listener/listener-docs.factor @@ -1,5 +1,7 @@ USING: help.markup help.syntax ui.commands ui.operations -ui.gadgets.editors ui.gadgets.panes listener io words ; +ui.gadgets.editors ui.gadgets.panes listener io words +ui.tools.listener.completion ui.tools.common help.tips +tools.vocabs vocabs ; IN: ui.tools.listener HELP: interactor @@ -21,11 +23,27 @@ ARTICLE: "ui-listener" "UI listener" { $operations \ word } { $heading "Vocabulary commands" } "These words operate on the vocabulary at the cursor." -{ $operations \ word } +{ $operations T{ vocab-link f "kernel" } } { $command-map interactor "quotation" } { $heading "Editing commands" } "The text editing commands are standard; see " { $link "gadgets-editors-commands" } "." { $heading "Implementation" } "Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } ") and an input area (instance of " { $link interactor } "). Clickable presentations can also be printed to the listener; see " { $link "ui-presentations" } "." ; +TIP: "You can read documentation by pressing F1." ; + +TIP: "The listener tool remembers previous lines of input. Press " { $command interactor "completion" recall-previous } " and " { $command interactor "completion" recall-next } " to cycle through them." ; + +TIP: "When you mouse over certain objects, a block border will appear. Left-clicking on such an object will perform the default operation. Right-clicking will show a menu with all operations." ; + +TIP: "The status bar displays stack effects of recognized words as they are being typed in." ; + +TIP: "Press " { $command interactor "completion" code-completion-popup } " to complete word, vocabulary and Unicode character names. The latter two features become available if the cursor is after a " { $link POSTPONE: USE: } ", " { $link POSTPONE: USING: } " or " { $link POSTPONE: CHAR: } "." ; + +TIP: "If a word's vocabulary is loaded, but not in the search path, you can use restarts to add the vocabulary to the search path. Auto-use mode (" { $command listener-gadget "toolbar" com-auto-use } ") invokes restarts automatically if there is only one restart." ; + +TIP: "Scroll the listener from the keyboard by pressing " { $command listener-gadget "scrolling" com-page-up } " and " { $command listener-gadget "scrolling" com-page-down } "." ; + +TIP: "Press " { $command tool "common" refresh-all } " or run " { $link refresh-all } " to reload changed source files from disk. " ; + ABOUT: "ui-listener" \ No newline at end of file diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 5efcd01eec..91448dfe10 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -2,12 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs calendar combinators locals colors.constants combinators.short-circuit compiler.units -concurrency.flags concurrency.mailboxes continuations destructors -documents documents.elements fry hashtables help help.markup io -io.styles kernel lexer listener math models models.delay models.arrow -namespaces parser prettyprint quotations sequences strings threads -tools.vocabs vocabs vocabs.loader vocabs.parser words debugger ui ui.commands -ui.pens.solid ui.gadgets ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors +help.tips concurrency.flags concurrency.mailboxes continuations +destructors documents documents.elements fry hashtables help +help.markup io io.styles kernel lexer listener math models +models.delay models.arrow namespaces parser prettyprint quotations +sequences strings threads tools.vocabs vocabs vocabs.loader +vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets +ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations ui.tools.browser ui.tools.common ui.tools.debugger @@ -354,16 +355,11 @@ interactor "completion" f { { T{ key-down f { C+ } "r" } history-completion-popup } } define-command-map -: welcome. ( -- ) - "If this is your first time with Factor, please read the " print - "handbook" ($link) ". To see a list of keyboard shortcuts," print - "press F1." print nl ; - : listener-thread ( listener -- ) dup listener-streams [ [ com-browse ] help-hook set '[ [ _ input>> ] 2dip debugger-popup ] error-hook set - welcome. + tip-of-the-day. nl listener ] with-streams* ; @@ -385,7 +381,7 @@ interactor "completion" f { [ wait-for-listener ] } cleave ; -: listener-help ( -- ) "ui-listener" com-browse ; +: listener-help ( -- ) "help.home" com-browse ; \ listener-help H{ { +nullary+ t } } define-command diff --git a/basis/ui/tools/operations/operations-docs.factor b/basis/ui/tools/operations/operations-docs.factor new file mode 100644 index 0000000000..455e4f5ccc --- /dev/null +++ b/basis/ui/tools/operations/operations-docs.factor @@ -0,0 +1,8 @@ +USING: help.tips help.markup help.syntax ui.operations +tools.walker tools.time tools.profiler ui.tools.operations ; + +TIP: "Press " { $operation com-stack-effect } " to print the stack effect of the code in the input field without executing it (" { $link "inference" } ")." ; + +TIP: "Press " { $operation walk } " to single-step through the code in the input field (" { $link "ui-walker" } ")." ; + +TIP: "Press " { $operation time } " to time execution of the code in the input field (" { $link "timing" } ")." ; diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor index 6d6cda1dba..28781e24bb 100644 --- a/basis/ui/tools/operations/operations.factor +++ b/basis/ui/tools/operations/operations.factor @@ -9,7 +9,7 @@ compiler.units accessors vocabs.parser macros.expander ui ui.tools.browser ui.tools.listener ui.tools.listener.completion ui.tools.profiler ui.tools.inspector ui.tools.traceback ui.commands ui.gadgets.editors ui.gestures ui.operations -ui.tools.deploy models ; +ui.tools.deploy models help.tips ; IN: ui.tools.operations ! Objects @@ -157,8 +157,6 @@ M: word com-stack-effect 1quotation com-stack-effect ; { +listener+ t } } define-operation -: com-profile ( quot -- ) profile profiler-window ; - [ quotation? ] \ com-profile H{ { +keyboard+ T{ key-down f { C+ } "o" } } { +listener+ t } diff --git a/basis/ui/tools/profiler/profiler-docs.factor b/basis/ui/tools/profiler/profiler-docs.factor new file mode 100644 index 0000000000..a54a29c6a1 --- /dev/null +++ b/basis/ui/tools/profiler/profiler-docs.factor @@ -0,0 +1,11 @@ +IN: ui.tools.profiler +USING: help.markup help.syntax ui.operations help.tips ; + +ARTICLE: "ui.tools.profiler" "UI profiler tool" +"The " { $vocab-link "ui.tools.profiler" } " vocabulary implements a graphical tool for viewing profiling results (see " { $link "tools.profiler" } ")." +$nl +"To use the profiler, enter a piece of code in the listener's input area and press " { $operation com-profile } "." ; + +TIP: "Press " { $operation com-profile } " to run the code in the input field with profiling enabled (" { $link "ui.tools.profiler" } ")." ; + +ABOUT: "ui.tools.profiler" \ No newline at end of file diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor index bbd9237c87..6bca4b40c4 100644 --- a/basis/ui/tools/profiler/profiler.factor +++ b/basis/ui/tools/profiler/profiler.factor @@ -208,4 +208,6 @@ profiler-gadget "toolbar" f { : profiler-window ( -- ) "Profiling results" open-status-window ; +: com-profile ( quot -- ) profile profiler-window ; + MAIN: profiler-window \ No newline at end of file diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor index d3078cc178..c591775429 100644 --- a/basis/ui/tools/tools-docs.factor +++ b/basis/ui/tools/tools-docs.factor @@ -1,7 +1,8 @@ USING: editors help.markup help.syntax summary inspector io io.styles listener parser prettyprint tools.profiler tools.walker ui.commands ui.gadgets.panes ui.gadgets.presentations ui.operations -ui.tools.operations ui.tools.profiler ui.tools.common vocabs see ; +ui.tools.operations ui.tools.profiler ui.tools.common vocabs see +help.tips ; IN: ui.tools ARTICLE: "starting-ui-tools" "Starting the UI tools" @@ -67,4 +68,6 @@ $nl "Platform-specific features:" { $subsection "ui-cocoa" } ; +TIP: "All UI developer tools support a common set of " { $link "ui-shortcuts" } ". Each individual tool has its own shortcuts as well; the F1 key is context-sensitive." ; + ABOUT: "ui-tools" diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 871f7c5321..b71f6ed3be 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -166,6 +166,7 @@ SYMBOL: interactive-vocabs "definitions" "editors" "help" + "help.apropos" "help.lint" "inspector" "io" @@ -186,7 +187,6 @@ SYMBOL: interactive-vocabs "strings" "syntax" "tools.annotations" - "tools.apropos" "tools.crossref" "tools.disassembler" "tools.memory" diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor index 2aa8ef421c..22e8bfcb62 100644 --- a/core/strings/strings-docs.factor +++ b/core/strings/strings-docs.factor @@ -1,6 +1,6 @@ USING: arrays byte-arrays help.markup help.syntax kernel kernel.private strings.private sequences vectors -sbufs math tools.vocabs.browser ; +sbufs math help.vocabs ; IN: strings ARTICLE: "strings" "Strings" diff --git a/extra/demos/demos.factor b/extra/demos/demos.factor index fd7aafb601..8c55945105 100644 --- a/extra/demos/demos.factor +++ b/extra/demos/demos.factor @@ -1,6 +1,6 @@ USING: kernel fry sequences - vocabs.loader tools.vocabs.browser + vocabs.loader help.vocabs ui ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.scrollers ui.tools.listener accessors ; diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index 6368e542a7..30d6845a9b 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -3,7 +3,7 @@ USING: accessors arrays assocs combinators help help.crossref help.markup help.topics io io.streams.string kernel make namespaces -parser prettyprint sequences summary tools.vocabs tools.vocabs.browser +parser prettyprint sequences summary tools.vocabs help.vocabs vocabs vocabs.loader words see ; IN: fuel.help diff --git a/extra/galois-talk/galois-talk.factor b/extra/galois-talk/galois-talk.factor index ccba90fb6f..be713542ed 100644 --- a/extra/galois-talk/galois-talk.factor +++ b/extra/galois-talk/galois-talk.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: slides help.markup math arrays hashtables namespaces sequences kernel sequences parser memoize io.encodings.binary -locals kernel.private tools.vocabs.browser assocs quotations +locals kernel.private help.vocabs assocs quotations urls peg.ebnf tools.vocabs tools.annotations tools.crossref help.topics math.functions compiler.tree.optimizer compiler.cfg.optimizer fry ; diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor index 4d4e3b0507..ab8e72fc76 100644 --- a/extra/google-tech-talk/google-tech-talk.factor +++ b/extra/google-tech-talk/google-tech-talk.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: slides help.markup math arrays hashtables namespaces sequences kernel sequences parser memoize io.encodings.binary -locals kernel.private tools.vocabs.browser assocs quotations +locals kernel.private help.vocabs assocs quotations urls peg.ebnf tools.vocabs tools.annotations tools.crossref help.topics math.functions compiler.tree.optimizer compiler.cfg.optimizer fry ; diff --git a/extra/otug-talk/otug-talk.factor b/extra/otug-talk/otug-talk.factor index 2ce307ce20..b7256246fe 100644 --- a/extra/otug-talk/otug-talk.factor +++ b/extra/otug-talk/otug-talk.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: slides help.markup math arrays hashtables namespaces sequences kernel sequences parser memoize io.encodings.binary locals -kernel.private tools.vocabs.browser assocs quotations tools.vocabs +kernel.private help.vocabs assocs quotations tools.vocabs tools.annotations tools.crossref help.topics math.functions compiler.tree.optimizer compiler.cfg.optimizer fry ui.gadgets.panes tetris tetris.game combinators generalizations multiline diff --git a/extra/vpri-talk/vpri-talk.factor b/extra/vpri-talk/vpri-talk.factor index 5d7620101f..1e5c9602b9 100644 --- a/extra/vpri-talk/vpri-talk.factor +++ b/extra/vpri-talk/vpri-talk.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: slides help.markup math arrays hashtables namespaces sequences kernel sequences parser memoize io.encodings.binary -locals kernel.private tools.vocabs.browser assocs quotations +locals kernel.private help.vocabs assocs quotations urls peg.ebnf tools.vocabs tools.annotations tools.crossref help.topics math.functions compiler.tree.optimizer compiler.cfg.optimizer fry ; From 577522fe0f4e71a708dce3d9d71f793f9ad3940e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 24 Mar 2009 08:56:59 -0500 Subject: [PATCH 43/43] Fix ui.tools.profiler help lint --- basis/ui/tools/profiler/profiler-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/tools/profiler/profiler-docs.factor b/basis/ui/tools/profiler/profiler-docs.factor index a54a29c6a1..e2a0ef5f4e 100644 --- a/basis/ui/tools/profiler/profiler-docs.factor +++ b/basis/ui/tools/profiler/profiler-docs.factor @@ -2,7 +2,7 @@ IN: ui.tools.profiler USING: help.markup help.syntax ui.operations help.tips ; ARTICLE: "ui.tools.profiler" "UI profiler tool" -"The " { $vocab-link "ui.tools.profiler" } " vocabulary implements a graphical tool for viewing profiling results (see " { $link "tools.profiler" } ")." +"The " { $vocab-link "ui.tools.profiler" } " vocabulary implements a graphical tool for viewing profiling results (see " { $link "profiling" } ")." $nl "To use the profiler, enter a piece of code in the listener's input area and press " { $operation com-profile } "." ;