From 237fd4648a36f4df129f8402ba4ef353681f3547 Mon Sep 17 00:00:00 2001 From: crc Date: Tue, 11 Feb 2020 21:18:34 +0000 Subject: [PATCH] retro.forth: minor reorganizations FossilOrigin-Name: 7e24bacd489b0d5855028649d4c48023a499f5c1e7c50bcabe02dcf192c7b5d1 --- image/retro.forth | 52 +++++++++++++++--------------- ngaImage | Bin 37844 -> 37844 bytes vm/nga-c/retro-image.c | 70 ++++++++++++++++++++--------------------- 3 files changed, 61 insertions(+), 61 deletions(-) diff --git a/image/retro.forth b/image/retro.forth index 541010d..8c093d5 100644 --- a/image/retro.forth +++ b/image/retro.forth @@ -445,32 +445,6 @@ to: [ swap repeat 0; \lisupudu `1 \puca.... \popo.... again ] call drop ; ~~~ -`case` is a conditional combinator. It's actually pretty -useful. What it does is compare a value on the stack to a -specific value. If the values are identical, it discards the -value and calls a quote before exiting the word. Otherwise -it leaves the stack alone and allows execution to continue. - -Example: - - :c:vowel? - $a [ TRUE ] case - $e [ TRUE ] case - $i [ TRUE ] case - $o [ TRUE ] case - $u [ TRUE ] case - drop FALSE ; - -~~~ -:case - [ over eq? ] dip swap - [ nip call #-1 ] [ drop #0 ] choose 0; pop drop drop ; - -:s:case - [ over s:eq? ] dip swap - [ nip call #-1 ] [ drop #0 ] choose 0; pop drop drop ; -~~~ - ## A Shortcut ~~~ @@ -494,6 +468,32 @@ Forth, where non-zero values are true. :FALSE (-n) #0 ; ~~~ +`case` is a conditional combinator. It's actually pretty +useful. What it does is compare a value on the stack to a +specific value. If the values are identical, it discards the +value and calls a quote before exiting the word. Otherwise +it leaves the stack alone and allows execution to continue. + +Example: + + :c:vowel? + $a [ TRUE ] case + $e [ TRUE ] case + $i [ TRUE ] case + $o [ TRUE ] case + $u [ TRUE ] case + drop FALSE ; + +~~~ +:case + [ over eq? ] dip swap + [ nip call TRUE ] [ drop FALSE ] choose 0; pop drop drop ; + +:s:case + [ over s:eq? ] dip swap + [ nip call TRUE ] [ drop FALSE ] choose 0; pop drop drop ; +~~~ + Some numeric comparisons. ~~~ diff --git a/ngaImage b/ngaImage index 42aa15fd7bca4265d50aa56042f77d4731f06ad9..d8dd2b03851bfa81e76012890254fc77e2045deb 100644 GIT binary patch delta 424 zcmcbzoaxGPrVVeDnbb1l!RGl*MI73s4SZ$3!5F&5mA> z9gMk~Gu7BR8BHb^>YFn(C6Pc~E)wqoIAU|{56V6XyW76u@joq<6ZD8|CfzyK6t zUP;026 z9uPxaz=o;-1!E__RW`Rwg&H>x=mvfuhPfpXsx22PzW_}>b8@VTIAhJ^QWa&{Qji*; zyeJTZ{ObUuLFNPk#k(hORZ(Yc2C}A4eyF0&*ta=Tjh&ORdvc+^Ipg%rEA_9d0;$GO zYfeU{&3ofE^8rJ!FxMDJE(Mb}!6a`UNW?L3Igoq_X3OSV1KE-J$v|>%K2Ub^$NY9) R#_5wQYx{u)a@L&|1ptOvPKN*h diff --git a/vm/nga-c/retro-image.c b/vm/nga-c/retro-image.c index c20f00c..2cd8804 100644 --- a/vm/nga-c/retro-image.c +++ b/vm/nga-c/retro-image.c @@ -118,14 +118,14 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 2235,7,10,1,2235,8,3,10,2224,2256,144,117,110,116,105,108,0,1793,2267,525570, 385942534,-1,25,3,1,2258,7,10,1,2258,8,3,10,2247,2281,144,116,105,109,101, 115,0,1793,2293,4,25,33886721,1,2053,1542,1,2284,7,10,1,2283,8,3,10,2272, - 2306,144,99,97,115,101,0,1793,2311,67502597,11,10,1,2308,2049,2106,4,1793,2323,772, - 8,1,-1,10,1,2318,1793,2331,3,1,0,10,1,2327,2049,64,25,6,3,3, - 10,2298,2350,144,115,58,99,97,115,101,0,1793,2356,67502597,2049,93,10,1,2352,2049, - 2106,4,1793,2368,772,8,1,-1,10,1,2363,1793,2376,3,1,0,10,1,2372,2049, - 64,25,6,3,3,10,2340,2397,156,112,114,101,102,105,120,58,124,0,2049,197, - 1793,2405,2049,158,15,10,1,2401,1793,2413,2049,160,15,10,1,2409,2049,2128,2049,1818, - 1793,2428,1,131,2049,2106,2049,1777,10,1,2421,1,21,2049,64,10,2385,2443,144,84, - 82,85,69,0,1,-1,10,2435,2455,144,70,65,76,83,69,0,1,0,10,2446, + 2310,156,112,114,101,102,105,120,58,124,0,2049,197,1793,2318,2049,158,15,10,1, + 2314,1793,2326,2049,160,15,10,1,2322,2049,2128,2049,1818,1793,2341,1,131,2049,2106,2049, + 1777,10,1,2334,1,21,2049,64,10,2298,2356,144,84,82,85,69,0,1,-1,10, + 2348,2368,144,70,65,76,83,69,0,1,0,10,2359,2379,144,99,97,115,101,0, + 1793,2384,67502597,11,10,1,2381,2049,2106,4,1793,2396,772,8,2049,2356,10,1,2391,1793, + 2404,3,2049,2368,10,1,2400,2049,64,25,6,3,3,10,2371,2423,144,115,58,99, + 97,115,101,0,1793,2429,67502597,2049,93,10,1,2425,2049,2106,4,1793,2441,772,8,2049, + 2356,10,1,2436,1793,2449,3,2049,2368,10,1,2445,2049,64,25,6,3,3,10,2413, 2465,144,110,111,116,0,1,-1,23,10,2458,2478,144,108,116,101,113,63,0,2049, 2096,101516555,22,10,2469,2492,144,103,116,101,113,63,0,4,2049,2478,10,2483,2505,144, 110,58,77,65,88,0,1,-5,15,10,2496,2518,144,110,58,77,73,78,0,1, @@ -154,8 +154,8 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 45,98,121,0,1793,2969,15,4,18,10,1,2965,2049,2116,16,10,2951,2984,144,118, 58,105,110,99,0,1,1,4,2049,2940,10,2975,2999,144,118,58,100,101,99,0, 1,1,4,2049,2963,10,2990,3016,144,118,58,108,105,109,105,116,0,5,5,2, - 15,6,6,2049,2866,4,16,10,3005,3035,144,118,58,111,110,0,2049,2443,4,16, - 10,3027,3049,144,118,58,111,102,102,0,2049,2455,4,16,10,3040,3063,144,97,108, + 15,6,6,2049,2866,4,16,10,3005,3035,144,118,58,111,110,0,2049,2356,4,16, + 10,3027,3049,144,118,58,111,102,102,0,2049,2368,4,16,10,3040,3063,144,97,108, 108,111,116,0,1,3,2049,2940,10,3054,3082,144,118,58,112,114,101,115,101,114, 118,101,0,4,2,15,1793,3092,1,21,2049,2106,10,1,3087,2049,2106,4,16,10, 3068,3111,144,118,58,117,112,100,97,116,101,0,4,1793,3118,15,4,8,10,1, @@ -276,7 +276,7 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 101,63,0,1,32,1,126,2049,2914,10,5388,5421,144,99,58,118,111,119,101,108, 63,0,2049,3657,97,101,105,111,117,65,69,73,79,85,0,1,5423,4,2049,4007, 10,5409,5456,144,99,58,99,111,110,115,111,110,97,110,116,63,0,2,2049,5361, - 1793,5466,2049,5421,2049,2465,10,1,5461,1793,5474,3,2049,2455,10,1,5470,2049,64,10, + 1793,5466,2049,5421,2049,2465,10,1,5461,1793,5474,3,2049,2368,10,1,5470,2049,64,10, 5440,5496,144,99,58,119,104,105,116,101,115,112,97,99,101,63,0,1,4846,4, 2049,4007,10,5479,5519,144,99,58,45,108,111,119,101,114,99,97,115,101,63,0, 2049,5318,2049,2465,10,5502,5541,144,99,58,45,117,112,112,101,114,99,97,115,101, @@ -306,7 +306,7 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 2049,2568,1793,6008,1,45,2049,3347,10,1,6003,9,2049,3313,2049,3762,2049,3612,10,1, 5966,2049,3463,10,5949,6045,131,82,101,119,114,105,116,101,85,110,100,101,114,115, 99,111,114,101,115,0,-1,6023,6053,144,115,117,98,0,1,95,1793,6060,1,32, - 10,1,6057,2049,2306,10,6046,6076,144,114,101,119,114,105,116,101,0,3841,6045,1793, + 10,1,6057,2049,2379,10,6046,6076,144,114,101,119,114,105,116,101,0,3841,6045,1793, 6085,1,6053,2049,4347,10,1,6080,9,10,6065,6099,144,104,97,110,100,108,101,0, 1,3716,8,10,6023,6115,156,112,114,101,102,105,120,58,39,0,2049,6076,2049,6099, 10,6103,6131,144,115,58,115,112,108,105,116,0,2049,2096,2049,3935,772,2049,2096,2049, @@ -353,15 +353,15 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 0,2049,6920,1,0,4,16,10,6691,6964,144,115,58,114,101,112,108,97,99,101, 45,97,108,108,0,1,3,1793,6979,2049,6852,2049,6869,2049,6901,2049,6940,2049,3612,10, 1,6968,2049,3082,10,6947,6992,144,99,104,97,114,0,1,32,1793,7001,1,95,2049, - 3347,10,1,6996,2049,2306,1,114,1793,7014,1,13,2049,3347,10,1,7009,2049,2306,1, - 110,1793,7027,1,10,2049,3347,10,1,7022,2049,2306,1,116,1793,7040,1,9,2049,3347, - 10,1,7035,2049,2306,1,48,1793,7053,1,0,2049,3347,10,1,7048,2049,2306,2049,3347, + 3347,10,1,6996,2049,2379,1,114,1793,7014,1,13,2049,3347,10,1,7009,2049,2379,1, + 110,1793,7027,1,10,2049,3347,10,1,7022,2049,2379,1,116,1793,7040,1,9,2049,3347, + 10,1,7035,2049,2379,1,48,1793,7053,1,0,2049,3347,10,1,7048,2049,2379,2049,3347, 10,6984,7070,144,115,116,114,105,110,103,0,2049,56,25,2049,3347,1,7070,7,10, - 7060,7087,144,116,121,112,101,0,1,99,1793,7095,4,2049,3347,10,1,7091,2049,2306, - 1,115,1793,7108,4,2049,7070,3,10,1,7103,2049,2306,1,110,1793,7123,4,2049,5964, - 2049,7070,3,10,1,7116,2049,2306,3,10,7079,7139,144,104,97,110,100,108,101,0, - 1,92,1793,7148,2049,56,2049,6992,10,1,7143,2049,2306,1,37,1793,7161,2049,56,2049, - 7087,10,1,7156,2049,2306,2049,3347,10,6947,7180,144,115,58,102,111,114,109,97,116, + 7060,7087,144,116,121,112,101,0,1,99,1793,7095,4,2049,3347,10,1,7091,2049,2379, + 1,115,1793,7108,4,2049,7070,3,10,1,7103,2049,2379,1,110,1793,7123,4,2049,5964, + 2049,7070,3,10,1,7116,2049,2379,3,10,7079,7139,144,104,97,110,100,108,101,0, + 1,92,1793,7148,2049,56,2049,6992,10,1,7143,2049,2379,1,37,1793,7161,2049,56,2049, + 7087,10,1,7156,2049,2379,2049,3347,10,6947,7180,144,115,58,102,111,114,109,97,116, 0,1793,7209,2049,3638,1793,7204,2049,3439,1793,7199,2049,56,25,2049,7139,1,7190,7,10, 1,7190,8,3,10,1,7186,2049,2116,10,1,7182,2049,3463,10,7168,7225,144,115,58, 99,111,110,115,116,0,1,3683,2049,2106,2049,2022,10,7214,7242,131,86,97,108,117, @@ -404,9 +404,9 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 97,116,105,111,110,0,0,7953,7977,144,112,114,101,112,97,114,101,0,4,1, -1,4097,7965,10,7966,7991,144,110,101,120,116,0,3841,7965,2049,2568,1793,8002,1,7965, 2049,2999,10,1,7997,9,10,7983,8016,144,109,97,116,99,104,63,0,67502597,11,1793, - 8025,3841,7965,2049,2568,10,1,8020,1793,8032,2049,2455,10,1,8029,2049,64,10,8006,8051, + 8025,3841,7965,2049,2568,10,1,8020,1793,8032,2049,2368,10,1,8029,2049,64,10,8006,8051, 144,109,97,116,99,104,45,115,116,114,63,0,67502597,2049,93,1793,8061,3841,7965,2049, - 2568,10,1,8056,1793,8068,2049,2455,10,1,8065,2049,64,10,8037,8083,144,117,112,100, + 2568,10,1,8056,1793,8068,2049,2368,10,1,8065,2049,64,10,8037,8083,144,117,112,100, 97,116,101,0,3841,7965,2049,2848,2049,2896,4097,7965,10,7912,8106,144,97,58,105,110, 100,101,120,45,111,102,0,2049,7977,2049,2096,2049,7894,1793,8118,771,1,-1,10,1, 8114,2049,2678,1793,8132,2049,8016,1,8083,9,2049,7991,10,1,8124,2049,7601,3,3841,7965, @@ -493,8 +493,8 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 58,115,105,122,101,0,1,6,2049,9574,10,9732,9765,144,102,105,108,101,58,100, 101,108,101,116,101,0,1,7,2049,9574,10,9750,9784,144,102,105,108,101,58,102, 108,117,115,104,0,1,8,2049,9574,10,9770,9805,144,102,105,108,101,58,101,120, - 105,115,116,115,63,0,1,0,2049,9635,2,2049,2549,1793,9819,2049,9654,2049,2443,10, - 1,9814,1793,9827,3,2049,2455,10,1,9823,2049,64,10,9789,9858,144,102,105,108,101, + 105,115,116,115,63,0,1,0,2049,9635,2,2049,2549,1793,9819,2049,9654,2049,2356,10, + 1,9814,1793,9827,3,2049,2368,10,1,9823,2049,64,10,9789,9858,144,102,105,108,101, 58,111,112,101,110,60,102,111,114,45,114,101,97,100,105,110,103,62,0,1, 0,2049,9635,2,2049,9745,4,10,9832,9892,144,102,105,108,101,58,111,112,101,110, 60,102,111,114,45,97,112,112,101,110,100,62,0,1,2,2049,9635,2,2049,9745, @@ -599,10 +599,10 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 10373,2049,10471,10,11831,11873,144,102,58,116,111,45,101,0,2049,10619,2049,11209,1793,11884, 2049,10634,1,-2147483647,10,1,11879,2049,2661,2049,10619,2049,11224,1793,11899,2049,10634,1,2147483646,10, 1,11894,2049,2661,2049,10619,2049,11240,1793,11914,2049,10634,1,-2147483646,10,1,11909,2049,2661,2049, - 11798,2049,11256,2049,10412,2049,11692,1,-2147483645,1793,11933,2049,10634,10,1,11930,2049,2306,1,2147483645, - 1793,11944,2049,10634,10,1,11941,2049,2306,10,11863,11959,144,101,58,116,111,45,102,0, - 1,-2147483647,1793,11966,2049,11118,10,1,11963,2049,2306,1,2147483646,1793,11977,2049,11146,10,1,11974, - 2049,2306,1,-2147483646,1793,11988,2049,11177,10,1,11985,2049,2306,2049,10373,2049,11816,10,11949,12008, + 11798,2049,11256,2049,10412,2049,11692,1,-2147483645,1793,11933,2049,10634,10,1,11930,2049,2379,1,2147483645, + 1793,11944,2049,10634,10,1,11941,2049,2379,10,11863,11959,144,101,58,116,111,45,102,0, + 1,-2147483647,1793,11966,2049,11118,10,1,11963,2049,2379,1,2147483646,1793,11977,2049,11146,10,1,11974, + 2049,2379,1,-2147483646,1793,11988,2049,11177,10,1,11985,2049,2379,2049,10373,2049,11816,10,11949,12008, 144,102,58,115,116,111,114,101,0,1793,12013,2049,11873,10,1,12010,2049,2106,16,10, 11997,12030,144,102,58,102,101,116,99,104,0,15,2049,11959,10,12019,12050,144,102,58, 100,117,109,112,45,115,116,97,99,107,0,2049,10605,2,1,10781,2049,2281,1793,12068, @@ -610,12 +610,12 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 117,109,112,45,97,115,116,97,99,107,0,2049,10812,2,1,10795,2049,2281,1793,12108, 2049,10619,2049,11057,2049,9353,2049,10781,10,1,12099,2049,2281,10,12073,12122,144,101,58,112, 117,116,0,1,2147483645,1793,12139,2049,3657,101,58,77,65,88,0,1,12128,2049,9379,10, - 1,12126,2049,2306,1,-2147483645,1793,12160,2049,3657,101,58,77,73,78,0,1,12149,2049,9379, - 10,1,12147,2049,2306,1,0,1793,12179,2049,3657,101,58,48,0,1,12170,2049,9379,10, - 1,12168,2049,2306,1,-2147483647,1793,12200,2049,3657,101,58,78,65,78,0,1,12189,2049,9379, - 10,1,12187,2049,2306,1,2147483646,1793,12221,2049,3657,101,58,73,78,70,0,1,12210,2049, - 9379,10,1,12208,2049,2306,1,-2147483646,1793,12243,2049,3657,101,58,45,73,78,70,0,1, - 12231,2049,9379,10,1,12229,2049,2306,2049,11959,2049,11057,10,12113,12270,131,105,111,58,85, + 1,12126,2049,2379,1,-2147483645,1793,12160,2049,3657,101,58,77,73,78,0,1,12149,2049,9379, + 10,1,12147,2049,2379,1,0,1793,12179,2049,3657,101,58,48,0,1,12170,2049,9379,10, + 1,12168,2049,2379,1,-2147483647,1793,12200,2049,3657,101,58,78,65,78,0,1,12189,2049,9379, + 10,1,12187,2049,2379,1,2147483646,1793,12221,2049,3657,101,58,73,78,70,0,1,12210,2049, + 9379,10,1,12208,2049,2379,1,-2147483646,1793,12243,2049,3657,101,58,45,73,78,70,0,1, + 12231,2049,9379,10,1,12229,2049,2379,2049,11959,2049,11057,10,12113,12270,131,105,111,58,85, 110,105,120,83,121,115,99,97,108,108,0,0,12252,12283,144,105,100,101,110,116, 105,102,121,0,3841,12270,2049,2533,1793,12350,1,8,2049,9286,2,2049,2568,1793,12338,3, 2049,3657,73,79,32,68,69,86,73,67,69,32,84,89,80,69,32,48,48,48, @@ -752,6 +752,6 @@ CELL ngaImage[] = { 1793,14339,14883,15036,202004,0,10,1,10,2,10,3,10,4,10,5,10, 10,1,14915,2049,7412,10,14883,14935,144,102,105,101,108,100,115,0,3841,2,2049,105, 2049,105,2049,105,10,14925,14961,144,105,110,118,97,108,105,100,45,110,97,109,101, 63,0,2,1,32,2049,4007,10,14944,14978,144,114,101,119,114,105,116,101,0,1793, - 14992,1,32,1793,14987,1,95,10,1,14984,2049,2306,10,1,14980,2049,4347,10,14967,15006, + 14992,1,32,1793,14987,1,95,10,1,14984,2049,2379,10,1,14980,2049,4347,10,14967,15006, 144,101,110,116,114,121,0,2049,1877,1,21,2049,2106,4097,2,10,1793,15034,1793,15029, 2049,14935,2049,14961,1,14978,9,2049,119,10,1,15019,2049,15006,10,1,15017,0 };