diff --git a/inferno-core/CHANGELOG.md b/inferno-core/CHANGELOG.md index ef6bc10..97b54ab 100644 --- a/inferno-core/CHANGELOG.md +++ b/inferno-core/CHANGELOG.md @@ -1,6 +1,9 @@ # Revision History for inferno-core *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH) +## 0.11.0.0 -- 2024-03-12 +* Add records to the Inferno language + ## 0.10.1.0 -- 2024-01-30 * Fix `ToValue` instances for functions and `ImplicitCast` diff --git a/inferno-core/app/Main.hs b/inferno-core/app/Main.hs index 49b93e7..9a4559d 100644 --- a/inferno-core/app/Main.hs +++ b/inferno-core/app/Main.hs @@ -3,28 +3,68 @@ module Main where +import Data.Bifunctor (bimap) import qualified Data.Map as Map import qualified Data.Text.IO as Text import Inferno.Core (Interpreter (..), mkInferno) import Inferno.Module.Prelude (builtinModules) +import Inferno.Types.VersionControl (pinnedToMaybe) import Inferno.Utils.Prettyprinter (showPretty) -import System.Environment (getArgs) +import Options.Applicative + ( Parser, + argument, + execParser, + fullDesc, + header, + help, + helper, + info, + long, + metavar, + progDesc, + short, + str, + switch, + (<**>), + ) import System.Exit (exitFailure) -import System.IO (hPutStrLn, stderr) +import System.IO (hPrint, stderr) + +data CliArgs = CliArgs {file :: String, typecheck :: Bool} + +cliargs :: Parser CliArgs +cliargs = + CliArgs + <$> argument str (metavar "FILE" <> help "Input file path") + <*> switch (long "typecheck" <> short 't' <> help "Only run type inference") main :: IO () main = do - file <- head <$> getArgs - src <- Text.readFile file - Interpreter {evalExpr, defaultEnv, parseAndInferTypeReps} <- + let opts = + info + (cliargs <**> helper) + ( fullDesc + <> progDesc "Run Inferno on FILE" + <> header "inferno - a functional scripting language" + ) + args <- execParser opts + + src <- Text.readFile $ file args + Interpreter {evalExpr, defaultEnv, parseAndInfer} <- mkInferno builtinModules [] :: IO (Interpreter IO ()) - case parseAndInferTypeReps src of + case parseAndInfer src of Left err -> do - hPutStrLn stderr $ show err + hPrint stderr err exitFailure - Right ast -> do - evalExpr defaultEnv Map.empty ast >>= \case - Left err -> do - hPutStrLn stderr $ show err - exitFailure - Right res -> showPretty res + Right (ast, ty, _, _) -> do + if typecheck args + then do + putStrLn "Inferred type:" + showPretty ty + else do + let ast' = bimap pinnedToMaybe (const ()) ast + evalExpr defaultEnv Map.empty ast' >>= \case + Left err -> do + hPrint stderr err + exitFailure + Right res -> showPretty res diff --git a/inferno-core/golden/InfernoType/TRecord.json b/inferno-core/golden/InfernoType/TRecord.json new file mode 100644 index 0000000..cddeacc --- /dev/null +++ b/inferno-core/golden/InfernoType/TRecord.json @@ -0,0 +1,5833 @@ +{ + "samples": [ + { + "contents": [ + { + "a2guaetqlgmiahf4cebz234v808": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "bj": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "c3vk6fde0uf": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "dg3wjk2e": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + "e_kci0j22aht3qoi_geocg1_u8m24y": { + "contents": { + "contents": [ + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": [ + "j", + [ + "hlm", + "z" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "b", + [ + "zs" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + [ + { + "contents": -1, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "ekhxj4nhchk": { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + "fougarey0zo_twe7ke69m0k7ibjj_": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "s", + [ + "k" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 3, + "tag": "TVar" + }, + "tag": "TOptional" + }, + [ + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": 1, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 2, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + "tag": "TOptional" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + [ + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "contents": { + "contents": [ + "g4", + [ + "d" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": 5, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "h1vb": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "ikrbz5nvmzqqfrt_ewg57o_y0ae5m": { + "contents": -18, + "tag": "TVar" + }, + "iyg2yfvk_k36_rpb7eud": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + "juptw2i35z8k": { + "contents": { + "contents": 7, + "tag": "TVar" + }, + "tag": "TOptional" + }, + "klqf1h4umfscmqq97wkmz6egmp": { + "contents": { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + "tag": "TArray" + }, + "kt": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "oxrcvwzyjtomem9bad": { + "contents": -27, + "tag": "TVar" + }, + "p1ljsk0vv2hoq2ew3gcn4f3w3fjx": { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + "pjv5sjguw": { + "contents": 3, + "tag": "TVar" + }, + "qsf3": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "r": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "s8gk_m7xqvfoj9je": { + "contents": { + "contents": -3, + "tag": "TVar" + }, + "tag": "TArray" + }, + "tp98neg_": { + "contents": 15, + "tag": "TVar" + }, + "u2lqe6_wat9pd07fs3": { + "contents": 1, + "tag": "TVar" + }, + "unvhm5vulzab3hovlf9b8_8y_xu": { + "contents": { + "contents": { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + "tag": "TOptional" + }, + "tag": "TArray" + }, + "vj_gryd01s98tmvxmb5a5ebz": { + "contents": { + "contents": -10, + "tag": "TVar" + }, + "tag": "TArray" + }, + "vnyfb2o3iwg7p_amc46za7qsjp": { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "vzchi1hfd09encv992rfzht50m56fb": { + "contents": { + "contents": [ + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 1, + "tag": "TVar" + }, + [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "i", + [ + "b", + "kq6" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": -3, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": -5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": -1, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + "ht31", + [ + "amw", + "ex", + "kp" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": { + "contents": [ + "d", + [ + "c8" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": -4, + "tag": "TVar" + }, + { + "contents": { + "contents": -2, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "n26r", + [ + "csz", + "fcme" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "wi4jhf5jn": { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 7, + "tag": "TVar" + }, + [ + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 3, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "ib", + [ + "lwup", + "q" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "wqg8t2tpstnz9avc7gihjrm": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + }, + { + "tag": "RowAbsent" + } + ], + "tag": "TRecord" + }, + { + "contents": [ + { + "bo1pnm112b1w8mqm7058chnnq": { + "contents": { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + "gr23a": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "ih0so5qm15e0k2umvf_6f": { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + } + }, + { + "tag": "RowAbsent" + } + ], + "tag": "TRecord" + }, + { + "contents": [ + { + "dyexgtx1unr0o8iw13xg": { + "contents": [ + { + "contents": { + "contents": { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + "tag": "TSeries" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "ipw5", + [ + "e8", + "j", + "n6x" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + "gcdcdt1z0a": { + "contents": { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": [ + "n", + [ + "u" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + "tag": "TSeries" + }, + "gcii6bhb5mcopng71wfobx": { + "contents": { + "contents": [ + "n814xcio4yyetvxu65fu295fx707tx", + [ + "b1r6", + "bdra0pu6", + "cf8zh6urmmep5as00s", + "gfpm96kslj", + "iph325ovqldq0wvqoo9", + "izbdt4ck2k0m9mp_3kzha5nn1entn", + "jmebn0skch2ow_tsfxwv", + "kjpjkgtu7clc", + "m3v_x2ixukggv56yz", + "osn5cshb2p", + "p2yztzd5p6x_qh089r", + "qa9mrnvreg0qb67e0dtz98l6", + "qngvwb19w9f6g9yk", + "qskoywij9sndwg5jg", + "t803v2jfuootij2exy_3tc", + "t9od7sb4xow9cqy_g_1r0", + "tixr3kghqa5gk257rqgp6e", + "ubo5hy1nidnkx8kor81jgs4o4609a", + "v7djiaqcwcyuz0c", + "vjqcueyiq5d4", + "y659ljstb0uc6mt4z60rvbbihjs83", + "zzpvv1" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "ipyb5qoykvdb1_sh14fmg3j8": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "kh13bc_bmvgka8ojs7o3x": { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "hz2jd48jn0", + [ + "du12k_qrr", + "fycsuup491", + "jopfvph6", + "kdg0_" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + [ + { + "contents": { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": [ + "d", + [ + "gi1", + "l" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + "f", + [ + "ja91" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": -2, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 2, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": -1, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": 3, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "l", + [ + "e" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": -1, + "tag": "TVar" + }, + [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": -1, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": -1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 3, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 9, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "xximv", + [ + "bljiejg4i", + "ld69jlcxe", + "o5zar4", + "xnzzd", + "zmuq" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 1, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": [ + "uyc", + [ + "kei" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 3, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": -8, + "tag": "TVar" + }, + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "te", + [ + "kg" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TSeries" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "lx2mvdd": { + "contents": { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + "ms91wgwwg3wv13mhx9k6i8p": { + "contents": 13, + "tag": "TVar" + }, + "omqib1dbi_0": { + "contents": -7, + "tag": "TVar" + }, + "pqy4hr7fb67o2x_sk3bbx": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "r5itjos8ad38x6v8elfoirf": { + "contents": { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + "kfi", + [ + "fo", + "n", + "s03" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + "t2tdjukrh4x9ba8j3xgv75lqi66z4m": { + "contents": 14, + "tag": "TVar" + }, + "tueg31y5ss7qesl9927tc0nd1x5kxxk": { + "contents": [ + { + "contents": { + "contents": -1, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": -9, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tuw222k8e9f7ykx": { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "oe", + [ + "bf6p3", + "blrn", + "bqsc", + "fvjg" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + "tzbrkdw8x96cv_gruf6r6yirk1h": { + "contents": { + "contents": [ + "w79w1umq5ymgomqvafox3fkf2cof", + [ + "ajugebmz", + "cn", + "ehztnask", + "g_isuyjldb5pyhv2ops205ndhz", + "ivk7t7tdrn03xg6ln6", + "mw141wo85ke84hv9", + "mzf3gfl5lqwbjv", + "off0rx3p5atl7v7stfs42r", + "uyomqy_5snpodgl8", + "v4hz36wopeyxzfp8cc9h0h_", + "ys5u4f3uyhskgwctvmlx3bn3eh" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "u5": { + "contents": [ + { + "contents": 5, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "umrqppsp8s4vn3ycaprh8keou": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "y7iy1igeodf": { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + "ztw3vjwiqm_fjxss5brygas5tifht": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + }, + { + "tag": "RowAbsent" + } + ], + "tag": "TRecord" + }, + { + "contents": [ + { + "d3d1lbe": { + "contents": [ + { + "contents": { + "contents": { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": 1, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + "i", + [ + "uh" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + [ + { + "contents": 0, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": -1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + "getqqrswy4bj6bp": { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": -2, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": 3, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": -2, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": -1, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -3, + "tag": "TVar" + }, + [ + { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": [ + "d", + [ + "ze" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "e", + [ + "rw" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": [ + "w", + [ + "d", + "np1" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "m2dw": { + "contents": [ + { + "contents": -9, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "n2wie6j_ajb15nqfv1vxl5u": { + "contents": { + "contents": [ + "uag9fugs708", + [ + "b_510fnwwhd1rvf7t_ujbp", + "bb3m_sd8m", + "cidlhhydtqi7", + "cx3", + "d16avwk4se7etez_62kjlnj1g_2", + "dohypf", + "ebymwjoqvau2jtgm4lzhq07qpwrms5", + "eqygtr1menr", + "f1dsz", + "giyk5", + "h0sff1ov9d_7yj5p2k", + "i1fsjsq4f54aio_cpskv", + "igwsqwzqpb1fh40i8xm6wa5t", + "j3v018dni2fu1vpsh0h4x3b", + "mcu7qzkqijxcsehpqoha", + "nwu38v_xjv3zgl7d7fr", + "ro48", + "t0e_2pbf9tutm", + "ul6ac4c8np2tuj722gya", + "wj0kr4y3ja5wtc9sx3a", + "y4unpb6bmiwws7mgegpb29sok3rrgu", + "yrs0oumye3n8q8h9y7", + "zpup9hcklpl6z6xy7iq5cjv_v_fgwjy" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "opid": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "p6g6jk8l4fp42m3fu": { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + "pq9qlkeqdl8tp109f": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "u4dr24y_tj422th6zdy5m2ka8nm7eua": { + "contents": { + "contents": { + "contents": -2, + "tag": "TVar" + }, + "tag": "TSeries" + }, + "tag": "TSeries" + }, + "usk9ho8e9_hbprzmynt102qzmly": { + "contents": [ + { + "contents": 8, + "tag": "TVar" + }, + { + "contents": -5, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "uxf_o_": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + }, + { + "tag": "RowAbsent" + } + ], + "tag": "TRecord" + }, + { + "contents": [ + { + "b43x": { + "contents": 27, + "tag": "TVar" + }, + "cvejrybuor9wn7p": { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 3, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": -1, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": 6, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": { + "contents": { + "contents": [ + "c", + [ + "j4d", + "q" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": -1, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": -1, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": 0, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": -3, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 1, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + "doe", + [ + "k9p", + "q", + "ymec" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "fy4igakaeaen_": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "ib0hok": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "iopbilx67y09a": { + "contents": { + "contents": 4, + "tag": "TVar" + }, + "tag": "TOptional" + }, + "j3jcky3e_isyy9rfxr7bc": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "jy7yhefdaw": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "kbjedd7e128g3i0bhcvjeg": { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TSeries" + }, + "tag": "TArray" + }, + { + "contents": -5, + "tag": "TVar" + }, + [ + { + "contents": -10, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + [ + { + "contents": -3, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": 7, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + "wv27u3d7wv", + [ + "a5a3hl4496", + "bi6uvfec_a", + "fzl92rezu", + "jgl", + "jxszc6z4e8", + "mtoug244", + "n", + "oe42jrqj2", + "rnxue3gogb", + "uhpg6lq3" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TOptional" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TOptional" + }, + [ + { + "contents": { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "contents": [ + "p4", + [ + "fj" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 3, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + [ + { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": 1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": -3, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": -1, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": -7, + "tag": "TVar" + }, + { + "contents": { + "contents": { + "contents": { + "contents": { + "contents": [ + "i", + [ + "rr" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + "tag": "TSeries" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": -1, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": { + "contents": [ + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": 0, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + { + "contents": -3, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": [ + "mwhgpzgcz8c", + [ + "bdigskjurx", + "gcmy", + "i_0v8r5mcwf", + "ns5q7", + "rtbxw3b3v", + "v2duk" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + { + "contents": { + "contents": { + "tag": "TTime" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": -6, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "lyku87szmdkrm36dt8ejj7lb0": { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": -8, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "m8is51tb4ubfs8ce_jdfmjo_bzdjz": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "nrbpdjxv": { + "contents": { + "contents": [ + { + "contents": -2, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + }, + [ + { + "contents": [ + { + "contents": 2, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + "a", + [ + "p" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + [ + { + "contents": 0, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 1, + "tag": "TVar" + }, + { + "contents": 1, + "tag": "TVar" + }, + [ + { + "contents": [ + { + "contents": { + "contents": [ + "f", + [ + "h" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + { + "contents": [ + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + }, + { + "contents": [ + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TArray" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TSeries" + }, + "tag": "TArray" + }, + { + "contents": [ + { + "contents": { + "contents": -1, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": 3, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": 5, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + "p8rp": { + "contents": { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TOptional" + }, + "tag": "TOptional" + }, + "ph585l9jmfqllgdrdnpwnye": { + "contents": [ + { + "contents": 10, + "tag": "TVar" + }, + { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + } + ], + "tag": "TArr" + }, + "pnl3l2or4tel2k34jzqfoni3b": { + "contents": { + "tag": "TResolution" + }, + "tag": "TBase" + }, + "qi16bwtv778d9bm4jojpvz6t6ohm": { + "contents": [ + { + "contents": -6, + "tag": "TVar" + }, + { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + }, + "qlm31nk5cb3znehs3jzt": { + "contents": 12, + "tag": "TVar" + }, + "r8_juxif8kjrn0xye7f5pdef8u635": { + "contents": { + "tag": "TWord32" + }, + "tag": "TBase" + }, + "sf": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + }, + { + "contents": -1, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + }, + "tag": "TOptional" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TArray" + } + ], + "tag": "TArr" + }, + "sih29kzs5_v2fua5zqcugv": { + "contents": [ + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": [ + { + "contents": { + "tag": "TTimeDiff" + }, + "tag": "TBase" + }, + { + "contents": 0, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": 0, + "tag": "TVar" + }, + [ + { + "contents": 0, + "tag": "TVar" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + [ + { + "contents": { + "tag": "TInt" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": { + "tag": "TText" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + { + "contents": { + "contents": { + "tag": "TNil" + }, + "tag": "TTuple" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + }, + "tft4uxos": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TDouble" + }, + "tag": "TBase" + }, + [ + { + "contents": 0, + "tag": "TVar" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": { + "contents": [ + "v", + [ + "pzo" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + }, + "tag": "TSeries" + }, + { + "contents": { + "contents": [ + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + { + "contents": { + "tag": "TWord16" + }, + "tag": "TBase" + }, + [ + { + "contents": { + "contents": [ + "i", + [ + "x" + ] + ], + "tag": "TEnum" + }, + "tag": "TBase" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + [] + ], + "tag": "TCons" + }, + "tag": "TTuple" + } + ] + ], + "tag": "TCons" + }, + "tag": "TTuple" + }, + { + "contents": 5, + "tag": "TVar" + } + ], + "tag": "TArr" + }, + "tmjf5x9xmfo0": { + "contents": -21, + "tag": "TVar" + }, + "viwr6_p75fex54ypvgo2snnfdai": { + "contents": -10, + "tag": "TVar" + }, + "x07349eajiwtj5d9rm2": { + "contents": -15, + "tag": "TVar" + }, + "y7z7mr8drk74zwnow7rhxx": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": -1, + "tag": "TVar" + }, + { + "contents": { + "tag": "TWord64" + }, + "tag": "TBase" + } + ], + "tag": "TArr" + }, + "tag": "TSeries" + }, + { + "contents": [ + { + "contents": { + "contents": 1, + "tag": "TVar" + }, + "tag": "TArray" + }, + { + "contents": { + "contents": 0, + "tag": "TVar" + }, + "tag": "TSeries" + } + ], + "tag": "TArr" + } + ], + "tag": "TArr" + } + }, + { + "contents": -23, + "tag": "RowVar" + } + ], + "tag": "TRecord" + } + ], + "seed": 522267232 +} \ No newline at end of file diff --git a/inferno-core/inferno-core.cabal b/inferno-core/inferno-core.cabal index c88bbb4..2148df7 100644 --- a/inferno-core/inferno-core.cabal +++ b/inferno-core/inferno-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: inferno-core -version: 0.10.1.0 +version: 0.11.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 @@ -46,7 +46,7 @@ library , Inferno.Utils.QQ.Common hs-source-dirs: src - ghc-options: -Wall -Wunused-packages -Wincomplete-uni-patterns -Wincomplete-record-updates + ghc-options: -Wall -Wunused-packages -Wincomplete-uni-patterns -Wincomplete-record-updates -Wincomplete-patterns build-depends: base >= 4.13 && < 4.17 , bimap >= 0.5.0 && < 0.6 @@ -59,7 +59,7 @@ library , extra >= 1.7.12 && < 1.8 , generic-lens >= 2.2.1 && < 2.3 , inferno-vc >= 0.3.0 && < 0.4 - , inferno-types >= 0.3.0 && < 0.4 + , inferno-types >= 0.4.0 && < 0.5 , megaparsec >= 9.2.1 && < 9.3 , memory >= 0.18.0 && < 0.19 , mtl >= 2.2.2 && < 2.3 @@ -137,5 +137,6 @@ executable inferno , containers , inferno-core , inferno-types + , optparse-applicative , text default-language: Haskell2010 diff --git a/inferno-core/src/Inferno/Eval.hs b/inferno-core/src/Inferno/Eval.hs index 31d09c3..4d3cbf4 100644 --- a/inferno-core/src/Inferno/Eval.hs +++ b/inferno-core/src/Inferno/Eval.hs @@ -29,19 +29,7 @@ import Inferno.Types.Syntax ) import Inferno.Types.Value ( ImplEnvM, - Value - ( VArray, - VDouble, - VEmpty, - VEnum, - VFun, - VInt, - VOne, - VText, - VTuple, - VTypeRep, - VWord64 - ), + Value (..), runImplEnvM, ) import Inferno.Types.VersionControl (VCObjectHash) @@ -204,6 +192,17 @@ eval env@(localEnv, pinnedEnv) expr = case expr of _ -> throwM $ RuntimeError "failed to match with a bool" Tuple_ es -> foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] (tListToList es) >>= return . VTuple + Record_ fs -> do + valMap <- foldrM (\(f, e, _) vs -> eval env e >>= \v -> return ((f, v) : vs)) [] fs + return $ VRecord $ Map.fromList valMap + RecordField_ (Ident r) f -> do + case Map.lookup (ExtIdent $ Right r) localEnv of + Just (VRecord fs) -> do + case Map.lookup f fs of + Just v -> return v + Nothing -> throwM $ RuntimeError "record field not found" + Just _ -> throwM $ RuntimeError "failed to match with a record" + Nothing -> throwM $ RuntimeError $ show (ExtIdent $ Right r) <> " not found in the unpinned env" One_ e -> eval env e >>= return . VOne Empty_ -> return $ VEmpty Assert_ cond e -> diff --git a/inferno-core/src/Inferno/Infer.hs b/inferno-core/src/Inferno/Infer.hs index b25a3bd..8c923d5 100644 --- a/inferno-core/src/Inferno/Infer.hs +++ b/inferno-core/src/Inferno/Infer.hs @@ -13,6 +13,7 @@ module Inferno.Infer findTypeClassWitnesses, inferTypeReps, inferPossibleTypes, + unifyRecords, ) where @@ -43,7 +44,7 @@ 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 Data.List (find, unzip4) import qualified Data.List.NonEmpty as NEList import qualified Data.Map as Map import qualified Data.Map.Merge.Lazy as Map @@ -78,6 +79,7 @@ import Inferno.Types.Syntax Lit (LDouble, LHex, LInt, LText), ModuleName (..), Pat (..), + RestOfRecord (..), Scoped (..), fromEitherList, fromScoped, @@ -95,7 +97,7 @@ import Inferno.Types.Type Subst (..), Substitutable (..), TCScheme (..), - TV, + TV (..), TypeClass (TypeClass), typeBool, typeDouble, @@ -106,9 +108,8 @@ import Inferno.Types.Type (.->), ) import Inferno.Types.VersionControl (Pinned (..), VCObjectHash, pinnedToMaybe, vcHash) --- import Inferno.Utils.Prettyprinter (renderPretty) --- import Prettyprinter (pretty) import qualified Picosat +import Prettyprinter (Pretty (pretty), (<+>)) import System.IO.Unsafe (unsafePerformIO) import Text.Megaparsec (SourcePos (..), initialPos) @@ -159,6 +160,10 @@ instance Substitutable Constraint where ftv (Left (t1, t2, _)) = ftv t1 `Set.union` ftv t2 ftv (Right (_, tc)) = ftv tc +instance Pretty Constraint where + pretty (Left (t1, t2, _errs)) = pretty t1 <+> "~" <+> pretty t2 + pretty (Right (_loc, tc)) = pretty tc + ------------------------------------------------------------------------------- -- Inference ------------------------------------------------------------------------------- @@ -289,15 +294,17 @@ inferExpr allModules expr = -- 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 + -- trace ("\ninferExpr: " <> (Text.unpack . renderPretty) expr') + -- $ trace + -- ( "ty: " + -- <> (Text.unpack . renderPretty) ty -- <> "\ncs: " - -- <> (intercalate "\n" $ map show $ Set.toList cs) + -- <> (intercalate "\n" $ map (Text.unpack . renderPretty) $ Set.toList cs) + -- <> "\n" -- ) - -- $ + -- $ -- case runSolve typeClasses $ filter (\case { Right (_, TypeClass "rep" _) -> False; _ -> True }) $ Set.toList cs of - case runSolve typeClasses $ Set.toList cs of + case runSolve count typeClasses $ Set.toList cs of Left errs -> Left errs Right subst -> -- trace ("substs: " <> show subst) $ @@ -372,14 +379,23 @@ inferExpr allModules expr = tyCls `Set.union` Set.unions [tc | Module {moduleTypeClasses = tc} <- Map.elems modules] ) +maxTVarInConstraints :: [Either (InfernoType, InfernoType, [a]) ((SourcePos, SourcePos), TypeClass)] -> Int +maxTVarInConstraints cs = case Set.lookupMax $ Set.unions $ map freeTypeVars cs of + Just (TV i) -> i + 1 + Nothing -> 0 + where + freeTypeVars (Right (_, c)) = ftv c + freeTypeVars (Left (t1, t2, _)) = ftv t1 `Set.union` ftv t2 + -- | Given a type signature and some concrete assignment of types (assumes inputTys and outputTy have no free variables) --- | this function computes the runtime reps +-- 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 + varCount = maxTVarInConstraints cs + in case runSolve varCount allTypeClasses cs of Left errs -> Left errs Right subst -> let tyClsSubst = Set.map (apply subst) tyCls @@ -399,7 +415,6 @@ inferTypeReps allTypeClasses (ForallTC tvs tyCls (ImplType _impl ty)) inputTys o 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]) @@ -407,7 +422,8 @@ inferPossibleTypes allTypeClasses (ForallTC _ tyCls (ImplType _impl ty)) inputTy let cs = [Right (dummyPos, c) | c@(TypeClass nm _) <- Set.toList tyCls, nm /= "rep"] ++ mkMaybeConstraints ty inputTys - in case runSolve allTypeClasses cs of + varCount = maxTVarInConstraints cs + in case runSolve varCount allTypeClasses cs of Left errs -> Left errs Right subst -> do let tyClsSubst = Set.map (apply subst) $ Set.filter (\case TypeClass "rep" _ -> False; _ -> True) tyCls @@ -433,7 +449,6 @@ inferPossibleTypes allTypeClasses (ForallTC _ tyCls (ImplType _impl ty)) inputTy Just t' -> [Left (t, t', [])] Nothing -> [] mkMaybeConstraints _ _ = error "mkConstraints: invalid input params length" - dummyPos = let pos = initialPos "" in (pos, pos) -- | Extend type environment @@ -506,7 +521,7 @@ 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 :: InfernoType -> InfernoType -> [TypeError SourcePos] -> Constraint 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) @@ -597,6 +612,48 @@ infer expr = ) let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) is return (InterpolatedString p1 (fromEitherList xs') p2, ImplType isMerged typeText, Set.unions css `Set.union` Set.fromList ics) + Record p1 fes p2 -> do + let (fs, es) = unzip $ map (\(f, e, p) -> (f, (e, p))) fes + (es', impls, tys, cs) <- go es + let (isMerged, ics) = mergeImplicitMaps (blockPosition expr) impls + let inferredTy = ImplType isMerged $ TRecord (Map.fromList $ zip fs tys) RowAbsent + let fes' = zipWith (\f (e, p) -> (f, e, p)) fs es' + + attachTypeToPosition + exprLoc + TypeMetadata + { identExpr = bimap (const ()) (const ()) $ removeComments expr, + ty = (Set.empty, inferredTy), + docs = Nothing + } + return + ( Record p1 fes' 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) + RecordField p_r (Ident r) (Ident f) -> do + (_e', ImplType i_r t_r, cs_r) <- infer $ Var p_r Local LocalScope $ Expl $ ExtIdent $ Right r + tv <- fresh + trv <- + fresh >>= \case + (TVar x) -> pure x + _ -> error "fresh returned something other than a TVar" + let tyCls = Set.fromList $ map snd $ rights $ Set.toList $ cs_r + let tyRec = TRecord (Map.singleton (Ident f) tv) (RowVar trv) + return + ( expr, + ImplType i_r tv, + cs_r + `Set.union` Set.fromList + [ tyConstr t_r tyRec [UnificationFail tyCls t_r tyRec $ blockPosition expr] + ] + ) Array _ [] _ -> do tv <- fresh let meta = @@ -800,7 +857,7 @@ infer expr = ( x, TypeMetadata { identExpr = Var () () LocalScope $ Expl x, - -- ty = ForallTC [] tyCls $ ImplType i1 t1, + -- TODO should this instead be: ty = t, ty = ForallTC [] tcs (ImplType iT tT), docs = Nothing } @@ -1206,12 +1263,12 @@ 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 +runSolve :: Int -> Set.Set TypeClass -> [Constraint] -> Either [TypeError SourcePos] Subst +runSolve varCount allClasses cs = runIdentity $ runExceptT $ flip runReaderT allClasses $ solver varCount st where st = (emptySubst, cs) -unifyMany :: [TypeError SourcePos] -> [InfernoType] -> [InfernoType] -> Solve Subst +unifyMany :: [TypeError SourcePos] -> [InfernoType] -> [InfernoType] -> SolveState Int Subst unifyMany _ [] [] = return emptySubst unifyMany err (t1 : ts1) (t2 : ts2) = do su1 <- unifies err t1 t2 @@ -1219,7 +1276,115 @@ unifyMany err (t1 : ts1) (t2 : ts2) = do return (su2 `compose` su1) unifyMany err _ _ = trace "throwing in unifyMany " $ throwError err -unifies :: [TypeError SourcePos] -> InfernoType -> InfernoType -> Solve Subst +-- | Unify the fields of two record types. +-- +-- The idea in theory is, if we are trying to unify +-- @ +-- {f1: tf1, ..., g1: tg1, ..., 'a} +-- ~ {g1: tg1', ..., f1': tf1', ..., 'b} +-- @ +-- where g1, ... gN are the common fields, then we first expand the row vars 'a and 'b +-- so that we have the same set of field names on both sides: +-- @ +-- {f1: tf1, ..., g1: tg1, ..., f1': 't1', ..., 'c} +-- ~ {f1: 't1, ..., g1: tg1', ..., f1': tf1', ..., 'd} +-- @ +-- where 't1, 't2, ... and 't1', 't2', ... and 'c and 'd are fresh type vars. +-- Then, we match up the field names and unify the field types. +-- Finally, we add the substs: +-- @ +-- 'a ~> {f1': 't1', ..., 'c} +-- 'b ~> {f1: 't1, ..., 'd} +-- @ +-- +-- The implementation in practice proceeds by recursing on the fields of both records. +-- We first convert the Map of field types to a *sorted* association list, and recurse +-- on both association lists in the style of mergesort's merge. When the two smallest +-- field names are the same, we unify the field types. Otherwise, we take the smallest +-- and create a fresh type var and add it as a new field to the other side. +-- This function recurses with arguments that include a list of new fields for each +-- record (in *descending* order of field names), and the list of pairs of field types +-- that must be unified. +-- +-- Reference: +-- https://gallium.inria.fr/~remy/ftp/habil.pdf (Chapter 2) +-- https://gallium.inria.fr/~remy/ftp/record-algebras.pdf +-- (Though the algorithm implemented here is based on my understanding of how the +-- theoretical algorithms in the above papers would be implemented in practice.) +unifyRecords :: + [TypeError SourcePos] -> + ([(Ident, InfernoType)], RestOfRecord) -> + ([(Ident, InfernoType)], RestOfRecord) -> + [(Ident, InfernoType)] -> + [(Ident, InfernoType)] -> + [(InfernoType, InfernoType)] -> + SolveState Int Subst +-- unifyRecords _err (ts1, trv1) (ts2, trv2) nf1 nf2 ps +-- | trace (Text.unpack ("\nunifyRecords called with " <> renderPretty (TRecord (Map.fromList ts1) trv1) <> " " <> renderPretty (TRecord (Map.fromList ts2) trv2))) False = undefined +unifyRecords err ([], trv1) ([], trv2) newFields1 newFields2 pairs = do + -- Base case: when all fields are expanded and matched up: + -- trace ("End unifyRecords: " <> show newFields1 <> " " <> show newFields2) $ pure () + -- If new fields were added, create a fresh row var and a substitution for it + (trv1', su1) <- makeRowVarSubst trv1 newFields1 + (trv2', su2) <- makeRowVarSubst trv2 newFields2 + let su = Subst $ Map.fromList $ su1 ++ su2 + -- Unify all pairs of field types and the final row vars + let pairsToUnify = unifyRowVars trv1' trv2' ++ pairs + su' <- uncurry (unifyMany err) $ unzip pairsToUnify + -- Apply su' to su so that the fields and row vars in su are unified + pure $ su' `compose` su + where + unifyRowVars RowAbsent RowAbsent = [] + unifyRowVars (RowVar tv) RowAbsent = [(TVar tv, TRecord mempty RowAbsent)] + unifyRowVars RowAbsent (RowVar tv) = [(TVar tv, TRecord mempty RowAbsent)] + unifyRowVars (RowVar tv) (RowVar tv') = [(TVar tv, TVar tv')] + -- Create a subst from a new row var to the new fields + makeRowVarSubst trv [] = + pure (trv, []) + makeRowVarSubst RowAbsent _ = + error "impossible: newFields created when RowVar is RowAbsent" + makeRowVarSubst (RowVar tv) newFields = do + tv' <- freshTypeVar + pure (RowVar tv', [(tv, TRecord (Map.fromDescList newFields) (RowVar tv'))]) +unifyRecords err ([], trv1) ((f2, t2) : ts2, trv2) newFields1 newFields2 pairs = do + tv <- expandRowVar err trv1 + let pairs' = (tv, t2) : pairs + let newFields1' = (f2, tv) : newFields1 + unifyRecords err ([], trv1) (ts2, trv2) newFields1' newFields2 pairs' +unifyRecords err ((f1, t1) : ts1, trv1) ([], trv2) newFields1 newFields2 pairs = do + tv <- expandRowVar err trv2 + let pairs' = (tv, t1) : pairs + let newFields2' = (f1, tv) : newFields2 + unifyRecords err (ts1, trv1) ([], trv2) newFields1 newFields2' pairs' +unifyRecords err ((f1, t1) : ts1, trv1) ((f2, t2) : ts2, trv2) newFields1 newFields2 pairs + | f1 == f2 = do + let pairs' = (t1, t2) : pairs + unifyRecords err (ts1, trv1) (ts2, trv2) newFields1 newFields2 pairs' + | f1 > f2 = do + tv <- expandRowVar err trv1 + let pairs' = (tv, t2) : pairs + let newFields1' = (f2, tv) : newFields1 + unifyRecords err ((f1, t1) : ts1, trv1) (ts2, trv2) newFields1' newFields2 pairs' + | otherwise = do + tv <- expandRowVar err trv2 + let pairs' = (tv, t1) : pairs + let newFields2' = (f1, tv) : newFields2 + unifyRecords err (ts1, trv1) ((f2, t2) : ts2, trv2) newFields1 newFields2' pairs' + +-- | If the rest of the record is a row variable, this generates a fresh type var to +-- denote a new field. Otherwise, it throws a type error. +expandRowVar :: [TypeError SourcePos] -> RestOfRecord -> SolveState Int InfernoType +expandRowVar err RowAbsent = throwError err +expandRowVar _err (RowVar _) = TVar <$> freshTypeVar + +freshTypeVar :: SolveState Int TV +freshTypeVar = do + count <- get + put $ count + 1 + return $ TV count + +unifies :: [TypeError SourcePos] -> InfernoType -> InfernoType -> SolveState Int Subst +-- unifies _ t1 t2 | trace (Text.unpack ("unifying " <> renderPretty t1 <> " and " <> renderPretty t2)) False = undefined 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 @@ -1230,28 +1395,33 @@ 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 (TRecord ts1 trv1) (TRecord ts2 trv2) = do + unifyRecords err (Map.toAscList ts1, trv1) (Map.toAscList ts2, trv2) [] [] [] unifies err _ _ = -- trace "throwing in unifies " $ throwError err -- Unification solver -solver :: Unifier -> Solve Subst -solver (su, cs) = +solver :: Int -> Unifier -> Solve Subst +solver varCount (su, cs) = case cs of [] -> return su _ -> do let (tyConstrs, typeCls) = partitionEithers cs - su1 <- solverTyCs su tyConstrs + su1 <- flip evalSolveState varCount $ solverTyCs su tyConstrs + -- trace ("After solverTyCs, final su1\n" <> show su1) $ pure () 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 :: Subst -> [(InfernoType, InfernoType, [TypeError SourcePos])] -> SolveState Int Subst +-- solverTyCs su _cs | trace ("solverTyCs with su: " <> show su) False = undefined solverTyCs su cs = case cs of [] -> return su ((t1, t2, errs) : cs0) -> do su1 <- unifies errs t1 t2 + -- trace ("In solverTyCs, applying su1\n" <> show su1 <> "\nOnto es\n" <> show cs0) $ pure () 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 @@ -1401,7 +1571,11 @@ findTypeClassWitnesses allClasses iters tyCls tvs = tryMatchPartial :: [InfernoType] -> TypeClass -> Solve (Maybe Subst) tryMatchPartial tys (TypeClass _ tys2) = - ((Just <$> unifyMany [] tys tys2) `catchError` (\_ -> return Nothing)) + (Just <$> evalSolveState (unifyMany [] tys tys2) varCount) `catchError` (\_ -> return Nothing) + where + varCount = case Set.lookupMax $ Set.unions $ map ftv $ tys ++ tys2 of + Just (TV i) -> i + 1 + Nothing -> 0 -- | 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. @@ -1489,7 +1663,7 @@ xor ls = forM_ xs $ \y -> addClause [-x, -y] go xs -bind :: [TypeError SourcePos] -> TV -> InfernoType -> Solve Subst +bind :: [TypeError SourcePos] -> TV -> InfernoType -> SolveState Int Subst bind err a t | t == TVar a = return emptySubst | occursCheck a t = throwError [InfiniteType a t loc | loc <- (getLocFromErrs err)] diff --git a/inferno-core/src/Inferno/Infer/Env.hs b/inferno-core/src/Inferno/Infer/Env.hs index d1d636d..fe4ca0b 100644 --- a/inferno-core/src/Inferno/Infer/Env.hs +++ b/inferno-core/src/Inferno/Infer/Env.hs @@ -30,7 +30,7 @@ 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.Syntax (ExtIdent, RestOfRecord (RowAbsent, RowVar)) import Inferno.Types.Type ( ImplType (..), InfernoType (..), @@ -131,6 +131,8 @@ fv (TArray t) = fv t fv (TSeries t) = fv t fv (TOptional t) = fv t fv (TTuple ts) = foldr ((++) . fv) [] ts +fv (TRecord ts RowAbsent) = concatMap fv ts +fv (TRecord ts (RowVar a)) = foldr ((++) . fv) [a] ts fv (TRep t) = fv t normtype :: Map.Map TV TV -> InfernoType -> InfernoType @@ -140,6 +142,11 @@ 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 (TRecord as RowAbsent) = TRecord (fmap (normtype ord) as) RowAbsent +normtype ord (TRecord as (RowVar a)) = + case Map.lookup a ord of + Just x -> TRecord (fmap (normtype ord) as) (RowVar x) + Nothing -> TRecord (fmap (normtype ord) as) (RowVar a) normtype ord (TRep a) = TRep $ normtype ord a normtype ord (TVar a) = case Map.lookup a ord of diff --git a/inferno-core/src/Inferno/Infer/Pinned.hs b/inferno-core/src/Inferno/Infer/Pinned.hs index 449895c..02b686e 100644 --- a/inferno-core/src/Inferno/Infer/Pinned.hs +++ b/inferno-core/src/Inferno/Infer/Pinned.hs @@ -139,9 +139,22 @@ pinExpr m expr = 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 + Var p _hash modNm i@(Expl (ExtIdent (Right x))) -> + case modNm of + Scope (ModuleName a) -> + -- `a.b` can be either Mod.foo or record.field + -- First check if `a` is a local var (record) + case lookupName exprPos LocalScope (FunNamespace $ Ident a) m of + Right _ -> + pure $ RecordField p (Ident a) (Ident x) + Left _ -> + -- Else assume `a.b` is Mod.foo + pinScopedVar + LocalScope -> pinScopedVar + where + pinScopedVar = 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 @@ -152,6 +165,11 @@ pinExpr m expr = InterpolatedString p1 xs p2 -> do xs' <- mapM (\(p3, e, p4) -> (\e' -> (p3, e', p4)) <$> pinExpr m e) xs pure $ InterpolatedString p1 xs' p2 + Record p1 es p2 -> do + es' <- mapM (\(f, e, p3) -> (f,,p3) <$> pinExpr m e) es + pure $ Record p1 es' p2 + RecordField p1 r f -> + pure $ RecordField p1 r f Array p1 es p2 -> do es' <- mapM (\(e, p3) -> (,p3) <$> pinExpr m e) es pure $ Array p1 es' p2 diff --git a/inferno-core/src/Inferno/Instances/Arbitrary.hs b/inferno-core/src/Inferno/Instances/Arbitrary.hs index d89bdca..7533f4c 100644 --- a/inferno-core/src/Inferno/Instances/Arbitrary.hs +++ b/inferno-core/src/Inferno/Instances/Arbitrary.hs @@ -49,6 +49,7 @@ import Inferno.Types.Syntax ModuleName (..), OpsTable, Pat (..), + RestOfRecord, Scoped (..), SomeIStr (..), TList (..), @@ -137,6 +138,10 @@ instance Arbitrary BaseType where ] ) +deriving instance ToADTArbitrary RestOfRecord + +deriving via (GenericArbitrary RestOfRecord) instance Arbitrary RestOfRecord + deriving instance ToADTArbitrary InfernoType instance Arbitrary InfernoType where @@ -160,6 +165,9 @@ instance Arbitrary InfernoType where arbitraryBase = TBase <$> arbitrary + arbitraryRecord = do + TRecord <$> scale (`div` 3) arbitrary <*> arbitrary + arbitraryRest = do -- NOTE: we omit TRep because it is an internal type that the parser does not support constr <- elements [TArray, TSeries, TOptional] @@ -175,6 +183,7 @@ instance Arbitrary InfernoType where arbitraryBase, arbitraryArr, arbitraryTTuple, + arbitraryRecord, arbitraryRest ] @@ -514,6 +523,11 @@ instance (Arbitrary hash, Arbitrary pos) => Arbitrary (Expr hash pos) where <*> oneof [(\p e -> Just (p, e)) <$> arbitrary <*> (arbitrarySized $ n `div` 3), pure Nothing] <*> arbitrary + arbitraryRecord n = do + k <- choose (0, n) + let args = sequence [(,,Nothing) <$> arbitrary <*> arbitrarySized (n `div` 3) | _ <- [1 .. k]] + Record <$> arbitrary <*> args <*> arbitrary + arbitrarySized :: (Arbitrary hash, Arbitrary pos) => Int -> Gen (Expr hash pos) arbitrarySized 0 = oneof @@ -543,6 +557,8 @@ instance (Arbitrary hash, Arbitrary pos) => Arbitrary (Expr hash pos) where ) <*> arbitrary, arbitraryArrayComp n, + arbitraryRecord n, + RecordField <$> arbitrary <*> arbitrary <*> arbitrary, One <$> arbitrary <*> arbitrarySized (n `div` 3), Empty <$> arbitrary, arbitraryAssert n, diff --git a/inferno-core/src/Inferno/Parse.hs b/inferno-core/src/Inferno/Parse.hs index 25cbf25..710acc9 100644 --- a/inferno-core/src/Inferno/Parse.hs +++ b/inferno-core/src/Inferno/Parse.hs @@ -13,6 +13,7 @@ module Inferno.Parse expr, parseExpr, parseType, + parseTCScheme, modulesParser, prettyError, rws, @@ -55,6 +56,7 @@ import Inferno.Types.Syntax Lit (..), ModuleName (..), Pat (..), + RestOfRecord (..), Scoped (..), SigVar (..), TList (..), @@ -336,7 +338,7 @@ arrayComprE = label "array builder\nfor example: [n * 2 + 1 | n <- range 0 10, i ifPos <- getSourcePos (ifPos,) <$> (rword "if" *> expr) -array :: SomeParser r a -> SomeParser r (SourcePos, [(a, Maybe SourcePos)], SourcePos) +array :: Parser a -> Parser (SourcePos, [(a, Maybe SourcePos)], SourcePos) array p = label "array\nfor example: [1,2,3,4,5]" $ lexeme $ do startPos <- getSourcePos @@ -362,6 +364,36 @@ array p = label "array\nfor example: [1,2,3,4,5]" $ ) <|> pure [] +record :: Parser a -> Parser (SourcePos, [(Ident, a, Maybe SourcePos)], SourcePos) +record p = label "record\nfor example: {name = \"Zaphod\"; age = 391}" $ + lexeme $ do + startPos <- getSourcePos + symbol "{" + args <- argsE + endPos <- getSourcePos + char '}' + return (startPos, args, endPos) + where + argsE = + try + ( do + f <- lexeme $ Ident <$> variable + symbol "=" + e <- p + commaPos <- getSourcePos + symbol ";" + es <- argsE + return ((f, e, Just commaPos) : es) + ) + <|> try + ( do + f <- lexeme $ Ident <$> variable + symbol "=" + e1 <- p + return [(f, e1, Nothing)] + ) + <|> pure [] + mkInterpolatedString :: [Either Text e] -> [Either Text e] mkInterpolatedString [] = [] mkInterpolatedString (Left x : Left y : xs) = mkInterpolatedString (Left (x <> y) : xs) @@ -656,6 +688,8 @@ term = <|> enumE Enum <|> do -- Variable: foo or Mod.foo or Mod.(+) + -- Record field access rec.field is also parsed as Var and converted to RecordField + -- in pinExpr startPos <- getSourcePos lexeme $ try @@ -687,6 +721,7 @@ term = <|> stringE Lit <|> interpolatedStringE <|> (try (uncurry3 Array <$> array expr)) + <|> try (uncurry3 Record <$> record expr) <|> arrayComprE app :: Parser (Expr () SourcePos) @@ -785,11 +820,55 @@ type_variable = do Just i -> return i Nothing -> customFailure $ UnboundTyVar nm +recordType :: TyParser (Map.Map Ident InfernoType, RestOfRecord) +recordType = label "record type\nfor example: {name: text; age: int}" $ + lexeme $ do + symbol "{" + (fields, rest) <- argsE + return (Map.fromList fields, rest) + where + argsE = + try + ( do + f <- lexeme $ Ident <$> fieldName + symbol ":" + e <- typeParser + symbol ";" + (fields, rest) <- argsE + return ((f, e) : fields, rest) + ) + <|> ( do + f <- lexeme $ Ident <$> fieldName + symbol ":" + e1 <- typeParser + char '}' + return ([(f, e1)], RowAbsent) + ) + <|> ( do + t <- type_variable + char '}' + return ([], RowVar $ TV t) + ) + <|> ( do + char '}' + pure ([], RowAbsent) + ) + keywords = Set.fromList $ rws ++ rws_type + fieldName :: TyParser Text + fieldName = f >>= check + where + f = pack <$> (((:) <$> letterChar <*> hidden (many alphaNumCharOrSeparator)) "a record field name") + check x = + if x `Set.member` keywords + then fail $ "Keyword " <> show x <> " cannot be a record field name" + else return x + typeParserBase :: TyParser InfernoType typeParserBase = try ((\(_, tys, _) -> TTuple $ fmap fst tys) <$> tuple typeParser) <|> parens typeParser <|> try (lexeme baseType) + <|> uncurry TRecord <$> recordType <|> lexeme (TBase <$> (TEnum <$> typeIdent <*> (Set.fromList <$> (symbol "{" *> enumList <* symbol "}")))) <|> lexeme (TVar . TV <$> type_variable) where @@ -820,6 +899,12 @@ parseType s = case runParser (runWriterT $ flip runReaderT (mempty, mempty, memp Left (ParseErrorBundle errs pos) -> Left $ fst $ attachSourcePos errorOffset errs pos Right (e, _) -> Right e +parseTCScheme :: Text -> Either String TCScheme +parseTCScheme s = + case runParser (runWriterT $ flip runReaderT (mempty, mempty, mempty, []) $ topLevel schemeParser) "" s of + Left (ParseErrorBundle errs pos) -> Left $ show $ fst $ attachSourcePos errorOffset errs pos + Right (e, _) -> Right e + listParser :: TyParser a -> TyParser [a] listParser p = try diff --git a/inferno-core/test/Eval/Spec.hs b/inferno-core/test/Eval/Spec.hs index e6f8749..fe1ac0c 100644 --- a/inferno-core/test/Eval/Spec.hs +++ b/inferno-core/test/Eval/Spec.hs @@ -389,6 +389,11 @@ evalTests = describe "evaluate" $ shouldEvaluateTo "zip [1, 2] [\"a\"] == [(1,\"a\")]" $ vTrue shouldEvaluateTo "zip [] [1, 2] == []" $ vTrue shouldEvaluateTo "zip [1, 2] [] == []" $ vTrue + -- Records + shouldEvaluateTo "let r = {x = 2; y = 3} in r.x" $ VDouble 2 + shouldEvaluateTo "let r = {x = 2; y = 3} in r.y" $ VDouble 3 + shouldEvaluateTo "let Array = {x = 2} in Array.x" $ VDouble 2 + shouldEvaluateTo "let module r = Array in r.length []" $ VInt 0 -- Type annotations shouldEvaluateTo "let x : int = 2 in x" $ VInt 2 shouldEvaluateTo "let x : double = 2 in x" $ VDouble 2 diff --git a/inferno-core/test/Infer/Spec.hs b/inferno-core/test/Infer/Spec.hs index 76406fa..52960ec 100644 --- a/inferno-core/test/Infer/Spec.hs +++ b/inferno-core/test/Infer/Spec.hs @@ -1,13 +1,19 @@ -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NamedFieldPuns #-} module Infer.Spec where +import Control.Monad.Except (runExceptT) +import Control.Monad.Identity (Identity (runIdentity)) +import Control.Monad.Reader (ReaderT (runReaderT)) +import Control.Monad.State (evalStateT) 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.Core (InfernoError (..), Interpreter (parseAndInfer), mkInferno) +import Debug.Trace (trace) +import Inferno.Core (InfernoError (..), Interpreter (..), mkInferno) +import Inferno.Infer (inferTypeReps, unifyRecords) import Inferno.Infer.Exhaustiveness ( Pattern (W), cEmpty, @@ -20,10 +26,12 @@ import Inferno.Infer.Exhaustiveness ) import Inferno.Module.Builtin (enumBoolHash) import qualified Inferno.Module.Prelude as Prelude +import Inferno.Parse (parseTCScheme, parseType) import Inferno.Parse.Error (prettyError) -import Inferno.Types.Syntax (ExtIdent (..), Ident (..)) +import Inferno.Types.Syntax (ExtIdent (..), Ident (..), RestOfRecord (..), typeText) import Inferno.Types.Type (ImplType (..), InfernoType (..), TCScheme (..), TV (..), TypeClass (..), typeBool, typeDouble, typeInt, typeWord64) import Inferno.Types.VersionControl (vcHash) +import Inferno.Utils.Prettyprinter (renderPretty) import Test.Hspec (Spec, describe, expectationFailure, it, runIO, shouldBe, shouldNotBe) inferTests :: Spec @@ -124,6 +132,31 @@ inferTests = describe "infer" $ shouldFailToInferTypeFor "round -1425" shouldInferTypeFor "round (-1425)" $ simpleType typeInt + -- Records: + shouldInferTypeFor "{}" $ simpleType $ TRecord Map.empty RowAbsent + shouldInferTypeFor "{name = \"Zaphod\"; age = 391.4}" $ + simpleType $ + TRecord (Map.fromList [(Ident "name", typeText), (Ident "age", typeDouble)]) RowAbsent + shouldInferTypeFor "let r = {name = \"Zaphod\"; age = 391.4} in r.age" $ simpleType typeDouble + shouldInferTypeFor "let r = {name = \"Zaphod\"; age = 391.4} in let f = fun r -> r.age in f r + 1" $ simpleType typeDouble + shouldFailToInferTypeFor "let r = {name = \"Zaphod\"; age = 391.4} in r.age + \" is too old\"" + shouldFailToInferTypeFor "rec.foo" + shouldInferTypeFor "Array.length []" $ simpleType typeInt + shouldFailToInferTypeFor "let r = {} in r.x" + shouldFailToInferTypeFor "let r = {y = 3} in r.x" + shouldInferTypeFor "let r = {y = 3.2; x = 4.3} in r.x" $ simpleType typeDouble + shouldFailToInferTypeFor "let Array = {} in Array.length" + shouldInferTypeFor "let Array = {x = 2.2} in Array.x" $ simpleType typeDouble + shouldFailToInferTypeFor "let module r = Array in r.x" + shouldInferTypeFor "let module r = Array in r.length []" $ simpleType typeInt + shouldInferTypeFor "let f = fun r -> r.age in f {age = 21.1; x = 5.4}" $ simpleType typeDouble + shouldFailToInferTypeFor "let f = fun r -> if #true then r else {age = 1.1} in f {age = 2; ht = 3}" + shouldInferTypeFor "let f = fun r -> truncateTo 2 r.ht + truncateTo 2 r.wt in f" $ + makeType 0 [] (TArr (TRecord (Map.fromList [(Ident {unIdent = "ht"}, typeDouble), (Ident {unIdent = "wt"}, typeDouble)]) (RowVar (TV {unTV = 0}))) typeDouble) + shouldFailToInferTypeFor "let f = fun r -> if #true then r else {age = 1.1} in fun r -> let x = r.ht + r.age + 1.1 in f r" + shouldFailToInferTypeFor "let f = fun r -> r.age in let x = f {age = 21.1} in let y = f {age = \"t\"} in 1" + shouldFailToInferTypeFor "let f = fun r -> truncateTo 2 r.age in f {age = \"t\"}" + -- Type annotations: shouldInferTypeFor "let xBoo : double = 1 in truncateTo 2 xBoo" $ simpleType typeDouble shouldFailToInferTypeFor "let xBoo : double = 1 in truncateTo xBoo 3.14" @@ -188,6 +221,111 @@ inferTests = describe "infer" $ ] shouldBeInexhaustive complexPattern shouldBeUseful complexPattern + + describe "inferTypeReps" $ do + Interpreter {typeClasses} <- runIO (mkInferno Prelude.builtinModules [] :: IO (Interpreter IO ())) + + let typeRepsShouldBe fnTy inTys outTy reps = do + let tcs = either error id $ parseTCScheme fnTy + let parseTy = either (error . show) id . parseType + it (unwords ["type reps of", unpack fnTy, show inTys, unpack outTy]) $ + case inferTypeReps typeClasses tcs (map parseTy inTys) (parseTy outTy) of + Left e -> expectationFailure $ show e + Right reps' -> reps' `shouldBe` reps + + let typeRepsShouldErr fnTy inTys outTy = do + let tcs = either error id $ parseTCScheme fnTy + let parseTy = either (error . show) id . parseType + it (unwords ["type reps of", unpack fnTy, show inTys, unpack outTy]) $ + case inferTypeReps typeClasses tcs (map parseTy inTys) (parseTy outTy) of + Left _ -> pure () + Right reps' -> expectationFailure $ "expected inferTypeReps to fail but got: " <> show reps' + + -- Some basic tests: + typeRepsShouldBe + "forall 'a 'b 'c . {requires addition on 'a 'b 'c} ⇒ 'a → 'b → 'c" + ["int", "double"] + "double" + [] + + -- Some tests with records: + + typeRepsShouldBe + "forall 'a 'b 'c 'd . {requires addition on 'a 'b 'c} ⇒ {x: 'a; 'd} → 'c" + ["{x: int; y: int}"] + "double" + [] + + typeRepsShouldErr + "forall 'a 'b 'c 'd . {requires addition on 'a 'b 'c} ⇒ {x: 'a; 'd} → 'c" + ["{z: int; y: int}"] + "double" + + typeRepsShouldErr + "forall 'a 'b 'c 'd . {requires addition on 'a 'b 'c} ⇒ {x: 'a; 'd} → 'c" + ["{x: int; y: int}"] + "text" + + describe "unifyRecords" $ do + unificationShouldBeOK + ([], RowAbsent) + ([], RowAbsent) + 0 + + unificationShouldBeOK + ([("f1", typeDouble)], RowVar $ TV 1) + ([("f1", typeDouble)], RowVar $ TV 2) + 3 + + unificationShouldBeOK + ([("f1", typeBool), ("f2", typeDouble)], RowAbsent) + ([("f2", typeDouble), ("f1", typeBool)], RowAbsent) + 0 + + unificationShouldBeOK + ([("f1", typeInt), ("f2", TVar $ TV 0)], RowAbsent) + ([("f1", TVar $ TV 1), ("f2", typeDouble)], RowAbsent) + 2 + + unificationShouldFail + ([("f2", TVar $ TV 0)], RowAbsent) + ([("f1", TVar $ TV 1), ("f2", TVar $ TV 2)], RowAbsent) + 3 + + unificationShouldBeOK + ([("f1", typeInt)], RowVar $ TV 0) + ([("f1", TVar $ TV 1), ("f2", typeDouble)], RowAbsent) + 2 + + unificationShouldFail + ([("f1", typeInt)], RowAbsent) + ([("f1", TVar $ TV 1), ("f2", typeDouble)], RowVar $ TV 0) + 2 + + unificationShouldBeOK + ([], RowVar $ TV 0) + ([("f1", typeInt), ("f2", typeDouble)], RowAbsent) + 1 + + unificationShouldFail + ([("f1", typeInt)], RowVar $ TV 0) + ([("f2", typeText), ("f3", typeDouble)], RowAbsent) + 1 + + unificationShouldBeOK + ([("f1", typeInt)], RowVar $ TV 0) + ([("f2", typeText)], RowVar $ TV 1) + 2 + + unificationShouldFail + ([("f1", typeInt), ("f2", typeDouble)], RowVar $ TV 0) + ([("f2", typeText), ("f3", typeDouble)], RowVar $ TV 1) + 2 + + unificationShouldBeOK + ([("f1", typeInt)], RowVar $ TV 0) + ([("f2", typeText), ("f3", typeDouble)], RowVar $ TV 1) + 2 where t_hash = vcHash ("true" :: Ident, enumBoolHash) f_hash = vcHash ("false" :: Ident, enumBoolHash) @@ -215,3 +353,27 @@ inferTests = describe "infer" $ shouldBeRedundant patts = it ("patterns\n " <> printPatts patts <> "\n should contain redundant clauses") $ checkUsefullness enum_sigs (map (: []) patts) `shouldNotBe` [] + + unificationShouldBeOK (ts1, trv1) (ts2, trv2) varCount = do + let pr (ts, trv) = renderPretty (TRecord (Map.fromList ts) trv) + it (unpack $ "unifyRecords " <> pr (ts1, trv1) <> " " <> pr (ts2, trv2)) $ do + let sortFields = Map.toAscList . Map.fromList + let x = unifyRecords [] (sortFields ts1, trv1) (sortFields ts2, trv2) [] [] [] + let y = runIdentity $ runExceptT $ flip evalStateT varCount $ runReaderT x mempty + case y of + Left errs -> + trace ("unification returned errors " <> show errs) $ expectationFailure $ show errs + Right s' -> + trace ("unification returned " <> show s') $ pure () + + unificationShouldFail (ts1, trv1) (ts2, trv2) varCount = do + let pr (ts, trv) = renderPretty (TRecord (Map.fromList ts) trv) + it (unpack $ "unifyRecords " <> pr (ts1, trv1) <> " " <> pr (ts2, trv2)) $ do + let sortFields = Map.toAscList . Map.fromList + let x = unifyRecords [] (sortFields ts1, trv1) (sortFields ts2, trv2) [] [] [] + let y = runIdentity $ runExceptT $ flip evalStateT varCount $ runReaderT x mempty + case y of + Left errs -> + trace ("unification returned errors " <> show errs) $ pure () + Right s' -> + trace ("unification returned " <> show s') $ expectationFailure "This unification should fail" diff --git a/inferno-core/test/Parse/Spec.hs b/inferno-core/test/Parse/Spec.hs index 22f1fc5..c2dce4b 100644 --- a/inferno-core/test/Parse/Spec.hs +++ b/inferno-core/test/Parse/Spec.hs @@ -48,7 +48,7 @@ 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 :: Expr () a -> Expr () a normalizeExpr = ana $ \case PreOp pos hsh prec LocalScope (Ident "-") e -> case normalizeExpr e of Lit l' (LInt x) -> project $ Lit l' $ LInt $ -x @@ -56,6 +56,9 @@ normalizeExpr = ana $ \case 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 + Record p1 xs p2 -> project $ Record p1 (fmap (\(f, e, _) -> (f, normalizeExpr e, Nothing)) xs) p2 + -- Convert RecordField back to scoped Var because that's how parser parses it: + RecordField p (Ident r) (Ident f) -> project $ Var p () (Scope $ ModuleName r) $ Expl $ ExtIdent $ Right f Array p1 xs p2 -> project $ Array p1 (fmap (\(e, _) -> (normalizeExpr e, Nothing)) xs) p2 ArrayComp p1 e_body p2 args e_cond p3 -> project $ @@ -71,7 +74,7 @@ normalizeExpr = ana $ \case 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 +() :: Testable p => p -> Text -> Property () = flip (counterexample . unpack) infixl 2 @@ -165,6 +168,15 @@ parsingTests = describe "pretty printing/parsing" $ do shouldSucceedFor "[]" $ Array () [] () shouldSucceedFor "[None, None]" $ Array () [(Empty (), Just ()), (Empty (), Nothing)] () + describe "parsing records" $ do + let r = Record () [(Ident "name", Lit () (LText "Zaphod"), Just ()), (Ident "age", Lit () (LInt 391), Nothing)] () + shouldSucceedFor "{}" $ Record () [] () + shouldSucceedFor "{name = \"Zaphod\"; age = 391}" $ r + -- Records are parsed as Var, converted to RecordField later in pinExpr: + let varRecordAccess = Var () () (Scope (ModuleName "r")) (Expl (ExtIdent (Right "age"))) + shouldSucceedFor "let r = {name = \"Zaphod\"; age = 391} in r.age" $ + Let () () (Expl $ ExtIdent $ Right "r") () r () varRecordAccess + describe "parsing infix operators" $ do shouldSucceedFor "2*3+7/2" $ Op diff --git a/inferno-lsp/CHANGELOG.md b/inferno-lsp/CHANGELOG.md index 41ddbc6..a8012be 100644 --- a/inferno-lsp/CHANGELOG.md +++ b/inferno-lsp/CHANGELOG.md @@ -1,6 +1,9 @@ # Revision History for inferno-lsp *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH) +## 0.2.3.0 -- 2024-03-12 +* Update inferno-types and inferno-core version; fix `parseAndInferTypeReps` + ## 0.2.2.0 -- 2024-01-29 * Update inferno-core version diff --git a/inferno-lsp/inferno-lsp.cabal b/inferno-lsp/inferno-lsp.cabal index 7ec1a45..d60d8c5 100644 --- a/inferno-lsp/inferno-lsp.cabal +++ b/inferno-lsp/inferno-lsp.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: inferno-lsp -version: 0.2.2.0 +version: 0.2.3.0 synopsis: LSP for Inferno description: A language server protocol implementation for the Inferno language category: IDE,DSL,Scripting @@ -32,8 +32,8 @@ library , bytestring >= 0.10.10 && < 0.12 , co-log-core >= 0.3.1 && < 0.4 , containers >= 0.6.2 && < 0.7 - , inferno-core >= 0.8.0 && < 0.11 - , inferno-types >= 0.2.0 && < 0.4 + , inferno-core >= 0.8.0 && < 0.12 + , inferno-types >= 0.2.0 && < 0.5 , inferno-vc >= 0.3.0 && < 0.4 , lsp >= 1.6.0 && < 1.7 , lsp-types >= 1.6.0 && < 1.7 diff --git a/inferno-lsp/src/Inferno/LSP/ParseInfer.hs b/inferno-lsp/src/Inferno/LSP/ParseInfer.hs index a23c89a..350f15e 100644 --- a/inferno-lsp/src/Inferno/LSP/ParseInfer.hs +++ b/inferno-lsp/src/Inferno/LSP/ParseInfer.hs @@ -603,10 +603,11 @@ parseAndInferTypeReps prelude expr inTys outTy = do putStrLn ("type reps:" :: String) print res -parseAndInferPossibleTypes :: forall c. (Pretty c, Eq c) => ModuleMap IO c -> Text -> [Maybe Text] -> Maybe Text -> IO () -parseAndInferPossibleTypes prelude expr inTys outTy = do +parseAndInferPossibleTypes :: forall c. (Pretty c, Eq c) => ModuleMap IO c -> Text -> [Text] -> [Maybe Text] -> Maybe Text -> IO () +parseAndInferPossibleTypes prelude expr args inTys outTy = do + let argIdents = map (Just . Ident) args interpreter@(Interpreter {typeClasses}) <- mkInferno prelude [] - (parseAndInferDiagnostics @IO @c interpreter) [] expr (const $ Right ()) >>= \case + (parseAndInferDiagnostics @IO @c interpreter) argIdents expr (const $ Right ()) >>= \case Left err -> print err Right (_expr, typ, _hovers) -> do putStrLn $ Text.unpack $ "\ntype: " <> renderPretty typ diff --git a/inferno-types/CHANGELOG.md b/inferno-types/CHANGELOG.md index 71b8baa..d4aa2a7 100644 --- a/inferno-types/CHANGELOG.md +++ b/inferno-types/CHANGELOG.md @@ -1,6 +1,9 @@ # Revision History for inferno-types *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH) +## 0.4.0.0 -- 2024-03-12 +* Add record types to InfernoType, Value, and Expr + ## 0.3.0.0 -- 2023-11-01 * Fix pretty printing of types to be parser-copmatible. Now prints as `bool{#true, #false}` diff --git a/inferno-types/inferno-types.cabal b/inferno-types/inferno-types.cabal index c846b4b..3b4235b 100644 --- a/inferno-types/inferno-types.cabal +++ b/inferno-types/inferno-types.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: inferno-types -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Core types for Inferno description: Core types for the Inferno language category: DSL,Scripting diff --git a/inferno-types/src/Inferno/Types/Syntax.hs b/inferno-types/src/Inferno/Types/Syntax.hs index 2edb9e9..fe33eee 100644 --- a/inferno-types/src/Inferno/Types/Syntax.hs +++ b/inferno-types/src/Inferno/Types/Syntax.hs @@ -42,6 +42,7 @@ module Inferno.Types.Syntax TV (..), CustomType, BaseType (..), + RestOfRecord (..), InfernoType (..), Expr ( .., @@ -65,6 +66,8 @@ module Inferno.Types.Syntax Case_, Array_, ArrayComp_, + Record_, + RecordField_, Bracketed_, RenameModule_, OpenModule_ @@ -136,7 +139,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)), toList) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe) -import Data.Serialize (Serialize) +import Data.Serialize (Serialize (..)) import qualified Data.Serialize as Serialize import qualified Data.Set as Set import Data.String (IsString) @@ -254,11 +257,36 @@ instance Hashable BaseType where hashWithSalt s (TEnum nm cs) = hashWithSalt s (10 :: Int, nm, Set.toList cs) hashWithSalt s (TCustom t) = hashWithSalt s (11 :: Int, t) +-- | A row variable: a special kind of type variable that represents zero or more fields +-- of a record type. Technically, it is a map from the set of all remaining field names to +-- @Present(type variable) | RowAbsent@ +-- indicating whether the field is present (and if so, what type) or absent. +-- In practice, since all records that we consider have finitely many fields, it is +-- sufficient to encode the remaining fields (rest of the record) as either a row +-- variable @RowVar TV@ (indicating an unknown rest of record) +-- or the special value @RowAbsent@ that indicates that no remaining field is +-- present in the record. For example: +-- +-- @ +-- {x = 2.2; y = "z"} : {x: double; y: text; RowAbsent} +-- fun r -> r.x + 1 : {x: double; RowVar 'a} -> double +-- @ +-- +-- The type of the function above indicates that it accepts any record as argument as +-- long as it has at least a field called @x@. +-- +-- Reference: https://www.cl.cam.ac.uk/teaching/1415/L28/rows.pdf (Sections 8.2 and 8.4.1) +data RestOfRecord = RowVar TV | RowAbsent + deriving (Show, Eq, Ord, Data, Generic, ToJSON, FromJSON, NFData, Hashable) + deriving anyclass (Serialize) + data InfernoType = TVar TV | TBase BaseType | TArr InfernoType InfernoType | TArray InfernoType + | -- | A record type containing *at least* the given fields (with types) and a row variable representing any potential other fields + TRecord (Map.Map Ident InfernoType) RestOfRecord | TSeries InfernoType | TOptional InfernoType | TTuple (TList InfernoType) @@ -311,6 +339,13 @@ instance Pretty InfernoType where TArray ty@(TBase _) -> "array of" <+> align (pretty ty) TArray ty@(TTuple _) -> "array of" <+> align (pretty ty) TArray ty -> "array of" <+> align (enclose lparen rparen $ pretty ty) + TRecord tys rowVar -> "{" <> prettyFields <> prettyRest rowVar <> "}" + where + prettyFields = sep $ Pretty.punctuate ";" $ map prettyField $ Map.toAscList tys + prettyField (Ident f, ty) = pretty f <> ":" <+> pretty ty + semicolon = if Map.null tys then "" else ";" + prettyRest (RowVar tv) = semicolon <> pretty tv + prettyRest RowAbsent = mempty TSeries ty@(TVar _) -> "series of" <+> align (pretty ty) TSeries ty@(TBase _) -> "series of" <+> align (pretty ty) TSeries ty@(TTuple _) -> "series of" <+> align (pretty ty) @@ -426,7 +461,9 @@ newtype Subst = Subst (Map.Map TV InfernoType) deriving newtype (Semigroup, Monoid) instance Show Subst where - show (Subst m) = intercalate "\n" $ map (\(x, t) -> unpack $ renderPretty x <> " ~> " <> renderPretty t) $ Map.toList m + show (Subst m) = "[" <> xs <> "]" + where + xs = intercalate ", " $ map (\(x, t) -> unpack $ renderPretty x <> " ~> " <> renderPretty t) $ Map.toList m class Substitutable a where apply :: Subst -> a -> a @@ -437,6 +474,24 @@ instance Substitutable InfernoType where apply (Subst s) t@(TVar a) = Map.findWithDefault t a s apply s (t1 `TArr` t2) = apply s t1 `TArr` apply s t2 apply s (TArray t) = TArray $ apply s t + apply (Subst s) (TRecord ts trv) = case trv of + RowVar tv -> case Map.findWithDefault (TVar tv) tv s of + TVar tv' -> TRecord ts' $ RowVar tv' + -- When performing unification, we will create substitutions that map some row vars + -- to a bunch of fields and a new row var, e.g. tv ~> f1: t1; f2: t2; tv' + -- We need to add any new fields to the fields of this record, and use the new row + -- var. E.g. {f0: t0; tv} ~> {f0: t0; f1: t1; f2: t2; tv'} under the above subst + TRecord ts'' trv' -> TRecord newFields trv' + where + newFields = + Map.unionWithKey + (\f _ _ -> error $ "TRecord susbstitution with duplicate field " <> show f) + ts' + ts'' + t -> error $ "TRecord substitution with unsupported RHS " <> show t + RowAbsent -> TRecord ts' RowAbsent + where + ts' = fmap (apply $ Subst s) ts apply s (TSeries t) = TSeries $ apply s t apply s (TOptional t) = TOptional $ apply s t apply s (TTuple ts) = TTuple $ fmap (apply s) ts @@ -446,6 +501,9 @@ instance Substitutable InfernoType where ftv (TVar a) = Set.singleton a ftv (t1 `TArr` t2) = ftv t1 `Set.union` ftv t2 ftv (TArray t) = ftv t + ftv (TRecord ts trv) = foldr (Set.union . ftv) tvs ts + where + tvs = case trv of RowVar tv -> Set.singleton tv; RowAbsent -> Set.empty ftv (TSeries t) = ftv t ftv (TOptional t) = ftv t ftv (TTuple ts) = foldr (Set.union . ftv) Set.empty ts @@ -505,6 +563,10 @@ newtype Ident = Ident {unIdent :: Text} deriving stock (Eq, Ord, Show, Data, Generic) deriving newtype (ToJSON, FromJSON, ToJSONKey, FromJSONKey, IsString, NFData, Hashable) +instance Serialize Ident where + put = put . Text.encodeUtf8 . unIdent + get = Ident . Text.decodeUtf8 <$> get + newtype ModuleName = ModuleName {unModuleName :: Text} deriving stock (Eq, Ord, Show, Data, Generic) deriving newtype (ToJSON, FromJSON, IsString) @@ -684,7 +746,7 @@ instance Traversable (IStr f) where ISStr s xs -> liftA (ISStr s) (traverse f xs) ISExpr e xs -> liftA2 ISExpr (f e) (traverse f xs) -data SomeIStr e = forall f. Typeable f => SomeIStr (IStr f e) +data SomeIStr e = forall f. (Typeable f) => SomeIStr (IStr f e) instance Data e => Data (SomeIStr e) where gfoldl k z (SomeIStr xs) = z SomeIStr `k` xs @@ -883,6 +945,18 @@ data Expr hash pos ) ) pos -- position of `}` + | Record + pos -- position of `{` + [ ( Ident, -- field name + Expr hash pos, -- field value + Maybe pos -- position of `;` + ) + ] + pos -- position of `}` + | RecordField -- r.f + pos + Ident -- the record var name + Ident -- field name | Array pos -- position of `[` [ ( Expr hash pos, @@ -1017,6 +1091,12 @@ pattern Assert_ c e <- Assert _ c _ e pattern Case_ :: forall hash pos. Expr hash pos -> NonEmpty (pos, Pat hash pos, pos, Expr hash pos) -> Expr hash pos pattern Case_ e xs <- Case _ e _ xs _ +pattern Record_ :: forall hash pos. [(Ident, Expr hash pos, Maybe pos)] -> Expr hash pos +pattern Record_ xs <- Record _ xs _ + +pattern RecordField_ :: forall hash pos. Ident -> Ident -> Expr hash pos +pattern RecordField_ r f <- RecordField _ r f + pattern Array_ :: forall hash pos. [(Expr hash pos, Maybe pos)] -> Expr hash pos pattern Array_ xs <- Array _ xs _ @@ -1197,6 +1277,9 @@ instance BlockUtils (Expr hash) where EmptyF pos -> (pos, incSourceCol pos 5) AssertF pos1 _ _ (_, pos2) -> (pos1, pos2) CaseF pos1 _ _ _ pos2 -> (pos1, incSourceCol pos2 1) + RecordF pos1 _ pos2 -> (pos1, incSourceCol pos2 1) + RecordFieldF pos1 (Ident r) (Ident f) -> + (pos1, incSourceCol pos1 $ Text.length r + Text.length f + 1) ArrayF pos1 _ pos2 -> (pos1, incSourceCol pos2 1) ArrayCompF pos1 _ _ _ _ pos2 -> (pos1, incSourceCol pos2 1) CommentAboveF c (_, pos2) -> let (pos1, _) = blockPosition c in (pos1, pos2) @@ -1365,6 +1448,9 @@ prettyPrec isBracketed prec expr = InterpolatedString _ _ _ -> p Tuple _ _ _ -> p Empty _ -> p + -- TODO test that these do the right thing! + Record _ _ _ -> p + RecordField _ _ _ -> p Array _ _ _ -> p ArrayComp _ _ _ _ _ _ -> p Bracketed _ _ _ -> p @@ -1435,23 +1521,30 @@ prettyPrec isBracketed prec expr = <> elsePretty Op e1 _ _ (n, NoFix) ns (Ident op) e2 -> bracketWhen e2 (prec > n) $ - prettyOpAux (n + 1) e1 <> (if hasTrailingComment e1 then hardline else mempty) + prettyOpAux (n + 1) e1 + <> (if hasTrailingComment e1 then hardline else mempty) <+> prettyOp ns op - <+> (if hasLeadingComment e2 then line else mempty) <> prettyOpAux (n + 1) e2 + <+> (if hasLeadingComment e2 then line else mempty) + <> prettyOpAux (n + 1) e2 Op e1 _ _ (n, LeftFix) ns (Ident op) e2 -> bracketWhen e2 (prec > n) $ - prettyOpAux n e1 <> (if hasTrailingComment e1 then hardline else mempty) + prettyOpAux n e1 + <> (if hasTrailingComment e1 then hardline else mempty) <+> prettyOp ns op - <+> (if hasLeadingComment e2 then line else mempty) <> prettyOpAux (n + 1) e2 + <+> (if hasLeadingComment e2 then line else mempty) + <> prettyOpAux (n + 1) e2 Op e1 _ _ (n, RightFix) ns (Ident op) e2 -> bracketWhen e2 (prec > n) $ - prettyOpAux (n + 1) e1 <> (if hasTrailingComment e1 then hardline else mempty) + prettyOpAux (n + 1) e1 + <> (if hasTrailingComment e1 then hardline else mempty) <+> prettyOp ns op - <+> (if hasLeadingComment e2 then line else mempty) <> prettyOpAux n e2 + <+> (if hasLeadingComment e2 then line else mempty) + <> prettyOpAux n e2 PreOp _ _ n ns (Ident op) e -> bracketWhen e (prec > n) $ prettyOp ns op - <+> (if hasLeadingComment e then line else mempty) <> prettyOpAux (n + 1) e + <+> (if hasLeadingComment e then line else mempty) + <> prettyOpAux (n + 1) e Tuple _ TNil _ -> "()" Tuple _ xs _ -> group $ (flatAlt "( " "(") <> prettyTuple True (tListToList xs) where @@ -1487,7 +1580,8 @@ prettyPrec isBracketed prec expr = group ( "|" <+> align - ( pretty pat <> (if hasTrailingComment pat then hardline else mempty) + ( pretty pat + <> (if hasTrailingComment pat then hardline else mempty) <+> "->" <> line <> (prettyPrec False 0 e) @@ -1499,6 +1593,26 @@ prettyPrec isBracketed prec expr = <> group ("|" <+> align (pretty pat <> (if hasTrailingComment pat then hardline else mempty) <+> "->" <> line <> (prettyPrec False 0 e))) <> (if hasTrailingComment e then hardline else line) <> prettyCase False es + Record _ [] _ -> "{}" + Record _ xs _ -> group $ flatAlt "{ " "{" <> prettyRecord True xs + where + prettyRecord firstElement = \case + [] -> mempty + [(Ident f, e, _)] -> + pretty f + <+> "=" + <+> align (prettyPrec False 0 e) + <> (if hasTrailingComment e then hardline <> "}" else flatAlt " }" "}") + (Ident f, e, _) : es -> + (if not firstElement && hasLeadingComment e then line else mempty) + <> pretty f + <+> "=" + <+> align (prettyPrec False 0 e) + <> (if hasTrailingComment e then hardline else line') + <> "; " + <> prettyRecord False es + RecordField _ (Ident r) (Ident f) -> + pretty r <> "." <> pretty f Array _ [] _ -> "[]" Array _ xs _ -> group $ (flatAlt "[ " "[") <> prettyArray True xs where diff --git a/inferno-types/src/Inferno/Types/Type.hs b/inferno-types/src/Inferno/Types/Type.hs index a467a7d..e1d5534 100644 --- a/inferno-types/src/Inferno/Types/Type.hs +++ b/inferno-types/src/Inferno/Types/Type.hs @@ -9,6 +9,7 @@ module Inferno.Types.Type Namespace (..), TCScheme (..), TV (..), + RestOfRecord (..), InfernoType (..), TypeClass (..), TypeClassShape (..), @@ -40,6 +41,7 @@ import Inferno.Types.Syntax ImplType (..), InfernoType (..), Namespace (..), + RestOfRecord (..), Scheme (..), Subst (..), Substitutable (..), diff --git a/inferno-types/src/Inferno/Types/Value.hs b/inferno-types/src/Inferno/Types/Value.hs index d7af7d7..01f5d63 100644 --- a/inferno-types/src/Inferno/Types/Value.hs +++ b/inferno-types/src/Inferno/Types/Value.hs @@ -25,7 +25,9 @@ import Prettyprinter comma, encloseSep, lbracket, + punctuate, rbracket, + sep, tupled, (<+>), ) @@ -42,6 +44,7 @@ data Value custom m | VEnum VCObjectHash Ident | VArray [Value custom m] | VTuple [Value custom m] + | VRecord (Map.Map Ident (Value custom m)) | VOne (Value custom m) | VEmpty | VFun (Value custom m -> m (Value custom m)) @@ -59,6 +62,7 @@ instance NFData custom => NFData (Value custom m) where rnf (VEnum hash i) = rnf hash `seq` rnf i `seq` () rnf (VArray xs) = rnf xs rnf (VTuple xs) = rnf xs + rnf (VRecord xs) = rnf xs rnf (VOne x) = rnf x rnf VEmpty = () rnf (VFun f) = rnf f @@ -78,6 +82,8 @@ instance Eq c => Eq (Value c m) where VEmpty == VEmpty = True (VArray a1) == (VArray a2) = length a1 == length a2 && (foldr ((&&) . (uncurry (==))) True $ zip a1 a2) (VTuple a1) == (VTuple a2) = length a1 == length a2 && (foldr ((&&) . (uncurry (==))) True $ zip a1 a2) + (VRecord fs1) == (VRecord fs2) = + Map.size fs1 == Map.size fs2 && Map.toAscList fs1 == Map.toAscList fs2 (VTypeRep t1) == (VTypeRep t2) = t1 == t2 (VCustom c1) == (VCustom c2) = c1 == c2 _ == _ = False @@ -93,6 +99,10 @@ instance Pretty c => Pretty (Value c m) where VEnum _ (Ident s) -> "#" <> pretty s VArray vs -> encloseSep lbracket rbracket comma $ map pretty vs VTuple vs -> tupled $ map pretty vs + VRecord fs -> "{" <> prettyFields <> "}" + where + prettyFields = sep $ punctuate ";" $ map prettyField $ Map.toAscList fs + prettyField (Ident f, v) = pretty f <> "=" <+> pretty v VOne v -> "Some" <+> align (pretty v) VEmpty -> "None" VFun {} -> "<>" diff --git a/inferno-types/src/Inferno/Types/VersionControl.hs b/inferno-types/src/Inferno/Types/VersionControl.hs index cc6193f..eefe9c4 100644 --- a/inferno-types/src/Inferno/Types/VersionControl.hs +++ b/inferno-types/src/Inferno/Types/VersionControl.hs @@ -64,6 +64,7 @@ import Inferno.Types.Type ImplType (..), InfernoType (..), Namespace, + RestOfRecord (..), TCScheme (..), TV (..), TypeClass (..), @@ -178,7 +179,7 @@ class GenericVCHashUpdate f where instance GenericVCHashUpdate U1 where genHashUpdate ctxt _ = ctxt -instance (VCHashUpdate a) => GenericVCHashUpdate (K1 i a) where +instance VCHashUpdate a => GenericVCHashUpdate (K1 i a) where genHashUpdate ctxt (K1 x) = ctxt &< x instance GenericVCHashUpdate f => GenericVCHashUpdate (D1 c f) where @@ -263,6 +264,8 @@ deriving instance VCHashUpdate BaseType deriving newtype instance VCHashUpdate TV +deriving instance VCHashUpdate RestOfRecord + deriving instance VCHashUpdate InfernoType deriving instance VCHashUpdate TypeClass diff --git a/inferno-vc/CHANGELOG.md b/inferno-vc/CHANGELOG.md index aae8b13..d837033 100644 --- a/inferno-vc/CHANGELOG.md +++ b/inferno-vc/CHANGELOG.md @@ -1,6 +1,9 @@ # Revision History for inferno-vc *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH) +## 0.3.5.0 -- 2024-03-12 +* Update inferno-types version + ## 0.3.4.0 -- 2024-02-28 * Add a parameter to runServerConfig to allow wai middleware to be applied * Extend VCServerError type with a constructor for storage bakcend to inject diff --git a/inferno-vc/inferno-vc.cabal b/inferno-vc/inferno-vc.cabal index 2c82705..bd5725c 100644 --- a/inferno-vc/inferno-vc.cabal +++ b/inferno-vc/inferno-vc.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: inferno-vc -version: 0.3.4.0 +version: 0.3.5.0 synopsis: Version control server for Inferno description: A version control server for Inferno scripts category: DSL,Scripting @@ -48,7 +48,7 @@ library , generic-lens >= 2.2.1 && < 2.3 , http-client >= 0.7.13 && < 0.8 , http-types >= 0.12.3 && < 0.13 - , inferno-types >= 0.2.0 && < 0.4 + , inferno-types >= 0.2.0 && < 0.5 , lens >= 5.2 && < 5.3 , mtl >= 2.2.2 && < 2.3 , plow-log >= 0.1.6 && < 0.2