inferno-core (empty) → 0.1.0.0
raw patch · 66 files changed
+20155/−0 lines, 66 filesdep +QuickCheckdep +basedep +bimap
Dependencies added: QuickCheck, base, bimap, bytestring, containers, cryptonite, exceptions, generic-lens, hspec, hspec-golden-aeson, inferno-core, inferno-types, inferno-vc, megaparsec, memory, mtl, parser-combinators, picosat, pretty-simple, prettyprinter, recursion-schemes, syb, template-haskell, text, time
Files
- CHANGELOG.md +4/−0
- LICENSE +21/−0
- golden/BaseType/TDouble.json +20/−0
- golden/BaseType/TEnum.json +118/−0
- golden/BaseType/TInt.json +20/−0
- golden/BaseType/TResolution.json +20/−0
- golden/BaseType/TText.json +20/−0
- golden/BaseType/TTime.json +20/−0
- golden/BaseType/TTimeDiff.json +20/−0
- golden/BaseType/TWord16.json +20/−0
- golden/BaseType/TWord32.json +20/−0
- golden/BaseType/TWord64.json +20/−0
- golden/Ident/Ident.json +10/−0
- golden/InfernoType/TArr.json +542/−0
- golden/InfernoType/TArray.json +1308/−0
- golden/InfernoType/TBase.json +61/−0
- golden/InfernoType/TOptional.json +64/−0
- golden/InfernoType/TRep.json +4011/−0
- golden/InfernoType/TSeries.json +73/−0
- golden/InfernoType/TTuple.json +5586/−0
- golden/InfernoType/TVar.json +25/−0
- golden/ModuleName/ModuleName.json +10/−0
- golden/Namespace/EnumNamespace.json +25/−0
- golden/Namespace/FunNamespace.json +25/−0
- golden/Namespace/ModuleNamespace.json +25/−0
- golden/Namespace/OpNamespace.json +25/−0
- golden/Namespace/TypeNamespace.json +25/−0
- golden/TV/TV.json +10/−0
- golden/VCIncompatReason/EnumConstructorsChanged.json +10/−0
- golden/VCIncompatReason/TypeSignatureChange.json +10/−0
- golden/VCMeta/VCMeta.json +276/−0
- golden/VCObjectHash/VCObjectHash.json +10/−0
- golden/VCObjectPred/CloneOf.json +25/−0
- golden/VCObjectPred/CloneOfNotFound.json +25/−0
- golden/VCObjectPred/CloneOfRemoved.json +25/−0
- golden/VCObjectPred/CompatibleWithPred.json +25/−0
- golden/VCObjectPred/IncompatibleWithPred.json +612/−0
- golden/VCObjectPred/Init.json +20/−0
- golden/VCObjectPred/MarkedBreakingWithPred.json +25/−0
- golden/VCObjectVisibility/VCObjectPrivate.json +10/−0
- golden/VCObjectVisibility/VCObjectPublic.json +10/−0
- inferno-core.cabal +118/−0
- src/Inferno/Eval.hs +288/−0
- src/Inferno/Eval/Error.hs +10/−0
- src/Inferno/Infer.hs +1428/−0
- src/Inferno/Infer/Env.hs +172/−0
- src/Inferno/Infer/Error.hs +93/−0
- src/Inferno/Infer/Exhaustiveness.hs +248/−0
- src/Inferno/Infer/Pinned.hs +265/−0
- src/Inferno/Module.hs +181/−0
- src/Inferno/Module/Builtin.hs +95/−0
- src/Inferno/Module/Cast.hs +294/−0
- src/Inferno/Module/Prelude.hs +658/−0
- src/Inferno/Module/Prelude/Defs.hs +501/−0
- src/Inferno/Parse.hs +889/−0
- src/Inferno/Parse/Commented.hs +221/−0
- src/Inferno/Parse/Error.hs +80/−0
- src/Inferno/Utils/QQ/Common.hs +34/−0
- src/Inferno/Utils/QQ/Module.hs +72/−0
- src/Inferno/Utils/QQ/Script.hs +81/−0
- test/Eval/Spec.hs +365/−0
- test/Golden/Spec.hs +28/−0
- test/Infer/Spec.hs +201/−0
- test/Parse/Spec.hs +541/−0
- test/Spec.hs +15/−0
- test/Utils.hs +46/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+# Revision History for inferno-core++## 0.1.0.0 -- 2022-11-28+* Prepare for OSS release
+ LICENSE view
@@ -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.
+ golden/BaseType/TDouble.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TDouble"+ },+ {+ "tag": "TDouble"+ },+ {+ "tag": "TDouble"+ },+ {+ "tag": "TDouble"+ },+ {+ "tag": "TDouble"+ }+ ],+ "seed": -2104182145+}
+ golden/BaseType/TEnum.json view
@@ -0,0 +1,118 @@+{+ "samples": [+ {+ "contents": [+ "|\u00110vm\u000b) $0\u0019\u001c\u0018yY\u0006T",+ [+ "p6gopja_27soykcr",+ "pzh8o8fbao",+ "ww87pwq4m8ih4bf0nn"+ ]+ ],+ "tag": "TEnum"+ },+ {+ "contents": [+ "\u000cFt]|O.0+L\u001b\u001f𫰰9sc\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\u001d6B",+ [+ "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": [+ "rFP\u000e<U,\u0010QBUW\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+}
+ golden/BaseType/TInt.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TInt"+ },+ {+ "tag": "TInt"+ },+ {+ "tag": "TInt"+ },+ {+ "tag": "TInt"+ },+ {+ "tag": "TInt"+ }+ ],+ "seed": -151905013+}
+ golden/BaseType/TResolution.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TResolution"+ },+ {+ "tag": "TResolution"+ },+ {+ "tag": "TResolution"+ },+ {+ "tag": "TResolution"+ },+ {+ "tag": "TResolution"+ }+ ],+ "seed": -27689261+}
+ golden/BaseType/TText.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TText"+ },+ {+ "tag": "TText"+ },+ {+ "tag": "TText"+ },+ {+ "tag": "TText"+ },+ {+ "tag": "TText"+ }+ ],+ "seed": 552880690+}
+ golden/BaseType/TTime.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TTime"+ },+ {+ "tag": "TTime"+ },+ {+ "tag": "TTime"+ },+ {+ "tag": "TTime"+ },+ {+ "tag": "TTime"+ }+ ],+ "seed": 1340613814+}
+ golden/BaseType/TTimeDiff.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TTimeDiff"+ },+ {+ "tag": "TTimeDiff"+ },+ {+ "tag": "TTimeDiff"+ },+ {+ "tag": "TTimeDiff"+ },+ {+ "tag": "TTimeDiff"+ }+ ],+ "seed": 2091293756+}
+ golden/BaseType/TWord16.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TWord16"+ },+ {+ "tag": "TWord16"+ },+ {+ "tag": "TWord16"+ },+ {+ "tag": "TWord16"+ },+ {+ "tag": "TWord16"+ }+ ],+ "seed": 1643623361+}
+ golden/BaseType/TWord32.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TWord32"+ },+ {+ "tag": "TWord32"+ },+ {+ "tag": "TWord32"+ },+ {+ "tag": "TWord32"+ },+ {+ "tag": "TWord32"+ }+ ],+ "seed": -789157068+}
+ golden/BaseType/TWord64.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "TWord64"+ },+ {+ "tag": "TWord64"+ },+ {+ "tag": "TWord64"+ },+ {+ "tag": "TWord64"+ },+ {+ "tag": "TWord64"+ }+ ],+ "seed": 357950783+}
+ golden/Ident/Ident.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ "nsp89kshwibrf83lq2kd20uhecq",+ "yojo98hbsccanq1jmr65i9eb366ccm9",+ "nm",+ "n0wuj_erymw2c7nt96b4dd7zxyvfg6p",+ "n"+ ],+ "seed": -1370367363+}
+ golden/InfernoType/TArr.json view
@@ -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\u0014EH6\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+}
+ golden/InfernoType/TArray.json view
@@ -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\u001a2/ 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+\u001bo(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\u0010Z\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\u0008H𬄢^\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\u001aY",+ [+ "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+}
+ golden/InfernoType/TBase.json view
@@ -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+}
+ golden/InfernoType/TOptional.json view
@@ -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+}
+ golden/InfernoType/TRep.json view
@@ -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'\u001eZRE",+ [+ "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\u0004Vz*]Kk@}uhNK",+ []+ ],+ "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\u001cVbl|' \rn\u00037z\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\u001c1~~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": [+ "{ $jN퇼K?wx5\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%?\u000ca\u0010e2!&y\u0008𗬆ZrF,\u0011NlD𦚚\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": [+ "YVp\t)e\u0019mf",+ [+ "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": [+ "oMr~.$\u0006Uhld>\rL`<\u0002wA\n$ic\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@Ma(\u0005TQ\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!|mi",+ [+ "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\u0003qreKr\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*\u001aR𠴳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\u000eXvS|+\u0015R:PDRj",+ [+ "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-2HxUl{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<J\u0002dB\u001b\u001f3g\u0011\u001a",+ [+ "bv_8dexb3v5bhzz4zr3olfcfic",+ "dqojgwna3wtdlvmjh1at2xocutwnwua",+ "fv1sxptmoh83pw_l9h4v346purt9e",+ "h9f41ir_2v",+ "hnocqo5sg5lh68r7cylxs4e",+ "kvatu1w3gq8v70z8v83umu2i0j7g",+ "la8w37s2q2q7s23y50pw",+ "o",+ "o70jx3",+ "o_ppkd31yfenriwqwzu7_h",+ "pkzu1324vsineu0",+ "qm",+ "rzi",+ "uo",+ "vbsc",+ "x"+ ]+ ],+ "tag": "TEnum"+ },+ "tag": "TBase"+ },+ {+ "contents": {+ "tag": "TResolution"+ },+ "tag": "TBase"+ },+ {+ "contents": -6,+ "tag": "TVar"+ },+ {+ "contents": {+ "tag": "TText"+ },+ "tag": "TBase"+ },+ {+ "contents": {+ "tag": "TText"+ },+ "tag": "TBase"+ },+ {+ "contents": {+ "tag": "TText"+ },+ "tag": "TBase"+ },+ {+ "contents": {+ "tag": "TWord64"+ },+ "tag": "TBase"+ },+ {+ "contents": {+ "tag": "TWord64"+ },+ "tag": "TBase"+ },+ {+ "contents": -30,+ "tag": "TVar"+ },+ {+ "contents": {+ "tag": "TTimeDiff"+ },+ "tag": "TBase"+ },+ {+ "contents": 5,+ "tag": "TVar"+ },+ {+ "contents": 9,+ "tag": "TVar"+ },+ {+ "contents": {+ "tag": "TInt"+ },+ "tag": "TBase"+ },+ {+ "contents": -9,+ "tag": "TVar"+ },+ {+ "contents": 10,+ "tag": "TVar"+ }+ ]+ ],+ "tag": "TCons"+ },+ "tag": "TTuple"+ },+ {+ "contents": {+ "contents": [+ {+ "contents": 1,+ "tag": "TVar"+ },+ {+ "contents": {+ "tag": "TTimeDiff"+ },+ "tag": "TBase"+ },+ [+ {+ "contents": -27,+ "tag": "TVar"+ },+ {+ "contents": -14,+ "tag": "TVar"+ },+ {+ "contents": -18,+ "tag": "TVar"+ },+ {+ "contents": {+ "contents": [+ "P\u001eoj\u00035\nZiX8\u0004>]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\u001ap<",+ [+ "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]\u0013C|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+}
+ golden/InfernoType/TSeries.json view
@@ -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+}
+ golden/InfernoType/TTuple.json view
@@ -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𝐄}af0S:\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": [+ "FLkb\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": [+ "$WxP\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": [+ "04zq*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": [+ "kL",+ [+ "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": [+ "yR\u0012\u0000\u0007\u0000w^UGQ\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": [+ "@dM\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\u0011r2a\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,\u0002g8;.~}2\u000c}^t*\u0006Bc.&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$vI9uXw𞋑\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\u0007c𐿦\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": [+ "^OMOr\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:#0h\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]DdUa",+ [+ "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": [+ "%{\u0001mhz[97(\u000c8:*+\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\u00085;\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\\aaP\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|psXbi\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+}
+ golden/InfernoType/TVar.json view
@@ -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+}
+ golden/ModuleName/ModuleName.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ "mtfl_r6bwux945gr7pdwkaqwt2u",+ "b_o2",+ "yx8gmvluqo4o3pqey",+ "s5gp6fktjtqt3jr61",+ "m88ryl7pti2dtij_i4gqicezybi42"+ ],+ "seed": -1738970587+}
+ golden/Namespace/EnumNamespace.json view
@@ -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+}
+ golden/Namespace/FunNamespace.json view
@@ -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+}
+ golden/Namespace/ModuleNamespace.json view
@@ -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+}
+ golden/Namespace/OpNamespace.json view
@@ -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+}
+ golden/Namespace/TypeNamespace.json view
@@ -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+}
+ golden/TV/TV.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ 10,+ 21,+ -5,+ -5,+ -14+ ],+ "seed": -997543535+}
+ golden/VCIncompatReason/EnumConstructorsChanged.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ "EnumConstructorsChanged",+ "EnumConstructorsChanged",+ "EnumConstructorsChanged",+ "EnumConstructorsChanged",+ "EnumConstructorsChanged"+ ],+ "seed": -1065983812+}
+ golden/VCIncompatReason/TypeSignatureChange.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ "TypeSignatureChange",+ "TypeSignatureChange",+ "TypeSignatureChange",+ "TypeSignatureChange",+ "TypeSignatureChange"+ ],+ "seed": 1126967857+}
+ golden/VCMeta/VCMeta.json view
@@ -0,0 +1,276 @@+{+ "samples": [+ {+ "author": "o00005b860000000000bf44de",+ "description": "\u000f\u0018\u0012<\u0018c-",+ "group": "o0000014200000000009596c9",+ "name": "]rI𡷕No𰵫q\u000f\tv",+ "obj": -6,+ "pred": {+ "contents": "5ih-nxxenNZGUinfdl14aRBlYJvE4HALNC_MwYKshTM=",+ "tag": "CompatibleWithPred"+ },+ "timestamp": -13156498,+ "visibility": "VCObjectPublic"+ },+ {+ "author": "o000073ce0000000000dbc2ea",+ "description": "N\u000b@5\u0008=\u0011P\u001b06",+ "group": "o00001134000000000044f712",+ "name": ".(lMx+𰈞p",+ "obj": -2,+ "pred": {+ "contents": "-qaLzxy3ykEmlL8Rmov3kQ7b6B0UGexf4Tm9th0oLLU=",+ "tag": "CompatibleWithPred"+ },+ "timestamp": -2376718,+ "visibility": "VCObjectPublic"+ },+ {+ "author": "o00007f960000000000c4b5fc",+ "description": "l\u0018f4eI_>\u000c3",+ "group": "o000016090000000000284f40",+ "name": "\u0011𫈸HW-9Do|\u001a0i_.\u001aﱚ=\u000b",+ "obj": 1,+ "pred": {+ "tag": "Init"+ },+ "timestamp": 4787500,+ "visibility": "VCObjectPublic"+ },+ {+ "author": "o00005fa20000000000c61725",+ "description": "g_\u0015YX~]X<",+ "group": "o000068e200000000008989ca",+ "name": "]Ub𢷏\u001aak;)",+ "obj": 3,+ "pred": {+ "contents": "CV0a0vVBkbFmpsDlrz28LKBdsn0G82hwtCt303mFtZo=",+ "tag": "MarkedBreakingWithPred"+ },+ "timestamp": -13542723,+ "visibility": "VCObjectPrivate"+ },+ {+ "author": "o0000184d0000000000de82a9",+ "description": "\u001f\u000ePsY9>",+ "group": "o0000399800000000000d735f",+ "name": "._ 3\u0016yF+?:\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+}
+ golden/VCObjectHash/VCObjectHash.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ "uPtsuBPcjkR_shUvEev6ocSUBLNZVsNp_9PLJCzJgqc=",+ "Ip2vp362dlwe7MZKiww-YuR69wpJnydHMvUzSzXWkm0=",+ "TsRzcSEC9foKGpvJ2zJBSv-qqCv57myRzPfLrNSqAcs=",+ "GVJTnA9O35oXWiCLWE2NIEUQ4ZZvZerjLdkolOHbXvg=",+ "qWB6-apnFwzMcVvrUQAab-3GsVt77V5yuFj63YwYb0g="+ ],+ "seed": -1840898569+}
+ golden/VCObjectPred/CloneOf.json view
@@ -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+}
+ golden/VCObjectPred/CloneOfNotFound.json view
@@ -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+}
+ golden/VCObjectPred/CloneOfRemoved.json view
@@ -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+}
+ golden/VCObjectPred/CompatibleWithPred.json view
@@ -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+}
+ golden/VCObjectPred/IncompatibleWithPred.json view
@@ -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+}
+ golden/VCObjectPred/Init.json view
@@ -0,0 +1,20 @@+{+ "samples": [+ {+ "tag": "Init"+ },+ {+ "tag": "Init"+ },+ {+ "tag": "Init"+ },+ {+ "tag": "Init"+ },+ {+ "tag": "Init"+ }+ ],+ "seed": -2029009563+}
+ golden/VCObjectPred/MarkedBreakingWithPred.json view
@@ -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+}
+ golden/VCObjectVisibility/VCObjectPrivate.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ "VCObjectPrivate",+ "VCObjectPrivate",+ "VCObjectPrivate",+ "VCObjectPrivate",+ "VCObjectPrivate"+ ],+ "seed": 1049274447+}
+ golden/VCObjectVisibility/VCObjectPublic.json view
@@ -0,0 +1,10 @@+{+ "samples": [+ "VCObjectPublic",+ "VCObjectPublic",+ "VCObjectPublic",+ "VCObjectPublic",+ "VCObjectPublic"+ ],+ "seed": 514231456+}
+ inferno-core.cabal view
@@ -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
+ src/Inferno/Eval.hs view
@@ -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
+ src/Inferno/Eval/Error.hs view
@@ -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)
+ src/Inferno/Infer.hs view
@@ -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 <ty>` variables, and an expression `e`+-- we want to either substitute any implicit variable `?var$n : rep of <ty>` with a `RuntimeRep <ty>`,+-- provided that `<ty>` 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
+ src/Inferno/Infer/Env.hs view
@@ -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
+ src/Inferno/Infer/Error.hs view
@@ -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
+ src/Inferno/Infer/Exhaustiveness.hs view
@@ -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
+ src/Inferno/Infer/Pinned.hs view
@@ -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'
+ src/Inferno/Module.hs view
@@ -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+ )+ }
+ src/Inferno/Module/Builtin.hs view
@@ -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)
+ src/Inferno/Module/Cast.hs view
@@ -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 $
+ src/Inferno/Module/Prelude.hs view
@@ -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+ };++|]
+ src/Inferno/Module/Prelude/Defs.hs view
@@ -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"
+ src/Inferno/Parse.hs view
@@ -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) "<stdin>" 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) "<stdin>" 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
+ src/Inferno/Parse/Commented.hs view
@@ -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)
+ src/Inferno/Parse/Error.hs view
@@ -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)
+ src/Inferno/Utils/QQ/Common.hs view
@@ -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)
+ src/Inferno/Utils/QQ/Module.hs view
@@ -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."+ }
+ src/Inferno/Utils/QQ/Script.hs view
@@ -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))+ )
+ test/Eval/Spec.hs view
@@ -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 "<<function>>"+ 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"
+ test/Golden/Spec.hs view
@@ -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)
+ test/Infer/Spec.hs view
@@ -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` []
+ test/Parse/Spec.hs view
@@ -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"
+ test/Spec.hs view
@@ -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
+ test/Utils.hs view
@@ -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