diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,4 @@ +# Revision History for inferno-core + +## 0.1.0.0 -- 2022-11-28 +* Prepare for OSS release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2022 Plow Technologies + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/golden/BaseType/TDouble.json b/golden/BaseType/TDouble.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TDouble.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TDouble" + }, + { + "tag": "TDouble" + }, + { + "tag": "TDouble" + }, + { + "tag": "TDouble" + }, + { + "tag": "TDouble" + } + ], + "seed": -2104182145 +} diff --git a/golden/BaseType/TEnum.json b/golden/BaseType/TEnum.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TEnum.json @@ -0,0 +1,118 @@ +{ + "samples": [ + { + "contents": [ + "󧻊|\u00110vm\u000b)񄖄 $0\u0019\u001c\u0018񾑐yY\u0006T", + [ + "p6gopja_27soykcr", + "pzh8o8fbao", + "ww87pwq4m8ih4bf0nn" + ] + ], + "tag": "TEnum" + }, + { + "contents": [ + "\u000c򌥂󖐑Ft󂕴]|O󢡪.0+L\u001b\u001f𫰰9򗄰sc\u0002\u0015", + [ + "a6lb0ngnkufi1qk54", + "bvcny8i3a7p0rj0oqp0", + "c6tu1cvxia93sbmlwadd3uvt4v12t", + "eimvbx", + "et5l_47o96u3g4hmvg", + "g7drhfl5yc12jouqagj6yecmqlpc", + "go36p3", + "hpqmgq2qi1ltlt05yc", + "iat", + "j4x7x9y8oa5", + "nq30zegz3dcdnabme", + "oxcvkiu1v8atmvl00a", + "oywk0310f2d7r9x", + "pxrmxmg2cbrglvf3", + "q9wg1vdfu3p3awurv3_p8aal63ekul", + "r9dcbztncadyxo_5i7o12qifr5hi", + "s", + "s405r2h", + "sg930syffk53mw", + "tfp8wzh272h", + "tkwd1f4kgu3", + "ts3e5uhjpays0l1gloqecu03", + "v2umd6csbio6s", + "v3nsc9", + "v6z", + "vu", + "w0_fu9rhq3uux_veyip190tk640kpcc", + "wbvcqyzz3bmhtez19m0e0gvspkak__" + ] + ], + "tag": "TEnum" + }, + { + "contents": [ + "􋂒\t3􍡴\u0018󟚠\u00073\u0016k\u000c󬇿\u001d򗽿򗒣6񜓉B񐜦", + [ + "ayqoove", + "coa9ge4_", + "d3k2suxox83xak", + "gtlxcp82q_te07iwg30b", + "gxd_wf3fmyhp58fjkpb68a4gc0kp", + "iix7yrxvw4bj7_fh4m_", + "pxwpo4obejh86yjw5g496pl84yk3fk4", + "u", + "u8q6d", + "uua5uzeny85p61w7jczz649ex4n4cv", + "vdf3jmldb66skm3if", + "vu9_vlf5z0jfox35xa_2y9ng0jvf", + "w0abr2yvsxsqs1tbo", + "xqhnixdxlvj", + "yp2_ymffxrd_lws", + "za0", + "zkvcffxc4qv7ur2b28jx" + ] + ], + "tag": "TEnum" + }, + { + "contents": [ + "rF󭈕񌍛P񾎍\u000e󻪶<򢁤U,\u0010Q𯝮BU𼾺W\u00066F_\u0000:\"\u001fEJ}", + [ + "algm0b5jbpcwd3", + "brv8ez9cwrea_d_vdh", + "cea4m6n", + "ighmqgee_wjz9uu2nnkkf", + "jgn", + "l", + "o1e2_5_md1lz23b", + "q5cpjhkm1nonr803cpgasmyqqswbuw1", + "qnbu_", + "u6tmnn7p6fd625fu9xjbf1ic1rt68a8", + "y8" + ] + ], + "tag": "TEnum" + }, + { + "contents": [ + "&", + [ + "fq68ltep41q6k5kw", + "hl3vyfj3ya8f65n3v", + "hms04f", + "leg6", + "lqtc2", + "od0bepw", + "q5w7j4w3pcd1_6uu1qjkpf", + "rr8i_lt6jg04xg9j7f", + "s2wumr8fivlrq7ll3bbwzbc", + "strdr0fy6zynrh", + "u4xo8qm8_01fomyie", + "vpk7jhvbfk1hpz9l", + "vwqy8hibjb2m2xu4", + "xoxm5_1qme3jz2c6wg4jabh" + ] + ], + "tag": "TEnum" + } + ], + "seed": -603584531 +} diff --git a/golden/BaseType/TInt.json b/golden/BaseType/TInt.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TInt.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TInt" + }, + { + "tag": "TInt" + }, + { + "tag": "TInt" + }, + { + "tag": "TInt" + }, + { + "tag": "TInt" + } + ], + "seed": -151905013 +} diff --git a/golden/BaseType/TResolution.json b/golden/BaseType/TResolution.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TResolution.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TResolution" + }, + { + "tag": "TResolution" + }, + { + "tag": "TResolution" + }, + { + "tag": "TResolution" + }, + { + "tag": "TResolution" + } + ], + "seed": -27689261 +} diff --git a/golden/BaseType/TText.json b/golden/BaseType/TText.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TText.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TText" + }, + { + "tag": "TText" + }, + { + "tag": "TText" + }, + { + "tag": "TText" + }, + { + "tag": "TText" + } + ], + "seed": 552880690 +} diff --git a/golden/BaseType/TTime.json b/golden/BaseType/TTime.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TTime.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TTime" + }, + { + "tag": "TTime" + }, + { + "tag": "TTime" + }, + { + "tag": "TTime" + }, + { + "tag": "TTime" + } + ], + "seed": 1340613814 +} diff --git a/golden/BaseType/TTimeDiff.json b/golden/BaseType/TTimeDiff.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TTimeDiff.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TTimeDiff" + }, + { + "tag": "TTimeDiff" + }, + { + "tag": "TTimeDiff" + }, + { + "tag": "TTimeDiff" + }, + { + "tag": "TTimeDiff" + } + ], + "seed": 2091293756 +} diff --git a/golden/BaseType/TWord16.json b/golden/BaseType/TWord16.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TWord16.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TWord16" + }, + { + "tag": "TWord16" + }, + { + "tag": "TWord16" + }, + { + "tag": "TWord16" + }, + { + "tag": "TWord16" + } + ], + "seed": 1643623361 +} diff --git a/golden/BaseType/TWord32.json b/golden/BaseType/TWord32.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TWord32.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TWord32" + }, + { + "tag": "TWord32" + }, + { + "tag": "TWord32" + }, + { + "tag": "TWord32" + }, + { + "tag": "TWord32" + } + ], + "seed": -789157068 +} diff --git a/golden/BaseType/TWord64.json b/golden/BaseType/TWord64.json new file mode 100644 --- /dev/null +++ b/golden/BaseType/TWord64.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "TWord64" + }, + { + "tag": "TWord64" + }, + { + "tag": "TWord64" + }, + { + "tag": "TWord64" + }, + { + "tag": "TWord64" + } + ], + "seed": 357950783 +} diff --git a/golden/Ident/Ident.json b/golden/Ident/Ident.json new file mode 100644 --- /dev/null +++ b/golden/Ident/Ident.json @@ -0,0 +1,10 @@ +{ + "samples": [ + "nsp89kshwibrf83lq2kd20uhecq", + "yojo98hbsccanq1jmr65i9eb366ccm9", + "nm", + "n0wuj_erymw2c7nt96b4dd7zxyvfg6p", + "n" + ], + "seed": -1370367363 +} diff --git a/golden/InfernoType/TArr.json b/golden/InfernoType/TArr.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TArr.json @@ -0,0 +1,542 @@ +{ + "samples": [ + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "k\t\u0001Y\u0014E􉞷H6\u0017^c", + [ + "b5ky_o9z7kwx1w9pap3rj24u", + "bl_wmc1rn0yd456aunx", + "bqp9md3poc6w3u86is96its", + "fr7", + "h_n4lxatfdc14gjrq1l0n", + "hsars9dv4yggc1d", + "i9hz7o2", + "jiawp036ildwucr7xnn4bq", + "klucu70h", + "l_alw48t598oa3qu8bc7375", + "lu6z6", + "mcpvl9ncdk1x", + "mgeh1jkhhnd8amkkk2okq6bpq", + "mxnc9ao9f", + "nu1q2", + "p8bvol013_e9a5cqfb2v", + "pa85", + "qgfly5j31o7k", + "qoxg40bv6k0eps_m_wb0cvb", + "rhuhpqbmcrc5mu8sx0m02i94bbvg", + "u7am68_dfwgp7ay", + "ueufze3qo4n5cf993w4betm", + "ytpeufilfk_h5679abj7bhlco", + "yvurpidpgv077q5z9", + "z3pyfly6rwxa5h_zqipyr79rbjtlyec", + "z_f1am5k4g", + "zdpb8r1pxt4skiaue4e6v89kawxmp" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -12, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": -17, + "tag": "TVar" + }, + [ + { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 25, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u0004\u0016c#;\u0002𹂅", + [ + "al5l4v4504hw0xq41ym", + "cxg806e7g1upoayag46mvg3", + "e2qc", + "kkguu488_xokm7hsy6vns", + "tjb8p7n4", + "wge5gbgkd39e" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "𖆲򵙞:", + [ + "c", + "c8k", + "cck5nd2gjlgvckowdb1pxlgsptqbwrm", + "crd5g", + "dn2rif7xcgv0xs5zu2h_72tmds2", + "doruib_9lrorvlxabn_", + "dxiv", + "fkzlxhpm1p3a6_56_iwn0akh1uxetf7", + "g_w924mg7_", + "irqhrqbup4wdgn", + "j21hnsh6wjs4e0o8", + "jfr1ujlp3afryyvgi1ed2_odwq", + "kn9wk0hyct3_vrel8gbj", + "o1fwhrpqnqnzya", + "olthj", + "oukqkz04jfylw32vpyknzfbxt116d", + "p02suxehiiyp5xuos4c8107", + "pw0_uihvzar1q1x0d6s840f7shqo4e", + "rthg5i7cjdiy5gbtfjjm32", + "t2rv2eeyf87qgy5v", + "tlc9llgwt", + "ubw3ba1m1pyoppg74", + "uqpakeiofk5", + "v8s9zzx", + "wq2614k6k", + "xylbpio06wxym2tr", + "yaha537jr8gh5t_rmemuu7uewxm04" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "contents": [ + ":\u0005r-\u00193-", + [] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": -2, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "contents": [ + "_92뾥Q󊴐\u0013\u0019\n󲴤}󻢺\\\u0006o\u001fd|V:󬔌򸑍~.򀖮e", + [ + "bkbhg6_ns0a9dwzc4bep4_", + "dwjdh79if2ynr4gih4uqq", + "hv73f9ucjxizsfrgulbmpf2", + "ixrr6b43i", + "kgjfp3wizlftubh", + "n", + "oc2vjfh92kimsz0ji1dg5c9bm6bn", + "pdts", + "qvmayuq5m5d2ms08f9", + "rmktyrory05jbe14mz1g31f", + "sn8hajcacid", + "sw4su7o2u0qsosszq", + "trbn7jdg3qzu", + "ucvjvv_0k2eikuo26n", + "v7id7nmqrjhby8ema", + "y", + "ymozkx00vfx5oh09cyplk7ya2" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -30, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": -11, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": -28, + "tag": "TVar" + }, + [ + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -17, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "contents": -8, + "tag": "TVar" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + } + ], + "seed": -988803472 +} diff --git a/golden/InfernoType/TArray.json b/golden/InfernoType/TArray.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TArray.json @@ -0,0 +1,1308 @@ +{ + "samples": [ + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": 22, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": -13, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "񱔥@󭡽HPIR^\u000cv8 ", + [ + "bdz_", + "iv2pegw_u", + "iz54f98wskk5k3npgyqdfk", + "qxpawd65o3gncw54plb14y3tx", + "uxhl_j311to1umkx9m3ps9b1j26_wpn" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u0011", + [ + "c1_ce4sji73ngdg6odrr2qkn9esy", + "ef", + "eg1ic85n9wsnyzn4q24hyi_3ohurqyq", + "iaw", + "lnvsi7ta4168c0koozsq0md1", + "n4ki9zx9wnhpxzfsuwlr77wstwx4ss", + "x3ta24xdkj4mmzlg5rsl13r2", + "xk7", + "zc1jopw773hy1xwh5gkeop5vea" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": 8, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + [ + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": { + "contents": -26, + "tag": "TVar" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": [ + "*", + [ + "d_y", + "f4oinqfe0bsnidwrurpegu", + "jgbarwje8ao6zbgifj3x", + "rqv9m" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -15, + "tag": "TVar" + }, + [ + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "d\u00014\u001a󸴏2󯩇/ S{", + [ + "a6e4gkfyxn__hn_krbp82uo", + "ac5hnw6b7smugb717", + "b_f2m0rrl", + "bfmunx", + "c6nvak2v7bzmu0fvdv5x_0qjpk", + "d7qq2wip8", + "gajgcp0zmvzytq41fuximvmuv", + "gq6i9r0jk_29w5c0i8vxnu0", + "gt8f", + "hlu1x3rqi6b", + "j4xkou8zye06z7xa_k", + "m7g2wzzuxxoaj9o0w8anoxo", + "mn606tt", + "p7lku4ysa", + "qe6ku7ynxjr3b4za947nt7swpwgah10", + "rfd_mszskq1qptmcdnvism7", + "x0y1_0nl6zcc0lcari86zun1k", + "xrhzbx2seo5r", + "yajhq09i6ibxbs25y0z_9ohyzqeq_qo" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": [ + { + "contents": -24, + "tag": "TVar" + }, + { + "contents": -8, + "tag": "TVar" + }, + [ + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "rv񺊃\u0017}Wf\u000b󝨏+\u001b򿇴o(K𵔭\u0008", + [ + "bwctejrlshqqb", + "bzrwhm68r1", + "ce", + "e00u0vswv", + "e1nhz2wyot_xbp26", + "f71igt76chjc", + "hjyhtb9kuk20u5k7i007irc3decaw89", + "hmq", + "hxruhp0glhuzsouqtidlgdr4c", + "jyuo1thks888", + "ms8n", + "nnfk6fq4i26xqsqgg50vkw87e6s1rf", + "ojadhaa6z5o2ncfl5g_gwod9", + "q1f5lckjz9", + "sdfb5odylac3nbvnwrl29", + "sowe1o4js521jewgquhln", + "tjujuk", + "uyk6qokae6_x_7a3zy7mamjib_ao", + "v4nsze0kv1k", + "x8sys6lvqvm5k_a7str8", + "y", + "z3pfi" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "򌻼򵭗\u001a򃢏\"򩄵(4HaM\u000bZg󻌷󞸏𳣏\u0010񡡝Z\u0003?e+f)򲗰O򠧶", + [ + "c866phhelavk50ah", + "dzc2zvx3f_mhg9", + "hphij42vec65teayykc", + "j_bcd", + "kf", + "lrz0yfbp_eiux8iastdsrenywu3y02", + "m3oqpt9suy2", + "msukzxmcohnnu5n", + "pd9x1f8y9h9e2x1dulb4", + "qi88914wuxibgwg_mks1ifuisa3", + "qkmp1g01zjunzqx9_232crgy26y", + "s05ini89vazgagzw57268l5u_hm", + "s8hkmh9w7txtokig9y_sjm599uf7i", + "sk4j91a0v047l17tsp2o4gz707sp", + "t6unfrky9g", + "te30ji9354vpubt_5", + "tq5c98s_n81124g", + "tsktrw2qxuttpxob53t1r32", + "yv9xiio2uw65hwqsumgo_22fgwqwzaa" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "1", + [ + "ciuh", + "cupfa7ntt5_", + "f1g5rwbz", + "g7", + "gj4qmu6n8u5tvo5v7mu6510h8zl7aqk", + "gz4clwy53fxnb281kyl50dc9r_9", + "i1u20xoi4yuzkltmkzqmthla9015j", + "i3vioqrfpzx4zsxomvko6tharen", + "iwszxl63v9_40nel0716ylht", + "l1eh_31fypkyj_dhpclyq6", + "mnaz6mqqicxcmm", + "odkde0", + "qgb669ho", + "v6kewx4pd", + "w68zey8zw", + "wgmjq", + "xqhu9u898z4oci82a", + "xx6hbb87uxohzb1ipr", + "zij05ffv_lvwzc" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": 24, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": -25, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u000b\u0008H𬄢^\u000e\u0014u\u0002𤸄ul", + [ + "at1pc3x57dsy4ow9byimf", + "cc9tw0kd3shhinku00oq_ysi9", + "eyr7cf0", + "g8t", + "h_gu461", + "r_k92ix1evdnw4wa3knc1h4f8", + "rtan21zkzq7p97pqn2m", + "s6x6jsn2", + "sh19j9qmsojcb0q1ea3bhe75tk2", + "som_osq35kate0i7as8brua0", + "swzpk11cgq2wh_ih7", + "tvkp2929w3ps448a5", + "v8dn_nd8tw61t5_lxfd38", + "wkkpvze86wtnjjx3v5fpmcxho", + "zzi30drvr123dvw4" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": -4, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": 26, + "tag": "TVar" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": -3, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": 19, + "tag": "TVar" + }, + [ + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": 11, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -18, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "contents": [ + "GO", + [ + "j7oaw7zzfsjr407n_8pu6ffc", + "lrmzjll3uuewj6n", + "s67rlope9a6q5jh7_qm8v" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": 20, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 28, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u0012򫫾\u0019)!򓲀}𵶳󍫦G\u0007']AY󾵰{\u0014sD{o(\u0014𽁜\u001a򎍃Y", + [ + "x6gsffrnkm0vesno" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -24, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": [ + { + "contents": 24, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": 24, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\r/񋢧\u0002Q\u0013|89jk", + [ + "bfnudtb", + "d30rng4_f_2", + "ermismta6xzhk4nmnk9i2u", + "iz9", + "k_hf3if", + "kzl5ipceeariiyuq33pr2u", + "lnlkn9q", + "mc_rzt8gx9zu", + "mte_qyvscefnw_ryo3p6o662b1hy", + "peettb8alt8ui835_l7ry7pf3gzkx2q", + "qomctmlm69stindmrx_vthxld3k0qz", + "u7rr", + "wdfil7i", + "wjjv", + "ya6g645a0yvplt8e9_3o970", + "ysvwepitdug39o2bty" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -25, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TArray" + } + ], + "seed": 978287237 +} diff --git a/golden/InfernoType/TBase.json b/golden/InfernoType/TBase.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TBase.json @@ -0,0 +1,61 @@ +{ + "samples": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "p@|#ww}\u0008", + [ + "a6w84t_rmv", + "bq4j_jza4y0731", + "chhdplp839", + "cw3hsmeo0_zf", + "dbqhquh6clwp3prc4c_0k8l22", + "edvtxyv3m56ghn6brgd2oeskcc16", + "ey", + "ffwgzqyfyckjqvhixrnbxrx6iamvqq", + "hs_wtx4o", + "imlc6odthsr4py6", + "jq8p8n50kwmpe0hmazc2mc", + "l6w", + "ldtm08p0", + "n", + "onqjbc55d6trmtnfrg2tow0", + "ow1pjgv69p3e7", + "qq78gk8000jd", + "qv975ab5o1y", + "r0727x42f_2qtskpppw", + "rd6lb92lkuwau6qm3mzj_a3b75m", + "vzrj_x401hmnu_ux" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "seed": 801499757 +} diff --git a/golden/InfernoType/TOptional.json b/golden/InfernoType/TOptional.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TOptional.json @@ -0,0 +1,64 @@ +{ + "samples": [ + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + "tag": "TOptional" + } + ], + "seed": -1505057936 +} diff --git a/golden/InfernoType/TRep.json b/golden/InfernoType/TRep.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TRep.json @@ -0,0 +1,4011 @@ +{ + "samples": [ + { + "contents": { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": -17, + "tag": "TVar" + }, + "tag": "TSeries" + }, + [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": -27, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -3, + "tag": "TVar" + }, + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "璛#N㙌\u000f񰜏\u001f=G񎩾{Z", + [ + "b1lkngj8", + "bhct1x5hwzuxpywzmztzo", + "cawu755ir22rl", + "cv6f0sfetd6vzbicnghhti6_zhwm59", + "d2z3odnh_w554q", + "e7tee0ybgxtd9c5", + "j9ft7xx0hga91cp596o3s56ta", + "lko92", + "lsuyikbc2rhq9mp8ii65r", + "m26eli6mmrz3e32u287h2vx", + "nogzjghtedc", + "rt5dq6n00c4", + "rt71w3_gq7_gpy2jr_8l", + "sgpvxi9m9lf77nkra1epw_", + "xqb4uftckcf3c", + "yvrn6ji2lngg" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "󆬓)􋲔i\u0017I\u00160|򺦈@\u0007-\n'򑫶󸖔\u001eZR򵋋E񄕣", + [ + "c4uw9rh6w_fv26i0ynlv6lbnn_bzus", + "cbuul0mg64", + "hhgys0qs3zahnxoam1elz2zh2", + "ja3hhdt4_j0w1yv1s", + "k09cr25h7", + "l", + "lnmi8hy4duzol1lgegns0c9vu", + "ls0oaf33u", + "obpd67po1ggjfg9", + "qu7_6cewuoxr05o002gke9pg0z7ev0t", + "u", + "zcychbb7_aa5wigq1ahsl8o868" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": -28, + "tag": "TVar" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": 26, + "tag": "TVar" + }, + { + "contents": 28, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -13, + "tag": "TVar" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "󜿳\t𫑜P\u0004󝒵Vz*􀸻]񅙕K񒳔k񙚄@}򉜟u󷀎hNK򡑛", + [] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 24, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 18, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": 15, + "tag": "TVar" + }, + "tag": "TRep" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + "-P)x\u001b7\u001cV񤥟bl񶫻|' \rn򮷚񹟪\u0003򠎟7z\u000b2*\u0005\u001d>q", + [ + "aab2226", + "bjnk3r7hoh77c2zntg3me780o8b", + "c3apaahmzappqk9", + "dn3lxeqv_85bv0q3yz", + "g5w6w3rgc450bxlisoip", + "h0klifyk3b9594r7b4hdh6up62v6a", + "i1y37e73wr0_nhlv_hsdvocm", + "l5", + "motsekacfq", + "n5epnydgyocqx", + "r6iq1ze", + "s4j_zvn3p9_5ja", + "ss9faeesov7jfh6q_6zitf_m", + "x", + "xjw3xvfm1luib_w", + "ytdbd_zmo7g3ju" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + "=W;ꇬXs\u001c򭥟1~~Fz񱼭[󭘮\u0017RaJ$", + [] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": -13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 11, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -20, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "contents": [ + "{ $j󇅠N􌅨퇼K񎻢࿦?w􂏃x5\n󉙾.}F񼅛\u000e򑌲\tc", + [ + "ed1ru2kue", + "h_pg8whf50qd__05nej5zd", + "hw9ecorw2cgwxichh7e75z0_fov4yxl", + "hzm12", + "kjtflwkpiyudd960y5c2g6s", + "n3b6", + "oh6a1u5", + "p17w8trdoglbxls_64623pjh", + "rjddf4w3407zr9kkfc9p4dgm2a27", + "y2_1k2o0keztfak6" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": -28, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": 22, + "tag": "TVar" + }, + [ + { + "contents": 14, + "tag": "TVar" + }, + { + "contents": 26, + "tag": "TVar" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": -29, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 28, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 19, + "tag": "TVar" + }, + "tag": "TRep" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TSeries" + }, + { + "contents": -24, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 7, + "tag": "TVar" + }, + "tag": "TRep" + }, + [ + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -21, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + "\u0002A󸂟", + [ + "ga", + "h5qp2tbh40fx2bxkcr8j8p1ly6kws", + "h6rle7pxzdar3gcyyb09zk", + "j_hy84r7i53cmt", + "mx_njz5d9gzdxtvhrtq2r4y0f_scyf", + "nez552kgdjeld7qy1ojqn7", + "ofkd6xx5vkq6t09paq6mn", + "s1aw7cx_m2ckv600m_7ewe68g8p47", + "yh08w406n", + "zaa4vpu7_emoj" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "j\u0008", + [ + "bttuf17rvx_25zainlywrn7x7", + "ceerwqe5a1iz3", + "cgok6m1n", + "e3m8zjw5x1f6jpol5", + "eg9pe6g6cxspep", + "fap1j1r9t2qchcza969tfwfp", + "jizrrjc97k6vd4c0ofwpivm20wpfmp", + "lve", + "mjvxsqqpbxo3yu8iaue9ew49tuoy5", + "oomuqnjc3oknc4k4lrt4l", + "ri", + "tn2h189_wtmfpz4repw", + "vq5spbnu", + "w", + "xxfffqyq" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "8󿁄%󆫷?\u000c󂕂a\u0010e򷣴2!&y\u0008𗬆Zr󥄬F,\u0011N􇵗lD𦚚\u0012Y", + [ + "a0faq8ttg99let68", + "amr", + "awx4k", + "bhsprs4", + "d", + "dgkipugtuudgia2bv", + "dmk_acafc6c06dnrmdw3", + "drc6m2zddza_ci4q8zfaf", + "eciuwfi5o5nle107cz", + "ediih08d0awo1s3vm", + "ix1z6", + "k8", + "l60xai1l", + "lt3a0f6zzdcsi8yuuc46ajyzfe7vr7", + "m5y9u0jxuidmmogpo31zmswm5y", + "mbk3qdfx7aeodfc", + "op63yn5i4e2ui2uhwblvzrdr", + "peg57zfo", + "pf_q798qrfaqkc5u_j", + "pswg0peb50bha_6zrozafxmgryx", + "svaxdmt3t", + "t8iel33hg218ctqo2c", + "uqun_ki3wqjcr2", + "wswj2uc87ywvx", + "xqwxx0r07lf", + "zec894jcs_nq_9", + "zt2vk" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -1, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "q\u0002𑤑n\u001eq󜺸\u0005𕳣", + [ + "d6fsgubzoomyvg_p22_nv7v2mye6j", + "fb7", + "fdrl5jbouje1frq4gohim", + "h_3p41nzcno123c8zu2qbg", + "j6qpqmgqlxp3htuch4bfxte", + "jmxk_0v", + "jundxz_e", + "okcsm_adl4bksctq5e3y_o59yns6n7g", + "os7tuepq3tetlbj1cyr6", + "p91ukjgbbstkojo", + "pvdpk2ak3shezy1ulmviytfv8b2", + "seequ4szcuqauc2p204", + "tjg43pksgf30", + "uor536vzny_62y62ehhub", + "usnam2akhor3pddcm", + "xc2t", + "y", + "yfavx0h4zq1tpp" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "Y􂄵V񨪷p򺱆񁴵\t)e\u0019m󤹭f", + [ + "a", + "ag77po7h6bkb", + "b1zsnmvl1iut", + "een__ornl033dys", + "esr9nfe2yrqsu", + "g2td8sewxxh3rpr3gu", + "lous9y5qtzbwuk71x1y9gfn206db_fz", + "mli01kf_uca2ze_cj0ri", + "pag0gf4hds5w74itr9p7thfoyo", + "ppmmbi5gpz8p_w_es4g3mls24bnrawb", + "qi5e6i5cia8rr1q", + "qqjaeska1fzfso9tp6pjc_9ah2tgdjv", + "vo06jlap9xia9q6uuji2g4476u91l8", + "w8gyav05yq4rw0fdpkcztu", + "wqtq0r37ond2j", + "xmb4eqkq58m2vzp8omz", + "xzm4e42ygz9ed" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -26, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": -27, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": -12, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": -6, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "\u0014OB񎘻|k6", + [ + "hzytyu6vfu78a36nb2mq69e", + "n6r1l7cg5pks8c84l2o4a_wlr", + "oicd25bdw6cetd65rruk4mxpmrqbl", + "ple02k50tkyi68214r1ey2", + "rzzl_n0vnagddegqpgde" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 18, + "tag": "TVar" + }, + [ + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": -12, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "󼮮󎃬o򶘒Mr~.$\u0006Uhld>\rL󸎮`<\u0002wA\n$i󁵕c\u0000", + [ + "ady7elyccln679nr", + "attkzj3ib6i", + "fsdxk94pc2s1", + "fv5zmfb36empgy", + "j46xq8", + "kz82kom1a_m2viu", + "nceoj5w", + "nl4gs", + "oiu9ruvo1o", + "p_cbaczhtqq6nfdt9jqkdik", + "psr18_ubuew213h2liinze168vt", + "r3in1xvb2u1z54clo0lyybroc7m9", + "t3flz2u91c9r5tqkbq2yicmg", + "v7a", + "v_tlisn9vvlfb1139tbzj7d", + "w4q6m5u6h3vx", + "zj3li6" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": 9, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + [ + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 8, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 4, + "tag": "TVar" + }, + { + "contents": 25, + "tag": "TVar" + }, + [ + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": -24, + "tag": "TVar" + }, + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": 3, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": -12, + "tag": "TVar" + }, + "tag": "TOptional" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": -17, + "tag": "TVar" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": 13, + "tag": "TVar" + }, + "tag": "TRep" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 24, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "󙑎]\u0016k]\u0014򰆱@󥪛M󝻟a(\u0005T񟷙Q򰕹\u0019", + [ + "a27kft0bnk7yvx6ipoushd", + "babru", + "cdvhaypr_4nw95q_03g1w7q90lzy", + "ci1zfrk7byebwpeo_", + "en3pllfpy28h3", + "fc75yvvhkcy2x", + "fsa2uq57ayre9vfyze", + "gbf8v8h3bf7s9ca8vr1dp_1_omgv7z", + "he", + "heko_7j6xg7i07mhzbok1", + "hjbz0raatwsl1p_ie9", + "hrc1vy2r_8msgr8kgxnic8qw4", + "l48qpnz45aebdws4d8rg", + "m892o3g7", + "nubtquiuobca1nt4y7bcehhuwjgae", + "ob3g5omyvt7iutwebqge5", + "obi5vhxf9005ls", + "plqqs088", + "rd8plz8licah92wx9klr3", + "rp89t8mal3vzdue3i5r8n0hfi3b9", + "t75ja5", + "tvsaod0c3l0je5_bnmgggvi8iuq2w", + "urkkmxkv11pmoh", + "vkj4n", + "vm9xf_prgxf9y4c", + "ydx8wxqmz4t4m_kb92cwuxsztkr37" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": 6, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -3, + "tag": "TVar" + }, + [ + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -17, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 26, + "tag": "TVar" + }, + [ + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": 4, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "{K􈽣", + [ + "bzjml6qvzmt2vu5h1aac2iofa3rz2i", + "dwj10erwgpxmvocja", + "f0r06i17xo_wk4ac", + "jhd7cm0ukl3", + "moylofrggzk3l6k1ee3qfjx3l19yz", + "p86gdy9", + "t08mr9z4d7u9q7dxqy3mqq", + "tlw3rrq93san0x5zz77aeu0q8", + "zv4mjv74rlkabtdwfh3" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u000c!򾈡|m󬰧󅹀i", + [ + "ap6i_noxvqyy", + "bld6ojxrkj8yl00pz8hqvgz", + "bqz3dtx3sddhnq", + "cfjbluccfx9u", + "e", + "f_6rx21n6uvigq7bfw4", + "fr8z3i32jd", + "hdewse27bifcynwkc_i54", + "huu2", + "i5kjgi6ofowhstf7gvz", + "i927_ly_9dd8vr0xc", + "j_4efo4dcpw4bwdbcs3ns6", + "jzvd91l", + "k", + "kw_07tvg3_g6b4thse2b4e", + "m3oea_8bn789kwyqjwj2m1i2qh", + "mnpzo8u02c1nwtrz0_ywvm", + "mo2uf7l02102hr43dmpgps56o9", + "nb6", + "o8lbxaicrsifyhgx_zv6_xnbu2jcbi", + "q0jp2_rpfo988", + "swb5_05jpoeetiv2r9q6fqfsfc1fyj", + "t1y1fna_a", + "tb_kaog0m6xxiik_pjfjs49gibtzzp2", + "wl8kwadg9yxvxny0", + "wz5mh", + "x9", + "xfaw", + "xt_76fe9gojkoe0ci23", + "y1o_fe5thzl9vb54r0" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "30}mt~,x䍠g\u0003qreK񴏩r\u0015I:\u0010_󝐊󅙻", + [ + "cni5", + "dh03_9741v", + "e5dzpcxq5zodig81rgh20bk4ggwz7i6", + "fpzrg", + "g7cp93dv9", + "ggmmu5wvu9c5i", + "he6ob3r4ds3lv5i21a4zj", + "i3hq5npbt54dlnk6pxn2g4fsp", + "im23t8n_9", + "jnkgsmrkogly", + "lakko86js8ywmxeyujo4dmlbh2", + "lmfd092hksj4oc8ci_8ucxac", + "lrdx5azx_n17rrx4jxylurn24ofnj5d", + "mj", + "mossq50mb6o5s7n8uqewh2fh20nm61", + "niqs246zl_f_n5xlsicplqhp2nywz", + "rexikit7h6_qtwkmawx", + "ttbi", + "uca3ppwsj", + "ufso38_p1eln_feg6vb8_kz", + "x", + "xqa7cxjsom", + "zl_xl7god0x04o6" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": -29, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 21, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "𰯳\u0004\u0007", + [] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "Xv'l", + [ + "d8tew8914sx", + "dete0s_pj7wk4kqbjdgiwlkvhq", + "e72y0ejjjj2e", + "f_zck", + "mib4bf8r3", + "mspn", + "toc1joupw", + "wpcfy7nx2c3bpl68lbmnjeqhb" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -11, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -20, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "t\u0003Ge0", + [ + "a4kb2uosiwtzd8w_9crxubh8ezo", + "cu36zvbs8wv", + "e6i36t0erk9kfgeuzlxl1zs", + "hfki0f3b2gatz", + "ixyf7pjrla6i8ayxhajxga7gb", + "l7k_ifqwyok757x6s09940zz0qu77iw", + "ll0lk30q2sc", + "n0f1m269t", + "nd4giyk6ec8x355f1o4s535hcnytas", + "ow3awqsrwui5w5hio8wjj", + "parfpuwe_6s5e3uxe", + "pqte", + "pukjjxag6o7rj0xshyb", + "r4946jmit3gx8", + "uj94fhr7xd_vd9", + "wzg43gwo7w24uaqlqcaxtta_d4at", + "xaqfo", + "zpvy_3y4lkgm9r_vugji7z66qq2p7q" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + }, + [ + { + "contents": -25, + "tag": "TVar" + }, + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 11, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "\u0017\n%", + [ + "a6r2", + "bfn", + "c", + "dsyd65zesjk12_rw944rmi_9ij", + "j85f", + "lbpetmxm", + "n8zhbqan9dnp", + "px9cqntjydex4e", + "q28j", + "v02gk_nb90w0_7aa58eznv", + "ykue" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "󿈘r", + [ + "ajsfj50tp4780hkzdh97mom8o1qf", + "k296tf384w6p1lvra7xwytd", + "link07hi3st" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + [ + { + "contents": { + "contents": [ + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": 30, + "tag": "TVar" + }, + [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": 11, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "-V6H\u000c\u0008I*\u001a򃘠R𠴳L", + [ + "byieact0x68", + "jeed5rpg_j54prmtz4_bohhi", + "px5yba3qgc491" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + "񵽚Zc\u0010\u001dJ3,5\u0007;𯈭򰾱򝃣\u0001", + [ + "axukh4wwlvccyywdpnb2", + "bauc89frci4t90h4_yvi3", + "bittqkpsa7bqo1vdzrj_2nl", + "bvw630bgj1wefe1gfn0gnosbnhywy6m", + "bw7aoqxhobu_vpjb82gouvy18r", + "c", + "d1nm_2lr77aq", + "egim508ajqzho36i00q2ehd_eu", + "g672la", + "gqopg04n", + "gvz0", + "h3lk0dxa86xpi", + "i3ioa", + "iuu_oqbinwu1ae__em8", + "j4shtadq_appi", + "jguu3v0cs5rb8jhj_k", + "mx3ngef8qnmgve4p37ck", + "nj", + "pew", + "q3id52kgjgi3ez", + "q668_2__az_kyvzqx4nug0qpwlj2", + "st0", + "swrtg38qf8xl4pwmt", + "t", + "tgl62dpgzch", + "ua__pawzlhkpbloek5l56in", + "vguwt4s3emr2h31i", + "yzpjfdzm8hddfei6wgvze75t", + "z7epa6sm7uub7il8e" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 29, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": -19, + "tag": "TVar" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": [ + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": -6, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + "\n񏙌\r", + [ + "cxjcihh", + "dszrp3c", + "e04k51u_vhnit9lq47idy8nnpwvw", + "ebpqkv1qy1m9lmg", + "ghtuqi0n0hk46_d63cllw", + "is", + "jbaf", + "lq", + "tfjrta8ewwv723t7wuapjig1o", + "vivimfogr2h36e0pqr8z08fvwq", + "wy1vwlb65xc_zhd", + "xv" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "7\u000eX񸈭vS|+\u0015񟮚R:󦁼PDR󔠎j", + [ + "at9eqo9c", + "j1rs_13_fx5uydsjritlq_9qyy", + "qksbaj6x7sfxp9f9ythrx0cr0unqbbe", + "s6346zj8_x4", + "skylqfyuzs25taall31k41vkav0vv", + "ubfb4ikk", + "v4bvptg7a86vv1nxvxbynsx5o_cjg" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -13, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "$+V1𕦫񱠦􀅓\u001eU򛨧-2Hx񁍆Ul{uUg$\u001b.=Qu", + [ + "e3xfgehxblx9pgvphp3xekmsv", + "fe_adpnjgu5uwym6w_qhq8o6fbxm", + "m6zf06rfe8du75f0l_1ecc7au", + "tga11i2nob5mq958l", + "vsetn", + "w36ln0_e7_b7", + "x", + "z0o0rrjjh3jo3dlgkrif78s" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "\u0003\nn􁎯$󕰴.잗&s\u000b\\\u0017i[򔿅\u000c\u000f%󍟃:-}󌬉^", + [ + "aof", + "byjuae0b75d8rfhqqp6w3li32hl0", + "dw_3rg4r9qrq3x8qcjqlxa3zm", + "feu4ztm0tdt9s", + "hopb2y4e5d", + "jedz1vf2t1a5qtyvku0i", + "jt1f_", + "ml4wwc6slm_vdhbvy6ap", + "nac401kkpyrmg3xdns95au_9prh", + "oxo_ctt_i_tw2tc", + "qjtf0g7sx7ks8afzulrr4e3ql72r", + "r665r8drhjfks5rn3", + "si4rrtxrgn1bq1iqd65ownticfiu", + "t", + "ux0xifedhpe9oys", + "w3yib3nut", + "wavidq19mm1", + "xwlskq8s7u_bhlb_lkb08__g", + "ypo5xhm81wt9osz6hxrvmkmg8", + "ztawchparbuc1h3911usj71a_asrql" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "񑇘𹯤𒌇M󦺔󸲹+Oc/>$GZ𽐣\u0008]X!\u001b \u000c", + [] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": 28, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -20, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": 1, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": 18, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": 4, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": -28, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u000c񩢧#󱍩\u0014񵷷`񩩱m2_/4Y𨐿", + [ + "aadv04_goj13j8u362t7z3", + "ailehpak7ux4s5u5ny1kdlrxp250", + "cchcclm52zz", + "ev4t5azvnk72b9wmmd2gko", + "f2478cmvuu", + "gh5oi_476bqe_0zwul1lse6wy52xr", + "h56ype5my870thk0o7t93bt6ss", + "l0k5hvzjnhj1gcoddkc8ylo9pnq5", + "lfcojj828dm0q", + "qbfcpij3y73keg_lsay9s21", + "qywbyefuvqqz73msb5mgol00", + "r", + "soe9tlvpgz", + "to_o1m1usoe98h6wr", + "u2v3dxhbvgc2ixiv4ng_", + "v1mirf", + "vai0o2stiyrbe", + "w0wirbn", + "y3xiu40_q" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + [ + { + "contents": [ + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": -6, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": -20, + "tag": "TVar" + }, + "tag": "TRep" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 25, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 28, + "tag": "TVar" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "M<`Zb\u001bM\u0000A\u000ff񌉷񒑖#M\u001a󸧐p񾃫<", + [ + "b2wmhsxg5j5vt5e7", + "c_hdzvlmc6yzbq", + "e0uwjf5vn_1b2x", + "ew2x", + "f7nz_3ywwpijlh9f1gop7ota0fk", + "gq1z29zlejume861a1mvmw4i", + "ipzdj3", + "jf2n__bwaezb", + "lbqo", + "lqia6c0x7so3", + "m8n0wjz4vx16", + "meks748z0zcczntx4wvk", + "mguudhsgbe3678v8la9fq5", + "n", + "n6hy_iu2g8hjjwunuk89m_q9nfd", + "pr_w0q9ef3xh", + "t8sk1bfg4np8ldpykvb", + "yir4ul7v8ubm" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 6, + "tag": "TVar" + }, + "tag": "TArray" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": 22, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": 2, + "tag": "TVar" + }, + "tag": "TSeries" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": 15, + "tag": "TVar" + }, + [ + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "+򐓺򫂅\u00146t]\u0013񇵳C|kRVs", + [ + "d6fgz", + "eb8gy0xzhkd1", + "m0fs99wz8y9ld0lt4d7dnc", + "p12bk2sdurg_uj_qpm2q65nr", + "pdnihscn9q9bw3t_hghvg3lhzw78", + "r6oe8yla4fiu", + "vrck85k_9sh8z", + "w0", + "weuvqd4jkeh000af", + "xkp9a8lvtdd3zmyz4ngjrl" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -12, + "tag": "TVar" + }, + { + "contents": -29, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + [ + { + "contents": 26, + "tag": "TVar" + }, + { + "contents": { + "contents": -6, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": [ + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": -24, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -25, + "tag": "TVar" + }, + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": { + "contents": -29, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": { + "contents": -11, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": -29, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TRep" + } + ], + "seed": 2065261373 +} diff --git a/golden/InfernoType/TSeries.json b/golden/InfernoType/TSeries.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TSeries.json @@ -0,0 +1,73 @@ +{ + "samples": [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": 12, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": 30, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": -17, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": -13, + "tag": "TVar" + }, + "tag": "TSeries" + } + ], + "seed": -570853263 +} diff --git a/golden/InfernoType/TTuple.json b/golden/InfernoType/TTuple.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TTuple.json @@ -0,0 +1,5586 @@ +{ + "samples": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": 21, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": 7, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": [ + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": [ + "\u0000餋bd󤽢𝐄}af񞫺0S񂏿:\u00150U#\u00173\t\u0005H(", + [ + "ct60e4k5xk0xtpciadn", + "dszvxsq6bnsn8znk95roj_wkur1", + "ecl4n61qgovx6l", + "f2kku9s13mfxgv3", + "fie1gzgby9zz8fys8gra7l7497d", + "fv8vooj1gzwqr4", + "gaa3prr7cl", + "gb2og_gb5z9sm2z446e9o541tywi", + "hxhf6qbmsqckm1orudj", + "kgz", + "l4f0q5d", + "m_erjx99xrf9q9pq20qwaice", + "nu5yplp4jhu3z74bbc9t", + "o1ah2_c2as", + "q656vwq0qvolojx2n", + "qmfgy06", + "qsl0jhz77kfx50jxca9kf79f", + "rs1qyswbr7fqpj8hq9x1eu", + "snld_iuq_nm1cu7xmyzo3u", + "sxp8itf04lu1wghpjqcqqkup", + "tmrhk50zy1gyezx0gs_", + "vmh_0a_zl47l2e", + "wh98oryxs6p66t9kg7p_pu4uof", + "x15la1pg8i5r0wo0etp", + "ya2w7ff", + "zlkueby8" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + [ + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -29, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": { + "contents": [ + "󰪒FL򝟦k񜐽b\t'\u0011\u0011Z\u000b;w;\u0002𨻜lxt\u001b󧧖\nb􌳂%", + [ + "aqdoictud9mv9y", + "bazq6u0pacrwafpxzk", + "c67but1bh", + "d4r2xj791551dj6h3qz30t_gm75zl_k", + "dmsjrwjx5fhpeqy4", + "jkmwzjgdcgiw2aitdv", + "k8cvobcib3hgqqy1c2e3rw5fa", + "kg1_236o", + "km6ofua", + "newzbkndrvfnvehkwzy2", + "now2fhhplo", + "nqu_dman3kwd4", + "o2215_tzra", + "oanrgr764b6vewn1dg", + "pc4biwe1386yrq61l_b8", + "ps8vwrncn3v6rx4w4c", + "q9n1khxa6am2xrzdn7gwde8k", + "uw2z_xixgzg", + "v4qnrec0_wz93co2e2x4royq", + "va2n", + "w4318", + "wssorjb_f589uc11mj208d", + "xaoq7c8u_bmlq1b__a6", + "yhg1y9z3o6f7b0n2lt28kq", + "z73nlskv39wr22siol4yq6oxuie", + "zmafi58bwgwp9887bfkdyl4s0", + "zsxqy" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "contents": [ + "𸪄\u0014Q󘀂𖢏[#\u000c_򾫅T;", + [ + "c8k60286ciq03b250h37xu6z__xa4qm", + "dx4wwfuh", + "eogki7puk1mkokhzp7", + "ep8pc6ta95bj", + "epj_15c7gsdm5eu661n8", + "j71yqp5iw6q66bh3l", + "jvdu9x7lwk1z1ivetl695ix91_", + "m3zsmrk510x_jle87oo8", + "my9c7o0ic5_t7vm1_2l0", + "o3veo11oik_higlfui", + "pszhm3neyl_pyoq_pcy14hs6km6", + "r", + "uwtxreeiz", + "y8e1fgqu2z8yy", + "yejf112t", + "z1n_m13_s3ehu", + "zg7885360xrtigd", + "znq5yyhf1gd0m06evsz" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": 11, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": 14, + "tag": "TVar" + }, + { + "contents": -6, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u0018󜉂<6\u0015I7I\u000e\u0013\u0001Rel`󪤧򳏃/AIgJ", + [ + "aqtuoqjwiq3", + "bwrfocgiyb4arkyitqfkjpaw7e1jrnk", + "c9gfwr4h8dwksv2c_lq2xvyvoe6", + "d5ljsiq7l", + "edkphaxrknropt4oybp2n2edeio8n_j", + "edufj6", + "faz4sh9lm", + "gkm816c96dsqxv21", + "h7p20kdb63qd1e7bwzfx2fm", + "hhtjvq", + "jbhs7", + "jdy6v0", + "m", + "qdll3i5voe1gvmbesmr7klkmvs286", + "qn44egkg1kkn9raai4d6", + "qwphi2yyi0cscfe_tj6rfbqavii", + "rnxt9q9ibdt", + "rz1z6z3aiethw5yjuyghnggbu", + "s", + "sts9bpu82oqz9lif0747nj64o_e8", + "uoxxnnm3gdvap_o3uyl", + "urn_qjo0pidqak5po6ieiyh", + "yvxsatnc1rzk6ix2bp", + "z5vrj6mhe4", + "zdkg9fj0ff002" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -28, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "[󄷂\u0003$|\t\u0010EPIh񏌿󙕖򋦛򒑞)VJ_%}𕾀", + [ + "avwzznjvm1l8qr0qf4rs8w5va", + "bhv", + "briw", + "bydhzdmciyoipw1", + "bze0jc", + "ew", + "hxwemx6gyvuho", + "irqjhznys", + "jkwl", + "kgine3rhdioy5rxxrrgo45nk96yh", + "krdizm7fw587af_dozt49eefk", + "li0042", + "lp6lmwl2ie5v", + "m5eoi", + "osxdqcx5bijhkwid", + "otymcyv2ppm6q", + "pif_a", + "q72izcp2l8zq0vn5sy5", + "ql179ebrnp7mjfj0zm8o6lvb1wu", + "r3x7be2t9ujezh", + "rss1t", + "u2jimx4", + "vr7b8hq2royz52l_t9tu3www7trq", + "y5", + "ydr_4722", + "z0vd_p0", + "z8aw8xlfhe_zjnqz_3o", + "zr6bklyn" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 11, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 25, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "contents": [ + "񈏆\u000b\u0001񰆺\u0016\u0017", + [ + "c8ifwvi0", + "efofku14sb4agrygo_bh6pks4gsip02", + "i", + "n7xvhkmnaq0imrio6lucdhh", + "p9gvlfnm", + "ts8uje1b0w0os_dec7ts634r5pp", + "vap7a09ou3hmapm430g0a58j" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "&mRHJ\u000b)i>CY\u001eW\u001bIpY\u0011\u00083Y䶬:D5.?B\u0007\u001c", + [ + "bb6msc0yeqc5j8gde" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "$󆒌W𲹔򬢓xP\u000cc\u001e򍚑^}Xi\u00032", + [ + "jc9bv2r1sbrs4mmv69i2itzrrar" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 4, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -17, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": 9, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": -13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 9, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": [ + { + "contents": 24, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -24, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "񰭥0򾂻4zq*Cxo󊢬`Z|$I򬑅#Po𮜓B3 q\u001eE=*", + [ + "aot8qh6x97aqizcc1y8ml", + "cxuftyoyt0y", + "d0jc0u4m4b1j142yvqxhdz7", + "d78w7snud3t8gt_f", + "d81", + "dr9uvkc69ut41_xx3g52yu467t8qdo", + "e0milpap4q11r92grm", + "e7t3zao_3jgnxbg328njkvqzk", + "ejbtoywc6zv7j8pvn3l540", + "eveesxatz4jiiwxl", + "fz39iln8nh8swtuv", + "g", + "g5nwrgs5zmyx3vd4wwit77k", + "hapsn1bu768q64nyq7z5ewi", + "k2", + "pdp1up4", + "q10cgbn53abpk8k", + "qb3lgvlr7him3j6h9qrrop", + "r2ifuohv64vetcum3", + "su03gryndj6", + "vyo__0_c6", + "w7gvo850qks6o62r75be7_v4_qzufr", + "w8zz_omv_n0k991k1sko6q7gm", + "xh1lwsth29pfe2s9", + "yp4tpfxixqrsb1j_iuwnv7oh48bun", + "z38txup_02jegfn" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -29, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + " 日}fE񠂜󄽀\u0013D\u00191𗦹󂄢𺣧$\u0018\u000b(`􂏾\u0014o\u001e\u0007d~x", + [ + "an1d73r59m1wngny75dustmdourawm", + "b0yzjy62dv2w_", + "c6bjsqhw", + "c7f5el2ii6qgluz372_8", + "dfjhc2rlg0r", + "dr8o9plby0f91idcsgw5", + "dvefcvx1qypl56r99uz17gi8_qu6j6", + "e5r", + "f7dzl4dyfd_xfg435y5l68g3", + "fodvjehrwfn", + "gnjf239ytt6entmyhba694upvk6c", + "kqq8ij", + "lhqp6dd1nssy2qtccb18gaemy", + "nqcw6p9ehsf3j38p5wo_624ieez_xu", + "on23", + "qb9f7pkpiknputyl", + "qs7vrslcbf6mjfkgeux9b", + "r", + "t2rx0htpt5wxaxdfqf_upxcqnsu0y1", + "w5egg62q6kceahh7rie3hvhln", + "w6bdr4nn4d1yq", + "wu6ybc3epwk6ugwodgewuxv7_a9tpx", + "y", + "zv0a04z_k58x" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": -10, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "򃉈k󈃾򫥴L", + [ + "bu0z0ozqkqixuuq4fsf9t_nvt9o", + "bvtbivdnv61sbkd_3z7", + "e4ww90tg408xuh63sytwsy05yyl9", + "exf75l", + "f19f37767rlsrivs2co4k40l", + "h", + "h3kas", + "h9zalgtzjplquoma5g48t9j5e", + "ibijzcka6enxds7pf8xo8smqjh6o_j", + "ix9t", + "k", + "l692wy0bv9ld_sqzqgnnw2", + "l95x69y7n22uqftbvkavdv", + "mke9gfuhjzn8wk", + "nd6glljhfh3", + "pstx9k6uhkq74hymx8zf9yyo6_", + "qcv", + "qmysr1su1fpdvg2n2536", + "qo2", + "qz", + "rowkxkkiv4811q2kn2792as", + "sdbxj1f2tiwavbmzmnu1o", + "y5rceo29kly", + "yrgwx0tfwb" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": -17, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -3, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "y򷤓󬷇R\u0012󎓝\u0000\u0007\u0000w^U񥴹GQ\u0006\u001dd1󟒷", + [ + "a1r3fnr312j_z0upo", + "d86l3wjpbmkdail4q", + "ia1vxkd85pgj3t1b2crv3oaej", + "ian86fklwworo95vd_h9ad312akb7k", + "j__x7c0wb_355_glfje2gnhs0z0", + "l9xz_ptmbuz99jg", + "lmfpjapyfqym2wjafrw5k", + "nc", + "nz32", + "ob_ik2oko4s1w699h36n", + "ol35pcw9apz11ien0kez_c4989qdl", + "oskby6o1y8164pg1h", + "r7l334861iz11x14ph_o_", + "rho6rh3kejz_bzz18c2", + "riyzde48rnlf3y1653cueox7", + "rj1mmku4rhm3loaxrg_", + "s9a", + "sknxe8njgzdpyx4kzjhmjruh3", + "ufys93gm_lsn5t60uq42o4od35ysyra", + "uq96r93m6", + "w", + "xqwbsf7yk1yltwfd1vc43v", + "y5qkwasp_xegj", + "y8uds3j0gi8g3u9qxwq9fx", + "zohyztekwhy2u972ptyj7kvfrqwh3", + "zy_ij432b7jg1pkh4lx4h7n" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "@󰜲d󸝕𻂾M󕆊\u0014Q\nwRy\u0008%9\u0003U󒻰򯼯", + [ + "bsm", + "g6r5iwtp6xopn3ry507zqh_fib3x03p", + "izxag604a9ic", + "ka1nl5qrl2ndsnnkdeuw2pu1g05_td", + "majyn8sfybng0", + "n7l9hz4vxitmdx_gn12rkhfw8h", + "pwqf1h5i_etfrhc1z7h3pmp9siwh", + "rz8atlj0gj3r1rvwrr1b7v" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": 20, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "UFzhHwU\u0001VK>>񔇭-S\t\u001a", + [ + "bn8h1een32pyg_s", + "cm_g7kde2ejnoml66yksyu", + "cxrp", + "dlcrxu6mppk", + "eas_db85w71zh2qo5zwykeozdbi", + "fmkxn6", + "hjne", + "i", + "iq07sb5", + "jyy8txtwauaq478ns", + "krd0m0_enw65_", + "l1i3d9", + "mpyhsf_jidzumsaby3z866f_l0qpoz", + "nl4a83tuyck9wdg0h1i", + "nr", + "r8apff", + "s78j1lhlopz03rr043xe40l", + "s_ree", + "svi4nd2yfojyw08lswv", + "t1lqrrk", + "t59kanmrlaxb7k424ky4yiuprc13", + "tych5r3pblvoh4g5nd", + "tznodq_g9yhfwxthdsh_nxu_if1ek", + "v97", + "vjq77c3n2_vyx5rjv2fb52t3vjxzn", + "w8r338jonjuzxap57gct3bvk8o_fsz_", + "x9h6fc0j9h6kpxor" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 3, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": -7, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": 16, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": 7, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": -28, + "tag": "TVar" + }, + { + "contents": -20, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 29, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -17, + "tag": "TVar" + }, + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "m\u000e%񑇼[\u0019󓜃", + [ + "a3ieaxe6dnx5_ta5klvvil0", + "b8uyh6ti72wabk", + "b9htcw", + "ce692pl1c5mg2ld63yvop4cujyduc", + "cyvbvpjsahd2exkhvtaj1", + "na8zx6cy4hcej3r5wrtxsvwo351a", + "ojxsahbwr8xsoa5f5ux4t", + "qkov33bz5913wnoqn76ol76jnxws", + "s57hq02faz_", + "s81_147vh_rjh_m_", + "uef219zvdx5iz3uv98_nn9", + "wngc6eaeco_s0wm4opt3h4n7aeg", + "y", + "ybv6k0snvqgavgki1qsf" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": 28, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "*񚗥>򝪣y6\u0017Uy\u000c𱈤\u001f$\u001b\u0012\u001c𱾤", + [ + "friyjq", + "kbutgrfp106zfoxqhfj4mu", + "lh85", + "o1d718b2pvkki", + "p12j4edocz5oc671slnu", + "r_34nw5isl3h45", + "rou16ih3p6oafp", + "sebovini8z1hx_03k2vxa8cl5ee", + "ukow087", + "y9c25hv1wwa49vlb_2" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u0011{y򧺯򽤨", + [ + "c", + "d2jj_dttna06o3uxgc", + "diwru2git99jianpgb14p", + "e8w2oz9nx", + "e_te3ig6e9gyhdm0j", + "ghl2aw8u8l8dci1u540huktr91", + "jkf_r15xx1f0geqxk4nnljgeuz42v", + "lepz96dhq", + "lyh3ec97ss7", + "nban4ra0jz", + "tafbaeo7t7s9l", + "vkf5ssdesc0qshgki6x_lk", + "w4k44q30vhhjab2cpcn9pji4bxuc", + "wu3reem6atk3fqw9caojo52f7car5" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": 14, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -25, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": -30, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 28, + "tag": "TVar" + }, + { + "contents": -24, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": -12, + "tag": "TVar" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": -25, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "?", + [ + "tmiz_zqyivjztxfnqhg3ky0" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -13, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + [ + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": 11, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 24, + "tag": "TVar" + }, + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": -25, + "tag": "TVar" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": -25, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 3, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -20, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 18, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -7, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 10, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "\u0019\"\u0015.", + [] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -15, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 19, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 4, + "tag": "TVar" + }, + { + "contents": 14, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": 27, + "tag": "TVar" + }, + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": 26, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 17, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": -11, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "contents": 22, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 28, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": -23, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": -11, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": [ + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": 1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": 9, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": [ + "􆤼h3\u0011r񝻮2a\u0000\u0006\u001bAof񑭮", + [ + "ae", + "eah4jrv_c4ndip3r9o", + "f", + "fepju04xycrsv2b", + "gtptqmdqbnwkvs5e", + "gzfxci7mn3amhqc668g4s75kgnwhe", + "hqn7nkevj0mf2tfnojw39l", + "jpwsqcqt5uyo4wr42_xcjdrhhs11", + "l9tlppqkm9yfzup80c4d", + "m1rbxud66", + "nokjmx_qzz", + "nubejoo4bb8id8vyd", + "qn", + "qns", + "rh9l2laam4vpkehx2zif", + "suemuu", + "uaso9ew", + "v7ymri3amv", + "vceck51zm9yavh4ovz", + "vcqol9xmfhak8p86ldx5xdx8611bw0x", + "ws6bn3vm", + "z8p4j6sg" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 26, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 4, + "tag": "TVar" + }, + [ + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": 28, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 16, + "tag": "TVar" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -13, + "tag": "TVar" + }, + [ + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "񛧩Gj,\u0002𜂧g8񦙴;񔙅.~}2\u000c}^t*\u0006B􃠒c򟔰.&J󣍏", + [ + "ao21vxo64b7it2", + "apn11udyuw3jz25zz66o0_uj8ecqlm", + "cbojxrkzcomeqx", + "dez4ojw00ypu18rftkqcrru2_exrbg", + "dplephcnd481k7u7ueyxc", + "gu8nx3g", + "iai9cou", + "ibj3u", + "l_4ol4pqb9xuipv_463v9k", + "mnd93uae8v2", + "n", + "n_bj", + "ra0z8crag7x1y1uvqak9f4s1s_xtr", + "sywmf2az7f_3_n_t557r", + "v6n6hwvm4b3l59ec1", + "vrlf9k802vqt4ks_93h6jl4", + "wn_2824juysliicddfk4ryxnjsgh6v", + "x32hsqcmfmliemzvlgpdwn7lp", + "zohf763_m_rpbq" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -12, + "tag": "TVar" + }, + { + "contents": 21, + "tag": "TVar" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "󅇴0$vI9u򢤬񜆷X󏓤w􄏙𞋑\u000bZ\u0005\u000c\u000b", + [ + "ridj8f05226", + "s6tpbdom9", + "tn2ol_zmo25753" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": 17, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "\u000bD\u0000s\u001f-u񝨨?񿄴.\u0001", + [ + "bd", + "bsq7y", + "eem0ab3ud6qfw27f9d0nblbt6y7", + "fbw7er8uxq6", + "gd59_pyqe5g_ra_uj2n0kt3", + "hv9wt3ihu", + "ighprcl1xb4rrgt9j5kp1", + "jc15io5wqe", + "nbynh9v", + "o36x781a0zgnroplvnzfdbqi3w0n", + "ontz6cexhnx0kx", + "q8ewr4yytvxrq5ez3", + "r", + "s", + "sfp5ni0ly1w6yp5ionu", + "tjqjjz90dcjhgddaa28f5w91kwdb", + "u6r6h3h98vy3c787ngpglody", + "w0bdsxe", + "w3zwhmo67", + "xls5uygzv_kjp" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "contents": [ + "\r}Q\u0010'~", + [ + "ak_xm71oamu8wv_m24yg4lgqb9zgq", + "bjtseg8q706", + "dz9r186lg4e", + "e", + "i787xzf4hal0gyt2k1wjp", + "l4lczce7ro2weqx3ktspvcrv6q", + "ljw3paj3bbavq", + "mj8dhe9d7wd116r6gfwsi91awqz", + "owcz9jc13738stqcbheh", + "rz06ei1pd8ujdzn9sv61rxya4", + "t2_x", + "uf4xf29t5cdw1", + "w1nz", + "wion1x92n2d49rcv69k6fc14hhk0", + "xl8ol9ex4s4qeyifq67_", + "z7u6udu" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "%R񥡿~<񡈓򉮾f8A.p f_X", + [ + "adjixvgjidsh1ph86", + "gje8ukt59apugte9uag629fx75xn", + "j1k98n20xlgkdgr69ve7lojxcy951", + "layezm7o", + "mkyjoc7qdakv8ccn65zos7icvwjpd4", + "mqvkxhbw3wz1xgyim", + "mrbn6z8j_ccy2j2sr130zn1", + "ongjn", + "pyr87t", + "r7ff", + "rl", + "sgmgiofzi02q70xlcquhx", + "udgz7e49itb_3_7sobpqy2xa7i92c", + "uupwnrg6e8eanzmmw79rydb", + "uz4wmli3txcz3h76l8", + "wjy6j7mvm_ygaizv22pmt0lj2z", + "wqpis0l3aw3xzkgxho_lv3sv78me", + "wt_thr57kld6_526b7w42vvmdv32i", + "yefc_z860x9w", + "za8pteykop7g9x7infrn1yedb_etf99", + "zb6lcsdkrwt34" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -12, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 11, + "tag": "TVar" + }, + "tag": "TSeries" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + "\u000b\u0007򈟁c𐿦\u000fE{R󖦣\u000eJ\r\u0003)\u00112:gl򣺔\u0013\u001aI6񢟴[", + [ + "b11gk4ti91mt1s2suqpaztvz0kpi", + "bl0wy15k", + "bwlwbjyzmcuhbxl9o0_", + "c_cw", + "cb7f0i_23zz8fe4jr026", + "evibq026zdhf0xt", + "ggl5je_1vaaym_z", + "h0gsux", + "h7qs8f73yh", + "i6cv9__i", + "j4jrwu76lqopbf9zzyn_nna2veg", + "l196u4geyz8nshsj8m8", + "oh", + "oju_6fwietthgn0cinr7iwo1jejx3", + "q8j6", + "qvkt000jc", + "qygwvccn0d1ho9pc9b", + "r3mdfhcruwomfr969hcjbcw", + "tl3mcuzf9w7cbjr", + "u4wib7vejlveiko7pim4", + "u6vikgv3ormbhvbbilijtf5i", + "v8ig783", + "vyyt", + "y2zgzoqpe10y9gnn", + "y3e0z1nfi664babp", + "z", + "zavx_97ct4wof75r0", + "zgi8gszx74l3u" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": 12, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "^O򡹼򀑠󶣟򴰬M񳤋O󚙼򔢘󦺛r𵟽\u000b𴩗\u001bT(񲹀\u001e", + [ + "ehz9", + "fio2e", + "fypapige99zj", + "iadwjbelq7", + "j_", + "k4up0q6r34ch_65iwsg", + "n4zzbp5npe48kkz5ay8tn7", + "n986aeaujs_hpe3s5bks", + "osj9vdv665o24f4xnwgoona7wov153", + "qug6bpupkd_0lfg", + "tdndfoq25cb", + "u5ic194z", + "wersqrgvqx69qddl9_w6l", + "x", + "zxhm54j5tfai1meu6zpmd05zrm_cy", + "zzayozurtayj6" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": -13, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -24, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 15, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 11, + "tag": "TVar" + }, + [ + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "'Bn`dX", + [ + "a96", + "bm0rxt1y", + "f1m_3y_fek5l8zzzp", + "ffrmg0e_tp5gf", + "hebys7yehm7oerur", + "ixl", + "j84hqeivc3bqdm2fpfyzvj", + "jlxxeikkowmeu938g2cg_z7ds1yoy3", + "kilaf7p01qu91yizxrrhapl69", + "p3mnsqehtbi9m3d_ya1lqsvmeg7j", + "pu_dzvwx6s_oet3_sxyco6x", + "rfep_d1l", + "s", + "txw_b8", + "uvcqh2", + "wwim7px7_co1t5ocb84lts2goc7r6", + "wzrw721wyl8e81vhxwlp5", + "y7xl0fd9jnmprpnl83k3s6", + "yajcroep9", + "ycn44tys3uv_qt" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": -30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -2, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": [ + { + "contents": -23, + "tag": "TVar" + }, + { + "contents": -11, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": 18, + "tag": "TVar" + }, + { + "contents": 25, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "D?\u0002D", + [ + "dml111_qygui6y5z14b", + "hl5k6ps198z2d42wzdgyegcigg", + "hsqol0iaygfcm92jcc2n6_o", + "hw2h0sslf6j", + "i0glc6rqvbgwelkl6wv6s_y2i", + "itwp4a2coznnj9eb2", + "jh6x07yd3lgbnjcqi3nlgru", + "li5zage3mgfoloqqxsmgx_i4", + "mkynp8ktxglmmv", + "s5h9chj6mzphoaiausejr_lkknaqq6", + "uj4e", + "x7cfpocqp3o" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 26, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": 22, + "tag": "TVar" + }, + { + "contents": -28, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": -12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + [ + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 11, + "tag": "TVar" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -15, + "tag": "TVar" + }, + { + "contents": 23, + "tag": "TVar" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": 12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "\u0011\u0018D󎮵񵢓\u001f\u001b򯰔\u00188&􉟟sqp&\u001f:񨓖#0𻣟h\u000f#JX", + [ + "a4us4d60b2e_i7tn0bcehwlj", + "e6ob", + "guhrw2vv" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -17, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": -28, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": -19, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 16, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": -15, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "contents": 22, + "tag": "TVar" + }, + "tag": "TSeries" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": [ + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": -26, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 29, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -29, + "tag": "TVar" + }, + { + "contents": { + "contents": 25, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": -16, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u0018\u001b򚠒", + [ + "h01wows3mts8hrl", + "hri373", + "kwj0bokqz0_s0erkm6dh", + "msp05916l1", + "tysr61tvocgb8y_u6ftlonbolg6g5", + "xpfyq90crpwr5pzo678u3x57g_k_", + "z5mwo1vc7k3bty" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": [ + "R񛑶@涰\u0012ULM(CE/~RFT2J'.\u0004F\u001e󚐹𜇺\u0001O8x", + [ + "m0", + "n643", + "qyzbdu0hx2mdao4nckj8qjonc3", + "wt", + "xwcxaf_x9nshx4ce", + "y1roeogsi9j1" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "contents": -8, + "tag": "TVar" + }, + "tag": "TArray" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -6, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": { + "contents": [ + { + "contents": -17, + "tag": "TVar" + }, + { + "contents": 12, + "tag": "TVar" + }, + [ + { + "contents": 30, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": 9, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 4, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 20, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 18, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": -29, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "H.󳌖\u0005:+b\u0018OR:D:H򳷟,F񤂚\u0006\u000b񹫪\n<񨱲\u0019Wq򅘗(", + [ + "asdz04i541iao_th8ep2kyo1fl81x", + "e432kzbotu9td2vcbp6t0", + "gaafnjnterq1_xg_yu", + "hxsqkx86xzma9liajgy", + "k4eyk1ugnuoebbgja004ob9bvf2xq8r", + "mk8yodafz2yl_7yjhktf2aw2ytdmc", + "py", + "r0av2_5piwn5bqepu2borfb7", + "r4hafai3aos1p1zxomkjcqk1_k", + "svt6gkvwvj9997dpae4wzqi", + "z3b2g0y9hm9n9xet31hz_mnmd4q", + "zm4amrq50l7sz1i02_fe7" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": -26, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": -22, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "\u0011]DdU򇇖a󓫾", + [ + "an9jc1eq620tln2k13", + "bxkj_f7u32", + "c56yugao1s", + "d2k_uvuqnl_36s0cpqgy", + "ekn", + "foh9aet", + "hf5iiwr3myipmwrkqbs2p", + "i0ldby4", + "j54rlka2aaikwcjev_", + "jepu", + "ln2ya502fh4o2pwxa_gosqz", + "lxkh", + "m", + "nkydp_uf12ud4u5s63208xj63jm8r0w", + "nlfx0m1piyxmm07kh2ka", + "p", + "p85", + "qbqs8m1", + "rli3l6wm9exi6_wfesk7oygeuvg", + "s7q41_ebos", + "shbju5e_ekc6", + "xyrtu_hnhkc_zn4ef49li56", + "yf6e4zmkuf76qj", + "yk2ewh0", + "zdlavegg7nsnl4k8ypvsu07qoq79k", + "zus0eoalmowjrnxagb7v29mkms4oy" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "%{\u0001mh󨻉z[󨳐򼕢97(\u000c🽦8:*+󾿔􀷝\u001f3nHq*", + [ + "b56yipao8ofixvy7", + "dmten0u6n", + "do7nsr", + "dzhe9d4o6i3qqyev6f5qjg", + "ffxvqv58ht1ft4cp39ulcgmcc0_lrl", + "g8gzwqpmp2_9hvyse5cptpmxh", + "giv", + "hdcwmf4luj0ivrg", + "hhje75", + "nloksv", + "omsyp8imgqnu68kf54d4c3acj", + "p7_l5zcrj3r18xmba2kes0", + "p8twgk3xnpzhg", + "pf", + "ps5hv", + "q5wg", + "qe1v42fxbpmw31rspgorlb8eicuc4hv", + "qqux5lfabbvfx9ue", + "rc", + "rjjfr86zs4lbcmu7kc4r_m5eoiex78", + "rte1dnyibwaoju4ubcmeggqrk7hy", + "vkuu282a", + "y6eea_cxd_ld4", + "yulkrjb7dg2yvo4l0pjyrk8z3", + "z0" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": -20, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": -12, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 14, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": 25, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 16, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": [ + { + "contents": 4, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + [ + { + "contents": [ + { + "contents": { + "contents": -7, + "tag": "TVar" + }, + "tag": "TRep" + }, + { + "contents": -16, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + "򜑼󝓐\u0015m[󖉊g󢯘\u0014aH\u0006R\u0008󚱊򜅍5򳦳;\u001aV", + [ + "cf15", + "fbx9xm3w", + "fg498yb1oiifjdznib878n4rxl", + "fy5pfc4wrd4e4b9", + "gwf6p336dt", + "h2dr6tebu4n", + "hfm9x6v4scqovdh2ku8r", + "iiw9967us", + "jd_etjdd8gqulzx7q97flsjyk5t", + "jq", + "kun9fpr8g_x6lyfujsax", + "l", + "mplf7nxkdiwmeiuav", + "nfn8tht8gqhknygkz5sywh2c3", + "nus9crmbytbzlw4dsy7s66wyyy", + "o3luck_olwrn4yx1mw82apk", + "pu0zxklxjyelhs7z8unk7fh", + "rdddksaj4_f9x9l6lbvbyjxdji", + "sddo_365w8s43uaxwqa1", + "srjy19t", + "t20qp3qi9j76vuw51hsoajyzryr", + "uusto", + "xdsybvp6ywuvpf1tanagbhda3o4jh", + "zi7vu2bposk92fberu2fr5aq_" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": 19, + "tag": "TVar" + }, + { + "contents": 28, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -19, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -3, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "J|\r/󿁴\\:\u0015\u00121\\a򝨅򨟖a񺢿P\u000e{\u0005", + [ + "e5", + "fb5num978f9hx0", + "g3z", + "gdp10k2350zdztbw_9qq5fv", + "jhhswzluu92f_sxy36vtc0ymwrlns", + "mij", + "qo7rdnn8zpo8k2jw_4e94ki", + "ub4h_b75", + "v1jnec7ld67qwp57", + "wbd813mj1n", + "xam7", + "xnd" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": -28, + "tag": "TVar" + }, + { + "contents": 10, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": 15, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 5, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": 11, + "tag": "TVar" + }, + { + "contents": -21, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + "\u001b򘥼#/.", + [ + "b83a22qyrnvi44su39e_n134hfe", + "f8ni72qrct1m540in8", + "h71f8f89rxdgb3av__7k_g", + "i501gv31xz", + "j0sdh2s", + "j8kqafsqf5mmbhlb_l5cuux", + "kolefpai6p8vf7se", + "s", + "se2evqq20umi436vvpp4gz3xd3oto3", + "sw", + "vqb8jj748nq1uu30kuhgt1h74y", + "w2aim_xzzn", + "whtsdiktsyqwi1h7tgsnz", + "xp7t9w1n_", + "zzf_" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 20, + "tag": "TVar" + }, + "tag": "TRep" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 14, + "tag": "TVar" + }, + [ + { + "contents": 20, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": -11, + "tag": "TVar" + }, + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": 13, + "tag": "TVar" + }, + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 14, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 28, + "tag": "TVar" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 15, + "tag": "TVar" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + }, + { + "contents": -27, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": -18, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "contents": [ + "󍱿'gN|󯘗p򼑨sX򩾃bi\u0016", + [ + "jiyal1iz9mhezjmbe", + "t78_jl992", + "tdpwv81ijgy" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TRep" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": -14, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "seed": 1872915585 +} diff --git a/golden/InfernoType/TVar.json b/golden/InfernoType/TVar.json new file mode 100644 --- /dev/null +++ b/golden/InfernoType/TVar.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": -21, + "tag": "TVar" + }, + { + "contents": -20, + "tag": "TVar" + }, + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": 29, + "tag": "TVar" + }, + { + "contents": 21, + "tag": "TVar" + } + ], + "seed": 2045224457 +} diff --git a/golden/ModuleName/ModuleName.json b/golden/ModuleName/ModuleName.json new file mode 100644 --- /dev/null +++ b/golden/ModuleName/ModuleName.json @@ -0,0 +1,10 @@ +{ + "samples": [ + "mtfl_r6bwux945gr7pdwkaqwt2u", + "b_o2", + "yx8gmvluqo4o3pqey", + "s5gp6fktjtqt3jr61", + "m88ryl7pti2dtij_i4gqicezybi42" + ], + "seed": -1738970587 +} diff --git a/golden/Namespace/EnumNamespace.json b/golden/Namespace/EnumNamespace.json new file mode 100644 --- /dev/null +++ b/golden/Namespace/EnumNamespace.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "ju7s1", + "tag": "EnumNamespace" + }, + { + "contents": "vtrwa3t3uw9a9olep078395prc2", + "tag": "EnumNamespace" + }, + { + "contents": "mu5okanezwj0atw_lzira8ald7qvyqz", + "tag": "EnumNamespace" + }, + { + "contents": "xf0uwv2", + "tag": "EnumNamespace" + }, + { + "contents": "q", + "tag": "EnumNamespace" + } + ], + "seed": 2006874210 +} diff --git a/golden/Namespace/FunNamespace.json b/golden/Namespace/FunNamespace.json new file mode 100644 --- /dev/null +++ b/golden/Namespace/FunNamespace.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "nwclq2jfeke", + "tag": "FunNamespace" + }, + { + "contents": "j_0g5olb9uumr5tkb", + "tag": "FunNamespace" + }, + { + "contents": "kl4v05xrylj3rbznr08s6", + "tag": "FunNamespace" + }, + { + "contents": "j585ea", + "tag": "FunNamespace" + }, + { + "contents": "hu3c", + "tag": "FunNamespace" + } + ], + "seed": 1571496230 +} diff --git a/golden/Namespace/ModuleNamespace.json b/golden/Namespace/ModuleNamespace.json new file mode 100644 --- /dev/null +++ b/golden/Namespace/ModuleNamespace.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "tipb5u8tjmankzq2wr71r", + "tag": "ModuleNamespace" + }, + { + "contents": "cb1ag5", + "tag": "ModuleNamespace" + }, + { + "contents": "v45vm424tkh1yq4yrcobqf1en9s713m", + "tag": "ModuleNamespace" + }, + { + "contents": "dcvuomg14y3g0hyxiel0e2srjqy69", + "tag": "ModuleNamespace" + }, + { + "contents": "f5mlt9w2qbumsnz6m", + "tag": "ModuleNamespace" + } + ], + "seed": -1878191093 +} diff --git a/golden/Namespace/OpNamespace.json b/golden/Namespace/OpNamespace.json new file mode 100644 --- /dev/null +++ b/golden/Namespace/OpNamespace.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "knr", + "tag": "OpNamespace" + }, + { + "contents": "yx7fjzftaqofckqpgxnwkf", + "tag": "OpNamespace" + }, + { + "contents": "hcywd2mao", + "tag": "OpNamespace" + }, + { + "contents": "q1bk_", + "tag": "OpNamespace" + }, + { + "contents": "afrehg", + "tag": "OpNamespace" + } + ], + "seed": 19646859 +} diff --git a/golden/Namespace/TypeNamespace.json b/golden/Namespace/TypeNamespace.json new file mode 100644 --- /dev/null +++ b/golden/Namespace/TypeNamespace.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "axwd2k2xej8ahf6w38figrdch9xh", + "tag": "TypeNamespace" + }, + { + "contents": "v8v", + "tag": "TypeNamespace" + }, + { + "contents": "jbb4uo0yfol78z054ojg6rkusuxjgou", + "tag": "TypeNamespace" + }, + { + "contents": "pivegv", + "tag": "TypeNamespace" + }, + { + "contents": "qo4bfettgkf84w3ikv1ruz1xe", + "tag": "TypeNamespace" + } + ], + "seed": 180972885 +} diff --git a/golden/TV/TV.json b/golden/TV/TV.json new file mode 100644 --- /dev/null +++ b/golden/TV/TV.json @@ -0,0 +1,10 @@ +{ + "samples": [ + 10, + 21, + -5, + -5, + -14 + ], + "seed": -997543535 +} diff --git a/golden/VCIncompatReason/EnumConstructorsChanged.json b/golden/VCIncompatReason/EnumConstructorsChanged.json new file mode 100644 --- /dev/null +++ b/golden/VCIncompatReason/EnumConstructorsChanged.json @@ -0,0 +1,10 @@ +{ + "samples": [ + "EnumConstructorsChanged", + "EnumConstructorsChanged", + "EnumConstructorsChanged", + "EnumConstructorsChanged", + "EnumConstructorsChanged" + ], + "seed": -1065983812 +} diff --git a/golden/VCIncompatReason/TypeSignatureChange.json b/golden/VCIncompatReason/TypeSignatureChange.json new file mode 100644 --- /dev/null +++ b/golden/VCIncompatReason/TypeSignatureChange.json @@ -0,0 +1,10 @@ +{ + "samples": [ + "TypeSignatureChange", + "TypeSignatureChange", + "TypeSignatureChange", + "TypeSignatureChange", + "TypeSignatureChange" + ], + "seed": 1126967857 +} diff --git a/golden/VCMeta/VCMeta.json b/golden/VCMeta/VCMeta.json new file mode 100644 --- /dev/null +++ b/golden/VCMeta/VCMeta.json @@ -0,0 +1,276 @@ +{ + "samples": [ + { + "author": "o00005b860000000000bf44de", + "description": "\u000f\u0018\u0012<\u0018c򉺈򐻨-󈖁", + "group": "o0000014200000000009596c9", + "name": "]񍥂r󡂯I𡷕No𰵫q\u000f\t򟻁v", + "obj": -6, + "pred": { + "contents": "5ih-nxxenNZGUinfdl14aRBlYJvE4HALNC_MwYKshTM=", + "tag": "CompatibleWithPred" + }, + "timestamp": -13156498, + "visibility": "VCObjectPublic" + }, + { + "author": "o000073ce0000000000dbc2ea", + "description": "N񖪰\u000b@5\u0008=\u0011񦇷P\u001b󟾌06", + "group": "o00001134000000000044f712", + "name": ".(􆀿𐻔lMx+𰈞󁒇p", + "obj": -2, + "pred": { + "contents": "-qaLzxy3ykEmlL8Rmov3kQ7b6B0UGexf4Tm9th0oLLU=", + "tag": "CompatibleWithPred" + }, + "timestamp": -2376718, + "visibility": "VCObjectPublic" + }, + { + "author": "o00007f960000000000c4b5fc", + "description": "󱖎l\u0018󴔠f4e򐤤I_>\u000c3", + "group": "o000016090000000000284f40", + "name": "\u0011𫈸H򘾏W񗁩񕮟𵀶-򖣶9D򨨋o|\u001a0񬼙i🫹_.\u001aﱚ=򲃍񧍀\u000b󸖜󉉅", + "obj": 1, + "pred": { + "tag": "Init" + }, + "timestamp": 4787500, + "visibility": "VCObjectPublic" + }, + { + "author": "o00005fa20000000000c61725", + "description": "g_\u0015Y򎕦X򰃤~]󺙋X󷨡<", + "group": "o000068e200000000008989ca", + "name": "]Ub𢷏򥵵\u001aak;)񑣹􅰌򌪳", + "obj": 3, + "pred": { + "contents": "CV0a0vVBkbFmpsDlrz28LKBdsn0G82hwtCt303mFtZo=", + "tag": "MarkedBreakingWithPred" + }, + "timestamp": -13542723, + "visibility": "VCObjectPrivate" + }, + { + "author": "o0000184d0000000000de82a9", + "description": "\u001f򋂘\u000e񽉑P򅅧sY󜊭9>", + "group": "o0000399800000000000d735f", + "name": "._񎋦 3𜊆񫛧\u0016󞎬yF+?:\u001cS\u0016\t\u0017򞜽𧸛|\u001b\u00128\u0002cc", + "obj": 26, + "pred": { + "contents": [ + "mh90LeT2FnG9wlz2Yynuig1i04DjltZr9Uv-I9DRDl4=", + [ + [ + { + "contents": "o_cy9d", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "j6q5vf9l8b56b4i", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "h24_d5134thk1", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "j607ksafp4c9_d2fyyg", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "vs3r9in64d4tkwruhvdoiooyyx", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "b03lzybeuf8wh1xjr873qj6wv__2fs", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "shv1t0920rvwyt37_f3sg9fzee", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "wmfeatfkc5pela1mn_of7g_", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "s20b4tpuz8nzj3qok18brhavw4kgnnz", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "i2zsu", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "gtu962ge9wd_lz32ttr", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "z", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "soprc0gz14cnc", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "kv1h", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "ync", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "qokfiml7vha4xy2n85_tq2a0", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "uqge3", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "kxvo5bdj0r", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "r_o3a9gheu0l8fdbyfs1uu1bisqgsf", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "vgee4vkcadaywx0", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "ls743vtmtq2zuddpnpvz2jfs2", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "cbrfd8if_ksc06mbt2xwxxvby", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "rx8jjaodrrmx5xal7", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "ki138rdoq5qzk5qxhwuu7ny6", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "zz4r6zfw9f0phah0sbc7", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "k", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "vp9xp7ycdg6q56t0paliox1k9mju3x7", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "f5dafbchf04kxesf7i4gfcu", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "c1jcbhwlz4nr_i", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ] + ] + ], + "tag": "IncompatibleWithPred" + }, + "timestamp": -8220550, + "visibility": "VCObjectPublic" + } + ], + "seed": 371110647 +} diff --git a/golden/VCObjectHash/VCObjectHash.json b/golden/VCObjectHash/VCObjectHash.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectHash/VCObjectHash.json @@ -0,0 +1,10 @@ +{ + "samples": [ + "uPtsuBPcjkR_shUvEev6ocSUBLNZVsNp_9PLJCzJgqc=", + "Ip2vp362dlwe7MZKiww-YuR69wpJnydHMvUzSzXWkm0=", + "TsRzcSEC9foKGpvJ2zJBSv-qqCv57myRzPfLrNSqAcs=", + "GVJTnA9O35oXWiCLWE2NIEUQ4ZZvZerjLdkolOHbXvg=", + "qWB6-apnFwzMcVvrUQAab-3GsVt77V5yuFj63YwYb0g=" + ], + "seed": -1840898569 +} diff --git a/golden/VCObjectPred/CloneOf.json b/golden/VCObjectPred/CloneOf.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectPred/CloneOf.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "L-hN8xwO0oGh7xyL1OiihPGr40JmDdP_zwvLFdpRPHs=", + "tag": "CloneOf" + }, + { + "contents": "9SNBH19VuBKtjb1Z04Vc88hcaWRbjvxonMTcROaGKxc=", + "tag": "CloneOf" + }, + { + "contents": "47DEQpj8HBSa-_TImW-5JCeuQeRkm5NMpJWZG3hSuFU=", + "tag": "CloneOf" + }, + { + "contents": "yIB4Nb-KHuw6JiCPCu6UHXMp6TNY2H_2E-JtExPjqO0=", + "tag": "CloneOf" + }, + { + "contents": "5TFlbsdVAOWy4WohmFvLrMUaBCRFYNKvS--ndwvo6mE=", + "tag": "CloneOf" + } + ], + "seed": -1893059259 +} diff --git a/golden/VCObjectPred/CloneOfNotFound.json b/golden/VCObjectPred/CloneOfNotFound.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectPred/CloneOfNotFound.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "yDo3R0TmFBZFMVanlJcaB1-3cYA6yzWiFUaBDF6bR8U=", + "tag": "CloneOfNotFound" + }, + { + "contents": "n6cPxioFXqKmhrSqYtWTINYhXiCJBzYqmCi7uZAaVG8=", + "tag": "CloneOfNotFound" + }, + { + "contents": "1B7_xldKqWbXHhUBepquWWyn9hzHQ5J28OkW1h4oJh4=", + "tag": "CloneOfNotFound" + }, + { + "contents": "-3Fi1qb1evpN9VpkwqeT1NAod6QloAZsOEm6RvGR5h4=", + "tag": "CloneOfNotFound" + }, + { + "contents": "EEjv2kymvTvjTAPCNtS3-41QyQXUxm_g7n8UtVa9ubY=", + "tag": "CloneOfNotFound" + } + ], + "seed": 2099502544 +} diff --git a/golden/VCObjectPred/CloneOfRemoved.json b/golden/VCObjectPred/CloneOfRemoved.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectPred/CloneOfRemoved.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "ZnVMwlR4pW70K25gnK6zRK7VLjp6jGd2-6myB2B-Npk=", + "tag": "CloneOfRemoved" + }, + { + "contents": "-KS0TI43OIuIb-Lxj0jH-iDooRkZX1TyfWrfjiFFGFI=", + "tag": "CloneOfRemoved" + }, + { + "contents": "NO2TLVX19kkGKnm_pkpYc6r7JIDpUvVu6tYtxRoVtNo=", + "tag": "CloneOfRemoved" + }, + { + "contents": "mSvNQZDxYEl62b5dWC4boOIAU48CWQnHVgwx26l6EYg=", + "tag": "CloneOfRemoved" + }, + { + "contents": "2RCWj1yC8s0rSf2O-Ub6BC2Zo7tAGYJ1KgQJl1IrvwY=", + "tag": "CloneOfRemoved" + } + ], + "seed": -1285972866 +} diff --git a/golden/VCObjectPred/CompatibleWithPred.json b/golden/VCObjectPred/CompatibleWithPred.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectPred/CompatibleWithPred.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "DSjxrEzE5kfoapYbkMn05oVViIcvRfRNRR3_7b3X7fA=", + "tag": "CompatibleWithPred" + }, + { + "contents": "loTwS9MueNObuFnW6wqG_xnfHPu4mX980JjnVS-WfIE=", + "tag": "CompatibleWithPred" + }, + { + "contents": "3-_bVVkxe45LW2hch0b5NdWKPvdjB28SYejL2zsfeQ0=", + "tag": "CompatibleWithPred" + }, + { + "contents": "WnfCNtHkLEj0awuVSqRQC-2j7SO-KMc9Yj6XmqtOfSE=", + "tag": "CompatibleWithPred" + }, + { + "contents": "OSGo3UUzl3VWcQbTsRZBwyLcF233vUcGM3iY0NmI0Bw=", + "tag": "CompatibleWithPred" + } + ], + "seed": 478349600 +} diff --git a/golden/VCObjectPred/IncompatibleWithPred.json b/golden/VCObjectPred/IncompatibleWithPred.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectPred/IncompatibleWithPred.json @@ -0,0 +1,612 @@ +{ + "samples": [ + { + "contents": [ + "Vemhvr4o5_tIdQRmn9nsZbWycxxp5MOxiAG1uvIce88=", + [ + [ + { + "contents": "ynzwugo1x8z0bh77vgec6v", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "i", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "qylo13x3", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "e7aar74ywzk_ip4z0_", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "l3amv0bey", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "hvvgksh01gnvtcm", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "u3ejf9whme06ip2jrd1x", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "gb51", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "obylfuv6l21yz_", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ] + ] + ], + "tag": "IncompatibleWithPred" + }, + { + "contents": [ + "WW6C0KGnysM7o7q02MOyFI8T3biae61FWXsF2YrJXto=", + [ + [ + { + "contents": "gu15l3c5mpxwg0dxvx9ar1", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "m1acn4t8ai_f", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "jxwbh", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "f4735kinf2o8dk6y43wfftd_x6", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "d0coe0lhajs6ku6pg7ioipwgw1pbbl", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "qm_zjini3sh_u_r5lsmze7_v_x9famz", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "s4uv_jz98516dml0w14apc9kz0jvl", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "pmano", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "j", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "z0wfeqzocd_j2qupnduw3", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "ldir", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "zxc6gxy", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "q27prt_xmy_9frca6jl5iqpz3r1577q", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "j4_kscodauzb3qici4_", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "trbie5dzaet5eghe", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "ajsmq2xtjrlebn_k", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "f1mth0458_2m8rhr02qqmcg", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "k6bb0fim1d5uk19hzlb0knw", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "f3larufgryq_k3dgxtauh9o8l", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "b4iv1lo", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "woz3inbf8b8ofa", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "kk6q1wwvaowbmmjgxwi2_r84fm_hlq", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "i_o", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "krwe4ye7fkfxuxj", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ] + ] + ], + "tag": "IncompatibleWithPred" + }, + { + "contents": [ + "47DEQpj8HBSa-_TImW-5JCeuQeRkm5NMpJWZG3hSuFU=", + [ + [ + { + "contents": "xiq9qfni1kih4p7gdk63q9dh2p", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "me4xlbpjus58uevedn1_", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "ugu", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "kxk_2tnqwq", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "c5ppspj61cn0k_owf_7maysddt7a", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "kmujhubxnueqwbrsdhwt", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "y_4ua7vn0pnp_00hy3z6qkddzv9", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "f7xe157k2gsk8wb", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "cteuwggq11wf4", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "v_mmlbokw75xi6i5f84wpo6yuv7a8u", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "lm6r_qgpk9ihupj5", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "yyrsabghvf2m3", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ] + ] + ], + "tag": "IncompatibleWithPred" + }, + { + "contents": [ + "8k7VxKA_dKiQzRRP3Op4XC1zixh761YS4wSFuc-JpeY=", + [ + [ + { + "contents": "dsh15dem3yb5h0chw94zc6_", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "b35c4_ovosx5_imfjj1s0l_1pia1n47", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "j_t7u32irlwap3", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "nnssk412g14jptj0", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "ejo4icy58nnnut2_c63u193fvxp", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "n1tdq", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "nklpwezk_msuygwrulgywrz", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "izmz", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "ide", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "pwxt", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "tmqi8cf1et70kvkw363e5th3_e", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "s8y_bjvsti55", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "dwx4", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "b", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "sa540wcalqrfejv", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "jyiyqmyb7txn4c", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "q4czdkwfs_wgrv4e36qnk6ld", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "v85311qf8kga5xxfct2", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "tbmvjdemh_0", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "zuw", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "h6h1irqsr9k9xapbz7c0w6h610a2", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "hz3j76zubakxjh7du6", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "h_cp", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ] + ] + ], + "tag": "IncompatibleWithPred" + }, + { + "contents": [ + "KL8oVcslKub759ew8T432jm8OTtSEcaTKby0sTn6Y5s=", + [ + [ + { + "contents": "hkp80nmbmq2dsyssjwu13ovh", + "tag": "FunNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "dj6jhtwi_m8d151crsdz", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "eteifny4se", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "py1pmuf_r8zf", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "c3sck9qnudrph8r9n", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "hc6ppvk08_", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "mve83n20dhd7a", + "tag": "TypeNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "kkgx5n", + "tag": "TypeNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "u0l88lyzz", + "tag": "ModuleNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "gxokjxonxckj077_u5360o", + "tag": "ModuleNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "g43z_", + "tag": "EnumNamespace" + }, + "TypeSignatureChange" + ], + [ + { + "contents": "h4vdq21gzh8gn", + "tag": "EnumNamespace" + }, + "EnumConstructorsChanged" + ], + [ + { + "contents": "u69o99ultq7p55_e", + "tag": "FunNamespace" + }, + "TypeSignatureChange" + ] + ] + ], + "tag": "IncompatibleWithPred" + } + ], + "seed": 493107477 +} diff --git a/golden/VCObjectPred/Init.json b/golden/VCObjectPred/Init.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectPred/Init.json @@ -0,0 +1,20 @@ +{ + "samples": [ + { + "tag": "Init" + }, + { + "tag": "Init" + }, + { + "tag": "Init" + }, + { + "tag": "Init" + }, + { + "tag": "Init" + } + ], + "seed": -2029009563 +} diff --git a/golden/VCObjectPred/MarkedBreakingWithPred.json b/golden/VCObjectPred/MarkedBreakingWithPred.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectPred/MarkedBreakingWithPred.json @@ -0,0 +1,25 @@ +{ + "samples": [ + { + "contents": "tiSafa5wpCshsb6nqaHKPei6yGr58IgPqG6I4LUwd4I=", + "tag": "MarkedBreakingWithPred" + }, + { + "contents": "Qb3kKcZH1GzMvxgqFQGpyqJdiQmNOFSt2lqtlbb-6pY=", + "tag": "MarkedBreakingWithPred" + }, + { + "contents": "FsuhbT7QwRtI5YKeTHw_dhqHH37nQTY6seUcMaa6iR8=", + "tag": "MarkedBreakingWithPred" + }, + { + "contents": "0AavcjK5LE8VP9Qzx78nItgZHLcjdqQm19PVtBCPQVI=", + "tag": "MarkedBreakingWithPred" + }, + { + "contents": "Dj8ZBpzhCXm-gMRQ9CWhESo_5zoDkEhm22eD754R-7A=", + "tag": "MarkedBreakingWithPred" + } + ], + "seed": -1006105665 +} diff --git a/golden/VCObjectVisibility/VCObjectPrivate.json b/golden/VCObjectVisibility/VCObjectPrivate.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectVisibility/VCObjectPrivate.json @@ -0,0 +1,10 @@ +{ + "samples": [ + "VCObjectPrivate", + "VCObjectPrivate", + "VCObjectPrivate", + "VCObjectPrivate", + "VCObjectPrivate" + ], + "seed": 1049274447 +} diff --git a/golden/VCObjectVisibility/VCObjectPublic.json b/golden/VCObjectVisibility/VCObjectPublic.json new file mode 100644 --- /dev/null +++ b/golden/VCObjectVisibility/VCObjectPublic.json @@ -0,0 +1,10 @@ +{ + "samples": [ + "VCObjectPublic", + "VCObjectPublic", + "VCObjectPublic", + "VCObjectPublic", + "VCObjectPublic" + ], + "seed": 514231456 +} diff --git a/inferno-core.cabal b/inferno-core.cabal new file mode 100644 --- /dev/null +++ b/inferno-core.cabal @@ -0,0 +1,118 @@ +cabal-version: 2.4 +name: inferno-core +version: 0.1.0.0 +synopsis: A statically-typed functional scripting language +description: Parser, type inference, and interpreter for a statically-typed functional scripting language +category: DSL,Scripting +homepage: https://github.com/plow-technologies/inferno.git#readme +bug-reports: https://github.com/plow-technologies/inferno.git/issues +copyright: Plow-Technologies LLC +license: MIT +license-file: LICENSE +author: Sam Balco +maintainer: info@plowtech.net +build-type: Simple +extra-source-files: + CHANGELOG.md + golden/**/*.json + +source-repository head + type: git + location: https://github.com/plow-technologies/inferno.git + +library + exposed-modules: + Inferno.Eval + , Inferno.Eval.Error + , Inferno.Infer + , Inferno.Infer.Env + , Inferno.Infer.Exhaustiveness + , Inferno.Infer.Pinned + , Inferno.Module + , Inferno.Module.Cast + , Inferno.Module.Builtin + , Inferno.Module.Prelude + , Inferno.Parse + , Inferno.Parse.Commented + , Inferno.Parse.Error + , Inferno.Utils.QQ.Script + , Inferno.Utils.QQ.Module + other-modules: + Inferno.Infer.Error + , Inferno.Module.Prelude.Defs + , Inferno.Utils.QQ.Common + hs-source-dirs: + src + ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + build-depends: + base >= 4.13 && < 4.17 + , bimap >= 0.5.0 && < 0.6 + , bytestring >= 0.10.10 && < 0.12 + , containers >= 0.6.2 && < 0.7 + , cryptonite >= 0.30 && < 0.31 + , exceptions >= 0.10.4 && < 0.11 + , generic-lens >= 2.2.1 && < 2.3 + , inferno-types >= 0.1.0 && < 0.2 + , megaparsec >= 9.2.1 && < 9.3 + , memory >= 0.18.0 && < 0.19 + , mtl >= 2.2.2 && < 2.3 + , parser-combinators >= 1.3.0 && < 1.4 + , picosat >= 0.1.6 && < 0.2 + , prettyprinter >= 1.7.1 && < 1.8 + , recursion-schemes >= 5.2.2 && < 5.3 + , syb >= 0.7.2 && < 0.8 + , template-haskell >= 2.15 && < 2.19 + , text >= 2.0.1 && < 2.1 + , time >= 1.9.3 && < 1.12 + + default-language: Haskell2010 + default-extensions: + DeriveDataTypeable + , DeriveFunctor + , DeriveGeneric + , FlexibleContexts + , FlexibleInstances + , LambdaCase + , MultiParamTypeClasses + , OverloadedStrings + , TupleSections + , RecordWildCards + +test-suite inferno-tests + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: + Eval.Spec + , Golden.Spec + , Infer.Spec + , Parse.Spec + , Utils + build-depends: + base >=4.7 && <5 + , containers + , exceptions + , hspec + , hspec-golden-aeson + , inferno-core + , inferno-types + , inferno-vc + , megaparsec + , mtl + , prettyprinter + , pretty-simple + , QuickCheck + , recursion-schemes + , text + default-language: Haskell2010 + default-extensions: + DeriveDataTypeable + , DeriveFunctor + , DeriveGeneric + , FlexibleContexts + , FlexibleInstances + , LambdaCase + , OverloadedStrings + , TupleSections + , RecordWildCards + ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates diff --git a/src/Inferno/Eval.hs b/src/Inferno/Eval.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Eval.hs @@ -0,0 +1,288 @@ +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Inferno.Eval where + +-- import Control.Monad (foldM, when) +import Control.Monad.Catch (MonadCatch, SomeException, try) +import Control.Monad.Except + ( Except, + ExceptT, + MonadError (throwError), + forM, + runExcept, + runExceptT, + ) +import Control.Monad.Identity (Identity) +import Control.Monad.Reader (ask, local) +import Data.Foldable (foldrM) +import Data.List.NonEmpty (NonEmpty (..), toList) +import qualified Data.Map as Map +import Data.Maybe (catMaybes) +import qualified Data.Text as Text +import Inferno.Eval.Error + ( EvalError (AssertionFailed, RuntimeError), + ) +import Inferno.Module.Builtin (enumBoolHash) +import Inferno.Types.Syntax + ( BaseType (..), + Expr (..), + ExtIdent (..), + Ident (..), + ImplExpl (..), + InfernoType (TBase), + Lit (LDouble, LHex, LInt, LText), + Pat (..), + tListToList, + toEitherList, + ) +import Inferno.Types.Value + ( ImplEnvM, + Value + ( VArray, + VDouble, + VEmpty, + VEnum, + VFun, + VInt, + VOne, + VText, + VTuple, + VTypeRep, + VWord64 + ), + runImplEnvM, + ) +import Inferno.Types.VersionControl (VCObjectHash) +import Inferno.Utils.Prettyprinter (renderPretty) +import Prettyprinter + ( LayoutOptions (LayoutOptions), + PageWidth (Unbounded), + Pretty (pretty), + layoutPretty, + ) +import Prettyprinter.Render.Text (renderStrict) + +type TermEnv hash c m = (Map.Map ExtIdent (Value c m), Map.Map hash (Value c m)) + +type Interpreter t = Except EvalError t + +emptyTmenv :: TermEnv hash c m +emptyTmenv = (Map.empty, Map.empty) + +eval :: (MonadError EvalError m, MonadError EvalError (ImplEnvM m c), Pretty c) => TermEnv VCObjectHash c (ImplEnvM m c) -> Expr (Maybe VCObjectHash) a -> ImplEnvM m c (Value c (ImplEnvM m c)) +eval env@(localEnv, pinnedEnv) expr = case expr of + Lit_ (LInt k) -> return $ + VFun $ \case + VTypeRep (TBase TInt) -> return $ VInt k + VTypeRep (TBase TDouble) -> return $ VDouble $ fromIntegral k + _ -> throwError $ RuntimeError "Invalid runtime rep for numeric constant." + Lit_ (LDouble k) -> return $ VDouble k + Lit_ (LHex w) -> return $ VWord64 w + Lit_ (LText t) -> return $ VText t + InterpolatedString_ es -> do + res <- forM (toEitherList es) $ either (return . VText) (\(_, e, _) -> eval env e) + return $ VText $ Text.concat $ map toText res + where + toText (VText t) = t + toText e = renderStrict $ layoutPretty (LayoutOptions Unbounded) $ pretty e + Array_ es -> + foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] es >>= return . VArray + ArrayComp_ e srcs mCond -> do + vals <- sequence' env srcs + VArray <$> case mCond of + Nothing -> + forM vals $ \vs -> + let nenv = foldr (uncurry Map.insert) localEnv vs in eval (nenv, pinnedEnv) e + Just (_, cond) -> + catMaybes + <$> ( forM vals $ \vs -> do + let nenv = foldr (uncurry Map.insert) localEnv vs + eval (nenv, pinnedEnv) cond >>= \case + VEnum hash "true" -> + if hash == enumBoolHash + then Just <$> (eval (nenv, pinnedEnv) e) + else throwError $ RuntimeError "failed to match with a bool" + VEnum hash "false" -> + if hash == enumBoolHash + then return Nothing + else throwError $ RuntimeError "failed to match with a bool" + _ -> throwError $ RuntimeError "failed to match with a bool" + ) + where + sequence' :: (MonadError EvalError m, Pretty c) => TermEnv VCObjectHash c (ImplEnvM m c) -> NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a) -> ImplEnvM m c [[(ExtIdent, Value c (ImplEnvM m c))]] + sequence' env'@(localEnv', pinnedEnv') = \case + (_, Ident x, _, e_s, _) :| [] -> do + eval env' e_s >>= \case + VArray vals -> return $ map ((: []) . (ExtIdent $ Right x,)) vals + _ -> throwError $ RuntimeError "failed to match with an array" + (_, Ident x, _, e_s, _) :| (r : rs) -> do + eval env' e_s >>= \case + VArray vals -> + concat + <$> ( forM vals $ \v -> do + res <- sequence' (Map.insert (ExtIdent $ Right x) v localEnv', pinnedEnv') (r :| rs) + return $ map ((ExtIdent $ Right x, v) :) res + ) + _ -> throwError $ RuntimeError "failed to match with an array" + Enum_ (Just hash) _ i -> return $ VEnum hash i + Enum_ Nothing _ _ -> throwError $ RuntimeError "All enums must be pinned" + Var_ (Just hash) _ x -> + case Map.lookup hash pinnedEnv of + Just v -> return v + Nothing -> throwError $ RuntimeError $ show x <> "(" <> show hash <> ") not found in the pinned env" + Var_ Nothing _ (Expl x) -> do + case Map.lookup x localEnv of + Just v -> return v + Nothing -> throwError $ RuntimeError $ show x <> " not found in the unpinned env" + Var_ Nothing _ (Impl x) -> do + implEnv <- ask + case Map.lookup x implEnv of + Just v -> return v + Nothing -> throwError $ RuntimeError $ show x <> " not found in the implicit env" + OpVar_ (Just hash) _ x -> + case Map.lookup hash pinnedEnv of + Just v -> return v + Nothing -> throwError $ RuntimeError $ show x <> "(" <> show hash <> ") not found in the pinned env" + OpVar_ Nothing _ (Ident x) -> do + case Map.lookup (ExtIdent $ Right x) localEnv of + Just v -> return v + Nothing -> throwError $ RuntimeError $ show x <> " not found in env" + TypeRep_ t -> pure $ VTypeRep t + Op_ _ Nothing _ op _ -> throwError $ RuntimeError $ show op <> " should be pinned" + Op_ a (Just hash) _ns op b -> do + a' <- eval env a + b' <- eval env b + case Map.lookup hash pinnedEnv of + Nothing -> throwError $ RuntimeError $ show op <> "(" <> show hash <> ") not found in the pinned env" + Just (VFun f) -> + f a' >>= \case + VFun f' -> f' b' + _ -> throwError $ RuntimeError $ show op <> " not bound to a binary function in env" + Just _ -> throwError $ RuntimeError $ show op <> " not bound to a function in env" + PreOp_ Nothing _ op _ -> throwError $ RuntimeError $ show op <> " should be pinned" + PreOp_ (Just hash) _ns op a -> do + a' <- eval env a + case Map.lookup hash pinnedEnv of + Nothing -> throwError $ RuntimeError $ show op <> "(" <> show hash <> ") not found in the pinned env" + Just (VFun f) -> f a' + Just _ -> throwError $ RuntimeError $ show op <> " not bound to a function in env" + Lam_ args body -> go localEnv $ toList args + where + go nenv = \case + [] -> eval (nenv, pinnedEnv) body + (_, Just x) : xs -> + return $ VFun $ \arg -> go (Map.insert x arg nenv) xs + (_, Nothing) : xs -> return $ VFun $ \_arg -> go nenv xs + App_ fun arg -> do + eval env fun >>= \case + VFun f -> do + argv <- eval env arg + f argv + _ -> throwError $ RuntimeError "failed to match with a function" + Let_ (Expl x) e body -> do + e' <- eval env e + let nenv = Map.insert x e' localEnv + eval (nenv, pinnedEnv) body + Let_ (Impl x) e body -> do + e' <- eval env e + local (\impEnv -> Map.insert x e' impEnv) $ eval env body + If_ cond tr fl -> + eval env cond >>= \case + VEnum hash "true" -> + if hash == enumBoolHash + then eval env tr + else throwError $ RuntimeError "failed to match with a bool" + VEnum hash "false" -> + if hash == enumBoolHash + then eval env fl + else throwError $ RuntimeError "failed to match with a bool" + _ -> throwError $ RuntimeError "failed to match with a bool" + Tuple_ es -> + foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] (tListToList es) >>= return . VTuple + One_ e -> eval env e >>= return . VOne + Empty_ -> return $ VEmpty + Assert_ cond e -> + eval env cond >>= \case + VEnum hash "false" -> + if hash == enumBoolHash + then throwError AssertionFailed + else throwError $ RuntimeError "failed to match with a bool" + VEnum hash "true" -> + if hash == enumBoolHash + then eval env e + else throwError $ RuntimeError "failed to match with a bool" + _ -> throwError $ RuntimeError "failed to match with a bool" + Case_ e pats -> do + v <- eval env e + matchAny v pats + where + matchAny v ((_, p, _, body) :| []) = case match v p of + Just nenv -> eval nenv body + Nothing -> throwError $ RuntimeError $ "non-exhaustive patterns in case detected in " <> (Text.unpack $ renderPretty v) + matchAny v ((_, p, _, body) :| (r : rs)) = case match v p of + Just nenv -> eval nenv body + Nothing -> matchAny v (r :| rs) + + match v p = case (v, p) of + (_, PVar _ (Just (Ident x))) -> Just $ (Map.insert (ExtIdent $ Right x) v localEnv, pinnedEnv) + (_, PVar _ Nothing) -> Just env + (VEnum h1 _, PEnum _ (Just h2) _ _) -> + if h1 == h2 + then Just env + else Nothing + (VInt i1, PLit _ (LInt i2)) -> + if i1 == i2 + then Just env + else Nothing + (VDouble d1, PLit _ (LDouble d2)) -> + if d1 == d2 + then Just env + else Nothing + (VText t1, PLit _ (LText t2)) -> + if t1 == t2 + then Just env + else Nothing + (VWord64 h1, PLit _ (LHex h2)) -> + if h1 == h2 + then Just env + else Nothing + (VOne v', POne _ p') -> match v' p' + (VEmpty, PEmpty _) -> Just env + (VTuple vs, PTuple _ ps _) -> matchTuple vs $ tListToList ps + _ -> Nothing + + matchTuple [] [] = Just env + matchTuple (v' : vs) ((p', _) : ps) = do + env1 <- match v' p' + env2 <- matchTuple vs ps + -- since variables in patterns must be linear, + -- env1 and env2 should not overlap + return $ env1 <> env2 + matchTuple _ _ = Nothing + CommentAbove _ e -> eval env e + CommentAfter e _ -> eval env e + CommentBelow e _ -> eval env e + Bracketed_ e -> eval env e + RenameModule_ _ _ e -> eval env e + OpenModule_ _ _ e -> eval env e + +runEvalIO :: + (MonadCatch m, Pretty c) => + ImplEnvM (ExceptT EvalError m) c (TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError m) c)) -> + Map.Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError m) c)) -> + Expr (Maybe VCObjectHash) a -> + m (Either EvalError (Value c (ImplEnvM (ExceptT EvalError m) c))) +runEvalIO env implicitEnv ex = do + input <- try $ runExceptT $ runImplEnvM implicitEnv $ (env >>= \env' -> eval env' ex) + return $ case input of + Left (e :: SomeException) -> Left $ RuntimeError $ show e + Right res -> res + +pureEval :: + (Pretty c) => + TermEnv VCObjectHash c (ImplEnvM (ExceptT EvalError Identity) c) -> + Map.Map ExtIdent (Value c (ImplEnvM (ExceptT EvalError Identity) c)) -> + Expr (Maybe VCObjectHash) a -> + Either EvalError (Value c (ImplEnvM (ExceptT EvalError Identity) c)) +pureEval env implicitEnv ex = runExcept $ runImplEnvM implicitEnv $ eval env ex diff --git a/src/Inferno/Eval/Error.hs b/src/Inferno/Eval/Error.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Eval/Error.hs @@ -0,0 +1,10 @@ +module Inferno.Eval.Error where + +import Inferno.Types.Syntax (ExtIdent) + +data EvalError + = AssertionFailed + | RuntimeError String + | CastError String + | NotFoundInImplicitEnv ExtIdent + deriving (Show, Eq) diff --git a/src/Inferno/Infer.hs b/src/Inferno/Infer.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Infer.hs @@ -0,0 +1,1428 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Inferno.Infer + ( Constraint, + TypeError (..), + Subst (..), + inferExpr, + closeOver, + closeOverType, + findTypeClassWitnesses, + inferTypeReps, + inferPossibleTypes, + ) +where + +import Control.Monad (when) +import Control.Monad.Except + ( Except, + ExceptT, + MonadError (catchError, throwError), + foldM, + forM, + forM_, + runExcept, + runExceptT, + ) +import Control.Monad.Identity (Identity (runIdentity)) +import Control.Monad.Reader + ( MonadReader (ask, local), + ReaderT (ReaderT, runReaderT), + ) +import Control.Monad.State + ( MonadState (get, put, state), + StateT (StateT, runStateT), + evalStateT, + execState, + modify, + ) +import Data.Bifunctor (bimap) +import qualified Data.Bimap as Bimap +import Data.Either (partitionEithers, rights) +import Data.Generics.Product (HasType, getTyped, setTyped) +import Data.List (find, unzip4) -- intercalate +import qualified Data.List.NonEmpty as NEList +import qualified Data.Map as Map +import qualified Data.Map.Merge.Lazy as Map +import Data.Maybe (catMaybes, fromJust) +import qualified Data.Set as Set +import qualified Data.Text as Text +import Debug.Trace (trace) +import Inferno.Infer.Env (Env (..), TypeMetadata (..), closeOver, closeOverType) +import qualified Inferno.Infer.Env as Env +import Inferno.Infer.Error (TypeError (..), getLocFromErrs, getTypeClassFromErrs) +import Inferno.Infer.Exhaustiveness + ( Pattern (..), + cEmpty, + cEnum, + cInf, + cOne, + cTuple, + checkUsefullness, + exhaustive, + mkEnumText, + ) +import Inferno.Module.Builtin (builtinModule, emptyHash, oneHash) +import Inferno.Types.Module (Module (..), PinnedModule, pinnedModuleHashToTy) +import Inferno.Types.Syntax + ( BlockUtils (blockPosition, removeComments), + ElementPosition (elementPosition), + Expr (..), + ExtIdent (..), + Ident (..), + ImplExpl (Expl, Impl), + Lit (LDouble, LHex, LInt, LText), + ModuleName (..), + Pat (..), + Scoped (..), + fromEitherList, + fromScoped, + incSourceCol, + patternToExpr, + substInternalIdents, + tListFromList, + tListToList, + toEitherList, + ) +import Inferno.Types.Type + ( BaseType (TEnum), + ImplType (..), + InfernoType (..), + Subst (..), + Substitutable (..), + TCScheme (..), + TV, + TypeClass (TypeClass), + typeBool, + typeDouble, + typeInt, + typeText, + typeWord64, + var, + (.->), + ) +import Inferno.Types.VersionControl (Pinned (..), VCObjectHash, pinnedToMaybe, vcHash) +-- import Inferno.Utils.Prettyprinter (renderPretty) +-- import Prettyprinter (pretty) +import qualified Picosat +import System.IO.Unsafe (unsafePerformIO) +import Text.Megaparsec (SourcePos (..), initialPos) + +------------------------------------------------------------------------------- +-- Classes +------------------------------------------------------------------------------- + +-- | Inference monad +type Infer a = + ( ReaderT + Env -- Typing environment + ( StateT -- Inference state + InferState + ( Except -- Inference errors + [TypeError SourcePos] + ) + ) + a -- Result + ) + +-- | Inference state +data InferState = InferState + { count :: Int, + typeMap :: Map.Map (Location SourcePos) (TypeMetadata (Set.Set TypeClass, ImplType)), + modules :: Map.Map ModuleName (Module ()), + typeClasses :: Set.Set TypeClass, + patternsToCheck :: [(Location SourcePos, [Pat (Pinned VCObjectHash) SourcePos])] + } + +-- | Initial inference state +initInfer :: InferState +initInfer = InferState {count = 0, typeMap = Map.empty, modules = Map.empty, typeClasses = Set.empty, patternsToCheck = []} + +type Constraint = Either (InfernoType, InfernoType, [TypeError SourcePos]) (Location SourcePos, TypeClass) + +type Unifier = (Subst, [Constraint]) + +-- | Constraint solver monad +type Solve a = ReaderT (Set.Set TypeClass) (ExceptT [TypeError SourcePos] Identity) a + +type SolveState st a = ReaderT (Set.Set TypeClass) (StateT st (ExceptT [TypeError SourcePos] Identity)) a + +type Location a = (a, a) + +instance Substitutable Constraint where + apply s (Left (t1, t2, es)) = Left (apply s t1, apply s t2, es) + apply s (Right (loc, tc)) = Right (loc, apply s tc) + ftv (Left (t1, t2, _)) = ftv t1 `Set.union` ftv t2 + ftv (Right (_, tc)) = ftv tc + +------------------------------------------------------------------------------- +-- Inference +------------------------------------------------------------------------------- + +filterInstantiatedTypeClasses :: Set.Set TypeClass -> Set.Set TypeClass +filterInstantiatedTypeClasses = Set.filter $ not . Set.null . ftv + +mkPattern :: Pat (Pinned VCObjectHash) a -> Pattern +mkPattern = \case + PVar _ _ -> W + PEnum _ Local _ns _ident -> error $ "internal error. cannot convert unpinned enum into a pattern" + PEnum _ hash _ns ident@(Ident i) -> cEnum (vcHash (ident, fromJust $ pinnedToMaybe hash)) i + PLit _ l -> case l of + LInt v -> cInf v + LDouble v -> cInf v + LHex v -> cInf v + LText v -> cInf $ mkEnumText v + POne _ p -> cOne $ mkPattern p + PEmpty _ -> cEmpty + PTuple _ ps _ -> cTuple $ map (mkPattern . fst) $ tListToList ps + PCommentAbove _ p -> mkPattern p + PCommentAfter p _ -> mkPattern p + PCommentBelow p _ -> mkPattern p + +checkExhaustivenessAndUsefullness :: Map.Map VCObjectHash (Set.Set (VCObjectHash, Text.Text)) -> Location SourcePos -> [Pat (Pinned VCObjectHash) SourcePos] -> [TypeError SourcePos] +checkExhaustivenessAndUsefullness enum_sigs loc patts = + let patternsOfPatts = map ((: []) . mkPattern) patts + in case exhaustive enum_sigs patternsOfPatts of + Just ps -> [NonExhaustivePatternMatch p loc | p <- ps] + Nothing -> + let uErrs = checkUsefullness enum_sigs patternsOfPatts + in map + ( \(i, j) -> + let loc' = blockPosition $ patts !! i + in let pat = patts !! j + in if i == j then UselessPattern Nothing loc' else UselessPattern (Just pat) loc' + ) + uErrs + +-- | Run the inference monad +runInfer :: Env -> Set.Set TypeClass -> Map.Map ModuleName (Module m) -> Infer r -> Either [TypeError SourcePos] (r, InferState) +runInfer env allClasses allModules m = + runExcept $ + runStateT + (runReaderT m env) + initInfer + { modules = Map.map (\m' -> m' {moduleObjects = ()}) allModules, + typeClasses = allClasses + } + +-- Given a map of implicit types containing `rep of ` variables, and an expression `e` +-- we want to either substitute any implicit variable `?var$n : rep of ` with a `RuntimeRep `, +-- provided that `` contains no free variables +-- otherwise we want to create a closure `fun var$n -> e[var$n/?var$n]` +closeOverTypeReps :: Map.Map ExtIdent InfernoType -> Expr (Pinned VCObjectHash) SourcePos -> (Maybe TypeClass, Map.Map ExtIdent InfernoType, Expr (Pinned VCObjectHash) SourcePos) +closeOverTypeReps implTys expr = + let (tReps, rest) = flip Map.partition implTys $ \case + TRep _ -> True + _ -> False + in if Map.null tReps + then (Nothing, implTys, expr) + else + let -- we partition the types to those that have been fully inferred and ones where we are lacking the type-rep information + (fullyInstantiated, withTypeHole) = Map.partition (Set.null . ftv) tReps + -- next, we create a Map Int (Either Int InfernoType) where all the fully instantiated `TRep ty`s get mapped to a `Right ty` + fullyInstantiatedMap = + Map.foldrWithKey + ( \k v m -> case (k, v) of + (ExtIdent (Left i), TRep ty) -> Map.insert i (Right ty) m + _ -> m + ) + mempty + fullyInstantiated + + -- we group all the types with holes + withTypeHoleGrouped = NEList.groupBy (\(_, ty1) (_, ty2) -> ty1 == ty2) $ Map.toList withTypeHole + -- each [(var$i_1, _),...,(var$i_n, _)] gets turned into the map {i_1 -> Left i_1, ... i_n -> Left i_1} + substMap = + foldr + ( \vs m -> case NEList.head vs of + (ExtIdent (Left i), _) -> + foldr + ( \(v, _) m' -> case v of + ExtIdent (Left j) -> Map.insert j (Left i) m' + _ -> m' + ) + m + vs + _ -> m + ) + fullyInstantiatedMap + withTypeHoleGrouped + + (pos, _) = blockPosition expr + expr' = substInternalIdents substMap expr + in case Map.toList withTypeHole of + [] -> (Nothing, rest, expr') + -- if we have any type holes, we need to wrap the expression in a lambda and add a `requires rep on ...` typeclass + -- capturing all the runtime reps that the expression needs + _ : _ -> + let lamList = fmap (\merged -> let (v, _) = NEList.head merged in (pos, Just v)) $ NEList.fromList $ withTypeHoleGrouped + in ( Just $ + TypeClass "rep" $ + map + ( \((_, ty) NEList.:| _) -> case ty of + TRep ty' -> ty' + _ -> ty + ) + withTypeHoleGrouped, + rest, + Lam pos lamList pos expr' + ) + +-- | Solve for the top level type of an expression in a given environment +inferExpr :: + Map.Map ModuleName (PinnedModule m) -> + Expr (Pinned VCObjectHash) SourcePos -> + Either + [TypeError SourcePos] + ( Expr (Pinned VCObjectHash) SourcePos, + TCScheme, + Map.Map (Location SourcePos) (TypeMetadata TCScheme) + ) +inferExpr allModules expr = + let (env, inScopeClasses) = openBuiltinModuleAndAddPinnedTypes allModules + in case runInfer env inScopeClasses allModules (infer expr) of + -- if we threw errors whilst inferring, rethrow + Left err -> Left err + Right ((expr', ty, cs), InferState {..}) -> + -- trace ("new expr: " <> (Text.unpack . renderPretty) expr') $ + -- trace + -- ( "ty: " <> (Text.unpack . renderPretty) ty + -- <> "\ncs: " + -- <> (intercalate "\n" $ map show $ Set.toList cs) + -- ) + -- $ + -- case runSolve typeClasses $ filter (\case { Right (_, TypeClass "rep" _) -> False; _ -> True }) $ Set.toList cs of + case runSolve typeClasses $ Set.toList cs of + Left errs -> Left errs + Right subst -> + -- trace ("substs: " <> show subst) $ + -- trace ("patternsToCheck: " <> show patternsToCheck) $ + case concatMap (uncurry $ checkExhaustivenessAndUsefullness enumSigs) patternsToCheck of + errs@(_ : _) -> Left errs + _ -> do + -- get type classes and type from solved constraints + let cls = filterInstantiatedTypeClasses $ Set.map (apply subst . snd) $ Set.fromList $ rights $ Set.toList cs + let substitutedTy@(ImplType implTys tyBody) = apply subst ty + -- get current type variables + let tvs = ftv substitutedTy `Set.union` (Set.unions $ Set.elems $ Set.map ftv cls) + let res substNew (mRepTyCls, implTys', expr'') = + let finalTy = + closeOver + ((filterInstantiatedTypeClasses $ Set.map (apply substNew) cls) `Set.union` (maybe mempty Set.singleton mRepTyCls)) + $ apply substNew + $ ImplType implTys' tyBody + in Right $ + ( expr'', + finalTy, + Map.map + (\meta@TypeMetadata {ty = (tcs, t)} -> meta {ty = closeOver (filterInstantiatedTypeClasses $ Set.map (apply $ substNew <> subst) tcs) $ apply (substNew <> subst) t}) + typeMap + ) + + if -- trace ("type classes: " <> show cls) $ + Set.null cls + then res mempty $ closeOverTypeReps implTys expr' + else case findTypeClassWitnesses typeClasses (Just 2) cls tvs of + [] -> Left [CouldNotFindTypeclassWitness cls $ blockPosition expr] + -- we attempt to find two type assignments. If there is only one satisfying assignment for all the type-classes, we automatically substitute the instantiations + [subst'] -> res subst' $ closeOverTypeReps (Map.map (apply subst') implTys) expr' + -- even if there isn't a unique solution, we can still safely apply the substitutions to any types which do not transitively depend on the input or output type variables + -- e.g. for `let x = 3.2 in x + 2` it does not matter whether the type of `2` is an int or a double, because the final type of the whole expression won't change + (Subst s) : _ -> + let ftvsDependentOnOuterType = + Set.foldl + ( \ftvsTransClosure c -> + let ftvCls = ftv c + in if Set.null $ ftvCls `Set.intersection` ftvsTransClosure + then ftvsTransClosure + else ftvCls `Set.union` ftvsTransClosure + ) + -- start with the body of the type, i.e. in `forall a_1 ... a_n {requires ..., implicit ...} => t` get the type variables in `t` + -- as well as any implicit arguments which aren't internal, since those are used for tracking type-reps + (ftv tyBody `Set.union` (Map.foldrWithKey (\(ExtIdent ident) t ftvs -> case ident of Left _ -> ftvs; Right _ -> ftv t `Set.union` ftvs) mempty implTys)) + cls + subst' = Subst $ Set.foldr Map.delete s ftvsDependentOnOuterType + in -- trace ("type ftvsDependentOnOuterType: " <> show ftvsDependentOnOuterType) $ + res subst' $ closeOverTypeReps (Map.map (apply subst') implTys) expr' + where + enumSigs :: Map.Map VCObjectHash (Set.Set (VCObjectHash, Text.Text)) + enumSigs = + Map.foldrWithKey + ( \h (ForallTC _ _ (ImplType _ ty)) m -> case ty of + TBase (TEnum _n cs) -> + let allConstrHashes = Set.map (\c@(Ident i) -> (vcHash (c, h), i)) cs + in Map.fromList [(cH, allConstrHashes) | (cH, _) <- Set.toList allConstrHashes] `Map.union` m + _ -> m + ) + mempty + $ Map.map ty + $ Map.unions + $ pinnedModuleHashToTy builtinModule : (map pinnedModuleHashToTy $ Map.elems allModules) + openBuiltinModuleAndAddPinnedTypes :: Map.Map ModuleName (PinnedModule m) -> (Env, Set.Set TypeClass) + openBuiltinModuleAndAddPinnedTypes modules = + let Module {moduleTypeClasses = tyCls, moduleObjects = (_, tys, _)} = builtinModule + in ( Env.empty + { Env.pinnedTypes = Map.unions $ tys : [pinnedModuleHashToTy m | m <- Map.elems modules] + }, + tyCls `Set.union` Set.unions [tc | Module {moduleTypeClasses = tc} <- Map.elems modules] + ) + +-- | Given a type signature and some concrete assignment of types (assumes inputTys and outputTy have no free variables) +-- | this function computes the runtime reps +inferTypeReps :: Set.Set TypeClass -> TCScheme -> [InfernoType] -> InfernoType -> Either [TypeError SourcePos] [InfernoType] +inferTypeReps allTypeClasses (ForallTC tvs tyCls (ImplType _impl ty)) inputTys outputTy = + let cs = + [Right (dummyPos, c) | c@(TypeClass nm _) <- Set.toList tyCls, nm /= "rep"] + ++ mkConstraints ty inputTys + in case runSolve allTypeClasses cs of + Left errs -> Left errs + Right subst -> + let tyClsSubst = Set.map (apply subst) tyCls + in case find (\(TypeClass nm _) -> nm == "rep") $ Set.toList tyClsSubst of + Nothing -> pure [] + Just rep@(TypeClass _ runtimeRepTys) -> + if Set.null $ ftv rep + then pure runtimeRepTys + else case findTypeClassWitnesses + allTypeClasses + (Just 1) + (Set.filter (\case TypeClass "rep" _ -> False; _ -> True) tyClsSubst) + (Set.fromList tvs) of + [] -> Left [CouldNotFindTypeclassWitness tyClsSubst dummyPos] + subst' : _ -> pure $ apply subst' runtimeRepTys + where + mkConstraints (TArr t1 t2) (x : xs) = Left (t1, x, []) : mkConstraints t2 xs + mkConstraints t [] = [Left (t, outputTy, [])] + mkConstraints _ _ = error "mkConstraints: invalid input params length" + + dummyPos = let pos = initialPos "" in (pos, pos) + +inferPossibleTypes :: Set.Set TypeClass -> TCScheme -> [Maybe InfernoType] -> Maybe InfernoType -> Either [TypeError SourcePos] ([[InfernoType]], [InfernoType]) +inferPossibleTypes allTypeClasses (ForallTC _ tyCls (ImplType _impl ty)) inputTys outputTy = + let cs = + [Right (dummyPos, c) | c@(TypeClass nm _) <- Set.toList tyCls, nm /= "rep"] + ++ mkMaybeConstraints ty inputTys + in case runSolve allTypeClasses cs of + Left errs -> Left errs + Right subst -> do + let tyClsSubst = Set.map (apply subst) $ Set.filter (\case TypeClass "rep" _ -> False; _ -> True) tyCls + let (inTysFromSig, outTyFromSig) = gatherArgs $ apply subst ty + let findAllPossibleTypes (supplied, t) = case supplied of + Just t' -> pure [t'] + Nothing -> + let tvs = ftv t + in if Set.null tvs + then pure [t] + else case findTypeClassWitnesses allTypeClasses (Just 100) tyClsSubst tvs of + [] -> Left [CouldNotFindTypeclassWitness tyClsSubst dummyPos] + substs -> pure [apply sub t | sub <- substs] + + possibleInTysFromSig <- forM (zip inputTys inTysFromSig) findAllPossibleTypes + (possibleInTysFromSig,) <$> findAllPossibleTypes (outputTy, outTyFromSig) + where + gatherArgs (TArr t1 t2) = bimap (t1 :) id $ gatherArgs t2 + gatherArgs x = ([], x) + mkMaybeConstraints (TArr t1 t2) (Just x : xs) = Left (t1, x, []) : mkMaybeConstraints t2 xs + mkMaybeConstraints (TArr _ t2) (Nothing : xs) = mkMaybeConstraints t2 xs + mkMaybeConstraints t [] = case outputTy of + Just t' -> [Left (t, t', [])] + Nothing -> [] + mkMaybeConstraints _ _ = error "mkConstraints: invalid input params length" + + dummyPos = let pos = initialPos "" in (pos, pos) + +-- | Extend type environment +inEnv :: (ExtIdent, TypeMetadata TCScheme) -> Infer a -> Infer a +inEnv (x, meta) m = do + let scope e = (Env.remove e x) `Env.extend` (x, meta) + local scope m + +-- | Lookup type in the environment +lookupEnv :: Location SourcePos -> Either VCObjectHash ExtIdent -> Infer (TypeMetadata (Set.Set TypeClass, ImplType)) +lookupEnv loc x = do + env <- ask + case either (flip Env.lookupPinned env) (flip Env.lookup env) x of + Nothing -> + throwError + [ either + (\hsh -> UnboundNameInNamespace LocalScope (Left hsh) loc) + (\i -> UnboundExtIdent LocalScope i loc) + x + ] + Just meta -> do + iTy <- instantiate $ ty meta + return meta {ty = iTy} + +mergeImplicitMaps :: Location SourcePos -> [Map.Map ExtIdent InfernoType] -> (Map.Map ExtIdent InfernoType, [Constraint]) +mergeImplicitMaps loc = + foldr + ( \m (mAll, cs) -> + let cs' = Map.elems $ Map.intersectionWithKey (\ident t1 t2 -> tyConstr t1 t2 [ImplicitVarTypeOverlap mempty ident t1 t2 loc]) mAll m + in (mAll `Map.union` m, cs' ++ cs) + ) + (Map.empty, []) + +fresh :: Infer InfernoType +fresh = do + s@InferState {..} <- get + put s {count = count + 1} + return $ var count + +freshRaw :: Infer Int +freshRaw = do + s@InferState {..} <- get + put s {count = count + 1} + return count + +attachTypeToPosition :: Location SourcePos -> TypeMetadata (Set.Set TypeClass, ImplType) -> Infer () +attachTypeToPosition k meta = + modify (\s -> s {typeMap = Map.insert k meta $ typeMap s}) + +addCasePatterns :: Location SourcePos -> [Pat (Pinned VCObjectHash) SourcePos] -> Infer () +addCasePatterns k pttrns = + modify + ( \s -> + s + { patternsToCheck = (k, pttrns) : patternsToCheck s + } + ) + +instantiate :: TCScheme -> Infer (Set.Set TypeClass, ImplType) +instantiate (ForallTC as tcs t) = do + as' <- mapM (const fresh) as + let s = Subst $ Map.fromList $ zip as as' + return $ (Set.map (apply s) tcs, apply s t) + +opGetTyComponents :: ImplType -> (InfernoType, InfernoType, InfernoType) +opGetTyComponents (ImplType _ (t1 `TArr` (t2 `TArr` t3))) = (t1, t2, t3) +opGetTyComponents _ = error "Invalid op type signature" + +preOpGetTyComponents :: ImplType -> (InfernoType, InfernoType) +preOpGetTyComponents (ImplType _ (t1 `TArr` t2)) = (t1, t2) +preOpGetTyComponents _ = error "Invalid pre-op type signature" + +tyConstr :: a -> b -> c -> Either (a, b, c) d +tyConstr t1 t2 es = Left (t1, t2, es) + +inferLit :: Expr (Pinned VCObjectHash) SourcePos -> Location SourcePos -> Lit -> InfernoType -> Infer (Expr (Pinned VCObjectHash) SourcePos, ImplType, Set.Set Constraint) +inferLit expr loc l t = do + attachTypeToPosition loc $ + TypeMetadata + { identExpr = Lit () l, + ty = (Set.empty, ImplType Map.empty t), + docs = Nothing + } + return (expr, ImplType Map.empty t, Set.empty) + +infer :: Expr (Pinned VCObjectHash) SourcePos -> Infer (Expr (Pinned VCObjectHash) SourcePos, ImplType, Set.Set Constraint) +infer expr = + let exprLoc = blockPosition expr + in case expr of + Lit pos l@(LInt _) -> do + tv <- fresh + let tyCls = TypeClass "numeric" [tv] + attachTypeToPosition exprLoc $ + TypeMetadata + { identExpr = Lit () l, + ty = (Set.singleton tyCls, ImplType Map.empty tv), + docs = Nothing + } + + i <- ExtIdent . Left <$> freshRaw + return (App expr (Var pos Local LocalScope $ Impl i), ImplType (Map.fromList [(i, TRep tv)]) tv, Set.singleton $ Right (exprLoc, tyCls)) + Lit _ l -> + inferLit + expr + exprLoc + l + (handleLit l) + where + handleLit (LDouble _) = typeDouble + handleLit (LHex _) = typeWord64 + handleLit (LText _) = typeText + handleLit (LInt _) = undefined + Var pos mHash _modNm (Expl x) -> do + meta <- lookupEnv exprLoc (maybe (Right x) Left $ pinnedToMaybe mHash) + let (tcs, t@(ImplType impl t'')) = ty meta + attachTypeToPosition exprLoc meta + (expr', t') <- case find (\(TypeClass nm _) -> nm == "rep") $ Set.toList tcs of + Just (TypeClass _ runtimeRepTys) -> do + implRepTyps <- forM runtimeRepTys $ \repTy -> do + i <- freshRaw + pure (ExtIdent $ Left i, TRep repTy) + let (vars, _) = unzip implRepTyps + + pure (foldl App expr $ map (Var pos Local LocalScope . Impl) vars, ImplType (impl `Map.union` Map.fromList implRepTyps) t'') + Nothing -> pure (expr, t) + return (expr', t', Set.map (Right . (exprLoc,)) $ Set.filter (\case TypeClass "rep" _ -> False; _ -> True) tcs) + Var _ _ _ (Impl x) -> do + tv <- fresh + attachTypeToPosition + exprLoc + TypeMetadata + { identExpr = bimap (const ()) (const ()) expr, + ty = (Set.empty, ImplType (Map.fromList [(x, tv)]) tv), + docs = Nothing + } + return (expr, ImplType (Map.fromList [(x, tv)]) tv, Set.empty) + OpVar _ mHash _ _ -> do + meta <- lookupEnv exprLoc (maybe (error "internal error, op vars must always be pinned!!") Left $ pinnedToMaybe mHash) + let (tcs, t) = ty meta + attachTypeToPosition exprLoc meta + return (expr, t, Set.map (Right . (exprLoc,)) tcs) + TypeRep _pos t -> return (expr, ImplType mempty $ TRep t, Set.empty) + Enum _ mHash _ _ -> do + meta <- lookupEnv exprLoc (maybe (error "internal error, enums must always be pinned!!") Left $ pinnedToMaybe mHash) + let (_, t) = ty meta + attachTypeToPosition exprLoc meta {identExpr = bimap (const ()) (const ()) $ expr} + return (expr, t, Set.empty) + InterpolatedString p1 xs p2 -> do + attachTypeToPosition + exprLoc + TypeMetadata + { identExpr = bimap (const ()) (const ()) $ removeComments expr, + ty = (Set.empty, ImplType Map.empty typeText), + docs = Nothing + } + (xs', is, css) <- + unzip3 + <$> ( forM (toEitherList xs) $ \case + Left str -> return (Left str, Map.empty, Set.empty) + Right (p3, e, p4) -> (\(e', ImplType is _t, cs) -> (Right (p3, e', p4), is, cs)) <$> infer e + ) + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) is + return (InterpolatedString p1 (fromEitherList xs') p2, ImplType isMerged typeText, Set.unions css `Set.union` Set.fromList ics) + Array _ [] _ -> do + tv <- fresh + let meta = + TypeMetadata + { identExpr = bimap (const ()) (const ()) $ removeComments expr, + ty = (Set.empty, ImplType Map.empty $ TArray tv), + docs = Nothing + } + let (_, t) = ty meta + attachTypeToPosition exprLoc meta + return (expr, t, Set.empty) + Array p1 ((e, p2) : es) p3 -> do + (e', ImplType i t, cs) <- infer e + (es', impls, cs') <- go t es + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) $ i : impls + let inferredTy = ImplType isMerged $ TArray t + attachTypeToPosition + exprLoc + TypeMetadata + { identExpr = bimap (const ()) (const ()) $ removeComments expr, + ty = (Set.empty, inferredTy), + docs = Nothing + } + + return + ( Array p1 ((e', p2) : es') p3, + inferredTy, + Set.fromList ics `Set.union` cs `Set.union` cs' + ) + where + go _t [] = return ([], [], Set.empty) + go t ((e', p4) : es') = do + (e'', ImplType i t', cs) <- infer e' + (es'', impls, csRest) <- go t es' + return + ( (e'', p4) : es'', + i : impls, + cs + `Set.union` csRest + `Set.union` Set.fromList + [ tyConstr + t + t' + [ UnificationFail + (Set.fromList . map snd . rights . Set.toList $ cs `Set.union` csRest) + t + t' + $ blockPosition e' + ] + ] + ) + ArrayComp p1 e p2 sels cond p3 -> do + _ <- checkVariableOverlap $ NEList.toList sels + (sels', vars, is, css) <- unzip4 <$> go (NEList.toList sels) id + + (e', ImplType i_e t_e, c_e) <- foldr inEnv (infer e) vars + + (cond', i_cond, c_cond) <- case cond of + Just (p4, e_cond) -> do + (e_cond', ImplType i_cond t_cond, c_cond) <- foldr inEnv (infer e_cond) vars + return + ( Just (p4, e_cond'), + i_cond, + c_cond + `Set.union` Set.singleton (tyConstr t_cond typeBool [UnificationFail (Set.fromList . map snd . rights . Set.toList $ c_cond) t_cond typeBool $ blockPosition e_cond]) + ) + Nothing -> return (Nothing, Map.empty, Set.empty) + + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) $ [i_e, i_cond] ++ is + return + ( ArrayComp p1 e' p2 (NEList.fromList sels') cond' p3, + ImplType isMerged (TArray t_e), + Set.fromList ics + `Set.union` c_e + `Set.union` c_cond + `Set.union` Set.unions css + ) + where + go [] _ = return [] + go ((pos, Ident x, p4, e_s, p5) : xs) f = do + (e_s', ImplType i_s t_s, c_s) <- f $ infer e_s + tv <- fresh + attachTypeToPosition + (elementPosition pos $ Ident x) + TypeMetadata + { identExpr = Var () () LocalScope $ Expl $ ExtIdent $ Right x, + ty = (Set.fromList $ map snd $ rights $ Set.toList c_s, ImplType i_s tv), + docs = Nothing + } + let newEnv = + ( ExtIdent $ Right x, + TypeMetadata + { identExpr = Var () () LocalScope $ Expl $ ExtIdent $ Right x, + ty = ForallTC [] (Set.fromList $ map snd $ rights $ Set.toList c_s) $ ImplType i_s tv, + docs = Nothing + } + ) + rest <- go xs (inEnv newEnv . f) + return $ + ( (pos, Ident x, p4, e_s', p5), + newEnv, + i_s, + c_s `Set.union` Set.singleton (tyConstr t_s (TArray tv) [UnificationFail (Set.fromList . map snd . rights . Set.toList $ c_s) t_s (TArray tv) $ blockPosition e_s]) + ) + : rest + + checkVariableOverlap :: [(SourcePos, Ident, SourcePos, b, Maybe SourcePos)] -> Infer () + checkVariableOverlap = \case + [] -> return () + (loc, x, _, _e, _) : xs -> case find (\(_, x', _, _, _) -> x == x') xs of + Just (loc', x', _, _, _) -> throwError [VarMultipleOccurrence x (elementPosition loc x) (elementPosition loc' x')] + Nothing -> checkVariableOverlap xs + Lam p1 args p2 e -> do + (e', ty, cs) <- go $ NEList.toList args + return (Lam p1 args p2 e', ty, cs) + where + go = \case + [] -> infer e + (pos, Just x) : xs -> do + tv <- fresh + let newEnv = + ( x, + TypeMetadata + { identExpr = Var () () LocalScope $ Expl x, + ty = ForallTC [] Set.empty $ ImplType Map.empty tv, + docs = Nothing + } + ) + (e', ImplType is t, cs) <- inEnv newEnv $ go xs + case x of + ExtIdent (Left _) -> pure () + ExtIdent (Right i) -> + attachTypeToPosition + (elementPosition pos $ Just $ Ident i) + TypeMetadata + { identExpr = Var () () LocalScope $ Expl x, + ty = (Set.empty, ImplType Map.empty tv), + docs = Nothing + } + return (e', ImplType is $ tv `TArr` t, cs) + (pos, Nothing) : xs -> do + tv <- fresh + attachTypeToPosition + (elementPosition pos (Nothing :: Maybe Ident)) + TypeMetadata + { identExpr = Var () () LocalScope $ Expl $ ExtIdent $ Right "_", + ty = (Set.empty, ImplType Map.empty tv), + docs = Nothing + } + (e', ImplType is t, cs) <- go xs + return (e', ImplType is $ tv `TArr` t, cs) + App e1 e2 -> do + (e1', ImplType i1 t1, c1) <- infer e1 + (e2', ImplType i2 t2, c2) <- infer e2 + + case t1 of + t1a `TArr` t1b -> do + tv <- fresh + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) [i1, i2] + tyCls = Set.fromList $ map snd $ rights $ Set.toList $ c1 `Set.union` c2 + return + ( App e1' e2', + ImplType isMerged tv, + Set.fromList ics + `Set.union` c1 + `Set.union` c2 + `Set.union` Set.fromList + [ tyConstr t1a t2 [UnificationFail tyCls t1a t2 $ blockPosition e2], + tyConstr t1b tv [UnificationFail tyCls t1b tv $ blockPosition expr] + ] + ) + _ -> do + tv <- fresh + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) [i1, i2] + tyCls = Set.fromList $ map snd $ rights $ Set.toList $ c1 `Set.union` c2 + -- if we end up on this branch, we will be throwing a unification error and + -- want to highlight e1, thus we attach `blockPosition e1` to the error + return + ( App e1' e2', + ImplType isMerged tv, + Set.fromList ics + `Set.union` c1 + `Set.union` c2 + `Set.union` Set.fromList + [ tyConstr t1 (t2 `TArr` tv) [ExpectedFunction tyCls (t2 `TArr` tv) t1 $ blockPosition e1] + ] + ) + + -- non generalized let + Let p1 loc (Expl x) p2 e1 p3 e2 -> do + (e1', ImplType i1 t1, c1) <- infer e1 + attachTypeToPosition + (elementPosition loc $ Expl x) + TypeMetadata + { identExpr = Var () () LocalScope $ Expl x, + ty = (Set.fromList $ map snd $ rights $ Set.toList c1, ImplType i1 t1), + docs = Nothing + } + + let newEnv = + ( x, + TypeMetadata + { identExpr = Var () () LocalScope $ Expl x, + ty = ForallTC [] (Set.fromList $ map snd $ rights $ Set.toList c1) $ ImplType i1 t1, + docs = Nothing + } + ) + (e2', ImplType i2 t2, c2) <- inEnv newEnv $ infer e2 + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) [i1, i2] + return + ( Let p1 loc (Expl x) p2 e1' p3 e2', + ImplType isMerged t2, + Set.fromList ics `Set.union` c1 `Set.union` c2 + ) + Let p1 loc (Impl x) p2 e1 p3 e2 -> do + (e1', ImplType i1 t1, c1) <- infer e1 + (e2', ImplType i2 t2, c2) <- infer e2 + + v1 <- case Map.lookup x i2 of + Just t -> return t + Nothing -> fresh + + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) [i1, Map.withoutKeys i2 (Set.singleton x)] + tyCls = Set.fromList $ map snd $ rights $ Set.toList $ c1 `Set.union` c2 + + return + ( Let p1 loc (Impl x) p2 e1' p3 e2', + ImplType isMerged t2, + Set.fromList ics + `Set.union` c1 + `Set.union` c2 + `Set.union` Set.singleton (tyConstr v1 t1 [ImplicitVarTypeOverlap tyCls x v1 t1 $ blockPosition expr]) + ) + Op e1 loc mHash opMeta modNm op e2 -> do + let (sPos, ePos) = elementPosition loc op + let opLoc = (sPos, incSourceCol ePos $ fromScoped 0 $ (+ 1) . Text.length . unModuleName <$> modNm) + + (e1', ImplType i1 t1, c1) <- infer e1 + (e2', ImplType i2 t2, c2) <- infer e2 + + meta <- lookupEnv opLoc (maybe (error "internal error, infix ops must always be pinned!!") Left $ pinnedToMaybe mHash) + let (tcs, (u1, u2, u3)) = opGetTyComponents <$> ty meta + + tv <- fresh + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) [i1, i2] + tyCls = Set.fromList $ map snd $ rights $ Set.toList $ c1 `Set.union` c2 + + attachTypeToPosition opLoc meta {ty = (tcs, ImplType Map.empty $ t1 `TArr` (t2 `TArr` tv))} + + return + ( Op e1' loc mHash opMeta modNm op e2', + ImplType isMerged tv, + Set.fromList ics + `Set.union` c1 + `Set.union` c2 + `Set.union` Set.fromList + [ tyConstr u1 t1 [UnificationFail tyCls u1 t1 $ blockPosition e1], + tyConstr u2 t2 [UnificationFail tyCls u2 t2 $ blockPosition e2], + tyConstr u3 tv [UnificationFail tyCls u3 tv $ blockPosition expr] + ] + `Set.union` (Set.map (Right . (opLoc,)) tcs) + ) + PreOp loc mHash opMeta modNm op e -> do + let (sPos, ePos) = elementPosition loc op + let opLoc = (sPos, incSourceCol ePos $ fromScoped 0 $ (+ 1) . Text.length . unModuleName <$> modNm) + + (e', ImplType i t, c) <- infer e + + meta <- lookupEnv opLoc (maybe (error "internal error, prefix ops must always be pinned!!") Left $ pinnedToMaybe mHash) + let (tcs, (u1, u2)) = preOpGetTyComponents <$> ty meta + tyCls = Set.fromList $ map snd $ rights $ Set.toList $ c + + tv <- fresh + attachTypeToPosition opLoc meta {ty = (tcs, ImplType Map.empty $ t `TArr` tv)} + + return + ( PreOp loc mHash opMeta modNm op e', + ImplType i tv, + c + `Set.union` Set.fromList + [ tyConstr u1 t [UnificationFail tyCls u1 t $ blockPosition e], + tyConstr u2 tv [UnificationFail tyCls u2 tv $ blockPosition expr] + ] + `Set.union` (Set.map (Right . (opLoc,)) tcs) + ) + If p1 cond p2 tr p3 fl -> do + (cond', ImplType i1 t1, c1) <- infer cond + (tr', ImplType i2 t2, c2) <- infer tr + (fl', ImplType i3 t3, c3) <- infer fl + + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) [i1, i2, i3] + tyCls = Set.fromList $ map snd $ rights $ Set.toList $ c1 `Set.union` c2 `Set.union` c3 + + return + ( If p1 cond' p2 tr' p3 fl', + ImplType isMerged t2, + Set.fromList ics + `Set.union` c1 + `Set.union` c2 + `Set.union` c3 + `Set.union` Set.fromList + [ tyConstr t1 typeBool [IfConditionMustBeBool tyCls t1 $ blockPosition cond], + tyConstr t2 t3 [IfBranchesMustBeEqType tyCls t2 t3 (blockPosition tr) (blockPosition fl)] + ] + ) + Tuple p1 es p2 -> do + (es', impls, tys, cs) <- go $ tListToList es + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) impls + let inferredTy = ImplType isMerged $ TTuple $ tListFromList tys + attachTypeToPosition + exprLoc + TypeMetadata + { identExpr = bimap (const ()) (const ()) $ removeComments expr, + ty = (Set.empty, inferredTy), + docs = Nothing + } + + return + ( Tuple p1 (tListFromList es') p2, + inferredTy, + Set.fromList ics `Set.union` cs + ) + where + go [] = return ([], [], [], Set.empty) + go ((e', p3) : es') = do + (e'', ImplType i t, cs) <- infer e' + (es'', impls, tRest, csRest) <- go es' + return ((e'', p3) : es'', i : impls, t : tRest, cs `Set.union` csRest) + Assert p1 cond p2 e -> do + (cond', ImplType i1 t1, c1) <- infer cond + (e', ImplType i2 t2, c2) <- infer e + + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) [i1, i2] + return + ( Assert p1 cond' p2 e', + ImplType isMerged t2, + Set.fromList ics + `Set.union` c1 + `Set.union` c2 + `Set.union` Set.singleton (tyConstr t1 typeBool [AssertConditionMustBeBool (Set.fromList . map snd . rights . Set.toList $ c1 `Set.union` c2) t1 $ blockPosition cond]) + ) + Empty _ -> do + meta <- lookupEnv exprLoc $ Left emptyHash + let (_, t) = ty meta + attachTypeToPosition exprLoc meta + return (expr, t, Set.empty) + One p e -> do + (e', ImplType is ty, cs) <- infer e + meta <- lookupEnv exprLoc $ Left oneHash + attachTypeToPosition exprLoc meta {ty = (Set.empty, ImplType is $ TOptional ty)} + return (One p e', ImplType is $ TOptional ty, cs) + Case p1 e p2 patExprs' p3 -> do + let patExprs = NEList.toList patExprs' + (e', ImplType i_e t_e, cs_e) <- infer e + (patTys, patVars) <- + unzip + <$> mapM + (\p -> checkVariableOverlap Map.empty p >> mkPatConstraint p) + (map (\(_, p, _, _) -> p) patExprs) + + addCasePatterns exprLoc $ map (\(_, p, _, _) -> p) patExprs + + res <- forM (zip patVars $ map (\(_, _p, _, e'') -> e'') patExprs) $ + \(vars, e''') -> foldr inEnv (infer e''') $ map (\(Ident x, meta) -> (ExtIdent $ Right x, meta)) vars + + let (es'', is_res, ts_res, cs_res) = unzip4 $ map (\(e'', ImplType i_r t_r, cs_r) -> (e'', i_r, t_r, cs_r)) res + (isMerged, ics) = mergeImplicitMaps (blockPosition expr) (i_e : is_res) + tyCls = Set.fromList $ map snd $ rights $ Set.toList $ cs_e `Set.union` (Set.unions cs_res) + patTysEqConstraints = + Set.fromList + [ tyConstr tPat4 tPat5 [PatternsMustBeEqType tyCls tPat4 tPat5 p4 p5 (blockPosition p4) (blockPosition p5)] + | (tPat4, p4) <- zip patTys (map (\(_, p, _, _) -> p) patExprs), + (tPat5, p5) <- zip patTys (map (\(_, p, _, _) -> p) patExprs), + p4 /= p5 + ] + patTysMustEqCaseExprTy cExprTy = + Set.fromList + [ tyConstr tPat cExprTy [PatternUnificationFail tPat cExprTy p $ blockPosition p] + | (tPat, p) <- zip patTys (map (\(_, p, _, _) -> p) patExprs) + ] + patExpTysEqConstraints set = + Set.fromList + [ tyConstr t1 t2 [CaseBranchesMustBeEqType tyCls t1 t2 (blockPosition e1) (blockPosition e2)] + | (ImplType _ t1, e1) <- set, + (ImplType _ t2, e2) <- set, + e1 /= e2 + ] + + return $ + ( Case p1 e' p2 (NEList.fromList $ map (\(e'', (p6, pat, p7, _)) -> (p6, pat, p7, e'')) $ zip es'' patExprs) p3, + ImplType isMerged $ head ts_res, + (Set.fromList ics) + `Set.union` cs_e + `Set.union` patTysEqConstraints + `Set.union` patTysMustEqCaseExprTy t_e + `Set.union` patExpTysEqConstraints (zip (map (\(_, ty, _) -> ty) res) (map (\(_, _p, _, e'') -> e'') patExprs)) + `Set.union` (Set.unions cs_res) + ) + where + mkPatConstraint :: Pat (Pinned VCObjectHash) SourcePos -> Infer (InfernoType, [(Ident, TypeMetadata TCScheme)]) + mkPatConstraint pattern = + let patLoc = blockPosition pattern + in case pattern of + PVar _ (Just (Ident x)) -> do + tv <- fresh + attachTypeToPosition + patLoc + TypeMetadata + { identExpr = Var () () LocalScope $ Expl $ ExtIdent $ Right x, + ty = (Set.empty, ImplType Map.empty tv), + docs = Nothing + } + let meta = + TypeMetadata + { identExpr = Var () () LocalScope $ Expl $ ExtIdent $ Right x, + ty = ForallTC [] Set.empty $ ImplType Map.empty tv, + docs = Nothing + } + return (tv, [(Ident x, meta)]) + PEnum _ Local _ _ -> error "internal error, malformed pattern enum must be pinned" + PEnum _ hash sc i -> do + meta <- lookupEnv patLoc $ Left $ fromJust $ pinnedToMaybe hash + let (_, ImplType _ t) = ty meta + attachTypeToPosition patLoc meta {identExpr = Enum () () sc i} + return (t, []) + PLit _ l -> + inferPatLit + patLoc + l + ( case l of + LInt _ -> typeInt + LDouble _ -> typeDouble + LHex _ -> typeWord64 + LText _ -> typeText + ) + POne _ p -> do + (t, vars) <- mkPatConstraint p + meta <- lookupEnv patLoc $ Left oneHash + attachTypeToPosition patLoc meta {ty = (Set.empty, ImplType Map.empty $ t .-> TOptional t)} + return (TOptional t, vars) + PEmpty _ -> do + meta <- lookupEnv patLoc $ Left emptyHash + let (_, ImplType _ t) = ty meta + attachTypeToPosition patLoc meta + return (t, []) + PTuple _ ps _ -> do + (ts, cs) <- aux $ tListToList ps + let inferredTy = TTuple $ tListFromList ts + attachTypeToPosition + patLoc + TypeMetadata + { identExpr = patternToExpr $ bimap (const ()) (const ()) pattern, + ty = (Set.empty, ImplType Map.empty $ inferredTy), + docs = Nothing + } + return (inferredTy, cs) + where + aux [] = return ([], []) + aux ((p', _l) : ps') = do + (t, vars1) <- mkPatConstraint p' + (ts, vars2) <- aux ps' + return (t : ts, vars1 ++ vars2) + PVar _ Nothing -> do + tv <- fresh + let meta = + TypeMetadata + { identExpr = patternToExpr $ bimap (const ()) (const ()) pattern, + ty = (Set.empty, ImplType Map.empty tv), + docs = Nothing + } + attachTypeToPosition patLoc meta + return (tv, []) + PCommentAbove _ p -> mkPatConstraint p + PCommentAfter p _ -> mkPatConstraint p + PCommentBelow p _ -> mkPatConstraint p + + checkVariableOverlap :: Map.Map Ident (Location SourcePos) -> Pat (Pinned VCObjectHash) SourcePos -> Infer (Map.Map Ident (Location SourcePos)) + checkVariableOverlap vars pattern = + let patLoc = blockPosition pattern + in case pattern of + PVar _ (Just x) -> case Map.lookup x vars of + Just loc' -> throwError [VarMultipleOccurrence x patLoc loc'] + Nothing -> return $ Map.insert x patLoc vars + POne _ p -> checkVariableOverlap vars p + PTuple _ ps _ -> foldM checkVariableOverlap vars $ map fst $ tListToList ps + _ -> return vars + CommentAbove p e -> do + (e', ty, cs) <- infer e + return (CommentAbove p e', ty, cs) + CommentAfter e p -> do + (e', ty, cs) <- infer e + return (CommentAfter e' p, ty, cs) + CommentBelow e p -> do + (e', ty, cs) <- infer e + return (CommentBelow e' p, ty, cs) + Bracketed p1 e p2 -> do + (e', ty, cs) <- infer e + return (Bracketed p1 e' p2, ty, cs) + RenameModule l1 newNm l2 oldNm l3 e -> do + s@InferState {modules = mods} <- get + when (newNm `Map.member` mods) $ throwError [ModuleNameTaken newNm $ elementPosition l1 newNm] + case Map.lookup oldNm mods of + Nothing -> throwError [ModuleDoesNotExist oldNm (l2, l3)] + Just oldNmMod -> do + put s {modules = Map.insert newNm oldNmMod mods} + (e', ty, cs) <- infer e + modify (\s' -> s' {modules = Map.delete newNm $ modules s}) + return (RenameModule l1 newNm l2 oldNm l3 e', ty, cs) + OpenModule l1 mHash modNm@(ModuleName n) imports p e -> do + InferState {modules = mods} <- get + case Map.lookup modNm mods of + Nothing -> throwError [ModuleDoesNotExist modNm $ elementPosition l1 $ Ident n] + Just _openMod -> do + (e', ty, cs) <- infer e + return (OpenModule l1 mHash modNm imports p e', ty, cs) + +inferPatLit :: Location SourcePos -> Lit -> InfernoType -> Infer (InfernoType, [b]) +inferPatLit loc n t = + attachTypeToPosition + loc + TypeMetadata + { identExpr = Lit () n, + ty = (Set.empty, ImplType Map.empty t), + docs = Nothing + } + >> return (t, []) + +------------------------------------------------------------------------------- +-- Constraint Solver +------------------------------------------------------------------------------- + +-- | The empty substitution +emptySubst :: Subst +emptySubst = mempty + +-- | Compose substitutions +compose :: Subst -> Subst -> Subst +(Subst s1) `compose` (Subst s2) = Subst $ Map.map (apply (Subst s1)) s2 `Map.union` s1 + +-- | Run the constraint solver +runSolve :: Set.Set TypeClass -> [Constraint] -> Either [TypeError SourcePos] Subst +runSolve allClasses cs = runIdentity $ runExceptT $ flip runReaderT allClasses $ solver st + where + st = (emptySubst, cs) + +unifyMany :: [TypeError SourcePos] -> [InfernoType] -> [InfernoType] -> Solve Subst +unifyMany _ [] [] = return emptySubst +unifyMany err (t1 : ts1) (t2 : ts2) = do + su1 <- unifies err t1 t2 + su2 <- unifyMany err (apply su1 ts1) (apply su1 ts2) + return (su2 `compose` su1) +unifyMany err _ _ = trace "throwing in unifyMany " $ throwError err + +unifies :: [TypeError SourcePos] -> InfernoType -> InfernoType -> Solve Subst +unifies _ t1 t2 | t1 == t2 = return emptySubst +unifies err (TVar v) t = bind err v t +unifies err t (TVar v) = bind err v t +unifies err (TArr t1 t2) (TArr t3 t4) = unifyMany err [t1, t2] [t3, t4] +unifies err (TArray t1) (TArray t2) = unifies err t1 t2 +unifies err (TSeries t1) (TSeries t2) = unifies err t1 t2 +unifies err (TOptional t1) (TOptional t2) = unifies err t1 t2 +unifies err (TTuple ts1) (TTuple ts2) + | length (tListToList ts1) == length (tListToList ts2) = unifyMany err (tListToList ts1) (tListToList ts2) + | otherwise = throwError [UnificationFail (getTypeClassFromErrs err) (TTuple ts1) (TTuple ts2) loc | loc <- (getLocFromErrs err)] +unifies err _ _ = + -- trace "throwing in unifies " $ + throwError err + +-- Unification solver +solver :: Unifier -> Solve Subst +solver (su, cs) = + case cs of + [] -> return su + _ -> do + let (tyConstrs, typeCls) = partitionEithers cs + su1 <- solverTyCs su tyConstrs + let partResolvedTyCls = map (\(loc, tc) -> (loc, apply su1 tc)) typeCls + -- trace ("partResolvedTyCls: " <> (intercalate "\n" $ map (unpack . renderPretty . pretty . snd) partResolvedTyCls)) $ + evalSolveState (solverTypeClasses $ su1 `compose` su) (Set.fromList partResolvedTyCls, mempty) + +solverTyCs :: Subst -> [(InfernoType, InfernoType, [TypeError SourcePos])] -> Solve Subst +solverTyCs su cs = + case cs of + [] -> return su + ((t1, t2, errs) : cs0) -> do + su1 <- unifies errs t1 t2 + solverTyCs (su1 `compose` su) (map (\(t1', t2', es) -> (apply su1 t1', apply su1 t2', map (apply su1) es)) cs0) + +evalSolveState :: SolveState st a -> st -> Solve a +evalSolveState (ReaderT f) st = ReaderT $ \r -> evalStateT (f r) st + +liftToSolveState :: Solve a -> SolveState st a +liftToSolveState (ReaderT f) = ReaderT $ \r -> StateT $ \s -> (,s) <$> f r + +pick :: (Show a, Ord a) => SolveState (Set.Set a, Set.Set a) (Maybe a) +pick = state $ \st@(current, marked) -> + case Set.lookupMin current of + Nothing -> (Nothing, st) + Just a -> (Just a, (Set.delete a current, Set.insert a marked)) + +-- | `applySubsts` applies the substitution `su` on both marked and unmarked typeclasses and an new information, propagated to +-- marked typeclasses, causes said typeclass to be moved back to the "current" set. +-- We then filter out any fully resolved classes in the marked set only!! to avoid extra unnecessary steps. +-- (Filtering the unprocessed, i.e. current classes may lead to subtle bugs if the class is fully instantiated but +-- is not in fact an instance found in `allClasses`) +applySubsts :: Ord loc => Subst -> SolveState (Set.Set (loc, TypeClass), Set.Set (loc, TypeClass)) () +applySubsts su = state $ \(current, marked) -> + (\(c, m) -> ((), (c, filterFullyInstantiated m))) $ + foldr + ( \(loc, a) (current', marked') -> + let a' = apply su a + in if a == a' + then (current', Set.insert (loc, a') marked') + else (Set.insert (loc, a') current', marked') + ) + (Set.map (\(loc, a) -> (loc, apply su a)) current, mempty) + marked + where + filterFullyInstantiated = + Set.filter $ + not + . Set.null + . ftv + . snd + +solverTypeClasses :: Subst -> SolveState (Set.Set (Location SourcePos, TypeClass), Set.Set (Location SourcePos, TypeClass)) Subst +solverTypeClasses su = + pick >>= \case + Nothing -> return su + Just (loc, tc@(TypeClass nm tys)) -> do + allClasses <- ask + let matchingInstances = Set.toList $ Set.filter (\(TypeClass nm' _) -> nm == nm') allClasses + if null matchingInstances + then throwError [TypeClassNotFoundError allClasses tc loc] + else do + res <- liftToSolveState (catMaybes <$> forM matchingInstances (tryMatchPartial tys)) + case res of + [] -> throwError [TypeClassNoPartialMatch tc loc] + (Subst s : xs) -> do + -- even if we have multiple matching substitutions, we can still make progress if they all agree + -- on some parameter + let su' = (Subst $ foldr intersection s [x | Subst x <- xs]) `compose` su + -- trace ("applying su': "<> show su' <> "\nprevious was su: " <> show su) $ + applySubsts su' + solverTypeClasses su' + where + intersection = Map.merge Map.dropMissing Map.dropMissing (Map.zipWithMaybeMatched $ \_ a b -> if a == b then Just a else Nothing) + +newtype Counter = Counter Int + +-- | Use `getLit` if you want to remember what it points to, i.e. if mapping a (TVar, InfernoType) to a SAT solver variable +getLit :: (MonadState s m, HasType (Bimap.Bimap Int a) s, HasType Counter s, Ord a) => a -> m Int +getLit a = do + st <- get + let bm = getTyped st + let Counter i = getTyped st + case Bimap.lookupR a bm of + Just l -> pure l + Nothing -> do + put $ setTyped (Counter $ i + 1) $ setTyped (Bimap.insert i a bm) st + pure i + +-- | Return a fresh SAT solver variable +newLit :: (MonadState s m, HasType Counter s) => m Int +newLit = do + st <- get + let Counter i = getTyped st + put $ setTyped (Counter $ i + 1) st + pure i + +addClause :: (MonadState s m, HasType [[Int]] s) => [Int] -> m () +addClause c = do + st <- get + let clauses = getTyped st + put $ setTyped (c : clauses) st + +-- | This function encodes our typeclasses into CNF clauses for the SAT-solver. +-- The translation works in the following way: +-- Given a set of type-classes, e.g. `{requires addition on 'a int producing 'b ,requires addition on 'b 'b producing double}` +-- we first compute all the matching instances from `allClasses`, in this case, we get: +-- `requires addition on 'a int producing 'b` matches: +-- - `requires addition on int int producing int` +-- - `requires addition on double int producing double` +-- `requires addition on 'b 'b producing double` matches: +-- - `requires addition on double double producing double` +-- Now we translate each possible class instantiation into the following clauses: +-- `requires addition on int int producing int` becomes: +-- `'a_int <-> add_class_1_inst_1_arg_1` +-- `'b_int <-> add_class_1_inst_1_arg_3` +-- `add_class_1_inst_1_arg_1 /\ add_class_1_inst_1_arg_3 <-> add_class_1_inst_1` +-- `requires addition on double int producing double` becomes: +-- `'a_double <-> add_class_1_inst_2_arg_1` +-- `'b_doube <-> add_class_1_inst_2_arg_3` +-- `add_class_1_inst_2_arg_1 /\ add_class_1_inst_2_arg_3 <-> add_class_1_inst_2` +-- We have to make sure that exactly one instance matches, +-- i.e. `requires addition on int int producing int` or `requires addition on double int producing double`, but not both: +-- `add_class_1_inst_1 XOR add_class_1_inst_2` +-- Next we encode the second set of matching instances, namely `requires addition on double double producing double`: +-- `'b_doube <-> add_class_2_inst_1_arg_1` +-- `'b_doube <-> add_class_2_inst_1_arg_2` +-- `add_class_2_inst_1_arg_1 /\ add_class_2_inst_1_arg_2 <-> add_class_2_inst_1` +-- Since the second typeclass only matches one instance, we simply add it in as true: +-- `add_class_2_inst_1` +-- Finally, we collect all the variables with all their possible types and encode the condition that exactly one type for each is matched: +-- `'a_int XOR 'a_double` +-- `'b_int XOR 'b_double` +-- If the SAT solver returns SAT, we simply check which one of `'a_?` and `'b_?` is set to true in the resulting model. +-- If the solver returns the model `'a_double /\ 'b_double` and we want to check for any more solutions, we simply add `-('a_double /\ 'b_double)` +-- (`-'a_double \/ -'b_double` in CNF) as a clause and re-run the solver. Once all assignments have been exhausted, we will get UNSAT. +{-# NOINLINE findTypeClassWitnesses #-} +findTypeClassWitnesses :: Set.Set TypeClass -> Maybe Int -> Set.Set TypeClass -> Set.Set TV -> [Subst] +findTypeClassWitnesses allClasses iters tyCls tvs = + unsafePerformIO $ + Picosat.evalScopedPicosat $ + Picosat.addBaseClauses clauses >> getSolutions iters + where + filteredSubs = filteredTypeClassSubstitutions allClasses $ Set.toList tyCls + (_, litMap, clauses) = flip execState (Counter 1, Bimap.empty, []) $ do + encodeTypeClasses allClasses filteredSubs $ Set.toList tyCls + lm :: Bimap.Bimap Int (TV, InfernoType) <- getTyped <$> get + let ls_grouped = foldr (\(l, (tv, _)) m' -> Map.alter (Just . maybe [l] (l :)) tv m') mempty $ Bimap.toList $ lm + forM_ (Map.elems ls_grouped) $ \ls -> xor ls + + getSolutions = \case + Just 0 -> pure [] + i -> do + Picosat.scopedSolutionWithAssumptions [] >>= \case + Picosat.Solution ls -> do + let found = catMaybes $ map (\l -> (l,) <$> Bimap.lookup l litMap) ls + Picosat.addBaseClauses [[-l | (l, (tv, _)) <- found, tv `Set.member` tvs]] + ((Subst $ Map.fromList $ map snd found) :) <$> getSolutions ((\x -> x - 1) <$> i) + _ -> pure [] + +tryMatchPartial :: [InfernoType] -> TypeClass -> Solve (Maybe Subst) +tryMatchPartial tys (TypeClass _ tys2) = + ((Just <$> unifyMany [] tys tys2) `catchError` (\_ -> return Nothing)) + +-- | This is a minor optimisation for the `encodeTypeClasses` function. The `filteredTypeClassSubstitutions` function takes the set of all type class instances, +-- along with the list of all the current classes we want to unify and computes all the matching substitutions. +-- It then recursively merges all the possible substitutions for each class and intersects the merged maps of each class instance. +-- For example, given `{requires addition on 'a 'b producing 'c, requires multiplication on 'c 'd producing 'e}`, we will first compute the merged substitutions +-- `{'a -> {int, double, time, timeDiff, word16, word32, word64}, 'b -> {int, double, time, timeDiff, word16, word32, word64}, 'c -> {int, double, time, timeDiff, word16, word32, word64}}` +-- for the `addition` typeclass, and +-- `{'c -> {int, double}, 'd -> {int, double}, 'e -> {int, double}}` for the `multiplication` one. +-- Then we merge the two maps and obtain +-- `{'a -> {int, double, time, timeDiff, word16, word32, word64}, 'b -> {int, double, time, timeDiff, word16, word32, word64}, 'c -> {int, double}, 'd -> {int, double}, 'e -> {int, double}}` +-- This map represents the set of all possible "consistent" type assingments for the free variables `'a`,`'b`,..,`'e`, such that there may exist matching instances of both typeclasses. +-- Notice that `'c` can only an `int` or a `double`, because there are no typeclass intances of `multiplication` for any other types. Precomputing these constraints reduces the number of +-- SAT solver clauses somewhat, especially for large arithmetic operations, e.g. `fun a b c d e f g h i j -> a + b * (c - d) + e / f / g * (h + i - j)` +filteredTypeClassSubstitutions :: Set.Set TypeClass -> [TypeClass] -> Map.Map TV (Set.Set InfernoType) +filteredTypeClassSubstitutions allClasses = \case + [] -> mempty + TypeClass nm tys : tcs -> do + let possibleMatchingInstances = Set.toList $ Set.filter (\(TypeClass nm' _) -> nm == nm') allClasses + case runIdentity $ runExceptT $ flip runReaderT allClasses $ (catMaybes <$> forM possibleMatchingInstances (tryMatchPartial tys)) of + Left _ -> filteredTypeClassSubstitutions allClasses tcs + Right subs' -> + let subs = [su | Subst su <- subs'] + mergedSubs = foldr (Map.merge (Map.mapMissing $ \_k a -> Set.singleton a) Map.preserveMissing $ Map.zipWithMatched $ \_k a as -> Set.insert a as) mempty subs + finalMap = filteredTypeClassSubstitutions allClasses tcs + in Map.merge Map.preserveMissing Map.preserveMissing (Map.zipWithMatched $ \_k as bs -> Set.intersection as bs) mergedSubs finalMap + +encodeTypeClasses :: + (MonadState s f, HasType (Bimap.Bimap Int (TV, InfernoType)) s, HasType [[Int]] s, HasType Counter s) => + Set.Set TypeClass -> + Map.Map TV (Set.Set InfernoType) -> + [TypeClass] -> + f () +encodeTypeClasses allClasses filteredSubs = \case + [] -> pure () + TypeClass nm tys : tcs -> do + let possibleMatchingInstances = Set.toList $ Set.filter (\(TypeClass nm' _) -> nm == nm') allClasses + case runIdentity $ runExceptT $ flip runReaderT allClasses $ (catMaybes <$> forM possibleMatchingInstances (tryMatchPartial tys)) of + Left _err -> encodeTypeClasses allClasses filteredSubs tcs + Right subs -> do + insts <- forM (filterSubs subs) $ \(Subst su) -> do + ls <- + concat + <$> ( forM tys $ \t -> + case t of + TVar tv -> do + let t' = su Map.! tv + tvLit <- getLit (tv, t') + freshLit <- newLit + [tvLit] `iff` freshLit + pure [freshLit] + _ -> pure [] + ) + freshLit <- newLit + ls `iff` freshLit + pure freshLit + xor insts + encodeTypeClasses allClasses filteredSubs tcs + where + filterSubs = + filter $ \(Subst su) -> + Map.foldrWithKey + ( \k v cond -> + cond && case Map.lookup k filteredSubs of + Nothing -> False + Just vs -> Set.member v vs + ) + True + su + + -- a_1 /\ ... /\ a_n -> b is equivalent to -a_1 \/ ... \/ -a_n \/ b + impl as b = addClause $ b : map (\a -> -a) as + -- a_1 /\ ... /\ a_n <-> b is equivalent to (a_1 /\ ... /\ a_n -> b) /\ (b -> a_1) /\ ... /\ (b -> a_n) + iff as b = do + as `impl` b + forM_ as $ \a -> [b] `impl` a + +xor :: (MonadState s m, HasType [[Int]] s) => [Int] -> m () +xor ls = + do + addClause ls + go ls + where + go [] = pure () + go (x : xs) = do + forM_ xs $ \y -> addClause [-x, -y] + go xs + +bind :: [TypeError SourcePos] -> TV -> InfernoType -> Solve Subst +bind err a t + | t == TVar a = return emptySubst + | occursCheck a t = throwError [InfiniteType a t loc | loc <- (getLocFromErrs err)] + | otherwise = return (Subst $ Map.singleton a t) + +occursCheck :: Substitutable a => TV -> a -> Bool +occursCheck a t = a `Set.member` ftv t diff --git a/src/Inferno/Infer/Env.hs b/src/Inferno/Infer/Env.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Infer/Env.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Inferno.Infer.Env + ( Env (..), + Namespace (..), + TypeMetadata (..), + closeOver, + closeOverType, + empty, + lookup, + lookupPinned, + remove, + extend, + merge, + mergeEnvs, + singleton, + keys, + fromList, + fromListModule, + toList, + normtype, + normTC, + fv, + namespaceToIdent, + generalize, + ) +where + +import Data.Foldable (Foldable (foldl')) +import Data.List (nub) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Inferno.Types.Syntax (ExtIdent) +import Inferno.Types.Type + ( ImplType (..), + InfernoType (..), + Namespace (..), + Substitutable (..), + TCScheme (..), + TV (..), + TypeClass (..), + TypeMetadata (..), + namespaceToIdent, + ) +import Inferno.Types.VersionControl (VCObjectHash) +import Prelude hiding (lookup) + +------------------------------------------------------------------------------- +-- Typing Environment +------------------------------------------------------------------------------- + +data Env = TypeEnv + { types :: Map.Map ExtIdent (TypeMetadata TCScheme), + pinnedTypes :: Map.Map VCObjectHash (TypeMetadata TCScheme) + } + deriving (Eq, Show) + +instance Substitutable Env where + apply s env = + env + { types = Map.map (\meta -> meta {ty = apply s $ ty meta}) $ types env, + pinnedTypes = Map.map (\meta -> meta {ty = apply s $ ty meta}) $ pinnedTypes env + } + ftv env = + ftv $ map ty $ Map.elems $ types env + +-- pinnedTypes should not have any free variables!! +empty :: Env +empty = TypeEnv Map.empty Map.empty + +extend :: Env -> (ExtIdent, TypeMetadata TCScheme) -> Env +extend env (x, m) = env {types = Map.insert x m (types env)} + +remove :: Env -> ExtIdent -> Env +remove env v = env {types = Map.delete v (types env)} + +lookup :: ExtIdent -> Env -> Maybe (TypeMetadata TCScheme) +lookup key env = Map.lookup key (types env) + +lookupPinned :: VCObjectHash -> Env -> Maybe (TypeMetadata TCScheme) +lookupPinned key env = Map.lookup key (pinnedTypes env) + +merge :: Env -> Env -> Env +merge (TypeEnv a b) (TypeEnv a' b') = + TypeEnv (Map.union a a') (Map.union b b') + +mergeEnvs :: [Env] -> Env +mergeEnvs = foldl' merge empty + +singleton :: ExtIdent -> TypeMetadata TCScheme -> Env +singleton x m = + TypeEnv + { types = Map.singleton x m, + pinnedTypes = Map.empty + } + +keys :: Env -> [ExtIdent] +keys = Map.keys . types + +fromList :: [(ExtIdent, TypeMetadata TCScheme)] -> Env +fromList xs = + TypeEnv + { types = Map.fromList xs, + pinnedTypes = Map.empty + } + +fromListModule :: [(VCObjectHash, TypeMetadata TCScheme)] -> Env +fromListModule xs = + TypeEnv + { types = Map.empty, + pinnedTypes = Map.fromList xs + } + +toList :: Env -> [(ExtIdent, TypeMetadata TCScheme)] +toList = Map.toList . types + +instance Semigroup Env where + (<>) = merge + +instance Monoid Env where + mempty = empty + +normTC :: (InfernoType -> InfernoType) -> TypeClass -> TypeClass +normTC nt (TypeClass n tys) = TypeClass n (map nt tys) + +fv :: InfernoType -> [TV] +fv (TVar a) = [a] +fv (TArr a b) = fv a ++ fv b +fv (TBase _) = [] +fv (TArray t) = fv t +fv (TSeries t) = fv t +fv (TOptional t) = fv t +fv (TTuple ts) = foldr ((++) . fv) [] ts +fv (TRep t) = fv t + +normtype :: Map.Map TV TV -> InfernoType -> InfernoType +normtype ord (TArr a b) = TArr (normtype ord a) (normtype ord b) +normtype _ (TBase a) = TBase a +normtype ord (TArray a) = TArray $ normtype ord a +normtype ord (TSeries a) = TSeries $ normtype ord a +normtype ord (TOptional a) = TOptional $ normtype ord a +normtype ord (TTuple as) = TTuple $ fmap (normtype ord) as +normtype ord (TRep a) = TRep $ normtype ord a +normtype ord (TVar a) = + case Map.lookup a ord of + Just x -> TVar x + Nothing -> TVar a -- error $ "type variable " <> show a <> "not in signature" + +normalize :: TCScheme -> TCScheme +normalize (ForallTC _ tcs (ImplType impl body)) = + ForallTC + (map snd ord) + (Set.map (normTC $ normtype ordMap) tcs) + $ ImplType (Map.map (normtype ordMap) impl) (normtype ordMap body) + where + -- collect free variables from the body of the function first, + -- then from any implicit type variables and finally from the typeclasses + ftvs = nub $ fv body ++ concatMap (fv . snd) (Map.toList impl) ++ concatMap (\(TypeClass _ tys) -> concatMap fv tys) (Set.toList tcs) + ord = zip ftvs (map TV [0 ..]) + ordMap = Map.fromList ord + +generalize :: Set.Set TypeClass -> ImplType -> TCScheme +generalize tcs t = ForallTC as tcs t + where + as = Set.toList $ ((ftv t) `Set.union` (Set.unions $ Set.elems $ Set.map ftv tcs)) + +-- | Canonicalize and return the polymorphic toplevel type. +closeOver :: Set.Set TypeClass -> ImplType -> TCScheme +closeOver tcs t = normalize $ generalize tcs t + +closeOverType :: InfernoType -> TCScheme +closeOverType = normalize . generalize Set.empty . ImplType Map.empty diff --git a/src/Inferno/Infer/Error.hs b/src/Inferno/Infer/Error.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Infer/Error.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Inferno.Infer.Error where + +import Data.Functor.Foldable (cata, embed) +import Data.Functor.Foldable.TH (makeBaseFunctor) +import qualified Data.Set as Set +import Inferno.Infer.Env (Namespace) +import Inferno.Infer.Exhaustiveness (Pattern) +import Inferno.Types.Syntax + ( ExtIdent, + Ident, + ModuleName, + Pat, + Scoped, + ) +import Inferno.Types.Type + ( InfernoType, + Substitutable (..), + TV, + TypeClass, + ) +import Inferno.Types.VersionControl (Pinned, VCObjectHash) + +type Location a = (a, a) + +data TypeError a + = UnificationFail (Set.Set TypeClass) InfernoType InfernoType (Location a) + | ExpectedFunction (Set.Set TypeClass) InfernoType InfernoType (Location a) + | InfiniteType TV InfernoType (Location a) + | UnboundNameInNamespace (Scoped ModuleName) (Either VCObjectHash Namespace) (Location a) + | UnboundExtIdent (Scoped ModuleName) ExtIdent (Location a) + | -- | UnificationMismatch (Set.Set TypeClass) InfernoType InfernoType (Location a) + -- | Ambiguous [Constraint] + ImplicitVarTypeOverlap (Set.Set TypeClass) ExtIdent InfernoType InfernoType (Location a) + | VarMultipleOccurrence Ident (Location a) (Location a) + | IfConditionMustBeBool (Set.Set TypeClass) InfernoType (Location a) + | AssertConditionMustBeBool (Set.Set TypeClass) InfernoType (Location a) + | IfBranchesMustBeEqType (Set.Set TypeClass) InfernoType InfernoType (Location a) (Location a) + | CaseBranchesMustBeEqType (Set.Set TypeClass) InfernoType InfernoType (Location a) (Location a) + | PatternUnificationFail InfernoType InfernoType (Pat (Pinned VCObjectHash) a) (Location a) + | PatternsMustBeEqType (Set.Set TypeClass) InfernoType InfernoType (Pat (Pinned VCObjectHash) a) (Pat (Pinned VCObjectHash) a) (Location a) (Location a) + | -- | TypeClassUnificationError InfernoType InfernoType TypeClass (Location a) + TypeClassNotFoundError (Set.Set TypeClass) TypeClass (Location a) + | TypeClassNoPartialMatch TypeClass (Location a) + | CouldNotFindTypeclassWitness (Set.Set TypeClass) (Location a) + | NonExhaustivePatternMatch Pattern (Location a) + | UselessPattern (Maybe (Pat (Pinned VCObjectHash) a)) (Location a) + | ModuleNameTaken ModuleName (Location a) + | ModuleDoesNotExist ModuleName (Location a) + | NameInModuleDoesNotExist ModuleName Ident (Location a) + | AmbiguousName ModuleName Namespace (Location a) + deriving (Show, Eq, Ord, Foldable) + +makeBaseFunctor ''TypeError + +instance Substitutable (TypeError a) where + apply s = cata go + where + go :: TypeErrorF a (TypeError a) -> TypeError a + go teF = embed $ fmap (apply s) teF + + ftv _ = Set.empty + +getLocFromErr :: TypeError a -> [Location a] +getLocFromErr = go . foldr (:) [] + where + go = \case + [] -> [] + (x : y : xs) -> (x, y) : go xs + _ -> undefined + +getLocFromErrs :: [TypeError b] -> [Location b] +getLocFromErrs = concatMap getLocFromErr + +getTypeClassFromErr :: TypeError a -> Set.Set TypeClass +getTypeClassFromErr = \case + UnificationFail tyCls _ _ _ -> tyCls + ExpectedFunction tyCls _ _ _ -> tyCls + ImplicitVarTypeOverlap tyCls _ _ _ _ -> tyCls + IfConditionMustBeBool tyCls _ _ -> tyCls + AssertConditionMustBeBool tyCls _ _ -> tyCls + IfBranchesMustBeEqType tyCls _ _ _ _ -> tyCls + CaseBranchesMustBeEqType tyCls _ _ _ _ -> tyCls + PatternsMustBeEqType tyCls _ _ _ _ _ _ -> tyCls + _ -> mempty + +getTypeClassFromErrs :: [TypeError a] -> Set.Set TypeClass +getTypeClassFromErrs = foldr Set.union mempty . map getTypeClassFromErr diff --git a/src/Inferno/Infer/Exhaustiveness.hs b/src/Inferno/Infer/Exhaustiveness.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Infer/Exhaustiveness.hs @@ -0,0 +1,248 @@ +{-# LANGUAGE ExistentialQuantification #-} + +-- this module is an implementation of the exhaustiveness checker from this paper: +-- MARANGET, L. (2007). Warnings for pattern matching. +-- Journal of Functional Programming, 17(3), 387-421. +-- doi:10.1017/S0956796807006223 + +module Inferno.Infer.Exhaustiveness + ( mkEnumText, + Pattern (W), + exhaustive, + checkUsefullness, + cInf, + cEnum, + cOne, + cEmpty, + cTuple, + ) +where + +import Data.List (intercalate) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Text +import Inferno.Types.VersionControl (VCObjectHash) +import Prettyprinter (Pretty (pretty), align, tupled, (<+>)) + +data Con = COne | CEmpty | CTuple Int | forall a. (Show a, Pretty a, Enum a) => CInf a | CEnum VCObjectHash Text + +instance Eq Con where + COne == COne = True + CEmpty == CEmpty = True + (CTuple i) == (CTuple j) = i == j + (CEnum e _) == (CEnum f _) = e == f + (CInf a) == (CInf b) = (show a) == (show b) + _ == _ = False + +-- we don't really care about the ord instance here +instance Ord Con where + compare a b = compare (mkOrd a) (mkOrd b) + where + mkOrd = \case + COne -> "one" + CEmpty -> "empty" + CTuple n -> show n + CInf v -> show v + CEnum _ e -> show e + +-- We define a more abstract type of a pattern here, which only deals with (C)onstructors and +-- holes/(W)ildcards, as we do not need to make a distinction between a variable and a wildcard +-- in the setting of exhaustiveness checking. +data Pattern = C Con [Pattern] | W deriving (Eq, Ord) + +instance Show Pattern where + show = \case + W -> "_" + C COne [x] -> "one " <> show x + C CEmpty _ -> "empty" + C (CTuple _) xs -> "(" <> intercalate "," (map show xs) <> ")" + C (CInf x) _ -> show x + C (CEnum _ x) _ -> "#" <> show x + C _ _ -> "undefined" + +instance Pretty Pattern where + pretty = \case + W -> "_" + C COne [x] -> "one" <+> align (pretty x) + C CEmpty _ -> "empty" + C (CTuple _) xs -> tupled (map pretty xs) + C (CInf x) _ -> pretty x + C (CEnum _ x) _ -> "#" <> pretty x + C _ _ -> "undefined" + +type PMatrix = [[Pattern]] + +cSize :: Con -> Int +cSize = \case + COne -> 1 + CEmpty -> 0 + CTuple s -> s + CInf _ -> 0 + CEnum _ _ -> 0 + +specialize :: Con -> PMatrix -> PMatrix +specialize _ [] = [] +specialize c ((pi1 : pis) : rest) = case pi1 of + C c' rs -> + if c == c' + then (rs ++ pis) : specialize c rest + else specialize c rest + W -> (replicate (cSize c) W ++ pis) : specialize c rest +specialize _ ([] : _) = error "malformed PMatrix" + +specializeVec :: Con -> [Pattern] -> Maybe [Pattern] +specializeVec c p = case specialize c [p] of + [p'] -> Just p' + _ -> Nothing + +col :: PMatrix -> [Pattern] +col [] = [] +col ([] : _) = [] +col ((x : _) : rest) = x : col rest + +conNames :: [Pattern] -> Set Con +conNames [] = Set.empty +conNames (p : ps) = case p of + C c _ -> Set.insert c $ conNames ps + W -> conNames ps + +data IsComplete = Complete | Incomplete Pattern + +isComplete :: IsComplete -> Bool +isComplete Complete = True +isComplete _ = False + +-- This function checks if a set Σ of patterns is a complete signature w.r.t the definition of the datatype, i.e.: +-- the set `{}` is always an incomplete signature (we disallow empty case exprs), +-- the set `{empty, one _}` is a complete signature for the optional type, +-- the set containing all constructors of some enum `E` is complete, +-- the set `{(_,...,_)}` is always complete for an n-tuple type, +-- the set containing any int/double/text/word patterns is always incomplete, because these sets are (theoretically) infinite +isCompleteSignature :: Map VCObjectHash (Set (VCObjectHash, Text)) -> Set Con -> IsComplete +isCompleteSignature enum_sigs s = + if Set.null s + then Incomplete W + else case Set.findMin s of + CEmpty -> if s == Set.fromList [COne, CEmpty] then Complete else Incomplete $ C COne [W] + COne -> if s == Set.fromList [COne, CEmpty] then Complete else Incomplete $ C CEmpty [] + CTuple _ -> Complete + CEnum e _ -> + let e_sig = Set.map (uncurry CEnum) $ enum_sigs Map.! e + in if s == e_sig + then Complete + else Incomplete $ C (Set.findMin $ e_sig `Set.difference` s) [] + CInf n -> Incomplete $ C (findSucc n) [] + where + findSucc :: (Show a, Pretty a, Enum a) => a -> Con + findSucc n = let sn = (CInf $ succ n) in if sn `Set.member` s then findSucc (succ n) else sn + +isUseful :: Map VCObjectHash (Set (VCObjectHash, Text)) -> PMatrix -> [Pattern] -> Bool +isUseful _ [] _ = True +isUseful _ ([] : _) _ = False +isUseful _ _ [] = False -- [Pattern] should never be empty +isUseful sigs p q@(q1 : qs) = case q1 of + C c _ -> + let sP = specialize c p + in case specializeVec c q of + Just sq -> isUseful sigs sP sq + Nothing -> error "unreachable specializeVec" + W -> + let sig = conNames $ col p + in if isComplete $ isCompleteSignature sigs sig + then + any + ( \ck -> case specializeVec ck q of + Just sq -> + let sP = specialize ck p + in isUseful sigs sP sq + Nothing -> False + ) + sig + else isUseful sigs (defaultMatrix p) qs + +defaultMatrix :: PMatrix -> PMatrix +defaultMatrix [] = [] +defaultMatrix ((C _ _ : _) : rest) = defaultMatrix rest +defaultMatrix ((W : pis) : rest) = pis : defaultMatrix rest +defaultMatrix _ = error "malformed PMatrix" + +cTuple :: [Pattern] -> Pattern +cTuple xs = C (CTuple (length xs)) xs + +cOne :: Pattern -> Pattern +cOne x = C COne [x] + +cEmpty :: Pattern +cEmpty = C CEmpty [] + +cEnum :: VCObjectHash -> Text -> Pattern +cEnum h t = C (CEnum h t) [] + +cInf :: (Show a, Pretty a, Enum a) => a -> Pattern +cInf n = C (CInf n) [] + +exhaustive :: Map VCObjectHash (Set (VCObjectHash, Text)) -> PMatrix -> Maybe [Pattern] +exhaustive sigs pm = i sigs pm 1 + where + -- i is a specialized version of isUseful, which returns a missing pattern list instead of just bool + i :: Map VCObjectHash (Set (VCObjectHash, Text)) -> PMatrix -> Int -> Maybe [Pattern] + i _ [] n = Just $ replicate n W + i _ ([] : _) 0 = Nothing + i enum_sigs p n = + let sig = conNames $ col p + in case isCompleteSignature enum_sigs sig of + Complete -> go $ Set.toList sig + Incomplete somePat -> (somePat :) <$> i enum_sigs (defaultMatrix p) (n -1) + where + go [] = Nothing + go (ck : rest) = + let sP = specialize ck p + in case i sigs sP (cSize ck + n - 1) of + Nothing -> go rest + Just pat -> + Just $ + [C ck $ take (cSize ck) pat] ++ drop (cSize ck) pat + +checkUsefullness :: Map VCObjectHash (Set (VCObjectHash, Text)) -> PMatrix -> [(Int, Int)] +checkUsefullness enum_sigs p = go 0 [] p + where + go _ _ [] = [] + go n preceding (p_i : rest) = + if isUseful enum_sigs preceding p_i + then go (n + 1) (preceding ++ [p_i]) rest + else (n, findOverlap p_i 0 preceding) : go (n + 1) (preceding ++ [p_i]) rest + + findOverlap :: [Pattern] -> Int -> PMatrix -> Int + findOverlap _ n [] = n + findOverlap p_i n (x : xs) = + if isUseful enum_sigs [x] p_i + then findOverlap p_i (n + 1) xs + else n + +-- DO NOT export the constructor EnumText or use EnumText for anything else +-- It is used purely as a hack to give Text a half defined Enum instance, +-- specifically we abuse the `succ` function to be able to generate an +-- example of an incomplete match on text +newtype EnumText = EnumText Text + +mkEnumText :: Text -> EnumText +mkEnumText = EnumText + +instance Show EnumText where + show (EnumText t) = show t + +instance Pretty EnumText where + pretty (EnumText t) = pretty $ show t + +instance Enum EnumText where + toEnum = undefined + fromEnum = undefined + succ (EnumText t) = + EnumText $ + if Text.null t + then "a" + else t <> t diff --git a/src/Inferno/Infer/Pinned.hs b/src/Inferno/Infer/Pinned.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Infer/Pinned.hs @@ -0,0 +1,265 @@ +{-# LANGUAGE TypeFamilies #-} + +module Inferno.Infer.Pinned + ( pinExpr, + insertHardcodedModule, + insertBuiltinModule, + openModule, + ) +where + +import Control.Monad (foldM, forM, when) +import Control.Monad.Except (MonadError (throwError)) +import Control.Monad.State (get, put, runStateT) +import Data.Functor.Foldable (cata) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import Inferno.Infer.Error (TypeError (..)) +import Inferno.Module.Builtin (builtinModule) +import Inferno.Types.Module (Module (..)) +import Inferno.Types.Syntax (Expr (..), ExtIdent (..), Ident (..), ImplExpl (..), Import (..), ModuleName (..), Pat (..), PatF (..), Scoped (..), blockPosition, elementPosition) +import Inferno.Types.Type (Namespace (..)) +import Inferno.Types.VersionControl (Pinned (..), VCObjectHash) +import Text.Megaparsec (SourcePos (..)) + +insertIntoLocalScope :: + Map Namespace (Pinned a) -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) +insertIntoLocalScope m moduleMap = + Map.alter (Just . addModuleToLocalScope) LocalScope moduleMap + where + addModuleToLocalScope maybeMap = case maybeMap of + Nothing -> m + Just m' -> m `Map.union` m' + +insertHardcodedModule :: + ModuleName -> + Map Namespace (Pinned a) -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) +insertHardcodedModule modNm m moduleMap = + insertIntoLocalScope (Map.filterWithKey isModuleNamespace m) $ + Map.insert (Scope modNm) m moduleMap + where + isModuleNamespace :: Namespace -> p -> Bool + isModuleNamespace k _v = case k of + ModuleNamespace _ -> True + _ -> False + +insertBuiltinModule :: + Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) +insertBuiltinModule = + openModule "Builtin" + . insertHardcodedModule "Builtin" (Map.map Builtin builtinTysToHash) + where + builtinTysToHash :: Map Namespace VCObjectHash + Module {moduleObjects = (builtinTysToHash, _, _)} = builtinModule + +openModule :: + ModuleName -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) +openModule modNm moduleMap = case Map.lookup (Scope modNm) moduleMap of + Nothing -> error $ "openModule: Module " <> show modNm <> " does not exist." + Just m -> insertIntoLocalScope m moduleMap + +lookupName :: + (MonadError [TypeError SourcePos] m, Eq a) => + (SourcePos, SourcePos) -> + Scoped ModuleName -> + Namespace -> + Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> + m (Pinned a) +lookupName loc modNm ns m = case Map.lookup modNm m of + Just m' -> case Map.lookup ns m' of + Just r -> pure r + Nothing -> throwError [UnboundNameInNamespace modNm (Right ns) loc] + Nothing -> case modNm of + Scope nm -> throwError [ModuleDoesNotExist nm loc] + LocalScope -> throwError [UnboundNameInNamespace modNm (Right ns) loc] + +pinPat :: (MonadError [TypeError SourcePos] m, Eq a) => Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> Pat h SourcePos -> m (Pat (Pinned a) SourcePos) +pinPat m pat = + let patPos = blockPosition pat + in case pat of + PVar p i -> pure $ PVar p i + PEnum p _ modNm x -> do + hash <- lookupName patPos modNm (EnumNamespace x) m + pure $ PEnum p hash modNm x + PLit p l -> pure $ PLit p l + POne p e -> POne p <$> pinPat m e + PEmpty p -> pure $ PEmpty p + PTuple p1 es p2 -> do + es' <- mapM (\(e, p3) -> (,p3) <$> pinPat m e) es + pure $ PTuple p1 es' p2 + PCommentAbove c e -> PCommentAbove c <$> pinPat m e + PCommentAfter e c -> (\e' -> PCommentAfter e' c) <$> pinPat m e + PCommentBelow e c -> (\e' -> PCommentBelow e' c) <$> pinPat m e + +-- pinExpr :: +-- (MonadError [TypeError SourcePos] m, Eq a) => +-- Map ModuleName (Map Namespace (Pinned a)) -> +-- Expr h SourcePos -> +-- m (Expr (Pinned a) SourcePos) +-- pinExpr nameMap = pinExpr nameMapWithBuiltin +-- where +-- Module {moduleObjects = (builtinTysToHash, _, _)} = builtinModule + +-- nameMapWithBuiltin = +-- let moduleNames = Map.filterWithKey isModNs $ Map.unions $ Map.elems nameMap +-- in Map.insert LocalScope (Map.map Builtin builtinTysToHash `Map.union` moduleNames) $ +-- Map.mapKeysMonotonic Scope $ Map.insert "Builtin" (Map.map Builtin builtinTysToHash) nameMap + +patVars :: Pat hash pos -> [Ident] +patVars p = + flip cata p $ + \case + PVarF _ (Just v) -> [v] + rest -> foldr (++) [] rest + +isModNs :: Namespace -> p -> Bool +isModNs k _v = case k of + ModuleNamespace _ -> True + _ -> False + +pinExpr :: (MonadError [TypeError SourcePos] m, Eq a) => Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> Expr h SourcePos -> m (Expr (Pinned a) SourcePos) +pinExpr m expr = + let exprPos = blockPosition expr + insertLocal k m' = Map.alter (alterFun (FunNamespace k) Local) LocalScope m' + alterFun k v = \case + Just m' -> Just $ Map.insert k v m' + Nothing -> Just $ Map.singleton k v + in case expr of + Lit p l -> pure $ Lit p l + Var p _hash modNm (Impl x) -> pure $ Var p Local modNm (Impl x) + Var p _hash modNm i@(Expl (ExtIdent (Left _))) -> pure $ Var p Local modNm i + Var p _hash modNm i@(Expl (ExtIdent (Right x))) -> do + hash <- lookupName exprPos modNm (FunNamespace $ Ident x) m + pure $ Var p hash modNm i + OpVar p _hash modNm x -> do + hash <- lookupName exprPos modNm (OpNamespace x) m + pure $ OpVar p hash modNm x + TypeRep p t -> pure $ TypeRep p t + Enum p _hash modNm x -> do + hash <- lookupName exprPos modNm (EnumNamespace x) m + pure $ Enum p hash modNm x + InterpolatedString p1 xs p2 -> do + xs' <- mapM (\(p3, e, p4) -> (\e' -> (p3, e', p4)) <$> pinExpr m e) xs + pure $ InterpolatedString p1 xs' p2 + Array p1 es p2 -> do + es' <- mapM (\(e, p3) -> (,p3) <$> pinExpr m e) es + pure $ Array p1 es' p2 + ArrayComp p1 e p2 sels cond p3 -> do + (sels', m') <- flip runStateT m $ + forM sels $ \(p4, i, p5, e1, p6) -> do + currentM <- get + e1' <- pinExpr currentM e1 + put $ insertLocal i currentM + pure $ (p4, i, p5, e1', p6) + + cond' <- mapM (\(p4, e1) -> (p4,) <$> pinExpr m' e1) cond + e' <- pinExpr m' e + pure $ ArrayComp p1 e' p2 sels' cond' p3 + Lam p1 args p2 e -> do + let m' = + foldr + ( \(_, mIdent) m'' -> case mIdent of + Just (ExtIdent (Right i)) -> insertLocal (Ident i) m'' + _ -> m'' + ) + m + args + Lam p1 args p2 <$> pinExpr m' e + App e1 e2 -> App <$> pinExpr m e1 <*> pinExpr m e2 + Let p1 loc x@(Expl (ExtIdent (Right i))) p2 e1 p3 e2 -> do + e1' <- pinExpr m e1 + e2' <- pinExpr (insertLocal (Ident i) m) e2 + pure $ Let p1 loc x p2 e1' p3 e2' + Let p1 loc x@(Expl (ExtIdent (Left _))) p2 e1 p3 e2 -> do + e1' <- pinExpr m e1 + e2' <- pinExpr m e2 + pure $ Let p1 loc x p2 e1' p3 e2' + Let p1 loc (Impl x) p2 e1 p3 e2 -> do + e1' <- pinExpr m e1 + e2' <- pinExpr m e2 + pure $ Let p1 loc (Impl x) p2 e1' p3 e2' + Op e1 p1 _ meta modNm op e2 -> do + hash <- lookupName exprPos modNm (OpNamespace op) m + (\e1' e2' -> Op e1' p1 hash meta modNm op e2') + <$> pinExpr m e1 <*> pinExpr m e2 + PreOp loc _ meta modNm op e -> do + hash <- lookupName exprPos modNm (FunNamespace op) m + PreOp loc hash meta modNm op <$> pinExpr m e + If p1 cond p2 tr p3 fl -> + (\c t f -> If p1 c p2 t p3 f) <$> pinExpr m cond <*> pinExpr m tr <*> pinExpr m fl + Tuple p1 es p2 -> do + es' <- mapM (\(e, p3) -> (,p3) <$> pinExpr m e) es + pure $ Tuple p1 es' p2 + Assert p1 cond p2 e -> + (\cond' e' -> Assert p1 cond' p2 e') + <$> pinExpr m cond <*> pinExpr m e + Empty p -> pure $ Empty p + One p e -> One p <$> pinExpr m e + Case p1 e p2 patExprs p3 -> do + e' <- pinExpr m e + patExprs' <- + mapM + ( \(p4, pat, p5, e1) -> do + pat' <- pinPat m pat + let m' = foldr insertLocal m $ patVars pat + e1' <- pinExpr m' e1 + pure $ (p4, pat', p5, e1') + ) + patExprs + pure $ Case p1 e' p2 patExprs' p3 + CommentAbove c e -> CommentAbove c <$> pinExpr m e + CommentAfter e c -> (\e' -> CommentAfter e' c) <$> pinExpr m e + CommentBelow e c -> (\e' -> CommentBelow e' c) <$> pinExpr m e + Bracketed p1 e p2 -> (\e' -> Bracketed p1 e' p2) <$> pinExpr m e + RenameModule l1 newNm l2 oldNm l3 e -> do + hash <- lookupName exprPos LocalScope (ModuleNamespace oldNm) m + when (Scope newNm `Map.member` m) $ throwError [ModuleNameTaken newNm $ elementPosition l1 newNm] + case Map.lookup (Scope oldNm) m of + Nothing -> throwError [ModuleDoesNotExist oldNm (l2, l3)] + Just oldNmMod -> do + let m' = Map.alter (alterFun (ModuleNamespace newNm) hash) LocalScope $ Map.insert (Scope newNm) oldNmMod m + RenameModule l1 newNm l2 oldNm l3 <$> pinExpr m' e + OpenModule p1 _mHash modNm@(ModuleName mn) imports p2 e -> do + hash <- lookupName exprPos LocalScope (ModuleNamespace modNm) m + let modPos = elementPosition p1 $ Ident mn + case Map.lookup (Scope modNm) m of + Nothing -> throwError [ModuleDoesNotExist modNm modPos] + Just openMod' -> do + let openMod = Map.filterWithKey (\k v -> not $ isModNs k v) openMod' + let localM = fromMaybe mempty $ Map.lookup LocalScope m + + checkedImports <- case imports of + [] -> pure $ openMod + _ -> Map.fromList <$> (foldM (collectImports openMod modPos) [] $ map fst imports) + + let intersectionWithLocal = localM `Map.intersection` checkedImports + when (not $ Map.null intersectionWithLocal) $ throwError [AmbiguousName modNm i modPos | i <- Map.keys checkedImports] + + OpenModule p1 hash modNm imports p2 <$> pinExpr (Map.insertWith Map.union LocalScope checkedImports m) e + where + collectImports openMod pos xs = \case + IVar _ i -> do + let k = FunNamespace i + when (not $ k `Map.member` openMod) $ throwError [NameInModuleDoesNotExist modNm i pos] + return $ (k, openMod Map.! k) : xs + IOpVar _ i -> do + let k = FunNamespace i + when (not $ k `Map.member` openMod) $ throwError [NameInModuleDoesNotExist modNm i pos] + return $ (k, openMod Map.! k) : xs + IEnum _ _ i -> do + let k = TypeNamespace i + when (not $ k `Map.member` openMod) $ throwError [NameInModuleDoesNotExist modNm i pos] + let enumHash = openMod Map.! k + return $ + (Map.toList $ Map.filter (\h -> h == enumHash) openMod) ++ xs + ICommentAbove _ x' -> collectImports openMod pos xs x' + ICommentAfter x' _ -> collectImports openMod pos xs x' + ICommentBelow x' _ -> collectImports openMod pos xs x' diff --git a/src/Inferno/Module.hs b/src/Inferno/Module.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Module.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Inferno.Module + ( Module (..), + PinnedModule, + BuiltinModuleHash (..), + BuiltinFunHash (..), + BuiltinEnumHash (..), + buildPinnedQQModules, + combineTermEnvs, + pinnedModuleNameToHash, + pinnedModuleHashToTy, + pinnedModuleTerms, + ToValue (..), + ) +where + +import Control.Monad (foldM) +import Control.Monad.Except (MonadError) +import Data.Bifunctor (bimap) +import Data.Foldable (foldl') +import qualified Data.IntMap as IntMap +import qualified Data.Map as Map +import qualified Data.Set as Set +import Inferno.Eval (TermEnv, eval) +import Inferno.Eval.Error (EvalError) +import Inferno.Infer (inferExpr) +import Inferno.Infer.Env (Namespace (..), TypeMetadata (..)) +import Inferno.Infer.Pinned (pinExpr) +import qualified Inferno.Infer.Pinned as Pinned +import Inferno.Module.Cast (ToValue (..)) +import Inferno.Parse (OpsTable, TopLevelDefn (..)) +import Inferno.Types.Module + ( BuiltinEnumHash (..), + BuiltinFunHash (..), + BuiltinModuleHash (..), + Module (..), + PinnedModule, + pinnedModuleHashToTy, + pinnedModuleNameToHash, + pinnedModuleTerms, + ) +import Inferno.Types.Syntax + ( Expr (..), + ExtIdent (..), + Ident (..), + ImplExpl (..), + ModuleName, + Scoped (..), + SigVar (..), + sigVarToExpr, + ) +import Inferno.Types.Type + ( BaseType (TEnum), + ImplType (..), + InfernoType (TBase), + TCScheme (..), + ) +import Inferno.Types.Value (ImplEnvM, Value) +import Inferno.Types.VersionControl (Pinned (..), VCObjectHash, pinnedToMaybe, vcHash) +import Prettyprinter (Pretty) +import Text.Megaparsec (SourcePos) + +combineTermEnvs :: + MonadError EvalError m => + Map.Map ModuleName (PinnedModule (ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c)))) -> + ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c)) +combineTermEnvs modules = foldM (\env m -> (env <>) <$> pinnedModuleTerms m) mempty $ Map.elems modules + +buildPinnedQQModules :: + (MonadError EvalError m, Pretty c) => + [(ModuleName, OpsTable, [TopLevelDefn (Either (TCScheme, ImplEnvM m c (Value c (ImplEnvM m c))) (Maybe TCScheme, Expr () SourcePos))])] -> + Map.Map ModuleName (PinnedModule (ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c)))) +buildPinnedQQModules modules = + snd $ + foldl' + ( \(alreadyPinnedModulesMap, alreadyBuiltModules) (moduleNm, opsTable, sigs) -> + -- first build the new module + let newMod = + buildModule alreadyPinnedModulesMap alreadyBuiltModules sigs $ + Module + { moduleName = moduleNm, + moduleOpsTable = opsTable, + moduleTypeClasses = mempty, + moduleObjects = (Map.singleton (ModuleNamespace moduleNm) $ vcHash $ BuiltinModuleHash moduleNm, mempty, pure mempty) + } + in -- then insert it into the temporary module pin map as well as the final module map + ( Pinned.insertHardcodedModule moduleNm (Map.map Builtin $ pinnedModuleNameToHash newMod) alreadyPinnedModulesMap, + Map.insert moduleNm newMod alreadyBuiltModules + ) + ) + mempty + modules + where + buildModule :: + (MonadError EvalError m, Pretty c) => + Map.Map (Scoped ModuleName) (Map.Map Namespace (Pinned VCObjectHash)) -> + Map.Map ModuleName (PinnedModule (ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c)))) -> + [TopLevelDefn (Either (TCScheme, ImplEnvM m c (Value c (ImplEnvM m c))) (Maybe TCScheme, Expr () SourcePos))] -> + PinnedModule (ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c))) -> + PinnedModule (ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c))) + buildModule _ _ [] m = m + buildModule alreadyPinnedModulesMap alreadyBuiltModules (Signature {..} : xs) m@Module {moduleName, moduleObjects = (nsMap, tyMap, mTrmEnv)} = + let sigVarToNamespace = \case + SigVar n -> FunNamespace $ Ident n + SigOpVar n -> OpNamespace $ Ident n + (sig, ns, hsh, mTrmEnv') = case def of + Left (sig', mVal) -> + let ns' = sigVarToNamespace name + hsh' = vcHash $ BuiltinFunHash (sigVarToExpr LocalScope name, sig) + in (sig', ns', hsh', (\val (local, pinned) -> (local, Map.insert hsh val pinned)) <$> mVal <*> mTrmEnv) + Right (_mSig, expr) -> + let pinMap = + Pinned.openModule moduleName $ + Pinned.insertHardcodedModule + moduleName + (Map.map Builtin nsMap) + alreadyPinnedModulesMap + pinnedExpr = either (error . show) id $ pinExpr pinMap expr + inferEnv = Map.insert moduleName m $ alreadyBuiltModules + (pinnedExpr', sig') = + either (\err -> error $ "Could not infer the type of this expression: " <> show err) (\(e, typ, _) -> (e, typ)) $ + inferExpr inferEnv $ pinnedExpr + ns' = sigVarToNamespace name + hsh' = vcHash $ BuiltinFunHash (sigVarToExpr LocalScope name, sig) + mVal = + combineTermEnvs alreadyBuiltModules >>= \env -> + mTrmEnv >>= \env' -> eval (env <> env') $ bimap pinnedToMaybe id pinnedExpr' + in (sig', ns', hsh', (\val (local, pinned) -> (local, Map.insert hsh val pinned)) <$> mVal <*> mTrmEnv) + in buildModule alreadyPinnedModulesMap alreadyBuiltModules xs $ + m + { moduleObjects = + ( Map.insert ns hsh nsMap, + Map.insert + hsh + TypeMetadata + { identExpr = sigVarToExpr (Scope moduleName) name, + docs = documentation, + ty = sig + } + tyMap, + mTrmEnv' + ) + } + buildModule alreadyPinnedModulesMap alreadyBuiltModules (TypeClassInstance tCl : xs) m@Module {moduleTypeClasses = tCls} = + buildModule alreadyPinnedModulesMap alreadyBuiltModules xs m {moduleTypeClasses = Set.insert tCl tCls} + buildModule alreadyPinnedModulesMap alreadyBuiltModules (Export modNm : xs) Module {moduleName, moduleOpsTable = opsTable, moduleTypeClasses = tyCls, moduleObjects = (nsMap, tyMap, mTrmEnv)} = + case Map.lookup modNm alreadyBuiltModules of + Nothing -> error $ "buildModule: Module " <> show modNm <> " does not exist." + Just Module {moduleOpsTable = opsTable', moduleTypeClasses = tyCls', moduleObjects = (nsMap', tyMap', mTrmEnv')} -> + buildModule + alreadyPinnedModulesMap + alreadyBuiltModules + xs + Module + { moduleName, + moduleOpsTable = IntMap.unionWith (<>) opsTable opsTable', + moduleTypeClasses = tyCls <> tyCls', + moduleObjects = (nsMap <> nsMap', tyMap <> tyMap', mTrmEnv >>= \x -> mTrmEnv' >>= \y -> pure $ x <> y) + } + buildModule alreadyPinnedModulesMap alreadyBuiltModules (EnumDef doc nm cs : xs) m@Module {moduleObjects = (nsMap, tyMap, mTrmEnv)} = + let enumTy = ForallTC [] Set.empty $ ImplType Map.empty $ TBase $ TEnum nm $ Set.fromList cs + hsh = vcHash $ BuiltinEnumHash enumTy + nms = TypeNamespace (Ident nm) : [EnumNamespace c | c <- cs] + in buildModule alreadyPinnedModulesMap alreadyBuiltModules xs $ + m + { moduleObjects = + ( Map.fromList [(n, hsh) | n <- nms] `Map.union` nsMap, + Map.insert + hsh + TypeMetadata + { identExpr = Var () () LocalScope (Expl $ ExtIdent $ Right "_"), + docs = doc, + ty = enumTy + } + tyMap, + mTrmEnv + ) + } diff --git a/src/Inferno/Module/Builtin.hs b/src/Inferno/Module/Builtin.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Module/Builtin.hs @@ -0,0 +1,95 @@ +module Inferno.Module.Builtin (builtinModule, emptyHash, oneHash, enumBoolHash) where + +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Text (Text) +import Inferno.Types.Module (BuiltinEnumHash (..), BuiltinFunHash (..), BuiltinModuleHash (..), Module (..), PinnedModule) +import Inferno.Types.Syntax (Expr (..), ExtIdent (..), ImplExpl (..), Scoped (..)) +import Inferno.Types.Type + ( ImplType (..), + InfernoType (..), + Namespace (..), + TCScheme (..), + TV (..), + TypeClass (TypeClass), + TypeMetadata (..), + typeBool, + typeDouble, + typeInt, + (.->), + ) +import Inferno.Types.VersionControl (VCObjectHash, vcHash) + +-- The builtin module is a dummy module only used for typechecking purposes +-- it contains the bool enum, which must exist because the `if...then..else..` that's built into the +-- basic AST type expects a boolean value in its first argument. +-- The module also includes some meta information for the `Some/None` constructors of the `option` type, +-- which is again built into the language. +-- NOTE: the code and the hashes use the old `one/empty` terms for legacy reasons +builtinModule :: PinnedModule () +builtinModule = + Module + { moduleName = "Builtin", + moduleOpsTable = mempty, + moduleObjects = (name2Hash, hash2ty, ()), + moduleTypeClasses = + Set.fromList + [ TypeClass "numeric" [typeInt], + TypeClass "numeric" [typeDouble] + ] + } + where + name2Hash = + Map.fromList + [ (ModuleNamespace "Builtin", vcHash $ BuiltinModuleHash "Builtin"), + (TypeNamespace "bool", enumBoolHash), + (EnumNamespace "true", enumBoolHash), + (EnumNamespace "false", enumBoolHash), + (FunNamespace "None", emptyHash), + (FunNamespace "Some", oneHash) + ] + hash2ty = + Map.fromList + [ ( enumBoolHash, + TypeMetadata + { identExpr = Var () () LocalScope (Expl $ ExtIdent $ Right "_"), + ty = ForallTC [] Set.empty $ ImplType Map.empty $ typeBool, + docs = Just "Boolean type" + } + ), + ( emptyHash, + TypeMetadata + { identExpr = Empty (), + ty = emptyTy, + docs = optionMetaText + } + ), + ( oneHash, + TypeMetadata + { identExpr = Var () () LocalScope $ Expl $ ExtIdent $ Right "Some", + ty = oneTy, + docs = optionMetaText + } + ) + ] + + optionMetaText :: Maybe Text + optionMetaText = + Just $ + "Optional type, representing a value which may be undefined.\n" + <> "`None` indicates no value is present and `Some v` holds a value `v`\n " + <> "To test whether an optional `o` holds some value, use `match ... with` and pattern match on `o`:\n" + <> "~~~\nmatch o with {\n | Some v -> // use v here\n | None -> // handle the case where o is None\n}\n~~~" + +emptyTy, oneTy, boolTy :: TCScheme +emptyTy = ForallTC [TV 0] Set.empty $ ImplType Map.empty $ TOptional (TVar $ TV 0) +oneTy = ForallTC [TV 0] Set.empty $ ImplType Map.empty $ TVar (TV 0) .-> TOptional (TVar $ TV 0) +boolTy = ForallTC [] Set.empty $ ImplType Map.empty $ typeBool + +emptyHash, oneHash, enumBoolHash :: VCObjectHash +emptyHash = builtinFunHash "empty" emptyTy +oneHash = builtinFunHash "one" oneTy +enumBoolHash = vcHash $ BuiltinEnumHash $ boolTy + +builtinFunHash :: Text -> TCScheme -> VCObjectHash +builtinFunHash n ty = vcHash $ BuiltinFunHash (Var () () LocalScope $ Expl $ ExtIdent $ Right n, ty) diff --git a/src/Inferno/Module/Cast.hs b/src/Inferno/Module/Cast.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Module/Cast.hs @@ -0,0 +1,294 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- TODO export only needed? +-- module Inferno.Module.Cast (FromValue, ToValue) where +module Inferno.Module.Cast where + +import Control.Monad.Except (MonadError (..)) +import Control.Monad.Reader (ask) +import Data.Int (Int64) +import qualified Data.Map as Map +import Data.Proxy (Proxy (..)) +import qualified Data.Set as Set +import Data.Text (Text, pack, unpack) +import Data.Typeable (Typeable, typeRep) +import Data.Word (Word16, Word32, Word64) +import Foreign.C.Types (CTime (..)) +import GHC.TypeLits (KnownSymbol, symbolVal) +import Inferno.Eval.Error (EvalError (CastError, NotFoundInImplicitEnv)) +import Inferno.Module.Builtin (enumBoolHash) +import Inferno.Types.Syntax (ExtIdent (..), Lit (..), TList (..)) +import Inferno.Types.Type (BaseType (..), InfernoType (..)) +import Inferno.Types.Value (ImplEnvM, ImplicitCast (..), Value (..)) +import Inferno.Utils.Prettyprinter (renderPretty) +import Prettyprinter (Pretty) + +type Either3 a b c = Either a (Either b c) + +type Either4 a b c d = Either a (Either3 b c d) + +type Either5 a b c d e = Either a (Either4 b c d e) + +type Either6 a b c d e f = Either a (Either5 b c d e f) + +type Either7 a b c d e f g = Either a (Either6 b c d e f g) + +-- | Types that can be converted to script values, allowing IO in the process. +class ToValue c m a where + toValue :: MonadError EvalError m => a -> m (Value c m) + +-- | Class of types that can be converted from script values. +class FromValue c m a where + fromValue :: MonadError EvalError m => (Value c m) -> m a + +-- | Haskell types that can be casted to mask script types. +class Kind0 a where + toType :: Proxy a -> InfernoType + +-- Instances + +couldNotCast :: forall c m a. (Pretty c, MonadError EvalError m, Typeable a) => Value c m -> m a +couldNotCast v = + throwError $ + CastError $ + "Could not cast value " <> (unpack $ renderPretty v) + <> " to " + <> (show $ typeRep (Proxy :: Proxy a)) + +instance ToValue c m (m (Value c m)) where + toValue = id + +instance ToValue c m (Value c m) where + toValue = pure + +instance FromValue c m (Value c m) where + fromValue = pure + +instance ToValue c m Lit where + toValue l = pure $ case l of + LInt i -> VInt i + LDouble x -> VDouble x + LText t -> VText t + LHex w -> VWord64 w + +instance ToValue c m Bool where + toValue True = pure $ VEnum enumBoolHash "true" + toValue False = pure $ VEnum enumBoolHash "false" + +instance Pretty c => FromValue c m Bool where + fromValue (VEnum hash ident) = + if hash == enumBoolHash + then + if ident == "true" + then pure True + else pure False + else couldNotCast $ (VEnum hash ident :: Value c m) + fromValue v = couldNotCast v + +instance ToValue c m Double where + toValue = pure . VDouble + +instance Pretty c => FromValue c m Double where + fromValue (VDouble x) = pure x + -- fromValue (VInt x) = pure $ fromIntegral x + fromValue v = couldNotCast v + +instance ToValue c m Int64 where + toValue = pure . VInt + +instance Pretty c => FromValue c m Int64 where + fromValue (VInt x) = pure x + fromValue v = couldNotCast v + +instance ToValue c m Int where + toValue = toValue . (fromIntegral :: Int -> Int64) + +instance Pretty c => FromValue c m Int where + fromValue v = do + i <- fromValue v `catchError` (\_ -> couldNotCast v) + if (i :: Int64) < fromIntegral (minBound :: Int) || i > fromIntegral (maxBound :: Int) + then couldNotCast v + else pure $ fromIntegral i + +instance ToValue c m Integer where + toValue = pure . VInt . fromInteger + +instance Pretty c => FromValue c m Integer where + fromValue (VInt x) = pure $ fromIntegral x + fromValue v = couldNotCast v + +instance ToValue c m Word16 where + toValue = pure . VWord16 + +instance Pretty c => FromValue c m Word16 where + fromValue (VWord16 w) = pure w + fromValue v = couldNotCast v + +instance ToValue c m Word32 where + toValue = pure . VWord32 + +instance Pretty c => FromValue c m Word32 where + fromValue (VWord32 w) = pure w + fromValue v = couldNotCast v + +instance ToValue c m Word64 where + toValue = pure . VWord64 + +instance Pretty c => FromValue c m Word64 where + fromValue (VWord64 w) = pure w + fromValue v = couldNotCast v + +instance ToValue c m () where + toValue _ = pure $ VTuple [] + +instance Pretty c => FromValue c m () where + fromValue (VTuple []) = pure () + fromValue v = couldNotCast v + +instance ToValue c m CTime where + toValue = pure . VEpochTime + +instance Pretty c => FromValue c m CTime where + fromValue (VEpochTime t) = pure t + fromValue v = couldNotCast v + +instance ToValue c m Text where + toValue = pure . VText + +instance Pretty c => FromValue c m Text where + fromValue (VText t) = pure t + fromValue v = couldNotCast v + +instance Kind0 Bool where + toType _ = TBase $ TEnum "bool" $ Set.fromList ["true", "false"] + +instance Kind0 Float where + toType _ = TBase $ TDouble + +instance Kind0 Double where + toType _ = TBase $ TDouble + +instance Kind0 Int where + toType _ = TBase $ TInt + +instance Kind0 Int64 where + toType _ = TBase $ TInt + +instance Kind0 Integer where + toType _ = TBase $ TInt + +instance Kind0 Word16 where + toType _ = TBase $ TWord16 + +instance Kind0 Word32 where + toType _ = TBase $ TWord32 + +instance Kind0 Word64 where + toType _ = TBase $ TWord64 + +instance Kind0 () where + toType _ = TTuple TNil + +instance Kind0 CTime where + toType _ = TBase $ TTime + +instance Kind0 Text where + toType _ = TBase $ TText + +instance (Kind0 a, Kind0 b) => Kind0 (a -> b) where + toType _ = TArr (toType (Proxy :: Proxy a)) (toType (Proxy :: Proxy b)) + +instance (Kind0 a) => Kind0 [a] where + toType _ = TArray (toType (Proxy :: Proxy a)) + +instance (FromValue c m a, ToValue c m b) => ToValue c m (a -> b) where + toValue f = pure $ + VFun $ \v -> do + x <- fromValue v + toValue $ f x + +instance (Monad m, FromValue c (ImplEnvM m c) a1, FromValue c (ImplEnvM m c) a2, ToValue c (ImplEnvM m c) a3, KnownSymbol lbl) => ToValue c (ImplEnvM m c) (ImplicitCast lbl a1 a2 a3) where + toValue (ImplicitCast f) = pure $ + VFun $ \b' -> do + impl <- ask + let i = ExtIdent $ Right $ pack $ symbolVal (Proxy :: Proxy lbl) + case Map.lookup i impl of + Just v -> do + x <- fromValue v + b <- fromValue b' + toValue $ f x b + Nothing -> throwError $ NotFoundInImplicitEnv i + +-- | In this instance, the 'IO' in the type is ignored. +instance Kind0 a => Kind0 (IO a) where + toType _ = toType (Proxy :: Proxy a) + +instance ToValue c m a => ToValue c m (Maybe a) where + toValue (Just x) = VOne <$> toValue x + toValue _ = pure VEmpty + +instance (Typeable a, FromValue c m a, Pretty c) => FromValue c m (Maybe a) where + fromValue VEmpty = pure Nothing + fromValue (VOne v) = Just <$> fromValue v + fromValue v = couldNotCast v + +instance Kind0 a => Kind0 (Maybe a) where + toType _ = TOptional (toType (Proxy :: Proxy a)) + +instance (ToValue c m a, ToValue c m b) => ToValue c m (Either a b) where + toValue (Left x) = toValue x + toValue (Right x) = toValue x + +instance ToValue c m a => ToValue c m [a] where + toValue xs = VArray <$> (mapM toValue xs) + +instance (Typeable a, FromValue c m a, Pretty c) => FromValue c m [a] where + fromValue (VArray vs) = mapM fromValue vs + fromValue v = couldNotCast v + +instance (FromValue c m a, FromValue c m b) => FromValue c m (Either a b) where + fromValue v = (Left <$> fromValue v) `catchError` (\_ -> Right <$> fromValue v) + +instance Kind0 (Either a b) where + toType _ = error "Definitions with Either must have explicit type signature" + +-- instance ToValue IO a => ToValue IO (IO a) where +-- toValue io = io >>= toValue + +-- instance FromValue m a => FromValue m (IO a) where +-- fromValue = fmap pure . fromValue + +-- instance FromValue m (EitherN '[]) where +-- fromValue v = undefined + +-- instance (FromValue m a, FromValue m (EitherN as)) => FromValue m (EitherN (a ': as)) where +-- fromValue v = (Here <$> fromValue v) `catchError` (\_ -> Next <$> fromValue v) + +-- instance ToValue m (EitherN '[]) where +-- toValue = undefined + +-- instance (ToValue m a, ToValue m (EitherN as)) => ToValue m (EitherN (a ': as)) where +-- toValue (Here x) = toValue x +-- toValue (Next x) = toValue x + +-- serializeToDouble :: MonadError EvalError m => Env -> Value m' -> m Double +-- serializeToDouble TypeEnv{..} = \case +-- VInt i -> return $ fromIntegral i +-- VDouble d -> return d +-- VEnum "true" -> return 1.0 +-- VEnum "false" -> return 0.0 +-- VEnum e -> case Map.lookup e enums of +-- Just (EnumMeta _ _ cs _) -> case fromIntegral <$> elemIndex e cs of +-- Just d -> return d +-- Nothing -> throwError $ RuntimeError $ "Malformed environment! Could not find enum constructor in the list" +-- Just _ -> throwError $ RuntimeError $ "Malformed environment! Was expecting enum metadata" +-- Nothing -> throwError $ CastError $ "Enum #" <> Text.unpack e <> " could not be found in the environment." +-- VWord16 w -> return $ fromIntegral w +-- VWord32 w -> return $ fromIntegral w +-- VWord64 w -> return $ fromIntegral w + +-- -- deserializeFromDouble :: MonadError EvalError m => Env -> Double -> InfernoType -> m (Value m') +-- -- deserializeFromDouble env d = \case +-- -- TBase TInt -> return $ VInt $ diff --git a/src/Inferno/Module/Prelude.hs b/src/Inferno/Module/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Module/Prelude.hs @@ -0,0 +1,658 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Inferno.Module.Prelude where + +import Control.Monad.Except (MonadError) +import qualified Data.IntMap as IntMap +import qualified Data.Map as Map +import Inferno.Eval (TermEnv) +import Inferno.Eval.Error (EvalError) +import qualified Inferno.Infer.Pinned as Pinned +import Inferno.Module (Module (..), PinnedModule, combineTermEnvs, pinnedModuleHashToTy, pinnedModuleNameToHash) +import Inferno.Module.Builtin (builtinModule) +import Inferno.Module.Cast (Kind0 (toType), ToValue (toValue)) +import Inferno.Module.Prelude.Defs + ( absFun, + andFun, + appendText, + arcCosFun, + arcSinFun, + arcTanFun, + argmaxFun, + argminFun, + argsortFun, + averageFun, + ceilingFun, + clearBitFun, + complementBitFun, + complementFun, + cosFun, + coshFun, + dayFun, + daysBeforeFun, + daysFun, + divFun, + doubleToInt, + enumFromToInt64, + eqFun, + expFun, + floorFun, + foldlFun, + foldrFun, + formatTime, + fromWordFun, + geqFun, + gtFun, + hourFun, + hoursBeforeFun, + hoursFun, + idFun, + intToDouble, + keepSomesFun, + lengthFun, + leqFun, + limitFun, + lnFun, + logBaseFun, + logFun, + ltFun, + magnitudeFun, + maxFun, + maximumFun, + minFun, + minimumFun, + minutesBeforeFun, + minutesFun, + modFun, + monthFun, + monthsBeforeFun, + mulFun, + negateFun, + neqFun, + normFun, + orFun, + piFun, + powFun, + recipFun, + roundFun, + roundToFun, + secondsBeforeFun, + secondsFun, + setBitFun, + shiftFun, + sinFun, + singletonFun, + sinhFun, + sqrtFun, + stripText, + subFun, + sumFun, + tanFun, + tanhFun, + testBitFun, + textLength, + textSplitAt, + timeIntervalFun, + timeToInt, + toWord16Fun, + toWord32Fun, + toWord64Fun, + truncateFun, + truncateToFun, + weeksBeforeFun, + weeksFun, + xorFun, + yearFun, + yearsBeforeFun, + zeroFun, + ) +import Inferno.Parse (OpsTable) +import Inferno.Types.Syntax (ModuleName, Scoped (..)) +import Inferno.Types.Type (Namespace, TCScheme, TypeMetadata) +import Inferno.Types.Value (ImplEnvM) +import Inferno.Types.VersionControl (Pinned (..), VCObjectHash) +import Inferno.Utils.QQ.Module (infernoModules) +import Prettyprinter (Pretty) + +type ModuleMap m c = Map.Map ModuleName (PinnedModule (ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c)))) + +baseOpsTable :: forall m c. (MonadError EvalError m, Pretty c, Eq c) => ModuleMap m c -> OpsTable +baseOpsTable moduleMap = + let Module {moduleOpsTable = ops, moduleName = modNm} = moduleMap Map.! "Base" + in IntMap.unionWith (<>) ops (IntMap.map (\xs -> [(fix, Scope modNm, op) | (fix, _, op) <- xs]) ops) + +builtinModulesOpsTable :: forall m c. (MonadError EvalError m, Pretty c, Eq c) => ModuleMap m c -> Map.Map ModuleName OpsTable +builtinModulesOpsTable moduleMap = Map.map (\Module {moduleOpsTable} -> moduleOpsTable) $ moduleMap + +builtinModulesPinMap :: forall m c. (MonadError EvalError m, Pretty c, Eq c) => ModuleMap m c -> Map.Map (Scoped ModuleName) (Map.Map Namespace (Pinned VCObjectHash)) +builtinModulesPinMap moduleMap = + Pinned.openModule "Base" $ + Pinned.insertBuiltinModule $ + Map.foldrWithKey Pinned.insertHardcodedModule mempty $ + Map.map (Map.map Builtin . pinnedModuleNameToHash) $ + moduleMap + +builtinModulesTerms :: forall m c. (MonadError EvalError m, Pretty c, Eq c) => ModuleMap m c -> ImplEnvM m c (TermEnv VCObjectHash c (ImplEnvM m c)) +builtinModulesTerms moduleMap = combineTermEnvs moduleMap + +preludeNameToTypeMap :: forall m c. (MonadError EvalError m, Pretty c, Eq c) => ModuleMap m c -> Map.Map (Maybe ModuleName, Namespace) (TypeMetadata TCScheme) +preludeNameToTypeMap moduleMap = + let unqualifiedN2h = pinnedModuleNameToHash $ moduleMap Map.! "Base" + n2h = + Map.unions $ + (Map.mapKeys (Nothing,) $ pinnedModuleNameToHash builtinModule) : + (Map.mapKeys (Nothing,) $ unqualifiedN2h) : + [Map.mapKeys (Just nm,) $ (pinnedModuleNameToHash m `Map.difference` unqualifiedN2h) | (nm, m) <- Map.toList $ moduleMap] + h2ty = Map.unions $ pinnedModuleHashToTy builtinModule : [pinnedModuleHashToTy m | m <- Map.elems $ moduleMap] + in Map.mapMaybe (\h -> Map.lookup h h2ty) n2h + +-- In the definitions below, ###!x### is an anti-quotation to a haskell variable `x` of type `Monad m => (Value m)` +-- This sort of Value is necessary for polymorphic functions such as `map` or `id` +-- The inferno type of this function must be explicitly specified, otherwise a runtime error will occur when typechecking + +-- ###x### is an anti-quotation for `x` for which there is a `ToValue` instance. +-- In most cases, the type of a monomorphic `x` can be automatically derived via the `Kind0` typeclass, +-- however, you must write the type explicitly when converting ad-hoc polymorphic functions such as (+) +-- as these require an accompanying definition of a typeclass, via the syntax: +-- `define typeclass_name on t1 ... tn;`. + +builtinModules :: (MonadError EvalError m, Pretty c, Eq c) => ModuleMap m c +builtinModules = + [infernoModules| + +module Number + + @doc The identity function; + id : forall 'a. 'a -> 'a := ###!idFun###; + + infixr 11 **; + + infixl 10 *; + infixl 10 /; + infixl 10 %; + + infixl 9 +; + infixl 9 -; + + prefix 19 -; + + define addition on int int int; + define addition on int double double; + define addition on double int double; + define addition on double double double; + define addition on time timeDiff time; + define addition on timeDiff time time; + define addition on timeDiff timeDiff timeDiff; + define addition on word16 word16 word16; + define addition on word16 word32 word32; + define addition on word32 word16 word32; + define addition on word32 word32 word32; + define addition on word16 word64 word64; + define addition on word64 word16 word64; + define addition on word32 word64 word64; + define addition on word64 word32 word64; + define addition on word64 word64 word64; + + + @doc Addition on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + (+) : forall 'a 'b 'c. {requires addition on 'a 'b 'c} => 'a -> 'b -> 'c := ###sumFun###; + + define subtraction on int int int; + define subtraction on int double double; + define subtraction on double int double; + define subtraction on double double double; + define subtraction on time timeDiff time; + define subtraction on timeDiff timeDiff timeDiff; + define subtraction on word16 word16 word16; + define subtraction on word32 word32 word32; + define subtraction on word64 word64 word64; + + @doc Subtraction on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + (-) : forall 'a 'b 'c. {requires subtraction on 'a 'b 'c} => 'a -> 'b -> 'c := ###subFun###; + + define division on int int int; + define division on int double double; + define division on double int double; + define division on double double double; + + @doc Division on `int`, `double`; + (/) : forall 'a 'b 'c. {requires division on 'a 'b 'c} => 'a -> 'b -> 'c := ###divFun###; + + define multiplication on int int int; + define multiplication on int double double; + define multiplication on double int double; + define multiplication on double double double; + define multiplication on int timeDiff timeDiff; + define multiplication on timeDiff int timeDiff; + + @doc Multiplication on `int`, `double`; + (*) : forall 'a 'b 'c. {requires multiplication on 'a 'b 'c} => 'a -> 'b -> 'c := ###mulFun###; + + @doc Reciprocal fraction; + recip : double -> double := ###recipFun###; + + define power on int; + define power on double; + + @doc `x ** y` raises `x` to the power of `y`, where the arguments are `int` or `double`; + (**) : forall 'a. {requires power on 'a} => 'a -> 'a -> 'a := ###powFun###; + + @doc Square root; + sqrt : double -> double := ###sqrtFun###; + + @doc Exponential function; + exp : double -> double := ###expFun###; + + @doc Natural logarithm; + ln : double -> double := ###lnFun###; + + @doc Logarithm with base `10`; + log : double -> double := ###logFun###; + + @doc Logarithm with base `b`; + logBase : double -> double -> double := ###logBaseFun###; + + define negate on int; + define negate on double; + define negate on timeDiff; + + @doc Negation (unary) on `int`, `double`, or `timeDiff`; + - : forall 'a. {requires negate on 'a} => 'a -> 'a := ###negateFun###; + + define abs on int; + define abs on double; + define abs on timeDiff; + + @doc Absolute value (sometimes written |x|) on `int`, `double`, or `timeDiff`; + abs : forall 'a. {requires abs on 'a} => 'a -> 'a := ###absFun###; + + (%) : int -> int -> int := ###modFun###; + + define roundable on double; + define roundable on int; + + @doc Floor function (rounds down to nearest integer); + floor : forall 'a. {requires roundable on 'a} => 'a -> int := ###floorFun###; + + @doc Ceiling function (rounds up to nearest integer); + ceiling : forall 'a. {requires roundable on 'a} => 'a -> int := ###ceilingFun###; + + @doc `round x` returns the nearest integer to `x` + (the even integer if `x` is equidistant between two integers); + round : forall 'a. {requires roundable on 'a} => 'a -> int := ###roundFun###; + + @doc `roundTo d x` rounds `x` to `d` decimal places; + roundTo : int -> double -> double := ###roundToFun###; + + @doc `truncate x` returns the integer nearest `x` between zero and `x`; + truncate : forall 'a. {requires roundable on 'a} => 'a -> int := ###truncateFun###; + + @doc `truncateTo d x` truncates `x` to `d` decimal places; + truncateTo : int -> double -> double := ###truncateToFun###; + + @doc `limit l u x = min l (max x u)` limits `x` to be between `l` and `u`; + limit : double -> double -> double -> double := ###limitFun###; + + @doc Pi (`3.14159... :: double`), the constant; + pi : double := ###piFun###; + + @doc Sine (trigonometric function) of a `double`; + sin : double -> double := ###sinFun###; + + @doc Hyperbolic sine (trigonometric function) of a `double`; + sinh : double -> double := ###sinhFun###; + + @doc Inverse sine (trigonometric function) of a `double`; + arcSin : double -> double := ###arcSinFun###; + + @doc Cosine (trigonometric function), on `double`; + cos : double -> double := ###cosFun###; + + @doc Hyperbolic cosine (trigonometric function) of a `double`; + cosh : double -> double := ###coshFun###; + + @doc Inverse cosine (trigonometric function) of a `double`; + arcCos : double -> double := ###arcCosFun###; + + @doc Tan (trigonometric function), on `double`; + tan : double -> double := ###tanFun###; + + @doc Hyperbolic tangent (trigonometric function) of a `double`; + tanh : double -> double := ###tanhFun###; + + @doc Inverse tan (trigonometric function) of a `double`; + arcTan : double -> double := ###arcTanFun###; + + @doc Convert int to double; + intToDouble : int -> double := ###intToDouble###; + + @doc Convert double to int; + doubleToInt : double -> int := ###doubleToInt###; + + // TODO how to deal with IO? + // @doc A (pseudo)random `double`; + // random : unit -> double := ###randomFun###; + +module Option + @doc `Option.reduce f o d` unwraps an optional value `o` and applies `f` to it, if o contains a `Some` value. Otherwise it returns the default value `d`. + ~~~inferno + Option.reduce (fun str -> `${str} there!`) "hi" (Some "hello") == "hello there!" + Option.reduce (fun str -> `${str} there!`) "hi" None == "hi" + ~~~; + reduce : forall 'a 'b. ('a -> 'b) -> 'b -> option of 'a -> 'b := + fun f b ma -> match ma with { + | Some a -> f a + | None -> b + }; + + @doc `Option.map f ma` applies `f` to the value inside `ma`, namely if `ma` is `Some a`, it will return `Some (f a)`.; + map : forall 'a 'b. ('a -> 'b) -> option of 'a -> option of 'b := + fun f ma -> match ma with { + | Some a -> Some (f a) + | None -> None + }; + singleton : forall 'a. 'a -> option of 'a := fun a -> Some a; + + @doc Given a tuple `(Some x , Some y)`, `Option.mergeTuple`` returns `Some (x , y)` otherwise it returns `None`.; + mergeTuple : forall 'a 'b. (option of 'a, option of 'b) -> option of ('a, 'b) := + fun ab -> match ab with { + | (Some a , Some b) -> Some (a , b) + | _ -> None + }; + +module Array + + @doc This function can be used to create an array with a single element: + ~~~inferno + singleton 2 + ~~~; + singleton : forall 'a. 'a -> array of 'a := ###!singletonFun###; + + length : forall 'a. array of 'a -> int := ###!lengthFun###; + + @doc The minimum value in an array; + minimum: forall 'a. array of 'a -> double := ###!minimumFun###; + + @doc The maximum value in an array; + maximum: forall 'a. array of 'a -> double := ###!maximumFun###; + + @doc The average of the values in an array; + average: forall 'a. array of 'a -> double := ###!averageFun###; + + @doc The index of the minimum value in an array; + argmin: forall 'a. array of 'a -> int := ###!argminFun###; + + @doc The index of the maximum value in an array; + argmax: forall 'a. array of 'a -> int := ###!argmaxFun###; + + @doc Returns the indices that would sort an array; + argsort: forall 'a. array of 'a -> array of int := ###!argsortFun###; + + @doc Returns the Euclidean norm of an array; + magnitude: forall 'a. array of 'a -> double := ###!magnitudeFun###; + + @doc Returns the Euclidean norm of an array; + norm: forall 'a. array of 'a -> double := ###!normFun###; + + @doc The `Array.range` function takes two `int` arguments `n` and `m` and produces an array `[n,...,m]`. + If `m` > `n`, the empty array is returned.; + range := ###enumFromToInt64###; + + @doc The `Array.map` function takes a function `f` and an array of elements and applies `f` to each one; + map := fun f xs -> [f x | x <- xs]; + + @doc `Array.keepSomes` discards any `None` values in an array and unwaps all `Some`s. + ~~~inferno + Array.keepSomes [None, Some "hello", None, Some "world"] = ["hello", "world"] + ~~~; + keepSomes : forall 'a. array of (option of 'a) -> array of 'a := ###!keepSomesFun###; + + reduce : forall 'a 'b. ('b -> 'a -> 'b) -> 'b -> array of 'a -> 'b := ###!foldlFun###; + reduceRight : forall 'a 'b. ('a -> 'b -> 'b) -> 'b -> array of 'a -> 'b := ###!foldrFun###; + + define zero on int; + define zero on double; + define zero on word16; + define zero on word32; + define zero on word64; + define zero on timeDiff; + + zero : forall 'a. {requires rep on 'a, requires zero on 'a} => 'a := ###!zeroFun###; + + @doc `Array.sum` computes the sum of elements in an array. The elements can be of type `int`/`double`/`word`.; + sum := reduce Number.(+) zero; + + findFirstSome : forall 'a. array of (option of 'a) -> option of 'a := + reduceRight + (fun a rest -> match a with { + | Some _ -> a + | None -> rest + }) + None; + findLastSome : forall 'a. array of (option of 'a) -> option of 'a := + reduce + (fun rest a -> match a with { + | Some _ -> a + | None -> rest + }) + None; + findFirstAndLastSome : forall 'a. array of (option of 'a) -> option of ('a, 'a) := + let firstLast = + reduce + (fun acc a -> match (a , acc) with { + | (Some _ , (None , _)) -> (a , a) + | (Some _ , (Some v , _)) -> (Some v , a) + | (None , _) -> acc + }) + (None, None) + in fun arr -> Option.mergeTuple (firstLast arr); + +module Text + + append : text -> text -> text := ###appendText###; + + length : text -> int := ###textLength###; + + strip : text -> text := ###stripText###; + + splitAt : int -> text -> (text, text) := ###!textSplitAt###; + +module Time + + toTime : timeDiff -> time := ###!idFun###; + + seconds : int -> timeDiff := ###secondsFun###; + + minutes : int -> timeDiff := ###minutesFun###; + + hours : int -> timeDiff := ###hoursFun###; + + days : int -> timeDiff := ###daysFun###; + + weeks : int -> timeDiff := ###weeksFun###; + + secondsBefore : time -> int -> time := ###secondsBeforeFun###; + + minutesBefore : time -> int -> time := ###minutesBeforeFun###; + + hoursBefore : time -> int -> time := ###hoursBeforeFun###; + + daysBefore : time -> int -> time := ###daysBeforeFun###; + + weeksBefore : time -> int -> time := ###weeksBeforeFun###; + + @doc Subtracts the given number of months, with days past the last day of the month clipped to the last day. For instance, 1 month before 2005-03-30 is 2005-02-28.; + monthsBefore : time -> int -> time := ###monthsBeforeFun###; + + @doc Subtracts the given number of years, with days past the last day of the month clipped to the last day. For instance, 2 years before 2006-02-29 is 2004-02-28.; + yearsBefore : time -> int -> time := ###yearsBeforeFun###; + + @doc Rounds down to the start of the nearest hour; + hour : time -> time := ###hourFun###; + + @doc Rounds down to the start of the nearest day; + day : time -> time := ###dayFun###; + + @doc Rounds down to the start of the nearest month; + month : time -> time := ###monthFun###; + + @doc Rounds down to the start of the nearest year; + year : time -> time := ###yearFun###; + + intervalEvery : timeDiff -> time -> time -> array of time := ###timeIntervalFun###; + + @doc Convert time to int (returned as seconds); + timeToInt : time -> int := ###timeToInt###; + + @doc Format time to string; + formatTime : time -> text -> text := ###formatTime###; + +module Word + + infixr 5 &&; + infixr 4 XOR; + infixr 3 ||; + + prefix 19 !; + + define bitlike on bool{#true, #false}; + define bitlike on word16; + define bitlike on word32; + define bitlike on word64; + + @doc Checks if the bit at the provided offset is set; + testBit : forall 'a. {requires bitlike on 'a} => 'a -> int -> bool{#true, #false} := ###testBitFun###; + + @doc Sets the bit at the provided offset to `1`; + setBit : forall 'a. {requires bitlike on 'a} => 'a -> int -> 'a := ###setBitFun###; + + @doc Clears the bit at the provided offset (i.e., sets it to `0`); + clearBit : forall 'a. {requires bitlike on 'a} => 'a -> int -> 'a := ###clearBitFun###; + + @doc Switches the bit at the provided offset (`0` to `1` or vice versa); + complementBit : forall 'a. {requires bitlike on 'a} => 'a -> int -> 'a := ###complementBitFun###; + + @doc `shift x i` shifts `x` left by `i` bits if `i` is positive, or right by `-i` bits otherwise. Right shifts perform sign extension on signed number types (i.e. they fill the top bits with `1` if `x` is negative and with `0` otherwise); + shift : forall 'a. {requires bitlike on 'a} => 'a -> int -> 'a := ###shiftFun###; + + @doc Bitwise AND; + (&&) : forall 'a. {requires bitlike on 'a} => 'a -> 'a -> 'a := ###andFun###; + + @doc Bitwise OR; + (||) : forall 'a. {requires bitlike on 'a} => 'a -> 'a -> 'a := ###orFun###; + + @doc Bitwise XOR; + (XOR) : forall 'a. {requires bitlike on 'a} => 'a -> 'a -> 'a := ###xorFun###; + + @doc Complements (switches 0s and 1s) all bits in the argument; + ! : forall 'a. {requires bitlike on 'a} => 'a -> 'a := ###complementFun###; + + define toWord64 on bool{#true, #false}; + define toWord64 on int; + define toWord64 on word16; + define toWord64 on word32; + define toWord64 on word64; + + @doc Convert an `int` or another word to a `word64`; + toWord64 : forall 'a. {requires toWord64 on 'a} => 'a -> word64 := ###toWord64Fun###; + + define toWord32 on bool{#true, #false}; + define toWord32 on int; + define toWord32 on word16; + define toWord32 on word32; + define toWord32 on word64; + + @doc Convert an `int` or another word to a `word32`, dropping bits if necessary; + toWord32 : forall 'a. {requires toWord32 on 'a} => 'a -> word32 := ###toWord32Fun###; + + define toWord16 on bool{#true, #false}; + define toWord16 on int; + define toWord16 on word16; + define toWord16 on word32; + define toWord16 on word64; + + @doc Convert an `int` or another word to a `word16`, dropping bits if necessary; + toWord16 : forall 'a. {requires toWord16 on 'a} => 'a -> word16 := ###toWord16Fun###; + + define fromWord on bool{#true, #false}; + define fromWord on word16; + define fromWord on word32; + define fromWord on word64; + + @doc Convert a word to an `int`; + fromWord : forall 'a. {requires fromWord on 'a} => 'a -> int := ###fromWordFun###; + +module Base + + infix 7 >=; + infix 7 >; + infix 7 <=; + infix 7 <; + infix 6 ==; + infix 6 !=; + infix 19 ..; + infix 5 ?; + + (..) := ###enumFromToInt64###; + + define order on int; + define order on double; + define order on time; + define order on timeDiff; + + @doc Ordering on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + (>) : forall 'a. {requires order on 'a} => 'a -> 'a -> bool{#true, #false} := ###gtFun###; + + @doc Ordering on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + (>=) : forall 'a. {requires order on 'a} => 'a -> 'a -> bool{#true, #false} := ###geqFun###; + + @doc Ordering on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + (<) : forall 'a. {requires order on 'a} => 'a -> 'a -> bool{#true, #false} := ###ltFun###; + + @doc Ordering on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + (<=) : forall 'a. {requires order on 'a} => 'a -> 'a -> bool{#true, #false} := ###leqFun###; + + @doc The equality function works on any value of the same type. Always returns `#false` for functions; + (==) : forall 'a. 'a -> 'a -> bool{#true, #false} := ###!eqFun###; + + @doc The (not) equals function works on any value of the same type. Always returns `#true` for functions; + (!=) : forall 'a. 'a -> 'a -> bool{#true, #false} := ###!neqFun###; + + @doc Minimum function on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + min : forall 'a. {requires order on 'a} => 'a -> 'a -> 'a := ###minFun###; + + @doc Maximum function on `int`, `double`, `word16/32/64`, `time` and `timeDiff`; + max : forall 'a. {requires order on 'a} => 'a -> 'a -> 'a := ###maxFun###; + + export Number; + export Word; + + + @doc The `fromOption` function unwraps an optional value, if given a default value to fall back on in case the value of the optional is `None`. + ~~~inferno + fromOption "hi" (Some "hello") == "hello" + fromOption "hi" None == "hi" + ~~~; + fromOption : forall 'a. 'a -> option of 'a -> 'a := + fun default ma -> match ma with { + | Some a -> a + | None -> default + }; + + @doc The `?` function unwraps an optional value, if given a default value to fall back on in case the value of the optional is `None`. + ~~~inferno + (Some "hello") ? "hi" == "hello" + None ? "hi" == "hi" + ~~~; + (?) : forall 'a. option of 'a -> 'a -> 'a := + fun ma default -> match ma with { + | Some a -> a + | None -> default + }; + +|] diff --git a/src/Inferno/Module/Prelude/Defs.hs b/src/Inferno/Module/Prelude/Defs.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Module/Prelude/Defs.hs @@ -0,0 +1,501 @@ +module Inferno.Module.Prelude.Defs where + +import Control.Monad (foldM) +import Control.Monad.Except (MonadError (throwError)) +import Data.Bifunctor (bimap) +import Data.Bits + ( clearBit, + complement, + complementBit, + setBit, + shift, + testBit, + xor, + (.&.), + (.|.), + ) +import Data.Foldable (foldrM, maximumBy, minimumBy) +import Data.Int (Int64) +import Data.List (sortOn) +import Data.Maybe (mapMaybe) +import Data.Ord (comparing) +import Data.Text (Text, pack, unpack) +import qualified Data.Text as Text +import Data.Time.Calendar (Day, addGregorianMonthsClip, addGregorianYearsClip, fromGregorian, toGregorian) +import Data.Time.Clock (DiffTime, UTCTime (..), diffTimeToPicoseconds, picosecondsToDiffTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) +import qualified Data.Time.Format as Time.Format +import Data.Word (Word16, Word32, Word64) +import Debug.Trace (trace) +import Foreign.C.Types (CTime (..)) +import Foreign.Marshal.Utils (fromBool) +import Inferno.Eval.Error (EvalError (RuntimeError)) +import Inferno.Module.Builtin (enumBoolHash) +import Inferno.Module.Cast (Either3, Either4, Either5, Either6) +import Inferno.Types.Type (BaseType (..), InfernoType (..)) +import Inferno.Types.Value (Value (..)) +import Inferno.Utils.Prettyprinter (renderPretty) +import Prettyprinter (Pretty) +import System.Posix.Types (EpochTime) + +zeroVal :: Value c m +zeroVal = VInt 0 + +secondsFun, minutesFun, hoursFun, daysFun, weeksFun, monthsFun, yearsFun :: Int64 -> CTime +secondsFun = CTime . fromIntegral +minutesFun = timeMultiplier 60 +hoursFun = timeMultiplier 3600 +daysFun = timeMultiplier 86400 +weeksFun = timeMultiplier 604800 +monthsFun = timeMultiplier 2592000 +yearsFun = timeMultiplier 31536000 + +hourFun, dayFun, monthFun, yearFun :: CTime -> CTime +hourFun = mapEpochAsUTC $ \(UTCTime d diff) -> UTCTime d $ hourDiffTime diff +dayFun = mapEpochAsUTC midnightUTCTime +monthFun = mapEpochAsUTC $ mapUTCTimeDay truncateMonth +yearFun = mapEpochAsUTC $ mapUTCTimeDay truncateYear + +mapUTCTimeDay :: (Day -> Day) -> (UTCTime -> UTCTime) +mapUTCTimeDay f (UTCTime d diff) = UTCTime (f d) diff + +mapEpochAsUTC :: (UTCTime -> UTCTime) -> (CTime -> CTime) +mapEpochAsUTC f = CTime . round . utcTimeToPOSIXSeconds . f . posixSecondsToUTCTime . realToFrac + +midnightUTCTime :: UTCTime -> UTCTime +midnightUTCTime (UTCTime d _) = UTCTime d 0 + +-- | Truncate a 'DiffTime' to the beginning of the hour. +hourDiffTime :: DiffTime -> DiffTime +hourDiffTime t = + -- Note: one second is 10^12 picoseconds + let hourlength = 60 * 60 * 10 ^ (12 :: Int) + in picosecondsToDiffTime $ hourlength * div (diffTimeToPicoseconds t) hourlength + +truncateMonth :: Day -> Day +truncateMonth day = + let (y, m, _) = toGregorian day + in fromGregorian y m 1 + +truncateYear :: Day -> Day +truncateYear day = + let (y, _, _) = toGregorian day + in fromGregorian y 1 1 + +secondsBeforeFun, minutesBeforeFun, hoursBeforeFun, daysBeforeFun, weeksBeforeFun :: CTime -> Int64 -> CTime +secondsBeforeFun t i = t - (secondsFun i) +minutesBeforeFun t i = t - (minutesFun i) +hoursBeforeFun t i = t - (hoursFun i) +daysBeforeFun t i = t - (daysFun i) +weeksBeforeFun t i = t - (weeksFun i) + +monthsBeforeFun, yearsBeforeFun :: CTime -> Integer -> CTime +monthsBeforeFun t m = advanceMonths (negate m) t +yearsBeforeFun t y = advanceYears (negate y) t + +advanceMonths :: Integer -> EpochTime -> EpochTime +advanceMonths months = mapEpochAsUTC $ \(UTCTime d diff) -> UTCTime (addGregorianMonthsClip months d) diff + +advanceYears :: Integer -> EpochTime -> EpochTime +advanceYears years = mapEpochAsUTC $ \(UTCTime d diff) -> UTCTime (addGregorianYearsClip years d) diff + +timeIntervalFun :: CTime -> CTime -> CTime -> [CTime] +timeIntervalFun every from to = [from, from + every .. to] + +timeMultiplier :: CTime -> Int64 -> CTime +timeMultiplier t m = t * fromIntegral m + +timeToInt :: CTime -> Int64 +timeToInt (CTime t) = fromIntegral t + +formatTime :: CTime -> Text -> Text +formatTime t f = + let t1 = posixSecondsToUTCTime $ realToFrac t + in pack $ Time.Format.formatTime Time.Format.defaultTimeLocale (unpack f) t1 + +keepSomesFun :: (MonadError EvalError m) => Value c m +keepSomesFun = + VFun $ \case + VArray xs -> + pure $ + VArray $ + foldr + ( \v vs -> case v of + VOne a -> a : vs + _ -> vs + ) + [] + xs + _ -> throwError $ RuntimeError "keepSomes: expecting an array" + +foldlFun :: (MonadError EvalError m) => Value c m +foldlFun = + VFun $ \case + VFun f -> + return $ + VFun $ \z -> return $ + VFun $ \case + VArray xs -> + foldM + ( \acc x -> + f acc >>= \case + VFun f' -> f' x + _ -> throwError $ RuntimeError "reduce: expecting a function when folding" + ) + z + xs + _ -> throwError $ RuntimeError "reduce: expecting an array in the third argument" + _ -> throwError $ RuntimeError "reduce: expecting a function in the first argument" + +foldrFun :: (MonadError EvalError m) => Value c m +foldrFun = + VFun $ \case + VFun f -> + return $ + VFun $ \z -> return $ + VFun $ \case + VArray xs -> + foldrM + ( \x acc -> + f x >>= \case + VFun f' -> f' acc + _ -> throwError $ RuntimeError "reduceRight: expecting a function when folding" + ) + z + xs + _ -> throwError $ RuntimeError "reduceRight: expecting an array in the third argument" + _ -> throwError $ RuntimeError "reduceRight: expecting a function in the first argument" + +traceFun :: (Monad m, Pretty c) => (Value c m) +traceFun = VFun $ \msg -> trace ("TRACE: " <> unpack (renderPretty msg)) $ return idFun + +idFun :: Monad m => (Value c m) +idFun = VFun $ \x -> return x + +eqFun :: (Monad m, Eq c) => (Value c m) +eqFun = VFun $ \x -> return $ VFun $ \y -> return $ if x == y then VEnum enumBoolHash "true" else VEnum enumBoolHash "false" + +neqFun :: (Monad m, Eq c) => (Value c m) +neqFun = VFun $ \x -> return $ VFun $ \y -> return $ if x == y then VEnum enumBoolHash "false" else VEnum enumBoolHash "true" + +enumFromToInt64 :: Int64 -> Int64 -> [Int64] +enumFromToInt64 = enumFromTo + +sumFun :: + Either6 Double Int64 EpochTime Word16 Word32 Word64 -> + Either6 + (Either Double Int64 -> Double) + (Either Double Int64 -> Either Double Int64) + (EpochTime -> EpochTime) + (Word16 -> Word16) + (Word32 -> Word32) + (Word64 -> Word64) +sumFun = + bimap (\x -> either ((+) x) ((+) x . fromIntegral)) $ + bimap (\i -> bimap ((+) $ fromIntegral i) ((+) i)) $ + bimap (+) $ bimap (+) $ bimap (+) (+) + +divFun :: + Either Double Int64 -> + Either + (Either Double Int64 -> Double) + (Either Double Int64 -> Either Double Int64) +divFun = + bimap (\x -> either ((/) x) ((/) x . fromIntegral)) $ + (\i -> bimap ((/) $ fromIntegral i) ((div) i)) + +modFun :: Int64 -> Int64 -> Int64 +modFun = mod + +mulFun :: + Either3 Double Int64 EpochTime -> + Either3 + (Either Double Int64 -> Double) + (Either3 Double Int64 EpochTime -> Either3 Double Int64 EpochTime) + (Int64 -> EpochTime) +mulFun = + bimap (\x -> either ((*) x) ((*) x . fromIntegral)) $ + bimap + (\i -> bimap ((*) $ fromIntegral i) (bimap ((*) i) ((*) $ secondsFun i))) + (\x -> ((*) x . secondsFun)) + +subFun :: + Either6 Double Int64 EpochTime Word16 Word32 Word64 -> + Either6 + (Either Double Int64 -> Double) + (Either Double Int64 -> Either Double Int64) + (EpochTime -> EpochTime) + (Word16 -> Word16) + (Word32 -> Word32) + (Word64 -> Word64) +subFun = + bimap (\x -> either ((-) x) ((-) x . fromIntegral)) $ + bimap (\i -> bimap ((-) $ fromIntegral i) ((-) i)) $ + bimap (-) $ bimap (-) $ bimap (-) (-) + +recipFun :: Double -> Double +recipFun = recip + +powFun :: Either Int64 Double -> Either (Int64 -> Int64) (Double -> Double) +powFun = bimap (^) (**) + +expFun :: Double -> Double +expFun = exp + +lnFun :: Double -> Double +lnFun = log + +logFun :: Double -> Double +logFun = logBase 10 + +logBaseFun :: Double -> Double -> Double +logBaseFun = logBase + +sqrtFun :: Double -> Double +sqrtFun = sqrt + +negateFun :: Either3 Int64 Double EpochTime -> Either3 Int64 Double EpochTime +negateFun = bimap negate (bimap negate negate) + +absFun :: Either3 Int64 Double EpochTime -> Either3 Int64 Double EpochTime +absFun = bimap abs (bimap abs abs) + +floorFun :: Either Double Int64 -> Int64 +floorFun = either floor id + +ceilingFun :: Either Double Int64 -> Int64 +ceilingFun = either ceiling id + +roundFun :: Either Double Int64 -> Int64 +roundFun = either round id + +roundToFun :: Int64 -> Double -> Double +roundToFun n x = + let q = 10 ^ n + in fromIntegral (round (x * q) :: Int64) / q + +truncateFun :: Either Double Int64 -> Int64 +truncateFun = either truncate id + +truncateToFun :: Int64 -> Double -> Double +truncateToFun n x = + let q = 10 ^ n + in fromIntegral (truncate (x * q) :: Int64) / q + +limitFun :: Double -> Double -> Double -> Double +limitFun = (\l u -> min u . max l) + +piFun :: Double +piFun = pi + +sinFun :: Double -> Double +sinFun = sin + +sinhFun :: Double -> Double +sinhFun = sinh + +arcSinFun :: Double -> Double +arcSinFun = asin + +cosFun :: Double -> Double +cosFun = cos + +coshFun :: Double -> Double +coshFun = cosh + +arcCosFun :: Double -> Double +arcCosFun = acos + +tanFun :: Double -> Double +tanFun = tan + +tanhFun :: Double -> Double +tanhFun = tanh + +arcTanFun :: Double -> Double +arcTanFun = atan + +intToDouble :: Int64 -> Double +intToDouble = fromIntegral + +doubleToInt :: Double -> Int64 +doubleToInt = truncate + +-- random :: () -> IO Double -- TODO types? +-- random = const randomIO + +gtFun :: Either3 Int64 Double EpochTime -> Either3 (Int64 -> Bool) (Double -> Bool) (EpochTime -> Bool) +gtFun = bimap (>) (bimap (>) (>)) + +geqFun :: Either3 Int64 Double EpochTime -> Either3 (Int64 -> Bool) (Double -> Bool) (EpochTime -> Bool) +geqFun = bimap (>=) (bimap (>=) (>=)) + +ltFun :: Either3 Int64 Double EpochTime -> Either3 (Int64 -> Bool) (Double -> Bool) (EpochTime -> Bool) +ltFun = bimap (<) (bimap (<) (<)) + +leqFun :: Either3 Int64 Double EpochTime -> Either3 (Int64 -> Bool) (Double -> Bool) (EpochTime -> Bool) +leqFun = bimap (<=) (bimap (<=) (<=)) + +minFun :: Either3 Int64 Double EpochTime -> Either3 (Int64 -> Int64) (Double -> Double) (EpochTime -> EpochTime) +minFun = bimap (min) (bimap (min) (min)) + +maxFun :: Either3 Int64 Double EpochTime -> Either3 (Int64 -> Int64) (Double -> Double) (EpochTime -> EpochTime) +maxFun = bimap (max) (bimap (max) (max)) + +singletonFun :: Monad m => (Value c m) +singletonFun = VFun $ \v -> return $ VArray [v] + +-- The following functions use Int and not Int64, but that should be fine +-- because they don't create ints, these are only argument types. + +testBitFun :: Either3 Word16 Word32 Word64 -> Int -> Bool +testBitFun = either testBit (either testBit testBit) + +setBitFun :: Either3 Word16 Word32 Word64 -> Either3 (Int -> Word16) (Int -> Word32) (Int -> Word64) +setBitFun = bimap setBit (bimap setBit setBit) + +clearBitFun :: Either3 Word16 Word32 Word64 -> Either3 (Int -> Word16) (Int -> Word32) (Int -> Word64) +clearBitFun = bimap clearBit (bimap clearBit clearBit) + +complementBitFun :: Either3 Word16 Word32 Word64 -> Either3 (Int -> Word16) (Int -> Word32) (Int -> Word64) +complementBitFun = bimap complementBit (bimap complementBit complementBit) + +complementFun :: Either4 Bool Word16 Word32 Word64 -> Either4 Bool Word16 Word32 Word64 +complementFun = bimap not (bimap complement (bimap complement complement)) + +andFun :: Either4 Bool Word16 Word32 Word64 -> Either4 (Bool -> Bool) (Word16 -> Word16) (Word32 -> Word32) (Word64 -> Word64) +andFun = bimap (&&) (bimap (.&.) (bimap (.&.) (.&.))) + +orFun :: Either4 Bool Word16 Word32 Word64 -> Either4 (Bool -> Bool) (Word16 -> Word16) (Word32 -> Word32) (Word64 -> Word64) +orFun = bimap (||) (bimap (.|.) (bimap (.|.) (.|.))) + +xorFun :: Either4 Bool Word16 Word32 Word64 -> Either4 (Bool -> Bool) (Word16 -> Word16) (Word32 -> Word32) (Word64 -> Word64) +xorFun = bimap (xor) (bimap (xor) (bimap (xor) (xor))) + +shiftFun :: Either3 Word16 Word32 Word64 -> Either3 (Int -> Word16) (Int -> Word32) (Int -> Word64) +shiftFun = bimap shift (bimap shift shift) + +toWord64Fun :: Either5 Bool Word16 Word32 Word64 Int64 -> Word64 +toWord64Fun = either fromBool (either fromIntegral (either fromIntegral $ either id fromIntegral)) + +toWord32Fun :: Either5 Bool Word16 Word32 Word64 Int64 -> Word32 +toWord32Fun = either fromBool (either fromIntegral (either id (either (fromIntegral . (.&.) 0xFFFFFFFF) fromIntegral))) + +toWord16Fun :: Either5 Bool Word16 Word32 Word64 Int64 -> Word16 +toWord16Fun = either fromBool (either id (either (fromIntegral . (.&.) 0xFFFF) (either (fromIntegral . (.&.) 0xFFFF) fromIntegral))) + +fromWordFun :: Either4 Bool Word16 Word32 Word64 -> Int64 +fromWordFun = either fromBool (either fromIntegral (either fromIntegral fromIntegral)) + +zeroFun :: MonadError EvalError m => (Value c m) +zeroFun = VFun $ \case + VTypeRep (TBase TInt) -> return $ VInt 0 + VTypeRep (TBase TDouble) -> return $ VDouble 0 + VTypeRep (TBase TTimeDiff) -> return $ VEpochTime 0 + VTypeRep (TBase TWord16) -> return $ VWord16 0 + VTypeRep (TBase TWord32) -> return $ VWord32 0 + VTypeRep (TBase TWord64) -> return $ VWord64 0 + VTypeRep ty -> throwError $ RuntimeError $ "zeroFun: unexpected runtimeRep " <> show ty + _ -> throwError $ RuntimeError "zeroFun: expecting a runtimeRep" + +lengthFun :: (MonadError EvalError m) => Value c m +lengthFun = + VFun $ \case + VArray xs -> pure $ VInt $ fromIntegral $ length xs + _ -> throwError $ RuntimeError "length: expecting an array" + +-- | Convenience function for comparing numbered value +-- in an array while maintaining the original value type +keepNumberValues :: [Value c m] -> [(Value c m, Double)] +keepNumberValues = + mapMaybe + ( \case + m@(VInt v) -> Just (m, fromIntegral v) + m@(VDouble v) -> Just (m, v) + _ -> Nothing + ) + +minimumFun :: (MonadError EvalError m) => Value c m +minimumFun = + VFun $ \case + VArray [] -> throwError $ RuntimeError "minimum: expecting a non-empty array" + VArray xs -> return $ fst $ minimumBy (comparing snd) $ keepNumberValues xs + _ -> throwError $ RuntimeError "minimum: expecting an array" + +maximumFun :: (MonadError EvalError m) => Value c m +maximumFun = + VFun $ \case + VArray [] -> throwError $ RuntimeError "maximum: expecting a non-empty array" + VArray xs -> return $ fst $ maximumBy (comparing snd) $ keepNumberValues xs + _ -> throwError $ RuntimeError "maximum: expecting an array" + +averageFun :: (MonadError EvalError m) => Value c m +averageFun = + VFun $ \case + VArray [] -> throwError $ RuntimeError "average: expecting a non-empty array" + VArray xs -> return $ VDouble $ sum (mapMaybe toDouble xs) / fromIntegral (length xs) + _ -> throwError $ RuntimeError "average: expecting an array" + where + toDouble :: Value c m -> Maybe Double + toDouble = \case + VInt v -> Just $ fromIntegral v + VDouble v -> Just v + _ -> Nothing + +argminFun :: (MonadError EvalError m) => Value c m +argminFun = + VFun $ \case + VArray xs -> pure $ VInt $ fromIntegral $ argMin' $ map snd $ keepNumberValues xs + _ -> throwError $ RuntimeError "argmin: expecting an array" + where + argMin' :: [Double] -> Int + argMin' = fst . minimumBy (comparing snd) . zip [0 ..] + +argmaxFun :: (MonadError EvalError m) => Value c m +argmaxFun = + VFun $ \case + VArray xs -> pure $ VInt $ fromIntegral $ argMax' $ map snd $ keepNumberValues xs + _ -> throwError $ RuntimeError "argmax: expecting an array" + where + argMax' :: [Double] -> Int + argMax' = fst . maximumBy (comparing snd) . zip [0 ..] + +argsortFun :: (MonadError EvalError m) => Value c m +argsortFun = + VFun $ \case + VArray xs -> pure $ VArray $ argsort' $ keepNumberValues xs + _ -> throwError $ RuntimeError "argsort: expecting an array" + where + argsort' :: [(Value c m, Double)] -> [Value c m] + argsort' xs = map (VInt . fst) $ sortOn (snd . snd) $ zip [0 ..] xs + +magnitudeFun :: (MonadError EvalError m) => Value c m +magnitudeFun = + VFun $ \case + VDouble x -> pure $ VDouble $ abs x + VInt x -> pure $ VInt $ abs x + VArray xs -> pure $ VDouble $ sqrt $ sum $ map (\x -> x ** 2) $ map snd (keepNumberValues xs) + _ -> throwError $ RuntimeError "magnitude: expecting a number" + +normFun :: (MonadError EvalError m) => Value c m +normFun = magnitudeFun + +appendText :: Text -> Text -> Text +appendText = Text.append + +textLength :: Text -> Int64 +textLength = fromIntegral . Text.length + +stripText :: Text -> Text +stripText = Text.strip + +textSplitAt :: (MonadError EvalError m) => Value c m +textSplitAt = + VFun $ \case + VInt n -> pure $ + VFun $ \case + VText txt -> + let (a, b) = Text.splitAt (fromIntegral n) txt + in pure $ VTuple [VText a, VText b] + _ -> throwError $ RuntimeError "splitAt: expecting text for the second argument" + _ -> throwError $ RuntimeError "splitAt: expecting an int for the first argument" diff --git a/src/Inferno/Parse.hs b/src/Inferno/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Parse.hs @@ -0,0 +1,889 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +module Inferno.Parse + ( Comment (..), + OpsTable, + TopLevelDefn (..), + QQDefinition (..), + InfernoParsingError (..), + topLevel, + expr, + parseExpr, + parseType, + modulesParser, + prettyError, + rws, + ) +where + +import Control.Applicative (Alternative ((<|>))) +import Control.Monad (foldM, void, when) +import Control.Monad.Combinators.Expr + ( Operator (InfixL, InfixN, InfixR, Prefix), + makeExprParser, + ) +import Control.Monad.Reader (ReaderT (..), ask, withReaderT) +import Control.Monad.Writer (WriterT (..), tell) +import Data.Bifunctor (bimap) +import Data.Char (isAlphaNum, isSpace) +import Data.Data (Data) +import Data.Either (partitionEithers) +import qualified Data.IntMap as IntMap +import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NEList +import qualified Data.Map as Map +import Data.Monoid (Endo (..)) +import qualified Data.Set as Set +import Data.Text (Text, pack, singleton, unpack) +import qualified Data.Text as Text +import Debug.Trace +import Inferno.Infer.Env (closeOver) +import Inferno.Parse.Error (prettyError) +import Inferno.Types.Syntax + ( Comment (..), + Expr (..), + ExtIdent (ExtIdent), + Fixity (..), + Ident (Ident), + ImplExpl (Expl, Impl), + Import (..), + InfixFixity (..), + Lit (..), + ModuleName (..), + Pat (..), + Scoped (..), + SigVar (..), + TList (..), + fromEitherList, + fromScoped, + rws, + tListFromList, + ) +import Inferno.Types.Type + ( BaseType (..), + ImplType (..), + InfernoType (..), + TCScheme (..), + TV (TV), + TypeClass (TypeClass), + ) +import Text.Megaparsec + ( MonadParsec + ( eof, + hidden, + label, + notFollowedBy, + takeWhile1P, + takeWhileP, + try + ), + ParseError, + ParseErrorBundle (ParseErrorBundle), + Parsec, + ShowErrorComponent (..), + SourcePos (..), + anySingle, + attachSourcePos, + between, + customFailure, + errorOffset, + getSourcePos, + many, + manyTill, + optional, + runParser, + satisfy, + sepBy1, + some, + unPos, + (), + ) +import Text.Megaparsec.Char + ( alphaNumChar, + char, + char', + letterChar, + spaceChar, + string, + ) +import qualified Text.Megaparsec.Char.Lexer as Lexer + +-- | Converts a curried function to a function on a triple. +uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) +uncurry3 f ~(a, b, c) = f a b c + +type Comments = Endo [Comment SourcePos] + +output :: Comment SourcePos -> SomeParser r () +output x = tell $ Endo ([x] <>) + +type Parser = ReaderT (OpsTable, Map.Map ModuleName OpsTable) (WriterT Comments (Parsec InfernoParsingError Text)) + +type SomeParser r = ReaderT r (WriterT Comments (Parsec InfernoParsingError Text)) + +skipLineComment :: SomeParser r () +skipLineComment = do + startPos <- getSourcePos + comment <- string "//" *> takeWhileP (Just "character") (/= '\n') + endPos <- getSourcePos + output $ LineComment startPos (Text.strip comment) endPos + +skipBlockComment :: SomeParser r () +skipBlockComment = do + startPos@(SourcePos _ _ col) <- getSourcePos + comment <- string "/*" >> manyTill anySingle (string "*/") + endPos <- getSourcePos + output $ + BlockComment + startPos + (Text.replace (pack $ '\n' : List.replicate (unPos col - 1) ' ') "\n" $ Text.pack comment) + endPos + +sc :: SomeParser r () +sc = Lexer.space (void spaceChar) skipLineComment skipBlockComment + +lexeme :: SomeParser r a -> SomeParser r a +lexeme = Lexer.lexeme sc + +symbol :: Text -> SomeParser r Text +symbol = Lexer.symbol sc + +-- | 'parens' parses something between parenthesis. +parens :: SomeParser r a -> SomeParser r a +parens p = hidden $ between (symbol "(") (symbol ")") p + +-- | 'rword' for parsing reserved words. +rword :: Text -> SomeParser r () +rword w = string w *> notFollowedBy alphaNumCharOrSeparator *> sc + +isAlphaNumOrSeparator :: Char -> Bool +isAlphaNumOrSeparator c = isAlphaNum c || c == '_' +{-# INLINE isAlphaNumOrSeparator #-} + +alphaNumCharOrSeparator :: SomeParser r Char +alphaNumCharOrSeparator = satisfy isAlphaNumOrSeparator "alphanumeric character or '_'" +{-# INLINE alphaNumCharOrSeparator #-} + +variable :: Parser Text +variable = do + (opsTable, _) <- ask + try (p >>= check opsTable) + where + p = pack <$> (((:) <$> letterChar <*> hidden (many alphaNumCharOrSeparator)) "a variable") + check oT x = + if x `elem` rws ++ (map (\(_, _, i) -> i) $ concat oT) + then fail $ "Keyword " <> show x <> " cannot be a variable/function name" + else return x + +mIdent :: Parser (SourcePos, Maybe Ident) +mIdent = lexeme $ do + startPos <- getSourcePos + (startPos,) . Just . Ident <$> variable + <|> (char '_' *> takeWhileP Nothing isAlphaNumOrSeparator *> pure (startPos, Nothing)) "a wildcard parameter '_'" + +mExtIdent :: Parser (SourcePos, Maybe ExtIdent) +mExtIdent = lexeme $ do + startPos <- getSourcePos + (startPos,) . Just . ExtIdent . Right <$> variable + <|> (char '_' *> takeWhileP Nothing isAlphaNumOrSeparator *> pure (startPos, Nothing)) "a wildcard parameter '_'" + +implicitVariable :: Parser Text +implicitVariable = hidden $ char '?' *> (Text.cons <$> letterChar <*> takeWhileP Nothing isAlphaNumOrSeparator) + +enumConstructor :: SomeParser r Ident +enumConstructor = + Ident + <$> (char '#' *> takeWhile1P Nothing isAlphaNumOrSeparator) "an enum constructor\nfor example: #true, #false" + +-- | 'signedInteger' parses an integer with an optional sign (with no space) +signedInteger :: Num a => Parser a +signedInteger = Lexer.signed (takeWhileP Nothing isHSpace *> pure ()) Lexer.decimal + +-- | 'signedInteger' parses a float/double with an optional sign (with no space) +signedFloat :: Parser Double +signedFloat = Lexer.signed (takeWhileP Nothing isHSpace *> pure ()) Lexer.float + +enumE :: (SourcePos -> () -> Scoped ModuleName -> Ident -> f) -> Parser f +enumE f = do + startPos <- getSourcePos + lexeme $ try (f startPos () <$> (Scope . ModuleName <$> variable) <*> (char '.' *> enumConstructor)) <|> f startPos () LocalScope <$> enumConstructor <* notFollowedBy (char '.') + +implVarE :: Parser (Expr () SourcePos) +implVarE = do + startPos <- getSourcePos + lexeme $ Var startPos () LocalScope . Impl . ExtIdent . Right <$> implicitVariable + +-- | 'intE' and 'doubleE' parse unsigned numbers +intE, doubleE :: Parser (Expr () SourcePos) +intE = label "a number\nfor example: 42, 3.1415, (-6)" $ do + startPos <- getSourcePos + lexeme $ Lit startPos . LInt <$> Lexer.decimal +doubleE = label "a number\nfor example: 42, 3.1415, (-6)" $ do + startPos <- getSourcePos + lexeme $ Lit startPos . LDouble <$> Lexer.float + +hexadecimal :: (SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos) +hexadecimal f = label "a hexadecimal number\nfor example: 0xE907, 0XE907" $ do + startPos <- getSourcePos + lexeme $ f startPos . LHex <$> (char '0' *> char' 'x' *> Lexer.hexadecimal) + +signedIntE, signedDoubleE :: (SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos) +signedIntE f = label "a number\nfor example: 42, 3.1415, (-6)" $ do + startPos <- getSourcePos + lexeme $ f startPos . LInt <$> signedInteger +signedDoubleE f = label "a number\nfor example: 42, 3.1415, (-6)" $ do + startPos <- getSourcePos + lexeme $ f startPos . LDouble <$> signedFloat + +noneE :: (SourcePos -> a) -> Parser a +noneE e = label "an optional\nfor example: Some x, None" $ do + startPos <- getSourcePos + lexeme $ (const $ e startPos) <$> (hidden $ string "None") + +someE :: (SourcePos -> t -> a) -> Parser t -> Parser a +someE f p = label "an optional\nfor example: Some x, None" $ do + startPos <- getSourcePos + lexeme $ (hidden $ string "Some") + f startPos <$> p + +stringE :: (SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos) +stringE f = label "a string\nfor example: \"hello world\"" $ do + startPos <- getSourcePos + lexeme $ f startPos . LText . pack <$> (char '\"' *> manyTill charNoNewline (char '\"')) + where + charNoNewline = notFollowedBy (char '\n') *> Lexer.charLiteral + +interpolatedStringE, arrayComprE, arrayE :: Parser (Expr () SourcePos) +interpolatedStringE = label "an interpolated string\nfor example: `hello ${1 + 2}`" $ + lexeme $ do + startPos@(SourcePos _ _ col) <- getSourcePos + es <- mkInterpolatedString <$> (char '`' *> go) + endPos <- getSourcePos + return $ InterpolatedString startPos (fromEitherList $ fixSpacing (unPos col) es) endPos + where + go = + ([] <$ char '`') + <|> try (((:) . Left . singleton) <$> (hidden $ char '\\' *> char '\\') <*> go) + <|> try (((:) . Left . singleton) <$> (hidden $ char '\\' *> char '`') <*> go) + <|> try (((:) . Left . singleton) <$> (hidden $ char '\\' *> char '$') <*> go) + <|> ( ((:) . Right) + <$> ( hidden $ do + startPos <- getSourcePos + e <- char '$' *> char '{' *> sc *> expr <* char '}' + endPos <- getSourcePos + pure $ (startPos, e, endPos) + ) + <*> go + ) + <|> (((:) . Left . singleton) <$> Lexer.charLiteral <*> go) + + fixSpacing newlineSpaceLength = + map (bimap (Text.replace (pack $ '\n' : List.replicate (newlineSpaceLength - 1) ' ') "\n") id) +arrayComprE = label "array builder\nfor example: [n * 2 + 1 | n <- range 0 10, if n % 2 == 0]" $ + lexeme $ do + startPos <- getSourcePos + symbol "[" + e <- expr + midPos <- getSourcePos + symbol "|" + (sels, cond) <- rhsE + endPos <- getSourcePos + char ']' + return $ ArrayComp startPos e midPos (NEList.fromList sels) cond endPos + where + selectE :: Parser (SourcePos, Ident, SourcePos, Expr () SourcePos) + selectE = do + startPos <- getSourcePos + var <- lexeme $ Ident <$> variable + arrPos <- getSourcePos + e <- symbol "<-" *> expr + return (startPos, var, arrPos, e) + + rhsE :: Parser ([(SourcePos, Ident, SourcePos, Expr () SourcePos, Maybe SourcePos)], Maybe (SourcePos, Expr () SourcePos)) + rhsE = + try + ( do + (startPos, var, arrPos, e) <- selectE + pos <- getSourcePos <* symbol "," + (xs, mcond) <- try rhsE <|> (\c -> ([], Just c)) <$> condE + pure ((startPos, var, arrPos, e, Just pos) : xs, mcond) + ) + <|> ((\(startPos, var, arrPos, e) -> ([(startPos, var, arrPos, e, Nothing)], Nothing)) <$> selectE) + + condE :: Parser (SourcePos, Expr () SourcePos) + condE = do + ifPos <- getSourcePos + (ifPos,) <$> (rword "if" *> expr) +arrayE = label "array\nfor example: [1,2,3,4,5]" $ + lexeme $ do + startPos <- getSourcePos + symbol "[" + args <- argsE + endPos <- getSourcePos + char ']' + return $ Array startPos args endPos + where + argsE :: Parser [(Expr () SourcePos, Maybe SourcePos)] + argsE = + try + ( do + e <- expr + commaPos <- getSourcePos + symbol "," + es <- argsE + return ((e, Just commaPos) : es) + ) + <|> try + ( do + e1 <- expr + return [(e1, Nothing)] + ) + <|> pure [] + +mkInterpolatedString :: [Either Text e] -> [Either Text e] +mkInterpolatedString [] = [] +mkInterpolatedString (Left x : Left y : xs) = mkInterpolatedString (Left (x <> y) : xs) +mkInterpolatedString (x : xs) = x : mkInterpolatedString xs + +funE :: Parser (Expr () SourcePos) +funE = label "a function\nfor example: fun x y -> x + y" $ do + startPos <- getSourcePos + hidden $ rword "fun" + args <- some mExtIdent + arrPos <- getSourcePos + symbol "->" "'->'" + body <- expr + return $ Lam startPos (NEList.fromList args) arrPos body + +renameModE :: Parser (Expr () SourcePos) +renameModE = label "a 'let module' expression\nfor example: let module A = Base in A.#true" $ + do + hidden $ rword "let" + hidden $ rword "module" + newNmPos <- getSourcePos + newNm <- lexeme $ (ModuleName <$> variable "module name") + symbol "=" "'='" + oldNmPos <- getSourcePos + oldNm <- lexeme $ (ModuleName <$> variable "name of an existing module") + inPos <- getSourcePos + (opsTable, modOpsTables) <- ask + case Map.lookup oldNm modOpsTables of + Nothing -> customFailure $ ModuleNotFound oldNm + Just opsTableOldNm -> do + let opsTable' = IntMap.unionWith (<>) opsTable $ IntMap.map (\xs -> [(fix, Scope newNm, op) | (fix, _, op) <- xs]) opsTableOldNm + let modOpsTables' = Map.insert newNm opsTableOldNm modOpsTables + e <- withReaderT (const (opsTable', modOpsTables')) $ (rword "in" "_the 'in' keyword") *> expr + pure $ RenameModule newNmPos newNm oldNmPos oldNm inPos e + +data InfernoParsingError = ModuleNotFound ModuleName | InfixOpNotFound ModuleName Ident | UnboundTyVar Text + deriving (Eq, Show, Ord) + +instance ShowErrorComponent InfernoParsingError where + showErrorComponent (ModuleNotFound (ModuleName modNm)) = + "Module '" <> unpack modNm <> "' could not be found" + showErrorComponent (InfixOpNotFound (ModuleName modNm) (Ident op)) = + "Module " <> unpack modNm <> " does nto export `(" <> unpack op <> ")`" + showErrorComponent (UnboundTyVar ty) = + "Unbound type variable '" <> unpack ty + +openModArgs :: ModuleName -> Parser ([(Import SourcePos, Maybe SourcePos)], SourcePos, Expr () SourcePos) +openModArgs modNm = do + symbol "(" + is <- go + symbol ")" + (opsTable, modOpsTables) <- ask + opsTable' <- + foldM + ( \oTbl i -> case i of + IOpVar _ op -> do + foundOpTbl <- findOp op modOpsTables + return $ IntMap.unionWith (<>) oTbl foundOpTbl + _ -> pure oTbl + ) + opsTable + (map fst is) + inPos <- getSourcePos + e <- withReaderT (const (opsTable', modOpsTables)) $ (rword "in" "_the 'in' keyword") *> expr + return (is, inPos, e) + where + findOp :: Ident -> Map.Map ModuleName OpsTable -> Parser OpsTable + findOp i@(Ident op) modOpsTables = + case Map.lookup modNm modOpsTables of + Just opsTable -> do + let filteredOpsTable = + IntMap.mapMaybe + (\xs -> let xs' = [(fix, LocalScope, op') | (fix, _modNm, op') <- xs, op == op'] in if null xs' then Nothing else Just xs') + opsTable + when (null filteredOpsTable) $ customFailure $ InfixOpNotFound modNm i + return filteredOpsTable + Nothing -> customFailure $ ModuleNotFound modNm + go = + try + ((:) <$> ((,) <$> parseImport <*> lexeme ((Just <$> getSourcePos) <* symbol ",")) <*> go) + <|> ((\i -> [(i, Nothing)]) <$> parseImport) + + parseImport = + try (IOpVar <$> getSourcePos <*> lexeme (char '(' *> (Ident <$> takeWhile1P Nothing isAlphaNum) <* char ')')) + <|> try (IEnum <$> lexeme (getSourcePos <* string "enum") <*> getSourcePos <*> lexeme (Ident <$> variable)) + <|> (IVar <$> getSourcePos <*> lexeme (Ident <$> variable)) + +openModE :: Parser (Expr () SourcePos) +openModE = label "an 'open' module expression\nfor example: open A in ..." $ + do + hidden $ rword "open" + nmPos <- getSourcePos + nm <- lexeme $ (ModuleName <$> variable "module name") + (uncurry3 (OpenModule nmPos () nm) <$> (try (openModArgs nm) <|> ((\inPos e -> ([], inPos, e)) <$> getSourcePos <*> openAll nm))) + where + openAll modNm = do + (opsTable, modOpsTables) <- ask + case trace ("modOpsTables: " <> show modOpsTables) $ Map.lookup modNm modOpsTables of + Just opsTable' -> + withReaderT (const (IntMap.unionWith (<>) opsTable opsTable', modOpsTables)) $ + (rword "in" "_the 'in' keyword") *> expr + Nothing -> customFailure $ ModuleNotFound modNm + +letE :: Parser (Expr () SourcePos) +letE = label ("a 'let' expression" ++ example (Expl $ ExtIdent $ Right "x")) $ + do + startPos <- getSourcePos + hidden $ rword "let" + varPos <- getSourcePos + x <- lexeme $ (((Expl . ExtIdent . Right <$> variable) <|> (Impl . ExtIdent . Right <$> implicitVariable)) "a variable") + eqPos <- getSourcePos + symbol "=" "'='" + e1 <- expr ("an expression to bind to '" ++ show x ++ "'" ++ example x) + inPos <- getSourcePos + e2 <- (rword "in" "_the 'in' keyword") *> expr + pure $ Let startPos varPos x eqPos e1 inPos e2 + where + example x = "\nfor example: let " ++ show x ++ " = 2 * 5 in ..." + +pat :: Parser (Pat () SourcePos) +pat = + try (uncurry3 PTuple <$> tuple pat) + <|> parens pat + <|> try (hexadecimal PLit) + <|> try (signedDoubleE PLit) + <|> signedIntE PLit + <|> enumE PEnum + <|> (uncurry PVar <$> mIdent) + <|> noneE PEmpty + <|> someE POne pat + <|> stringE PLit + +casePatts :: Parser [(SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)] +casePatts = do + -- The | is optional before the first match clause: + _ <- optional (symbol "|" "'|'") + onePat `sepBy1` (symbol "|" "'|'") + where + onePat :: Parser (SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos) + onePat = label "_a pattern match clause\nfor example: #true -> ..." $ do + startPos <- getSourcePos + p <- pat + arrPos <- getSourcePos + symbol "->" "'->'" + e <- expr + return (startPos, p, arrPos, e) + +caseE :: Parser (Expr () SourcePos) +caseE = label "a pattern-match expression\nfor example: match x with { 1 -> #true | _ -> #false }" $ + lexeme $ do + startPos <- getSourcePos + rword "match" + e <- expr "an expression to pattern match on\nfor example: match (x, y) with { ... }" + rword "with" + brPos <- getSourcePos + symbol "{" + cs <- casePatts + endPos <- getSourcePos + char '}' + return $ Case startPos e brPos (NEList.fromList cs) endPos + +tupleArgs :: SomeParser r a -> SomeParser r [(a, Maybe SourcePos)] +tupleArgs p = + try + ( do + e <- p + commaPos <- lexeme $ char ',' *> getSourcePos + es <- tupleArgs p + return ((e, Just commaPos) : es) + ) + <|> do + e1 <- p + commaPos <- lexeme $ char ',' *> getSourcePos + e2 <- p + return [(e1, Just commaPos), (e2, Nothing)] + +isHSpace :: Char -> Bool +isHSpace x = isSpace x && x /= '\n' && x /= '\r' + +tuple :: SomeParser r a -> SomeParser r (SourcePos, TList (a, Maybe SourcePos), SourcePos) +tuple p = label "a tuple\nfor example: (2, #true, 4.4)" $ + lexeme $ do + startPos <- getSourcePos + symbol "(" + r <- tListFromList <$> tupleArgs p <|> ((takeWhileP Nothing isHSpace) *> pure TNil) + endPos <- getSourcePos + char ')' + return (startPos, r, endPos) + +assertE :: Parser (Expr () SourcePos) +assertE = label "an assertion\nfor example: assert x > 10 in ..." $ do + startPos <- getSourcePos + hidden $ rword "assert" + e1 <- expr "a boolean expression\nfor example: x > 10 && x <= 25" + inPos <- getSourcePos + e2 <- (rword "in" "_the 'in' keyword") *> expr + return $ Assert startPos e1 inPos e2 + +ifE :: Parser (Expr () SourcePos) +ifE = do + ifPos <- getSourcePos + hidden $ rword "if" + cond <- (hidden $ expr) "_a conditional expression\nfor example: x > 2" + thenPos <- getSourcePos + tr <- (rword "then" *> expr) "_the 'then' branch\nfor example: if x > 2 then 1 else 0" + elsePos <- getSourcePos + fl <- (rword "else" *> expr) "_the 'else' branch\nfor example: if x > 2 then 1 else 0" + return $ If ifPos cond thenPos tr elsePos fl + +appE :: Parser (Expr () SourcePos) +appE = + try (hexadecimal $ Lit) + <|> try (uncurry3 Tuple <$> tuple expr) + <|> hidden + ( ask + >>= tryMany operatorAsFun . concat . fst + ) + <|> do + startPos <- getSourcePos + symbol "(" + e <- expr + char ')' + endPos <- getSourcePos + lexeme $ pure $ Bracketed startPos e endPos + <|> try doubleE + <|> intE + <|> enumE Enum + <|> do + startPos <- getSourcePos + lexeme $ + try ((\nmspc x -> Var startPos () (Scope $ ModuleName nmspc) $ Expl $ ExtIdent $ Right x) <$> variable <*> (char '.' *> variable)) + <|> (try $ (Var startPos () LocalScope . Expl . ExtIdent . Right) <$> variable <* notFollowedBy (char '.')) + <|> noneE Empty + <|> someE One expr + <|> ifE + <|> try renameModE + <|> letE + <|> openModE + <|> assertE + <|> funE + <|> caseE + <|> try implVarE + <|> stringE Lit + <|> interpolatedStringE + <|> try arrayE + <|> arrayComprE + +term :: Parser (Expr () SourcePos) +term = + appE >>= \x -> + (some appE >>= \xs -> return (foldl App x xs)) + <|> return x + +operatorAsFun :: (Fixity, Scoped ModuleName, Text) -> Parser (Expr () SourcePos) +operatorAsFun (_fix, modNm, s) = do + startPos <- getSourcePos + symbol $ (fromScoped "" $ ((<> ".") . unModuleName) <$> modNm) <> "(" <> s <> ")" + return $ OpVar startPos () modNm $ Ident s + +tryMany :: (t -> Parser a) -> [t] -> Parser a +tryMany _ [] = fail "none of the operators matched" +tryMany p [x] = p x +tryMany p (x : xs) = try (p x) <|> tryMany p xs + +expr :: Parser (Expr () SourcePos) +expr = ask >>= \(opsTable, _) -> makeExprParser term $ mkOperators opsTable + +mkOperators :: OpsTable -> [[Operator Parser (Expr () SourcePos)]] +mkOperators opsTable = + [ map (uncurry3 $ mkOperatorP prec) opGrp | (prec, opGrp) <- IntMap.toDescList opsTable + ] + where + infixLabel = label "an infix operator\nfor example: +, *, ==, >, <" + prefixLabel = label "a prefix operator\nfor example: -, !" + + opString :: Scoped ModuleName -> Text -> Text + opString modNm s = case modNm of + LocalScope -> s + Scope (ModuleName ns) -> ns <> "." <> s + + mkOperatorP :: Int -> Fixity -> Scoped ModuleName -> Text -> Operator Parser (Expr () SourcePos) + mkOperatorP prec (InfixOp NoFix) ns o = + InfixN $ + infixLabel $ + (\pos e1 e2 -> Op e1 pos () (prec, NoFix) ns (Ident o) e2) <$> (lexeme $ getSourcePos <* string (opString ns o)) + mkOperatorP prec (InfixOp LeftFix) ns o = + InfixL $ + infixLabel $ + (\pos e1 e2 -> Op e1 pos () (prec, LeftFix) ns (Ident o) e2) <$> (lexeme $ getSourcePos <* string (opString ns o)) + mkOperatorP prec (InfixOp RightFix) ns o = + InfixR $ + infixLabel $ + (\pos e1 e2 -> Op e1 pos () (prec, RightFix) ns (Ident o) e2) <$> (lexeme $ getSourcePos <* string (opString ns o)) + mkOperatorP prec PrefixOp ns o = + Prefix $ + prefixLabel $ + (\pos e -> PreOp pos () prec ns (Ident o) e) <$> (lexeme $ getSourcePos <* string (opString ns o)) + +parseExpr :: + OpsTable -> + Map.Map ModuleName OpsTable -> + Text -> + Either + (NonEmpty (ParseError Text InfernoParsingError, SourcePos)) + (Expr () SourcePos, [Comment SourcePos]) +parseExpr opsTable modOpsTables s = + case runParser (runWriterT $ flip runReaderT (opsTable, modOpsTables) $ topLevel expr) "" s of + Left (ParseErrorBundle errs pos) -> Left $ fst $ attachSourcePos errorOffset errs pos + Right (e, comments) -> Right (e, appEndo comments []) + +-- parsing types + +type TyParser = ReaderT (Map.Map Text Int, OpsTable, Map.Map ModuleName OpsTable) (WriterT Comments (Parsec InfernoParsingError Text)) + +rws_type :: [Text] -- list of reserved type sig words +rws_type = ["define", "on", "forall"] + +typeIdent :: TyParser Text +typeIdent = try (p >>= check) + where + p = pack <$> (((:) <$> letterChar <*> hidden (many alphaNumChar)) "a type") + check x = + if x `elem` rws_type + then fail $ "Keyword " <> show x <> " cannot be a variable/function name" + else return x + +baseType :: TyParser InfernoType +baseType = + TBase + <$> ( (symbol "int" *> pure TInt) + <|> (symbol "double" *> pure TDouble) + <|> (symbol "word16" *> pure TWord16) + <|> (symbol "word32" *> pure TWord32) + <|> (symbol "word64" *> pure TWord64) + <|> (symbol "text" *> pure TText) + <|> try (symbol "timeDiff" *> pure TTimeDiff) + <|> (symbol "time" *> pure TTime) + <|> (symbol "resolution" *> pure TResolution) + ) + +type_variable_raw :: TyParser Text +type_variable_raw = (char '\'' *> takeWhile1P Nothing isAlphaNum) + +type_variable :: TyParser Int +type_variable = do + nm <- type_variable_raw + (tys, _, _) <- ask + case Map.lookup nm tys of + Just i -> return i + Nothing -> customFailure $ UnboundTyVar nm + +typeParserBase :: TyParser InfernoType +typeParserBase = + try ((\(_, tys, _) -> TTuple $ fmap fst tys) <$> tuple typeParser) + <|> parens typeParser + <|> try (lexeme baseType) + <|> lexeme (TBase <$> (TEnum <$> typeIdent <*> (Set.fromList <$> (symbol "{" *> enumList <* symbol "}")))) + <|> lexeme (TVar . TV <$> type_variable) + where + enumList = + try + ((:) <$> enumConstructor <* symbol "," <*> enumList) + <|> ((: []) <$> enumConstructor) + +typeParser :: TyParser InfernoType +typeParser = + makeExprParser + typeParserBase + [ [ Prefix (TArray <$ rword "array" <* rword "of"), + Prefix (TSeries <$ rword "series" <* rword "of"), + Prefix (TOptional <$ rword "option" <* rword "of") + ], + [ InfixR (TArr <$ symbol "->"), + InfixR (TArr <$ symbol "→") + ] + ] + +parseType :: + Text -> + Either + (NonEmpty (ParseError Text InfernoParsingError, SourcePos)) + InfernoType +parseType s = case runParser (runWriterT $ flip runReaderT (mempty, mempty, mempty) $ topLevel typeParser) "" s of + Left (ParseErrorBundle errs pos) -> Left $ fst $ attachSourcePos errorOffset errs pos + Right (e, _) -> Right e + +listParser :: TyParser a -> TyParser [a] +listParser p = + try + ( do + e <- p + symbol "," + es <- listParser p + return (e : es) + ) + <|> do + e1 <- p + return [e1] + +tyContext :: TyParser [Either TypeClass (Text, InfernoType)] +tyContext = lexeme $ do + _ <- symbol "{" + res <- listParser tyContextSingle + _ <- symbol "}" + _ <- (symbol "=>" <|> symbol "⇒") + return res + +typeClass :: TyParser TypeClass +typeClass = TypeClass <$> (lexeme typeIdent <* symbol "on") <*> (many typeParser) + +tyContextSingle :: TyParser (Either TypeClass (Text, InfernoType)) +tyContextSingle = (Left <$> (symbol "requires" *> typeClass)) <|> (Right <$> ((,) <$> (symbol "implicit" *> lexeme (withReaderT (\(_, ops, m) -> (ops, m)) variable)) <*> (symbol ":" *> typeParser))) + +schemeParser :: TyParser TCScheme +schemeParser = do + vars <- try (rword "forall" *> (many $ lexeme $ type_variable_raw) <* rword ".") <|> pure mempty + withReaderT (\(_, ops, m) -> (Map.fromList $ zip vars [0 ..], ops, m)) $ + constructScheme <$> (try tyContext <|> pure []) <*> typeParser + where + constructScheme :: [Either TypeClass (Text, InfernoType)] -> InfernoType -> TCScheme + constructScheme cs t = + let (tcs, impls) = partitionEithers cs + in closeOver (Set.fromList tcs) $ ImplType (Map.fromList $ map (bimap (ExtIdent . Right) id) impls) t + +doc :: Parser Text +doc = do + _ <- symbol "@doc" + txt <- takeWhileP Nothing (/= ';') + _ <- symbol ";" + return txt + +data TopLevelDefn def + = Signature + { documentation :: Maybe Text, + name :: SigVar, + def :: def + } + | EnumDef (Maybe Text) Text [Ident] + | TypeClassInstance TypeClass + | Export ModuleName + deriving (Eq, Show, Data) + +enumConstructors :: Parser [Ident] +enumConstructors = try ((:) <$> (lexeme enumConstructor <* symbol "|") <*> enumConstructors) <|> (: []) <$> lexeme enumConstructor + +sigVariable :: Parser SigVar +sigVariable = + ask >>= \(opsTable, _) -> + let opList = + concatMap + ( \case + (InfixOp _, _ns, i) -> [i] + _ -> [] + ) + $ concat $ IntMap.elems opsTable + preOpList = + concatMap + ( \case + (PrefixOp, _ns, i) -> [i] + _ -> [] + ) + $ concat $ IntMap.elems opsTable + in lexeme $ + (tryMany (\op -> char '(' *> (SigOpVar <$> string op) <* char ')') opList) + <|> (tryMany (\op -> (SigVar <$> string op)) preOpList) + <|> (SigVar <$> variable) + +data QQDefinition = QQRawDef String | QQToValueDef String | InlineDef (Expr () SourcePos) deriving (Data) + +exprOrBuiltin :: Parser QQDefinition +exprOrBuiltin = + try ((QQToValueDef . unpack) <$> lexeme (string "###" *> withReaderT (const (mempty, mempty)) variable <* string "###")) + <|> try ((QQRawDef . unpack) <$> lexeme (string "###!" *> withReaderT (const (mempty, mempty)) variable <* string "###")) + <|> (InlineDef <$> expr) + +sigParser :: Parser (TopLevelDefn (Maybe TCScheme, QQDefinition)) +sigParser = + ( try (Signature <$> (try (Just <$> doc) <|> pure Nothing) <*> sigVariable <*> ((,) <$> (try (Just <$> (symbol ":" *> (withReaderT (\(ops, m) -> (mempty, ops, m)) schemeParser))) <|> pure Nothing) <*> (symbol ":=" *> exprOrBuiltin))) + <|> try (EnumDef <$> (Just <$> doc) <*> (symbol "enum" *> lexeme variable <* symbol ":=") <*> enumConstructors) + <|> (EnumDef Nothing <$> (symbol "enum" *> lexeme variable <* symbol ":=") <*> enumConstructors) + <|> TypeClassInstance <$> (symbol "define" *> (withReaderT (\(ops, m) -> (mempty, ops, m)) typeClass)) + <|> Export <$> (symbol "export" *> (ModuleName <$> lexeme variable)) + ) + <* symbol ";" + +fixityP :: Parser Fixity +fixityP = + lexeme $ + try (rword "infixr" *> pure (InfixOp RightFix)) + <|> try (rword "infixl" *> pure (InfixOp LeftFix)) + <|> try (rword "infix" *> pure (InfixOp NoFix)) + <|> try (rword "prefix" *> pure PrefixOp) + +type OpsTable = IntMap.IntMap [(Fixity, Scoped ModuleName, Text)] + +fixityLvl :: Parser Int +fixityLvl = try (lexeme Lexer.decimal >>= check) + where + check x = + if x >= 0 && x < 20 + then return x + else fail $ "Fixity level annotation must be between 0 and 19 (inclusive)" + +sigsParser :: Parser (OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)]) +sigsParser = + try (opDeclP >>= \opsTable' -> withReaderT (const opsTable') sigsParser) + <|> try + ( do + def <- sigParser + (opsTable, defs) <- sigsParser + return (opsTable, def : defs) + ) + <|> try ((,[]) . fst <$> opDeclP) + <|> (sigParser >>= \r -> ask >>= \(opsTable, _) -> return (opsTable, [r])) + where + opDeclP = ask >>= \(opsTable, modOpsTables) -> (\f l o -> (insertIntoOpsTable opsTable f l o, modOpsTables)) <$> fixityP <*> fixityLvl <*> (operatorP <* symbol ";") + operatorP = lexeme $ takeWhile1P (Just "operator") (\c -> c /= ';' && not (isSpace c)) + +insertIntoOpsTable :: OpsTable -> Fixity -> Int -> Text -> OpsTable +insertIntoOpsTable opsTable fixity lvl op = + IntMap.alter + ( \case + Nothing -> Just [(fixity, LocalScope, op)] + Just xs -> Just $ xs ++ [(fixity, LocalScope, op)] + ) + lvl + opsTable + +modulesParser :: Parser [(ModuleName, OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)])] +modulesParser = do + symbol "module" + moduleNm <- ModuleName <$> lexeme variable + (ops, sigs) <- sigsParser + let opsQualified = IntMap.map (map (\(fix, _, t) -> (fix, Scope moduleNm, t))) ops + try + ( do + ms <- withReaderT (\(prevOps, modOpsTables) -> (IntMap.unionWith (<>) prevOps opsQualified, Map.insert moduleNm ops modOpsTables)) modulesParser + pure $ (moduleNm, ops, sigs) : ms + ) + <|> pure [(moduleNm, ops, sigs)] + +topLevel :: SomeParser r a -> SomeParser r a +topLevel p = sc *> p <* eof diff --git a/src/Inferno/Parse/Commented.hs b/src/Inferno/Parse/Commented.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Parse/Commented.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Inferno.Parse.Commented where + +import Data.List.NonEmpty (fromList, toList) +import Inferno.Types.Syntax + +insertCommentIntoImport :: Comment SourcePos -> Import SourcePos -> Import SourcePos +insertCommentIntoImport comment i = + let (startE, endE) = blockPosition i + in if endC <= startE + then ICommentAbove comment i + else -- if the comment starts after the current block then, either + + if endE <= startC + then + let SourcePos {sourceLine = eLine} = endE + SourcePos {sourceLine = cLine} = startC + in -- it is on the same line as the block + if eLine == cLine + then ICommentAfter i comment + else -- otherwise it is below the block + ICommentBelow i comment + else -- if the comment is neither before nor after the block, it must be within the expression + case i of + ICommentAfter i1 c -> ICommentAfter (insertCommentIntoImport comment i1) c + ICommentBelow i1 c -> ICommentBelow (insertCommentIntoImport comment i1) c + _ -> i + where + (startC, endC) = blockPosition comment + +insertCommentIntoPat :: Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos +insertCommentIntoPat comment e = + let (startE, endE) = blockPosition e + in if endC <= startE + then PCommentAbove comment e + else -- if the comment starts after the current block then, either + + if endE <= startC + then + let SourcePos {sourceLine = eLine} = endE + SourcePos {sourceLine = cLine} = startC + in -- it is on the same line as the block + if eLine == cLine + then PCommentAfter e comment + else -- otherwise it is below the block + PCommentBelow e comment + else -- if the comment is neither before nor after the block, it must be within the expression + case e of + PTuple p1 es1 p2 -> PTuple p1 (tListFromList $ insertTuple $ tListToList es1) p2 + POne p e1 -> POne p $ insertCommentIntoPat comment e1 + PCommentAfter e1 c -> PCommentAfter (insertCommentIntoPat comment e1) c + PCommentBelow e1 c -> PCommentBelow (insertCommentIntoPat comment e1) c + _ -> e + where + (startC, endC) = blockPosition comment + + insertTuple = \case + [] -> [] + [(e1, mp)] -> [(insertCommentIntoPat comment e1, mp)] + x@(e1, Just commaPos) : xs -> + if endC <= commaPos + then (insertCommentIntoPat comment e1, Just commaPos) : xs + else x : insertTuple xs + -- this case should be unreachable + x : xs -> x : insertTuple xs + +insertCommentIntoExpr :: Comment SourcePos -> Expr hash SourcePos -> Expr hash SourcePos +insertCommentIntoExpr comment expr = go' expr + where + (startC, endC) = blockPosition comment + commentIsWithin s e = s <= startC && endC <= e + commentIsBefore p = endC <= p + + istrGo' :: IStr f (SourcePos, Expr hash SourcePos, SourcePos) -> IStr f (SourcePos, Expr hash SourcePos, SourcePos) + istrGo' ISEmpty = ISEmpty + istrGo' (ISStr x xs) = ISStr x $ istrGo' xs + istrGo' (ISExpr (p1, e, p2) xs) = + if commentIsWithin p1 p2 + then ISExpr (p1, go' e, p2) xs + else ISExpr (p1, e, p2) $ istrGo' xs + + tupleGo' :: [(Expr hash SourcePos, Maybe SourcePos)] -> [(Expr hash SourcePos, Maybe SourcePos)] + tupleGo' = \case + [] -> [] + [(e, mp)] -> [(go' e, mp)] + x@(e, Just commaPos) : xs -> + if commentIsBefore commaPos + then (go' e, Just commaPos) : xs + else x : tupleGo' xs + _ -> error "unreachable" + + caseGo' :: + [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)] -> + [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)] + caseGo' = \case + [] -> [] + [(ofPos, pat, arrPos, e)] -> + if commentIsBefore arrPos + then [(ofPos, insertCommentIntoPat comment pat, arrPos, e)] + else [(ofPos, pat, arrPos, go' e)] + x@(ofPos, pat, arrPos, e) : xs@((ofPos2, _, _, _) : _) -> + if commentIsBefore arrPos + then (ofPos, insertCommentIntoPat comment pat, arrPos, e) : xs + else + if commentIsWithin arrPos ofPos2 + then (ofPos, pat, arrPos, go' e) : xs + else x : caseGo' xs + + arrayCompGo' :: + Maybe (a1, Expr hash SourcePos) -> + [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)] -> + ([(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)], Maybe (a1, Expr hash SourcePos)) + arrayCompGo' mcond = \case + [] -> ([], case mcond of Just (p, e) -> Just (p, go' e); Nothing -> Nothing) + [(p1, ident, p2, e, Nothing)] -> ([(p1, ident, p2, go' e, Nothing)], mcond) + x@(p1, ident, p2, e, Just commaPos) : xs -> + if commentIsBefore commaPos + then ((p1, ident, p2, go' e, Just commaPos) : xs, mcond) + else let (xs', mcond') = arrayCompGo' mcond xs in (x : xs', mcond') + _ -> error "unreachable" + + importsGo' = \case + [] -> [] + [(i, mp)] -> [(insertCommentIntoImport comment i, mp)] + x@(i, Just commaPos) : xs -> + if commentIsBefore commaPos + then (insertCommentIntoImport comment i, Just commaPos) : xs + else x : importsGo' xs + _ -> error "unreachable" + + go' :: Expr hash SourcePos -> Expr hash SourcePos + go' x = head $ go [x] + + go :: [Expr hash SourcePos] -> [Expr hash SourcePos] + go = + \case + [] -> [] + (e : es) -> + let (startE, endE) = blockPosition e + in if endC <= startE + then CommentAbove comment e : es + else -- if the comment starts after the current block then, either + + if endE <= startC + then + let SourcePos {sourceLine = eLine} = endE + SourcePos {sourceLine = cLine} = startC + in -- it is on the same line as the block + if eLine == cLine + then CommentAfter e comment : es + else -- otherwise it is below the block + + -- in case `e` is the last element, we attach the comment below `e` + + case es of + [] -> [CommentBelow e comment] + _ -> + -- in case we have more blocks in the list, we instead proceed to attach the comment lower down + e : go es + else -- if the comment is neither before nor after the block, it must be within the expression + + ( case e of + App e1 e2 -> let res = go [e1, e2] in App (res !! 0) (res !! 1) + Lam p1 xs p2 body -> Lam p1 xs p2 $ go' body + Let p1 p2 v p3 e1 posOfIn e2 -> + if commentIsBefore posOfIn + then Let p1 p2 v p3 (go' e1) posOfIn e2 + else Let p1 p2 v p3 e1 posOfIn $ go' e2 + InterpolatedString p1 (SomeIStr xs) p2 -> InterpolatedString p1 (SomeIStr $ istrGo' xs) p2 + If ifPos c thenPos t elsePos f -> + if commentIsWithin ifPos thenPos + then If ifPos (go' c) thenPos t elsePos f + else + if commentIsWithin thenPos elsePos + then If ifPos c thenPos (go' t) elsePos f + else If ifPos c thenPos t elsePos (go' f) + Op e1 posOfOp hash opMeta ns op e2 -> + if commentIsBefore posOfOp + then Op (go' e1) posOfOp hash opMeta ns op e2 + else Op e1 posOfOp hash opMeta ns op $ go' e2 + PreOp posOfOp hash opMeta ns op e1 -> + PreOp posOfOp hash opMeta ns op $ go' e1 + Tuple p1 es1 p2 -> Tuple p1 (tListFromList $ tupleGo' $ tListToList es1) p2 + One p e1 -> One p $ go' e1 + Assert p1 c inPos e1 -> + if commentIsBefore inPos + then Assert p1 (go' c) inPos e1 + else Assert p1 c inPos $ go' e1 + Case p1 e_c brPos cases p2 -> + if commentIsBefore brPos + then Case p1 (go' e_c) brPos cases p2 + else Case p1 e_c brPos (fromList $ caseGo' $ toList cases) p2 + Array p1 es1 p2 -> Array p1 (tupleGo' es1) p2 + ArrayComp p1 e1 posOfBar args mcond p2 -> + if commentIsBefore posOfBar + then ArrayComp p1 (go' e1) posOfBar args mcond p2 + else + let (args', mcond') = arrayCompGo' mcond $ toList args + in ArrayComp p1 e1 posOfBar (fromList $ args') mcond' p2 + CommentAfter e1 c -> CommentAfter (go' e1) c + CommentBelow e1 c -> CommentBelow (go' e1) c + Bracketed p1 e1 p2 -> Bracketed p1 (go' e1) p2 + RenameModule p1 m1 p2 m2 p3 e1 -> RenameModule p1 m1 p2 m2 p3 $ go' e1 + OpenModule p1 hash mn [] inPos e1 -> OpenModule p1 hash mn [] inPos $ go' e1 + OpenModule p1 hash mn is inPos e1 -> + if commentIsBefore inPos + then OpenModule p1 hash mn (importsGo' is) inPos e1 + else OpenModule p1 hash mn is inPos $ go' e1 + _ -> e + ) : + es + +insertCommentsIntoExpr :: [Comment SourcePos] -> Expr hash SourcePos -> Expr hash SourcePos +insertCommentsIntoExpr = flip (foldr insertCommentIntoExpr) diff --git a/src/Inferno/Parse/Error.hs b/src/Inferno/Parse/Error.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Parse/Error.hs @@ -0,0 +1,80 @@ +module Inferno.Parse.Error where + +import Data.List (intercalate) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NEList +import Data.Maybe (isNothing) +import Data.Proxy (Proxy (..)) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text, pack, replace, unpack) +import Text.Megaparsec + ( ErrorFancy (..), + ErrorItem (..), + ParseError (..), + ShowErrorComponent (..), + Stream (Token), + unPos, + ) +import Text.Megaparsec.Stream (showTokens) + +drop_ :: String -> String +drop_ "" = "" +drop_ ('_' : xs) = xs +drop_ xs = xs + +orList :: NonEmpty Text -> String +orList (x :| []) = drop_ $ unpack x +orList xs = + "one of the following:\n∙ " + <> intercalate "\n∙ " (map (drop_ . unpack . replace "\n" "\n ") $ NEList.toList xs) + +showErrorItem :: ErrorItem (Token Text) -> String +showErrorItem = \case + Tokens ts -> showTokens (Proxy :: Proxy Text) ts + Label lbl -> NEList.toList lbl + EndOfInput -> "end of input" + +messageItemsPretty :: + -- | Prefix to prepend + String -> + -- | Collection of messages + Set String -> + -- | Result of rendering + String +messageItemsPretty prefix ts + | Set.null ts = "" + | otherwise = + prefix <> (orList . NEList.fromList . Set.toAscList . Set.map pack) ts <> "\n" + +showErrorFancy :: ShowErrorComponent e => ErrorFancy e -> String +showErrorFancy = \case + ErrorFail msg -> msg + ErrorIndentation ord ref actual -> + "incorrect indentation (got " <> show (unPos actual) + <> ", should be " + <> p + <> show (unPos ref) + <> ")" + where + p = case ord of + LT -> "less than " + EQ -> "equal to " + GT -> "greater than " + ErrorCustom a -> showErrorComponent a + +prettyError :: + ShowErrorComponent e => + -- | Parse error to render + ParseError Text e -> + String +prettyError (TrivialError _ us ps) = + if isNothing us && Set.null ps + then "unknown parse error\n" + else + messageItemsPretty "unexpected " (showErrorItem `Set.map` maybe Set.empty Set.singleton us) + <> messageItemsPretty "expecting " (showErrorItem `Set.map` ps) +prettyError (FancyError _ xs) = + if Set.null xs + then "unknown fancy parse error\n" + else unlines (showErrorFancy <$> Set.toAscList xs) diff --git a/src/Inferno/Utils/QQ/Common.hs b/src/Inferno/Utils/QQ/Common.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Utils/QQ/Common.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Inferno.Utils.QQ.Common where + +import Data.Text (Text) +import qualified Data.Text as Text +import Inferno.Parse.Error (prettyError) +import Language.Haskell.TH.Syntax + ( Exp (AppE, VarE), + Lift (lift), + Loc (loc_filename, loc_start), + Q, + location, + ) +import Text.Megaparsec (ParseError, ShowErrorComponent, SourcePos (..), mkPos, unPos) + +location' :: Q SourcePos +location' = aux <$> location + where + aux :: Loc -> SourcePos + aux loc = let (l, c) = (loc_start loc) in SourcePos (loc_filename loc) (mkPos l) (mkPos c) + +-- fix for https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable +liftText :: Text -> Q Exp +liftText txt = AppE (VarE 'Text.pack) <$> lift (Text.unpack txt) + +mkParseErrorStr :: ShowErrorComponent e => (ParseError Text e, SourcePos) -> String +mkParseErrorStr (err, SourcePos {..}) = + "Error at line " + <> (show $ unPos sourceLine) + <> " column " + <> (show $ unPos sourceColumn) + <> "\n " + <> (Text.unpack $ Text.replace "\n" "\n " $ Text.pack $ prettyError err) diff --git a/src/Inferno/Utils/QQ/Module.hs b/src/Inferno/Utils/QQ/Module.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Utils/QQ/Module.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Inferno.Utils.QQ.Module where + +import Control.Monad.Reader (ReaderT (..)) +import Control.Monad.Writer (WriterT (..)) +import Data.Data (Proxy (..), cast) +import Data.Generics.Aliases (extQ) +import Data.List (intercalate) +import qualified Data.List.NonEmpty as NEList +import Data.Text (pack) +import Inferno.Infer (closeOverType) +import Inferno.Module (buildPinnedQQModules) +import Inferno.Parse + ( QQDefinition (..), + modulesParser, + topLevel, + ) +import qualified Inferno.Types.Type as Type +import Inferno.Utils.QQ.Common + ( liftText, + location', + mkParseErrorStr, + ) +import qualified Language.Haskell.TH.Lib as TH +import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) +import Language.Haskell.TH.Syntax (mkName) +import Text.Megaparsec + ( ParseErrorBundle (ParseErrorBundle), + PosState (PosState), + State (State), + attachSourcePos, + defaultTabWidth, + errorOffset, + runParser', + ) + +mkProxy :: a -> Proxy a +mkProxy _ = Proxy + +metaToValue :: (Maybe Type.TCScheme, QQDefinition) -> Maybe TH.ExpQ +metaToValue = \case + (Just sch, QQToValueDef x) -> Just [|Left ($(dataToExpQ (\a -> liftText <$> cast a) sch), toValue $(TH.varE (mkName x)))|] + (Nothing, QQToValueDef x) -> + Just [|Left (closeOverType (toType (mkProxy $(TH.varE (mkName x)))), toValue $(TH.varE (mkName x)))|] + (Just sch, QQRawDef x) -> Just [|Left ($(dataToExpQ (\a -> liftText <$> cast a) sch), pure $(TH.varE (mkName x)))|] + (Nothing, QQRawDef _) -> error "QQRawDef must have an explicit type" + (sch, InlineDef e) -> + Just [|Right ($(dataToExpQ (\a -> liftText <$> cast a) sch), $(dataToExpQ (\a -> liftText <$> cast a) e))|] + +infernoModules :: QuasiQuoter +infernoModules = + QuasiQuoter + { quoteExp = \str -> do + l <- location' + let (_, res) = + runParser' (runWriterT $ flip runReaderT (mempty, mempty) $ topLevel $ modulesParser) $ + State + (pack str) + 0 + (PosState (pack str) 0 l defaultTabWidth "") + [] + case res of + Left (ParseErrorBundle errs pos) -> + let errs' = map mkParseErrorStr $ NEList.toList $ fst $ attachSourcePos errorOffset errs pos + in fail $ intercalate "\n\n" errs' + Right (modules, _comments) -> + [|buildPinnedQQModules $(dataToExpQ ((\a -> liftText <$> cast a) `extQ` metaToValue) modules)|], + quotePat = error "infernoModule: Invalid use of this quasi-quoter in pattern context.", + quoteType = error "infernoModule: Invalid use of this quasi-quoter in type context.", + quoteDec = error "infernoModule: Invalid use of this quasi-quoter in top-level declaration context." + } diff --git a/src/Inferno/Utils/QQ/Script.hs b/src/Inferno/Utils/QQ/Script.hs new file mode 100644 --- /dev/null +++ b/src/Inferno/Utils/QQ/Script.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Inferno.Utils.QQ.Script where + +import Control.Monad.Reader (ReaderT (..)) +import Control.Monad.Writer (WriterT (..), appEndo) +import qualified Crypto.Hash as Crypto +import Data.ByteArray (convert) +import Data.ByteString (ByteString, unpack) +import Data.Data (cast) +import Data.Generics.Aliases (extQ) +import Data.List (intercalate) +import qualified Data.List.NonEmpty as NEList +import qualified Data.Maybe as Maybe +import Data.Text (pack) +import Inferno.Eval.Error (EvalError) +import Inferno.Infer (inferExpr) +import Inferno.Infer.Pinned (pinExpr) +import Inferno.Module.Prelude (baseOpsTable, builtinModules, builtinModulesOpsTable, builtinModulesPinMap) +import Inferno.Parse (expr, topLevel) +import Inferno.Parse.Commented (insertCommentsIntoExpr) +import Inferno.Utils.QQ.Common + ( liftText, + location', + mkParseErrorStr, + ) +import qualified Language.Haskell.TH.Lib as TH +import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) +import Language.Haskell.TH.Syntax (Exp (AppE, VarE), Lift (lift)) +import Prettyprinter (Pretty) +import Text.Megaparsec + ( ParseErrorBundle (ParseErrorBundle), + PosState (PosState), + State (State), + attachSourcePos, + defaultTabWidth, + errorOffset, + runParser', + ) + +inferno :: forall c. (Pretty c, Eq c) => QuasiQuoter +inferno = + QuasiQuoter + { quoteExp = \str -> do + l <- location' + let (_, res) = + runParser' (runWriterT $ flip runReaderT (baseOpsTable @_ @c builtins, builtinModulesOpsTable @_ @c builtins) $ topLevel $ expr) $ + State + (pack str) + 0 + (PosState (pack str) 0 l defaultTabWidth "") + [] + case res of + Left (ParseErrorBundle errs pos) -> + let errs' = map mkParseErrorStr $ NEList.toList $ fst $ attachSourcePos errorOffset errs pos + in fail $ intercalate "\n\n" errs' + Right (ast, comments) -> + case pinExpr (builtinModulesPinMap @_ @c builtins) ast of + Left err -> fail $ "Pinning expression failed:\n" <> show err + Right pinnedAST -> + case inferExpr builtins pinnedAST of + Left err -> fail $ "Inference failed:\n" <> show err + Right (pinnedAST', t, _tyMap) -> do + let final = insertCommentsIntoExpr (appEndo comments []) pinnedAST' + dataToExpQ ((\a -> liftText <$> cast a) `extQ` vcObjectHashToValue) (final, t), + quotePat = error "inferno: Invalid use of this quasi-quoter in pattern context.", + quoteType = error "inferno: Invalid use of this quasi-quoter in type context.", + quoteDec = error "inferno: Invalid use of this quasi-quoter in top-level declaration context." + } + where + builtins = builtinModules @(Either EvalError) @c + vcObjectHashToValue :: Crypto.Digest Crypto.SHA256 -> Maybe TH.ExpQ + vcObjectHashToValue h = + let str = (convert h) :: ByteString + in Just $ + ( AppE (VarE 'Maybe.fromJust) + <$> (AppE (VarE 'Crypto.digestFromByteString) <$> lift (unpack str)) + ) diff --git a/test/Eval/Spec.hs b/test/Eval/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Eval/Spec.hs @@ -0,0 +1,365 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Eval.Spec where + +import Control.Monad.Except (ExceptT) +import Control.Monad.IO.Class (liftIO) +import Data.Bifunctor (bimap) +import Data.Int (Int64) +import qualified Data.List.NonEmpty as NEList +import qualified Data.Map as Map +import Data.Text (unpack) +import Inferno.Eval.Error (EvalError (..)) +import Inferno.Infer (inferExpr) +import Inferno.Infer.Pinned (pinExpr) +import Inferno.Module.Builtin (enumBoolHash) +import Inferno.Parse (parseExpr, prettyError) +import Inferno.Types.Syntax (Expr (App, TypeRep), ExtIdent (..), Ident (..)) +import Inferno.Types.Type (typeDouble, typeInt) +import Inferno.Types.Value (Value (..)) +import Inferno.Types.VersionControl (pinnedToMaybe) +import Inferno.Utils.Prettyprinter (renderPretty) +import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe) +import Text.Megaparsec (initialPos) +import Utils (TestCustomValue, baseOpsTable, builtinModules, builtinModulesOpsTable, builtinModulesPinMap, builtinModulesTerms, runEvalIO) + +evalTests :: Spec +evalTests = describe "evaluate" $ + do + shouldEvaluateToWithTRep typeInt "3" $ VInt 3 + shouldEvaluateToWithTRep typeInt "-3" $ VInt (-3) + shouldEvaluateToWithTRep typeDouble "3" $ VDouble 3 + shouldEvaluateToWithTRep typeDouble "-3" $ VDouble (-3) + shouldEvaluateToWithTRep typeInt "-(-3)" $ VInt 3 + shouldEvaluateToWithTReps [typeInt, typeInt] "3+4" $ VInt 7 + shouldEvaluateTo "3.0" $ VDouble 3.0 + shouldEvaluateTo "3.0-2" $ VDouble 1.0 + shouldEvaluateTo "3.0/2" $ VDouble 1.5 + -- Reciprocals + shouldEvaluateTo "3.14 * recip 3.14" $ VDouble 1.0 + -- Power + shouldEvaluateToWithTRep typeInt "14 ** 5" $ VInt (14 ^ (5 :: Int64)) + shouldEvaluateTo "1.4 ** 2.5" $ VDouble (1.4 ** 2.5) + shouldEvaluateTo "exp 0" $ VDouble 1.0 + shouldEvaluateTo "exp (ln 1)" $ VDouble 1.0 + -- Logs + shouldEvaluateTo "log 10" $ VDouble 1.0 + shouldEvaluateTo "logBase 10 100" $ VDouble 2.0 + shouldEvaluateTo "ln (exp 1)" $ VDouble 1.0 + -- Square root + shouldEvaluateTo "sqrt 1.425" $ VDouble (sqrt 1.425) + shouldEvaluateTo "sqrt (-1.425)" $ VDouble (sqrt (-1.425)) + -- Negation + shouldEvaluateToWithTRep typeInt "let x = 1425 in -x" $ VInt (-1425) + shouldEvaluateTo "let x = 1.425 in -x" $ VDouble (-1.425) + -- Absolute value + shouldEvaluateToWithTRep typeInt "abs 1425" $ VInt 1425 + shouldEvaluateToWithTRep typeInt "abs (-1425)" $ VInt 1425 + shouldEvaluateToWithTRep typeDouble "abs 1425" $ VDouble 1425 + shouldEvaluateToWithTRep typeDouble "abs (-1425)" $ VDouble 1425 + shouldEvaluateTo "abs 14.25" $ VDouble 14.25 + shouldEvaluateTo "abs (-14.25)" $ VDouble 14.25 + -- Modulus + shouldEvaluateTo "1425 % 5" $ VInt 0 + shouldEvaluateTo "1426 % 5" $ VInt 1 + shouldEvaluateTo "-3 % 5" $ VInt 2 + -- Floor and ceiling + shouldEvaluateTo "floor 1425" $ VInt 1425 + shouldEvaluateTo "floor (-1425)" $ VInt (-1425) + shouldEvaluateTo "floor 14.25" $ VInt 14 + shouldEvaluateTo "floor (-14.25)" $ VInt (-15) + shouldEvaluateTo "ceiling 1425" $ VInt 1425 + shouldEvaluateTo "ceiling (-1425)" $ VInt (-1425) + shouldEvaluateTo "ceiling 14.25" $ VInt 15 + shouldEvaluateTo "ceiling (-14.25)" $ VInt (-14) + -- Rounding + shouldEvaluateTo "round 1425" $ VInt 1425 + shouldEvaluateTo "round (-1425)" $ VInt (-1425) + shouldEvaluateTo "round 14.25" $ VInt 14 + shouldEvaluateTo "round 14.55" $ VInt 15 + shouldEvaluateTo "round (-14.25)" $ VInt (-14) + shouldEvaluateTo "round (-14.55)" $ VInt (-15) + -- TODO fix type inference here? Check types inferred + shouldEvaluateTo "roundTo 0 1.72839" $ VDouble 2.0 + shouldEvaluateTo "roundTo 1 1.72839" $ VDouble 1.7 + shouldEvaluateTo "roundTo 2 1.72839" $ VDouble 1.73 + shouldEvaluateTo "roundTo 3 1.72839" $ VDouble 1.728 + shouldEvaluateTo "roundTo 4 1.72839" $ VDouble 1.7284 + shouldEvaluateTo "roundTo 5 1.72839" $ VDouble 1.72839 + shouldEvaluateTo "truncate 1425" $ VInt 1425 + shouldEvaluateTo "truncate (-1425)" $ VInt (-1425) + shouldEvaluateTo "truncate 14.25" $ VInt 14 + shouldEvaluateTo "truncate 14.55" $ VInt 14 + shouldEvaluateTo "truncate (-14.25)" $ VInt (-14) + shouldEvaluateTo "truncate (-14.55)" $ VInt (-14) + shouldEvaluateTo "truncateTo 0 1.72839" $ VDouble 1.0 + shouldEvaluateTo "truncateTo 1 1.72839" $ VDouble 1.7 + shouldEvaluateTo "truncateTo 2 1.72839" $ VDouble 1.72 + shouldEvaluateTo "truncateTo 3 1.72839" $ VDouble 1.728 + shouldEvaluateTo "truncateTo 4 1.72839" $ VDouble 1.7283 + -- Limit + shouldEvaluateTo "limit 1.72 9.32 (-23.4)" $ VDouble 1.72 + shouldEvaluateTo "limit 1.72 9.32 3.4" $ VDouble 3.4 + shouldEvaluateTo "limit 1.72 9.32 9.32" $ VDouble 9.32 + shouldEvaluateTo "limit 1.72 9.32 233.4" $ VDouble 9.32 + -- Trigonometry + shouldEvaluateTo "(sin 1.87) ** 2.0 + (cos 1.87) ** 2.0" $ VDouble 1.0 + shouldEvaluateTo "(cosh 1.87) ** 2.0 - (sinh 1.87) ** 2.0" $ VDouble 1.0 + shouldEvaluateTo "tanh 1.87" $ VDouble (sinh 1.87 / cosh 1.87) + shouldEvaluateTo "truncateTo 4 ((sin 1.87 / (cos 1.87)) - tan 1.87)" $ VDouble 0.0 + shouldEvaluateTo "truncateTo 4 (sin (2 * pi))" $ VDouble 0.0 + shouldEvaluateTo "arcSin (sin 1.02)" $ VDouble 1.02 + shouldEvaluateTo "arcCos (cos 1.02)" $ VDouble 1.02 + shouldEvaluateTo "arcTan (tan 1.02)" $ VDouble 1.02 + -- Booleans + shouldEvaluateTo "#true" vTrue + shouldEvaluateTo "!#true" vFalse + shouldEvaluateTo "!(!#true)" vTrue + shouldEvaluateTo "#false && #false" vFalse + shouldEvaluateTo "#true && #false" vFalse + shouldEvaluateTo "#true && #true" vTrue + shouldEvaluateTo "#false || #false" vFalse + shouldEvaluateTo "#true || #false" vTrue + shouldEvaluateTo "#true || #true" vTrue + shouldEvaluateTo "#false XOR #false" vFalse + shouldEvaluateTo "#true XOR #false" vTrue + shouldEvaluateTo "#true XOR #true" vFalse + shouldEvaluateTo "#true XOR #true || #true" vTrue + shouldEvaluateTo "#true || #true XOR #true" vTrue + shouldEvaluateTo "(#true XOR #true) || #true" vTrue + shouldEvaluateTo "#true XOR (#true || #true)" vFalse + shouldEvaluateTo "#true && #false || #true" vTrue + shouldEvaluateTo "#true || #false && #true" vTrue + -- Order + shouldEvaluateTo "1.2 < 8.9" vTrue + shouldEvaluateTo "-1.2 < -8.9" vFalse + shouldEvaluateTo "-1.2 < -1.2" vFalse + shouldEvaluateTo "1.2 > 8.9" vFalse + shouldEvaluateTo "-1.2 > -8.9" vTrue + shouldEvaluateTo "-1.2 > -1.2" vFalse + shouldEvaluateTo "1.2 <= 8.9" vTrue + shouldEvaluateTo "-1.2 <= (-8.9)" vFalse + shouldEvaluateTo "-1.2 <= -1.2" vTrue + shouldEvaluateTo "1.2 >= 8.9" vFalse + shouldEvaluateTo "-1.2 >= -8.9" vTrue + shouldEvaluateTo "-1.2 >= -1.2" vTrue + shouldEvaluateTo "min 1.23 4.33" $ VDouble 1.23 + shouldEvaluateTo "min 11.23 4.33" $ VDouble 4.33 + shouldEvaluateTo "max 1.23 4.33" $ VDouble 4.33 + shouldEvaluateTo "max 11.23 4.33" $ VDouble 11.23 + -- equality is defined for all types, however comparing function types will always yield #false + shouldEvaluateTo "1.2 == 1.2" vTrue + shouldEvaluateTo "-1.2 == -1.2" vTrue + shouldEvaluateTo "1.2 == 3.2" vFalse + shouldEvaluateTo "1.2 != 1.2" vFalse + shouldEvaluateTo "-1.2 != -1.2" vFalse + shouldEvaluateTo "1.2 != 3.2" vTrue + shouldEvaluateTo "12 == 12" vTrue + shouldEvaluateTo "-12 == -12" vTrue + shouldEvaluateTo "12 == 32" vFalse + shouldEvaluateTo "12 != 12" vFalse + shouldEvaluateTo "-12 != -12" vFalse + shouldEvaluateTo "12 != 32" vTrue + shouldEvaluateTo "(fun x -> x) == (fun x -> x)" vFalse + shouldEvaluateTo "(fun x -> x) != (fun x -> x)" vTrue + -- Bits + shouldEvaluateTo "0x3abc" $ VWord64 15036 + shouldEvaluateTo "testBit 0x1 0" vTrue + shouldEvaluateTo "testBit 0x1 1" vFalse + shouldEvaluateTo "testBit 0x2 0" vFalse + shouldEvaluateTo "testBit (setBit 0x0 3) 3" vTrue + shouldEvaluateTo "testBit (setBit 0x0 3) 2" vFalse + shouldEvaluateTo "testBit (clearBit (setBit 0x0 3) 2) 3" vTrue + shouldEvaluateTo "testBit (clearBit (setBit 0x0 3) 3) 3" vFalse + shouldEvaluateTo "testBit (complementBit 0x0 3) 3" vTrue + shouldEvaluateTo "testBit (complementBit (complementBit 0x0 3) 3) 3" vFalse + shouldEvaluateTo "shift 0x1 3" $ VWord64 8 + shouldEvaluateTo "shift 0x10 (-3)" $ VWord64 2 + shouldEvaluateTo "0x10 && 0x01" $ VWord64 0 + shouldEvaluateTo "0x5 && 0x9" $ VWord64 1 + shouldEvaluateTo "0x5 && 0x6" $ VWord64 4 + shouldEvaluateTo "0x5 || 0x9" $ VWord64 13 + shouldEvaluateTo "0x5 || 0x6" $ VWord64 7 + shouldEvaluateTo "0x5 XOR 0x9" $ VWord64 12 + shouldEvaluateTo "0x5 XOR 0x6" $ VWord64 3 + shouldEvaluateTo "0x10 XOR 0x01" $ VWord64 17 + shouldEvaluateTo "!(toWord16 0x1)" $ VWord64 (fromIntegral (2 ^ (16 :: Integer) - (2 :: Integer))) + shouldEvaluateTo "toWord16 #true" $ VWord16 1 + shouldEvaluateTo "toWord16 (toWord64 77)" $ VWord16 77 + shouldEvaluateTo "toWord16 (toWord64 (2**17 + 2))" $ VWord16 2 + shouldEvaluateTo "toWord32 (toWord64 77)" $ VWord32 77 + shouldEvaluateTo "toWord32 (toWord64 (2**33 + 5))" $ VWord32 5 + shouldEvaluateTo "toWord64 (toWord16 (2**62 + 1))" $ VWord64 1 + shouldEvaluateTo "fromWord (toWord64 (2**62))" $ VInt (2 ^ (62 :: Int64)) + shouldEvaluateTo "fromWord (toWord32 (2**62 + 2**31))" $ VInt (2 ^ (31 :: Int64)) + shouldEvaluateTo "fromWord (toWord16 (2**31 + 2**3))" $ VInt 8 + shouldEvaluateTo "fromWord #false" $ VInt 0 + shouldEvaluateTo "fromWord #true" $ VInt 1 + -- Arrays + shouldEvaluateTo "Array.singleton 3.14" $ VArray [VDouble 3.14] + shouldEvaluateTo "Array.length []" $ VInt 0 + shouldEvaluateTo "Array.length [3.0, 4.0]" $ VInt 2 + shouldEvaluateTo "Array.minimum [3.0, 4.0]" $ VDouble 3.0 + shouldEvaluateTo "Array.maximum [3.0, 4.0]" $ VDouble 4.0 + shouldEvaluateTo "Array.average [0.0, 1.0]" $ VDouble 0.5 + shouldEvaluateTo "Array.argmin [3.0, 4.0]" $ VInt 0 + shouldEvaluateTo "Array.argmax [3.0, 4.0]" $ VInt 1 + shouldEvaluateTo "Array.argsort [3.0, 1.0, 2.0]" $ VArray [VInt 1, VInt 2, VInt 0] + shouldEvaluateTo "Array.magnitude [1.0, 2.0, 3.0]" $ VDouble (sqrt (1.0 + 4.0 + 9.0)) + shouldEvaluateTo "Array.norm [1.0, -2.0, 3.0]" $ VDouble (sqrt (1.0 + 4.0 + 9.0)) + + shouldEvaluateTo "Array.range 4 3" $ VArray [] + shouldEvaluateTo "Array.range 4 13" $ VArray (map VInt [4 .. 13]) + shouldEvaluateTo "4 .. 13" $ VArray (map VInt [4 .. 13]) + shouldEvaluateTo "Array.map (fun x -> x**2) (Array.range 1 4)" $ VArray (map VInt [1, 4, 9, 16]) + -- The output type depends on the type of the starting value 0: + shouldEvaluateToWithTRep typeInt "Array.reduce (fun x y -> x + max 0 y) 0 (Array.range (-3) 3)" $ VInt 6 + shouldEvaluateToWithTRep typeDouble "Array.reduce (fun x y -> x + max 0 y) 0 (Array.range (-3) 3)" $ VDouble 6 + shouldEvaluateToWithTRep typeInt "Array.reduceRight (fun x y -> y + max 0 x) 0 (Array.range (-3) 3)" $ VInt 6 + shouldEvaluateToWithTRep typeDouble "Array.reduceRight (fun x y -> y + max 0 x) 0 (Array.range (-3) 3)" $ VDouble 6 + shouldEvaluateTo "(Array.reduce (fun x y -> x + max 0 y) 0 ((-3) .. 3)) == 6" vTrue + shouldEvaluateTo "(Array.reduce (fun x y -> x + max 0 y) 0 ((-3) .. 3)) == 6.0" vTrue + shouldEvaluateTo "(Array.reduce (fun x y -> x + max 0 y) 0 ((-3) .. 3)) == (Array.reduceRight (fun x y -> y + max 0 x) 0 ((-3) .. 3))" vTrue + -- This needs two type reps: one for the zero in sumArray, and one for the array elements + shouldEvaluateToWithTReps [typeInt, typeInt] "Array.sum [1, 2, 4, 8]" $ VInt 15 + shouldEvaluateTo "Array.sum [1.0, 2.0, 4.0, 8.0]" $ VDouble 15 + shouldEvaluateTo "open Array in range 4 13" $ VArray (map VInt [4 .. 13]) + shouldEvaluateTo "open Time in Array.sum [seconds 2, hours 5]" $ VEpochTime 18002 + -- Option type + shouldEvaluateTo "Array.sum (Array.keepSomes [Some 3.0, None, Some 4.0])" $ VDouble 7 + shouldEvaluateTo "Array.findFirstSome [None, Some 3.0, None, Some 4.0]" $ VOne $ VDouble 3 + shouldEvaluateTo "Array.findLastSome [None, Some 3.0, None, Some 4.0]" $ VOne $ VDouble 4 + shouldEvaluateTo "Array.findFirstAndLastSome [None, Some 3.0, None, Some 4.0]" $ VOne $ VTuple [VDouble 3, VDouble 4] + shouldEvaluateTo "Option.map (fun x -> x + 2) (Some 4.0)" $ VOne $ VDouble 6 + shouldEvaluateToWithTRep typeInt "Option.map (fun x -> x + 2) None" VEmpty + shouldEvaluateTo "fromOption 0 (Some 4.0)" $ VDouble 4 + shouldEvaluateTo "fromOption 0.0 None" $ VDouble 0 + shouldEvaluateTo "(Some 4.0) ? 0" $ VDouble 4 + shouldEvaluateTo "None ? 0.0" $ VDouble 0 + shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0.0 (Some 4)" $ VDouble 6 + shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0.0 (Some 4.0)" $ VDouble 6 + shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0 (Some 4.0)" $ VDouble 6 + shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0.0 None" $ VDouble 0 + -- Time + shouldEvaluateTo "Time.seconds 5" $ VEpochTime 5 + shouldEvaluateTo "Time.minutes 5 == 5 * Time.seconds 60" vTrue + shouldEvaluateTo "Time.hours 5 == 5 * Time.minutes 60" vTrue + shouldEvaluateTo "Time.days 5 == 5 * Time.hours 24" vTrue + shouldEvaluateTo "Time.weeks 5 == 5 * Time.days 7" vTrue + shouldEvaluateTo "open Time in let ?now = toTime (seconds 4000) in intervalEvery (seconds 4) ?now (?now + seconds 10)" $ + VArray [VEpochTime 4000, VEpochTime 4004, VEpochTime 4008] + shouldEvaluateTo "open Time in hour (toTime (hours 3 + seconds 400)) == toTime (hours 3)" vTrue + shouldEvaluateTo "open Time in day (toTime (days 3 + hours 22)) == toTime (days 3)" vTrue + shouldEvaluateTo "open Time in month (toTime (days 66)) == toTime (days 59)" vTrue + shouldEvaluateTo "open Time in year (toTime (days 367))" $ VEpochTime (60 * 60 * 24 * 365) + shouldEvaluateTo + "open Time in let ?now = (toTime (seconds 66666)) in secondsBefore ?now 44 == ?now - (seconds 44)" + vTrue + shouldEvaluateTo + "open Time in let ?now = (toTime (minutes 66666)) in minutesBefore ?now 44 == ?now - (minutes 44)" + vTrue + shouldEvaluateTo + "open Time in let ?now = (toTime (hours 66666)) in hoursBefore ?now 44 == ?now - (hours 44)" + vTrue + shouldEvaluateTo + "open Time in let ?now = (toTime (days 66666)) in daysBefore ?now 44 == ?now - (days 44)" + vTrue + shouldEvaluateTo + "open Time in let ?now = (toTime (weeks 66666)) in weeksBefore ?now 44 == ?now - (weeks 44)" + vTrue + shouldEvaluateTo + -- 2 months before 1970-04-11 is 1970-02-11 + "open Time in monthsBefore (toTime (days 100 + hours 22)) 2 == toTime (days 41 + hours 22)" + vTrue + shouldEvaluateTo + -- 3 months before 1970-05-31 is 1970-02-28 because of clipping + "open Time in monthsBefore (toTime (days 150 + hours 22)) 3 == toTime (days 58 + hours 22)" + vTrue + shouldEvaluateTo + -- 2 years before 1972-04-11 is 1970-04-11 + "open Time in yearsBefore (toTime (days 831 + hours 22)) 2 == toTime (days 100 + hours 22)" + vTrue + shouldEvaluateTo + -- 2 years before 1972-02-29 is 1970-02-28 because of clipping + "open Time in yearsBefore (toTime (days 789 + hours 22)) 2 == toTime (days 58 + hours 22)" + vTrue + shouldEvaluateTo "Time.formatTime (Time.toTime (Time.seconds 0)) \"%H:%M:%S\"" $ VText "00:00:00" + shouldEvaluateTo "Time.formatTime (Time.toTime (Time.seconds 0)) \"%c\"" $ VText "Thu Jan 1 00:00:00 UTC 1970" + -- Text + shouldEvaluateTo "Text.append \"hello \" \"world\"" $ VText "hello world" + shouldEvaluateTo "Text.length \"hello\"" $ VInt 5 + shouldEvaluateTo "Text.strip \" hello \"" $ VText "hello" + shouldEvaluateTo "Text.splitAt 5 \"hello world\"" $ VTuple [VText "hello", VText " world"] + -- Miscellaneous + shouldEvaluateTo "\"hello world\"" $ VText "hello world" + shouldEvaluateInEnvTo + Map.empty + (Map.fromList [(ExtIdent $ Right "x", VInt 5)]) + [TypeRep dummyPos typeInt] + "?x + 2" + (VInt 7) + shouldEvaluateInEnvTo + Map.empty + (Map.fromList [(ExtIdent $ Right "x", VInt 5)]) + [TypeRep dummyPos typeInt] + "let f = fun x -> ?x + 2 in f 0" + (VInt 7) + shouldEvaluateTo "let ?x = 3.2 in ?x + 2" $ VDouble 5.2 + shouldEvaluateTo "let x = 3.2 in x + 2" $ VDouble 5.2 + shouldEvaluateTo "if #true then Some 2.0 else None" $ VOne (VDouble 2) + shouldEvaluateTo "match #true with { | #true -> #false | _ -> #true}" vFalse + shouldEvaluateTo "match 3.9 - 2.2 with { 0.0 -> #false | _ -> #true}" vTrue + shouldEvaluateTo "`hello ${Array.range 1 10}`" $ VText "hello [1,2,3,4,5,6,7,8,9,10]" + shouldEvaluateTo "`${id}`" $ VText "<>" + shouldEvaluateTo "`hello\nworld${`I am ${\"nested\"}`}`" $ VText "hello\nworldI am nested" + shouldEvaluateTo "[x | x <- 1 .. 10]" $ VArray (map VInt [1 .. 10]) + shouldEvaluateTo "[x | x <- 1 .. 10, if x % 2 == 0]" $ VArray (map VInt [2, 4, 6, 8, 10]) + shouldThrowRuntimeError "assert #false in ()" $ Just AssertionFailed + shouldEvaluateTo "assert #true in ()" $ VTuple [] + where + vTrue = VEnum enumBoolHash (Ident "true") + vFalse = VEnum enumBoolHash (Ident "false") + shouldEvaluateInEnvTo localEnv implEnv typeReps str (v :: Value TestCustomValue (ExceptT EvalError IO)) = + it ("\"" <> unpack str <> "\" should evaluate to " <> (unpack $ renderPretty v)) $ + case parseExpr baseOpsTable builtinModulesOpsTable str of + Left err -> expectationFailure $ "Failed parsing with: " <> (prettyError $ fst $ NEList.head err) + Right (ast, _) -> do + case pinExpr builtinModulesPinMap ast of + Left err -> expectationFailure $ "Failed inference with: " <> show err + Right pinnedAST -> + case inferExpr builtinModules pinnedAST of + Left err -> expectationFailure $ "Failed inference with: " <> show err + Right (pinnedAST', ty, _) -> do + let trmEnv = ((localEnv, mempty) <>) <$> builtinModulesTerms + let expr = foldl App pinnedAST' typeReps + (liftIO $ runEvalIO trmEnv implEnv $ bimap pinnedToMaybe id expr) >>= \case + Left err -> + expectationFailure $ + "Failed eval with: " <> show err + <> "\nType: " + <> show ty + <> "\nExpr: " + <> show (bimap (const ()) (const ()) expr) + Right v' -> (renderPretty v') `shouldBe` (renderPretty v) + shouldEvaluateTo = shouldEvaluateInEnvTo Map.empty Map.empty [] + shouldEvaluateToWithTRep typ = shouldEvaluateInEnvTo Map.empty Map.empty [TypeRep dummyPos typ] + shouldEvaluateToWithTReps typs = shouldEvaluateInEnvTo Map.empty Map.empty (map (TypeRep dummyPos) typs) + shouldThrowRuntimeError str merr = + it ("\"" <> unpack str <> "\" should throw a runtime error") $ + case parseExpr baseOpsTable builtinModulesOpsTable str of + Left err -> expectationFailure $ "Failed parsing with: " <> (prettyError $ fst $ NEList.head err) + Right (ast, _) -> do + case pinExpr builtinModulesPinMap ast of + Left err -> expectationFailure $ "Failed inference with: " <> show err + Right pinnedAST -> + case inferExpr builtinModules pinnedAST of + Left err -> expectationFailure $ "Failed inference with: " <> show err + Right _ -> do + let trmEnv = builtinModulesTerms + (liftIO $ runEvalIO trmEnv mempty $ bimap pinnedToMaybe id pinnedAST) >>= \case + Left err' -> case merr of + Nothing -> pure () + Just err -> err' `shouldBe` err + Right _ -> expectationFailure $ "Should not evaluate." + dummyPos = initialPos "dummy" diff --git a/test/Golden/Spec.hs b/test/Golden/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Golden/Spec.hs @@ -0,0 +1,28 @@ +module Golden.Spec (goldenTests) where + +import Inferno.Types.Syntax (BaseType, Ident, InfernoType, ModuleName, TV) +import Inferno.Types.Type (Namespace) +import Inferno.VersionControl.Types + ( VCIncompatReason, + VCObjectHash, + VCObjectPred, + VCObjectVisibility, + ) +import Test.Aeson.GenericSpecs + ( Proxy (..), + roundtripAndGoldenADTSpecs, + ) +import Test.Hspec (Spec) + +goldenTests :: Spec +goldenTests = do + roundtripAndGoldenADTSpecs (Proxy :: Proxy VCObjectHash) + roundtripAndGoldenADTSpecs (Proxy :: Proxy Ident) + roundtripAndGoldenADTSpecs (Proxy :: Proxy ModuleName) + roundtripAndGoldenADTSpecs (Proxy :: Proxy Namespace) + roundtripAndGoldenADTSpecs (Proxy :: Proxy VCIncompatReason) + roundtripAndGoldenADTSpecs (Proxy :: Proxy VCObjectPred) + roundtripAndGoldenADTSpecs (Proxy :: Proxy VCObjectVisibility) + roundtripAndGoldenADTSpecs (Proxy :: Proxy BaseType) + roundtripAndGoldenADTSpecs (Proxy :: Proxy TV) + roundtripAndGoldenADTSpecs (Proxy :: Proxy InfernoType) diff --git a/test/Infer/Spec.hs b/test/Infer/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Infer/Spec.hs @@ -0,0 +1,201 @@ +{-# LANGUAGE TypeApplications #-} + +module Infer.Spec where + +import Data.List (intercalate) +import qualified Data.List.NonEmpty as NEList +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Text (unpack) +import Inferno.Infer (inferExpr) +import Inferno.Infer.Exhaustiveness + ( Pattern (W), + cEmpty, + cEnum, + cInf, + cOne, + cTuple, + checkUsefullness, + exhaustive, + ) +import Inferno.Infer.Pinned (pinExpr) +import Inferno.Module.Builtin (enumBoolHash) +import Inferno.Parse (parseExpr, prettyError) +import Inferno.Types.Syntax (ExtIdent (..), Ident (..)) +import Inferno.Types.Type (ImplType (..), InfernoType (..), TCScheme (..), TV (..), TypeClass (..), typeBool, typeDouble, typeInt, typeWord64) +import Inferno.Types.VersionControl (vcHash) +import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe, shouldNotBe) +import Utils (baseOpsTable, builtinModules, builtinModulesOpsTable, builtinModulesPinMap) + +inferTests :: Spec +inferTests = describe "infer" $ + do + let simpleType t = ForallTC [] Set.empty (ImplType Map.empty t) + + let tv i = TVar (TV {unTV = i}) + let makeTCs name params = TypeClass {className = name, params = params} + let addTC ts = makeTCs "addition" ts + let mulTC ts = makeTCs "multiplication" ts + let negTC ts = makeTCs "negate" ts + let numTC ts = makeTCs "numeric" ts + let ordTC ts = makeTCs "order" ts + let repTC ts = makeTCs "rep" ts + let makeType numTypeVars typeClassList t = ForallTC (map (\i -> TV {unTV = i}) [0 .. numTypeVars]) (Set.fromList typeClassList) (ImplType mempty t) + + shouldInferTypeFor "3" $ + makeType 0 [numTC [tv 0], repTC [tv 0]] (TVar $ TV {unTV = 0}) + shouldInferTypeFor "-3" $ + makeType 0 [negTC [tv 0], numTC [tv 0], repTC [tv 0]] (TVar $ TV {unTV = 0}) + shouldInferTypeFor "3+4" $ + makeType + 2 + [addTC [tv 1, tv 2, tv 0], numTC [tv 1], numTC [tv 2], repTC [tv 1, tv 2]] + (TVar $ TV {unTV = 0}) + shouldInferTypeFor "3.0" $ simpleType typeDouble + shouldInferTypeFor "-3.14" $ simpleType typeDouble + shouldInferTypeFor "3.0-2" $ simpleType typeDouble + shouldInferTypeFor "0x3abc" $ simpleType typeWord64 + shouldInferTypeFor "#true" $ simpleType typeBool + shouldInferTypeFor "Builtin.#true" $ simpleType typeBool + shouldInferTypeFor "#true || #false" $ simpleType typeBool + shouldFailToInferTypeFor "x" + shouldInferTypeFor "fun x -> x || #false" $ simpleType (TArr typeBool typeBool) + shouldInferTypeFor "fun x -> x * 2" $ + makeType + 2 + [mulTC [tv 0, tv 2, tv 1], numTC [tv 2], repTC [tv 2]] + (TArr (TVar (TV {unTV = 0})) (TVar (TV {unTV = 1}))) + shouldInferTypeFor "fun x -> x * 2.0" $ + makeType + 0 + [mulTC [tv 0, typeDouble, typeDouble]] + (TArr (TVar (TV {unTV = 0})) typeDouble) + shouldInferTypeFor "(fun x -> x * 2) 3.0" $ simpleType typeDouble + shouldInferTypeFor "(fun x -> x < 2)" $ + makeType + 0 + [numTC [tv 0], ordTC [tv 0], repTC [tv 0]] + (TArr (TVar (TV {unTV = 0})) typeBool) + shouldInferTypeFor "fun x -> x" $ + ForallTC [TV {unTV = 0}] Set.empty (ImplType Map.empty (TArr (TVar (TV {unTV = 0})) (TVar (TV {unTV = 0})))) + shouldInferTypeFor "?x + 2" $ + ForallTC + [TV {unTV = 0}, TV {unTV = 1}, TV {unTV = 2}] + (Set.fromList [addTC [tv 1, tv 2, tv 0], numTC [tv 2], repTC [tv 2]]) + (ImplType (Map.fromList [(ExtIdent $ Right "x", TVar (TV {unTV = 1}))]) (TVar (TV {unTV = 0}))) + shouldInferTypeFor "?x == 2" $ + ForallTC + [TV {unTV = 0}] + (Set.fromList [numTC [tv 0], repTC [tv 0]]) + (ImplType (Map.fromList [(ExtIdent $ Right "x", TVar (TV {unTV = 0}))]) typeBool) + shouldInferTypeFor "let ?x = 3.14 in ?x + 2" $ simpleType typeDouble + shouldInferTypeFor "let x = 3.14 in x + 2" $ simpleType typeDouble + shouldInferTypeFor "if #true then Some 2 else None" $ + makeType + 0 + [numTC [tv 0], repTC [tv 0]] + (TOptional (TVar (TV {unTV = 0}))) + shouldInferTypeFor "2 > 3.0" $ simpleType typeBool + shouldInferTypeFor "2 == 3.0" $ simpleType typeBool + -- equality is defined for all types, however comparing function types will always yield #false + shouldInferTypeFor "(fun x -> x) == (fun x -> x)" $ simpleType typeBool + shouldFailToInferTypeFor "if 2 then () else ()" + shouldFailToInferTypeFor "if #true then () else None" + shouldInferTypeFor "match #true with { | #true -> #false | _ -> #true}" $ simpleType typeBool + -- inference fails due to exhaustiveness error, even though this program is runtime safe... + -- however it is also silly and probably not worth trying to "fix" + shouldFailToInferTypeFor "match #true with { | #true -> #false}" + shouldFailToInferTypeFor "fun x -> match x with { | #true -> 1 | #false -> 2 | _ -> 3}" + -- this should fail because it parses '-' as infix + shouldFailToInferTypeFor "round -1425" + shouldInferTypeFor "round (-1425)" $ simpleType typeInt + + describe "exhaustiveness checker" $ + do + let boolsPattern = + [ cEnum f_hash "false", + cEnum t_hash "true", + cEnum f_hash "false" + ] + shouldBeExhaustive boolsPattern + shouldBeRedundant boolsPattern + + let numsPattern = + [ cInf (2.3 :: Double), + cInf (1.2 :: Double), + cInf (3.4 :: Double), + cInf (4.0 :: Double), + W + ] + shouldBeExhaustive numsPattern + shouldBeUseful numsPattern + shouldBeInexhaustive $ init numsPattern + + let optionalPattern = + [ cOne W, + cOne $ cEnum f_hash "false", + cEmpty + ] + shouldBeExhaustive optionalPattern + shouldBeRedundant optionalPattern + + let complexPattern = + [ cTuple [cOne (cInf (3 :: Int)), cEnum t_hash "true", cInf (5.0 :: Double)], + cTuple [cOne W, cEnum t_hash "true", cInf (5.0 :: Double)], + cTuple [cOne W, cEnum f_hash "false", W], + cTuple [cEmpty, cEnum t_hash "true", cInf (5.0 :: Double)], + cTuple [cEmpty, cEnum f_hash "false", cInf (5.0 :: Double)] + ] + shouldBeInexhaustive complexPattern + shouldBeUseful complexPattern + where + t_hash = vcHash ("true" :: Ident, enumBoolHash) + f_hash = vcHash ("false" :: Ident, enumBoolHash) + + shouldInferTypeFor str t = + it ("should infer type of \"" <> unpack str <> "\"") $ + case parseExpr baseOpsTable builtinModulesOpsTable str of + Left err -> expectationFailure $ "Failed parsing with: " <> (prettyError $ fst $ NEList.head err) + Right (ast, _) -> + case pinExpr builtinModulesPinMap ast of + Left err -> expectationFailure $ "Failed inference with: " <> show err + Right pinnedAST -> + case inferExpr builtinModules pinnedAST of + Left err -> expectationFailure $ "Failed inference with: " <> show err + Right (_expr, t', _tyMap) -> t' `shouldBe` t + + shouldFailToInferTypeFor str = + it ("should fail to infer type of \"" <> unpack str <> "\"") $ + case parseExpr baseOpsTable builtinModulesOpsTable str of + Left err -> expectationFailure $ "Failed parsing with: " <> (prettyError $ fst $ NEList.head err) + Right (ast, _) -> + case pinExpr builtinModulesPinMap ast of + Left _err -> pure () + Right pinnedAST -> + case inferExpr builtinModules pinnedAST of + Left _err -> pure () + Right _ -> expectationFailure $ "Should fail to infer a type" + + enum_sigs = + Map.fromList + [ (t_hash, Set.fromList [(t_hash, "true"), (f_hash, "false")]), + (f_hash, Set.fromList [(t_hash, "true"), (f_hash, "false")]) + ] + + printPatts ps = intercalate "\n " $ map show ps + shouldBeExhaustive patts = + it ("patterns\n " <> printPatts patts <> "\n should be exhaustive") $ + case exhaustive enum_sigs $ map (: []) patts of + Just _ps -> expectationFailure $ "These patterns should be exhaustive" + Nothing -> pure () + shouldBeInexhaustive patts = + it ("patterns\n " <> printPatts patts <> "\n should be inexhaustive") $ + case exhaustive enum_sigs $ map (: []) patts of + Just _ps -> pure () + Nothing -> expectationFailure $ "These patterns should be inexhaustive" + shouldBeUseful patts = + it ("patterns\n " <> printPatts patts <> "\n should be useful") $ + checkUsefullness enum_sigs (map (: []) patts) `shouldBe` [] + shouldBeRedundant patts = + it ("patterns\n " <> printPatts patts <> "\n should contain redundant clauses") $ + checkUsefullness enum_sigs (map (: []) patts) `shouldNotBe` [] diff --git a/test/Parse/Spec.hs b/test/Parse/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Parse/Spec.hs @@ -0,0 +1,541 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Parse.Spec where + +import Data.Functor.Foldable (ana, project) +import qualified Data.IntMap as IntMap (elems, toList) +import qualified Data.List.NonEmpty as NEList +import Data.Text (Text, pack, unpack) +import qualified Data.Text as Text +import Data.Text.Lazy (toStrict) +-- import Inferno.Module.Prelude (baseOpsTable, builtinModulesOpsTable) +import Inferno.Parse (parseExpr, prettyError) +import Inferno.Types.Syntax + ( BlockUtils (removeComments), + Comment (..), + Expr (..), + ExtIdent (..), + Fixity (..), + IStr (..), + Ident (Ident), + ImplExpl (..), + Import (..), + InfixFixity (..), + Lit (..), + ModuleName (..), + Pat (..), + Scoped (..), + SomeIStr (..), + TList (..), + arbitraryName, + tListFromList, + ) +import Inferno.Utils.Prettyprinter (renderPretty) +import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck + ( Arbitrary (..), + Gen, + PrintableString (getPrintableString), + Property, + Testable (property), + choose, + counterexample, + genericShrink, + oneof, + recursivelyShrink, + shrinkNothing, + sized, + suchThat, + (===), + ) +import Text.Pretty.Simple (pShow) +import Utils (baseOpsTable, builtinModulesOpsTable) + +instance Arbitrary a => Arbitrary (Scoped a) where + arbitrary = oneof $ [pure LocalScope, Scope <$> arbitrary] + shrink = shrinkNothing + +instance Arbitrary InfixFixity where + arbitrary = oneof $ map pure [NoFix, LeftFix, RightFix] + shrink = shrinkNothing + +instance Arbitrary Lit where + arbitrary = + oneof + [ LInt <$> arbitrary, + LDouble <$> arbitrary, + (LText . pack . getPrintableString) <$> arbitrary, + LHex <$> arbitrary + ] + +instance Arbitrary ImplExpl where + shrink = shrinkNothing + arbitrary = + oneof + [ Impl <$> arbitrary, + Expl <$> arbitrary + ] + +instance Arbitrary (Import ()) where + shrink = shrinkNothing + arbitrary = + oneof + [ IVar () <$> arbitrary, + IOpVar () <$> arbitrary, + IEnum () () <$> arbitrary + ] + +instance Arbitrary (Comment ()) where + shrink = shrinkNothing + arbitrary = + oneof + [ (\x -> LineComment () x ()) <$> (pack . getPrintableString <$> arbitrary) `suchThat` (Text.all $ \c -> c /= '\n' && c /= '\r'), + (\x -> BlockComment () x ()) <$> (pack . getPrintableString <$> arbitrary) `suchThat` (Text.all $ \c -> c /= '*') -- prevent having a '*/' + ] + +instance Arbitrary a => Arbitrary (SomeIStr a) where + arbitrary = sized $ \n -> do + k <- choose (0, n) + oneof [SomeIStr <$> goT k, SomeIStr <$> goF k] + where + goT :: Int -> Gen (IStr 'True a) + goT = \case + 0 -> pure ISEmpty + n -> oneof [ISExpr <$> arbitrary <*> goT (n -1), ISExpr <$> arbitrary <*> goF (n -1)] + + goF :: Int -> Gen (IStr 'False a) + goF = \case + 0 -> ISStr <$> arbitrary <*> pure ISEmpty + n -> ISStr <$> arbitrary <*> goT (n -1) + + shrink (SomeIStr ISEmpty) = [] + shrink (SomeIStr (ISStr s xs)) = + -- shrink to subterms + [SomeIStr xs] + ++ + -- recursively shrink subterms + [ case xs' of + SomeIStr (ISStr _ _) -> xs' + SomeIStr r@(ISExpr _ _) -> SomeIStr $ ISStr s r + SomeIStr r@ISEmpty -> SomeIStr $ ISStr s r + | xs' <- shrink (SomeIStr xs) + ] + shrink (SomeIStr (ISExpr e xs)) = + [SomeIStr xs] + ++ [SomeIStr (ISExpr e' xs) | e' <- shrink e] + ++ + -- recursively shrink subterms + [SomeIStr (ISExpr e' xs') | (e', SomeIStr xs') <- shrink (e, SomeIStr xs)] + +instance Arbitrary (Pat () ()) where + arbitrary = sized arbitrarySizedPat + shrink = recursivelyShrink + +arbitrarySizedPat :: Int -> Gen (Pat () ()) +arbitrarySizedPat n = + oneof + [ pure $ PVar () Nothing, + PVar () . Just <$> arbitrary, + PEnum () () LocalScope <$> arbitrary, + PLit () <$> arbitrary, + POne () <$> arbitrarySizedPat n, + pure $ PEmpty (), + PCommentAbove <$> arbitrary <*> arbitrarySizedPat (n `div` 3), + PCommentAfter <$> arbitrarySizedPat (n `div` 3) <*> arbitrary, + PCommentBelow <$> arbitrarySizedPat (n `div` 3) <*> arbitrary, + (\xs -> PTuple () (tListFromList xs) ()) <$> do + k <- choose (0, n) + sequence [(,Nothing) <$> arbitrarySizedPat (n `div` 3) | _ <- [1 .. k]] + `suchThat` (\xs -> length xs /= 1) + ] + +instance Arbitrary e => Arbitrary (NEList.NonEmpty e) where + arbitrary = NEList.fromList <$> (arbitrary `suchThat` (not . null)) + shrink = genericShrink + +instance Arbitrary (Expr () ()) where + shrink = recursivelyShrink + arbitrary = sized arbitrarySized + where + -- Don't generate implicit variables, because parser does not support them + arbitraryExtIdent = ExtIdent <$> Right <$> arbitraryName + arbitraryImplExpl = oneof [Impl <$> arbitraryExtIdent, Expl <$> arbitraryExtIdent] + arbitraryVar = + oneof + [ Var () () LocalScope <$> arbitraryImplExpl, + OpVar () () LocalScope . Ident + <$> ( oneof $ + concatMap + ( \case + (InfixOp _, _, op) -> [pure op] + _ -> [] + ) + $ concat $ IntMap.elems baseOpsTable + ) + ] + arbitraryEnum = Enum () () LocalScope <$> arbitrary + arbitraryLit = Lit () <$> arbitrary + + arbitraryApp n = + App + <$> (arbitrarySized $ n `div` 3) + <*> (arbitrarySized $ n `div` 3) + + arbitraryLam n = + (\vs e -> Lam () vs () e) + <$> arbitraryLamVars <*> (arbitrarySized $ n `div` 3) + where + -- Don't generate implicit vars. Sorry, there must be a nicer way to do this + arbitraryLamVars :: Gen (NEList.NonEmpty ((), Maybe ExtIdent)) + arbitraryLamVars = arbitrary `suchThat` (all isSomeRight . snd . NEList.unzip) + isSomeRight (Just (ExtIdent (Right _))) = True + isSomeRight _ = False + + arbitraryLet n = + (\v e1 e2 -> Let () () v () e1 () e2) + <$> arbitraryImplExpl <*> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3) + + arbitraryIString n = + (\xs -> InterpolatedString () xs ()) + <$> do + k <- choose (0, n) + oneof [SomeIStr <$> goT k, SomeIStr <$> goF k] + where + goT :: Int -> Gen (IStr 'True ((), Expr () (), ())) + goT = \case + 0 -> pure ISEmpty + m -> + oneof + [ ISExpr <$> ((\x -> ((), x, ())) <$> (arbitrarySized $ n `div` 3)) <*> goT (m -1), + ISExpr <$> ((\x -> ((), x, ())) <$> (arbitrarySized $ n `div` 3)) <*> goF (m -1) + ] + + goF :: Int -> Gen (IStr 'False ((), Expr () (), ())) + goF = \case + 0 -> + ISStr + <$> ( (pack . getPrintableString <$> arbitrary) + `suchThat` (\x -> not (Text.null x) && Text.all (\c -> c /= '\\' && c /= '$' && c /= '`') x) + ) + <*> pure ISEmpty + m -> + ISStr + <$> ( (pack . getPrintableString <$> arbitrary) + `suchThat` (\x -> not (Text.null x) && Text.all (\c -> c /= '\\' && c /= '$' && c /= '`') x) + ) + <*> goT (m -1) + + arbitraryIf n = + (\c t f -> If () c () t () f) + <$> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3) + + arbitraryAssert n = + (\c e -> Assert () c () e) + <$> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3) + + arbitraryOp n = + (\(prec, fix, op) e1 e2 -> Op e1 () () (prec, fix) LocalScope (Ident op) e2) + <$> ( oneof $ + map pure $ + concatMap + ( \(prec, xs) -> + concatMap + ( \case + (InfixOp fix, _, op) -> [(prec, fix, op)] + _ -> [] + ) + xs + ) + $ IntMap.toList baseOpsTable + ) + <*> (arbitrarySized $ n `div` 3) + <*> (arbitrarySized $ n `div` 3) + + arbitraryPreOp n = + (\(prec, op) e -> PreOp () () prec LocalScope (Ident op) e) + <$> ( oneof $ + map pure $ + concatMap + ( \(prec, xs) -> + concatMap + ( \case + (PrefixOp, _, op) -> [(prec, op)] + _ -> [] + ) + xs + ) + $ IntMap.toList baseOpsTable + ) + <*> (arbitrarySized $ n `div` 3) + + arbitraryCase n = + (\e cs -> Case () e () (NEList.fromList cs) ()) + <$> (arbitrarySized $ n `div` 3) + <*> do + k <- choose (0, n) + sequence + [ (\i e -> ((), i, (), e)) + <$> arbitrarySizedPat (n `div` 3) <*> arbitrarySized (n `div` 3) + | _ <- [1 .. k] + ] + `suchThat` (not . null) + + arbitraryBracketed n = (\e -> Bracketed () e ()) <$> arbitrarySized (n `div` 3) + arbitrarySized 0 = + oneof + [ arbitraryVar, + arbitraryEnum, + arbitraryLit, + pure $ Empty () + ] + arbitrarySized n = + oneof + [ arbitraryVar, + arbitraryEnum, + arbitraryLit, + arbitraryApp n, + arbitraryLam n, + arbitraryLet n, + arbitraryIString n, + arbitraryIf n, + arbitraryOp n, + arbitraryPreOp n, + (\xs -> Array () xs ()) + <$> ( do + k <- choose (0, n) + sequence [(,Nothing) <$> arbitrarySized (n `div` 3) | _ <- [1 .. k]] + ), + One () <$> arbitrarySized (n `div` 3), + pure $ Empty (), + arbitraryAssert n, + arbitraryCase n, + (\e xs c -> ArrayComp () e () (NEList.fromList [((), x, (), e', Nothing) | (x, e') <- xs]) c ()) + <$> (arbitrarySized $ n `div` 3) + <*> do + k <- choose (0, n) + sequence [(,) <$> arbitrary <*> arbitrarySized (n `div` 3) | _ <- [1 .. k]] + `suchThat` (not . null) + <*> oneof [Just . ((),) <$> (arbitrarySized $ n `div` 3), pure Nothing], + arbitraryBracketed n, + CommentAbove <$> arbitrary <*> arbitrarySized (n `div` 3), + CommentAfter <$> arbitrarySized (n `div` 3) <*> arbitrary, + CommentBelow <$> arbitrarySized (n `div` 3) <*> arbitrary + ] + +normalizePat :: Pat h a -> Pat h a +normalizePat = ana $ \case + PTuple p1 xs p2 -> project $ PTuple p1 (fmap (\(e, _) -> (normalizePat e, Nothing)) xs) p2 + x -> project x + +normalizeExpr :: Expr h a -> Expr h a +normalizeExpr = ana $ \case + PreOp pos hsh prec LocalScope (Ident "-") e -> case normalizeExpr e of + Lit l' (LInt x) -> project $ Lit l' $ LInt $ - x + Lit l' (LDouble x) -> project $ Lit l' $ LDouble $ - x + PreOp _ _ _ LocalScope (Ident "-") e' -> project $ e' + e' -> project $ PreOp pos hsh prec LocalScope (Ident "-") e' + Tuple p1 xs p2 -> project $ Tuple p1 (fmap (\(e, _) -> (normalizeExpr e, Nothing)) xs) p2 + Array p1 xs p2 -> project $ Array p1 (fmap (\(e, _) -> (normalizeExpr e, Nothing)) xs) p2 + ArrayComp p1 e_body p2 args e_cond p3 -> + project $ + ArrayComp + p1 + (normalizeExpr e_body) + p2 + (fmap (\(p4, x, p5, e, _) -> (p4, x, p5, normalizeExpr e, Nothing)) args) + (fmap (\(p4, e) -> (p4, normalizeExpr e)) e_cond) + p3 + Bracketed _ e _ -> project $ normalizeExpr e + Op e1 p1 h (_, fix) modNm i e2 -> project $ Op (normalizeExpr e1) p1 h (0, fix) modNm i (normalizeExpr e2) + Case p1 e_case p2 patExprs p3 -> project $ Case p1 (normalizeExpr e_case) p2 (fmap (\(p4, p, p5, e) -> (p4, normalizePat p, p5, normalizeExpr e)) patExprs) p3 + x -> project x + +() :: (Testable p) => p -> Text -> Property +() = flip (counterexample . unpack) + +infixl 2 + +parsingTests :: Spec +parsingTests = describe "pretty printing/parsing" $ do + prop "parseExpr and pretty are inverse up to normalizeExpr" $ + \(x :: Expr () ()) -> case parseExpr baseOpsTable builtinModulesOpsTable (renderPretty x) of + Left err -> + property False + ( "Pretty: \n" <> (renderPretty x) + <> "\nParse error:\n" + <> (pack $ prettyError $ fst $ NEList.head err) + ) + Right (res, _comments) -> + (normalizeExpr (removeComments x) === normalizeExpr (fmap (const ()) res)) + ( "Pretty: \n" <> (renderPretty x) + <> "\nParsed: \n" + <> (toStrict $ pShow res) + <> "\nParsed pretty: \n" + <> (renderPretty res) + ) + + describe "parsing literals" $ do + shouldSucceedFor "0" $ Lit () (LInt 0) + shouldSucceedFor "0.0" $ Lit () (LDouble 0) + shouldSucceedFor "3" $ Lit () (LInt 3) + shouldSucceedFor "3.1415" $ Lit () (LDouble 3.1415) + shouldSucceedFor "0xff" $ Lit () (LHex 255) + shouldSucceedFor "0Xff" $ Lit () (LHex 255) + shouldSucceedFor "0xFf" $ Lit () (LHex 255) + shouldSucceedFor "0XFF" $ Lit () (LHex 255) + shouldSucceedFor "0x123456789abcdef" $ Lit () (LHex 81985529216486895) + shouldFailFor "0x3.14" + shouldSucceedFor "\"0XFF\"" $ Lit () (LText "0XFF") + shouldSucceedFor "\"0X\\nFF\"" $ Lit () (LText "0X\nFF") + shouldSucceedFor "\"0X\\\\nFF\"" $ Lit () (LText "0X\\nFF") + shouldFailFor "\"0X\nFF\"" + + describe "parsing interpolated strings" $ do + shouldSucceedFor "``" $ InterpolatedString () (SomeIStr $ ISEmpty) () + shouldSucceedFor "`hello\nworld`" $ InterpolatedString () (SomeIStr (ISStr "hello\nworld" ISEmpty)) () + shouldSucceedFor "`${1}`" $ InterpolatedString () (SomeIStr (ISExpr ((), Lit () (LInt 1), ()) ISEmpty)) () + shouldSucceedFor "`hello\nworld${1}`" $ InterpolatedString () (SomeIStr (ISStr "hello\nworld" (ISExpr ((), Lit () (LInt 1), ()) ISEmpty))) () + shouldSucceedFor "`hello\nworld${\"!\"}`" $ InterpolatedString () (SomeIStr (ISStr "hello\nworld" (ISExpr ((), Lit () (LText "!"), ()) ISEmpty))) () + shouldSucceedFor "`hello\nworld${`I am ${\"nested\"}`}`" $ + InterpolatedString () (SomeIStr (ISStr "hello\nworld" (ISExpr ((), InterpolatedString () (SomeIStr (ISStr "I am " (ISExpr ((), Lit () (LText "nested"), ()) ISEmpty))) (), ()) ISEmpty))) () + shouldFailFor "`hello\nworld${}`" + + describe "parsing negation" $ do + shouldSucceedFor "-3" $ PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3)) + shouldSucceedFor "(-3)" $ Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) () + shouldFailFor "--3" + shouldSucceedFor "-x" $ PreOp () () 19 LocalScope (Ident "-") (Var () () LocalScope (Expl (ExtIdent $ Right "x"))) + shouldSucceedFor "(-(-x))" $ Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Var () () LocalScope (Expl (ExtIdent $ Right "x")))) ())) () + shouldSucceedFor "5+(-3)" $ Op (Lit () (LInt 5)) () () (9, LeftFix) LocalScope (Ident "+") (Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) ()) + shouldSucceedFor "5+-3" $ Op (Lit () (LInt 5)) () () (9, LeftFix) LocalScope (Ident "+") (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) + shouldSucceedFor "-3+5" $ Op (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) () () (9, LeftFix) LocalScope (Ident "+") (Lit () (LInt 5)) + shouldSucceedFor "(-3)+5" $ Op (Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) ()) () () (9, LeftFix) LocalScope (Ident "+") (Lit () (LInt 5)) + + describe "parsing variables" $ do + shouldSucceedFor "x" $ Var () () LocalScope (Expl (ExtIdent $ Right "x")) + shouldSucceedFor "A.x" $ Var () () (Scope (ModuleName "A")) (Expl (ExtIdent $ Right "x")) + shouldSucceedFor "x127652" $ Var () () LocalScope (Expl (ExtIdent $ Right "x127652")) + shouldSucceedFor "X12aaAA" $ Var () () LocalScope (Expl (ExtIdent $ Right "X12aaAA")) + shouldSucceedFor "X_12aaAA" $ Var () () LocalScope (Expl (ExtIdent $ Right "X_12aaAA")) + shouldSucceedFor "X__" $ Var () () LocalScope (Expl (ExtIdent $ Right "X__")) + shouldFailFor "_x" + shouldFailFor "let _ = () in ()" + shouldFailFor "let _x = () in ()" + shouldSucceedFor "fun _x -> ()" $ Lam () (((), Nothing) NEList.:| []) () (Tuple () TNil ()) + + describe "parsing implicit variables" $ do + let letImpl x = Let () () (Impl (ExtIdent $ Right x)) () (Tuple () TNil ()) () (Tuple () TNil ()) + shouldSucceedFor "let ?X__ = () in ()" $ letImpl "X__" + shouldSucceedFor "let ?x = () in ()" $ letImpl "x" + shouldSucceedFor "let ?x_y = () in ()" $ letImpl "x_y" + shouldFailFor "let ?_ = () in ()" + shouldFailFor "let ?x-y = () in ()" + + describe "parsing tuples" $ do + shouldSucceedFor "()" $ Tuple () TNil () + shouldSucceedFor "(None, None)" $ Tuple () (TCons (Empty (), Just ()) (Empty (), Nothing) []) () + shouldSucceedFor "(None)" $ Bracketed () (Empty ()) () + + describe "parsing arrays" $ do + shouldSucceedFor "[]" $ Array () [] () + shouldSucceedFor "[None, None]" $ Array () [(Empty (), Just ()), (Empty (), Nothing)] () + + describe "parsing infix operators" $ do + shouldSucceedFor "2*3+7/2" $ + Op + (Op (Lit () (LInt 2)) () () (10, LeftFix) LocalScope (Ident "*") (Lit () (LInt 3))) + () + () + (9, LeftFix) + LocalScope + (Ident "+") + (Op (Lit () (LInt 7)) () () (10, LeftFix) LocalScope (Ident "/") (Lit () (LInt 2))) + shouldSucceedFor "2*(3+7)/2" $ + Op + ( Op + (Lit () (LInt 2)) + () + () + (10, LeftFix) + LocalScope + (Ident "*") + (Bracketed () (Op (Lit () (LInt 3)) () () (9, LeftFix) LocalScope (Ident "+") (Lit () (LInt 7))) ()) + ) + () + () + (10, LeftFix) + LocalScope + (Ident "/") + (Lit () (LInt 2)) + shouldSucceedFor "2*3*4" $ + Op + (Op (Lit () (LInt 2)) () () (10, LeftFix) LocalScope (Ident "*") (Lit () (LInt 3))) + () + () + (10, LeftFix) + LocalScope + (Ident "*") + (Lit () (LInt 4)) + -- should this parse or should <,<=,>,>= be the same precedence level as == ? + shouldSucceedFor "2>3==3<2" $ + Op + (Op (Lit () (LInt 2)) () () (7, NoFix) LocalScope (Ident ">") (Lit () (LInt 3))) + () + () + (6, NoFix) + LocalScope + (Ident "==") + (Op (Lit () (LInt 3)) () () (7, NoFix) LocalScope (Ident "<") (Lit () (LInt 2))) + shouldFailFor "2==3==4" + + describe "parsing case statements" $ do + shouldFailFor "match () with {}" + shouldSucceedFor "match () with { () -> ()}" $ Case () (Tuple () TNil ()) () (((), PTuple () TNil (), (), Tuple () TNil ()) NEList.:| []) () + shouldSucceedFor "match () with { | () -> ()}" $ Case () (Tuple () TNil ()) () (((), PTuple () TNil (), (), Tuple () TNil ()) NEList.:| []) () + + describe "parsing assertions" $ do + shouldFailFor "assert #false" + shouldSucceedFor "assert #false in ()" $ Assert () (Enum () () LocalScope (Ident "false")) () (Tuple () TNil ()) + + describe "parsing array builder" $ do + shouldSucceedFor "[() | x <- someList]" $ + ArrayComp + () + (Tuple () TNil ()) + () + (((), Ident "x", (), Var () () LocalScope (Expl (ExtIdent $ Right "someList")), Nothing) NEList.:| []) + Nothing + () + shouldSucceedFor "[(x,y) | x <- someList, y <- otherList]" $ + ArrayComp + () + (Tuple () (TCons (Var () () LocalScope (Expl (ExtIdent $ Right "x")), Just ()) (Var () () LocalScope (Expl (ExtIdent $ Right "y")), Nothing) []) ()) + () + (((), Ident "x", (), Var () () LocalScope (Expl (ExtIdent $ Right "someList")), Just ()) NEList.:| [((), Ident "y", (), Var () () LocalScope (Expl (ExtIdent $ Right "otherList")), Nothing)]) + Nothing + () + shouldSucceedFor "[2*x | x <- someList, if x > 10]" $ + ArrayComp + () + (Op (Lit () (LInt 2)) () () (10, LeftFix) LocalScope (Ident "*") (Var () () LocalScope (Expl (ExtIdent $ Right "x")))) + () + (((), Ident "x", (), Var () () LocalScope (Expl (ExtIdent $ Right "someList")), Just ()) NEList.:| []) + (Just ((), Op (Var () () LocalScope (Expl (ExtIdent $ Right "x"))) () () (7, NoFix) LocalScope (Ident ">") (Lit () (LInt 10)))) + () + shouldFailFor "[() | if x > 10]" + where + shouldSucceedFor str ast = + it ("should succeed for \"" <> unpack str <> "\"") $ + case parseExpr baseOpsTable builtinModulesOpsTable str of + Left err -> expectationFailure $ "Failed with: " <> (prettyError $ fst $ NEList.head err) + Right (res, _) -> fmap (const ()) res `shouldBe` ast + shouldFailFor str = + it ("should fail for \"" <> unpack str <> "\"") $ + case parseExpr baseOpsTable builtinModulesOpsTable str of + Left _err -> pure () + Right _res -> expectationFailure $ "This should not parse" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,15 @@ +module Main (main) where + +import Eval.Spec (evalTests) +import Golden.Spec (goldenTests) +import Infer.Spec (inferTests) +import Parse.Spec (parsingTests) +import Test.Hspec (hspec) + +main :: IO () +main = + hspec $ do + parsingTests + inferTests + evalTests + goldenTests diff --git a/test/Utils.hs b/test/Utils.hs new file mode 100644 --- /dev/null +++ b/test/Utils.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TypeApplications #-} + +module Utils where + +import Control.Monad.Catch (MonadCatch) +import Control.Monad.Except (ExceptT) +import qualified Data.Map as Map +import Inferno.Eval as Eval +import Inferno.Eval.Error (EvalError (..)) +import qualified Inferno.Module.Prelude as Prelude +import Inferno.Parse (OpsTable) +import Inferno.Types.Module (PinnedModule) +import Inferno.Types.Syntax + ( Expr (..), + ExtIdent (..), + ModuleName (..), + Scoped (..), + ) +import Inferno.Types.Type (Namespace (..)) +import Inferno.Types.Value (ImplEnvM, Value) +import Inferno.Types.VersionControl (Pinned (..), VCObjectHash) + +type TestCustomValue = () + +builtinModules :: Map.Map ModuleName (PinnedModule (ImplEnvM (ExceptT EvalError IO) TestCustomValue (Eval.TermEnv VCObjectHash TestCustomValue (ImplEnvM (ExceptT EvalError IO) TestCustomValue)))) +builtinModules = Prelude.builtinModules @(ExceptT EvalError IO) @TestCustomValue + +builtinModulesOpsTable :: Map.Map ModuleName OpsTable +builtinModulesOpsTable = Prelude.builtinModulesOpsTable @(ExceptT EvalError IO) @TestCustomValue builtinModules + +builtinModulesPinMap :: Map.Map (Scoped ModuleName) (Map.Map Namespace (Pinned VCObjectHash)) +builtinModulesPinMap = Prelude.builtinModulesPinMap @(ExceptT EvalError IO) @TestCustomValue builtinModules + +baseOpsTable :: OpsTable +baseOpsTable = Prelude.baseOpsTable @(ExceptT EvalError IO) @TestCustomValue builtinModules + +builtinModulesTerms :: ImplEnvM (ExceptT EvalError IO) TestCustomValue (Eval.TermEnv VCObjectHash TestCustomValue (ImplEnvM (ExceptT EvalError IO) TestCustomValue)) +builtinModulesTerms = Prelude.builtinModulesTerms @(ExceptT EvalError IO) @TestCustomValue builtinModules + +runEvalIO :: + (MonadCatch m) => + ImplEnvM (ExceptT EvalError m) TestCustomValue (Eval.TermEnv VCObjectHash TestCustomValue (ImplEnvM (ExceptT EvalError m) TestCustomValue)) -> + Map.Map ExtIdent (Value TestCustomValue (ImplEnvM (ExceptT EvalError m) TestCustomValue)) -> + Expr (Maybe VCObjectHash) a -> + m (Either EvalError (Value TestCustomValue (ImplEnvM (ExceptT EvalError m) TestCustomValue))) +runEvalIO = Eval.runEvalIO @_ @TestCustomValue