diff options
Diffstat (limited to 'testsuite/tests/programs/thurston-modular-arith')
5 files changed, 163 insertions, 0 deletions
diff --git a/testsuite/tests/programs/thurston-modular-arith/Main.hs b/testsuite/tests/programs/thurston-modular-arith/Main.hs new file mode 100644 index 0000000000..608025b1e1 --- /dev/null +++ b/testsuite/tests/programs/thurston-modular-arith/Main.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE UndecidableInstances, ExistentialQuantification, + ScopedTypeVariables, Rank2Types #-} + +-- Modular arithmetic, due to Dale Thurston + +-- Here's a way to mimic dependent types using existential types, +-- illustrated by an implementation of modular arithmetic. To try it +-- out, load modulus.hs and try something like +-- inModulus (mkModulus (1234567890123::Integer)) (^ 98765432198765) 2 +-- to compute 2 to the 98765432198765'th power modulo 1234567890123. + +-- The key is the definitions at the top of TypeVal.hs: +-- +-- class TypeVal a t | t -> a where +-- -- typeToVal should ignore its argument. +-- typeToVal :: t -> a +-- +-- data Wrapper a = forall t . (TypeVal a t) => Wrapper t +-- +-- class ValToType a where +-- valToType :: a -> Wrapper a +-- +-- `valToType' takes a value `x' and returns a (wrapped version of a) +-- fake value in a new type; from the new type, `x' can be recovered by +-- applying typeToVal. +-- +-- This code works under ghc. It uses existentially quantified data +-- constructors, scoped type variables, and explicit universal +-- quantification. + + +module Main where + +import TypeVal + +default (Integer) + +main = print (map (inModulus (mkModulus (1234567890123::Integer)) (^98765432198765)) [2..1000]) + + + +data Mod s a = Mod {value::a} deriving (Eq, Show) + +data Modulus a = forall s. TypeVal a s => Modulus (a -> Mod s a) (Mod s a -> a) + +mkModulus :: (ValToType a, Integral a) => a -> Modulus a +mkModulus x = case valToType x of {Wrapper (y :: t) -> + Modulus normalize (value :: Mod t a -> a)} + +normalize :: forall a s. (TypeVal a s, Integral a) => a -> Mod s a +normalize x = (Mod (x `mod` typeToVal (undefined::s))) + +inModulus :: Modulus a -> (forall s . TypeVal a s => Mod s a -> Mod s a) + -> a -> a +inModulus (Modulus in_ out) f x = out (f (in_ x)) + +instance (TypeVal a s, Integral a) => Num (Mod s a) where + Mod x + Mod y = normalize (x + y) + Mod x - Mod y = normalize (x - y) + negate (Mod x) = normalize (negate x) + Mod x * Mod y = normalize (x * y) + fromInteger a = normalize (fromInteger a) diff --git a/testsuite/tests/programs/thurston-modular-arith/Makefile b/testsuite/tests/programs/thurston-modular-arith/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/programs/thurston-modular-arith/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/programs/thurston-modular-arith/TypeVal.hs b/testsuite/tests/programs/thurston-modular-arith/TypeVal.hs new file mode 100644 index 0000000000..f1608a7dfe --- /dev/null +++ b/testsuite/tests/programs/thurston-modular-arith/TypeVal.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, + UndecidableInstances, ExistentialQuantification, + ScopedTypeVariables #-} + +-- TypeVal.hs: dependent types, here we come! +module TypeVal where + +-- The functional dependency is necessary to get ghc to accept +-- some of the instances below. Is this a bug? +class TypeVal a t | t -> a where + -- typeToVal should ignore its argument. + typeToVal :: t -> a + +data Wrapper a = forall t . (TypeVal a t) => Wrapper t +instance Show a => Show (Wrapper a) where + show x = "valToType " ++ show (getValue x) + +class ValToType a where + valToType :: a -> Wrapper a + +getValue :: Wrapper a -> a +getValue (Wrapper p) = case p of {(_::t) -> typeToVal (undefined::t)} + +-- Instances of ValToType for standard types. This would also be a +-- straightforward compiler extension for the general case. +---- ValToType Bool +data TRUE = Dummy1 +instance TypeVal Bool TRUE where typeToVal = const True +data FALSE = Dummy2 +instance TypeVal Bool FALSE where typeToVal = const False + +instance ValToType Bool where + valToType True = Wrapper (undefined :: TRUE) + valToType False = Wrapper (undefined :: FALSE) + +---- ValToType Int, ValToType Integer +data Zero = Dummy3 +instance TypeVal Integer Zero where typeToVal = const 0 +data Succ n = Dummy4 +instance (TypeVal Integer n) => TypeVal Integer (Succ n) + where typeToVal = const (typeToVal (undefined :: n) + 1) +data Pred n = Dummy5 +instance (TypeVal Integer n) => TypeVal Integer (Pred n) + where typeToVal = const (typeToVal (undefined :: n) - 1) +data Dbl n = Dummy6 +instance (TypeVal Integer n) => TypeVal Integer (Dbl n) + where typeToVal = const (typeToVal (undefined :: n) * 2) + +instance ValToType Integer where + valToType n | n == 0 = Wrapper (undefined :: Zero) + | even n = + case valToType (div n 2) of {Wrapper x -> + case x of {(_ :: t) -> + Wrapper (undefined :: Dbl t)}} + | n > 0 = + case valToType (n-1) of {Wrapper x -> + case x of {(_ :: t) -> + Wrapper (undefined :: Succ t)}} + | n < 1 = + case valToType (n+1) of {Wrapper x -> + case x of {(_ :: t) -> + Wrapper (undefined :: Pred t)}} + +--- ValToType (a,b) +--- Doesn't work. Perhaps a bug in ghc? +--- Don't need it yet, anyway. +--instance (TypeVal a1 t1, TypeVal a2 t2) => TypeVal (a1,a2) (t1,t2) +-- where typeToVal (x,y) = (typeToVal x, typeToVal y) + +--instance (ValToType a, ValToType b) => ValToType (a,b) where +-- valToType (a,b) = case valToType a of {x -> +-- case valToType b of {y -> +-- Wrapper (x,y)}} + +data NIL a = Dummy20 +instance TypeVal [a] (NIL a) + where typeToVal = const [] +data CONS t r = Dummy21 +instance (TypeVal [a] r, TypeVal a t) => TypeVal [a] (CONS t r) + where typeToVal = const (typeToVal (undefined::t):typeToVal (undefined::r)) + +instance (ValToType a) => ValToType [a] where + valToType [] = Wrapper (undefined::NIL a) + valToType (x:xs) = case valToType x of {Wrapper x' -> + case x' of {(_::xt) -> + case valToType xs of {Wrapper xs' -> + case xs' of {(_::xst) -> + Wrapper (undefined::CONS xt xst)}}}} + diff --git a/testsuite/tests/programs/thurston-modular-arith/test.T b/testsuite/tests/programs/thurston-modular-arith/test.T new file mode 100644 index 0000000000..812fb07ba0 --- /dev/null +++ b/testsuite/tests/programs/thurston-modular-arith/test.T @@ -0,0 +1,8 @@ +# uses GHC-specific scoped type variables +test('thurston-modular-arith', + [skip_if_fast, + extra_clean(['Main.hi', 'Main.o', 'TypeVal.hi', 'TypeVal.o']), + only_compiler_types(['ghc'])], + multimod_compile_and_run, + ['Main', '']) + diff --git a/testsuite/tests/programs/thurston-modular-arith/thurston-modular-arith.stdout b/testsuite/tests/programs/thurston-modular-arith/thurston-modular-arith.stdout new file mode 100644 index 0000000000..8e3f242235 --- /dev/null +++ b/testsuite/tests/programs/thurston-modular-arith/thurston-modular-arith.stdout @@ -0,0 +1 @@ +[1160454313058,601042866744,486139893064,1061833102220,1200539454459,431697477337,1071932948573,437368016493,648465519190,28117328753,572802463620,525458964661,1098965050058,1146413181663,1031790281833,132693597578,1022572439703,1188385014820,1155550272194,1085333828748,711138169084,1097810085884,969851413290,688113499105,1051451464166,91762740357,683576430811,1017300306164,859345346706,464476722784,986691407909,126154333557,616844850370,807700787534,950949002319,569427334108,139926701747,190252127100,681104764591,255337432013,578119123611,1095387195469,205025111054,4280351535,610564088860,668244575777,808958391,413622644002,547196368946,972489655833,43426052275,1029109886156,1003618336884,701219690218,32652275231,856890419730,795025690024,547167228323,81588598779,99123847990,1220352459311,861656358801,415539053485,262846600937,1095771863403,902329833964,155153868473,153256674846,95762892226,434756569979,1119461310498,225955668604,956407996106,602727331338,938712892870,138739207238,597476751261,753203850127,630377605028,1104011481810,651971720632,612639306767,44587272558,723189778903,1175694673739,296308490298,1050104370640,627705731156,456946245990,273636070060,370164717197,714102131007,241897937971,38548029431,641195604432,461162026660,1034230483799,414958271178,116683347148,993546029951,41338685529,1220999331823,355305087011,1154304537831,766433766430,492783359087,728660191128,1182291562810,303019838675,970531985883,1045175815468,414139799249,356215791186,930220136011,1207666364855,579053085321,1129739376256,618126466955,368266007673,603781312885,473511265493,481922050275,677266129081,470427220376,847741222506,990891352681,812435920874,1023023680992,1208648273494,1088031018179,397541463261,529449734884,685114033205,176592183684,1090703954446,425846826311,1030710203349,955873684381,1187149926806,151655613972,786557007817,906015064925,705327542406,765658988977,796744992014,459893204178,7120144612,955773870884,1107099246174,642634148962,523073631629,58810720680,871199825791,432464993000,473547864180,1192291465438,595260628376,1072564372326,78245140603,907635981434,1107920080794,448916242606,138424240535,771626704089,165569019913,39555526940,770608713618,515846898835,75890462387,368361334842,45929245822,113717079968,27967579008,761506187395,1041881431520,325796720496,1116752001385,562028391536,674089512057,684719722795,698329876223,1000106137626,333283811722,544115584442,52151559447,593024042413,593403396845,703893326397,891454822660,673538061926,1085365393980,682406768362,1175661162158,24810610938,428514302596,242328677783,1146691870623,445320947368,864057887837,1043096768322,1079482205566,528910556072,656320945593,1064352684013,278897066828,225559146681,402782331265,659412153374,362593056657,364730396677,1148557099688,421921752513,133993132252,1212170060675,634220655210,1193832204682,944513974343,100005147966,1143053740822,869930873522,597571253205,1126573274992,1098475166978,1019152575837,127516694770,753856020941,182462155983,1055841159892,1090239319538,1111328111610,109997744290,716224188827,696188724732,628913582881,1140602949365,1191662634855,1118097070063,914849082719,675285189684,1212483031948,1005245378633,359463110721,599408183053,547330377389,722963002668,297547082524,774657435221,99824244072,823385133688,281330124509,496819564299,608029555942,418934961653,535244972361,69559315471,719903133248,775576742202,791217321085,830663150129,357628283766,50329297006,629010984818,399300483534,844190871193,1177651219601,295235324508,298762498933,640850115419,996814410816,1191748613152,623580620366,848859960861,450598347415,937257569423,185858247159,387374896393,484633408337,595302696579,313413800134,496578302939,1186936457550,1084776227881,1207149372011,378702576975,13768562311,88971637925,78133947057,370744945123,506882398136,1041055057095,514588090864,810688626791,749466223761,201955679689,193128396581,622185514341,50781478150,96159001679,1095884182806,363039641863,721677089876,539220204741,703310309362,792815735693,1158048228795,902375131249,967175975249,236171954442,212846487217,355219969592,224801991714,399425740960,705135846005,1097450157045,1113041027773,740806614671,471468459255,212390876815,875518600811,91631615655,549056769637,318874352846,804813562572,320760633832,415881440936,967177486461,220454508523,1017740100677,1189461696882,304789032646,1053664539896,952370456796,387781408399,205824342704,1043023288251,229962678091,1157959228388,157439920431,710504704177,547579387976,162664500339,870138759367,460985207786,455487687357,8941448179,554639580674,1188661385061,541750828411,644168654918,1112574821787,426308210125,32055355232,1043230207386,817091977816,893778761354,943758646944,228461650648,1048712884757,421413823740,325501620253,1199866192940,928639509771,131629542466,129295607117,360470445201,917320693930,762083126231,824301510441,201186223081,333161915069,632714271198,360025291471,1081931599316,1189948821699,478148985928,360636707762,733359741846,1154318330158,4740061154,154804428228,595322626936,1190077271684,648335955183,70902560803,965638725137,884647563534,246333658246,997025680376,876772960188,268821879826,564963007403,496203319992,1190255420221,1205878745345,761790415671,363992050603,914469688418,830971452261,604356339244,681802188773,1139919862926,617134290520,506310044828,1062000551985,367349124595,631047074579,139402478742,119201476132,568357381712,746135276958,377692642384,427149372725,1134775925640,6286992172,1213780407968,1099210021863,1112144815717,186978713498,473414771892,1042388392384,810706992008,1184326701837,230266782967,777166996691,754307517579,185890912750,737382949109,1157370682449,984031886647,201323443925,451852790436,29770301089,510986676710,272590013214,313071017737,183766893173,24142297407,1019310800176,518107423013,848680481169,1001375623714,222556405526,1078851836163,971374237084,685014921170,306091259997,758451325831,161822311238,503187490506,757573811953,399929921153,307727255763,622976564857,777026317370,878048036676,375263237737,190034609300,560433601737,439106791060,688051786847,800100518109,1056996730813,1052473747676,1079216172801,388541989780,693297119405,65087791335,1032219499684,752853293756,225848306913,214729950034,1071237287861,1047979140312,376025964895,723732391964,105401678547,983938797598,779738601410,583856935776,847798794211,1202302182695,433115846580,776043906184,490746025703,540238890048,576350727547,1210658282030,1205125109643,638664247138,1218415239266,665480311572,264979343416,42572107736,519364330929,1013530783237,1136792022548,266240525811,1116177912751,876885668567,579372041244,686881957741,869588711057,53902619421,1137719320579,333660464642,653519234190,536169401650,488134923326,666373975728,574797219589,419780893640,1056631409409,404201534647,700888820813,12633156054,1048562180281,452418067259,98144609445,678734068666,223938955292,571034512779,1089434833354,813073368098,66718778856,896591098510,810930390536,1083816917535,949520068315,237324564635,450805767306,1031087019826,718256322665,668953458180,107118126445,796601244899,423207189471,745416172117,331197599630,548793228600,836410144525,1109259650234,287280184875,551647209646,673640803448,930837538401,246170879647,1073444959250,1133458004343,777088699882,512175277337,187110897210,1188867033061,1029022199471,1003276554945,1149086828404,872914915673,771310912452,919129709572,977899716566,645299335803,636693979498,777884667695,241002230496,308988228235,716253490004,990350757363,551816255251,795464824433,579042118215,590495051341,485379632300,333440087460,401442097876,58112869031,538439987268,723917486872,738611440298,25181737887,789222479599,778777859522,177224757066,591901112146,603428436269,36556739187,1095915354724,1120666090166,1076764711272,417618270562,372482310311,1115161210740,1061283447088,891370967168,614503373025,705386707777,176657312189,426056599269,106155768004,4834253099,185076150300,1134248064883,255044207948,969655781724,801145069630,823540691849,495443851494,1124906765692,63595663727,543602566536,1080292362568,803133407084,1196172699624,615526340809,42092276858,859293415248,34559835463,501493313834,36454784694,605630067508,1192374228119,1171423126038,62066814913,44545946426,439207033797,1092646960921,414091445564,608291005227,21762096208,867954464315,1017550045014,22731996142,49560289331,222015335580,151964194894,696163708808,498591364503,458938819435,852580990280,176405495163,716406386188,873740680490,810232860120,1064634217903,743347864466,542722926261,627997546633,922725420917,141925635147,1082879409280,246364778111,1173214463124,1107528346528,347026435673,1175664021489,811196017027,520831331666,668249677512,414115730068,282793576307,939013384965,246200840836,77432200211,463885150533,394985748859,339962496404,788961748989,492272778106,1132589035625,95797076439,81297818446,603127748105,488796622353,19119566668,350885526914,608635935204,272378421700,266623750190,490855611894,111923979553,213211244837,619892836065,575035208152,600688763276,3968264184,1134646634788,231538274435,472441410960,291440077675,1025363433788,532254950955,949871527390,163404774242,947254408062,989303806084,67039322273,455068899216,759289806901,492408235529,443633467602,197303904070,830603398865,1039525525473,549796662556,225671429921,1089123020142,13099529380,991302967631,376676271165,50848774357,245397995564,27673216080,73564292053,222598516223,162621662673,1116304987417,845358791561,324151213014,663787442521,759535744781,835869085407,45516137494,39088312847,281794196451,742120345573,704748391196,127129982442,784443607819,1007044082108,1020324776409,1151301844147,1054297114136,1217548061994,624217342234,756801050240,827565925374,610212327871,1209344774438,420836195643,190253021119,1019448057740,904737588471,298611112576,922632323987,377556252450,493405832035,986145757880,931014075537,987189757201,16801494617,912036401208,963436283158,961508349530,196882435335,324623940508,488567083754,473968663077,237556588690,428804808065,872569024512,566376854056,169576240292,1184551251063,1047838560715,585107124704,1041503818257,618379283590,986528569040,173200849248,978957144595,377336710283,747312415956,765602210758,987023945711,1221251392449,1144049855161,1194562367543,883657437597,801193848082,1144522383824,19018716660,833643076306,1094367968099,1045228448610,537332435335,937431679397,32309800005,8820587755,1099504787084,316187090010,1076501314930,1117055439086,291270278271,655813071325,823457184848,1030789554096,866396461009,7799629667,727869519225,160285383850,743348569961,1021748344044,540077384539,850294073258,1096919735280,810655428142,778365106256,49073962377,320024370520,678926236469,708492477777,49993284382,762653920025,624120527208,421583562973,1172984912486,158832494130,186071390764,817194898499,1230715808202,1026946734106,742625356844,697042207251,1095808038256,961307591537,870277884573,855648831577,649462441088,695372808411,673649632234,910307791166,1094641072197,474112802497,903646629164,808585464567,650147277253,444834812771,778279687335,211291803634,1022480888153,178013981526,47880352543,975754452467,707537330220,269331014119,303622262270,1039322874414,149200761730,1219332108926,170560181796,945674748334,485302770896,311002029522,559559656303,566899917458,236783273007,206088843892,1088628973061,1026892605411,394263456073,394345625390,1122032680902,491690434723,1020592556885,1219961462568,652365968092,825235016780,73370248665,796890173578,928364785229,17110826604,1162942078537,1173507878195,1232221757148,467827784866,223619026325,298514612472,887977813861,260547093800,825998471361,109911996004,215065834514,319154485806,1189677213955,53282417159,109447793880,1011636097942,176096736290,156690829818,197304290182,125061656846,32794352883,895336369369,1047310675160,469354358526,273657872464,875246913089,717944780535,492436502587,86652673007,1181180595048,256906166476,56191734983,337545292959,20090366131,1042260087323,1096609289421,468486331123,657576693674,540406625694,589752064096,196447528265,1092803351910,1033442605564,738974294747,360853858020,753658950817,251754117887,185150165169,1080251673814,696410723501,209146220727,728116952386,541816275992,885329108817,523336091209,1207901223971,197708138706,549737409931,707289691964,1008236790759,593819768920,3135402797,757258400919,188728338655,326462614298,202101067536,49575572212,792989987609,656828936424,1027081263814,664578896573,568858527078,379895869435,1200454144442,1187313887964,347463668044,863495153564,697828624611,707836378177,497800941782,891147150183,1097337866503,965913241799,214704777741,1233651782329,1135014633092,357714026754,633888552586,89066644166,1030848723300,509543498059,1142147774309,270312177909,729834048334,520851616817,473654695560,1191708665263,980790712148,559483522461,823078061473,139116053984,156281534361,508228538947,1170210501914,98354970072,412534017133,1141235914757,986721161949,178299003463,982812836462,382538408247,424482988636,91109478353,394544577027,633277865194,1017479542775,757102424373,140155683415,455694849041,785294036826,1224623784043,393785874140,990223248441,109957573366,480437033783,1057527371877,1145404508929,531860986940,738863767248,1033171120555] |