From 7898a9252d7ade2dda2248273c101f512911afd0 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sat, 15 Nov 2008 15:43:21 -0500 Subject: [PATCH 001/102] Cleanup PE solutions and formatting --- extra/project-euler/203/203-tests.factor | 4 +- extra/project-euler/203/203.factor | 67 +++++++++++++++++++++--- extra/project-euler/215/215.factor | 2 +- extra/project-euler/project-euler.factor | 2 +- 4 files changed, 65 insertions(+), 10 deletions(-) diff --git a/extra/project-euler/203/203-tests.factor b/extra/project-euler/203/203-tests.factor index 6c49c2f958..4922f9a8cc 100644 --- a/extra/project-euler/203/203-tests.factor +++ b/extra/project-euler/203/203-tests.factor @@ -1,5 +1,5 @@ -USING: project-euler.203 tools.test ; +USING: project-euler.203 project-euler.203.private tools.test ; IN: project-euler.203.tests [ 105 ] [ 8 solve ] unit-test -[ 34029210557338 ] [ 51 solve ] unit-test +[ 34029210557338 ] [ euler203 ] unit-test diff --git a/extra/project-euler/203/203.factor b/extra/project-euler/203/203.factor index 9a2916649e..f2b5a2e212 100644 --- a/extra/project-euler/203/203.factor +++ b/extra/project-euler/203/203.factor @@ -1,9 +1,64 @@ +! Copyright (c) 2008 Eric Mertens. +! See http://factorcode.org/license.txt for BSD license. USING: fry kernel math math.primes.factors sequences sets ; IN: project-euler.203 -: iterate ( n initial quot -- results ) swapd '[ @ dup ] replicate nip ; inline -: (generate) ( seq -- seq ) [ 0 prefix ] [ 0 suffix ] bi [ + ] 2map ; -: generate ( n -- seq ) 1- { 1 } [ (generate) ] iterate concat prune ; -: squarefree ( n -- ? ) factors duplicates empty? ; -: solve ( n -- n ) generate [ squarefree ] filter sum ; -: euler203 ( -- n ) 51 solve ; +! http://projecteuler.net/index.php?section=problems&id=203 + +! DESCRIPTION +! ----------- + +! The binomial coefficients nCk can be arranged in triangular form, Pascal's +! triangle, like this: + +! 1 +! 1 1 +! 1 2 1 +! 1 3 3 1 +! 1 4 6 4 1 +! 1 5 10 10 5 1 +! 1 6 15 20 15 6 1 +! 1 7 21 35 35 21 7 1 +! ......... + +! It can be seen that the first eight rows of Pascal's triangle contain twelve +! distinct numbers: 1, 2, 3, 4, 5, 6, 7, 10, 15, 20, 21 and 35. + +! A positive integer n is called squarefree if no square of a prime divides n. +! Of the twelve distinct numbers in the first eight rows of Pascal's triangle, +! all except 4 and 20 are squarefree. The sum of the distinct squarefree numbers +! in the first eight rows is 105. + +! Find the sum of the distinct squarefree numbers in the first 51 rows of +! Pascal's triangle. + + +! SOLUTION +! -------- + + + +: euler203 ( -- n ) + 51 solve ; + +! [ euler203 ] 100 ave-time +! 12 ms ave run time - 1.6 SD (100 trials) + +MAIN: euler203 diff --git a/extra/project-euler/215/215.factor b/extra/project-euler/215/215.factor index fc09b37515..82d6a31c66 100644 --- a/extra/project-euler/215/215.factor +++ b/extra/project-euler/215/215.factor @@ -9,7 +9,7 @@ IN: project-euler.215 ! ----------- ! Consider the problem of building a wall out of 2x1 and 3x1 bricks -! (horizontalvertical dimensions) such that, for extra strength, the gaps +! (horizontal x vertical dimensions) such that, for extra strength, the gaps ! between horizontally-adjacent bricks never line up in consecutive layers, ! i.e. never form a "running crack". diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 9549505bf6..60d35f27ad 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -20,7 +20,7 @@ USING: definitions io io.files kernel math math.parser project-euler.097 project-euler.100 project-euler.116 project-euler.117 project-euler.134 project-euler.148 project-euler.150 project-euler.151 project-euler.164 project-euler.169 project-euler.173 project-euler.175 - project-euler.186 project-euler.190 project-euler.215 ; + project-euler.186 project-euler.190 project-euler.203 project-euler.215 ; IN: project-euler Date: Sat, 15 Nov 2008 17:26:00 -0500 Subject: [PATCH 002/102] Solution to Project Euler problem 99 --- extra/project-euler/099/099-tests.factor | 5 + extra/project-euler/099/099.factor | 52 ++ extra/project-euler/099/base_exp.txt | 1000 ++++++++++++++++++++++ 3 files changed, 1057 insertions(+) create mode 100644 extra/project-euler/099/099-tests.factor create mode 100644 extra/project-euler/099/099.factor create mode 100644 extra/project-euler/099/base_exp.txt diff --git a/extra/project-euler/099/099-tests.factor b/extra/project-euler/099/099-tests.factor new file mode 100644 index 0000000000..d3d46d98b4 --- /dev/null +++ b/extra/project-euler/099/099-tests.factor @@ -0,0 +1,5 @@ +USING: project-euler.099 project-euler.099.private tools.test ; +IN: project-euler.099.tests + +[ 2 ] [ { { 2 11 } { 3 7 } } solve ] unit-test +[ 709 ] [ euler099 ] unit-test diff --git a/extra/project-euler/099/099.factor b/extra/project-euler/099/099.factor new file mode 100644 index 0000000000..ebc830cf00 --- /dev/null +++ b/extra/project-euler/099/099.factor @@ -0,0 +1,52 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: io.encodings.ascii io.files kernel math math.functions math.parser + math.vectors sequences splitting ; +IN: project-euler.099 + +! http://projecteuler.net/index.php?section=problems&id=99 + +! DESCRIPTION +! ----------- + +! Comparing two numbers written in index form like 2^11 and 3^7 is not difficult, +! as any calculator would confirm that 2^11 = 2048 < 3^7 = 2187. + +! However, confirming that 632382^518061 519432^525806 would be much more +! difficult, as both numbers contain over three million digits. + +! Using base_exp.txt (right click and 'Save Link/Target As...'), a 22K text +! file containing one thousand lines with a base/exponent pair on each line, +! determine which line number has the greatest numerical value. + +! NOTE: The first two lines in the file represent the numbers in the example +! given above. + + +! SOLUTION +! -------- + +! Use logarithms to make the calculations necessary more manageable. + +number ] map ] map ; + +: simplify ( seq -- seq ) + #! exponent * log(base) + flip first2 swap [ log ] map v* ; + +: solve ( seq -- index ) + simplify [ supremum ] keep index 1+ ; + +PRIVATE> + +: euler099 ( -- answer ) + source-099 solve ; + +! [ euler099 ] 100 ave-time +! 16 ms ave run timen - 1.67 SD (100 trials) + +MAIN: euler099 diff --git a/extra/project-euler/099/base_exp.txt b/extra/project-euler/099/base_exp.txt new file mode 100644 index 0000000000..92201db6f5 --- /dev/null +++ b/extra/project-euler/099/base_exp.txt @@ -0,0 +1,1000 @@ +519432,525806 +632382,518061 +78864,613712 +466580,530130 +780495,510032 +525895,525320 +15991,714883 +960290,502358 +760018,511029 +166800,575487 +210884,564478 +555151,523163 +681146,515199 +563395,522587 +738250,512126 +923525,503780 +595148,520429 +177108,572629 +750923,511482 +440902,532446 +881418,505504 +422489,534197 +979858,501616 +685893,514935 +747477,511661 +167214,575367 +234140,559696 +940238,503122 +728969,512609 +232083,560102 +900971,504694 +688801,514772 +189664,569402 +891022,505104 +445689,531996 +119570,591871 +821453,508118 +371084,539600 +911745,504251 +623655,518600 +144361,582486 +352442,541775 +420726,534367 +295298,549387 +6530,787777 +468397,529976 +672336,515696 +431861,533289 +84228,610150 +805376,508857 +444409,532117 +33833,663511 +381850,538396 +402931,536157 +92901,604930 +304825,548004 +731917,512452 +753734,511344 +51894,637373 +151578,580103 +295075,549421 +303590,548183 +333594,544123 +683952,515042 +60090,628880 +951420,502692 +28335,674991 +714940,513349 +343858,542826 +549279,523586 +804571,508887 +260653,554881 +291399,549966 +402342,536213 +408889,535550 +40328,652524 +375856,539061 +768907,510590 +165993,575715 +976327,501755 +898500,504795 +360404,540830 +478714,529095 +694144,514472 +488726,528258 +841380,507226 +328012,544839 +22389,690868 +604053,519852 +329514,544641 +772965,510390 +492798,527927 +30125,670983 +895603,504906 +450785,531539 +840237,507276 +380711,538522 +63577,625673 +76801,615157 +502694,527123 +597706,520257 +310484,547206 +944468,502959 +121283,591152 +451131,531507 +566499,522367 +425373,533918 +40240,652665 +39130,654392 +714926,513355 +469219,529903 +806929,508783 +287970,550487 +92189,605332 +103841,599094 +671839,515725 +452048,531421 +987837,501323 +935192,503321 +88585,607450 +613883,519216 +144551,582413 +647359,517155 +213902,563816 +184120,570789 +258126,555322 +502546,527130 +407655,535678 +401528,536306 +477490,529193 +841085,507237 +732831,512408 +833000,507595 +904694,504542 +581435,521348 +455545,531110 +873558,505829 +94916,603796 +720176,513068 +545034,523891 +246348,557409 +556452,523079 +832015,507634 +173663,573564 +502634,527125 +250732,556611 +569786,522139 +216919,563178 +521815,525623 +92304,605270 +164446,576167 +753413,511364 +11410,740712 +448845,531712 +925072,503725 +564888,522477 +7062,780812 +641155,517535 +738878,512100 +636204,517828 +372540,539436 +443162,532237 +571192,522042 +655350,516680 +299741,548735 +581914,521307 +965471,502156 +513441,526277 +808682,508700 +237589,559034 +543300,524025 +804712,508889 +247511,557192 +543486,524008 +504383,526992 +326529,545039 +792493,509458 +86033,609017 +126554,589005 +579379,521481 +948026,502823 +404777,535969 +265767,554022 +266876,553840 +46631,643714 +492397,527958 +856106,506581 +795757,509305 +748946,511584 +294694,549480 +409781,535463 +775887,510253 +543747,523991 +210592,564536 +517119,525990 +520253,525751 +247926,557124 +592141,520626 +346580,542492 +544969,523902 +506501,526817 +244520,557738 +144745,582349 +69274,620858 +292620,549784 +926027,503687 +736320,512225 +515528,526113 +407549,535688 +848089,506927 +24141,685711 +9224,757964 +980684,501586 +175259,573121 +489160,528216 +878970,505604 +969546,502002 +525207,525365 +690461,514675 +156510,578551 +659778,516426 +468739,529945 +765252,510770 +76703,615230 +165151,575959 +29779,671736 +928865,503569 +577538,521605 +927555,503618 +185377,570477 +974756,501809 +800130,509093 +217016,563153 +365709,540216 +774508,510320 +588716,520851 +631673,518104 +954076,502590 +777828,510161 +990659,501222 +597799,520254 +786905,509727 +512547,526348 +756449,511212 +869787,505988 +653747,516779 +84623,609900 +839698,507295 +30159,670909 +797275,509234 +678136,515373 +897144,504851 +989554,501263 +413292,535106 +55297,633667 +788650,509637 +486748,528417 +150724,580377 +56434,632490 +77207,614869 +588631,520859 +611619,519367 +100006,601055 +528924,525093 +190225,569257 +851155,506789 +682593,515114 +613043,519275 +514673,526183 +877634,505655 +878905,505602 +1926,914951 +613245,519259 +152481,579816 +841774,507203 +71060,619442 +865335,506175 +90244,606469 +302156,548388 +399059,536557 +478465,529113 +558601,522925 +69132,620966 +267663,553700 +988276,501310 +378354,538787 +529909,525014 +161733,576968 +758541,511109 +823425,508024 +149821,580667 +269258,553438 +481152,528891 +120871,591322 +972322,501901 +981350,501567 +676129,515483 +950860,502717 +119000,592114 +392252,537272 +191618,568919 +946699,502874 +289555,550247 +799322,509139 +703886,513942 +194812,568143 +261823,554685 +203052,566221 +217330,563093 +734748,512313 +391759,537328 +807052,508777 +564467,522510 +59186,629748 +113447,594545 +518063,525916 +905944,504492 +613922,519213 +439093,532607 +445946,531981 +230530,560399 +297887,549007 +459029,530797 +403692,536075 +855118,506616 +963127,502245 +841711,507208 +407411,535699 +924729,503735 +914823,504132 +333725,544101 +176345,572832 +912507,504225 +411273,535308 +259774,555036 +632853,518038 +119723,591801 +163902,576321 +22691,689944 +402427,536212 +175769,572988 +837260,507402 +603432,519893 +313679,546767 +538165,524394 +549026,523608 +61083,627945 +898345,504798 +992556,501153 +369999,539727 +32847,665404 +891292,505088 +152715,579732 +824104,507997 +234057,559711 +730507,512532 +960529,502340 +388395,537687 +958170,502437 +57105,631806 +186025,570311 +993043,501133 +576770,521664 +215319,563513 +927342,503628 +521353,525666 +39563,653705 +752516,511408 +110755,595770 +309749,547305 +374379,539224 +919184,503952 +990652,501226 +647780,517135 +187177,570017 +168938,574877 +649558,517023 +278126,552016 +162039,576868 +658512,516499 +498115,527486 +896583,504868 +561170,522740 +747772,511647 +775093,510294 +652081,516882 +724905,512824 +499707,527365 +47388,642755 +646668,517204 +571700,522007 +180430,571747 +710015,513617 +435522,532941 +98137,602041 +759176,511070 +486124,528467 +526942,525236 +878921,505604 +408313,535602 +926980,503640 +882353,505459 +566887,522345 +3326,853312 +911981,504248 +416309,534800 +392991,537199 +622829,518651 +148647,581055 +496483,527624 +666314,516044 +48562,641293 +672618,515684 +443676,532187 +274065,552661 +265386,554079 +347668,542358 +31816,667448 +181575,571446 +961289,502320 +365689,540214 +987950,501317 +932299,503440 +27388,677243 +746701,511701 +492258,527969 +147823,581323 +57918,630985 +838849,507333 +678038,515375 +27852,676130 +850241,506828 +818403,508253 +131717,587014 +850216,506834 +904848,504529 +189758,569380 +392845,537217 +470876,529761 +925353,503711 +285431,550877 +454098,531234 +823910,508003 +318493,546112 +766067,510730 +261277,554775 +421530,534289 +694130,514478 +120439,591498 +213308,563949 +854063,506662 +365255,540263 +165437,575872 +662240,516281 +289970,550181 +847977,506933 +546083,523816 +413252,535113 +975829,501767 +361540,540701 +235522,559435 +224643,561577 +736350,512229 +328303,544808 +35022,661330 +307838,547578 +474366,529458 +873755,505819 +73978,617220 +827387,507845 +670830,515791 +326511,545034 +309909,547285 +400970,536363 +884827,505352 +718307,513175 +28462,674699 +599384,520150 +253565,556111 +284009,551093 +343403,542876 +446557,531921 +992372,501160 +961601,502308 +696629,514342 +919537,503945 +894709,504944 +892201,505051 +358160,541097 +448503,531745 +832156,507636 +920045,503924 +926137,503675 +416754,534757 +254422,555966 +92498,605151 +826833,507873 +660716,516371 +689335,514746 +160045,577467 +814642,508425 +969939,501993 +242856,558047 +76302,615517 +472083,529653 +587101,520964 +99066,601543 +498005,527503 +709800,513624 +708000,513716 +20171,698134 +285020,550936 +266564,553891 +981563,501557 +846502,506991 +334,1190800 +209268,564829 +9844,752610 +996519,501007 +410059,535426 +432931,533188 +848012,506929 +966803,502110 +983434,501486 +160700,577267 +504374,526989 +832061,507640 +392825,537214 +443842,532165 +440352,532492 +745125,511776 +13718,726392 +661753,516312 +70500,619875 +436952,532814 +424724,533973 +21954,692224 +262490,554567 +716622,513264 +907584,504425 +60086,628882 +837123,507412 +971345,501940 +947162,502855 +139920,584021 +68330,621624 +666452,516038 +731446,512481 +953350,502619 +183157,571042 +845400,507045 +651548,516910 +20399,697344 +861779,506331 +629771,518229 +801706,509026 +189207,569512 +737501,512168 +719272,513115 +479285,529045 +136046,585401 +896746,504860 +891735,505067 +684771,514999 +865309,506184 +379066,538702 +503117,527090 +621780,518717 +209518,564775 +677135,515423 +987500,501340 +197049,567613 +329315,544673 +236756,559196 +357092,541226 +520440,525733 +213471,563911 +956852,502490 +702223,514032 +404943,535955 +178880,572152 +689477,514734 +691351,514630 +866669,506128 +370561,539656 +739805,512051 +71060,619441 +624861,518534 +261660,554714 +366137,540160 +166054,575698 +601878,519990 +153445,579501 +279899,551729 +379166,538691 +423209,534125 +675310,515526 +145641,582050 +691353,514627 +917468,504026 +284778,550976 +81040,612235 +161699,576978 +616394,519057 +767490,510661 +156896,578431 +427408,533714 +254849,555884 +737217,512182 +897133,504851 +203815,566051 +270822,553189 +135854,585475 +778805,510111 +784373,509847 +305426,547921 +733418,512375 +732087,512448 +540668,524215 +702898,513996 +628057,518328 +640280,517587 +422405,534204 +10604,746569 +746038,511733 +839808,507293 +457417,530938 +479030,529064 +341758,543090 +620223,518824 +251661,556451 +561790,522696 +497733,527521 +724201,512863 +489217,528217 +415623,534867 +624610,518548 +847541,506953 +432295,533249 +400391,536421 +961158,502319 +139173,584284 +421225,534315 +579083,521501 +74274,617000 +701142,514087 +374465,539219 +217814,562985 +358972,540995 +88629,607424 +288597,550389 +285819,550812 +538400,524385 +809930,508645 +738326,512126 +955461,502535 +163829,576343 +826475,507891 +376488,538987 +102234,599905 +114650,594002 +52815,636341 +434037,533082 +804744,508880 +98385,601905 +856620,506559 +220057,562517 +844734,507078 +150677,580387 +558697,522917 +621751,518719 +207067,565321 +135297,585677 +932968,503404 +604456,519822 +579728,521462 +244138,557813 +706487,513800 +711627,513523 +853833,506674 +497220,527562 +59428,629511 +564845,522486 +623621,518603 +242689,558077 +125091,589591 +363819,540432 +686453,514901 +656813,516594 +489901,528155 +386380,537905 +542819,524052 +243987,557841 +693412,514514 +488484,528271 +896331,504881 +336730,543721 +728298,512647 +604215,519840 +153729,579413 +595687,520398 +540360,524240 +245779,557511 +924873,503730 +509628,526577 +528523,525122 +3509,847707 +522756,525555 +895447,504922 +44840,646067 +45860,644715 +463487,530404 +398164,536654 +894483,504959 +619415,518874 +966306,502129 +990922,501212 +835756,507474 +548881,523618 +453578,531282 +474993,529410 +80085,612879 +737091,512193 +50789,638638 +979768,501620 +792018,509483 +665001,516122 +86552,608694 +462772,530469 +589233,520821 +891694,505072 +592605,520594 +209645,564741 +42531,649269 +554376,523226 +803814,508929 +334157,544042 +175836,572970 +868379,506051 +658166,516520 +278203,551995 +966198,502126 +627162,518387 +296774,549165 +311803,547027 +843797,507118 +702304,514032 +563875,522553 +33103,664910 +191932,568841 +543514,524006 +506835,526794 +868368,506052 +847025,506971 +678623,515342 +876139,505726 +571997,521984 +598632,520198 +213590,563892 +625404,518497 +726508,512738 +689426,514738 +332495,544264 +411366,535302 +242546,558110 +315209,546555 +797544,509219 +93889,604371 +858879,506454 +124906,589666 +449072,531693 +235960,559345 +642403,517454 +720567,513047 +705534,513858 +603692,519870 +488137,528302 +157370,578285 +63515,625730 +666326,516041 +619226,518883 +443613,532186 +597717,520257 +96225,603069 +86940,608450 +40725,651929 +460976,530625 +268875,553508 +270671,553214 +363254,540500 +384248,538137 +762889,510892 +377941,538833 +278878,551890 +176615,572755 +860008,506412 +944392,502967 +608395,519571 +225283,561450 +45095,645728 +333798,544090 +625733,518476 +995584,501037 +506135,526853 +238050,558952 +557943,522972 +530978,524938 +634244,517949 +177168,572616 +85200,609541 +953043,502630 +523661,525484 +999295,500902 +840803,507246 +961490,502312 +471747,529685 +380705,538523 +911180,504275 +334149,544046 +478992,529065 +325789,545133 +335884,543826 +426976,533760 +749007,511582 +667067,516000 +607586,519623 +674054,515599 +188534,569675 +565185,522464 +172090,573988 +87592,608052 +907432,504424 +8912,760841 +928318,503590 +757917,511138 +718693,513153 +315141,546566 +728326,512645 +353492,541647 +638429,517695 +628892,518280 +877286,505672 +620895,518778 +385878,537959 +423311,534113 +633501,517997 +884833,505360 +883402,505416 +999665,500894 +708395,513697 +548142,523667 +756491,511205 +987352,501340 +766520,510705 +591775,520647 +833758,507563 +843890,507108 +925551,503698 +74816,616598 +646942,517187 +354923,541481 +256291,555638 +634470,517942 +930904,503494 +134221,586071 +282663,551304 +986070,501394 +123636,590176 +123678,590164 +481717,528841 +423076,534137 +866246,506145 +93313,604697 +783632,509880 +317066,546304 +502977,527103 +141272,583545 +71708,618938 +617748,518975 +581190,521362 +193824,568382 +682368,515131 +352956,541712 +351375,541905 +505362,526909 +905165,504518 +128645,588188 +267143,553787 +158409,577965 +482776,528754 +628896,518282 +485233,528547 +563606,522574 +111001,595655 +115920,593445 +365510,540237 +959724,502374 +938763,503184 +930044,503520 +970959,501956 +913658,504176 +68117,621790 +989729,501253 +567697,522288 +820427,508163 +54236,634794 +291557,549938 +124961,589646 +403177,536130 +405421,535899 +410233,535417 +815111,508403 +213176,563974 +83099,610879 +998588,500934 +513640,526263 +129817,587733 +1820,921851 +287584,550539 +299160,548820 +860621,506386 +529258,525059 +586297,521017 +953406,502616 +441234,532410 +986217,501386 +781938,509957 +461247,530595 +735424,512277 +146623,581722 +839838,507288 +510667,526494 +935085,503327 +737523,512167 +303455,548204 +992779,501145 +60240,628739 +939095,503174 +794368,509370 +501825,527189 +459028,530798 +884641,505363 +512287,526364 +835165,507499 +307723,547590 +160587,577304 +735043,512300 +493289,527887 +110717,595785 +306480,547772 +318593,546089 +179810,571911 +200531,566799 +314999,546580 +197020,567622 +301465,548487 +237808,559000 +131944,586923 +882527,505449 +468117,530003 +711319,513541 +156240,578628 +965452,502162 +992756,501148 +437959,532715 +739938,512046 +614249,519196 +391496,537356 +62746,626418 +688215,514806 +75501,616091 +883573,505412 +558824,522910 +759371,511061 +173913,573489 +891351,505089 +727464,512693 +164833,576051 +812317,508529 +540320,524243 +698061,514257 +69149,620952 +471673,529694 +159092,577753 +428134,533653 +89997,606608 +711061,513557 +779403,510081 +203327,566155 +798176,509187 +667688,515963 +636120,517833 +137410,584913 +217615,563034 +556887,523038 +667229,515991 +672276,515708 +325361,545187 +172115,573985 +13846,725685 \ No newline at end of file From 72fea0752652a7a0ea4d716ced7d6266e0748b10 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sat, 15 Nov 2008 17:33:51 -0500 Subject: [PATCH 003/102] Forgot to update project-euler.factor --- extra/project-euler/project-euler.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 60d35f27ad..027e8fe50f 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -17,10 +17,11 @@ USING: definitions io io.files kernel math math.parser project-euler.052 project-euler.053 project-euler.055 project-euler.056 project-euler.059 project-euler.067 project-euler.071 project-euler.073 project-euler.075 project-euler.076 project-euler.079 project-euler.092 - project-euler.097 project-euler.100 project-euler.116 project-euler.117 - project-euler.134 project-euler.148 project-euler.150 project-euler.151 - project-euler.164 project-euler.169 project-euler.173 project-euler.175 - project-euler.186 project-euler.190 project-euler.203 project-euler.215 ; + project-euler.097 project-euler.099 project-euler.100 project-euler.116 + project-euler.117 project-euler.134 project-euler.148 project-euler.150 + project-euler.151 project-euler.164 project-euler.169 project-euler.173 + project-euler.175 project-euler.186 project-euler.190 project-euler.203 + project-euler.215 ; IN: project-euler Date: Sun, 16 Nov 2008 13:07:03 -0600 Subject: [PATCH 004/102] gl-rect stack effect changed --- extra/springies/ui/ui.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/springies/ui/ui.factor b/extra/springies/ui/ui.factor index 07865f38e0..21e97a1827 100644 --- a/extra/springies/ui/ui.factor +++ b/extra/springies/ui/ui.factor @@ -7,7 +7,7 @@ IN: springies.ui ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: draw-node ( node -- ) pos>> { -5 -5 } v+ dup { 10 10 } v+ gl-rect ; +: draw-node ( node -- ) pos>> { -5 -5 } v+ [ { 10 10 } gl-rect ] with-translation ; : draw-spring ( spring -- ) [ node-a>> pos>> ] [ node-b>> pos>> ] bi gl-line ; From e6218fdc7180fa9003a8f6ee801f5b636c823cea Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 13:46:21 -0600 Subject: [PATCH 005/102] Move words from compiler.errors.private to compiler.errors --- core/compiler/errors/errors-docs.factor | 2 +- core/compiler/errors/errors.factor | 4 ---- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/core/compiler/errors/errors-docs.factor b/core/compiler/errors/errors-docs.factor index d86587662b..cb896dbf53 100644 --- a/core/compiler/errors/errors-docs.factor +++ b/core/compiler/errors/errors-docs.factor @@ -1,6 +1,6 @@ IN: compiler.errors USING: help.markup help.syntax vocabs.loader words io -quotations compiler.errors.private ; +quotations ; ARTICLE: "compiler-errors" "Compiler warnings and errors" "The compiler saves various notifications in a global variable:" diff --git a/core/compiler/errors/errors.factor b/core/compiler/errors/errors.factor index 7a28c1fb99..c2452f719d 100644 --- a/core/compiler/errors/errors.factor +++ b/core/compiler/errors/errors.factor @@ -14,8 +14,6 @@ M: object compiler-error-type drop +error+ ; GENERIC# compiler-error. 1 ( error word -- ) - - : :errors ( -- ) +error+ compiler-errors. ; : :warnings ( -- ) +warning+ compiler-errors. ; From 105831fabec6bb4dd3541466a6b8f720ed88473d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 13:46:30 -0600 Subject: [PATCH 006/102] Update for compiler.errors change --- basis/tools/deploy/shaker/shaker.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index a7332ea9ea..f8f9680c16 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -9,7 +9,7 @@ sorting compiler.units definitions ; QUALIFIED: bootstrap.stage2 QUALIFIED: classes QUALIFIED: command-line -QUALIFIED: compiler.errors.private +QUALIFIED: compiler.errors QUALIFIED: continuations QUALIFIED: definitions QUALIFIED: init @@ -291,7 +291,7 @@ IN: tools.deploy.shaker strip-debugger? [ { - compiler.errors.private:compiler-errors + compiler.errors:compiler-errors continuations:thread-error-hook } % ] when From 437d59498220fbe39095c1d5a854c5f0407b9741 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 13:46:45 -0600 Subject: [PATCH 007/102] Put compiler errors in build report --- extra/mason/child/child.factor | 1 + extra/mason/common/common.factor | 1 + extra/mason/report/report.factor | 29 ++++++++++++++++++----------- extra/mason/test/test.factor | 18 ++++++++++++++++-- 4 files changed, 36 insertions(+), 13 deletions(-) diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 02085a89b3..2bc6b191c4 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -61,6 +61,7 @@ IN: mason.child [ load-everything-vocabs-file eval-file empty? ] [ test-all-vocabs-file eval-file empty? ] [ help-lint-vocabs-file eval-file empty? ] + [ compiler-errors-file eval-file empty? ] } 0&& ; : build-child ( -- ) diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index 24a1292be3..fc7149e181 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -75,6 +75,7 @@ SYMBOL: stamp : boot-time-file "boot-time" ; : load-time-file "load-time" ; +: compiler-errors-file "compiler-errors" ; : test-time-file "test-time" ; : help-lint-time-file "help-lint-time" ; : benchmark-time-file "benchmark-time" ; diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 0b5f21540a..1b2697a5d1 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces debugger fry io io.files io.sockets io.encodings.utf8 prettyprint benchmark mason.common -mason.platform mason.config ; +mason.platform mason.config sequences ; IN: mason.report : time. ( file -- ) @@ -50,18 +50,25 @@ IN: mason.report nl - "Did not pass load-everything:" print - load-everything-vocabs-file cat - load-everything-errors-file cat + load-everything-vocabs-file eval-file [ + "== Did not pass load-everything:" print . + load-everything-errors-file cat + ] unless-empty - "Did not pass test-all:" print - test-all-vocabs-file cat - test-all-errors-file cat + compiler-errors-file eval-file [ + "== Vocabularies with compiler errors:" print . + ] unless-empty - "Did not pass help-lint:" print - help-lint-vocabs-file cat - help-lint-errors-file cat + test-all-vocabs-file eval-file [ + "== Did not pass test-all:" print . + test-all-errors-file cat + ] unless-empty - "Benchmarks:" print + help-lint-vocabs-file eval-file [ + "== Did not pass help-lint:" print . + help-lint-errors-file cat + ] unless-empty + + "== Benchmarks:" print benchmarks-file eval-file benchmarks. ] with-report ; \ No newline at end of file diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor index cc83c9db44..760b51617d 100644 --- a/extra/mason/test/test.factor +++ b/extra/mason/test/test.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces assocs io.files io.encodings.utf8 prettyprint help.lint benchmark tools.time bootstrap.stage2 -tools.test tools.vocabs help.html mason.common ; +tools.test tools.vocabs help.html mason.common words generic +accessors compiler.errors sequences sets sorting ; IN: mason.test : do-load ( -- ) @@ -11,6 +12,19 @@ IN: mason.test [ load-everything-errors-file utf8 [ load-failures. ] with-file-writer ] bi ; +GENERIC: word-vocabulary ( word -- vocabulary ) + +M: word word-vocabulary vocabulary>> ; + +M: method-body word-vocabulary "method-generic" word-prop ; + +: do-compile-errors ( -- ) + compiler-errors-file utf8 [ + +error+ errors-of-type keys + [ word-vocabulary ] map + prune natural-sort . + ] with-file-writer ; + : do-tests ( -- ) run-all-tests [ keys test-all-vocabs-file to-file ] @@ -29,7 +43,7 @@ IN: mason.test : do-all ( -- ) ".." [ bootstrap-time get boot-time-file to-file - [ do-load ] benchmark load-time-file to-file + [ do-load do-compile-errors ] benchmark load-time-file to-file [ generate-help ] benchmark html-help-time-file to-file [ do-tests ] benchmark test-time-file to-file [ do-help-lint ] benchmark help-lint-time-file to-file From bb8df5c0c9c2a828f930963001a6ce8cf0b51f5c Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 16 Nov 2008 22:10:19 +0100 Subject: [PATCH 008/102] Cosmetic changes: factor-- prefix for internal symbols, sectioning with ^L, header comments. --- misc/factor.el | 237 ++++++++++++++++++++++++++----------------------- 1 file changed, 124 insertions(+), 113 deletions(-) diff --git a/misc/factor.el b/misc/factor.el index 2d222187e4..393ed26ae0 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -1,25 +1,42 @@ -;; Eduardo Cavazos - wayo.cavazos@gmail.com +;;; factor.el --- Interacting with Factor within emacs +;; +;; Authors: Eduardo Cavazos +;; Jose A Ortega Ruiz +;; Keywords: languages + +;;; Commentary: + +;;; Quick setup: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Add these lines to your .emacs file: - -;; (load-file "/scratch/repos/Factor/misc/factor.el") -;; (setq factor-binary "/scratch/repos/Factor/factor") -;; (setq factor-image "/scratch/repos/Factor/factor.image") - +;; +;; (load-file "/scratch/repos/Factor/misc/factor.el") +;; (setq factor-binary "/scratch/repos/Factor/factor") +;; (setq factor-image "/scratch/repos/Factor/factor.image") +;; ;; Of course, you'll have to edit the directory paths for your system -;; accordingly. - +;; accordingly. Alternatively, put this file in your load-path and use +;; +;; (require 'factor) +;; +;; instead of load-file. +;; ;; That's all you have to do to "install" factor.el on your ;; system. Whenever you edit a factor file, Emacs will know to switch ;; to Factor mode. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; For further customization options, +;; M-x customize-group RET factor +;; +;; To start a Factor listener inside Emacs, +;; M-x run-factor -;; M-x run-factor === Start a Factor listener inside Emacs +;;; Requirements: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Customization -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(require 'font-lock) +(require 'comint) + +;;; Customization: (defgroup factor nil "Factor mode" @@ -37,9 +54,19 @@ value from the existing code in the buffer." :type 'integer :group 'factor) +(defcustom factor-binary "~/factor/factor" + "Full path to the factor executable to use when starting a listener." + :type '(file :must-match t) + :group 'factor) + +(defcustom factor-image "~/factor/factor.image" + "Full path to the factor image to use when starting a listener." + :type '(file :must-match t) + :group 'factor) + (defcustom factor-display-compilation-output t "Display the REPL buffer before compiling files." - :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) + :type 'boolean :group 'factor) (defcustom factor-mode-hook nil @@ -47,59 +74,6 @@ value from the existing code in the buffer." :type 'hook :group 'factor) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; factor-mode syntax -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar factor-mode-syntax-table nil - "Syntax table used while in Factor mode.") - -(if factor-mode-syntax-table - () - (let ((i 0)) - (setq factor-mode-syntax-table (make-syntax-table)) - - ;; Default is atom-constituent - (while (< i 256) - (modify-syntax-entry i "_ " factor-mode-syntax-table) - (setq i (1+ i))) - - ;; Word components. - (setq i ?0) - (while (<= i ?9) - (modify-syntax-entry i "w " factor-mode-syntax-table) - (setq i (1+ i))) - (setq i ?A) - (while (<= i ?Z) - (modify-syntax-entry i "w " factor-mode-syntax-table) - (setq i (1+ i))) - (setq i ?a) - (while (<= i ?z) - (modify-syntax-entry i "w " factor-mode-syntax-table) - (setq i (1+ i))) - - ;; Whitespace - (modify-syntax-entry ?\t " " factor-mode-syntax-table) - (modify-syntax-entry ?\n ">" factor-mode-syntax-table) - (modify-syntax-entry ?\f " " factor-mode-syntax-table) - (modify-syntax-entry ?\r " " factor-mode-syntax-table) - (modify-syntax-entry ? " " factor-mode-syntax-table) - - (modify-syntax-entry ?\[ "(] " factor-mode-syntax-table) - (modify-syntax-entry ?\] ")[ " factor-mode-syntax-table) - (modify-syntax-entry ?{ "(} " factor-mode-syntax-table) - (modify-syntax-entry ?} "){ " factor-mode-syntax-table) - - (modify-syntax-entry ?\( "()" factor-mode-syntax-table) - (modify-syntax-entry ?\) ")(" factor-mode-syntax-table) - (modify-syntax-entry ?\" "\" " factor-mode-syntax-table))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; factor-mode font lock -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'font-lock) - (defgroup factor-faces nil "Faces used in Factor mode" :group 'factor @@ -143,6 +117,9 @@ value from the existing code in the buffer." "Face for parsing words." :group 'factor-faces) + +;;; Factor mode font lock: + (defconst factor--parsing-words '("{" "}" "^:" "^::" ";" "<<" ">" "BIN:" "BV{" "B{" "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CS{" "C{" @@ -191,16 +168,57 @@ value from the existing code in the buffer." (,factor--regex-type-definition 2 'factor-font-lock-type-definition) (,factor--regex-symbol-definition 2 'factor-font-lock-symbol-definition) (,factor--regex-using-line 1 'factor-font-lock-vocabulary-name) - (,factor--regex-use-line 1 'factor-font-lock-vocabulary-name))) + (,factor--regex-use-line 1 'factor-font-lock-vocabulary-name)) + "Font lock keywords definition for Factor mode.") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; factor-mode commands -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Factor mode syntax: -(require 'comint) +(defvar factor-mode-syntax-table nil + "Syntax table used while in Factor mode.") -(defvar factor-binary "~/factor/factor") -(defvar factor-image "~/factor/factor.image") +(if factor-mode-syntax-table + () + (let ((i 0)) + (setq factor-mode-syntax-table (make-syntax-table)) + + ;; Default is atom-constituent + (while (< i 256) + (modify-syntax-entry i "_ " factor-mode-syntax-table) + (setq i (1+ i))) + + ;; Word components. + (setq i ?0) + (while (<= i ?9) + (modify-syntax-entry i "w " factor-mode-syntax-table) + (setq i (1+ i))) + (setq i ?A) + (while (<= i ?Z) + (modify-syntax-entry i "w " factor-mode-syntax-table) + (setq i (1+ i))) + (setq i ?a) + (while (<= i ?z) + (modify-syntax-entry i "w " factor-mode-syntax-table) + (setq i (1+ i))) + + ;; Whitespace + (modify-syntax-entry ?\t " " factor-mode-syntax-table) + (modify-syntax-entry ?\n ">" factor-mode-syntax-table) + (modify-syntax-entry ?\f " " factor-mode-syntax-table) + (modify-syntax-entry ?\r " " factor-mode-syntax-table) + (modify-syntax-entry ? " " factor-mode-syntax-table) + + (modify-syntax-entry ?\[ "(] " factor-mode-syntax-table) + (modify-syntax-entry ?\] ")[ " factor-mode-syntax-table) + (modify-syntax-entry ?{ "(} " factor-mode-syntax-table) + (modify-syntax-entry ?} "){ " factor-mode-syntax-table) + + (modify-syntax-entry ?\( "()" factor-mode-syntax-table) + (modify-syntax-entry ?\) ")(" factor-mode-syntax-table) + (modify-syntax-entry ?\" "\" " factor-mode-syntax-table))) + + +;;; Factor mode commands: (defun factor-telnet-to-port (port) (interactive "nPort: ") @@ -231,11 +249,6 @@ value from the existing code in the buffer." (unless (get-buffer-window (current-buffer) t) (display-buffer (current-buffer) t)))) -;; (defun factor-send-region (start end) -;; (interactive "r") -;; (comint-send-region "*factor*" start end) -;; (comint-send-string "*factor*" "\n")) - (defun factor-send-string (str) (let ((n (length (split-string str "\n")))) (save-excursion @@ -288,7 +301,8 @@ value from the existing code in the buffer." (beginning-of-line) (insert "! ")) -(defvar factor-mode-map (make-sparse-keymap)) +(defvar factor-mode-map (make-sparse-keymap) + "Key map used by Factor mode.") (define-key factor-mode-map "\C-c\C-f" 'factor-run-file) (define-key factor-mode-map "\C-c\C-r" 'factor-send-region) @@ -300,39 +314,39 @@ value from the existing code in the buffer." (define-key factor-mode-map [return] 'newline-and-indent) (define-key factor-mode-map [tab] 'indent-for-tab-command) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; factor-mode indentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst factor-word-starting-keywords - '("" ":" "TUPLE" "MACRO" "MACRO:" "M")) - -(defmacro factor-word-start-re (keywords) - `(format - "^\\(%s\\): " - (mapconcat 'identity ,keywords "\\|"))) + +;;; Factor mode indentation: (defvar factor-indent-width factor-default-indent-width "Indentation width in factor buffers. A local variable.") (make-variable-buffer-local 'factor-indent-width) +(defconst factor--regexp-word-start + (let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M"))) + (format "^\\(%s\\): " (mapconcat 'identity sws "\\|")))) + (defun factor--guess-indent-width () "Chooses an indentation value from existing code." - (let ((word-def (factor-word-start-re factor-word-starting-keywords)) - (word-cont "^ +[^ ]") + (let ((word-cont "^ +[^ ]") (iw)) (save-excursion (beginning-of-buffer) (while (not iw) - (if (not (re-search-forward word-def nil t)) + (if (not (re-search-forward factor--regexp-word-start nil t)) (setq iw factor-default-indent-width) (forward-line) (when (looking-at word-cont) (setq iw (current-indentation)))))) iw)) -(defun factor-calculate-indentation () +(defun factor--brackets-depth () + "Returns number of brackets, not closed on previous lines." + (syntax-ppss-depth + (save-excursion + (syntax-ppss (line-beginning-position))))) + +(defun factor--calculate-indentation () "Calculate Factor indentation for line at point." (let ((not-indented t) (cur-indent 0)) @@ -344,11 +358,11 @@ value from the existing code in the buffer." (while not-indented ;; Check that we are inside open brackets (save-excursion - (let ((cur-depth (factor-brackets-depth))) + (let ((cur-depth (factor--brackets-depth))) (forward-line -1) (setq cur-indent (+ (current-indentation) (* factor-indent-width - (- cur-depth (factor-brackets-depth))))) + (- cur-depth (factor--brackets-depth))))) (setq not-indented nil))) (forward-line -1) ;; Check that we are after the end of previous word @@ -357,8 +371,7 @@ value from the existing code in the buffer." (setq cur-indent (- (current-indentation) factor-indent-width)) (setq not-indented nil)) ;; Check that we are after the start of word - (if (looking-at (factor-word-start-re factor-word-starting-keywords)) -; (if (looking-at "^[A-Z:]*: ") + (if (looking-at factor--regexp-word-start) (progn (message "inword") (setq cur-indent (+ (current-indentation) factor-indent-width)) @@ -367,15 +380,9 @@ value from the existing code in the buffer." (setq not-indented nil)))))))) cur-indent)) -(defun factor-brackets-depth () - "Returns number of brackets, not closed on previous lines." - (syntax-ppss-depth - (save-excursion - (syntax-ppss (line-beginning-position))))) - (defun factor-indent-line () "Indent current line as Factor code" - (let ((target (factor-calculate-indentation)) + (let ((target (factor--calculate-indentation)) (pos (- (point-max) (point)))) (if (= target (current-indentation)) (if (< (current-column) (current-indentation)) @@ -386,10 +393,10 @@ value from the existing code in the buffer." (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; factor-mode -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Factor mode: +;;;###autoload (defun factor-mode () "A mode for editing programs written in the Factor programming language. \\{factor-mode-map}" @@ -410,9 +417,8 @@ value from the existing code in the buffer." (add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; factor-listener-mode -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Factor listener mode (define-derived-mode factor-listener-mode comint-mode "Factor Listener") @@ -429,3 +435,8 @@ value from the existing code in the buffer." (defun factor-refresh-all () (interactive) (comint-send-string "*factor*" "refresh-all\n")) + + + +(provide 'factor) +;;; factor.el ends here From fbe29ceca826a7c62200ee3b79f51982fa1aaf8a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 15:31:17 -0600 Subject: [PATCH 009/102] format-table should not be private since ui.gadgets.grids uses it --- core/io/streams/string/string.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index 184b5e1c15..10d8f7d947 100644 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -26,12 +26,12 @@ M: null-encoding decode-char drop stream-read1 ; : map-last ( seq quot -- seq ) >r dup length [ zero? ] r> compose 2map ; inline +PRIVATE> + : format-table ( table -- seq ) flip [ format-column ] map-last flip [ " " join ] map ; -PRIVATE> - M: growable dispose drop ; M: growable stream-write1 push ; From 78161aa2b3143009c59ffd2b071db2fc6907eff3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 15:31:31 -0600 Subject: [PATCH 010/102] Fix bug in do-compile-errors --- extra/mason/test/test.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor index 760b51617d..0206df7db9 100644 --- a/extra/mason/test/test.factor +++ b/extra/mason/test/test.factor @@ -16,7 +16,7 @@ GENERIC: word-vocabulary ( word -- vocabulary ) M: word word-vocabulary vocabulary>> ; -M: method-body word-vocabulary "method-generic" word-prop ; +M: method-body word-vocabulary "method-generic" word-prop word-vocabulary ; : do-compile-errors ( -- ) compiler-errors-file utf8 [ From 6d28ecc46b6b647775c3431fa05e3b64cf9e6c4b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 15:39:30 -0600 Subject: [PATCH 011/102] Forgot to add call to upload-help --- extra/mason/build/build.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index 8b8befce34..f253529950 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -23,6 +23,7 @@ IN: mason.build clone-builds-factor record-id build-child + upload-help release email-report cleanup ; From a85be4658cab892747096e5e87e750b58bd5e8ea Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 16 Nov 2008 15:50:48 -0600 Subject: [PATCH 012/102] fix compile errors --- extra/hardware-info/macosx/macosx.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/hardware-info/macosx/macosx.factor b/extra/hardware-info/macosx/macosx.factor index fe1fd72a21..e3c604f2fd 100644 --- a/extra/hardware-info/macosx/macosx.factor +++ b/extra/hardware-info/macosx/macosx.factor @@ -12,11 +12,11 @@ FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, voi : make-int-array ( seq -- byte-array ) [ ] map concat ; -: (sysctl-query) ( name namelen oldp oldlenp -- oldp error/f ) - over >r f 0 sysctl io-error r> ; +: (sysctl-query) ( name namelen oldp oldlenp -- oldp ) + over [ f 0 sysctl io-error ] dip ; : sysctl-query ( seq n -- byte-array ) - >r [ make-int-array ] [ length ] bi r> + [ [ make-int-array ] [ length ] bi ] dip [ ] [ ] bi (sysctl-query) ; : sysctl-query-string ( seq -- n ) From c471edba59fd88a2bff1cff5f97f0c061ad72ae0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 15:51:10 -0600 Subject: [PATCH 013/102] Fix load error --- extra/mason/build/build.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index f253529950..35070d8902 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files io.launcher io.encodings.utf8 prettyprint arrays calendar namespaces mason.common mason.child -mason.release mason.report mason.email mason.cleanup ; +mason.release mason.report mason.email mason.cleanup +mason.help ; IN: mason.build : create-build-dir ( -- ) From bd2d78b6b19b3ba8d336d98000df2829f7cc42e8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 16:19:18 -0600 Subject: [PATCH 014/102] Disable referrer checking by default since adblock doesn't send it for some lame reason --- basis/furnace/alloy/alloy.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor index 128ec448b7..0fe80427b9 100644 --- a/basis/furnace/alloy/alloy.factor +++ b/basis/furnace/alloy/alloy.factor @@ -4,7 +4,6 @@ USING: kernel sequences db.tuples alarms calendar db fry furnace.db furnace.cache furnace.asides -furnace.referrer furnace.sessions furnace.conversations furnace.auth.providers @@ -24,8 +23,7 @@ IN: furnace.alloy ] dip - - ; + ; : start-expiring ( db -- ) '[ From f2d34b6d6ec4c5def9649e046cec8e6ad90f05d3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 16:21:25 -0600 Subject: [PATCH 015/102] Only upload help if buld is clean --- extra/mason/help/help.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/extra/mason/help/help.factor b/extra/mason/help/help.factor index 1e3e1509c9..c9ca50f0c2 100644 --- a/extra/mason/help/help.factor +++ b/extra/mason/help/help.factor @@ -16,8 +16,11 @@ IN: mason.help help-directory get "/docs.tar.gz" append upload-safely ; -: upload-help ( -- ) +: (upload-help) ( -- ) upload-help? get [ make-help-archive upload-help-archive ] when ; + +: upload-help ( -- ) + status get status-clean eq? [ (upload-help) ] when ; From de64b18158bf358eca853f3906f92296a7d998d1 Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 16 Nov 2008 17:34:53 -0500 Subject: [PATCH 016/102] Missing in extra/webapps/user-admin/new-user.xml --- extra/webapps/user-admin/new-user.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/user-admin/new-user.xml b/extra/webapps/user-admin/new-user.xml index d3cf681165..313c8e2702 100644 --- a/extra/webapps/user-admin/new-user.xml +++ b/extra/webapps/user-admin/new-user.xml @@ -37,7 +37,7 @@ Capabilities: -

  • +

    • From e6fbd4f84fc91eb8cabce43eb060aeaf7c0092e8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 16:59:25 -0600 Subject: [PATCH 017/102] fix compile errors --- extra/html/parser/analyzer/analyzer.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 8d7a92b0d9..a18bb31874 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -60,13 +60,13 @@ TUPLE: link attributes clickable ; [ [ [ blank? ] trim ] change-text ] when ] map ; -: find-by-id ( vector id -- vector' ) +: find-by-id ( vector id -- vector' elt/f ) '[ attributes>> "id" at _ = ] find ; -: find-by-class ( vector id -- vector' ) +: find-by-class ( vector id -- vector' elt/f ) '[ attributes>> "class" at _ = ] find ; -: find-by-name ( vector string -- vector ) +: find-by-name ( vector string -- vector elt/f ) >lower '[ name>> _ = ] find ; : find-by-id-between ( vector string -- vector' ) @@ -83,7 +83,7 @@ TUPLE: link attributes clickable ; [ attributes>> "id" swap at _ = ] bi and ] dupd find find-between* ; -: find-by-attribute-key ( vector key -- vector' ) +: find-by-attribute-key ( vector key -- vector' elt/? ) >lower [ attributes>> at _ = ] filter sift ; From e030d5bdfb5ba6c46899d8e9fbdfddca07588af3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 17:18:10 -0600 Subject: [PATCH 018/102] Move odbc to unmtainained: compile errors --- {extra => unmaintained}/odbc/authors.txt | 0 {extra => unmaintained}/odbc/odbc-docs.factor | 0 {extra => unmaintained}/odbc/odbc.factor | 0 {extra => unmaintained}/odbc/summary.txt | 0 {extra => unmaintained}/odbc/tags.txt | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/odbc/authors.txt (100%) rename {extra => unmaintained}/odbc/odbc-docs.factor (100%) rename {extra => unmaintained}/odbc/odbc.factor (100%) rename {extra => unmaintained}/odbc/summary.txt (100%) rename {extra => unmaintained}/odbc/tags.txt (100%) diff --git a/extra/odbc/authors.txt b/unmaintained/odbc/authors.txt similarity index 100% rename from extra/odbc/authors.txt rename to unmaintained/odbc/authors.txt diff --git a/extra/odbc/odbc-docs.factor b/unmaintained/odbc/odbc-docs.factor similarity index 100% rename from extra/odbc/odbc-docs.factor rename to unmaintained/odbc/odbc-docs.factor diff --git a/extra/odbc/odbc.factor b/unmaintained/odbc/odbc.factor similarity index 100% rename from extra/odbc/odbc.factor rename to unmaintained/odbc/odbc.factor diff --git a/extra/odbc/summary.txt b/unmaintained/odbc/summary.txt similarity index 100% rename from extra/odbc/summary.txt rename to unmaintained/odbc/summary.txt diff --git a/extra/odbc/tags.txt b/unmaintained/odbc/tags.txt similarity index 100% rename from extra/odbc/tags.txt rename to unmaintained/odbc/tags.txt From 4feecbd23e880e0b92a405f20ee80e9cc568fdc3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 17:20:02 -0600 Subject: [PATCH 019/102] More more stuff to unmaintained because of compile errors --- {extra => unmaintained}/factory/authors.txt | 0 {extra => unmaintained}/factory/commands/authors.txt | 0 {extra => unmaintained}/factory/commands/commands.factor | 0 {extra => unmaintained}/factory/factory-menus | 0 {extra => unmaintained}/factory/factory-rc | 0 {extra => unmaintained}/factory/factory.factor | 0 {extra => unmaintained}/factory/load/authors.txt | 0 {extra => unmaintained}/factory/load/load.factor | 0 {extra => unmaintained}/factory/summary.txt | 0 {extra => unmaintained}/factory/tags.txt | 0 {extra => unmaintained}/mortar/authors.txt | 0 {extra => unmaintained}/mortar/mortar.factor | 0 {extra => unmaintained}/mortar/sugar/sugar.factor | 0 {extra => unmaintained}/mortar/tags.txt | 0 {extra/ui/gadgets => unmaintained}/tiling/tiling.factor | 0 {extra => unmaintained}/x/authors.txt | 0 {extra => unmaintained}/x/font/authors.txt | 0 {extra => unmaintained}/x/font/font.factor | 0 {extra => unmaintained}/x/gc/authors.txt | 0 {extra => unmaintained}/x/gc/gc.factor | 0 {extra => unmaintained}/x/keysym-table/authors.txt | 0 {extra => unmaintained}/x/keysym-table/keysym-table.factor | 0 {extra => unmaintained}/x/pen/authors.txt | 0 {extra => unmaintained}/x/pen/pen.factor | 0 {extra => unmaintained}/x/widgets/authors.txt | 0 {extra => unmaintained}/x/widgets/button/authors.txt | 0 {extra => unmaintained}/x/widgets/button/button.factor | 0 {extra => unmaintained}/x/widgets/keymenu/authors.txt | 0 {extra => unmaintained}/x/widgets/keymenu/keymenu.factor | 0 {extra => unmaintained}/x/widgets/label/authors.txt | 0 {extra => unmaintained}/x/widgets/label/label.factor | 0 {extra => unmaintained}/x/widgets/widgets.factor | 0 {extra => unmaintained}/x/widgets/wm/child/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/child/child.factor | 0 {extra => unmaintained}/x/widgets/wm/frame/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/frame/drag/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/frame/drag/drag.factor | 0 {extra => unmaintained}/x/widgets/wm/frame/drag/move/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/frame/drag/move/move.factor | 0 {extra => unmaintained}/x/widgets/wm/frame/drag/size/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/frame/drag/size/size.factor | 0 {extra => unmaintained}/x/widgets/wm/frame/frame.factor | 0 {extra => unmaintained}/x/widgets/wm/menu/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/menu/menu.factor | 0 {extra => unmaintained}/x/widgets/wm/root/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/root/root.factor | 0 .../x/widgets/wm/unmapped-frames-menu/authors.txt | 0 .../x/widgets/wm/unmapped-frames-menu/unmapped-frames-menu.factor | 0 {extra => unmaintained}/x/widgets/wm/workspace/authors.txt | 0 {extra => unmaintained}/x/widgets/wm/workspace/workspace.factor | 0 {extra => unmaintained}/x/x.factor | 0 51 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/factory/authors.txt (100%) rename {extra => unmaintained}/factory/commands/authors.txt (100%) rename {extra => unmaintained}/factory/commands/commands.factor (100%) rename {extra => unmaintained}/factory/factory-menus (100%) rename {extra => unmaintained}/factory/factory-rc (100%) rename {extra => unmaintained}/factory/factory.factor (100%) rename {extra => unmaintained}/factory/load/authors.txt (100%) rename {extra => unmaintained}/factory/load/load.factor (100%) rename {extra => unmaintained}/factory/summary.txt (100%) rename {extra => unmaintained}/factory/tags.txt (100%) rename {extra => unmaintained}/mortar/authors.txt (100%) rename {extra => unmaintained}/mortar/mortar.factor (100%) rename {extra => unmaintained}/mortar/sugar/sugar.factor (100%) rename {extra => unmaintained}/mortar/tags.txt (100%) rename {extra/ui/gadgets => unmaintained}/tiling/tiling.factor (100%) rename {extra => unmaintained}/x/authors.txt (100%) rename {extra => unmaintained}/x/font/authors.txt (100%) rename {extra => unmaintained}/x/font/font.factor (100%) rename {extra => unmaintained}/x/gc/authors.txt (100%) rename {extra => unmaintained}/x/gc/gc.factor (100%) rename {extra => unmaintained}/x/keysym-table/authors.txt (100%) rename {extra => unmaintained}/x/keysym-table/keysym-table.factor (100%) rename {extra => unmaintained}/x/pen/authors.txt (100%) rename {extra => unmaintained}/x/pen/pen.factor (100%) rename {extra => unmaintained}/x/widgets/authors.txt (100%) rename {extra => unmaintained}/x/widgets/button/authors.txt (100%) rename {extra => unmaintained}/x/widgets/button/button.factor (100%) rename {extra => unmaintained}/x/widgets/keymenu/authors.txt (100%) rename {extra => unmaintained}/x/widgets/keymenu/keymenu.factor (100%) rename {extra => unmaintained}/x/widgets/label/authors.txt (100%) rename {extra => unmaintained}/x/widgets/label/label.factor (100%) rename {extra => unmaintained}/x/widgets/widgets.factor (100%) rename {extra => unmaintained}/x/widgets/wm/child/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/child/child.factor (100%) rename {extra => unmaintained}/x/widgets/wm/frame/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/frame/drag/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/frame/drag/drag.factor (100%) rename {extra => unmaintained}/x/widgets/wm/frame/drag/move/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/frame/drag/move/move.factor (100%) rename {extra => unmaintained}/x/widgets/wm/frame/drag/size/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/frame/drag/size/size.factor (100%) rename {extra => unmaintained}/x/widgets/wm/frame/frame.factor (100%) rename {extra => unmaintained}/x/widgets/wm/menu/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/menu/menu.factor (100%) rename {extra => unmaintained}/x/widgets/wm/root/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/root/root.factor (100%) rename {extra => unmaintained}/x/widgets/wm/unmapped-frames-menu/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/unmapped-frames-menu/unmapped-frames-menu.factor (100%) rename {extra => unmaintained}/x/widgets/wm/workspace/authors.txt (100%) rename {extra => unmaintained}/x/widgets/wm/workspace/workspace.factor (100%) rename {extra => unmaintained}/x/x.factor (100%) diff --git a/extra/factory/authors.txt b/unmaintained/factory/authors.txt similarity index 100% rename from extra/factory/authors.txt rename to unmaintained/factory/authors.txt diff --git a/extra/factory/commands/authors.txt b/unmaintained/factory/commands/authors.txt similarity index 100% rename from extra/factory/commands/authors.txt rename to unmaintained/factory/commands/authors.txt diff --git a/extra/factory/commands/commands.factor b/unmaintained/factory/commands/commands.factor similarity index 100% rename from extra/factory/commands/commands.factor rename to unmaintained/factory/commands/commands.factor diff --git a/extra/factory/factory-menus b/unmaintained/factory/factory-menus similarity index 100% rename from extra/factory/factory-menus rename to unmaintained/factory/factory-menus diff --git a/extra/factory/factory-rc b/unmaintained/factory/factory-rc similarity index 100% rename from extra/factory/factory-rc rename to unmaintained/factory/factory-rc diff --git a/extra/factory/factory.factor b/unmaintained/factory/factory.factor similarity index 100% rename from extra/factory/factory.factor rename to unmaintained/factory/factory.factor diff --git a/extra/factory/load/authors.txt b/unmaintained/factory/load/authors.txt similarity index 100% rename from extra/factory/load/authors.txt rename to unmaintained/factory/load/authors.txt diff --git a/extra/factory/load/load.factor b/unmaintained/factory/load/load.factor similarity index 100% rename from extra/factory/load/load.factor rename to unmaintained/factory/load/load.factor diff --git a/extra/factory/summary.txt b/unmaintained/factory/summary.txt similarity index 100% rename from extra/factory/summary.txt rename to unmaintained/factory/summary.txt diff --git a/extra/factory/tags.txt b/unmaintained/factory/tags.txt similarity index 100% rename from extra/factory/tags.txt rename to unmaintained/factory/tags.txt diff --git a/extra/mortar/authors.txt b/unmaintained/mortar/authors.txt similarity index 100% rename from extra/mortar/authors.txt rename to unmaintained/mortar/authors.txt diff --git a/extra/mortar/mortar.factor b/unmaintained/mortar/mortar.factor similarity index 100% rename from extra/mortar/mortar.factor rename to unmaintained/mortar/mortar.factor diff --git a/extra/mortar/sugar/sugar.factor b/unmaintained/mortar/sugar/sugar.factor similarity index 100% rename from extra/mortar/sugar/sugar.factor rename to unmaintained/mortar/sugar/sugar.factor diff --git a/extra/mortar/tags.txt b/unmaintained/mortar/tags.txt similarity index 100% rename from extra/mortar/tags.txt rename to unmaintained/mortar/tags.txt diff --git a/extra/ui/gadgets/tiling/tiling.factor b/unmaintained/tiling/tiling.factor similarity index 100% rename from extra/ui/gadgets/tiling/tiling.factor rename to unmaintained/tiling/tiling.factor diff --git a/extra/x/authors.txt b/unmaintained/x/authors.txt similarity index 100% rename from extra/x/authors.txt rename to unmaintained/x/authors.txt diff --git a/extra/x/font/authors.txt b/unmaintained/x/font/authors.txt similarity index 100% rename from extra/x/font/authors.txt rename to unmaintained/x/font/authors.txt diff --git a/extra/x/font/font.factor b/unmaintained/x/font/font.factor similarity index 100% rename from extra/x/font/font.factor rename to unmaintained/x/font/font.factor diff --git a/extra/x/gc/authors.txt b/unmaintained/x/gc/authors.txt similarity index 100% rename from extra/x/gc/authors.txt rename to unmaintained/x/gc/authors.txt diff --git a/extra/x/gc/gc.factor b/unmaintained/x/gc/gc.factor similarity index 100% rename from extra/x/gc/gc.factor rename to unmaintained/x/gc/gc.factor diff --git a/extra/x/keysym-table/authors.txt b/unmaintained/x/keysym-table/authors.txt similarity index 100% rename from extra/x/keysym-table/authors.txt rename to unmaintained/x/keysym-table/authors.txt diff --git a/extra/x/keysym-table/keysym-table.factor b/unmaintained/x/keysym-table/keysym-table.factor similarity index 100% rename from extra/x/keysym-table/keysym-table.factor rename to unmaintained/x/keysym-table/keysym-table.factor diff --git a/extra/x/pen/authors.txt b/unmaintained/x/pen/authors.txt similarity index 100% rename from extra/x/pen/authors.txt rename to unmaintained/x/pen/authors.txt diff --git a/extra/x/pen/pen.factor b/unmaintained/x/pen/pen.factor similarity index 100% rename from extra/x/pen/pen.factor rename to unmaintained/x/pen/pen.factor diff --git a/extra/x/widgets/authors.txt b/unmaintained/x/widgets/authors.txt similarity index 100% rename from extra/x/widgets/authors.txt rename to unmaintained/x/widgets/authors.txt diff --git a/extra/x/widgets/button/authors.txt b/unmaintained/x/widgets/button/authors.txt similarity index 100% rename from extra/x/widgets/button/authors.txt rename to unmaintained/x/widgets/button/authors.txt diff --git a/extra/x/widgets/button/button.factor b/unmaintained/x/widgets/button/button.factor similarity index 100% rename from extra/x/widgets/button/button.factor rename to unmaintained/x/widgets/button/button.factor diff --git a/extra/x/widgets/keymenu/authors.txt b/unmaintained/x/widgets/keymenu/authors.txt similarity index 100% rename from extra/x/widgets/keymenu/authors.txt rename to unmaintained/x/widgets/keymenu/authors.txt diff --git a/extra/x/widgets/keymenu/keymenu.factor b/unmaintained/x/widgets/keymenu/keymenu.factor similarity index 100% rename from extra/x/widgets/keymenu/keymenu.factor rename to unmaintained/x/widgets/keymenu/keymenu.factor diff --git a/extra/x/widgets/label/authors.txt b/unmaintained/x/widgets/label/authors.txt similarity index 100% rename from extra/x/widgets/label/authors.txt rename to unmaintained/x/widgets/label/authors.txt diff --git a/extra/x/widgets/label/label.factor b/unmaintained/x/widgets/label/label.factor similarity index 100% rename from extra/x/widgets/label/label.factor rename to unmaintained/x/widgets/label/label.factor diff --git a/extra/x/widgets/widgets.factor b/unmaintained/x/widgets/widgets.factor similarity index 100% rename from extra/x/widgets/widgets.factor rename to unmaintained/x/widgets/widgets.factor diff --git a/extra/x/widgets/wm/child/authors.txt b/unmaintained/x/widgets/wm/child/authors.txt similarity index 100% rename from extra/x/widgets/wm/child/authors.txt rename to unmaintained/x/widgets/wm/child/authors.txt diff --git a/extra/x/widgets/wm/child/child.factor b/unmaintained/x/widgets/wm/child/child.factor similarity index 100% rename from extra/x/widgets/wm/child/child.factor rename to unmaintained/x/widgets/wm/child/child.factor diff --git a/extra/x/widgets/wm/frame/authors.txt b/unmaintained/x/widgets/wm/frame/authors.txt similarity index 100% rename from extra/x/widgets/wm/frame/authors.txt rename to unmaintained/x/widgets/wm/frame/authors.txt diff --git a/extra/x/widgets/wm/frame/drag/authors.txt b/unmaintained/x/widgets/wm/frame/drag/authors.txt similarity index 100% rename from extra/x/widgets/wm/frame/drag/authors.txt rename to unmaintained/x/widgets/wm/frame/drag/authors.txt diff --git a/extra/x/widgets/wm/frame/drag/drag.factor b/unmaintained/x/widgets/wm/frame/drag/drag.factor similarity index 100% rename from extra/x/widgets/wm/frame/drag/drag.factor rename to unmaintained/x/widgets/wm/frame/drag/drag.factor diff --git a/extra/x/widgets/wm/frame/drag/move/authors.txt b/unmaintained/x/widgets/wm/frame/drag/move/authors.txt similarity index 100% rename from extra/x/widgets/wm/frame/drag/move/authors.txt rename to unmaintained/x/widgets/wm/frame/drag/move/authors.txt diff --git a/extra/x/widgets/wm/frame/drag/move/move.factor b/unmaintained/x/widgets/wm/frame/drag/move/move.factor similarity index 100% rename from extra/x/widgets/wm/frame/drag/move/move.factor rename to unmaintained/x/widgets/wm/frame/drag/move/move.factor diff --git a/extra/x/widgets/wm/frame/drag/size/authors.txt b/unmaintained/x/widgets/wm/frame/drag/size/authors.txt similarity index 100% rename from extra/x/widgets/wm/frame/drag/size/authors.txt rename to unmaintained/x/widgets/wm/frame/drag/size/authors.txt diff --git a/extra/x/widgets/wm/frame/drag/size/size.factor b/unmaintained/x/widgets/wm/frame/drag/size/size.factor similarity index 100% rename from extra/x/widgets/wm/frame/drag/size/size.factor rename to unmaintained/x/widgets/wm/frame/drag/size/size.factor diff --git a/extra/x/widgets/wm/frame/frame.factor b/unmaintained/x/widgets/wm/frame/frame.factor similarity index 100% rename from extra/x/widgets/wm/frame/frame.factor rename to unmaintained/x/widgets/wm/frame/frame.factor diff --git a/extra/x/widgets/wm/menu/authors.txt b/unmaintained/x/widgets/wm/menu/authors.txt similarity index 100% rename from extra/x/widgets/wm/menu/authors.txt rename to unmaintained/x/widgets/wm/menu/authors.txt diff --git a/extra/x/widgets/wm/menu/menu.factor b/unmaintained/x/widgets/wm/menu/menu.factor similarity index 100% rename from extra/x/widgets/wm/menu/menu.factor rename to unmaintained/x/widgets/wm/menu/menu.factor diff --git a/extra/x/widgets/wm/root/authors.txt b/unmaintained/x/widgets/wm/root/authors.txt similarity index 100% rename from extra/x/widgets/wm/root/authors.txt rename to unmaintained/x/widgets/wm/root/authors.txt diff --git a/extra/x/widgets/wm/root/root.factor b/unmaintained/x/widgets/wm/root/root.factor similarity index 100% rename from extra/x/widgets/wm/root/root.factor rename to unmaintained/x/widgets/wm/root/root.factor diff --git a/extra/x/widgets/wm/unmapped-frames-menu/authors.txt b/unmaintained/x/widgets/wm/unmapped-frames-menu/authors.txt similarity index 100% rename from extra/x/widgets/wm/unmapped-frames-menu/authors.txt rename to unmaintained/x/widgets/wm/unmapped-frames-menu/authors.txt diff --git a/extra/x/widgets/wm/unmapped-frames-menu/unmapped-frames-menu.factor b/unmaintained/x/widgets/wm/unmapped-frames-menu/unmapped-frames-menu.factor similarity index 100% rename from extra/x/widgets/wm/unmapped-frames-menu/unmapped-frames-menu.factor rename to unmaintained/x/widgets/wm/unmapped-frames-menu/unmapped-frames-menu.factor diff --git a/extra/x/widgets/wm/workspace/authors.txt b/unmaintained/x/widgets/wm/workspace/authors.txt similarity index 100% rename from extra/x/widgets/wm/workspace/authors.txt rename to unmaintained/x/widgets/wm/workspace/authors.txt diff --git a/extra/x/widgets/wm/workspace/workspace.factor b/unmaintained/x/widgets/wm/workspace/workspace.factor similarity index 100% rename from extra/x/widgets/wm/workspace/workspace.factor rename to unmaintained/x/widgets/wm/workspace/workspace.factor diff --git a/extra/x/x.factor b/unmaintained/x/x.factor similarity index 100% rename from extra/x/x.factor rename to unmaintained/x/x.factor From 84ce5c3b9114a87c08b57d2ad8785456446db1ba Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 19:15:09 -0600 Subject: [PATCH 020/102] Windows workaround --- basis/editors/emacs/emacs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index 1550fccc0b..79387f9820 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -1,11 +1,11 @@ USING: definitions io.launcher kernel parser words sequences math -math.parser namespaces editors make ; +math.parser namespaces editors make system ; IN: editors.emacs : emacsclient ( file line -- ) [ \ emacsclient get "emacsclient" or , - "--no-wait" , + os windows? [ "--no-wait" , ] unless "+" swap number>string append , , ] { } make try-process ; From e4dde55d725ecfcffa6f18963625c7cb383b6a14 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 19:15:51 -0600 Subject: [PATCH 021/102] On Windows, we now look for factor-rc and factor-boot-rc, instead of .factor-rc and .factor-boot-rc, since Explorer doesn't like filenames with leading periods --- basis/command-line/command-line-docs.factor | 48 ++++++++++++++++----- basis/command-line/command-line.factor | 8 +++- 2 files changed, 43 insertions(+), 13 deletions(-) diff --git a/basis/command-line/command-line-docs.factor b/basis/command-line/command-line-docs.factor index d1b18ab5da..65d290df3a 100644 --- a/basis/command-line/command-line-docs.factor +++ b/basis/command-line/command-line-docs.factor @@ -2,10 +2,10 @@ USING: help.markup help.syntax parser vocabs.loader strings ; IN: command-line HELP: run-bootstrap-init -{ $description "Runs the " { $snippet ".factor-boot-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ; +{ $description "Runs the bootstrap initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } " on Unix and " { $snippet "factor-boot-rc" } " on Windows." } ; HELP: run-user-init -{ $description "Runs the " { $snippet ".factor-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ; +{ $description "Runs the startup initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } " on Unix and " { $snippet "factor-rc" } " on Windows." } ; HELP: cli-param { $values { "param" string } } @@ -57,7 +57,7 @@ ARTICLE: "bootstrap-cli-args" "Command line switches for bootstrap" "A number of command line switches can be passed to a bootstrap image to modify the behavior of the resulting image:" { $table { { $snippet "-output-image=" { $emphasis "image" } } { "Save the result to " { $snippet "image" } ". The default is " { $snippet "factor.image" } "." } } - { { $snippet "-no-user-init" } { "Inhibits the running of the " { $snippet ".factor-boot-rc" } " file in the user's home directory." } } + { { $snippet "-no-user-init" } { "Inhibits the running of user initialization files on startup. See " { $link "rc-files" } "." } } { { $snippet "-include=" { $emphasis "components..." } } "A list of components to include (see below)." } { { $snippet "-exclude=" { $emphasis "components..." } } "A list of components to exclude." } { { $snippet "-ui-backend=" { $emphasis "backend" } } { "One of " { $snippet "x11" } ", " { $snippet "windows" } ", or " { $snippet "cocoa" } ". The default is platform-specific." } } @@ -74,9 +74,9 @@ ARTICLE: "bootstrap-cli-args" "Command line switches for bootstrap" "By default, all optional components are loaded. To load all optional components except for a given list, use the " { $snippet "-exclude=" } " switch; to only load specified optional components, use the " { $snippet "-include=" } "." $nl "For example, to build an image with the compiler but no other components, you could do:" -{ $code "./factor -i=boot.ppc.image -include=compiler" } +{ $code "./factor -i=boot.macosx-ppc.image -include=compiler" } "To build an image with everything except for the user interface and graphical tools," -{ $code "./factor -i=boot.ppc.image -exclude=\"ui ui.tools\"" } +{ $code "./factor -i=boot.macosx-ppc.image -exclude=\"ui ui.tools\"" } "To generate a bootstrap image in the first place, see " { $link "bootstrap.image" } "." ; ARTICLE: "standard-cli-args" "Command line switches for general usage" @@ -84,17 +84,43 @@ ARTICLE: "standard-cli-args" "Command line switches for general usage" { $table { { $snippet "-e=" { $emphasis "code" } } { "This specifies a code snippet to evaluate. If you want Factor to exit immediately after, also specify " { $snippet "-run=none" } "." } } { { $snippet "-run=" { $emphasis "vocab" } } { { $snippet { $emphasis "vocab" } } " is the name of a vocabulary with a " { $link POSTPONE: MAIN: } " hook to run on startup, for example " { $vocab-link "listener" } ", " { $vocab-link "ui" } " or " { $vocab-link "none" } "." } } - { { $snippet "-no-user-init" } { "Inhibits the running of the " { $snippet ".factor-rc" } " file in the user's home directory on startup." } } + { { $snippet "-no-user-init" } { "Inhibits the running of user initialization files on startup. See " { $link "rc-files" } "." } } { { $snippet "-quiet" } { "If set, " { $link run-file } " and " { $link require } " will not print load messages." } } { { $snippet "-script" } { "Equivalent to " { $snippet "-quiet -run=none" } "." $nl "On Unix systems, Factor can be used for scripting - just create an executable text file whose first line is:" { $code "#! /usr/local/bin/factor -script" } "The space after " { $snippet "#!" } " is necessary because of Factor syntax." } } } ; -ARTICLE: "rc-files" "Running code on startup" -"Unless the " { $snippet "-no-user-init" } " command line switch is specified, The startup routine runs the " { $snippet ".factor-rc" } " file in the user's home directory, if it exists. This file can contain initialization and customization for your development environment." +ARTICLE: "factor-boot-rc" "Bootstrap initialization file" +"The botstrap initialization file is named " { $snippet "factor-boot-rc" } " on Windows and " { $snippet ".factor-boot-rc" } " on Unix. This file can contain " { $link require } " calls for vocabularies you use frequently, and other such long-running tasks that you do not want to perform every time Factor starts." $nl -"The " { $snippet ".factor-rc" } " and " { $snippet ".factor-boot-rc" } " files can be run explicitly:" -{ $subsection run-user-init } -{ $subsection run-bootstrap-init } ; +"A word to run this file from an existing Factor session:" +{ $subsection run-bootstrap-init } +"For example, if you changed " { $snippet ".factor-boot-rc" } " and do not want to bootstrap again, you can just invoke " { $link run-bootstrap-init } " in the listener." ; + +ARTICLE: "factor-rc" "Startup initialization file" +"The startup initialization file is named " { $snippet "factor-rc" } " on Windows and " { $snippet ".factor-rc" } " on Unix. If it exists, it is run every time Factor starts." +$nl +"A word to run this file from an existing Factor session:" +{ $subsection run-user-init } ; + +ARTICLE: "rc-files" "Running code on startup" +"Factor looks for two files in your home directory." +{ $subsection "factor-boot-rc" } +{ $subsection "factor-rc" } +"The " { $snippet "-no-user-init" } " command line switch will inhibit the running of these files." +$nl +"If you are unsure where the files should be located, evaluate the following code:" +{ $code + "USE: command-line" + "\"factor-rc\" rc-path print" + "\"factor-boot-rc\" rc-path print" +} +"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration, adds an additional vocabulary root (see " { $link "vocabs.roots" } "), and increases the font size in the UI by setting the DPI (dots-per-inch) variable:" +{ $code + "USING: editors.gvim vocabs.loader ui.freetype namespaces sequences ;" + "\"/opt/local/bin\" \\ gvim-path set-global" + "\"/home/jane/src/\" vocab-roots get push" + "100 dpi set-global" +} ; ARTICLE: "cli" "Command line usage" "Zero or more command line arguments may be passed to the Factor runtime. Command line arguments starting with a dash (" { $snippet "-" } ") is interpreted as switches. All other arguments are taken to be file names to be run by " { $link run-file } "." diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor index 37dbf9b7a6..7691f6877b 100644 --- a/basis/command-line/command-line.factor +++ b/basis/command-line/command-line.factor @@ -5,14 +5,18 @@ kernel.private namespaces parser sequences strings system splitting io.files eval ; IN: command-line +: rc-path ( name -- path ) + os windows? [ "." prepend ] unless + home prepend-path ; + : run-bootstrap-init ( -- ) "user-init" get [ - home ".factor-boot-rc" append-path ?run-file + "factor-boot-rc" rc-path ?run-file ] when ; : run-user-init ( -- ) "user-init" get [ - home ".factor-rc" append-path ?run-file + "factor-rc" rc-path ?run-file ] when ; : cli-var-param ( name value -- ) swap set-global ; From 251f9213c328d2a8fff678244ad9f49d21a700eb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 19:19:53 -0600 Subject: [PATCH 022/102] Fix typo --- core/vocabs/loader/loader-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor index ebaf8b3c8f..1325110122 100644 --- a/core/vocabs/loader/loader-docs.factor +++ b/core/vocabs/loader/loader-docs.factor @@ -11,7 +11,7 @@ ARTICLE: "vocabs.roots" "Vocabulary roots" { { $snippet "extra" } " - additional contributed libraries." } { { $snippet "work" } " - a root for vocabularies which are not intended to be contributed back to Factor." } } -"Your own vocabularies should go into " { $snippet "extra" } " or " { $snippet "work" } ", depending on whether or not you intend to contribute them back to the Factor project. If you wish to work on vocabularies outside of the Factor source directory, create a " { $snippet "~/.factor-rc" } " file like the following," +"Your own vocabularies should go into " { $snippet "extra" } " or " { $snippet "work" } ", depending on whether or not you intend to contribute them back to the Factor project. If you wish to work on vocabularies outside of the Factor source directory, create a " { $link "factor-boot-rc" } " file like the following:" { $code "USING: namespaces sequences vocabs.loader ;" "\"/home/jane/sources/\" vocab-roots get push" From 8b5b887b7e19fab8df254484c6a46376da3bc9be Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 19:20:35 -0600 Subject: [PATCH 023/102] geom depends on mortar which has compiler errors. moving to unmaintained --- extra/cfdg/models/game1-turn6/game1-turn6.factor | 2 +- extra/cfdg/models/sierpinski/sierpinski.factor | 2 +- {extra => unmaintained}/geom/dim/authors.txt | 0 {extra => unmaintained}/geom/dim/dim.factor | 0 {extra => unmaintained}/geom/pos/authors.txt | 0 {extra => unmaintained}/geom/pos/pos.factor | 0 {extra => unmaintained}/geom/rect/authors.txt | 0 {extra => unmaintained}/geom/rect/rect.factor | 0 8 files changed, 2 insertions(+), 2 deletions(-) rename {extra => unmaintained}/geom/dim/authors.txt (100%) rename {extra => unmaintained}/geom/dim/dim.factor (100%) rename {extra => unmaintained}/geom/pos/authors.txt (100%) rename {extra => unmaintained}/geom/pos/pos.factor (100%) rename {extra => unmaintained}/geom/rect/authors.txt (100%) rename {extra => unmaintained}/geom/rect/rect.factor (100%) diff --git a/extra/cfdg/models/game1-turn6/game1-turn6.factor b/extra/cfdg/models/game1-turn6/game1-turn6.factor index 5e512cd74a..66424acff7 100644 --- a/extra/cfdg/models/game1-turn6/game1-turn6.factor +++ b/extra/cfdg/models/game1-turn6/game1-turn6.factor @@ -1,6 +1,6 @@ USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate - mortar random-weighted cfdg ; + random-weighted cfdg ; IN: cfdg.models.game1-turn6 diff --git a/extra/cfdg/models/sierpinski/sierpinski.factor b/extra/cfdg/models/sierpinski/sierpinski.factor index 2333506f29..8257302a3e 100644 --- a/extra/cfdg/models/sierpinski/sierpinski.factor +++ b/extra/cfdg/models/sierpinski/sierpinski.factor @@ -1,6 +1,6 @@ USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate - mortar random-weighted cfdg ; + random-weighted cfdg ; IN: cfdg.models.sierpinski diff --git a/extra/geom/dim/authors.txt b/unmaintained/geom/dim/authors.txt similarity index 100% rename from extra/geom/dim/authors.txt rename to unmaintained/geom/dim/authors.txt diff --git a/extra/geom/dim/dim.factor b/unmaintained/geom/dim/dim.factor similarity index 100% rename from extra/geom/dim/dim.factor rename to unmaintained/geom/dim/dim.factor diff --git a/extra/geom/pos/authors.txt b/unmaintained/geom/pos/authors.txt similarity index 100% rename from extra/geom/pos/authors.txt rename to unmaintained/geom/pos/authors.txt diff --git a/extra/geom/pos/pos.factor b/unmaintained/geom/pos/pos.factor similarity index 100% rename from extra/geom/pos/pos.factor rename to unmaintained/geom/pos/pos.factor diff --git a/extra/geom/rect/authors.txt b/unmaintained/geom/rect/authors.txt similarity index 100% rename from extra/geom/rect/authors.txt rename to unmaintained/geom/rect/authors.txt diff --git a/extra/geom/rect/rect.factor b/unmaintained/geom/rect/rect.factor similarity index 100% rename from extra/geom/rect/rect.factor rename to unmaintained/geom/rect/rect.factor From 9e82f1f8dd96efccbd3834f01d34ebf93258cc19 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 19:42:53 -0600 Subject: [PATCH 024/102] Better inference error messages --- basis/compiler/tree/builder/builder.factor | 12 ++++-------- basis/stack-checker/errors/errors.factor | 2 +- .../recursive-state/recursive-state.factor | 4 +--- 3 files changed, 6 insertions(+), 12 deletions(-) diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index c2ec6552cd..4e79c4cd2d 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -34,14 +34,10 @@ IN: compiler.tree.builder if ; : (build-tree-from-word) ( word -- ) - dup - [ "inline" word-prop ] - [ "recursive" word-prop ] bi and [ - 1quotation f initial-recursive-state infer-quot - ] [ - [ specialized-def ] [ initial-recursive-state ] bi - infer-quot - ] if ; + dup initial-recursive-state recursive-state set + dup [ "inline" word-prop ] [ "recursive" word-prop ] bi and + [ 1quotation ] [ specialized-def ] if + infer-quot-here ; : check-cannot-infer ( word -- ) dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ; diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index efdc7e23b2..9fb2b59f6c 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -24,7 +24,7 @@ M: inference-error error-help error>> error-help ; +warning+ (inference-error) ; inline M: inference-error error. - [ "In word: " write word>> . ] [ error>> error. ] bi ; + [ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ; TUPLE: literal-expected ; diff --git a/basis/stack-checker/recursive-state/recursive-state.factor b/basis/stack-checker/recursive-state/recursive-state.factor index 41d7331230..9abfb1fcd5 100644 --- a/basis/stack-checker/recursive-state/recursive-state.factor +++ b/basis/stack-checker/recursive-state/recursive-state.factor @@ -4,9 +4,7 @@ USING: accessors arrays sequences kernel sequences assocs namespaces stack-checker.recursive-state.tree ; IN: stack-checker.recursive-state -TUPLE: recursive-state words word quotations inline-words ; - -C: recursive-state +TUPLE: recursive-state word words quotations inline-words ; : prepare-recursive-state ( word rstate -- rstate ) swap >>word From f29300c6ba727579ce289766a25a240fc8288681 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 16 Nov 2008 19:47:52 -0600 Subject: [PATCH 025/102] Better error message when vocab top level forms leave crap on the stack --- core/vocabs/loader/loader-tests.factor | 9 +++++++-- core/vocabs/loader/loader.factor | 2 +- core/vocabs/loader/test/e/e.factor | 1 + core/vocabs/loader/test/e/tags.txt | 1 + 4 files changed, 10 insertions(+), 3 deletions(-) create mode 100644 core/vocabs/loader/test/e/e.factor create mode 100644 core/vocabs/loader/test/e/tags.txt diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 5ba7f7ed88..3f06b9735c 100644 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -1,9 +1,9 @@ -! Unit tests for vocabs.loader vocabulary IN: vocabs.loader.tests USING: vocabs.loader tools.test continuations vocabs math kernel arrays sequences namespaces io.streams.string parser source-files words assocs classes.tuple definitions -debugger compiler.units tools.vocabs accessors eval ; +debugger compiler.units tools.vocabs accessors eval +combinators ; ! This vocab should not exist, but just in case... [ ] [ @@ -151,3 +151,8 @@ forget-junk [ "xabbabbja" forget-vocab ] with-compilation-unit forget-junk + +[ ] [ [ "vocabs.loader.test.e" forget-vocab ] with-compilation-unit ] unit-test + +[ "vocabs.loader.test.e" require ] +[ relative-overflow? ] must-fail-with diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index f48a3d1950..690b8b0d92 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -55,7 +55,7 @@ SYMBOL: load-help? f over set-vocab-source-loaded? [ vocab-source-path [ parse-file ] [ [ ] ] if* ] keep t swap set-vocab-source-loaded? - [ % ] [ call ] if-bootstrapping ; + [ % ] [ assert-depth ] if-bootstrapping ; : load-docs ( vocab -- vocab ) load-help? get [ diff --git a/core/vocabs/loader/test/e/e.factor b/core/vocabs/loader/test/e/e.factor new file mode 100644 index 0000000000..b85905ec0b --- /dev/null +++ b/core/vocabs/loader/test/e/e.factor @@ -0,0 +1 @@ +1 2 3 diff --git a/core/vocabs/loader/test/e/tags.txt b/core/vocabs/loader/test/e/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/core/vocabs/loader/test/e/tags.txt @@ -0,0 +1 @@ +unportable From c7f5d53144fbe560f611a240fb609df65a5f14c0 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sun, 16 Nov 2008 21:24:56 -0500 Subject: [PATCH 026/102] Cleanup math.functions and remove >r r> usages --- basis/math/functions/functions.factor | 28 +++++++++++++-------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 43efc35c27..4fa83a9904 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -15,7 +15,7 @@ IN: math.functions PRIVATE> : rect> ( x y -- z ) - over real? over real? and [ + 2dup [ real? ] both? [ (rect>) ] [ "Complex number must have real components" throw @@ -27,10 +27,10 @@ M: real sqrt >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ; : each-bit ( n quot: ( ? -- ) -- ) - over 0 = pick -1 = or [ + over [ 0 = ] [ -1 = ] bi or [ 2drop ] [ - 2dup >r >r >r odd? r> call r> 2/ r> each-bit + 2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread ] if ; inline recursive : map-bits ( n quot: ( ? -- obj ) -- seq ) @@ -69,8 +69,7 @@ PRIVATE> >rect [ >float ] bi@ ; inline : >polar ( z -- abs arg ) - >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; - inline + >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; inline : cis ( arg -- z ) dup fcos swap fsin rect> ; inline @@ -79,11 +78,10 @@ PRIVATE> r >r >float-rect swap r> swap fpow r> rot * fexp /f ; - inline + [ >float-rect swap ] [ swap fpow ] [ rot * fexp /f ] tri* ; inline : ^theta ( w abs arg -- theta ) - >r >r >float-rect r> flog * swap r> * + ; inline + [ >float-rect ] [ flog * swap ] [ * + ] tri* ; inline : ^complex ( x y -- z ) swap >polar [ ^mag ] [ ^theta ] 3bi polar> ; inline @@ -106,18 +104,18 @@ PRIVATE> : (^mod) ( n x y -- z ) 1 swap [ - [ dupd * pick mod ] when >r sq over mod r> + [ dupd * pick mod ] when [ sq over mod ] dip ] each-bit 2nip ; inline : (gcd) ( b a x y -- a d ) over zero? [ 2nip ] [ - swap [ /mod >r over * swapd - r> ] keep (gcd) + swap [ /mod [ over * swapd - ] dip ] keep (gcd) ] if ; : gcd ( x y -- a d ) - 0 -rot 1 -rot (gcd) dup 0 < [ neg ] when ; foldable + [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable : lcm ( a b -- c ) [ * ] 2keep gcd nip /i ; foldable @@ -131,7 +129,7 @@ PRIVATE> : ^mod ( x y n -- z ) over 0 < [ - [ >r neg r> ^mod ] keep mod-inv + [ [ neg ] dip ^mod ] keep mod-inv ] [ -rot (^mod) ] if ; foldable @@ -141,14 +139,14 @@ GENERIC: absq ( x -- y ) foldable M: real absq sq ; : ~abs ( x y epsilon -- ? ) - >r - abs r> < ; + [ - abs ] dip < ; : ~rel ( x y epsilon -- ? ) - >r [ - abs ] 2keep [ abs ] bi@ + r> * < ; + [ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ; : ~ ( x y epsilon -- ? ) { - { [ pick fp-nan? pick fp-nan? or ] [ 3drop f ] } + { [ pick pick [ fp-nan? ] either? ] [ 3drop f ] } { [ dup zero? ] [ drop number= ] } { [ dup 0 < ] [ ~rel ] } [ ~abs ] From 67878c389ba48283ec32341b1cad76056fbbc801 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 16 Nov 2008 20:55:25 -0600 Subject: [PATCH 027/102] automata: minor indentation fix --- extra/automata/automata.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/automata/automata.factor b/extra/automata/automata.factor index 979a733692..0f3fdcd3f6 100644 --- a/extra/automata/automata.factor +++ b/extra/automata/automata.factor @@ -25,7 +25,7 @@ VAR: rule VAR: rule-number : rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-left string>digits ; : set-rule ( n -- ) -dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; + dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! step-capped-line @@ -37,7 +37,7 @@ dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; : cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ; : wrap-line ( a-line-z -- za-line-za ) -dup peek 1array swap dup first 1array append append ; + dup peek 1array swap dup first 1array append append ; : step-line ( line -- new-line ) 3 [ pattern>state ] map ; From 7688c8eb482f2ae80c66a0d677b29932bc83fd2a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 16 Nov 2008 21:20:00 -0600 Subject: [PATCH 028/102] automata: more indentation fixes --- extra/automata/automata.factor | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/extra/automata/automata.factor b/extra/automata/automata.factor index 0f3fdcd3f6..9001521490 100644 --- a/extra/automata/automata.factor +++ b/extra/automata/automata.factor @@ -13,14 +13,14 @@ VAR: rule VAR: rule-number : init-rule ( -- ) 8 >rule ; : rule-keys ( -- array ) -{ { 1 1 1 } - { 1 1 0 } - { 1 0 1 } - { 1 0 0 } - { 0 1 1 } - { 0 1 0 } - { 0 0 1 } - { 0 0 0 } } ; + { { 1 1 1 } + { 1 1 0 } + { 1 0 1 } + { 1 0 0 } + { 0 1 1 } + { 0 1 0 } + { 0 0 1 } + { 0 0 0 } } ; : rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-left string>digits ; @@ -61,8 +61,8 @@ VARS: width height ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : interesting ( -- seq ) -{ 18 22 26 30 41 45 54 60 73 75 82 86 89 90 97 101 102 105 106 107 109 - 110 120 121 122 124 126 129 137 146 147 149 150 151 153 154 161 165 } ; + { 18 22 26 30 41 45 54 60 73 75 82 86 89 90 97 101 102 105 106 107 109 + 110 120 121 122 124 126 129 137 146 147 149 150 151 153 154 161 165 } ; : mild ( -- seq ) { 6 9 11 57 62 74 118 } ; @@ -75,7 +75,7 @@ VAR: bitmap VAR: last-line : run-rule ( -- ) -last-line> height> [ drop step-capped-line dup ] map >bitmap >last-line ; + last-line> height> [ drop step-capped-line dup ] map >bitmap >last-line ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From fb45cd9e5549888702aa91f130439d67f12c7d43 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 16 Nov 2008 23:31:36 -0600 Subject: [PATCH 029/102] automata.ui: minor indentation fix --- extra/automata/ui/ui.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor index cfb0462877..9210097cab 100644 --- a/extra/automata/ui/ui.factor +++ b/extra/automata/ui/ui.factor @@ -39,10 +39,10 @@ VAR: slate ! Call a 'model' quotation with the current 'view'. : with-view ( quot -- ) -slate> rect-dim first >width -slate> rect-dim second >height -call -slate> relayout-1 ; + slate> rect-dim first >width + slate> rect-dim second >height + call + slate> relayout-1 ; ! Create a quotation that is appropriate for buttons and gesture handler. From 403381a6f3b48cd89274ef457df3f6773884025c Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 17 Nov 2008 00:49:42 -0600 Subject: [PATCH 030/102] boids: minor indentation fix --- extra/boids/boids.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 8c045ee270..c3cf1077e9 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -76,7 +76,7 @@ VAR: separation-radius : constrain ( n a b -- n ) rot min max ; : angle-between ( vec vec -- angle ) -2dup v. -rot norm swap norm * / -1 1 constrain acos rad>deg ; + 2dup v. -rot norm swap norm * / -1 1 constrain acos rad>deg ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 3f85a4e7273292cbe6c6bd82a0a609f387408635 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 05:16:34 -0600 Subject: [PATCH 031/102] OpenGL rendering tweaks --- basis/opengl/opengl.factor | 10 +++++----- basis/ui/freetype/freetype.factor | 1 - basis/ui/gadgets/editors/editors.factor | 4 ++-- basis/ui/render/render.factor | 2 +- 4 files changed, 8 insertions(+), 9 deletions(-) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 64326f340e..8e9cd3a3b8 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -31,7 +31,7 @@ IN: opengl over glEnableClientState dip glDisableClientState ; inline : words>values ( word/value-seq -- value-seq ) - [ dup word? [ execute ] [ ] if ] map ; + [ dup word? [ execute ] when ] map ; : (all-enabled) ( seq quot -- ) over [ glEnable ] each dip [ glDisable ] each ; inline @@ -71,10 +71,10 @@ MACRO: all-enabled-client-state ( seq quot -- ) : (rect-vertices) ( dim -- vertices ) { - [ drop 0 1 ] - [ first 1- 1 ] - [ [ first 1- ] [ second ] bi ] - [ second 0 swap ] + [ drop 0.5 0.5 ] + [ first 0.5 ] + [ [ first ] [ second ] bi ] + [ second 0.5 swap ] } cleave 8 narray >c-float-array ; : rect-vertices ( dim -- ) diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor index 5a6118fb00..d2dfe56ed4 100644 --- a/basis/ui/freetype/freetype.factor +++ b/basis/ui/freetype/freetype.factor @@ -196,7 +196,6 @@ M: freetype-renderer string-height ( open-font string -- h ) :: (draw-string) ( open-font sprites string loc -- ) GL_TEXTURE_2D [ loc [ - -0.5 0.5 0.0 glTranslated string open-font string char-widths scan-sums [ [ open-font sprites ] 2dip draw-char ] 2each diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 0d0611f532..74647a6afb 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -112,7 +112,7 @@ M: editor ungraft* line-height * ; : caret-loc ( editor -- loc ) - [ editor-caret* ] keep 2dup loc>x + [ editor-caret* ] keep 2dup loc>x 1+ rot first rot line>y 2array ; : caret-dim ( editor -- dim ) @@ -120,7 +120,7 @@ M: editor ungraft* : scroll>caret ( editor -- ) dup graft-state>> second [ - dup caret-loc over caret-dim { 1 0 } v+ + dup caret-loc over caret-dim over scroll>rect ] when drop ; diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index 71304aca0b..1e4c9c34f1 100644 --- a/basis/ui/render/render.factor +++ b/basis/ui/render/render.factor @@ -23,7 +23,7 @@ SYMBOL: viewport-translation [ rect-intersect ] keep dim>> dup { 0 1 } v* viewport-translation set { 0 0 } over gl-viewport - -0.5 swap first2 [ 0.5 - ] [ 0.5 + ] bi* 0.5 gluOrtho2D + 0 swap first2 0 gluOrtho2D clip set do-clip ; From b4ae47dfc89374bddbac809268c41d45aaa71fda Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 05:56:53 -0600 Subject: [PATCH 032/102] More OpenGL tweaks --- basis/opengl/opengl.factor | 6 +++--- basis/ui/gadgets/grid-lines/grid-lines.factor | 7 +++++-- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 8e9cd3a3b8..aec7960857 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -72,9 +72,9 @@ MACRO: all-enabled-client-state ( seq quot -- ) : (rect-vertices) ( dim -- vertices ) { [ drop 0.5 0.5 ] - [ first 0.5 ] - [ [ first ] [ second ] bi ] - [ second 0.5 swap ] + [ first 0.5 - 0.5 ] + [ [ first 0.5 - ] [ second 0.5 - ] bi ] + [ second 0.5 - 0.5 swap ] } cleave 8 narray >c-float-array ; : rect-vertices ( dim -- ) diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor index 0356e7fd4d..d7844e3fa3 100644 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -27,6 +27,9 @@ M: grid-lines draw-boundary dup grid set dup rect-dim half-gap v- grid-dim set compute-grid - { 0 1 } draw-grid-lines - { 1 0 } draw-grid-lines + [ { 1 0 } draw-grid-lines ] + [ + { 0.5 -0.5 } gl-translate + { 0 1 } draw-grid-lines + ] bi* ] with-scope ; From 55ce87466f012224a06998fcc20563c4adc10959 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 17 Nov 2008 06:20:25 -0600 Subject: [PATCH 033/102] boids: more indentation fixes --- extra/boids/boids.factor | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index c3cf1077e9..193582524c 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -43,19 +43,19 @@ VAR: separation-radius ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : init-variables ( -- ) -1.0 >cohesion-weight -1.0 >alignment-weight -1.0 >separation-weight + 1.0 >cohesion-weight + 1.0 >alignment-weight + 1.0 >separation-weight -75 >cohesion-radius -50 >alignment-radius -25 >separation-radius + 75 >cohesion-radius + 50 >alignment-radius + 25 >separation-radius -180 >cohesion-view-angle -180 >alignment-view-angle -180 >separation-view-angle + 180 >cohesion-view-angle + 180 >alignment-view-angle + 180 >separation-view-angle -10 >time-slice ; + 10 >time-slice ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! random-boid and random-boids From 0eee4f89d4bdef66edce0462fd6ce31f1ea73c6b Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 17 Nov 2008 06:59:17 -0600 Subject: [PATCH 034/102] Mess around with tags --- basis/calendar/windows/tags.txt | 1 - basis/io/windows/tags.txt | 1 - basis/opengl/gl/windows/tags.txt | 1 - basis/random/windows/tags.txt | 1 - basis/tools/deploy/windows/tags.txt | 1 - basis/windows/com/syntax/tags.txt | 2 -- basis/windows/com/tags.txt | 2 -- basis/windows/com/wrapper/tags.txt | 2 -- basis/windows/dinput/tags.txt | 1 - basis/windows/tags.txt | 1 - extra/game-input/backend/dinput/tags.txt | 5 +---- extra/game-input/backend/iokit/tags.txt | 5 +---- extra/game-input/backend/tags.txt | 4 +--- extra/game-input/scancodes/tags.txt | 3 +-- extra/game-input/tags.txt | 4 +--- extra/hardware-info/windows/tags.txt | 1 - extra/icfp/2006/tags.txt | 2 +- extra/iokit/hid/tags.txt | 3 +-- extra/iokit/tags.txt | 3 +-- extra/joystick-demo/tags.txt | 3 +-- extra/key-caps/tags.txt | 2 +- extra/opengl/shaders/tags.txt | 1 - extra/peg/javascript/ast/tags.txt | 1 + extra/peg/javascript/parser/tags.txt | 1 + extra/peg/javascript/tags.txt | 1 + extra/peg/javascript/tokenizer/tags.txt | 1 + extra/spheres/tags.txt | 1 - 27 files changed, 14 insertions(+), 40 deletions(-) mode change 100644 => 100755 basis/calendar/windows/tags.txt mode change 100644 => 100755 basis/io/windows/tags.txt mode change 100644 => 100755 basis/opengl/gl/windows/tags.txt mode change 100644 => 100755 basis/random/windows/tags.txt mode change 100644 => 100755 basis/tools/deploy/windows/tags.txt mode change 100644 => 100755 basis/windows/com/syntax/tags.txt mode change 100644 => 100755 basis/windows/com/tags.txt mode change 100644 => 100755 basis/windows/com/wrapper/tags.txt mode change 100644 => 100755 basis/windows/tags.txt mode change 100644 => 100755 extra/game-input/backend/iokit/tags.txt mode change 100644 => 100755 extra/game-input/backend/tags.txt mode change 100644 => 100755 extra/game-input/scancodes/tags.txt mode change 100644 => 100755 extra/game-input/tags.txt mode change 100644 => 100755 extra/hardware-info/windows/tags.txt mode change 100644 => 100755 extra/icfp/2006/tags.txt mode change 100644 => 100755 extra/iokit/hid/tags.txt mode change 100644 => 100755 extra/iokit/tags.txt mode change 100644 => 100755 extra/joystick-demo/tags.txt mode change 100644 => 100755 extra/key-caps/tags.txt mode change 100644 => 100755 extra/opengl/shaders/tags.txt mode change 100644 => 100755 extra/peg/javascript/ast/tags.txt mode change 100644 => 100755 extra/peg/javascript/parser/tags.txt mode change 100644 => 100755 extra/peg/javascript/tags.txt mode change 100644 => 100755 extra/peg/javascript/tokenizer/tags.txt mode change 100644 => 100755 extra/spheres/tags.txt diff --git a/basis/calendar/windows/tags.txt b/basis/calendar/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/calendar/windows/tags.txt +++ b/basis/calendar/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/basis/io/windows/tags.txt b/basis/io/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/io/windows/tags.txt +++ b/basis/io/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/basis/opengl/gl/windows/tags.txt b/basis/opengl/gl/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/opengl/gl/windows/tags.txt +++ b/basis/opengl/gl/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/basis/random/windows/tags.txt b/basis/random/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/random/windows/tags.txt +++ b/basis/random/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/basis/tools/deploy/windows/tags.txt b/basis/tools/deploy/windows/tags.txt old mode 100644 new mode 100755 index b58a515ed8..660d511420 --- a/basis/tools/deploy/windows/tags.txt +++ b/basis/tools/deploy/windows/tags.txt @@ -1,3 +1,2 @@ unportable -windows tools diff --git a/basis/windows/com/syntax/tags.txt b/basis/windows/com/syntax/tags.txt old mode 100644 new mode 100755 index 71c5900baf..2320bdd648 --- a/basis/windows/com/syntax/tags.txt +++ b/basis/windows/com/syntax/tags.txt @@ -1,4 +1,2 @@ unportable -windows -com bindings diff --git a/basis/windows/com/tags.txt b/basis/windows/com/tags.txt old mode 100644 new mode 100755 index 71c5900baf..2320bdd648 --- a/basis/windows/com/tags.txt +++ b/basis/windows/com/tags.txt @@ -1,4 +1,2 @@ unportable -windows -com bindings diff --git a/basis/windows/com/wrapper/tags.txt b/basis/windows/com/wrapper/tags.txt old mode 100644 new mode 100755 index 71c5900baf..2320bdd648 --- a/basis/windows/com/wrapper/tags.txt +++ b/basis/windows/com/wrapper/tags.txt @@ -1,4 +1,2 @@ unportable -windows -com bindings diff --git a/basis/windows/dinput/tags.txt b/basis/windows/dinput/tags.txt index 1431506222..2320bdd648 100755 --- a/basis/windows/dinput/tags.txt +++ b/basis/windows/dinput/tags.txt @@ -1,3 +1,2 @@ unportable -windows bindings diff --git a/basis/windows/tags.txt b/basis/windows/tags.txt old mode 100644 new mode 100755 index 1431506222..2320bdd648 --- a/basis/windows/tags.txt +++ b/basis/windows/tags.txt @@ -1,3 +1,2 @@ unportable -windows bindings diff --git a/extra/game-input/backend/dinput/tags.txt b/extra/game-input/backend/dinput/tags.txt index 9098dfdba4..82506ff250 100755 --- a/extra/game-input/backend/dinput/tags.txt +++ b/extra/game-input/backend/dinput/tags.txt @@ -1,5 +1,2 @@ unportable -input -gamepads -joysticks -windows +games diff --git a/extra/game-input/backend/iokit/tags.txt b/extra/game-input/backend/iokit/tags.txt old mode 100644 new mode 100755 index 704b10bc4c..82506ff250 --- a/extra/game-input/backend/iokit/tags.txt +++ b/extra/game-input/backend/iokit/tags.txt @@ -1,5 +1,2 @@ unportable -gamepads -joysticks -mac -input +games diff --git a/extra/game-input/backend/tags.txt b/extra/game-input/backend/tags.txt old mode 100644 new mode 100755 index 48ad1f6141..84d4140a70 --- a/extra/game-input/backend/tags.txt +++ b/extra/game-input/backend/tags.txt @@ -1,3 +1 @@ -gamepads -joysticks -input +games diff --git a/extra/game-input/scancodes/tags.txt b/extra/game-input/scancodes/tags.txt old mode 100644 new mode 100755 index 6f4814c59c..84d4140a70 --- a/extra/game-input/scancodes/tags.txt +++ b/extra/game-input/scancodes/tags.txt @@ -1,2 +1 @@ -keyboard -input +games diff --git a/extra/game-input/tags.txt b/extra/game-input/tags.txt old mode 100644 new mode 100755 index ae360e1776..84d4140a70 --- a/extra/game-input/tags.txt +++ b/extra/game-input/tags.txt @@ -1,3 +1 @@ -joysticks -gamepads -input +games diff --git a/extra/hardware-info/windows/tags.txt b/extra/hardware-info/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/extra/hardware-info/windows/tags.txt +++ b/extra/hardware-info/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/extra/icfp/2006/tags.txt b/extra/icfp/2006/tags.txt old mode 100644 new mode 100755 index 7102ccb5bb..1e107f52e4 --- a/extra/icfp/2006/tags.txt +++ b/extra/icfp/2006/tags.txt @@ -1 +1 @@ -icfp +examples diff --git a/extra/iokit/hid/tags.txt b/extra/iokit/hid/tags.txt old mode 100644 new mode 100755 index c83070b657..bf2a35f15b --- a/extra/iokit/hid/tags.txt +++ b/extra/iokit/hid/tags.txt @@ -1,3 +1,2 @@ -mac bindings -system +unportable diff --git a/extra/iokit/tags.txt b/extra/iokit/tags.txt old mode 100644 new mode 100755 index c83070b657..bf2a35f15b --- a/extra/iokit/tags.txt +++ b/extra/iokit/tags.txt @@ -1,3 +1,2 @@ -mac bindings -system +unportable diff --git a/extra/joystick-demo/tags.txt b/extra/joystick-demo/tags.txt old mode 100644 new mode 100755 index 4d4417f0b8..84d4140a70 --- a/extra/joystick-demo/tags.txt +++ b/extra/joystick-demo/tags.txt @@ -1,2 +1 @@ -gamepads -joysticks +games diff --git a/extra/key-caps/tags.txt b/extra/key-caps/tags.txt old mode 100644 new mode 100755 index c253983475..cb5fc203e1 --- a/extra/key-caps/tags.txt +++ b/extra/key-caps/tags.txt @@ -1 +1 @@ -keyboard +demos diff --git a/extra/opengl/shaders/tags.txt b/extra/opengl/shaders/tags.txt old mode 100644 new mode 100755 index ce0345edc9..21154b6383 --- a/extra/opengl/shaders/tags.txt +++ b/extra/opengl/shaders/tags.txt @@ -1,3 +1,2 @@ opengl -glsl bindings \ No newline at end of file diff --git a/extra/peg/javascript/ast/tags.txt b/extra/peg/javascript/ast/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/ast/tags.txt +++ b/extra/peg/javascript/ast/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/peg/javascript/parser/tags.txt b/extra/peg/javascript/parser/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/parser/tags.txt +++ b/extra/peg/javascript/parser/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/peg/javascript/tags.txt b/extra/peg/javascript/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/tags.txt +++ b/extra/peg/javascript/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/peg/javascript/tokenizer/tags.txt b/extra/peg/javascript/tokenizer/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/tokenizer/tags.txt +++ b/extra/peg/javascript/tokenizer/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/spheres/tags.txt b/extra/spheres/tags.txt old mode 100644 new mode 100755 index b9a82374be..36ee50526a --- a/extra/spheres/tags.txt +++ b/extra/spheres/tags.txt @@ -1,3 +1,2 @@ opengl -glsl demos From 553bc1fb7a7055bd2d9ce650e89299c8f7f96b55 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 07:17:05 -0600 Subject: [PATCH 035/102] Fix +

    diff --git a/basis/furnace/auth/features/recover-password/recover-1.xml b/basis/furnace/auth/features/recover-password/recover-1.xml index a8b67513a4..6dc882538e 100644 --- a/basis/furnace/auth/features/recover-password/recover-1.xml +++ b/basis/furnace/auth/features/recover-password/recover-1.xml @@ -32,7 +32,7 @@ - + diff --git a/basis/furnace/auth/features/recover-password/recover-3.xml b/basis/furnace/auth/features/recover-password/recover-3.xml index 2df400ffe2..ec68e27947 100644 --- a/basis/furnace/auth/features/recover-password/recover-3.xml +++ b/basis/furnace/auth/features/recover-password/recover-3.xml @@ -31,7 +31,7 @@

    - +

    diff --git a/basis/furnace/auth/features/registration/register.xml b/basis/furnace/auth/features/registration/register.xml index 45c090905e..1e2fec6dd0 100644 --- a/basis/furnace/auth/features/registration/register.xml +++ b/basis/furnace/auth/features/registration/register.xml @@ -62,7 +62,7 @@

    - +

    diff --git a/basis/furnace/auth/login/login.xml b/basis/furnace/auth/login/login.xml index 917c182fb3..9a37174e95 100644 --- a/basis/furnace/auth/login/login.xml +++ b/basis/furnace/auth/login/login.xml @@ -35,7 +35,7 @@

    - +

    diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index e5fa5d3901..bcaed59ea4 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -30,7 +30,7 @@ - + diff --git a/extra/webapps/pastebin/new-paste.xml b/extra/webapps/pastebin/new-paste.xml index 96339b6cf8..9866c8819a 100644 --- a/extra/webapps/pastebin/new-paste.xml +++ b/extra/webapps/pastebin/new-paste.xml @@ -18,6 +18,6 @@ -

    +

    diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml index 8fe672049f..a48d2ea42d 100644 --- a/extra/webapps/pastebin/paste.xml +++ b/extra/webapps/pastebin/paste.xml @@ -52,7 +52,7 @@ -

    +

    diff --git a/extra/webapps/wee-url/shorten.xml b/extra/webapps/wee-url/shorten.xml index 53f611a8d8..3dda556aa2 100644 --- a/extra/webapps/wee-url/shorten.xml +++ b/extra/webapps/wee-url/shorten.xml @@ -4,7 +4,7 @@

    Shorten URL:

    - +     diff --git a/extra/webapps/wiki/edit.xml b/extra/webapps/wiki/edit.xml index 9cb2e92f93..f8c593cf2f 100644 --- a/extra/webapps/wiki/edit.xml +++ b/extra/webapps/wiki/edit.xml @@ -16,7 +16,7 @@

    - +

    diff --git a/extra/webapps/wiki/revisions.xml b/extra/webapps/wiki/revisions.xml index 1d9c01fd65..759cc77449 100644 --- a/extra/webapps/wiki/revisions.xml +++ b/extra/webapps/wiki/revisions.xml @@ -32,7 +32,7 @@ - + From c0b56c4d3ba4ef7f4fc70584a1ba923a89960e17 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 08:47:08 -0600 Subject: [PATCH 036/102] 'see' now shows declarations on methods --- basis/prettyprint/prettyprint-tests.factor | 10 ++++++++++ basis/prettyprint/prettyprint.factor | 3 +++ 2 files changed, 13 insertions(+) diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 6a4ac71eb8..8eaaab3c1d 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -355,3 +355,13 @@ INTERSECTION: intersection-see-test sequence number ; [ ] [ \ curry see ] unit-test [ "POSTPONE: [" ] [ \ [ unparse ] unit-test + +TUPLE: started-out-hustlin' ; + +GENERIC: ended-up-ballin' + +M: started-out-hustlin' ended-up-ballin' ; inline + +[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [ + [ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer +] unit-test diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index b0293a8759..3befdaff2b 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -253,6 +253,9 @@ M: object see block> ] with-use nl ; +M: method-spec see + first2 method see ; + GENERIC: see-class* ( word -- ) M: union-class see-class* From 543ef13a7d30ad86ed398de5a6ec8b20af38109f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 09:01:01 -0600 Subject: [PATCH 037/102] Shorter help filenames --- basis/help/html/html.factor | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 4100a34d72..d2d0725a1e 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -10,17 +10,15 @@ IN: help.html : escape-char ( ch -- ) dup H{ - { CHAR: " "__quote__" } + { CHAR: " "__quo__" } { CHAR: * "__star__" } { CHAR: : "__colon__" } { CHAR: < "__lt__" } { CHAR: > "__gt__" } - { CHAR: ? "__question__" } - { CHAR: \\ "__backslash__" } + { CHAR: ? "__que__" } + { CHAR: \\ "__back__" } { CHAR: | "__pipe__" } - { CHAR: _ "__underscore__" } { CHAR: / "__slash__" } - { CHAR: \\ "__backslash__" } { CHAR: , "__comma__" } { CHAR: @ "__at__" } } at [ % ] [ , ] ?if ; From 672f9e400e4845f1cda10efc3cc985c13e38dee4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 11:16:32 -0600 Subject: [PATCH 038/102] Better error message --- basis/stack-checker/errors/errors.factor | 6 ++++++ basis/stack-checker/known-words/known-words.factor | 2 +- basis/stack-checker/stack-checker-tests.factor | 2 ++ 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 9fb2b59f6c..31ae0a6789 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -108,3 +108,9 @@ M: inconsistent-recursive-call-error error. "The recursive word " write word>> pprint " calls itself with a different set of quotation parameters than were input" print ; + +TUPLE: unknown-primitive-error ; + +M: unknown-primitive-error error. + drop + "Cannot determine stack effect statically" print ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 4aea0f2d28..f1034f2ca6 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -162,7 +162,7 @@ M: object infer-call* { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } - { \ do-primitive [ \ do-primitive cannot-infer-effect ] } + { \ do-primitive [ unknown-primitive-error inference-error ] } { \ alien-invoke [ infer-alien-invoke ] } { \ alien-indirect [ infer-alien-indirect ] } { \ alien-callback [ infer-alien-callback ] } diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 9bf8ed62f0..defcde53f0 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -580,3 +580,5 @@ DEFER: eee' dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive [ bogus-error ] must-infer + +[ [ clear ] infer. ] [ inference-error? ] must-fail-with From a166db313aaf090048914b85c2fd38bf387672df Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 12:23:12 -0600 Subject: [PATCH 039/102] Inferring set-datastack is just a warning not an error --- basis/stack-checker/known-words/known-words.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index f1034f2ca6..fdc4b4b35c 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -162,7 +162,7 @@ M: object infer-call* { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } - { \ do-primitive [ unknown-primitive-error inference-error ] } + { \ do-primitive [ unknown-primitive-error inference-warning ] } { \ alien-invoke [ infer-alien-invoke ] } { \ alien-indirect [ infer-alien-indirect ] } { \ alien-callback [ infer-alien-callback ] } From 14246fde379df2117238498b2094920c417af33b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 12:23:44 -0600 Subject: [PATCH 040/102] Better FFI unit tests expose a new problem --- basis/compiler/tests/alien.factor | 14 +++++++++++--- vm/ffi_test.c | 12 +++++++++++- vm/ffi_test.h | 3 ++- 3 files changed, 24 insertions(+), 5 deletions(-) diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index d7e82402d5..3ca6fc87f3 100644 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -146,13 +146,21 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3, ! Make sure XT doesn't get clobbered in stack frame -: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a ptr -- result y ) - "void" +: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y ) + "int" f "ffi_test_31" { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" } alien-invoke gc 3 ; -[ 3 ] [ 42 [ ] each ffi_test_31 ] unit-test +[ 861 3 ] [ 42 [ ] each ffi_test_31 ] unit-test + +: ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result ) + "float" + f "ffi_test_31_point_5" + { "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" } + alien-invoke ; + +[ 861.0 ] [ 42 [ >float ] each ffi_test_31_point_5 ] unit-test FUNCTION: longlong ffi_test_21 long x long y ; diff --git a/vm/ffi_test.c b/vm/ffi_test.c index 081ae42ebf..7ae4491d80 100755 --- a/vm/ffi_test.c +++ b/vm/ffi_test.c @@ -224,7 +224,17 @@ struct test_struct_7 ffi_test_30(void) return s; } -void ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41) { } +int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41) +{ + printf("ffi_test_31(%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d)\n",x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41); + return x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + x40 + x41; +} + +float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41) +{ + printf("ffi_test_31_point_5(%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f)\n",x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41); + return x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + x40 + x41; +} double ffi_test_32(struct test_struct_8 x, int y) { diff --git a/vm/ffi_test.h b/vm/ffi_test.h index f9195a4285..7c51261157 100755 --- a/vm/ffi_test.h +++ b/vm/ffi_test.h @@ -48,7 +48,8 @@ struct test_struct_6 { char x, y, z, a, b, c; }; DLLEXPORT struct test_struct_6 ffi_test_29(void); struct test_struct_7 { char x, y, z, a, b, c, d; }; DLLEXPORT struct test_struct_7 ffi_test_30(void); -DLLEXPORT void ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41); +DLLEXPORT int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41); +DLLEXPORT float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41); struct test_struct_8 { double x; double y; }; DLLEXPORT double ffi_test_32(struct test_struct_8 x, int y); struct test_struct_9 { float x; float y; }; From 20f5541d35c6a064d328b9da568298b02aa49ccf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 13:34:37 -0600 Subject: [PATCH 041/102] Refactoring FFI for Win64 --- basis/alien/c-types/c-types.factor | 2 +- basis/alien/structs/structs.factor | 28 ++++++++++++---------- basis/compiler/codegen/codegen.factor | 4 ++-- basis/cpu/architecture/architecture.factor | 17 +++---------- basis/cpu/ppc/linux/linux.factor | 2 +- basis/cpu/ppc/macosx/macosx.factor | 2 +- basis/cpu/x86/64/winnt/winnt.factor | 5 ++-- basis/cpu/x86/x86.factor | 2 +- 8 files changed, 27 insertions(+), 35 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index a93c87611d..b4e4d05f2e 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -164,7 +164,7 @@ GENERIC: stack-size ( type -- size ) foldable M: string stack-size c-type stack-size ; -M: c-type stack-size size>> ; +M: c-type stack-size size>> cell align ; GENERIC: byte-length ( seq -- n ) flushable diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index ce30a2ee25..adb25aa977 100644 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -1,14 +1,10 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays generic hashtables kernel kernel.private -math namespaces parser sequences strings words libc +math namespaces parser sequences strings words libc fry alien.c-types alien.structs.fields cpu.architecture ; IN: alien.structs -: if-value-structs? ( ctype true false -- ) - value-structs? - [ drop call ] [ >r 2drop "void*" r> call ] if ; inline - TUPLE: struct-type size align fields ; M: struct-type heap-size size>> ; @@ -17,20 +13,26 @@ M: struct-type c-type-align align>> ; M: struct-type c-type-stack-align? drop f ; -M: struct-type unbox-parameter - [ %unbox-struct ] [ unbox-parameter ] if-value-structs? ; +: if-value-struct ( ctype true false -- ) + [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline -M: struct-type unbox-return - f swap %unbox-struct ; +M: struct-type unbox-parameter + [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; M: struct-type box-parameter - [ %box-struct ] [ box-parameter ] if-value-structs? ; + [ %box-large-struct ] [ box-parameter ] if-value-struct ; + +: if-small-struct ( c-type true false -- ? ) + [ dup struct-small-enough? ] 2dip '[ f swap @ ] if ; inline + +M: struct-type unbox-return + [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ; M: struct-type box-return - f swap %box-struct ; + [ %box-small-struct ] [ %box-large-struct ] if-small-struct ; M: struct-type stack-size - [ heap-size ] [ stack-size ] if-value-structs? ; + [ heap-size ] [ stack-size ] if-value-struct ; : c-struct? ( type -- ? ) (c-type) struct-type? ; @@ -40,7 +42,7 @@ M: struct-type stack-size -rot define-c-type ; : define-struct-early ( name vocab fields -- fields ) - -rot [ rot first2 ] 2curry map ; + [ first2 ] with with map ; : compute-struct-align ( types -- n ) [ c-type-align ] map supremum ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 0d45b28126..9f6e8e9c9b 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -235,7 +235,7 @@ M: float-regs reg-class-variable drop float-regs ; GENERIC: inc-reg-class ( register-class -- ) : ?dummy-stack-params ( reg-class -- ) - dummy-stack-params? [ reg-size stack-params +@ ] [ drop ] if ; + dummy-stack-params? [ reg-size cell align stack-params +@ ] [ drop ] if ; : ?dummy-int-params ( reg-class -- ) dummy-int-params? [ reg-size cell /i 1 max int-regs +@ ] [ drop ] if ; @@ -264,7 +264,7 @@ M: object reg-class-full? : spill-param ( reg-class -- n reg-class ) stack-params get - >r reg-size stack-params +@ r> + >r reg-size cell align stack-params +@ r> stack-params ; : fastcall-param ( reg-class -- n reg-class ) diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 96dd577c10..d26e7f6ff7 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -141,10 +141,10 @@ HOOK: %loop-entry cpu ( -- ) HOOK: small-enough? cpu ( n -- ? ) ! Is this structure small enough to be returned in registers? -HOOK: struct-small-enough? cpu ( heap-size -- ? ) +HOOK: struct-small-enough? cpu ( c-type -- ? ) -! Do we pass value structs by value or hidden reference? -HOOK: value-structs? cpu ( -- ? ) +! Do we pass this struct by value or hidden reference? +HOOK: value-struct? cpu ( c-type -- ? ) ! If t, all parameters are shadowed by dummy stack parameters HOOK: dummy-stack-params? cpu ( -- ? ) @@ -207,14 +207,3 @@ M: object %callback-return drop %return ; M: stack-params param-reg drop ; M: stack-params param-regs drop f ; - -: if-small-struct ( n size true false -- ? ) - [ 2dup [ not ] [ struct-small-enough? ] bi* and ] 2dip - [ '[ nip @ ] ] dip if ; - inline - -: %unbox-struct ( n c-type -- ) - [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ; - -: %box-struct ( n c-type -- ) - [ %box-small-struct ] [ %box-large-struct ] if-small-struct ; diff --git a/basis/cpu/ppc/linux/linux.factor b/basis/cpu/ppc/linux/linux.factor index 090495aa11..5cfa1391c4 100644 --- a/basis/cpu/ppc/linux/linux.factor +++ b/basis/cpu/ppc/linux/linux.factor @@ -15,7 +15,7 @@ M: linux lr-save 1 cells ; M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ; -M: ppc value-structs? f ; +M: ppc value-struct? drop f ; M: ppc dummy-stack-params? f ; diff --git a/basis/cpu/ppc/macosx/macosx.factor b/basis/cpu/ppc/macosx/macosx.factor index 877fb37d31..c742cf2ddc 100644 --- a/basis/cpu/ppc/macosx/macosx.factor +++ b/basis/cpu/ppc/macosx/macosx.factor @@ -16,7 +16,7 @@ M: macosx lr-save 2 cells ; M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ; -M: ppc value-structs? t ; +M: ppc value-struct? drop t ; M: ppc dummy-stack-params? t ; diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 0124c40877..92560ef5e9 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -10,8 +10,9 @@ M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ; M: x86.64 reserved-area-size 4 cells ; -M: x86.64 struct-small-enough? ( size -- ? ) - heap-size cell <= ; +M: x86.64 struct-small-enough? heap-size { 1 2 4 8 } member? ; + +M: x86.64 value-struct? heap-size { 1 2 4 8 } member? ; M: x86.64 dummy-stack-params? f ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index dfe3d3e55e..58d95ffcde 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -507,7 +507,7 @@ M: x86 %prepare-alien-invoke temp-reg-1 2 cells [+] ds-reg MOV temp-reg-1 3 cells [+] rs-reg MOV ; -M: x86 value-structs? t ; +M: x86 value-struct? drop t ; M: x86 small-enough? ( n -- ? ) HEX: -80000000 HEX: 7fffffff between? ; From 5d8b3c3fb13f4404f0eb16a868aa729c6edf50b1 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 17:20:56 -0500 Subject: [PATCH 042/102] Cleanup math.intervals and eliminate >r r> usage --- basis/math/intervals/intervals.factor | 34 +++++++++++++-------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 54ee0ac894..4182d25524 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -12,10 +12,10 @@ SYMBOL: full-interval TUPLE: interval { from read-only } { to read-only } ; : ( from to -- int ) - over first over first { + 2dup [ first ] bi@ { { [ 2dup > ] [ 2drop 2drop empty-interval ] } { [ 2dup = ] [ - 2drop over second over second and + 2drop 2dup [ second ] both? [ interval boa ] [ 2drop empty-interval ] if ] } [ 2drop interval boa ] @@ -26,16 +26,16 @@ TUPLE: interval { from read-only } { to read-only } ; : closed-point ( n -- endpoint ) t 2array ; : [a,b] ( a b -- interval ) - >r closed-point r> closed-point ; foldable + [ closed-point ] dip closed-point ; foldable : (a,b) ( a b -- interval ) - >r open-point r> open-point ; foldable + [ open-point ] dip open-point ; foldable : [a,b) ( a b -- interval ) - >r closed-point r> open-point ; foldable + [ closed-point ] dip open-point ; foldable : (a,b] ( a b -- interval ) - >r open-point r> closed-point ; foldable + [ open-point ] dip closed-point ; foldable : [a,a] ( a -- interval ) closed-point dup ; foldable @@ -51,11 +51,11 @@ TUPLE: interval { from read-only } { to read-only } ; : [-inf,inf] ( -- interval ) full-interval ; inline : compare-endpoints ( p1 p2 quot -- ? ) - >r over first over first r> call [ + [ 2dup [ first ] bi@ ] dip call [ 2drop t ] [ - over first over first = [ - swap second swap second not or + 2dup [ first ] bi@ = [ + [ second ] bi@ not or ] [ 2drop f ] if @@ -86,7 +86,7 @@ TUPLE: interval { from read-only } { to read-only } ; ] if ; : (interval-op) ( p1 p2 quot -- p3 ) - [ [ first ] [ first ] [ ] tri* call ] + [ [ first ] [ first ] [ call ] tri* ] [ drop [ second ] both? ] 3bi 2array ; inline @@ -177,7 +177,7 @@ TUPLE: interval { from read-only } { to read-only } ; drop f ] [ interval>points - 2dup [ second ] bi@ and + 2dup [ second ] both? [ [ first ] bi@ = ] [ 2drop f ] if ] if ; @@ -193,9 +193,9 @@ TUPLE: interval { from read-only } { to read-only } ; dup [ interval>points [ first ] bi@ [a,b] ] when ; : interval-integer-op ( i1 i2 quot -- i3 ) - >r 2dup - [ interval>points [ first integer? ] both? ] both? - r> [ 2drop [-inf,inf] ] if ; inline + [ + 2dup [ interval>points [ first integer? ] both? ] both? + ] dip [ 2drop [-inf,inf] ] if ; inline : interval-shift ( i1 i2 -- i3 ) #! Inaccurate; could be tighter @@ -302,7 +302,7 @@ SYMBOL: incomparable 2tri and and ; : (interval<) ( i1 i2 -- i1 i2 ? ) - over from>> over from>> endpoint< ; + 2dup [ from>> ] bi@ endpoint< ; : interval< ( i1 i2 -- ? ) { @@ -314,10 +314,10 @@ SYMBOL: incomparable } cond 2nip ; : left-endpoint-<= ( i1 i2 -- ? ) - >r from>> r> to>> = ; + [ from>> ] dip to>> = ; : right-endpoint-<= ( i1 i2 -- ? ) - >r to>> r> from>> = ; + [ to>> ] dip from>> = ; : interval<= ( i1 i2 -- ? ) { From d328589b87c05cfb40a8c1e9363b6d9a0fee5837 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 17:59:15 -0500 Subject: [PATCH 043/102] Cleanup partial-dispatch by removing >r r> usage --- basis/math/partial-dispatch/partial-dispatch.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor index fd0e910b37..6874b79d2e 100644 --- a/basis/math/partial-dispatch/partial-dispatch.factor +++ b/basis/math/partial-dispatch/partial-dispatch.factor @@ -126,7 +126,7 @@ SYMBOL: fast-math-ops : math-method* ( word left right -- quot ) 3dup math-op - [ >r 3drop r> 1quotation ] [ drop math-method ] if ; + [ [ 3drop ] dip 1quotation ] [ drop math-method ] if ; : math-both-known? ( word left right -- ? ) 3dup math-op @@ -157,13 +157,13 @@ SYMBOL: fast-math-ops ] bi@ append ; : each-derived-op ( word quot -- ) - >r derived-ops r> each ; inline + [ derived-ops ] dip each ; inline : each-fast-derived-op ( word quot -- ) - >r fast-derived-ops r> each ; inline + [ fast-derived-ops ] dip each ; inline : each-integer-derived-op ( word quot -- ) - >r integer-derived-ops r> each ; inline + [ integer-derived-ops ] dip each ; inline [ [ From fa88f8825b6656cf66ae7c74516e8d9ea881ede1 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:13:42 -0500 Subject: [PATCH 044/102] Replace >r r> usage with dip in math.ratios --- basis/math/ratios/ratios.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index d9dea22b7b..81294d29f7 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -12,10 +12,10 @@ IN: math.ratios dup 1 number= [ drop ] [ ] if ; inline : scale ( a/b c/d -- a*d b*c ) - 2>fraction >r * swap r> * swap ; inline + 2>fraction [ * swap ] dip * swap ; inline : ratio+d ( a/b c/d -- b*d ) - denominator swap denominator * ; inline + [ denominator ] bi@ * ; inline PRIVATE> @@ -24,7 +24,7 @@ M: integer / "Division by zero" throw ] [ dup 0 < [ [ neg ] bi@ ] when - 2dup gcd nip tuck /i >r /i r> fraction> + 2dup gcd nip tuck /i [ /i ] dip fraction> ] if ; M: ratio hashcode* @@ -52,7 +52,7 @@ M: ratio >= scale >= ; M: ratio + 2dup scale + -rot ratio+d / ; M: ratio - 2dup scale - -rot ratio+d / ; -M: ratio * 2>fraction * >r * r> / ; +M: ratio * 2>fraction * [ * ] dip / ; M: ratio / scale / ; M: ratio /i scale /i ; M: ratio /f scale /f ; From d2a67c78b2b385b3286d376c50a6f02fbfbb3b3b Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:14:29 -0500 Subject: [PATCH 045/102] Replace >r r> usage with dip in math.ranges --- basis/math/ranges/ranges.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 5acdc43ca3..41fd28e441 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -8,7 +8,7 @@ TUPLE: range { step read-only } ; : ( a b step -- range ) - >r over - r> + [ over - ] dip [ / 1+ 0 max >integer ] keep range boa ; inline From 9c27e9d61bd086cfa44e9ad9451c72c4aa82af81 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:17:14 -0500 Subject: [PATCH 046/102] Replace >r r> usage with dip in math.vectors --- basis/math/vectors/vectors.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 5316720b2f..01a421b4e7 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -25,7 +25,7 @@ IN: math.vectors : normalize ( u -- v ) dup norm v/n ; : set-axis ( u v axis -- w ) - [ >r zero? 2over ? r> swap nth ] map-index 2nip ; + [ [ zero? 2over ? ] dip swap nth ] map-index 2nip ; HINTS: vneg { array } ; HINTS: norm-sq { array } ; From 000d84a8719d689199aec3a343349838935fcc49 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:20:34 -0500 Subject: [PATCH 047/102] Replace pick pick with 2over in math.functions --- basis/math/functions/functions.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 4fa83a9904..c582c560a9 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -146,7 +146,7 @@ M: real absq sq ; : ~ ( x y epsilon -- ? ) { - { [ pick pick [ fp-nan? ] either? ] [ 3drop f ] } + { [ 2over [ fp-nan? ] either? ] [ 3drop f ] } { [ dup zero? ] [ drop number= ] } { [ dup 0 < ] [ ~rel ] } [ ~abs ] From 7815560f30c19699d44e251acf18b4f69d937651 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:28:44 -0600 Subject: [PATCH 048/102] Fix index paths --- basis/help/html/html.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index d2d0725a1e..82e83e60e0 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,10 +115,10 @@ M: result link-href href>> ; [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) - "articles.idx" temp-file offline-apropos ; + "docs/articles.idx" temp-file offline-apropos ; : word-apropos ( string -- results ) - "words.idx" temp-file offline-apropos ; + "docs/words.idx" temp-file offline-apropos ; : vocab-apropos ( string -- results ) - "vocabs.idx" temp-file offline-apropos ; + "docs/vocabs.idx" temp-file offline-apropos ; From b50d4c9b36621be6e96eff3d935d48454e49c39f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:30:47 -0600 Subject: [PATCH 049/102] Fix help search again --- basis/help/html/html.factor | 6 +++--- extra/webapps/help/help.factor | 8 +++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 82e83e60e0..6b90ba6937 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,10 +115,10 @@ M: result link-href href>> ; [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) - "docs/articles.idx" temp-file offline-apropos ; + "articles.idx" offline-apropos ; : word-apropos ( string -- results ) - "docs/words.idx" temp-file offline-apropos ; + "words.idx" offline-apropos ; : vocab-apropos ( string -- results ) - "docs/vocabs.idx" temp-file offline-apropos ; + "vocabs.idx" offline-apropos ; diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index c209fe222e..3072f5d024 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -18,9 +18,11 @@ TUPLE: help-webapp < dispatcher ; help-dir set-current-directory - "search" value article-apropos "articles" set-value - "search" value word-apropos "words" set-value - "search" value vocab-apropos "vocabs" set-value + help-dir [ + "search" value article-apropos "articles" set-value + "search" value word-apropos "words" set-value + "search" value vocab-apropos "vocabs" set-value + ] with-directory { help-webapp "search" } ] >>submit ; From 4d0b5cf7e74c793b1a1b75ff3ea052b24c3b9348 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 17:35:39 -0600 Subject: [PATCH 050/102] Clean up --- extra/webapps/help/help.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index 3072f5d024..6f2c4f0042 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -16,8 +16,6 @@ TUPLE: help-webapp < dispatcher ; { "search" [ 1 v-min-length 50 v-max-length v-one-line ] } } validate-params - help-dir set-current-directory - help-dir [ "search" value article-apropos "articles" set-value "search" value word-apropos "words" set-value From f8e86894a46d3879c233e9d1161626111ac402b8 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:41:21 -0500 Subject: [PATCH 051/102] Minor Project Euler cleanup --- extra/project-euler/047/047.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/project-euler/047/047.factor b/extra/project-euler/047/047.factor index 30c01d8f61..9caaa8776f 100644 --- a/extra/project-euler/047/047.factor +++ b/extra/project-euler/047/047.factor @@ -32,7 +32,7 @@ IN: project-euler.047 Date: Mon, 17 Nov 2008 17:48:06 -0600 Subject: [PATCH 052/102] Fix typo --- basis/compiler/compiler-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 6cb860d33f..512d26f4bf 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -6,7 +6,7 @@ HELP: enable-compiler { $description "Enables the optimizing compiler." } ; HELP: disable-compiler -{ $description "Enables the optimizing compiler." } ; +{ $description "Disable the optimizing compiler." } ; ARTICLE: "compiler-usage" "Calling the optimizing compiler" "Normally, new word definitions are recompiled automatically. This can be changed:" From 6161d99637b3badf687552d9d2ac81a9fca5cad0 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:48:19 -0500 Subject: [PATCH 053/102] Replace nested >r r> with spread in math.statistics --- extra/math/statistics/statistics.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor index 267a95c100..7568af5294 100644 --- a/extra/math/statistics/statistics.factor +++ b/extra/math/statistics/statistics.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Michael Judge. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math math.analysis math.functions sequences sequences.lib - sorting ; +USING: arrays combinators kernel math math.analysis math.functions sequences + sequences.lib sorting ; IN: math.statistics : mean ( seq -- n ) @@ -63,7 +63,7 @@ IN: math.statistics r sq ; : least-squares ( {{x,y}...} -- alpha beta ) - [r] >r >r >r >r 2dup r> r> r> r> + [r] { [ 2dup ] [ ] [ ] [ ] [ ] } spread ! stack is mean(x) mean(y) mean(x) mean(y) {x} {y} sx sy [ (r) ] 2keep ! stack is mean(x) mean(y) r sx sy swap / * ! stack is mean(x) mean(y) beta From eea93234d05abd58a8512d05985541f436ff4652 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:41:53 -0600 Subject: [PATCH 054/102] Fix some types for Win64 --- basis/windows/kernel32/kernel32.factor | 10 +++++----- basis/windows/types/types.factor | 9 +++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 462377e85c..96301dbbe4 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -199,11 +199,11 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : THREAD_PRIORITY_TIME_CRITICAL 15 ; inline C-STRUCT: OVERLAPPED - { "int" "internal" } - { "int" "internal-high" } - { "int" "offset" } - { "int" "offset-high" } - { "void*" "event" } ; + { "UINT_PTR" "internal" } + { "UINT_PTR" "internal-high" } + { "DWORD" "offset" } + { "DWORD" "offset-high" } + { "HANDLE" "event" } ; C-STRUCT: SYSTEMTIME { "WORD" "wYear" } diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index 0ac8409016..6b1a57a098 100644 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -40,10 +40,11 @@ TYPEDEF: void* LPVOID TYPEDEF: void* LPCVOID TYPEDEF: float FLOAT -TYPEDEF: short HALF_PTR -TYPEDEF: ushort UHALF_PTR -TYPEDEF: int INT_PTR -TYPEDEF: uint UINT_PTR + +TYPEDEF: intptr_t HALF_PTR +TYPEDEF: intptr_t UHALF_PTR +TYPEDEF: intptr_t INT_PTR +TYPEDEF: intptr_t UINT_PTR TYPEDEF: int LONG_PTR TYPEDEF: ulong ULONG_PTR From ccd13ce975fe4461de7ffe903b8fd4b8cd1408b5 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:10 -0600 Subject: [PATCH 055/102] Define intptr_t type --- basis/alien/c-types/c-types.factor | 2 +- basis/cpu/x86/64/winnt/winnt.factor | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index b4e4d05f2e..543af8dee8 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -436,6 +436,6 @@ M: long-long-type box-return ( type -- ) "double" define-primitive-type "long" "ptrdiff_t" typedef - + "long" "intptr_t" typedef "ulong" "size_t" typedef ] with-compilation-unit diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 92560ef5e9..9108c0e8f7 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel layouts system math alien.c-types +USING: kernel layouts system math alien.c-types sequences compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ; IN: cpu.x86.64.winnt @@ -22,6 +22,7 @@ M: x86.64 dummy-fp-params? t ; << "longlong" "ptrdiff_t" typedef +"longlong" "intptr_t" typedef "int" "long" typedef "uint" "ulong" typedef >> From efb2e49c50c318f598508d6e62da53ebcf056a21 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:21 -0600 Subject: [PATCH 056/102] Fix freetype for Win64 --- basis/freetype/freetype.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/freetype/freetype.factor b/basis/freetype/freetype.factor index 8572a8bd91..683169e394 100644 --- a/basis/freetype/freetype.factor +++ b/basis/freetype/freetype.factor @@ -64,7 +64,7 @@ C-STRUCT: glyph { "FT_Pos" "advance-x" } { "FT_Pos" "advance-y" } - { "long" "format" } + { "intptr_t" "format" } { "int" "bitmap-rows" } { "int" "bitmap-width" } From d0139671802d194732d31d3ef60f202e9e33af88 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:42:44 -0600 Subject: [PATCH 057/102] Make io.servers.connection work if SSL is not available --- basis/io/servers/connection/connection.factor | 30 ++++++++++++------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 674ed8803c..942bdb041d 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -114,19 +114,29 @@ M: threaded-server handle-client* handler>> call ; ] when* ] unless ; +: (start-server) ( threaded-server -- ) + init-server + dup threaded-server [ + dup name>> [ + [ listen-on [ start-accept-loop ] parallel-each ] + [ ready>> raise-flag ] + bi + ] with-logging + ] with-variable ; + PRIVATE> : start-server ( threaded-server -- ) - init-server - dup secure-config>> [ - dup threaded-server [ - dup name>> [ - [ listen-on [ start-accept-loop ] parallel-each ] - [ ready>> raise-flag ] - bi - ] with-logging - ] with-variable - ] with-secure-context ; + #! Only create a secure-context if we want to listen on + #! a secure port, otherwise start-server won't work at + #! all if SSL is not available. + dup secure>> [ + dup secure-config>> [ + (start-server) + ] with-secure-context + ] [ + (start-server) + ] if ; : wait-for-server ( threaded-server -- ) ready>> wait-for-flag ; From 1c33e993daa0093db9efcff32a577e9d2f0c4251 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:10 -0600 Subject: [PATCH 058/102] Tweak launcher test: it failed without cygwin --- .../windows/nt/launcher/launcher-tests.factor | 314 +++++++++--------- 1 file changed, 157 insertions(+), 157 deletions(-) diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor index 949b0a7961..cbae2f5eca 100644 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ b/basis/io/windows/nt/launcher/launcher-tests.factor @@ -1,157 +1,157 @@ -USING: io.launcher tools.test calendar accessors environment -namespaces kernel system arrays io io.files io.encodings.ascii -sequences parser assocs hashtables math continuations eval ; -IN: io.windows.launcher.nt.tests - -[ ] [ - - "notepad" >>command - 1/2 seconds >>timeout - "notepad" set -] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ f ] [ "notepad" get process-started? ] unit-test - -[ ] [ "notepad" [ run-detached ] change ] unit-test - -[ "notepad" get wait-for-process ] must-fail - -[ t ] [ "notepad" get killed>> ] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ ] [ - - vm "-quiet" "-run=hello-world" 3array >>command - "out.txt" temp-file >>stdout - try-process -] unit-test - -[ "Hello world" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - - vm "-run=listener" 2array >>command - +closed+ >>stdin - try-process -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - "err.txt" temp-file >>stderr - try-process - ] with-directory -] unit-test - -[ "output" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "error" ] [ - "err.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - +stdout+ >>stderr - try-process - ] with-directory -] unit-test - -[ "outputerror" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "output" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "err2.txt" temp-file >>stderr - ascii lines first - ] with-directory -] unit-test - -[ "error" ] [ - "err2.txt" temp-file ascii file-lines first -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - +replace-environment+ >>environment-mode - os-envs >>environment - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ "B" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "A" "B" } } >>environment - ascii contents - ] with-directory eval - - "A" swap at -] unit-test - -[ f ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "HOME" "XXX" } } >>environment - +prepend-environment+ >>environment-mode - ascii contents - ] with-directory eval - - "HOME" swap at "XXX" = -] unit-test - -2 [ - [ ] [ - - "cmd.exe /c dir" >>command - "dir.txt" temp-file >>stdout - try-process - ] unit-test - - [ ] [ "dir.txt" temp-file delete-file ] unit-test -] times - -[ "append-test" temp-file delete-file ] ignore-errors - -[ "Hello appender\r\nHello appender\r\n" ] [ - 2 [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "append.factor" 3array >>command - "append-test" temp-file >>stdout - try-process - ] with-directory - ] times - - "append-test" temp-file ascii file-contents -] unit-test +USING: io.launcher tools.test calendar accessors environment +namespaces kernel system arrays io io.files io.encodings.ascii +sequences parser assocs hashtables math continuations eval ; +IN: io.windows.launcher.nt.tests + +[ ] [ + + "notepad" >>command + 1/2 seconds >>timeout + "notepad" set +] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ f ] [ "notepad" get process-started? ] unit-test + +[ ] [ "notepad" [ run-detached ] change ] unit-test + +[ "notepad" get wait-for-process ] must-fail + +[ t ] [ "notepad" get killed>> ] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ ] [ + + vm "-quiet" "-run=hello-world" 3array >>command + "out.txt" temp-file >>stdout + try-process +] unit-test + +[ "Hello world" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + + vm "-run=listener" 2array >>command + +closed+ >>stdin + try-process +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + "err.txt" temp-file >>stderr + try-process + ] with-directory +] unit-test + +[ "output" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "error" ] [ + "err.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + +stdout+ >>stderr + try-process + ] with-directory +] unit-test + +[ "outputerror" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "output" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "err2.txt" temp-file >>stderr + ascii lines first + ] with-directory +] unit-test + +[ "error" ] [ + "err2.txt" temp-file ascii file-lines first +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + +replace-environment+ >>environment-mode + os-envs >>environment + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ "B" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "A" "B" } } >>environment + ascii contents + ] with-directory eval + + "A" swap at +] unit-test + +[ f ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "USERPROFILE" "XXX" } } >>environment + +prepend-environment+ >>environment-mode + ascii contents + ] with-directory eval + + "USERPROFILE" swap at "XXX" = +] unit-test + +2 [ + [ ] [ + + "cmd.exe /c dir" >>command + "dir.txt" temp-file >>stdout + try-process + ] unit-test + + [ ] [ "dir.txt" temp-file delete-file ] unit-test +] times + +[ "append-test" temp-file delete-file ] ignore-errors + +[ "Hello appender\r\nHello appender\r\n" ] [ + 2 [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "append.factor" 3array >>command + "append-test" temp-file >>stdout + try-process + ] with-directory + ] times + + "append-test" temp-file ascii file-contents +] unit-test From b8487ffcb0c1bbb8bdb134017a17fd457a66e152 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:33 -0600 Subject: [PATCH 059/102] Download Windows DLLs from builder, so that we don't need wget to build Factor --- extra/mason/child/child.factor | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 2bc6b191c4..0c9669ed5a 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -2,14 +2,26 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces make debugger sequences io.files io.launcher arrays accessors calendar continuations -combinators.short-circuit mason.common mason.report mason.platform ; +combinators.short-circuit mason.common mason.report +mason.platform mason.config http.client ; IN: mason.child : make-cmd ( -- args ) - [ gnu-make , "clean" , platform , ] { } make ; + gnu-make platform 2array ; + +: download-dlls ( -- ) + target-os get "winnt" = [ + "http://factorcode.org/dlls/" + target-cpu get "x86.64" = [ "64/" append ] when + [ "freetype6.dll" append ] + [ "zlib1.dll" append ] bi + [ download ] bi@ + ] when ; : make-vm ( -- ) "factor" [ + download-dlls + make-cmd >>command "../compile-log" >>stdout From 93c8f5a2f4ad2448018c7ce715495ab678661525 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:43:59 -0600 Subject: [PATCH 060/102] Use our MD5 library instead of OpenSSL so that we can run builder without OpenSSL being installed --- basis/bootstrap/image/download/download.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index 71aa2e8adc..f9b7b56779 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: http.client checksums checksums.openssl splitting assocs +USING: http.client checksums checksums.md5 splitting assocs kernel io.files bootstrap.image sequences io urls ; IN: bootstrap.image.download @@ -13,7 +13,7 @@ IN: bootstrap.image.download : need-new-image? ( image -- ? ) dup exists? [ - [ openssl-md5 checksum-file hex-string ] + [ md5 checksum-file hex-string ] [ download-checksums at ] bi = not ] [ drop t ] if ; From ddd28c7d12fff8bf6ed4fa757e63c9eb24f9247c Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 17 Nov 2008 18:44:06 -0600 Subject: [PATCH 061/102] Fix Win64 type issue --- vm/math.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/math.c b/vm/math.c index 388a472f2e..c6b91bc8f7 100644 --- a/vm/math.c +++ b/vm/math.c @@ -109,7 +109,7 @@ void primitive_fixnum_shift(void) } else if(y < WORD_SIZE - TAG_BITS) { - F_FIXNUM mask = -(1L << (WORD_SIZE - 1 - TAG_BITS - y)); + F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y)); if((x > 0 && (x & mask) == 0) || (x & mask) == mask) { dpush(tag_fixnum(x << y)); From a7551efd0231f9e0bd466429897972fb320a7e75 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 21:12:10 -0500 Subject: [PATCH 062/102] Add documentation for math.quaternions --- .../math/quaternions/quaternions-docs.factor | 46 +++++++++++++++++++ extra/math/quaternions/quaternions.factor | 35 +++++--------- 2 files changed, 58 insertions(+), 23 deletions(-) create mode 100644 extra/math/quaternions/quaternions-docs.factor diff --git a/extra/math/quaternions/quaternions-docs.factor b/extra/math/quaternions/quaternions-docs.factor new file mode 100644 index 0000000000..bb34ec8da2 --- /dev/null +++ b/extra/math/quaternions/quaternions-docs.factor @@ -0,0 +1,46 @@ +USING: help.markup help.syntax math math.vectors vectors ; +IN: math.quaternions + +HELP: q* +{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u*v" "a quaternion" } } +{ $description "Multiply quaternions." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q* ." "{ 0 C{ 0 1 } }" } } ; + +HELP: qconjugate +{ $values { "u" "a quaternion" } { "u'" "a quaternion" } } +{ $description "Quaternion conjugate." } ; + +HELP: qrecip +{ $values { "u" "a quaternion" } { "1/u" "a quaternion" } } +{ $description "Quaternion inverse." } ; + +HELP: q/ +{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u/v" "a quaternion" } } +{ $description "Divide quaternions." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 C{ 0 1 } } { 0 1 } q/ ." "{ C{ 0 1 } 0 }" } } ; + +HELP: q*n +{ $values { "q" "a quaternion" } { "n" number } { "q" "a quaternion" } } +{ $description "Multiplies each element of " { $snippet "q" } " by " { $snippet "n" } "." } +{ $notes "You will get the wrong result if you try to multiply a quaternion by a complex number on the right using " { $link v*n } ". Use this word instead." + $nl "Note that " { $link v*n } " with a quaternion and a real is okay." } ; + +HELP: c>q +{ $values { "c" number } { "q" "a quaternion" } } +{ $description "Turn a complex number into a quaternion." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "C{ 0 1 } c>q ." "{ C{ 0 1 } 0 }" } } ; + +HELP: v>q +{ $values { "v" vector } { "q" "a quaternion" } } +{ $description "Turn a 3-vector into a quaternion with real part 0." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 1 0 0 } v>q ." "{ C{ 0 1 } 0 }" } } ; + +HELP: q>v +{ $values { "q" "a quaternion" } { "v" vector } } +{ $description "Get the vector part of a quaternion, discarding the real part." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } q>v ." "{ 1 0 0 }" } } ; + +HELP: euler +{ $values { "phi" number } { "theta" number } { "psi" number } { "q" "a quaternion" } } +{ $description "Convert a rotation given by Euler angles (phi, theta, and psi) to a quaternion." } ; + diff --git a/extra/math/quaternions/quaternions.factor b/extra/math/quaternions/quaternions.factor index ffc0fcc9f7..bb0d025dc6 100755 --- a/extra/math/quaternions/quaternions.factor +++ b/extra/math/quaternions/quaternions.factor @@ -1,15 +1,13 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. - -! Everybody's favorite non-commutative skew field, the -! quaternions! - -! Quaternions are represented as pairs of complex numbers, -! using the identity: (a+bi)+(c+di)j = a+bi+cj+dk. -USING: arrays kernel math math.vectors math.functions -arrays sequences ; +USING: arrays kernel math math.functions math.vectors sequences ; IN: math.quaternions +! Everybody's favorite non-commutative skew field, the quaternions! + +! Quaternions are represented as pairs of complex numbers, using the +! identity: (a+bi)+(c+di)j = a+bi+cj+dk. + : q* ( u v -- u*v ) - #! Multiply quaternions. [ q*a ] [ q*b ] 2bi 2array ; : qconjugate ( u -- u' ) - #! Quaternion conjugate. first2 [ conjugate ] [ neg ] bi* 2array ; : qrecip ( u -- 1/u ) - #! Quaternion inverse. qconjugate dup norm-sq v/n ; : q/ ( u v -- u/v ) - #! Divide quaternions. qrecip q* ; : q*n ( q n -- q ) - #! Note: you will get the wrong result if you try to - #! multiply a quaternion by a complex number on the right - #! using v*n. Use this word instead. Note that v*n with a - #! quaternion and a real is okay. conjugate v*n ; : c>q ( c -- q ) - #! Turn a complex number into a quaternion. 0 2array ; : v>q ( v -- q ) - #! Turn a 3-vector into a quaternion with real part 0. first3 rect> [ 0 swap rect> ] dip 2array ; : q>v ( q -- v ) - #! Get the vector part of a quaternion, discarding the real - #! part. first2 [ imaginary-part ] dip >rect 3array ; ! Zero @@ -67,11 +53,14 @@ PRIVATE> : qj { 0 1 } ; : qk { 0 C{ 0 1 } } ; -! Euler angles -- see -! http://www.mathworks.com/access/helpdesk/help/toolbox/aeroblks/euleranglestoquaternions.html +! Euler angles + +q swap sin ] dip n*v v- ; + [ -0.5 * [ cos c>q ] [ sin ] bi ] dip n*v v- ; + +PRIVATE> : euler ( phi theta psi -- q ) [ qi (euler) ] [ qj (euler) ] [ qk (euler) ] tri* q* q* ; From a9a28a3231e08a5eff92e0ad033d1d70a02c3b48 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 20:28:52 -0600 Subject: [PATCH 063/102] Trying to blindly fix Win64 unit tests --- basis/html/templates/fhtml/fhtml-tests.factor | 6 ++++-- core/io/io-tests.factor | 7 ++++++- core/io/test/separator-test.txt | 1 - extra/benchmark/regex-dna/regex-dna-tests.factor | 6 +++--- extra/contributors/contributors.factor | 2 +- extra/mason/child/child-tests.factor | 6 +++--- 6 files changed, 17 insertions(+), 11 deletions(-) delete mode 100644 core/io/test/separator-test.txt diff --git a/basis/html/templates/fhtml/fhtml-tests.factor b/basis/html/templates/fhtml/fhtml-tests.factor index b863087a92..d314a60124 100644 --- a/basis/html/templates/fhtml/fhtml-tests.factor +++ b/basis/html/templates/fhtml/fhtml-tests.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.string io.encodings.utf8 html.templates html.templates.fhtml kernel -tools.test sequences parser ; +tools.test sequences parser splitting prettyprint ; IN: html.templates.fhtml.tests : test-template ( path -- ? ) @@ -8,8 +8,10 @@ IN: html.templates.fhtml.tests prepend [ ".fhtml" append [ call-template ] with-string-writer + lines ] keep - ".html" append utf8 file-contents = ; + ".html" append utf8 file-lines + [ . . ] [ = ] 2bi ; [ t ] [ "example" test-template ] unit-test [ t ] [ "bug" test-template ] unit-test diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index c38a7c9ebc..18cde1a35c 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -25,6 +25,11 @@ IN: io.tests ! Make sure we use correct to_c_string form when writing [ ] [ "\0" write ] unit-test +[ ] [ + "It seems Jobs has lost his grasp on reality again.\n" + "separator-test.txt" temp-file latin1 set-file-contents +] unit-test + [ { { "It seems " CHAR: J } @@ -33,7 +38,7 @@ IN: io.tests } ] [ [ - "resource:core/io/test/separator-test.txt" + "separator-test.txt" temp-file latin1 [ "J" read-until 2array , "i" read-until 2array , diff --git a/core/io/test/separator-test.txt b/core/io/test/separator-test.txt deleted file mode 100644 index c3568f6ea0..0000000000 --- a/core/io/test/separator-test.txt +++ /dev/null @@ -1 +0,0 @@ -It seems Jobs has lost his grasp on reality again. diff --git a/extra/benchmark/regex-dna/regex-dna-tests.factor b/extra/benchmark/regex-dna/regex-dna-tests.factor index f1d4b7f627..79765849b5 100644 --- a/extra/benchmark/regex-dna/regex-dna-tests.factor +++ b/extra/benchmark/regex-dna/regex-dna-tests.factor @@ -1,10 +1,10 @@ USING: benchmark.regex-dna io io.files io.encodings.ascii -io.streams.string kernel tools.test ; +io.streams.string kernel tools.test splitting ; IN: benchmark.regex-dna.tests [ t ] [ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" - [ regex-dna ] with-string-writer + [ regex-dna ] with-string-writer string-lines "resource:extra/benchmark/regex-dna/regex-dna-test-out.txt" - ascii file-contents = + ascii file-lines = ] unit-test diff --git a/extra/contributors/contributors.factor b/extra/contributors/contributors.factor index 9f2d5a55fa..f6fcac5297 100755 --- a/extra/contributors/contributors.factor +++ b/extra/contributors/contributors.factor @@ -7,7 +7,7 @@ IN: contributors : changelog ( -- authors ) image parent-directory [ - "git-log --pretty=format:%an" ascii lines + "git log --pretty=format:%an" ascii lines ] with-directory ; : patch-counts ( authors -- assoc ) diff --git a/extra/mason/child/child-tests.factor b/extra/mason/child/child-tests.factor index 7913d05b26..104360e1fa 100644 --- a/extra/mason/child/child-tests.factor +++ b/extra/mason/child/child-tests.factor @@ -1,7 +1,7 @@ IN: mason.child.tests USING: mason.child mason.config tools.test namespaces ; -[ { "make" "clean" "winnt-x86-32" } ] [ +[ { "make" "winnt-x86-32" } ] [ [ "winnt" target-os set "x86.32" target-cpu set @@ -9,7 +9,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "make" "clean" "macosx-x86-32" } ] [ +[ { "make" "macosx-x86-32" } ] [ [ "macosx" target-os set "x86.32" target-cpu set @@ -17,7 +17,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "gmake" "clean" "netbsd-ppc" } ] [ +[ { "gmake" "netbsd-ppc" } ] [ [ "netbsd" target-os set "ppc" target-cpu set From 116ad2f04b4905952d2747d1841dc408a28f1eac Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 17 Nov 2008 20:40:53 -0600 Subject: [PATCH 064/102] Fix compile errors in hardware-info.windows --- extra/hardware-info/windows/windows.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/hardware-info/windows/windows.factor b/extra/hardware-info/windows/windows.factor index 3162496974..3aa6824ff6 100755 --- a/extra/hardware-info/windows/windows.factor +++ b/extra/hardware-info/windows/windows.factor @@ -18,7 +18,7 @@ IN: hardware-info.windows : processor-architecture ( -- n ) system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ; -: os-version +: os-version ( -- os-version ) "OSVERSIONINFO" "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize [ GetVersionEx ] keep swap zero? [ win32-error ] when ; @@ -67,4 +67,4 @@ IN: hardware-info.windows { { [ os wince? ] [ "hardware-info.windows.ce" ] } { [ os winnt? ] [ "hardware-info.windows.nt" ] } -} cond [ require ] when* >> +} cond require >> From b0821229a1debae326f568c108e90541bda7eb23 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 18 Nov 2008 03:47:13 +0100 Subject: [PATCH 065/102] Emacs factor mode: indentation improvements. --- misc/factor.el | 107 +++++++++++++++++++++++++++++++------------------ 1 file changed, 67 insertions(+), 40 deletions(-) diff --git a/misc/factor.el b/misc/factor.el index 393ed26ae0..6204bdbef6 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -317,10 +317,9 @@ value from the existing code in the buffer." ;;; Factor mode indentation: -(defvar factor-indent-width factor-default-indent-width - "Indentation width in factor buffers. A local variable.") - -(make-variable-buffer-local 'factor-indent-width) +(make-variable-buffer-local + (defvar factor-indent-width factor-default-indent-width + "Indentation width in factor buffers. A local variable.")) (defconst factor--regexp-word-start (let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M"))) @@ -340,45 +339,67 @@ value from the existing code in the buffer." (setq iw (current-indentation)))))) iw)) -(defun factor--brackets-depth () - "Returns number of brackets, not closed on previous lines." - (syntax-ppss-depth - (save-excursion - (syntax-ppss (line-beginning-position))))) +(defsubst factor--ppss-brackets-depth () + (nth 0 (syntax-ppss))) + +(defsubst factor--ppss-brackets-start () + (nth 1 (syntax-ppss))) + +(defsubst factor--line-indent (pos) + (save-excursion (goto-char pos) (current-indentation))) + +(defconst factor--regex-closing-paren "[])}]") +(defsubst factor--at-closing-paren-p () + (looking-at factor--regex-closing-paren)) + +(defsubst factor--at-first-char-p () + (= (- (point) (line-beginning-position)) (current-indentation))) + +(defconst factor--regex-single-liner + (format "^%s" (regexp-opt '("USE:" "IN:" "PRIVATE>" " (factor--ppss-brackets-depth) 0)) + (let ((op (factor--ppss-brackets-start))) + (when (> (line-number-at-pos) (line-number-at-pos op)) + (if (factor--at-closing-paren-p) + (factor--line-indent op) + (+ (factor--line-indent op) factor-indent-width))))))) + +(defun factor--indent-definition () + (save-excursion + (beginning-of-line) + (when (looking-at "\\([^ ]\\|^\\)+:") 0))) + +(defun factor--indent-continuation () + (save-excursion + (forward-line -1) + (beginning-of-line) + (if (bobp) 0 + (if (looking-at "^[ \t]*$") + (factor--indent-continuation) + (if (factor--at-end-of-def) + (- (current-indentation) factor-indent-width) + (if (factor--indent-definition) + (+ (current-indentation) factor-indent-width) + (current-indentation))))))) (defun factor--calculate-indentation () "Calculate Factor indentation for line at point." - (let ((not-indented t) - (cur-indent 0)) - (save-excursion - (beginning-of-line) - (if (bobp) - (setq cur-indent 0) - (save-excursion - (while not-indented - ;; Check that we are inside open brackets - (save-excursion - (let ((cur-depth (factor--brackets-depth))) - (forward-line -1) - (setq cur-indent (+ (current-indentation) - (* factor-indent-width - (- cur-depth (factor--brackets-depth))))) - (setq not-indented nil))) - (forward-line -1) - ;; Check that we are after the end of previous word - (if (looking-at ".*;[ \t]*$") - (progn - (setq cur-indent (- (current-indentation) factor-indent-width)) - (setq not-indented nil)) - ;; Check that we are after the start of word - (if (looking-at factor--regexp-word-start) - (progn - (message "inword") - (setq cur-indent (+ (current-indentation) factor-indent-width)) - (setq not-indented nil)) - (if (bobp) - (setq not-indented nil)))))))) - cur-indent)) + (or (and (bobp) 0) + (factor--indent-definition) + (factor--indent-in-brackets) + (factor--indent-continuation) + 0)) (defun factor-indent-line () "Indent current line as Factor code" @@ -420,11 +441,15 @@ value from the existing code in the buffer." ;;; Factor listener mode +;;;###autoload (define-derived-mode factor-listener-mode comint-mode "Factor Listener") (define-key factor-listener-mode-map [f8] 'factor-refresh-all) +;;;###autoload (defun run-factor () + "Start a factor listener inside emacs, or switch to it if it +already exists." (interactive) (switch-to-buffer (make-comint-in-buffer "factor" nil (expand-file-name factor-binary) nil @@ -433,6 +458,8 @@ value from the existing code in the buffer." (factor-listener-mode)) (defun factor-refresh-all () + "Reload source files and documentation for all loaded +vocabularies which have been modified on disk." (interactive) (comint-send-string "*factor*" "refresh-all\n")) From 5697b75394ca218ed6041b3a4411d19dfddb9d46 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 20:48:02 -0600 Subject: [PATCH 066/102] Fix user-admin/new-user template --- extra/webapps/user-admin/new-user.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/user-admin/new-user.xml b/extra/webapps/user-admin/new-user.xml index 313c8e2702..0820dbcb64 100644 --- a/extra/webapps/user-admin/new-user.xml +++ b/extra/webapps/user-admin/new-user.xml @@ -37,7 +37,7 @@ Capabilities: -

    • +
    From d6dd9ea2a31bda9e6d6613945883e2f88cdcef5d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:21:57 -0600 Subject: [PATCH 067/102] Add workaround for Windows bttray.exe issue --- vm/os-windows-nt.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c index 54afd1c147..e22ea1446b 100755 --- a/vm/os-windows-nt.c +++ b/vm/os-windows-nt.c @@ -29,7 +29,13 @@ long exception_handler(PEXCEPTION_POINTERS pe) signal_number = ERROR_DIVIDE_BY_ZERO; c->EIP = (CELL)divide_by_zero_signal_handler_impl; } - else + /* If the Widcomm bluetooth stack is installed, the BTTray.exe process + injects code into running programs. For some reason this results in + random SEH exceptions with this (undocumented) exception code being + raised. The workaround seems to be ignoring this altogether, since that + is what happens if SEH is not enabled. Don't really have any idea what + this exception means. */ + else if(e->ExceptionCode != 0x40010006) { signal_number = 11; c->EIP = (CELL)misc_signal_handler_impl; From 930f3d0edc786e42c23ff352722f0d452b33e7a7 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 17 Nov 2008 21:26:16 -0600 Subject: [PATCH 068/102] locals: Allow 'local-reader' in literals --- basis/locals/locals.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index e74ecf3dc9..7de9d10436 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -229,6 +229,8 @@ M: tuple rewrite-element M: local rewrite-element , ; +M: local-reader rewrite-element , ; + M: word rewrite-element literalize , ; M: object rewrite-element , ; From 5c51d9fd2cef229c4a729e4e54e8328688187981 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:42:59 -0600 Subject: [PATCH 069/102] Get regexp words to infer --- basis/regexp/parser/parser.factor | 2 +- basis/regexp/regexp-tests.factor | 3 +++ basis/regexp/traversal/traversal.factor | 3 ++- basis/regexp/utils/utils-tests.factor | 4 ++++ basis/regexp/utils/utils.factor | 4 +--- 5 files changed, 11 insertions(+), 5 deletions(-) create mode 100644 basis/regexp/utils/utils-tests.factor diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index d04016b93a..b7716d8580 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -137,7 +137,7 @@ ERROR: bad-special-group string ; DEFER: (parse-regexp) : nested-parse-regexp ( token ? -- ) [ push-stack (parse-regexp) pop-stack ] dip - [ ] when pop-stack boa push-stack ; + [ ] when pop-stack new swap >>term push-stack ; ! non-capturing groups : (parse-special-group) ( -- ) diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 2339628801..2a6c0dc16f 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -2,6 +2,9 @@ USING: regexp tools.test kernel sequences regexp.parser regexp.traversal eval ; IN: regexp-tests +\ must-infer +\ matches? must-infer + [ f ] [ "b" "a*" matches? ] unit-test [ t ] [ "" "a*" matches? ] unit-test [ t ] [ "a" "a*" matches? ] unit-test diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor index 91c7ce16dc..c9e8a54348 100644 --- a/basis/regexp/traversal/traversal.factor +++ b/basis/regexp/traversal/traversal.factor @@ -107,7 +107,8 @@ M: capture-group-off flag-action ( dfa-traverser flag -- ) : increment-state ( dfa-traverser state -- dfa-traverser ) [ dup traverse-forward>> - [ 1+ ] [ 1- ] ? change-current-index + [ [ 1+ ] change-current-index ] + [ [ 1- ] change-current-index ] if dup current-state>> >>last-state ] dip first >>current-state ; diff --git a/basis/regexp/utils/utils-tests.factor b/basis/regexp/utils/utils-tests.factor new file mode 100644 index 0000000000..d048ad4be1 --- /dev/null +++ b/basis/regexp/utils/utils-tests.factor @@ -0,0 +1,4 @@ +USING: regexp.utils tools.test ; +IN: regexp.utils.tests + +[ [ ] [ ] while-changes ] must-infer diff --git a/basis/regexp/utils/utils.factor b/basis/regexp/utils/utils.factor index fb058ecf92..5116dd2b7e 100644 --- a/basis/regexp/utils/utils.factor +++ b/basis/regexp/utils/utils.factor @@ -5,9 +5,7 @@ namespaces regexp.backend sequences unicode.categories math.ranges fry combinators.short-circuit vectors ; IN: regexp.utils -: (while-changes) ( obj quot pred pred-ret -- obj ) - ! quot: ( obj -- obj' ) - ! pred: ( obj -- <=> ) +: (while-changes) ( obj quot: ( obj -- obj' ) pred: ( obj -- <=> ) pred-ret -- obj ) [ [ dup slip ] dip pick over call ] dip dupd = [ 3drop ] [ (while-changes) ] if ; inline recursive From b3e63a2b1a67458670a0e1aed0c583216dac0d23 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:45:23 -0600 Subject: [PATCH 070/102] Fix gradient in slides --- extra/galois-talk/authors.txt | 1 + extra/galois-talk/summary.txt | 1 + extra/galois-talk/tags.txt | 1 + extra/google-tech-talk/authors.txt | 1 + extra/google-tech-talk/summary.txt | 1 + extra/google-tech-talk/tags.txt | 1 + extra/slides/slides.factor | 12 +++++------- extra/vpri-talk/authors.txt | 1 + extra/vpri-talk/summary.txt | 1 + extra/vpri-talk/tags.txt | 1 + 10 files changed, 14 insertions(+), 7 deletions(-) create mode 100644 extra/galois-talk/authors.txt create mode 100644 extra/galois-talk/summary.txt create mode 100644 extra/galois-talk/tags.txt create mode 100644 extra/google-tech-talk/authors.txt create mode 100644 extra/google-tech-talk/summary.txt create mode 100644 extra/google-tech-talk/tags.txt create mode 100644 extra/vpri-talk/authors.txt create mode 100644 extra/vpri-talk/summary.txt create mode 100644 extra/vpri-talk/tags.txt diff --git a/extra/galois-talk/authors.txt b/extra/galois-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/galois-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/galois-talk/summary.txt b/extra/galois-talk/summary.txt new file mode 100644 index 0000000000..00f30acf8d --- /dev/null +++ b/extra/galois-talk/summary.txt @@ -0,0 +1 @@ +Slides from a talk at Galois by Slava Pestov, October 2008 diff --git a/extra/galois-talk/tags.txt b/extra/galois-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/galois-talk/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/google-tech-talk/authors.txt b/extra/google-tech-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/google-tech-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/google-tech-talk/summary.txt b/extra/google-tech-talk/summary.txt new file mode 100644 index 0000000000..1747a569c9 --- /dev/null +++ b/extra/google-tech-talk/summary.txt @@ -0,0 +1 @@ +Slides from Google Tech Talk by Slava Pestov, October 2008 diff --git a/extra/google-tech-talk/tags.txt b/extra/google-tech-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/google-tech-talk/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index 2940bcbfcb..dc8bdd4576 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -48,19 +48,17 @@ IN: slides : $divider ( -- ) [ - T{ gradient f - { - T{ rgba f 0.25 0.25 0.25 1.0 } - T{ rgba f 1.0 1.0 1.0 0.0 } - } - } >>interior + { + T{ rgba f 0.25 0.25 0.25 1.0 } + T{ rgba f 1.0 1.0 1.0 0.0 } + } >>interior { 800 10 } >>dim { 1 0 } >>orientation gadget. ] ($block) ; : page-theme ( gadget -- ) - T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } } + { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } >>interior drop ; : ( list -- gadget ) diff --git a/extra/vpri-talk/authors.txt b/extra/vpri-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/vpri-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/vpri-talk/summary.txt b/extra/vpri-talk/summary.txt new file mode 100644 index 0000000000..1ebcc4b114 --- /dev/null +++ b/extra/vpri-talk/summary.txt @@ -0,0 +1 @@ +Slides from a talk at VPRI by Slava Pestov, October 2008 diff --git a/extra/vpri-talk/tags.txt b/extra/vpri-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/vpri-talk/tags.txt @@ -0,0 +1 @@ +demos From e17f51948005ff8b20f63efe74f7d0d3fe48cb5b Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 22:51:57 -0500 Subject: [PATCH 071/102] Minor documentation fixes --- basis/math/vectors/vectors-docs.factor | 2 +- extra/math/derivatives/derivatives-docs.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 140eddb2f6..7ee948be65 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -34,7 +34,7 @@ HELP: n*v { $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ; HELP: v*n -{ $values { "n" "a number" } { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } } +{ $values { "u" "a sequence of numbers" } { "n" "a number" } { "v" "a sequence of numbers" } } { $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ; HELP: n/v diff --git a/extra/math/derivatives/derivatives-docs.factor b/extra/math/derivatives/derivatives-docs.factor index bbb793fe92..1630b2f9de 100644 --- a/extra/math/derivatives/derivatives-docs.factor +++ b/extra/math/derivatives/derivatives-docs.factor @@ -90,7 +90,6 @@ HELP: derivative-func " [ cos ]" " bi - abs" "] map minmax" - } } } ; @@ -100,4 +99,5 @@ ARTICLE: "derivatives" "The Derivative Toolkit" { $subsection derivative } { $subsection derivative-func } { $subsection (derivative) } ; + ABOUT: "derivatives" From 1fa0fb6258bc39e8e5d145f2b6c0a9d2a9984381 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:53:38 -0600 Subject: [PATCH 072/102] Add unit test for Ed's fix --- basis/locals/locals-tests.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 003ef459e3..ca6697be1c 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -346,7 +346,6 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as - :: literal-identity-test ( -- a b ) { } V{ } ; @@ -356,6 +355,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; swapd [ eq? ] [ eq? ] 2bi* ] unit-test +:: mutable-local-in-literal-test ( a! -- b ) a 1 + a! { a } ; + +[ { 4 } ] [ 3 mutable-local-in-literal-test ] unit-test + :: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- ) obj1 obj2 <=> { { +lt+ [ lt-quot call ] } From 4df50bc6411f1bd11dadccad4430d721f2dd2ac5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Nov 2008 21:56:59 -0600 Subject: [PATCH 073/102] Fix benchmark.regex-dna --- extra/benchmark/regex-dna/regex-dna-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/benchmark/regex-dna/regex-dna-tests.factor b/extra/benchmark/regex-dna/regex-dna-tests.factor index 79765849b5..9f64d438c7 100644 --- a/extra/benchmark/regex-dna/regex-dna-tests.factor +++ b/extra/benchmark/regex-dna/regex-dna-tests.factor @@ -4,7 +4,7 @@ IN: benchmark.regex-dna.tests [ t ] [ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" - [ regex-dna ] with-string-writer string-lines + [ regex-dna ] with-string-writer lines "resource:extra/benchmark/regex-dna/regex-dna-test-out.txt" ascii file-lines = ] unit-test From 91df21a8cfc0bd50a02e63038dd1388e17d67dd3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 17 Nov 2008 21:57:46 -0600 Subject: [PATCH 074/102] boids: Fix indendation --- extra/boids/boids.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 193582524c..9956df9982 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -83,7 +83,7 @@ VAR: separation-radius : relative-position ( self other -- v ) swap [ pos>> ] bi@ v- ; : relative-angle ( self other -- angle ) -over vel>> -rot relative-position angle-between ; + over vel>> -rot relative-position angle-between ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 79b80baae826f1f4fbeffe88ca371a656132351e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 01:10:00 -0600 Subject: [PATCH 075/102] remove storing the user in ftp server --- extra/ftp/server/server.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index f8ab04ed00..c5c854ba92 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -75,7 +75,7 @@ C: ftp-list : handle-USER ( ftp-command -- ) [ - tokenized>> second client get (>>user) + drop 331 "Please specify the password." server-response ] [ 2drop "bad USER" ftp-error From bb3fee58e390a81cb734ff2bd8bbd3cb247b2302 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 18 Nov 2008 01:38:29 -0600 Subject: [PATCH 076/102] update.latest: Use 'http' protocol for git commands (git daemon on factorcode.org is flakey lately) --- extra/update/latest/latest.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/update/latest/latest.factor b/extra/update/latest/latest.factor index 7cc2fac853..9546379223 100644 --- a/extra/update/latest/latest.factor +++ b/extra/update/latest/latest.factor @@ -9,7 +9,7 @@ IN: update.latest : git-pull-master ( -- ) image parent-directory [ - { "git" "pull" "git://factorcode.org/git/factor.git" "master" } + { "git" "pull" "http://factorcode.org/git/factor.git" "master" } run-command ] with-directory ; From a79107695ebd0ef0420d2a04463527089ee8dbca Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 18 Nov 2008 08:57:20 -0600 Subject: [PATCH 077/102] boids: more indentation fixes --- extra/boids/boids.factor | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 9956df9982..3d4cd392ca 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -189,13 +189,12 @@ boids> [ within-alignment-neighborhood? ] with filter ; : above? ( n a b -- ? ) nip > ; : wrap ( n a b -- n ) -{ { [ 3dup below? ] - [ 2nip ] } - { [ 3dup above? ] - [ drop nip ] } - { [ t ] - [ 2drop ] } } -cond ; + { + { [ 3dup below? ] [ 2nip ] } + { [ 3dup above? ] [ drop nip ] } + { [ t ] [ 2drop ] } + } + cond ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From fd95e641257a63e2931d2c7b15ab213888d873a9 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Tue, 18 Nov 2008 10:13:57 -0500 Subject: [PATCH 078/102] Cleanup polynomials and add documentation --- .../math/polynomials/polynomials-docs.factor | 94 +++++++++++++++++++ .../math/polynomials/polynomials-tests.factor | 3 +- extra/math/polynomials/polynomials.factor | 46 ++++----- 3 files changed, 115 insertions(+), 28 deletions(-) create mode 100644 extra/math/polynomials/polynomials-docs.factor diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor new file mode 100644 index 0000000000..08b7ca7c4d --- /dev/null +++ b/extra/math/polynomials/polynomials-docs.factor @@ -0,0 +1,94 @@ +USING: help.markup help.syntax math sequences ; +IN: math.polynomials + +ARTICLE: "polynomials" "Polynomials" +"A polynomial is a vector with the highest powers on the right:" +{ $code "{ 1 1 0 1 } -> 1 + x + x^3" "{ } -> 0" } +"Numerous words are defined to help with polynomial arithmetic:" +{ $subsection p= } +{ $subsection p+ } +{ $subsection p- } +{ $subsection p* } +{ $subsection p-sq } +{ $subsection powers } +{ $subsection n*p } +{ $subsection p/mod } +{ $subsection pgcd } +{ $subsection polyval } +{ $subsection pdiff } +{ $subsection pextend-conv } +{ $subsection ptrim } +{ $subsection 2ptrim } ; + +ABOUT: "polynomials" + +HELP: powers +{ $values { "n" integer } { "x" number } { "seq" sequence } } +{ $description "Output a sequence having " { $snippet "n" } " elements in the format: " { $snippet "{ 1 x x^2 x^3 ... }" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "4 2 powers ." "{ 1 2 4 8 }" } } ; + +HELP: p= +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "?" "a boolean" } } +{ $description "Tests if two polynomials are equal." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 } { 0 1 0 } p= ." "t" } } ; + +HELP: ptrim +{ $values { "p" "a polynomial" } { "p" "a polynomial" } } +{ $description "Trims excess zeros from a polynomial." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } ptrim ." "{ 0 1 }" } } ; + +HELP: 2ptrim +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } +{ $description "Trims excess zeros from two polynomials." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; + +HELP: p+ +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } +{ $description "Adds " { $snippet "p" } " and " { $snippet "q" } " component-wise." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } p+ ." "{ 1 1 1 }" } } ; + +HELP: p- +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } +{ $description "Subtracts " { $snippet "q" } " from " { $snippet "p" } " component-wise." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 } { 0 1 } p- ." "{ 1 0 1 }" } } ; + +HELP: n*p +{ $values { "n" number } { "p" "a polynomial" } { "n*p" "a polynomial" } } +{ $description "Multiplies each element of " { $snippet "p" } " by " { $snippet "n" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "4 { 3 0 1 } n*p ." "{ 12 0 4 }" } } ; + +HELP: pextend-conv +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } +{ $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; + +HELP: p* +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } +{ $description "Multiplies two polynomials." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 3 0 0 0 } { 1 2 0 0 } p* ." "{ 1 4 7 6 0 0 0 0 0 }" } } ; + +HELP: p-sq +{ $values { "p" "a polynomial" } { "p^2" "a polynomial" } } +{ $description "Squares a polynomial." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 0 } p-sq ." "{ 1 4 4 0 0 }" } } ; + +HELP: p/mod +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } } +{ $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; + +HELP: pgcd +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } } +{ $description "Computes the greatest common divisor " { $snippet "d" } " of " { $snippet "p" } " and " { $snippet "q" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*q = d mod p" } } +{ $notes "GCD in the case of polynomials is a monic polynomial of the highest possible degree that divides into both " { $snippet "p" } " and " { $snippet "q" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1} { 1 1 } pgcd swap . ." "{ 0 0 }\n{ 1 1 }" } } ; + +HELP: pdiff +{ $values { "p" "a polynomial" } { "p'" "a polynomial" } } +{ $description "Finds the derivative of " { $snippet "p" } "." } ; + +HELP: polyval +{ $values { "p" "a polynomial" } { "x" number } { "p[x]" number } } +{ $description "Evaluate " { $snippet "p" } " with the input " { $snippet "x" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } 2 polyval ." "5" } } ; + diff --git a/extra/math/polynomials/polynomials-tests.factor b/extra/math/polynomials/polynomials-tests.factor index cccf24fbff..cd88d19d13 100644 --- a/extra/math/polynomials/polynomials-tests.factor +++ b/extra/math/polynomials/polynomials-tests.factor @@ -1,7 +1,6 @@ -IN: math.polynomials.tests USING: kernel math math.polynomials tools.test ; +IN: math.polynomials.tests -! Tests [ { 0 1 } ] [ { 0 1 0 0 } ptrim ] unit-test [ { 1 } ] [ { 1 0 0 } ptrim ] unit-test [ { 0 } ] [ { 0 } ptrim ] unit-test diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 47226114d0..13090b6486 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -4,46 +4,38 @@ USING: arrays kernel make math math.order math.vectors sequences shuffle splitting vectors ; IN: math.polynomials -! Polynomials are vectors with the highest powers on the right: -! { 1 1 0 1 } -> 1 + x + x^3 -! { } -> 0 - -: powers ( n x -- seq ) - #! Output sequence has n elements, { 1 x x^2 x^3 ... } - 1 [ * ] accumulate nip ; - -: p= ( p p -- ? ) pextend = ; +: powers ( n x -- seq ) + 1 [ * ] accumulate nip ; + +: p= ( p q -- ? ) pextend = ; : ptrim ( p -- p ) dup length 1 = [ [ zero? ] trim-right ] unless ; -: 2ptrim ( p p -- p p ) [ ptrim ] bi@ ; -: p+ ( p p -- p ) pextend v+ ; -: p- ( p p -- p ) pextend v- ; +: 2ptrim ( p q -- p q ) [ ptrim ] bi@ ; +: p+ ( p q -- r ) pextend v+ ; +: p- ( p q -- r ) pextend v- ; : n*p ( n p -- n*p ) n*v ; -! convolution -: pextend-conv ( p p -- p p ) - #! extend to: p_m + p_n - 1 +: pextend-conv ( p q -- p q ) 2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ; -: p* ( p p -- p ) - #! Multiply two polynomials. +: p* ( p q -- r ) 2unempty pextend-conv dup length [ over length pick pick [ * ] 2map sum ] map 2nip reverse ; -: p-sq ( p -- p-sq ) +: p-sq ( p -- p^2 ) dup p* ; PRIVATE> -: p/mod ( a b -- / mod ) +: p/mod ( p q -- z w ) p/mod-setup [ [ (p/mod) ] times ] V{ } make reverse nip swap 2ptrim pextend ; + tuck p/mod [ pick p* swap [ swapd p- ] dip ] dip (pgcd) ] if ; -: pgcd ( p p -- p q ) +PRIVATE> + +: pgcd ( p q -- a d ) swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ; : pdiff ( p -- p' ) - #! Polynomial derivative. dup length v* { 0 } ?head drop ; : polyval ( p x -- p[x] ) - #! Evaluate a polynomial. [ dup length ] dip powers v. ; From f44d8f4cf51b7073fd3eb99de4f21291ef079f5c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:45:55 -0600 Subject: [PATCH 079/102] Fix combinators so that directory. can infer on Unix --- basis/unix/groups/groups.factor | 6 ++++-- basis/unix/users/users.factor | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index b8edf7fa36..177949aec9 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -76,9 +76,11 @@ M: integer user-groups ( id -- seq ) : all-groups ( -- seq ) [ getgrent dup ] [ group-struct>group ] [ drop ] produce ; +: ( -- assoc ) + all-groups [ [ id>> ] keep ] H{ } map>assoc ; + : with-group-cache ( quot -- ) - all-groups [ [ id>> ] keep ] H{ } map>assoc - group-cache rot with-variable ; inline + [ group-cache ] dip with-variable ; inline : real-group-id ( -- id ) getgid ; inline diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index f76fbd5388..8487d5adf2 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -41,9 +41,11 @@ PRIVATE> SYMBOL: user-cache +: ( -- assoc ) + all-users [ [ uid>> ] keep ] H{ } map>assoc ; + : with-user-cache ( quot -- ) - all-users [ [ uid>> ] keep ] H{ } map>assoc - user-cache rot with-variable ; inline + [ user-cache ] dip with-variable ; inline GENERIC: user-passwd ( obj -- passwd ) From bec8cc423939ef5184700def9959e41c7c6a1e83 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:46:51 -0600 Subject: [PATCH 080/102] Add unit test to assert that directory. can infeR --- basis/io/files/listing/listing-tests.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/io/files/listing/listing-tests.factor b/basis/io/files/listing/listing-tests.factor index a2347c8db9..8c2dc28559 100644 --- a/basis/io/files/listing/listing-tests.factor +++ b/basis/io/files/listing/listing-tests.factor @@ -3,4 +3,6 @@ USING: tools.test io.files.listing strings kernel ; IN: io.files.listing.tests +\ directory. must-infer + [ ] [ "" directory. ] unit-test From b609ca7d01a07425dcb84b6669f93f7ac5529886 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:48:06 -0600 Subject: [PATCH 081/102] Tweak gl-rect to generate the correct output on Windows with Intel graphics --- basis/opengl/opengl.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index aec7960857..21fe663c44 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -72,9 +72,9 @@ MACRO: all-enabled-client-state ( seq quot -- ) : (rect-vertices) ( dim -- vertices ) { [ drop 0.5 0.5 ] - [ first 0.5 - 0.5 ] - [ [ first 0.5 - ] [ second 0.5 - ] bi ] - [ second 0.5 - 0.5 swap ] + [ first 0.3 - 0.5 ] + [ [ first 0.3 - ] [ second 0.3 - ] bi ] + [ second 0.3 - 0.5 swap ] } cleave 8 narray >c-float-array ; : rect-vertices ( dim -- ) From f8a6e3b0d8148a605d8bd2b48eb0369fbb5434d7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 11:50:02 -0600 Subject: [PATCH 082/102] Don't use the obscure CLEAR key --- basis/ui/tools/listener/listener.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 68bf765295..d842bf8a68 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -181,8 +181,8 @@ M: stack-display tool-scroller listener-gadget "toolbar" f { { f restart-listener } - { T{ key-down f f "CLEAR" } clear-output } - { T{ key-down f { C+ } "CLEAR" } clear-stack } + { T{ key-down f { A+ } "c" } clear-output } + { T{ key-down f { A+ } "C" } clear-stack } { T{ key-down f { C+ } "d" } com-end } { T{ key-down f f "F1" } listener-help } } define-command-map From 0a124677675d849f384752a5118e23dff4aa3350 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 13:31:43 -0600 Subject: [PATCH 083/102] fix compile errors in ftp.server --- extra/ftp/server/server.factor | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index c5c854ba92..9095dedf35 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -7,10 +7,11 @@ namespaces make sequences ftp io.unix.launcher.parser unicode.case splitting assocs classes io.servers.connection destructors calendar io.timeouts io.streams.duplex threads continuations math concurrency.promises byte-arrays -io.backend sequences.lib tools.hexdump io.files.listing ; +io.backend sequences.lib tools.hexdump io.files.listing +io.streams.string ; IN: ftp.server -TUPLE: ftp-client url mode state command-promise ; +TUPLE: ftp-client url mode state command-promise user password ; : ( url -- ftp-client ) ftp-client new @@ -75,7 +76,7 @@ C: ftp-list : handle-USER ( ftp-command -- ) [ - drop + tokenized>> second client get (>>user) 331 "Please specify the password." server-response ] [ 2drop "bad USER" ftp-error @@ -140,16 +141,16 @@ ERROR: type-error type ; 150 "Here comes the directory listing." server-response ; : finish-directory ( -- ) - 226 "Opening " server-response ; + 226 "Directory send OK." server-response ; GENERIC: service-command ( stream obj -- ) M: ftp-list service-command ( stream obj -- ) drop - start-directory - [ + start-directory [ utf8 encode-output - directory. [ ftp-send ] each + [ current-directory get directory. ] with-string-writer string-lines + harvest [ ftp-send ] each ] with-output-stream finish-directory ; From 054dce145ccc6e06285e0dd6c9ca0a3b15baf56d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 14:00:27 -0600 Subject: [PATCH 084/102] fix polynomial help lint --- extra/math/polynomials/polynomials-docs.factor | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor index 08b7ca7c4d..f97ae308e1 100644 --- a/extra/math/polynomials/polynomials-docs.factor +++ b/extra/math/polynomials/polynomials-docs.factor @@ -40,7 +40,7 @@ HELP: ptrim HELP: 2ptrim { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Trims excess zeros from two polynomials." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; HELP: p+ { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -60,7 +60,7 @@ HELP: n*p HELP: pextend-conv { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; HELP: p* { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -75,13 +75,18 @@ HELP: p-sq HELP: p/mod { $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } } { $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; HELP: pgcd { $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } } { $description "Computes the greatest common divisor " { $snippet "d" } " of " { $snippet "p" } " and " { $snippet "q" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*q = d mod p" } } { $notes "GCD in the case of polynomials is a monic polynomial of the highest possible degree that divides into both " { $snippet "p" } " and " { $snippet "q" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1} { 1 1 } pgcd swap . ." "{ 0 0 }\n{ 1 1 }" } } ; +{ $examples + { $example "USING: kernel math.polynomials prettyprint ;" + "{ 1 1 1 1 } { 1 1 } pgcd [ . ] bi@" + "{ 0 0 }\n{ 1 1 }" + } +} ; HELP: pdiff { $values { "p" "a polynomial" } { "p'" "a polynomial" } } From 46e7978371b97f000bd1e866b032228b1cc186d9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 14:00:43 -0600 Subject: [PATCH 085/102] fix typo --- basis/furnace/furnace-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/furnace/furnace-docs.factor b/basis/furnace/furnace-docs.factor index b86d4c3295..911433d100 100644 --- a/basis/furnace/furnace-docs.factor +++ b/basis/furnace/furnace-docs.factor @@ -97,7 +97,7 @@ HELP: with-exit-continuation { $notes "Furnace actions and authentication realms wrap their execution in this combinator, allowing form validation failures and login requests, respectively, to immediately return an HTTP response to the client without running any more responder code." } ; ARTICLE: "furnace.extension-points" "Furnace extension points" -"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the setateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used." +"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the stateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used." $nl "Responders can implement methods on the following generic words:" { $subsection modify-query } From cba8f2a8605eec3a0f743f442870929602957433 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 18 Nov 2008 14:09:50 -0600 Subject: [PATCH 086/102] swap . . -> [ . ] bi@ --- extra/math/polynomials/polynomials-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor index f97ae308e1..edffa5377d 100644 --- a/extra/math/polynomials/polynomials-docs.factor +++ b/extra/math/polynomials/polynomials-docs.factor @@ -40,7 +40,7 @@ HELP: ptrim HELP: 2ptrim { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Trims excess zeros from two polynomials." } -{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim [ . ] bi@" "{ 0 1 }\n{ 1 }" } } ; HELP: p+ { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -60,7 +60,7 @@ HELP: n*p HELP: pextend-conv { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." } -{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv [ . ] bi@" "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; HELP: p* { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -75,7 +75,7 @@ HELP: p-sq HELP: p/mod { $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } } { $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." } -{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod [ . ] bi@" "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; HELP: pgcd { $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } } From aee589190b1e8911eda3565d0086ff721bd388e2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:10:21 -0600 Subject: [PATCH 087/102] Add signed-le> and signed-be> wordS --- basis/math/bitwise/bitwise.factor | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index ad1907fcb0..afd83d4458 100644 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.functions sequences sequences.private words namespaces macros hints -combinators fry ; +combinators fry io.binary ; IN: math.bitwise ! utilities @@ -93,3 +93,11 @@ PRIVATE> : bit-count ( x -- n ) dup 0 < [ bitnot ] when (bit-count) ; inline + +! Signed byte array to integer conversion +: signed-le> ( bytes -- x ) + [ le> ] [ length 8 * 1- on-bits ] bi + 2dup > [ bitnot bitor ] [ drop ] if ; + +: signed-be> ( bytes -- x ) + signed-le> ; From f32908f502ebb82a1d807e6bb5ba19a65f87348f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:10:31 -0600 Subject: [PATCH 088/102] Fix load-bitmap to work with negative height --- extra/graphics/bitmap/bitmap.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 4d83300934..4c35e3d7d0 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays byte-arrays combinators summary -io.backend graphics.viewer io io.binary io.files kernel libc -math math.functions namespaces opengl opengl.gl prettyprint -sequences strings ui ui.gadgets.panes io.encodings.binary -accessors grouping ; +USING: alien arrays byte-arrays combinators summary io.backend +graphics.viewer io io.binary io.files kernel libc math +math.functions math.bitwise namespaces opengl opengl.gl +prettyprint sequences strings ui ui.gadgets.panes +io.encodings.binary accessors grouping ; IN: graphics.bitmap ! Currently can only handle 24bit bitmaps. @@ -56,8 +56,8 @@ M: bitmap-magic summary : parse-bitmap-header ( bitmap -- ) 4 read le> >>header-length - 4 read le> >>width - 4 read le> >>height + 4 read signed-le> >>width + 4 read signed-le> >>height 2 read le> >>planes 2 read le> >>bit-count 4 read le> >>compression From d0e53db5fc9415250170748d01e81fea8c48fb1c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:15:38 -0600 Subject: [PATCH 089/102] Rendering tweaks --- basis/opengl/opengl.factor | 3 ++- basis/ui/gadgets/buttons/buttons.factor | 4 ++-- basis/ui/gadgets/editors/editors.factor | 2 +- basis/ui/gadgets/grid-lines/grid-lines.factor | 2 +- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 21fe663c44..ecb4c4a08c 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -64,7 +64,8 @@ MACRO: all-enabled-client-state ( seq quot -- ) [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline : line-vertices ( a b -- ) - append >c-float-array gl-vertex-pointer ; + [ first2 [ 0.5 + ] bi@ ] bi@ 4 narray + >c-float-array gl-vertex-pointer ; : gl-line ( a b -- ) line-vertices GL_LINES 0 2 glDrawArrays ; diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 11fb69fc7d..c975e64b12 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -111,8 +111,8 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ; : checkmark-points ( dim -- points ) { - [ { 0 0 } v* { 0 1 } v+ ] - [ { 1 1 } v* { 0 1 } v+ ] + [ { 0 0 } v* ] + [ { 1 1 } v* ] [ { 0 1 } v* ] [ { 1 0 } v* ] } cleave 4array ; diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 74647a6afb..2cf6d24154 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -112,7 +112,7 @@ M: editor ungraft* line-height * ; : caret-loc ( editor -- loc ) - [ editor-caret* ] keep 2dup loc>x 1+ + [ editor-caret* ] keep 2dup loc>x rot first rot line>y 2array ; : caret-dim ( editor -- dim ) diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor index d7844e3fa3..adfdd16f69 100644 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -27,7 +27,7 @@ M: grid-lines draw-boundary dup grid set dup rect-dim half-gap v- grid-dim set compute-grid - [ { 1 0 } draw-grid-lines ] + [ { -0.5 -0.5 } gl-translate { 1 0 } draw-grid-lines ] [ { 0.5 -0.5 } gl-translate { 0 1 } draw-grid-lines From 9fb6224e301a7bb2851169057da13e991457d730 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Nov 2008 14:15:48 -0600 Subject: [PATCH 090/102] Add UI render test tool --- extra/ui/render/test/reference.bmp | Bin 0 -> 73554 bytes extra/ui/render/test/reference.bmp.2 | Bin 0 -> 89322 bytes extra/ui/render/test/test.factor | 70 +++++++++++++++++++++++++++ 3 files changed, 70 insertions(+) create mode 100644 extra/ui/render/test/reference.bmp create mode 100644 extra/ui/render/test/reference.bmp.2 create mode 100644 extra/ui/render/test/test.factor diff --git a/extra/ui/render/test/reference.bmp b/extra/ui/render/test/reference.bmp new file mode 100644 index 0000000000000000000000000000000000000000..0740fcc8173f0a6fc4fcfa76802b5146e5a7c59b GIT binary patch literal 73554 zcmeIwu?Ye}7=+RPx-bw-t-u1zO{~HGGvjlWD?&cr!Y&*a&CI($o|kRD=eF*3-S@h$ zb+?xW#gNHaszyq*OiTL2FeZaU0zo?xW#gNH zaszyq*OiTL2FeZaU0zo?xW#gNHaszyq*OiTL O2FeZaU0(OkvwZ-#zpe-X literal 0 HcmV?d00001 diff --git a/extra/ui/render/test/reference.bmp.2 b/extra/ui/render/test/reference.bmp.2 new file mode 100644 index 0000000000000000000000000000000000000000..630563a5c7d6bc7838e122b7207ff3ad83cf5102 GIT binary patch literal 89322 zcmeI5L6X}x5JlzkGP|50XYt-Q$TG_;vd&3nPUpQZp|HhJ`oa(xN@Am7_M0+Hh>!^2 z_kRsQQ!an|{`1c-C;Rz#Dt}Mq$5j5B%9qn0r?1oXpQ-)#-%gh@z5M^@d^*j4?Dctm z!rZi_e)-V(d^%Hx(cltL3o2y@4ZPWyY31)|1uV|SoOir={x*$!#3I^r^gk;Ad)t`k zl{;WB51A!<@9*!YT6ueWtG3lXqxboIUB88G*vrk{;sdUI)aT&-OIz9&eYh_T&q5SJAdv>W7S+^;ibREpL(1Eu-AvL7Duob=l{r_ zVGs5q{g=7#l07~5w{kUY`!UP9my^JfJ@o;6?Z;P3OU-wj_wsNEdwuw7v8VYC_F%8& z725XY754J*rZZ*T+n1wf@)CPab!478?8URkx|fGHohj_Wp8A1$KLub9_WHSvo>YO7 zJw1C^8^vD(_MGa-JoS=2^#R=Zb7vZ>=KPKU_Ta7$cd(a-wQ{Bwd(E|)gW<0af4a}t zSa|7QdVtq43cy|;zFHh)*1eq0kDqnP zo}T-yjpDBX>s~wu5hEzsQy;*cKX<0F<~zP?iJ%~+PuT0jS1XTczJt9O4kCJmJ=lxz z9ewgWXKOv`)yAGPCyA_kta~|~A3tl@gS~hc<{Sa+!Cp@1$IrTCPtP9KM)B8x?>XZ+ zh!{c1p85dp{JArYRdasF5J5pqpRm`5uT~y|y%_ID_X>OQ?CCzAbuXHTe*MEDC!Jw1C^8^vD(_MAN(KTcmId+GzY^XJYqR?Ybx z!#Hesj|BGm@YTv=RraRf&;LW)4p-U3czcTHZ&LvF;@Q)E{@uD~>^0Xt*z-mp?D??wYp_>a4_hBy#wGSP`ULU?%c}(-& zUX0bA1A8A32)hA$uoq^&CaJbUapb3zDv@$9kZggxU>ePFLC{u-#}wR75D_vc)j z)9a(ndXB}-U+M$6yXoSog=$`7?5_XGM0c;39J%rSXdcWu9*d#IThAV=@m=D~b>06@ z=mL8==_}b&AHd!K>)s_ZT6TP~NKVM<^zmj5dwuw7@lF z91-lrv#0xf*vrEq?8URUW!`SaNavIVfDF{?5Pjn&YwHeSo7VZ-<>@A{yE-tKhV-o0od!qS1XTc zzI&9VN8b;7{n+}fC)k6%&pblAj{>k4&mMbDA8(KTRM?AWk3Hw;l=zGf_I?faEKb)l zS>alL;=YfQcl^PUwE2)zwzz4$)d$y@uEm*q>;8X27u8&2 z!N1=d5}Dlw1$*)5J>BQm*xT#=9Pi!i!-HN>0QTb9+p_M#-U}ul^rNr`dxKi@@WX;V z*gL$*2c017!QPKA|Gskptvt2CUH??7?2c9yB>B0DJN5vFCI&_`r{by?FMv>^Ut? z*E0F(T7TmHz;;YEv^Dn33rn$_{8@czU%T@8ZTc-N)y{QG`{fFIhhVg1?=HrgQ>m}7 zH9PC_fj#4Fk0RqdgmDir3D}dpocJ>;2i>tZz<8o`$kOjlnRSos%rmA{&eM1Q0k)Uf A1ONa4 literal 0 HcmV?d00001 diff --git a/extra/ui/render/test/test.factor b/extra/ui/render/test/test.factor new file mode 100644 index 0000000000..01b5b65bcf --- /dev/null +++ b/extra/ui/render/test/test.factor @@ -0,0 +1,70 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors colors arrays kernel sequences math byte-arrays +namespaces cap graphics.bitmap +ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids +ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons +ui.render ui opengl opengl.gl ; +IN: ui.render.test + +SINGLETON: line-test + +M: line-test draw-interior + 2drop { 0 0 } { 0 10 } gl-line ; + +: ( -- gadget ) + + line-test >>interior + { 1 10 } >>dim ; + +TUPLE: ui-render-test < pack { first-time? initial: t } ; + +: message-window ( text -- ) +