From 617f8432afc22d06023455d5f09377c84bfccdc5 Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Thu, 19 Dec 2024 00:08:16 +0000 Subject: [PATCH] WIP Types --- src/Builder/Build.elm | 388 ++- src/Builder/Deps/Diff.elm | 53 +- src/Builder/Elm/Details.elm | 54 +- src/Builder/File.elm | 23 +- src/Builder/Generate.elm | 6 +- src/Builder/Reporting/Exit.elm | 18 +- src/Builder/Reporting/Exit/Help.elm | 5 +- src/Compiler/AST/Canonical.elm | 337 +-- src/Compiler/Canonicalize/Effects.elm | 45 +- src/Compiler/Canonicalize/Environment.elm | 35 +- .../Canonicalize/Environment/Dups.elm | 15 +- .../Canonicalize/Environment/Foreign.elm | 15 +- .../Canonicalize/Environment/Local.elm | 19 +- src/Compiler/Canonicalize/Expression.elm | 172 +- src/Compiler/Canonicalize/Module.elm | 51 +- src/Compiler/Canonicalize/Pattern.elm | 52 +- src/Compiler/Canonicalize/Type.elm | 9 +- src/Compiler/Compile.elm | 19 +- src/Compiler/Elm/Compiler/Type.elm | 90 +- src/Compiler/Elm/Docs.elm | 255 +- src/Compiler/Generate/JavaScript.elm | 9 +- src/Compiler/Nitpick/PatternMatches.elm | 329 ++- src/Compiler/Optimize/Case.elm | 3 +- src/Compiler/Optimize/DecisionTree.elm | 134 +- src/Compiler/Optimize/Expression.elm | 161 +- src/Compiler/Optimize/Module.elm | 73 +- src/Compiler/Parse/Declaration.elm | 139 +- src/Compiler/Parse/Expression.elm | 351 ++- src/Compiler/Parse/Module.elm | 251 +- src/Compiler/Parse/Number.elm | 25 +- src/Compiler/Parse/Pattern.elm | 145 +- src/Compiler/Parse/Shader.elm | 15 +- src/Compiler/Parse/Space.elm | 19 +- src/Compiler/Parse/String.elm | 41 +- src/Compiler/Parse/Symbol.elm | 47 +- src/Compiler/Parse/Type.elm | 117 +- src/Compiler/Reporting/Error.elm | 101 +- src/Compiler/Reporting/Error/Canonicalize.elm | 483 ++-- src/Compiler/Reporting/Error/Docs.elm | 156 +- src/Compiler/Reporting/Error/Import.elm | 59 +- src/Compiler/Reporting/Error/Main.elm | 46 +- src/Compiler/Reporting/Error/Pattern.elm | 48 +- src/Compiler/Reporting/Error/Syntax.elm | 2235 +++++++---------- src/Compiler/Reporting/Error/Type.elm | 783 +++--- src/Compiler/Reporting/Render/Type.elm | 4 +- .../Reporting/Render/Type/Localizer.elm | 78 +- src/Compiler/Reporting/Warning.elm | 3 +- src/Compiler/Type/Constrain/Expression.elm | 276 +- src/Compiler/Type/Constrain/Module.elm | 23 +- src/Compiler/Type/Constrain/Pattern.elm | 90 +- src/Compiler/Type/Error.elm | 313 +-- src/Compiler/Type/Solve.elm | 30 +- src/Compiler/Type/Type.elm | 71 +- src/Compiler/Type/Unify.elm | 2 +- src/System/IO.elm | 7 +- src/Terminal/Diff.elm | 28 +- src/Terminal/Repl.elm | 12 +- src/Types.elm | 1178 ++++++++- 58 files changed, 4821 insertions(+), 4725 deletions(-) diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index 5463025d3..925d66903 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -1,7 +1,5 @@ module Builder.Build exposing ( Artifacts(..) - , BB_BResult - , BB_CachedInterface(..) , Dependencies , DocsGoal(..) , Module(..) @@ -40,7 +38,6 @@ import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Module as Parse import Compiler.Reporting.Error as Error -import Compiler.Reporting.Error.Docs as EDocs import Compiler.Reporting.Error.Import as Import import Compiler.Reporting.Error.Syntax as Syntax import Compiler.Reporting.Render.Type.Localizer as L @@ -60,7 +57,7 @@ import Utils.Main as Utils type Env - = Env Reporting.BKey String Parse.ProjectType (List AbsoluteSrcDir) Details.BED_BuildID (Dict String T.CEMN_Raw Details.BED_Local) (Dict String T.CEMN_Raw Details.Foreign) + = Env Reporting.BKey String Parse.ProjectType (List AbsoluteSrcDir) T.BED_BuildID (Dict String T.CEMN_Raw T.BED_Local) (Dict String T.CEMN_Raw Details.Foreign) makeEnv : Reporting.BKey -> T.FilePath -> Details.Details -> IO Env @@ -210,7 +207,7 @@ type Artifacts type Module = Fresh T.CEMN_Raw T.CEI_Interface T.CASTO_LocalGraph - | Cached T.CEMN_Raw Bool (T.MVar BB_CachedInterface) + | Cached T.CEMN_Raw Bool (T.MVar T.BB_CachedInterface) type alias Dependencies = @@ -320,10 +317,10 @@ type alias StatusDict = type Status - = SCached Details.BED_Local - | SChanged Details.BED_Local String T.CASTS_Module DocsNeed - | SBadImport Import.CREI_Problem - | SBadSyntax T.FilePath File.BF_Time String Syntax.CRES_Error + = SCached T.BED_Local + | SChanged T.BED_Local String T.CASTS_Module DocsNeed + | SBadImport T.CREI_Problem + | SBadSyntax T.FilePath T.BF_Time String T.CRES_Error | SForeign T.CEP_Name | SKernel @@ -374,7 +371,7 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv [ path ] -> case Dict.get identity name foreigns of Just (Details.Foreign dep deps) -> - IO.pure <| SBadImport <| Import.CREI_Ambiguous path [] dep deps + IO.pure <| SBadImport <| T.CREI_Ambiguous path [] dep deps Nothing -> File.getTime path @@ -384,7 +381,7 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv Nothing -> crawlFile env mvar docsNeed name path newTime buildID - Just ((Details.BED_Local oldPath oldTime deps _ lastChange _) as local) -> + Just ((T.BED_Local oldPath oldTime deps _ lastChange _) as local) -> if path /= oldPath || oldTime /= newTime || needsDocs then crawlFile env mvar docsNeed name path newTime lastChange @@ -393,7 +390,7 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv ) p1 :: p2 :: ps -> - IO.pure <| SBadImport <| Import.CREI_AmbiguousLocal (Utils.fpMakeRelative root p1) (Utils.fpMakeRelative root p2) (List.map (Utils.fpMakeRelative root) ps) + IO.pure <| SBadImport <| T.CREI_AmbiguousLocal (Utils.fpMakeRelative root p1) (Utils.fpMakeRelative root p2) (List.map (Utils.fpMakeRelative root) ps) [] -> case Dict.get identity name foreigns of @@ -403,7 +400,7 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv IO.pure <| SForeign dep d :: ds -> - IO.pure <| SBadImport <| Import.CREI_AmbiguousForeign dep d ds + IO.pure <| SBadImport <| T.CREI_AmbiguousForeign dep d ds Nothing -> if Name.isKernel name && Parse.isKernel projectType then @@ -414,15 +411,15 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv SKernel else - SBadImport Import.CREI_NotFound + SBadImport T.CREI_NotFound ) else - IO.pure <| SBadImport Import.CREI_NotFound + IO.pure <| SBadImport T.CREI_NotFound ) -crawlFile : Env -> T.MVar StatusDict -> DocsNeed -> T.CEMN_Raw -> T.FilePath -> File.BF_Time -> Details.BED_BuildID -> IO Status +crawlFile : Env -> T.MVar StatusDict -> DocsNeed -> T.CEMN_Raw -> T.FilePath -> T.BF_Time -> T.BED_BuildID -> IO Status crawlFile ((Env _ root projectType _ buildID _ _) as env) mvar docsNeed expectedName path time lastChange = File.readUtf8 (Utils.fpForwardSlash root path) |> IO.bind @@ -434,7 +431,7 @@ crawlFile ((Env _ root projectType _ buildID _ _) as env) mvar docsNeed expected Ok ((T.CASTS_Module maybeActualName _ _ imports values _ _ _ _) as modul) -> case maybeActualName of Nothing -> - IO.pure <| SBadSyntax path time source (Syntax.CRES_ModuleNameUnspecified expectedName) + IO.pure <| SBadSyntax path time source (T.CRES_ModuleNameUnspecified expectedName) Just ((T.CRA_At _ actualName) as name) -> if expectedName == actualName then @@ -443,14 +440,14 @@ crawlFile ((Env _ root projectType _ buildID _ _) as env) mvar docsNeed expected deps = List.map Src.getImportName imports - local : Details.BED_Local + local : T.BED_Local local = - Details.BED_Local path time deps (List.any isMain values) lastChange buildID + T.BED_Local path time deps (List.any isMain values) lastChange buildID in crawlDeps env mvar deps (SChanged local source modul docsNeed) else - IO.pure <| SBadSyntax path time source (Syntax.CRES_ModuleNameMismatch expectedName name) + IO.pure <| SBadSyntax path time source (T.CRES_ModuleNameMismatch expectedName name) ) @@ -463,31 +460,10 @@ isMain (T.CRA_At _ (T.CASTS_Value (T.CRA_At _ name) _ _ _)) = -- CHECK MODULE -type alias ResultDict = - Dict String T.CEMN_Raw (T.MVar BB_BResult) - - -type BB_BResult - = BB_RNew Details.BED_Local T.CEI_Interface T.CASTO_LocalGraph (Maybe Docs.CED_Module) - | BB_RSame Details.BED_Local T.CEI_Interface T.CASTO_LocalGraph (Maybe Docs.CED_Module) - | BB_RCached Bool Details.BED_BuildID (T.MVar BB_CachedInterface) - | BB_RNotFound Import.CREI_Problem - | BB_RProblem Error.CRE_Module - | BB_RBlocked - | BB_RForeign T.CEI_Interface - | BB_RKernel - - -type BB_CachedInterface - = BB_Unneeded - | BB_Loaded T.CEI_Interface - | BB_Corrupted - - -checkModule : Env -> Dependencies -> T.MVar ResultDict -> T.CEMN_Raw -> Status -> IO BB_BResult +checkModule : Env -> Dependencies -> T.MVar T.BB_ResultDict -> T.CEMN_Raw -> Status -> IO T.BB_BResult checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name status = case status of - SCached ((Details.BED_Local path time deps hasMain lastChange lastCompile) as local) -> + SCached ((T.BED_Local path time deps hasMain lastChange lastCompile) as local) -> Utils.readMVar resultDictDecoder resultsMVar |> IO.bind (\results -> @@ -505,38 +481,38 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name Err err -> IO.pure <| - BB_RProblem <| - Error.CRE_Module name path time source (Error.CRE_BadSyntax err) + T.BB_RProblem <| + T.CRE_Module name path time source (T.CRE_BadSyntax err) ) DepsSame _ _ -> - Utils.newMVar cachedInterfaceEncoder BB_Unneeded + Utils.newMVar cachedInterfaceEncoder T.BB_Unneeded |> IO.fmap (\mvar -> - BB_RCached hasMain lastChange mvar + T.BB_RCached hasMain lastChange mvar ) DepsBlock -> - IO.pure BB_RBlocked + IO.pure T.BB_RBlocked DepsNotFound problems -> File.readUtf8 path |> IO.bind (\source -> IO.pure <| - BB_RProblem <| - Error.CRE_Module name path time source <| + T.BB_RProblem <| + T.CRE_Module name path time source <| case Parse.fromByteString projectType source of Ok (T.CASTS_Module _ _ _ imports _ _ _ _ _) -> - Error.CRE_BadImports (toImportErrors env results imports problems) + T.CRE_BadImports (toImportErrors env results imports problems) Err err -> - Error.CRE_BadSyntax err + T.CRE_BadSyntax err ) ) ) - SChanged ((Details.BED_Local path time deps _ _ lastCompile) as local) source ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) docsNeed -> + SChanged ((T.BED_Local path time deps _ _ lastCompile) as local) source ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) docsNeed -> Utils.readMVar resultDictDecoder resultsMVar |> IO.bind (\results -> @@ -553,42 +529,42 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name (\maybeLoaded -> case maybeLoaded of Nothing -> - IO.pure BB_RBlocked + IO.pure T.BB_RBlocked Just ifaces -> compile env docsNeed local source ifaces modul ) DepsBlock -> - IO.pure BB_RBlocked + IO.pure T.BB_RBlocked DepsNotFound problems -> IO.pure <| - BB_RProblem <| - Error.CRE_Module name path time source <| - Error.CRE_BadImports (toImportErrors env results imports problems) + T.BB_RProblem <| + T.CRE_Module name path time source <| + T.CRE_BadImports (toImportErrors env results imports problems) ) ) SBadImport importProblem -> - IO.pure (BB_RNotFound importProblem) + IO.pure (T.BB_RNotFound importProblem) SBadSyntax path time source err -> IO.pure <| - BB_RProblem <| - Error.CRE_Module name path time source <| - Error.CRE_BadSyntax err + T.BB_RProblem <| + T.CRE_Module name path time source <| + T.CRE_BadSyntax err SForeign home -> case Utils.find ModuleName.toComparableCanonical (T.CEMN_Canonical home name) foreigns of I.Public iface -> - IO.pure (BB_RForeign iface) + IO.pure (T.BB_RForeign iface) I.Private _ _ _ -> crash <| "mistakenly seeing private interface for " ++ Pkg.toChars home ++ " " ++ name SKernel -> - IO.pure BB_RKernel + IO.pure T.BB_RKernel @@ -599,10 +575,10 @@ type DepsStatus = DepsChange (Dict String T.CEMN_Raw T.CEI_Interface) | DepsSame (List Dep) (List CDep) | DepsBlock - | DepsNotFound (NE.Nonempty ( T.CEMN_Raw, Import.CREI_Problem )) + | DepsNotFound (NE.Nonempty ( T.CEMN_Raw, T.CREI_Problem )) -checkDeps : T.FilePath -> ResultDict -> List T.CEMN_Raw -> Details.BED_BuildID -> IO DepsStatus +checkDeps : T.FilePath -> T.BB_ResultDict -> List T.CEMN_Raw -> T.BED_BuildID -> IO DepsStatus checkDeps root results deps lastCompile = checkDepsHelp root results deps [] [] [] [] False 0 lastCompile @@ -612,10 +588,10 @@ type alias Dep = type alias CDep = - ( T.CEMN_Raw, T.MVar BB_CachedInterface ) + ( T.CEMN_Raw, T.MVar T.BB_CachedInterface ) -checkDepsHelp : T.FilePath -> ResultDict -> List T.CEMN_Raw -> List Dep -> List Dep -> List CDep -> List ( T.CEMN_Raw, Import.CREI_Problem ) -> Bool -> Details.BED_BuildID -> Details.BED_BuildID -> IO DepsStatus +checkDepsHelp : T.FilePath -> T.BB_ResultDict -> List T.CEMN_Raw -> List Dep -> List Dep -> List CDep -> List ( T.CEMN_Raw, T.CREI_Problem ) -> Bool -> T.BED_BuildID -> T.BED_BuildID -> IO DepsStatus checkDepsHelp root results deps new same cached importProblems isBlocked lastDepChange lastCompile = case deps of dep :: otherDeps -> @@ -623,28 +599,28 @@ checkDepsHelp root results deps new same cached importProblems isBlocked lastDep |> IO.bind (\result -> case result of - BB_RNew (Details.BED_Local _ _ _ _ lastChange _) iface _ _ -> + T.BB_RNew (T.BED_Local _ _ _ _ lastChange _) iface _ _ -> checkDepsHelp root results otherDeps (( dep, iface ) :: new) same cached importProblems isBlocked (max lastChange lastDepChange) lastCompile - BB_RSame (Details.BED_Local _ _ _ _ lastChange _) iface _ _ -> + T.BB_RSame (T.BED_Local _ _ _ _ lastChange _) iface _ _ -> checkDepsHelp root results otherDeps new (( dep, iface ) :: same) cached importProblems isBlocked (max lastChange lastDepChange) lastCompile - BB_RCached _ lastChange mvar -> + T.BB_RCached _ lastChange mvar -> checkDepsHelp root results otherDeps new same (( dep, mvar ) :: cached) importProblems isBlocked (max lastChange lastDepChange) lastCompile - BB_RNotFound prob -> + T.BB_RNotFound prob -> checkDepsHelp root results otherDeps new same cached (( dep, prob ) :: importProblems) True lastDepChange lastCompile - BB_RProblem _ -> + T.BB_RProblem _ -> checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile - BB_RBlocked -> + T.BB_RBlocked -> checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile - BB_RForeign iface -> + T.BB_RForeign iface -> checkDepsHelp root results otherDeps new (( dep, iface ) :: same) cached importProblems isBlocked lastDepChange lastCompile - BB_RKernel -> + T.BB_RKernel -> checkDepsHelp root results otherDeps new same cached importProblems isBlocked lastDepChange lastCompile ) @@ -677,7 +653,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked lastDep -- TO IMPORT ERROR -toImportErrors : Env -> ResultDict -> List T.CASTS_Import -> NE.Nonempty ( T.CEMN_Raw, Import.CREI_Problem ) -> NE.Nonempty Import.CREI_Error +toImportErrors : Env -> T.BB_ResultDict -> List T.CASTS_Import -> NE.Nonempty ( T.CEMN_Raw, T.CREI_Problem ) -> NE.Nonempty T.CREI_Error toImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems = let knownModules : EverySet.EverySet String T.CEMN_Raw @@ -698,9 +674,9 @@ toImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems = regionDict = Dict.fromList identity (List.map (\(T.CASTS_Import (T.CRA_At region name) _ _) -> ( name, region )) imports) - toError : ( T.CDN_Name, Import.CREI_Problem ) -> Import.CREI_Error + toError : ( T.CDN_Name, T.CREI_Problem ) -> T.CREI_Error toError ( name, problem ) = - Import.CREI_Error (Utils.find identity name regionDict) name unimportedModules problem + T.CREI_Error (Utils.find identity name regionDict) name unimportedModules problem in NE.map toError problems @@ -733,25 +709,25 @@ loadInterface root ( name, ciMvar ) = |> IO.bind (\cachedInterface -> case cachedInterface of - BB_Corrupted -> + T.BB_Corrupted -> Utils.putMVar cachedInterfaceEncoder ciMvar cachedInterface |> IO.fmap (\_ -> Nothing) - BB_Loaded iface -> + T.BB_Loaded iface -> Utils.putMVar cachedInterfaceEncoder ciMvar cachedInterface |> IO.fmap (\_ -> Just ( name, iface )) - BB_Unneeded -> + T.BB_Unneeded -> File.readBinary I.interfaceDecoder (Stuff.elmi root name) |> IO.bind (\maybeIface -> case maybeIface of Nothing -> - Utils.putMVar cachedInterfaceEncoder ciMvar BB_Corrupted + Utils.putMVar cachedInterfaceEncoder ciMvar T.BB_Corrupted |> IO.fmap (\_ -> Nothing) Just iface -> - Utils.putMVar cachedInterfaceEncoder ciMvar (BB_Loaded iface) + Utils.putMVar cachedInterfaceEncoder ciMvar (T.BB_Loaded iface) |> IO.fmap (\_ -> Just ( name, iface )) ) ) @@ -853,10 +829,10 @@ addToGraph name status graph = dependencies : List T.CEMN_Raw dependencies = case status of - SCached (Details.BED_Local _ _ deps _ _ _) -> + SCached (T.BED_Local _ _ deps _ _ _) -> deps - SChanged (Details.BED_Local _ _ deps _ _ _) _ _ _ -> + SChanged (T.BED_Local _ _ deps _ _ _) _ _ _ -> deps SBadImport _ -> @@ -904,7 +880,7 @@ rootStatusToNamePathPair sroot = SInside _ -> Nothing - SOutsideOk (Details.BED_Local path _ _ _ _ _) _ modul -> + SOutsideOk (T.BED_Local path _ _ _ _ _) _ modul -> Just ( Src.getName modul, OneOrMore.one path ) SOutsideErr _ -> @@ -924,10 +900,10 @@ checkOutside name paths = checkInside : T.CEMN_Raw -> T.FilePath -> Status -> Result Exit.BuildProjectProblem () checkInside name p1 status = case status of - SCached (Details.BED_Local p2 _ _ _ _ _) -> + SCached (T.BED_Local p2 _ _ _ _ _) -> Err (Exit.BP_RootNameDuplicate name p1 p2) - SChanged (Details.BED_Local p2 _ _ _ _ _) _ _ _ -> + SChanged (T.BED_Local p2 _ _ _ _ _) _ _ _ -> Err (Exit.BP_RootNameDuplicate name p1 p2) SBadImport _ -> @@ -947,8 +923,8 @@ checkInside name p1 status = -- COMPILE MODULE -compile : Env -> DocsNeed -> Details.BED_Local -> String -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO BB_BResult -compile (Env key root projectType _ buildID _ _) docsNeed (Details.BED_Local path time deps main lastChange _) source ifaces modul = +compile : Env -> DocsNeed -> T.BED_Local -> String -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO T.BB_BResult +compile (Env key root projectType _ buildID _ _) docsNeed (T.BED_Local path time deps main lastChange _) source ifaces modul = let pkg : T.CEP_Name pkg = @@ -962,8 +938,8 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.BED_Local pat case makeDocs docsNeed canonical of Err err -> IO.pure <| - BB_RProblem <| - Error.CRE_Module (Src.getName modul) path time source (Error.CRE_BadDocs err) + T.BB_RProblem <| + T.CRE_Module (Src.getName modul) path time source (T.CRE_BadDocs err) Ok docs -> let @@ -993,11 +969,11 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.BED_Local pat |> IO.fmap (\_ -> let - local : Details.BED_Local + local : T.BED_Local local = - Details.BED_Local path time deps main lastChange buildID + T.BED_Local path time deps main lastChange buildID in - BB_RSame local iface objects docs + T.BB_RSame local iface objects docs ) else @@ -1008,11 +984,11 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.BED_Local pat |> IO.fmap (\_ -> let - local : Details.BED_Local + local : T.BED_Local local = - Details.BED_Local path time deps main buildID buildID + T.BED_Local path time deps main buildID buildID in - BB_RNew local iface objects docs + T.BB_RNew local iface objects docs ) ) @@ -1025,11 +1001,11 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.BED_Local pat |> IO.fmap (\_ -> let - local : Details.BED_Local + local : T.BED_Local local = - Details.BED_Local path time deps main buildID buildID + T.BED_Local path time deps main buildID buildID in - BB_RNew local iface objects docs + T.BB_RNew local iface objects docs ) ) ) @@ -1037,8 +1013,8 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.BED_Local pat Err err -> IO.pure <| - BB_RProblem <| - Error.CRE_Module (Src.getName modul) path time source err + T.BB_RProblem <| + T.CRE_Module (Src.getName modul) path time source err ) @@ -1056,37 +1032,37 @@ projectTypeToPkg projectType = -- WRITE DETAILS -writeDetails : T.FilePath -> Details.Details -> Dict String T.CEMN_Raw BB_BResult -> IO () +writeDetails : T.FilePath -> Details.Details -> Dict String T.CEMN_Raw T.BB_BResult -> IO () writeDetails root (Details.Details time outline buildID locals foreigns extras) results = File.writeBinary Details.detailsEncoder (Stuff.details root) <| Details.Details time outline buildID (Dict.foldr compare addNewLocal locals results) foreigns extras -addNewLocal : T.CEMN_Raw -> BB_BResult -> Dict String T.CEMN_Raw Details.BED_Local -> Dict String T.CEMN_Raw Details.BED_Local +addNewLocal : T.CEMN_Raw -> T.BB_BResult -> Dict String T.CEMN_Raw T.BED_Local -> Dict String T.CEMN_Raw T.BED_Local addNewLocal name result locals = case result of - BB_RNew local _ _ _ -> + T.BB_RNew local _ _ _ -> Dict.insert identity name local locals - BB_RSame local _ _ _ -> + T.BB_RSame local _ _ _ -> Dict.insert identity name local locals - BB_RCached _ _ _ -> + T.BB_RCached _ _ _ -> locals - BB_RNotFound _ -> + T.BB_RNotFound _ -> locals - BB_RProblem _ -> + T.BB_RProblem _ -> locals - BB_RBlocked -> + T.BB_RBlocked -> locals - BB_RForeign _ -> + T.BB_RForeign _ -> locals - BB_RKernel -> + T.BB_RKernel -> locals @@ -1094,7 +1070,7 @@ addNewLocal name result locals = -- FINALIZE EXPOSED -finalizeExposed : T.FilePath -> DocsGoal docs -> NE.Nonempty T.CEMN_Raw -> Dict String T.CEMN_Raw BB_BResult -> IO (Result Exit.BuildProblem docs) +finalizeExposed : T.FilePath -> DocsGoal docs -> NE.Nonempty T.CEMN_Raw -> Dict String T.CEMN_Raw T.BB_BResult -> IO (Result Exit.BuildProblem docs) finalizeExposed root docsGoal exposed results = case List.foldr (addImportProblems results) [] (NE.toList exposed) of p :: ps -> @@ -1109,59 +1085,59 @@ finalizeExposed root docsGoal exposed results = IO.pure <| Err <| Exit.BuildBadModules root e es -addErrors : BB_BResult -> List Error.CRE_Module -> List Error.CRE_Module +addErrors : T.BB_BResult -> List T.CRE_Module -> List T.CRE_Module addErrors result errors = case result of - BB_RNew _ _ _ _ -> + T.BB_RNew _ _ _ _ -> errors - BB_RSame _ _ _ _ -> + T.BB_RSame _ _ _ _ -> errors - BB_RCached _ _ _ -> + T.BB_RCached _ _ _ -> errors - BB_RNotFound _ -> + T.BB_RNotFound _ -> errors - BB_RProblem e -> + T.BB_RProblem e -> e :: errors - BB_RBlocked -> + T.BB_RBlocked -> errors - BB_RForeign _ -> + T.BB_RForeign _ -> errors - BB_RKernel -> + T.BB_RKernel -> errors -addImportProblems : Dict String T.CEMN_Raw BB_BResult -> T.CEMN_Raw -> List ( T.CEMN_Raw, Import.CREI_Problem ) -> List ( T.CEMN_Raw, Import.CREI_Problem ) +addImportProblems : Dict String T.CEMN_Raw T.BB_BResult -> T.CEMN_Raw -> List ( T.CEMN_Raw, T.CREI_Problem ) -> List ( T.CEMN_Raw, T.CREI_Problem ) addImportProblems results name problems = case Utils.find identity name results of - BB_RNew _ _ _ _ -> + T.BB_RNew _ _ _ _ -> problems - BB_RSame _ _ _ _ -> + T.BB_RSame _ _ _ _ -> problems - BB_RCached _ _ _ -> + T.BB_RCached _ _ _ -> problems - BB_RNotFound p -> + T.BB_RNotFound p -> ( name, p ) :: problems - BB_RProblem _ -> + T.BB_RProblem _ -> problems - BB_RBlocked -> + T.BB_RBlocked -> problems - BB_RForeign _ -> + T.BB_RForeign _ -> problems - BB_RKernel -> + T.BB_RKernel -> problems @@ -1170,12 +1146,12 @@ addImportProblems results name problems = type DocsGoal docs - = KeepDocs (Dict String T.CEMN_Raw BB_BResult -> docs) - | WriteDocs (Dict String T.CEMN_Raw BB_BResult -> IO docs) + = KeepDocs (Dict String T.CEMN_Raw T.BB_BResult -> docs) + | WriteDocs (Dict String T.CEMN_Raw T.BB_BResult -> IO docs) | IgnoreDocs docs -keepDocs : DocsGoal (Dict String T.CEMN_Raw Docs.CED_Module) +keepDocs : DocsGoal (Dict String T.CEMN_Raw T.CED_Module) keepDocs = KeepDocs (Utils.mapMapMaybe identity compare toDocs) @@ -1207,7 +1183,7 @@ toDocsNeed goal = DocsNeed True -makeDocs : DocsNeed -> Can.Module -> Result EDocs.CRED_Error (Maybe Docs.CED_Module) +makeDocs : DocsNeed -> Can.Module -> Result T.CRED_Error (Maybe T.CED_Module) makeDocs (DocsNeed isNeeded) modul = if isNeeded then case Docs.fromModule modul of @@ -1221,7 +1197,7 @@ makeDocs (DocsNeed isNeeded) modul = Ok Nothing -finalizeDocs : DocsGoal docs -> Dict String T.CEMN_Raw BB_BResult -> IO docs +finalizeDocs : DocsGoal docs -> Dict String T.CEMN_Raw T.BB_BResult -> IO docs finalizeDocs goal results = case goal of KeepDocs f -> @@ -1234,31 +1210,31 @@ finalizeDocs goal results = IO.pure val -toDocs : BB_BResult -> Maybe Docs.CED_Module +toDocs : T.BB_BResult -> Maybe T.CED_Module toDocs result = case result of - BB_RNew _ _ _ d -> + T.BB_RNew _ _ _ d -> d - BB_RSame _ _ _ d -> + T.BB_RSame _ _ _ d -> d - BB_RCached _ _ _ -> + T.BB_RCached _ _ _ -> Nothing - BB_RNotFound _ -> + T.BB_RNotFound _ -> Nothing - BB_RProblem _ -> + T.BB_RProblem _ -> Nothing - BB_RBlocked -> + T.BB_RBlocked -> Nothing - BB_RForeign _ -> + T.BB_RForeign _ -> Nothing - BB_RKernel -> + T.BB_RKernel -> Nothing @@ -1270,7 +1246,7 @@ toDocs result = type ReplArtifacts - = ReplArtifacts T.CEMN_Canonical (List Module) L.CRRTL_Localizer (Dict String T.CDN_Name T.CASTC_Annotation) + = ReplArtifacts T.CEMN_Canonical (List Module) T.CRRTL_Localizer (Dict String T.CDN_Name T.CASTC_Annotation) fromRepl : T.FilePath -> Details.Details -> String -> IO (Result Exit.Repl ReplArtifacts) @@ -1280,7 +1256,7 @@ fromRepl root details source = (\((Env _ _ projectType _ _ _ _) as env) -> case Parse.fromByteString projectType source of Err syntaxError -> - IO.pure <| Err <| Exit.ReplBadInput source <| Error.CRE_BadSyntax syntaxError + IO.pure <| Err <| Exit.ReplBadInput source <| T.CRE_BadSyntax syntaxError Ok ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) -> Details.loadInterfaces root details @@ -1341,7 +1317,7 @@ fromRepl root details source = ) -finalizeReplArtifacts : Env -> String -> T.CASTS_Module -> DepsStatus -> ResultDict -> Dict String T.CEMN_Raw BB_BResult -> IO (Result Exit.Repl ReplArtifacts) +finalizeReplArtifacts : Env -> String -> T.CASTS_Module -> DepsStatus -> T.BB_ResultDict -> Dict String T.CEMN_Raw T.BB_BResult -> IO (Result Exit.Repl ReplArtifacts) finalizeReplArtifacts ((Env _ root projectType _ _ _ _) as env) source ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) depsStatus resultMVars results = let pkg : T.CEP_Name @@ -1402,7 +1378,7 @@ finalizeReplArtifacts ((Env _ root projectType _ _ _ _) as env) source ((T.CASTS IO.pure <| Err <| Exit.ReplBadInput source <| - Error.CRE_BadImports <| + T.CRE_BadImports <| toImportErrors env resultMVars imports problems @@ -1588,8 +1564,8 @@ dropPrefix roots paths = type RootStatus = SInside T.CEMN_Raw - | SOutsideOk Details.BED_Local String T.CASTS_Module - | SOutsideErr Error.CRE_Module + | SOutsideOk T.BED_Local String T.CASTS_Module + | SOutsideErr T.CRE_Module crawlRoot : Env -> T.MVar StatusDict -> RootLocation -> IO RootStatus @@ -1625,16 +1601,16 @@ crawlRoot ((Env _ _ projectType _ buildID _ _) as env) mvar root = deps = List.map Src.getImportName imports - local : Details.BED_Local + local : T.BED_Local local = - Details.BED_Local path time deps (List.any isMain values) buildID buildID + T.BED_Local path time deps (List.any isMain values) buildID buildID in crawlDeps env mvar deps (SOutsideOk local source modul) Err syntaxError -> IO.pure <| SOutsideErr <| - Error.CRE_Module "???" path time source (Error.CRE_BadSyntax syntaxError) + T.CRE_Module "???" path time source (T.CRE_BadSyntax syntaxError) ) ) @@ -1646,11 +1622,11 @@ crawlRoot ((Env _ _ projectType _ buildID _ _) as env) mvar root = type RootResult = RInside T.CEMN_Raw | ROutsideOk T.CEMN_Raw T.CEI_Interface T.CASTO_LocalGraph - | ROutsideErr Error.CRE_Module + | ROutsideErr T.CRE_Module | ROutsideBlocked -checkRoot : Env -> ResultDict -> RootStatus -> IO RootResult +checkRoot : Env -> T.BB_ResultDict -> RootStatus -> IO RootResult checkRoot ((Env _ root _ _ _ _ _) as env) results rootStatus = case rootStatus of SInside name -> @@ -1659,7 +1635,7 @@ checkRoot ((Env _ root _ _ _ _ _) as env) results rootStatus = SOutsideErr err -> IO.pure (ROutsideErr err) - SOutsideOk ((Details.BED_Local path time deps _ _ lastCompile) as local) source ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) -> + SOutsideOk ((T.BED_Local path time deps _ _ lastCompile) as local) source ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) -> checkDeps root results deps lastCompile |> IO.bind (\depsStatus -> @@ -1685,13 +1661,13 @@ checkRoot ((Env _ root _ _ _ _ _) as env) results rootStatus = DepsNotFound problems -> IO.pure <| ROutsideErr <| - Error.CRE_Module (Src.getName modul) path time source <| - Error.CRE_BadImports (toImportErrors env results imports problems) + T.CRE_Module (Src.getName modul) path time source <| + T.CRE_BadImports (toImportErrors env results imports problems) ) -compileOutside : Env -> Details.BED_Local -> String -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO RootResult -compileOutside (Env key _ projectType _ _ _ _) (Details.BED_Local path time _ _ _ _) source ifaces modul = +compileOutside : Env -> T.BED_Local -> String -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO RootResult +compileOutside (Env key _ projectType _ _ _ _) (T.BED_Local path time _ _ _ _) source ifaces modul = let pkg : T.CEP_Name pkg = @@ -1710,7 +1686,7 @@ compileOutside (Env key _ projectType _ _ _ _) (Details.BED_Local path time _ _ |> IO.fmap (\_ -> ROutsideOk name (I.fromModule pkg canonical annotations) objects) Err errors -> - IO.pure <| ROutsideErr <| Error.CRE_Module name path time source errors + IO.pure <| ROutsideErr <| T.CRE_Module name path time source errors ) @@ -1723,7 +1699,7 @@ type Root | Outside T.CEMN_Raw T.CEI_Interface T.CASTO_LocalGraph -toArtifacts : Env -> Dependencies -> Dict String T.CEMN_Raw BB_BResult -> NE.Nonempty RootResult -> Result Exit.BuildProblem Artifacts +toArtifacts : Env -> Dependencies -> Dict String T.CEMN_Raw T.BB_BResult -> NE.Nonempty RootResult -> Result Exit.BuildProblem Artifacts toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults = case gatherProblemsOrMains results rootResults of Err (NE.Nonempty e es) -> @@ -1735,10 +1711,10 @@ toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults = Dict.foldr compare addInside (NE.foldr addOutside [] rootResults) results -gatherProblemsOrMains : Dict String T.CEMN_Raw BB_BResult -> NE.Nonempty RootResult -> Result (NE.Nonempty Error.CRE_Module) (NE.Nonempty Root) +gatherProblemsOrMains : Dict String T.CEMN_Raw T.BB_BResult -> NE.Nonempty RootResult -> Result (NE.Nonempty T.CRE_Module) (NE.Nonempty Root) gatherProblemsOrMains results (NE.Nonempty rootResult rootResults) = let - addResult : RootResult -> ( List Error.CRE_Module, List Root ) -> ( List Error.CRE_Module, List Root ) + addResult : RootResult -> ( List T.CRE_Module, List Root ) -> ( List T.CRE_Module, List Root ) addResult result ( es, roots ) = case result of RInside n -> @@ -1753,7 +1729,7 @@ gatherProblemsOrMains results (NE.Nonempty rootResult rootResults) = ROutsideBlocked -> ( es, roots ) - errors : List Error.CRE_Module + errors : List T.CRE_Module errors = Dict.foldr compare (\_ -> addErrors) [] results in @@ -1780,31 +1756,31 @@ gatherProblemsOrMains results (NE.Nonempty rootResult rootResults) = Err (NE.Nonempty e es) -addInside : T.CEMN_Raw -> BB_BResult -> List Module -> List Module +addInside : T.CEMN_Raw -> T.BB_BResult -> List Module -> List Module addInside name result modules = case result of - BB_RNew _ iface objs _ -> + T.BB_RNew _ iface objs _ -> Fresh name iface objs :: modules - BB_RSame _ iface objs _ -> + T.BB_RSame _ iface objs _ -> Fresh name iface objs :: modules - BB_RCached main _ mvar -> + T.BB_RCached main _ mvar -> Cached name main mvar :: modules - BB_RNotFound _ -> + T.BB_RNotFound _ -> crash (badInside name) - BB_RProblem _ -> + T.BB_RProblem _ -> crash (badInside name) - BB_RBlocked -> + T.BB_RBlocked -> crash (badInside name) - BB_RForeign _ -> + T.BB_RForeign _ -> modules - BB_RKernel -> + T.BB_RKernel -> modules @@ -1833,15 +1809,15 @@ addOutside root modules = -- ENCODERS and DECODERS -dictRawMVarBResultEncoder : Dict String T.CEMN_Raw (T.MVar BB_BResult) -> Encode.Value +dictRawMVarBResultEncoder : Dict String T.CEMN_Raw (T.MVar T.BB_BResult) -> Encode.Value dictRawMVarBResultEncoder = E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder -bResultEncoder : BB_BResult -> Encode.Value +bResultEncoder : T.BB_BResult -> Encode.Value bResultEncoder bResult = case bResult of - BB_RNew local iface objects docs -> + T.BB_RNew local iface objects docs -> Encode.object [ ( "type", Encode.string "RNew" ) , ( "local", Details.localEncoder local ) @@ -1854,7 +1830,7 @@ bResultEncoder bResult = ) ] - BB_RSame local iface objects docs -> + T.BB_RSame local iface objects docs -> Encode.object [ ( "type", Encode.string "RSame" ) , ( "local", Details.localEncoder local ) @@ -1863,7 +1839,7 @@ bResultEncoder bResult = , ( "docs", E.maybe Docs.jsonModuleEncoder docs ) ] - BB_RCached main lastChange (T.MVar ref) -> + T.BB_RCached main lastChange (T.MVar ref) -> Encode.object [ ( "type", Encode.string "RCached" ) , ( "main", Encode.bool main ) @@ -1871,74 +1847,74 @@ bResultEncoder bResult = , ( "mvar", Encode.int ref ) ] - BB_RNotFound importProblem -> + T.BB_RNotFound importProblem -> Encode.object [ ( "type", Encode.string "RNotFound" ) , ( "importProblem", Import.problemEncoder importProblem ) ] - BB_RProblem e -> + T.BB_RProblem e -> Encode.object [ ( "type", Encode.string "RProblem" ) , ( "e", Error.moduleEncoder e ) ] - BB_RBlocked -> + T.BB_RBlocked -> Encode.object [ ( "type", Encode.string "RBlocked" ) ] - BB_RForeign iface -> + T.BB_RForeign iface -> Encode.object [ ( "type", Encode.string "RForeign" ) , ( "iface", I.interfaceEncoder iface ) ] - BB_RKernel -> + T.BB_RKernel -> Encode.object [ ( "type", Encode.string "RKernel" ) ] -bResultDecoder : Decode.Decoder BB_BResult +bResultDecoder : Decode.Decoder T.BB_BResult bResultDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "RNew" -> - Decode.map4 BB_RNew + Decode.map4 T.BB_RNew (Decode.field "local" Details.localDecoder) (Decode.field "iface" I.interfaceDecoder) (Decode.field "objects" Opt.localGraphDecoder) (Decode.field "docs" (Decode.maybe Docs.jsonModuleDecoder)) "RSame" -> - Decode.map4 BB_RSame + Decode.map4 T.BB_RSame (Decode.field "local" Details.localDecoder) (Decode.field "iface" I.interfaceDecoder) (Decode.field "objects" Opt.localGraphDecoder) (Decode.field "docs" (Decode.maybe Docs.jsonModuleDecoder)) "RCached" -> - Decode.map3 BB_RCached + Decode.map3 T.BB_RCached (Decode.field "main" Decode.bool) (Decode.field "lastChange" Decode.int) (Decode.field "mvar" (Decode.map T.MVar Decode.int)) "RNotFound" -> - Decode.map BB_RNotFound + Decode.map T.BB_RNotFound (Decode.field "importProblem" Import.problemDecoder) "RProblem" -> - Decode.map BB_RProblem + Decode.map T.BB_RProblem (Decode.field "e" Error.moduleDecoder) "RBlocked" -> - Decode.succeed BB_RBlocked + Decode.succeed T.BB_RBlocked "RForeign" -> - Decode.map BB_RForeign + Decode.map T.BB_RForeign (Decode.field "iface" I.interfaceDecoder) "RKernel" -> - Decode.succeed BB_RKernel + Decode.succeed T.BB_RKernel _ -> Decode.fail ("Failed to decode BResult's type: " ++ type_) @@ -2084,12 +2060,12 @@ rootStatusDecoder = ) -resultDictEncoder : ResultDict -> Encode.Value +resultDictEncoder : T.BB_ResultDict -> Encode.Value resultDictEncoder = E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder -resultDictDecoder : Decode.Decoder ResultDict +resultDictDecoder : Decode.Decoder T.BB_ResultDict resultDictDecoder = D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder @@ -2184,40 +2160,40 @@ resultBuildProjectProblemRootInfoDecoder = D.result Exit.buildProjectProblemDecoder rootInfoDecoder -cachedInterfaceEncoder : BB_CachedInterface -> Encode.Value +cachedInterfaceEncoder : T.BB_CachedInterface -> Encode.Value cachedInterfaceEncoder cachedInterface = case cachedInterface of - BB_Unneeded -> + T.BB_Unneeded -> Encode.object [ ( "type", Encode.string "Unneeded" ) ] - BB_Loaded iface -> + T.BB_Loaded iface -> Encode.object [ ( "type", Encode.string "Loaded" ) , ( "iface", I.interfaceEncoder iface ) ] - BB_Corrupted -> + T.BB_Corrupted -> Encode.object [ ( "type", Encode.string "Corrupted" ) ] -cachedInterfaceDecoder : Decode.Decoder BB_CachedInterface +cachedInterfaceDecoder : Decode.Decoder T.BB_CachedInterface cachedInterfaceDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Unneeded" -> - Decode.succeed BB_Unneeded + Decode.succeed T.BB_Unneeded "Loaded" -> - Decode.map BB_Loaded (Decode.field "iface" I.interfaceDecoder) + Decode.map T.BB_Loaded (Decode.field "iface" I.interfaceDecoder) "Corrupted" -> - Decode.succeed BB_Corrupted + Decode.succeed T.BB_Corrupted _ -> Decode.fail ("Failed to decode CachedInterface's type: " ++ type_) diff --git a/src/Builder/Deps/Diff.elm b/src/Builder/Deps/Diff.elm index 2a08f3a56..b0b69b3ae 100644 --- a/src/Builder/Deps/Diff.elm +++ b/src/Builder/Deps/Diff.elm @@ -15,7 +15,6 @@ import Builder.Http as Http import Builder.Reporting.Exit as Exit exposing (DocsProblem(..)) import Builder.Stuff as Stuff import Compiler.Data.Name as Name -import Compiler.Elm.Compiler.Type as Type import Compiler.Elm.Docs as Docs import Compiler.Elm.Magnitude as M import Compiler.Elm.Version as V exposing (Version) @@ -33,7 +32,7 @@ type PackageChanges type ModuleChanges - = ModuleChanges (Changes String T.CDN_Name Docs.CED_Union) (Changes String T.CDN_Name Docs.CED_Alias) (Changes String T.CDN_Name Docs.CED_Value) (Changes String T.CDN_Name Docs.CED_Binop) + = ModuleChanges (Changes String T.CDN_Name T.CED_Union) (Changes String T.CDN_Name T.CED_Alias) (Changes String T.CDN_Name T.CED_Value) (Changes String T.CDN_Name T.CED_Binop) type Changes c k v @@ -77,8 +76,8 @@ diff oldDocs newDocs = (Dict.keys compare removed) -diffModule : ( Docs.CED_Module, Docs.CED_Module ) -> ModuleChanges -diffModule ( Docs.CED_Module _ _ u1 a1 v1 b1, Docs.CED_Module _ _ u2 a2 v2 b2 ) = +diffModule : ( T.CED_Module, T.CED_Module ) -> ModuleChanges +diffModule ( T.CED_Module _ _ u1 a1 v1 b1, T.CED_Module _ _ u2 a2 v2 b2 ) = ModuleChanges (getChanges identity compare isEquivalentUnion u1 u2) (getChanges identity compare isEquivalentAlias a1 a2) @@ -90,18 +89,18 @@ diffModule ( Docs.CED_Module _ _ u1 a1 v1 b1, Docs.CED_Module _ _ u2 a2 v2 b2 ) -- EQUIVALENCE -isEquivalentUnion : Docs.CED_Union -> Docs.CED_Union -> Bool -isEquivalentUnion (Docs.CED_Union oldComment oldVars oldCtors) (Docs.CED_Union newComment newVars newCtors) = +isEquivalentUnion : T.CED_Union -> T.CED_Union -> Bool +isEquivalentUnion (T.CED_Union oldComment oldVars oldCtors) (T.CED_Union newComment newVars newCtors) = let - equiv : List Type.CECT_Type -> List Type.CECT_Type -> Bool + equiv : List T.CECT_Type -> List T.CECT_Type -> Bool equiv oldTypes newTypes = let allEquivalent : List Bool allEquivalent = List.map2 isEquivalentAlias - (List.map (Docs.CED_Alias oldComment oldVars) oldTypes) - (List.map (Docs.CED_Alias newComment newVars) newTypes) + (List.map (T.CED_Alias oldComment oldVars) oldTypes) + (List.map (T.CED_Alias newComment newVars) newTypes) in (List.length oldTypes == List.length newTypes) && List.all identity allEquivalent @@ -111,8 +110,8 @@ isEquivalentUnion (Docs.CED_Union oldComment oldVars oldCtors) (Docs.CED_Union n && List.all identity (Dict.values compare (Utils.mapIntersectionWith identity compare equiv (Dict.fromList identity oldCtors) (Dict.fromList identity newCtors))) -isEquivalentAlias : Docs.CED_Alias -> Docs.CED_Alias -> Bool -isEquivalentAlias (Docs.CED_Alias _ oldVars oldType) (Docs.CED_Alias _ newVars newType) = +isEquivalentAlias : T.CED_Alias -> T.CED_Alias -> Bool +isEquivalentAlias (T.CED_Alias _ oldVars oldType) (T.CED_Alias _ newVars newType) = case diffType oldType newType of Nothing -> False @@ -122,14 +121,14 @@ isEquivalentAlias (Docs.CED_Alias _ oldVars oldType) (Docs.CED_Alias _ newVars n && isEquivalentRenaming (List.map2 Tuple.pair oldVars newVars ++ renamings) -isEquivalentValue : Docs.CED_Value -> Docs.CED_Value -> Bool -isEquivalentValue (Docs.CED_Value c1 t1) (Docs.CED_Value c2 t2) = - isEquivalentAlias (Docs.CED_Alias c1 [] t1) (Docs.CED_Alias c2 [] t2) +isEquivalentValue : T.CED_Value -> T.CED_Value -> Bool +isEquivalentValue (T.CED_Value c1 t1) (T.CED_Value c2 t2) = + isEquivalentAlias (T.CED_Alias c1 [] t1) (T.CED_Alias c2 [] t2) -isEquivalentBinop : Docs.CED_Binop -> Docs.CED_Binop -> Bool -isEquivalentBinop (Docs.CED_Binop c1 t1 a1 p1) (Docs.CED_Binop c2 t2 a2 p2) = - isEquivalentAlias (Docs.CED_Alias c1 [] t1) (Docs.CED_Alias c2 [] t2) +isEquivalentBinop : T.CED_Binop -> T.CED_Binop -> Bool +isEquivalentBinop (T.CED_Binop c1 t1 a1 p1) (T.CED_Binop c2 t2 a2 p2) = + isEquivalentAlias (T.CED_Alias c1 [] t1) (T.CED_Alias c2 [] t2) && (a1 == a2) && (p1 == p2) @@ -138,23 +137,23 @@ isEquivalentBinop (Docs.CED_Binop c1 t1 a1 p1) (Docs.CED_Binop c2 t2 a2 p2) = -- DIFF TYPES -diffType : Type.CECT_Type -> Type.CECT_Type -> Maybe (List ( T.CDN_Name, T.CDN_Name )) +diffType : T.CECT_Type -> T.CECT_Type -> Maybe (List ( T.CDN_Name, T.CDN_Name )) diffType oldType newType = case ( oldType, newType ) of - ( Type.CECT_Var oldName, Type.CECT_Var newName ) -> + ( T.CECT_Var oldName, T.CECT_Var newName ) -> Just [ ( oldName, newName ) ] - ( Type.CECT_Lambda a b, Type.CECT_Lambda a_ b_ ) -> + ( T.CECT_Lambda a b, T.CECT_Lambda a_ b_ ) -> Maybe.map2 (++) (diffType a a_) (diffType b b_) - ( Type.CECT_Type oldName oldArgs, Type.CECT_Type newName newArgs ) -> + ( T.CECT_Type oldName oldArgs, T.CECT_Type newName newArgs ) -> if not (isSameName oldName newName) || List.length oldArgs /= List.length newArgs then Nothing else Maybe.map List.concat (Utils.zipWithM diffType oldArgs newArgs) - ( Type.CECT_Record fields maybeExt, Type.CECT_Record fields_ maybeExt_ ) -> + ( T.CECT_Record fields maybeExt, T.CECT_Record fields_ maybeExt_ ) -> case ( maybeExt, maybeExt_ ) of ( Nothing, Just _ ) -> Nothing @@ -168,10 +167,10 @@ diffType oldType newType = ( Just oldExt, Just newExt ) -> Maybe.map ((::) ( oldExt, newExt )) (diffFields fields fields_) - ( Type.CECT_Unit, Type.CECT_Unit ) -> + ( T.CECT_Unit, T.CECT_Unit ) -> Just [] - ( Type.CECT_Tuple a b cs, Type.CECT_Tuple x y zs ) -> + ( T.CECT_Tuple a b cs, T.CECT_Tuple x y zs ) -> if List.length cs /= List.length zs then Nothing @@ -207,7 +206,7 @@ isSameName oldFullName newFullName = oldFullName == newFullName -diffFields : List ( T.CDN_Name, Type.CECT_Type ) -> List ( T.CDN_Name, Type.CECT_Type ) -> Maybe (List ( T.CDN_Name, T.CDN_Name )) +diffFields : List ( T.CDN_Name, T.CECT_Type ) -> List ( T.CDN_Name, T.CECT_Type ) -> Maybe (List ( T.CDN_Name, T.CDN_Name )) diffFields oldRawFields newRawFields = if List.length oldRawFields /= List.length newRawFields then Nothing @@ -218,11 +217,11 @@ diffFields oldRawFields newRawFields = sort fields = List.sortBy Tuple.first fields - oldFields : List ( T.CDN_Name, Type.CECT_Type ) + oldFields : List ( T.CDN_Name, T.CECT_Type ) oldFields = sort oldRawFields - newFields : List ( T.CDN_Name, Type.CECT_Type ) + newFields : List ( T.CDN_Name, T.CECT_Type ) newFields = sort newRawFields in diff --git a/src/Builder/Elm/Details.elm b/src/Builder/Elm/Details.elm index fb95241a1..4f236a74d 100644 --- a/src/Builder/Elm/Details.elm +++ b/src/Builder/Elm/Details.elm @@ -1,7 +1,5 @@ module Builder.Elm.Details exposing - ( BED_BuildID - , BED_Local(..) - , Details(..) + ( Details(..) , Extras , Foreign(..) , Interfaces @@ -58,11 +56,7 @@ import Utils.Main as Utils type Details - = Details File.BF_Time ValidOutline BED_BuildID (Dict String T.CEMN_Raw BED_Local) (Dict String T.CEMN_Raw Foreign) Extras - - -type alias BED_BuildID = - Int + = Details T.BF_Time ValidOutline T.BED_BuildID (Dict String T.CEMN_Raw T.BED_Local) (Dict String T.CEMN_Raw Foreign) Extras type ValidOutline @@ -70,26 +64,6 @@ type ValidOutline | ValidPkg T.CEP_Name (List T.CEMN_Raw) (Dict ( String, String ) T.CEP_Name V.Version {- for docs in reactor -}) - --- NOTE: we need two ways to detect if a file must be recompiled: --- --- (1) _time is the modification time from the last time we compiled the file. --- By checking EQUALITY with the current modification time, we can detect file --- saves and `git checkout` of previous versions. Both need a recompile. --- --- (2) _lastChange is the BuildID from the last time a new interface file was --- generated, and _lastCompile is the BuildID from the last time the file was --- compiled. These may be different if a file is recompiled but the interface --- stayed the same. When the _lastCompile is LESS THAN the _lastChange of any --- imports, we need to recompile. This can happen when a project has multiple --- entrypoints and some modules are compiled less often than their imports. --- - - -type BED_Local - = BED_Local T.FilePath File.BF_Time (List T.CEMN_Raw) Bool BED_BuildID BED_BuildID - - type Foreign = Foreign T.CEP_Name (List T.CEP_Name) @@ -184,7 +158,7 @@ load style scope root = -- GENERATE -generate : Reporting.Style -> BW.Scope -> T.FilePath -> File.BF_Time -> IO (Result Exit.Details Details) +generate : Reporting.Style -> BW.Scope -> T.FilePath -> T.BF_Time -> IO (Result Exit.Details Details) generate style scope root time = Reporting.trackDetails style (\key -> @@ -249,7 +223,7 @@ type alias Task a = Task.Task Exit.Details a -verifyPkg : Env -> File.BF_Time -> Outline.PkgOutline -> Task Details +verifyPkg : Env -> T.BF_Time -> Outline.PkgOutline -> Task Details verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm) = if Con.goodElm elm then union identity Pkg.compareName noDups direct testDirect @@ -274,7 +248,7 @@ verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm) Task.throw (Exit.DetailsBadElmInPkg elm) -verifyApp : Env -> File.BF_Time -> Outline.AppOutline -> Task Details +verifyApp : Env -> T.BF_Time -> Outline.AppOutline -> Task Details verifyApp env time ((Outline.AppOutline elmVersion srcDirs direct _ _ _) as outline) = if elmVersion == V.compiler then checkAppDeps outline @@ -399,7 +373,7 @@ fork_Maybe_CASTO_GlobalGraph work = -- VERIFY DEPENDENCIES -verifyDependencies : Env -> File.BF_Time -> ValidOutline -> Dict ( String, String ) T.CEP_Name Solver.Details -> Dict ( String, String ) T.CEP_Name a -> Task Details +verifyDependencies : Env -> T.BF_Time -> ValidOutline -> Dict ( String, String ) T.CEP_Name Solver.Details -> Dict ( String, String ) T.CEP_Name a -> Task Details verifyDependencies ((Env key scope root cache _ _ _) as env) time outline solution directDeps = Task.eio identity (Reporting.report key (Reporting.DStart (Dict.size solution)) @@ -915,7 +889,7 @@ getDepHome fi = type DResult - = RLocal T.CEI_Interface T.CASTO_LocalGraph (Maybe Docs.CED_Module) + = RLocal T.CEI_Interface T.CASTO_LocalGraph (Maybe T.CED_Module) | RForeign T.CEI_Interface | RKernelLocal (List T.CEK_Chunk) | RKernelForeign @@ -946,7 +920,7 @@ compile pkg mvar status = ifaces = I.fromModule pkg canonical annotations - docs : Maybe Docs.CED_Module + docs : Maybe T.CED_Module docs = makeDocs docsStatus canonical in @@ -1001,7 +975,7 @@ getDocsStatus cache pkg vsn = ) -makeDocs : T.BED_DocsStatus -> Can.Module -> Maybe Docs.CED_Module +makeDocs : T.BED_DocsStatus -> Can.Module -> Maybe T.CED_Module makeDocs status modul = case status of T.BED_DocsNeeded -> @@ -1027,7 +1001,7 @@ writeDocs cache pkg vsn status results = IO.pure () -toDocs : DResult -> Maybe Docs.CED_Module +toDocs : DResult -> Maybe T.CED_Module toDocs result = case result of RLocal _ _ docs -> @@ -1262,8 +1236,8 @@ statusDictDecoder = D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder -localEncoder : BED_Local -> Encode.Value -localEncoder (BED_Local path time deps hasMain lastChange lastCompile) = +localEncoder : T.BED_Local -> Encode.Value +localEncoder (T.BED_Local path time deps hasMain lastChange lastCompile) = Encode.object [ ( "type", Encode.string "Local" ) , ( "path", Encode.string path ) @@ -1275,9 +1249,9 @@ localEncoder (BED_Local path time deps hasMain lastChange lastCompile) = ] -localDecoder : Decode.Decoder BED_Local +localDecoder : Decode.Decoder T.BED_Local localDecoder = - Decode.map6 BED_Local + Decode.map6 T.BED_Local (Decode.field "path" Decode.string) (Decode.field "time" File.timeDecoder) (Decode.field "deps" (Decode.list ModuleName.rawDecoder)) diff --git a/src/Builder/File.elm b/src/Builder/File.elm index b1a949d55..a1b7e77ec 100644 --- a/src/Builder/File.elm +++ b/src/Builder/File.elm @@ -1,6 +1,5 @@ module Builder.File exposing - ( BF_Time(..) - , exists + ( exists , getTime , readBinary , readUtf8 @@ -27,18 +26,14 @@ import Utils.Main as Utils -- TIME -type BF_Time - = BF_Time Time.Posix - - -getTime : T.FilePath -> IO BF_Time +getTime : T.FilePath -> IO T.BF_Time getTime path = - IO.fmap BF_Time (Utils.dirGetModificationTime path) + IO.fmap T.BF_Time (Utils.dirGetModificationTime path) -zeroTime : BF_Time +zeroTime : T.BF_Time zeroTime = - BF_Time (Time.millisToPosix 0) + T.BF_Time (Time.millisToPosix 0) @@ -189,11 +184,11 @@ remove path = -- ENCODERS and DECODERS -timeEncoder : BF_Time -> Encode.Value -timeEncoder (BF_Time posix) = +timeEncoder : T.BF_Time -> Encode.Value +timeEncoder (T.BF_Time posix) = Encode.int (Time.posixToMillis posix) -timeDecoder : Decode.Decoder BF_Time +timeDecoder : Decode.Decoder T.BF_Time timeDecoder = - Decode.map (BF_Time << Time.millisToPosix) Decode.int + Decode.map (T.BF_Time << Time.millisToPosix) Decode.int diff --git a/src/Builder/Generate.elm b/src/Builder/Generate.elm index 0098e5971..121f2c853 100644 --- a/src/Builder/Generate.elm +++ b/src/Builder/Generate.elm @@ -280,7 +280,7 @@ loadTypesHelp root modul = |> IO.bind (\cachedInterface -> case cachedInterface of - Build.BB_Unneeded -> + T.BB_Unneeded -> Utils.newEmptyMVar |> IO.bind (\mvar -> @@ -294,9 +294,9 @@ loadTypesHelp root modul = |> IO.fmap (\_ -> mvar) ) - Build.BB_Loaded iface -> + T.BB_Loaded iface -> Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) (Just (Extract.fromInterface name iface)) - Build.BB_Corrupted -> + T.BB_Corrupted -> Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) Nothing ) diff --git a/src/Builder/Reporting/Exit.elm b/src/Builder/Reporting/Exit.elm index 8c9d024e8..0e54017c8 100644 --- a/src/Builder/Reporting/Exit.elm +++ b/src/Builder/Reporting/Exit.elm @@ -2504,7 +2504,7 @@ makeToReport make = type BuildProblem - = BuildBadModules T.FilePath Error.CRE_Module (List Error.CRE_Module) + = BuildBadModules T.FilePath T.CRE_Module (List T.CRE_Module) | BuildProjectProblem BuildProjectProblem @@ -2517,7 +2517,7 @@ type BuildProjectProblem | BP_RootNameInvalid T.FilePath T.FilePath (List String) | BP_CannotLoadDependencies | BP_Cycle T.CEMN_Raw (List T.CEMN_Raw) - | BP_MissingExposed (NE.Nonempty ( T.CEMN_Raw, Import.CREI_Problem )) + | BP_MissingExposed (NE.Nonempty ( T.CEMN_Raw, T.CREI_Problem )) toBuildProblemReport : BuildProblem -> Help.Report @@ -2620,7 +2620,7 @@ toProjectProblemReport projectProblem = BP_MissingExposed (NE.Nonempty ( name, problem ) _) -> case problem of - Import.CREI_NotFound -> + T.CREI_NotFound -> Help.report "MISSING MODULE" (Just "elm.json") "The \"exposed-modules\" of your elm.json lists the following module:" @@ -2629,7 +2629,7 @@ toProjectProblemReport projectProblem = "But I cannot find it in your src/ directory. Is there a typo? Was it renamed?" ] - Import.CREI_Ambiguous _ _ pkg _ -> + T.CREI_Ambiguous _ _ pkg _ -> Help.report "AMBIGUOUS MODULE NAME" (Just "elm.json") "The \"exposed-modules\" of your elm.json lists the following module:" @@ -2640,7 +2640,7 @@ toProjectProblemReport projectProblem = ++ " already uses that name. Try choosing a different name for your local file." ] - Import.CREI_AmbiguousLocal path1 path2 paths -> + T.CREI_AmbiguousLocal path1 path2 paths -> Help.report "AMBIGUOUS MODULE NAME" (Just "elm.json") "The \"exposed-modules\" of your elm.json lists the following module:" @@ -2655,7 +2655,7 @@ toProjectProblemReport projectProblem = "Change the module names to be distinct!" ] - Import.CREI_AmbiguousForeign _ _ _ -> + T.CREI_AmbiguousForeign _ _ _ -> Help.report "MISSING MODULE" (Just "elm.json") "The \"exposed-modules\" of your elm.json lists the following module:" @@ -2786,8 +2786,8 @@ corruptCacheReport = type Repl = ReplBadDetails Details - | ReplBadInput String Error.CRE_Error - | ReplBadLocalDeps T.FilePath Error.CRE_Module (List Error.CRE_Module) + | ReplBadInput String T.CRE_Error + | ReplBadLocalDeps T.FilePath T.CRE_Module (List T.CRE_Module) | ReplProjectProblem BuildProjectProblem | ReplBadGenerate Generate | ReplBadCache @@ -2801,7 +2801,7 @@ replToReport problem = toDetailsReport details ReplBadInput source err -> - Help.compilerReport "/" (Error.CRE_Module N.replModule "REPL" File.zeroTime source err) [] + Help.compilerReport "/" (T.CRE_Module N.replModule "REPL" File.zeroTime source err) [] ReplBadLocalDeps root e es -> Help.compilerReport root e es diff --git a/src/Builder/Reporting/Exit/Help.elm b/src/Builder/Reporting/Exit/Help.elm index 14d372e58..349b54bea 100644 --- a/src/Builder/Reporting/Exit/Help.elm +++ b/src/Builder/Reporting/Exit/Help.elm @@ -15,6 +15,7 @@ import Compiler.Reporting.Doc as D import Compiler.Reporting.Error as Error import Maybe.Extra as Maybe import System.IO as IO exposing (IO) +import Types as T @@ -22,7 +23,7 @@ import System.IO as IO exposing (IO) type Report - = CompilerReport String Error.CRE_Module (List Error.CRE_Module) + = CompilerReport String T.CRE_Module (List T.CRE_Module) | Report String (Maybe String) D.Doc @@ -41,7 +42,7 @@ jsonReport = Report -compilerReport : String -> Error.CRE_Module -> List Error.CRE_Module -> Report +compilerReport : String -> T.CRE_Module -> List T.CRE_Module -> Report compilerReport = CompilerReport diff --git a/src/Compiler/AST/Canonical.elm b/src/Compiler/AST/Canonical.elm index b80dee37c..ff550e5f8 100644 --- a/src/Compiler/AST/Canonical.elm +++ b/src/Compiler/AST/Canonical.elm @@ -1,19 +1,10 @@ module Compiler.AST.Canonical exposing ( Binop(..) - , CaseBranch(..) - , Decls(..) - , Def(..) , Effects(..) , Export(..) , Exports(..) - , Expr - , Expr_(..) - , FieldUpdate(..) , Manager(..) , Module(..) - , Pattern - , PatternCtorArg(..) - , Pattern_(..) , Port(..) , aliasDecoder , aliasEncoder @@ -62,116 +53,6 @@ import Types as T --- EXPRESSIONS - - -type alias Expr = - T.CRA_Located Expr_ - - - --- CACHE Annotations for type inference - - -type Expr_ - = VarLocal T.CDN_Name - | VarTopLevel T.CEMN_Canonical T.CDN_Name - | VarKernel T.CDN_Name T.CDN_Name - | VarForeign T.CEMN_Canonical T.CDN_Name T.CASTC_Annotation - | VarCtor T.CASTC_CtorOpts T.CEMN_Canonical T.CDN_Name T.CDI_ZeroBased T.CASTC_Annotation - | VarDebug T.CEMN_Canonical T.CDN_Name T.CASTC_Annotation - | VarOperator T.CDN_Name T.CEMN_Canonical T.CDN_Name T.CASTC_Annotation -- CACHE real name for optimization - | Chr String - | Str String - | Int Int - | Float Float - | List (List Expr) - | Negate Expr - | Binop T.CDN_Name T.CEMN_Canonical T.CDN_Name T.CASTC_Annotation Expr Expr -- CACHE real name for optimization - | Lambda (List Pattern) Expr - | Call Expr (List Expr) - | If (List ( Expr, Expr )) Expr - | Let Def Expr - | LetRec (List Def) Expr - | LetDestruct Pattern Expr Expr - | Case Expr (List CaseBranch) - | Accessor T.CDN_Name - | Access Expr (T.CRA_Located T.CDN_Name) - | Update T.CDN_Name Expr (Dict String T.CDN_Name FieldUpdate) - | Record (Dict String T.CDN_Name Expr) - | Unit - | Tuple Expr Expr (Maybe Expr) - | Shader T.CASTUS_Source T.CASTUS_Types - - -type CaseBranch - = CaseBranch Pattern Expr - - -type FieldUpdate - = FieldUpdate T.CRA_Region Expr - - - --- DEFS - - -type Def - = Def (T.CRA_Located T.CDN_Name) (List Pattern) Expr - | TypedDef (T.CRA_Located T.CDN_Name) T.CASTC_FreeVars (List ( Pattern, T.CASTC_Type )) Expr T.CASTC_Type - - -type Decls - = Declare Def Decls - | DeclareRec Def (List Def) Decls - | SaveTheEnvironment - - - --- PATTERNS - - -type alias Pattern = - T.CRA_Located Pattern_ - - -type Pattern_ - = PAnything - | PVar T.CDN_Name - | PRecord (List T.CDN_Name) - | PAlias Pattern T.CDN_Name - | PUnit - | PTuple Pattern Pattern (Maybe Pattern) - | PList (List Pattern) - | PCons Pattern Pattern - | PBool T.CASTC_Union Bool - | PChr String - | PStr String - | PInt Int - | PCtor - -- CACHE p_home, p_type, and p_vars for type inference - -- CACHE p_index to replace p_name in PROD code gen - -- CACHE p_opts to allocate less in PROD code gen - -- CACHE p_alts and p_numAlts for exhaustiveness checker - { home : T.CEMN_Canonical - , type_ : T.CDN_Name - , union : T.CASTC_Union - , name : T.CDN_Name - , index : T.CDI_ZeroBased - , args : List PatternCtorArg - } - - -type PatternCtorArg - = PatternCtorArg - -- CACHE for destructors/errors - T.CDI_ZeroBased - -- CACHE for type inference - T.CASTC_Type - Pattern - - - -- TYPES -- NOTE: The Word16 marks the source order, but it may not be available -- for every canonical type. For example, if the canonical type is inferred @@ -199,7 +80,7 @@ fieldsToList fields = type Module - = Module T.CEMN_Canonical Exports T.CASTS_Docs Decls (Dict String T.CDN_Name T.CASTC_Union) (Dict String T.CDN_Name T.CASTC_Alias) (Dict String T.CDN_Name Binop) Effects + = Module T.CEMN_Canonical Exports T.CASTS_Docs T.CASTC_Decls (Dict String T.CDN_Name T.CASTC_Union) (Dict String T.CDN_Name T.CASTC_Alias) (Dict String T.CDN_Name Binop) Effects type Binop @@ -519,8 +400,8 @@ ctorOptsDecoder = ) -fieldUpdateEncoder : FieldUpdate -> Encode.Value -fieldUpdateEncoder (FieldUpdate fieldRegion expr) = +fieldUpdateEncoder : T.CASTC_FieldUpdate -> Encode.Value +fieldUpdateEncoder (T.CASTC_FieldUpdate fieldRegion expr) = Encode.object [ ( "type", Encode.string "FieldUpdate" ) , ( "fieldRegion", A.regionEncoder fieldRegion ) @@ -528,47 +409,47 @@ fieldUpdateEncoder (FieldUpdate fieldRegion expr) = ] -fieldUpdateDecoder : Decode.Decoder FieldUpdate +fieldUpdateDecoder : Decode.Decoder T.CASTC_FieldUpdate fieldUpdateDecoder = - Decode.map2 FieldUpdate + Decode.map2 T.CASTC_FieldUpdate (Decode.field "fieldRegion" A.regionDecoder) (Decode.field "expr" exprDecoder) -exprEncoder : Expr -> Encode.Value +exprEncoder : T.CASTC_Expr -> Encode.Value exprEncoder = A.locatedEncoder expr_Encoder -exprDecoder : Decode.Decoder Expr +exprDecoder : Decode.Decoder T.CASTC_Expr exprDecoder = A.locatedDecoder expr_Decoder -expr_Encoder : Expr_ -> Encode.Value +expr_Encoder : T.CASTC_Expr_ -> Encode.Value expr_Encoder expr_ = case expr_ of - VarLocal name -> + T.CASTC_VarLocal name -> Encode.object [ ( "type", Encode.string "VarLocal" ) , ( "name", Encode.string name ) ] - VarTopLevel home name -> + T.CASTC_VarTopLevel home name -> Encode.object [ ( "type", Encode.string "VarTopLevel" ) , ( "home", ModuleName.canonicalEncoder home ) , ( "name", Encode.string name ) ] - VarKernel home name -> + T.CASTC_VarKernel home name -> Encode.object [ ( "type", Encode.string "VarKernel" ) , ( "home", Encode.string home ) , ( "name", Encode.string name ) ] - VarForeign home name annotation -> + T.CASTC_VarForeign home name annotation -> Encode.object [ ( "type", Encode.string "VarForeign" ) , ( "home", ModuleName.canonicalEncoder home ) @@ -576,7 +457,7 @@ expr_Encoder expr_ = , ( "annotation", annotationEncoder annotation ) ] - VarCtor opts home name index annotation -> + T.CASTC_VarCtor opts home name index annotation -> Encode.object [ ( "type", Encode.string "VarCtor" ) , ( "opts", ctorOptsEncoder opts ) @@ -586,7 +467,7 @@ expr_Encoder expr_ = , ( "annotation", annotationEncoder annotation ) ] - VarDebug home name annotation -> + T.CASTC_VarDebug home name annotation -> Encode.object [ ( "type", Encode.string "VarDebug" ) , ( "home", ModuleName.canonicalEncoder home ) @@ -594,7 +475,7 @@ expr_Encoder expr_ = , ( "annotation", annotationEncoder annotation ) ] - VarOperator op home name annotation -> + T.CASTC_VarOperator op home name annotation -> Encode.object [ ( "type", Encode.string "VarOperator" ) , ( "op", Encode.string op ) @@ -603,43 +484,43 @@ expr_Encoder expr_ = , ( "annotation", annotationEncoder annotation ) ] - Chr chr -> + T.CASTC_Chr chr -> Encode.object [ ( "type", Encode.string "Chr" ) , ( "chr", Encode.string chr ) ] - Str str -> + T.CASTC_Str str -> Encode.object [ ( "type", Encode.string "Str" ) , ( "str", Encode.string str ) ] - Int int -> + T.CASTC_Int int -> Encode.object [ ( "type", Encode.string "Int" ) , ( "int", Encode.int int ) ] - Float float -> + T.CASTC_Float float -> Encode.object [ ( "type", Encode.string "Float" ) , ( "float", Encode.float float ) ] - List entries -> + T.CASTC_List entries -> Encode.object [ ( "type", Encode.string "List" ) , ( "entries", Encode.list exprEncoder entries ) ] - Negate expr -> + T.CASTC_Negate expr -> Encode.object [ ( "type", Encode.string "Negate" ) , ( "expr", exprEncoder expr ) ] - Binop op home name annotation left right -> + T.CASTC_Binop op home name annotation left right -> Encode.object [ ( "type", Encode.string "Binop" ) , ( "op", Encode.string op ) @@ -650,42 +531,42 @@ expr_Encoder expr_ = , ( "right", exprEncoder right ) ] - Lambda args body -> + T.CASTC_Lambda args body -> Encode.object [ ( "type", Encode.string "Lambda" ) , ( "args", Encode.list patternEncoder args ) , ( "body", exprEncoder body ) ] - Call func args -> + T.CASTC_Call func args -> Encode.object [ ( "type", Encode.string "Call" ) , ( "func", exprEncoder func ) , ( "args", Encode.list exprEncoder args ) ] - If branches finally -> + T.CASTC_If branches finally -> Encode.object [ ( "type", Encode.string "If" ) , ( "branches", Encode.list (E.jsonPair exprEncoder exprEncoder) branches ) , ( "finally", exprEncoder finally ) ] - Let def body -> + T.CASTC_Let def body -> Encode.object [ ( "type", Encode.string "Let" ) , ( "def", defEncoder def ) , ( "body", exprEncoder body ) ] - LetRec defs body -> + T.CASTC_LetRec defs body -> Encode.object [ ( "type", Encode.string "LetRec" ) , ( "defs", Encode.list defEncoder defs ) , ( "body", exprEncoder body ) ] - LetDestruct pattern expr body -> + T.CASTC_LetDestruct pattern expr body -> Encode.object [ ( "type", Encode.string "LetDestruct" ) , ( "pattern", patternEncoder pattern ) @@ -693,27 +574,27 @@ expr_Encoder expr_ = , ( "body", exprEncoder body ) ] - Case expr branches -> + T.CASTC_Case expr branches -> Encode.object [ ( "type", Encode.string "Case" ) , ( "expr", exprEncoder expr ) , ( "branches", Encode.list caseBranchEncoder branches ) ] - Accessor field -> + T.CASTC_Accessor field -> Encode.object [ ( "type", Encode.string "Accessor" ) , ( "field", Encode.string field ) ] - Access record field -> + T.CASTC_Access record field -> Encode.object [ ( "type", Encode.string "Access" ) , ( "record", exprEncoder record ) , ( "field", A.locatedEncoder Encode.string field ) ] - Update name record updates -> + T.CASTC_Update name record updates -> Encode.object [ ( "type", Encode.string "Update" ) , ( "name", Encode.string name ) @@ -721,18 +602,18 @@ expr_Encoder expr_ = , ( "updates", E.assocListDict compare Encode.string fieldUpdateEncoder updates ) ] - Record fields -> + T.CASTC_Record fields -> Encode.object [ ( "type", Encode.string "Record" ) , ( "fields", E.assocListDict compare Encode.string exprEncoder fields ) ] - Unit -> + T.CASTC_Unit -> Encode.object [ ( "type", Encode.string "Unit" ) ] - Tuple a b maybeC -> + T.CASTC_Tuple a b maybeC -> Encode.object [ ( "type", Encode.string "Tuple" ) , ( "a", exprEncoder a ) @@ -740,7 +621,7 @@ expr_Encoder expr_ = , ( "maybeC", E.maybe exprEncoder maybeC ) ] - Shader src types -> + T.CASTC_Shader src types -> Encode.object [ ( "type", Encode.string "Shader" ) , ( "src", Shader.sourceEncoder src ) @@ -748,33 +629,33 @@ expr_Encoder expr_ = ] -expr_Decoder : Decode.Decoder Expr_ +expr_Decoder : Decode.Decoder T.CASTC_Expr_ expr_Decoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "VarLocal" -> - Decode.map VarLocal (Decode.field "name" Decode.string) + Decode.map T.CASTC_VarLocal (Decode.field "name" Decode.string) "VarTopLevel" -> - Decode.map2 VarTopLevel + Decode.map2 T.CASTC_VarTopLevel (Decode.field "moduleName" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) "VarKernel" -> - Decode.map2 VarKernel + Decode.map2 T.CASTC_VarKernel (Decode.field "home" Decode.string) (Decode.field "name" Decode.string) "VarForeign" -> - Decode.map3 VarForeign + Decode.map3 T.CASTC_VarForeign (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) (Decode.field "annotation" annotationDecoder) "VarCtor" -> - Decode.map5 VarCtor + Decode.map5 T.CASTC_VarCtor (Decode.field "opts" ctorOptsDecoder) (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) @@ -782,38 +663,38 @@ expr_Decoder = (Decode.field "annotation" annotationDecoder) "VarDebug" -> - Decode.map3 VarDebug + Decode.map3 T.CASTC_VarDebug (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) (Decode.field "annotation" annotationDecoder) "VarOperator" -> - Decode.map4 VarOperator + Decode.map4 T.CASTC_VarOperator (Decode.field "op" Decode.string) (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) (Decode.field "annotation" annotationDecoder) "Chr" -> - Decode.map Chr (Decode.field "chr" Decode.string) + Decode.map T.CASTC_Chr (Decode.field "chr" Decode.string) "Str" -> - Decode.map Str (Decode.field "str" Decode.string) + Decode.map T.CASTC_Str (Decode.field "str" Decode.string) "Int" -> - Decode.map Int (Decode.field "int" Decode.int) + Decode.map T.CASTC_Int (Decode.field "int" Decode.int) "Float" -> - Decode.map Float (Decode.field "float" Decode.float) + Decode.map T.CASTC_Float (Decode.field "float" Decode.float) "List" -> - Decode.map List (Decode.field "entries" (Decode.list exprDecoder)) + Decode.map T.CASTC_List (Decode.field "entries" (Decode.list exprDecoder)) "Negate" -> - Decode.map Negate (Decode.field "expr" exprDecoder) + Decode.map T.CASTC_Negate (Decode.field "expr" exprDecoder) "Binop" -> - Decode.map6 Binop + Decode.map6 T.CASTC_Binop (Decode.field "op" Decode.string) (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) @@ -822,70 +703,70 @@ expr_Decoder = (Decode.field "right" exprDecoder) "Lambda" -> - Decode.map2 Lambda + Decode.map2 T.CASTC_Lambda (Decode.field "args" (Decode.list patternDecoder)) (Decode.field "body" exprDecoder) "Call" -> - Decode.map2 Call + Decode.map2 T.CASTC_Call (Decode.field "func" exprDecoder) (Decode.field "args" (Decode.list exprDecoder)) "If" -> - Decode.map2 If + Decode.map2 T.CASTC_If (Decode.field "branches" (Decode.list (D.jsonPair exprDecoder exprDecoder))) (Decode.field "finally" exprDecoder) "Let" -> - Decode.map2 Let + Decode.map2 T.CASTC_Let (Decode.field "def" defDecoder) (Decode.field "body" exprDecoder) "LetRec" -> - Decode.map2 LetRec + Decode.map2 T.CASTC_LetRec (Decode.field "defs" (Decode.list defDecoder)) (Decode.field "body" exprDecoder) "LetDestruct" -> - Decode.map3 LetDestruct + Decode.map3 T.CASTC_LetDestruct (Decode.field "pattern" patternDecoder) (Decode.field "expr" exprDecoder) (Decode.field "body" exprDecoder) "Case" -> - Decode.map2 Case + Decode.map2 T.CASTC_Case (Decode.field "expr" exprDecoder) (Decode.field "branches" (Decode.list caseBranchDecoder)) "Accessor" -> - Decode.map Accessor (Decode.field "field" Decode.string) + Decode.map T.CASTC_Accessor (Decode.field "field" Decode.string) "Access" -> - Decode.map2 Access + Decode.map2 T.CASTC_Access (Decode.field "record" exprDecoder) (Decode.field "field" (A.locatedDecoder Decode.string)) "Update" -> - Decode.map3 Update + Decode.map3 T.CASTC_Update (Decode.field "name" Decode.string) (Decode.field "record" exprDecoder) (Decode.field "updates" (D.assocListDict identity Decode.string fieldUpdateDecoder)) "Record" -> - Decode.map Record + Decode.map T.CASTC_Record (Decode.field "fields" (D.assocListDict identity Decode.string exprDecoder)) "Unit" -> - Decode.succeed Unit + Decode.succeed T.CASTC_Unit "Tuple" -> - Decode.map3 Tuple + Decode.map3 T.CASTC_Tuple (Decode.field "a" exprDecoder) (Decode.field "b" exprDecoder) (Decode.field "maybeC" (Decode.maybe exprDecoder)) "Shader" -> - Decode.map2 Shader + Decode.map2 T.CASTC_Shader (Decode.field "src" Shader.sourceDecoder) (Decode.field "types" Shader.typesDecoder) @@ -894,49 +775,49 @@ expr_Decoder = ) -patternEncoder : Pattern -> Encode.Value +patternEncoder : T.CASTC_Pattern -> Encode.Value patternEncoder = A.locatedEncoder pattern_Encoder -patternDecoder : Decode.Decoder Pattern +patternDecoder : Decode.Decoder T.CASTC_Pattern patternDecoder = A.locatedDecoder pattern_Decoder -pattern_Encoder : Pattern_ -> Encode.Value +pattern_Encoder : T.CASTC_Pattern_ -> Encode.Value pattern_Encoder pattern_ = case pattern_ of - PAnything -> + T.CASTC_PAnything -> Encode.object [ ( "type", Encode.string "PAnything" ) ] - PVar name -> + T.CASTC_PVar name -> Encode.object [ ( "type", Encode.string "PVar" ) , ( "name", Encode.string name ) ] - PRecord names -> + T.CASTC_PRecord names -> Encode.object [ ( "type", Encode.string "PRecord" ) , ( "names", Encode.list Encode.string names ) ] - PAlias pattern name -> + T.CASTC_PAlias pattern name -> Encode.object [ ( "type", Encode.string "PAlias" ) , ( "pattern", patternEncoder pattern ) , ( "name", Encode.string name ) ] - PUnit -> + T.CASTC_PUnit -> Encode.object [ ( "type", Encode.string "PUnit" ) ] - PTuple pattern1 pattern2 maybePattern3 -> + T.CASTC_PTuple pattern1 pattern2 maybePattern3 -> Encode.object [ ( "type", Encode.string "PTuple" ) , ( "pattern1", patternEncoder pattern1 ) @@ -944,45 +825,45 @@ pattern_Encoder pattern_ = , ( "pattern3", E.maybe patternEncoder maybePattern3 ) ] - PList patterns -> + T.CASTC_PList patterns -> Encode.object [ ( "type", Encode.string "PList" ) , ( "patterns", Encode.list patternEncoder patterns ) ] - PCons pattern1 pattern2 -> + T.CASTC_PCons pattern1 pattern2 -> Encode.object [ ( "type", Encode.string "PCons" ) , ( "pattern1", patternEncoder pattern1 ) , ( "pattern2", patternEncoder pattern2 ) ] - PBool union bool -> + T.CASTC_PBool union bool -> Encode.object [ ( "type", Encode.string "PBool" ) , ( "union", unionEncoder union ) , ( "bool", Encode.bool bool ) ] - PChr chr -> + T.CASTC_PChr chr -> Encode.object [ ( "type", Encode.string "PChr" ) , ( "chr", Encode.string chr ) ] - PStr str -> + T.CASTC_PStr str -> Encode.object [ ( "type", Encode.string "PStr" ) , ( "str", Encode.string str ) ] - PInt int -> + T.CASTC_PInt int -> Encode.object [ ( "type", Encode.string "PInt" ) , ( "int", Encode.int int ) ] - PCtor { home, type_, union, name, index, args } -> + T.CASTC_PCtor { home, type_, union, name, index, args } -> Encode.object [ ( "type", Encode.string "PCtor" ) , ( "home", ModuleName.canonicalEncoder home ) @@ -994,64 +875,64 @@ pattern_Encoder pattern_ = ] -pattern_Decoder : Decode.Decoder Pattern_ +pattern_Decoder : Decode.Decoder T.CASTC_Pattern_ pattern_Decoder = Decode.field "type" Decode.string |> Decode.andThen (\patternType -> case patternType of "PAnything" -> - Decode.succeed PAnything + Decode.succeed T.CASTC_PAnything "PVar" -> - Decode.map PVar + Decode.map T.CASTC_PVar (Decode.field "name" Decode.string) "PRecord" -> - Decode.map PRecord + Decode.map T.CASTC_PRecord (Decode.field "names" (Decode.list Decode.string)) "PAlias" -> - Decode.map2 PAlias + Decode.map2 T.CASTC_PAlias (Decode.field "pattern" patternDecoder) (Decode.field "name" Decode.string) "PUnit" -> - Decode.succeed PUnit + Decode.succeed T.CASTC_PUnit "PTuple" -> - Decode.map3 PTuple + Decode.map3 T.CASTC_PTuple (Decode.field "pattern1" patternDecoder) (Decode.field "pattern2" patternDecoder) (Decode.field "pattern3" (Decode.maybe patternDecoder)) "PList" -> - Decode.map PList + Decode.map T.CASTC_PList (Decode.field "patterns" (Decode.list patternDecoder)) "PCons" -> - Decode.map2 PCons + Decode.map2 T.CASTC_PCons (Decode.field "pattern1" patternDecoder) (Decode.field "pattern2" patternDecoder) "PBool" -> - Decode.map2 PBool + Decode.map2 T.CASTC_PBool (Decode.field "union" unionDecoder) (Decode.field "bool" Decode.bool) "PChr" -> - Decode.map PChr (Decode.field "chr" Decode.string) + Decode.map T.CASTC_PChr (Decode.field "chr" Decode.string) "PStr" -> - Decode.map PStr (Decode.field "str" Decode.string) + Decode.map T.CASTC_PStr (Decode.field "str" Decode.string) "PInt" -> - Decode.map PInt (Decode.field "int" Decode.int) + Decode.map T.CASTC_PInt (Decode.field "int" Decode.int) "PCtor" -> Decode.map6 (\home type_ union name index args -> - PCtor + T.CASTC_PCtor { home = home , type_ = type_ , union = union @@ -1072,8 +953,8 @@ pattern_Decoder = ) -patternCtorArgEncoder : PatternCtorArg -> Encode.Value -patternCtorArgEncoder (PatternCtorArg index srcType pattern) = +patternCtorArgEncoder : T.CASTC_PatternCtorArg -> Encode.Value +patternCtorArgEncoder (T.CASTC_PatternCtorArg index srcType pattern) = Encode.object [ ( "type", Encode.string "PatternCtorArg" ) , ( "index", Index.zeroBasedEncoder index ) @@ -1082,18 +963,18 @@ patternCtorArgEncoder (PatternCtorArg index srcType pattern) = ] -patternCtorArgDecoder : Decode.Decoder PatternCtorArg +patternCtorArgDecoder : Decode.Decoder T.CASTC_PatternCtorArg patternCtorArgDecoder = - Decode.map3 PatternCtorArg + Decode.map3 T.CASTC_PatternCtorArg (Decode.field "index" Index.zeroBasedDecoder) (Decode.field "srcType" typeDecoder) (Decode.field "pattern" patternDecoder) -defEncoder : Def -> Encode.Value +defEncoder : T.CASTC_Def -> Encode.Value defEncoder def = case def of - Def name args expr -> + T.CASTC_Def name args expr -> Encode.object [ ( "type", Encode.string "Def" ) , ( "name", A.locatedEncoder Encode.string name ) @@ -1101,7 +982,7 @@ defEncoder def = , ( "expr", exprEncoder expr ) ] - TypedDef name freeVars typedArgs expr srcResultType -> + T.CASTC_TypedDef name freeVars typedArgs expr srcResultType -> Encode.object [ ( "type", Encode.string "TypedDef" ) , ( "name", A.locatedEncoder Encode.string name ) @@ -1112,20 +993,20 @@ defEncoder def = ] -defDecoder : Decode.Decoder Def +defDecoder : Decode.Decoder T.CASTC_Def defDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Def" -> - Decode.map3 Def + Decode.map3 T.CASTC_Def (Decode.field "name" (A.locatedDecoder Decode.string)) (Decode.field "args" (Decode.list patternDecoder)) (Decode.field "expr" exprDecoder) "TypedDef" -> - Decode.map5 TypedDef + Decode.map5 T.CASTC_TypedDef (Decode.field "name" (A.locatedDecoder Decode.string)) (Decode.field "freeVars" freeVarsDecoder) (Decode.field "typedArgs" (Decode.list (D.jsonPair patternDecoder typeDecoder))) @@ -1137,8 +1018,8 @@ defDecoder = ) -caseBranchEncoder : CaseBranch -> Encode.Value -caseBranchEncoder (CaseBranch pattern expr) = +caseBranchEncoder : T.CASTC_CaseBranch -> Encode.Value +caseBranchEncoder (T.CASTC_CaseBranch pattern expr) = Encode.object [ ( "type", Encode.string "CaseBranch" ) , ( "pattern", patternEncoder pattern ) @@ -1146,8 +1027,8 @@ caseBranchEncoder (CaseBranch pattern expr) = ] -caseBranchDecoder : Decode.Decoder CaseBranch +caseBranchDecoder : Decode.Decoder T.CASTC_CaseBranch caseBranchDecoder = - Decode.map2 CaseBranch + Decode.map2 T.CASTC_CaseBranch (Decode.field "pattern" patternDecoder) (Decode.field "expr" exprDecoder) diff --git a/src/Compiler/Canonicalize/Effects.elm b/src/Compiler/Canonicalize/Effects.elm index 2b072c8b1..2095280ec 100644 --- a/src/Compiler/Canonicalize/Effects.elm +++ b/src/Compiler/Canonicalize/Effects.elm @@ -9,7 +9,6 @@ import Compiler.Canonicalize.Environment as Env import Compiler.Canonicalize.Type as Type import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Data.Map as Dict exposing (Dict) import Maybe exposing (Maybe(..)) @@ -21,7 +20,7 @@ import Types as T type alias EResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a @@ -41,7 +40,7 @@ canonicalize env values unions effects = T.CASTS_Ports ports -> let - pairs : R.RResult i w Error.CREC_Error (List ( T.CDN_Name, Can.Port )) + pairs : R.RResult i w T.CREC_Error (List ( T.CDN_Name, Can.Port )) pairs = R.traverse (canonicalizePort env) ports in @@ -108,7 +107,7 @@ canonicalizePort env (T.CASTS_Port (T.CRA_At region portName) tipe) = if home == ModuleName.cmd && name == Name.cmd then case revArgs of [] -> - R.throw (Error.CREC_PortTypeInvalid region portName Error.CREC_CmdNoArg) + R.throw (T.CREC_PortTypeInvalid region portName T.CREC_CmdNoArg) [ outgoingType ] -> case msg of @@ -125,13 +124,13 @@ canonicalizePort env (T.CASTS_Port (T.CRA_At region portName) tipe) = ) Err ( badType, err ) -> - R.throw (Error.CREC_PortPayloadInvalid region portName badType err) + R.throw (T.CREC_PortPayloadInvalid region portName badType err) _ -> - R.throw (Error.CREC_PortTypeInvalid region portName Error.CREC_CmdBadMsg) + R.throw (T.CREC_PortTypeInvalid region portName T.CREC_CmdBadMsg) _ -> - R.throw (Error.CREC_PortTypeInvalid region portName (Error.CREC_CmdExtraArgs (List.length revArgs))) + R.throw (T.CREC_PortTypeInvalid region portName (T.CREC_CmdExtraArgs (List.length revArgs))) else if home == ModuleName.sub && name == Name.sub then case revArgs of @@ -151,22 +150,22 @@ canonicalizePort env (T.CASTS_Port (T.CRA_At region portName) tipe) = ) Err ( badType, err ) -> - R.throw (Error.CREC_PortPayloadInvalid region portName badType err) + R.throw (T.CREC_PortPayloadInvalid region portName badType err) else - R.throw (Error.CREC_PortTypeInvalid region portName Error.CREC_SubBad) + R.throw (T.CREC_PortTypeInvalid region portName T.CREC_SubBad) _ -> - R.throw (Error.CREC_PortTypeInvalid region portName Error.CREC_SubBad) + R.throw (T.CREC_PortTypeInvalid region portName T.CREC_SubBad) _ -> - R.throw (Error.CREC_PortTypeInvalid region portName Error.CREC_SubBad) + R.throw (T.CREC_PortTypeInvalid region portName T.CREC_SubBad) else - R.throw (Error.CREC_PortTypeInvalid region portName Error.CREC_NotCmdOrSub) + R.throw (T.CREC_PortTypeInvalid region portName T.CREC_NotCmdOrSub) _ -> - R.throw (Error.CREC_PortTypeInvalid region portName Error.CREC_NotCmdOrSub) + R.throw (T.CREC_PortTypeInvalid region portName T.CREC_NotCmdOrSub) ) @@ -180,7 +179,7 @@ verifyEffectType (T.CRA_At region name) unions = R.ok name else - R.throw (Error.CREC_EffectNotFound region name) + R.throw (T.CREC_EffectNotFound region name) toNameRegion : T.CRA_Located T.CASTS_Value -> ( T.CDN_Name, T.CRA_Region ) @@ -195,14 +194,14 @@ verifyManager tagRegion values name = R.ok region Nothing -> - R.throw (Error.CREC_EffectFunctionNotFound tagRegion name) + R.throw (T.CREC_EffectFunctionNotFound tagRegion name) -- CHECK PAYLOAD TYPES -checkPayload : T.CASTC_Type -> Result ( T.CASTC_Type, Error.CREC_InvalidPayload ) () +checkPayload : T.CASTC_Type -> Result ( T.CASTC_Type, T.CREC_InvalidPayload ) () checkPayload tipe = case tipe of T.CASTC_TAlias _ _ args aliasedType -> @@ -215,17 +214,17 @@ checkPayload tipe = Ok () else - Err ( tipe, Error.CREC_UnsupportedType name ) + Err ( tipe, T.CREC_UnsupportedType name ) [ arg ] -> if isList home name || isMaybe home name || isArray home name then checkPayload arg else - Err ( tipe, Error.CREC_UnsupportedType name ) + Err ( tipe, T.CREC_UnsupportedType name ) _ -> - Err ( tipe, Error.CREC_UnsupportedType name ) + Err ( tipe, T.CREC_UnsupportedType name ) T.CASTC_TUnit -> Ok () @@ -244,13 +243,13 @@ checkPayload tipe = ) T.CASTC_TVar name -> - Err ( tipe, Error.CREC_TypeVariable name ) + Err ( tipe, T.CREC_TypeVariable name ) T.CASTC_TLambda _ _ -> - Err ( tipe, Error.CREC_Function ) + Err ( tipe, T.CREC_Function ) T.CASTC_TRecord _ (Just _) -> - Err ( tipe, Error.CREC_ExtendedRecord ) + Err ( tipe, T.CREC_ExtendedRecord ) T.CASTC_TRecord fields Nothing -> Dict.foldl compare @@ -259,7 +258,7 @@ checkPayload tipe = fields -checkFieldPayload : T.CASTC_FieldType -> Result ( T.CASTC_Type, Error.CREC_InvalidPayload ) () +checkFieldPayload : T.CASTC_FieldType -> Result ( T.CASTC_Type, T.CREC_InvalidPayload ) () checkFieldPayload (T.CASTC_FieldType _ tipe) = checkPayload tipe diff --git a/src/Compiler/Canonicalize/Environment.elm b/src/Compiler/Canonicalize/Environment.elm index cb1eb9d29..2a85052a3 100644 --- a/src/Compiler/Canonicalize/Environment.elm +++ b/src/Compiler/Canonicalize/Environment.elm @@ -18,7 +18,6 @@ module Compiler.Canonicalize.Environment exposing ) import Compiler.Data.OneOrMore as OneOrMore -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Data.Map as Dict exposing (Dict) import Data.Set as EverySet @@ -31,7 +30,7 @@ import Types as T type alias EResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a @@ -163,10 +162,10 @@ addLocalBoth name region var = R.ok (Local region) Local parentRegion -> - R.throw (Error.CREC_Shadowing name parentRegion region) + R.throw (T.CREC_Shadowing name parentRegion region) TopLevel parentRegion -> - R.throw (Error.CREC_Shadowing name parentRegion region) + R.throw (T.CREC_Shadowing name parentRegion region) @@ -180,10 +179,10 @@ findType region { types, q_types } name = R.ok tipe Just (Ambiguous h hs) -> - R.throw (Error.CREC_AmbiguousType region Nothing name h hs) + R.throw (T.CREC_AmbiguousType region Nothing name h hs) Nothing -> - R.throw (Error.CREC_NotFoundType region Nothing name (toPossibleNames types q_types)) + R.throw (T.CREC_NotFoundType region Nothing name (toPossibleNames types q_types)) findTypeQual : T.CRA_Region -> Env -> T.CDN_Name -> T.CDN_Name -> EResult i w Type @@ -195,13 +194,13 @@ findTypeQual region { types, q_types } prefix name = R.ok tipe Just (Ambiguous h hs) -> - R.throw (Error.CREC_AmbiguousType region (Just prefix) name h hs) + R.throw (T.CREC_AmbiguousType region (Just prefix) name h hs) Nothing -> - R.throw (Error.CREC_NotFoundType region (Just prefix) name (toPossibleNames types q_types)) + R.throw (T.CREC_NotFoundType region (Just prefix) name (toPossibleNames types q_types)) Nothing -> - R.throw (Error.CREC_NotFoundType region (Just prefix) name (toPossibleNames types q_types)) + R.throw (T.CREC_NotFoundType region (Just prefix) name (toPossibleNames types q_types)) @@ -215,10 +214,10 @@ findCtor region { ctors, q_ctors } name = R.ok ctor Just (Ambiguous h hs) -> - R.throw (Error.CREC_AmbiguousVariant region Nothing name h hs) + R.throw (T.CREC_AmbiguousVariant region Nothing name h hs) Nothing -> - R.throw (Error.CREC_NotFoundVariant region Nothing name (toPossibleNames ctors q_ctors)) + R.throw (T.CREC_NotFoundVariant region Nothing name (toPossibleNames ctors q_ctors)) findCtorQual : T.CRA_Region -> Env -> T.CDN_Name -> T.CDN_Name -> EResult i w Ctor @@ -230,13 +229,13 @@ findCtorQual region { ctors, q_ctors } prefix name = R.ok pattern Just (Ambiguous h hs) -> - R.throw (Error.CREC_AmbiguousVariant region (Just prefix) name h hs) + R.throw (T.CREC_AmbiguousVariant region (Just prefix) name h hs) Nothing -> - R.throw (Error.CREC_NotFoundVariant region (Just prefix) name (toPossibleNames ctors q_ctors)) + R.throw (T.CREC_NotFoundVariant region (Just prefix) name (toPossibleNames ctors q_ctors)) Nothing -> - R.throw (Error.CREC_NotFoundVariant region (Just prefix) name (toPossibleNames ctors q_ctors)) + R.throw (T.CREC_NotFoundVariant region (Just prefix) name (toPossibleNames ctors q_ctors)) @@ -250,16 +249,16 @@ findBinop region { binops } name = R.ok binop Just (Ambiguous h hs) -> - R.throw (Error.CREC_AmbiguousBinop region name h hs) + R.throw (T.CREC_AmbiguousBinop region name h hs) Nothing -> - R.throw (Error.CREC_NotFoundBinop region name (EverySet.fromList identity (Dict.keys compare binops))) + R.throw (T.CREC_NotFoundBinop region name (EverySet.fromList identity (Dict.keys compare binops))) -- TO POSSIBLE NAMES -toPossibleNames : Exposed a -> Qualified a -> Error.CREC_PossibleNames +toPossibleNames : Exposed a -> Qualified a -> T.CREC_PossibleNames toPossibleNames exposed qualified = - Error.CREC_PossibleNames (EverySet.fromList identity (Dict.keys compare exposed)) (Dict.map (\_ -> Dict.keys compare >> EverySet.fromList identity) qualified) + T.CREC_PossibleNames (EverySet.fromList identity (Dict.keys compare exposed)) (Dict.map (\_ -> Dict.keys compare >> EverySet.fromList identity) qualified) diff --git a/src/Compiler/Canonicalize/Environment/Dups.elm b/src/Compiler/Canonicalize/Environment/Dups.elm index 9f8ab7514..233da58da 100644 --- a/src/Compiler/Canonicalize/Environment/Dups.elm +++ b/src/Compiler/Canonicalize/Environment/Dups.elm @@ -13,7 +13,6 @@ module Compiler.Canonicalize.Environment.Dups exposing ) import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) -import Compiler.Reporting.Error.Canonicalize as Error exposing (CREC_Error) import Compiler.Reporting.Result as R import Data.Map as Dict exposing (Dict) import Types as T @@ -39,10 +38,10 @@ type alias Info value = type alias ToError = - T.CDN_Name -> T.CRA_Region -> T.CRA_Region -> CREC_Error + T.CDN_Name -> T.CRA_Region -> T.CRA_Region -> T.CREC_Error -detect : ToError -> Tracker a -> R.RResult i w CREC_Error (Dict String T.CDN_Name a) +detect : ToError -> Tracker a -> R.RResult i w T.CREC_Error (Dict String T.CDN_Name a) detect toError dict = Dict.foldl compare (\name values -> @@ -56,7 +55,7 @@ detect toError dict = dict -detectHelp : ToError -> T.CDN_Name -> OneOrMore (Info a) -> R.RResult i w CREC_Error a +detectHelp : ToError -> T.CDN_Name -> OneOrMore (Info a) -> R.RResult i w T.CREC_Error a detectHelp toError name values = case values of OneOrMore.One { value } -> @@ -74,9 +73,9 @@ detectHelp toError name values = -- CHECK FIELDS -checkFields : List ( T.CRA_Located T.CDN_Name, a ) -> R.RResult i w CREC_Error (Dict String T.CDN_Name a) +checkFields : List ( T.CRA_Located T.CDN_Name, a ) -> R.RResult i w T.CREC_Error (Dict String T.CDN_Name a) checkFields fields = - detect Error.CREC_DuplicateField (List.foldr addField none fields) + detect T.CREC_DuplicateField (List.foldr addField none fields) addField : ( T.CRA_Located T.CDN_Name, a ) -> Tracker a -> Tracker a @@ -84,9 +83,9 @@ addField ( T.CRA_At region name, value ) dups = Utils.mapInsertWith identity OneOrMore.more name (OneOrMore.one (Info region value)) dups -checkFields_ : (T.CRA_Region -> a -> b) -> List ( T.CRA_Located T.CDN_Name, a ) -> R.RResult i w CREC_Error (Dict String T.CDN_Name b) +checkFields_ : (T.CRA_Region -> a -> b) -> List ( T.CRA_Located T.CDN_Name, a ) -> R.RResult i w T.CREC_Error (Dict String T.CDN_Name b) checkFields_ toValue fields = - detect Error.CREC_DuplicateField (List.foldr (addField_ toValue) none fields) + detect T.CREC_DuplicateField (List.foldr (addField_ toValue) none fields) addField_ : (T.CRA_Region -> a -> b) -> ( T.CRA_Located T.CDN_Name, a ) -> Tracker b -> Tracker b diff --git a/src/Compiler/Canonicalize/Environment/Foreign.elm b/src/Compiler/Canonicalize/Environment/Foreign.elm index 3b6ff6a75..2667b7a9c 100644 --- a/src/Compiler/Canonicalize/Environment/Foreign.elm +++ b/src/Compiler/Canonicalize/Environment/Foreign.elm @@ -9,7 +9,6 @@ import Compiler.Data.Name as Name import Compiler.Elm.Interface as I import Compiler.Elm.ModuleName as ModuleName import Compiler.Elm.Package as Pkg -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Data.Map as Dict exposing (Dict) import Types as T @@ -18,7 +17,7 @@ import Utils.Main as Utils type alias FResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a createInitialEnv : T.CEMN_Canonical -> Dict String T.CEMN_Raw T.CEI_Interface -> List T.CASTS_Import -> FResult i w Env.Env @@ -274,7 +273,7 @@ addExposedValue home vars types binops state exposed = R.ok { state | vars = Utils.mapInsertWith identity Env.mergeInfo name info state.vars } Nothing -> - R.throw (Error.CREC_ImportExposingNotFound region home name (Dict.keys compare vars)) + R.throw (T.CREC_ImportExposingNotFound region home name (Dict.keys compare vars)) T.CASTS_Upper (T.CRA_At region name) privacy -> case privacy of @@ -305,10 +304,10 @@ addExposedValue home vars types binops state exposed = Nothing -> case checkForCtorMistake name types of tipe :: _ -> - R.throw <| Error.CREC_ImportCtorByName region name tipe + R.throw <| T.CREC_ImportCtorByName region name tipe [] -> - R.throw <| Error.CREC_ImportExposingNotFound region home name (Dict.keys compare types) + R.throw <| T.CREC_ImportExposingNotFound region home name (Dict.keys compare types) T.CASTS_Public dotDotRegion -> case Dict.get identity name types of @@ -327,10 +326,10 @@ addExposedValue home vars types binops state exposed = R.ok { state | types = ts2, ctors = cs2 } Env.Alias _ _ _ _ -> - R.throw (Error.CREC_ImportOpenAlias dotDotRegion name) + R.throw (T.CREC_ImportOpenAlias dotDotRegion name) Nothing -> - R.throw (Error.CREC_ImportExposingNotFound region home name (Dict.keys compare types)) + R.throw (T.CREC_ImportExposingNotFound region home name (Dict.keys compare types)) T.CASTS_Operator region op -> case Dict.get identity op binops of @@ -343,7 +342,7 @@ addExposedValue home vars types binops state exposed = R.ok { state | binops = bs2 } Nothing -> - R.throw (Error.CREC_ImportExposingNotFound region home op (Dict.keys compare binops)) + R.throw (T.CREC_ImportExposingNotFound region home op (Dict.keys compare binops)) checkForCtorMistake : T.CDN_Name -> Dict String T.CDN_Name ( Env.Type, Env.Exposed Env.Ctor ) -> List T.CDN_Name diff --git a/src/Compiler/Canonicalize/Environment/Local.elm b/src/Compiler/Canonicalize/Environment/Local.elm index c6b56a586..e78c98bf1 100644 --- a/src/Compiler/Canonicalize/Environment/Local.elm +++ b/src/Compiler/Canonicalize/Environment/Local.elm @@ -5,7 +5,6 @@ import Compiler.Canonicalize.Environment as Env import Compiler.Canonicalize.Environment.Dups as Dups import Compiler.Canonicalize.Type as Type import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Data.Graph as Graph import Data.Map as Dict exposing (Dict) @@ -18,7 +17,7 @@ import Utils.Main as Utils type alias LResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a type alias Unions = @@ -62,7 +61,7 @@ collectVars (T.CASTS_Module _ _ _ _ values _ _ _ effects) = addDecl (T.CRA_At _ (T.CASTS_Value (T.CRA_At region name) _ _ _)) = Dups.insert name region (Env.TopLevel region) in - Dups.detect Error.CREC_DuplicateDecl <| + Dups.detect T.CREC_DuplicateDecl <| List.foldl addDecl (toEffectDups effects) values @@ -113,7 +112,7 @@ addTypes (T.CASTS_Module _ _ _ _ _ unions aliases _ _) env = typeNameDups = List.foldl addUnionDups (List.foldl addAliasDups Dups.none aliases) unions in - Dups.detect Error.CREC_DuplicateType typeNameDups + Dups.detect T.CREC_DuplicateType typeNameDups |> R.bind (\_ -> Utils.foldM (addUnion env.home) env.types unions @@ -188,7 +187,7 @@ addAlias ({ home, vars, types, ctors, binops, q_vars, q_types, q_ctors } as env) toName (T.CRA_At _ (T.CASTS_Alias (T.CRA_At _ name) _ _)) = name in - R.throw (Error.CREC_RecursiveAlias region name1 args tipe (List.map toName others)) + R.throw (T.CREC_RecursiveAlias region name1 args tipe (List.map toName others)) ) @@ -241,7 +240,7 @@ checkUnionFreeVars (T.CRA_At unionRegion (T.CASTS_Union (T.CRA_At _ name) args c addCtorFreeVars ( _, tipes ) freeVars = List.foldl addFreeVars freeVars tipes in - Dups.detect (Error.CREC_DuplicateUnionArg name) (List.foldr addArg Dups.none args) + Dups.detect (T.CREC_DuplicateUnionArg name) (List.foldr addArg Dups.none args) |> R.bind (\boundVars -> let @@ -255,7 +254,7 @@ checkUnionFreeVars (T.CRA_At unionRegion (T.CASTS_Union (T.CRA_At _ name) args c unbound :: unbounds -> R.throw <| - Error.CREC_TypeVarsUnboundInUnion unionRegion name (List.map A.toValue args) unbound unbounds + T.CREC_TypeVarsUnboundInUnion unionRegion name (List.map A.toValue args) unbound unbounds ) @@ -266,7 +265,7 @@ checkAliasFreeVars (T.CRA_At aliasRegion (T.CASTS_Alias (T.CRA_At _ name) args t addArg (T.CRA_At region arg) dict = Dups.insert arg region region dict in - Dups.detect (Error.CREC_DuplicateAliasArg name) (List.foldr addArg Dups.none args) + Dups.detect (T.CREC_DuplicateAliasArg name) (List.foldr addArg Dups.none args) |> R.bind (\boundVars -> let @@ -283,7 +282,7 @@ checkAliasFreeVars (T.CRA_At aliasRegion (T.CASTS_Alias (T.CRA_At _ name) args t else R.throw <| - Error.CREC_TypeVarsMessedUpInAlias aliasRegion + T.CREC_TypeVarsMessedUpInAlias aliasRegion name (List.map A.toValue args) (Dict.toList compare (Dict.diff boundVars freeVars)) @@ -338,7 +337,7 @@ addCtors (T.CASTS_Module _ _ _ _ _ unions aliases _ _) env = R.traverse (canonicalizeAlias env) aliases |> R.bind (\aliasInfo -> - (Dups.detect Error.CREC_DuplicateCtor <| + (Dups.detect T.CREC_DuplicateCtor <| Dups.union (Dups.unions (List.map Tuple.second unionInfo)) (Dups.unions (List.map Tuple.second aliasInfo)) diff --git a/src/Compiler/Canonicalize/Expression.elm b/src/Compiler/Canonicalize/Expression.elm index 4db503230..2ca5e4ffc 100644 --- a/src/Compiler/Canonicalize/Expression.elm +++ b/src/Compiler/Canonicalize/Expression.elm @@ -8,7 +8,6 @@ module Compiler.Canonicalize.Expression exposing ) import Basics.Extra exposing (flip) -import Compiler.AST.Canonical as Can import Compiler.AST.Utils.Type as Type import Compiler.Canonicalize.Environment as Env import Compiler.Canonicalize.Environment.Dups as Dups @@ -19,7 +18,6 @@ import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName import Compiler.Elm.Package as Pkg import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Compiler.Reporting.Warning as W import Data.Graph as Graph @@ -34,7 +32,7 @@ import Utils.Main as Utils type alias EResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a type alias FreeLocals = @@ -52,21 +50,21 @@ type Uses -- CANONICALIZE -canonicalize : Env.Env -> T.CASTS_Expr -> EResult FreeLocals (List W.Warning) Can.Expr +canonicalize : Env.Env -> T.CASTS_Expr -> EResult FreeLocals (List W.Warning) T.CASTC_Expr canonicalize env (T.CRA_At region expression) = R.fmap (T.CRA_At region) <| case expression of T.CASTS_Str string -> - R.ok (Can.Str string) + R.ok (T.CASTC_Str string) T.CASTS_Chr char -> - R.ok (Can.Chr char) + R.ok (T.CASTC_Chr char) T.CASTS_Int int -> - R.ok (Can.Int int) + R.ok (T.CASTC_Int int) T.CASTS_Float float -> - R.ok (Can.Float float) + R.ok (T.CASTC_Float float) T.CASTS_Var varType name -> case varType of @@ -85,24 +83,24 @@ canonicalize env (T.CRA_At region expression) = R.fmap (toVarCtor name) (Env.findCtorQual region env prefix name) T.CASTS_List exprs -> - R.fmap Can.List (R.traverse (canonicalize env) exprs) + R.fmap T.CASTC_List (R.traverse (canonicalize env) exprs) T.CASTS_Op op -> Env.findBinop region env op |> R.fmap (\(Env.Binop _ home name annotation _ _) -> - Can.VarOperator op home name annotation + T.CASTC_VarOperator op home name annotation ) T.CASTS_Negate expr -> - R.fmap Can.Negate (canonicalize env expr) + R.fmap T.CASTC_Negate (canonicalize env expr) T.CASTS_Binops ops final -> R.fmap A.toValue (canonicalizeBinops region env ops final) T.CASTS_Lambda srcArgs body -> delayedUsage <| - (Pattern.verify Error.CREC_DPLambdaArgs + (Pattern.verify T.CREC_DPLambdaArgs (R.traverse (Pattern.canonicalize env) srcArgs) |> R.bind (\( args, bindings ) -> @@ -112,19 +110,19 @@ canonicalize env (T.CRA_At region expression) = verifyBindings W.Pattern bindings (canonicalize newEnv body) |> R.fmap (\( cbody, freeLocals ) -> - ( Can.Lambda args cbody, freeLocals ) + ( T.CASTC_Lambda args cbody, freeLocals ) ) ) ) ) T.CASTS_Call func args -> - R.pure Can.Call + R.pure T.CASTC_Call |> R.apply (canonicalize env func) |> R.apply (R.traverse (canonicalize env) args) T.CASTS_If branches finally -> - R.pure Can.If + R.pure T.CASTC_If |> R.apply (R.traverse (canonicalizeIfBranch env) branches) |> R.apply (canonicalize env finally) @@ -132,25 +130,25 @@ canonicalize env (T.CRA_At region expression) = R.fmap A.toValue <| canonicalizeLet region env defs expr T.CASTS_Case expr branches -> - R.pure Can.Case + R.pure T.CASTC_Case |> R.apply (canonicalize env expr) |> R.apply (R.traverse (canonicalizeCaseBranch env) branches) T.CASTS_Accessor field -> - R.pure (Can.Accessor field) + R.pure (T.CASTC_Accessor field) T.CASTS_Access record field -> - R.pure Can.Access + R.pure T.CASTC_Access |> R.apply (canonicalize env record) |> R.apply (R.ok field) T.CASTS_Update (T.CRA_At reg name) fields -> let - makeCanFields : R.RResult i w Error.CREC_Error (Dict String T.CDN_Name (R.RResult FreeLocals (List W.Warning) Error.CREC_Error Can.FieldUpdate)) + makeCanFields : R.RResult i w T.CREC_Error (Dict String T.CDN_Name (R.RResult FreeLocals (List W.Warning) T.CREC_Error T.CASTC_FieldUpdate)) makeCanFields = - Dups.checkFields_ (\r t -> R.fmap (Can.FieldUpdate r) (canonicalize env t)) fields + Dups.checkFields_ (\r t -> R.fmap (T.CASTC_FieldUpdate r) (canonicalize env t)) fields in - R.pure (Can.Update name) + R.pure (T.CASTC_Update name) |> R.apply (R.fmap (T.CRA_At reg) (findVar reg env name)) |> R.apply (R.bind (Utils.sequenceADict identity compare) makeCanFields) @@ -158,23 +156,23 @@ canonicalize env (T.CRA_At region expression) = Dups.checkFields fields |> R.bind (\fieldDict -> - R.fmap Can.Record (R.traverseDict identity compare (canonicalize env) fieldDict) + R.fmap T.CASTC_Record (R.traverseDict identity compare (canonicalize env) fieldDict) ) T.CASTS_Unit -> - R.ok Can.Unit + R.ok T.CASTC_Unit T.CASTS_Tuple a b cs -> - R.pure Can.Tuple + R.pure T.CASTC_Tuple |> R.apply (canonicalize env a) |> R.apply (canonicalize env b) |> R.apply (canonicalizeTupleExtras region env cs) T.CASTS_Shader src tipe -> - R.ok (Can.Shader src tipe) + R.ok (T.CASTC_Shader src tipe) -canonicalizeTupleExtras : T.CRA_Region -> Env.Env -> List T.CASTS_Expr -> EResult FreeLocals (List W.Warning) (Maybe Can.Expr) +canonicalizeTupleExtras : T.CRA_Region -> Env.Env -> List T.CASTS_Expr -> EResult FreeLocals (List W.Warning) (Maybe T.CASTC_Expr) canonicalizeTupleExtras region env extras = case extras of [] -> @@ -184,14 +182,14 @@ canonicalizeTupleExtras region env extras = R.fmap Just <| canonicalize env three _ -> - R.throw (Error.CREC_TupleLargerThanThree region) + R.throw (T.CREC_TupleLargerThanThree region) -- CANONICALIZE IF BRANCH -canonicalizeIfBranch : Env.Env -> ( T.CASTS_Expr, T.CASTS_Expr ) -> EResult FreeLocals (List W.Warning) ( Can.Expr, Can.Expr ) +canonicalizeIfBranch : Env.Env -> ( T.CASTS_Expr, T.CASTS_Expr ) -> EResult FreeLocals (List W.Warning) ( T.CASTC_Expr, T.CASTC_Expr ) canonicalizeIfBranch env ( condition, branch ) = R.pure Tuple.pair |> R.apply (canonicalize env condition) @@ -202,10 +200,10 @@ canonicalizeIfBranch env ( condition, branch ) = -- CANONICALIZE CASE BRANCH -canonicalizeCaseBranch : Env.Env -> ( T.CASTS_Pattern, T.CASTS_Expr ) -> EResult FreeLocals (List W.Warning) Can.CaseBranch +canonicalizeCaseBranch : Env.Env -> ( T.CASTS_Pattern, T.CASTS_Expr ) -> EResult FreeLocals (List W.Warning) T.CASTC_CaseBranch canonicalizeCaseBranch env ( pattern, expr ) = directUsage - (Pattern.verify Error.CREC_DPCaseBranch + (Pattern.verify T.CREC_DPCaseBranch (Pattern.canonicalize env pattern) |> R.bind (\( cpattern, bindings ) -> @@ -215,7 +213,7 @@ canonicalizeCaseBranch env ( pattern, expr ) = verifyBindings W.Pattern bindings (canonicalize newEnv expr) |> R.fmap (\( cexpr, freeLocals ) -> - ( Can.CaseBranch cpattern cexpr, freeLocals ) + ( T.CASTC_CaseBranch cpattern cexpr, freeLocals ) ) ) ) @@ -226,10 +224,10 @@ canonicalizeCaseBranch env ( pattern, expr ) = -- CANONICALIZE BINOPS -canonicalizeBinops : T.CRA_Region -> Env.Env -> List ( T.CASTS_Expr, T.CRA_Located T.CDN_Name ) -> T.CASTS_Expr -> EResult FreeLocals (List W.Warning) Can.Expr +canonicalizeBinops : T.CRA_Region -> Env.Env -> List ( T.CASTS_Expr, T.CRA_Located T.CDN_Name ) -> T.CASTS_Expr -> EResult FreeLocals (List W.Warning) T.CASTC_Expr canonicalizeBinops overallRegion env ops final = let - canonicalizeHelp : ( T.CASTS_Expr, T.CRA_Located T.CDN_Name ) -> R.RResult FreeLocals (List W.Warning) Error.CREC_Error ( Can.Expr, Env.Binop ) + canonicalizeHelp : ( T.CASTS_Expr, T.CRA_Located T.CDN_Name ) -> R.RResult FreeLocals (List W.Warning) T.CREC_Error ( T.CASTC_Expr, Env.Binop ) canonicalizeHelp ( expr, T.CRA_At region op ) = R.ok Tuple.pair |> R.apply (canonicalize env expr) @@ -243,12 +241,12 @@ canonicalizeBinops overallRegion env ops final = type Step - = Done Can.Expr - | More (List ( Can.Expr, Env.Binop )) Can.Expr + = Done T.CASTC_Expr + | More (List ( T.CASTC_Expr, Env.Binop )) T.CASTC_Expr | Error Env.Binop Env.Binop -runBinopStepper : T.CRA_Region -> Step -> EResult FreeLocals w Can.Expr +runBinopStepper : T.CRA_Region -> Step -> EResult FreeLocals w T.CASTC_Expr runBinopStepper overallRegion step = case step of Done expr -> @@ -262,10 +260,10 @@ runBinopStepper overallRegion step = toBinopStep (toBinop op expr) op rest final Error (Env.Binop op1 _ _ _ _ _) (Env.Binop op2 _ _ _ _ _) -> - R.throw (Error.CREC_Binop overallRegion op1 op2) + R.throw (T.CREC_Binop overallRegion op1 op2) -toBinopStep : (Can.Expr -> Can.Expr) -> Env.Binop -> List ( Can.Expr, Env.Binop ) -> Can.Expr -> Step +toBinopStep : (T.CASTC_Expr -> T.CASTC_Expr) -> Env.Binop -> List ( T.CASTC_Expr, Env.Binop ) -> T.CASTC_Expr -> Step toBinopStep makeBinop ((Env.Binop _ _ _ _ rootAssociativity rootPrecedence) as rootOp) middle final = case middle of [] -> @@ -298,15 +296,15 @@ toBinopStep makeBinop ((Env.Binop _ _ _ _ rootAssociativity rootPrecedence) as r Error rootOp op -toBinop : Env.Binop -> Can.Expr -> Can.Expr -> Can.Expr +toBinop : Env.Binop -> T.CASTC_Expr -> T.CASTC_Expr -> T.CASTC_Expr toBinop (Env.Binop op home name annotation _ _) left right = - A.merge left right (Can.Binop op home name annotation left right) + A.merge left right (T.CASTC_Binop op home name annotation left right) -canonicalizeLet : T.CRA_Region -> Env.Env -> List (T.CRA_Located T.CASTS_Def) -> T.CASTS_Expr -> EResult FreeLocals (List W.Warning) Can.Expr +canonicalizeLet : T.CRA_Region -> Env.Env -> List (T.CRA_Located T.CASTS_Def) -> T.CASTS_Expr -> EResult FreeLocals (List W.Warning) T.CASTC_Expr canonicalizeLet letRegion env defs body = directUsage <| - (Dups.detect (Error.CREC_DuplicatePattern Error.CREC_DPLetBinding) + (Dups.detect (T.CREC_DuplicatePattern T.CREC_DPLetBinding) (List.foldl addBindings Dups.none defs) |> R.bind (\bindings -> @@ -393,9 +391,9 @@ type alias Node = type Binding - = Define Can.Def + = Define T.CASTC_Def | Edge (T.CRA_Located T.CDN_Name) - | Destruct Can.Pattern Can.Expr + | Destruct T.CASTC_Pattern T.CASTC_Expr addDefNodes : Env.Env -> List Node -> T.CRA_Located T.CASTS_Def -> EResult FreeLocals (List W.Warning) (List Node) @@ -404,7 +402,7 @@ addDefNodes env nodes (T.CRA_At _ def) = T.CASTS_Define ((T.CRA_At _ name) as aname) srcArgs body maybeType -> case maybeType of Nothing -> - Pattern.verify (Error.CREC_DPFuncArgs name) + Pattern.verify (T.CREC_DPFuncArgs name) (R.traverse (Pattern.canonicalize env) srcArgs) |> R.bind (\( args, argBindings ) -> @@ -415,9 +413,9 @@ addDefNodes env nodes (T.CRA_At _ def) = |> R.bind (\( cbody, freeLocals ) -> let - cdef : Can.Def + cdef : T.CASTC_Def cdef = - Can.Def aname args cbody + T.CASTC_Def aname args cbody node : ( Binding, T.CDN_Name, List T.CDN_Name ) node = @@ -432,7 +430,7 @@ addDefNodes env nodes (T.CRA_At _ def) = Type.toAnnotation env tipe |> R.bind (\(T.CASTC_Forall freeVars ctipe) -> - Pattern.verify (Error.CREC_DPFuncArgs name) + Pattern.verify (T.CREC_DPFuncArgs name) (gatherTypedArgs env name srcArgs ctipe Index.first []) |> R.bind (\( ( args, resultType ), argBindings ) -> @@ -443,9 +441,9 @@ addDefNodes env nodes (T.CRA_At _ def) = |> R.bind (\( cbody, freeLocals ) -> let - cdef : Can.Def + cdef : T.CASTC_Def cdef = - Can.TypedDef aname freeVars args cbody resultType + T.CASTC_TypedDef aname freeVars args cbody resultType node : ( Binding, T.CDN_Name, List T.CDN_Name ) node = @@ -458,7 +456,7 @@ addDefNodes env nodes (T.CRA_At _ def) = ) T.CASTS_Destruct pattern body -> - Pattern.verify Error.CREC_DPDestruct + Pattern.verify T.CREC_DPDestruct (Pattern.canonicalize env pattern) |> R.bind (\( cpattern, _ ) -> @@ -572,8 +570,8 @@ gatherTypedArgs : -> List T.CASTS_Pattern -> T.CASTC_Type -> T.CDI_ZeroBased - -> List ( Can.Pattern, T.CASTC_Type ) - -> EResult Pattern.DupsDict w ( List ( Can.Pattern, T.CASTC_Type ), T.CASTC_Type ) + -> List ( T.CASTC_Pattern, T.CASTC_Type ) + -> EResult Pattern.DupsDict w ( List ( T.CASTC_Pattern, T.CASTC_Type ), T.CASTC_Type ) gatherTypedArgs env name srcArgs tipe index revTypedArgs = case srcArgs of [] -> @@ -594,10 +592,10 @@ gatherTypedArgs env name srcArgs tipe index revTypedArgs = ( T.CRA_At start _, T.CRA_At end _ ) = ( Prelude.head srcArgs, Prelude.last srcArgs ) in - R.throw (Error.CREC_AnnotationTooShort (A.mergeRegions start end) name index (List.length srcArgs)) + R.throw (T.CREC_AnnotationTooShort (A.mergeRegions start end) name index (List.length srcArgs)) -detectCycles : T.CRA_Region -> List (Graph.SCC Binding) -> Can.Expr -> EResult i w Can.Expr +detectCycles : T.CRA_Region -> List (Graph.SCC Binding) -> T.CASTC_Expr -> EResult i w T.CASTC_Expr detectCycles letRegion sccs body = case sccs of [] -> @@ -609,7 +607,7 @@ detectCycles letRegion sccs body = case binding of Define def -> detectCycles letRegion subSccs body - |> R.fmap (Can.Let def) + |> R.fmap (T.CASTC_Let def) |> R.fmap (T.CRA_At letRegion) Edge _ -> @@ -617,17 +615,17 @@ detectCycles letRegion sccs body = Destruct pattern expr -> detectCycles letRegion subSccs body - |> R.fmap (Can.LetDestruct pattern expr) + |> R.fmap (T.CASTC_LetDestruct pattern expr) |> R.fmap (T.CRA_At letRegion) Graph.CyclicSCC bindings -> - R.ok Can.LetRec + R.ok T.CASTC_LetRec |> R.apply (checkCycle bindings []) |> R.apply (detectCycles letRegion subSccs body) |> R.fmap (T.CRA_At letRegion) -checkCycle : List Binding -> List Can.Def -> EResult i w (List Can.Def) +checkCycle : List Binding -> List T.CASTC_Def -> EResult i w (List T.CASTC_Def) checkCycle bindings defs = case bindings of [] -> @@ -635,22 +633,22 @@ checkCycle bindings defs = binding :: otherBindings -> case binding of - Define ((Can.Def name args _) as def) -> + Define ((T.CASTC_Def name args _) as def) -> if List.isEmpty args then - R.throw (Error.CREC_RecursiveLet name (toNames otherBindings defs)) + R.throw (T.CREC_RecursiveLet name (toNames otherBindings defs)) else checkCycle otherBindings (def :: defs) - Define ((Can.TypedDef name _ args _ _) as def) -> + Define ((T.CASTC_TypedDef name _ args _ _) as def) -> if List.isEmpty args then - R.throw (Error.CREC_RecursiveLet name (toNames otherBindings defs)) + R.throw (T.CREC_RecursiveLet name (toNames otherBindings defs)) else checkCycle otherBindings (def :: defs) Edge name -> - R.throw (Error.CREC_RecursiveLet name (toNames otherBindings defs)) + R.throw (T.CREC_RecursiveLet name (toNames otherBindings defs)) Destruct _ _ -> -- a Destruct cannot appear in a cycle without any Edge values @@ -658,7 +656,7 @@ checkCycle bindings defs = checkCycle otherBindings defs -toNames : List Binding -> List Can.Def -> List T.CDN_Name +toNames : List Binding -> List T.CASTC_Def -> List T.CDN_Name toNames bindings revDefs = case bindings of [] -> @@ -676,13 +674,13 @@ toNames bindings revDefs = toNames otherBindings revDefs -getDefName : Can.Def -> T.CDN_Name +getDefName : T.CASTC_Def -> T.CDN_Name getDefName def = case def of - Can.Def (T.CRA_At _ name) _ _ -> + T.CASTC_Def (T.CRA_At _ name) _ _ -> name - Can.TypedDef (T.CRA_At _ name) _ _ _ _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ _ _ _ -> name @@ -794,34 +792,34 @@ delayedUsage (R.RResult k) = -- FIND VARIABLE -findVar : T.CRA_Region -> Env.Env -> T.CDN_Name -> EResult FreeLocals w Can.Expr_ +findVar : T.CRA_Region -> Env.Env -> T.CDN_Name -> EResult FreeLocals w T.CASTC_Expr_ findVar region env name = case Dict.get identity name env.vars of Just var -> case var of Env.Local _ -> - logVar name (Can.VarLocal name) + logVar name (T.CASTC_VarLocal name) Env.TopLevel _ -> - logVar name (Can.VarTopLevel env.home name) + logVar name (T.CASTC_VarTopLevel env.home name) Env.Foreign home annotation -> R.ok (if home == ModuleName.debug then - Can.VarDebug env.home name annotation + T.CASTC_VarDebug env.home name annotation else - Can.VarForeign home name annotation + T.CASTC_VarForeign home name annotation ) Env.Foreigns h hs -> - R.throw (Error.CREC_AmbiguousVar region Nothing name h hs) + R.throw (T.CREC_AmbiguousVar region Nothing name h hs) Nothing -> - R.throw (Error.CREC_NotFoundVar region Nothing name (toPossibleNames env.vars env.q_vars)) + R.throw (T.CREC_NotFoundVar region Nothing name (toPossibleNames env.vars env.q_vars)) -findVarQual : T.CRA_Region -> Env.Env -> T.CDN_Name -> T.CDN_Name -> EResult FreeLocals w Can.Expr_ +findVarQual : T.CRA_Region -> Env.Env -> T.CDN_Name -> T.CDN_Name -> EResult FreeLocals w T.CASTC_Expr_ findVarQual region env prefix name = case Dict.get identity prefix env.q_vars of Just qualified -> @@ -829,16 +827,16 @@ findVarQual region env prefix name = Just (Env.Specific home annotation) -> R.ok <| if home == ModuleName.debug then - Can.VarDebug env.home name annotation + T.CASTC_VarDebug env.home name annotation else - Can.VarForeign home name annotation + T.CASTC_VarForeign home name annotation Just (Env.Ambiguous h hs) -> - R.throw (Error.CREC_AmbiguousVar region (Just prefix) name h hs) + R.throw (T.CREC_AmbiguousVar region (Just prefix) name h hs) Nothing -> - R.throw (Error.CREC_NotFoundVar region (Just prefix) name (toPossibleNames env.vars env.q_vars)) + R.throw (T.CREC_NotFoundVar region (Just prefix) name (toPossibleNames env.vars env.q_vars)) Nothing -> let @@ -846,22 +844,22 @@ findVarQual region env prefix name = env.home in if Name.isKernel prefix && Pkg.isKernel pkg then - R.ok <| Can.VarKernel (Name.getKernel prefix) name + R.ok <| T.CASTC_VarKernel (Name.getKernel prefix) name else - R.throw (Error.CREC_NotFoundVar region (Just prefix) name (toPossibleNames env.vars env.q_vars)) + R.throw (T.CREC_NotFoundVar region (Just prefix) name (toPossibleNames env.vars env.q_vars)) -toPossibleNames : Dict String T.CDN_Name Env.Var -> Env.Qualified T.CASTC_Annotation -> Error.CREC_PossibleNames +toPossibleNames : Dict String T.CDN_Name Env.Var -> Env.Qualified T.CASTC_Annotation -> T.CREC_PossibleNames toPossibleNames exposed qualified = - Error.CREC_PossibleNames (Utils.keysSet identity compare exposed) (Dict.map (\_ -> Utils.keysSet identity compare) qualified) + T.CREC_PossibleNames (Utils.keysSet identity compare exposed) (Dict.map (\_ -> Utils.keysSet identity compare) qualified) -- FIND CTOR -toVarCtor : T.CDN_Name -> Env.Ctor -> Can.Expr_ +toVarCtor : T.CDN_Name -> Env.Ctor -> T.CASTC_Expr_ toVarCtor name ctor = case ctor of Env.Ctor home typeName (T.CASTC_Union vars _ _ opts) index args -> @@ -878,7 +876,7 @@ toVarCtor name ctor = tipe = List.foldr T.CASTC_TLambda result args in - Can.VarCtor opts home name index (T.CASTC_Forall freeVars tipe) + T.CASTC_VarCtor opts home name index (T.CASTC_Forall freeVars tipe) Env.RecordCtor home vars tipe -> let @@ -886,4 +884,4 @@ toVarCtor name ctor = freeVars = Dict.fromList identity (List.map (\v -> ( v, () )) vars) in - Can.VarCtor T.CASTC_Normal home name Index.first (T.CASTC_Forall freeVars tipe) + T.CASTC_VarCtor T.CASTC_Normal home name Index.first (T.CASTC_Forall freeVars tipe) diff --git a/src/Compiler/Canonicalize/Module.elm b/src/Compiler/Canonicalize/Module.elm index 8fd891d3a..3565fbb13 100644 --- a/src/Compiler/Canonicalize/Module.elm +++ b/src/Compiler/Canonicalize/Module.elm @@ -12,7 +12,6 @@ import Compiler.Canonicalize.Pattern as Pattern import Compiler.Canonicalize.Type as Type import Compiler.Data.Index as Index import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Compiler.Reporting.Warning as W import Data.Graph as Graph @@ -26,7 +25,7 @@ import Utils.Crash exposing (crash) type alias MResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a @@ -82,22 +81,22 @@ canonicalizeBinop (T.CRA_At _ (T.CASTS_Infix op associativity precedence func)) -- 2. Detect cycles using DIRECT dependencies => nonterminating recursion -canonicalizeValues : Env.Env -> List (T.CRA_Located T.CASTS_Value) -> MResult i (List W.Warning) Can.Decls +canonicalizeValues : Env.Env -> List (T.CRA_Located T.CASTS_Value) -> MResult i (List W.Warning) T.CASTC_Decls canonicalizeValues env values = R.traverse (toNodeOne env) values |> R.bind (\nodes -> detectCycles (Graph.stronglyConnComp nodes)) -detectCycles : List (Graph.SCC NodeTwo) -> MResult i w Can.Decls +detectCycles : List (Graph.SCC NodeTwo) -> MResult i w T.CASTC_Decls detectCycles sccs = case sccs of [] -> - R.ok Can.SaveTheEnvironment + R.ok T.CASTC_SaveTheEnvironment scc :: otherSccs -> case scc of Graph.AcyclicSCC ( def, _, _ ) -> - R.fmap (Can.Declare def) (detectCycles otherSccs) + R.fmap (T.CASTC_Declare def) (detectCycles otherSccs) Graph.CyclicSCC subNodes -> R.traverse detectBadCycles (Graph.stronglyConnComp subNodes) @@ -108,11 +107,11 @@ detectCycles sccs = detectCycles otherSccs d :: ds -> - R.fmap (Can.DeclareRec d ds) (detectCycles otherSccs) + R.fmap (T.CASTC_DeclareRec d ds) (detectCycles otherSccs) ) -detectBadCycles : Graph.SCC Can.Def -> MResult i w Can.Def +detectBadCycles : Graph.SCC T.CASTC_Def -> MResult i w T.CASTC_Def detectBadCycles scc = case scc of Graph.AcyclicSCC def -> @@ -130,16 +129,16 @@ detectBadCycles scc = names = List.map (A.toValue << extractDefName) defs in - R.throw (Error.CREC_RecursiveDecl region name names) + R.throw (T.CREC_RecursiveDecl region name names) -extractDefName : Can.Def -> T.CRA_Located T.CDN_Name +extractDefName : T.CASTC_Def -> T.CRA_Located T.CDN_Name extractDefName def = case def of - Can.Def name _ _ -> + T.CASTC_Def name _ _ -> name - Can.TypedDef name _ _ _ _ -> + T.CASTC_TypedDef name _ _ _ _ -> name @@ -162,14 +161,14 @@ type alias NodeOne = type alias NodeTwo = - ( Can.Def, T.CDN_Name, List T.CDN_Name ) + ( T.CASTC_Def, T.CDN_Name, List T.CDN_Name ) toNodeOne : Env.Env -> T.CRA_Located T.CASTS_Value -> MResult i (List W.Warning) NodeOne toNodeOne env (T.CRA_At _ (T.CASTS_Value ((T.CRA_At _ name) as aname) srcArgs body maybeType)) = case maybeType of Nothing -> - Pattern.verify (Error.CREC_DPFuncArgs name) + Pattern.verify (T.CREC_DPFuncArgs name) (R.traverse (Pattern.canonicalize env) srcArgs) |> R.bind (\( args, argBindings ) -> @@ -180,9 +179,9 @@ toNodeOne env (T.CRA_At _ (T.CASTS_Value ((T.CRA_At _ name) as aname) srcArgs bo |> R.fmap (\( cbody, freeLocals ) -> let - def : Can.Def + def : T.CASTC_Def def = - Can.Def aname args cbody + T.CASTC_Def aname args cbody in ( toNodeTwo name srcArgs def freeLocals , name @@ -196,7 +195,7 @@ toNodeOne env (T.CRA_At _ (T.CASTS_Value ((T.CRA_At _ name) as aname) srcArgs bo Type.toAnnotation env srcType |> R.bind (\(T.CASTC_Forall freeVars tipe) -> - Pattern.verify (Error.CREC_DPFuncArgs name) + Pattern.verify (T.CREC_DPFuncArgs name) (Expr.gatherTypedArgs env name srcArgs tipe Index.first []) |> R.bind (\( ( args, resultType ), argBindings ) -> @@ -207,9 +206,9 @@ toNodeOne env (T.CRA_At _ (T.CASTS_Value ((T.CRA_At _ name) as aname) srcArgs bo |> R.fmap (\( cbody, freeLocals ) -> let - def : Can.Def + def : T.CASTC_Def def = - Can.TypedDef aname freeVars args cbody resultType + T.CASTC_TypedDef aname freeVars args cbody resultType in ( toNodeTwo name srcArgs def freeLocals , name @@ -221,7 +220,7 @@ toNodeOne env (T.CRA_At _ (T.CASTS_Value ((T.CRA_At _ name) as aname) srcArgs bo ) -toNodeTwo : T.CDN_Name -> List arg -> Can.Def -> Expr.FreeLocals -> NodeTwo +toNodeTwo : T.CDN_Name -> List arg -> T.CASTC_Def -> Expr.FreeLocals -> NodeTwo toNodeTwo name args def freeLocals = case args of [] -> @@ -266,7 +265,7 @@ canonicalizeExports values unions aliases binops effects (T.CRA_At region exposi R.traverse (checkExposed names unions aliases binops effects) exposeds |> R.bind (\infos -> - Dups.detect Error.CREC_ExportDuplicate (Dups.unions infos) + Dups.detect T.CREC_ExportDuplicate (Dups.unions infos) |> R.fmap Can.Export ) @@ -296,24 +295,24 @@ checkExposed values unions aliases binops effects exposed = ok name region Can.ExportPort Just ports -> - R.throw (Error.CREC_ExportNotFound region Error.CREC_BadVar name (ports ++ Dict.keys compare values)) + R.throw (T.CREC_ExportNotFound region T.CREC_BadVar name (ports ++ Dict.keys compare values)) T.CASTS_Operator region name -> if Dict.member identity name binops then ok name region Can.ExportBinop else - R.throw (Error.CREC_ExportNotFound region Error.CREC_BadOp name (Dict.keys compare binops)) + R.throw (T.CREC_ExportNotFound region T.CREC_BadOp name (Dict.keys compare binops)) T.CASTS_Upper (T.CRA_At region name) (T.CASTS_Public dotDotRegion) -> if Dict.member identity name unions then ok name region Can.ExportUnionOpen else if Dict.member identity name aliases then - R.throw (Error.CREC_ExportOpenAlias dotDotRegion name) + R.throw (T.CREC_ExportOpenAlias dotDotRegion name) else - R.throw (Error.CREC_ExportNotFound region Error.CREC_BadType name (Dict.keys compare unions ++ Dict.keys compare aliases)) + R.throw (T.CREC_ExportNotFound region T.CREC_BadType name (Dict.keys compare unions ++ Dict.keys compare aliases)) T.CASTS_Upper (T.CRA_At region name) T.CASTS_Private -> if Dict.member identity name unions then @@ -323,7 +322,7 @@ checkExposed values unions aliases binops effects exposed = ok name region Can.ExportAlias else - R.throw (Error.CREC_ExportNotFound region Error.CREC_BadType name (Dict.keys compare unions ++ Dict.keys compare aliases)) + R.throw (T.CREC_ExportNotFound region T.CREC_BadType name (Dict.keys compare unions ++ Dict.keys compare aliases)) checkPorts : Can.Effects -> T.CDN_Name -> Maybe (List T.CDN_Name) diff --git a/src/Compiler/Canonicalize/Pattern.elm b/src/Compiler/Canonicalize/Pattern.elm index a217d95ad..7be8333e1 100644 --- a/src/Compiler/Canonicalize/Pattern.elm +++ b/src/Compiler/Canonicalize/Pattern.elm @@ -6,14 +6,12 @@ module Compiler.Canonicalize.Pattern exposing , verify ) -import Compiler.AST.Canonical as Can import Compiler.Canonicalize.Environment as Env import Compiler.Canonicalize.Environment.Dups as Dups import Compiler.Data.Index as Index import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Data.Map exposing (Dict) import Types as T @@ -25,7 +23,7 @@ import Utils.Main as Utils type alias PResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a type alias Bindings = @@ -36,7 +34,7 @@ type alias Bindings = -- VERIFY -verify : Error.CREC_DuplicatePatternContext -> PResult DupsDict w a -> PResult i w ( a, Bindings ) +verify : T.CREC_DuplicatePatternContext -> PResult DupsDict w a -> PResult i w ( a, Bindings ) verify context (R.RResult k) = R.RResult <| \info warnings -> @@ -45,7 +43,7 @@ verify context (R.RResult k) = Err (R.RErr info warnings1 errors) Ok (R.ROk bindings warnings1 value) -> - case Dups.detect (Error.CREC_DuplicatePattern context) bindings of + case Dups.detect (T.CREC_DuplicatePattern context) bindings of R.RResult k1 -> case k1 () () of Err (R.RErr () () errs) -> @@ -63,24 +61,24 @@ type alias DupsDict = Dups.Tracker T.CRA_Region -canonicalize : Env.Env -> T.CASTS_Pattern -> PResult DupsDict w Can.Pattern +canonicalize : Env.Env -> T.CASTS_Pattern -> PResult DupsDict w T.CASTC_Pattern canonicalize env (T.CRA_At region pattern) = R.fmap (T.CRA_At region) <| case pattern of T.CASTS_PAnything -> - R.ok Can.PAnything + R.ok T.CASTC_PAnything T.CASTS_PVar name -> - logVar name region (Can.PVar name) + logVar name region (T.CASTC_PVar name) T.CASTS_PRecord fields -> - logFields fields (Can.PRecord (List.map A.toValue fields)) + logFields fields (T.CASTC_PRecord (List.map A.toValue fields)) T.CASTS_PUnit -> - R.ok Can.PUnit + R.ok T.CASTC_PUnit T.CASTS_PTuple a b cs -> - R.ok Can.PTuple + R.ok T.CASTC_PTuple |> R.apply (canonicalize env a) |> R.apply (canonicalize env b) |> R.apply (canonicalizeTuple region env cs) @@ -94,35 +92,35 @@ canonicalize env (T.CRA_At region pattern) = |> R.bind (canonicalizeCtor env region name patterns) T.CASTS_PList patterns -> - R.fmap Can.PList (canonicalizeList env patterns) + R.fmap T.CASTC_PList (canonicalizeList env patterns) T.CASTS_PCons first rest -> - R.ok Can.PCons + R.ok T.CASTC_PCons |> R.apply (canonicalize env first) |> R.apply (canonicalize env rest) T.CASTS_PAlias ptrn (T.CRA_At reg name) -> canonicalize env ptrn - |> R.bind (\cpattern -> logVar name reg (Can.PAlias cpattern name)) + |> R.bind (\cpattern -> logVar name reg (T.CASTC_PAlias cpattern name)) T.CASTS_PChr chr -> - R.ok (Can.PChr chr) + R.ok (T.CASTC_PChr chr) T.CASTS_PStr str -> - R.ok (Can.PStr str) + R.ok (T.CASTC_PStr str) T.CASTS_PInt int -> - R.ok (Can.PInt int) + R.ok (T.CASTC_PInt int) -canonicalizeCtor : Env.Env -> T.CRA_Region -> T.CDN_Name -> List T.CASTS_Pattern -> Env.Ctor -> PResult DupsDict w Can.Pattern_ +canonicalizeCtor : Env.Env -> T.CRA_Region -> T.CDN_Name -> List T.CASTS_Pattern -> Env.Ctor -> PResult DupsDict w T.CASTC_Pattern_ canonicalizeCtor env region name patterns ctor = case ctor of Env.Ctor home tipe union index args -> let - toCanonicalArg : T.CDI_ZeroBased -> T.CASTS_Pattern -> T.CASTC_Type -> R.RResult DupsDict w Error.CREC_Error Can.PatternCtorArg + toCanonicalArg : T.CDI_ZeroBased -> T.CASTS_Pattern -> T.CASTC_Type -> R.RResult DupsDict w T.CREC_Error T.CASTC_PatternCtorArg toCanonicalArg argIndex argPattern argTipe = - R.fmap (Can.PatternCtorArg argIndex argTipe) + R.fmap (T.CASTC_PatternCtorArg argIndex argTipe) (canonicalize env argPattern) in Utils.indexedZipWithA toCanonicalArg patterns args @@ -131,20 +129,20 @@ canonicalizeCtor env region name patterns ctor = case verifiedList of Index.LengthMatch cargs -> if tipe == Name.bool && home == ModuleName.basics then - R.ok (Can.PBool union (name == Name.true)) + R.ok (T.CASTC_PBool union (name == Name.true)) else - R.ok (Can.PCtor { home = home, type_ = tipe, union = union, name = name, index = index, args = cargs }) + R.ok (T.CASTC_PCtor { home = home, type_ = tipe, union = union, name = name, index = index, args = cargs }) Index.LengthMismatch actualLength expectedLength -> - R.throw (Error.CREC_BadArity region Error.CREC_PatternArity name expectedLength actualLength) + R.throw (T.CREC_BadArity region T.CREC_PatternArity name expectedLength actualLength) ) Env.RecordCtor _ _ _ -> - R.throw (Error.CREC_PatternHasRecordCtor region name) + R.throw (T.CREC_PatternHasRecordCtor region name) -canonicalizeTuple : T.CRA_Region -> Env.Env -> List T.CASTS_Pattern -> PResult DupsDict w (Maybe Can.Pattern) +canonicalizeTuple : T.CRA_Region -> Env.Env -> List T.CASTS_Pattern -> PResult DupsDict w (Maybe T.CASTC_Pattern) canonicalizeTuple tupleRegion env extras = case extras of [] -> @@ -154,10 +152,10 @@ canonicalizeTuple tupleRegion env extras = R.fmap Just (canonicalize env three) _ -> - R.throw (Error.CREC_TupleLargerThanThree tupleRegion) + R.throw (T.CREC_TupleLargerThanThree tupleRegion) -canonicalizeList : Env.Env -> List T.CASTS_Pattern -> PResult DupsDict w (List Can.Pattern) +canonicalizeList : Env.Env -> List T.CASTS_Pattern -> PResult DupsDict w (List T.CASTC_Pattern) canonicalizeList env list = case list of [] -> diff --git a/src/Compiler/Canonicalize/Type.elm b/src/Compiler/Canonicalize/Type.elm index b48892ef8..79297e4ae 100644 --- a/src/Compiler/Canonicalize/Type.elm +++ b/src/Compiler/Canonicalize/Type.elm @@ -7,7 +7,6 @@ module Compiler.Canonicalize.Type exposing import Compiler.Canonicalize.Environment as Env import Compiler.Canonicalize.Environment.Dups as Dups import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Canonicalize as Error import Compiler.Reporting.Result as R import Data.Map as Dict exposing (Dict) import Types as T @@ -19,7 +18,7 @@ import Utils.Main as Utils type alias CResult i w a = - R.RResult i w Error.CREC_Error a + R.RResult i w T.CREC_Error a @@ -81,14 +80,14 @@ canonicalize env (T.CRA_At typeRegion tipe) = |> R.fmap (tTuple << Just) _ -> - R.throw <| Error.CREC_TupleLargerThanThree typeRegion + R.throw <| T.CREC_TupleLargerThanThree typeRegion ) canonicalizeFields : Env.Env -> List ( T.CRA_Located T.CDN_Name, T.CASTS_Type ) -> List ( T.CRA_Located T.CDN_Name, CResult i w T.CASTC_FieldType ) canonicalizeFields env fields = let - canonicalizeField : Int -> ( a, T.CASTS_Type ) -> ( a, R.RResult i w Error.CREC_Error T.CASTC_FieldType ) + canonicalizeField : Int -> ( a, T.CASTS_Type ) -> ( a, R.RResult i w T.CREC_Error T.CASTC_FieldType ) canonicalizeField index ( name, srcType ) = ( name, R.fmap (T.CASTC_FieldType index) (canonicalize env srcType) ) in @@ -126,7 +125,7 @@ checkArity expected region name args answer = R.ok answer else - R.throw (Error.CREC_BadArity region Error.CREC_TypeArity name expected actual) + R.throw (T.CREC_BadArity region T.CREC_TypeArity name expected actual) diff --git a/src/Compiler/Compile.elm b/src/Compiler/Compile.elm index 7c01b30ba..30b6c1a16 100644 --- a/src/Compiler/Compile.elm +++ b/src/Compiler/Compile.elm @@ -7,7 +7,6 @@ import Compiler.AST.Canonical as Can import Compiler.Canonicalize.Module as Canonicalize import Compiler.Nitpick.PatternMatches as PatternMatches import Compiler.Optimize.Module as Optimize -import Compiler.Reporting.Error as E import Compiler.Reporting.Render.Type.Localizer as Localizer import Compiler.Reporting.Result as R import Compiler.Type.Constrain.Module as Type @@ -26,7 +25,7 @@ type Artifacts = Artifacts Can.Module (Dict String T.CDN_Name T.CASTC_Annotation) T.CASTO_LocalGraph -compile : T.CEP_Name -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO (Result E.CRE_Error Artifacts) +compile : T.CEP_Name -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO (Result T.CRE_Error Artifacts) compile pkg ifaces modul = IO.pure (canonicalize pkg ifaces modul) |> IO.fmap @@ -51,41 +50,41 @@ compile pkg ifaces modul = -- PHASES -canonicalize : T.CEP_Name -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> Result E.CRE_Error Can.Module +canonicalize : T.CEP_Name -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> Result T.CRE_Error Can.Module canonicalize pkg ifaces modul = case Tuple.second (R.run (Canonicalize.canonicalize pkg ifaces modul)) of Ok canonical -> Ok canonical Err errors -> - Err (E.CRE_BadNames errors) + Err (T.CRE_BadNames errors) -typeCheck : T.CASTS_Module -> Can.Module -> Result E.CRE_Error (Dict String T.CDN_Name T.CASTC_Annotation) +typeCheck : T.CASTS_Module -> Can.Module -> Result T.CRE_Error (Dict String T.CDN_Name T.CASTC_Annotation) typeCheck modul canonical = case TypeCheck.unsafePerformIO (TypeCheck.bind Type.run (Type.constrain canonical)) of Ok annotations -> Ok annotations Err errors -> - Err (E.CRE_BadTypes (Localizer.fromModule modul) errors) + Err (T.CRE_BadTypes (Localizer.fromModule modul) errors) -nitpick : Can.Module -> Result E.CRE_Error () +nitpick : Can.Module -> Result T.CRE_Error () nitpick canonical = case PatternMatches.check canonical of Ok () -> Ok () Err errors -> - Err (E.CRE_BadPatterns errors) + Err (T.CRE_BadPatterns errors) -optimize : T.CASTS_Module -> Dict String T.CDN_Name T.CASTC_Annotation -> Can.Module -> Result E.CRE_Error T.CASTO_LocalGraph +optimize : T.CASTS_Module -> Dict String T.CDN_Name T.CASTC_Annotation -> Can.Module -> Result T.CRE_Error T.CASTO_LocalGraph optimize modul annotations canonical = case Tuple.second (R.run (Optimize.optimize annotations canonical)) of Ok localGraph -> Ok localGraph Err errors -> - Err (E.CRE_BadMains (Localizer.fromModule modul) errors) + Err (T.CRE_BadMains (Localizer.fromModule modul) errors) diff --git a/src/Compiler/Elm/Compiler/Type.elm b/src/Compiler/Elm/Compiler/Type.elm index 3cf83029d..8baaa9761 100644 --- a/src/Compiler/Elm/Compiler/Type.elm +++ b/src/Compiler/Elm/Compiler/Type.elm @@ -1,6 +1,5 @@ module Compiler.Elm.Compiler.Type exposing ( Alias(..) - , CECT_Type(..) , DebugMetadata(..) , Union(..) , decoder @@ -30,35 +29,26 @@ import Utils.Crash exposing (crash) -- TYPES -type CECT_Type - = CECT_Lambda CECT_Type CECT_Type - | CECT_Var T.CDN_Name - | CECT_Type T.CDN_Name (List CECT_Type) - | CECT_Record (List ( T.CDN_Name, CECT_Type )) (Maybe T.CDN_Name) - | CECT_Unit - | CECT_Tuple CECT_Type CECT_Type (List CECT_Type) - - type DebugMetadata - = DebugMetadata CECT_Type (List Alias) (List Union) + = DebugMetadata T.CECT_Type (List Alias) (List Union) type Alias - = Alias T.CDN_Name (List T.CDN_Name) CECT_Type + = Alias T.CDN_Name (List T.CDN_Name) T.CECT_Type type Union - = Union T.CDN_Name (List T.CDN_Name) (List ( T.CDN_Name, List CECT_Type )) + = Union T.CDN_Name (List T.CDN_Name) (List ( T.CDN_Name, List T.CECT_Type )) -- TO DOC -toDoc : L.CRRTL_Localizer -> RT.Context -> CECT_Type -> D.Doc +toDoc : T.CRRTL_Localizer -> RT.Context -> T.CECT_Type -> D.Doc toDoc localizer context tipe = case tipe of - CECT_Lambda _ _ -> + T.CECT_Lambda _ _ -> case List.map (toDoc localizer RT.Func) (collectLambdas tipe) of a :: b :: cs -> RT.lambda context a b cs @@ -66,39 +56,39 @@ toDoc localizer context tipe = _ -> crash "toDoc Lambda" - CECT_Var name -> + T.CECT_Var name -> D.fromName name - CECT_Unit -> + T.CECT_Unit -> D.fromChars "()" - CECT_Tuple a b cs -> + T.CECT_Tuple a b cs -> RT.tuple (toDoc localizer RT.None a) (toDoc localizer RT.None b) (List.map (toDoc localizer RT.None) cs) - CECT_Type name args -> + T.CECT_Type name args -> RT.apply context (D.fromName name) (List.map (toDoc localizer RT.App) args) - CECT_Record fields ext -> + T.CECT_Record fields ext -> RT.record (List.map (entryToDoc localizer) fields) (Maybe.map D.fromName ext) -entryToDoc : L.CRRTL_Localizer -> ( T.CDN_Name, CECT_Type ) -> ( D.Doc, D.Doc ) +entryToDoc : T.CRRTL_Localizer -> ( T.CDN_Name, T.CECT_Type ) -> ( D.Doc, D.Doc ) entryToDoc localizer ( field, fieldType ) = ( D.fromName field, toDoc localizer RT.None fieldType ) -collectLambdas : CECT_Type -> List CECT_Type +collectLambdas : T.CECT_Type -> List T.CECT_Type collectLambdas tipe = case tipe of - CECT_Lambda arg body -> + T.CECT_Lambda arg body -> arg :: collectLambdas body _ -> @@ -109,52 +99,52 @@ collectLambdas tipe = -- JSON for TYPE -encode : CECT_Type -> Value +encode : T.CECT_Type -> Value encode tipe = E.string (D.toLine (toDoc L.empty RT.None tipe)) -decoder : Decoder () CECT_Type +decoder : Decoder () T.CECT_Type decoder = D.customString parser (\_ _ -> ()) -parser : P.Parser () CECT_Type +parser : P.Parser () T.CECT_Type parser = P.specialize (\_ _ _ -> ()) (P.fmap fromRawType (P.fmap Tuple.first Type.expression)) -fromRawType : T.CASTS_Type -> CECT_Type +fromRawType : T.CASTS_Type -> T.CECT_Type fromRawType (T.CRA_At _ astType) = case astType of T.CASTS_TLambda t1 t2 -> - CECT_Lambda (fromRawType t1) (fromRawType t2) + T.CECT_Lambda (fromRawType t1) (fromRawType t2) T.CASTS_TVar x -> - CECT_Var x + T.CECT_Var x T.CASTS_TUnit -> - CECT_Unit + T.CECT_Unit T.CASTS_TTuple a b cs -> - CECT_Tuple + T.CECT_Tuple (fromRawType a) (fromRawType b) (List.map fromRawType cs) T.CASTS_TType _ name args -> - CECT_Type name (List.map fromRawType args) + T.CECT_Type name (List.map fromRawType args) T.CASTS_TTypeQual _ _ name args -> - CECT_Type name (List.map fromRawType args) + T.CECT_Type name (List.map fromRawType args) T.CASTS_TRecord fields ext -> let - fromField : ( T.CRA_Located a, T.CASTS_Type ) -> ( a, CECT_Type ) + fromField : ( T.CRA_Located a, T.CASTS_Type ) -> ( a, T.CECT_Type ) fromField ( T.CRA_At _ field, tipe ) = ( field, fromRawType tipe ) in - CECT_Record + T.CECT_Record (List.map fromField fields) (Maybe.map A.toValue ext) @@ -192,7 +182,7 @@ toCustomTypeField (Union name args constructors) = ) -toVariantObject : ( T.CDN_Name, List CECT_Type ) -> ( String, Value ) +toVariantObject : ( T.CDN_Name, List T.CECT_Type ) -> ( String, Value ) toVariantObject ( name, args ) = ( Json.fromName name, E.list encode args ) @@ -201,42 +191,42 @@ toVariantObject ( name, args ) = -- ENCODERS and DECODERS -jsonEncoder : CECT_Type -> Encode.Value +jsonEncoder : T.CECT_Type -> Encode.Value jsonEncoder type_ = case type_ of - CECT_Lambda arg body -> + T.CECT_Lambda arg body -> Encode.object [ ( "type", Encode.string "Lambda" ) , ( "arg", jsonEncoder arg ) , ( "body", jsonEncoder body ) ] - CECT_Var name -> + T.CECT_Var name -> Encode.object [ ( "type", Encode.string "Var" ) , ( "name", Encode.string name ) ] - CECT_Type name args -> + T.CECT_Type name args -> Encode.object [ ( "type", Encode.string "Type" ) , ( "name", Encode.string name ) , ( "args", Encode.list jsonEncoder args ) ] - CECT_Record fields ext -> + T.CECT_Record fields ext -> Encode.object [ ( "type", Encode.string "Record" ) , ( "fields", Encode.list (E.jsonPair Encode.string jsonEncoder) fields ) , ( "ext", E.maybe Encode.string ext ) ] - CECT_Unit -> + T.CECT_Unit -> Encode.object [ ( "type", Encode.string "Unit" ) ] - CECT_Tuple a b cs -> + T.CECT_Tuple a b cs -> Encode.object [ ( "type", Encode.string "Tuple" ) , ( "a", jsonEncoder a ) @@ -245,36 +235,36 @@ jsonEncoder type_ = ] -jsonDecoder : Decode.Decoder CECT_Type +jsonDecoder : Decode.Decoder T.CECT_Type jsonDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Lambda" -> - Decode.map2 CECT_Lambda + Decode.map2 T.CECT_Lambda (Decode.field "arg" jsonDecoder) (Decode.field "body" jsonDecoder) "Var" -> - Decode.map CECT_Var + Decode.map T.CECT_Var (Decode.field "name" Decode.string) "Type" -> - Decode.map2 CECT_Type + Decode.map2 T.CECT_Type (Decode.field "name" Decode.string) (Decode.field "args" (Decode.list jsonDecoder)) "Record" -> - Decode.map2 CECT_Record + Decode.map2 T.CECT_Record (Decode.field "fields" (Decode.list (D.jsonPair Decode.string jsonDecoder))) (Decode.field "ext" (Decode.maybe Decode.string)) "Unit" -> - Decode.succeed CECT_Unit + Decode.succeed T.CECT_Unit "Tuple" -> - Decode.map3 CECT_Tuple + Decode.map3 T.CECT_Tuple (Decode.field "a" jsonDecoder) (Decode.field "b" jsonDecoder) (Decode.field "cs" (Decode.list jsonDecoder)) diff --git a/src/Compiler/Elm/Docs.elm b/src/Compiler/Elm/Docs.elm index 4d86bf1f9..04646b62a 100644 --- a/src/Compiler/Elm/Docs.elm +++ b/src/Compiler/Elm/Docs.elm @@ -1,11 +1,5 @@ module Compiler.Elm.Docs exposing - ( CED_Alias(..) - , CED_Binop(..) - , CED_Comment - , CED_Module(..) - , CED_Union(..) - , CED_Value(..) - , Documentation + ( Documentation , Error(..) , decoder , encode @@ -32,7 +26,6 @@ import Compiler.Parse.Space as Space import Compiler.Parse.Symbol as Symbol import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Docs as E import Compiler.Reporting.Result as Result import Data.Map as Dict exposing (Dict) import Json.Decode as Decode @@ -46,31 +39,7 @@ import Utils.Main as Utils type alias Documentation = - Dict String T.CDN_Name CED_Module - - -type CED_Module - = CED_Module T.CDN_Name CED_Comment (Dict String T.CDN_Name CED_Union) (Dict String T.CDN_Name CED_Alias) (Dict String T.CDN_Name CED_Value) (Dict String T.CDN_Name CED_Binop) - - -type alias CED_Comment = - String - - -type CED_Alias - = CED_Alias CED_Comment (List T.CDN_Name) Type.CECT_Type - - -type CED_Union - = CED_Union CED_Comment (List T.CDN_Name) (List ( T.CDN_Name, List Type.CECT_Type )) - - -type CED_Value - = CED_Value CED_Comment Type.CECT_Type - - -type CED_Binop - = CED_Binop CED_Comment Type.CECT_Type T.CASTUB_Associativity T.CASTUB_Precedence + Dict String T.CDN_Name T.CED_Module @@ -82,8 +51,8 @@ encode docs = E.list encodeModule (Dict.values compare docs) -encodeModule : CED_Module -> E.Value -encodeModule (CED_Module name comment unions aliases values binops) = +encodeModule : T.CED_Module -> E.Value +encodeModule (T.CED_Module name comment unions aliases values binops) = E.object [ ( "name", ModuleName.encode name ) , ( "comment", E.string comment ) @@ -105,19 +74,19 @@ decoder = D.fmap toDict (D.list moduleDecoder) -toDict : List CED_Module -> Documentation +toDict : List T.CED_Module -> Documentation toDict modules = Dict.fromList identity (List.map toDictHelp modules) -toDictHelp : CED_Module -> ( T.CDN_Name, CED_Module ) -toDictHelp ((CED_Module name _ _ _ _ _) as modul) = +toDictHelp : T.CED_Module -> ( T.CDN_Name, T.CED_Module ) +toDictHelp ((T.CED_Module name _ _ _ _ _) as modul) = ( name, modul ) -moduleDecoder : D.Decoder Error CED_Module +moduleDecoder : D.Decoder Error T.CED_Module moduleDecoder = - D.pure CED_Module + D.pure T.CED_Module |> D.apply (D.field "name" moduleNameDecoder) |> D.apply (D.field "comment" D.string) |> D.apply (D.field "unions" (dictDecoder union)) @@ -148,7 +117,7 @@ moduleNameDecoder = D.mapError (always BadModuleName) ModuleName.decoder -typeDecoder : D.Decoder Error Type.CECT_Type +typeDecoder : D.Decoder Error T.CECT_Type typeDecoder = D.mapError (always BadType) Type.decoder @@ -157,8 +126,8 @@ typeDecoder = -- UNION JSON -encodeUnion : ( T.CDN_Name, CED_Union ) -> E.Value -encodeUnion ( name, CED_Union comment args cases ) = +encodeUnion : ( T.CDN_Name, T.CED_Union ) -> E.Value +encodeUnion ( name, T.CED_Union comment args cases ) = E.object [ ( "name", E.name name ) , ( "comment", E.string comment ) @@ -167,20 +136,20 @@ encodeUnion ( name, CED_Union comment args cases ) = ] -union : D.Decoder Error CED_Union +union : D.Decoder Error T.CED_Union union = - D.pure CED_Union + D.pure T.CED_Union |> D.apply (D.field "comment" D.string) |> D.apply (D.field "args" (D.list nameDecoder)) |> D.apply (D.field "cases" (D.list caseDecoder)) -encodeCase : ( T.CDN_Name, List Type.CECT_Type ) -> E.Value +encodeCase : ( T.CDN_Name, List T.CECT_Type ) -> E.Value encodeCase ( tag, args ) = E.list identity [ E.name tag, E.list Type.encode args ] -caseDecoder : D.Decoder Error ( T.CDN_Name, List Type.CECT_Type ) +caseDecoder : D.Decoder Error ( T.CDN_Name, List T.CECT_Type ) caseDecoder = D.pair nameDecoder (D.list typeDecoder) @@ -189,8 +158,8 @@ caseDecoder = -- ALIAS JSON -encodeAlias : ( T.CDN_Name, CED_Alias ) -> E.Value -encodeAlias ( name, CED_Alias comment args tipe ) = +encodeAlias : ( T.CDN_Name, T.CED_Alias ) -> E.Value +encodeAlias ( name, T.CED_Alias comment args tipe ) = E.object [ ( "name", E.name name ) , ( "comment", E.string comment ) @@ -199,9 +168,9 @@ encodeAlias ( name, CED_Alias comment args tipe ) = ] -alias_ : D.Decoder Error CED_Alias +alias_ : D.Decoder Error T.CED_Alias alias_ = - D.pure CED_Alias + D.pure T.CED_Alias |> D.apply (D.field "comment" D.string) |> D.apply (D.field "args" (D.list nameDecoder)) |> D.apply (D.field "type" typeDecoder) @@ -211,8 +180,8 @@ alias_ = -- VALUE JSON -encodeValue : ( T.CDN_Name, CED_Value ) -> E.Value -encodeValue ( name, CED_Value comment tipe ) = +encodeValue : ( T.CDN_Name, T.CED_Value ) -> E.Value +encodeValue ( name, T.CED_Value comment tipe ) = E.object [ ( "name", E.name name ) , ( "comment", E.string comment ) @@ -220,9 +189,9 @@ encodeValue ( name, CED_Value comment tipe ) = ] -value : D.Decoder Error CED_Value +value : D.Decoder Error T.CED_Value value = - D.pure CED_Value + D.pure T.CED_Value |> D.apply (D.field "comment" D.string) |> D.apply (D.field "type" typeDecoder) @@ -231,8 +200,8 @@ value = -- BINOP JSON -encodeBinop : ( T.CDN_Name, CED_Binop ) -> E.Value -encodeBinop ( name, CED_Binop comment tipe assoc prec ) = +encodeBinop : ( T.CDN_Name, T.CED_Binop ) -> E.Value +encodeBinop ( name, T.CED_Binop comment tipe assoc prec ) = E.object [ ( "name", E.name name ) , ( "comment", E.string comment ) @@ -242,9 +211,9 @@ encodeBinop ( name, CED_Binop comment tipe assoc prec ) = ] -binop : D.Decoder Error CED_Binop +binop : D.Decoder Error T.CED_Binop binop = - D.pure CED_Binop + D.pure T.CED_Binop |> D.apply (D.field "comment" D.string) |> D.apply (D.field "type" typeDecoder) |> D.apply (D.field "associativity" assocDecoder) @@ -318,16 +287,16 @@ precDecoder = -- FROM MODULE -fromModule : Can.Module -> Result E.CRED_Error CED_Module +fromModule : Can.Module -> Result T.CRED_Error T.CED_Module fromModule ((Can.Module _ exports docs _ _ _ _ _) as modul) = case exports of Can.ExportEverything region -> - Err (E.CRED_ImplicitExposing region) + Err (T.CRED_ImplicitExposing region) Can.Export exportDict -> case docs of T.CASTS_NoDocs region -> - Err (E.CRED_NoDocs region) + Err (T.CRED_NoDocs region) T.CASTS_YesDocs overview comments -> parseOverview overview @@ -339,18 +308,18 @@ fromModule ((Can.Module _ exports docs _ _ _ _ _) as modul) = -- PARSE OVERVIEW -parseOverview : T.CASTS_Comment -> Result E.CRED_Error (List (T.CRA_Located T.CDN_Name)) +parseOverview : T.CASTS_Comment -> Result T.CRED_Error (List (T.CRA_Located T.CDN_Name)) parseOverview (T.CASTS_Comment snippet) = - case P.fromSnippet (chompOverview []) E.CRED_BadEnd snippet of + case P.fromSnippet (chompOverview []) T.CRED_BadEnd snippet of Err err -> - Err (E.CRED_SyntaxProblem err) + Err (T.CRED_SyntaxProblem err) Ok names -> Ok names type alias Parser a = - P.Parser E.CRED_SyntaxProblem a + P.Parser T.CRED_SyntaxProblem a chompOverview : List (T.CRA_Located T.CDN_Name) -> Parser (List (T.CRA_Located T.CDN_Name)) @@ -359,7 +328,7 @@ chompOverview names = |> P.bind (\isDocs -> if isDocs then - Space.chomp E.CRED_Space + Space.chomp T.CRED_Space |> P.bind (\_ -> P.bind chompOverview (chompDocs names)) else @@ -370,28 +339,28 @@ chompOverview names = chompDocs : List (T.CRA_Located T.CDN_Name) -> Parser (List (T.CRA_Located T.CDN_Name)) chompDocs names = P.addLocation - (P.oneOf E.CRED_Name - [ Var.lower E.CRED_Name - , Var.upper E.CRED_Name + (P.oneOf T.CRED_Name + [ Var.lower T.CRED_Name + , Var.upper T.CRED_Name , chompOperator ] ) |> P.bind (\name -> - Space.chomp E.CRED_Space + Space.chomp T.CRED_Space |> P.bind (\_ -> P.oneOfWithFallback [ P.getPosition |> P.bind (\pos -> - Space.checkIndent pos E.CRED_Comma + Space.checkIndent pos T.CRED_Comma |> P.bind (\_ -> - P.word1 ',' E.CRED_Comma + P.word1 ',' T.CRED_Comma |> P.bind (\_ -> - Space.chomp E.CRED_Space + Space.chomp T.CRED_Space |> P.bind (\_ -> chompDocs (name :: names) @@ -407,13 +376,13 @@ chompDocs names = chompOperator : Parser T.CDN_Name chompOperator = - P.word1 '(' E.CRED_Op + P.word1 '(' T.CRED_Op |> P.bind (\_ -> - Symbol.operator E.CRED_Op E.CRED_OpBad + Symbol.operator T.CRED_Op T.CRED_OpBad |> P.bind (\op -> - P.word1 ')' E.CRED_Op + P.word1 ')' T.CRED_Op |> P.fmap (\_ -> op) ) ) @@ -484,22 +453,22 @@ untilDocs src pos end row col = -- CHECK NAMES -checkNames : Dict String T.CDN_Name (T.CRA_Located Can.Export) -> List (T.CRA_Located T.CDN_Name) -> Result E.CRED_Error () +checkNames : Dict String T.CDN_Name (T.CRA_Located Can.Export) -> List (T.CRA_Located T.CDN_Name) -> Result T.CRED_Error () checkNames exports names = let docs : DocNameRegions docs = List.foldl addName Dict.empty names - loneExport : T.CDN_Name -> T.CRA_Located Can.Export -> Result.RResult i w E.CRED_NameProblem T.CRA_Region -> Result.RResult i w E.CRED_NameProblem T.CRA_Region + loneExport : T.CDN_Name -> T.CRA_Located Can.Export -> Result.RResult i w T.CRED_NameProblem T.CRA_Region -> Result.RResult i w T.CRED_NameProblem T.CRA_Region loneExport name export_ _ = onlyInExports name export_ - checkBoth : T.CDN_Name -> T.CRA_Located Can.Export -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w E.CRED_NameProblem T.CRA_Region -> Result.RResult i w E.CRED_NameProblem T.CRA_Region + checkBoth : T.CDN_Name -> T.CRA_Located Can.Export -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w T.CRED_NameProblem T.CRA_Region -> Result.RResult i w T.CRED_NameProblem T.CRA_Region checkBoth n _ r _ = isUnique n r - loneDoc : T.CDN_Name -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w E.CRED_NameProblem T.CRA_Region -> Result.RResult i w E.CRED_NameProblem T.CRA_Region + loneDoc : T.CDN_Name -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w T.CRED_NameProblem T.CRA_Region -> Result.RResult i w T.CRED_NameProblem T.CRA_Region loneDoc name regions _ = onlyInDocs name regions in @@ -508,7 +477,7 @@ checkNames exports names = Ok () ( _, Err es ) -> - Err (E.CRED_NameProblems (OneOrMore.destruct NE.Nonempty es)) + Err (T.CRED_NameProblems (OneOrMore.destruct NE.Nonempty es)) type alias DocNameRegions = @@ -520,7 +489,7 @@ addName (T.CRA_At region name) dict = Utils.mapInsertWith identity OneOrMore.more name (OneOrMore.one region) dict -isUnique : T.CDN_Name -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w E.CRED_NameProblem T.CRA_Region +isUnique : T.CDN_Name -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w T.CRED_NameProblem T.CRA_Region isUnique name regions = case regions of OneOrMore.One region -> @@ -531,28 +500,28 @@ isUnique name regions = ( r1, r2 ) = OneOrMore.getFirstTwo left right in - Result.throw (E.CRED_NameDuplicate name r1 r2) + Result.throw (T.CRED_NameDuplicate name r1 r2) -onlyInDocs : T.CDN_Name -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w E.CRED_NameProblem a +onlyInDocs : T.CDN_Name -> OneOrMore.OneOrMore T.CRA_Region -> Result.RResult i w T.CRED_NameProblem a onlyInDocs name regions = isUnique name regions |> Result.bind (\region -> - Result.throw (E.CRED_NameOnlyInDocs name region) + Result.throw (T.CRED_NameOnlyInDocs name region) ) -onlyInExports : T.CDN_Name -> T.CRA_Located Can.Export -> Result.RResult i w E.CRED_NameProblem a +onlyInExports : T.CDN_Name -> T.CRA_Located Can.Export -> Result.RResult i w T.CRED_NameProblem a onlyInExports name (T.CRA_At region _) = - Result.throw (E.CRED_NameOnlyInExports name region) + Result.throw (T.CRED_NameOnlyInExports name region) -- CHECK DEFS -checkDefs : Dict String T.CDN_Name (T.CRA_Located Can.Export) -> T.CASTS_Comment -> Dict String T.CDN_Name T.CASTS_Comment -> Can.Module -> Result E.CRED_Error CED_Module +checkDefs : Dict String T.CDN_Name (T.CRA_Located Can.Export) -> T.CASTS_Comment -> Dict String T.CDN_Name T.CASTS_Comment -> Can.Module -> Result T.CRED_Error T.CED_Module checkDefs exportDict overview comments (Can.Module name _ _ decls unions aliases infixes effects) = let types : Types @@ -565,22 +534,22 @@ checkDefs exportDict overview comments (Can.Module name _ _ decls unions aliases in case Result.run (Result.mapTraverseWithKey identity compare (checkExport info) exportDict) of ( _, Err problems ) -> - Err (E.CRED_DefProblems (OneOrMore.destruct NE.Nonempty problems)) + Err (T.CRED_DefProblems (OneOrMore.destruct NE.Nonempty problems)) ( _, Ok inserters ) -> Ok (Dict.foldr compare (\_ -> (<|)) (emptyModule name overview) inserters) -emptyModule : T.CEMN_Canonical -> T.CASTS_Comment -> CED_Module +emptyModule : T.CEMN_Canonical -> T.CASTS_Comment -> T.CED_Module emptyModule (T.CEMN_Canonical _ name) (T.CASTS_Comment overview) = - CED_Module name (Json.fromComment overview) Dict.empty Dict.empty Dict.empty Dict.empty + T.CED_Module name (Json.fromComment overview) Dict.empty Dict.empty Dict.empty Dict.empty type Info = Info (Dict String T.CDN_Name T.CASTS_Comment) (Dict String T.CDN_Name (Result T.CRA_Region T.CASTC_Type)) (Dict String T.CDN_Name T.CASTC_Union) (Dict String T.CDN_Name T.CASTC_Alias) (Dict String T.CDN_Name Can.Binop) Can.Effects -checkExport : Info -> T.CDN_Name -> T.CRA_Located Can.Export -> Result.RResult i w E.CRED_DefProblem (CED_Module -> CED_Module) +checkExport : Info -> T.CDN_Name -> T.CRA_Located Can.Export -> Result.RResult i w T.CRED_DefProblem (T.CED_Module -> T.CED_Module) checkExport ((Info _ _ iUnions iAliases iBinops _) as info) name (T.CRA_At region export) = case export of Can.ExportValue -> @@ -591,13 +560,13 @@ checkExport ((Info _ _ iUnions iAliases iBinops _) as info) name (T.CRA_At regio |> Result.bind (\comment -> Result.ok - (\(CED_Module mName mComment mUnions mAliases mValues mBinops) -> - CED_Module + (\(T.CED_Module mName mComment mUnions mAliases mValues mBinops) -> + T.CED_Module mName mComment mUnions mAliases - (Dict.insert identity name (CED_Value comment tipe) mValues) + (Dict.insert identity name (T.CED_Value comment tipe) mValues) mBinops ) ) @@ -615,14 +584,14 @@ checkExport ((Info _ _ iUnions iAliases iBinops _) as info) name (T.CRA_At regio |> Result.bind (\comment -> Result.ok - (\(CED_Module mName mComment mUnions mAliases mValues mBinops) -> - CED_Module + (\(T.CED_Module mName mComment mUnions mAliases mValues mBinops) -> + T.CED_Module mName mComment mUnions mAliases mValues - (Dict.insert identity name (CED_Binop comment tipe assoc prec) mBinops) + (Dict.insert identity name (T.CED_Binop comment tipe assoc prec) mBinops) ) ) ) @@ -636,11 +605,11 @@ checkExport ((Info _ _ iUnions iAliases iBinops _) as info) name (T.CRA_At regio |> Result.bind (\comment -> Result.ok - (\(CED_Module mName mComment mUnions mAliases mValues mBinops) -> - CED_Module mName + (\(T.CED_Module mName mComment mUnions mAliases mValues mBinops) -> + T.CED_Module mName mComment mUnions - (Dict.insert identity name (CED_Alias comment tvars (Extract.fromType tipe)) mAliases) + (Dict.insert identity name (T.CED_Alias comment tvars (Extract.fromType tipe)) mAliases) mValues mBinops ) @@ -655,10 +624,10 @@ checkExport ((Info _ _ iUnions iAliases iBinops _) as info) name (T.CRA_At regio |> Result.bind (\comment -> Result.ok - (\(CED_Module mName mComment mUnions mAliases mValues mBinops) -> - CED_Module mName + (\(T.CED_Module mName mComment mUnions mAliases mValues mBinops) -> + T.CED_Module mName mComment - (Dict.insert identity name (CED_Union comment tvars (List.map dector ctors)) mUnions) + (Dict.insert identity name (T.CED_Union comment tvars (List.map dector ctors)) mUnions) mAliases mValues mBinops @@ -674,10 +643,10 @@ checkExport ((Info _ _ iUnions iAliases iBinops _) as info) name (T.CRA_At regio |> Result.bind (\comment -> Result.ok - (\(CED_Module mName mComment mUnions mAliases mValues mBinops) -> - CED_Module mName + (\(T.CED_Module mName mComment mUnions mAliases mValues mBinops) -> + T.CED_Module mName mComment - (Dict.insert identity name (CED_Union comment tvars []) mUnions) + (Dict.insert identity name (T.CED_Union comment tvars []) mUnions) mAliases mValues mBinops @@ -692,39 +661,39 @@ checkExport ((Info _ _ iUnions iAliases iBinops _) as info) name (T.CRA_At regio |> Result.bind (\comment -> Result.ok - (\(CED_Module mName mComment mUnions mAliases mValues mBinops) -> - CED_Module mName + (\(T.CED_Module mName mComment mUnions mAliases mValues mBinops) -> + T.CED_Module mName mComment mUnions mAliases - (Dict.insert identity name (CED_Value comment tipe) mValues) + (Dict.insert identity name (T.CED_Value comment tipe) mValues) mBinops ) ) ) -getComment : T.CRA_Region -> T.CDN_Name -> Info -> Result.RResult i w E.CRED_DefProblem CED_Comment +getComment : T.CRA_Region -> T.CDN_Name -> Info -> Result.RResult i w T.CRED_DefProblem T.CED_Comment getComment region name (Info iComments _ _ _ _ _) = case Dict.get identity name iComments of Nothing -> - Result.throw (E.CRED_NoComment name region) + Result.throw (T.CRED_NoComment name region) Just (T.CASTS_Comment snippet) -> Result.ok (Json.fromComment snippet) -getType : T.CDN_Name -> Info -> Result.RResult i w E.CRED_DefProblem Type.CECT_Type +getType : T.CDN_Name -> Info -> Result.RResult i w T.CRED_DefProblem T.CECT_Type getType name (Info _ iValues _ _ _ _) = case Utils.find identity name iValues of Err region -> - Result.throw (E.CRED_NoAnnotation name region) + Result.throw (T.CRED_NoAnnotation name region) Ok tipe -> Result.ok (Extract.fromType tipe) -dector : T.CASTC_Ctor -> ( T.CDN_Name, List Type.CECT_Type ) +dector : T.CASTC_Ctor -> ( T.CDN_Name, List T.CECT_Type ) dector (T.CASTC_Ctor name _ _ args) = ( name, List.map Extract.fromType args ) @@ -737,26 +706,26 @@ type alias Types = Dict String T.CDN_Name (Result T.CRA_Region T.CASTC_Type) -gatherTypes : Can.Decls -> Types -> Types +gatherTypes : T.CASTC_Decls -> Types -> Types gatherTypes decls types = case decls of - Can.Declare def subDecls -> + T.CASTC_Declare def subDecls -> gatherTypes subDecls (addDef types def) - Can.DeclareRec def defs subDecls -> + T.CASTC_DeclareRec def defs subDecls -> gatherTypes subDecls (List.foldl (flip addDef) (addDef types def) defs) - Can.SaveTheEnvironment -> + T.CASTC_SaveTheEnvironment -> types -addDef : Types -> Can.Def -> Types +addDef : Types -> T.CASTC_Def -> Types addDef types def = case def of - Can.Def (T.CRA_At region name) _ _ -> + T.CASTC_Def (T.CRA_At region name) _ _ -> Dict.insert identity name (Err region) types - Can.TypedDef (T.CRA_At _ name) _ typedArgs _ resultType -> + T.CASTC_TypedDef (T.CRA_At _ name) _ typedArgs _ resultType -> let tipe : T.CASTC_Type tipe = @@ -779,8 +748,8 @@ jsonDecoder = Decode.map toDict (Decode.list jsonModuleDecoder) -jsonModuleEncoder : CED_Module -> Encode.Value -jsonModuleEncoder (CED_Module name comment unions aliases values binops) = +jsonModuleEncoder : T.CED_Module -> Encode.Value +jsonModuleEncoder (T.CED_Module name comment unions aliases values binops) = Encode.object [ ( "name", Encode.string name ) , ( "comment", Encode.string comment ) @@ -791,9 +760,9 @@ jsonModuleEncoder (CED_Module name comment unions aliases values binops) = ] -jsonModuleDecoder : Decode.Decoder CED_Module +jsonModuleDecoder : Decode.Decoder T.CED_Module jsonModuleDecoder = - Decode.map6 CED_Module + Decode.map6 T.CED_Module (Decode.field "name" Decode.string) (Decode.field "comment" Decode.string) (Decode.field "unions" (D.assocListDict identity Decode.string jsonUnionDecoder)) @@ -802,8 +771,8 @@ jsonModuleDecoder = (Decode.field "binops" (D.assocListDict identity Decode.string jsonBinopDecoder)) -jsonUnionEncoder : CED_Union -> Encode.Value -jsonUnionEncoder (CED_Union comment args cases) = +jsonUnionEncoder : T.CED_Union -> Encode.Value +jsonUnionEncoder (T.CED_Union comment args cases) = Encode.object [ ( "comment", Encode.string comment ) , ( "args", Encode.list Encode.string args ) @@ -811,16 +780,16 @@ jsonUnionEncoder (CED_Union comment args cases) = ] -jsonUnionDecoder : Decode.Decoder CED_Union +jsonUnionDecoder : Decode.Decoder T.CED_Union jsonUnionDecoder = - Decode.map3 CED_Union + Decode.map3 T.CED_Union (Decode.field "comment" Decode.string) (Decode.field "args" (Decode.list Decode.string)) (Decode.field "cases" (Decode.list (D.jsonPair Decode.string (Decode.list Type.jsonDecoder)))) -jsonAliasEncoder : CED_Alias -> Encode.Value -jsonAliasEncoder (CED_Alias comment args type_) = +jsonAliasEncoder : T.CED_Alias -> Encode.Value +jsonAliasEncoder (T.CED_Alias comment args type_) = Encode.object [ ( "comment", Encode.string comment ) , ( "args", Encode.list Encode.string args ) @@ -828,31 +797,31 @@ jsonAliasEncoder (CED_Alias comment args type_) = ] -jsonAliasDecoder : Decode.Decoder CED_Alias +jsonAliasDecoder : Decode.Decoder T.CED_Alias jsonAliasDecoder = - Decode.map3 CED_Alias + Decode.map3 T.CED_Alias (Decode.field "comment" Decode.string) (Decode.field "args" (Decode.list Decode.string)) (Decode.field "type" Type.jsonDecoder) -jsonValueEncoder : CED_Value -> Encode.Value -jsonValueEncoder (CED_Value comment type_) = +jsonValueEncoder : T.CED_Value -> Encode.Value +jsonValueEncoder (T.CED_Value comment type_) = Encode.object [ ( "comment", Encode.string comment ) , ( "type", Type.jsonEncoder type_ ) ] -jsonValueDecoder : Decode.Decoder CED_Value +jsonValueDecoder : Decode.Decoder T.CED_Value jsonValueDecoder = - Decode.map2 CED_Value + Decode.map2 T.CED_Value (Decode.field "comment" Decode.string) (Decode.field "type" Type.jsonDecoder) -jsonBinopEncoder : CED_Binop -> Encode.Value -jsonBinopEncoder (CED_Binop comment type_ associativity precedence) = +jsonBinopEncoder : T.CED_Binop -> Encode.Value +jsonBinopEncoder (T.CED_Binop comment type_ associativity precedence) = Encode.object [ ( "comment", Encode.string comment ) , ( "type", Type.jsonEncoder type_ ) @@ -861,9 +830,9 @@ jsonBinopEncoder (CED_Binop comment type_ associativity precedence) = ] -jsonBinopDecoder : Decode.Decoder CED_Binop +jsonBinopDecoder : Decode.Decoder T.CED_Binop jsonBinopDecoder = - Decode.map4 CED_Binop + Decode.map4 T.CED_Binop (Decode.field "comment" Decode.string) (Decode.field "type" Type.jsonDecoder) (Decode.field "associativity" Binop.associativityDecoder) diff --git a/src/Compiler/Generate/JavaScript.elm b/src/Compiler/Generate/JavaScript.elm index 2b0963033..69c42fe8d 100644 --- a/src/Compiler/Generate/JavaScript.elm +++ b/src/Compiler/Generate/JavaScript.elm @@ -17,7 +17,6 @@ import Compiler.Generate.JavaScript.Name as JsName import Compiler.Generate.Mode as Mode import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Type as RT -import Compiler.Reporting.Render.Type.Localizer as L import Data.Map as Dict exposing (Dict) import Data.Set as EverySet exposing (EverySet) import Json.Encode as Encode @@ -76,7 +75,7 @@ perfNote mode = ++ " for better performance and smaller assets.');" -generateForRepl : Bool -> L.CRRTL_Localizer -> T.CASTO_GlobalGraph -> T.CEMN_Canonical -> T.CDN_Name -> T.CASTC_Annotation -> String +generateForRepl : Bool -> T.CRRTL_Localizer -> T.CASTO_GlobalGraph -> T.CEMN_Canonical -> T.CDN_Name -> T.CASTC_Annotation -> String generateForRepl ansi localizer (T.CASTO_GlobalGraph graph _) home name (T.CASTC_Forall _ tipe) = let mode : Mode.Mode @@ -97,7 +96,7 @@ generateForRepl ansi localizer (T.CASTO_GlobalGraph graph _) home name (T.CASTC_ ++ print ansi localizer home name tipe -print : Bool -> L.CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> T.CASTC_Type -> String +print : Bool -> T.CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> T.CASTC_Type -> String print ansi localizer home name tipe = let value : JsName.Name @@ -137,7 +136,7 @@ print ansi localizer home name tipe = -- GENERATE FOR REPL ENDPOINT -generateForReplEndpoint : L.CRRTL_Localizer -> T.CASTO_GlobalGraph -> T.CEMN_Canonical -> Maybe T.CDN_Name -> T.CASTC_Annotation -> String +generateForReplEndpoint : T.CRRTL_Localizer -> T.CASTO_GlobalGraph -> T.CEMN_Canonical -> Maybe T.CDN_Name -> T.CASTC_Annotation -> String generateForReplEndpoint localizer (T.CASTO_GlobalGraph graph _) home maybeName (T.CASTC_Forall _ tipe) = let name : T.CDN_Name @@ -161,7 +160,7 @@ generateForReplEndpoint localizer (T.CASTO_GlobalGraph graph _) home maybeName ( ++ postMessage localizer home maybeName tipe -postMessage : L.CRRTL_Localizer -> T.CEMN_Canonical -> Maybe T.CDN_Name -> T.CASTC_Type -> String +postMessage : T.CRRTL_Localizer -> T.CEMN_Canonical -> Maybe T.CDN_Name -> T.CASTC_Type -> String postMessage localizer home maybeName tipe = let name : T.CDN_Name diff --git a/src/Compiler/Nitpick/PatternMatches.elm b/src/Compiler/Nitpick/PatternMatches.elm index 093eabec3..ae61cdc42 100644 --- a/src/Compiler/Nitpick/PatternMatches.elm +++ b/src/Compiler/Nitpick/PatternMatches.elm @@ -1,9 +1,5 @@ module Compiler.Nitpick.PatternMatches exposing - ( CNPM_Context(..) - , CNPM_Error(..) - , CNPM_Literal(..) - , CNPM_Pattern(..) - , check + ( check , errorDecoder , errorEncoder ) @@ -32,70 +28,54 @@ import Utils.Main as Utils --- PATTERN - - -type CNPM_Pattern - = CNPM_Anything - | CNPM_Literal CNPM_Literal - | CNPM_Ctor T.CASTC_Union T.CDN_Name (List CNPM_Pattern) - - -type CNPM_Literal - = CNPM_Chr String - | CNPM_Str String - | CNPM_Int Int - - - -- CREATE SIMPLIFIED PATTERNS -simplify : Can.Pattern -> CNPM_Pattern +simplify : T.CASTC_Pattern -> T.CNPM_Pattern simplify (T.CRA_At _ pattern) = case pattern of - Can.PAnything -> - CNPM_Anything + T.CASTC_PAnything -> + T.CNPM_Anything - Can.PVar _ -> - CNPM_Anything + T.CASTC_PVar _ -> + T.CNPM_Anything - Can.PRecord _ -> - CNPM_Anything + T.CASTC_PRecord _ -> + T.CNPM_Anything - Can.PUnit -> - CNPM_Ctor unit unitName [] + T.CASTC_PUnit -> + T.CNPM_Ctor unit unitName [] - Can.PTuple a b Nothing -> - CNPM_Ctor pair pairName [ simplify a, simplify b ] + T.CASTC_PTuple a b Nothing -> + T.CNPM_Ctor pair pairName [ simplify a, simplify b ] - Can.PTuple a b (Just c) -> - CNPM_Ctor triple tripleName [ simplify a, simplify b, simplify c ] + T.CASTC_PTuple a b (Just c) -> + T.CNPM_Ctor triple tripleName [ simplify a, simplify b, simplify c ] - Can.PCtor { union, name, args } -> - CNPM_Ctor union name <| - List.map (\(Can.PatternCtorArg _ _ arg) -> simplify arg) args + T.CASTC_PCtor { union, name, args } -> + T.CNPM_Ctor union name <| + List.map (\(T.CASTC_PatternCtorArg _ _ arg) -> simplify arg) args - Can.PList entries -> + T.CASTC_PList entries -> List.foldr cons nil entries - Can.PCons hd tl -> + T.CASTC_PCons hd tl -> cons hd (simplify tl) - Can.PAlias subPattern _ -> + T.CASTC_PAlias subPattern _ -> simplify subPattern - Can.PInt int -> - CNPM_Literal (CNPM_Int int) + T.CASTC_PInt int -> + T.CNPM_Literal (T.CNPM_Int int) - Can.PStr str -> - CNPM_Literal (CNPM_Str str) + T.CASTC_PStr str -> + T.CNPM_Literal (T.CNPM_Str str) - Can.PChr chr -> - CNPM_Literal (CNPM_Chr chr) + T.CASTC_PChr chr -> + T.CNPM_Literal (T.CNPM_Chr chr) - Can.PBool union bool -> - CNPM_Ctor union + T.CASTC_PBool union bool -> + T.CNPM_Ctor union (if bool then Name.true @@ -105,14 +85,14 @@ simplify (T.CRA_At _ pattern) = [] -cons : Can.Pattern -> CNPM_Pattern -> CNPM_Pattern +cons : T.CASTC_Pattern -> T.CNPM_Pattern -> T.CNPM_Pattern cons hd tl = - CNPM_Ctor list consName [ simplify hd, tl ] + T.CNPM_Ctor list consName [ simplify hd, tl ] -nil : CNPM_Pattern +nil : T.CNPM_Pattern nil = - CNPM_Ctor list nilName [] + T.CNPM_Ctor list nilName [] @@ -194,25 +174,10 @@ nilName = --- ERROR - - -type CNPM_Error - = CNPM_Incomplete T.CRA_Region CNPM_Context (List CNPM_Pattern) - | CNPM_Redundant T.CRA_Region T.CRA_Region Int - - -type CNPM_Context - = CNPM_BadArg - | CNPM_BadDestruct - | CNPM_BadCase - - - -- CHECK -check : Can.Module -> Result (NE.Nonempty CNPM_Error) () +check : Can.Module -> Result (NE.Nonempty T.CNPM_Error) () check (Can.Module _ _ _ decls _ _ _ _) = case checkDecls decls [] of [] -> @@ -226,16 +191,16 @@ check (Can.Module _ _ _ decls _ _ _ _) = -- CHECK DECLS -checkDecls : Can.Decls -> List CNPM_Error -> List CNPM_Error +checkDecls : T.CASTC_Decls -> List T.CNPM_Error -> List T.CNPM_Error checkDecls decls errors = case decls of - Can.Declare def subDecls -> + T.CASTC_Declare def subDecls -> checkDef def (checkDecls subDecls errors) - Can.DeclareRec def defs subDecls -> + T.CASTC_DeclareRec def defs subDecls -> checkDef def (List.foldr checkDef (checkDecls subDecls errors) defs) - Can.SaveTheEnvironment -> + T.CASTC_SaveTheEnvironment -> errors @@ -243,114 +208,114 @@ checkDecls decls errors = -- CHECK DEFS -checkDef : Can.Def -> List CNPM_Error -> List CNPM_Error +checkDef : T.CASTC_Def -> List T.CNPM_Error -> List T.CNPM_Error checkDef def errors = case def of - Can.Def _ args body -> + T.CASTC_Def _ args body -> List.foldr checkArg (checkExpr body errors) args - Can.TypedDef _ _ args body _ -> + T.CASTC_TypedDef _ _ args body _ -> List.foldr checkTypedArg (checkExpr body errors) args -checkArg : Can.Pattern -> List CNPM_Error -> List CNPM_Error +checkArg : T.CASTC_Pattern -> List T.CNPM_Error -> List T.CNPM_Error checkArg ((T.CRA_At region _) as pattern) errors = - checkPatterns region CNPM_BadArg [ pattern ] errors + checkPatterns region T.CNPM_BadArg [ pattern ] errors -checkTypedArg : ( Can.Pattern, tipe ) -> List CNPM_Error -> List CNPM_Error +checkTypedArg : ( T.CASTC_Pattern, tipe ) -> List T.CNPM_Error -> List T.CNPM_Error checkTypedArg ( (T.CRA_At region _) as pattern, _ ) errors = - checkPatterns region CNPM_BadArg [ pattern ] errors + checkPatterns region T.CNPM_BadArg [ pattern ] errors -- CHECK EXPRESSIONS -checkExpr : Can.Expr -> List CNPM_Error -> List CNPM_Error +checkExpr : T.CASTC_Expr -> List T.CNPM_Error -> List T.CNPM_Error checkExpr (T.CRA_At region expression) errors = case expression of - Can.VarLocal _ -> + T.CASTC_VarLocal _ -> errors - Can.VarTopLevel _ _ -> + T.CASTC_VarTopLevel _ _ -> errors - Can.VarKernel _ _ -> + T.CASTC_VarKernel _ _ -> errors - Can.VarForeign _ _ _ -> + T.CASTC_VarForeign _ _ _ -> errors - Can.VarCtor _ _ _ _ _ -> + T.CASTC_VarCtor _ _ _ _ _ -> errors - Can.VarDebug _ _ _ -> + T.CASTC_VarDebug _ _ _ -> errors - Can.VarOperator _ _ _ _ -> + T.CASTC_VarOperator _ _ _ _ -> errors - Can.Chr _ -> + T.CASTC_Chr _ -> errors - Can.Str _ -> + T.CASTC_Str _ -> errors - Can.Int _ -> + T.CASTC_Int _ -> errors - Can.Float _ -> + T.CASTC_Float _ -> errors - Can.List entries -> + T.CASTC_List entries -> List.foldr checkExpr errors entries - Can.Negate expr -> + T.CASTC_Negate expr -> checkExpr expr errors - Can.Binop _ _ _ _ left right -> + T.CASTC_Binop _ _ _ _ left right -> checkExpr left (checkExpr right errors) - Can.Lambda args body -> + T.CASTC_Lambda args body -> List.foldr checkArg (checkExpr body errors) args - Can.Call func args -> + T.CASTC_Call func args -> checkExpr func (List.foldr checkExpr errors args) - Can.If branches finally -> + T.CASTC_If branches finally -> List.foldr checkIfBranch (checkExpr finally errors) branches - Can.Let def body -> + T.CASTC_Let def body -> checkDef def (checkExpr body errors) - Can.LetRec defs body -> + T.CASTC_LetRec defs body -> List.foldr checkDef (checkExpr body errors) defs - Can.LetDestruct ((T.CRA_At reg _) as pattern) expr body -> - checkPatterns reg CNPM_BadDestruct [ pattern ] <| + T.CASTC_LetDestruct ((T.CRA_At reg _) as pattern) expr body -> + checkPatterns reg T.CNPM_BadDestruct [ pattern ] <| checkExpr expr (checkExpr body errors) - Can.Case expr branches -> + T.CASTC_Case expr branches -> checkExpr expr (checkCases region branches errors) - Can.Accessor _ -> + T.CASTC_Accessor _ -> errors - Can.Access record _ -> + T.CASTC_Access record _ -> checkExpr record errors - Can.Update _ record fields -> + T.CASTC_Update _ record fields -> checkExpr record <| Dict.foldr compare (\_ -> checkField) errors fields - Can.Record fields -> + T.CASTC_Record fields -> Dict.foldr compare (\_ -> checkExpr) errors fields - Can.Unit -> + T.CASTC_Unit -> errors - Can.Tuple a b maybeC -> + T.CASTC_Tuple a b maybeC -> checkExpr a (checkExpr b (case maybeC of @@ -362,7 +327,7 @@ checkExpr (T.CRA_At region expression) errors = ) ) - Can.Shader _ _ -> + T.CASTC_Shader _ _ -> errors @@ -370,8 +335,8 @@ checkExpr (T.CRA_At region expression) errors = -- CHECK FIELD -checkField : Can.FieldUpdate -> List CNPM_Error -> List CNPM_Error -checkField (Can.FieldUpdate _ expr) errors = +checkField : T.CASTC_FieldUpdate -> List T.CNPM_Error -> List T.CNPM_Error +checkField (T.CASTC_FieldUpdate _ expr) errors = checkExpr expr errors @@ -379,7 +344,7 @@ checkField (Can.FieldUpdate _ expr) errors = -- CHECK IF BRANCH -checkIfBranch : ( Can.Expr, Can.Expr ) -> List CNPM_Error -> List CNPM_Error +checkIfBranch : ( T.CASTC_Expr, T.CASTC_Expr ) -> List T.CNPM_Error -> List T.CNPM_Error checkIfBranch ( condition, branch ) errs = checkExpr condition (checkExpr branch errs) @@ -388,17 +353,17 @@ checkIfBranch ( condition, branch ) errs = -- CHECK CASE EXPRESSION -checkCases : T.CRA_Region -> List Can.CaseBranch -> List CNPM_Error -> List CNPM_Error +checkCases : T.CRA_Region -> List T.CASTC_CaseBranch -> List T.CNPM_Error -> List T.CNPM_Error checkCases region branches errors = let ( patterns, newErrors ) = List.foldr checkCaseBranch ( [], errors ) branches in - checkPatterns region CNPM_BadCase patterns newErrors + checkPatterns region T.CNPM_BadCase patterns newErrors -checkCaseBranch : Can.CaseBranch -> ( List Can.Pattern, List CNPM_Error ) -> ( List Can.Pattern, List CNPM_Error ) -checkCaseBranch (Can.CaseBranch pattern expr) ( patterns, errors ) = +checkCaseBranch : T.CASTC_CaseBranch -> ( List T.CASTC_Pattern, List T.CNPM_Error ) -> ( List T.CASTC_Pattern, List T.CNPM_Error ) +checkCaseBranch (T.CASTC_CaseBranch pattern expr) ( patterns, errors ) = ( pattern :: patterns , checkExpr expr errors ) @@ -408,7 +373,7 @@ checkCaseBranch (Can.CaseBranch pattern expr) ( patterns, errors ) = -- CHECK PATTERNS -checkPatterns : T.CRA_Region -> CNPM_Context -> List Can.Pattern -> List CNPM_Error -> List CNPM_Error +checkPatterns : T.CRA_Region -> T.CNPM_Context -> List T.CASTC_Pattern -> List T.CNPM_Error -> List T.CNPM_Error checkPatterns region context patterns errors = case toNonRedundantRows region patterns of Err err -> @@ -420,7 +385,7 @@ checkPatterns region context patterns errors = errors badPatterns -> - CNPM_Incomplete region context (List.map Prelude.head badPatterns) :: errors + T.CNPM_Incomplete region context (List.map Prelude.head badPatterns) :: errors @@ -433,11 +398,11 @@ checkPatterns region context patterns errors = -- -isExhaustive : List (List CNPM_Pattern) -> Int -> List (List CNPM_Pattern) +isExhaustive : List (List T.CNPM_Pattern) -> Int -> List (List T.CNPM_Pattern) isExhaustive matrix n = case matrix of [] -> - [ List.repeat n CNPM_Anything ] + [ List.repeat n T.CNPM_Anything ] _ -> if n == 0 then @@ -454,7 +419,7 @@ isExhaustive matrix n = Dict.size ctors in if numSeen == 0 then - List.map ((::) CNPM_Anything) + List.map ((::) T.CNPM_Anything) (isExhaustive (List.filterMap specializeRowByAnything matrix) (n - 1)) else @@ -469,7 +434,7 @@ isExhaustive matrix n = else let - isAltExhaustive : T.CASTC_Ctor -> List (List CNPM_Pattern) + isAltExhaustive : T.CASTC_Ctor -> List (List T.CNPM_Pattern) isAltExhaustive (T.CASTC_Ctor name _ arity _) = List.map (recoverCtor alts name arity) (isExhaustive @@ -480,22 +445,22 @@ isExhaustive matrix n = List.concatMap isAltExhaustive altList -isMissing : T.CASTC_Union -> Dict String T.CDN_Name a -> T.CASTC_Ctor -> Maybe CNPM_Pattern +isMissing : T.CASTC_Union -> Dict String T.CDN_Name a -> T.CASTC_Ctor -> Maybe T.CNPM_Pattern isMissing union ctors (T.CASTC_Ctor name _ arity _) = if Dict.member identity name ctors then Nothing else - Just (CNPM_Ctor union name (List.repeat arity CNPM_Anything)) + Just (T.CNPM_Ctor union name (List.repeat arity T.CNPM_Anything)) -recoverCtor : T.CASTC_Union -> T.CDN_Name -> Int -> List CNPM_Pattern -> List CNPM_Pattern +recoverCtor : T.CASTC_Union -> T.CDN_Name -> Int -> List T.CNPM_Pattern -> List T.CNPM_Pattern recoverCtor union name arity patterns = let ( args, rest ) = List.splitAt arity patterns in - CNPM_Ctor union name args :: rest + T.CNPM_Ctor union name args :: rest @@ -504,14 +469,14 @@ recoverCtor union name arity patterns = {-| INVARIANT: Produces a list of rows where (forall row. length row == 1) -} -toNonRedundantRows : T.CRA_Region -> List Can.Pattern -> Result CNPM_Error (List (List CNPM_Pattern)) +toNonRedundantRows : T.CRA_Region -> List T.CASTC_Pattern -> Result T.CNPM_Error (List (List T.CNPM_Pattern)) toNonRedundantRows region patterns = toSimplifiedUsefulRows region [] patterns {-| INVARIANT: Produces a list of rows where (forall row. length row == 1) -} -toSimplifiedUsefulRows : T.CRA_Region -> List (List CNPM_Pattern) -> List Can.Pattern -> Result CNPM_Error (List (List CNPM_Pattern)) +toSimplifiedUsefulRows : T.CRA_Region -> List (List T.CNPM_Pattern) -> List T.CASTC_Pattern -> Result T.CNPM_Error (List (List T.CNPM_Pattern)) toSimplifiedUsefulRows overallRegion checkedRows uncheckedPatterns = case uncheckedPatterns of [] -> @@ -519,7 +484,7 @@ toSimplifiedUsefulRows overallRegion checkedRows uncheckedPatterns = ((T.CRA_At region _) as pattern) :: rest -> let - nextRow : List CNPM_Pattern + nextRow : List T.CNPM_Pattern nextRow = [ simplify pattern ] in @@ -527,14 +492,14 @@ toSimplifiedUsefulRows overallRegion checkedRows uncheckedPatterns = toSimplifiedUsefulRows overallRegion (nextRow :: checkedRows) rest else - Err (CNPM_Redundant overallRegion region (List.length checkedRows + 1)) + Err (T.CNPM_Redundant overallRegion region (List.length checkedRows + 1)) -- Check if a new row "vector" is useful given previous rows "matrix" -isUseful : List (List CNPM_Pattern) -> List CNPM_Pattern -> Bool +isUseful : List (List T.CNPM_Pattern) -> List T.CNPM_Pattern -> Bool isUseful matrix vector = case matrix of [] -> @@ -550,13 +515,13 @@ isUseful matrix vector = firstPattern :: patterns -> case firstPattern of - CNPM_Ctor _ name args -> + T.CNPM_Ctor _ name args -> -- keep checking rows that start with this Ctor or Anything isUseful (List.filterMap (specializeRowByCtor name (List.length args)) matrix) (args ++ patterns) - CNPM_Anything -> + T.CNPM_Anything -> -- check if all alts appear in matrix case isComplete matrix of No -> @@ -574,11 +539,11 @@ isUseful matrix vector = isUsefulAlt (T.CASTC_Ctor name _ arity _) = isUseful (List.filterMap (specializeRowByCtor name arity) matrix) - (List.repeat arity CNPM_Anything ++ patterns) + (List.repeat arity T.CNPM_Anything ++ patterns) in List.any isUsefulAlt alts - CNPM_Literal literal -> + T.CNPM_Literal literal -> -- keep checking rows that start with this Literal or Anything isUseful (List.filterMap (specializeRowByLiteral literal) matrix) @@ -589,20 +554,20 @@ isUseful matrix vector = -- INVARIANT: (length row == N) ==> (length result == arity + N - 1) -specializeRowByCtor : T.CDN_Name -> Int -> List CNPM_Pattern -> Maybe (List CNPM_Pattern) +specializeRowByCtor : T.CDN_Name -> Int -> List T.CNPM_Pattern -> Maybe (List T.CNPM_Pattern) specializeRowByCtor ctorName arity row = case row of - (CNPM_Ctor _ name args) :: patterns -> + (T.CNPM_Ctor _ name args) :: patterns -> if name == ctorName then Just (args ++ patterns) else Nothing - CNPM_Anything :: patterns -> - Just (List.repeat arity CNPM_Anything ++ patterns) + T.CNPM_Anything :: patterns -> + Just (List.repeat arity T.CNPM_Anything ++ patterns) - (CNPM_Literal _) :: _ -> + (T.CNPM_Literal _) :: _ -> crash <| "Compiler bug! After type checking, constructors and literals should never align in pattern match exhaustiveness checks." @@ -614,20 +579,20 @@ specializeRowByCtor ctorName arity row = -- INVARIANT: (length row == N) ==> (length result == N-1) -specializeRowByLiteral : CNPM_Literal -> List CNPM_Pattern -> Maybe (List CNPM_Pattern) +specializeRowByLiteral : T.CNPM_Literal -> List T.CNPM_Pattern -> Maybe (List T.CNPM_Pattern) specializeRowByLiteral literal row = case row of - (CNPM_Literal lit) :: patterns -> + (T.CNPM_Literal lit) :: patterns -> if lit == literal then Just patterns else Nothing - CNPM_Anything :: patterns -> + T.CNPM_Anything :: patterns -> Just patterns - (CNPM_Ctor _ _ _) :: _ -> + (T.CNPM_Ctor _ _ _) :: _ -> crash <| "Compiler bug! After type checking, constructors and literals should never align in pattern match exhaustiveness checks." @@ -639,19 +604,19 @@ specializeRowByLiteral literal row = -- INVARIANT: (length row == N) ==> (length result == N-1) -specializeRowByAnything : List CNPM_Pattern -> Maybe (List CNPM_Pattern) +specializeRowByAnything : List T.CNPM_Pattern -> Maybe (List T.CNPM_Pattern) specializeRowByAnything row = case row of [] -> Nothing - (CNPM_Ctor _ _ _) :: _ -> + (T.CNPM_Ctor _ _ _) :: _ -> Nothing - CNPM_Anything :: patterns -> + T.CNPM_Anything :: patterns -> Just patterns - (CNPM_Literal _) :: _ -> + (T.CNPM_Literal _) :: _ -> Nothing @@ -664,7 +629,7 @@ type Complete | No -isComplete : List (List CNPM_Pattern) -> Complete +isComplete : List (List T.CNPM_Pattern) -> Complete isComplete matrix = let ctors : Dict String T.CDN_Name T.CASTC_Union @@ -694,15 +659,15 @@ isComplete matrix = -- COLLECT CTORS -collectCtors : List (List CNPM_Pattern) -> Dict String T.CDN_Name T.CASTC_Union +collectCtors : List (List T.CNPM_Pattern) -> Dict String T.CDN_Name T.CASTC_Union collectCtors matrix = List.foldl (\row acc -> collectCtorsHelp acc row) Dict.empty matrix -collectCtorsHelp : Dict String T.CDN_Name T.CASTC_Union -> List CNPM_Pattern -> Dict String T.CDN_Name T.CASTC_Union +collectCtorsHelp : Dict String T.CDN_Name T.CASTC_Union -> List T.CNPM_Pattern -> Dict String T.CDN_Name T.CASTC_Union collectCtorsHelp ctors row = case row of - (CNPM_Ctor union name _) :: _ -> + (T.CNPM_Ctor union name _) :: _ -> Dict.insert identity name union ctors _ -> @@ -713,10 +678,10 @@ collectCtorsHelp ctors row = -- ENCODERS and DECODERS -errorEncoder : CNPM_Error -> Encode.Value +errorEncoder : T.CNPM_Error -> Encode.Value errorEncoder error = case error of - CNPM_Incomplete region context unhandled -> + T.CNPM_Incomplete region context unhandled -> Encode.object [ ( "type", Encode.string "Incomplete" ) , ( "region", A.regionEncoder region ) @@ -724,7 +689,7 @@ errorEncoder error = , ( "unhandled", Encode.list patternEncoder unhandled ) ] - CNPM_Redundant caseRegion patternRegion index -> + T.CNPM_Redundant caseRegion patternRegion index -> Encode.object [ ( "type", Encode.string "Redundant" ) , ( "caseRegion", A.regionEncoder caseRegion ) @@ -733,20 +698,20 @@ errorEncoder error = ] -errorDecoder : Decode.Decoder CNPM_Error +errorDecoder : Decode.Decoder T.CNPM_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Incomplete" -> - Decode.map3 CNPM_Incomplete + Decode.map3 T.CNPM_Incomplete (Decode.field "region" A.regionDecoder) (Decode.field "context" contextDecoder) (Decode.field "unhandled" (Decode.list patternDecoder)) "Redundant" -> - Decode.map3 CNPM_Redundant + Decode.map3 T.CNPM_Redundant (Decode.field "caseRegion" A.regionDecoder) (Decode.field "patternRegion" A.regionDecoder) (Decode.field "index" Decode.int) @@ -756,54 +721,54 @@ errorDecoder = ) -contextEncoder : CNPM_Context -> Encode.Value +contextEncoder : T.CNPM_Context -> Encode.Value contextEncoder context = case context of - CNPM_BadArg -> + T.CNPM_BadArg -> Encode.string "BadArg" - CNPM_BadDestruct -> + T.CNPM_BadDestruct -> Encode.string "BadDestruct" - CNPM_BadCase -> + T.CNPM_BadCase -> Encode.string "BadCase" -contextDecoder : Decode.Decoder CNPM_Context +contextDecoder : Decode.Decoder T.CNPM_Context contextDecoder = Decode.string |> Decode.andThen (\str -> case str of "BadArg" -> - Decode.succeed CNPM_BadArg + Decode.succeed T.CNPM_BadArg "BadDestruct" -> - Decode.succeed CNPM_BadDestruct + Decode.succeed T.CNPM_BadDestruct "BadCase" -> - Decode.succeed CNPM_BadCase + Decode.succeed T.CNPM_BadCase _ -> Decode.fail ("Unknown Context: " ++ str) ) -patternEncoder : CNPM_Pattern -> Encode.Value +patternEncoder : T.CNPM_Pattern -> Encode.Value patternEncoder pattern = case pattern of - CNPM_Anything -> + T.CNPM_Anything -> Encode.object [ ( "type", Encode.string "Anything" ) ] - CNPM_Literal index -> + T.CNPM_Literal index -> Encode.object [ ( "type", Encode.string "Literal" ) , ( "index", literalEncoder index ) ] - CNPM_Ctor union name args -> + T.CNPM_Ctor union name args -> Encode.object [ ( "type", Encode.string "Ctor" ) , ( "union", Can.unionEncoder union ) @@ -812,20 +777,20 @@ patternEncoder pattern = ] -patternDecoder : Decode.Decoder CNPM_Pattern +patternDecoder : Decode.Decoder T.CNPM_Pattern patternDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Anything" -> - Decode.succeed CNPM_Anything + Decode.succeed T.CNPM_Anything "Literal" -> - Decode.map CNPM_Literal (Decode.field "index" literalDecoder) + Decode.map T.CNPM_Literal (Decode.field "index" literalDecoder) "Ctor" -> - Decode.map3 CNPM_Ctor + Decode.map3 T.CNPM_Ctor (Decode.field "union" Can.unionDecoder) (Decode.field "name" Decode.string) (Decode.field "args" (Decode.list patternDecoder)) @@ -835,42 +800,42 @@ patternDecoder = ) -literalEncoder : CNPM_Literal -> Encode.Value +literalEncoder : T.CNPM_Literal -> Encode.Value literalEncoder literal = case literal of - CNPM_Chr value -> + T.CNPM_Chr value -> Encode.object [ ( "type", Encode.string "Chr" ) , ( "value", Encode.string value ) ] - CNPM_Str value -> + T.CNPM_Str value -> Encode.object [ ( "type", Encode.string "Str" ) , ( "value", Encode.string value ) ] - CNPM_Int value -> + T.CNPM_Int value -> Encode.object [ ( "type", Encode.string "Int" ) , ( "value", Encode.int value ) ] -literalDecoder : Decode.Decoder CNPM_Literal +literalDecoder : Decode.Decoder T.CNPM_Literal literalDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Chr" -> - Decode.map CNPM_Chr (Decode.field "value" Decode.string) + Decode.map T.CNPM_Chr (Decode.field "value" Decode.string) "Str" -> - Decode.map CNPM_Str (Decode.field "value" Decode.string) + Decode.map T.CNPM_Str (Decode.field "value" Decode.string) "Int" -> - Decode.map CNPM_Int (Decode.field "value" Decode.int) + Decode.map T.CNPM_Int (Decode.field "value" Decode.int) _ -> Decode.fail ("Unknown Literal's type: " ++ type_) diff --git a/src/Compiler/Optimize/Case.elm b/src/Compiler/Optimize/Case.elm index b3059e0c0..d06e1e3d6 100644 --- a/src/Compiler/Optimize/Case.elm +++ b/src/Compiler/Optimize/Case.elm @@ -1,6 +1,5 @@ module Compiler.Optimize.Case exposing (optimize) -import Compiler.AST.Canonical as Can import Compiler.Optimize.DecisionTree as DT import Data.Map as Dict exposing (Dict) import Prelude @@ -13,7 +12,7 @@ import Utils.Main as Utils -- OPTIMIZE A CASE EXPRESSION -optimize : T.CDN_Name -> T.CDN_Name -> List ( Can.Pattern, T.CASTO_Expr ) -> T.CASTO_Expr +optimize : T.CDN_Name -> T.CDN_Name -> List ( T.CASTC_Pattern, T.CASTO_Expr ) -> T.CASTO_Expr optimize temp root optBranches = let ( patterns, indexedBranches ) = diff --git a/src/Compiler/Optimize/DecisionTree.elm b/src/Compiler/Optimize/DecisionTree.elm index ace0089b7..f4e74fd12 100644 --- a/src/Compiler/Optimize/DecisionTree.elm +++ b/src/Compiler/Optimize/DecisionTree.elm @@ -44,10 +44,10 @@ make that work nicely. When is JS getting goto?! ;) That is outside the scope of this module though. -} -compile : List ( Can.Pattern, Int ) -> DecisionTree +compile : List ( T.CASTC_Pattern, Int ) -> DecisionTree compile rawBranches = let - format : ( Can.Pattern, Int ) -> Branch + format : ( T.CASTC_Pattern, Int ) -> Branch format ( pattern, index ) = Branch index [ ( T.CODT_Empty, pattern ) ] in @@ -68,7 +68,7 @@ type DecisionTree type Branch - = Branch Int (List ( T.CODT_Path, Can.Pattern )) + = Branch Int (List ( T.CODT_Path, T.CASTC_Pattern )) toDecisionTree : List Branch -> DecisionTree @@ -149,16 +149,16 @@ flattenPatterns (Branch goal pathPatterns) = Branch goal (List.foldr flatten [] pathPatterns) -flatten : ( T.CODT_Path, Can.Pattern ) -> List ( T.CODT_Path, Can.Pattern ) -> List ( T.CODT_Path, Can.Pattern ) +flatten : ( T.CODT_Path, T.CASTC_Pattern ) -> List ( T.CODT_Path, T.CASTC_Pattern ) -> List ( T.CODT_Path, T.CASTC_Pattern ) flatten (( path, T.CRA_At region pattern ) as pathPattern) otherPathPatterns = case pattern of - Can.PVar _ -> + T.CASTC_PVar _ -> pathPattern :: otherPathPatterns - Can.PAnything -> + T.CASTC_PAnything -> pathPattern :: otherPathPatterns - Can.PCtor { union, args } -> + T.CASTC_PCtor { union, args } -> let (T.CASTC_Union _ _ numAlts _) = union @@ -174,7 +174,7 @@ flatten (( path, T.CRA_At region pattern ) as pathPattern) otherPathPatterns = else pathPattern :: otherPathPatterns - Can.PTuple a b maybeC -> + T.CASTC_PTuple a b maybeC -> flatten ( T.CODT_Index Index.first path, a ) <| flatten ( T.CODT_Index Index.second path, b ) <| case maybeC of @@ -184,43 +184,43 @@ flatten (( path, T.CRA_At region pattern ) as pathPattern) otherPathPatterns = Just c -> flatten ( T.CODT_Index Index.third path, c ) otherPathPatterns - Can.PUnit -> + T.CASTC_PUnit -> otherPathPatterns - Can.PAlias realPattern alias -> + T.CASTC_PAlias realPattern alias -> flatten ( path, realPattern ) <| - ( path, T.CRA_At region (Can.PVar alias) ) + ( path, T.CRA_At region (T.CASTC_PVar alias) ) :: otherPathPatterns - Can.PRecord _ -> + T.CASTC_PRecord _ -> pathPattern :: otherPathPatterns - Can.PList _ -> + T.CASTC_PList _ -> pathPattern :: otherPathPatterns - Can.PCons _ _ -> + T.CASTC_PCons _ _ -> pathPattern :: otherPathPatterns - Can.PChr _ -> + T.CASTC_PChr _ -> pathPattern :: otherPathPatterns - Can.PStr _ -> + T.CASTC_PStr _ -> pathPattern :: otherPathPatterns - Can.PInt _ -> + T.CASTC_PInt _ -> pathPattern :: otherPathPatterns - Can.PBool _ _ -> + T.CASTC_PBool _ _ -> pathPattern :: otherPathPatterns -subPositions : T.CODT_Path -> List Can.Pattern -> List ( T.CODT_Path, Can.Pattern ) +subPositions : T.CODT_Path -> List T.CASTC_Pattern -> List ( T.CODT_Path, T.CASTC_Pattern ) subPositions path patterns = Index.indexedMap (\index pattern -> ( T.CODT_Index index path, pattern )) patterns -dearg : Can.PatternCtorArg -> Can.Pattern -dearg (Can.PatternCtorArg _ _ pattern) = +dearg : T.CASTC_PatternCtorArg -> T.CASTC_Pattern +dearg (T.CASTC_PatternCtorArg _ _ pattern) = pattern @@ -303,14 +303,14 @@ testAtPath selectedPath (Branch _ pathPatterns) = |> Maybe.andThen (\(T.CRA_At _ pattern) -> case pattern of - Can.PCtor { home, union, name, index } -> + T.CASTC_PCtor { home, union, name, index } -> let (T.CASTC_Union _ _ numAlts opts) = union in Just (T.CODT_IsCtor home name index numAlts opts) - Can.PList ps -> + T.CASTC_PList ps -> Just (case ps of [] -> @@ -320,37 +320,37 @@ testAtPath selectedPath (Branch _ pathPatterns) = T.CODT_IsCons ) - Can.PCons _ _ -> + T.CASTC_PCons _ _ -> Just T.CODT_IsCons - Can.PTuple _ _ _ -> + T.CASTC_PTuple _ _ _ -> Just T.CODT_IsTuple - Can.PUnit -> + T.CASTC_PUnit -> Just T.CODT_IsTuple - Can.PVar _ -> + T.CASTC_PVar _ -> Nothing - Can.PAnything -> + T.CASTC_PAnything -> Nothing - Can.PInt int -> + T.CASTC_PInt int -> Just (T.CODT_IsInt int) - Can.PStr str -> + T.CASTC_PStr str -> Just (T.CODT_IsStr str) - Can.PChr chr -> + T.CASTC_PChr chr -> Just (T.CODT_IsChr chr) - Can.PBool _ bool -> + T.CASTC_PBool _ bool -> Just (T.CODT_IsBool bool) - Can.PRecord _ -> + T.CASTC_PRecord _ -> Nothing - Can.PAlias _ _ -> + T.CASTC_PAlias _ _ -> crash "aliases should never reach 'testAtPath' function" ) @@ -371,7 +371,7 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = case extract path pathPatterns of Found start (T.CRA_At region pattern) end -> case pattern of - Can.PCtor { union, name, args } -> + T.CASTC_PCtor { union, name, args } -> case test of T.CODT_IsCtor _ testName _ _ _ -> if name == testName then @@ -399,7 +399,7 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = _ -> Nothing - Can.PList [] -> + T.CASTC_PList [] -> case test of T.CODT_IsNil -> Just (Branch goal (start ++ end)) @@ -407,20 +407,20 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = _ -> Nothing - Can.PList (hd :: tl) -> + T.CASTC_PList (hd :: tl) -> case test of T.CODT_IsCons -> let - tl_ : T.CRA_Located Can.Pattern_ + tl_ : T.CRA_Located T.CASTC_Pattern_ tl_ = - T.CRA_At region (Can.PList tl) + T.CRA_At region (T.CASTC_PList tl) in Just (Branch goal (start ++ subPositions path [ hd, tl_ ] ++ end)) _ -> Nothing - Can.PCons hd tl -> + T.CASTC_PCons hd tl -> case test of T.CODT_IsCons -> Just (Branch goal (start ++ subPositions path [ hd, tl ] ++ end)) @@ -428,7 +428,7 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = _ -> Nothing - Can.PChr chr -> + T.CASTC_PChr chr -> case test of T.CODT_IsChr testChr -> if chr == testChr then @@ -440,7 +440,7 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = _ -> Nothing - Can.PStr str -> + T.CASTC_PStr str -> case test of T.CODT_IsStr testStr -> if str == testStr then @@ -452,7 +452,7 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = _ -> Nothing - Can.PInt int -> + T.CASTC_PInt int -> case test of T.CODT_IsInt testInt -> if int == testInt then @@ -464,7 +464,7 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = _ -> Nothing - Can.PBool _ bool -> + T.CASTC_PBool _ bool -> case test of T.CODT_IsBool testBool -> if bool == testBool then @@ -476,10 +476,10 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = _ -> Nothing - Can.PUnit -> + T.CASTC_PUnit -> Just (Branch goal (start ++ end)) - Can.PTuple a b maybeC -> + T.CASTC_PTuple a b maybeC -> Just (Branch goal (start @@ -494,16 +494,16 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = ) ) - Can.PVar _ -> + T.CASTC_PVar _ -> Just branch - Can.PAnything -> + T.CASTC_PAnything -> Just branch - Can.PRecord _ -> + T.CASTC_PRecord _ -> Just branch - Can.PAlias _ _ -> + T.CASTC_PAlias _ _ -> Just branch NotFound -> @@ -512,10 +512,10 @@ toRelevantBranch test path ((Branch goal pathPatterns) as branch) = type Extract = NotFound - | Found (List ( T.CODT_Path, Can.Pattern )) Can.Pattern (List ( T.CODT_Path, Can.Pattern )) + | Found (List ( T.CODT_Path, T.CASTC_Pattern )) T.CASTC_Pattern (List ( T.CODT_Path, T.CASTC_Pattern )) -extract : T.CODT_Path -> List ( T.CODT_Path, Can.Pattern ) -> Extract +extract : T.CODT_Path -> List ( T.CODT_Path, T.CASTC_Pattern ) -> Extract extract selectedPath pathPatterns = case pathPatterns of [] -> @@ -548,46 +548,46 @@ isIrrelevantTo selectedPath (Branch _ pathPatterns) = not (needsTests pattern) -needsTests : Can.Pattern -> Bool +needsTests : T.CASTC_Pattern -> Bool needsTests (T.CRA_At _ pattern) = case pattern of - Can.PVar _ -> + T.CASTC_PVar _ -> False - Can.PAnything -> + T.CASTC_PAnything -> False - Can.PRecord _ -> + T.CASTC_PRecord _ -> False - Can.PCtor _ -> + T.CASTC_PCtor _ -> True - Can.PList _ -> + T.CASTC_PList _ -> True - Can.PCons _ _ -> + T.CASTC_PCons _ _ -> True - Can.PUnit -> + T.CASTC_PUnit -> True - Can.PTuple _ _ _ -> + T.CASTC_PTuple _ _ _ -> True - Can.PChr _ -> + T.CASTC_PChr _ -> True - Can.PStr _ -> + T.CASTC_PStr _ -> True - Can.PInt _ -> + T.CASTC_PInt _ -> True - Can.PBool _ _ -> + T.CASTC_PBool _ _ -> True - Can.PAlias _ _ -> + T.CASTC_PAlias _ _ -> crash "aliases should never reach 'isIrrelevantTo' function" @@ -610,7 +610,7 @@ pickPath branches = Prelude.head (bests (addWeights (smallBranchingFactor branches) tiedPaths)) -isChoicePath : ( T.CODT_Path, Can.Pattern ) -> Maybe T.CODT_Path +isChoicePath : ( T.CODT_Path, T.CASTC_Pattern ) -> Maybe T.CODT_Path isChoicePath ( path, pattern ) = if needsTests pattern then Just path diff --git a/src/Compiler/Optimize/Expression.elm b/src/Compiler/Optimize/Expression.elm index 34dc3b0db..1a3546db0 100644 --- a/src/Compiler/Optimize/Expression.elm +++ b/src/Compiler/Optimize/Expression.elm @@ -5,7 +5,6 @@ module Compiler.Optimize.Expression exposing , optimizePotentialTailCall ) -import Compiler.AST.Canonical as Can import Compiler.Data.Index as Index import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName @@ -25,51 +24,51 @@ type alias Cycle = EverySet String T.CDN_Name -optimize : Cycle -> Can.Expr -> Names.Tracker T.CASTO_Expr +optimize : Cycle -> T.CASTC_Expr -> Names.Tracker T.CASTO_Expr optimize cycle (T.CRA_At region expression) = case expression of - Can.VarLocal name -> + T.CASTC_VarLocal name -> Names.pure (T.CASTO_VarLocal name) - Can.VarTopLevel home name -> + T.CASTC_VarTopLevel home name -> if EverySet.member identity name cycle then Names.pure (T.CASTO_VarCycle home name) else Names.registerGlobal home name - Can.VarKernel home name -> + T.CASTC_VarKernel home name -> Names.registerKernel home (T.CASTO_VarKernel home name) - Can.VarForeign home name _ -> + T.CASTC_VarForeign home name _ -> Names.registerGlobal home name - Can.VarCtor opts home name index _ -> + T.CASTC_VarCtor opts home name index _ -> Names.registerCtor home name index opts - Can.VarDebug home name _ -> + T.CASTC_VarDebug home name _ -> Names.registerDebug name home region - Can.VarOperator _ home name _ -> + T.CASTC_VarOperator _ home name _ -> Names.registerGlobal home name - Can.Chr chr -> + T.CASTC_Chr chr -> Names.registerKernel Name.utils (T.CASTO_Chr chr) - Can.Str str -> + T.CASTC_Str str -> Names.pure (T.CASTO_Str str) - Can.Int int -> + T.CASTC_Int int -> Names.pure (T.CASTO_Int int) - Can.Float float -> + T.CASTC_Float float -> Names.pure (T.CASTO_Float float) - Can.List entries -> + T.CASTC_List entries -> Names.traverse (optimize cycle) entries |> Names.bind (Names.registerKernel Name.list << T.CASTO_List) - Can.Negate expr -> + T.CASTC_Negate expr -> Names.registerGlobal ModuleName.basics Name.negate |> Names.bind (\func -> @@ -80,7 +79,7 @@ optimize cycle (T.CRA_At region expression) = ) ) - Can.Binop _ home name _ left right -> + T.CASTC_Binop _ home name _ left right -> Names.registerGlobal home name |> Names.bind (\optFunc -> @@ -95,7 +94,7 @@ optimize cycle (T.CRA_At region expression) = ) ) - Can.Lambda args body -> + T.CASTC_Lambda args body -> destructArgs args |> Names.bind (\( argNames, destructors ) -> @@ -106,7 +105,7 @@ optimize cycle (T.CRA_At region expression) = ) ) - Can.Call func args -> + T.CASTC_Call func args -> optimize cycle func |> Names.bind (\optimizeExpr -> @@ -114,9 +113,9 @@ optimize cycle (T.CRA_At region expression) = |> Names.fmap (T.CASTO_Call optimizeExpr) ) - Can.If branches finally -> + T.CASTC_If branches finally -> let - optimizeBranch : ( Can.Expr, Can.Expr ) -> Names.Tracker ( T.CASTO_Expr, T.CASTO_Expr ) + optimizeBranch : ( T.CASTC_Expr, T.CASTC_Expr ) -> Names.Tracker ( T.CASTO_Expr, T.CASTO_Expr ) optimizeBranch ( condition, branch ) = optimize cycle condition |> Names.bind @@ -132,11 +131,11 @@ optimize cycle (T.CRA_At region expression) = |> Names.fmap (T.CASTO_If optimizedBranches) ) - Can.Let def body -> + T.CASTC_Let def body -> optimize cycle body |> Names.bind (optimizeDef cycle def) - Can.LetRec defs body -> + T.CASTC_LetRec defs body -> case defs of [ def ] -> optimizePotentialTailCallDef cycle def @@ -154,7 +153,7 @@ optimize cycle (T.CRA_At region expression) = (optimize cycle body) defs - Can.LetDestruct pattern expr body -> + T.CASTC_LetDestruct pattern expr body -> destruct pattern |> Names.bind (\( name, destructs ) -> @@ -169,10 +168,10 @@ optimize cycle (T.CRA_At region expression) = ) ) - Can.Case expr branches -> + T.CASTC_Case expr branches -> let - optimizeBranch : T.CDN_Name -> Can.CaseBranch -> Names.Tracker ( Can.Pattern, T.CASTO_Expr ) - optimizeBranch root (Can.CaseBranch pattern branch) = + optimizeBranch : T.CDN_Name -> T.CASTC_CaseBranch -> Names.Tracker ( T.CASTC_Pattern, T.CASTO_Expr ) + optimizeBranch root (T.CASTC_CaseBranch pattern branch) = destructCase root pattern |> Names.bind (\destructors -> @@ -203,17 +202,17 @@ optimize cycle (T.CRA_At region expression) = ) ) - Can.Accessor field -> + T.CASTC_Accessor field -> Names.registerField field (T.CASTO_Accessor field) - Can.Access record (T.CRA_At _ field) -> + T.CASTC_Access record (T.CRA_At _ field) -> optimize cycle record |> Names.bind (\optRecord -> Names.registerField field (T.CASTO_Access optRecord field) ) - Can.Update _ record updates -> + T.CASTC_Update _ record updates -> Names.mapTraverse identity compare (optimizeUpdate cycle) updates |> Names.bind (\optUpdates -> @@ -224,17 +223,17 @@ optimize cycle (T.CRA_At region expression) = ) ) - Can.Record fields -> + T.CASTC_Record fields -> Names.mapTraverse identity compare (optimize cycle) fields |> Names.bind (\optFields -> Names.registerFieldDict fields (T.CASTO_Record optFields) ) - Can.Unit -> + T.CASTC_Unit -> Names.registerKernel Name.utils T.CASTO_Unit - Can.Tuple a b maybeC -> + T.CASTC_Tuple a b maybeC -> optimize cycle a |> Names.bind (\optA -> @@ -255,7 +254,7 @@ optimize cycle (T.CRA_At region expression) = ) ) - Can.Shader src (T.CASTUS_Types attributes uniforms _) -> + T.CASTC_Shader src (T.CASTUS_Types attributes uniforms _) -> Names.pure (T.CASTO_Shader src (EverySet.fromList identity (Dict.keys compare attributes)) (EverySet.fromList identity (Dict.keys compare uniforms))) @@ -263,8 +262,8 @@ optimize cycle (T.CRA_At region expression) = -- UPDATE -optimizeUpdate : Cycle -> Can.FieldUpdate -> Names.Tracker T.CASTO_Expr -optimizeUpdate cycle (Can.FieldUpdate _ expr) = +optimizeUpdate : Cycle -> T.CASTC_FieldUpdate -> Names.Tracker T.CASTO_Expr +optimizeUpdate cycle (T.CASTC_FieldUpdate _ expr) = optimize cycle expr @@ -272,17 +271,17 @@ optimizeUpdate cycle (Can.FieldUpdate _ expr) = -- DEFINITION -optimizeDef : Cycle -> Can.Def -> T.CASTO_Expr -> Names.Tracker T.CASTO_Expr +optimizeDef : Cycle -> T.CASTC_Def -> T.CASTO_Expr -> Names.Tracker T.CASTO_Expr optimizeDef cycle def body = case def of - Can.Def (T.CRA_At _ name) args expr -> + T.CASTC_Def (T.CRA_At _ name) args expr -> optimizeDefHelp cycle name args expr body - Can.TypedDef (T.CRA_At _ name) _ typedArgs expr _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ typedArgs expr _ -> optimizeDefHelp cycle name (List.map Tuple.first typedArgs) expr body -optimizeDefHelp : Cycle -> T.CDN_Name -> List Can.Pattern -> Can.Expr -> T.CASTO_Expr -> Names.Tracker T.CASTO_Expr +optimizeDefHelp : Cycle -> T.CDN_Name -> List T.CASTC_Pattern -> T.CASTC_Expr -> T.CASTO_Expr -> Names.Tracker T.CASTO_Expr optimizeDefHelp cycle name args expr body = case args of [] -> @@ -310,7 +309,7 @@ optimizeDefHelp cycle name args expr body = -- DESTRUCTURING -destructArgs : List Can.Pattern -> Names.Tracker ( List T.CDN_Name, List T.CASTO_Destructor ) +destructArgs : List T.CASTC_Pattern -> Names.Tracker ( List T.CDN_Name, List T.CASTO_Destructor ) destructArgs args = Names.traverse destruct args |> Names.fmap List.unzip @@ -320,19 +319,19 @@ destructArgs args = ) -destructCase : T.CDN_Name -> Can.Pattern -> Names.Tracker (List T.CASTO_Destructor) +destructCase : T.CDN_Name -> T.CASTC_Pattern -> Names.Tracker (List T.CASTO_Destructor) destructCase rootName pattern = destructHelp (T.CASTO_Root rootName) pattern [] |> Names.fmap List.reverse -destruct : Can.Pattern -> Names.Tracker ( T.CDN_Name, List T.CASTO_Destructor ) +destruct : T.CASTC_Pattern -> Names.Tracker ( T.CDN_Name, List T.CASTO_Destructor ) destruct ((T.CRA_At _ ptrn) as pattern) = case ptrn of - Can.PVar name -> + T.CASTC_PVar name -> Names.pure ( name, [] ) - Can.PAlias subPattern name -> + T.CASTC_PAlias subPattern name -> destructHelp (T.CASTO_Root name) subPattern [] |> Names.fmap (\revDs -> ( name, List.reverse revDs )) @@ -348,16 +347,16 @@ destruct ((T.CRA_At _ ptrn) as pattern) = ) -destructHelp : T.CASTO_Path -> Can.Pattern -> List T.CASTO_Destructor -> Names.Tracker (List T.CASTO_Destructor) +destructHelp : T.CASTO_Path -> T.CASTC_Pattern -> List T.CASTO_Destructor -> Names.Tracker (List T.CASTO_Destructor) destructHelp path (T.CRA_At region pattern) revDs = case pattern of - Can.PAnything -> + T.CASTC_PAnything -> Names.pure revDs - Can.PVar name -> + T.CASTC_PVar name -> Names.pure (T.CASTO_Destructor name path :: revDs) - Can.PRecord fields -> + T.CASTC_PRecord fields -> let toDestruct : T.CDN_Name -> T.CASTO_Destructor toDestruct name = @@ -365,17 +364,17 @@ destructHelp path (T.CRA_At region pattern) revDs = in Names.registerFieldList fields (List.map toDestruct fields ++ revDs) - Can.PAlias subPattern name -> + T.CASTC_PAlias subPattern name -> destructHelp (T.CASTO_Root name) subPattern <| (T.CASTO_Destructor name path :: revDs) - Can.PUnit -> + T.CASTC_PUnit -> Names.pure revDs - Can.PTuple a b Nothing -> + T.CASTC_PTuple a b Nothing -> destructTwo path a b revDs - Can.PTuple a b (Just c) -> + T.CASTC_PTuple a b (Just c) -> case path of T.CASTO_Root _ -> destructHelp (T.CASTO_Index Index.first path) a revDs @@ -396,30 +395,30 @@ destructHelp path (T.CRA_At region pattern) revDs = |> Names.bind (destructHelp (T.CASTO_Index Index.third newRoot) c) ) - Can.PList [] -> + T.CASTC_PList [] -> Names.pure revDs - Can.PList (hd :: tl) -> - destructTwo path hd (T.CRA_At region (Can.PList tl)) revDs + T.CASTC_PList (hd :: tl) -> + destructTwo path hd (T.CRA_At region (T.CASTC_PList tl)) revDs - Can.PCons hd tl -> + T.CASTC_PCons hd tl -> destructTwo path hd tl revDs - Can.PChr _ -> + T.CASTC_PChr _ -> Names.pure revDs - Can.PStr _ -> + T.CASTC_PStr _ -> Names.pure revDs - Can.PInt _ -> + T.CASTC_PInt _ -> Names.pure revDs - Can.PBool _ _ -> + T.CASTC_PBool _ _ -> Names.pure revDs - Can.PCtor { union, args } -> + T.CASTC_PCtor { union, args } -> case args of - [ Can.PatternCtorArg _ _ arg ] -> + [ T.CASTC_PatternCtorArg _ _ arg ] -> let (T.CASTC_Union _ _ _ opts) = union @@ -451,7 +450,7 @@ destructHelp path (T.CRA_At region pattern) revDs = ) -destructTwo : T.CASTO_Path -> Can.Pattern -> Can.Pattern -> List T.CASTO_Destructor -> Names.Tracker (List T.CASTO_Destructor) +destructTwo : T.CASTO_Path -> T.CASTC_Pattern -> T.CASTC_Pattern -> List T.CASTO_Destructor -> Names.Tracker (List T.CASTO_Destructor) destructTwo path a b revDs = case path of T.CASTO_Root _ -> @@ -472,8 +471,8 @@ destructTwo path a b revDs = ) -destructCtorArg : T.CASTO_Path -> List T.CASTO_Destructor -> Can.PatternCtorArg -> Names.Tracker (List T.CASTO_Destructor) -destructCtorArg path revDs (Can.PatternCtorArg index _ arg) = +destructCtorArg : T.CASTO_Path -> List T.CASTO_Destructor -> T.CASTC_PatternCtorArg -> Names.Tracker (List T.CASTO_Destructor) +destructCtorArg path revDs (T.CASTC_PatternCtorArg index _ arg) = destructHelp (T.CASTO_Index index path) arg revDs @@ -481,17 +480,17 @@ destructCtorArg path revDs (Can.PatternCtorArg index _ arg) = -- TAIL CALL -optimizePotentialTailCallDef : Cycle -> Can.Def -> Names.Tracker T.CASTO_Def +optimizePotentialTailCallDef : Cycle -> T.CASTC_Def -> Names.Tracker T.CASTO_Def optimizePotentialTailCallDef cycle def = case def of - Can.Def (T.CRA_At _ name) args expr -> + T.CASTC_Def (T.CRA_At _ name) args expr -> optimizePotentialTailCall cycle name args expr - Can.TypedDef (T.CRA_At _ name) _ typedArgs expr _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ typedArgs expr _ -> optimizePotentialTailCall cycle name (List.map Tuple.first typedArgs) expr -optimizePotentialTailCall : Cycle -> T.CDN_Name -> List Can.Pattern -> Can.Expr -> Names.Tracker T.CASTO_Def +optimizePotentialTailCall : Cycle -> T.CDN_Name -> List T.CASTC_Pattern -> T.CASTC_Expr -> Names.Tracker T.CASTO_Def optimizePotentialTailCall cycle name args expr = destructArgs args |> Names.bind @@ -501,10 +500,10 @@ optimizePotentialTailCall cycle name args expr = ) -optimizeTail : Cycle -> T.CDN_Name -> List T.CDN_Name -> Can.Expr -> Names.Tracker T.CASTO_Expr +optimizeTail : Cycle -> T.CDN_Name -> List T.CDN_Name -> T.CASTC_Expr -> Names.Tracker T.CASTO_Expr optimizeTail cycle rootName argNames ((T.CRA_At _ expression) as locExpr) = case expression of - Can.Call func args -> + T.CASTC_Call func args -> Names.traverse (optimize cycle) args |> Names.bind (\oargs -> @@ -512,10 +511,10 @@ optimizeTail cycle rootName argNames ((T.CRA_At _ expression) as locExpr) = isMatchingName : Bool isMatchingName = case A.toValue func of - Can.VarLocal name -> + T.CASTC_VarLocal name -> rootName == name - Can.VarTopLevel _ name -> + T.CASTC_VarTopLevel _ name -> rootName == name _ -> @@ -535,9 +534,9 @@ optimizeTail cycle rootName argNames ((T.CRA_At _ expression) as locExpr) = |> Names.fmap (\ofunc -> T.CASTO_Call ofunc oargs) ) - Can.If branches finally -> + T.CASTC_If branches finally -> let - optimizeBranch : ( Can.Expr, Can.Expr ) -> Names.Tracker ( T.CASTO_Expr, T.CASTO_Expr ) + optimizeBranch : ( T.CASTC_Expr, T.CASTC_Expr ) -> Names.Tracker ( T.CASTO_Expr, T.CASTO_Expr ) optimizeBranch ( condition, branch ) = optimize cycle condition |> Names.bind @@ -553,11 +552,11 @@ optimizeTail cycle rootName argNames ((T.CRA_At _ expression) as locExpr) = |> Names.fmap (T.CASTO_If obranches) ) - Can.Let def body -> + T.CASTC_Let def body -> optimizeTail cycle rootName argNames body |> Names.bind (optimizeDef cycle def) - Can.LetRec defs body -> + T.CASTC_LetRec defs body -> case defs of [ def ] -> optimizePotentialTailCallDef cycle def @@ -575,7 +574,7 @@ optimizeTail cycle rootName argNames ((T.CRA_At _ expression) as locExpr) = (optimize cycle body) defs - Can.LetDestruct pattern expr body -> + T.CASTC_LetDestruct pattern expr body -> destruct pattern |> Names.bind (\( dname, destructors ) -> @@ -590,10 +589,10 @@ optimizeTail cycle rootName argNames ((T.CRA_At _ expression) as locExpr) = ) ) - Can.Case expr branches -> + T.CASTC_Case expr branches -> let - optimizeBranch : T.CDN_Name -> Can.CaseBranch -> Names.Tracker ( Can.Pattern, T.CASTO_Expr ) - optimizeBranch root (Can.CaseBranch pattern branch) = + optimizeBranch : T.CDN_Name -> T.CASTC_CaseBranch -> Names.Tracker ( T.CASTC_Pattern, T.CASTO_Expr ) + optimizeBranch root (T.CASTC_CaseBranch pattern branch) = destructCase root pattern |> Names.bind (\destructors -> diff --git a/src/Compiler/Optimize/Module.elm b/src/Compiler/Optimize/Module.elm index f37de0c20..6cd890384 100644 --- a/src/Compiler/Optimize/Module.elm +++ b/src/Compiler/Optimize/Module.elm @@ -9,7 +9,6 @@ import Compiler.Elm.ModuleName as ModuleName import Compiler.Optimize.Expression as Expr import Compiler.Optimize.Names as Names import Compiler.Optimize.Port as Port -import Compiler.Reporting.Error.Main as E import Compiler.Reporting.Result as R import Compiler.Reporting.Warning as W import Data.Map as Dict exposing (Dict) @@ -23,7 +22,7 @@ import Utils.Main as Utils type alias MResult i w a = - R.RResult i w E.CREM_Error a + R.RResult i w T.CREM_Error a type alias Annotations = @@ -205,16 +204,16 @@ addToGraph name node fields (T.CASTO_LocalGraph main nodes fieldCounts) = -- ADD DECLS -addDecls : T.CEMN_Canonical -> Annotations -> Can.Decls -> T.CASTO_LocalGraph -> MResult i (List W.Warning) T.CASTO_LocalGraph +addDecls : T.CEMN_Canonical -> Annotations -> T.CASTC_Decls -> T.CASTO_LocalGraph -> MResult i (List W.Warning) T.CASTO_LocalGraph addDecls home annotations decls graph = case decls of - Can.Declare def subDecls -> + T.CASTC_Declare def subDecls -> addDef home annotations def graph |> R.bind (addDecls home annotations subDecls) - Can.DeclareRec d ds subDecls -> + T.CASTC_DeclareRec d ds subDecls -> let - defs : List Can.Def + defs : List T.CASTC_Def defs = d :: ds in @@ -223,13 +222,13 @@ addDecls home annotations decls graph = addDecls home annotations subDecls (addRecDefs home defs graph) Just region -> - R.throw <| E.CREM_BadCycle region (defToName d) (List.map defToName ds) + R.throw <| T.CREM_BadCycle region (defToName d) (List.map defToName ds) - Can.SaveTheEnvironment -> + T.CASTC_SaveTheEnvironment -> R.ok graph -findMain : List Can.Def -> Maybe T.CRA_Region +findMain : List T.CASTC_Def -> Maybe T.CRA_Region findMain defs = case defs of [] -> @@ -237,14 +236,14 @@ findMain defs = def :: rest -> case def of - Can.Def (T.CRA_At region name) _ _ -> + T.CASTC_Def (T.CRA_At region name) _ _ -> if name == Name.main_ then Just region else findMain rest - Can.TypedDef (T.CRA_At region name) _ _ _ _ -> + T.CASTC_TypedDef (T.CRA_At region name) _ _ _ _ -> if name == Name.main_ then Just region @@ -252,13 +251,13 @@ findMain defs = findMain rest -defToName : Can.Def -> T.CDN_Name +defToName : T.CASTC_Def -> T.CDN_Name defToName def = case def of - Can.Def (T.CRA_At _ name) _ _ -> + T.CASTC_Def (T.CRA_At _ name) _ _ -> name - Can.TypedDef (T.CRA_At _ name) _ _ _ _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ _ _ _ -> name @@ -266,10 +265,10 @@ defToName def = -- ADD DEFS -addDef : T.CEMN_Canonical -> Annotations -> Can.Def -> T.CASTO_LocalGraph -> MResult i (List W.Warning) T.CASTO_LocalGraph +addDef : T.CEMN_Canonical -> Annotations -> T.CASTC_Def -> T.CASTO_LocalGraph -> MResult i (List W.Warning) T.CASTO_LocalGraph addDef home annotations def graph = case def of - Can.Def (T.CRA_At region name) args body -> + T.CASTC_Def (T.CRA_At region name) args body -> let (T.CASTC_Forall _ tipe) = Utils.find identity name annotations @@ -277,11 +276,11 @@ addDef home annotations def graph = addDefHelp region annotations home name args body graph |> R.then_ (R.warn (W.MissingTypeAnnotation region name tipe)) - Can.TypedDef (T.CRA_At region name) _ typedArgs body _ -> + T.CASTC_TypedDef (T.CRA_At region name) _ typedArgs body _ -> addDefHelp region annotations home name (List.map Tuple.first typedArgs) body graph -addDefHelp : T.CRA_Region -> Annotations -> T.CEMN_Canonical -> T.CDN_Name -> List Can.Pattern -> Can.Expr -> T.CASTO_LocalGraph -> MResult i w T.CASTO_LocalGraph +addDefHelp : T.CRA_Region -> Annotations -> T.CEMN_Canonical -> T.CDN_Name -> List T.CASTC_Pattern -> T.CASTC_Expr -> T.CASTO_LocalGraph -> MResult i w T.CASTO_LocalGraph addDefHelp region annotations home name args body ((T.CASTO_LocalGraph _ nodes fieldCounts) as graph) = if name /= Name.main_ then R.ok (addDefNode home name args body EverySet.empty graph) @@ -302,7 +301,7 @@ addDefHelp region annotations home name args body ((T.CASTO_LocalGraph _ nodes f R.ok <| addMain <| Names.run <| Names.registerKernel Name.virtualDom T.CASTO_Static else - R.throw (E.CREM_BadType region tipe) + R.throw (T.CREM_BadType region tipe) T.CASTC_TType hm nm [ flags, _, message ] -> if hm == ModuleName.platform && nm == Name.program then @@ -311,16 +310,16 @@ addDefHelp region annotations home name args body ((T.CASTO_LocalGraph _ nodes f R.ok <| addMain <| Names.run <| Names.fmap (T.CASTO_Dynamic message) <| Port.toFlagsDecoder flags Err ( subType, invalidPayload ) -> - R.throw (E.CREM_BadFlags region subType invalidPayload) + R.throw (T.CREM_BadFlags region subType invalidPayload) else - R.throw (E.CREM_BadType region tipe) + R.throw (T.CREM_BadType region tipe) _ -> - R.throw (E.CREM_BadType region tipe) + R.throw (T.CREM_BadType region tipe) -addDefNode : T.CEMN_Canonical -> T.CDN_Name -> List Can.Pattern -> Can.Expr -> EverySet (List String) T.CASTO_Global -> T.CASTO_LocalGraph -> T.CASTO_LocalGraph +addDefNode : T.CEMN_Canonical -> T.CDN_Name -> List T.CASTC_Pattern -> T.CASTC_Expr -> EverySet (List String) T.CASTO_Global -> T.CASTO_LocalGraph -> T.CASTO_LocalGraph addDefNode home name args body mainDeps graph = let ( deps, fields, def ) = @@ -355,7 +354,7 @@ type State } -addRecDefs : T.CEMN_Canonical -> List Can.Def -> T.CASTO_LocalGraph -> T.CASTO_LocalGraph +addRecDefs : T.CEMN_Canonical -> List T.CASTC_Def -> T.CASTO_LocalGraph -> T.CASTO_LocalGraph addRecDefs home defs (T.CASTO_LocalGraph main nodes fieldCounts) = let names : List T.CDN_Name @@ -386,27 +385,27 @@ addRecDefs home defs (T.CASTO_LocalGraph main nodes fieldCounts) = (Utils.mapUnionWith identity compare (+) fields fieldCounts) -toName : Can.Def -> T.CDN_Name +toName : T.CASTC_Def -> T.CDN_Name toName def = case def of - Can.Def (T.CRA_At _ name) _ _ -> + T.CASTC_Def (T.CRA_At _ name) _ _ -> name - Can.TypedDef (T.CRA_At _ name) _ _ _ _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ _ _ _ -> name -addValueName : Can.Def -> EverySet String T.CDN_Name -> EverySet String T.CDN_Name +addValueName : T.CASTC_Def -> EverySet String T.CDN_Name -> EverySet String T.CDN_Name addValueName def names = case def of - Can.Def (T.CRA_At _ name) args _ -> + T.CASTC_Def (T.CRA_At _ name) args _ -> if List.isEmpty args then EverySet.insert identity name names else names - Can.TypedDef (T.CRA_At _ name) _ args _ _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ args _ _ -> if List.isEmpty args then EverySet.insert identity name names @@ -414,13 +413,13 @@ addValueName def names = names -addLink : T.CEMN_Canonical -> T.CASTO_Node -> Can.Def -> Dict (List String) T.CASTO_Global T.CASTO_Node -> Dict (List String) T.CASTO_Global T.CASTO_Node +addLink : T.CEMN_Canonical -> T.CASTO_Node -> T.CASTC_Def -> Dict (List String) T.CASTO_Global T.CASTO_Node -> Dict (List String) T.CASTO_Global T.CASTO_Node addLink home link def links = case def of - Can.Def (T.CRA_At _ name) _ _ -> + T.CASTC_Def (T.CRA_At _ name) _ _ -> Dict.insert Opt.toComparableGlobal (T.CASTO_Global home name) link links - Can.TypedDef (T.CRA_At _ name) _ _ _ _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ _ _ _ -> Dict.insert Opt.toComparableGlobal (T.CASTO_Global home name) link links @@ -428,17 +427,17 @@ addLink home link def links = -- ADD RECURSIVE DEFS -addRecDef : EverySet String T.CDN_Name -> State -> Can.Def -> Names.Tracker State +addRecDef : EverySet String T.CDN_Name -> State -> T.CASTC_Def -> Names.Tracker State addRecDef cycle state def = case def of - Can.Def (T.CRA_At _ name) args body -> + T.CASTC_Def (T.CRA_At _ name) args body -> addRecDefHelp cycle state name args body - Can.TypedDef (T.CRA_At _ name) _ args body _ -> + T.CASTC_TypedDef (T.CRA_At _ name) _ args body _ -> addRecDefHelp cycle state name (List.map Tuple.first args) body -addRecDefHelp : EverySet String T.CDN_Name -> State -> T.CDN_Name -> List Can.Pattern -> Can.Expr -> Names.Tracker State +addRecDefHelp : EverySet String T.CDN_Name -> State -> T.CDN_Name -> List T.CASTC_Pattern -> T.CASTC_Expr -> Names.Tracker State addRecDefHelp cycle (State { values, functions }) name args body = case args of [] -> diff --git a/src/Compiler/Parse/Declaration.elm b/src/Compiler/Parse/Declaration.elm index 22f0b2a49..7afa60b2e 100644 --- a/src/Compiler/Parse/Declaration.elm +++ b/src/Compiler/Parse/Declaration.elm @@ -14,7 +14,6 @@ import Compiler.Parse.Symbol as Symbol import Compiler.Parse.Type as Type import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Syntax as E import Types as T @@ -29,7 +28,7 @@ type Decl | Port (Maybe T.CASTS_Comment) T.CASTS_Port -declaration : Space.Parser E.CRES_Decl Decl +declaration : Space.Parser T.CRES_Decl Decl declaration = chompDocComment |> P.bind @@ -37,7 +36,7 @@ declaration = P.getPosition |> P.bind (\start -> - P.oneOf E.CRES_DeclStart + P.oneOf T.CRES_DeclStart [ typeDecl maybeDocs start , portDecl maybeDocs , valueDecl maybeDocs start @@ -50,14 +49,14 @@ declaration = -- DOC COMMENT -chompDocComment : P.Parser E.CRES_Decl (Maybe T.CASTS_Comment) +chompDocComment : P.Parser T.CRES_Decl (Maybe T.CASTS_Comment) chompDocComment = P.oneOfWithFallback - [ Space.docComment E.CRES_DeclStart E.CRES_DeclSpace + [ Space.docComment T.CRES_DeclStart T.CRES_DeclSpace |> P.bind (\docComment -> - Space.chomp E.CRES_DeclSpace - |> P.bind (\_ -> Space.checkFreshLine E.CRES_DeclFreshLineAfterDocComment) + Space.chomp T.CRES_DeclSpace + |> P.bind (\_ -> Space.checkFreshLine T.CRES_DeclFreshLineAfterDocComment) |> P.fmap (\_ -> Just docComment) ) ] @@ -68,29 +67,29 @@ chompDocComment = -- DEFINITION and ANNOTATION -valueDecl : Maybe T.CASTS_Comment -> T.CRA_Position -> Space.Parser E.CRES_Decl Decl +valueDecl : Maybe T.CASTS_Comment -> T.CRA_Position -> Space.Parser T.CRES_Decl Decl valueDecl maybeDocs start = - Var.lower E.CRES_DeclStart + Var.lower T.CRES_DeclStart |> P.bind (\name -> P.getPosition |> P.bind (\end -> - P.specialize (E.CRES_DeclDef name) <| - (Space.chompAndCheckIndent E.CRES_DeclDefSpace E.CRES_DeclDefIndentEquals + P.specialize (T.CRES_DeclDef name) <| + (Space.chompAndCheckIndent T.CRES_DeclDefSpace T.CRES_DeclDefIndentEquals |> P.bind (\_ -> - P.oneOf E.CRES_DeclDefEquals - [ P.word1 ':' E.CRES_DeclDefEquals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_DeclDefSpace E.CRES_DeclDefIndentType) - |> P.bind (\_ -> P.specialize E.CRES_DeclDefType Type.expression) + P.oneOf T.CRES_DeclDefEquals + [ P.word1 ':' T.CRES_DeclDefEquals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_DeclDefSpace T.CRES_DeclDefIndentType) + |> P.bind (\_ -> P.specialize T.CRES_DeclDefType Type.expression) |> P.bind (\( tipe, _ ) -> - Space.checkFreshLine E.CRES_DeclDefNameRepeat + Space.checkFreshLine T.CRES_DeclDefNameRepeat |> P.bind (\_ -> chompMatchingName name) |> P.bind (\defName -> - Space.chompAndCheckIndent E.CRES_DeclDefSpace E.CRES_DeclDefIndentEquals + Space.chompAndCheckIndent T.CRES_DeclDefSpace T.CRES_DeclDefIndentEquals |> P.bind (\_ -> chompDefArgsAndBody maybeDocs start defName (Just tipe) []) ) ) @@ -102,18 +101,18 @@ valueDecl maybeDocs start = ) -chompDefArgsAndBody : Maybe T.CASTS_Comment -> T.CRA_Position -> T.CRA_Located T.CDN_Name -> Maybe T.CASTS_Type -> List T.CASTS_Pattern -> Space.Parser E.CRES_DeclDef Decl +chompDefArgsAndBody : Maybe T.CASTS_Comment -> T.CRA_Position -> T.CRA_Located T.CDN_Name -> Maybe T.CASTS_Type -> List T.CASTS_Pattern -> Space.Parser T.CRES_DeclDef Decl chompDefArgsAndBody maybeDocs start name tipe revArgs = - P.oneOf E.CRES_DeclDefEquals - [ P.specialize E.CRES_DeclDefArg Pattern.term + P.oneOf T.CRES_DeclDefEquals + [ P.specialize T.CRES_DeclDefArg Pattern.term |> P.bind (\arg -> - Space.chompAndCheckIndent E.CRES_DeclDefSpace E.CRES_DeclDefIndentEquals + Space.chompAndCheckIndent T.CRES_DeclDefSpace T.CRES_DeclDefIndentEquals |> P.bind (\_ -> chompDefArgsAndBody maybeDocs start name tipe (arg :: revArgs)) ) - , P.word1 '=' E.CRES_DeclDefEquals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_DeclDefSpace E.CRES_DeclDefIndentBody) - |> P.bind (\_ -> P.specialize E.CRES_DeclDefBody Expr.expression) + , P.word1 '=' T.CRES_DeclDefEquals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_DeclDefSpace T.CRES_DeclDefIndentBody) + |> P.bind (\_ -> P.specialize T.CRES_DeclDefBody Expr.expression) |> P.fmap (\( body, end ) -> let @@ -130,11 +129,11 @@ chompDefArgsAndBody maybeDocs start name tipe revArgs = ] -chompMatchingName : T.CDN_Name -> P.Parser E.CRES_DeclDef (T.CRA_Located T.CDN_Name) +chompMatchingName : T.CDN_Name -> P.Parser T.CRES_DeclDef (T.CRA_Located T.CDN_Name) chompMatchingName expectedName = let (P.Parser parserL) = - Var.lower E.CRES_DeclDefNameRepeat + Var.lower T.CRES_DeclDefNameRepeat in P.Parser <| \((P.State _ _ _ _ sr sc) as state) -> @@ -144,7 +143,7 @@ chompMatchingName expectedName = Ok (P.POk status (T.CRA_At (T.CRA_Region (T.CRA_Position sr sc) (T.CRA_Position er ec)) name) newState) else - Err (P.PErr status sr sc (E.CRES_DeclDefNameMatch name)) + Err (P.PErr status sr sc (T.CRES_DeclDefNameMatch name)) ) (parserL state) @@ -153,19 +152,19 @@ chompMatchingName expectedName = -- TYPE DECLARATIONS -typeDecl : Maybe T.CASTS_Comment -> T.CRA_Position -> Space.Parser E.CRES_Decl Decl +typeDecl : Maybe T.CASTS_Comment -> T.CRA_Position -> Space.Parser T.CRES_Decl Decl typeDecl maybeDocs start = - P.inContext E.CRES_DeclType (Keyword.type_ E.CRES_DeclStart) <| - (Space.chompAndCheckIndent E.CRES_DT_Space E.CRES_DT_IndentName + P.inContext T.CRES_DeclType (Keyword.type_ T.CRES_DeclStart) <| + (Space.chompAndCheckIndent T.CRES_DT_Space T.CRES_DT_IndentName |> P.bind (\_ -> - P.oneOf E.CRES_DT_Name - [ P.inContext E.CRES_DT_Alias (Keyword.alias_ E.CRES_DT_Name) <| - (Space.chompAndCheckIndent E.CRES_AliasSpace E.CRES_AliasIndentEquals + P.oneOf T.CRES_DT_Name + [ P.inContext T.CRES_DT_Alias (Keyword.alias_ T.CRES_DT_Name) <| + (Space.chompAndCheckIndent T.CRES_AliasSpace T.CRES_AliasIndentEquals |> P.bind (\_ -> chompAliasNameToEquals) |> P.bind (\( name, args ) -> - P.specialize E.CRES_AliasBody Type.expression + P.specialize T.CRES_AliasBody Type.expression |> P.fmap (\( tipe, end ) -> let @@ -177,7 +176,7 @@ typeDecl maybeDocs start = ) ) ) - , P.specialize E.CRES_DT_Union <| + , P.specialize T.CRES_DT_Union <| (chompCustomNameToEquals |> P.bind (\( name, args ) -> @@ -206,27 +205,27 @@ typeDecl maybeDocs start = -- TYPE ALIASES -chompAliasNameToEquals : P.Parser E.CRES_TypeAlias ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) +chompAliasNameToEquals : P.Parser T.CRES_TypeAlias ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) chompAliasNameToEquals = - P.addLocation (Var.upper E.CRES_AliasName) + P.addLocation (Var.upper T.CRES_AliasName) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_AliasSpace E.CRES_AliasIndentEquals + Space.chompAndCheckIndent T.CRES_AliasSpace T.CRES_AliasIndentEquals |> P.bind (\_ -> chompAliasNameToEqualsHelp name []) ) -chompAliasNameToEqualsHelp : T.CRA_Located T.CDN_Name -> List (T.CRA_Located T.CDN_Name) -> P.Parser E.CRES_TypeAlias ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) +chompAliasNameToEqualsHelp : T.CRA_Located T.CDN_Name -> List (T.CRA_Located T.CDN_Name) -> P.Parser T.CRES_TypeAlias ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) chompAliasNameToEqualsHelp name args = - P.oneOf E.CRES_AliasEquals - [ P.addLocation (Var.lower E.CRES_AliasEquals) + P.oneOf T.CRES_AliasEquals + [ P.addLocation (Var.lower T.CRES_AliasEquals) |> P.bind (\arg -> - Space.chompAndCheckIndent E.CRES_AliasSpace E.CRES_AliasIndentEquals + Space.chompAndCheckIndent T.CRES_AliasSpace T.CRES_AliasIndentEquals |> P.bind (\_ -> chompAliasNameToEqualsHelp name (arg :: args)) ) - , P.word1 '=' E.CRES_AliasEquals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_AliasSpace E.CRES_AliasIndentBody) + , P.word1 '=' T.CRES_AliasEquals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_AliasSpace T.CRES_AliasIndentBody) |> P.fmap (\_ -> ( name, List.reverse args )) ] @@ -235,37 +234,37 @@ chompAliasNameToEqualsHelp name args = -- CUSTOM TYPES -chompCustomNameToEquals : P.Parser E.CRES_CustomType ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) +chompCustomNameToEquals : P.Parser T.CRES_CustomType ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) chompCustomNameToEquals = - P.addLocation (Var.upper E.CRES_CT_Name) + P.addLocation (Var.upper T.CRES_CT_Name) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_CT_Space E.CRES_CT_IndentEquals + Space.chompAndCheckIndent T.CRES_CT_Space T.CRES_CT_IndentEquals |> P.bind (\_ -> chompCustomNameToEqualsHelp name []) ) -chompCustomNameToEqualsHelp : T.CRA_Located T.CDN_Name -> List (T.CRA_Located T.CDN_Name) -> P.Parser E.CRES_CustomType ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) +chompCustomNameToEqualsHelp : T.CRA_Located T.CDN_Name -> List (T.CRA_Located T.CDN_Name) -> P.Parser T.CRES_CustomType ( T.CRA_Located T.CDN_Name, List (T.CRA_Located T.CDN_Name) ) chompCustomNameToEqualsHelp name args = - P.oneOf E.CRES_CT_Equals - [ P.addLocation (Var.lower E.CRES_CT_Equals) + P.oneOf T.CRES_CT_Equals + [ P.addLocation (Var.lower T.CRES_CT_Equals) |> P.bind (\arg -> - Space.chompAndCheckIndent E.CRES_CT_Space E.CRES_CT_IndentEquals + Space.chompAndCheckIndent T.CRES_CT_Space T.CRES_CT_IndentEquals |> P.bind (\_ -> chompCustomNameToEqualsHelp name (arg :: args)) ) - , P.word1 '=' E.CRES_CT_Equals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_CT_Space E.CRES_CT_IndentAfterEquals) + , P.word1 '=' T.CRES_CT_Equals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_CT_Space T.CRES_CT_IndentAfterEquals) |> P.fmap (\_ -> ( name, List.reverse args )) ] -chompVariants : List ( T.CRA_Located T.CDN_Name, List T.CASTS_Type ) -> T.CRA_Position -> Space.Parser E.CRES_CustomType (List ( T.CRA_Located T.CDN_Name, List T.CASTS_Type )) +chompVariants : List ( T.CRA_Located T.CDN_Name, List T.CASTS_Type ) -> T.CRA_Position -> Space.Parser T.CRES_CustomType (List ( T.CRA_Located T.CDN_Name, List T.CASTS_Type )) chompVariants variants end = P.oneOfWithFallback - [ Space.checkIndent end E.CRES_CT_IndentBar - |> P.bind (\_ -> P.word1 '|' E.CRES_CT_Bar) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_CT_Space E.CRES_CT_IndentAfterBar) + [ Space.checkIndent end T.CRES_CT_IndentBar + |> P.bind (\_ -> P.word1 '|' T.CRES_CT_Bar) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_CT_Space T.CRES_CT_IndentAfterBar) |> P.bind (\_ -> Type.variant) |> P.bind (\( variant, newEnd ) -> chompVariants (variant :: variants) newEnd) ] @@ -276,19 +275,19 @@ chompVariants variants end = -- PORT -portDecl : Maybe T.CASTS_Comment -> Space.Parser E.CRES_Decl Decl +portDecl : Maybe T.CASTS_Comment -> Space.Parser T.CRES_Decl Decl portDecl maybeDocs = - P.inContext E.CRES_Port (Keyword.port_ E.CRES_DeclStart) <| - (Space.chompAndCheckIndent E.CRES_PortSpace E.CRES_PortIndentName - |> P.bind (\_ -> P.addLocation (Var.lower E.CRES_PortName)) + P.inContext T.CRES_Port (Keyword.port_ T.CRES_DeclStart) <| + (Space.chompAndCheckIndent T.CRES_PortSpace T.CRES_PortIndentName + |> P.bind (\_ -> P.addLocation (Var.lower T.CRES_PortName)) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_PortSpace E.CRES_PortIndentColon - |> P.bind (\_ -> P.word1 ':' E.CRES_PortColon) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_PortSpace E.CRES_PortIndentType) + Space.chompAndCheckIndent T.CRES_PortSpace T.CRES_PortIndentColon + |> P.bind (\_ -> P.word1 ':' T.CRES_PortColon) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_PortSpace T.CRES_PortIndentType) |> P.bind (\_ -> - P.specialize E.CRES_PortType Type.expression + P.specialize T.CRES_PortType Type.expression |> P.fmap (\( tipe, end ) -> ( Port maybeDocs (T.CASTS_Port name tipe) @@ -306,16 +305,16 @@ portDecl maybeDocs = -- -infix_ : P.Parser E.CRES_Module (T.CRA_Located T.CASTS_Infix) +infix_ : P.Parser T.CRES_Module (T.CRA_Located T.CASTS_Infix) infix_ = let - err : T.CPP_Row -> T.CPP_Col -> E.CRES_Module + err : T.CPP_Row -> T.CPP_Col -> T.CRES_Module err = - E.CRES_Infix + T.CRES_Infix - err_ : a -> T.CPP_Row -> T.CPP_Col -> E.CRES_Module + err_ : a -> T.CPP_Row -> T.CPP_Col -> T.CRES_Module err_ = - \_ -> E.CRES_Infix + \_ -> T.CRES_Infix in P.getPosition |> P.bind diff --git a/src/Compiler/Parse/Expression.elm b/src/Compiler/Parse/Expression.elm index 612a154f7..2755911ea 100644 --- a/src/Compiler/Parse/Expression.elm +++ b/src/Compiler/Parse/Expression.elm @@ -11,7 +11,6 @@ import Compiler.Parse.Symbol as Symbol import Compiler.Parse.Type as Type import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Syntax as E import Types as T @@ -19,12 +18,12 @@ import Types as T -- TERMS -term : P.Parser E.CRES_Expr T.CASTS_Expr +term : P.Parser T.CRES_Expr T.CASTS_Expr term = P.getPosition |> P.bind (\start -> - P.oneOf E.CRES_Start + P.oneOf T.CRES_Start [ variable start |> P.bind (accessible start) , string start , number start @@ -38,21 +37,21 @@ term = ) -string : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +string : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr string start = - String.string E.CRES_Start E.CRES_String_ + String.string T.CRES_Start T.CRES_String_ |> P.bind (\str -> P.addEnd start (T.CASTS_Str str)) -character : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +character : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr character start = - String.character E.CRES_Start E.CRES_Char + String.character T.CRES_Start T.CRES_Char |> P.bind (\chr -> P.addEnd start (T.CASTS_Chr chr)) -number : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +number : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr number start = - Number.number E.CRES_Start E.CRES_Number + Number.number T.CRES_Start T.CRES_Number |> P.bind (\nmbr -> P.addEnd start <| @@ -65,27 +64,27 @@ number start = ) -accessor : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +accessor : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr accessor start = - P.word1 '.' E.CRES_Dot - |> P.bind (\_ -> Var.lower E.CRES_Access) + P.word1 '.' T.CRES_Dot + |> P.bind (\_ -> Var.lower T.CRES_Access) |> P.bind (\field -> P.addEnd start (T.CASTS_Accessor field)) -variable : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +variable : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr variable start = - Var.foreignAlpha E.CRES_Start + Var.foreignAlpha T.CRES_Start |> P.bind (\var -> P.addEnd start var) -accessible : T.CRA_Position -> T.CASTS_Expr -> P.Parser E.CRES_Expr T.CASTS_Expr +accessible : T.CRA_Position -> T.CASTS_Expr -> P.Parser T.CRES_Expr T.CASTS_Expr accessible start expr = P.oneOfWithFallback - [ P.word1 '.' E.CRES_Dot + [ P.word1 '.' T.CRES_Dot |> P.bind (\_ -> P.getPosition) |> P.bind (\pos -> - Var.lower E.CRES_Access + Var.lower T.CRES_Access |> P.bind (\field -> P.getPosition @@ -104,38 +103,38 @@ accessible start expr = -- LISTS -list : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +list : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr list start = - P.inContext E.CRES_List (P.word1 '[' E.CRES_Start) <| - (Space.chompAndCheckIndent E.CRES_ListSpace E.CRES_ListIndentOpen + P.inContext T.CRES_List (P.word1 '[' T.CRES_Start) <| + (Space.chompAndCheckIndent T.CRES_ListSpace T.CRES_ListIndentOpen |> P.bind (\_ -> - P.oneOf E.CRES_ListOpen - [ P.specialize E.CRES_ListExpr expression + P.oneOf T.CRES_ListOpen + [ P.specialize T.CRES_ListExpr expression |> P.bind (\( entry, end ) -> - Space.checkIndent end E.CRES_ListIndentEnd + Space.checkIndent end T.CRES_ListIndentEnd |> P.bind (\_ -> chompListEnd start [ entry ]) ) - , P.word1 ']' E.CRES_ListOpen + , P.word1 ']' T.CRES_ListOpen |> P.bind (\_ -> P.addEnd start (T.CASTS_List [])) ] ) ) -chompListEnd : T.CRA_Position -> List T.CASTS_Expr -> P.Parser E.CRES_List_ T.CASTS_Expr +chompListEnd : T.CRA_Position -> List T.CASTS_Expr -> P.Parser T.CRES_List_ T.CASTS_Expr chompListEnd start entries = - P.oneOf E.CRES_ListEnd - [ P.word1 ',' E.CRES_ListEnd - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ListSpace E.CRES_ListIndentExpr) - |> P.bind (\_ -> P.specialize E.CRES_ListExpr expression) + P.oneOf T.CRES_ListEnd + [ P.word1 ',' T.CRES_ListEnd + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ListSpace T.CRES_ListIndentExpr) + |> P.bind (\_ -> P.specialize T.CRES_ListExpr expression) |> P.bind (\( entry, end ) -> - Space.checkIndent end E.CRES_ListIndentEnd + Space.checkIndent end T.CRES_ListIndentEnd |> P.bind (\_ -> chompListEnd start (entry :: entries)) ) - , P.word1 ']' E.CRES_ListEnd + , P.word1 ']' T.CRES_ListEnd |> P.bind (\_ -> P.addEnd start (T.CASTS_List (List.reverse entries))) ] @@ -144,40 +143,40 @@ chompListEnd start entries = -- TUPLES -tuple : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +tuple : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr tuple ((T.CRA_Position row col) as start) = - P.inContext E.CRES_Tuple (P.word1 '(' E.CRES_Start) <| + P.inContext T.CRES_Tuple (P.word1 '(' T.CRES_Start) <| (P.getPosition |> P.bind (\before -> - Space.chompAndCheckIndent E.CRES_TupleSpace E.CRES_TupleIndentExpr1 + Space.chompAndCheckIndent T.CRES_TupleSpace T.CRES_TupleIndentExpr1 |> P.bind (\_ -> P.getPosition |> P.bind (\after -> if before /= after then - P.specialize E.CRES_TupleExpr expression + P.specialize T.CRES_TupleExpr expression |> P.bind (\( entry, end ) -> - Space.checkIndent end E.CRES_TupleIndentEnd + Space.checkIndent end T.CRES_TupleIndentEnd |> P.bind (\_ -> chompTupleEnd start entry []) ) else - P.oneOf E.CRES_TupleIndentExpr1 - [ Symbol.operator E.CRES_TupleIndentExpr1 E.CRES_TupleOperatorReserved + P.oneOf T.CRES_TupleIndentExpr1 + [ Symbol.operator T.CRES_TupleIndentExpr1 T.CRES_TupleOperatorReserved |> P.bind (\op -> if op == "-" then - P.oneOf E.CRES_TupleOperatorClose - [ P.word1 ')' E.CRES_TupleOperatorClose + P.oneOf T.CRES_TupleOperatorClose + [ P.word1 ')' T.CRES_TupleOperatorClose |> P.bind (\_ -> P.addEnd start (T.CASTS_Op op)) - , P.specialize E.CRES_TupleExpr + , P.specialize T.CRES_TupleExpr (term |> P.bind (\((T.CRA_At (T.CRA_Region _ end) _) as negatedExpr) -> - Space.chomp E.CRES_Space + Space.chomp T.CRES_Space |> P.bind (\_ -> let @@ -202,21 +201,21 @@ tuple ((T.CRA_Position row col) as start) = ) |> P.bind (\( entry, end ) -> - Space.checkIndent end E.CRES_TupleIndentEnd + Space.checkIndent end T.CRES_TupleIndentEnd |> P.bind (\_ -> chompTupleEnd start entry []) ) ] else - P.word1 ')' E.CRES_TupleOperatorClose + P.word1 ')' T.CRES_TupleOperatorClose |> P.bind (\_ -> P.addEnd start (T.CASTS_Op op)) ) - , P.word1 ')' E.CRES_TupleIndentExpr1 + , P.word1 ')' T.CRES_TupleIndentExpr1 |> P.bind (\_ -> P.addEnd start T.CASTS_Unit) - , P.specialize E.CRES_TupleExpr expression + , P.specialize T.CRES_TupleExpr expression |> P.bind (\( entry, end ) -> - Space.checkIndent end E.CRES_TupleIndentEnd + Space.checkIndent end T.CRES_TupleIndentEnd |> P.bind (\_ -> chompTupleEnd start entry []) ) ] @@ -226,24 +225,24 @@ tuple ((T.CRA_Position row col) as start) = ) -chompTupleEnd : T.CRA_Position -> T.CASTS_Expr -> List T.CASTS_Expr -> P.Parser E.CRES_Tuple T.CASTS_Expr +chompTupleEnd : T.CRA_Position -> T.CASTS_Expr -> List T.CASTS_Expr -> P.Parser T.CRES_Tuple T.CASTS_Expr chompTupleEnd start firstExpr revExprs = - P.oneOf E.CRES_TupleEnd - [ P.word1 ',' E.CRES_TupleEnd + P.oneOf T.CRES_TupleEnd + [ P.word1 ',' T.CRES_TupleEnd |> P.bind (\_ -> - Space.chompAndCheckIndent E.CRES_TupleSpace E.CRES_TupleIndentExprN + Space.chompAndCheckIndent T.CRES_TupleSpace T.CRES_TupleIndentExprN |> P.bind (\_ -> - P.specialize E.CRES_TupleExpr expression + P.specialize T.CRES_TupleExpr expression |> P.bind (\( entry, end ) -> - Space.checkIndent end E.CRES_TupleIndentEnd + Space.checkIndent end T.CRES_TupleIndentEnd |> P.bind (\_ -> chompTupleEnd start firstExpr (entry :: revExprs)) ) ) ) - , P.word1 ')' E.CRES_TupleEnd + , P.word1 ')' T.CRES_TupleEnd |> P.bind (\_ -> case List.reverse revExprs of @@ -260,33 +259,33 @@ chompTupleEnd start firstExpr revExprs = -- RECORDS -record : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +record : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr record start = - P.inContext E.CRES_Record (P.word1 '{' E.CRES_Start) <| - (Space.chompAndCheckIndent E.CRES_RecordSpace E.CRES_RecordIndentOpen + P.inContext T.CRES_Record (P.word1 '{' T.CRES_Start) <| + (Space.chompAndCheckIndent T.CRES_RecordSpace T.CRES_RecordIndentOpen |> P.bind (\_ -> - P.oneOf E.CRES_RecordOpen - [ P.word1 '}' E.CRES_RecordOpen + P.oneOf T.CRES_RecordOpen + [ P.word1 '}' T.CRES_RecordOpen |> P.bind (\_ -> P.addEnd start (T.CASTS_Record [])) - , P.addLocation (Var.lower E.CRES_RecordField) + , P.addLocation (Var.lower T.CRES_RecordField) |> P.bind (\starter -> - Space.chompAndCheckIndent E.CRES_RecordSpace E.CRES_RecordIndentEquals + Space.chompAndCheckIndent T.CRES_RecordSpace T.CRES_RecordIndentEquals |> P.bind (\_ -> - P.oneOf E.CRES_RecordEquals - [ P.word1 '|' E.CRES_RecordEquals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_RecordSpace E.CRES_RecordIndentField) + P.oneOf T.CRES_RecordEquals + [ P.word1 '|' T.CRES_RecordEquals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_RecordSpace T.CRES_RecordIndentField) |> P.bind (\_ -> chompField) |> P.bind (\firstField -> chompFields [ firstField ]) |> P.bind (\fields -> P.addEnd start (T.CASTS_Update starter fields)) - , P.word1 '=' E.CRES_RecordEquals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_RecordSpace E.CRES_RecordIndentExpr) - |> P.bind (\_ -> P.specialize E.CRES_RecordExpr expression) + , P.word1 '=' T.CRES_RecordEquals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_RecordSpace T.CRES_RecordIndentExpr) + |> P.bind (\_ -> P.specialize T.CRES_RecordExpr expression) |> P.bind (\( value, end ) -> - Space.checkIndent end E.CRES_RecordIndentEnd + Space.checkIndent end T.CRES_RecordIndentEnd |> P.bind (\_ -> chompFields [ ( starter, value ) ]) |> P.bind (\fields -> P.addEnd start (T.CASTS_Record fields)) ) @@ -302,30 +301,30 @@ type alias Field = ( T.CRA_Located T.CDN_Name, T.CASTS_Expr ) -chompFields : List Field -> P.Parser E.CRES_Record (List Field) +chompFields : List Field -> P.Parser T.CRES_Record (List Field) chompFields fields = - P.oneOf E.CRES_RecordEnd - [ P.word1 ',' E.CRES_RecordEnd - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_RecordSpace E.CRES_RecordIndentField) + P.oneOf T.CRES_RecordEnd + [ P.word1 ',' T.CRES_RecordEnd + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_RecordSpace T.CRES_RecordIndentField) |> P.bind (\_ -> chompField) |> P.bind (\f -> chompFields (f :: fields)) - , P.word1 '}' E.CRES_RecordEnd + , P.word1 '}' T.CRES_RecordEnd |> P.fmap (\_ -> List.reverse fields) ] -chompField : P.Parser E.CRES_Record Field +chompField : P.Parser T.CRES_Record Field chompField = - P.addLocation (Var.lower E.CRES_RecordField) + P.addLocation (Var.lower T.CRES_RecordField) |> P.bind (\key -> - Space.chompAndCheckIndent E.CRES_RecordSpace E.CRES_RecordIndentEquals - |> P.bind (\_ -> P.word1 '=' E.CRES_RecordEquals) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_RecordSpace E.CRES_RecordIndentExpr) - |> P.bind (\_ -> P.specialize E.CRES_RecordExpr expression) + Space.chompAndCheckIndent T.CRES_RecordSpace T.CRES_RecordIndentEquals + |> P.bind (\_ -> P.word1 '=' T.CRES_RecordEquals) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_RecordSpace T.CRES_RecordIndentExpr) + |> P.bind (\_ -> P.specialize T.CRES_RecordExpr expression) |> P.bind (\( value, end ) -> - Space.checkIndent end E.CRES_RecordIndentEnd + Space.checkIndent end T.CRES_RecordIndentEnd |> P.fmap (\_ -> ( key, value )) ) ) @@ -335,12 +334,12 @@ chompField = -- EXPRESSIONS -expression : Space.Parser E.CRES_Expr T.CASTS_Expr +expression : Space.Parser T.CRES_Expr T.CASTS_Expr expression = P.getPosition |> P.bind (\start -> - P.oneOf E.CRES_Start + P.oneOf T.CRES_Start [ let_ start , if_ start , case_ start @@ -351,7 +350,7 @@ expression = P.getPosition |> P.bind (\end -> - Space.chomp E.CRES_Space + Space.chomp T.CRES_Space |> P.bind (\_ -> chompExprEnd start @@ -378,18 +377,18 @@ type State } -chompExprEnd : T.CRA_Position -> State -> Space.Parser E.CRES_Expr T.CASTS_Expr +chompExprEnd : T.CRA_Position -> State -> Space.Parser T.CRES_Expr T.CASTS_Expr chompExprEnd start (State { ops, expr, args, end }) = P.oneOfWithFallback [ -- argument - Space.checkIndent end E.CRES_Start + Space.checkIndent end T.CRES_Start |> P.bind (\_ -> term) |> P.bind (\arg -> P.getPosition |> P.bind (\newEnd -> - Space.chomp E.CRES_Space + Space.chomp T.CRES_Space |> P.bind (\_ -> chompExprEnd start @@ -404,11 +403,11 @@ chompExprEnd start (State { ops, expr, args, end }) = ) ) , -- operator - Space.checkIndent end E.CRES_Start - |> P.bind (\_ -> P.addLocation (Symbol.operator E.CRES_Start E.CRES_OperatorReserved)) + Space.checkIndent end T.CRES_Start + |> P.bind (\_ -> P.addLocation (Symbol.operator T.CRES_Start T.CRES_OperatorReserved)) |> P.bind (\((T.CRA_At (T.CRA_Region opStart opEnd) opName) as op) -> - Space.chompAndCheckIndent E.CRES_Space (E.CRES_IndentOperatorRight opName) + Space.chompAndCheckIndent T.CRES_Space (T.CRES_IndentOperatorRight opName) |> P.bind (\_ -> P.getPosition) |> P.bind (\newStart -> @@ -420,7 +419,7 @@ chompExprEnd start (State { ops, expr, args, end }) = P.getPosition |> P.bind (\newEnd -> - Space.chomp E.CRES_Space + Space.chomp T.CRES_Space |> P.bind (\_ -> let @@ -442,9 +441,9 @@ chompExprEnd start (State { ops, expr, args, end }) = else let - err : T.CPP_Row -> T.CPP_Col -> E.CRES_Expr + err : T.CPP_Row -> T.CPP_Col -> T.CRES_Expr err = - E.CRES_OperatorRight opName + T.CRES_OperatorRight opName in P.oneOf err [ -- term @@ -454,7 +453,7 @@ chompExprEnd start (State { ops, expr, args, end }) = P.getPosition |> P.bind (\newEnd -> - Space.chomp E.CRES_Space + Space.chomp T.CRES_Space |> P.bind (\_ -> let @@ -511,10 +510,10 @@ chompExprEnd start (State { ops, expr, args, end }) = ) -possiblyNegativeTerm : T.CRA_Position -> P.Parser E.CRES_Expr T.CASTS_Expr +possiblyNegativeTerm : T.CRA_Position -> P.Parser T.CRES_Expr T.CASTS_Expr possiblyNegativeTerm start = - P.oneOf E.CRES_Start - [ P.word1 '-' E.CRES_Start + P.oneOf T.CRES_Start + [ P.word1 '-' T.CRES_Start |> P.bind (\_ -> term @@ -541,27 +540,27 @@ toCall func revArgs = -- IF EXPRESSION -if_ : T.CRA_Position -> Space.Parser E.CRES_Expr T.CASTS_Expr +if_ : T.CRA_Position -> Space.Parser T.CRES_Expr T.CASTS_Expr if_ start = - P.inContext E.CRES_If (Keyword.if_ E.CRES_Start) <| + P.inContext T.CRES_If (Keyword.if_ T.CRES_Start) <| chompIfEnd start [] -chompIfEnd : T.CRA_Position -> List ( T.CASTS_Expr, T.CASTS_Expr ) -> Space.Parser E.CRES_If T.CASTS_Expr +chompIfEnd : T.CRA_Position -> List ( T.CASTS_Expr, T.CASTS_Expr ) -> Space.Parser T.CRES_If T.CASTS_Expr chompIfEnd start branches = - Space.chompAndCheckIndent E.CRES_IfSpace E.CRES_IfIndentCondition - |> P.bind (\_ -> P.specialize E.CRES_IfCondition expression) + Space.chompAndCheckIndent T.CRES_IfSpace T.CRES_IfIndentCondition + |> P.bind (\_ -> P.specialize T.CRES_IfCondition expression) |> P.bind (\( condition, condEnd ) -> - Space.checkIndent condEnd E.CRES_IfIndentThen - |> P.bind (\_ -> Keyword.then_ E.CRES_IfThen) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_IfSpace E.CRES_IfIndentThenBranch) - |> P.bind (\_ -> P.specialize E.CRES_IfThenBranch expression) + Space.checkIndent condEnd T.CRES_IfIndentThen + |> P.bind (\_ -> Keyword.then_ T.CRES_IfThen) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_IfSpace T.CRES_IfIndentThenBranch) + |> P.bind (\_ -> P.specialize T.CRES_IfThenBranch expression) |> P.bind (\( thenBranch, thenEnd ) -> - Space.checkIndent thenEnd E.CRES_IfIndentElse - |> P.bind (\_ -> Keyword.else_ E.CRES_IfElse) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_IfSpace E.CRES_IfIndentElseBranch) + Space.checkIndent thenEnd T.CRES_IfIndentElse + |> P.bind (\_ -> Keyword.else_ T.CRES_IfElse) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_IfSpace T.CRES_IfIndentElseBranch) |> P.bind (\_ -> let @@ -569,10 +568,10 @@ chompIfEnd start branches = newBranches = ( condition, thenBranch ) :: branches in - P.oneOf E.CRES_IfElseBranchStart - [ Keyword.if_ E.CRES_IfElseBranchStart + P.oneOf T.CRES_IfElseBranchStart + [ Keyword.if_ T.CRES_IfElseBranchStart |> P.bind (\_ -> chompIfEnd start newBranches) - , P.specialize E.CRES_IfElseBranch expression + , P.specialize T.CRES_IfElseBranch expression |> P.fmap (\( elseBranch, elseEnd ) -> let @@ -592,19 +591,19 @@ chompIfEnd start branches = -- LAMBDA EXPRESSION -function : T.CRA_Position -> Space.Parser E.CRES_Expr T.CASTS_Expr +function : T.CRA_Position -> Space.Parser T.CRES_Expr T.CASTS_Expr function start = - P.inContext E.CRES_Func (P.word1 '\\' E.CRES_Start) <| - (Space.chompAndCheckIndent E.CRES_FuncSpace E.CRES_FuncIndentArg - |> P.bind (\_ -> P.specialize E.CRES_FuncArg Pattern.term) + P.inContext T.CRES_Func (P.word1 '\\' T.CRES_Start) <| + (Space.chompAndCheckIndent T.CRES_FuncSpace T.CRES_FuncIndentArg + |> P.bind (\_ -> P.specialize T.CRES_FuncArg Pattern.term) |> P.bind (\arg -> - Space.chompAndCheckIndent E.CRES_FuncSpace E.CRES_FuncIndentArrow + Space.chompAndCheckIndent T.CRES_FuncSpace T.CRES_FuncIndentArrow |> P.bind (\_ -> chompArgs [ arg ]) |> P.bind (\revArgs -> - Space.chompAndCheckIndent E.CRES_FuncSpace E.CRES_FuncIndentBody - |> P.bind (\_ -> P.specialize E.CRES_FuncBody expression) + Space.chompAndCheckIndent T.CRES_FuncSpace T.CRES_FuncIndentBody + |> P.bind (\_ -> P.specialize T.CRES_FuncBody expression) |> P.fmap (\( body, end ) -> let @@ -619,16 +618,16 @@ function start = ) -chompArgs : List T.CASTS_Pattern -> P.Parser E.CRES_Func (List T.CASTS_Pattern) +chompArgs : List T.CASTS_Pattern -> P.Parser T.CRES_Func (List T.CASTS_Pattern) chompArgs revArgs = - P.oneOf E.CRES_FuncArrow - [ P.specialize E.CRES_FuncArg Pattern.term + P.oneOf T.CRES_FuncArrow + [ P.specialize T.CRES_FuncArg Pattern.term |> P.bind (\arg -> - Space.chompAndCheckIndent E.CRES_FuncSpace E.CRES_FuncIndentArrow + Space.chompAndCheckIndent T.CRES_FuncSpace T.CRES_FuncIndentArrow |> P.bind (\_ -> chompArgs (arg :: revArgs)) ) - , P.word2 '-' '>' E.CRES_FuncArrow + , P.word2 '-' '>' T.CRES_FuncArrow |> P.fmap (\_ -> revArgs) ] @@ -637,16 +636,16 @@ chompArgs revArgs = -- CASE EXPRESSIONS -case_ : T.CRA_Position -> Space.Parser E.CRES_Expr T.CASTS_Expr +case_ : T.CRA_Position -> Space.Parser T.CRES_Expr T.CASTS_Expr case_ start = - P.inContext E.CRES_Case (Keyword.case_ E.CRES_Start) <| - (Space.chompAndCheckIndent E.CRES_CaseSpace E.CRES_CaseIndentExpr - |> P.bind (\_ -> P.specialize E.CRES_CaseExpr expression) + P.inContext T.CRES_Case (Keyword.case_ T.CRES_Start) <| + (Space.chompAndCheckIndent T.CRES_CaseSpace T.CRES_CaseIndentExpr + |> P.bind (\_ -> P.specialize T.CRES_CaseExpr expression) |> P.bind (\( expr, exprEnd ) -> - Space.checkIndent exprEnd E.CRES_CaseIndentOf - |> P.bind (\_ -> Keyword.of_ E.CRES_CaseOf) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_CaseSpace E.CRES_CaseIndentPattern) + Space.checkIndent exprEnd T.CRES_CaseIndentOf + |> P.bind (\_ -> Keyword.of_ T.CRES_CaseOf) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_CaseSpace T.CRES_CaseIndentPattern) |> P.bind (\_ -> P.withIndent <| @@ -667,23 +666,23 @@ case_ start = ) -chompBranch : Space.Parser E.CRES_Case ( T.CASTS_Pattern, T.CASTS_Expr ) +chompBranch : Space.Parser T.CRES_Case ( T.CASTS_Pattern, T.CASTS_Expr ) chompBranch = - P.specialize E.CRES_CasePattern Pattern.expression + P.specialize T.CRES_CasePattern Pattern.expression |> P.bind (\( pattern, patternEnd ) -> - Space.checkIndent patternEnd E.CRES_CaseIndentArrow - |> P.bind (\_ -> P.word2 '-' '>' E.CRES_CaseArrow) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_CaseSpace E.CRES_CaseIndentBranch) - |> P.bind (\_ -> P.specialize E.CRES_CaseBranch expression) + Space.checkIndent patternEnd T.CRES_CaseIndentArrow + |> P.bind (\_ -> P.word2 '-' '>' T.CRES_CaseArrow) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_CaseSpace T.CRES_CaseIndentBranch) + |> P.bind (\_ -> P.specialize T.CRES_CaseBranch expression) |> P.fmap (\( branchExpr, end ) -> ( ( pattern, branchExpr ), end )) ) -chompCaseEnd : List ( T.CASTS_Pattern, T.CASTS_Expr ) -> T.CRA_Position -> Space.Parser E.CRES_Case (List ( T.CASTS_Pattern, T.CASTS_Expr )) +chompCaseEnd : List ( T.CASTS_Pattern, T.CASTS_Expr ) -> T.CRA_Position -> Space.Parser T.CRES_Case (List ( T.CASTS_Pattern, T.CASTS_Expr )) chompCaseEnd branches end = P.oneOfWithFallback - [ Space.checkAligned E.CRES_CasePatternAlignment + [ Space.checkAligned T.CRES_CasePatternAlignment |> P.bind (\_ -> chompBranch) |> P.bind (\( branch, newEnd ) -> chompCaseEnd (branch :: branches) newEnd) ] @@ -694,11 +693,11 @@ chompCaseEnd branches end = -- LET EXPRESSION -let_ : T.CRA_Position -> Space.Parser E.CRES_Expr T.CASTS_Expr +let_ : T.CRA_Position -> Space.Parser T.CRES_Expr T.CASTS_Expr let_ start = - P.inContext E.CRES_Let (Keyword.let_ E.CRES_Start) <| + P.inContext T.CRES_Let (Keyword.let_ T.CRES_Start) <| ((P.withBacksetIndent 3 <| - (Space.chompAndCheckIndent E.CRES_LetSpace E.CRES_LetIndentDef + (Space.chompAndCheckIndent T.CRES_LetSpace T.CRES_LetIndentDef |> P.bind (\_ -> P.withIndent <| @@ -710,10 +709,10 @@ let_ start = ) |> P.bind (\( defs, defsEnd ) -> - Space.checkIndent defsEnd E.CRES_LetIndentIn - |> P.bind (\_ -> Keyword.in_ E.CRES_LetIn) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_LetSpace E.CRES_LetIndentBody) - |> P.bind (\_ -> P.specialize E.CRES_LetBody expression) + Space.checkIndent defsEnd T.CRES_LetIndentIn + |> P.bind (\_ -> Keyword.in_ T.CRES_LetIn) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_LetSpace T.CRES_LetIndentBody) + |> P.bind (\_ -> P.specialize T.CRES_LetBody expression) |> P.fmap (\( body, end ) -> ( A.at start end (T.CASTS_Let defs body), end ) @@ -722,10 +721,10 @@ let_ start = ) -chompLetDefs : List (T.CRA_Located T.CASTS_Def) -> T.CRA_Position -> Space.Parser E.CRES_Let (List (T.CRA_Located T.CASTS_Def)) +chompLetDefs : List (T.CRA_Located T.CASTS_Def) -> T.CRA_Position -> Space.Parser T.CRES_Let (List (T.CRA_Located T.CASTS_Def)) chompLetDefs revDefs end = P.oneOfWithFallback - [ Space.checkAligned E.CRES_LetDefAlignment + [ Space.checkAligned T.CRES_LetDefAlignment |> P.bind (\_ -> chompLetDef) |> P.bind (\( def, newEnd ) -> chompLetDefs (def :: revDefs) newEnd) ] @@ -736,9 +735,9 @@ chompLetDefs revDefs end = -- LET DEFINITIONS -chompLetDef : Space.Parser E.CRES_Let (T.CRA_Located T.CASTS_Def) +chompLetDef : Space.Parser T.CRES_Let (T.CRA_Located T.CASTS_Def) chompLetDef = - P.oneOf E.CRES_LetDefName + P.oneOf T.CRES_LetDefName [ definition , destructure ] @@ -748,26 +747,26 @@ chompLetDef = -- DEFINITION -definition : Space.Parser E.CRES_Let (T.CRA_Located T.CASTS_Def) +definition : Space.Parser T.CRES_Let (T.CRA_Located T.CASTS_Def) definition = - P.addLocation (Var.lower E.CRES_LetDefName) + P.addLocation (Var.lower T.CRES_LetDefName) |> P.bind (\((T.CRA_At (T.CRA_Region start _) name) as aname) -> - P.specialize (E.CRES_LetDef name) <| - (Space.chompAndCheckIndent E.CRES_DefSpace E.CRES_DefIndentEquals + P.specialize (T.CRES_LetDef name) <| + (Space.chompAndCheckIndent T.CRES_DefSpace T.CRES_DefIndentEquals |> P.bind (\_ -> - P.oneOf E.CRES_DefEquals - [ P.word1 ':' E.CRES_DefEquals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_DefSpace E.CRES_DefIndentType) - |> P.bind (\_ -> P.specialize E.CRES_DefType Type.expression) + P.oneOf T.CRES_DefEquals + [ P.word1 ':' T.CRES_DefEquals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_DefSpace T.CRES_DefIndentType) + |> P.bind (\_ -> P.specialize T.CRES_DefType Type.expression) |> P.bind (\( tipe, _ ) -> - Space.checkAligned E.CRES_DefAlignment + Space.checkAligned T.CRES_DefAlignment |> P.bind (\_ -> chompMatchingName name) |> P.bind (\defName -> - Space.chompAndCheckIndent E.CRES_DefSpace E.CRES_DefIndentEquals + Space.chompAndCheckIndent T.CRES_DefSpace T.CRES_DefIndentEquals |> P.bind (\_ -> chompDefArgsAndBody start defName (Just tipe) []) ) ) @@ -778,18 +777,18 @@ definition = ) -chompDefArgsAndBody : T.CRA_Position -> T.CRA_Located T.CDN_Name -> Maybe T.CASTS_Type -> List T.CASTS_Pattern -> Space.Parser E.CRES_Def (T.CRA_Located T.CASTS_Def) +chompDefArgsAndBody : T.CRA_Position -> T.CRA_Located T.CDN_Name -> Maybe T.CASTS_Type -> List T.CASTS_Pattern -> Space.Parser T.CRES_Def (T.CRA_Located T.CASTS_Def) chompDefArgsAndBody start name tipe revArgs = - P.oneOf E.CRES_DefEquals - [ P.specialize E.CRES_DefArg Pattern.term + P.oneOf T.CRES_DefEquals + [ P.specialize T.CRES_DefArg Pattern.term |> P.bind (\arg -> - Space.chompAndCheckIndent E.CRES_DefSpace E.CRES_DefIndentEquals + Space.chompAndCheckIndent T.CRES_DefSpace T.CRES_DefIndentEquals |> P.bind (\_ -> chompDefArgsAndBody start name tipe (arg :: revArgs)) ) - , P.word1 '=' E.CRES_DefEquals - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_DefSpace E.CRES_DefIndentBody) - |> P.bind (\_ -> P.specialize E.CRES_DefBody expression) + , P.word1 '=' T.CRES_DefEquals + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_DefSpace T.CRES_DefIndentBody) + |> P.bind (\_ -> P.specialize T.CRES_DefBody expression) |> P.fmap (\( body, end ) -> ( A.at start end (T.CASTS_Define name (List.reverse revArgs) body tipe) @@ -799,11 +798,11 @@ chompDefArgsAndBody start name tipe revArgs = ] -chompMatchingName : T.CDN_Name -> P.Parser E.CRES_Def (T.CRA_Located T.CDN_Name) +chompMatchingName : T.CDN_Name -> P.Parser T.CRES_Def (T.CRA_Located T.CDN_Name) chompMatchingName expectedName = let (P.Parser parserL) = - Var.lower E.CRES_DefNameRepeat + Var.lower T.CRES_DefNameRepeat in P.Parser <| \((P.State _ _ _ _ sr sc) as state) -> @@ -813,7 +812,7 @@ chompMatchingName expectedName = Ok (P.POk status (T.CRA_At (T.CRA_Region (T.CRA_Position sr sc) (T.CRA_Position er ec)) name) newState) else - Err (P.PErr status sr sc (E.CRES_DefNameMatch name)) + Err (P.PErr status sr sc (T.CRES_DefNameMatch name)) ) (parserL state) @@ -822,19 +821,19 @@ chompMatchingName expectedName = -- DESTRUCTURE -destructure : Space.Parser E.CRES_Let (T.CRA_Located T.CASTS_Def) +destructure : Space.Parser T.CRES_Let (T.CRA_Located T.CASTS_Def) destructure = - P.specialize E.CRES_LetDestruct <| + P.specialize T.CRES_LetDestruct <| (P.getPosition |> P.bind (\start -> - P.specialize E.CRES_DestructPattern Pattern.term + P.specialize T.CRES_DestructPattern Pattern.term |> P.bind (\pattern -> - Space.chompAndCheckIndent E.CRES_DestructSpace E.CRES_DestructIndentEquals - |> P.bind (\_ -> P.word1 '=' E.CRES_DestructEquals) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_DestructSpace E.CRES_DestructIndentBody) - |> P.bind (\_ -> P.specialize E.CRES_DestructBody expression) + Space.chompAndCheckIndent T.CRES_DestructSpace T.CRES_DestructIndentEquals + |> P.bind (\_ -> P.word1 '=' T.CRES_DestructEquals) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_DestructSpace T.CRES_DestructIndentBody) + |> P.bind (\_ -> P.specialize T.CRES_DestructBody expression) |> P.fmap (\( expr, end ) -> ( A.at start end (T.CASTS_Destruct pattern expr) diff --git a/src/Compiler/Parse/Module.elm b/src/Compiler/Parse/Module.elm index 27ac2b885..4113f855c 100644 --- a/src/Compiler/Parse/Module.elm +++ b/src/Compiler/Parse/Module.elm @@ -15,7 +15,6 @@ import Compiler.Parse.Space as Space import Compiler.Parse.Symbol as Symbol import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Syntax as E import Types as T @@ -23,14 +22,14 @@ import Types as T -- FROM BYTE STRING -fromByteString : ProjectType -> String -> Result E.CRES_Error T.CASTS_Module +fromByteString : ProjectType -> String -> Result T.CRES_Error T.CASTS_Module fromByteString projectType source = - case P.fromByteString (chompModule projectType) E.CRES_ModuleBadEnd source of + case P.fromByteString (chompModule projectType) T.CRES_ModuleBadEnd source of Ok modul -> checkModule projectType modul Err err -> - Err (E.CRES_ParseError err) + Err (T.CRES_ParseError err) @@ -74,7 +73,7 @@ type alias Module = } -chompModule : ProjectType -> P.Parser E.CRES_Module Module +chompModule : ProjectType -> P.Parser T.CRES_Module Module chompModule projectType = chompHeader |> P.bind @@ -96,7 +95,7 @@ chompModule projectType = ) |> P.bind (\infixes -> - P.specialize E.CRES_Declarations (chompDecls []) + P.specialize T.CRES_Declarations (chompDecls []) |> P.fmap (\decls -> Module @@ -114,7 +113,7 @@ chompModule projectType = -- CHECK MODULE -checkModule : ProjectType -> Module -> Result E.CRES_Error T.CASTS_Module +checkModule : ProjectType -> Module -> Result T.CRES_Error T.CASTS_Module checkModule projectType module_ = let ( ( values, unions ), ( aliases, ports ) ) = @@ -156,7 +155,7 @@ checkModule projectType module_ = ) -checkEffects : ProjectType -> List T.CASTS_Port -> Effects -> Result E.CRES_Error T.CASTS_Effects +checkEffects : ProjectType -> List T.CASTS_Port -> Effects -> Result T.CRES_Error T.CASTS_Effects checkEffects projectType ports effects = case effects of NoEffects region -> @@ -167,20 +166,20 @@ checkEffects projectType ports effects = (T.CASTS_Port name _) :: _ -> case projectType of Package _ -> - Err (E.CRES_NoPortsInPackage name) + Err (T.CRES_NoPortsInPackage name) Application -> - Err (E.CRES_UnexpectedPort region) + Err (T.CRES_UnexpectedPort region) Ports region -> case projectType of Package _ -> - Err (E.CRES_NoPortModulesInPackage region) + Err (T.CRES_NoPortModulesInPackage region) Application -> case ports of [] -> - Err (E.CRES_NoPorts region) + Err (T.CRES_NoPorts region) _ :: _ -> Ok (T.CASTS_Ports ports) @@ -192,10 +191,10 @@ checkEffects projectType ports effects = Ok (T.CASTS_Manager region manager) _ :: _ -> - Err (E.CRES_UnexpectedPort region) + Err (T.CRES_UnexpectedPort region) else - Err (E.CRES_NoEffectsOutsideKernel region) + Err (T.CRES_NoEffectsOutsideKernel region) categorizeDecls : List (T.CRA_Located T.CASTS_Value) -> List (T.CRA_Located T.CASTS_Union) -> List (T.CRA_Located T.CASTS_Alias) -> List T.CASTS_Port -> List Decl.Decl -> ( ( List (T.CRA_Located T.CASTS_Value), List (T.CRA_Located T.CASTS_Union) ), ( List (T.CRA_Located T.CASTS_Alias), List T.CASTS_Port ) ) @@ -268,9 +267,9 @@ addComment maybeComment (T.CRA_At _ name) comments = -- FRESH LINES -freshLine : (T.CPP_Row -> T.CPP_Col -> E.CRES_Module) -> P.Parser E.CRES_Module () +freshLine : (T.CPP_Row -> T.CPP_Col -> T.CRES_Module) -> P.Parser T.CRES_Module () freshLine toFreshLineError = - Space.chomp E.CRES_ModuleSpace + Space.chomp T.CRES_ModuleSpace |> P.bind (\_ -> Space.checkFreshLine toFreshLineError) @@ -278,20 +277,20 @@ freshLine toFreshLineError = -- CHOMP DECLARATIONS -chompDecls : List Decl.Decl -> P.Parser E.CRES_Decl (List Decl.Decl) +chompDecls : List Decl.Decl -> P.Parser T.CRES_Decl (List Decl.Decl) chompDecls decls = Decl.declaration |> P.bind (\( decl, _ ) -> P.oneOfWithFallback - [ Space.checkFreshLine E.CRES_DeclStart + [ Space.checkFreshLine T.CRES_DeclStart |> P.bind (\_ -> chompDecls (decl :: decls)) ] (List.reverse (decl :: decls)) ) -chompInfixes : List (T.CRA_Located T.CASTS_Infix) -> P.Parser E.CRES_Module (List (T.CRA_Located T.CASTS_Infix)) +chompInfixes : List (T.CRA_Located T.CASTS_Infix) -> P.Parser T.CRES_Module (List (T.CRA_Located T.CASTS_Infix)) chompInfixes infixes = P.oneOfWithFallback [ Decl.infix_ @@ -304,17 +303,17 @@ chompInfixes infixes = -- MODULE DOC COMMENT -chompModuleDocCommentSpace : P.Parser E.CRES_Module (Result T.CRA_Region T.CASTS_Comment) +chompModuleDocCommentSpace : P.Parser T.CRES_Module (Result T.CRA_Region T.CASTS_Comment) chompModuleDocCommentSpace = - P.addLocation (freshLine E.CRES_FreshLine) + P.addLocation (freshLine T.CRES_FreshLine) |> P.bind (\(T.CRA_At region ()) -> P.oneOfWithFallback - [ Space.docComment E.CRES_ImportStart E.CRES_ModuleSpace + [ Space.docComment T.CRES_ImportStart T.CRES_ModuleSpace |> P.bind (\docComment -> - Space.chomp E.CRES_ModuleSpace - |> P.bind (\_ -> Space.checkFreshLine E.CRES_FreshLine) + Space.chomp T.CRES_ModuleSpace + |> P.bind (\_ -> Space.checkFreshLine T.CRES_FreshLine) |> P.fmap (\_ -> Ok docComment) ) ] @@ -340,26 +339,26 @@ type Effects | Manager T.CRA_Region T.CASTS_Manager -chompHeader : P.Parser E.CRES_Module (Maybe Header) +chompHeader : P.Parser T.CRES_Module (Maybe Header) chompHeader = - freshLine E.CRES_FreshLine + freshLine T.CRES_FreshLine |> P.bind (\_ -> P.getPosition) |> P.bind (\start -> P.oneOfWithFallback [ -- module MyThing exposing (..) - Keyword.module_ E.CRES_ModuleProblem + Keyword.module_ T.CRES_ModuleProblem |> P.bind (\_ -> P.getPosition) |> P.bind (\effectEnd -> - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_ModuleProblem - |> P.bind (\_ -> P.addLocation (Var.moduleName E.CRES_ModuleName)) + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_ModuleProblem + |> P.bind (\_ -> P.addLocation (Var.moduleName T.CRES_ModuleName)) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_ModuleProblem - |> P.bind (\_ -> Keyword.exposing_ E.CRES_ModuleProblem) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_ModuleProblem) - |> P.bind (\_ -> P.addLocation (P.specialize E.CRES_ModuleExposing exposing_)) + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_ModuleProblem + |> P.bind (\_ -> Keyword.exposing_ T.CRES_ModuleProblem) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_ModuleProblem) + |> P.bind (\_ -> P.addLocation (P.specialize T.CRES_ModuleExposing exposing_)) |> P.bind (\exports -> chompModuleDocCommentSpace @@ -376,20 +375,20 @@ chompHeader = ) ) , -- port module MyThing exposing (..) - Keyword.port_ E.CRES_PortModuleProblem - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_PortModuleProblem) - |> P.bind (\_ -> Keyword.module_ E.CRES_PortModuleProblem) + Keyword.port_ T.CRES_PortModuleProblem + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_PortModuleProblem) + |> P.bind (\_ -> Keyword.module_ T.CRES_PortModuleProblem) |> P.bind (\_ -> P.getPosition) |> P.bind (\effectEnd -> - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_PortModuleProblem - |> P.bind (\_ -> P.addLocation (Var.moduleName E.CRES_PortModuleName)) + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_PortModuleProblem + |> P.bind (\_ -> P.addLocation (Var.moduleName T.CRES_PortModuleName)) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_PortModuleProblem - |> P.bind (\_ -> Keyword.exposing_ E.CRES_PortModuleProblem) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_PortModuleProblem) - |> P.bind (\_ -> P.addLocation (P.specialize E.CRES_PortModuleExposing exposing_)) + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_PortModuleProblem + |> P.bind (\_ -> Keyword.exposing_ T.CRES_PortModuleProblem) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_PortModuleProblem) + |> P.bind (\_ -> P.addLocation (P.specialize T.CRES_PortModuleExposing exposing_)) |> P.bind (\exports -> chompModuleDocCommentSpace @@ -406,26 +405,26 @@ chompHeader = ) ) , -- effect module MyThing where { command = MyCmd } exposing (..) - Keyword.effect_ E.CRES_Effect - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_Effect) - |> P.bind (\_ -> Keyword.module_ E.CRES_Effect) + Keyword.effect_ T.CRES_Effect + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_Effect) + |> P.bind (\_ -> Keyword.module_ T.CRES_Effect) |> P.bind (\_ -> P.getPosition) |> P.bind (\effectEnd -> - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_Effect - |> P.bind (\_ -> P.addLocation (Var.moduleName E.CRES_ModuleName)) + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_Effect + |> P.bind (\_ -> P.addLocation (Var.moduleName T.CRES_ModuleName)) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_Effect - |> P.bind (\_ -> Keyword.where_ E.CRES_Effect) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_Effect) + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_Effect + |> P.bind (\_ -> Keyword.where_ T.CRES_Effect) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_Effect) |> P.bind (\_ -> chompManager) |> P.bind (\manager -> - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_Effect - |> P.bind (\_ -> Keyword.exposing_ E.CRES_Effect) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_Effect) - |> P.bind (\_ -> P.addLocation (P.specialize (\_ -> E.CRES_Effect) exposing_)) + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_Effect + |> P.bind (\_ -> Keyword.exposing_ T.CRES_Effect) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_Effect) + |> P.bind (\_ -> P.addLocation (P.specialize (\_ -> T.CRES_Effect) exposing_)) |> P.bind (\exports -> chompModuleDocCommentSpace @@ -444,30 +443,30 @@ chompHeader = ) -chompManager : P.Parser E.CRES_Module T.CASTS_Manager +chompManager : P.Parser T.CRES_Module T.CASTS_Manager chompManager = - P.word1 '{' E.CRES_Effect + P.word1 '{' T.CRES_Effect |> P.bind (\_ -> spaces_em) |> P.bind (\_ -> - P.oneOf E.CRES_Effect + P.oneOf T.CRES_Effect [ chompCommand |> P.bind (\cmd -> spaces_em |> P.bind (\_ -> - P.oneOf E.CRES_Effect - [ P.word1 '}' E.CRES_Effect + P.oneOf T.CRES_Effect + [ P.word1 '}' T.CRES_Effect |> P.bind (\_ -> spaces_em) |> P.fmap (\_ -> T.CASTS_Cmd cmd) - , P.word1 ',' E.CRES_Effect + , P.word1 ',' T.CRES_Effect |> P.bind (\_ -> spaces_em) |> P.bind (\_ -> chompSubscription) |> P.bind (\sub -> spaces_em - |> P.bind (\_ -> P.word1 '}' E.CRES_Effect) + |> P.bind (\_ -> P.word1 '}' T.CRES_Effect) |> P.bind (\_ -> spaces_em) |> P.fmap (\_ -> T.CASTS_Fx cmd sub) ) @@ -480,17 +479,17 @@ chompManager = spaces_em |> P.bind (\_ -> - P.oneOf E.CRES_Effect - [ P.word1 '}' E.CRES_Effect + P.oneOf T.CRES_Effect + [ P.word1 '}' T.CRES_Effect |> P.bind (\_ -> spaces_em) |> P.fmap (\_ -> T.CASTS_Sub sub) - , P.word1 ',' E.CRES_Effect + , P.word1 ',' T.CRES_Effect |> P.bind (\_ -> spaces_em) |> P.bind (\_ -> chompCommand) |> P.bind (\cmd -> spaces_em - |> P.bind (\_ -> P.word1 '}' E.CRES_Effect) + |> P.bind (\_ -> P.word1 '}' T.CRES_Effect) |> P.bind (\_ -> spaces_em) |> P.fmap (\_ -> T.CASTS_Fx cmd sub) ) @@ -501,34 +500,34 @@ chompManager = ) -chompCommand : P.Parser E.CRES_Module (T.CRA_Located T.CDN_Name) +chompCommand : P.Parser T.CRES_Module (T.CRA_Located T.CDN_Name) chompCommand = - Keyword.command_ E.CRES_Effect + Keyword.command_ T.CRES_Effect |> P.bind (\_ -> spaces_em) - |> P.bind (\_ -> P.word1 '=' E.CRES_Effect) + |> P.bind (\_ -> P.word1 '=' T.CRES_Effect) |> P.bind (\_ -> spaces_em) - |> P.bind (\_ -> P.addLocation (Var.upper E.CRES_Effect)) + |> P.bind (\_ -> P.addLocation (Var.upper T.CRES_Effect)) -chompSubscription : P.Parser E.CRES_Module (T.CRA_Located T.CDN_Name) +chompSubscription : P.Parser T.CRES_Module (T.CRA_Located T.CDN_Name) chompSubscription = - Keyword.subscription_ E.CRES_Effect + Keyword.subscription_ T.CRES_Effect |> P.bind (\_ -> spaces_em) - |> P.bind (\_ -> P.word1 '=' E.CRES_Effect) + |> P.bind (\_ -> P.word1 '=' T.CRES_Effect) |> P.bind (\_ -> spaces_em) - |> P.bind (\_ -> P.addLocation (Var.upper E.CRES_Effect)) + |> P.bind (\_ -> P.addLocation (Var.upper T.CRES_Effect)) -spaces_em : P.Parser E.CRES_Module () +spaces_em : P.Parser T.CRES_Module () spaces_em = - Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_Effect + Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_Effect -- IMPORTS -chompImports : List T.CASTS_Import -> P.Parser E.CRES_Module (List T.CASTS_Import) +chompImports : List T.CASTS_Import -> P.Parser T.CRES_Module (List T.CASTS_Import) chompImports is = P.oneOfWithFallback [ chompImport @@ -537,23 +536,23 @@ chompImports is = (List.reverse is) -chompImport : P.Parser E.CRES_Module T.CASTS_Import +chompImport : P.Parser T.CRES_Module T.CASTS_Import chompImport = - Keyword.import_ E.CRES_ImportStart - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_ImportIndentName) - |> P.bind (\_ -> P.addLocation (Var.moduleName E.CRES_ImportName)) + Keyword.import_ T.CRES_ImportStart + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_ImportIndentName) + |> P.bind (\_ -> P.addLocation (Var.moduleName T.CRES_ImportName)) |> P.bind (\((T.CRA_At (T.CRA_Region _ end) _) as name) -> - Space.chomp E.CRES_ModuleSpace + Space.chomp T.CRES_ModuleSpace |> P.bind (\_ -> - P.oneOf E.CRES_ImportEnd - [ Space.checkFreshLine E.CRES_ImportEnd + P.oneOf T.CRES_ImportEnd + [ Space.checkFreshLine T.CRES_ImportEnd |> P.fmap (\_ -> T.CASTS_Import name Nothing (T.CASTS_Explicit [])) - , Space.checkIndent end E.CRES_ImportEnd + , Space.checkIndent end T.CRES_ImportEnd |> P.bind (\_ -> - P.oneOf E.CRES_ImportAs + P.oneOf T.CRES_ImportAs [ chompAs name , chompExposing name Nothing ] @@ -563,23 +562,23 @@ chompImport = ) -chompAs : T.CRA_Located T.CDN_Name -> P.Parser E.CRES_Module T.CASTS_Import +chompAs : T.CRA_Located T.CDN_Name -> P.Parser T.CRES_Module T.CASTS_Import chompAs name = - Keyword.as_ E.CRES_ImportAs - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_ImportIndentAlias) - |> P.bind (\_ -> Var.upper E.CRES_ImportAlias) + Keyword.as_ T.CRES_ImportAs + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_ImportIndentAlias) + |> P.bind (\_ -> Var.upper T.CRES_ImportAlias) |> P.bind (\alias -> P.getPosition |> P.bind (\end -> - Space.chomp E.CRES_ModuleSpace + Space.chomp T.CRES_ModuleSpace |> P.bind (\_ -> - P.oneOf E.CRES_ImportEnd - [ Space.checkFreshLine E.CRES_ImportEnd + P.oneOf T.CRES_ImportEnd + [ Space.checkFreshLine T.CRES_ImportEnd |> P.fmap (\_ -> T.CASTS_Import name (Just alias) (T.CASTS_Explicit [])) - , Space.checkIndent end E.CRES_ImportEnd + , Space.checkIndent end T.CRES_ImportEnd |> P.bind (\_ -> chompExposing name (Just alias)) ] ) @@ -587,14 +586,14 @@ chompAs name = ) -chompExposing : T.CRA_Located T.CDN_Name -> Maybe T.CDN_Name -> P.Parser E.CRES_Module T.CASTS_Import +chompExposing : T.CRA_Located T.CDN_Name -> Maybe T.CDN_Name -> P.Parser T.CRES_Module T.CASTS_Import chompExposing name maybeAlias = - Keyword.exposing_ E.CRES_ImportExposing - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ModuleSpace E.CRES_ImportIndentExposingList) - |> P.bind (\_ -> P.specialize E.CRES_ImportExposingList exposing_) + Keyword.exposing_ T.CRES_ImportExposing + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ModuleSpace T.CRES_ImportIndentExposingList) + |> P.bind (\_ -> P.specialize T.CRES_ImportExposingList exposing_) |> P.bind (\exposed -> - freshLine E.CRES_ImportEnd + freshLine T.CRES_ImportEnd |> P.fmap (\_ -> T.CASTS_Import name maybeAlias exposed) ) @@ -603,70 +602,70 @@ chompExposing name maybeAlias = -- LISTING -exposing_ : P.Parser E.CRES_Exposing T.CASTS_Exposing +exposing_ : P.Parser T.CRES_Exposing T.CASTS_Exposing exposing_ = - P.word1 '(' E.CRES_ExposingStart - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingIndentValue) + P.word1 '(' T.CRES_ExposingStart + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingIndentValue) |> P.bind (\_ -> - P.oneOf E.CRES_ExposingValue - [ P.word2 '.' '.' E.CRES_ExposingValue - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingIndentEnd) - |> P.bind (\_ -> P.word1 ')' E.CRES_ExposingEnd) + P.oneOf T.CRES_ExposingValue + [ P.word2 '.' '.' T.CRES_ExposingValue + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingIndentEnd) + |> P.bind (\_ -> P.word1 ')' T.CRES_ExposingEnd) |> P.fmap (\_ -> T.CASTS_Open) , chompExposed |> P.bind (\exposed -> - Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingIndentEnd + Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingIndentEnd |> P.bind (\_ -> exposingHelp [ exposed ]) ) ] ) -exposingHelp : List T.CASTS_Exposed -> P.Parser E.CRES_Exposing T.CASTS_Exposing +exposingHelp : List T.CASTS_Exposed -> P.Parser T.CRES_Exposing T.CASTS_Exposing exposingHelp revExposed = - P.oneOf E.CRES_ExposingEnd - [ P.word1 ',' E.CRES_ExposingEnd - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingIndentValue) + P.oneOf T.CRES_ExposingEnd + [ P.word1 ',' T.CRES_ExposingEnd + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingIndentValue) |> P.bind (\_ -> chompExposed) |> P.bind (\exposed -> - Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingIndentEnd + Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingIndentEnd |> P.bind (\_ -> exposingHelp (exposed :: revExposed)) ) - , P.word1 ')' E.CRES_ExposingEnd + , P.word1 ')' T.CRES_ExposingEnd |> P.fmap (\_ -> T.CASTS_Explicit (List.reverse revExposed)) ] -chompExposed : P.Parser E.CRES_Exposing T.CASTS_Exposed +chompExposed : P.Parser T.CRES_Exposing T.CASTS_Exposed chompExposed = P.getPosition |> P.bind (\start -> - P.oneOf E.CRES_ExposingValue - [ Var.lower E.CRES_ExposingValue + P.oneOf T.CRES_ExposingValue + [ Var.lower T.CRES_ExposingValue |> P.bind (\name -> P.getPosition |> P.fmap (\end -> T.CASTS_Lower <| A.at start end name) ) - , P.word1 '(' E.CRES_ExposingValue - |> P.bind (\_ -> Symbol.operator E.CRES_ExposingOperator E.CRES_ExposingOperatorReserved) + , P.word1 '(' T.CRES_ExposingValue + |> P.bind (\_ -> Symbol.operator T.CRES_ExposingOperator T.CRES_ExposingOperatorReserved) |> P.bind (\op -> - P.word1 ')' E.CRES_ExposingOperatorRightParen + P.word1 ')' T.CRES_ExposingOperatorRightParen |> P.bind (\_ -> P.getPosition) |> P.fmap (\end -> T.CASTS_Operator (T.CRA_Region start end) op) ) - , Var.upper E.CRES_ExposingValue + , Var.upper T.CRES_ExposingValue |> P.bind (\name -> P.getPosition |> P.bind (\end -> - Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingIndentEnd + Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingIndentEnd |> P.bind (\_ -> privacy @@ -678,20 +677,20 @@ chompExposed = ) -privacy : P.Parser E.CRES_Exposing T.CASTS_Privacy +privacy : P.Parser T.CRES_Exposing T.CASTS_Privacy privacy = P.oneOfWithFallback - [ P.word1 '(' E.CRES_ExposingTypePrivacy - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingTypePrivacy) + [ P.word1 '(' T.CRES_ExposingTypePrivacy + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingTypePrivacy) |> P.bind (\_ -> P.getPosition) |> P.bind (\start -> - P.word2 '.' '.' E.CRES_ExposingTypePrivacy + P.word2 '.' '.' T.CRES_ExposingTypePrivacy |> P.bind (\_ -> P.getPosition) |> P.bind (\end -> - Space.chompAndCheckIndent E.CRES_ExposingSpace E.CRES_ExposingTypePrivacy - |> P.bind (\_ -> P.word1 ')' E.CRES_ExposingTypePrivacy) + Space.chompAndCheckIndent T.CRES_ExposingSpace T.CRES_ExposingTypePrivacy + |> P.bind (\_ -> P.word1 ')' T.CRES_ExposingTypePrivacy) |> P.fmap (\_ -> T.CASTS_Public (T.CRA_Region start end)) ) ) diff --git a/src/Compiler/Parse/Number.elm b/src/Compiler/Parse/Number.elm index ad60b9d8d..b65ba6d47 100644 --- a/src/Compiler/Parse/Number.elm +++ b/src/Compiler/Parse/Number.elm @@ -8,7 +8,6 @@ module Compiler.Parse.Number exposing import Compiler.Parse.Primitives as P import Compiler.Parse.Variable as Var -import Compiler.Reporting.Error.Syntax as E import Types as T import Utils.Crash exposing (crash) @@ -36,7 +35,7 @@ type Number | Float Float -number : (T.CPP_Row -> T.CPP_Col -> x) -> (E.CRES_Number -> T.CPP_Row -> T.CPP_Col -> x) -> P.Parser x Number +number : (T.CPP_Row -> T.CPP_Col -> x) -> (T.CRES_Number -> T.CPP_Row -> T.CPP_Col -> x) -> P.Parser x Number number toExpectation toError = P.Parser <| \(P.State src pos end indent row col) -> @@ -118,7 +117,7 @@ number toExpectation toError = type Outcome - = Err_ Int E.CRES_Number + = Err_ Int T.CRES_Number | OkInt Int Int | OkFloat Int @@ -148,7 +147,7 @@ chompInt src pos end n = chompExponent src (pos + 1) end else if isDirtyEnd src pos end word then - Err_ pos E.CRES_NumberEnd + Err_ pos T.CRES_NumberEnd else OkInt pos n @@ -166,13 +165,13 @@ chompFraction src pos end n = pos + 1 in if pos1 >= end then - Err_ pos (E.CRES_NumberDot n) + Err_ pos (T.CRES_NumberDot n) else if isDecimalDigit (String.uncons (String.dropLeft pos1 src) |> Maybe.map Tuple.first |> Maybe.withDefault ' ') then chompFractionHelp src (pos1 + 1) end else - Err_ pos (E.CRES_NumberDot n) + Err_ pos (T.CRES_NumberDot n) chompFractionHelp : String -> Int -> Int -> Outcome @@ -193,7 +192,7 @@ chompFractionHelp src pos end = chompExponent src (pos + 1) end else if isDirtyEnd src pos end word then - Err_ pos E.CRES_NumberEnd + Err_ pos T.CRES_NumberEnd else OkFloat pos @@ -206,7 +205,7 @@ chompFractionHelp src pos end = chompExponent : String -> Int -> Int -> Outcome chompExponent src pos end = if pos >= end then - Err_ pos E.CRES_NumberEnd + Err_ pos T.CRES_NumberEnd else let @@ -227,10 +226,10 @@ chompExponent src pos end = chompExponentHelp src (pos + 2) end else - Err_ pos E.CRES_NumberEnd + Err_ pos T.CRES_NumberEnd else - Err_ pos E.CRES_NumberEnd + Err_ pos T.CRES_NumberEnd chompExponentHelp : String -> Int -> Int -> Outcome @@ -267,10 +266,10 @@ chompZero src pos end = chompFraction src pos end 0 else if isDecimalDigit word then - Err_ pos E.CRES_NumberNoLeadingZero + Err_ pos T.CRES_NumberNoLeadingZero else if isDirtyEnd src pos end word then - Err_ pos E.CRES_NumberEnd + Err_ pos T.CRES_NumberEnd else OkInt pos 0 @@ -283,7 +282,7 @@ chompHexInt src pos end = chompHex src pos end in if answer < 0 then - Err_ newPos E.CRES_NumberHexDigit + Err_ newPos T.CRES_NumberHexDigit else OkInt newPos answer diff --git a/src/Compiler/Parse/Pattern.elm b/src/Compiler/Parse/Pattern.elm index 0b6dba40c..22cc13ad4 100644 --- a/src/Compiler/Parse/Pattern.elm +++ b/src/Compiler/Parse/Pattern.elm @@ -11,7 +11,6 @@ import Compiler.Parse.Space as Space import Compiler.Parse.String as String import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Syntax as E import Types as T @@ -19,12 +18,12 @@ import Types as T -- TERM -term : P.Parser E.CRES_Pattern T.CASTS_Pattern +term : P.Parser T.CRES_Pattern T.CASTS_Pattern term = P.getPosition |> P.bind (\start -> - P.oneOf E.CRES_PStart + P.oneOf T.CRES_PStart [ record start , tuple start , list start @@ -33,14 +32,14 @@ term = ) -termHelp : T.CRA_Position -> P.Parser E.CRES_Pattern T.CASTS_Pattern +termHelp : T.CRA_Position -> P.Parser T.CRES_Pattern T.CASTS_Pattern termHelp start = - P.oneOf E.CRES_PStart + P.oneOf T.CRES_PStart [ wildcard |> P.bind (\_ -> P.addEnd start T.CASTS_PAnything) - , Var.lower E.CRES_PStart + , Var.lower T.CRES_PStart |> P.bind (\name -> P.addEnd start (T.CASTS_PVar name)) - , Var.foreignUpper E.CRES_PStart + , Var.foreignUpper T.CRES_PStart |> P.bind (\upper -> P.getPosition @@ -60,7 +59,7 @@ termHelp start = T.CASTS_PCtorQual region home name [] ) ) - , Number.number E.CRES_PStart E.CRES_PNumber + , Number.number T.CRES_PStart T.CRES_PNumber |> P.bind (\number -> P.getPosition @@ -79,12 +78,12 @@ termHelp start = String.fromFloat float |> String.length in - Err (P.PErr P.Consumed row (col - width) (E.CRES_PFloat width)) + Err (P.PErr P.Consumed row (col - width) (T.CRES_PFloat width)) ) ) - , String.string E.CRES_PStart E.CRES_PString + , String.string T.CRES_PStart T.CRES_PString |> P.bind (\str -> P.addEnd start (T.CASTS_PStr str)) - , String.character E.CRES_PStart E.CRES_PChar + , String.character T.CRES_PStart T.CRES_PChar |> P.bind (\chr -> P.addEnd start (T.CASTS_PChr chr)) ] @@ -93,12 +92,12 @@ termHelp start = -- WILDCARD -wildcard : P.Parser E.CRES_Pattern () +wildcard : P.Parser T.CRES_Pattern () wildcard = P.Parser <| \(P.State src pos end indent row col) -> if pos == end || P.unsafeIndex src pos /= '_' then - Err (P.PErr P.Empty row col E.CRES_PStart) + Err (P.PErr P.Empty row col T.CRES_PStart) else let @@ -115,7 +114,7 @@ wildcard = ( badPos, badCol ) = Var.chompInnerChars src newPos end newCol in - Err (P.PErr P.Consumed row col (E.CRES_PWildcardNotVar (Name.fromPtr src pos badPos) (badCol - col))) + Err (P.PErr P.Consumed row col (T.CRES_PWildcardNotVar (Name.fromPtr src pos badPos) (badCol - col))) else let @@ -130,38 +129,38 @@ wildcard = -- RECORDS -record : T.CRA_Position -> P.Parser E.CRES_Pattern T.CASTS_Pattern +record : T.CRA_Position -> P.Parser T.CRES_Pattern T.CASTS_Pattern record start = - P.inContext E.CRES_PRecord (P.word1 '{' E.CRES_PStart) <| - (Space.chompAndCheckIndent E.CRES_PRecordSpace E.CRES_PRecordIndentOpen + P.inContext T.CRES_PRecord (P.word1 '{' T.CRES_PStart) <| + (Space.chompAndCheckIndent T.CRES_PRecordSpace T.CRES_PRecordIndentOpen |> P.bind (\_ -> - P.oneOf E.CRES_PRecordOpen - [ P.addLocation (Var.lower E.CRES_PRecordField) + P.oneOf T.CRES_PRecordOpen + [ P.addLocation (Var.lower T.CRES_PRecordField) |> P.bind (\var -> - Space.chompAndCheckIndent E.CRES_PRecordSpace E.CRES_PRecordIndentEnd + Space.chompAndCheckIndent T.CRES_PRecordSpace T.CRES_PRecordIndentEnd |> P.bind (\_ -> recordHelp start [ var ]) ) - , P.word1 '}' E.CRES_PRecordEnd + , P.word1 '}' T.CRES_PRecordEnd |> P.bind (\_ -> P.addEnd start (T.CASTS_PRecord [])) ] ) ) -recordHelp : T.CRA_Position -> List (T.CRA_Located T.CDN_Name) -> P.Parser E.CRES_PRecord T.CASTS_Pattern +recordHelp : T.CRA_Position -> List (T.CRA_Located T.CDN_Name) -> P.Parser T.CRES_PRecord T.CASTS_Pattern recordHelp start vars = - P.oneOf E.CRES_PRecordEnd - [ P.word1 ',' E.CRES_PRecordEnd - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_PRecordSpace E.CRES_PRecordIndentField) - |> P.bind (\_ -> P.addLocation (Var.lower E.CRES_PRecordField)) + P.oneOf T.CRES_PRecordEnd + [ P.word1 ',' T.CRES_PRecordEnd + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_PRecordSpace T.CRES_PRecordIndentField) + |> P.bind (\_ -> P.addLocation (Var.lower T.CRES_PRecordField)) |> P.bind (\var -> - Space.chompAndCheckIndent E.CRES_PRecordSpace E.CRES_PRecordIndentEnd + Space.chompAndCheckIndent T.CRES_PRecordSpace T.CRES_PRecordIndentEnd |> P.bind (\_ -> recordHelp start (var :: vars)) ) - , P.word1 '}' E.CRES_PRecordEnd + , P.word1 '}' T.CRES_PRecordEnd |> P.bind (\_ -> P.addEnd start (T.CASTS_PRecord vars)) ] @@ -170,38 +169,38 @@ recordHelp start vars = -- TUPLES -tuple : T.CRA_Position -> P.Parser E.CRES_Pattern T.CASTS_Pattern +tuple : T.CRA_Position -> P.Parser T.CRES_Pattern T.CASTS_Pattern tuple start = - P.inContext E.CRES_PTuple (P.word1 '(' E.CRES_PStart) <| - (Space.chompAndCheckIndent E.CRES_PTupleSpace E.CRES_PTupleIndentExpr1 + P.inContext T.CRES_PTuple (P.word1 '(' T.CRES_PStart) <| + (Space.chompAndCheckIndent T.CRES_PTupleSpace T.CRES_PTupleIndentExpr1 |> P.bind (\_ -> - P.oneOf E.CRES_PTupleOpen - [ P.specialize E.CRES_PTupleExpr expression + P.oneOf T.CRES_PTupleOpen + [ P.specialize T.CRES_PTupleExpr expression |> P.bind (\( pattern, end ) -> - Space.checkIndent end E.CRES_PTupleIndentEnd + Space.checkIndent end T.CRES_PTupleIndentEnd |> P.bind (\_ -> tupleHelp start pattern []) ) - , P.word1 ')' E.CRES_PTupleEnd + , P.word1 ')' T.CRES_PTupleEnd |> P.bind (\_ -> P.addEnd start T.CASTS_PUnit) ] ) ) -tupleHelp : T.CRA_Position -> T.CASTS_Pattern -> List T.CASTS_Pattern -> P.Parser E.CRES_PTuple T.CASTS_Pattern +tupleHelp : T.CRA_Position -> T.CASTS_Pattern -> List T.CASTS_Pattern -> P.Parser T.CRES_PTuple T.CASTS_Pattern tupleHelp start firstPattern revPatterns = - P.oneOf E.CRES_PTupleEnd - [ P.word1 ',' E.CRES_PTupleEnd - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_PTupleSpace E.CRES_PTupleIndentExprN) - |> P.bind (\_ -> P.specialize E.CRES_PTupleExpr expression) + P.oneOf T.CRES_PTupleEnd + [ P.word1 ',' T.CRES_PTupleEnd + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_PTupleSpace T.CRES_PTupleIndentExprN) + |> P.bind (\_ -> P.specialize T.CRES_PTupleExpr expression) |> P.bind (\( pattern, end ) -> - Space.checkIndent end E.CRES_PTupleIndentEnd + Space.checkIndent end T.CRES_PTupleIndentEnd |> P.bind (\_ -> tupleHelp start firstPattern (pattern :: revPatterns)) ) - , P.word1 ')' E.CRES_PTupleEnd + , P.word1 ')' T.CRES_PTupleEnd |> P.bind (\_ -> case List.reverse revPatterns of @@ -218,38 +217,38 @@ tupleHelp start firstPattern revPatterns = -- LIST -list : T.CRA_Position -> P.Parser E.CRES_Pattern T.CASTS_Pattern +list : T.CRA_Position -> P.Parser T.CRES_Pattern T.CASTS_Pattern list start = - P.inContext E.CRES_PList (P.word1 '[' E.CRES_PStart) <| - (Space.chompAndCheckIndent E.CRES_PListSpace E.CRES_PListIndentOpen + P.inContext T.CRES_PList (P.word1 '[' T.CRES_PStart) <| + (Space.chompAndCheckIndent T.CRES_PListSpace T.CRES_PListIndentOpen |> P.bind (\_ -> - P.oneOf E.CRES_PListOpen - [ P.specialize E.CRES_PListExpr expression + P.oneOf T.CRES_PListOpen + [ P.specialize T.CRES_PListExpr expression |> P.bind (\( pattern, end ) -> - Space.checkIndent end E.CRES_PListIndentEnd + Space.checkIndent end T.CRES_PListIndentEnd |> P.bind (\_ -> listHelp start [ pattern ]) ) - , P.word1 ']' E.CRES_PListEnd + , P.word1 ']' T.CRES_PListEnd |> P.bind (\_ -> P.addEnd start (T.CASTS_PList [])) ] ) ) -listHelp : T.CRA_Position -> List T.CASTS_Pattern -> P.Parser E.CRES_PList T.CASTS_Pattern +listHelp : T.CRA_Position -> List T.CASTS_Pattern -> P.Parser T.CRES_PList T.CASTS_Pattern listHelp start patterns = - P.oneOf E.CRES_PListEnd - [ P.word1 ',' E.CRES_PListEnd - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_PListSpace E.CRES_PListIndentExpr) - |> P.bind (\_ -> P.specialize E.CRES_PListExpr expression) + P.oneOf T.CRES_PListEnd + [ P.word1 ',' T.CRES_PListEnd + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_PListSpace T.CRES_PListIndentExpr) + |> P.bind (\_ -> P.specialize T.CRES_PListExpr expression) |> P.bind (\( pattern, end ) -> - Space.checkIndent end E.CRES_PListIndentEnd + Space.checkIndent end T.CRES_PListIndentEnd |> P.bind (\_ -> listHelp start (pattern :: patterns)) ) - , P.word1 ']' E.CRES_PListEnd + , P.word1 ']' T.CRES_PListEnd |> P.bind (\_ -> P.addEnd start (T.CASTS_PList (List.reverse patterns))) ] @@ -258,7 +257,7 @@ listHelp start patterns = -- EXPRESSION -expression : Space.Parser E.CRES_Pattern T.CASTS_Pattern +expression : Space.Parser T.CRES_Pattern T.CASTS_Pattern expression = P.getPosition |> P.bind @@ -271,27 +270,27 @@ expression = ) -exprHelp : T.CRA_Position -> List T.CASTS_Pattern -> ( T.CASTS_Pattern, T.CRA_Position ) -> Space.Parser E.CRES_Pattern T.CASTS_Pattern +exprHelp : T.CRA_Position -> List T.CASTS_Pattern -> ( T.CASTS_Pattern, T.CRA_Position ) -> Space.Parser T.CRES_Pattern T.CASTS_Pattern exprHelp start revPatterns ( pattern, end ) = P.oneOfWithFallback - [ Space.checkIndent end E.CRES_PIndentStart - |> P.bind (\_ -> P.word2 ':' ':' E.CRES_PStart) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_PSpace E.CRES_PIndentStart) + [ Space.checkIndent end T.CRES_PIndentStart + |> P.bind (\_ -> P.word2 ':' ':' T.CRES_PStart) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_PSpace T.CRES_PIndentStart) |> P.bind (\_ -> exprPart) |> P.bind (\ePart -> exprHelp start (pattern :: revPatterns) ePart) - , Space.checkIndent end E.CRES_PIndentStart - |> P.bind (\_ -> Keyword.as_ E.CRES_PStart) - |> P.bind (\_ -> Space.chompAndCheckIndent E.CRES_PSpace E.CRES_PIndentAlias) + , Space.checkIndent end T.CRES_PIndentStart + |> P.bind (\_ -> Keyword.as_ T.CRES_PStart) + |> P.bind (\_ -> Space.chompAndCheckIndent T.CRES_PSpace T.CRES_PIndentAlias) |> P.bind (\_ -> P.getPosition) |> P.bind (\nameStart -> - Var.lower E.CRES_PAlias + Var.lower T.CRES_PAlias |> P.bind (\name -> P.getPosition |> P.bind (\newEnd -> - Space.chomp E.CRES_PSpace + Space.chomp T.CRES_PSpace |> P.fmap (\_ -> let @@ -321,13 +320,13 @@ cons hd tl = -- EXPRESSION PART -exprPart : Space.Parser E.CRES_Pattern T.CASTS_Pattern +exprPart : Space.Parser T.CRES_Pattern T.CASTS_Pattern exprPart = - P.oneOf E.CRES_PStart + P.oneOf T.CRES_PStart [ P.getPosition |> P.bind (\start -> - Var.foreignUpper E.CRES_PStart + Var.foreignUpper T.CRES_PStart |> P.bind (\upper -> P.getPosition @@ -337,22 +336,22 @@ exprPart = , term |> P.bind (\((T.CRA_At (T.CRA_Region _ end) _) as eterm) -> - Space.chomp E.CRES_PSpace + Space.chomp T.CRES_PSpace |> P.fmap (\_ -> ( eterm, end )) ) ] -exprTermHelp : T.CRA_Region -> Var.Upper -> T.CRA_Position -> List T.CASTS_Pattern -> Space.Parser E.CRES_Pattern T.CASTS_Pattern +exprTermHelp : T.CRA_Region -> Var.Upper -> T.CRA_Position -> List T.CASTS_Pattern -> Space.Parser T.CRES_Pattern T.CASTS_Pattern exprTermHelp region upper start revArgs = P.getPosition |> P.bind (\end -> - Space.chomp E.CRES_PSpace + Space.chomp T.CRES_PSpace |> P.bind (\_ -> P.oneOfWithFallback - [ Space.checkIndent end E.CRES_PIndentStart + [ Space.checkIndent end T.CRES_PIndentStart |> P.bind (\_ -> term) |> P.bind (\arg -> exprTermHelp region upper start (arg :: revArgs)) ] diff --git a/src/Compiler/Parse/Shader.elm b/src/Compiler/Parse/Shader.elm index 4a6934560..5b77245c1 100644 --- a/src/Compiler/Parse/Shader.elm +++ b/src/Compiler/Parse/Shader.elm @@ -3,7 +3,6 @@ module Compiler.Parse.Shader exposing (shader) import Compiler.AST.Utils.Shader as Shader import Compiler.Parse.Primitives as P exposing (Parser) import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Syntax as E import Data.Map as Dict import Language.GLSL.Parser as GLP import Language.GLSL.Syntax as GLS @@ -15,7 +14,7 @@ import Utils.Crash as Crash -- SHADER -shader : T.CRA_Position -> Parser E.CRES_Expr T.CASTS_Expr +shader : T.CRA_Position -> Parser T.CRES_Expr T.CASTS_Expr shader ((T.CRA_Position row col) as start) = parseBlock |> P.bind @@ -36,7 +35,7 @@ shader ((T.CRA_Position row col) as start) = -- BLOCK -parseBlock : Parser E.CRES_Expr String +parseBlock : Parser T.CRES_Expr String parseBlock = P.Parser <| \(P.State src pos end indent row col) -> @@ -80,10 +79,10 @@ parseBlock = Ok (P.POk P.Consumed block newState) Unending -> - Err (P.PErr P.Consumed row col E.CRES_EndlessShader) + Err (P.PErr P.Consumed row col T.CRES_EndlessShader) else - Err (P.PErr P.Empty row col E.CRES_Start) + Err (P.PErr P.Empty row col T.CRES_Start) type Status @@ -121,7 +120,7 @@ eatShader src pos end row col = -- GLSL -parseGlsl : T.CPP_Row -> T.CPP_Col -> String -> Parser E.CRES_Expr T.CASTUS_Types +parseGlsl : T.CPP_Row -> T.CPP_Col -> String -> Parser T.CRES_Expr T.CASTUS_Types parseGlsl startRow startCol src = case GLP.parse src of Ok (GLS.TranslationUnit decls) -> @@ -168,11 +167,11 @@ showErrorMessages msgs = String.join "\n" msgs -failure : T.CPP_Row -> T.CPP_Col -> String -> Parser E.CRES_Expr a +failure : T.CPP_Row -> T.CPP_Col -> String -> Parser T.CRES_Expr a failure row col msg = P.Parser <| \_ -> - Err (P.PErr P.Consumed row col (E.CRES_ShaderProblem msg)) + Err (P.PErr P.Consumed row col (T.CRES_ShaderProblem msg)) diff --git a/src/Compiler/Parse/Space.elm b/src/Compiler/Parse/Space.elm index f8fb6836c..fc60b9767 100644 --- a/src/Compiler/Parse/Space.elm +++ b/src/Compiler/Parse/Space.elm @@ -9,7 +9,6 @@ module Compiler.Parse.Space exposing ) import Compiler.Parse.Primitives as P -import Compiler.Reporting.Error.Syntax as E import Types as T @@ -25,7 +24,7 @@ type alias Parser x a = -- CHOMP -chomp : (E.CRES_Space -> T.CPP_Row -> T.CPP_Col -> x) -> P.Parser x () +chomp : (T.CRES_Space -> T.CPP_Row -> T.CPP_Col -> x) -> P.Parser x () chomp toError = P.Parser <| \(P.State src pos end indent row col) -> @@ -43,10 +42,10 @@ chomp toError = Ok (P.POk P.Consumed () newState) HasTab -> - Err (P.PErr P.Consumed newRow newCol (toError E.CRES_HasTab)) + Err (P.PErr P.Consumed newRow newCol (toError T.CRES_HasTab)) EndlessMultiComment -> - Err (P.PErr P.Consumed newRow newCol (toError E.CRES_EndlessMultiComment)) + Err (P.PErr P.Consumed newRow newCol (toError T.CRES_EndlessMultiComment)) @@ -90,7 +89,7 @@ checkFreshLine toError = -- CHOMP AND CHECK -chompAndCheckIndent : (E.CRES_Space -> T.CPP_Row -> T.CPP_Col -> x) -> (T.CPP_Row -> T.CPP_Col -> x) -> P.Parser x () +chompAndCheckIndent : (T.CRES_Space -> T.CPP_Row -> T.CPP_Col -> x) -> (T.CPP_Row -> T.CPP_Col -> x) -> P.Parser x () chompAndCheckIndent toSpaceError toIndentError = P.Parser <| \(P.State src pos end indent row col) -> @@ -112,10 +111,10 @@ chompAndCheckIndent toSpaceError toIndentError = Err (P.PErr P.Consumed row col toIndentError) HasTab -> - Err (P.PErr P.Consumed newRow newCol (toSpaceError E.CRES_HasTab)) + Err (P.PErr P.Consumed newRow newCol (toSpaceError T.CRES_HasTab)) EndlessMultiComment -> - Err (P.PErr P.Consumed newRow newCol (toSpaceError E.CRES_EndlessMultiComment)) + Err (P.PErr P.Consumed newRow newCol (toSpaceError T.CRES_EndlessMultiComment)) @@ -283,7 +282,7 @@ eatMultiCommentHelp src pos end row col openComments = -- DOCUMENTATION COMMENT -docComment : (Int -> Int -> x) -> (E.CRES_Space -> Int -> Int -> x) -> P.Parser x T.CASTS_Comment +docComment : (Int -> Int -> x) -> (T.CRES_Space -> Int -> Int -> x) -> P.Parser x T.CASTS_Comment docComment toExpectation toSpaceError = P.Parser <| \(P.State src pos end indent row col) -> @@ -338,10 +337,10 @@ docComment toExpectation toSpaceError = Ok (P.POk P.Consumed comment newState) MultiTab -> - Err (P.PErr P.Consumed newRow newCol (toSpaceError E.CRES_HasTab)) + Err (P.PErr P.Consumed newRow newCol (toSpaceError T.CRES_HasTab)) MultiEndless -> - Err (P.PErr P.Consumed row col (toSpaceError E.CRES_EndlessMultiComment)) + Err (P.PErr P.Consumed row col (toSpaceError T.CRES_EndlessMultiComment)) else Err (P.PErr P.Empty row col toExpectation) diff --git a/src/Compiler/Parse/String.elm b/src/Compiler/Parse/String.elm index 0909a90c7..626d45bf2 100644 --- a/src/Compiler/Parse/String.elm +++ b/src/Compiler/Parse/String.elm @@ -6,7 +6,6 @@ module Compiler.Parse.String exposing import Compiler.Elm.String as ES import Compiler.Parse.Number as Number import Compiler.Parse.Primitives as P exposing (Parser(..)) -import Compiler.Reporting.Error.Syntax as E import Types as T @@ -14,7 +13,7 @@ import Types as T -- CHARACTER -character : (T.CPP_Row -> T.CPP_Col -> x) -> (E.CRES_Char -> T.CPP_Row -> T.CPP_Col -> x) -> Parser x String +character : (T.CPP_Row -> T.CPP_Col -> x) -> (T.CRES_Char -> T.CPP_Row -> T.CPP_Col -> x) -> Parser x String character toExpectation toError = Parser (\(P.State src pos end indent row col) -> @@ -25,7 +24,7 @@ character toExpectation toError = case chompChar src (pos + 1) end row (col + 1) 0 placeholder of Good newPos newCol numChars mostRecent -> if numChars /= 1 then - Err (P.PErr P.Consumed row col (toError (E.CRES_CharNotString (newCol - col)))) + Err (P.PErr P.Consumed row col (toError (T.CRES_CharNotString (newCol - col)))) else let @@ -40,17 +39,17 @@ character toExpectation toError = Ok (P.POk P.Consumed char newState) CharEndless newCol -> - Err (P.PErr P.Consumed row newCol (toError E.CRES_CharEndless)) + Err (P.PErr P.Consumed row newCol (toError T.CRES_CharEndless)) CharEscape r c escape -> - Err (P.PErr P.Consumed r c (toError (E.CRES_CharEscape escape))) + Err (P.PErr P.Consumed r c (toError (T.CRES_CharEscape escape))) ) type CharResult = Good Int T.CPP_Col Int ES.Chunk | CharEndless T.CPP_Col - | CharEscape T.CPP_Row T.CPP_Col E.CRES_Escape + | CharEscape T.CPP_Row T.CPP_Col T.CRES_Escape chompChar : String -> Int -> Int -> T.CPP_Row -> T.CPP_Col -> Int -> ES.Chunk -> CharResult @@ -104,7 +103,7 @@ chompChar src pos end row col numChars mostRecent = -- STRINGS -string : (T.CPP_Row -> T.CPP_Col -> x) -> (E.CRES_String_ -> T.CPP_Row -> T.CPP_Col -> x) -> Parser x String +string : (T.CPP_Row -> T.CPP_Col -> x) -> (T.CRES_String_ -> T.CPP_Row -> T.CPP_Col -> x) -> Parser x String string toExpectation toError = Parser (\(P.State src pos end indent row col) -> @@ -162,7 +161,7 @@ isDoubleQuote src pos end = type StringResult = SROk Int T.CPP_Row T.CPP_Col String - | SRErr T.CPP_Row T.CPP_Col E.CRES_String_ + | SRErr T.CPP_Row T.CPP_Col T.CRES_String_ finalize : String -> Int -> Int -> List ES.Chunk -> String @@ -193,7 +192,7 @@ addEscape chunk start end revChunks = singleString : String -> Int -> Int -> T.CPP_Row -> T.CPP_Col -> Int -> List ES.Chunk -> StringResult singleString src pos end row col initialPos revChunks = if pos >= end then - SRErr row col E.CRES_StringEndless_Single + SRErr row col T.CRES_StringEndless_Single else let @@ -206,7 +205,7 @@ singleString src pos end row col initialPos revChunks = finalize src initialPos pos revChunks else if word == '\n' then - SRErr row col E.CRES_StringEndless_Single + SRErr row col T.CRES_StringEndless_Single else if word == '\'' then let @@ -232,10 +231,10 @@ singleString src pos end row col initialPos revChunks = addEscape (ES.CodePoint code) initialPos pos revChunks EscapeProblem r c x -> - SRErr r c (E.CRES_StringEscape x) + SRErr r c (T.CRES_StringEscape x) EscapeEndOfFile -> - SRErr row (col + 1) E.CRES_StringEndless_Single + SRErr row (col + 1) T.CRES_StringEndless_Single else let @@ -253,7 +252,7 @@ singleString src pos end row col initialPos revChunks = multiString : String -> Int -> Int -> T.CPP_Row -> T.CPP_Col -> Int -> T.CPP_Row -> T.CPP_Col -> List ES.Chunk -> StringResult multiString src pos end row col initialPos sr sc revChunks = if pos >= end then - SRErr sr sc E.CRES_StringEndless_Multi + SRErr sr sc T.CRES_StringEndless_Multi else let @@ -307,10 +306,10 @@ multiString src pos end row col initialPos sr sc revChunks = addEscape (ES.CodePoint code) initialPos pos revChunks EscapeProblem r c x -> - SRErr r c (E.CRES_StringEscape x) + SRErr r c (T.CRES_StringEscape x) EscapeEndOfFile -> - SRErr sr sc E.CRES_StringEndless_Multi + SRErr sr sc T.CRES_StringEndless_Multi else let @@ -329,7 +328,7 @@ type Escape = EscapeNormal | EscapeUnicode Int Int | EscapeEndOfFile - | EscapeProblem T.CPP_Row T.CPP_Col E.CRES_Escape + | EscapeProblem T.CPP_Row T.CPP_Col T.CRES_Escape eatEscape : String -> Int -> Int -> T.CPP_Row -> T.CPP_Col -> Escape @@ -361,13 +360,13 @@ eatEscape src pos end row col = eatUnicode src (pos + 1) end row col _ -> - EscapeProblem row col E.CRES_EscapeUnknown + EscapeProblem row col T.CRES_EscapeUnknown eatUnicode : String -> Int -> Int -> T.CPP_Row -> T.CPP_Col -> Escape eatUnicode src pos end row col = if pos >= end || P.unsafeIndex src pos /= '{' then - EscapeProblem row col (E.CRES_BadUnicodeFormat 2) + EscapeProblem row col (T.CRES_BadUnicodeFormat 2) else let @@ -383,13 +382,13 @@ eatUnicode src pos end row col = newPos - digitPos in if newPos >= end || P.unsafeIndex src newPos /= '}' then - EscapeProblem row col (E.CRES_BadUnicodeFormat (2 + numDigits)) + EscapeProblem row col (T.CRES_BadUnicodeFormat (2 + numDigits)) else if code < 0 || code > 0x0010FFFF then - EscapeProblem row col (E.CRES_BadUnicodeCode (3 + numDigits)) + EscapeProblem row col (T.CRES_BadUnicodeCode (3 + numDigits)) else if numDigits < 4 || numDigits > 6 then - EscapeProblem row col (E.CRES_BadUnicodeLength (3 + numDigits) numDigits code) + EscapeProblem row col (T.CRES_BadUnicodeLength (3 + numDigits) numDigits code) else EscapeUnicode (numDigits + 4) code diff --git a/src/Compiler/Parse/Symbol.elm b/src/Compiler/Parse/Symbol.elm index e984d389c..6d3ceaa06 100644 --- a/src/Compiler/Parse/Symbol.elm +++ b/src/Compiler/Parse/Symbol.elm @@ -1,6 +1,5 @@ module Compiler.Parse.Symbol exposing - ( CPS_BadOperator(..) - , badOperatorDecoder + ( badOperatorDecoder , badOperatorEncoder , binopCharSet , operator @@ -17,15 +16,7 @@ import Types as T -- OPERATOR -type CPS_BadOperator - = CPS_BadDot - | CPS_BadPipe - | CPS_BadArrow - | CPS_BadEquals - | CPS_BadHasType - - -operator : (T.CPP_Row -> T.CPP_Col -> x) -> (CPS_BadOperator -> T.CPP_Row -> T.CPP_Col -> x) -> Parser x T.CDN_Name +operator : (T.CPP_Row -> T.CPP_Col -> x) -> (T.CPS_BadOperator -> T.CPP_Row -> T.CPP_Col -> x) -> Parser x T.CDN_Name operator toExpectation toError = P.Parser <| \(P.State src pos end indent row col) -> @@ -40,19 +31,19 @@ operator toExpectation toError = else case String.slice pos newPos src of "." -> - Err (P.PErr P.Empty row col (toError CPS_BadDot)) + Err (P.PErr P.Empty row col (toError T.CPS_BadDot)) "|" -> - Err (P.PErr P.Consumed row col (toError CPS_BadPipe)) + Err (P.PErr P.Consumed row col (toError T.CPS_BadPipe)) "->" -> - Err (P.PErr P.Consumed row col (toError CPS_BadArrow)) + Err (P.PErr P.Consumed row col (toError T.CPS_BadArrow)) "=" -> - Err (P.PErr P.Consumed row col (toError CPS_BadEquals)) + Err (P.PErr P.Consumed row col (toError T.CPS_BadEquals)) ":" -> - Err (P.PErr P.Consumed row col (toError CPS_BadHasType)) + Err (P.PErr P.Consumed row col (toError T.CPS_BadHasType)) op -> let @@ -95,45 +86,45 @@ binopCharSet = -- ENCODERS and DECODERS -badOperatorEncoder : CPS_BadOperator -> Encode.Value +badOperatorEncoder : T.CPS_BadOperator -> Encode.Value badOperatorEncoder badOperator = case badOperator of - CPS_BadDot -> + T.CPS_BadDot -> Encode.string "BadDot" - CPS_BadPipe -> + T.CPS_BadPipe -> Encode.string "BadPipe" - CPS_BadArrow -> + T.CPS_BadArrow -> Encode.string "BadArrow" - CPS_BadEquals -> + T.CPS_BadEquals -> Encode.string "BadEquals" - CPS_BadHasType -> + T.CPS_BadHasType -> Encode.string "BadHasType" -badOperatorDecoder : Decode.Decoder CPS_BadOperator +badOperatorDecoder : Decode.Decoder T.CPS_BadOperator badOperatorDecoder = Decode.string |> Decode.andThen (\str -> case str of "BadDot" -> - Decode.succeed CPS_BadDot + Decode.succeed T.CPS_BadDot "BadPipe" -> - Decode.succeed CPS_BadPipe + Decode.succeed T.CPS_BadPipe "BadArrow" -> - Decode.succeed CPS_BadArrow + Decode.succeed T.CPS_BadArrow "BadEquals" -> - Decode.succeed CPS_BadEquals + Decode.succeed T.CPS_BadEquals "BadHasType" -> - Decode.succeed CPS_BadHasType + Decode.succeed T.CPS_BadHasType _ -> Decode.fail ("Unknown BadOperator: " ++ str) diff --git a/src/Compiler/Parse/Type.elm b/src/Compiler/Parse/Type.elm index a796e72d0..e5e42a2b6 100644 --- a/src/Compiler/Parse/Type.elm +++ b/src/Compiler/Parse/Type.elm @@ -7,7 +7,6 @@ import Compiler.Parse.Primitives as P import Compiler.Parse.Space as Space import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Syntax as E import Types as T @@ -15,14 +14,14 @@ import Types as T -- TYPE TERMS -term : P.Parser E.CRES_Type T.CASTS_Type +term : P.Parser T.CRES_Type T.CASTS_Type term = P.getPosition |> P.bind (\start -> - P.oneOf E.CRES_TStart + P.oneOf T.CRES_TStart [ -- types with no arguments (Int, Float, etc.) - Var.foreignUpper E.CRES_TStart + Var.foreignUpper T.CRES_TStart |> P.bind (\upper -> P.getPosition @@ -43,46 +42,46 @@ term = ) ) , -- type variables - Var.lower E.CRES_TStart + Var.lower T.CRES_TStart |> P.bind (\var -> P.addEnd start (T.CASTS_TVar var) ) , -- tuples - P.inContext E.CRES_TTuple (P.word1 '(' E.CRES_TStart) <| - P.oneOf E.CRES_TTupleOpen - [ P.word1 ')' E.CRES_TTupleOpen + P.inContext T.CRES_TTuple (P.word1 '(' T.CRES_TStart) <| + P.oneOf T.CRES_TTupleOpen + [ P.word1 ')' T.CRES_TTupleOpen |> P.bind (\_ -> P.addEnd start T.CASTS_TUnit) - , Space.chompAndCheckIndent E.CRES_TTupleSpace E.CRES_TTupleIndentType1 + , Space.chompAndCheckIndent T.CRES_TTupleSpace T.CRES_TTupleIndentType1 |> P.bind (\_ -> - P.specialize E.CRES_TTupleType expression + P.specialize T.CRES_TTupleType expression |> P.bind (\( tipe, end ) -> - Space.checkIndent end E.CRES_TTupleIndentEnd + Space.checkIndent end T.CRES_TTupleIndentEnd |> P.bind (\_ -> chompTupleEnd start tipe []) ) ) ] , -- records - P.inContext E.CRES_TRecord (P.word1 '{' E.CRES_TStart) <| - (Space.chompAndCheckIndent E.CRES_TRecordSpace E.CRES_TRecordIndentOpen + P.inContext T.CRES_TRecord (P.word1 '{' T.CRES_TStart) <| + (Space.chompAndCheckIndent T.CRES_TRecordSpace T.CRES_TRecordIndentOpen |> P.bind (\_ -> - P.oneOf E.CRES_TRecordOpen - [ P.word1 '}' E.CRES_TRecordEnd + P.oneOf T.CRES_TRecordOpen + [ P.word1 '}' T.CRES_TRecordEnd |> P.bind (\_ -> P.addEnd start (T.CASTS_TRecord [] Nothing)) - , P.addLocation (Var.lower E.CRES_TRecordField) + , P.addLocation (Var.lower T.CRES_TRecordField) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_TRecordSpace E.CRES_TRecordIndentColon + Space.chompAndCheckIndent T.CRES_TRecordSpace T.CRES_TRecordIndentColon |> P.bind (\_ -> - P.oneOf E.CRES_TRecordColon - [ P.word1 '|' E.CRES_TRecordColon + P.oneOf T.CRES_TRecordColon + [ P.word1 '|' T.CRES_TRecordColon |> P.bind (\_ -> - Space.chompAndCheckIndent E.CRES_TRecordSpace E.CRES_TRecordIndentField + Space.chompAndCheckIndent T.CRES_TRecordSpace T.CRES_TRecordIndentField |> P.bind (\_ -> chompField @@ -93,16 +92,16 @@ term = ) ) ) - , P.word1 ':' E.CRES_TRecordColon + , P.word1 ':' T.CRES_TRecordColon |> P.bind (\_ -> - Space.chompAndCheckIndent E.CRES_TRecordSpace E.CRES_TRecordIndentType + Space.chompAndCheckIndent T.CRES_TRecordSpace T.CRES_TRecordIndentType |> P.bind (\_ -> - P.specialize E.CRES_TRecordType expression + P.specialize T.CRES_TRecordType expression |> P.bind (\( tipe, end ) -> - Space.checkIndent end E.CRES_TRecordIndentEnd + Space.checkIndent end T.CRES_TRecordIndentEnd |> P.bind (\_ -> chompRecordEnd [ ( name, tipe ) ] @@ -125,12 +124,12 @@ term = -- TYPE EXPRESSIONS -expression : Space.Parser E.CRES_Type T.CASTS_Type +expression : Space.Parser T.CRES_Type T.CASTS_Type expression = P.getPosition |> P.bind (\start -> - P.oneOf E.CRES_TStart + P.oneOf T.CRES_TStart [ app start , term |> P.bind @@ -138,7 +137,7 @@ expression = P.getPosition |> P.bind (\end -> - Space.chomp E.CRES_TSpace + Space.chomp T.CRES_TSpace |> P.fmap (\_ -> ( eterm, end )) ) ) @@ -147,14 +146,14 @@ expression = (\(( tipe1, end1 ) as term1) -> P.oneOfWithFallback [ -- should never trigger - Space.checkIndent end1 E.CRES_TIndentStart + Space.checkIndent end1 T.CRES_TIndentStart |> P.bind (\_ -> -- could just be another type instead - P.word2 '-' '>' E.CRES_TStart + P.word2 '-' '>' T.CRES_TStart |> P.bind (\_ -> - Space.chompAndCheckIndent E.CRES_TSpace E.CRES_TIndentStart + Space.chompAndCheckIndent T.CRES_TSpace T.CRES_TIndentStart |> P.bind (\_ -> expression @@ -180,15 +179,15 @@ expression = -- TYPE CONSTRUCTORS -app : T.CRA_Position -> Space.Parser E.CRES_Type T.CASTS_Type +app : T.CRA_Position -> Space.Parser T.CRES_Type T.CASTS_Type app start = - Var.foreignUpper E.CRES_TStart + Var.foreignUpper T.CRES_TStart |> P.bind (\upper -> P.getPosition |> P.bind (\upperEnd -> - Space.chomp E.CRES_TSpace + Space.chomp T.CRES_TSpace |> P.bind (\_ -> chompArgs [] upperEnd @@ -215,10 +214,10 @@ app start = ) -chompArgs : List T.CASTS_Type -> T.CRA_Position -> Space.Parser E.CRES_Type (List T.CASTS_Type) +chompArgs : List T.CASTS_Type -> T.CRA_Position -> Space.Parser T.CRES_Type (List T.CASTS_Type) chompArgs args end = P.oneOfWithFallback - [ Space.checkIndent end E.CRES_TIndentStart + [ Space.checkIndent end T.CRES_TIndentStart |> P.bind (\_ -> term @@ -227,7 +226,7 @@ chompArgs args end = P.getPosition |> P.bind (\newEnd -> - Space.chomp E.CRES_TSpace + Space.chomp T.CRES_TSpace |> P.bind (\_ -> chompArgs (arg :: args) newEnd @@ -243,19 +242,19 @@ chompArgs args end = -- TUPLES -chompTupleEnd : T.CRA_Position -> T.CASTS_Type -> List T.CASTS_Type -> P.Parser E.CRES_TTuple T.CASTS_Type +chompTupleEnd : T.CRA_Position -> T.CASTS_Type -> List T.CASTS_Type -> P.Parser T.CRES_TTuple T.CASTS_Type chompTupleEnd start firstType revTypes = - P.oneOf E.CRES_TTupleEnd - [ P.word1 ',' E.CRES_TTupleEnd + P.oneOf T.CRES_TTupleEnd + [ P.word1 ',' T.CRES_TTupleEnd |> P.bind (\_ -> - Space.chompAndCheckIndent E.CRES_TTupleSpace E.CRES_TTupleIndentTypeN + Space.chompAndCheckIndent T.CRES_TTupleSpace T.CRES_TTupleIndentTypeN |> P.bind (\_ -> - P.specialize E.CRES_TTupleType expression + P.specialize T.CRES_TTupleType expression |> P.bind (\( tipe, end ) -> - Space.checkIndent end E.CRES_TTupleIndentEnd + Space.checkIndent end T.CRES_TTupleIndentEnd |> P.bind (\_ -> chompTupleEnd start firstType (tipe :: revTypes) @@ -263,7 +262,7 @@ chompTupleEnd start firstType revTypes = ) ) ) - , P.word1 ')' E.CRES_TTupleEnd + , P.word1 ')' T.CRES_TTupleEnd |> P.bind (\_ -> case List.reverse revTypes of @@ -284,13 +283,13 @@ type alias Field = ( T.CRA_Located T.CDN_Name, T.CASTS_Type ) -chompRecordEnd : List Field -> P.Parser E.CRES_TRecord (List Field) +chompRecordEnd : List Field -> P.Parser T.CRES_TRecord (List Field) chompRecordEnd fields = - P.oneOf E.CRES_TRecordEnd - [ P.word1 ',' E.CRES_TRecordEnd + P.oneOf T.CRES_TRecordEnd + [ P.word1 ',' T.CRES_TRecordEnd |> P.bind (\_ -> - Space.chompAndCheckIndent E.CRES_TRecordSpace E.CRES_TRecordIndentField + Space.chompAndCheckIndent T.CRES_TRecordSpace T.CRES_TRecordIndentField |> P.bind (\_ -> chompField @@ -300,29 +299,29 @@ chompRecordEnd fields = ) ) ) - , P.word1 '}' E.CRES_TRecordEnd + , P.word1 '}' T.CRES_TRecordEnd |> P.fmap (\_ -> List.reverse fields) ] -chompField : P.Parser E.CRES_TRecord Field +chompField : P.Parser T.CRES_TRecord Field chompField = - P.addLocation (Var.lower E.CRES_TRecordField) + P.addLocation (Var.lower T.CRES_TRecordField) |> P.bind (\name -> - Space.chompAndCheckIndent E.CRES_TRecordSpace E.CRES_TRecordIndentColon + Space.chompAndCheckIndent T.CRES_TRecordSpace T.CRES_TRecordIndentColon |> P.bind (\_ -> - P.word1 ':' E.CRES_TRecordColon + P.word1 ':' T.CRES_TRecordColon |> P.bind (\_ -> - Space.chompAndCheckIndent E.CRES_TRecordSpace E.CRES_TRecordIndentType + Space.chompAndCheckIndent T.CRES_TRecordSpace T.CRES_TRecordIndentType |> P.bind (\_ -> - P.specialize E.CRES_TRecordType expression + P.specialize T.CRES_TRecordType expression |> P.bind (\( tipe, end ) -> - Space.checkIndent end E.CRES_TRecordIndentEnd + Space.checkIndent end T.CRES_TRecordIndentEnd |> P.fmap (\_ -> ( name, tipe )) ) ) @@ -335,15 +334,15 @@ chompField = -- VARIANT -variant : Space.Parser E.CRES_CustomType ( T.CRA_Located T.CDN_Name, List T.CASTS_Type ) +variant : Space.Parser T.CRES_CustomType ( T.CRA_Located T.CDN_Name, List T.CASTS_Type ) variant = - P.addLocation (Var.upper E.CRES_CT_Variant) + P.addLocation (Var.upper T.CRES_CT_Variant) |> P.bind (\((T.CRA_At (T.CRA_Region _ nameEnd) _) as name) -> - Space.chomp E.CRES_CT_Space + Space.chomp T.CRES_CT_Space |> P.bind (\_ -> - P.specialize E.CRES_CT_VariantArg (chompArgs [] nameEnd) + P.specialize T.CRES_CT_VariantArg (chompArgs [] nameEnd) |> P.fmap (\( args, end ) -> ( ( name, args ), end ) diff --git a/src/Compiler/Reporting/Error.elm b/src/Compiler/Reporting/Error.elm index a3b1028f7..02434e161 100644 --- a/src/Compiler/Reporting/Error.elm +++ b/src/Compiler/Reporting/Error.elm @@ -1,7 +1,5 @@ module Compiler.Reporting.Error exposing - ( CRE_Error(..) - , CRE_Module - , jsonToJson + ( jsonToJson , moduleDecoder , moduleEncoder , toDoc @@ -10,7 +8,7 @@ module Compiler.Reporting.Error exposing import Builder.File as File import Compiler.Data.NonEmptyList as NE -import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) +import Compiler.Data.OneOrMore as OneOrMore import Compiler.Elm.ModuleName as ModuleName import Compiler.Json.Decode as DecodeX import Compiler.Json.Encode as E @@ -34,58 +32,31 @@ import Utils.Main as Utils --- MODULE - - -type alias CRE_Module = - { name : T.CEMN_Raw - , absolutePath : String - , modificationTime : File.BF_Time - , source : String - , error : CRE_Error - } - - - --- ERRORS - - -type CRE_Error - = CRE_BadSyntax Syntax.CRES_Error - | CRE_BadImports (NE.Nonempty Import.CREI_Error) - | CRE_BadNames (OneOrMore Canonicalize.CREC_Error) - | CRE_BadTypes L.CRRTL_Localizer (NE.Nonempty Type.CRET_Error) - | CRE_BadMains L.CRRTL_Localizer (OneOrMore Main.CREM_Error) - | CRE_BadPatterns (NE.Nonempty P.CNPM_Error) - | CRE_BadDocs Docs.CRED_Error - - - -- TO REPORT -toReports : Code.Source -> CRE_Error -> NE.Nonempty Report.Report +toReports : Code.Source -> T.CRE_Error -> NE.Nonempty Report.Report toReports source err = case err of - CRE_BadSyntax syntaxError -> + T.CRE_BadSyntax syntaxError -> NE.singleton (Syntax.toReport source syntaxError) - CRE_BadImports errs -> + T.CRE_BadImports errs -> NE.map (Import.toReport source) errs - CRE_BadNames errs -> + T.CRE_BadNames errs -> NE.map (Canonicalize.toReport source) (OneOrMore.destruct NE.Nonempty errs) - CRE_BadTypes localizer errs -> + T.CRE_BadTypes localizer errs -> NE.map (Type.toReport source localizer) errs - CRE_BadMains localizer errs -> + T.CRE_BadMains localizer errs -> NE.map (Main.toReport localizer source) (OneOrMore.destruct NE.Nonempty errs) - CRE_BadPatterns errs -> + T.CRE_BadPatterns errs -> NE.map (Pattern.toReport source) errs - CRE_BadDocs docsErr -> + T.CRE_BadDocs docsErr -> Docs.toReports source docsErr @@ -93,14 +64,14 @@ toReports source err = -- TO DOC -toDoc : String -> CRE_Module -> List CRE_Module -> D.Doc +toDoc : String -> T.CRE_Module -> List T.CRE_Module -> D.Doc toDoc root err errs = let (NE.Nonempty m ms) = NE.sortBy (\{ modificationTime } -> let - (File.BF_Time posix) = + (T.BF_Time posix) = modificationTime in Time.posixToMillis posix @@ -110,7 +81,7 @@ toDoc root err errs = D.vcat (toDocHelp root m ms) -toDocHelp : String -> CRE_Module -> List CRE_Module -> List D.Doc +toDocHelp : String -> T.CRE_Module -> List T.CRE_Module -> List D.Doc toDocHelp root module1 modules = case modules of [] -> @@ -124,7 +95,7 @@ toDocHelp root module1 modules = :: toDocHelp root module2 otherModules -toSeparator : CRE_Module -> CRE_Module -> D.Doc +toSeparator : T.CRE_Module -> T.CRE_Module -> D.Doc toSeparator beforeModule afterModule = let before : T.CEMN_Raw @@ -149,7 +120,7 @@ toSeparator beforeModule afterModule = -- MODULE TO DOC -moduleToDoc : String -> CRE_Module -> D.Doc +moduleToDoc : String -> T.CRE_Module -> D.Doc moduleToDoc root { absolutePath, source, error } = let reports : NE.Nonempty Report.Report @@ -194,7 +165,7 @@ toMessageBar title filePath = -- TO JSON -toJson : CRE_Module -> E.Value +toJson : T.CRE_Module -> E.Value toJson { name, absolutePath, source, error } = let reports : NE.Nonempty Report.Report @@ -239,12 +210,12 @@ encodeRegion (T.CRA_Region (T.CRA_Position sr sc) (T.CRA_Position er ec)) = -- ENCODERS and DECODERS -jsonToJson : CRE_Module -> Encode.Value +jsonToJson : T.CRE_Module -> Encode.Value jsonToJson = E.toJsonValue << toJson -moduleEncoder : CRE_Module -> Encode.Value +moduleEncoder : T.CRE_Module -> Encode.Value moduleEncoder modul = Encode.object [ ( "name", ModuleName.rawEncoder modul.name ) @@ -255,9 +226,9 @@ moduleEncoder modul = ] -moduleDecoder : Decode.Decoder CRE_Module +moduleDecoder : Decode.Decoder T.CRE_Module moduleDecoder = - Decode.map5 CRE_Module + Decode.map5 T.CRE_Module (Decode.field "name" ModuleName.rawDecoder) (Decode.field "absolutePath" Decode.string) (Decode.field "modificationTime" File.timeDecoder) @@ -265,84 +236,84 @@ moduleDecoder = (Decode.field "error" errorDecoder) -errorEncoder : CRE_Error -> Encode.Value +errorEncoder : T.CRE_Error -> Encode.Value errorEncoder error = case error of - CRE_BadSyntax syntaxError -> + T.CRE_BadSyntax syntaxError -> Encode.object [ ( "type", Encode.string "BadSyntax" ) , ( "syntaxError", Syntax.errorEncoder syntaxError ) ] - CRE_BadImports errs -> + T.CRE_BadImports errs -> Encode.object [ ( "type", Encode.string "BadImports" ) , ( "errs", E.nonempty Import.errorEncoder errs ) ] - CRE_BadNames errs -> + T.CRE_BadNames errs -> Encode.object [ ( "type", Encode.string "BadNames" ) , ( "errs", E.oneOrMore Canonicalize.errorEncoder errs ) ] - CRE_BadTypes localizer errs -> + T.CRE_BadTypes localizer errs -> Encode.object [ ( "type", Encode.string "BadTypes" ) , ( "localizer", L.localizerEncoder localizer ) , ( "errs", E.nonempty Type.errorEncoder errs ) ] - CRE_BadMains localizer errs -> + T.CRE_BadMains localizer errs -> Encode.object [ ( "type", Encode.string "BadMains" ) , ( "localizer", L.localizerEncoder localizer ) , ( "errs", E.oneOrMore Main.errorEncoder errs ) ] - CRE_BadPatterns errs -> + T.CRE_BadPatterns errs -> Encode.object [ ( "type", Encode.string "BadPatterns" ) , ( "errs", E.nonempty P.errorEncoder errs ) ] - CRE_BadDocs docsErr -> + T.CRE_BadDocs docsErr -> Encode.object [ ( "type", Encode.string "BadDocs" ) , ( "docsErr", Docs.errorEncoder docsErr ) ] -errorDecoder : Decode.Decoder CRE_Error +errorDecoder : Decode.Decoder T.CRE_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "BadSyntax" -> - Decode.map CRE_BadSyntax (Decode.field "syntaxError" Syntax.errorDecoder) + Decode.map T.CRE_BadSyntax (Decode.field "syntaxError" Syntax.errorDecoder) "BadImports" -> - Decode.map CRE_BadImports (Decode.field "errs" (DecodeX.nonempty Import.errorDecoder)) + Decode.map T.CRE_BadImports (Decode.field "errs" (DecodeX.nonempty Import.errorDecoder)) "BadNames" -> - Decode.map CRE_BadNames (Decode.field "errs" (DecodeX.oneOrMore Canonicalize.errorDecoder)) + Decode.map T.CRE_BadNames (Decode.field "errs" (DecodeX.oneOrMore Canonicalize.errorDecoder)) "BadTypes" -> - Decode.map2 CRE_BadTypes + Decode.map2 T.CRE_BadTypes (Decode.field "localizer" L.localizerDecoder) (Decode.field "errs" (DecodeX.nonempty Type.errorDecoder)) "BadMains" -> - Decode.map2 CRE_BadMains + Decode.map2 T.CRE_BadMains (Decode.field "localizer" L.localizerDecoder) (Decode.field "errs" (DecodeX.oneOrMore Main.errorDecoder)) "BadPatterns" -> - Decode.map CRE_BadPatterns (Decode.field "errs" (DecodeX.nonempty P.errorDecoder)) + Decode.map T.CRE_BadPatterns (Decode.field "errs" (DecodeX.nonempty P.errorDecoder)) "BadDocs" -> - Decode.map CRE_BadDocs (Decode.field "docsErr" Docs.errorDecoder) + Decode.map T.CRE_BadDocs (Decode.field "docsErr" Docs.errorDecoder) _ -> Decode.fail ("Unknown Path's type: " ++ type_) diff --git a/src/Compiler/Reporting/Error/Canonicalize.elm b/src/Compiler/Reporting/Error/Canonicalize.elm index 5adccf191..f76f5e20f 100644 --- a/src/Compiler/Reporting/Error/Canonicalize.elm +++ b/src/Compiler/Reporting/Error/Canonicalize.elm @@ -1,12 +1,5 @@ module Compiler.Reporting.Error.Canonicalize exposing - ( CREC_BadArityContext(..) - , CREC_DuplicatePatternContext(..) - , CREC_Error(..) - , CREC_InvalidPayload(..) - , CREC_PortProblem(..) - , CREC_PossibleNames - , CREC_VarKind(..) - , errorDecoder + ( errorDecoder , errorEncoder , invalidPayloadDecoder , invalidPayloadEncoder @@ -16,7 +9,7 @@ module Compiler.Reporting.Error.Canonicalize exposing import Compiler.AST.Canonical as Can import Compiler.AST.Source as Src import Compiler.Data.Index as Index -import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) +import Compiler.Data.OneOrMore as OneOrMore import Compiler.Elm.ModuleName as ModuleName import Compiler.Json.Decode as DecodeX import Compiler.Json.Encode as EncodeX @@ -26,7 +19,7 @@ import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Report as Report import Compiler.Reporting.Suggest as Suggest -import Data.Map as Dict exposing (Dict) +import Data.Map as Dict import Data.Set as EverySet exposing (EverySet) import Json.Decode as Decode import Json.Encode as Encode @@ -34,99 +27,13 @@ import Types as T --- CANONICALIZATION ERRORS - - -type CREC_Error - = CREC_AnnotationTooShort T.CRA_Region T.CDN_Name T.CDI_ZeroBased Int - | CREC_AmbiguousVar T.CRA_Region (Maybe T.CDN_Name) T.CDN_Name T.CEMN_Canonical (OneOrMore T.CEMN_Canonical) - | CREC_AmbiguousType T.CRA_Region (Maybe T.CDN_Name) T.CDN_Name T.CEMN_Canonical (OneOrMore T.CEMN_Canonical) - | CREC_AmbiguousVariant T.CRA_Region (Maybe T.CDN_Name) T.CDN_Name T.CEMN_Canonical (OneOrMore T.CEMN_Canonical) - | CREC_AmbiguousBinop T.CRA_Region T.CDN_Name T.CEMN_Canonical (OneOrMore T.CEMN_Canonical) - | CREC_BadArity T.CRA_Region CREC_BadArityContext T.CDN_Name Int Int - | CREC_Binop T.CRA_Region T.CDN_Name T.CDN_Name - | CREC_DuplicateDecl T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_DuplicateType T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_DuplicateCtor T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_DuplicateBinop T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_DuplicateField T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_DuplicateAliasArg T.CDN_Name T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_DuplicateUnionArg T.CDN_Name T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_DuplicatePattern CREC_DuplicatePatternContext T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_EffectNotFound T.CRA_Region T.CDN_Name - | CREC_EffectFunctionNotFound T.CRA_Region T.CDN_Name - | CREC_ExportDuplicate T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_ExportNotFound T.CRA_Region CREC_VarKind T.CDN_Name (List T.CDN_Name) - | CREC_ExportOpenAlias T.CRA_Region T.CDN_Name - | CREC_ImportCtorByName T.CRA_Region T.CDN_Name T.CDN_Name - | CREC_ImportNotFound T.CRA_Region T.CDN_Name (List T.CEMN_Canonical) - | CREC_ImportOpenAlias T.CRA_Region T.CDN_Name - | CREC_ImportExposingNotFound T.CRA_Region T.CEMN_Canonical T.CDN_Name (List T.CDN_Name) - | CREC_NotFoundVar T.CRA_Region (Maybe T.CDN_Name) T.CDN_Name CREC_PossibleNames - | CREC_NotFoundType T.CRA_Region (Maybe T.CDN_Name) T.CDN_Name CREC_PossibleNames - | CREC_NotFoundVariant T.CRA_Region (Maybe T.CDN_Name) T.CDN_Name CREC_PossibleNames - | CREC_NotFoundBinop T.CRA_Region T.CDN_Name (EverySet String T.CDN_Name) - | CREC_PatternHasRecordCtor T.CRA_Region T.CDN_Name - | CREC_PortPayloadInvalid T.CRA_Region T.CDN_Name T.CASTC_Type CREC_InvalidPayload - | CREC_PortTypeInvalid T.CRA_Region T.CDN_Name CREC_PortProblem - | CREC_RecursiveAlias T.CRA_Region T.CDN_Name (List T.CDN_Name) T.CASTS_Type (List T.CDN_Name) - | CREC_RecursiveDecl T.CRA_Region T.CDN_Name (List T.CDN_Name) - | CREC_RecursiveLet (T.CRA_Located T.CDN_Name) (List T.CDN_Name) - | CREC_Shadowing T.CDN_Name T.CRA_Region T.CRA_Region - | CREC_TupleLargerThanThree T.CRA_Region - | CREC_TypeVarsUnboundInUnion T.CRA_Region T.CDN_Name (List T.CDN_Name) ( T.CDN_Name, T.CRA_Region ) (List ( T.CDN_Name, T.CRA_Region )) - | CREC_TypeVarsMessedUpInAlias T.CRA_Region T.CDN_Name (List T.CDN_Name) (List ( T.CDN_Name, T.CRA_Region )) (List ( T.CDN_Name, T.CRA_Region )) - - -type CREC_BadArityContext - = CREC_TypeArity - | CREC_PatternArity - - -type CREC_DuplicatePatternContext - = CREC_DPLambdaArgs - | CREC_DPFuncArgs T.CDN_Name - | CREC_DPCaseBranch - | CREC_DPLetBinding - | CREC_DPDestruct - - -type CREC_InvalidPayload - = CREC_ExtendedRecord - | CREC_Function - | CREC_TypeVariable T.CDN_Name - | CREC_UnsupportedType T.CDN_Name - - -type CREC_PortProblem - = CREC_CmdNoArg - | CREC_CmdExtraArgs Int - | CREC_CmdBadMsg - | CREC_SubBad - | CREC_NotCmdOrSub - - -type alias CREC_PossibleNames = - { locals : EverySet String T.CDN_Name - , quals : Dict String T.CDN_Name (EverySet String T.CDN_Name) - } - - - -- KIND -type CREC_VarKind - = CREC_BadOp - | CREC_BadVar - | CREC_BadPattern - | CREC_BadType - - -toKindInfo : CREC_VarKind -> T.CDN_Name -> ( D.Doc, D.Doc, D.Doc ) +toKindInfo : T.CREC_VarKind -> T.CDN_Name -> ( D.Doc, D.Doc, D.Doc ) toKindInfo kind name = case kind of - CREC_BadOp -> + T.CREC_BadOp -> ( D.fromChars "an" , D.fromChars "operator" , D.fromChars "(" @@ -134,7 +41,7 @@ toKindInfo kind name = |> D.a (D.fromChars ")") ) - CREC_BadVar -> + T.CREC_BadVar -> ( D.fromChars "a" , D.fromChars "value" , D.fromChars "`" @@ -142,7 +49,7 @@ toKindInfo kind name = |> D.a (D.fromChars "`") ) - CREC_BadPattern -> + T.CREC_BadPattern -> ( D.fromChars "a" , D.fromChars "pattern" , D.fromChars "`" @@ -150,7 +57,7 @@ toKindInfo kind name = |> D.a (D.fromChars "`") ) - CREC_BadType -> + T.CREC_BadType -> ( D.fromChars "a" , D.fromChars "type" , D.fromChars "`" @@ -163,10 +70,10 @@ toKindInfo kind name = -- TO REPORT -toReport : Code.Source -> CREC_Error -> Report.Report +toReport : Code.Source -> T.CREC_Error -> Report.Report toReport source err = case err of - CREC_AnnotationTooShort region name index leftovers -> + T.CREC_AnnotationTooShort region name index leftovers -> let numTypeArgs : Int numTypeArgs = @@ -201,27 +108,27 @@ toReport source err = ) ) - CREC_AmbiguousVar region maybePrefix name h hs -> + T.CREC_AmbiguousVar region maybePrefix name h hs -> ambiguousName source region maybePrefix name h hs "variable" - CREC_AmbiguousType region maybePrefix name h hs -> + T.CREC_AmbiguousType region maybePrefix name h hs -> ambiguousName source region maybePrefix name h hs "type" - CREC_AmbiguousVariant region maybePrefix name h hs -> + T.CREC_AmbiguousVariant region maybePrefix name h hs -> ambiguousName source region maybePrefix name h hs "variant" - CREC_AmbiguousBinop region name h hs -> + T.CREC_AmbiguousBinop region name h hs -> ambiguousName source region Nothing name h hs "operator" - CREC_BadArity region badArityContext name expected actual -> + T.CREC_BadArity region badArityContext name expected actual -> let thing : String thing = case badArityContext of - CREC_TypeArity -> + T.CREC_TypeArity -> "type" - CREC_PatternArity -> + T.CREC_PatternArity -> "variant" in if actual < expected then @@ -267,7 +174,7 @@ toReport source err = D.fromChars "Which are the extra ones? Maybe some parentheses are missing?" ) - CREC_Binop region op1 op2 -> + T.CREC_Binop region op1 op2 -> Report.Report "INFIX PROBLEM" region [] <| Code.toSnippet source region @@ -278,37 +185,37 @@ toReport source err = "I do not know how to group these expressions. Add parentheses for me!" ) - CREC_DuplicateDecl name r1 r2 -> + T.CREC_DuplicateDecl name r1 r2 -> nameClash source r1 r2 <| "This file has multiple `" ++ name ++ "` declarations." - CREC_DuplicateType name r1 r2 -> + T.CREC_DuplicateType name r1 r2 -> nameClash source r1 r2 <| "This file defines multiple `" ++ name ++ "` types." - CREC_DuplicateCtor name r1 r2 -> + T.CREC_DuplicateCtor name r1 r2 -> nameClash source r1 r2 <| "This file defines multiple `" ++ name ++ "` type constructors." - CREC_DuplicateBinop name r1 r2 -> + T.CREC_DuplicateBinop name r1 r2 -> nameClash source r1 r2 <| "This file defines multiple (" ++ name ++ ") operators." - CREC_DuplicateField name r1 r2 -> + T.CREC_DuplicateField name r1 r2 -> nameClash source r1 r2 <| "This record has multiple `" ++ name ++ "` fields." - CREC_DuplicateAliasArg typeName name r1 r2 -> + T.CREC_DuplicateAliasArg typeName name r1 r2 -> nameClash source r1 r2 <| "The `" ++ typeName @@ -316,7 +223,7 @@ toReport source err = ++ name ++ "` type variables." - CREC_DuplicateUnionArg typeName name r1 r2 -> + T.CREC_DuplicateUnionArg typeName name r1 r2 -> nameClash source r1 r2 <| "The `" ++ typeName @@ -324,25 +231,25 @@ toReport source err = ++ name ++ "` type variables." - CREC_DuplicatePattern context name r1 r2 -> + T.CREC_DuplicatePattern context name r1 r2 -> nameClash source r1 r2 <| case context of - CREC_DPLambdaArgs -> + T.CREC_DPLambdaArgs -> "This anonymous function has multiple `" ++ name ++ "` arguments." - CREC_DPFuncArgs funcName -> + T.CREC_DPFuncArgs funcName -> "The `" ++ funcName ++ "` function has multiple `" ++ name ++ "` arguments." - CREC_DPCaseBranch -> + T.CREC_DPCaseBranch -> "This `case` pattern has multiple `" ++ name ++ "` variables." - CREC_DPLetBinding -> + T.CREC_DPLetBinding -> "This `let` expression defines `" ++ name ++ "` more than once!" - CREC_DPDestruct -> + T.CREC_DPDestruct -> "This pattern contains multiple `" ++ name ++ "` variables." - CREC_EffectNotFound region name -> + T.CREC_EffectNotFound region name -> Report.Report "EFFECT PROBLEM" region [] <| Code.toSnippet source region @@ -353,7 +260,7 @@ toReport source err = ("But I cannot find a custom type named `" ++ name ++ "` in this file!") ) - CREC_EffectFunctionNotFound region name -> + T.CREC_EffectFunctionNotFound region name -> Report.Report "EFFECT PROBLEM" region [] <| Code.toSnippet source region @@ -364,7 +271,7 @@ toReport source err = ("But I cannot find `" ++ name ++ "` in this file!") ) - CREC_ExportDuplicate name r1 r2 -> + T.CREC_ExportDuplicate name r1 r2 -> let messageThatEndsWithPunctuation : String messageThatEndsWithPunctuation = @@ -382,7 +289,7 @@ toReport source err = , D.fromChars "Remove one of them and you should be all set!" ) - CREC_ExportNotFound region kind rawName possibleNames -> + T.CREC_ExportNotFound region kind rawName possibleNames -> let suggestions : List String suggestions = @@ -431,7 +338,7 @@ toReport source err = ] ] - CREC_ExportOpenAlias region name -> + T.CREC_ExportOpenAlias region name -> Report.Report "BAD EXPORT" region [] <| Code.toSnippet source region @@ -445,7 +352,7 @@ toReport source err = "Remove the (..) and you should be fine!" ) - CREC_ImportCtorByName region ctor tipe -> + T.CREC_ImportCtorByName region ctor tipe -> Report.Report "BAD IMPORT" region [] <| Code.toSnippet source region @@ -481,7 +388,7 @@ toReport source err = ] ) - CREC_ImportNotFound region name _ -> + T.CREC_ImportNotFound region name _ -> -- -- NOTE: this should always be detected by `builder` -- So this error should never actually get printed out. @@ -495,7 +402,7 @@ toReport source err = , D.empty ) - CREC_ImportOpenAlias region name -> + T.CREC_ImportOpenAlias region name -> Report.Report "BAD IMPORT" region [] <| Code.toSnippet source region @@ -506,7 +413,7 @@ toReport source err = "Remove the (..) and it should work." ) - CREC_ImportExposingNotFound region (T.CEMN_Canonical _ home) value possibleNames -> + T.CREC_ImportExposingNotFound region (T.CEMN_Canonical _ home) value possibleNames -> let suggestions : List String suggestions = @@ -543,16 +450,16 @@ toReport source err = ] ) - CREC_NotFoundVar region prefix name possibleNames -> + T.CREC_NotFoundVar region prefix name possibleNames -> notFound source region prefix name "variable" possibleNames - CREC_NotFoundType region prefix name possibleNames -> + T.CREC_NotFoundType region prefix name possibleNames -> notFound source region prefix name "type" possibleNames - CREC_NotFoundVariant region prefix name possibleNames -> + T.CREC_NotFoundVariant region prefix name possibleNames -> notFound source region prefix name "variant" possibleNames - CREC_NotFoundBinop region op locals -> + T.CREC_NotFoundBinop region op locals -> if op == "===" then Report.Report "UNKNOWN OPERATOR" region [ "==" ] <| Code.toSnippet source @@ -650,7 +557,7 @@ toReport source err = ) ) - CREC_PatternHasRecordCtor region name -> + T.CREC_PatternHasRecordCtor region name -> Report.Report "BAD PATTERN" region [] <| Code.toSnippet source region @@ -664,7 +571,7 @@ toReport source err = "I recommend matching the record as a variable and unpacking it later." ) - CREC_PortPayloadInvalid region portName _ invalidPayload -> + T.CREC_PortPayloadInvalid region portName _ invalidPayload -> let formatDetails : ( String, D.Doc ) -> Report.Report formatDetails ( aBadKindOfThing, elaboration ) = @@ -685,25 +592,25 @@ toReport source err = in formatDetails <| case invalidPayload of - CREC_ExtendedRecord -> + T.CREC_ExtendedRecord -> ( "an extended record" , D.reflow "But the exact shape of the record must be known at compile time. No type variables!" ) - CREC_Function -> + T.CREC_Function -> ( "a function" , D.reflow "But functions cannot be sent in and out ports. If we allowed functions in from JS they may perform some side-effects. If we let functions out, they could produce incorrect results because Elm optimizations assume there are no side-effects." ) - CREC_TypeVariable name -> + T.CREC_TypeVariable name -> ( "an unspecified type" , D.reflow ("But type variables like `" ++ name ++ "` cannot flow through ports. I need to know exactly what type of data I am getting, so I can guarantee that unexpected data cannot sneak in and crash the Elm program.") ) - CREC_UnsupportedType name -> + T.CREC_UnsupportedType name -> ( "a `" ++ name ++ "` value" , D.stack [ D.reflow "I cannot handle that. The types that CAN flow in and out of Elm include:" @@ -715,7 +622,7 @@ toReport source err = ] ) - CREC_PortTypeInvalid region name portProblem -> + T.CREC_PortTypeInvalid region name portProblem -> let formatDetails : ( String, D.Doc ) -> Report.Report formatDetails ( before, after ) = @@ -735,13 +642,13 @@ toReport source err = in formatDetails <| case portProblem of - CREC_CmdNoArg -> + T.CREC_CmdNoArg -> ( "The `" ++ name ++ "` port cannot be just a command." , D.reflow "It can be (() -> Cmd msg) if you just need to trigger a JavaScript function, but there is often a better way to set things up." ) - CREC_CmdExtraArgs n -> + T.CREC_CmdExtraArgs n -> ( "The `" ++ name ++ "` port can only send ONE value out to JavaScript." , let theseItemsInSomething : String @@ -758,13 +665,13 @@ toReport source err = D.reflow <| "You can put " ++ theseItemsInSomething ++ " to send them out though." ) - CREC_CmdBadMsg -> + T.CREC_CmdBadMsg -> ( "The `" ++ name ++ "` port cannot send any messages to the `update` function." , D.reflow "It must produce a (Cmd msg) type. Notice the lower case `msg` type variable. The command will trigger some JS code, but it will not send anything particular back to Elm." ) - CREC_SubBad -> + T.CREC_SubBad -> ( "There is something off about this `" ++ name ++ "` port declaration." , D.stack [ D.reflow @@ -775,16 +682,16 @@ toReport source err = ] ) - CREC_NotCmdOrSub -> + T.CREC_NotCmdOrSub -> ( "I am confused about the `" ++ name ++ "` port declaration." , D.reflow "Ports need to produce a command (Cmd) or a subscription (Sub) but this is neither. I do not know how to handle this." ) - CREC_RecursiveAlias region name args tipe others -> + T.CREC_RecursiveAlias region name args tipe others -> aliasRecursionReport source region name args tipe others - CREC_RecursiveDecl region name names -> + T.CREC_RecursiveDecl region name names -> let makeTheory : String -> String -> D.Doc makeTheory question details = @@ -811,7 +718,7 @@ toReport source err = ] ) - CREC_RecursiveLet (T.CRA_At region name) names -> + T.CREC_RecursiveLet (T.CRA_At region name) names -> Report.Report "CYCLIC VALUE" region [] <| Code.toSnippet source region Nothing <| case names of @@ -838,7 +745,7 @@ toReport source err = ] ) - CREC_Shadowing name r1 r2 -> + T.CREC_Shadowing name r1 r2 -> let advice : D.Doc advice = @@ -859,7 +766,7 @@ toReport source err = , advice ) - CREC_TupleLargerThanThree region -> + T.CREC_TupleLargerThanThree region -> Report.Report "BAD TUPLE" region [] <| Code.toSnippet source region @@ -871,10 +778,10 @@ toReport source err = ] ) - CREC_TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds -> + T.CREC_TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds -> unboundTypeVars source unionRegion [ D.fromChars "type" ] typeName allVars unbound unbounds - CREC_TypeVarsMessedUpInAlias aliasRegion typeName allVars unusedVars unboundVars -> + T.CREC_TypeVarsMessedUpInAlias aliasRegion typeName allVars unusedVars unboundVars -> case ( unusedVars, unboundVars ) of ( unused :: unuseds, [] ) -> let @@ -1179,7 +1086,7 @@ ambiguousName source region maybePrefix name h hs thing = ) -notFound : Code.Source -> T.CRA_Region -> Maybe T.CDN_Name -> T.CDN_Name -> String -> CREC_PossibleNames -> Report.Report +notFound : Code.Source -> T.CRA_Region -> Maybe T.CDN_Name -> T.CDN_Name -> String -> T.CREC_PossibleNames -> Report.Report notFound source region maybePrefix name thing { locals, quals } = let givenName : T.CDN_Name @@ -1297,10 +1204,10 @@ aliasToUnionDoc name args tipe = -- ENCODERS and DECODERS -errorEncoder : CREC_Error -> Encode.Value +errorEncoder : T.CREC_Error -> Encode.Value errorEncoder error = case error of - CREC_AnnotationTooShort region name index leftovers -> + T.CREC_AnnotationTooShort region name index leftovers -> Encode.object [ ( "type", Encode.string "AnnotationTooShort" ) , ( "region", A.regionEncoder region ) @@ -1309,7 +1216,7 @@ errorEncoder error = , ( "leftovers", Encode.int leftovers ) ] - CREC_AmbiguousVar region maybePrefix name h hs -> + T.CREC_AmbiguousVar region maybePrefix name h hs -> Encode.object [ ( "type", Encode.string "AmbiguousVar" ) , ( "region", A.regionEncoder region ) @@ -1319,7 +1226,7 @@ errorEncoder error = , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) ] - CREC_AmbiguousType region maybePrefix name h hs -> + T.CREC_AmbiguousType region maybePrefix name h hs -> Encode.object [ ( "type", Encode.string "AmbiguousType" ) , ( "region", A.regionEncoder region ) @@ -1329,7 +1236,7 @@ errorEncoder error = , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) ] - CREC_AmbiguousVariant region maybePrefix name h hs -> + T.CREC_AmbiguousVariant region maybePrefix name h hs -> Encode.object [ ( "type", Encode.string "AmbiguousVariant" ) , ( "region", A.regionEncoder region ) @@ -1339,7 +1246,7 @@ errorEncoder error = , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) ] - CREC_AmbiguousBinop region name h hs -> + T.CREC_AmbiguousBinop region name h hs -> Encode.object [ ( "type", Encode.string "AmbiguousBinop" ) , ( "region", A.regionEncoder region ) @@ -1348,7 +1255,7 @@ errorEncoder error = , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) ] - CREC_BadArity region badArityContext name expected actual -> + T.CREC_BadArity region badArityContext name expected actual -> Encode.object [ ( "type", Encode.string "BadArity" ) , ( "region", A.regionEncoder region ) @@ -1358,7 +1265,7 @@ errorEncoder error = , ( "actual", Encode.int actual ) ] - CREC_Binop region op1 op2 -> + T.CREC_Binop region op1 op2 -> Encode.object [ ( "type", Encode.string "Binop" ) , ( "region", A.regionEncoder region ) @@ -1366,7 +1273,7 @@ errorEncoder error = , ( "op2", Encode.string op2 ) ] - CREC_DuplicateDecl name r1 r2 -> + T.CREC_DuplicateDecl name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicateDecl" ) , ( "name", Encode.string name ) @@ -1374,7 +1281,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_DuplicateType name r1 r2 -> + T.CREC_DuplicateType name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicateType" ) , ( "name", Encode.string name ) @@ -1382,7 +1289,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_DuplicateCtor name r1 r2 -> + T.CREC_DuplicateCtor name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicateCtor" ) , ( "name", Encode.string name ) @@ -1390,7 +1297,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_DuplicateBinop name r1 r2 -> + T.CREC_DuplicateBinop name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicateBinop" ) , ( "name", Encode.string name ) @@ -1398,7 +1305,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_DuplicateField name r1 r2 -> + T.CREC_DuplicateField name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicateField" ) , ( "name", Encode.string name ) @@ -1406,7 +1313,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_DuplicateAliasArg typeName name r1 r2 -> + T.CREC_DuplicateAliasArg typeName name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicateAliasArg" ) , ( "typeName", Encode.string typeName ) @@ -1415,7 +1322,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_DuplicateUnionArg typeName name r1 r2 -> + T.CREC_DuplicateUnionArg typeName name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicateUnionArg" ) , ( "typeName", Encode.string typeName ) @@ -1424,7 +1331,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_DuplicatePattern context name r1 r2 -> + T.CREC_DuplicatePattern context name r1 r2 -> Encode.object [ ( "type", Encode.string "DuplicatePattern" ) , ( "context", duplicatePatternContextEncoder context ) @@ -1433,21 +1340,21 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_EffectNotFound region name -> + T.CREC_EffectNotFound region name -> Encode.object [ ( "type", Encode.string "EffectNotFound" ) , ( "region", A.regionEncoder region ) , ( "name", Encode.string name ) ] - CREC_EffectFunctionNotFound region name -> + T.CREC_EffectFunctionNotFound region name -> Encode.object [ ( "type", Encode.string "EffectFunctionNotFound" ) , ( "region", A.regionEncoder region ) , ( "name", Encode.string name ) ] - CREC_ExportDuplicate name r1 r2 -> + T.CREC_ExportDuplicate name r1 r2 -> Encode.object [ ( "type", Encode.string "ExportDuplicate" ) , ( "name", Encode.string name ) @@ -1455,7 +1362,7 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_ExportNotFound region kind rawName possibleNames -> + T.CREC_ExportNotFound region kind rawName possibleNames -> Encode.object [ ( "type", Encode.string "ExportNotFound" ) , ( "region", A.regionEncoder region ) @@ -1464,14 +1371,14 @@ errorEncoder error = , ( "possibleNames", Encode.list Encode.string possibleNames ) ] - CREC_ExportOpenAlias region name -> + T.CREC_ExportOpenAlias region name -> Encode.object [ ( "type", Encode.string "ExportOpenAlias" ) , ( "region", A.regionEncoder region ) , ( "name", Encode.string name ) ] - CREC_ImportCtorByName region ctor tipe -> + T.CREC_ImportCtorByName region ctor tipe -> Encode.object [ ( "type", Encode.string "ImportCtorByName" ) , ( "region", A.regionEncoder region ) @@ -1479,7 +1386,7 @@ errorEncoder error = , ( "tipe", Encode.string tipe ) ] - CREC_ImportNotFound region name suggestions -> + T.CREC_ImportNotFound region name suggestions -> Encode.object [ ( "type", Encode.string "ImportNotFound" ) , ( "region", A.regionEncoder region ) @@ -1487,14 +1394,14 @@ errorEncoder error = , ( "suggestions", Encode.list ModuleName.canonicalEncoder suggestions ) ] - CREC_ImportOpenAlias region name -> + T.CREC_ImportOpenAlias region name -> Encode.object [ ( "type", Encode.string "ImportOpenAlias" ) , ( "region", A.regionEncoder region ) , ( "name", Encode.string name ) ] - CREC_ImportExposingNotFound region home value possibleNames -> + T.CREC_ImportExposingNotFound region home value possibleNames -> Encode.object [ ( "type", Encode.string "ImportExposingNotFound" ) , ( "region", A.regionEncoder region ) @@ -1503,7 +1410,7 @@ errorEncoder error = , ( "possibleNames", Encode.list Encode.string possibleNames ) ] - CREC_NotFoundVar region prefix name possibleNames -> + T.CREC_NotFoundVar region prefix name possibleNames -> Encode.object [ ( "type", Encode.string "NotFoundVar" ) , ( "region", A.regionEncoder region ) @@ -1512,7 +1419,7 @@ errorEncoder error = , ( "possibleNames", possibleNamesEncoder possibleNames ) ] - CREC_NotFoundType region prefix name possibleNames -> + T.CREC_NotFoundType region prefix name possibleNames -> Encode.object [ ( "type", Encode.string "NotFoundType" ) , ( "region", A.regionEncoder region ) @@ -1521,7 +1428,7 @@ errorEncoder error = , ( "possibleNames", possibleNamesEncoder possibleNames ) ] - CREC_NotFoundVariant region prefix name possibleNames -> + T.CREC_NotFoundVariant region prefix name possibleNames -> Encode.object [ ( "type", Encode.string "NotFoundVariant" ) , ( "region", A.regionEncoder region ) @@ -1530,7 +1437,7 @@ errorEncoder error = , ( "possibleNames", possibleNamesEncoder possibleNames ) ] - CREC_NotFoundBinop region op locals -> + T.CREC_NotFoundBinop region op locals -> Encode.object [ ( "type", Encode.string "NotFoundBinop" ) , ( "region", A.regionEncoder region ) @@ -1538,14 +1445,14 @@ errorEncoder error = , ( "locals", EncodeX.everySet compare Encode.string locals ) ] - CREC_PatternHasRecordCtor region name -> + T.CREC_PatternHasRecordCtor region name -> Encode.object [ ( "type", Encode.string "PatternHasRecordCtor" ) , ( "region", A.regionEncoder region ) , ( "name", Encode.string name ) ] - CREC_PortPayloadInvalid region portName badType invalidPayload -> + T.CREC_PortPayloadInvalid region portName badType invalidPayload -> Encode.object [ ( "type", Encode.string "PortPayloadInvalid" ) , ( "region", A.regionEncoder region ) @@ -1554,7 +1461,7 @@ errorEncoder error = , ( "invalidPayload", invalidPayloadEncoder invalidPayload ) ] - CREC_PortTypeInvalid region name portProblem -> + T.CREC_PortTypeInvalid region name portProblem -> Encode.object [ ( "type", Encode.string "PortTypeInvalid" ) , ( "region", A.regionEncoder region ) @@ -1562,7 +1469,7 @@ errorEncoder error = , ( "portProblem", portProblemEncoder portProblem ) ] - CREC_RecursiveAlias region name args tipe others -> + T.CREC_RecursiveAlias region name args tipe others -> Encode.object [ ( "type", Encode.string "RecursiveAlias" ) , ( "region", A.regionEncoder region ) @@ -1572,7 +1479,7 @@ errorEncoder error = , ( "others", Encode.list Encode.string others ) ] - CREC_RecursiveDecl region name names -> + T.CREC_RecursiveDecl region name names -> Encode.object [ ( "type", Encode.string "RecursiveDecl" ) , ( "region", A.regionEncoder region ) @@ -1580,14 +1487,14 @@ errorEncoder error = , ( "names", Encode.list Encode.string names ) ] - CREC_RecursiveLet name names -> + T.CREC_RecursiveLet name names -> Encode.object [ ( "type", Encode.string "RecursiveLet" ) , ( "name", A.locatedEncoder Encode.string name ) , ( "names", Encode.list Encode.string names ) ] - CREC_Shadowing name r1 r2 -> + T.CREC_Shadowing name r1 r2 -> Encode.object [ ( "type", Encode.string "Shadowing" ) , ( "name", Encode.string name ) @@ -1595,13 +1502,13 @@ errorEncoder error = , ( "r2", A.regionEncoder r2 ) ] - CREC_TupleLargerThanThree region -> + T.CREC_TupleLargerThanThree region -> Encode.object [ ( "type", Encode.string "TupleLargerThanThree" ) , ( "region", A.regionEncoder region ) ] - CREC_TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds -> + T.CREC_TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds -> Encode.object [ ( "type", Encode.string "TypeVarsUnboundInUnion" ) , ( "unionRegion", A.regionEncoder unionRegion ) @@ -1611,7 +1518,7 @@ errorEncoder error = , ( "unbounds", Encode.list (EncodeX.jsonPair Encode.string A.regionEncoder) unbounds ) ] - CREC_TypeVarsMessedUpInAlias aliasRegion typeName allVars unusedVars unboundVars -> + T.CREC_TypeVarsMessedUpInAlias aliasRegion typeName allVars unusedVars unboundVars -> Encode.object [ ( "type", Encode.string "TypeVarsMessedUpInAlias" ) , ( "aliasRegion", A.regionEncoder aliasRegion ) @@ -1622,21 +1529,21 @@ errorEncoder error = ] -errorDecoder : Decode.Decoder CREC_Error +errorDecoder : Decode.Decoder T.CREC_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "AnnotationTooShort" -> - Decode.map4 CREC_AnnotationTooShort + Decode.map4 T.CREC_AnnotationTooShort (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "index" Index.zeroBasedDecoder) (Decode.field "leftovers" Decode.int) "AmbiguousVar" -> - Decode.map5 CREC_AmbiguousVar + Decode.map5 T.CREC_AmbiguousVar (Decode.field "region" A.regionDecoder) (Decode.field "maybePrefix" (Decode.maybe Decode.string)) (Decode.field "name" Decode.string) @@ -1644,7 +1551,7 @@ errorDecoder = (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) "AmbiguousType" -> - Decode.map5 CREC_AmbiguousType + Decode.map5 T.CREC_AmbiguousType (Decode.field "region" A.regionDecoder) (Decode.field "maybePrefix" (Decode.maybe Decode.string)) (Decode.field "name" Decode.string) @@ -1652,7 +1559,7 @@ errorDecoder = (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) "AmbiguousVariant" -> - Decode.map5 CREC_AmbiguousVariant + Decode.map5 T.CREC_AmbiguousVariant (Decode.field "region" A.regionDecoder) (Decode.field "maybePrefix" (Decode.maybe Decode.string)) (Decode.field "name" Decode.string) @@ -1660,14 +1567,14 @@ errorDecoder = (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) "AmbiguousBinop" -> - Decode.map4 CREC_AmbiguousBinop + Decode.map4 T.CREC_AmbiguousBinop (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "h" ModuleName.canonicalDecoder) (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) "BadArity" -> - Decode.map5 CREC_BadArity + Decode.map5 T.CREC_BadArity (Decode.field "region" A.regionDecoder) (Decode.field "badArityContext" badArityContextDecoder) (Decode.field "name" Decode.string) @@ -1675,161 +1582,161 @@ errorDecoder = (Decode.field "actual" Decode.int) "Binop" -> - Decode.map3 CREC_Binop + Decode.map3 T.CREC_Binop (Decode.field "region" A.regionDecoder) (Decode.field "op1" Decode.string) (Decode.field "op2" Decode.string) "DuplicateDecl" -> - Decode.map3 CREC_DuplicateDecl + Decode.map3 T.CREC_DuplicateDecl (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "DuplicateType" -> - Decode.map3 CREC_DuplicateType + Decode.map3 T.CREC_DuplicateType (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "DuplicateCtor" -> - Decode.map3 CREC_DuplicateCtor + Decode.map3 T.CREC_DuplicateCtor (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "DuplicateBinop" -> - Decode.map3 CREC_DuplicateBinop + Decode.map3 T.CREC_DuplicateBinop (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "DuplicateField" -> - Decode.map3 CREC_DuplicateField + Decode.map3 T.CREC_DuplicateField (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "DuplicateAliasArg" -> - Decode.map4 CREC_DuplicateAliasArg + Decode.map4 T.CREC_DuplicateAliasArg (Decode.field "typeName" Decode.string) (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "DuplicateUnionArg" -> - Decode.map4 CREC_DuplicateUnionArg + Decode.map4 T.CREC_DuplicateUnionArg (Decode.field "typeName" Decode.string) (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "DuplicatePattern" -> - Decode.map4 CREC_DuplicatePattern + Decode.map4 T.CREC_DuplicatePattern (Decode.field "context" duplicatePatternContextDecoder) (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "EffectNotFound" -> - Decode.map2 CREC_EffectNotFound + Decode.map2 T.CREC_EffectNotFound (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) "EffectFunctionNotFound" -> - Decode.map2 CREC_EffectFunctionNotFound + Decode.map2 T.CREC_EffectFunctionNotFound (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) "ExportDuplicate" -> - Decode.map3 CREC_ExportDuplicate + Decode.map3 T.CREC_ExportDuplicate (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "ExportNotFound" -> - Decode.map4 CREC_ExportNotFound + Decode.map4 T.CREC_ExportNotFound (Decode.field "region" A.regionDecoder) (Decode.field "kind" varKindDecoder) (Decode.field "rawName" Decode.string) (Decode.field "possibleNames" (Decode.list Decode.string)) "ExportOpenAlias" -> - Decode.map2 CREC_ExportOpenAlias + Decode.map2 T.CREC_ExportOpenAlias (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) "ImportCtorByName" -> - Decode.map3 CREC_ImportCtorByName + Decode.map3 T.CREC_ImportCtorByName (Decode.field "region" A.regionDecoder) (Decode.field "ctor" Decode.string) (Decode.field "tipe" Decode.string) "ImportNotFound" -> - Decode.map3 CREC_ImportNotFound + Decode.map3 T.CREC_ImportNotFound (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "suggestions" (Decode.list ModuleName.canonicalDecoder)) "ImportOpenAlias" -> - Decode.map2 CREC_ImportOpenAlias + Decode.map2 T.CREC_ImportOpenAlias (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) "ImportExposingNotFound" -> - Decode.map4 CREC_ImportExposingNotFound + Decode.map4 T.CREC_ImportExposingNotFound (Decode.field "region" A.regionDecoder) (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "value" Decode.string) (Decode.field "possibleNames" (Decode.list Decode.string)) "NotFoundVar" -> - Decode.map4 CREC_NotFoundVar + Decode.map4 T.CREC_NotFoundVar (Decode.field "region" A.regionDecoder) (Decode.field "prefix" (Decode.maybe Decode.string)) (Decode.field "name" Decode.string) (Decode.field "possibleNames" possibleNamesDecoder) "NotFoundType" -> - Decode.map4 CREC_NotFoundType + Decode.map4 T.CREC_NotFoundType (Decode.field "region" A.regionDecoder) (Decode.field "prefix" (Decode.maybe Decode.string)) (Decode.field "name" Decode.string) (Decode.field "possibleNames" possibleNamesDecoder) "NotFoundVariant" -> - Decode.map4 CREC_NotFoundVariant + Decode.map4 T.CREC_NotFoundVariant (Decode.field "region" A.regionDecoder) (Decode.field "prefix" (Decode.maybe Decode.string)) (Decode.field "name" Decode.string) (Decode.field "possibleNames" possibleNamesDecoder) "NotFoundBinop" -> - Decode.map3 CREC_NotFoundBinop + Decode.map3 T.CREC_NotFoundBinop (Decode.field "region" A.regionDecoder) (Decode.field "op" Decode.string) (Decode.field "locals" (DecodeX.everySet identity Decode.string)) "PatternHasRecordCtor" -> - Decode.map2 CREC_PatternHasRecordCtor + Decode.map2 T.CREC_PatternHasRecordCtor (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) "PortPayloadInvalid" -> - Decode.map4 CREC_PortPayloadInvalid + Decode.map4 T.CREC_PortPayloadInvalid (Decode.field "region" A.regionDecoder) (Decode.field "portName" Decode.string) (Decode.field "badType" Can.typeDecoder) (Decode.field "invalidPayload" invalidPayloadDecoder) "PortTypeInvalid" -> - Decode.map3 CREC_PortTypeInvalid + Decode.map3 T.CREC_PortTypeInvalid (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "portProblem" portProblemDecoder) "RecursiveAlias" -> - Decode.map5 CREC_RecursiveAlias + Decode.map5 T.CREC_RecursiveAlias (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "args" (Decode.list Decode.string)) @@ -1837,27 +1744,27 @@ errorDecoder = (Decode.field "others" (Decode.list Decode.string)) "RecursiveDecl" -> - Decode.map3 CREC_RecursiveDecl + Decode.map3 T.CREC_RecursiveDecl (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "names" (Decode.list Decode.string)) "RecursiveLet" -> - Decode.map2 CREC_RecursiveLet + Decode.map2 T.CREC_RecursiveLet (Decode.field "name" (A.locatedDecoder Decode.string)) (Decode.field "names" (Decode.list Decode.string)) "Shadowing" -> - Decode.map3 CREC_Shadowing + Decode.map3 T.CREC_Shadowing (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "TupleLargerThanThree" -> - Decode.map CREC_TupleLargerThanThree (Decode.field "region" A.regionDecoder) + Decode.map T.CREC_TupleLargerThanThree (Decode.field "region" A.regionDecoder) "TypeVarsUnboundInUnion" -> - Decode.map5 CREC_TypeVarsUnboundInUnion + Decode.map5 T.CREC_TypeVarsUnboundInUnion (Decode.field "unionRegion" A.regionDecoder) (Decode.field "typeName" Decode.string) (Decode.field "allVars" (Decode.list Decode.string)) @@ -1865,7 +1772,7 @@ errorDecoder = (Decode.field "unbounds" (Decode.list (DecodeX.jsonPair Decode.string A.regionDecoder))) "TypeVarsMessedUpInAlias" -> - Decode.map5 CREC_TypeVarsMessedUpInAlias + Decode.map5 T.CREC_TypeVarsMessedUpInAlias (Decode.field "aliasRegion" A.regionDecoder) (Decode.field "typeName" Decode.string) (Decode.field "allVars" (Decode.list Decode.string)) @@ -1877,129 +1784,129 @@ errorDecoder = ) -badArityContextEncoder : CREC_BadArityContext -> Encode.Value +badArityContextEncoder : T.CREC_BadArityContext -> Encode.Value badArityContextEncoder badArityContext = case badArityContext of - CREC_TypeArity -> + T.CREC_TypeArity -> Encode.string "TypeArity" - CREC_PatternArity -> + T.CREC_PatternArity -> Encode.string "PatternArity" -badArityContextDecoder : Decode.Decoder CREC_BadArityContext +badArityContextDecoder : Decode.Decoder T.CREC_BadArityContext badArityContextDecoder = Decode.string |> Decode.andThen (\str -> case str of "TypeArity" -> - Decode.succeed CREC_TypeArity + Decode.succeed T.CREC_TypeArity "PatternArity" -> - Decode.succeed CREC_PatternArity + Decode.succeed T.CREC_PatternArity _ -> Decode.fail ("Unknown BadArityContext: " ++ str) ) -duplicatePatternContextEncoder : CREC_DuplicatePatternContext -> Encode.Value +duplicatePatternContextEncoder : T.CREC_DuplicatePatternContext -> Encode.Value duplicatePatternContextEncoder duplicatePatternContext = case duplicatePatternContext of - CREC_DPLambdaArgs -> + T.CREC_DPLambdaArgs -> Encode.object [ ( "type", Encode.string "DPLambdaArgs" ) ] - CREC_DPFuncArgs funcName -> + T.CREC_DPFuncArgs funcName -> Encode.object [ ( "type", Encode.string "DPFuncArgs" ) , ( "funcName", Encode.string funcName ) ] - CREC_DPCaseBranch -> + T.CREC_DPCaseBranch -> Encode.object [ ( "type", Encode.string "DPCaseBranch" ) ] - CREC_DPLetBinding -> + T.CREC_DPLetBinding -> Encode.object [ ( "type", Encode.string "DPLetBinding" ) ] - CREC_DPDestruct -> + T.CREC_DPDestruct -> Encode.object [ ( "type", Encode.string "DPDestruct" ) ] -duplicatePatternContextDecoder : Decode.Decoder CREC_DuplicatePatternContext +duplicatePatternContextDecoder : Decode.Decoder T.CREC_DuplicatePatternContext duplicatePatternContextDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "DPLambdaArgs" -> - Decode.succeed CREC_DPLambdaArgs + Decode.succeed T.CREC_DPLambdaArgs "DPFuncArgs" -> - Decode.map CREC_DPFuncArgs (Decode.field "funcName" Decode.string) + Decode.map T.CREC_DPFuncArgs (Decode.field "funcName" Decode.string) "DPCaseBranch" -> - Decode.succeed CREC_DPCaseBranch + Decode.succeed T.CREC_DPCaseBranch "DPLetBinding" -> - Decode.succeed CREC_DPLetBinding + Decode.succeed T.CREC_DPLetBinding "DPDestruct" -> - Decode.succeed CREC_DPDestruct + Decode.succeed T.CREC_DPDestruct _ -> Decode.fail ("Failed to decode DuplicatePatternContext's type: " ++ type_) ) -varKindEncoder : CREC_VarKind -> Encode.Value +varKindEncoder : T.CREC_VarKind -> Encode.Value varKindEncoder varKind = case varKind of - CREC_BadOp -> + T.CREC_BadOp -> Encode.string "BadOp" - CREC_BadVar -> + T.CREC_BadVar -> Encode.string "BadVar" - CREC_BadPattern -> + T.CREC_BadPattern -> Encode.string "BadPattern" - CREC_BadType -> + T.CREC_BadType -> Encode.string "BadType" -varKindDecoder : Decode.Decoder CREC_VarKind +varKindDecoder : Decode.Decoder T.CREC_VarKind varKindDecoder = Decode.string |> Decode.andThen (\str -> case str of "BadOp" -> - Decode.succeed CREC_BadOp + Decode.succeed T.CREC_BadOp "BadVar" -> - Decode.succeed CREC_BadVar + Decode.succeed T.CREC_BadVar "BadPattern" -> - Decode.succeed CREC_BadPattern + Decode.succeed T.CREC_BadPattern "BadType" -> - Decode.succeed CREC_BadType + Decode.succeed T.CREC_BadType _ -> Decode.fail ("Unknown VarKind: " ++ str) ) -possibleNamesEncoder : CREC_PossibleNames -> Encode.Value +possibleNamesEncoder : T.CREC_PossibleNames -> Encode.Value possibleNamesEncoder possibleNames = Encode.object [ ( "type", Encode.string "PossibleNames" ) @@ -2008,112 +1915,112 @@ possibleNamesEncoder possibleNames = ] -possibleNamesDecoder : Decode.Decoder CREC_PossibleNames +possibleNamesDecoder : Decode.Decoder T.CREC_PossibleNames possibleNamesDecoder = - Decode.map2 CREC_PossibleNames + Decode.map2 T.CREC_PossibleNames (Decode.field "locals" (DecodeX.everySet identity Decode.string)) (Decode.field "quals" (DecodeX.assocListDict identity Decode.string (DecodeX.everySet identity Decode.string))) -invalidPayloadEncoder : CREC_InvalidPayload -> Encode.Value +invalidPayloadEncoder : T.CREC_InvalidPayload -> Encode.Value invalidPayloadEncoder invalidPayload = case invalidPayload of - CREC_ExtendedRecord -> + T.CREC_ExtendedRecord -> Encode.object [ ( "type", Encode.string "ExtendedRecord" ) ] - CREC_Function -> + T.CREC_Function -> Encode.object [ ( "type", Encode.string "Function" ) ] - CREC_TypeVariable name -> + T.CREC_TypeVariable name -> Encode.object [ ( "type", Encode.string "TypeVariable" ) , ( "name", Encode.string name ) ] - CREC_UnsupportedType name -> + T.CREC_UnsupportedType name -> Encode.object [ ( "type", Encode.string "UnsupportedType" ) , ( "name", Encode.string name ) ] -invalidPayloadDecoder : Decode.Decoder CREC_InvalidPayload +invalidPayloadDecoder : Decode.Decoder T.CREC_InvalidPayload invalidPayloadDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "ExtendedRecord" -> - Decode.succeed CREC_ExtendedRecord + Decode.succeed T.CREC_ExtendedRecord "Function" -> - Decode.succeed CREC_Function + Decode.succeed T.CREC_Function "TypeVariable" -> - Decode.map CREC_TypeVariable (Decode.field "name" Decode.string) + Decode.map T.CREC_TypeVariable (Decode.field "name" Decode.string) "UnsupportedType" -> - Decode.map CREC_UnsupportedType (Decode.field "name" Decode.string) + Decode.map T.CREC_UnsupportedType (Decode.field "name" Decode.string) _ -> Decode.fail ("Failed to decode InvalidPayload's type: " ++ type_) ) -portProblemEncoder : CREC_PortProblem -> Encode.Value +portProblemEncoder : T.CREC_PortProblem -> Encode.Value portProblemEncoder portProblem = case portProblem of - CREC_CmdNoArg -> + T.CREC_CmdNoArg -> Encode.object [ ( "type", Encode.string "CmdNoArg" ) ] - CREC_CmdExtraArgs n -> + T.CREC_CmdExtraArgs n -> Encode.object [ ( "type", Encode.string "CmdExtraArgs" ) , ( "n", Encode.int n ) ] - CREC_CmdBadMsg -> + T.CREC_CmdBadMsg -> Encode.object [ ( "type", Encode.string "CmdBadMsg" ) ] - CREC_SubBad -> + T.CREC_SubBad -> Encode.object [ ( "type", Encode.string "SubBad" ) ] - CREC_NotCmdOrSub -> + T.CREC_NotCmdOrSub -> Encode.object [ ( "type", Encode.string "NotCmdOrSub" ) ] -portProblemDecoder : Decode.Decoder CREC_PortProblem +portProblemDecoder : Decode.Decoder T.CREC_PortProblem portProblemDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "CmdNoArg" -> - Decode.succeed CREC_CmdNoArg + Decode.succeed T.CREC_CmdNoArg "CmdExtraArgs" -> - Decode.map CREC_CmdExtraArgs (Decode.field "n" Decode.int) + Decode.map T.CREC_CmdExtraArgs (Decode.field "n" Decode.int) "CmdBadMsg" -> - Decode.succeed CREC_CmdBadMsg + Decode.succeed T.CREC_CmdBadMsg "SubBad" -> - Decode.succeed CREC_SubBad + Decode.succeed T.CREC_SubBad "NotCmdOrSub" -> - Decode.succeed CREC_NotCmdOrSub + Decode.succeed T.CREC_NotCmdOrSub _ -> Decode.fail ("Failed to decode PortProblem's type: " ++ type_) diff --git a/src/Compiler/Reporting/Error/Docs.elm b/src/Compiler/Reporting/Error/Docs.elm index ebed03da6..25d5f8d1f 100644 --- a/src/Compiler/Reporting/Error/Docs.elm +++ b/src/Compiler/Reporting/Error/Docs.elm @@ -1,9 +1,5 @@ module Compiler.Reporting.Error.Docs exposing - ( CRED_DefProblem(..) - , CRED_Error(..) - , CRED_NameProblem(..) - , CRED_SyntaxProblem(..) - , errorDecoder + ( errorDecoder , errorEncoder , toReports ) @@ -11,7 +7,7 @@ module Compiler.Reporting.Error.Docs exposing import Compiler.Data.NonEmptyList as NE import Compiler.Json.Decode as DecodeX import Compiler.Json.Encode as EncodeX -import Compiler.Parse.Symbol exposing (CPS_BadOperator) +import Compiler.Parse.Symbol import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Error.Syntax as E @@ -22,38 +18,10 @@ import Json.Encode as Encode import Types as T -type CRED_Error - = CRED_NoDocs T.CRA_Region - | CRED_ImplicitExposing T.CRA_Region - | CRED_SyntaxProblem CRED_SyntaxProblem - | CRED_NameProblems (NE.Nonempty CRED_NameProblem) - | CRED_DefProblems (NE.Nonempty CRED_DefProblem) - - -type CRED_SyntaxProblem - = CRED_Op T.CPP_Row T.CPP_Col - | CRED_OpBad CPS_BadOperator T.CPP_Row T.CPP_Col - | CRED_Name T.CPP_Row T.CPP_Col - | CRED_Space E.CRES_Space T.CPP_Row T.CPP_Col - | CRED_Comma T.CPP_Row T.CPP_Col - | CRED_BadEnd T.CPP_Row T.CPP_Col - - -type CRED_NameProblem - = CRED_NameDuplicate T.CDN_Name T.CRA_Region T.CRA_Region - | CRED_NameOnlyInDocs T.CDN_Name T.CRA_Region - | CRED_NameOnlyInExports T.CDN_Name T.CRA_Region - - -type CRED_DefProblem - = CRED_NoComment T.CDN_Name T.CRA_Region - | CRED_NoAnnotation T.CDN_Name T.CRA_Region - - -toReports : Code.Source -> CRED_Error -> NE.Nonempty Report.Report +toReports : Code.Source -> T.CRED_Error -> NE.Nonempty Report.Report toReports source err = case err of - CRED_NoDocs region -> + T.CRED_NoDocs region -> NE.singleton <| Report.Report "NO DOCS" region [] <| Code.toSnippet source @@ -63,7 +31,7 @@ toReports source err = , D.reflow "Learn more at " ) - CRED_ImplicitExposing region -> + T.CRED_ImplicitExposing region -> NE.singleton <| Report.Report "IMPLICIT EXPOSING" region [] <| Code.toSnippet source @@ -73,18 +41,18 @@ toReports source err = , D.reflow "A great API usually hides some implementation details, so it is rare that everything in the file should be exposed. And requiring package authors to be explicit about this is a way of adding another quality check before code gets published. So as you write out the public API, ask yourself if it will be easy to understand as people read the documentation!" ) - CRED_SyntaxProblem problem -> + T.CRED_SyntaxProblem problem -> NE.singleton <| toSyntaxProblemReport source problem - CRED_NameProblems problems -> + T.CRED_NameProblems problems -> NE.map (toNameProblemReport source) problems - CRED_DefProblems problems -> + T.CRED_DefProblems problems -> NE.map (toDefProblemReport source) problems -toSyntaxProblemReport : Code.Source -> CRED_SyntaxProblem -> Report.Report +toSyntaxProblemReport : Code.Source -> T.CRED_SyntaxProblem -> Report.Report toSyntaxProblemReport source problem = let toSyntaxReport : T.CPP_Row -> T.CPP_Col -> String -> Report.Report @@ -106,22 +74,22 @@ toSyntaxProblemReport source problem = ) in case problem of - CRED_Op row col -> + T.CRED_Op row col -> toSyntaxReport row col "I am trying to parse an operator like (+) or (*) but something is going wrong." - CRED_OpBad _ row col -> + T.CRED_OpBad _ row col -> toSyntaxReport row col "I am trying to parse an operator like (+) or (*) but it looks like you are using a reserved symbol in this case." - CRED_Name row col -> + T.CRED_Name row col -> toSyntaxReport row col "I was expecting to see the name of another exposed value from this module." - CRED_Space space row col -> + T.CRED_Space space row col -> E.toSpaceReport source space row col - CRED_Comma row col -> + T.CRED_Comma row col -> toSyntaxReport row col "I was expecting to see a comma next." - CRED_BadEnd row col -> + T.CRED_BadEnd row col -> toSyntaxReport row col "I am not really sure what I am getting stuck on though." @@ -135,10 +103,10 @@ toRegion row col = T.CRA_Region pos pos -toNameProblemReport : Code.Source -> CRED_NameProblem -> Report.Report +toNameProblemReport : Code.Source -> T.CRED_NameProblem -> Report.Report toNameProblemReport source problem = case problem of - CRED_NameDuplicate name r1 r2 -> + T.CRED_NameDuplicate name r1 r2 -> Report.Report "DUPLICATE DOCS" r2 [] <| Code.toPair source r1 @@ -151,7 +119,7 @@ toNameProblemReport source problem = , D.fromChars "Remove one of them!" ) - CRED_NameOnlyInDocs name region -> + T.CRED_NameOnlyInDocs name region -> Report.Report "DOCS MISTAKE" region [] <| Code.toSnippet source region @@ -160,7 +128,7 @@ toNameProblemReport source problem = , D.reflow ("Does it need to be added to the `exposing` list as well? Or maybe you removed `" ++ name ++ "` and forgot to delete it here?") ) - CRED_NameOnlyInExports name region -> + T.CRED_NameOnlyInExports name region -> Report.Report "DOCS MISTAKE" region [] <| Code.toSnippet source region @@ -173,10 +141,10 @@ toNameProblemReport source problem = ) -toDefProblemReport : Code.Source -> CRED_DefProblem -> Report.Report +toDefProblemReport : Code.Source -> T.CRED_DefProblem -> Report.Report toDefProblemReport source problem = case problem of - CRED_NoComment name region -> + T.CRED_NoComment name region -> Report.Report "NO DOCS" region [] <| Code.toSnippet source region @@ -188,7 +156,7 @@ toDefProblemReport source problem = ] ) - CRED_NoAnnotation name region -> + T.CRED_NoAnnotation name region -> Report.Report "NO TYPE ANNOTATION" region [] <| Code.toSnippet source region @@ -205,77 +173,77 @@ toDefProblemReport source problem = -- ENCODERS and DECODERS -errorEncoder : CRED_Error -> Encode.Value +errorEncoder : T.CRED_Error -> Encode.Value errorEncoder error = case error of - CRED_NoDocs region -> + T.CRED_NoDocs region -> Encode.object [ ( "type", Encode.string "NoDocs" ) , ( "region", A.regionEncoder region ) ] - CRED_ImplicitExposing region -> + T.CRED_ImplicitExposing region -> Encode.object [ ( "type", Encode.string "ImplicitExposing" ) , ( "region", A.regionEncoder region ) ] - CRED_SyntaxProblem problem -> + T.CRED_SyntaxProblem problem -> Encode.object [ ( "type", Encode.string "SyntaxProblem" ) , ( "problem", syntaxProblemEncoder problem ) ] - CRED_NameProblems problems -> + T.CRED_NameProblems problems -> Encode.object [ ( "type", Encode.string "NameProblems" ) , ( "problems", EncodeX.nonempty nameProblemEncoder problems ) ] - CRED_DefProblems problems -> + T.CRED_DefProblems problems -> Encode.object [ ( "type", Encode.string "DefProblems" ) , ( "problems", EncodeX.nonempty defProblemEncoder problems ) ] -errorDecoder : Decode.Decoder CRED_Error +errorDecoder : Decode.Decoder T.CRED_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "NoDocs" -> - Decode.map CRED_NoDocs (Decode.field "region" A.regionDecoder) + Decode.map T.CRED_NoDocs (Decode.field "region" A.regionDecoder) "ImplicitExposing" -> - Decode.map CRED_ImplicitExposing (Decode.field "region" A.regionDecoder) + Decode.map T.CRED_ImplicitExposing (Decode.field "region" A.regionDecoder) "SyntaxProblem" -> - Decode.map CRED_SyntaxProblem (Decode.field "problem" syntaxProblemDecoder) + Decode.map T.CRED_SyntaxProblem (Decode.field "problem" syntaxProblemDecoder) "NameProblems" -> - Decode.map CRED_NameProblems (Decode.field "problems" (DecodeX.nonempty nameProblemDecoder)) + Decode.map T.CRED_NameProblems (Decode.field "problems" (DecodeX.nonempty nameProblemDecoder)) "DefProblems" -> - Decode.map CRED_DefProblems (Decode.field "problems" (DecodeX.nonempty defProblemDecoder)) + Decode.map T.CRED_DefProblems (Decode.field "problems" (DecodeX.nonempty defProblemDecoder)) _ -> Decode.fail ("Failed to decode Error's type: " ++ type_) ) -syntaxProblemEncoder : CRED_SyntaxProblem -> Encode.Value +syntaxProblemEncoder : T.CRED_SyntaxProblem -> Encode.Value syntaxProblemEncoder syntaxProblem = case syntaxProblem of - CRED_Op row col -> + T.CRED_Op row col -> Encode.object [ ( "type", Encode.string "Op" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRED_OpBad badOperator row col -> + T.CRED_OpBad badOperator row col -> Encode.object [ ( "type", Encode.string "OpBad" ) , ( "badOperator", Compiler.Parse.Symbol.badOperatorEncoder badOperator ) @@ -283,14 +251,14 @@ syntaxProblemEncoder syntaxProblem = , ( "col", Encode.int col ) ] - CRED_Name row col -> + T.CRED_Name row col -> Encode.object [ ( "type", Encode.string "Name" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRED_Space name row col -> + T.CRED_Space name row col -> Encode.object [ ( "type", Encode.string "Space" ) , ( "name", E.spaceEncoder name ) @@ -298,14 +266,14 @@ syntaxProblemEncoder syntaxProblem = , ( "col", Encode.int col ) ] - CRED_Comma row col -> + T.CRED_Comma row col -> Encode.object [ ( "type", Encode.string "Comma" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRED_BadEnd row col -> + T.CRED_BadEnd row col -> Encode.object [ ( "type", Encode.string "BadEnd" ) , ( "row", Encode.int row ) @@ -313,41 +281,41 @@ syntaxProblemEncoder syntaxProblem = ] -syntaxProblemDecoder : Decode.Decoder CRED_SyntaxProblem +syntaxProblemDecoder : Decode.Decoder T.CRED_SyntaxProblem syntaxProblemDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Op" -> - Decode.map2 CRED_Op + Decode.map2 T.CRED_Op (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "OpBad" -> - Decode.map3 CRED_OpBad + Decode.map3 T.CRED_OpBad (Decode.field "badOperator" Compiler.Parse.Symbol.badOperatorDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Name" -> - Decode.map2 CRED_Name + Decode.map2 T.CRED_Name (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Space" -> - Decode.map3 CRED_Space + Decode.map3 T.CRED_Space (Decode.field "name" E.spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Comma" -> - Decode.map2 CRED_Comma + Decode.map2 T.CRED_Comma (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "BadEnd" -> - Decode.map2 CRED_BadEnd + Decode.map2 T.CRED_BadEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -356,10 +324,10 @@ syntaxProblemDecoder = ) -nameProblemEncoder : CRED_NameProblem -> Encode.Value +nameProblemEncoder : T.CRED_NameProblem -> Encode.Value nameProblemEncoder nameProblem = case nameProblem of - CRED_NameDuplicate name r1 r2 -> + T.CRED_NameDuplicate name r1 r2 -> Encode.object [ ( "type", Encode.string "NameDuplicate" ) , ( "name", Encode.string name ) @@ -367,14 +335,14 @@ nameProblemEncoder nameProblem = , ( "r2", A.regionEncoder r2 ) ] - CRED_NameOnlyInDocs name region -> + T.CRED_NameOnlyInDocs name region -> Encode.object [ ( "type", Encode.string "NameOnlyInDocs" ) , ( "name", Encode.string name ) , ( "region", A.regionEncoder region ) ] - CRED_NameOnlyInExports name region -> + T.CRED_NameOnlyInExports name region -> Encode.object [ ( "type", Encode.string "NameOnlyInExports" ) , ( "name", Encode.string name ) @@ -382,25 +350,25 @@ nameProblemEncoder nameProblem = ] -nameProblemDecoder : Decode.Decoder CRED_NameProblem +nameProblemDecoder : Decode.Decoder T.CRED_NameProblem nameProblemDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "NameDuplicate" -> - Decode.map3 CRED_NameDuplicate + Decode.map3 T.CRED_NameDuplicate (Decode.field "name" Decode.string) (Decode.field "r1" A.regionDecoder) (Decode.field "r2" A.regionDecoder) "NameOnlyInDocs" -> - Decode.map2 CRED_NameOnlyInDocs + Decode.map2 T.CRED_NameOnlyInDocs (Decode.field "name" Decode.string) (Decode.field "region" A.regionDecoder) "NameOnlyInExports" -> - Decode.map2 CRED_NameOnlyInExports + Decode.map2 T.CRED_NameOnlyInExports (Decode.field "name" Decode.string) (Decode.field "region" A.regionDecoder) @@ -409,17 +377,17 @@ nameProblemDecoder = ) -defProblemEncoder : CRED_DefProblem -> Encode.Value +defProblemEncoder : T.CRED_DefProblem -> Encode.Value defProblemEncoder defProblem = case defProblem of - CRED_NoComment name region -> + T.CRED_NoComment name region -> Encode.object [ ( "type", Encode.string "NoComment" ) , ( "name", Encode.string name ) , ( "region", A.regionEncoder region ) ] - CRED_NoAnnotation name region -> + T.CRED_NoAnnotation name region -> Encode.object [ ( "type", Encode.string "NoAnnotation" ) , ( "name", Encode.string name ) @@ -427,19 +395,19 @@ defProblemEncoder defProblem = ] -defProblemDecoder : Decode.Decoder CRED_DefProblem +defProblemDecoder : Decode.Decoder T.CRED_DefProblem defProblemDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "NoComment" -> - Decode.map2 CRED_NoComment + Decode.map2 T.CRED_NoComment (Decode.field "name" Decode.string) (Decode.field "region" A.regionDecoder) "NoAnnotation" -> - Decode.map2 CRED_NoAnnotation + Decode.map2 T.CRED_NoAnnotation (Decode.field "name" Decode.string) (Decode.field "region" A.regionDecoder) diff --git a/src/Compiler/Reporting/Error/Import.elm b/src/Compiler/Reporting/Error/Import.elm index 50ec5cbda..362dd267e 100644 --- a/src/Compiler/Reporting/Error/Import.elm +++ b/src/Compiler/Reporting/Error/Import.elm @@ -1,7 +1,5 @@ module Compiler.Reporting.Error.Import exposing - ( CREI_Error(..) - , CREI_Problem(..) - , errorDecoder + ( errorDecoder , errorEncoder , problemDecoder , problemEncoder @@ -25,28 +23,13 @@ import Types as T --- ERROR - - -type CREI_Error - = CREI_Error T.CRA_Region T.CEMN_Raw (EverySet String T.CEMN_Raw) CREI_Problem - - -type CREI_Problem - = CREI_NotFound - | CREI_Ambiguous String (List String) T.CEP_Name (List T.CEP_Name) - | CREI_AmbiguousLocal String String (List String) - | CREI_AmbiguousForeign T.CEP_Name T.CEP_Name (List T.CEP_Name) - - - -- TO REPORT -toReport : Code.Source -> CREI_Error -> Report.Report -toReport source (CREI_Error region name unimportedModules problem) = +toReport : Code.Source -> T.CREI_Error -> Report.Report +toReport source (T.CREI_Error region name unimportedModules problem) = case problem of - CREI_NotFound -> + T.CREI_NotFound -> Report.Report "MODULE NOT FOUND" region [] <| Code.toSnippet source region @@ -90,7 +73,7 @@ toReport source (CREI_Error region name unimportedModules problem) = ] ) - CREI_Ambiguous path _ pkg _ -> + T.CREI_Ambiguous path _ pkg _ -> Report.Report "AMBIGUOUS IMPORT" region [] <| Code.toSnippet source region @@ -136,7 +119,7 @@ toReport source (CREI_Error region name unimportedModules problem) = ] ) - CREI_AmbiguousLocal path1 path2 paths -> + T.CREI_AmbiguousLocal path1 path2 paths -> Report.Report "AMBIGUOUS IMPORT" region [] <| Code.toSnippet source region @@ -155,7 +138,7 @@ toReport source (CREI_Error region name unimportedModules problem) = ] ) - CREI_AmbiguousForeign pkg1 pkg2 pkgs -> + T.CREI_AmbiguousForeign pkg1 pkg2 pkgs -> Report.Report "AMBIGUOUS IMPORT" region [] <| Code.toSnippet source region @@ -187,15 +170,15 @@ toSuggestions name unimportedModules = -- ENCODERS and DECODERS -problemEncoder : CREI_Problem -> Encode.Value +problemEncoder : T.CREI_Problem -> Encode.Value problemEncoder problem = case problem of - CREI_NotFound -> + T.CREI_NotFound -> Encode.object [ ( "type", Encode.string "NotFound" ) ] - CREI_Ambiguous path paths pkg pkgs -> + T.CREI_Ambiguous path paths pkg pkgs -> Encode.object [ ( "type", Encode.string "Ambiguous" ) , ( "path", Encode.string path ) @@ -204,7 +187,7 @@ problemEncoder problem = , ( "pkgs", Encode.list Pkg.nameEncoder pkgs ) ] - CREI_AmbiguousLocal path1 path2 paths -> + T.CREI_AmbiguousLocal path1 path2 paths -> Encode.object [ ( "type", Encode.string "AmbiguousLocal" ) , ( "path1", Encode.string path1 ) @@ -212,7 +195,7 @@ problemEncoder problem = , ( "paths", Encode.list Encode.string paths ) ] - CREI_AmbiguousForeign pkg1 pkg2 pkgs -> + T.CREI_AmbiguousForeign pkg1 pkg2 pkgs -> Encode.object [ ( "type", Encode.string "AmbiguousForeign" ) , ( "pkg1", Pkg.nameEncoder pkg1 ) @@ -221,30 +204,30 @@ problemEncoder problem = ] -problemDecoder : Decode.Decoder CREI_Problem +problemDecoder : Decode.Decoder T.CREI_Problem problemDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "NotFound" -> - Decode.succeed CREI_NotFound + Decode.succeed T.CREI_NotFound "Ambiguous" -> - Decode.map4 CREI_Ambiguous + Decode.map4 T.CREI_Ambiguous (Decode.field "path" Decode.string) (Decode.field "paths" (Decode.list Decode.string)) (Decode.field "pkg" Pkg.nameDecoder) (Decode.field "pkgs" (Decode.list Pkg.nameDecoder)) "AmbiguousLocal" -> - Decode.map3 CREI_AmbiguousLocal + Decode.map3 T.CREI_AmbiguousLocal (Decode.field "path1" Decode.string) (Decode.field "path2" Decode.string) (Decode.field "paths" (Decode.list Decode.string)) "AmbiguousForeign" -> - Decode.map3 CREI_AmbiguousForeign + Decode.map3 T.CREI_AmbiguousForeign (Decode.field "pkg1" Pkg.nameDecoder) (Decode.field "pkg2" Pkg.nameDecoder) (Decode.field "pkgs" (Decode.list Pkg.nameDecoder)) @@ -254,8 +237,8 @@ problemDecoder = ) -errorEncoder : CREI_Error -> Encode.Value -errorEncoder (CREI_Error region name unimportedModules problem) = +errorEncoder : T.CREI_Error -> Encode.Value +errorEncoder (T.CREI_Error region name unimportedModules problem) = Encode.object [ ( "type", Encode.string "Error" ) , ( "region", A.regionEncoder region ) @@ -265,9 +248,9 @@ errorEncoder (CREI_Error region name unimportedModules problem) = ] -errorDecoder : Decode.Decoder CREI_Error +errorDecoder : Decode.Decoder T.CREI_Error errorDecoder = - Decode.map4 CREI_Error + Decode.map4 T.CREI_Error (Decode.field "region" A.regionDecoder) (Decode.field "name" ModuleName.rawDecoder) (Decode.field "unimportedModules" (DecodeX.everySet identity ModuleName.rawDecoder)) diff --git a/src/Compiler/Reporting/Error/Main.elm b/src/Compiler/Reporting/Error/Main.elm index 7028daa3c..ce71c5a22 100644 --- a/src/Compiler/Reporting/Error/Main.elm +++ b/src/Compiler/Reporting/Error/Main.elm @@ -1,6 +1,5 @@ module Compiler.Reporting.Error.Main exposing - ( CREM_Error(..) - , errorDecoder + ( errorDecoder , errorEncoder , toReport ) @@ -11,7 +10,6 @@ import Compiler.Reporting.Doc as D import Compiler.Reporting.Error.Canonicalize as E import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type as RT -import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report as Report import Json.Decode as Decode import Json.Encode as Encode @@ -19,23 +17,13 @@ import Types as T --- ERROR - - -type CREM_Error - = CREM_BadType T.CRA_Region T.CASTC_Type - | CREM_BadCycle T.CRA_Region T.CDN_Name (List T.CDN_Name) - | CREM_BadFlags T.CRA_Region T.CASTC_Type E.CREC_InvalidPayload - - - -- TO REPORT -toReport : L.CRRTL_Localizer -> Code.Source -> CREM_Error -> Report.Report +toReport : T.CRRTL_Localizer -> Code.Source -> T.CREM_Error -> Report.Report toReport localizer source err = case err of - CREM_BadType region tipe -> + T.CREM_BadType region tipe -> Report.Report "BAD MAIN TYPE" region [] <| Code.toSnippet source region Nothing <| ( D.fromChars "I cannot handle this type of `main` value:" @@ -46,7 +34,7 @@ toReport localizer source err = ] ) - CREM_BadCycle region name names -> + T.CREM_BadCycle region name names -> Report.Report "BAD MAIN" region [] <| Code.toSnippet source region Nothing <| ( D.fromChars "A `main` definition cannot be defined in terms of itself." @@ -56,7 +44,7 @@ toReport localizer source err = ] ) - CREM_BadFlags region _ invalidPayload -> + T.CREM_BadFlags region _ invalidPayload -> let formatDetails : ( String, D.Doc ) -> Report.Report formatDetails ( aBadKindOfThing, butThatIsNoGood ) = @@ -68,22 +56,22 @@ toReport localizer source err = in formatDetails <| case invalidPayload of - E.CREC_ExtendedRecord -> + T.CREC_ExtendedRecord -> ( "an extended record" , D.reflow "But the exact shape of the record must be known at compile time. No type variables!" ) - E.CREC_Function -> + T.CREC_Function -> ( "a function" , D.reflow "But if I allowed functions from JS, it would be possible to sneak side-effects and runtime exceptions into Elm!" ) - E.CREC_TypeVariable name -> + T.CREC_TypeVariable name -> ( "an unspecified type" , D.reflow ("But type variables like `" ++ name ++ "` cannot be given as flags. I need to know exactly what type of data I am getting, so I can guarantee that unexpected data cannot sneak in and crash the Elm program.") ) - E.CREC_UnsupportedType name -> + T.CREC_UnsupportedType name -> ( "a `" ++ name ++ "` value" , D.stack [ D.reflow "I cannot handle that. The types that CAN be in flags include:" @@ -98,17 +86,17 @@ toReport localizer source err = -- ENCODERS and DECODERS -errorEncoder : CREM_Error -> Encode.Value +errorEncoder : T.CREM_Error -> Encode.Value errorEncoder error = case error of - CREM_BadType region tipe -> + T.CREM_BadType region tipe -> Encode.object [ ( "type", Encode.string "BadType" ) , ( "region", A.regionEncoder region ) , ( "tipe", Can.typeEncoder tipe ) ] - CREM_BadCycle region name names -> + T.CREM_BadCycle region name names -> Encode.object [ ( "type", Encode.string "BadCycle" ) , ( "region", A.regionEncoder region ) @@ -116,7 +104,7 @@ errorEncoder error = , ( "names", Encode.list Encode.string names ) ] - CREM_BadFlags region subType invalidPayload -> + T.CREM_BadFlags region subType invalidPayload -> Encode.object [ ( "type", Encode.string "BadFlags" ) , ( "region", A.regionEncoder region ) @@ -125,25 +113,25 @@ errorEncoder error = ] -errorDecoder : Decode.Decoder CREM_Error +errorDecoder : Decode.Decoder T.CREM_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "BadType" -> - Decode.map2 CREM_BadType + Decode.map2 T.CREM_BadType (Decode.field "region" A.regionDecoder) (Decode.field "tipe" Can.typeDecoder) "BadCycle" -> - Decode.map3 CREM_BadCycle + Decode.map3 T.CREM_BadCycle (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "names" (Decode.list Decode.string)) "BadFlags" -> - Decode.map3 CREM_BadFlags + Decode.map3 T.CREM_BadFlags (Decode.field "region" A.regionDecoder) (Decode.field "subType" Can.typeDecoder) (Decode.field "invalidPayload" E.invalidPayloadDecoder) diff --git a/src/Compiler/Reporting/Error/Pattern.elm b/src/Compiler/Reporting/Error/Pattern.elm index 7b4f887c3..f6d1aac3c 100644 --- a/src/Compiler/Reporting/Error/Pattern.elm +++ b/src/Compiler/Reporting/Error/Pattern.elm @@ -1,19 +1,19 @@ module Compiler.Reporting.Error.Pattern exposing (toReport) -import Compiler.Nitpick.PatternMatches as P import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Report as Report +import Types as T -- TO REPORT -toReport : Code.Source -> P.CNPM_Error -> Report.Report +toReport : Code.Source -> T.CNPM_Error -> Report.Report toReport source err = case err of - P.CNPM_Redundant caseRegion patternRegion index -> + T.CNPM_Redundant caseRegion patternRegion index -> Report.Report "REDUNDANT PATTERN" patternRegion [] <| Code.toSnippet source caseRegion @@ -26,9 +26,9 @@ toReport source err = "Any value with this shape will be handled by a previous pattern, so it should be removed." ) - P.CNPM_Incomplete region context unhandled -> + T.CNPM_Incomplete region context unhandled -> case context of - P.CNPM_BadArg -> + T.CNPM_BadArg -> Report.Report "UNSAFE PATTERN" region [] <| Code.toSnippet source region @@ -42,7 +42,7 @@ toReport source err = ] ) - P.CNPM_BadDestruct -> + T.CNPM_BadDestruct -> Report.Report "UNSAFE PATTERN" region [] <| Code.toSnippet source region @@ -58,7 +58,7 @@ toReport source err = ] ) - P.CNPM_BadCase -> + T.CNPM_BadCase -> Report.Report "MISSING PATTERNS" region [] <| Code.toSnippet source region @@ -81,7 +81,7 @@ toReport source err = -- PATTERN TO DOC -unhandledPatternsToDocBlock : List P.CNPM_Pattern -> D.Doc +unhandledPatternsToDocBlock : List T.CNPM_Pattern -> D.Doc unhandledPatternsToDocBlock unhandledPatterns = D.indent 4 <| D.dullyellow <| @@ -95,34 +95,34 @@ type Context | Unambiguous -patternToDoc : Context -> P.CNPM_Pattern -> D.Doc +patternToDoc : Context -> T.CNPM_Pattern -> D.Doc patternToDoc context pattern = case delist pattern [] of - NonList P.CNPM_Anything -> + NonList T.CNPM_Anything -> D.fromChars "_" - NonList (P.CNPM_Literal literal) -> + NonList (T.CNPM_Literal literal) -> case literal of - P.CNPM_Chr chr -> + T.CNPM_Chr chr -> D.fromChars ("'" ++ chr ++ "'") - P.CNPM_Str str -> + T.CNPM_Str str -> D.fromChars ("\"" ++ str ++ "\"") - P.CNPM_Int int -> + T.CNPM_Int int -> D.fromChars (String.fromInt int) - NonList (P.CNPM_Ctor _ "#0" []) -> + NonList (T.CNPM_Ctor _ "#0" []) -> D.fromChars "()" - NonList (P.CNPM_Ctor _ "#2" [ a, b ]) -> + NonList (T.CNPM_Ctor _ "#2" [ a, b ]) -> D.fromChars "( " |> D.a (patternToDoc Unambiguous a) |> D.a (D.fromChars ", ") |> D.a (patternToDoc Unambiguous b) |> D.a (D.fromChars " )") - NonList (P.CNPM_Ctor _ "#3" [ a, b, c ]) -> + NonList (T.CNPM_Ctor _ "#3" [ a, b, c ]) -> D.fromChars "( " |> D.a (patternToDoc Unambiguous a) |> D.a (D.fromChars ", ") @@ -131,7 +131,7 @@ patternToDoc context pattern = |> D.a (patternToDoc Unambiguous c) |> D.a (D.fromChars " )") - NonList (P.CNPM_Ctor _ name args) -> + NonList (T.CNPM_Ctor _ name args) -> let ctorDoc : D.Doc ctorDoc = @@ -181,18 +181,18 @@ patternToDoc context pattern = type Structure - = FiniteList (List P.CNPM_Pattern) - | Conses (List P.CNPM_Pattern) P.CNPM_Pattern - | NonList P.CNPM_Pattern + = FiniteList (List T.CNPM_Pattern) + | Conses (List T.CNPM_Pattern) T.CNPM_Pattern + | NonList T.CNPM_Pattern -delist : P.CNPM_Pattern -> List P.CNPM_Pattern -> Structure +delist : T.CNPM_Pattern -> List T.CNPM_Pattern -> Structure delist pattern revEntries = case pattern of - P.CNPM_Ctor _ "[]" [] -> + T.CNPM_Ctor _ "[]" [] -> FiniteList revEntries - P.CNPM_Ctor _ "::" [ hd, tl ] -> + T.CNPM_Ctor _ "::" [ hd, tl ] -> delist tl (hd :: revEntries) _ -> diff --git a/src/Compiler/Reporting/Error/Syntax.elm b/src/Compiler/Reporting/Error/Syntax.elm index 7b426c1f9..f192e2505 100644 --- a/src/Compiler/Reporting/Error/Syntax.elm +++ b/src/Compiler/Reporting/Error/Syntax.elm @@ -1,36 +1,5 @@ module Compiler.Reporting.Error.Syntax exposing - ( CRES_Case(..) - , CRES_Char(..) - , CRES_CustomType(..) - , CRES_Decl(..) - , CRES_DeclDef(..) - , CRES_DeclType(..) - , CRES_Def(..) - , CRES_Destruct(..) - , CRES_Error(..) - , CRES_Escape(..) - , CRES_Exposing(..) - , CRES_Expr(..) - , CRES_Func(..) - , CRES_If(..) - , CRES_Let(..) - , CRES_List_(..) - , CRES_Module(..) - , CRES_Number(..) - , CRES_PList(..) - , CRES_PRecord(..) - , CRES_PTuple(..) - , CRES_Pattern(..) - , CRES_Port(..) - , CRES_Record(..) - , CRES_Space(..) - , CRES_String_(..) - , CRES_TRecord(..) - , CRES_TTuple(..) - , CRES_Tuple(..) - , CRES_Type(..) - , CRES_TypeAlias(..) - , errorDecoder + ( errorDecoder , errorEncoder , spaceDecoder , spaceEncoder @@ -39,7 +8,7 @@ module Compiler.Reporting.Error.Syntax exposing ) import Compiler.Elm.ModuleName as ModuleName -import Compiler.Parse.Symbol exposing (CPS_BadOperator(..)) +import Compiler.Parse.Symbol import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code @@ -51,433 +20,13 @@ import Types as T --- ALL SYNTAX ERRORS - - -type CRES_Error - = CRES_ModuleNameUnspecified T.CEMN_Raw - | CRES_ModuleNameMismatch T.CEMN_Raw (T.CRA_Located T.CEMN_Raw) - | CRES_UnexpectedPort T.CRA_Region - | CRES_NoPorts T.CRA_Region - | CRES_NoPortsInPackage (T.CRA_Located T.CDN_Name) - | CRES_NoPortModulesInPackage T.CRA_Region - | CRES_NoEffectsOutsideKernel T.CRA_Region - | CRES_ParseError CRES_Module - - -type CRES_Module - = CRES_ModuleSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_ModuleBadEnd T.CPP_Row T.CPP_Col - -- - | CRES_ModuleProblem T.CPP_Row T.CPP_Col - | CRES_ModuleName T.CPP_Row T.CPP_Col - | CRES_ModuleExposing CRES_Exposing T.CPP_Row T.CPP_Col - -- - | CRES_PortModuleProblem T.CPP_Row T.CPP_Col - | CRES_PortModuleName T.CPP_Row T.CPP_Col - | CRES_PortModuleExposing CRES_Exposing T.CPP_Row T.CPP_Col - -- - | CRES_Effect T.CPP_Row T.CPP_Col - -- - | CRES_FreshLine T.CPP_Row T.CPP_Col - -- - | CRES_ImportStart T.CPP_Row T.CPP_Col - | CRES_ImportName T.CPP_Row T.CPP_Col - | CRES_ImportAs T.CPP_Row T.CPP_Col - | CRES_ImportAlias T.CPP_Row T.CPP_Col - | CRES_ImportExposing T.CPP_Row T.CPP_Col - | CRES_ImportExposingList CRES_Exposing T.CPP_Row T.CPP_Col - | CRES_ImportEnd T.CPP_Row T.CPP_Col -- different based on col=1 or if greater - -- - | CRES_ImportIndentName T.CPP_Row T.CPP_Col - | CRES_ImportIndentAlias T.CPP_Row T.CPP_Col - | CRES_ImportIndentExposingList T.CPP_Row T.CPP_Col - -- - | CRES_Infix T.CPP_Row T.CPP_Col - -- - | CRES_Declarations CRES_Decl T.CPP_Row T.CPP_Col - - -type CRES_Exposing - = CRES_ExposingSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_ExposingStart T.CPP_Row T.CPP_Col - | CRES_ExposingValue T.CPP_Row T.CPP_Col - | CRES_ExposingOperator T.CPP_Row T.CPP_Col - | CRES_ExposingOperatorReserved CPS_BadOperator T.CPP_Row T.CPP_Col - | CRES_ExposingOperatorRightParen T.CPP_Row T.CPP_Col - | CRES_ExposingTypePrivacy T.CPP_Row T.CPP_Col - | CRES_ExposingEnd T.CPP_Row T.CPP_Col - -- - | CRES_ExposingIndentEnd T.CPP_Row T.CPP_Col - | CRES_ExposingIndentValue T.CPP_Row T.CPP_Col - - - --- DECLARATIONS - - -type CRES_Decl - = CRES_DeclStart T.CPP_Row T.CPP_Col - | CRES_DeclSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_Port CRES_Port T.CPP_Row T.CPP_Col - | CRES_DeclType CRES_DeclType T.CPP_Row T.CPP_Col - | CRES_DeclDef T.CDN_Name CRES_DeclDef T.CPP_Row T.CPP_Col - -- - | CRES_DeclFreshLineAfterDocComment T.CPP_Row T.CPP_Col - - -type CRES_DeclDef - = CRES_DeclDefSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_DeclDefEquals T.CPP_Row T.CPP_Col - | CRES_DeclDefType CRES_Type T.CPP_Row T.CPP_Col - | CRES_DeclDefArg CRES_Pattern T.CPP_Row T.CPP_Col - | CRES_DeclDefBody CRES_Expr T.CPP_Row T.CPP_Col - | CRES_DeclDefNameRepeat T.CPP_Row T.CPP_Col - | CRES_DeclDefNameMatch T.CDN_Name T.CPP_Row T.CPP_Col - -- - | CRES_DeclDefIndentType T.CPP_Row T.CPP_Col - | CRES_DeclDefIndentEquals T.CPP_Row T.CPP_Col - | CRES_DeclDefIndentBody T.CPP_Row T.CPP_Col - - -type CRES_Port - = CRES_PortSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_PortName T.CPP_Row T.CPP_Col - | CRES_PortColon T.CPP_Row T.CPP_Col - | CRES_PortType CRES_Type T.CPP_Row T.CPP_Col - | CRES_PortIndentName T.CPP_Row T.CPP_Col - | CRES_PortIndentColon T.CPP_Row T.CPP_Col - | CRES_PortIndentType T.CPP_Row T.CPP_Col - - - --- TYPE DECLARATIONS - - -type CRES_DeclType - = CRES_DT_Space CRES_Space T.CPP_Row T.CPP_Col - | CRES_DT_Name T.CPP_Row T.CPP_Col - | CRES_DT_Alias CRES_TypeAlias T.CPP_Row T.CPP_Col - | CRES_DT_Union CRES_CustomType T.CPP_Row T.CPP_Col - -- - | CRES_DT_IndentName T.CPP_Row T.CPP_Col - - -type CRES_TypeAlias - = CRES_AliasSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_AliasName T.CPP_Row T.CPP_Col - | CRES_AliasEquals T.CPP_Row T.CPP_Col - | CRES_AliasBody CRES_Type T.CPP_Row T.CPP_Col - -- - | CRES_AliasIndentEquals T.CPP_Row T.CPP_Col - | CRES_AliasIndentBody T.CPP_Row T.CPP_Col - - -type CRES_CustomType - = CRES_CT_Space CRES_Space T.CPP_Row T.CPP_Col - | CRES_CT_Name T.CPP_Row T.CPP_Col - | CRES_CT_Equals T.CPP_Row T.CPP_Col - | CRES_CT_Bar T.CPP_Row T.CPP_Col - | CRES_CT_Variant T.CPP_Row T.CPP_Col - | CRES_CT_VariantArg CRES_Type T.CPP_Row T.CPP_Col - -- - | CRES_CT_IndentEquals T.CPP_Row T.CPP_Col - | CRES_CT_IndentBar T.CPP_Row T.CPP_Col - | CRES_CT_IndentAfterBar T.CPP_Row T.CPP_Col - | CRES_CT_IndentAfterEquals T.CPP_Row T.CPP_Col - - - --- EXPRESSIONS - - -type CRES_Expr - = CRES_Let CRES_Let T.CPP_Row T.CPP_Col - | CRES_Case CRES_Case T.CPP_Row T.CPP_Col - | CRES_If CRES_If T.CPP_Row T.CPP_Col - | CRES_List CRES_List_ T.CPP_Row T.CPP_Col - | CRES_Record CRES_Record T.CPP_Row T.CPP_Col - | CRES_Tuple CRES_Tuple T.CPP_Row T.CPP_Col - | CRES_Func CRES_Func T.CPP_Row T.CPP_Col - -- - | CRES_Dot T.CPP_Row T.CPP_Col - | CRES_Access T.CPP_Row T.CPP_Col - | CRES_OperatorRight T.CDN_Name T.CPP_Row T.CPP_Col - | CRES_OperatorReserved CPS_BadOperator T.CPP_Row T.CPP_Col - -- - | CRES_Start T.CPP_Row T.CPP_Col - | CRES_Char CRES_Char T.CPP_Row T.CPP_Col - | CRES_String_ CRES_String_ T.CPP_Row T.CPP_Col - | CRES_Number CRES_Number T.CPP_Row T.CPP_Col - | CRES_Space CRES_Space T.CPP_Row T.CPP_Col - | CRES_EndlessShader T.CPP_Row T.CPP_Col - | CRES_ShaderProblem String T.CPP_Row T.CPP_Col - | CRES_IndentOperatorRight T.CDN_Name T.CPP_Row T.CPP_Col - - -type CRES_Record - = CRES_RecordOpen T.CPP_Row T.CPP_Col - | CRES_RecordEnd T.CPP_Row T.CPP_Col - | CRES_RecordField T.CPP_Row T.CPP_Col - | CRES_RecordEquals T.CPP_Row T.CPP_Col - | CRES_RecordExpr CRES_Expr T.CPP_Row T.CPP_Col - | CRES_RecordSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_RecordIndentOpen T.CPP_Row T.CPP_Col - | CRES_RecordIndentEnd T.CPP_Row T.CPP_Col - | CRES_RecordIndentField T.CPP_Row T.CPP_Col - | CRES_RecordIndentEquals T.CPP_Row T.CPP_Col - | CRES_RecordIndentExpr T.CPP_Row T.CPP_Col - - -type CRES_Tuple - = CRES_TupleExpr CRES_Expr T.CPP_Row T.CPP_Col - | CRES_TupleSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_TupleEnd T.CPP_Row T.CPP_Col - | CRES_TupleOperatorClose T.CPP_Row T.CPP_Col - | CRES_TupleOperatorReserved CPS_BadOperator T.CPP_Row T.CPP_Col - -- - | CRES_TupleIndentExpr1 T.CPP_Row T.CPP_Col - | CRES_TupleIndentExprN T.CPP_Row T.CPP_Col - | CRES_TupleIndentEnd T.CPP_Row T.CPP_Col - - -type CRES_List_ - = CRES_ListSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_ListOpen T.CPP_Row T.CPP_Col - | CRES_ListExpr CRES_Expr T.CPP_Row T.CPP_Col - | CRES_ListEnd T.CPP_Row T.CPP_Col - -- - | CRES_ListIndentOpen T.CPP_Row T.CPP_Col - | CRES_ListIndentEnd T.CPP_Row T.CPP_Col - | CRES_ListIndentExpr T.CPP_Row T.CPP_Col - - -type CRES_Func - = CRES_FuncSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_FuncArg CRES_Pattern T.CPP_Row T.CPP_Col - | CRES_FuncBody CRES_Expr T.CPP_Row T.CPP_Col - | CRES_FuncArrow T.CPP_Row T.CPP_Col - -- - | CRES_FuncIndentArg T.CPP_Row T.CPP_Col - | CRES_FuncIndentArrow T.CPP_Row T.CPP_Col - | CRES_FuncIndentBody T.CPP_Row T.CPP_Col - - -type CRES_Case - = CRES_CaseSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_CaseOf T.CPP_Row T.CPP_Col - | CRES_CasePattern CRES_Pattern T.CPP_Row T.CPP_Col - | CRES_CaseArrow T.CPP_Row T.CPP_Col - | CRES_CaseExpr CRES_Expr T.CPP_Row T.CPP_Col - | CRES_CaseBranch CRES_Expr T.CPP_Row T.CPP_Col - -- - | CRES_CaseIndentOf T.CPP_Row T.CPP_Col - | CRES_CaseIndentExpr T.CPP_Row T.CPP_Col - | CRES_CaseIndentPattern T.CPP_Row T.CPP_Col - | CRES_CaseIndentArrow T.CPP_Row T.CPP_Col - | CRES_CaseIndentBranch T.CPP_Row T.CPP_Col - | CRES_CasePatternAlignment Int T.CPP_Row T.CPP_Col - - -type CRES_If - = CRES_IfSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_IfThen T.CPP_Row T.CPP_Col - | CRES_IfElse T.CPP_Row T.CPP_Col - | CRES_IfElseBranchStart T.CPP_Row T.CPP_Col - -- - | CRES_IfCondition CRES_Expr T.CPP_Row T.CPP_Col - | CRES_IfThenBranch CRES_Expr T.CPP_Row T.CPP_Col - | CRES_IfElseBranch CRES_Expr T.CPP_Row T.CPP_Col - -- - | CRES_IfIndentCondition T.CPP_Row T.CPP_Col - | CRES_IfIndentThen T.CPP_Row T.CPP_Col - | CRES_IfIndentThenBranch T.CPP_Row T.CPP_Col - | CRES_IfIndentElseBranch T.CPP_Row T.CPP_Col - | CRES_IfIndentElse T.CPP_Row T.CPP_Col - - -type CRES_Let - = CRES_LetSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_LetIn T.CPP_Row T.CPP_Col - | CRES_LetDefAlignment Int T.CPP_Row T.CPP_Col - | CRES_LetDefName T.CPP_Row T.CPP_Col - | CRES_LetDef T.CDN_Name CRES_Def T.CPP_Row T.CPP_Col - | CRES_LetDestruct CRES_Destruct T.CPP_Row T.CPP_Col - | CRES_LetBody CRES_Expr T.CPP_Row T.CPP_Col - | CRES_LetIndentDef T.CPP_Row T.CPP_Col - | CRES_LetIndentIn T.CPP_Row T.CPP_Col - | CRES_LetIndentBody T.CPP_Row T.CPP_Col - - -type CRES_Def - = CRES_DefSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_DefType CRES_Type T.CPP_Row T.CPP_Col - | CRES_DefNameRepeat T.CPP_Row T.CPP_Col - | CRES_DefNameMatch T.CDN_Name T.CPP_Row T.CPP_Col - | CRES_DefArg CRES_Pattern T.CPP_Row T.CPP_Col - | CRES_DefEquals T.CPP_Row T.CPP_Col - | CRES_DefBody CRES_Expr T.CPP_Row T.CPP_Col - | CRES_DefIndentEquals T.CPP_Row T.CPP_Col - | CRES_DefIndentType T.CPP_Row T.CPP_Col - | CRES_DefIndentBody T.CPP_Row T.CPP_Col - | CRES_DefAlignment Int T.CPP_Row T.CPP_Col - - -type CRES_Destruct - = CRES_DestructSpace CRES_Space T.CPP_Row T.CPP_Col - | CRES_DestructPattern CRES_Pattern T.CPP_Row T.CPP_Col - | CRES_DestructEquals T.CPP_Row T.CPP_Col - | CRES_DestructBody CRES_Expr T.CPP_Row T.CPP_Col - | CRES_DestructIndentEquals T.CPP_Row T.CPP_Col - | CRES_DestructIndentBody T.CPP_Row T.CPP_Col - - - --- PATTERNS - - -type CRES_Pattern - = CRES_PRecord CRES_PRecord T.CPP_Row T.CPP_Col - | CRES_PTuple CRES_PTuple T.CPP_Row T.CPP_Col - | CRES_PList CRES_PList T.CPP_Row T.CPP_Col - -- - | CRES_PStart T.CPP_Row T.CPP_Col - | CRES_PChar CRES_Char T.CPP_Row T.CPP_Col - | CRES_PString CRES_String_ T.CPP_Row T.CPP_Col - | CRES_PNumber CRES_Number T.CPP_Row T.CPP_Col - | CRES_PFloat Int T.CPP_Row T.CPP_Col - | CRES_PAlias T.CPP_Row T.CPP_Col - | CRES_PWildcardNotVar T.CDN_Name Int T.CPP_Row T.CPP_Col - | CRES_PSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_PIndentStart T.CPP_Row T.CPP_Col - | CRES_PIndentAlias T.CPP_Row T.CPP_Col - - -type CRES_PRecord - = CRES_PRecordOpen T.CPP_Row T.CPP_Col - | CRES_PRecordEnd T.CPP_Row T.CPP_Col - | CRES_PRecordField T.CPP_Row T.CPP_Col - | CRES_PRecordSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_PRecordIndentOpen T.CPP_Row T.CPP_Col - | CRES_PRecordIndentEnd T.CPP_Row T.CPP_Col - | CRES_PRecordIndentField T.CPP_Row T.CPP_Col - - -type CRES_PTuple - = CRES_PTupleOpen T.CPP_Row T.CPP_Col - | CRES_PTupleEnd T.CPP_Row T.CPP_Col - | CRES_PTupleExpr CRES_Pattern T.CPP_Row T.CPP_Col - | CRES_PTupleSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_PTupleIndentEnd T.CPP_Row T.CPP_Col - | CRES_PTupleIndentExpr1 T.CPP_Row T.CPP_Col - | CRES_PTupleIndentExprN T.CPP_Row T.CPP_Col - - -type CRES_PList - = CRES_PListOpen T.CPP_Row T.CPP_Col - | CRES_PListEnd T.CPP_Row T.CPP_Col - | CRES_PListExpr CRES_Pattern T.CPP_Row T.CPP_Col - | CRES_PListSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_PListIndentOpen T.CPP_Row T.CPP_Col - | CRES_PListIndentEnd T.CPP_Row T.CPP_Col - | CRES_PListIndentExpr T.CPP_Row T.CPP_Col - - - --- TYPES - - -type CRES_Type - = CRES_TRecord CRES_TRecord T.CPP_Row T.CPP_Col - | CRES_TTuple CRES_TTuple T.CPP_Row T.CPP_Col - -- - | CRES_TStart T.CPP_Row T.CPP_Col - | CRES_TSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_TIndentStart T.CPP_Row T.CPP_Col - - -type CRES_TRecord - = CRES_TRecordOpen T.CPP_Row T.CPP_Col - | CRES_TRecordEnd T.CPP_Row T.CPP_Col - -- - | CRES_TRecordField T.CPP_Row T.CPP_Col - | CRES_TRecordColon T.CPP_Row T.CPP_Col - | CRES_TRecordType CRES_Type T.CPP_Row T.CPP_Col - -- - | CRES_TRecordSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_TRecordIndentOpen T.CPP_Row T.CPP_Col - | CRES_TRecordIndentField T.CPP_Row T.CPP_Col - | CRES_TRecordIndentColon T.CPP_Row T.CPP_Col - | CRES_TRecordIndentType T.CPP_Row T.CPP_Col - | CRES_TRecordIndentEnd T.CPP_Row T.CPP_Col - - -type CRES_TTuple - = CRES_TTupleOpen T.CPP_Row T.CPP_Col - | CRES_TTupleEnd T.CPP_Row T.CPP_Col - | CRES_TTupleType CRES_Type T.CPP_Row T.CPP_Col - | CRES_TTupleSpace CRES_Space T.CPP_Row T.CPP_Col - -- - | CRES_TTupleIndentType1 T.CPP_Row T.CPP_Col - | CRES_TTupleIndentTypeN T.CPP_Row T.CPP_Col - | CRES_TTupleIndentEnd T.CPP_Row T.CPP_Col - - - --- LITERALS - - -type CRES_Char - = CRES_CharEndless - | CRES_CharEscape CRES_Escape - | CRES_CharNotString Int - - -type CRES_String_ - = CRES_StringEndless_Single - | CRES_StringEndless_Multi - | CRES_StringEscape CRES_Escape - - -type CRES_Escape - = CRES_EscapeUnknown - | CRES_BadUnicodeFormat Int - | CRES_BadUnicodeCode Int - | CRES_BadUnicodeLength Int Int Int - - -type CRES_Number - = CRES_NumberEnd - | CRES_NumberDot Int - | CRES_NumberHexDigit - | CRES_NumberNoLeadingZero - - - --- MISC - - -type CRES_Space - = CRES_HasTab - | CRES_EndlessMultiComment - - - -- TO REPORT -toReport : Code.Source -> CRES_Error -> Report.Report +toReport : Code.Source -> T.CRES_Error -> Report.Report toReport source err = case err of - CRES_ModuleNameUnspecified name -> + T.CRES_ModuleNameUnspecified name -> let region : T.CRA_Region region = @@ -499,7 +48,7 @@ toReport source err = "It is best to replace (..) with an explicit list of types and functions you want to expose. When you know a value is only used within this module, you can refactor without worrying about uses elsewhere. Limiting exposed values can also speed up compilation because I can skip a bunch of work if I see that the exposed API has not changed." ] - CRES_ModuleNameMismatch expectedName (T.CRA_At region actualName) -> + T.CRES_ModuleNameMismatch expectedName (T.CRA_At region actualName) -> Report.Report "MODULE NAME MISMATCH" region [ expectedName ] <| Code.toSnippet source region Nothing <| ( D.fromChars "It looks like this module name is out of sync:" @@ -518,7 +67,7 @@ toReport source err = ] ) - CRES_UnexpectedPort region -> + T.CRES_UnexpectedPort region -> Report.Report "UNEXPECTED PORTS" region [] <| Code.toSnippet source region Nothing <| ( D.reflow <| @@ -546,7 +95,7 @@ toReport source err = ] ) - CRES_NoPorts region -> + T.CRES_NoPorts region -> Report.Report "NO PORTS" region [] <| Code.toSnippet source region Nothing <| ( D.reflow <| @@ -565,7 +114,7 @@ toReport source err = ] ) - CRES_NoPortsInPackage (T.CRA_At region _) -> + T.CRES_NoPortsInPackage (T.CRA_At region _) -> Report.Report "PACKAGES CANNOT HAVE PORTS" region [] <| Code.toSnippet source region Nothing <| ( D.reflow <| @@ -577,7 +126,7 @@ toReport source err = ] ) - CRES_NoPortModulesInPackage region -> + T.CRES_NoPortModulesInPackage region -> Report.Report "PACKAGES CANNOT HAVE PORTS" region [] <| Code.toSnippet source region Nothing <| ( D.reflow <| @@ -600,7 +149,7 @@ toReport source err = ] ) - CRES_NoEffectsOutsideKernel region -> + T.CRES_NoEffectsOutsideKernel region -> Report.Report "INVALID EFFECT MODULE" region [] <| Code.toSnippet source region Nothing <| ( D.reflow <| @@ -613,7 +162,7 @@ toReport source err = ] ) - CRES_ParseError modul -> + T.CRES_ParseError modul -> toParseErrorReport source modul @@ -627,20 +176,20 @@ noteForPortsInPackage = ] -toParseErrorReport : Code.Source -> CRES_Module -> Report.Report +toParseErrorReport : Code.Source -> T.CRES_Module -> Report.Report toParseErrorReport source modul = case modul of - CRES_ModuleSpace space row col -> + T.CRES_ModuleSpace space row col -> toSpaceReport source space row col - CRES_ModuleBadEnd row col -> + T.CRES_ModuleBadEnd row col -> if col == 1 then toDeclStartReport source row col else toWeirdEndReport source row col - CRES_ModuleProblem row col -> + T.CRES_ModuleProblem row col -> let region : T.CRA_Region region = @@ -673,7 +222,7 @@ toParseErrorReport source modul = ] ) - CRES_ModuleName row col -> + T.CRES_ModuleName row col -> let region : T.CRA_Region region = @@ -718,10 +267,10 @@ toParseErrorReport source modul = ] ) - CRES_ModuleExposing exposing_ row col -> + T.CRES_ModuleExposing exposing_ row col -> toExposingReport source exposing_ row col - CRES_PortModuleProblem row col -> + T.CRES_PortModuleProblem row col -> let region : T.CRA_Region region = @@ -755,7 +304,7 @@ toParseErrorReport source modul = ] ) - CRES_PortModuleName row col -> + T.CRES_PortModuleName row col -> let region : T.CRA_Region region = @@ -790,10 +339,10 @@ toParseErrorReport source modul = ] ) - CRES_PortModuleExposing exposing_ row col -> + T.CRES_PortModuleExposing exposing_ row col -> toExposingReport source exposing_ row col - CRES_Effect row col -> + T.CRES_Effect row col -> let region : T.CRA_Region region = @@ -807,7 +356,7 @@ toParseErrorReport source modul = "This type of module is reserved for the @elm organization. It is used to define certain effects, avoiding building them into the compiler." ) - CRES_FreshLine row col -> + T.CRES_FreshLine row col -> let region : T.CRA_Region region = @@ -863,10 +412,10 @@ toParseErrorReport source modul = ] ) - CRES_ImportStart row col -> + T.CRES_ImportStart row col -> toImportReport source row col - CRES_ImportName row col -> + T.CRES_ImportName row col -> let region : T.CRA_Region region = @@ -908,10 +457,10 @@ toParseErrorReport source modul = ] ) - CRES_ImportAs row col -> + T.CRES_ImportAs row col -> toImportReport source row col - CRES_ImportAlias row col -> + T.CRES_ImportAlias row col -> let region : T.CRA_Region region = @@ -951,22 +500,22 @@ toParseErrorReport source modul = ] ) - CRES_ImportExposing row col -> + T.CRES_ImportExposing row col -> toImportReport source row col - CRES_ImportExposingList exposing_ row col -> + T.CRES_ImportExposingList exposing_ row col -> toExposingReport source exposing_ row col - CRES_ImportEnd row col -> + T.CRES_ImportEnd row col -> toImportReport source row col - CRES_ImportIndentName row col -> + T.CRES_ImportIndentName row col -> toImportReport source row col - CRES_ImportIndentAlias row col -> + T.CRES_ImportIndentAlias row col -> toImportReport source row col - CRES_ImportIndentExposingList row col -> + T.CRES_ImportIndentExposingList row col -> let region : T.CRA_Region region = @@ -999,7 +548,7 @@ toParseErrorReport source modul = ] ) - CRES_Infix row col -> + T.CRES_Infix row col -> let region : T.CRA_Region region = @@ -1013,7 +562,7 @@ toParseErrorReport source modul = "This feature is used by the @elm organization to define the languages built-in operators." ) - CRES_Declarations decl _ _ -> + T.CRES_Declarations decl _ _ -> toDeclarationsReport source decl @@ -1219,13 +768,13 @@ toImportReport source row col = -- EXPOSING -toExposingReport : Code.Source -> CRES_Exposing -> T.CPP_Row -> T.CPP_Col -> Report.Report +toExposingReport : Code.Source -> T.CRES_Exposing -> T.CPP_Row -> T.CPP_Col -> Report.Report toExposingReport source exposing_ startRow startCol = case exposing_ of - CRES_ExposingSpace space row col -> + T.CRES_ExposingSpace space row col -> toSpaceReport source space row col - CRES_ExposingStart row col -> + T.CRES_ExposingStart row col -> let surroundings : T.CRA_Region surroundings = @@ -1274,7 +823,7 @@ toExposingReport source exposing_ startRow startCol = ] ) - CRES_ExposingValue row col -> + T.CRES_ExposingValue row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -1355,7 +904,7 @@ toExposingReport source exposing_ startRow startCol = ] ) - CRES_ExposingOperator row col -> + T.CRES_ExposingOperator row col -> let surroundings : T.CRA_Region surroundings = @@ -1397,7 +946,7 @@ toExposingReport source exposing_ startRow startCol = ] ) - CRES_ExposingOperatorReserved op row col -> + T.CRES_ExposingOperatorReserved op row col -> let surroundings : T.CRA_Region surroundings = @@ -1411,10 +960,10 @@ toExposingReport source exposing_ startRow startCol = Code.toSnippet source surroundings (Just region) <| ( D.reflow "I cannot expose this as an operator:" , case op of - CPS_BadDot -> + T.CPS_BadDot -> D.reflow "Try getting rid of this entry? Maybe I can give you a better hint after that?" - CPS_BadPipe -> + T.CPS_BadPipe -> D.fillSep [ D.fromChars "Maybe" , D.fromChars "you" @@ -1423,10 +972,10 @@ toExposingReport source exposing_ startRow startCol = , D.fromChars "instead?" ] - CPS_BadArrow -> + T.CPS_BadArrow -> D.reflow "Try getting rid of this entry? Maybe I can give you a better hint after that?" - CPS_BadEquals -> + T.CPS_BadEquals -> D.fillSep [ D.fromChars "Maybe" , D.fromChars "you" @@ -1435,7 +984,7 @@ toExposingReport source exposing_ startRow startCol = , D.fromChars "instead?" ] - CPS_BadHasType -> + T.CPS_BadHasType -> D.fillSep [ D.fromChars "Maybe" , D.fromChars "you" @@ -1445,7 +994,7 @@ toExposingReport source exposing_ startRow startCol = ] ) - CRES_ExposingOperatorRightParen row col -> + T.CRES_ExposingOperatorRightParen row col -> let surroundings : T.CRA_Region surroundings = @@ -1480,7 +1029,7 @@ toExposingReport source exposing_ startRow startCol = ] ) - CRES_ExposingEnd row col -> + T.CRES_ExposingEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -1496,7 +1045,7 @@ toExposingReport source exposing_ startRow startCol = , D.reflow "Maybe there is a comma missing before this?" ) - CRES_ExposingTypePrivacy row col -> + T.CRES_ExposingTypePrivacy row col -> let surroundings : T.CRA_Region surroundings = @@ -1541,7 +1090,7 @@ toExposingReport source exposing_ startRow startCol = ] ) - CRES_ExposingIndentEnd row col -> + T.CRES_ExposingIndentEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -1574,7 +1123,7 @@ toExposingReport source exposing_ startRow startCol = ] ) - CRES_ExposingIndentValue row col -> + T.CRES_ExposingIndentValue row col -> let surroundings : T.CRA_Region surroundings = @@ -1595,10 +1144,10 @@ toExposingReport source exposing_ startRow startCol = -- SPACES -toSpaceReport : Code.Source -> CRES_Space -> T.CPP_Row -> T.CPP_Col -> Report.Report +toSpaceReport : Code.Source -> T.CRES_Space -> T.CPP_Row -> T.CPP_Col -> Report.Report toSpaceReport source space row col = case space of - CRES_HasTab -> + T.CRES_HasTab -> let region : T.CRA_Region region = @@ -1610,7 +1159,7 @@ toSpaceReport source space row col = , D.reflow "Replace the tab with spaces." ) - CRES_EndlessMultiComment -> + T.CRES_EndlessMultiComment -> let region : T.CRA_Region region = @@ -1655,25 +1204,25 @@ toKeywordRegion row col keyword = (T.CRA_Position row (col + String.length keyword)) -toDeclarationsReport : Code.Source -> CRES_Decl -> Report.Report +toDeclarationsReport : Code.Source -> T.CRES_Decl -> Report.Report toDeclarationsReport source decl = case decl of - CRES_DeclStart row col -> + T.CRES_DeclStart row col -> toDeclStartReport source row col - CRES_DeclSpace space row col -> + T.CRES_DeclSpace space row col -> toSpaceReport source space row col - CRES_Port port_ row col -> + T.CRES_Port port_ row col -> toPortReport source port_ row col - CRES_DeclType declType row col -> + T.CRES_DeclType declType row col -> toDeclTypeReport source declType row col - CRES_DeclDef name declDef row col -> + T.CRES_DeclDef name declDef row col -> toDeclDefReport source name declDef row col - CRES_DeclFreshLineAfterDocComment row col -> + T.CRES_DeclFreshLineAfterDocComment row col -> let region : T.CRA_Region region = @@ -1853,13 +1402,13 @@ toDeclStartWeirdDeclarationReport source region = -- PORT -toPortReport : Code.Source -> CRES_Port -> T.CPP_Row -> T.CPP_Col -> Report.Report +toPortReport : Code.Source -> T.CRES_Port -> T.CPP_Row -> T.CPP_Col -> Report.Report toPortReport source port_ startRow startCol = case port_ of - CRES_PortSpace space row col -> + T.CRES_PortSpace space row col -> toSpaceReport source space row col - CRES_PortName row col -> + T.CRES_PortName row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -1916,7 +1465,7 @@ toPortReport source port_ startRow startCol = ] ) - CRES_PortColon row col -> + T.CRES_PortColon row col -> let surroundings : T.CRA_Region surroundings = @@ -1935,10 +1484,10 @@ toPortReport source port_ startRow startCol = ] ) - CRES_PortType tipe row col -> + T.CRES_PortType tipe row col -> toTypeReport source TC_Port tipe row col - CRES_PortIndentName row col -> + T.CRES_PortIndentName row col -> let surroundings : T.CRA_Region surroundings = @@ -1977,7 +1526,7 @@ toPortReport source port_ startRow startCol = ] ) - CRES_PortIndentColon row col -> + T.CRES_PortIndentColon row col -> let surroundings : T.CRA_Region surroundings = @@ -1996,7 +1545,7 @@ toPortReport source port_ startRow startCol = ] ) - CRES_PortIndentType row col -> + T.CRES_PortIndentType row col -> let surroundings : T.CRA_Region surroundings = @@ -2058,13 +1607,13 @@ portNote = -- DECL TYPE -toDeclTypeReport : Code.Source -> CRES_DeclType -> T.CPP_Row -> T.CPP_Col -> Report.Report +toDeclTypeReport : Code.Source -> T.CRES_DeclType -> T.CPP_Row -> T.CPP_Col -> Report.Report toDeclTypeReport source declType startRow startCol = case declType of - CRES_DT_Space space row col -> + T.CRES_DT_Space space row col -> toSpaceReport source space row col - CRES_DT_Name row col -> + T.CRES_DT_Name row col -> let surroundings : T.CRA_Region surroundings = @@ -2107,13 +1656,13 @@ toDeclTypeReport source declType startRow startCol = ] ) - CRES_DT_Alias typeAlias row col -> + T.CRES_DT_Alias typeAlias row col -> toTypeAliasReport source typeAlias row col - CRES_DT_Union customType row col -> + T.CRES_DT_Union customType row col -> toCustomTypeReport source customType row col - CRES_DT_IndentName row col -> + T.CRES_DT_IndentName row col -> let surroundings : T.CRA_Region surroundings = @@ -2157,13 +1706,13 @@ toDeclTypeReport source declType startRow startCol = ) -toTypeAliasReport : Code.Source -> CRES_TypeAlias -> T.CPP_Row -> T.CPP_Col -> Report.Report +toTypeAliasReport : Code.Source -> T.CRES_TypeAlias -> T.CPP_Row -> T.CPP_Col -> Report.Report toTypeAliasReport source typeAlias startRow startCol = case typeAlias of - CRES_AliasSpace space row col -> + T.CRES_AliasSpace space row col -> toSpaceReport source space row col - CRES_AliasName row col -> + T.CRES_AliasName row col -> let surroundings : T.CRA_Region surroundings = @@ -2206,7 +1755,7 @@ toTypeAliasReport source typeAlias startRow startCol = ] ) - CRES_AliasEquals row col -> + T.CRES_AliasEquals row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -2250,10 +1799,10 @@ toTypeAliasReport source typeAlias startRow startCol = ] ) - CRES_AliasBody tipe row col -> + T.CRES_AliasBody tipe row col -> toTypeReport source TC_TypeAlias tipe row col - CRES_AliasIndentEquals row col -> + T.CRES_AliasIndentEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -2272,7 +1821,7 @@ toTypeAliasReport source typeAlias startRow startCol = ] ) - CRES_AliasIndentBody row col -> + T.CRES_AliasIndentBody row col -> let surroundings : T.CRA_Region surroundings = @@ -2335,13 +1884,13 @@ typeAliasNote = ] -toCustomTypeReport : Code.Source -> CRES_CustomType -> T.CPP_Row -> T.CPP_Col -> Report.Report +toCustomTypeReport : Code.Source -> T.CRES_CustomType -> T.CPP_Row -> T.CPP_Col -> Report.Report toCustomTypeReport source customType startRow startCol = case customType of - CRES_CT_Space space row col -> + T.CRES_CT_Space space row col -> toSpaceReport source space row col - CRES_CT_Name row col -> + T.CRES_CT_Name row col -> let surroundings : T.CRA_Region surroundings = @@ -2384,7 +1933,7 @@ toCustomTypeReport source customType startRow startCol = ] ) - CRES_CT_Equals row col -> + T.CRES_CT_Equals row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -2427,7 +1976,7 @@ toCustomTypeReport source customType startRow startCol = ] ) - CRES_CT_Bar row col -> + T.CRES_CT_Bar row col -> let surroundings : T.CRA_Region surroundings = @@ -2446,7 +1995,7 @@ toCustomTypeReport source customType startRow startCol = ] ) - CRES_CT_Variant row col -> + T.CRES_CT_Variant row col -> let surroundings : T.CRA_Region surroundings = @@ -2490,10 +2039,10 @@ toCustomTypeReport source customType startRow startCol = ] ) - CRES_CT_VariantArg tipe row col -> + T.CRES_CT_VariantArg tipe row col -> toTypeReport source TC_CustomType tipe row col - CRES_CT_IndentEquals row col -> + T.CRES_CT_IndentEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -2512,7 +2061,7 @@ toCustomTypeReport source customType startRow startCol = ] ) - CRES_CT_IndentBar row col -> + T.CRES_CT_IndentBar row col -> let surroundings : T.CRA_Region surroundings = @@ -2531,7 +2080,7 @@ toCustomTypeReport source customType startRow startCol = ] ) - CRES_CT_IndentAfterBar row col -> + T.CRES_CT_IndentAfterBar row col -> let surroundings : T.CRA_Region surroundings = @@ -2550,7 +2099,7 @@ toCustomTypeReport source customType startRow startCol = ] ) - CRES_CT_IndentAfterEquals row col -> + T.CRES_CT_IndentAfterEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -2589,13 +2138,13 @@ customTypeNote = -- DECL DEF -toDeclDefReport : Code.Source -> T.CDN_Name -> CRES_DeclDef -> T.CPP_Row -> T.CPP_Col -> Report.Report +toDeclDefReport : Code.Source -> T.CDN_Name -> T.CRES_DeclDef -> T.CPP_Row -> T.CPP_Col -> Report.Report toDeclDefReport source name declDef startRow startCol = case declDef of - CRES_DeclDefSpace space row col -> + T.CRES_DeclDefSpace space row col -> toSpaceReport source space row col - CRES_DeclDefEquals row col -> + T.CRES_DeclDefEquals row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -2789,16 +2338,16 @@ toDeclDefReport source name declDef startRow startCol = ] ) - CRES_DeclDefType tipe row col -> + T.CRES_DeclDefType tipe row col -> toTypeReport source (TC_Annotation name) tipe row col - CRES_DeclDefArg pattern row col -> + T.CRES_DeclDefArg pattern row col -> toPatternReport source PArg pattern row col - CRES_DeclDefBody expr row col -> + T.CRES_DeclDefBody expr row col -> toExprReport source (InDef name startRow startCol) expr row col - CRES_DeclDefNameRepeat row col -> + T.CRES_DeclDefNameRepeat row col -> let surroundings : T.CRA_Region surroundings = @@ -2820,7 +2369,7 @@ toDeclDefReport source name declDef startRow startCol = ] ) - CRES_DeclDefNameMatch defName row col -> + T.CRES_DeclDefNameMatch defName row col -> let surroundings : T.CRA_Region surroundings = @@ -2849,7 +2398,7 @@ toDeclDefReport source name declDef startRow startCol = ] ) - CRES_DeclDefIndentType row col -> + T.CRES_DeclDefIndentType row col -> let surroundings : T.CRA_Region surroundings = @@ -2871,7 +2420,7 @@ toDeclDefReport source name declDef startRow startCol = ] ) - CRES_DeclDefIndentEquals row col -> + T.CRES_DeclDefIndentEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -2893,7 +2442,7 @@ toDeclDefReport source name declDef startRow startCol = ] ) - CRES_DeclDefIndentBody row col -> + T.CRES_DeclDefIndentBody row col -> let surroundings : T.CRA_Region surroundings = @@ -2985,31 +2534,31 @@ isWithin desiredNode context = -- EXPR REPORTS -toExprReport : Code.Source -> Context -> CRES_Expr -> T.CPP_Row -> T.CPP_Col -> Report.Report +toExprReport : Code.Source -> Context -> T.CRES_Expr -> T.CPP_Row -> T.CPP_Col -> Report.Report toExprReport source context expr startRow startCol = case expr of - CRES_Let let_ row col -> + T.CRES_Let let_ row col -> toLetReport source context let_ row col - CRES_Case case_ row col -> + T.CRES_Case case_ row col -> toCaseReport source context case_ row col - CRES_If if_ row col -> + T.CRES_If if_ row col -> toIfReport source context if_ row col - CRES_List list row col -> + T.CRES_List list row col -> toListReport source context list row col - CRES_Record record row col -> + T.CRES_Record record row col -> toRecordReport source context record row col - CRES_Tuple tuple row col -> + T.CRES_Tuple tuple row col -> toTupleReport source context tuple row col - CRES_Func func row col -> + T.CRES_Func func row col -> toFuncReport source context func row col - CRES_Dot row col -> + T.CRES_Dot row col -> let region : T.CRA_Region region = @@ -3034,7 +2583,7 @@ toExprReport source context expr startRow startCol = ] ) - CRES_Access row col -> + T.CRES_Access row col -> let region : T.CRA_Region region = @@ -3062,7 +2611,7 @@ toExprReport source context expr startRow startCol = ] ) - CRES_OperatorRight op row col -> + T.CRES_OperatorRight op row col -> let surroundings : T.CRA_Region surroundings = @@ -3146,10 +2695,10 @@ toExprReport source context expr startRow startCol = D.reflow "I was expecting to see an expression next." ) - CRES_OperatorReserved operator row col -> + T.CRES_OperatorReserved operator row col -> toOperatorReport source context operator row col - CRES_Start row col -> + T.CRES_Start row col -> let ( contextRow, contextCol, aThing ) = case context of @@ -3229,19 +2778,19 @@ toExprReport source context expr startRow startCol = ] ) - CRES_Char char row col -> + T.CRES_Char char row col -> toCharReport source char row col - CRES_String_ string row col -> + T.CRES_String_ string row col -> toStringReport source string row col - CRES_Number number row col -> + T.CRES_Number number row col -> toNumberReport source number row col - CRES_Space space row col -> + T.CRES_Space space row col -> toSpaceReport source space row col - CRES_EndlessShader row col -> + T.CRES_EndlessShader row col -> let region : T.CRA_Region region = @@ -3253,7 +2802,7 @@ toExprReport source context expr startRow startCol = , D.reflow "Add a |] somewhere after this to end the shader." ) - CRES_ShaderProblem problem row col -> + T.CRES_ShaderProblem problem row col -> let region : T.CRA_Region region = @@ -3268,7 +2817,7 @@ toExprReport source context expr startRow startCol = ] ) - CRES_IndentOperatorRight op row col -> + T.CRES_IndentOperatorRight op row col -> let surroundings : T.CRA_Region surroundings = @@ -3318,10 +2867,10 @@ toExprReport source context expr startRow startCol = -- CHAR -toCharReport : Code.Source -> CRES_Char -> T.CPP_Row -> T.CPP_Col -> Report.Report +toCharReport : Code.Source -> T.CRES_Char -> T.CPP_Row -> T.CPP_Col -> Report.Report toCharReport source char row col = case char of - CRES_CharEndless -> + T.CRES_CharEndless -> let region : T.CRA_Region region = @@ -3334,10 +2883,10 @@ toCharReport source char row col = , D.reflow "Add a closing single quote here!" ) - CRES_CharEscape escape -> + T.CRES_CharEscape escape -> toEscapeReport source escape row col - CRES_CharNotString width -> + T.CRES_CharNotString width -> let region : T.CRA_Region region = @@ -3363,10 +2912,10 @@ toCharReport source char row col = -- STRING -toStringReport : Code.Source -> CRES_String_ -> T.CPP_Row -> T.CPP_Col -> Report.Report +toStringReport : Code.Source -> T.CRES_String_ -> T.CPP_Row -> T.CPP_Col -> Report.Report toStringReport source string row col = case string of - CRES_StringEndless_Single -> + T.CRES_StringEndless_Single -> let region : T.CRA_Region region = @@ -3415,7 +2964,7 @@ toStringReport source string row col = ] ) - CRES_StringEndless_Multi -> + T.CRES_StringEndless_Multi -> let region : T.CRA_Region region = @@ -3443,7 +2992,7 @@ toStringReport source string row col = ] ) - CRES_StringEscape escape -> + T.CRES_StringEscape escape -> toEscapeReport source escape row col @@ -3451,10 +3000,10 @@ toStringReport source string row col = -- ESCAPES -toEscapeReport : Code.Source -> CRES_Escape -> T.CPP_Row -> T.CPP_Col -> Report.Report +toEscapeReport : Code.Source -> T.CRES_Escape -> T.CPP_Row -> T.CPP_Col -> Report.Report toEscapeReport source escape row col = case escape of - CRES_EscapeUnknown -> + T.CRES_EscapeUnknown -> let region : T.CRA_Region region = @@ -3481,7 +3030,7 @@ toEscapeReport source escape row col = ] ) - CRES_BadUnicodeFormat width -> + T.CRES_BadUnicodeFormat width -> let region : T.CRA_Region region = @@ -3504,7 +3053,7 @@ toEscapeReport source escape row col = ] ) - CRES_BadUnicodeCode width -> + T.CRES_BadUnicodeCode width -> let region : T.CRA_Region region = @@ -3516,7 +3065,7 @@ toEscapeReport source escape row col = , D.reflow "The valid code points are between 0 and 10FFFF inclusive." ) - CRES_BadUnicodeLength width numDigits badCode -> + T.CRES_BadUnicodeLength width numDigits badCode -> let region : T.CRA_Region region = @@ -3576,7 +3125,7 @@ toEscapeReport source escape row col = -- NUMBERS -toNumberReport : Code.Source -> CRES_Number -> T.CPP_Row -> T.CPP_Col -> Report.Report +toNumberReport : Code.Source -> T.CRES_Number -> T.CPP_Row -> T.CPP_Col -> Report.Report toNumberReport source number row col = let region : T.CRA_Region @@ -3584,7 +3133,7 @@ toNumberReport source number row col = toRegion row col in case number of - CRES_NumberEnd -> + T.CRES_NumberEnd -> Report.Report "WEIRD NUMBER" region [] <| Code.toSnippet source region Nothing <| ( D.reflow "I thought I was reading a number, but I ran into some weird stuff here:" @@ -3601,7 +3150,7 @@ toNumberReport source number row col = ] ) - CRES_NumberDot int -> + T.CRES_NumberDot int -> Report.Report "WEIRD NUMBER" region [] <| Code.toSnippet source region Nothing <| ( D.reflow "Numbers cannot end with a dot like this:" @@ -3617,7 +3166,7 @@ toNumberReport source number row col = ] ) - CRES_NumberHexDigit -> + T.CRES_NumberHexDigit -> Report.Report "WEIRD HEXIDECIMAL" region [] <| Code.toSnippet source region Nothing <| ( D.reflow "I thought I was reading a hexidecimal number until I got here:" @@ -3632,7 +3181,7 @@ toNumberReport source number row col = ] ) - CRES_NumberNoLeadingZero -> + T.CRES_NumberNoLeadingZero -> Report.Report "LEADING ZEROS" region [] <| Code.toSnippet source region Nothing <| ( D.reflow "I do not accept numbers with leading zeros:" @@ -3647,10 +3196,10 @@ toNumberReport source number row col = -- OPERATORS -toOperatorReport : Code.Source -> Context -> CPS_BadOperator -> T.CPP_Row -> T.CPP_Col -> Report.Report +toOperatorReport : Code.Source -> Context -> T.CPS_BadOperator -> T.CPP_Row -> T.CPP_Col -> Report.Report toOperatorReport source context operator row col = case operator of - CPS_BadDot -> + T.CPS_BadDot -> let region : T.CRA_Region region = @@ -3662,7 +3211,7 @@ toOperatorReport source context operator row col = , D.reflow "Dots are for record access and decimal points, so they cannot float around on their own. Maybe there is some extra whitespace?" ) - CPS_BadPipe -> + T.CPS_BadPipe -> let region : T.CRA_Region region = @@ -3674,7 +3223,7 @@ toOperatorReport source context operator row col = , D.reflow "Vertical bars should only appear in custom type declarations. Maybe you want || instead?" ) - CPS_BadArrow -> + T.CPS_BadArrow -> let region : T.CRA_Region region = @@ -3710,7 +3259,7 @@ toOperatorReport source context operator row col = ] ) - CPS_BadEquals -> + T.CPS_BadEquals -> let region : T.CRA_Region region = @@ -3738,7 +3287,7 @@ toOperatorReport source context operator row col = ] ) - CPS_BadHasType -> + T.CPS_BadHasType -> let region : T.CRA_Region region = @@ -3801,13 +3350,13 @@ toOperatorReport source context operator row col = -- CASE -toLetReport : Code.Source -> Context -> CRES_Let -> T.CPP_Row -> T.CPP_Col -> Report.Report +toLetReport : Code.Source -> Context -> T.CRES_Let -> T.CPP_Row -> T.CPP_Col -> Report.Report toLetReport source context let_ startRow startCol = case let_ of - CRES_LetSpace space row col -> + T.CRES_LetSpace space row col -> toSpaceReport source space row col - CRES_LetIn row col -> + T.CRES_LetIn row col -> let surroundings : T.CRA_Region surroundings = @@ -3846,7 +3395,7 @@ toLetReport source context let_ startRow startCol = ] ) - CRES_LetDefAlignment _ row col -> + T.CRES_LetDefAlignment _ row col -> let surroundings : T.CRA_Region surroundings = @@ -3885,7 +3434,7 @@ toLetReport source context let_ startRow startCol = ] ) - CRES_LetDefName row col -> + T.CRES_LetDefName row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -3912,21 +3461,21 @@ toLetReport source context let_ startRow startCol = D.reflow "I was expecting the name of a definition next." - CRES_LetDef name def row col -> + T.CRES_LetDef name def row col -> toLetDefReport source name def row col - CRES_LetDestruct destruct row col -> + T.CRES_LetDestruct destruct row col -> toLetDestructReport source destruct row col - CRES_LetBody expr row col -> + T.CRES_LetBody expr row col -> toExprReport source context expr row col - CRES_LetIndentDef row col -> + T.CRES_LetIndentDef row col -> toUnfinishLetReport source row col startRow startCol <| D.reflow "I was expecting a value to be defined here." - CRES_LetIndentIn row col -> + T.CRES_LetIndentIn row col -> toUnfinishLetReport source row col startRow startCol <| D.fillSep [ D.fromChars "I" @@ -3946,7 +3495,7 @@ toLetReport source context let_ startRow startCol = , D.fromChars "expression?" ] - CRES_LetIndentBody row col -> + T.CRES_LetIndentBody row col -> toUnfinishLetReport source row col startRow startCol <| D.reflow "I was expecting an expression next. Tell me what should happen with the value you just defined!" @@ -4003,16 +3552,16 @@ toUnfinishLetReport source row col startRow startCol message = ) -toLetDefReport : Code.Source -> T.CDN_Name -> CRES_Def -> T.CPP_Row -> T.CPP_Col -> Report.Report +toLetDefReport : Code.Source -> T.CDN_Name -> T.CRES_Def -> T.CPP_Row -> T.CPP_Col -> Report.Report toLetDefReport source name def startRow startCol = case def of - CRES_DefSpace space row col -> + T.CRES_DefSpace space row col -> toSpaceReport source space row col - CRES_DefType tipe row col -> + T.CRES_DefType tipe row col -> toTypeReport source (TC_Annotation name) tipe row col - CRES_DefNameRepeat row col -> + T.CRES_DefNameRepeat row col -> let surroundings : T.CRA_Region surroundings = @@ -4031,7 +3580,7 @@ toLetDefReport source name def startRow startCol = ] ) - CRES_DefNameMatch defName row col -> + T.CRES_DefNameMatch defName row col -> let surroundings : T.CRA_Region surroundings = @@ -4055,10 +3604,10 @@ toLetDefReport source name def startRow startCol = ] ) - CRES_DefArg pattern row col -> + T.CRES_DefArg pattern row col -> toPatternReport source PArg pattern row col - CRES_DefEquals row col -> + T.CRES_DefEquals row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -4243,10 +3792,10 @@ toLetDefReport source name def startRow startCol = ] ) - CRES_DefBody expr row col -> + T.CRES_DefBody expr row col -> toExprReport source (InDef name startRow startCol) expr row col - CRES_DefIndentEquals row col -> + T.CRES_DefIndentEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -4265,7 +3814,7 @@ toLetDefReport source name def startRow startCol = ] ) - CRES_DefIndentType row col -> + T.CRES_DefIndentType row col -> let surroundings : T.CRA_Region surroundings = @@ -4284,7 +3833,7 @@ toLetDefReport source name def startRow startCol = ] ) - CRES_DefIndentBody row col -> + T.CRES_DefIndentBody row col -> let surroundings : T.CRA_Region surroundings = @@ -4303,7 +3852,7 @@ toLetDefReport source name def startRow startCol = ] ) - CRES_DefAlignment indent row col -> + T.CRES_DefAlignment indent row col -> let surroundings : T.CRA_Region surroundings = @@ -4354,16 +3903,16 @@ defNote = ] -toLetDestructReport : Code.Source -> CRES_Destruct -> T.CPP_Row -> T.CPP_Col -> Report.Report +toLetDestructReport : Code.Source -> T.CRES_Destruct -> T.CPP_Row -> T.CPP_Col -> Report.Report toLetDestructReport source destruct startRow startCol = case destruct of - CRES_DestructSpace space row col -> + T.CRES_DestructSpace space row col -> toSpaceReport source space row col - CRES_DestructPattern pattern row col -> + T.CRES_DestructPattern pattern row col -> toPatternReport source PLet pattern row col - CRES_DestructEquals row col -> + T.CRES_DestructEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -4387,10 +3936,10 @@ toLetDestructReport source destruct startRow startCol = D.reflow "I was expecting to see an equals sign next, followed by an expression telling me what to compute." ) - CRES_DestructBody expr row col -> + T.CRES_DestructBody expr row col -> toExprReport source (InDestruct startRow startCol) expr row col - CRES_DestructIndentEquals row col -> + T.CRES_DestructIndentEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -4406,7 +3955,7 @@ toLetDestructReport source destruct startRow startCol = , D.reflow "I was expecting to see an equals sign next, followed by an expression telling me what to compute." ) - CRES_DestructIndentBody row col -> + T.CRES_DestructIndentBody row col -> let surroundings : T.CRA_Region surroundings = @@ -4427,13 +3976,13 @@ toLetDestructReport source destruct startRow startCol = -- CASE -toCaseReport : Code.Source -> Context -> CRES_Case -> T.CPP_Row -> T.CPP_Col -> Report.Report +toCaseReport : Code.Source -> Context -> T.CRES_Case -> T.CPP_Row -> T.CPP_Col -> Report.Report toCaseReport source context case_ startRow startCol = case case_ of - CRES_CaseSpace space row col -> + T.CRES_CaseSpace space row col -> toSpaceReport source space row col - CRES_CaseOf row col -> + T.CRES_CaseOf row col -> toUnfinishCaseReport source row col @@ -4452,10 +4001,10 @@ toCaseReport source context case_ startRow startCol = ] ) - CRES_CasePattern pattern row col -> + T.CRES_CasePattern pattern row col -> toPatternReport source PCase pattern row col - CRES_CaseArrow row col -> + T.CRES_CaseArrow row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -4555,13 +4104,13 @@ toCaseReport source context case_ startRow startCol = ) ) - CRES_CaseExpr expr row col -> + T.CRES_CaseExpr expr row col -> toExprReport source (InNode NCase startRow startCol context) expr row col - CRES_CaseBranch expr row col -> + T.CRES_CaseBranch expr row col -> toExprReport source (InNode NBranch startRow startCol context) expr row col - CRES_CaseIndentOf row col -> + T.CRES_CaseIndentOf row col -> toUnfinishCaseReport source row col @@ -4580,7 +4129,7 @@ toCaseReport source context case_ startRow startCol = ] ) - CRES_CaseIndentExpr row col -> + T.CRES_CaseIndentExpr row col -> toUnfinishCaseReport source row col @@ -4588,7 +4137,7 @@ toCaseReport source context case_ startRow startCol = startCol (D.reflow "I was expecting to see an expression next.") - CRES_CaseIndentPattern row col -> + T.CRES_CaseIndentPattern row col -> toUnfinishCaseReport source row col @@ -4596,7 +4145,7 @@ toCaseReport source context case_ startRow startCol = startCol (D.reflow "I was expecting to see a pattern next.") - CRES_CaseIndentArrow row col -> + T.CRES_CaseIndentArrow row col -> toUnfinishCaseReport source row col @@ -4620,7 +4169,7 @@ toCaseReport source context case_ startRow startCol = ] ) - CRES_CaseIndentBranch row col -> + T.CRES_CaseIndentBranch row col -> toUnfinishCaseReport source row col @@ -4628,7 +4177,7 @@ toCaseReport source context case_ startRow startCol = startCol (D.reflow "I was expecting to see an expression next. What should I do when I run into this particular pattern?") - CRES_CasePatternAlignment indent row col -> + T.CRES_CasePatternAlignment indent row col -> toUnfinishCaseReport source row col @@ -4694,13 +4243,13 @@ noteForCaseIndentError = -- IF -toIfReport : Code.Source -> Context -> CRES_If -> T.CPP_Row -> T.CPP_Col -> Report.Report +toIfReport : Code.Source -> Context -> T.CRES_If -> T.CPP_Row -> T.CPP_Col -> Report.Report toIfReport source context if_ startRow startCol = case if_ of - CRES_IfSpace space row col -> + T.CRES_IfSpace space row col -> toSpaceReport source space row col - CRES_IfThen row col -> + T.CRES_IfThen row col -> let surroundings : T.CRA_Region surroundings = @@ -4726,7 +4275,7 @@ toIfReport source context if_ startRow startCol = ] ) - CRES_IfElse row col -> + T.CRES_IfElse row col -> let surroundings : T.CRA_Region surroundings = @@ -4752,7 +4301,7 @@ toIfReport source context if_ startRow startCol = ] ) - CRES_IfElseBranchStart row col -> + T.CRES_IfElseBranchStart row col -> let surroundings : T.CRA_Region surroundings = @@ -4768,16 +4317,16 @@ toIfReport source context if_ startRow startCol = , D.reflow "I was expecting to see an expression next. Maybe it is not filled in yet?" ) - CRES_IfCondition expr row col -> + T.CRES_IfCondition expr row col -> toExprReport source (InNode NCond startRow startCol context) expr row col - CRES_IfThenBranch expr row col -> + T.CRES_IfThenBranch expr row col -> toExprReport source (InNode NThen startRow startCol context) expr row col - CRES_IfElseBranch expr row col -> + T.CRES_IfElseBranch expr row col -> toExprReport source (InNode NElse startRow startCol context) expr row col - CRES_IfIndentCondition row col -> + T.CRES_IfIndentCondition row col -> let surroundings : T.CRA_Region surroundings = @@ -4812,7 +4361,7 @@ toIfReport source context if_ startRow startCol = ] ) - CRES_IfIndentThen row col -> + T.CRES_IfIndentThen row col -> let surroundings : T.CRA_Region surroundings = @@ -4841,7 +4390,7 @@ toIfReport source context if_ startRow startCol = ] ) - CRES_IfIndentThenBranch row col -> + T.CRES_IfIndentThenBranch row col -> let surroundings : T.CRA_Region surroundings = @@ -4860,7 +4409,7 @@ toIfReport source context if_ startRow startCol = ] ) - CRES_IfIndentElseBranch row col -> + T.CRES_IfIndentElseBranch row col -> let surroundings : T.CRA_Region surroundings = @@ -4879,7 +4428,7 @@ toIfReport source context if_ startRow startCol = ] ) - CRES_IfIndentElse row col -> + T.CRES_IfIndentElse row col -> case Code.nextLineStartsWithKeyword "else" source row of Just ( elseRow, elseCol ) -> let @@ -4963,10 +4512,10 @@ toIfReport source context if_ startRow startCol = -- RECORD -toRecordReport : Code.Source -> Context -> CRES_Record -> T.CPP_Row -> T.CPP_Col -> Report.Report +toRecordReport : Code.Source -> Context -> T.CRES_Record -> T.CPP_Row -> T.CPP_Col -> Report.Report toRecordReport source context record startRow startCol = case record of - CRES_RecordOpen row col -> + T.CRES_RecordOpen row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -5028,7 +4577,7 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordEnd row col -> + T.CRES_RecordEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -5069,7 +4618,7 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordField row col -> + T.CRES_RecordField row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -5169,7 +4718,7 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordEquals row col -> + T.CRES_RecordEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -5212,13 +4761,13 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordExpr expr row col -> + T.CRES_RecordExpr expr row col -> toExprReport source (InNode NRecord startRow startCol context) expr row col - CRES_RecordSpace space row col -> + T.CRES_RecordSpace space row col -> toSpaceReport source space row col - CRES_RecordIndentOpen row col -> + T.CRES_RecordIndentOpen row col -> let surroundings : T.CRA_Region surroundings = @@ -5253,7 +4802,7 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordIndentEnd row col -> + T.CRES_RecordIndentEnd row col -> case Code.nextLineStartsWithCloseCurly source row of Just ( curlyRow, curlyCol ) -> let @@ -5314,7 +4863,7 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordIndentField row col -> + T.CRES_RecordIndentField row col -> let surroundings : T.CRA_Region surroundings = @@ -5333,7 +4882,7 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordIndentEquals row col -> + T.CRES_RecordIndentEquals row col -> let surroundings : T.CRA_Region surroundings = @@ -5361,7 +4910,7 @@ toRecordReport source context record startRow startCol = ] ) - CRES_RecordIndentExpr row col -> + T.CRES_RecordIndentExpr row col -> let surroundings : T.CRA_Region surroundings = @@ -5425,16 +4974,16 @@ noteForRecordIndentError = -- TUPLE -toTupleReport : Code.Source -> Context -> CRES_Tuple -> T.CPP_Row -> T.CPP_Col -> Report.Report +toTupleReport : Code.Source -> Context -> T.CRES_Tuple -> T.CPP_Row -> T.CPP_Col -> Report.Report toTupleReport source context tuple startRow startCol = case tuple of - CRES_TupleExpr expr row col -> + T.CRES_TupleExpr expr row col -> toExprReport source (InNode NParens startRow startCol context) expr row col - CRES_TupleSpace space row col -> + T.CRES_TupleSpace space row col -> toSpaceReport source space row col - CRES_TupleEnd row col -> + T.CRES_TupleEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -5463,7 +5012,7 @@ toTupleReport source context tuple startRow startCol = ] ) - CRES_TupleOperatorClose row col -> + T.CRES_TupleOperatorClose row col -> let surroundings : T.CRA_Region surroundings = @@ -5492,7 +5041,7 @@ toTupleReport source context tuple startRow startCol = ] ) - CRES_TupleOperatorReserved operator row col -> + T.CRES_TupleOperatorReserved operator row col -> let surroundings : T.CRA_Region surroundings = @@ -5507,7 +5056,7 @@ toTupleReport source context tuple startRow startCol = ( D.reflow "I ran into an unexpected symbol here:" , D.fillSep (case operator of - CPS_BadDot -> + T.CPS_BadDot -> [ D.fromChars "Maybe" , D.fromChars "you" , D.fromChars "wanted" @@ -5521,7 +5070,7 @@ toTupleReport source context tuple startRow startCol = , D.fromChars "instead?" ] - CPS_BadPipe -> + T.CPS_BadPipe -> [ D.fromChars "Try" , D.dullyellow <| D.fromChars "(||)" , D.fromChars "instead?" @@ -5534,7 +5083,7 @@ toTupleReport source context tuple startRow startCol = , D.fromChars "function?" ] - CPS_BadArrow -> + T.CPS_BadArrow -> [ D.fromChars "Maybe" , D.fromChars "you" , D.fromChars "wanted" @@ -5544,7 +5093,7 @@ toTupleReport source context tuple startRow startCol = , D.fromChars "instead?" ] - CPS_BadEquals -> + T.CPS_BadEquals -> [ D.fromChars "Try" , D.dullyellow <| D.fromChars "(==)" , D.fromChars "instead?" @@ -5557,7 +5106,7 @@ toTupleReport source context tuple startRow startCol = , D.fromChars "equality?" ] - CPS_BadHasType -> + T.CPS_BadHasType -> [ D.fromChars "Try" , D.dullyellow <| D.fromChars "(::)" , D.fromChars "instead?" @@ -5573,7 +5122,7 @@ toTupleReport source context tuple startRow startCol = ) ) - CRES_TupleIndentExpr1 row col -> + T.CRES_TupleIndentExpr1 row col -> let surroundings : T.CRA_Region surroundings = @@ -5608,7 +5157,7 @@ toTupleReport source context tuple startRow startCol = ] ) - CRES_TupleIndentExprN row col -> + T.CRES_TupleIndentExprN row col -> let surroundings : T.CRA_Region surroundings = @@ -5645,7 +5194,7 @@ toTupleReport source context tuple startRow startCol = ] ) - CRES_TupleIndentEnd row col -> + T.CRES_TupleIndentEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -5675,13 +5224,13 @@ toTupleReport source context tuple startRow startCol = ) -toListReport : Code.Source -> Context -> CRES_List_ -> T.CPP_Row -> T.CPP_Col -> Report.Report +toListReport : Code.Source -> Context -> T.CRES_List_ -> T.CPP_Row -> T.CPP_Col -> Report.Report toListReport source context list startRow startCol = case list of - CRES_ListSpace space row col -> + T.CRES_ListSpace space row col -> toSpaceReport source space row col - CRES_ListOpen row col -> + T.CRES_ListOpen row col -> let surroundings : T.CRA_Region surroundings = @@ -5723,9 +5272,9 @@ toListReport source context list startRow startCol = ] ) - CRES_ListExpr expr row col -> + T.CRES_ListExpr expr row col -> case expr of - CRES_Start r c -> + T.CRES_Start r c -> let surroundings : T.CRA_Region surroundings = @@ -5755,7 +5304,7 @@ toListReport source context list startRow startCol = _ -> toExprReport source (InNode NList startRow startCol context) expr row col - CRES_ListEnd row col -> + T.CRES_ListEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -5797,7 +5346,7 @@ toListReport source context list startRow startCol = ] ) - CRES_ListIndentOpen row col -> + T.CRES_ListIndentOpen row col -> let surroundings : T.CRA_Region surroundings = @@ -5860,7 +5409,7 @@ toListReport source context list startRow startCol = ] ) - CRES_ListIndentEnd row col -> + T.CRES_ListIndentEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -5904,7 +5453,7 @@ toListReport source context list startRow startCol = ] ) - CRES_ListIndentExpr row col -> + T.CRES_ListIndentExpr row col -> let surroundings : T.CRA_Region surroundings = @@ -5932,19 +5481,19 @@ toListReport source context list startRow startCol = ) -toFuncReport : Code.Source -> Context -> CRES_Func -> T.CPP_Row -> T.CPP_Col -> Report.Report +toFuncReport : Code.Source -> Context -> T.CRES_Func -> T.CPP_Row -> T.CPP_Col -> Report.Report toFuncReport source context func startRow startCol = case func of - CRES_FuncSpace space row col -> + T.CRES_FuncSpace space row col -> toSpaceReport source space row col - CRES_FuncArg pattern row col -> + T.CRES_FuncArg pattern row col -> toPatternReport source PArg pattern row col - CRES_FuncBody expr row col -> + T.CRES_FuncBody expr row col -> toExprReport source (InNode NFunc startRow startCol context) expr row col - CRES_FuncArrow row col -> + T.CRES_FuncArrow row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -5998,7 +5547,7 @@ toFuncReport source context func startRow startCol = ] ) - CRES_FuncIndentArg row col -> + T.CRES_FuncIndentArg row col -> let surroundings : T.CRA_Region surroundings = @@ -6031,7 +5580,7 @@ toFuncReport source context func startRow startCol = ] ) - CRES_FuncIndentArrow row col -> + T.CRES_FuncIndentArrow row col -> let surroundings : T.CRA_Region surroundings = @@ -6070,7 +5619,7 @@ toFuncReport source context func startRow startCol = ] ) - CRES_FuncIndentBody row col -> + T.CRES_FuncIndentBody row col -> let surroundings : T.CRA_Region surroundings = @@ -6118,19 +5667,19 @@ type PContext | PLet -toPatternReport : Code.Source -> PContext -> CRES_Pattern -> T.CPP_Row -> T.CPP_Col -> Report.Report +toPatternReport : Code.Source -> PContext -> T.CRES_Pattern -> T.CPP_Row -> T.CPP_Col -> Report.Report toPatternReport source context pattern startRow startCol = case pattern of - CRES_PRecord record row col -> + T.CRES_PRecord record row col -> toPRecordReport source record row col - CRES_PTuple tuple row col -> + T.CRES_PTuple tuple row col -> toPTupleReport source context tuple row col - CRES_PList list row col -> + T.CRES_PList list row col -> toPListReport source context list row col - CRES_PStart row col -> + T.CRES_PStart row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -6226,16 +5775,16 @@ toPatternReport source context pattern startRow startCol = ] ) - CRES_PChar char row col -> + T.CRES_PChar char row col -> toCharReport source char row col - CRES_PString string row col -> + T.CRES_PString string row col -> toStringReport source string row col - CRES_PNumber number row col -> + T.CRES_PNumber number row col -> toNumberReport source number row col - CRES_PFloat width row col -> + T.CRES_PFloat width row col -> let region : T.CRA_Region region = @@ -6271,7 +5820,7 @@ toPatternReport source context pattern startRow startCol = ] ) - CRES_PAlias row col -> + T.CRES_PAlias row col -> let region : T.CRA_Region region = @@ -6329,7 +5878,7 @@ toPatternReport source context pattern startRow startCol = ] ) - CRES_PWildcardNotVar name width row col -> + T.CRES_PWildcardNotVar name width row col -> let region : T.CRA_Region region = @@ -6379,10 +5928,10 @@ toPatternReport source context pattern startRow startCol = ) ) - CRES_PSpace space row col -> + T.CRES_PSpace space row col -> toSpaceReport source space row col - CRES_PIndentStart row col -> + T.CRES_PIndentStart row col -> let surroundings : T.CRA_Region surroundings = @@ -6432,7 +5981,7 @@ toPatternReport source context pattern startRow startCol = ] ) - CRES_PIndentAlias row col -> + T.CRES_PIndentAlias row col -> let region : T.CRA_Region region = @@ -6490,14 +6039,14 @@ toPatternReport source context pattern startRow startCol = ) -toPRecordReport : Code.Source -> CRES_PRecord -> T.CPP_Row -> T.CPP_Col -> Report.Report +toPRecordReport : Code.Source -> T.CRES_PRecord -> T.CPP_Row -> T.CPP_Col -> Report.Report toPRecordReport source record startRow startCol = case record of - CRES_PRecordOpen row col -> + T.CRES_PRecordOpen row col -> toUnfinishRecordPatternReport source row col startRow startCol <| D.reflow "I was expecting to see a field name next." - CRES_PRecordEnd row col -> + T.CRES_PRecordEnd row col -> toUnfinishRecordPatternReport source row col startRow startCol <| D.fillSep [ D.fromChars "I" @@ -6517,7 +6066,7 @@ toPRecordReport source record startRow startCol = , D.fromChars "here?" ] - CRES_PRecordField row col -> + T.CRES_PRecordField row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -6543,14 +6092,14 @@ toPRecordReport source record startRow startCol = toUnfinishRecordPatternReport source row col startRow startCol <| D.reflow "I was expecting to see a field name next." - CRES_PRecordSpace space row col -> + T.CRES_PRecordSpace space row col -> toSpaceReport source space row col - CRES_PRecordIndentOpen row col -> + T.CRES_PRecordIndentOpen row col -> toUnfinishRecordPatternReport source row col startRow startCol <| D.reflow "I was expecting to see a field name next." - CRES_PRecordIndentEnd row col -> + T.CRES_PRecordIndentEnd row col -> toUnfinishRecordPatternReport source row col startRow startCol <| D.fillSep [ D.fromChars "I" @@ -6570,7 +6119,7 @@ toPRecordReport source record startRow startCol = , D.fromChars "here?" ] - CRES_PRecordIndentField row col -> + T.CRES_PRecordIndentField row col -> toUnfinishRecordPatternReport source row col startRow startCol <| D.reflow "I was expecting to see a field name next." @@ -6615,10 +6164,10 @@ toUnfinishRecordPatternReport source row col startRow startCol message = ) -toPTupleReport : Code.Source -> PContext -> CRES_PTuple -> T.CPP_Row -> T.CPP_Col -> Report.Report +toPTupleReport : Code.Source -> PContext -> T.CRES_PTuple -> T.CPP_Row -> T.CPP_Col -> Report.Report toPTupleReport source context tuple startRow startCol = case tuple of - CRES_PTupleOpen row col -> + T.CRES_PTupleOpen row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -6678,7 +6227,7 @@ toPTupleReport source context tuple startRow startCol = ] ) - CRES_PTupleEnd row col -> + T.CRES_PTupleEnd row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -6779,13 +6328,13 @@ toPTupleReport source context tuple startRow startCol = ] ) - CRES_PTupleExpr pattern row col -> + T.CRES_PTupleExpr pattern row col -> toPatternReport source context pattern row col - CRES_PTupleSpace space row col -> + T.CRES_PTupleSpace space row col -> toSpaceReport source space row col - CRES_PTupleIndentEnd row col -> + T.CRES_PTupleIndentEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -6816,7 +6365,7 @@ toPTupleReport source context tuple startRow startCol = ] ) - CRES_PTupleIndentExpr1 row col -> + T.CRES_PTupleIndentExpr1 row col -> let surroundings : T.CRA_Region surroundings = @@ -6854,7 +6403,7 @@ toPTupleReport source context tuple startRow startCol = ] ) - CRES_PTupleIndentExprN row col -> + T.CRES_PTupleIndentExprN row col -> let surroundings : T.CRA_Region surroundings = @@ -6899,10 +6448,10 @@ toPTupleReport source context tuple startRow startCol = ) -toPListReport : Code.Source -> PContext -> CRES_PList -> T.CPP_Row -> T.CPP_Col -> Report.Report +toPListReport : Code.Source -> PContext -> T.CRES_PList -> T.CPP_Row -> T.CPP_Col -> Report.Report toPListReport source context list startRow startCol = case list of - CRES_PListOpen row col -> + T.CRES_PListOpen row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -6946,7 +6495,7 @@ toPListReport source context list startRow startCol = ] ) - CRES_PListEnd row col -> + T.CRES_PListEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -6972,13 +6521,13 @@ toPListReport source context list startRow startCol = ] ) - CRES_PListExpr pattern row col -> + T.CRES_PListExpr pattern row col -> toPatternReport source context pattern row col - CRES_PListSpace space row col -> + T.CRES_PListSpace space row col -> toSpaceReport source space row col - CRES_PListIndentOpen row col -> + T.CRES_PListIndentOpen row col -> let surroundings : T.CRA_Region surroundings = @@ -7007,7 +6556,7 @@ toPListReport source context list startRow startCol = ] ) - CRES_PListIndentEnd row col -> + T.CRES_PListIndentEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -7036,7 +6585,7 @@ toPListReport source context list startRow startCol = ] ) - CRES_PListIndentExpr row col -> + T.CRES_PListIndentExpr row col -> let surroundings : T.CRA_Region surroundings = @@ -7067,16 +6616,16 @@ type TContext | TC_Port -toTypeReport : Code.Source -> TContext -> CRES_Type -> T.CPP_Row -> T.CPP_Col -> Report.Report +toTypeReport : Code.Source -> TContext -> T.CRES_Type -> T.CPP_Row -> T.CPP_Col -> Report.Report toTypeReport source context tipe startRow startCol = case tipe of - CRES_TRecord record row col -> + T.CRES_TRecord record row col -> toTRecordReport source context record row col - CRES_TTuple tuple row col -> + T.CRES_TTuple tuple row col -> toTTupleReport source context tuple row col - CRES_TStart row col -> + T.CRES_TStart row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -7156,10 +6705,10 @@ toTypeReport source context tipe startRow startCol = ] ) - CRES_TSpace space row col -> + T.CRES_TSpace space row col -> toSpaceReport source space row col - CRES_TIndentStart row col -> + T.CRES_TIndentStart row col -> let surroundings : T.CRA_Region surroundings = @@ -7210,10 +6759,10 @@ toTypeReport source context tipe startRow startCol = ) -toTRecordReport : Code.Source -> TContext -> CRES_TRecord -> T.CPP_Row -> T.CPP_Col -> Report.Report +toTRecordReport : Code.Source -> TContext -> T.CRES_TRecord -> T.CPP_Row -> T.CPP_Col -> Report.Report toTRecordReport source context record startRow startCol = case record of - CRES_TRecordOpen row col -> + T.CRES_TRecordOpen row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -7263,7 +6812,7 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordEnd row col -> + T.CRES_TRecordEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -7304,7 +6853,7 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordField row col -> + T.CRES_TRecordField row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -7403,7 +6952,7 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordColon row col -> + T.CRES_TRecordColon row col -> let surroundings : T.CRA_Region surroundings = @@ -7445,13 +6994,13 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordType tipe row col -> + T.CRES_TRecordType tipe row col -> toTypeReport source context tipe row col - CRES_TRecordSpace space row col -> + T.CRES_TRecordSpace space row col -> toSpaceReport source space row col - CRES_TRecordIndentOpen row col -> + T.CRES_TRecordIndentOpen row col -> let surroundings : T.CRA_Region surroundings = @@ -7486,7 +7035,7 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordIndentEnd row col -> + T.CRES_TRecordIndentEnd row col -> case Code.nextLineStartsWithCloseCurly source row of Just ( curlyRow, curlyCol ) -> let @@ -7547,7 +7096,7 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordIndentField row col -> + T.CRES_TRecordIndentField row col -> let surroundings : T.CRA_Region surroundings = @@ -7566,7 +7115,7 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordIndentColon row col -> + T.CRES_TRecordIndentColon row col -> let surroundings : T.CRA_Region surroundings = @@ -7594,7 +7143,7 @@ toTRecordReport source context record startRow startCol = ] ) - CRES_TRecordIndentType row col -> + T.CRES_TRecordIndentType row col -> let surroundings : T.CRA_Region surroundings = @@ -7658,10 +7207,10 @@ noteForRecordTypeIndentError = ] -toTTupleReport : Code.Source -> TContext -> CRES_TTuple -> T.CPP_Row -> T.CPP_Col -> Report.Report +toTTupleReport : Code.Source -> TContext -> T.CRES_TTuple -> T.CPP_Row -> T.CPP_Col -> Report.Report toTTupleReport source context tuple startRow startCol = case tuple of - CRES_TTupleOpen row col -> + T.CRES_TTupleOpen row col -> case Code.whatIsNext source row col of Code.Keyword keyword -> let @@ -7713,7 +7262,7 @@ toTTupleReport source context tuple startRow startCol = ] ) - CRES_TTupleEnd row col -> + T.CRES_TTupleEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -7744,13 +7293,13 @@ toTTupleReport source context tuple startRow startCol = ] ) - CRES_TTupleType tipe row col -> + T.CRES_TTupleType tipe row col -> toTypeReport source context tipe row col - CRES_TTupleSpace space row col -> + T.CRES_TTupleSpace space row col -> toSpaceReport source space row col - CRES_TTupleIndentType1 row col -> + T.CRES_TTupleIndentType1 row col -> let surroundings : T.CRA_Region surroundings = @@ -7786,7 +7335,7 @@ toTTupleReport source context tuple startRow startCol = ] ) - CRES_TTupleIndentTypeN row col -> + T.CRES_TTupleIndentTypeN row col -> let surroundings : T.CRA_Region surroundings = @@ -7825,7 +7374,7 @@ toTTupleReport source context tuple startRow startCol = ] ) - CRES_TTupleIndentEnd row col -> + T.CRES_TTupleIndentEnd row col -> let surroundings : T.CRA_Region surroundings = @@ -7861,127 +7410,127 @@ toTTupleReport source context tuple startRow startCol = -- ENCODERS and DECODERS -errorEncoder : CRES_Error -> Encode.Value +errorEncoder : T.CRES_Error -> Encode.Value errorEncoder error = case error of - CRES_ModuleNameUnspecified name -> + T.CRES_ModuleNameUnspecified name -> Encode.object [ ( "type", Encode.string "ModuleNameUnspecified" ) , ( "name", ModuleName.rawEncoder name ) ] - CRES_ModuleNameMismatch expectedName actualName -> + T.CRES_ModuleNameMismatch expectedName actualName -> Encode.object [ ( "type", Encode.string "ModuleNameMismatch" ) , ( "expectedName", ModuleName.rawEncoder expectedName ) , ( "actualName", A.locatedEncoder ModuleName.rawEncoder actualName ) ] - CRES_UnexpectedPort region -> + T.CRES_UnexpectedPort region -> Encode.object [ ( "type", Encode.string "UnexpectedPort" ) , ( "region", A.regionEncoder region ) ] - CRES_NoPorts region -> + T.CRES_NoPorts region -> Encode.object [ ( "type", Encode.string "NoPorts" ) , ( "region", A.regionEncoder region ) ] - CRES_NoPortsInPackage name -> + T.CRES_NoPortsInPackage name -> Encode.object [ ( "type", Encode.string "NoPortsInPackage" ) , ( "name", A.locatedEncoder Encode.string name ) ] - CRES_NoPortModulesInPackage region -> + T.CRES_NoPortModulesInPackage region -> Encode.object [ ( "type", Encode.string "NoPortModulesInPackage" ) , ( "region", A.regionEncoder region ) ] - CRES_NoEffectsOutsideKernel region -> + T.CRES_NoEffectsOutsideKernel region -> Encode.object [ ( "type", Encode.string "NoEffectsOutsideKernel" ) , ( "region", A.regionEncoder region ) ] - CRES_ParseError modul -> + T.CRES_ParseError modul -> Encode.object [ ( "type", Encode.string "ParseError" ) , ( "modul", moduleEncoder modul ) ] -errorDecoder : Decode.Decoder CRES_Error +errorDecoder : Decode.Decoder T.CRES_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "ModuleNameUnspecified" -> - Decode.map CRES_ModuleNameUnspecified (Decode.field "name" ModuleName.rawDecoder) + Decode.map T.CRES_ModuleNameUnspecified (Decode.field "name" ModuleName.rawDecoder) "ModuleNameMismatch" -> - Decode.map2 CRES_ModuleNameMismatch + Decode.map2 T.CRES_ModuleNameMismatch (Decode.field "expectedName" ModuleName.rawDecoder) (Decode.field "actualName" (A.locatedDecoder ModuleName.rawDecoder)) "UnexpectedPort" -> - Decode.map CRES_UnexpectedPort (Decode.field "region" A.regionDecoder) + Decode.map T.CRES_UnexpectedPort (Decode.field "region" A.regionDecoder) "NoPorts" -> - Decode.map CRES_NoPorts (Decode.field "region" A.regionDecoder) + Decode.map T.CRES_NoPorts (Decode.field "region" A.regionDecoder) "NoPortsInPackage" -> - Decode.map CRES_NoPortsInPackage (Decode.field "name" (A.locatedDecoder Decode.string)) + Decode.map T.CRES_NoPortsInPackage (Decode.field "name" (A.locatedDecoder Decode.string)) "NoPortModulesInPackage" -> - Decode.map CRES_NoPortModulesInPackage (Decode.field "region" A.regionDecoder) + Decode.map T.CRES_NoPortModulesInPackage (Decode.field "region" A.regionDecoder) "NoEffectsOutsideKernel" -> - Decode.map CRES_NoEffectsOutsideKernel (Decode.field "region" A.regionDecoder) + Decode.map T.CRES_NoEffectsOutsideKernel (Decode.field "region" A.regionDecoder) "ParseError" -> - Decode.map CRES_ParseError (Decode.field "modul" moduleDecoder) + Decode.map T.CRES_ParseError (Decode.field "modul" moduleDecoder) _ -> Decode.fail ("Failed to decode Error's type: " ++ type_) ) -spaceEncoder : CRES_Space -> Encode.Value +spaceEncoder : T.CRES_Space -> Encode.Value spaceEncoder space = case space of - CRES_HasTab -> + T.CRES_HasTab -> Encode.string "HasTab" - CRES_EndlessMultiComment -> + T.CRES_EndlessMultiComment -> Encode.string "EndlessMultiComment" -spaceDecoder : Decode.Decoder CRES_Space +spaceDecoder : Decode.Decoder T.CRES_Space spaceDecoder = Decode.string |> Decode.andThen (\str -> case str of "HasTab" -> - Decode.succeed CRES_HasTab + Decode.succeed T.CRES_HasTab "EndlessMultiComment" -> - Decode.succeed CRES_EndlessMultiComment + Decode.succeed T.CRES_EndlessMultiComment _ -> Decode.fail ("Unknown Space: " ++ str) ) -moduleEncoder : CRES_Module -> Encode.Value +moduleEncoder : T.CRES_Module -> Encode.Value moduleEncoder modul = case modul of - CRES_ModuleSpace space row col -> + T.CRES_ModuleSpace space row col -> Encode.object [ ( "type", Encode.string "ModuleSpace" ) , ( "space", spaceEncoder space ) @@ -7989,28 +7538,28 @@ moduleEncoder modul = , ( "col", Encode.int col ) ] - CRES_ModuleBadEnd row col -> + T.CRES_ModuleBadEnd row col -> Encode.object [ ( "type", Encode.string "ModuleBadEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ModuleProblem row col -> + T.CRES_ModuleProblem row col -> Encode.object [ ( "type", Encode.string "ModuleProblem" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ModuleName row col -> + T.CRES_ModuleName row col -> Encode.object [ ( "type", Encode.string "ModuleName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ModuleExposing exposing_ row col -> + T.CRES_ModuleExposing exposing_ row col -> Encode.object [ ( "type", Encode.string "ModuleExposing" ) , ( "exposing", exposingEncoder exposing_ ) @@ -8018,21 +7567,21 @@ moduleEncoder modul = , ( "col", Encode.int col ) ] - CRES_PortModuleProblem row col -> + T.CRES_PortModuleProblem row col -> Encode.object [ ( "type", Encode.string "PortModuleProblem" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PortModuleName row col -> + T.CRES_PortModuleName row col -> Encode.object [ ( "type", Encode.string "PortModuleName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PortModuleExposing exposing_ row col -> + T.CRES_PortModuleExposing exposing_ row col -> Encode.object [ ( "type", Encode.string "PortModuleExposing" ) , ( "exposing", exposingEncoder exposing_ ) @@ -8040,56 +7589,56 @@ moduleEncoder modul = , ( "col", Encode.int col ) ] - CRES_Effect row col -> + T.CRES_Effect row col -> Encode.object [ ( "type", Encode.string "Effect" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_FreshLine row col -> + T.CRES_FreshLine row col -> Encode.object [ ( "type", Encode.string "FreshLine" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportStart row col -> + T.CRES_ImportStart row col -> Encode.object [ ( "type", Encode.string "ImportStart" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportName row col -> + T.CRES_ImportName row col -> Encode.object [ ( "type", Encode.string "ImportName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportAs row col -> + T.CRES_ImportAs row col -> Encode.object [ ( "type", Encode.string "ImportAs" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportAlias row col -> + T.CRES_ImportAlias row col -> Encode.object [ ( "type", Encode.string "ImportAlias" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportExposing row col -> + T.CRES_ImportExposing row col -> Encode.object [ ( "type", Encode.string "ImportExposing" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportExposingList exposing_ row col -> + T.CRES_ImportExposingList exposing_ row col -> Encode.object [ ( "type", Encode.string "ImportExposingList" ) , ( "exposing", exposingEncoder exposing_ ) @@ -8097,42 +7646,42 @@ moduleEncoder modul = , ( "col", Encode.int col ) ] - CRES_ImportEnd row col -> + T.CRES_ImportEnd row col -> Encode.object [ ( "type", Encode.string "ImportEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportIndentName row col -> + T.CRES_ImportIndentName row col -> Encode.object [ ( "type", Encode.string "ImportIndentName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportIndentAlias row col -> + T.CRES_ImportIndentAlias row col -> Encode.object [ ( "type", Encode.string "ImportIndentAlias" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ImportIndentExposingList row col -> + T.CRES_ImportIndentExposingList row col -> Encode.object [ ( "type", Encode.string "ImportIndentExposingList" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_Infix row col -> + T.CRES_Infix row col -> Encode.object [ ( "type", Encode.string "Infix" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_Declarations decl row col -> + T.CRES_Declarations decl row col -> Encode.object [ ( "type", Encode.string "Declarations" ) , ( "decl", declEncoder decl ) @@ -8141,123 +7690,123 @@ moduleEncoder modul = ] -moduleDecoder : Decode.Decoder CRES_Module +moduleDecoder : Decode.Decoder T.CRES_Module moduleDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "ModuleSpace" -> - Decode.map3 CRES_ModuleSpace + Decode.map3 T.CRES_ModuleSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ModuleBadEnd" -> - Decode.map2 CRES_ModuleBadEnd + Decode.map2 T.CRES_ModuleBadEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ModuleProblem" -> - Decode.map2 CRES_ModuleProblem + Decode.map2 T.CRES_ModuleProblem (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ModuleName" -> - Decode.map2 CRES_ModuleName + Decode.map2 T.CRES_ModuleName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ModuleExposing" -> - Decode.map3 CRES_ModuleExposing + Decode.map3 T.CRES_ModuleExposing (Decode.field "exposing" exposingDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortModuleProblem" -> - Decode.map2 CRES_PortModuleProblem + Decode.map2 T.CRES_PortModuleProblem (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortModuleName" -> - Decode.map2 CRES_PortModuleName + Decode.map2 T.CRES_PortModuleName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortModuleExposing" -> - Decode.map3 CRES_PortModuleExposing + Decode.map3 T.CRES_PortModuleExposing (Decode.field "exposing" exposingDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Effect" -> - Decode.map2 CRES_Effect + Decode.map2 T.CRES_Effect (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "FreshLine" -> - Decode.map2 CRES_FreshLine + Decode.map2 T.CRES_FreshLine (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportStart" -> - Decode.map2 CRES_ImportStart + Decode.map2 T.CRES_ImportStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportName" -> - Decode.map2 CRES_ImportName + Decode.map2 T.CRES_ImportName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportAs" -> - Decode.map2 CRES_ImportAs + Decode.map2 T.CRES_ImportAs (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportAlias" -> - Decode.map2 CRES_ImportAlias + Decode.map2 T.CRES_ImportAlias (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportExposing" -> - Decode.map2 CRES_ImportExposing + Decode.map2 T.CRES_ImportExposing (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportExposingList" -> - Decode.map3 CRES_ImportExposingList + Decode.map3 T.CRES_ImportExposingList (Decode.field "exposing" exposingDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportEnd" -> - Decode.map2 CRES_ImportEnd + Decode.map2 T.CRES_ImportEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportIndentName" -> - Decode.map2 CRES_ImportIndentName + Decode.map2 T.CRES_ImportIndentName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportIndentAlias" -> - Decode.map2 CRES_ImportIndentAlias + Decode.map2 T.CRES_ImportIndentAlias (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ImportIndentExposingList" -> - Decode.map2 CRES_ImportIndentExposingList + Decode.map2 T.CRES_ImportIndentExposingList (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Infix" -> - Decode.map2 CRES_Infix + Decode.map2 T.CRES_Infix (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Declarations" -> - Decode.map3 CRES_Declarations + Decode.map3 T.CRES_Declarations (Decode.field "decl" declDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -8267,10 +7816,10 @@ moduleDecoder = ) -exposingEncoder : CRES_Exposing -> Encode.Value +exposingEncoder : T.CRES_Exposing -> Encode.Value exposingEncoder exposing_ = case exposing_ of - CRES_ExposingSpace space row col -> + T.CRES_ExposingSpace space row col -> Encode.object [ ( "type", Encode.string "ExposingSpace" ) , ( "space", spaceEncoder space ) @@ -8278,28 +7827,28 @@ exposingEncoder exposing_ = , ( "col", Encode.int col ) ] - CRES_ExposingStart row col -> + T.CRES_ExposingStart row col -> Encode.object [ ( "type", Encode.string "ExposingStart" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ExposingValue row col -> + T.CRES_ExposingValue row col -> Encode.object [ ( "type", Encode.string "ExposingValue" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ExposingOperator row col -> + T.CRES_ExposingOperator row col -> Encode.object [ ( "type", Encode.string "ExposingOperator" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ExposingOperatorReserved op row col -> + T.CRES_ExposingOperatorReserved op row col -> Encode.object [ ( "type", Encode.string "ExposingOperatorReserved" ) , ( "op", Compiler.Parse.Symbol.badOperatorEncoder op ) @@ -8307,35 +7856,35 @@ exposingEncoder exposing_ = , ( "col", Encode.int col ) ] - CRES_ExposingOperatorRightParen row col -> + T.CRES_ExposingOperatorRightParen row col -> Encode.object [ ( "type", Encode.string "ExposingOperatorRightParen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ExposingTypePrivacy row col -> + T.CRES_ExposingTypePrivacy row col -> Encode.object [ ( "type", Encode.string "ExposingTypePrivacy" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ExposingEnd row col -> + T.CRES_ExposingEnd row col -> Encode.object [ ( "type", Encode.string "ExposingEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ExposingIndentEnd row col -> + T.CRES_ExposingIndentEnd row col -> Encode.object [ ( "type", Encode.string "ExposingIndentEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ExposingIndentValue row col -> + T.CRES_ExposingIndentValue row col -> Encode.object [ ( "type", Encode.string "ExposingIndentValue" ) , ( "row", Encode.int row ) @@ -8343,61 +7892,61 @@ exposingEncoder exposing_ = ] -exposingDecoder : Decode.Decoder CRES_Exposing +exposingDecoder : Decode.Decoder T.CRES_Exposing exposingDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "ExposingSpace" -> - Decode.map3 CRES_ExposingSpace + Decode.map3 T.CRES_ExposingSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingStart" -> - Decode.map2 CRES_ExposingStart + Decode.map2 T.CRES_ExposingStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingValue" -> - Decode.map2 CRES_ExposingValue + Decode.map2 T.CRES_ExposingValue (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingOperator" -> - Decode.map2 CRES_ExposingOperator + Decode.map2 T.CRES_ExposingOperator (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingOperatorReserved" -> - Decode.map3 CRES_ExposingOperatorReserved + Decode.map3 T.CRES_ExposingOperatorReserved (Decode.field "op" Compiler.Parse.Symbol.badOperatorDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingOperatorRightParen" -> - Decode.map2 CRES_ExposingOperatorRightParen + Decode.map2 T.CRES_ExposingOperatorRightParen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingTypePrivacy" -> - Decode.map2 CRES_ExposingTypePrivacy + Decode.map2 T.CRES_ExposingTypePrivacy (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingEnd" -> - Decode.map2 CRES_ExposingEnd + Decode.map2 T.CRES_ExposingEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingIndentEnd" -> - Decode.map2 CRES_ExposingIndentEnd + Decode.map2 T.CRES_ExposingIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ExposingIndentValue" -> - Decode.map2 CRES_ExposingIndentValue + Decode.map2 T.CRES_ExposingIndentValue (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -8406,17 +7955,17 @@ exposingDecoder = ) -declEncoder : CRES_Decl -> Encode.Value +declEncoder : T.CRES_Decl -> Encode.Value declEncoder decl = case decl of - CRES_DeclStart row col -> + T.CRES_DeclStart row col -> Encode.object [ ( "type", Encode.string "DeclStart" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DeclSpace space row col -> + T.CRES_DeclSpace space row col -> Encode.object [ ( "type", Encode.string "DeclSpace" ) , ( "space", spaceEncoder space ) @@ -8424,7 +7973,7 @@ declEncoder decl = , ( "col", Encode.int col ) ] - CRES_Port port_ row col -> + T.CRES_Port port_ row col -> Encode.object [ ( "type", Encode.string "Port" ) , ( "port", portEncoder port_ ) @@ -8432,7 +7981,7 @@ declEncoder decl = , ( "col", Encode.int col ) ] - CRES_DeclType declType row col -> + T.CRES_DeclType declType row col -> Encode.object [ ( "type", Encode.string "DeclType" ) , ( "declType", declTypeEncoder declType ) @@ -8440,7 +7989,7 @@ declEncoder decl = , ( "col", Encode.int col ) ] - CRES_DeclDef name declDef row col -> + T.CRES_DeclDef name declDef row col -> Encode.object [ ( "type", Encode.string "DeclDef" ) , ( "name", Encode.string name ) @@ -8449,7 +7998,7 @@ declEncoder decl = , ( "col", Encode.int col ) ] - CRES_DeclFreshLineAfterDocComment row col -> + T.CRES_DeclFreshLineAfterDocComment row col -> Encode.object [ ( "type", Encode.string "DeclFreshLineAfterDocComment" ) , ( "row", Encode.int row ) @@ -8457,44 +8006,44 @@ declEncoder decl = ] -declDecoder : Decode.Decoder CRES_Decl +declDecoder : Decode.Decoder T.CRES_Decl declDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "DeclStart" -> - Decode.map2 CRES_DeclStart + Decode.map2 T.CRES_DeclStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclSpace" -> - Decode.map3 CRES_DeclSpace + Decode.map3 T.CRES_DeclSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Port" -> - Decode.map3 CRES_Port + Decode.map3 T.CRES_Port (Decode.field "port" portDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclType" -> - Decode.map3 CRES_DeclType + Decode.map3 T.CRES_DeclType (Decode.field "declType" declTypeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDef" -> - Decode.map4 CRES_DeclDef + Decode.map4 T.CRES_DeclDef (Decode.field "name" Decode.string) (Decode.field "declDef" declDefDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclFreshLineAfterDocComment" -> - Decode.map2 CRES_DeclFreshLineAfterDocComment + Decode.map2 T.CRES_DeclFreshLineAfterDocComment (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -8503,10 +8052,10 @@ declDecoder = ) -portEncoder : CRES_Port -> Encode.Value +portEncoder : T.CRES_Port -> Encode.Value portEncoder port_ = case port_ of - CRES_PortSpace space row col -> + T.CRES_PortSpace space row col -> Encode.object [ ( "type", Encode.string "PortSpace" ) , ( "space", spaceEncoder space ) @@ -8514,21 +8063,21 @@ portEncoder port_ = , ( "col", Encode.int col ) ] - CRES_PortName row col -> + T.CRES_PortName row col -> Encode.object [ ( "type", Encode.string "PortName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PortColon row col -> + T.CRES_PortColon row col -> Encode.object [ ( "type", Encode.string "PortColon" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PortType tipe row col -> + T.CRES_PortType tipe row col -> Encode.object [ ( "type", Encode.string "PortType" ) , ( "tipe", typeEncoder tipe ) @@ -8536,21 +8085,21 @@ portEncoder port_ = , ( "col", Encode.int col ) ] - CRES_PortIndentName row col -> + T.CRES_PortIndentName row col -> Encode.object [ ( "type", Encode.string "PortIndentName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PortIndentColon row col -> + T.CRES_PortIndentColon row col -> Encode.object [ ( "type", Encode.string "PortIndentColon" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PortIndentType row col -> + T.CRES_PortIndentType row col -> Encode.object [ ( "type", Encode.string "PortIndentType" ) , ( "row", Encode.int row ) @@ -8558,46 +8107,46 @@ portEncoder port_ = ] -portDecoder : Decode.Decoder CRES_Port +portDecoder : Decode.Decoder T.CRES_Port portDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PortSpace" -> - Decode.map3 CRES_PortSpace + Decode.map3 T.CRES_PortSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortName" -> - Decode.map2 CRES_PortName + Decode.map2 T.CRES_PortName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortColon" -> - Decode.map2 CRES_PortColon + Decode.map2 T.CRES_PortColon (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortType" -> - Decode.map3 CRES_PortType + Decode.map3 T.CRES_PortType (Decode.field "tipe" typeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortIndentName" -> - Decode.map2 CRES_PortIndentName + Decode.map2 T.CRES_PortIndentName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortIndentColon" -> - Decode.map2 CRES_PortIndentColon + Decode.map2 T.CRES_PortIndentColon (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PortIndentType" -> - Decode.map2 CRES_PortIndentType + Decode.map2 T.CRES_PortIndentType (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -8606,10 +8155,10 @@ portDecoder = ) -declTypeEncoder : CRES_DeclType -> Encode.Value +declTypeEncoder : T.CRES_DeclType -> Encode.Value declTypeEncoder declType = case declType of - CRES_DT_Space space row col -> + T.CRES_DT_Space space row col -> Encode.object [ ( "type", Encode.string "DT_Space" ) , ( "space", spaceEncoder space ) @@ -8617,14 +8166,14 @@ declTypeEncoder declType = , ( "col", Encode.int col ) ] - CRES_DT_Name row col -> + T.CRES_DT_Name row col -> Encode.object [ ( "type", Encode.string "DT_Name" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DT_Alias typeAlias row col -> + T.CRES_DT_Alias typeAlias row col -> Encode.object [ ( "type", Encode.string "DT_Alias" ) , ( "typeAlias", typeAliasEncoder typeAlias ) @@ -8632,7 +8181,7 @@ declTypeEncoder declType = , ( "col", Encode.int col ) ] - CRES_DT_Union customType row col -> + T.CRES_DT_Union customType row col -> Encode.object [ ( "type", Encode.string "DT_Union" ) , ( "customType", customTypeEncoder customType ) @@ -8640,7 +8189,7 @@ declTypeEncoder declType = , ( "col", Encode.int col ) ] - CRES_DT_IndentName row col -> + T.CRES_DT_IndentName row col -> Encode.object [ ( "type", Encode.string "DT_IndentName" ) , ( "row", Encode.int row ) @@ -8648,37 +8197,37 @@ declTypeEncoder declType = ] -declTypeDecoder : Decode.Decoder CRES_DeclType +declTypeDecoder : Decode.Decoder T.CRES_DeclType declTypeDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "DT_Space" -> - Decode.map3 CRES_DT_Space + Decode.map3 T.CRES_DT_Space (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DT_Name" -> - Decode.map2 CRES_DT_Name + Decode.map2 T.CRES_DT_Name (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DT_Alias" -> - Decode.map3 CRES_DT_Alias + Decode.map3 T.CRES_DT_Alias (Decode.field "typeAlias" typeAliasDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DT_Union" -> - Decode.map3 CRES_DT_Union + Decode.map3 T.CRES_DT_Union (Decode.field "customType" customTypeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DT_IndentName" -> - Decode.map2 CRES_DT_IndentName + Decode.map2 T.CRES_DT_IndentName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -8687,10 +8236,10 @@ declTypeDecoder = ) -declDefEncoder : CRES_DeclDef -> Encode.Value +declDefEncoder : T.CRES_DeclDef -> Encode.Value declDefEncoder declDef = case declDef of - CRES_DeclDefSpace space row col -> + T.CRES_DeclDefSpace space row col -> Encode.object [ ( "type", Encode.string "DeclDefSpace" ) , ( "space", spaceEncoder space ) @@ -8698,14 +8247,14 @@ declDefEncoder declDef = , ( "col", Encode.int col ) ] - CRES_DeclDefEquals row col -> + T.CRES_DeclDefEquals row col -> Encode.object [ ( "type", Encode.string "DeclDefEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DeclDefType tipe row col -> + T.CRES_DeclDefType tipe row col -> Encode.object [ ( "type", Encode.string "DeclDefType" ) , ( "tipe", typeEncoder tipe ) @@ -8713,7 +8262,7 @@ declDefEncoder declDef = , ( "col", Encode.int col ) ] - CRES_DeclDefArg pattern row col -> + T.CRES_DeclDefArg pattern row col -> Encode.object [ ( "type", Encode.string "DeclDefArg" ) , ( "pattern", patternEncoder pattern ) @@ -8721,7 +8270,7 @@ declDefEncoder declDef = , ( "col", Encode.int col ) ] - CRES_DeclDefBody expr row col -> + T.CRES_DeclDefBody expr row col -> Encode.object [ ( "type", Encode.string "DeclDefBody" ) , ( "expr", exprEncoder expr ) @@ -8729,14 +8278,14 @@ declDefEncoder declDef = , ( "col", Encode.int col ) ] - CRES_DeclDefNameRepeat row col -> + T.CRES_DeclDefNameRepeat row col -> Encode.object [ ( "type", Encode.string "DeclDefNameRepeat" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DeclDefNameMatch name row col -> + T.CRES_DeclDefNameMatch name row col -> Encode.object [ ( "type", Encode.string "DeclDefNameMatch" ) , ( "name", Encode.string name ) @@ -8744,21 +8293,21 @@ declDefEncoder declDef = , ( "col", Encode.int col ) ] - CRES_DeclDefIndentType row col -> + T.CRES_DeclDefIndentType row col -> Encode.object [ ( "type", Encode.string "DeclDefIndentType" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DeclDefIndentEquals row col -> + T.CRES_DeclDefIndentEquals row col -> Encode.object [ ( "type", Encode.string "DeclDefIndentEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DeclDefIndentBody row col -> + T.CRES_DeclDefIndentBody row col -> Encode.object [ ( "type", Encode.string "DeclDefIndentBody" ) , ( "row", Encode.int row ) @@ -8766,64 +8315,64 @@ declDefEncoder declDef = ] -declDefDecoder : Decode.Decoder CRES_DeclDef +declDefDecoder : Decode.Decoder T.CRES_DeclDef declDefDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "DeclDefSpace" -> - Decode.map3 CRES_DeclDefSpace + Decode.map3 T.CRES_DeclDefSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefEquals" -> - Decode.map2 CRES_DeclDefEquals + Decode.map2 T.CRES_DeclDefEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefType" -> - Decode.map3 CRES_DeclDefType + Decode.map3 T.CRES_DeclDefType (Decode.field "tipe" typeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefArg" -> - Decode.map3 CRES_DeclDefArg + Decode.map3 T.CRES_DeclDefArg (Decode.field "pattern" patternDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefBody" -> - Decode.map3 CRES_DeclDefBody + Decode.map3 T.CRES_DeclDefBody (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefNameRepeat" -> - Decode.map2 CRES_DeclDefNameRepeat + Decode.map2 T.CRES_DeclDefNameRepeat (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefNameMatch" -> - Decode.map3 CRES_DeclDefNameMatch + Decode.map3 T.CRES_DeclDefNameMatch (Decode.field "name" Decode.string) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefIndentType" -> - Decode.map2 CRES_DeclDefIndentType + Decode.map2 T.CRES_DeclDefIndentType (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefIndentEquals" -> - Decode.map2 CRES_DeclDefIndentEquals + Decode.map2 T.CRES_DeclDefIndentEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DeclDefIndentBody" -> - Decode.map2 CRES_DeclDefIndentBody + Decode.map2 T.CRES_DeclDefIndentBody (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -8832,10 +8381,10 @@ declDefDecoder = ) -typeEncoder : CRES_Type -> Encode.Value +typeEncoder : T.CRES_Type -> Encode.Value typeEncoder type_ = case type_ of - CRES_TRecord record row col -> + T.CRES_TRecord record row col -> Encode.object [ ( "type", Encode.string "TRecord" ) , ( "record", tRecordEncoder record ) @@ -8843,7 +8392,7 @@ typeEncoder type_ = , ( "col", Encode.int col ) ] - CRES_TTuple tuple row col -> + T.CRES_TTuple tuple row col -> Encode.object [ ( "type", Encode.string "TTuple" ) , ( "tuple", tTupleEncoder tuple ) @@ -8851,14 +8400,14 @@ typeEncoder type_ = , ( "col", Encode.int col ) ] - CRES_TStart row col -> + T.CRES_TStart row col -> Encode.object [ ( "type", Encode.string "TStart" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TSpace space row col -> + T.CRES_TSpace space row col -> Encode.object [ ( "type", Encode.string "TSpace" ) , ( "space", spaceEncoder space ) @@ -8866,7 +8415,7 @@ typeEncoder type_ = , ( "col", Encode.int col ) ] - CRES_TIndentStart row col -> + T.CRES_TIndentStart row col -> Encode.object [ ( "type", Encode.string "TIndentStart" ) , ( "row", Encode.int row ) @@ -8874,37 +8423,37 @@ typeEncoder type_ = ] -typeDecoder : Decode.Decoder CRES_Type +typeDecoder : Decode.Decoder T.CRES_Type typeDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "TRecord" -> - Decode.map3 CRES_TRecord + Decode.map3 T.CRES_TRecord (Decode.field "record" tRecordDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TTuple" -> - Decode.map3 CRES_TTuple + Decode.map3 T.CRES_TTuple (Decode.field "tuple" tTupleDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TStart" -> - Decode.map2 CRES_TStart + Decode.map2 T.CRES_TStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TSpace" -> - Decode.map3 CRES_TSpace + Decode.map3 T.CRES_TSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TIndentStart" -> - Decode.map2 CRES_TIndentStart + Decode.map2 T.CRES_TIndentStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -8913,10 +8462,10 @@ typeDecoder = ) -patternEncoder : CRES_Pattern -> Encode.Value +patternEncoder : T.CRES_Pattern -> Encode.Value patternEncoder pattern = case pattern of - CRES_PRecord record row col -> + T.CRES_PRecord record row col -> Encode.object [ ( "type", Encode.string "PRecord" ) , ( "record", pRecordEncoder record ) @@ -8924,7 +8473,7 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PTuple tuple row col -> + T.CRES_PTuple tuple row col -> Encode.object [ ( "type", Encode.string "PTuple" ) , ( "tuple", pTupleEncoder tuple ) @@ -8932,7 +8481,7 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PList list row col -> + T.CRES_PList list row col -> Encode.object [ ( "type", Encode.string "PList" ) , ( "list", pListEncoder list ) @@ -8940,14 +8489,14 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PStart row col -> + T.CRES_PStart row col -> Encode.object [ ( "type", Encode.string "PStart" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PChar char row col -> + T.CRES_PChar char row col -> Encode.object [ ( "type", Encode.string "PChar" ) , ( "char", charEncoder char ) @@ -8955,7 +8504,7 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PString string row col -> + T.CRES_PString string row col -> Encode.object [ ( "type", Encode.string "PString" ) , ( "string", stringEncoder string ) @@ -8963,7 +8512,7 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PNumber number row col -> + T.CRES_PNumber number row col -> Encode.object [ ( "type", Encode.string "PNumber" ) , ( "number", numberEncoder number ) @@ -8971,7 +8520,7 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PFloat width row col -> + T.CRES_PFloat width row col -> Encode.object [ ( "type", Encode.string "PFloat" ) , ( "width", Encode.int width ) @@ -8979,14 +8528,14 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PAlias row col -> + T.CRES_PAlias row col -> Encode.object [ ( "type", Encode.string "PAlias" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PWildcardNotVar name width row col -> + T.CRES_PWildcardNotVar name width row col -> Encode.object [ ( "type", Encode.string "PWildcardNotVar" ) , ( "name", Encode.string name ) @@ -8995,7 +8544,7 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PSpace space row col -> + T.CRES_PSpace space row col -> Encode.object [ ( "type", Encode.string "PSpace" ) , ( "space", spaceEncoder space ) @@ -9003,14 +8552,14 @@ patternEncoder pattern = , ( "col", Encode.int col ) ] - CRES_PIndentStart row col -> + T.CRES_PIndentStart row col -> Encode.object [ ( "type", Encode.string "PIndentStart" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PIndentAlias row col -> + T.CRES_PIndentAlias row col -> Encode.object [ ( "type", Encode.string "PIndentAlias" ) , ( "row", Encode.int row ) @@ -9018,84 +8567,84 @@ patternEncoder pattern = ] -patternDecoder : Decode.Decoder CRES_Pattern +patternDecoder : Decode.Decoder T.CRES_Pattern patternDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PRecord" -> - Decode.map3 CRES_PRecord + Decode.map3 T.CRES_PRecord (Decode.field "record" pRecordDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PTuple" -> - Decode.map3 CRES_PTuple + Decode.map3 T.CRES_PTuple (Decode.field "tuple" pTupleDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PList" -> - Decode.map3 CRES_PList + Decode.map3 T.CRES_PList (Decode.field "list" pListDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PStart" -> - Decode.map2 CRES_PStart + Decode.map2 T.CRES_PStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PChar" -> - Decode.map3 CRES_PChar + Decode.map3 T.CRES_PChar (Decode.field "char" charDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PString" -> - Decode.map3 CRES_PString + Decode.map3 T.CRES_PString (Decode.field "string" stringDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PNumber" -> - Decode.map3 CRES_PNumber + Decode.map3 T.CRES_PNumber (Decode.field "number" numberDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PFloat" -> - Decode.map3 CRES_PFloat + Decode.map3 T.CRES_PFloat (Decode.field "width" Decode.int) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PAlias" -> - Decode.map2 CRES_PAlias + Decode.map2 T.CRES_PAlias (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PWildcardNotVar" -> - Decode.map4 CRES_PWildcardNotVar + Decode.map4 T.CRES_PWildcardNotVar (Decode.field "name" Decode.string) (Decode.field "width" Decode.int) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PSpace" -> - Decode.map3 CRES_PSpace + Decode.map3 T.CRES_PSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PIndentStart" -> - Decode.map2 CRES_PIndentStart + Decode.map2 T.CRES_PIndentStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PIndentAlias" -> - Decode.map2 CRES_PIndentAlias + Decode.map2 T.CRES_PIndentAlias (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -9104,10 +8653,10 @@ patternDecoder = ) -exprEncoder : CRES_Expr -> Encode.Value +exprEncoder : T.CRES_Expr -> Encode.Value exprEncoder expr = case expr of - CRES_Let let_ row col -> + T.CRES_Let let_ row col -> Encode.object [ ( "type", Encode.string "Let" ) , ( "let", letEncoder let_ ) @@ -9115,7 +8664,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Case case_ row col -> + T.CRES_Case case_ row col -> Encode.object [ ( "type", Encode.string "Case" ) , ( "case", caseEncoder case_ ) @@ -9123,7 +8672,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_If if_ row col -> + T.CRES_If if_ row col -> Encode.object [ ( "type", Encode.string "If" ) , ( "if", ifEncoder if_ ) @@ -9131,7 +8680,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_List list row col -> + T.CRES_List list row col -> Encode.object [ ( "type", Encode.string "List" ) , ( "list", listEncoder list ) @@ -9139,7 +8688,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Record record row col -> + T.CRES_Record record row col -> Encode.object [ ( "type", Encode.string "Record" ) , ( "record", recordEncoder record ) @@ -9147,7 +8696,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Tuple tuple row col -> + T.CRES_Tuple tuple row col -> Encode.object [ ( "type", Encode.string "Tuple" ) , ( "tuple", tupleEncoder tuple ) @@ -9155,7 +8704,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Func func row col -> + T.CRES_Func func row col -> Encode.object [ ( "type", Encode.string "Func" ) , ( "func", funcEncoder func ) @@ -9163,21 +8712,21 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Dot row col -> + T.CRES_Dot row col -> Encode.object [ ( "type", Encode.string "Dot" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_Access row col -> + T.CRES_Access row col -> Encode.object [ ( "type", Encode.string "Access" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_OperatorRight op row col -> + T.CRES_OperatorRight op row col -> Encode.object [ ( "type", Encode.string "OperatorRight" ) , ( "op", Encode.string op ) @@ -9185,7 +8734,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_OperatorReserved operator row col -> + T.CRES_OperatorReserved operator row col -> Encode.object [ ( "type", Encode.string "OperatorReserved" ) , ( "operator", Compiler.Parse.Symbol.badOperatorEncoder operator ) @@ -9193,14 +8742,14 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Start row col -> + T.CRES_Start row col -> Encode.object [ ( "type", Encode.string "Start" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_Char char row col -> + T.CRES_Char char row col -> Encode.object [ ( "type", Encode.string "Char" ) , ( "char", charEncoder char ) @@ -9208,7 +8757,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_String_ string row col -> + T.CRES_String_ string row col -> Encode.object [ ( "type", Encode.string "String" ) , ( "string", stringEncoder string ) @@ -9216,7 +8765,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Number number row col -> + T.CRES_Number number row col -> Encode.object [ ( "type", Encode.string "Number" ) , ( "number", numberEncoder number ) @@ -9224,7 +8773,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_Space space row col -> + T.CRES_Space space row col -> Encode.object [ ( "type", Encode.string "Space" ) , ( "space", spaceEncoder space ) @@ -9232,14 +8781,14 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_EndlessShader row col -> + T.CRES_EndlessShader row col -> Encode.object [ ( "type", Encode.string "EndlessShader" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ShaderProblem problem row col -> + T.CRES_ShaderProblem problem row col -> Encode.object [ ( "type", Encode.string "ShaderProblem" ) , ( "problem", Encode.string problem ) @@ -9247,7 +8796,7 @@ exprEncoder expr = , ( "col", Encode.int col ) ] - CRES_IndentOperatorRight op row col -> + T.CRES_IndentOperatorRight op row col -> Encode.object [ ( "type", Encode.string "IndentOperatorRight" ) , ( "op", Encode.string op ) @@ -9256,118 +8805,118 @@ exprEncoder expr = ] -exprDecoder : Decode.Decoder CRES_Expr +exprDecoder : Decode.Decoder T.CRES_Expr exprDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Let" -> - Decode.map3 CRES_Let + Decode.map3 T.CRES_Let (Decode.field "let" letDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Case" -> - Decode.map3 CRES_Case + Decode.map3 T.CRES_Case (Decode.field "case" caseDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "If" -> - Decode.map3 CRES_If + Decode.map3 T.CRES_If (Decode.field "if" ifDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "List" -> - Decode.map3 CRES_List + Decode.map3 T.CRES_List (Decode.field "list" listDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Record" -> - Decode.map3 CRES_Record + Decode.map3 T.CRES_Record (Decode.field "record" recordDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Tuple" -> - Decode.map3 CRES_Tuple + Decode.map3 T.CRES_Tuple (Decode.field "tuple" tupleDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Func" -> - Decode.map3 CRES_Func + Decode.map3 T.CRES_Func (Decode.field "func" funcDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Dot" -> - Decode.map2 CRES_Dot + Decode.map2 T.CRES_Dot (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Access" -> - Decode.map2 CRES_Access + Decode.map2 T.CRES_Access (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "OperatorRight" -> - Decode.map3 CRES_OperatorRight + Decode.map3 T.CRES_OperatorRight (Decode.field "op" Decode.string) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "OperatorReserved" -> - Decode.map3 CRES_OperatorReserved + Decode.map3 T.CRES_OperatorReserved (Decode.field "operator" Compiler.Parse.Symbol.badOperatorDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Start" -> - Decode.map2 CRES_Start + Decode.map2 T.CRES_Start (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Char" -> - Decode.map3 CRES_Char + Decode.map3 T.CRES_Char (Decode.field "char" charDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "String" -> - Decode.map3 CRES_String_ + Decode.map3 T.CRES_String_ (Decode.field "string" stringDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Number" -> - Decode.map3 CRES_Number + Decode.map3 T.CRES_Number (Decode.field "number" numberDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "Space" -> - Decode.map3 CRES_Space + Decode.map3 T.CRES_Space (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "EndlessShader" -> - Decode.map2 CRES_EndlessShader + Decode.map2 T.CRES_EndlessShader (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ShaderProblem" -> - Decode.map3 CRES_ShaderProblem + Decode.map3 T.CRES_ShaderProblem (Decode.field "problem" Decode.string) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IndentOperatorRight" -> - Decode.map3 CRES_IndentOperatorRight + Decode.map3 T.CRES_IndentOperatorRight (Decode.field "op" Decode.string) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -9377,10 +8926,10 @@ exprDecoder = ) -letEncoder : CRES_Let -> Encode.Value +letEncoder : T.CRES_Let -> Encode.Value letEncoder let_ = case let_ of - CRES_LetSpace space row col -> + T.CRES_LetSpace space row col -> Encode.object [ ( "type", Encode.string "LetSpace" ) , ( "space", spaceEncoder space ) @@ -9388,14 +8937,14 @@ letEncoder let_ = , ( "col", Encode.int col ) ] - CRES_LetIn row col -> + T.CRES_LetIn row col -> Encode.object [ ( "type", Encode.string "LetIn" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_LetDefAlignment int row col -> + T.CRES_LetDefAlignment int row col -> Encode.object [ ( "type", Encode.string "LetDefAlignment" ) , ( "int", Encode.int int ) @@ -9403,14 +8952,14 @@ letEncoder let_ = , ( "col", Encode.int col ) ] - CRES_LetDefName row col -> + T.CRES_LetDefName row col -> Encode.object [ ( "type", Encode.string "LetDefName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_LetDef name def row col -> + T.CRES_LetDef name def row col -> Encode.object [ ( "type", Encode.string "LetDef" ) , ( "name", Encode.string name ) @@ -9419,7 +8968,7 @@ letEncoder let_ = , ( "col", Encode.int col ) ] - CRES_LetDestruct destruct row col -> + T.CRES_LetDestruct destruct row col -> Encode.object [ ( "type", Encode.string "LetDestruct" ) , ( "destruct", destructEncoder destruct ) @@ -9427,7 +8976,7 @@ letEncoder let_ = , ( "col", Encode.int col ) ] - CRES_LetBody expr row col -> + T.CRES_LetBody expr row col -> Encode.object [ ( "type", Encode.string "LetBody" ) , ( "expr", exprEncoder expr ) @@ -9435,21 +8984,21 @@ letEncoder let_ = , ( "col", Encode.int col ) ] - CRES_LetIndentDef row col -> + T.CRES_LetIndentDef row col -> Encode.object [ ( "type", Encode.string "LetIndentDef" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_LetIndentIn row col -> + T.CRES_LetIndentIn row col -> Encode.object [ ( "type", Encode.string "LetIndentIn" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_LetIndentBody row col -> + T.CRES_LetIndentBody row col -> Encode.object [ ( "type", Encode.string "LetIndentBody" ) , ( "row", Encode.int row ) @@ -9457,65 +9006,65 @@ letEncoder let_ = ] -letDecoder : Decode.Decoder CRES_Let +letDecoder : Decode.Decoder T.CRES_Let letDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "LetSpace" -> - Decode.map3 CRES_LetSpace + Decode.map3 T.CRES_LetSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetIn" -> - Decode.map2 CRES_LetIn + Decode.map2 T.CRES_LetIn (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetDefAlignment" -> - Decode.map3 CRES_LetDefAlignment + Decode.map3 T.CRES_LetDefAlignment (Decode.field "int" Decode.int) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetDefName" -> - Decode.map2 CRES_LetDefName + Decode.map2 T.CRES_LetDefName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetDef" -> - Decode.map4 CRES_LetDef + Decode.map4 T.CRES_LetDef (Decode.field "name" Decode.string) (Decode.field "def" defDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetDestruct" -> - Decode.map3 CRES_LetDestruct + Decode.map3 T.CRES_LetDestruct (Decode.field "destruct" destructDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetBody" -> - Decode.map3 CRES_LetBody + Decode.map3 T.CRES_LetBody (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetIndentDef" -> - Decode.map2 CRES_LetIndentDef + Decode.map2 T.CRES_LetIndentDef (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetIndentIn" -> - Decode.map2 CRES_LetIndentIn + Decode.map2 T.CRES_LetIndentIn (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "LetIndentBody" -> - Decode.map2 CRES_LetIndentBody + Decode.map2 T.CRES_LetIndentBody (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -9524,10 +9073,10 @@ letDecoder = ) -caseEncoder : CRES_Case -> Encode.Value +caseEncoder : T.CRES_Case -> Encode.Value caseEncoder case_ = case case_ of - CRES_CaseSpace space row col -> + T.CRES_CaseSpace space row col -> Encode.object [ ( "type", Encode.string "CaseSpace" ) , ( "space", spaceEncoder space ) @@ -9535,14 +9084,14 @@ caseEncoder case_ = , ( "col", Encode.int col ) ] - CRES_CaseOf row col -> + T.CRES_CaseOf row col -> Encode.object [ ( "type", Encode.string "CaseOf" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CasePattern pattern row col -> + T.CRES_CasePattern pattern row col -> Encode.object [ ( "type", Encode.string "CasePattern" ) , ( "pattern", patternEncoder pattern ) @@ -9550,14 +9099,14 @@ caseEncoder case_ = , ( "col", Encode.int col ) ] - CRES_CaseArrow row col -> + T.CRES_CaseArrow row col -> Encode.object [ ( "type", Encode.string "CaseArrow" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CaseExpr expr row col -> + T.CRES_CaseExpr expr row col -> Encode.object [ ( "type", Encode.string "CaseExpr" ) , ( "expr", exprEncoder expr ) @@ -9565,7 +9114,7 @@ caseEncoder case_ = , ( "col", Encode.int col ) ] - CRES_CaseBranch expr row col -> + T.CRES_CaseBranch expr row col -> Encode.object [ ( "type", Encode.string "CaseBranch" ) , ( "expr", exprEncoder expr ) @@ -9573,42 +9122,42 @@ caseEncoder case_ = , ( "col", Encode.int col ) ] - CRES_CaseIndentOf row col -> + T.CRES_CaseIndentOf row col -> Encode.object [ ( "type", Encode.string "CaseIndentOf" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CaseIndentExpr row col -> + T.CRES_CaseIndentExpr row col -> Encode.object [ ( "type", Encode.string "CaseIndentExpr" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CaseIndentPattern row col -> + T.CRES_CaseIndentPattern row col -> Encode.object [ ( "type", Encode.string "CaseIndentPattern" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CaseIndentArrow row col -> + T.CRES_CaseIndentArrow row col -> Encode.object [ ( "type", Encode.string "CaseIndentArrow" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CaseIndentBranch row col -> + T.CRES_CaseIndentBranch row col -> Encode.object [ ( "type", Encode.string "CaseIndentBranch" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CasePatternAlignment indent row col -> + T.CRES_CasePatternAlignment indent row col -> Encode.object [ ( "type", Encode.string "CasePatternAlignment" ) , ( "indent", Encode.int indent ) @@ -9617,73 +9166,73 @@ caseEncoder case_ = ] -caseDecoder : Decode.Decoder CRES_Case +caseDecoder : Decode.Decoder T.CRES_Case caseDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "CaseSpace" -> - Decode.map3 CRES_CaseSpace + Decode.map3 T.CRES_CaseSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseOf" -> - Decode.map2 CRES_CaseOf + Decode.map2 T.CRES_CaseOf (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CasePattern" -> - Decode.map3 CRES_CasePattern + Decode.map3 T.CRES_CasePattern (Decode.field "pattern" patternDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseArrow" -> - Decode.map2 CRES_CaseArrow + Decode.map2 T.CRES_CaseArrow (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseExpr" -> - Decode.map3 CRES_CaseExpr + Decode.map3 T.CRES_CaseExpr (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseBranch" -> - Decode.map3 CRES_CaseBranch + Decode.map3 T.CRES_CaseBranch (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseIndentOf" -> - Decode.map2 CRES_CaseIndentOf + Decode.map2 T.CRES_CaseIndentOf (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseIndentExpr" -> - Decode.map2 CRES_CaseIndentExpr + Decode.map2 T.CRES_CaseIndentExpr (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseIndentPattern" -> - Decode.map2 CRES_CaseIndentPattern + Decode.map2 T.CRES_CaseIndentPattern (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseIndentArrow" -> - Decode.map2 CRES_CaseIndentArrow + Decode.map2 T.CRES_CaseIndentArrow (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CaseIndentBranch" -> - Decode.map2 CRES_CaseIndentBranch + Decode.map2 T.CRES_CaseIndentBranch (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CasePatternAlignment" -> - Decode.map3 CRES_CasePatternAlignment + Decode.map3 T.CRES_CasePatternAlignment (Decode.field "indent" Decode.int) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -9693,10 +9242,10 @@ caseDecoder = ) -ifEncoder : CRES_If -> Encode.Value +ifEncoder : T.CRES_If -> Encode.Value ifEncoder if_ = case if_ of - CRES_IfSpace space row col -> + T.CRES_IfSpace space row col -> Encode.object [ ( "type", Encode.string "IfSpace" ) , ( "space", spaceEncoder space ) @@ -9704,28 +9253,28 @@ ifEncoder if_ = , ( "col", Encode.int col ) ] - CRES_IfThen row col -> + T.CRES_IfThen row col -> Encode.object [ ( "type", Encode.string "IfThen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_IfElse row col -> + T.CRES_IfElse row col -> Encode.object [ ( "type", Encode.string "IfElse" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_IfElseBranchStart row col -> + T.CRES_IfElseBranchStart row col -> Encode.object [ ( "type", Encode.string "IfElseBranchStart" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_IfCondition expr row col -> + T.CRES_IfCondition expr row col -> Encode.object [ ( "type", Encode.string "IfCondition" ) , ( "expr", exprEncoder expr ) @@ -9733,7 +9282,7 @@ ifEncoder if_ = , ( "col", Encode.int col ) ] - CRES_IfThenBranch expr row col -> + T.CRES_IfThenBranch expr row col -> Encode.object [ ( "type", Encode.string "IfThenBranch" ) , ( "expr", exprEncoder expr ) @@ -9741,7 +9290,7 @@ ifEncoder if_ = , ( "col", Encode.int col ) ] - CRES_IfElseBranch expr row col -> + T.CRES_IfElseBranch expr row col -> Encode.object [ ( "type", Encode.string "IfElseBranch" ) , ( "expr", exprEncoder expr ) @@ -9749,35 +9298,35 @@ ifEncoder if_ = , ( "col", Encode.int col ) ] - CRES_IfIndentCondition row col -> + T.CRES_IfIndentCondition row col -> Encode.object [ ( "type", Encode.string "IfIndentCondition" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_IfIndentThen row col -> + T.CRES_IfIndentThen row col -> Encode.object [ ( "type", Encode.string "IfIndentThen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_IfIndentThenBranch row col -> + T.CRES_IfIndentThenBranch row col -> Encode.object [ ( "type", Encode.string "IfIndentThenBranch" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_IfIndentElseBranch row col -> + T.CRES_IfIndentElseBranch row col -> Encode.object [ ( "type", Encode.string "IfIndentElseBranch" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_IfIndentElse row col -> + T.CRES_IfIndentElse row col -> Encode.object [ ( "type", Encode.string "IfIndentElse" ) , ( "row", Encode.int row ) @@ -9785,73 +9334,73 @@ ifEncoder if_ = ] -ifDecoder : Decode.Decoder CRES_If +ifDecoder : Decode.Decoder T.CRES_If ifDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "IfSpace" -> - Decode.map3 CRES_IfSpace + Decode.map3 T.CRES_IfSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfThen" -> - Decode.map2 CRES_IfThen + Decode.map2 T.CRES_IfThen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfElse" -> - Decode.map2 CRES_IfElse + Decode.map2 T.CRES_IfElse (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfElseBranchStart" -> - Decode.map2 CRES_IfElseBranchStart + Decode.map2 T.CRES_IfElseBranchStart (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfCondition" -> - Decode.map3 CRES_IfCondition + Decode.map3 T.CRES_IfCondition (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfThenBranch" -> - Decode.map3 CRES_IfThenBranch + Decode.map3 T.CRES_IfThenBranch (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfElseBranch" -> - Decode.map3 CRES_IfElseBranch + Decode.map3 T.CRES_IfElseBranch (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfIndentCondition" -> - Decode.map2 CRES_IfIndentCondition + Decode.map2 T.CRES_IfIndentCondition (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfIndentThen" -> - Decode.map2 CRES_IfIndentThen + Decode.map2 T.CRES_IfIndentThen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfIndentThenBranch" -> - Decode.map2 CRES_IfIndentThenBranch + Decode.map2 T.CRES_IfIndentThenBranch (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfIndentElseBranch" -> - Decode.map2 CRES_IfIndentElseBranch + Decode.map2 T.CRES_IfIndentElseBranch (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "IfIndentElse" -> - Decode.map2 CRES_IfIndentElse + Decode.map2 T.CRES_IfIndentElse (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -9860,10 +9409,10 @@ ifDecoder = ) -listEncoder : CRES_List_ -> Encode.Value +listEncoder : T.CRES_List_ -> Encode.Value listEncoder list_ = case list_ of - CRES_ListSpace space row col -> + T.CRES_ListSpace space row col -> Encode.object [ ( "type", Encode.string "ListSpace" ) , ( "space", spaceEncoder space ) @@ -9871,14 +9420,14 @@ listEncoder list_ = , ( "col", Encode.int col ) ] - CRES_ListOpen row col -> + T.CRES_ListOpen row col -> Encode.object [ ( "type", Encode.string "ListOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ListExpr expr row col -> + T.CRES_ListExpr expr row col -> Encode.object [ ( "type", Encode.string "ListExpr" ) , ( "expr", exprEncoder expr ) @@ -9886,28 +9435,28 @@ listEncoder list_ = , ( "col", Encode.int col ) ] - CRES_ListEnd row col -> + T.CRES_ListEnd row col -> Encode.object [ ( "type", Encode.string "ListEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ListIndentOpen row col -> + T.CRES_ListIndentOpen row col -> Encode.object [ ( "type", Encode.string "ListIndentOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ListIndentEnd row col -> + T.CRES_ListIndentEnd row col -> Encode.object [ ( "type", Encode.string "ListIndentEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_ListIndentExpr row col -> + T.CRES_ListIndentExpr row col -> Encode.object [ ( "type", Encode.string "ListIndentExpr" ) , ( "row", Encode.int row ) @@ -9915,46 +9464,46 @@ listEncoder list_ = ] -listDecoder : Decode.Decoder CRES_List_ +listDecoder : Decode.Decoder T.CRES_List_ listDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "ListSpace" -> - Decode.map3 CRES_ListSpace + Decode.map3 T.CRES_ListSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ListOpen" -> - Decode.map2 CRES_ListOpen + Decode.map2 T.CRES_ListOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ListExpr" -> - Decode.map3 CRES_ListExpr + Decode.map3 T.CRES_ListExpr (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ListEnd" -> - Decode.map2 CRES_ListEnd + Decode.map2 T.CRES_ListEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ListIndentOpen" -> - Decode.map2 CRES_ListIndentOpen + Decode.map2 T.CRES_ListIndentOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ListIndentEnd" -> - Decode.map2 CRES_ListIndentEnd + Decode.map2 T.CRES_ListIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "ListIndentExpr" -> - Decode.map2 CRES_ListIndentExpr + Decode.map2 T.CRES_ListIndentExpr (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -9963,38 +9512,38 @@ listDecoder = ) -recordEncoder : CRES_Record -> Encode.Value +recordEncoder : T.CRES_Record -> Encode.Value recordEncoder record = case record of - CRES_RecordOpen row col -> + T.CRES_RecordOpen row col -> Encode.object [ ( "type", Encode.string "RecordOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordEnd row col -> + T.CRES_RecordEnd row col -> Encode.object [ ( "type", Encode.string "RecordEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordField row col -> + T.CRES_RecordField row col -> Encode.object [ ( "type", Encode.string "RecordField" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordEquals row col -> + T.CRES_RecordEquals row col -> Encode.object [ ( "type", Encode.string "RecordEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordExpr expr row col -> + T.CRES_RecordExpr expr row col -> Encode.object [ ( "type", Encode.string "RecordExpr" ) , ( "expr", exprEncoder expr ) @@ -10002,7 +9551,7 @@ recordEncoder record = , ( "col", Encode.int col ) ] - CRES_RecordSpace space row col -> + T.CRES_RecordSpace space row col -> Encode.object [ ( "type", Encode.string "RecordSpace" ) , ( "space", spaceEncoder space ) @@ -10010,35 +9559,35 @@ recordEncoder record = , ( "col", Encode.int col ) ] - CRES_RecordIndentOpen row col -> + T.CRES_RecordIndentOpen row col -> Encode.object [ ( "type", Encode.string "RecordIndentOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordIndentEnd row col -> + T.CRES_RecordIndentEnd row col -> Encode.object [ ( "type", Encode.string "RecordIndentEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordIndentField row col -> + T.CRES_RecordIndentField row col -> Encode.object [ ( "type", Encode.string "RecordIndentField" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordIndentEquals row col -> + T.CRES_RecordIndentEquals row col -> Encode.object [ ( "type", Encode.string "RecordIndentEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_RecordIndentExpr row col -> + T.CRES_RecordIndentExpr row col -> Encode.object [ ( "type", Encode.string "RecordIndentExpr" ) , ( "row", Encode.int row ) @@ -10046,66 +9595,66 @@ recordEncoder record = ] -recordDecoder : Decode.Decoder CRES_Record +recordDecoder : Decode.Decoder T.CRES_Record recordDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "RecordOpen" -> - Decode.map2 CRES_RecordOpen + Decode.map2 T.CRES_RecordOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordEnd" -> - Decode.map2 CRES_RecordEnd + Decode.map2 T.CRES_RecordEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordField" -> - Decode.map2 CRES_RecordField + Decode.map2 T.CRES_RecordField (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordEquals" -> - Decode.map2 CRES_RecordEquals + Decode.map2 T.CRES_RecordEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordExpr" -> - Decode.map3 CRES_RecordExpr + Decode.map3 T.CRES_RecordExpr (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordSpace" -> - Decode.map3 CRES_RecordSpace + Decode.map3 T.CRES_RecordSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordIndentOpen" -> - Decode.map2 CRES_RecordIndentOpen + Decode.map2 T.CRES_RecordIndentOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordIndentEnd" -> - Decode.map2 CRES_RecordIndentEnd + Decode.map2 T.CRES_RecordIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordIndentField" -> - Decode.map2 CRES_RecordIndentField + Decode.map2 T.CRES_RecordIndentField (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordIndentEquals" -> - Decode.map2 CRES_RecordIndentEquals + Decode.map2 T.CRES_RecordIndentEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "RecordIndentExpr" -> - Decode.map2 CRES_RecordIndentExpr + Decode.map2 T.CRES_RecordIndentExpr (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -10114,10 +9663,10 @@ recordDecoder = ) -tupleEncoder : CRES_Tuple -> Encode.Value +tupleEncoder : T.CRES_Tuple -> Encode.Value tupleEncoder tuple = case tuple of - CRES_TupleExpr expr row col -> + T.CRES_TupleExpr expr row col -> Encode.object [ ( "type", Encode.string "TupleExpr" ) , ( "expr", exprEncoder expr ) @@ -10125,7 +9674,7 @@ tupleEncoder tuple = , ( "col", Encode.int col ) ] - CRES_TupleSpace space row col -> + T.CRES_TupleSpace space row col -> Encode.object [ ( "type", Encode.string "TupleSpace" ) , ( "space", spaceEncoder space ) @@ -10133,21 +9682,21 @@ tupleEncoder tuple = , ( "col", Encode.int col ) ] - CRES_TupleEnd row col -> + T.CRES_TupleEnd row col -> Encode.object [ ( "type", Encode.string "TupleEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TupleOperatorClose row col -> + T.CRES_TupleOperatorClose row col -> Encode.object [ ( "type", Encode.string "TupleOperatorClose" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TupleOperatorReserved operator row col -> + T.CRES_TupleOperatorReserved operator row col -> Encode.object [ ( "type", Encode.string "TupleOperatorReserved" ) , ( "operator", Compiler.Parse.Symbol.badOperatorEncoder operator ) @@ -10155,21 +9704,21 @@ tupleEncoder tuple = , ( "col", Encode.int col ) ] - CRES_TupleIndentExpr1 row col -> + T.CRES_TupleIndentExpr1 row col -> Encode.object [ ( "type", Encode.string "TupleIndentExpr1" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TupleIndentExprN row col -> + T.CRES_TupleIndentExprN row col -> Encode.object [ ( "type", Encode.string "TupleIndentExprN" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TupleIndentEnd row col -> + T.CRES_TupleIndentEnd row col -> Encode.object [ ( "type", Encode.string "TupleIndentEnd" ) , ( "row", Encode.int row ) @@ -10177,52 +9726,52 @@ tupleEncoder tuple = ] -tupleDecoder : Decode.Decoder CRES_Tuple +tupleDecoder : Decode.Decoder T.CRES_Tuple tupleDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "TupleExpr" -> - Decode.map3 CRES_TupleExpr + Decode.map3 T.CRES_TupleExpr (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TupleSpace" -> - Decode.map3 CRES_TupleSpace + Decode.map3 T.CRES_TupleSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TupleEnd" -> - Decode.map2 CRES_TupleEnd + Decode.map2 T.CRES_TupleEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TupleOperatorClose" -> - Decode.map2 CRES_TupleOperatorClose + Decode.map2 T.CRES_TupleOperatorClose (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TupleOperatorReserved" -> - Decode.map3 CRES_TupleOperatorReserved + Decode.map3 T.CRES_TupleOperatorReserved (Decode.field "operator" Compiler.Parse.Symbol.badOperatorDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TupleIndentExpr1" -> - Decode.map2 CRES_TupleIndentExpr1 + Decode.map2 T.CRES_TupleIndentExpr1 (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TupleIndentExprN" -> - Decode.map2 CRES_TupleIndentExprN + Decode.map2 T.CRES_TupleIndentExprN (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TupleIndentEnd" -> - Decode.map2 CRES_TupleIndentEnd + Decode.map2 T.CRES_TupleIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -10231,10 +9780,10 @@ tupleDecoder = ) -funcEncoder : CRES_Func -> Encode.Value +funcEncoder : T.CRES_Func -> Encode.Value funcEncoder func = case func of - CRES_FuncSpace space row col -> + T.CRES_FuncSpace space row col -> Encode.object [ ( "type", Encode.string "FuncSpace" ) , ( "space", spaceEncoder space ) @@ -10242,7 +9791,7 @@ funcEncoder func = , ( "col", Encode.int col ) ] - CRES_FuncArg pattern row col -> + T.CRES_FuncArg pattern row col -> Encode.object [ ( "type", Encode.string "FuncArg" ) , ( "pattern", patternEncoder pattern ) @@ -10250,7 +9799,7 @@ funcEncoder func = , ( "col", Encode.int col ) ] - CRES_FuncBody expr row col -> + T.CRES_FuncBody expr row col -> Encode.object [ ( "type", Encode.string "FuncBody" ) , ( "expr", exprEncoder expr ) @@ -10258,28 +9807,28 @@ funcEncoder func = , ( "col", Encode.int col ) ] - CRES_FuncArrow row col -> + T.CRES_FuncArrow row col -> Encode.object [ ( "type", Encode.string "FuncArrow" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_FuncIndentArg row col -> + T.CRES_FuncIndentArg row col -> Encode.object [ ( "type", Encode.string "FuncIndentArg" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_FuncIndentArrow row col -> + T.CRES_FuncIndentArrow row col -> Encode.object [ ( "type", Encode.string "FuncIndentArrow" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_FuncIndentBody row col -> + T.CRES_FuncIndentBody row col -> Encode.object [ ( "type", Encode.string "FuncIndentBody" ) , ( "row", Encode.int row ) @@ -10287,47 +9836,47 @@ funcEncoder func = ] -funcDecoder : Decode.Decoder CRES_Func +funcDecoder : Decode.Decoder T.CRES_Func funcDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "FuncSpace" -> - Decode.map3 CRES_FuncSpace + Decode.map3 T.CRES_FuncSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "FuncArg" -> - Decode.map3 CRES_FuncArg + Decode.map3 T.CRES_FuncArg (Decode.field "pattern" patternDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "FuncBody" -> - Decode.map3 CRES_FuncBody + Decode.map3 T.CRES_FuncBody (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "FuncArrow" -> - Decode.map2 CRES_FuncArrow + Decode.map2 T.CRES_FuncArrow (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "FuncIndentArg" -> - Decode.map2 CRES_FuncIndentArg + Decode.map2 T.CRES_FuncIndentArg (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "FuncIndentArrow" -> - Decode.map2 CRES_FuncIndentArrow + Decode.map2 T.CRES_FuncIndentArrow (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "FuncIndentBody" -> - Decode.map2 CRES_FuncIndentBody + Decode.map2 T.CRES_FuncIndentBody (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -10336,154 +9885,154 @@ funcDecoder = ) -charEncoder : CRES_Char -> Encode.Value +charEncoder : T.CRES_Char -> Encode.Value charEncoder char = case char of - CRES_CharEndless -> + T.CRES_CharEndless -> Encode.object [ ( "type", Encode.string "CharEndless" ) ] - CRES_CharEscape escape -> + T.CRES_CharEscape escape -> Encode.object [ ( "type", Encode.string "CharEscape" ) , ( "escape", escapeEncoder escape ) ] - CRES_CharNotString width -> + T.CRES_CharNotString width -> Encode.object [ ( "type", Encode.string "CharNotString" ) , ( "width", Encode.int width ) ] -charDecoder : Decode.Decoder CRES_Char +charDecoder : Decode.Decoder T.CRES_Char charDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "CharEndless" -> - Decode.succeed CRES_CharEndless + Decode.succeed T.CRES_CharEndless "CharEscape" -> - Decode.map CRES_CharEscape (Decode.field "escape" escapeDecoder) + Decode.map T.CRES_CharEscape (Decode.field "escape" escapeDecoder) "CharNotString" -> - Decode.map CRES_CharNotString (Decode.field "width" Decode.int) + Decode.map T.CRES_CharNotString (Decode.field "width" Decode.int) _ -> Decode.fail ("Failed to decode Char's type: " ++ type_) ) -stringEncoder : CRES_String_ -> Encode.Value +stringEncoder : T.CRES_String_ -> Encode.Value stringEncoder string_ = case string_ of - CRES_StringEndless_Single -> + T.CRES_StringEndless_Single -> Encode.object [ ( "type", Encode.string "StringEndless_Single" ) ] - CRES_StringEndless_Multi -> + T.CRES_StringEndless_Multi -> Encode.object [ ( "type", Encode.string "StringEndless_Multi" ) ] - CRES_StringEscape escape -> + T.CRES_StringEscape escape -> Encode.object [ ( "type", Encode.string "StringEscape" ) , ( "escape", escapeEncoder escape ) ] -stringDecoder : Decode.Decoder CRES_String_ +stringDecoder : Decode.Decoder T.CRES_String_ stringDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "StringEndless_Single" -> - Decode.succeed CRES_StringEndless_Single + Decode.succeed T.CRES_StringEndless_Single "StringEndless_Multi" -> - Decode.succeed CRES_StringEndless_Multi + Decode.succeed T.CRES_StringEndless_Multi "StringEscape" -> - Decode.map CRES_StringEscape (Decode.field "escape" escapeDecoder) + Decode.map T.CRES_StringEscape (Decode.field "escape" escapeDecoder) _ -> Decode.fail ("Failed to decode String's type: " ++ type_) ) -numberEncoder : CRES_Number -> Encode.Value +numberEncoder : T.CRES_Number -> Encode.Value numberEncoder number = case number of - CRES_NumberEnd -> + T.CRES_NumberEnd -> Encode.object [ ( "type", Encode.string "NumberEnd" ) ] - CRES_NumberDot n -> + T.CRES_NumberDot n -> Encode.object [ ( "type", Encode.string "NumberDot" ) , ( "n", Encode.int n ) ] - CRES_NumberHexDigit -> + T.CRES_NumberHexDigit -> Encode.object [ ( "type", Encode.string "NumberHexDigit" ) ] - CRES_NumberNoLeadingZero -> + T.CRES_NumberNoLeadingZero -> Encode.object [ ( "type", Encode.string "NumberNoLeadingZero" ) ] -numberDecoder : Decode.Decoder CRES_Number +numberDecoder : Decode.Decoder T.CRES_Number numberDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "NumberEnd" -> - Decode.succeed CRES_NumberEnd + Decode.succeed T.CRES_NumberEnd "NumberDot" -> - Decode.map CRES_NumberDot (Decode.field "n" Decode.int) + Decode.map T.CRES_NumberDot (Decode.field "n" Decode.int) "NumberHexDigit" -> - Decode.succeed CRES_NumberHexDigit + Decode.succeed T.CRES_NumberHexDigit "NumberNoLeadingZero" -> - Decode.succeed CRES_NumberNoLeadingZero + Decode.succeed T.CRES_NumberNoLeadingZero _ -> Decode.fail ("Failed to decode Number's type: " ++ type_) ) -escapeEncoder : CRES_Escape -> Encode.Value +escapeEncoder : T.CRES_Escape -> Encode.Value escapeEncoder escape = case escape of - CRES_EscapeUnknown -> + T.CRES_EscapeUnknown -> Encode.object [ ( "type", Encode.string "EscapeUnknown" ) ] - CRES_BadUnicodeFormat width -> + T.CRES_BadUnicodeFormat width -> Encode.object [ ( "type", Encode.string "BadUnicodeFormat" ) , ( "width", Encode.int width ) ] - CRES_BadUnicodeCode width -> + T.CRES_BadUnicodeCode width -> Encode.object [ ( "type", Encode.string "BadUnicodeCode" ) , ( "width", Encode.int width ) ] - CRES_BadUnicodeLength width numDigits badCode -> + T.CRES_BadUnicodeLength width numDigits badCode -> Encode.object [ ( "type", Encode.string "BadUnicodeLength" ) , ( "width", Encode.int width ) @@ -10492,23 +10041,23 @@ escapeEncoder escape = ] -escapeDecoder : Decode.Decoder CRES_Escape +escapeDecoder : Decode.Decoder T.CRES_Escape escapeDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "EscapeUnknown" -> - Decode.succeed CRES_EscapeUnknown + Decode.succeed T.CRES_EscapeUnknown "BadUnicodeFormat" -> - Decode.map CRES_BadUnicodeFormat (Decode.field "width" Decode.int) + Decode.map T.CRES_BadUnicodeFormat (Decode.field "width" Decode.int) "BadUnicodeCode" -> - Decode.map CRES_BadUnicodeCode (Decode.field "width" Decode.int) + Decode.map T.CRES_BadUnicodeCode (Decode.field "width" Decode.int) "BadUnicodeLength" -> - Decode.map3 CRES_BadUnicodeLength + Decode.map3 T.CRES_BadUnicodeLength (Decode.field "width" Decode.int) (Decode.field "numDigits" Decode.int) (Decode.field "badCode" Decode.int) @@ -10518,10 +10067,10 @@ escapeDecoder = ) -defEncoder : CRES_Def -> Encode.Value +defEncoder : T.CRES_Def -> Encode.Value defEncoder def = case def of - CRES_DefSpace space row col -> + T.CRES_DefSpace space row col -> Encode.object [ ( "type", Encode.string "DefSpace" ) , ( "space", spaceEncoder space ) @@ -10529,7 +10078,7 @@ defEncoder def = , ( "col", Encode.int col ) ] - CRES_DefType tipe row col -> + T.CRES_DefType tipe row col -> Encode.object [ ( "type", Encode.string "DefType" ) , ( "tipe", typeEncoder tipe ) @@ -10537,14 +10086,14 @@ defEncoder def = , ( "col", Encode.int col ) ] - CRES_DefNameRepeat row col -> + T.CRES_DefNameRepeat row col -> Encode.object [ ( "type", Encode.string "DefNameRepeat" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DefNameMatch name row col -> + T.CRES_DefNameMatch name row col -> Encode.object [ ( "type", Encode.string "DefNameMatch" ) , ( "name", Encode.string name ) @@ -10552,7 +10101,7 @@ defEncoder def = , ( "col", Encode.int col ) ] - CRES_DefArg pattern row col -> + T.CRES_DefArg pattern row col -> Encode.object [ ( "type", Encode.string "DefArg" ) , ( "pattern", patternEncoder pattern ) @@ -10560,14 +10109,14 @@ defEncoder def = , ( "col", Encode.int col ) ] - CRES_DefEquals row col -> + T.CRES_DefEquals row col -> Encode.object [ ( "type", Encode.string "DefEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DefBody expr row col -> + T.CRES_DefBody expr row col -> Encode.object [ ( "type", Encode.string "DefBody" ) , ( "expr", exprEncoder expr ) @@ -10575,28 +10124,28 @@ defEncoder def = , ( "col", Encode.int col ) ] - CRES_DefIndentEquals row col -> + T.CRES_DefIndentEquals row col -> Encode.object [ ( "type", Encode.string "DefIndentEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DefIndentType row col -> + T.CRES_DefIndentType row col -> Encode.object [ ( "type", Encode.string "DefIndentType" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DefIndentBody row col -> + T.CRES_DefIndentBody row col -> Encode.object [ ( "type", Encode.string "DefIndentBody" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DefAlignment indent row col -> + T.CRES_DefAlignment indent row col -> Encode.object [ ( "type", Encode.string "DefAlignment" ) , ( "indent", Encode.int indent ) @@ -10605,69 +10154,69 @@ defEncoder def = ] -defDecoder : Decode.Decoder CRES_Def +defDecoder : Decode.Decoder T.CRES_Def defDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "DefSpace" -> - Decode.map3 CRES_DefSpace + Decode.map3 T.CRES_DefSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefType" -> - Decode.map3 CRES_DefType + Decode.map3 T.CRES_DefType (Decode.field "tipe" typeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefNameRepeat" -> - Decode.map2 CRES_DefNameRepeat + Decode.map2 T.CRES_DefNameRepeat (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefNameMatch" -> - Decode.map3 CRES_DefNameMatch + Decode.map3 T.CRES_DefNameMatch (Decode.field "name" Decode.string) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefArg" -> - Decode.map3 CRES_DefArg + Decode.map3 T.CRES_DefArg (Decode.field "pattern" patternDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefEquals" -> - Decode.map2 CRES_DefEquals + Decode.map2 T.CRES_DefEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefBody" -> - Decode.map3 CRES_DefBody + Decode.map3 T.CRES_DefBody (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefIndentEquals" -> - Decode.map2 CRES_DefIndentEquals + Decode.map2 T.CRES_DefIndentEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefIndentType" -> - Decode.map2 CRES_DefIndentType + Decode.map2 T.CRES_DefIndentType (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefIndentBody" -> - Decode.map2 CRES_DefIndentBody + Decode.map2 T.CRES_DefIndentBody (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DefAlignment" -> - Decode.map3 CRES_DefAlignment + Decode.map3 T.CRES_DefAlignment (Decode.field "indent" Decode.int) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -10677,10 +10226,10 @@ defDecoder = ) -destructEncoder : CRES_Destruct -> Encode.Value +destructEncoder : T.CRES_Destruct -> Encode.Value destructEncoder destruct = case destruct of - CRES_DestructSpace space row col -> + T.CRES_DestructSpace space row col -> Encode.object [ ( "type", Encode.string "DestructSpace" ) , ( "space", spaceEncoder space ) @@ -10688,7 +10237,7 @@ destructEncoder destruct = , ( "col", Encode.int col ) ] - CRES_DestructPattern pattern row col -> + T.CRES_DestructPattern pattern row col -> Encode.object [ ( "type", Encode.string "DestructPattern" ) , ( "pattern", patternEncoder pattern ) @@ -10696,14 +10245,14 @@ destructEncoder destruct = , ( "col", Encode.int col ) ] - CRES_DestructEquals row col -> + T.CRES_DestructEquals row col -> Encode.object [ ( "type", Encode.string "DestructEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DestructBody expr row col -> + T.CRES_DestructBody expr row col -> Encode.object [ ( "type", Encode.string "DestructBody" ) , ( "expr", exprEncoder expr ) @@ -10711,14 +10260,14 @@ destructEncoder destruct = , ( "col", Encode.int col ) ] - CRES_DestructIndentEquals row col -> + T.CRES_DestructIndentEquals row col -> Encode.object [ ( "type", Encode.string "DestructIndentEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_DestructIndentBody row col -> + T.CRES_DestructIndentBody row col -> Encode.object [ ( "type", Encode.string "DestructIndentBody" ) , ( "row", Encode.int row ) @@ -10726,42 +10275,42 @@ destructEncoder destruct = ] -destructDecoder : Decode.Decoder CRES_Destruct +destructDecoder : Decode.Decoder T.CRES_Destruct destructDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "DestructSpace" -> - Decode.map3 CRES_DestructSpace + Decode.map3 T.CRES_DestructSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DestructPattern" -> - Decode.map3 CRES_DestructPattern + Decode.map3 T.CRES_DestructPattern (Decode.field "pattern" patternDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DestructEquals" -> - Decode.map2 CRES_DestructEquals + Decode.map2 T.CRES_DestructEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DestructBody" -> - Decode.map3 CRES_DestructBody + Decode.map3 T.CRES_DestructBody (Decode.field "expr" exprDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DestructIndentEquals" -> - Decode.map2 CRES_DestructIndentEquals + Decode.map2 T.CRES_DestructIndentEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "DestructIndentBody" -> - Decode.map2 CRES_DestructIndentBody + Decode.map2 T.CRES_DestructIndentBody (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -10770,31 +10319,31 @@ destructDecoder = ) -pRecordEncoder : CRES_PRecord -> Encode.Value +pRecordEncoder : T.CRES_PRecord -> Encode.Value pRecordEncoder pRecord = case pRecord of - CRES_PRecordOpen row col -> + T.CRES_PRecordOpen row col -> Encode.object [ ( "type", Encode.string "PRecordOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PRecordEnd row col -> + T.CRES_PRecordEnd row col -> Encode.object [ ( "type", Encode.string "PRecordEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PRecordField row col -> + T.CRES_PRecordField row col -> Encode.object [ ( "type", Encode.string "PRecordField" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PRecordSpace space row col -> + T.CRES_PRecordSpace space row col -> Encode.object [ ( "type", Encode.string "PRecordSpace" ) , ( "space", spaceEncoder space ) @@ -10802,21 +10351,21 @@ pRecordEncoder pRecord = , ( "col", Encode.int col ) ] - CRES_PRecordIndentOpen row col -> + T.CRES_PRecordIndentOpen row col -> Encode.object [ ( "type", Encode.string "PRecordIndentOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PRecordIndentEnd row col -> + T.CRES_PRecordIndentEnd row col -> Encode.object [ ( "type", Encode.string "PRecordIndentEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PRecordIndentField row col -> + T.CRES_PRecordIndentField row col -> Encode.object [ ( "type", Encode.string "PRecordIndentField" ) , ( "row", Encode.int row ) @@ -10824,45 +10373,45 @@ pRecordEncoder pRecord = ] -pRecordDecoder : Decode.Decoder CRES_PRecord +pRecordDecoder : Decode.Decoder T.CRES_PRecord pRecordDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PRecordOpen" -> - Decode.map2 CRES_PRecordOpen + Decode.map2 T.CRES_PRecordOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PRecordEnd" -> - Decode.map2 CRES_PRecordEnd + Decode.map2 T.CRES_PRecordEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PRecordField" -> - Decode.map2 CRES_PRecordField + Decode.map2 T.CRES_PRecordField (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PRecordSpace" -> - Decode.map3 CRES_PRecordSpace + Decode.map3 T.CRES_PRecordSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PRecordIndentOpen" -> - Decode.map2 CRES_PRecordIndentOpen + Decode.map2 T.CRES_PRecordIndentOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PRecordIndentEnd" -> - Decode.map2 CRES_PRecordIndentEnd + Decode.map2 T.CRES_PRecordIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PRecordIndentField" -> - Decode.map2 CRES_PRecordIndentField + Decode.map2 T.CRES_PRecordIndentField (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -10871,24 +10420,24 @@ pRecordDecoder = ) -pTupleEncoder : CRES_PTuple -> Encode.Value +pTupleEncoder : T.CRES_PTuple -> Encode.Value pTupleEncoder pTuple = case pTuple of - CRES_PTupleOpen row col -> + T.CRES_PTupleOpen row col -> Encode.object [ ( "type", Encode.string "PTupleOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PTupleEnd row col -> + T.CRES_PTupleEnd row col -> Encode.object [ ( "type", Encode.string "PTupleEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PTupleExpr pattern row col -> + T.CRES_PTupleExpr pattern row col -> Encode.object [ ( "type", Encode.string "PTupleExpr" ) , ( "pattern", patternEncoder pattern ) @@ -10896,7 +10445,7 @@ pTupleEncoder pTuple = , ( "col", Encode.int col ) ] - CRES_PTupleSpace space row col -> + T.CRES_PTupleSpace space row col -> Encode.object [ ( "type", Encode.string "PTupleSpace" ) , ( "space", spaceEncoder space ) @@ -10904,21 +10453,21 @@ pTupleEncoder pTuple = , ( "col", Encode.int col ) ] - CRES_PTupleIndentEnd row col -> + T.CRES_PTupleIndentEnd row col -> Encode.object [ ( "type", Encode.string "PTupleIndentEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PTupleIndentExpr1 row col -> + T.CRES_PTupleIndentExpr1 row col -> Encode.object [ ( "type", Encode.string "PTupleIndentExpr1" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PTupleIndentExprN row col -> + T.CRES_PTupleIndentExprN row col -> Encode.object [ ( "type", Encode.string "PTupleIndentExprN" ) , ( "row", Encode.int row ) @@ -10926,46 +10475,46 @@ pTupleEncoder pTuple = ] -pTupleDecoder : Decode.Decoder CRES_PTuple +pTupleDecoder : Decode.Decoder T.CRES_PTuple pTupleDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PTupleOpen" -> - Decode.map2 CRES_PTupleOpen + Decode.map2 T.CRES_PTupleOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PTupleEnd" -> - Decode.map2 CRES_PTupleEnd + Decode.map2 T.CRES_PTupleEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PTupleExpr" -> - Decode.map3 CRES_PTupleExpr + Decode.map3 T.CRES_PTupleExpr (Decode.field "pattern" patternDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PTupleSpace" -> - Decode.map3 CRES_PTupleSpace + Decode.map3 T.CRES_PTupleSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PTupleIndentEnd" -> - Decode.map2 CRES_PTupleIndentEnd + Decode.map2 T.CRES_PTupleIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PTupleIndentExpr1" -> - Decode.map2 CRES_PTupleIndentExpr1 + Decode.map2 T.CRES_PTupleIndentExpr1 (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PTupleIndentExprN" -> - Decode.map2 CRES_PTupleIndentExprN + Decode.map2 T.CRES_PTupleIndentExprN (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -10974,24 +10523,24 @@ pTupleDecoder = ) -pListEncoder : CRES_PList -> Encode.Value +pListEncoder : T.CRES_PList -> Encode.Value pListEncoder pList = case pList of - CRES_PListOpen row col -> + T.CRES_PListOpen row col -> Encode.object [ ( "type", Encode.string "PListOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PListEnd row col -> + T.CRES_PListEnd row col -> Encode.object [ ( "type", Encode.string "PListEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PListExpr pattern row col -> + T.CRES_PListExpr pattern row col -> Encode.object [ ( "type", Encode.string "PListExpr" ) , ( "pattern", patternEncoder pattern ) @@ -10999,7 +10548,7 @@ pListEncoder pList = , ( "col", Encode.int col ) ] - CRES_PListSpace space row col -> + T.CRES_PListSpace space row col -> Encode.object [ ( "type", Encode.string "PListSpace" ) , ( "space", spaceEncoder space ) @@ -11007,21 +10556,21 @@ pListEncoder pList = , ( "col", Encode.int col ) ] - CRES_PListIndentOpen row col -> + T.CRES_PListIndentOpen row col -> Encode.object [ ( "type", Encode.string "PListIndentOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PListIndentEnd row col -> + T.CRES_PListIndentEnd row col -> Encode.object [ ( "type", Encode.string "PListIndentEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_PListIndentExpr row col -> + T.CRES_PListIndentExpr row col -> Encode.object [ ( "type", Encode.string "PListIndentExpr" ) , ( "row", Encode.int row ) @@ -11029,46 +10578,46 @@ pListEncoder pList = ] -pListDecoder : Decode.Decoder CRES_PList +pListDecoder : Decode.Decoder T.CRES_PList pListDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PListOpen" -> - Decode.map2 CRES_PListOpen + Decode.map2 T.CRES_PListOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PListEnd" -> - Decode.map2 CRES_PListEnd + Decode.map2 T.CRES_PListEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PListExpr" -> - Decode.map3 CRES_PListExpr + Decode.map3 T.CRES_PListExpr (Decode.field "pattern" patternDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PListSpace" -> - Decode.map3 CRES_PListSpace + Decode.map3 T.CRES_PListSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PListIndentOpen" -> - Decode.map2 CRES_PListIndentOpen + Decode.map2 T.CRES_PListIndentOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PListIndentEnd" -> - Decode.map2 CRES_PListIndentEnd + Decode.map2 T.CRES_PListIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "PListIndentExpr" -> - Decode.map2 CRES_PListIndentExpr + Decode.map2 T.CRES_PListIndentExpr (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -11077,38 +10626,38 @@ pListDecoder = ) -tRecordEncoder : CRES_TRecord -> Encode.Value +tRecordEncoder : T.CRES_TRecord -> Encode.Value tRecordEncoder tRecord = case tRecord of - CRES_TRecordOpen row col -> + T.CRES_TRecordOpen row col -> Encode.object [ ( "type", Encode.string "TRecordOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordEnd row col -> + T.CRES_TRecordEnd row col -> Encode.object [ ( "type", Encode.string "TRecordEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordField row col -> + T.CRES_TRecordField row col -> Encode.object [ ( "type", Encode.string "TRecordField" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordColon row col -> + T.CRES_TRecordColon row col -> Encode.object [ ( "type", Encode.string "TRecordColon" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordType tipe row col -> + T.CRES_TRecordType tipe row col -> Encode.object [ ( "type", Encode.string "TRecordType" ) , ( "tipe", typeEncoder tipe ) @@ -11116,7 +10665,7 @@ tRecordEncoder tRecord = , ( "col", Encode.int col ) ] - CRES_TRecordSpace space row col -> + T.CRES_TRecordSpace space row col -> Encode.object [ ( "type", Encode.string "TRecordSpace" ) , ( "space", spaceEncoder space ) @@ -11124,35 +10673,35 @@ tRecordEncoder tRecord = , ( "col", Encode.int col ) ] - CRES_TRecordIndentOpen row col -> + T.CRES_TRecordIndentOpen row col -> Encode.object [ ( "type", Encode.string "TRecordIndentOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordIndentField row col -> + T.CRES_TRecordIndentField row col -> Encode.object [ ( "type", Encode.string "TRecordIndentField" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordIndentColon row col -> + T.CRES_TRecordIndentColon row col -> Encode.object [ ( "type", Encode.string "TRecordIndentColon" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordIndentType row col -> + T.CRES_TRecordIndentType row col -> Encode.object [ ( "type", Encode.string "TRecordIndentType" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TRecordIndentEnd row col -> + T.CRES_TRecordIndentEnd row col -> Encode.object [ ( "type", Encode.string "TRecordIndentEnd" ) , ( "row", Encode.int row ) @@ -11160,66 +10709,66 @@ tRecordEncoder tRecord = ] -tRecordDecoder : Decode.Decoder CRES_TRecord +tRecordDecoder : Decode.Decoder T.CRES_TRecord tRecordDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "TRecordOpen" -> - Decode.map2 CRES_TRecordOpen + Decode.map2 T.CRES_TRecordOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordEnd" -> - Decode.map2 CRES_TRecordEnd + Decode.map2 T.CRES_TRecordEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordField" -> - Decode.map2 CRES_TRecordField + Decode.map2 T.CRES_TRecordField (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordColon" -> - Decode.map2 CRES_TRecordColon + Decode.map2 T.CRES_TRecordColon (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordType" -> - Decode.map3 CRES_TRecordType + Decode.map3 T.CRES_TRecordType (Decode.field "tipe" typeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordSpace" -> - Decode.map3 CRES_TRecordSpace + Decode.map3 T.CRES_TRecordSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordIndentOpen" -> - Decode.map2 CRES_TRecordIndentOpen + Decode.map2 T.CRES_TRecordIndentOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordIndentField" -> - Decode.map2 CRES_TRecordIndentField + Decode.map2 T.CRES_TRecordIndentField (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordIndentColon" -> - Decode.map2 CRES_TRecordIndentColon + Decode.map2 T.CRES_TRecordIndentColon (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordIndentType" -> - Decode.map2 CRES_TRecordIndentType + Decode.map2 T.CRES_TRecordIndentType (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TRecordIndentEnd" -> - Decode.map2 CRES_TRecordIndentEnd + Decode.map2 T.CRES_TRecordIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -11228,24 +10777,24 @@ tRecordDecoder = ) -tTupleEncoder : CRES_TTuple -> Encode.Value +tTupleEncoder : T.CRES_TTuple -> Encode.Value tTupleEncoder tTuple = case tTuple of - CRES_TTupleOpen row col -> + T.CRES_TTupleOpen row col -> Encode.object [ ( "type", Encode.string "TTupleOpen" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TTupleEnd row col -> + T.CRES_TTupleEnd row col -> Encode.object [ ( "type", Encode.string "TTupleEnd" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TTupleType tipe row col -> + T.CRES_TTupleType tipe row col -> Encode.object [ ( "type", Encode.string "TTupleType" ) , ( "tipe", typeEncoder tipe ) @@ -11253,7 +10802,7 @@ tTupleEncoder tTuple = , ( "col", Encode.int col ) ] - CRES_TTupleSpace space row col -> + T.CRES_TTupleSpace space row col -> Encode.object [ ( "type", Encode.string "TTupleSpace" ) , ( "space", spaceEncoder space ) @@ -11261,21 +10810,21 @@ tTupleEncoder tTuple = , ( "col", Encode.int col ) ] - CRES_TTupleIndentType1 row col -> + T.CRES_TTupleIndentType1 row col -> Encode.object [ ( "type", Encode.string "TTupleIndentType1" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TTupleIndentTypeN row col -> + T.CRES_TTupleIndentTypeN row col -> Encode.object [ ( "type", Encode.string "TTupleIndentTypeN" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_TTupleIndentEnd row col -> + T.CRES_TTupleIndentEnd row col -> Encode.object [ ( "type", Encode.string "TTupleIndentEnd" ) , ( "row", Encode.int row ) @@ -11283,46 +10832,46 @@ tTupleEncoder tTuple = ] -tTupleDecoder : Decode.Decoder CRES_TTuple +tTupleDecoder : Decode.Decoder T.CRES_TTuple tTupleDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "TTupleOpen" -> - Decode.map2 CRES_TTupleOpen + Decode.map2 T.CRES_TTupleOpen (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TTupleEnd" -> - Decode.map2 CRES_TTupleEnd + Decode.map2 T.CRES_TTupleEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TTupleType" -> - Decode.map3 CRES_TTupleType + Decode.map3 T.CRES_TTupleType (Decode.field "tipe" typeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TTupleSpace" -> - Decode.map3 CRES_TTupleSpace + Decode.map3 T.CRES_TTupleSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TTupleIndentType1" -> - Decode.map2 CRES_TTupleIndentType1 + Decode.map2 T.CRES_TTupleIndentType1 (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TTupleIndentTypeN" -> - Decode.map2 CRES_TTupleIndentTypeN + Decode.map2 T.CRES_TTupleIndentTypeN (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "TTupleIndentEnd" -> - Decode.map2 CRES_TTupleIndentEnd + Decode.map2 T.CRES_TTupleIndentEnd (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -11331,10 +10880,10 @@ tTupleDecoder = ) -customTypeEncoder : CRES_CustomType -> Encode.Value +customTypeEncoder : T.CRES_CustomType -> Encode.Value customTypeEncoder customType = case customType of - CRES_CT_Space space row col -> + T.CRES_CT_Space space row col -> Encode.object [ ( "type", Encode.string "CT_Space" ) , ( "space", spaceEncoder space ) @@ -11342,35 +10891,35 @@ customTypeEncoder customType = , ( "col", Encode.int col ) ] - CRES_CT_Name row col -> + T.CRES_CT_Name row col -> Encode.object [ ( "type", Encode.string "CT_Name" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CT_Equals row col -> + T.CRES_CT_Equals row col -> Encode.object [ ( "type", Encode.string "CT_Equals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CT_Bar row col -> + T.CRES_CT_Bar row col -> Encode.object [ ( "type", Encode.string "CT_Bar" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CT_Variant row col -> + T.CRES_CT_Variant row col -> Encode.object [ ( "type", Encode.string "CT_Variant" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CT_VariantArg tipe row col -> + T.CRES_CT_VariantArg tipe row col -> Encode.object [ ( "type", Encode.string "CT_VariantArg" ) , ( "tipe", typeEncoder tipe ) @@ -11378,28 +10927,28 @@ customTypeEncoder customType = , ( "col", Encode.int col ) ] - CRES_CT_IndentEquals row col -> + T.CRES_CT_IndentEquals row col -> Encode.object [ ( "type", Encode.string "CT_IndentEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CT_IndentBar row col -> + T.CRES_CT_IndentBar row col -> Encode.object [ ( "type", Encode.string "CT_IndentBar" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CT_IndentAfterBar row col -> + T.CRES_CT_IndentAfterBar row col -> Encode.object [ ( "type", Encode.string "CT_IndentAfterBar" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_CT_IndentAfterEquals row col -> + T.CRES_CT_IndentAfterEquals row col -> Encode.object [ ( "type", Encode.string "CT_IndentAfterEquals" ) , ( "row", Encode.int row ) @@ -11407,61 +10956,61 @@ customTypeEncoder customType = ] -customTypeDecoder : Decode.Decoder CRES_CustomType +customTypeDecoder : Decode.Decoder T.CRES_CustomType customTypeDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "CT_Space" -> - Decode.map3 CRES_CT_Space + Decode.map3 T.CRES_CT_Space (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_Name" -> - Decode.map2 CRES_CT_Name + Decode.map2 T.CRES_CT_Name (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_Equals" -> - Decode.map2 CRES_CT_Equals + Decode.map2 T.CRES_CT_Equals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_Bar" -> - Decode.map2 CRES_CT_Bar + Decode.map2 T.CRES_CT_Bar (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_Variant" -> - Decode.map2 CRES_CT_Variant + Decode.map2 T.CRES_CT_Variant (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_VariantArg" -> - Decode.map3 CRES_CT_VariantArg + Decode.map3 T.CRES_CT_VariantArg (Decode.field "tipe" typeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_IndentEquals" -> - Decode.map2 CRES_CT_IndentEquals + Decode.map2 T.CRES_CT_IndentEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_IndentBar" -> - Decode.map2 CRES_CT_IndentBar + Decode.map2 T.CRES_CT_IndentBar (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_IndentAfterBar" -> - Decode.map2 CRES_CT_IndentAfterBar + Decode.map2 T.CRES_CT_IndentAfterBar (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "CT_IndentAfterEquals" -> - Decode.map2 CRES_CT_IndentAfterEquals + Decode.map2 T.CRES_CT_IndentAfterEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) @@ -11470,10 +11019,10 @@ customTypeDecoder = ) -typeAliasEncoder : CRES_TypeAlias -> Encode.Value +typeAliasEncoder : T.CRES_TypeAlias -> Encode.Value typeAliasEncoder typeAlias = case typeAlias of - CRES_AliasSpace space row col -> + T.CRES_AliasSpace space row col -> Encode.object [ ( "type", Encode.string "AliasSpace" ) , ( "space", spaceEncoder space ) @@ -11481,21 +11030,21 @@ typeAliasEncoder typeAlias = , ( "col", Encode.int col ) ] - CRES_AliasName row col -> + T.CRES_AliasName row col -> Encode.object [ ( "type", Encode.string "AliasName" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_AliasEquals row col -> + T.CRES_AliasEquals row col -> Encode.object [ ( "type", Encode.string "AliasEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_AliasBody tipe row col -> + T.CRES_AliasBody tipe row col -> Encode.object [ ( "type", Encode.string "AliasBody" ) , ( "tipe", typeEncoder tipe ) @@ -11503,14 +11052,14 @@ typeAliasEncoder typeAlias = , ( "col", Encode.int col ) ] - CRES_AliasIndentEquals row col -> + T.CRES_AliasIndentEquals row col -> Encode.object [ ( "type", Encode.string "AliasIndentEquals" ) , ( "row", Encode.int row ) , ( "col", Encode.int col ) ] - CRES_AliasIndentBody row col -> + T.CRES_AliasIndentBody row col -> Encode.object [ ( "type", Encode.string "AliasIndentBody" ) , ( "row", Encode.int row ) @@ -11518,41 +11067,41 @@ typeAliasEncoder typeAlias = ] -typeAliasDecoder : Decode.Decoder CRES_TypeAlias +typeAliasDecoder : Decode.Decoder T.CRES_TypeAlias typeAliasDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "AliasSpace" -> - Decode.map3 CRES_AliasSpace + Decode.map3 T.CRES_AliasSpace (Decode.field "space" spaceDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "AliasName" -> - Decode.map2 CRES_AliasName + Decode.map2 T.CRES_AliasName (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "AliasEquals" -> - Decode.map2 CRES_AliasEquals + Decode.map2 T.CRES_AliasEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "AliasBody" -> - Decode.map3 CRES_AliasBody + Decode.map3 T.CRES_AliasBody (Decode.field "tipe" typeDecoder) (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "AliasIndentEquals" -> - Decode.map2 CRES_AliasIndentEquals + Decode.map2 T.CRES_AliasIndentEquals (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) "AliasIndentBody" -> - Decode.map2 CRES_AliasIndentBody + Decode.map2 T.CRES_AliasIndentBody (Decode.field "row" Decode.int) (Decode.field "col" Decode.int) diff --git a/src/Compiler/Reporting/Error/Type.elm b/src/Compiler/Reporting/Error/Type.elm index 243652506..b000ab341 100644 --- a/src/Compiler/Reporting/Error/Type.elm +++ b/src/Compiler/Reporting/Error/Type.elm @@ -1,14 +1,5 @@ module Compiler.Reporting.Error.Type exposing - ( CRET_Category(..) - , CRET_Context(..) - , CRET_Error(..) - , CRET_Expected(..) - , CRET_MaybeName(..) - , CRET_PCategory(..) - , CRET_PContext(..) - , CRET_PExpected(..) - , CRET_SubContext(..) - , errorDecoder + ( errorDecoder , errorEncoder , ptypeReplace , toReport @@ -23,156 +14,56 @@ import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type as RT -import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report as Report import Compiler.Reporting.Suggest as Suggest import Compiler.Type.Error as T -import Data.Map as Dict exposing (Dict) +import Data.Map as Dict import Json.Decode as Decode import Json.Encode as Encode import Types as T --- ERRORS - - -type CRET_Error - = CRET_BadExpr T.CRA_Region CRET_Category T.Type (CRET_Expected T.Type) - | CRET_BadPattern T.CRA_Region CRET_PCategory T.Type (CRET_PExpected T.Type) - | CRET_InfiniteType T.CRA_Region T.CDN_Name T.Type - - - --- EXPRESSION EXPECTATIONS - - -type CRET_Expected tipe - = NoExpectation tipe - | FromContext T.CRA_Region CRET_Context tipe - | FromAnnotation T.CDN_Name Int CRET_SubContext tipe - - -type CRET_Context - = CRET_ListEntry T.CDI_ZeroBased - | CRET_Negate - | CRET_OpLeft T.CDN_Name - | CRET_OpRight T.CDN_Name - | CRET_IfCondition - | CRET_IfBranch T.CDI_ZeroBased - | CRET_CaseBranch T.CDI_ZeroBased - | CRET_CallArity CRET_MaybeName Int - | CRET_CallArg CRET_MaybeName T.CDI_ZeroBased - | CRET_RecordAccess T.CRA_Region (Maybe T.CDN_Name) T.CRA_Region T.CDN_Name - | CRET_RecordUpdateKeys T.CDN_Name (Dict String T.CDN_Name Can.FieldUpdate) - | CRET_RecordUpdateValue T.CDN_Name - | CRET_Destructure - - -type CRET_SubContext - = CRET_TypedIfBranch T.CDI_ZeroBased - | CRET_TypedCaseBranch T.CDI_ZeroBased - | CRET_TypedBody - - -type CRET_MaybeName - = CRET_FuncName T.CDN_Name - | CRET_CtorName T.CDN_Name - | CRET_OpName T.CDN_Name - | CRET_NoName - - -type CRET_Category - = CRET_List - | CRET_Number - | CRET_Float - | CRET_String - | CRET_Char - | CRET_If - | CRET_Case - | CRET_CallResult CRET_MaybeName - | CRET_Lambda - | CRET_Accessor T.CDN_Name - | CRET_Access T.CDN_Name - | CRET_Record - | CRET_Tuple - | CRET_Unit - | CRET_Shader - | CRET_Effects - | CRET_Local T.CDN_Name - | CRET_Foreign T.CDN_Name - - - --- PATTERN EXPECTATIONS - - -type CRET_PExpected tipe - = CRET_PNoExpectation tipe - | CRET_PFromContext T.CRA_Region CRET_PContext tipe - - -type CRET_PContext - = CRET_PTypedArg T.CDN_Name T.CDI_ZeroBased - | CRET_PCaseMatch T.CDI_ZeroBased - | CRET_PCtorArg T.CDN_Name T.CDI_ZeroBased - | CRET_PListEntry T.CDI_ZeroBased - | CRET_PTail - - -type CRET_PCategory - = CRET_PRecord - | CRET_PUnit - | CRET_PTuple - | CRET_PList - | CRET_PCtor T.CDN_Name - | CRET_PInt - | CRET_PStr - | CRET_PChr - | CRET_PBool - - - -- HELPERS -typeReplace : CRET_Expected a -> b -> CRET_Expected b +typeReplace : T.CRET_Expected a -> b -> T.CRET_Expected b typeReplace expectation tipe = case expectation of - NoExpectation _ -> - NoExpectation tipe + T.CRET_NoExpectation _ -> + T.CRET_NoExpectation tipe - FromContext region context _ -> - FromContext region context tipe + T.CRET_FromContext region context _ -> + T.CRET_FromContext region context tipe - FromAnnotation name arity context _ -> - FromAnnotation name arity context tipe + T.CRET_FromAnnotation name arity context _ -> + T.CRET_FromAnnotation name arity context tipe -ptypeReplace : CRET_PExpected a -> b -> CRET_PExpected b +ptypeReplace : T.CRET_PExpected a -> b -> T.CRET_PExpected b ptypeReplace expectation tipe = case expectation of - CRET_PNoExpectation _ -> - CRET_PNoExpectation tipe + T.CRET_PNoExpectation _ -> + T.CRET_PNoExpectation tipe - CRET_PFromContext region context _ -> - CRET_PFromContext region context tipe + T.CRET_PFromContext region context _ -> + T.CRET_PFromContext region context tipe -- TO REPORT -toReport : Code.Source -> L.CRRTL_Localizer -> CRET_Error -> Report.Report +toReport : Code.Source -> T.CRRTL_Localizer -> T.CRET_Error -> Report.Report toReport source localizer err = case err of - CRET_BadExpr region category actualType expected -> + T.CRET_BadExpr region category actualType expected -> toExprReport source localizer region category actualType expected - CRET_BadPattern region category tipe expected -> + T.CRET_BadPattern region category tipe expected -> toPatternReport source localizer region category tipe expected - CRET_InfiniteType region name overallType -> + T.CRET_InfiniteType region name overallType -> toInfiniteReport source localizer region name overallType @@ -180,11 +71,11 @@ toReport source localizer err = -- TO PATTERN REPORT -toPatternReport : Code.Source -> L.CRRTL_Localizer -> T.CRA_Region -> CRET_PCategory -> T.Type -> CRET_PExpected T.Type -> Report.Report +toPatternReport : Code.Source -> T.CRRTL_Localizer -> T.CRA_Region -> T.CRET_PCategory -> T.CTE_Type -> T.CRET_PExpected T.CTE_Type -> Report.Report toPatternReport source localizer patternRegion category tipe expected = Report.Report "TYPE MISMATCH" patternRegion [] <| case expected of - CRET_PNoExpectation expectedType -> + T.CRET_PNoExpectation expectedType -> Code.toSnippet source patternRegion Nothing <| ( D.fromChars "This pattern is being used in an unexpected way:" , patternTypeComparison localizer @@ -195,10 +86,10 @@ toPatternReport source localizer patternRegion category tipe expected = [] ) - CRET_PFromContext region context expectedType -> + T.CRET_PFromContext region context expectedType -> Code.toSnippet source region (Just patternRegion) <| case context of - CRET_PTypedArg name index -> + T.CRET_PTypedArg name index -> ( D.reflow <| "The " ++ D.ordinal index @@ -218,7 +109,7 @@ toPatternReport source localizer patternRegion category tipe expected = [] ) - CRET_PCaseMatch index -> + T.CRET_PCaseMatch index -> if index == Index.first then ( D.reflow <| "The 1st pattern in this `case` causing a mismatch:" @@ -249,7 +140,7 @@ toPatternReport source localizer patternRegion category tipe expected = ] ) - CRET_PCtorArg name index -> + T.CRET_PCtorArg name index -> ( D.reflow <| "The " ++ D.ordinal index @@ -269,7 +160,7 @@ toPatternReport source localizer patternRegion category tipe expected = [] ) - CRET_PListEntry index -> + T.CRET_PListEntry index -> ( D.reflow <| "The " ++ D.ordinal index @@ -286,7 +177,7 @@ toPatternReport source localizer patternRegion category tipe expected = ] ) - CRET_PTail -> + T.CRET_PTail -> ( D.reflow <| "The pattern after (::) is causing issues." , patternTypeComparison localizer @@ -302,7 +193,7 @@ toPatternReport source localizer patternRegion category tipe expected = -- PATTERN HELPERS -patternTypeComparison : L.CRRTL_Localizer -> T.Type -> T.Type -> String -> String -> List D.Doc -> D.Doc +patternTypeComparison : T.CRRTL_Localizer -> T.CTE_Type -> T.CTE_Type -> String -> String -> List D.Doc -> D.Doc patternTypeComparison localizer actual expected iAmSeeing insteadOf contextHints = let ( actualDoc, expectedDoc, problems ) = @@ -318,35 +209,35 @@ patternTypeComparison localizer actual expected iAmSeeing insteadOf contextHints ++ contextHints -addPatternCategory : String -> CRET_PCategory -> String +addPatternCategory : String -> T.CRET_PCategory -> String addPatternCategory iAmTryingToMatch category = iAmTryingToMatch ++ (case category of - CRET_PRecord -> + T.CRET_PRecord -> " record values of type:" - CRET_PUnit -> + T.CRET_PUnit -> " unit values:" - CRET_PTuple -> + T.CRET_PTuple -> " tuples of type:" - CRET_PList -> + T.CRET_PList -> " lists of type:" - CRET_PCtor name -> + T.CRET_PCtor name -> " `" ++ name ++ "` values of type:" - CRET_PInt -> + T.CRET_PInt -> " integers:" - CRET_PStr -> + T.CRET_PStr -> " strings:" - CRET_PChr -> + T.CRET_PChr -> " characters:" - CRET_PBool -> + T.CRET_PBool -> " booleans:" ) @@ -355,7 +246,7 @@ addPatternCategory iAmTryingToMatch category = -- EXPR HELPERS -typeComparison : L.CRRTL_Localizer -> T.Type -> T.Type -> String -> String -> List D.Doc -> D.Doc +typeComparison : T.CRRTL_Localizer -> T.CTE_Type -> T.CTE_Type -> String -> String -> List D.Doc -> D.Doc typeComparison localizer actual expected iAmSeeing insteadOf contextHints = let ( actualDoc, expectedDoc, problems ) = @@ -371,7 +262,7 @@ typeComparison localizer actual expected iAmSeeing insteadOf contextHints = ++ problemsToHint problems -loneType : L.CRRTL_Localizer -> T.Type -> T.Type -> D.Doc -> List D.Doc -> D.Doc +loneType : T.CRRTL_Localizer -> T.CTE_Type -> T.CTE_Type -> D.Doc -> List D.Doc -> D.Doc loneType localizer actual expected iAmSeeing furtherDetails = let ( actualDoc, _, problems ) = @@ -385,72 +276,72 @@ loneType localizer actual expected iAmSeeing furtherDetails = ++ problemsToHint problems -addCategory : String -> CRET_Category -> String +addCategory : String -> T.CRET_Category -> String addCategory thisIs category = case category of - CRET_Local name -> + T.CRET_Local name -> "This `" ++ name ++ "` value is a:" - CRET_Foreign name -> + T.CRET_Foreign name -> "This `" ++ name ++ "` value is a:" - CRET_Access field -> + T.CRET_Access field -> "The value at ." ++ field ++ " is a:" - CRET_Accessor field -> + T.CRET_Accessor field -> "This ." ++ field ++ " field access function has type:" - CRET_If -> + T.CRET_If -> "This `if` expression produces:" - CRET_Case -> + T.CRET_Case -> "This `case` expression produces:" - CRET_List -> + T.CRET_List -> thisIs ++ " a list of type:" - CRET_Number -> + T.CRET_Number -> thisIs ++ " a number of type:" - CRET_Float -> + T.CRET_Float -> thisIs ++ " a float of type:" - CRET_String -> + T.CRET_String -> thisIs ++ " a string of type:" - CRET_Char -> + T.CRET_Char -> thisIs ++ " a character of type:" - CRET_Lambda -> + T.CRET_Lambda -> thisIs ++ " an anonymous function of type:" - CRET_Record -> + T.CRET_Record -> thisIs ++ " a record of type:" - CRET_Tuple -> + T.CRET_Tuple -> thisIs ++ " a tuple of type:" - CRET_Unit -> + T.CRET_Unit -> thisIs ++ " a unit value:" - CRET_Shader -> + T.CRET_Shader -> thisIs ++ " a GLSL shader of type:" - CRET_Effects -> + T.CRET_Effects -> thisIs ++ " a thing for CORE LIBRARIES ONLY." - CRET_CallResult maybeName -> + T.CRET_CallResult maybeName -> case maybeName of - CRET_NoName -> + T.CRET_NoName -> thisIs ++ ":" - CRET_FuncName name -> + T.CRET_FuncName name -> "This `" ++ name ++ "` call produces:" - CRET_CtorName name -> + T.CRET_CtorName name -> "This `" ++ name ++ "` call produces:" - CRET_OpName _ -> + T.CRET_OpName _ -> thisIs ++ ":" @@ -601,116 +492,116 @@ problemToHint problem = T.BadFlexSuper direction super tipe -> case tipe of - T.Lambda _ _ _ -> + T.CTE_Lambda _ _ _ -> badFlexSuper direction super tipe - T.Infinite -> + T.CTE_Infinite -> [] - T.Error -> + T.CTE_Error -> [] - T.FlexVar _ -> + T.CTE_FlexVar _ -> [] - T.FlexSuper s _ -> + T.CTE_FlexSuper s _ -> badFlexFlexSuper super s - T.RigidVar y -> + T.CTE_RigidVar y -> badRigidVar y (toASuperThing super) - T.RigidSuper s _ -> + T.CTE_RigidSuper s _ -> badRigidSuper s (toASuperThing super) - T.Type _ _ _ -> + T.CTE_Type _ _ _ -> badFlexSuper direction super tipe - T.Record _ _ -> + T.CTE_Record _ _ -> badFlexSuper direction super tipe - T.Unit -> + T.CTE_Unit -> badFlexSuper direction super tipe - T.Tuple _ _ _ -> + T.CTE_Tuple _ _ _ -> badFlexSuper direction super tipe - T.Alias _ _ _ _ -> + T.CTE_Alias _ _ _ _ -> badFlexSuper direction super tipe T.BadRigidVar x tipe -> case tipe of - T.Lambda _ _ _ -> + T.CTE_Lambda _ _ _ -> badRigidVar x "a function" - T.Infinite -> + T.CTE_Infinite -> [] - T.Error -> + T.CTE_Error -> [] - T.FlexVar _ -> + T.CTE_FlexVar _ -> [] - T.FlexSuper s _ -> + T.CTE_FlexSuper s _ -> badRigidVar x (toASuperThing s) - T.RigidVar y -> + T.CTE_RigidVar y -> badDoubleRigid x y - T.RigidSuper _ y -> + T.CTE_RigidSuper _ y -> badDoubleRigid x y - T.Type _ n _ -> + T.CTE_Type _ n _ -> badRigidVar x ("a `" ++ n ++ "` value") - T.Record _ _ -> + T.CTE_Record _ _ -> badRigidVar x "a record" - T.Unit -> + T.CTE_Unit -> badRigidVar x "a unit value" - T.Tuple _ _ _ -> + T.CTE_Tuple _ _ _ -> badRigidVar x "a tuple" - T.Alias _ n _ _ -> + T.CTE_Alias _ n _ _ -> badRigidVar x ("a `" ++ n ++ "` value") T.BadRigidSuper super x tipe -> case tipe of - T.Lambda _ _ _ -> + T.CTE_Lambda _ _ _ -> badRigidSuper super "a function" - T.Infinite -> + T.CTE_Infinite -> [] - T.Error -> + T.CTE_Error -> [] - T.FlexVar _ -> + T.CTE_FlexVar _ -> [] - T.FlexSuper s _ -> + T.CTE_FlexSuper s _ -> badRigidSuper super (toASuperThing s) - T.RigidVar y -> + T.CTE_RigidVar y -> badDoubleRigid x y - T.RigidSuper _ y -> + T.CTE_RigidSuper _ y -> badDoubleRigid x y - T.Type _ n _ -> + T.CTE_Type _ n _ -> badRigidSuper super ("a `" ++ n ++ "` value") - T.Record _ _ -> + T.CTE_Record _ _ -> badRigidSuper super "a record" - T.Unit -> + T.CTE_Unit -> badRigidSuper super "a unit value" - T.Tuple _ _ _ -> + T.CTE_Tuple _ _ _ -> badRigidSuper super "a tuple" - T.Alias _ n _ _ -> + T.CTE_Alias _ n _ _ -> badRigidSuper super ("a `" ++ n ++ "` value") T.FieldsMissing fields -> @@ -792,19 +683,19 @@ badDoubleRigid x y = ] -toASuperThing : T.Super -> String +toASuperThing : T.CTE_Super -> String toASuperThing super = case super of - T.Number -> + T.CTE_Number -> "a `number` value" - T.Comparable -> + T.CTE_Comparable -> "a `comparable` value" - T.CompAppend -> + T.CTE_CompAppend -> "a `compappend` value" - T.Appendable -> + T.CTE_Appendable -> "an `appendable` value" @@ -812,19 +703,19 @@ toASuperThing super = -- BAD SUPER HINTS -badFlexSuper : T.Direction -> T.Super -> T.Type -> List D.Doc +badFlexSuper : T.Direction -> T.CTE_Super -> T.CTE_Type -> List D.Doc badFlexSuper direction super tipe = case super of - T.Comparable -> + T.CTE_Comparable -> case tipe of - T.Record _ _ -> + T.CTE_Record _ _ -> [ D.link "Hint" "I do not know how to compare records. I can only compare ints, floats, chars, strings, lists of comparable values, and tuples of comparable values. Check out" "comparing-records" "for ideas on how to proceed." ] - T.Type _ name _ -> + T.CTE_Type _ name _ -> [ D.toSimpleHint <| "I do not know how to compare `" ++ name @@ -840,17 +731,17 @@ badFlexSuper direction super tipe = "I only know how to compare ints, floats, chars, strings, lists of comparable values, and tuples of comparable values." ] - T.Appendable -> + T.CTE_Appendable -> [ D.toSimpleHint "I only know how to append strings and lists." ] - T.CompAppend -> + T.CTE_CompAppend -> [ D.toSimpleHint "Only strings and lists are both comparable and appendable." ] - T.Number -> + T.CTE_Number -> case tipe of - T.Type home name _ -> + T.CTE_Type home name _ -> if T.isString home name then case direction of T.Have -> @@ -903,21 +794,21 @@ badFlexSuperNumber = ] -badRigidSuper : T.Super -> String -> List D.Doc +badRigidSuper : T.CTE_Super -> String -> List D.Doc badRigidSuper super aThing = let ( superType, manyThings ) = case super of - T.Number -> + T.CTE_Number -> ( "number", "ints AND floats" ) - T.Comparable -> + T.CTE_Comparable -> ( "comparable", "ints, floats, chars, strings, lists, and tuples" ) - T.Appendable -> + T.CTE_Appendable -> ( "appendable", "strings AND lists" ) - T.CompAppend -> + T.CTE_CompAppend -> ( "compappend", "strings AND lists" ) in [ D.toSimpleHint <| @@ -932,22 +823,22 @@ badRigidSuper super aThing = ] -badFlexFlexSuper : T.Super -> T.Super -> List D.Doc +badFlexFlexSuper : T.CTE_Super -> T.CTE_Super -> List D.Doc badFlexFlexSuper s1 s2 = let - likeThis : T.Super -> String + likeThis : T.CTE_Super -> String likeThis super = case super of - T.Number -> + T.CTE_Number -> "a number" - T.Comparable -> + T.CTE_Comparable -> "comparable" - T.CompAppend -> + T.CTE_CompAppend -> "a compappend" - T.Appendable -> + T.CTE_Appendable -> "appendable" in [ D.toSimpleHint <| @@ -963,10 +854,10 @@ badFlexFlexSuper s1 s2 = -- TO EXPR REPORT -toExprReport : Code.Source -> L.CRRTL_Localizer -> T.CRA_Region -> CRET_Category -> T.Type -> CRET_Expected T.Type -> Report.Report +toExprReport : Code.Source -> T.CRRTL_Localizer -> T.CRA_Region -> T.CRET_Category -> T.CTE_Type -> T.CRET_Expected T.CTE_Type -> Report.Report toExprReport source localizer exprRegion category tipe expected = case expected of - NoExpectation expectedType -> + T.CRET_NoExpectation expectedType -> Report.Report "TYPE MISMATCH" exprRegion [] <| Code.toSnippet source exprRegion @@ -980,30 +871,30 @@ toExprReport source localizer exprRegion category tipe expected = [] ) - FromAnnotation name _ subContext expectedType -> + T.CRET_FromAnnotation name _ subContext expectedType -> let thing : String thing = case subContext of - CRET_TypedIfBranch index -> + T.CRET_TypedIfBranch index -> D.ordinal index ++ " branch of this `if` expression:" - CRET_TypedCaseBranch index -> + T.CRET_TypedCaseBranch index -> D.ordinal index ++ " branch of this `case` expression:" - CRET_TypedBody -> + T.CRET_TypedBody -> "body of the `" ++ name ++ "` definition:" itIs : String itIs = case subContext of - CRET_TypedIfBranch index -> + T.CRET_TypedIfBranch index -> "The " ++ D.ordinal index ++ " branch is" - CRET_TypedCaseBranch index -> + T.CRET_TypedCaseBranch index -> "The " ++ D.ordinal index ++ " branch is" - CRET_TypedBody -> + T.CRET_TypedBody -> "The body is" in Report.Report "TYPE MISMATCH" exprRegion [] <| @@ -1017,7 +908,7 @@ toExprReport source localizer exprRegion category tipe expected = [] ) - FromContext region context expectedType -> + T.CRET_FromContext region context expectedType -> let mismatch : ( ( Maybe T.CRA_Region, String ), ( String, String, List D.Doc ) ) -> Report.Report mismatch ( ( maybeHighlight, problem ), ( thisIs, insteadOf, furtherDetails ) ) = @@ -1045,7 +936,7 @@ toExprReport source localizer exprRegion category tipe expected = Code.toSnippet source region maybeHighlight docPair in case context of - CRET_ListEntry index -> + T.CRET_ListEntry index -> let ith : String ith = @@ -1065,7 +956,7 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_Negate -> + T.CRET_Negate -> badType ( ( Just exprRegion , "I do not know how to negate this type of value:" @@ -1088,11 +979,11 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_OpLeft op -> + T.CRET_OpLeft op -> custom (Just exprRegion) <| opLeftToDocs localizer category op tipe expectedType - CRET_OpRight op -> + T.CRET_OpRight op -> case opRightToDocs localizer category op tipe expectedType of EmphBoth details -> custom Nothing details @@ -1100,7 +991,7 @@ toExprReport source localizer exprRegion category tipe expected = EmphRight details -> custom (Just exprRegion) details - CRET_IfCondition -> + T.CRET_IfCondition -> badType ( ( Just exprRegion , "This `if` condition does not evaluate to a boolean value, True or False." @@ -1123,7 +1014,7 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_IfBranch index -> + T.CRET_IfBranch index -> let ith : String ith = @@ -1143,7 +1034,7 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_CaseBranch index -> + T.CRET_CaseBranch index -> let ith : String ith = @@ -1163,7 +1054,7 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_CallArity maybeFuncName numGivenArgs -> + T.CRET_CallArity maybeFuncName numGivenArgs -> Report.Report "TOO MANY ARGS" exprRegion [] <| Code.toSnippet source region (Just exprRegion) <| case countArgs tipe of @@ -1172,16 +1063,16 @@ toExprReport source localizer exprRegion category tipe expected = thisValue : String thisValue = case maybeFuncName of - CRET_NoName -> + T.CRET_NoName -> "This value" - CRET_FuncName name -> + T.CRET_FuncName name -> "The `" ++ name ++ "` value" - CRET_CtorName name -> + T.CRET_CtorName name -> "The `" ++ name ++ "` value" - CRET_OpName op -> + T.CRET_OpName op -> "The (" ++ op ++ ") operator" in ( D.reflow <| thisValue ++ " is not a function, but it was given " ++ D.args numGivenArgs ++ "." @@ -1193,23 +1084,23 @@ toExprReport source localizer exprRegion category tipe expected = thisFunction : String thisFunction = case maybeFuncName of - CRET_NoName -> + T.CRET_NoName -> "This function" - CRET_FuncName name -> + T.CRET_FuncName name -> "The `" ++ name ++ "` function" - CRET_CtorName name -> + T.CRET_CtorName name -> "The `" ++ name ++ "` constructor" - CRET_OpName op -> + T.CRET_OpName op -> "The (" ++ op ++ ") operator" in ( D.reflow <| thisFunction ++ " expects " ++ D.args n ++ ", but it got " ++ String.fromInt numGivenArgs ++ " instead." , D.reflow <| "Are there any missing commas? Or missing parentheses?" ) - CRET_CallArg maybeFuncName index -> + T.CRET_CallArg maybeFuncName index -> let ith : String ith = @@ -1218,16 +1109,16 @@ toExprReport source localizer exprRegion category tipe expected = thisFunction : String thisFunction = case maybeFuncName of - CRET_NoName -> + T.CRET_NoName -> "this function" - CRET_FuncName name -> + T.CRET_FuncName name -> "`" ++ name ++ "`" - CRET_CtorName name -> + T.CRET_CtorName name -> "`" ++ name ++ "`" - CRET_OpName op -> + T.CRET_OpName op -> "(" ++ op ++ ")" in mismatch @@ -1246,9 +1137,9 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_RecordAccess recordRegion maybeName fieldRegion field -> + T.CRET_RecordAccess recordRegion maybeName fieldRegion field -> case T.iteratedDealias tipe of - T.Record fields ext -> + T.CTE_Record fields ext -> custom (Just fieldRegion) ( D.reflow <| "This " @@ -1300,9 +1191,9 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_RecordUpdateKeys record expectedFields -> + T.CRET_RecordUpdateKeys record expectedFields -> case T.iteratedDealias tipe of - T.Record actualFields ext -> + T.CTE_Record actualFields ext -> case List.sortBy Tuple.first (Dict.toList compare (Dict.diff expectedFields actualFields)) of [] -> mismatch @@ -1317,7 +1208,7 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - ( field, Can.FieldUpdate fieldRegion _ ) :: _ -> + ( field, T.CASTC_FieldUpdate fieldRegion _ ) :: _ -> let rStr : String rStr = @@ -1368,7 +1259,7 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_RecordUpdateValue field -> + T.CRET_RecordUpdateValue field -> mismatch ( ( Just exprRegion , "I cannot update the `" ++ field ++ "` field like this:" @@ -1381,7 +1272,7 @@ toExprReport source localizer exprRegion category tipe expected = ) ) - CRET_Destructure -> + T.CRET_Destructure -> mismatch ( ( Nothing , "This definition is causing issues:" @@ -1397,10 +1288,10 @@ toExprReport source localizer exprRegion category tipe expected = -- HELPERS -countArgs : T.Type -> Int +countArgs : T.CTE_Type -> Int countArgs tipe = case tipe of - T.Lambda _ _ stuff -> + T.CTE_Lambda _ _ stuff -> 1 + List.length stuff _ -> @@ -1411,7 +1302,7 @@ countArgs tipe = -- FIELD NAME HELPERS -toNearbyRecord : L.CRRTL_Localizer -> ( T.CDN_Name, T.Type ) -> List ( T.CDN_Name, T.Type ) -> T.Extension -> D.Doc +toNearbyRecord : T.CRRTL_Localizer -> ( T.CDN_Name, T.CTE_Type ) -> List ( T.CDN_Name, T.CTE_Type ) -> T.CTE_Extension -> D.Doc toNearbyRecord localizer f fs ext = D.indent 4 <| if List.length fs <= 3 then @@ -1421,23 +1312,23 @@ toNearbyRecord localizer f fs ext = RT.vrecordSnippet (fieldToDocs localizer f) (List.map (fieldToDocs localizer) (List.take 3 fs)) -fieldToDocs : L.CRRTL_Localizer -> ( T.CDN_Name, T.Type ) -> ( D.Doc, D.Doc ) +fieldToDocs : T.CRRTL_Localizer -> ( T.CDN_Name, T.CTE_Type ) -> ( D.Doc, D.Doc ) fieldToDocs localizer ( name, tipe ) = ( D.fromName name , T.toDoc localizer RT.None tipe ) -extToDoc : T.Extension -> Maybe D.Doc +extToDoc : T.CTE_Extension -> Maybe D.Doc extToDoc ext = case ext of - T.Closed -> + T.CTE_Closed -> Nothing - T.FlexOpen x -> + T.CTE_FlexOpen x -> Just (D.fromName x) - T.RigidOpen x -> + T.CTE_RigidOpen x -> Just (D.fromName x) @@ -1445,7 +1336,7 @@ extToDoc ext = -- OP LEFT -opLeftToDocs : L.CRRTL_Localizer -> CRET_Category -> T.CDN_Name -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +opLeftToDocs : T.CRRTL_Localizer -> T.CRET_Category -> T.CDN_Name -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) opLeftToDocs localizer category op tipe expected = case op of "+" -> @@ -1527,7 +1418,7 @@ type RightDocs | EmphRight ( D.Doc, D.Doc ) -opRightToDocs : L.CRRTL_Localizer -> CRET_Category -> T.CDN_Name -> T.Type -> T.Type -> RightDocs +opRightToDocs : T.CRRTL_Localizer -> T.CRET_Category -> T.CDN_Name -> T.CTE_Type -> T.CTE_Type -> RightDocs opRightToDocs localizer category op tipe expected = case op of "+" -> @@ -1628,7 +1519,7 @@ opRightToDocs localizer category op tipe expected = "|>" -> case ( tipe, expected ) of - ( T.Lambda expectedArgType _ _, T.Lambda argType _ _ ) -> + ( T.CTE_Lambda expectedArgType _ _, T.CTE_Lambda argType _ _ ) -> EmphRight ( D.reflow "This function cannot handle the argument sent through the (|>) pipe:" , typeComparison localizer @@ -1653,7 +1544,7 @@ opRightToDocs localizer category op tipe expected = badOpRightFallback localizer category op tipe expected -badOpRightFallback : L.CRRTL_Localizer -> CRET_Category -> T.CDN_Name -> T.Type -> T.Type -> RightDocs +badOpRightFallback : T.CRRTL_Localizer -> T.CRET_Category -> T.CDN_Name -> T.CTE_Type -> T.CTE_Type -> RightDocs badOpRightFallback localizer category op tipe expected = EmphRight ( D.reflow ("The right argument of (" ++ op ++ ") is causing problems.") @@ -1670,40 +1561,40 @@ badOpRightFallback localizer category op tipe expected = ) -isInt : T.Type -> Bool +isInt : T.CTE_Type -> Bool isInt tipe = case tipe of - T.Type home name [] -> + T.CTE_Type home name [] -> T.isInt home name _ -> False -isFloat : T.Type -> Bool +isFloat : T.CTE_Type -> Bool isFloat tipe = case tipe of - T.Type home name [] -> + T.CTE_Type home name [] -> T.isFloat home name _ -> False -isString : T.Type -> Bool +isString : T.CTE_Type -> Bool isString tipe = case tipe of - T.Type home name [] -> + T.CTE_Type home name [] -> T.isString home name _ -> False -isList : T.Type -> Bool +isList : T.CTE_Type -> Bool isList tipe = case tipe of - T.Type home name [ _ ] -> + T.CTE_Type home name [ _ ] -> T.isList home name _ -> @@ -1714,13 +1605,13 @@ isList tipe = -- BAD CONS -badConsRight : L.CRRTL_Localizer -> CRET_Category -> T.Type -> T.Type -> RightDocs +badConsRight : T.CRRTL_Localizer -> T.CRET_Category -> T.CTE_Type -> T.CTE_Type -> RightDocs badConsRight localizer category tipe expected = case tipe of - T.Type home1 name1 [ actualElement ] -> + T.CTE_Type home1 name1 [ actualElement ] -> if T.isList home1 name1 then case expected of - T.Type home2 name2 [ expectedElement ] -> + T.CTE_Type home2 name2 [ expectedElement ] -> if T.isList home2 name2 then EmphBoth ( D.reflow "I am having trouble with this (::) operator:" @@ -1730,7 +1621,7 @@ badConsRight localizer category tipe expected = "The left side of (::) is:" "But you are trying to put that into a list filled with:" (case expectedElement of - T.Type home name [ _ ] -> + T.CTE_Type home name [ _ ] -> if T.isList home name then [ D.toSimpleHint "Are you trying to append two lists? The (++) operator appends lists, whereas the (::) operator is only for adding ONE element to a list." @@ -1806,10 +1697,10 @@ type AppendType | AOther -toAppendType : T.Type -> AppendType +toAppendType : T.CTE_Type -> AppendType toAppendType tipe = case tipe of - T.Type home name _ -> + T.CTE_Type home name _ -> if T.isInt home name then ANumber (D.fromChars "Int") (D.fromChars "String.fromInt") @@ -1825,14 +1716,14 @@ toAppendType tipe = else AOther - T.FlexSuper T.Number _ -> + T.CTE_FlexSuper T.CTE_Number _ -> ANumber (D.fromChars "number") (D.fromChars "String.fromInt") _ -> AOther -badAppendLeft : L.CRRTL_Localizer -> CRET_Category -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +badAppendLeft : T.CRRTL_Localizer -> T.CRET_Category -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) badAppendLeft localizer category tipe expected = case toAppendType tipe of ANumber thing stringFromThing -> @@ -1917,7 +1808,7 @@ badAppendLeft localizer category tipe expected = ) -badAppendRight : L.CRRTL_Localizer -> CRET_Category -> T.Type -> T.Type -> RightDocs +badAppendRight : T.CRRTL_Localizer -> T.CRET_Category -> T.CTE_Type -> T.CTE_Type -> RightDocs badAppendRight localizer category tipe expected = case ( toAppendType expected, toAppendType tipe ) of ( AString, ANumber thing stringFromThing ) -> @@ -2175,7 +2066,7 @@ badStringAdd = ) -badListAdd : L.CRRTL_Localizer -> CRET_Category -> String -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +badListAdd : T.CRRTL_Localizer -> T.CRET_Category -> String -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) badListAdd localizer category direction tipe expected = ( D.fromChars "I cannot do addition with lists:" , loneType localizer @@ -2207,7 +2098,7 @@ badListAdd localizer category direction tipe expected = ) -badListMul : L.CRRTL_Localizer -> CRET_Category -> String -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +badListMul : T.CRRTL_Localizer -> T.CRET_Category -> String -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) badListMul localizer category direction tipe expected = badMath localizer category "Multiplication" direction "*" tipe expected <| [ D.toFancyHint @@ -2226,7 +2117,7 @@ badListMul localizer category direction tipe expected = ] -badMath : L.CRRTL_Localizer -> CRET_Category -> String -> String -> String -> T.Type -> T.Type -> List D.Doc -> ( D.Doc, D.Doc ) +badMath : T.CRRTL_Localizer -> T.CRET_Category -> String -> String -> String -> T.CTE_Type -> T.CTE_Type -> List D.Doc -> ( D.Doc, D.Doc ) badMath localizer category operation direction op tipe expected otherHints = ( D.reflow <| operation @@ -2251,7 +2142,7 @@ badMath localizer category operation direction op tipe expected otherHints = ) -badFDiv : L.CRRTL_Localizer -> D.Doc -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +badFDiv : T.CRRTL_Localizer -> D.Doc -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) badFDiv localizer direction tipe expected = ( D.reflow "The (/) operator is specifically for floating-point division:" , if isInt tipe then @@ -2311,7 +2202,7 @@ badFDiv localizer direction tipe expected = ) -badIDiv : L.CRRTL_Localizer -> D.Doc -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +badIDiv : T.CRRTL_Localizer -> D.Doc -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) badIDiv localizer direction tipe expected = ( D.reflow "The (//) operator is specifically for integer division:" , if isFloat tipe then @@ -2382,7 +2273,7 @@ badIDiv localizer direction tipe expected = -- BAD BOOLS -badBool : L.CRRTL_Localizer -> D.Doc -> D.Doc -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +badBool : T.CRRTL_Localizer -> D.Doc -> D.Doc -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) badBool localizer op direction tipe expected = ( D.reflow "I am struggling with this boolean operation:" , loneType localizer @@ -2412,7 +2303,7 @@ badBool localizer op direction tipe expected = -- BAD COMPARISON -badCompLeft : L.CRRTL_Localizer -> CRET_Category -> String -> String -> T.Type -> T.Type -> ( D.Doc, D.Doc ) +badCompLeft : T.CRRTL_Localizer -> T.CRET_Category -> String -> String -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc ) badCompLeft localizer category op direction tipe expected = ( D.reflow "I cannot do a comparison with this value:" , loneType localizer @@ -2458,7 +2349,7 @@ badCompLeft localizer category op direction tipe expected = ) -badCompRight : L.CRRTL_Localizer -> String -> T.Type -> T.Type -> RightDocs +badCompRight : T.CRRTL_Localizer -> String -> T.CTE_Type -> T.CTE_Type -> RightDocs badCompRight localizer op tipe expected = EmphBoth ( D.reflow <| @@ -2478,7 +2369,7 @@ badCompRight localizer op tipe expected = -- BAD EQUALITY -badEquality : L.CRRTL_Localizer -> String -> T.Type -> T.Type -> RightDocs +badEquality : T.CRRTL_Localizer -> String -> T.CTE_Type -> T.CTE_Type -> RightDocs badEquality localizer op tipe expected = EmphBoth ( D.reflow <| @@ -2502,7 +2393,7 @@ badEquality localizer op tipe expected = -- INFINITE TYPES -toInfiniteReport : Code.Source -> L.CRRTL_Localizer -> T.CRA_Region -> T.CDN_Name -> T.Type -> Report.Report +toInfiniteReport : Code.Source -> T.CRRTL_Localizer -> T.CRA_Region -> T.CDN_Name -> T.CTE_Type -> Report.Report toInfiniteReport source localizer region name overallType = Report.Report "INFINITE TYPE" region [] <| Code.toSnippet source region Nothing <| @@ -2524,10 +2415,10 @@ toInfiniteReport source localizer region name overallType = -- ENCODERS and DECODERS -errorEncoder : CRET_Error -> Encode.Value +errorEncoder : T.CRET_Error -> Encode.Value errorEncoder error = case error of - CRET_BadExpr region category actualType expected -> + T.CRET_BadExpr region category actualType expected -> Encode.object [ ( "type", Encode.string "BadExpr" ) , ( "region", A.regionEncoder region ) @@ -2536,7 +2427,7 @@ errorEncoder error = , ( "expected", expectedEncoder T.typeEncoder expected ) ] - CRET_BadPattern region category tipe expected -> + T.CRET_BadPattern region category tipe expected -> Encode.object [ ( "type", Encode.string "BadPattern" ) , ( "region", A.regionEncoder region ) @@ -2545,7 +2436,7 @@ errorEncoder error = , ( "expected", pExpectedEncoder T.typeEncoder expected ) ] - CRET_InfiniteType region name overallType -> + T.CRET_InfiniteType region name overallType -> Encode.object [ ( "type", Encode.string "InfiniteType" ) , ( "region", A.regionEncoder region ) @@ -2554,28 +2445,28 @@ errorEncoder error = ] -errorDecoder : Decode.Decoder CRET_Error +errorDecoder : Decode.Decoder T.CRET_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "BadExpr" -> - Decode.map4 CRET_BadExpr + Decode.map4 T.CRET_BadExpr (Decode.field "region" A.regionDecoder) (Decode.field "category" categoryDecoder) (Decode.field "actualType" T.typeDecoder) (Decode.field "expected" (expectedDecoder T.typeDecoder)) "BadPattern" -> - Decode.map4 CRET_BadPattern + Decode.map4 T.CRET_BadPattern (Decode.field "region" A.regionDecoder) (Decode.field "category" pCategoryDecoder) (Decode.field "tipe" T.typeDecoder) (Decode.field "expected" (pExpectedDecoder T.typeDecoder)) "InfiniteType" -> - Decode.map3 CRET_InfiniteType + Decode.map3 T.CRET_InfiniteType (Decode.field "region" A.regionDecoder) (Decode.field "name" Decode.string) (Decode.field "overallType" T.typeDecoder) @@ -2585,180 +2476,180 @@ errorDecoder = ) -categoryEncoder : CRET_Category -> Encode.Value +categoryEncoder : T.CRET_Category -> Encode.Value categoryEncoder category = case category of - CRET_List -> + T.CRET_List -> Encode.object [ ( "type", Encode.string "List" ) ] - CRET_Number -> + T.CRET_Number -> Encode.object [ ( "type", Encode.string "Number" ) ] - CRET_Float -> + T.CRET_Float -> Encode.object [ ( "type", Encode.string "Float" ) ] - CRET_String -> + T.CRET_String -> Encode.object [ ( "type", Encode.string "String" ) ] - CRET_Char -> + T.CRET_Char -> Encode.object [ ( "type", Encode.string "Char" ) ] - CRET_If -> + T.CRET_If -> Encode.object [ ( "type", Encode.string "If" ) ] - CRET_Case -> + T.CRET_Case -> Encode.object [ ( "type", Encode.string "Case" ) ] - CRET_CallResult maybeName -> + T.CRET_CallResult maybeName -> Encode.object [ ( "type", Encode.string "CallResult" ) , ( "maybeName", maybeNameEncoder maybeName ) ] - CRET_Lambda -> + T.CRET_Lambda -> Encode.object [ ( "type", Encode.string "Lambda" ) ] - CRET_Accessor field -> + T.CRET_Accessor field -> Encode.object [ ( "type", Encode.string "Accessor" ) , ( "field", Encode.string field ) ] - CRET_Access field -> + T.CRET_Access field -> Encode.object [ ( "type", Encode.string "Access" ) , ( "field", Encode.string field ) ] - CRET_Record -> + T.CRET_Record -> Encode.object [ ( "type", Encode.string "Record" ) ] - CRET_Tuple -> + T.CRET_Tuple -> Encode.object [ ( "type", Encode.string "Tuple" ) ] - CRET_Unit -> + T.CRET_Unit -> Encode.object [ ( "type", Encode.string "Unit" ) ] - CRET_Shader -> + T.CRET_Shader -> Encode.object [ ( "type", Encode.string "Shader" ) ] - CRET_Effects -> + T.CRET_Effects -> Encode.object [ ( "type", Encode.string "Effects" ) ] - CRET_Local name -> + T.CRET_Local name -> Encode.object [ ( "type", Encode.string "Local" ) , ( "name", Encode.string name ) ] - CRET_Foreign name -> + T.CRET_Foreign name -> Encode.object [ ( "type", Encode.string "Foreign" ) , ( "name", Encode.string name ) ] -categoryDecoder : Decode.Decoder CRET_Category +categoryDecoder : Decode.Decoder T.CRET_Category categoryDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "List" -> - Decode.succeed CRET_List + Decode.succeed T.CRET_List "Number" -> - Decode.succeed CRET_Number + Decode.succeed T.CRET_Number "Float" -> - Decode.succeed CRET_Float + Decode.succeed T.CRET_Float "String" -> - Decode.succeed CRET_String + Decode.succeed T.CRET_String "Char" -> - Decode.succeed CRET_Char + Decode.succeed T.CRET_Char "If" -> - Decode.succeed CRET_If + Decode.succeed T.CRET_If "Case" -> - Decode.succeed CRET_Case + Decode.succeed T.CRET_Case "CallResult" -> - Decode.map CRET_CallResult (Decode.field "maybeName" maybeNameDecoder) + Decode.map T.CRET_CallResult (Decode.field "maybeName" maybeNameDecoder) "Lambda" -> - Decode.succeed CRET_Lambda + Decode.succeed T.CRET_Lambda "Accessor" -> - Decode.map CRET_Accessor (Decode.field "field" Decode.string) + Decode.map T.CRET_Accessor (Decode.field "field" Decode.string) "Access" -> - Decode.map CRET_Access (Decode.field "field" Decode.string) + Decode.map T.CRET_Access (Decode.field "field" Decode.string) "Record" -> - Decode.succeed CRET_Record + Decode.succeed T.CRET_Record "Tuple" -> - Decode.succeed CRET_Tuple + Decode.succeed T.CRET_Tuple "Unit" -> - Decode.succeed CRET_Unit + Decode.succeed T.CRET_Unit "Shader" -> - Decode.succeed CRET_Shader + Decode.succeed T.CRET_Shader "Effects" -> - Decode.succeed CRET_Effects + Decode.succeed T.CRET_Effects "Local" -> - Decode.map CRET_Local (Decode.field "name" Decode.string) + Decode.map T.CRET_Local (Decode.field "name" Decode.string) "Foreign" -> - Decode.map CRET_Foreign (Decode.field "name" Decode.string) + Decode.map T.CRET_Foreign (Decode.field "name" Decode.string) _ -> Decode.fail ("Failed to decode Category's type: " ++ type_) ) -expectedEncoder : (a -> Encode.Value) -> CRET_Expected a -> Encode.Value +expectedEncoder : (a -> Encode.Value) -> T.CRET_Expected a -> Encode.Value expectedEncoder encoder expected = case expected of - NoExpectation expectedType -> + T.CRET_NoExpectation expectedType -> Encode.object [ ( "type", Encode.string "NoExpectation" ) , ( "expectedType", encoder expectedType ) ] - FromContext region context expectedType -> + T.CRET_FromContext region context expectedType -> Encode.object [ ( "type", Encode.string "FromContext" ) , ( "region", A.regionEncoder region ) @@ -2766,7 +2657,7 @@ expectedEncoder encoder expected = , ( "expectedType", encoder expectedType ) ] - FromAnnotation name arity subContext expectedType -> + T.CRET_FromAnnotation name arity subContext expectedType -> Encode.object [ ( "type", Encode.string "FromAnnotation" ) , ( "name", Encode.string name ) @@ -2776,24 +2667,24 @@ expectedEncoder encoder expected = ] -expectedDecoder : Decode.Decoder a -> Decode.Decoder (CRET_Expected a) +expectedDecoder : Decode.Decoder a -> Decode.Decoder (T.CRET_Expected a) expectedDecoder decoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "NoExpectation" -> - Decode.map NoExpectation + Decode.map T.CRET_NoExpectation (Decode.field "expectedType" decoder) "FromContext" -> - Decode.map3 FromContext + Decode.map3 T.CRET_FromContext (Decode.field "region" A.regionDecoder) (Decode.field "context" contextDecoder) (Decode.field "expectedType" decoder) "FromAnnotation" -> - Decode.map4 FromAnnotation + Decode.map4 T.CRET_FromAnnotation (Decode.field "name" Decode.string) (Decode.field "arity" Decode.int) (Decode.field "subContext" subContextDecoder) @@ -2804,124 +2695,124 @@ expectedDecoder decoder = ) -contextDecoder : Decode.Decoder CRET_Context +contextDecoder : Decode.Decoder T.CRET_Context contextDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "ListEntry" -> - Decode.map CRET_ListEntry (Decode.field "index" Index.zeroBasedDecoder) + Decode.map T.CRET_ListEntry (Decode.field "index" Index.zeroBasedDecoder) "Negate" -> - Decode.succeed CRET_Negate + Decode.succeed T.CRET_Negate "OpLeft" -> - Decode.map CRET_OpLeft (Decode.field "op" Decode.string) + Decode.map T.CRET_OpLeft (Decode.field "op" Decode.string) "OpRight" -> - Decode.map CRET_OpRight (Decode.field "op" Decode.string) + Decode.map T.CRET_OpRight (Decode.field "op" Decode.string) "IfCondition" -> - Decode.succeed CRET_IfCondition + Decode.succeed T.CRET_IfCondition "IfBranch" -> - Decode.map CRET_IfBranch (Decode.field "index" Index.zeroBasedDecoder) + Decode.map T.CRET_IfBranch (Decode.field "index" Index.zeroBasedDecoder) "CaseBranch" -> - Decode.map CRET_CaseBranch (Decode.field "index" Index.zeroBasedDecoder) + Decode.map T.CRET_CaseBranch (Decode.field "index" Index.zeroBasedDecoder) "CallArity" -> - Decode.map2 CRET_CallArity + Decode.map2 T.CRET_CallArity (Decode.field "maybeFuncName" maybeNameDecoder) (Decode.field "numGivenArgs" Decode.int) "CallArg" -> - Decode.map2 CRET_CallArg + Decode.map2 T.CRET_CallArg (Decode.field "maybeFuncName" maybeNameDecoder) (Decode.field "index" Index.zeroBasedDecoder) "RecordAccess" -> - Decode.map4 CRET_RecordAccess + Decode.map4 T.CRET_RecordAccess (Decode.field "recordRegion" A.regionDecoder) (Decode.field "maybeName" (Decode.nullable Decode.string)) (Decode.field "fieldRegion" A.regionDecoder) (Decode.field "field" Decode.string) "RecordUpdateKeys" -> - Decode.map2 CRET_RecordUpdateKeys + Decode.map2 T.CRET_RecordUpdateKeys (Decode.field "record" Decode.string) (Decode.field "expectedFields" (DecodeX.assocListDict identity Decode.string Can.fieldUpdateDecoder)) "RecordUpdateValue" -> - Decode.map CRET_RecordUpdateValue (Decode.field "field" Decode.string) + Decode.map T.CRET_RecordUpdateValue (Decode.field "field" Decode.string) "Destructure" -> - Decode.succeed CRET_Destructure + Decode.succeed T.CRET_Destructure _ -> Decode.fail ("Unknown Context's type: " ++ type_) ) -contextEncoder : CRET_Context -> Encode.Value +contextEncoder : T.CRET_Context -> Encode.Value contextEncoder context = case context of - CRET_ListEntry index -> + T.CRET_ListEntry index -> Encode.object [ ( "type", Encode.string "ListEntry" ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_Negate -> + T.CRET_Negate -> Encode.object [ ( "type", Encode.string "Negate" ) ] - CRET_OpLeft op -> + T.CRET_OpLeft op -> Encode.object [ ( "type", Encode.string "OpLeft" ) , ( "op", Encode.string op ) ] - CRET_OpRight op -> + T.CRET_OpRight op -> Encode.object [ ( "type", Encode.string "OpRight" ) , ( "op", Encode.string op ) ] - CRET_IfCondition -> + T.CRET_IfCondition -> Encode.object [ ( "type", Encode.string "IfCondition" ) ] - CRET_IfBranch index -> + T.CRET_IfBranch index -> Encode.object [ ( "type", Encode.string "IfBranch" ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_CaseBranch index -> + T.CRET_CaseBranch index -> Encode.object [ ( "type", Encode.string "CaseBranch" ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_CallArity maybeFuncName numGivenArgs -> + T.CRET_CallArity maybeFuncName numGivenArgs -> Encode.object [ ( "type", Encode.string "CallArity" ) , ( "maybeFuncName", maybeNameEncoder maybeFuncName ) , ( "numGivenArgs", Encode.int numGivenArgs ) ] - CRET_CallArg maybeFuncName index -> + T.CRET_CallArg maybeFuncName index -> Encode.object [ ( "type", Encode.string "CallArg" ) , ( "maybeFuncName", maybeNameEncoder maybeFuncName ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_RecordAccess recordRegion maybeName fieldRegion field -> + T.CRET_RecordAccess recordRegion maybeName fieldRegion field -> Encode.object [ ( "type", Encode.string "RecordAccess" ) , ( "recordRegion", A.regionEncoder recordRegion ) @@ -2930,166 +2821,166 @@ contextEncoder context = , ( "field", Encode.string field ) ] - CRET_RecordUpdateKeys record expectedFields -> + T.CRET_RecordUpdateKeys record expectedFields -> Encode.object [ ( "type", Encode.string "RecordUpdateKeys" ) , ( "record", Encode.string record ) , ( "expectedFields", EncodeX.assocListDict compare Encode.string Can.fieldUpdateEncoder expectedFields ) ] - CRET_RecordUpdateValue field -> + T.CRET_RecordUpdateValue field -> Encode.object [ ( "type", Encode.string "RecordUpdateValue" ) , ( "field", Encode.string field ) ] - CRET_Destructure -> + T.CRET_Destructure -> Encode.object [ ( "type", Encode.string "Destructure" ) ] -subContextDecoder : Decode.Decoder CRET_SubContext +subContextDecoder : Decode.Decoder T.CRET_SubContext subContextDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "TypedIfBranch" -> - Decode.map CRET_TypedIfBranch + Decode.map T.CRET_TypedIfBranch (Decode.field "index" Index.zeroBasedDecoder) "TypedCaseBranch" -> - Decode.map CRET_TypedCaseBranch + Decode.map T.CRET_TypedCaseBranch (Decode.field "index" Index.zeroBasedDecoder) "TypedBody" -> - Decode.succeed CRET_TypedBody + Decode.succeed T.CRET_TypedBody _ -> Decode.fail ("Unknown SubContext's type: " ++ type_) ) -subContextEncoder : CRET_SubContext -> Encode.Value +subContextEncoder : T.CRET_SubContext -> Encode.Value subContextEncoder subContext = case subContext of - CRET_TypedIfBranch index -> + T.CRET_TypedIfBranch index -> Encode.object [ ( "type", Encode.string "TypedIfBranch" ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_TypedCaseBranch index -> + T.CRET_TypedCaseBranch index -> Encode.object [ ( "type", Encode.string "TypedCaseBranch" ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_TypedBody -> + T.CRET_TypedBody -> Encode.object [ ( "type", Encode.string "TypedBody" ) ] -pCategoryEncoder : CRET_PCategory -> Encode.Value +pCategoryEncoder : T.CRET_PCategory -> Encode.Value pCategoryEncoder pCategory = case pCategory of - CRET_PRecord -> + T.CRET_PRecord -> Encode.object [ ( "type", Encode.string "PRecord" ) ] - CRET_PUnit -> + T.CRET_PUnit -> Encode.object [ ( "type", Encode.string "PUnit" ) ] - CRET_PTuple -> + T.CRET_PTuple -> Encode.object [ ( "type", Encode.string "PTuple" ) ] - CRET_PList -> + T.CRET_PList -> Encode.object [ ( "type", Encode.string "PList" ) ] - CRET_PCtor name -> + T.CRET_PCtor name -> Encode.object [ ( "type", Encode.string "PCtor" ) , ( "name", Encode.string name ) ] - CRET_PInt -> + T.CRET_PInt -> Encode.object [ ( "type", Encode.string "PInt" ) ] - CRET_PStr -> + T.CRET_PStr -> Encode.object [ ( "type", Encode.string "PStr" ) ] - CRET_PChr -> + T.CRET_PChr -> Encode.object [ ( "type", Encode.string "PChr" ) ] - CRET_PBool -> + T.CRET_PBool -> Encode.object [ ( "type", Encode.string "PBool" ) ] -pCategoryDecoder : Decode.Decoder CRET_PCategory +pCategoryDecoder : Decode.Decoder T.CRET_PCategory pCategoryDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PRecord" -> - Decode.succeed CRET_PRecord + Decode.succeed T.CRET_PRecord "PUnit" -> - Decode.succeed CRET_PUnit + Decode.succeed T.CRET_PUnit "PTuple" -> - Decode.succeed CRET_PTuple + Decode.succeed T.CRET_PTuple "PList" -> - Decode.succeed CRET_PList + Decode.succeed T.CRET_PList "PCtor" -> - Decode.map CRET_PCtor (Decode.field "name" Decode.string) + Decode.map T.CRET_PCtor (Decode.field "name" Decode.string) "PInt" -> - Decode.succeed CRET_PInt + Decode.succeed T.CRET_PInt "PStr" -> - Decode.succeed CRET_PStr + Decode.succeed T.CRET_PStr "PChr" -> - Decode.succeed CRET_PChr + Decode.succeed T.CRET_PChr "PBool" -> - Decode.succeed CRET_PBool + Decode.succeed T.CRET_PBool _ -> Decode.fail ("Unknown PCategory's type: " ++ type_) ) -pExpectedEncoder : (a -> Encode.Value) -> CRET_PExpected a -> Encode.Value +pExpectedEncoder : (a -> Encode.Value) -> T.CRET_PExpected a -> Encode.Value pExpectedEncoder encoder pExpected = case pExpected of - CRET_PNoExpectation expectedType -> + T.CRET_PNoExpectation expectedType -> Encode.object [ ( "type", Encode.string "PNoExpectation" ) , ( "expectedType", encoder expectedType ) ] - CRET_PFromContext region context expectedType -> + T.CRET_PFromContext region context expectedType -> Encode.object [ ( "type", Encode.string "PFromContext" ) , ( "region", A.regionEncoder region ) @@ -3098,18 +2989,18 @@ pExpectedEncoder encoder pExpected = ] -pExpectedDecoder : Decode.Decoder a -> Decode.Decoder (CRET_PExpected a) +pExpectedDecoder : Decode.Decoder a -> Decode.Decoder (T.CRET_PExpected a) pExpectedDecoder decoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PNoExpectation" -> - Decode.map CRET_PNoExpectation (Decode.field "expectedType" decoder) + Decode.map T.CRET_PNoExpectation (Decode.field "expectedType" decoder) -- | PFromContext T.CRA_Region PContext tipe "PFromContext" -> - Decode.map3 CRET_PFromContext + Decode.map3 T.CRET_PFromContext (Decode.field "region" A.regionDecoder) (Decode.field "context" pContextDecoder) (Decode.field "expectedType" decoder) @@ -3119,115 +3010,115 @@ pExpectedDecoder decoder = ) -maybeNameEncoder : CRET_MaybeName -> Encode.Value +maybeNameEncoder : T.CRET_MaybeName -> Encode.Value maybeNameEncoder maybeName = case maybeName of - CRET_FuncName name -> + T.CRET_FuncName name -> Encode.object [ ( "type", Encode.string "FuncName" ) , ( "name", Encode.string name ) ] - CRET_CtorName name -> + T.CRET_CtorName name -> Encode.object [ ( "type", Encode.string "CtorName" ) , ( "name", Encode.string name ) ] - CRET_OpName op -> + T.CRET_OpName op -> Encode.object [ ( "type", Encode.string "OpName" ) , ( "op", Encode.string op ) ] - CRET_NoName -> + T.CRET_NoName -> Encode.object [ ( "type", Encode.string "NoName" ) ] -maybeNameDecoder : Decode.Decoder CRET_MaybeName +maybeNameDecoder : Decode.Decoder T.CRET_MaybeName maybeNameDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "FuncName" -> - Decode.map CRET_FuncName (Decode.field "name" Decode.string) + Decode.map T.CRET_FuncName (Decode.field "name" Decode.string) "CtorName" -> - Decode.map CRET_CtorName (Decode.field "name" Decode.string) + Decode.map T.CRET_CtorName (Decode.field "name" Decode.string) "OpName" -> - Decode.map CRET_OpName (Decode.field "op" Decode.string) + Decode.map T.CRET_OpName (Decode.field "op" Decode.string) "NoName" -> - Decode.succeed CRET_NoName + Decode.succeed T.CRET_NoName _ -> Decode.fail ("Failed to decode MaybeName's type: " ++ type_) ) -pContextEncoder : CRET_PContext -> Encode.Value +pContextEncoder : T.CRET_PContext -> Encode.Value pContextEncoder pContext = case pContext of - CRET_PTypedArg name index -> + T.CRET_PTypedArg name index -> Encode.object [ ( "type", Encode.string "PTypedArg" ) , ( "name", Encode.string name ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_PCaseMatch index -> + T.CRET_PCaseMatch index -> Encode.object [ ( "type", Encode.string "PCaseMatch" ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_PCtorArg name index -> + T.CRET_PCtorArg name index -> Encode.object [ ( "type", Encode.string "PCtorArg" ) , ( "name", Encode.string name ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_PListEntry index -> + T.CRET_PListEntry index -> Encode.object [ ( "type", Encode.string "PListEntry" ) , ( "index", Index.zeroBasedEncoder index ) ] - CRET_PTail -> + T.CRET_PTail -> Encode.object [ ( "type", Encode.string "PTail" ) ] -pContextDecoder : Decode.Decoder CRET_PContext +pContextDecoder : Decode.Decoder T.CRET_PContext pContextDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "PTypedArg" -> - Decode.map2 CRET_PTypedArg + Decode.map2 T.CRET_PTypedArg (Decode.field "name" Decode.string) (Decode.field "index" Index.zeroBasedDecoder) "PCaseMatch" -> - Decode.map CRET_PCaseMatch (Decode.field "index" Index.zeroBasedDecoder) + Decode.map T.CRET_PCaseMatch (Decode.field "index" Index.zeroBasedDecoder) "PCtorArg" -> - Decode.map2 CRET_PCtorArg + Decode.map2 T.CRET_PCtorArg (Decode.field "name" Decode.string) (Decode.field "index" Index.zeroBasedDecoder) "PListEntry" -> - Decode.map CRET_PListEntry (Decode.field "index" Index.zeroBasedDecoder) + Decode.map T.CRET_PListEntry (Decode.field "index" Index.zeroBasedDecoder) "PTail" -> - Decode.succeed CRET_PTail + Decode.succeed T.CRET_PTail _ -> Decode.fail ("Failed to decode PContext's type: " ++ type_) diff --git a/src/Compiler/Reporting/Render/Type.elm b/src/Compiler/Reporting/Render/Type.elm index 7c7a24854..90ec5124e 100644 --- a/src/Compiler/Reporting/Render/Type.elm +++ b/src/Compiler/Reporting/Render/Type.elm @@ -210,7 +210,7 @@ collectSrcArgs tipe = -- CANONICAL TYPE TO DOC -canToDoc : L.CRRTL_Localizer -> Context -> T.CASTC_Type -> D.Doc +canToDoc : T.CRRTL_Localizer -> Context -> T.CASTC_Type -> D.Doc canToDoc localizer context tipe = case tipe of T.CASTC_TLambda arg1 result -> @@ -239,7 +239,7 @@ canToDoc localizer context tipe = apply context (L.toDoc localizer home name) (List.map (canToDoc localizer App << Tuple.second) args) -canFieldToDoc : L.CRRTL_Localizer -> ( T.CDN_Name, T.CASTC_Type ) -> ( D.Doc, D.Doc ) +canFieldToDoc : T.CRRTL_Localizer -> ( T.CDN_Name, T.CASTC_Type ) -> ( D.Doc, D.Doc ) canFieldToDoc localizer ( name, tipe ) = ( D.fromName name, canToDoc localizer None tipe ) diff --git a/src/Compiler/Reporting/Render/Type/Localizer.elm b/src/Compiler/Reporting/Render/Type/Localizer.elm index a1c8cb83f..bdfa0b298 100644 --- a/src/Compiler/Reporting/Render/Type/Localizer.elm +++ b/src/Compiler/Reporting/Render/Type/Localizer.elm @@ -1,6 +1,5 @@ module Compiler.Reporting.Render.Type.Localizer exposing - ( CRRTL_Localizer - , empty + ( empty , fromModule , fromNames , localizerDecoder @@ -26,47 +25,32 @@ import Types as T -- LOCALIZER -type CRRTL_Localizer - = CRRTL_Localizer (Dict String T.CDN_Name CRRTL_Import) - - -type alias CRRTL_Import = - { alias : Maybe T.CDN_Name - , exposing_ : CRRTL_Exposing - } - - -type CRRTL_Exposing - = CRRTL_All - | CRRTL_Only (EverySet String T.CDN_Name) - - -empty : CRRTL_Localizer +empty : T.CRRTL_Localizer empty = - CRRTL_Localizer Dict.empty + T.CRRTL_Localizer Dict.empty -- LOCALIZE -toDoc : CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> D.Doc +toDoc : T.CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> D.Doc toDoc localizer home name = D.fromChars (toChars localizer home name) -toChars : CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> String -toChars (CRRTL_Localizer localizer) ((T.CEMN_Canonical _ home) as moduleName) name = +toChars : T.CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> String +toChars (T.CRRTL_Localizer localizer) ((T.CEMN_Canonical _ home) as moduleName) name = case Dict.get identity home localizer of Nothing -> home ++ "." ++ name Just import_ -> case import_.exposing_ of - CRRTL_All -> + T.CRRTL_All -> name - CRRTL_Only set -> + T.CRRTL_Only set -> if EverySet.member identity name set then name @@ -81,37 +65,37 @@ toChars (CRRTL_Localizer localizer) ((T.CEMN_Canonical _ home) as moduleName) na -- FROM NAMES -fromNames : Dict String T.CDN_Name a -> CRRTL_Localizer +fromNames : Dict String T.CDN_Name a -> T.CRRTL_Localizer fromNames names = - CRRTL_Localizer (Dict.map (\_ _ -> { alias = Nothing, exposing_ = CRRTL_All }) names) + T.CRRTL_Localizer (Dict.map (\_ _ -> { alias = Nothing, exposing_ = T.CRRTL_All }) names) -- FROM MODULE -fromModule : T.CASTS_Module -> CRRTL_Localizer +fromModule : T.CASTS_Module -> T.CRRTL_Localizer fromModule ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) = - CRRTL_Localizer <| + T.CRRTL_Localizer <| Dict.fromList identity <| - (( Src.getName modul, { alias = Nothing, exposing_ = CRRTL_All } ) :: List.map toPair imports) + (( Src.getName modul, { alias = Nothing, exposing_ = T.CRRTL_All } ) :: List.map toPair imports) -toPair : T.CASTS_Import -> ( T.CDN_Name, CRRTL_Import ) +toPair : T.CASTS_Import -> ( T.CDN_Name, T.CRRTL_Import ) toPair (T.CASTS_Import (T.CRA_At _ name) alias_ exposing_) = ( name - , CRRTL_Import alias_ (toExposing exposing_) + , T.CRRTL_Import alias_ (toExposing exposing_) ) -toExposing : T.CASTS_Exposing -> CRRTL_Exposing +toExposing : T.CASTS_Exposing -> T.CRRTL_Exposing toExposing exposing_ = case exposing_ of T.CASTS_Open -> - CRRTL_All + T.CRRTL_All T.CASTS_Explicit exposedList -> - CRRTL_Only (List.foldr addType EverySet.empty exposedList) + T.CRRTL_Only (List.foldr addType EverySet.empty exposedList) addType : T.CASTS_Exposed -> EverySet String T.CDN_Name -> EverySet String T.CDN_Name @@ -131,17 +115,17 @@ addType exposed types = -- ENCODERS and DECODERS -localizerEncoder : CRRTL_Localizer -> Encode.Value -localizerEncoder (CRRTL_Localizer localizer) = +localizerEncoder : T.CRRTL_Localizer -> Encode.Value +localizerEncoder (T.CRRTL_Localizer localizer) = EncodeX.assocListDict compare Encode.string importEncoder localizer -localizerDecoder : Decode.Decoder CRRTL_Localizer +localizerDecoder : Decode.Decoder T.CRRTL_Localizer localizerDecoder = - Decode.map CRRTL_Localizer (DecodeX.assocListDict identity Decode.string importDecoder) + Decode.map T.CRRTL_Localizer (DecodeX.assocListDict identity Decode.string importDecoder) -importEncoder : CRRTL_Import -> Encode.Value +importEncoder : T.CRRTL_Import -> Encode.Value importEncoder import_ = Encode.object [ ( "type", Encode.string "Import" ) @@ -150,39 +134,39 @@ importEncoder import_ = ] -importDecoder : Decode.Decoder CRRTL_Import +importDecoder : Decode.Decoder T.CRRTL_Import importDecoder = - Decode.map2 CRRTL_Import + Decode.map2 T.CRRTL_Import (Decode.field "alias" (Decode.maybe Decode.string)) (Decode.field "exposing" exposingDecoder) -exposingEncoder : CRRTL_Exposing -> Encode.Value +exposingEncoder : T.CRRTL_Exposing -> Encode.Value exposingEncoder exposing_ = case exposing_ of - CRRTL_All -> + T.CRRTL_All -> Encode.object [ ( "type", Encode.string "All" ) ] - CRRTL_Only set -> + T.CRRTL_Only set -> Encode.object [ ( "type", Encode.string "Only" ) , ( "set", EncodeX.everySet compare Encode.string set ) ] -exposingDecoder : Decode.Decoder CRRTL_Exposing +exposingDecoder : Decode.Decoder T.CRRTL_Exposing exposingDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "All" -> - Decode.succeed CRRTL_All + Decode.succeed T.CRRTL_All "Only" -> - Decode.map CRRTL_Only (Decode.field "set" (DecodeX.everySet identity Decode.string)) + Decode.map T.CRRTL_Only (Decode.field "set" (DecodeX.everySet identity Decode.string)) _ -> Decode.fail ("Unknown Exposing's type: " ++ type_) diff --git a/src/Compiler/Reporting/Warning.elm b/src/Compiler/Reporting/Warning.elm index 1a7ac8740..48d3af0e6 100644 --- a/src/Compiler/Reporting/Warning.elm +++ b/src/Compiler/Reporting/Warning.elm @@ -8,7 +8,6 @@ import Compiler.AST.Utils.Type as Type import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type as RT -import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report exposing (Report(..)) import Types as T @@ -32,7 +31,7 @@ type Context -- TO REPORT -toReport : L.CRRTL_Localizer -> Code.Source -> Warning -> Report +toReport : T.CRRTL_Localizer -> Code.Source -> Warning -> Report toReport localizer source warning = case warning of UnusedImport region moduleName -> diff --git a/src/Compiler/Type/Constrain/Expression.elm b/src/Compiler/Type/Constrain/Expression.elm index cda1a4fdf..6b991f473 100644 --- a/src/Compiler/Type/Constrain/Expression.elm +++ b/src/Compiler/Type/Constrain/Expression.elm @@ -4,12 +4,10 @@ module Compiler.Type.Constrain.Expression exposing , constrainRecursiveDefs ) -import Compiler.AST.Canonical as Can import Compiler.Data.Index as Index import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Type as E exposing (CRET_Category(..), CRET_Context(..), CRET_Expected(..), CRET_MaybeName(..), CRET_PContext(..), CRET_PExpected(..), CRET_SubContext(..)) import Compiler.Type.Constrain.Pattern as Pattern import Compiler.Type.Instantiate as Instantiate import Compiler.Type.Type as Type exposing (Constraint(..), Type(..)) @@ -35,50 +33,50 @@ type alias RTV = Dict String T.CDN_Name Type -constrain : RTV -> Can.Expr -> E.CRET_Expected Type -> IO Constraint +constrain : RTV -> T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrain rtv (T.CRA_At region expression) expected = case expression of - Can.VarLocal name -> + T.CASTC_VarLocal name -> IO.pure (CLocal region name expected) - Can.VarTopLevel _ name -> + T.CASTC_VarTopLevel _ name -> IO.pure (CLocal region name expected) - Can.VarKernel _ _ -> + T.CASTC_VarKernel _ _ -> IO.pure CTrue - Can.VarForeign _ name annotation -> + T.CASTC_VarForeign _ name annotation -> IO.pure (CForeign region name annotation expected) - Can.VarCtor _ _ name _ annotation -> + T.CASTC_VarCtor _ _ name _ annotation -> IO.pure (CForeign region name annotation expected) - Can.VarDebug _ name annotation -> + T.CASTC_VarDebug _ name annotation -> IO.pure (CForeign region name annotation expected) - Can.VarOperator op _ _ annotation -> + T.CASTC_VarOperator op _ _ annotation -> IO.pure (CForeign region op annotation expected) - Can.Str _ -> - IO.pure (CEqual region CRET_String Type.string expected) + T.CASTC_Str _ -> + IO.pure (CEqual region T.CRET_String Type.string expected) - Can.Chr _ -> - IO.pure (CEqual region CRET_Char Type.char expected) + T.CASTC_Chr _ -> + IO.pure (CEqual region T.CRET_Char Type.char expected) - Can.Int _ -> + T.CASTC_Int _ -> Type.mkFlexNumber |> IO.fmap (\var -> - Type.exists [ var ] (CEqual region E.CRET_Number (VarN var) expected) + Type.exists [ var ] (CEqual region T.CRET_Number (VarN var) expected) ) - Can.Float _ -> - IO.pure (CEqual region CRET_Float Type.float expected) + T.CASTC_Float _ -> + IO.pure (CEqual region T.CRET_Float Type.float expected) - Can.List elements -> + T.CASTC_List elements -> constrainList rtv region elements expected - Can.Negate expr -> + T.CASTC_Negate expr -> Type.mkFlexNumber |> IO.bind (\numberVar -> @@ -87,46 +85,46 @@ constrain rtv (T.CRA_At region expression) expected = numberType = VarN numberVar in - constrain rtv expr (FromContext region CRET_Negate numberType) + constrain rtv expr (T.CRET_FromContext region T.CRET_Negate numberType) |> IO.fmap (\numberCon -> let negateCon : Constraint negateCon = - CEqual region E.CRET_Number numberType expected + CEqual region T.CRET_Number numberType expected in Type.exists [ numberVar ] (CAnd [ numberCon, negateCon ]) ) ) - Can.Binop op _ _ annotation leftExpr rightExpr -> + T.CASTC_Binop op _ _ annotation leftExpr rightExpr -> constrainBinop rtv region op annotation leftExpr rightExpr expected - Can.Lambda args body -> + T.CASTC_Lambda args body -> constrainLambda rtv region args body expected - Can.Call func args -> + T.CASTC_Call func args -> constrainCall rtv region func args expected - Can.If branches finally -> + T.CASTC_If branches finally -> constrainIf rtv region branches finally expected - Can.Case expr branches -> + T.CASTC_Case expr branches -> constrainCase rtv region expr branches expected - Can.Let def body -> + T.CASTC_Let def body -> IO.bind (constrainDef rtv def) (constrain rtv body expected) - Can.LetRec defs body -> + T.CASTC_LetRec defs body -> IO.bind (constrainRecursiveDefs rtv defs) (constrain rtv body expected) - Can.LetDestruct pattern expr body -> + T.CASTC_LetDestruct pattern expr body -> IO.bind (constrainDestruct rtv region pattern expr) (constrain rtv body expected) - Can.Accessor field -> + T.CASTC_Accessor field -> Type.mkFlexVar |> IO.bind (\extVar -> @@ -146,11 +144,11 @@ constrain rtv (T.CRA_At region expression) expected = recordType = RecordN (Dict.singleton identity field fieldType) extType in - Type.exists [ fieldVar, extVar ] (CEqual region (CRET_Accessor field) (FunN recordType fieldType) expected) + Type.exists [ fieldVar, extVar ] (CEqual region (T.CRET_Accessor field) (FunN recordType fieldType) expected) ) ) - Can.Access expr (T.CRA_At accessRegion field) -> + T.CASTC_Access expr (T.CRA_At accessRegion field) -> Type.mkFlexVar |> IO.bind (\extVar -> @@ -170,31 +168,31 @@ constrain rtv (T.CRA_At region expression) expected = recordType = RecordN (Dict.singleton identity field fieldType) extType - context : CRET_Context + context : T.CRET_Context context = - CRET_RecordAccess (A.toRegion expr) (getAccessName expr) accessRegion field + T.CRET_RecordAccess (A.toRegion expr) (getAccessName expr) accessRegion field in - constrain rtv expr (FromContext region context recordType) + constrain rtv expr (T.CRET_FromContext region context recordType) |> IO.fmap (\recordCon -> - Type.exists [ fieldVar, extVar ] (CAnd [ recordCon, CEqual region (CRET_Access field) fieldType expected ]) + Type.exists [ fieldVar, extVar ] (CAnd [ recordCon, CEqual region (T.CRET_Access field) fieldType expected ]) ) ) ) - Can.Update name expr fields -> + T.CASTC_Update name expr fields -> constrainUpdate rtv region name expr fields expected - Can.Record fields -> + T.CASTC_Record fields -> constrainRecord rtv region fields expected - Can.Unit -> - IO.pure (CEqual region CRET_Unit UnitN expected) + T.CASTC_Unit -> + IO.pure (CEqual region T.CRET_Unit UnitN expected) - Can.Tuple a b maybeC -> + T.CASTC_Tuple a b maybeC -> constrainTuple rtv region a b maybeC expected - Can.Shader _ types -> + T.CASTC_Shader _ types -> constrainShader region types expected @@ -202,12 +200,12 @@ constrain rtv (T.CRA_At region expression) expected = -- CONSTRAIN LAMBDA -constrainLambda : RTV -> T.CRA_Region -> List Can.Pattern -> Can.Expr -> E.CRET_Expected Type -> IO Constraint +constrainLambda : RTV -> T.CRA_Region -> List T.CASTC_Pattern -> T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrainLambda rtv region args body expected = constrainArgs args |> IO.bind (\(Args vars tipe resultType (Pattern.State headers pvars revCons)) -> - constrain rtv body (NoExpectation resultType) + constrain rtv body (T.CRET_NoExpectation resultType) |> IO.fmap (\bodyCon -> Type.exists vars <| @@ -217,7 +215,7 @@ constrainLambda rtv region args body expected = headers (CAnd (List.reverse revCons)) bodyCon - , CEqual region CRET_Lambda tipe expected + , CEqual region T.CRET_Lambda tipe expected ] ) ) @@ -227,10 +225,10 @@ constrainLambda rtv region args body expected = -- CONSTRAIN CALL -constrainCall : RTV -> T.CRA_Region -> Can.Expr -> List Can.Expr -> E.CRET_Expected Type -> IO Constraint +constrainCall : RTV -> T.CRA_Region -> T.CASTC_Expr -> List T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrainCall rtv region ((T.CRA_At funcRegion _) as func) args expected = let - maybeName : CRET_MaybeName + maybeName : T.CRET_MaybeName maybeName = getName func in @@ -249,7 +247,7 @@ constrainCall rtv region ((T.CRA_At funcRegion _) as func) args expected = resultType = VarN resultVar in - constrain rtv func (E.NoExpectation funcType) + constrain rtv func (T.CRET_NoExpectation funcType) |> IO.bind (\funcCon -> IO.fmap Utils.unzip3 (IO.traverseIndexed (constrainArg rtv region maybeName) args) @@ -260,14 +258,14 @@ constrainCall rtv region ((T.CRA_At funcRegion _) as func) args expected = arityType = List.foldr FunN resultType argTypes - category : CRET_Category + category : T.CRET_Category category = - CRET_CallResult maybeName + T.CRET_CallResult maybeName in Type.exists (funcVar :: resultVar :: argVars) (CAnd [ funcCon - , CEqual funcRegion category funcType (FromContext region (CRET_CallArity maybeName (List.length args)) arityType) + , CEqual funcRegion category funcType (T.CRET_FromContext region (T.CRET_CallArity maybeName (List.length args)) arityType) , CAnd argCons , CEqual region category resultType expected ] @@ -278,7 +276,7 @@ constrainCall rtv region ((T.CRA_At funcRegion _) as func) args expected = ) -constrainArg : RTV -> T.CRA_Region -> E.CRET_MaybeName -> T.CDI_ZeroBased -> Can.Expr -> IO ( IO.Variable, Type, Constraint ) +constrainArg : RTV -> T.CRA_Region -> T.CRET_MaybeName -> T.CDI_ZeroBased -> T.CASTC_Expr -> IO ( IO.Variable, Type, Constraint ) constrainArg rtv region maybeName index arg = Type.mkFlexVar |> IO.bind @@ -288,7 +286,7 @@ constrainArg rtv region maybeName index arg = argType = VarN argVar in - constrain rtv arg (FromContext region (CRET_CallArg maybeName index) argType) + constrain rtv arg (T.CRET_FromContext region (T.CRET_CallArg maybeName index) argType) |> IO.fmap (\argCon -> ( argVar, argType, argCon ) @@ -296,41 +294,41 @@ constrainArg rtv region maybeName index arg = ) -getName : Can.Expr -> CRET_MaybeName +getName : T.CASTC_Expr -> T.CRET_MaybeName getName (T.CRA_At _ expr) = case expr of - Can.VarLocal name -> - CRET_FuncName name + T.CASTC_VarLocal name -> + T.CRET_FuncName name - Can.VarTopLevel _ name -> - CRET_FuncName name + T.CASTC_VarTopLevel _ name -> + T.CRET_FuncName name - Can.VarForeign _ name _ -> - CRET_FuncName name + T.CASTC_VarForeign _ name _ -> + T.CRET_FuncName name - Can.VarCtor _ _ name _ _ -> - CRET_CtorName name + T.CASTC_VarCtor _ _ name _ _ -> + T.CRET_CtorName name - Can.VarOperator op _ _ _ -> - CRET_OpName op + T.CASTC_VarOperator op _ _ _ -> + T.CRET_OpName op - Can.VarKernel _ name -> - CRET_FuncName name + T.CASTC_VarKernel _ name -> + T.CRET_FuncName name _ -> - CRET_NoName + T.CRET_NoName -getAccessName : Can.Expr -> Maybe T.CDN_Name +getAccessName : T.CASTC_Expr -> Maybe T.CDN_Name getAccessName (T.CRA_At _ expr) = case expr of - Can.VarLocal name -> + T.CASTC_VarLocal name -> Just name - Can.VarTopLevel _ name -> + T.CASTC_VarTopLevel _ name -> Just name - Can.VarForeign _ name _ -> + T.CASTC_VarForeign _ name _ -> Just name _ -> @@ -341,7 +339,7 @@ getAccessName (T.CRA_At _ expr) = -- CONSTRAIN BINOP -constrainBinop : RTV -> T.CRA_Region -> T.CDN_Name -> T.CASTC_Annotation -> Can.Expr -> Can.Expr -> E.CRET_Expected Type -> IO Constraint +constrainBinop : RTV -> T.CRA_Region -> T.CDN_Name -> T.CASTC_Annotation -> T.CASTC_Expr -> T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrainBinop rtv region op annotation leftExpr rightExpr expected = Type.mkFlexVar |> IO.bind @@ -371,12 +369,12 @@ constrainBinop rtv region op annotation leftExpr rightExpr expected = opCon : Constraint opCon = - CForeign region op annotation (NoExpectation binopType) + CForeign region op annotation (T.CRET_NoExpectation binopType) in - constrain rtv leftExpr (FromContext region (CRET_OpLeft op) leftType) + constrain rtv leftExpr (T.CRET_FromContext region (T.CRET_OpLeft op) leftType) |> IO.bind (\leftCon -> - constrain rtv rightExpr (FromContext region (CRET_OpRight op) rightType) + constrain rtv rightExpr (T.CRET_FromContext region (T.CRET_OpRight op) rightType) |> IO.fmap (\rightCon -> Type.exists [ leftVar, rightVar, answerVar ] @@ -384,7 +382,7 @@ constrainBinop rtv region op annotation leftExpr rightExpr expected = [ opCon , leftCon , rightCon - , CEqual region (CRET_CallResult (CRET_OpName op)) answerType expected + , CEqual region (T.CRET_CallResult (T.CRET_OpName op)) answerType expected ] ) ) @@ -398,7 +396,7 @@ constrainBinop rtv region op annotation leftExpr rightExpr expected = -- CONSTRAIN LISTS -constrainList : RTV -> T.CRA_Region -> List Can.Expr -> E.CRET_Expected Type -> IO Constraint +constrainList : RTV -> T.CRA_Region -> List T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrainList rtv region entries expected = Type.mkFlexVar |> IO.bind @@ -418,28 +416,28 @@ constrainList rtv region entries expected = Type.exists [ entryVar ] (CAnd [ CAnd entryCons - , CEqual region CRET_List listType expected + , CEqual region T.CRET_List listType expected ] ) ) ) -constrainListEntry : RTV -> T.CRA_Region -> Type -> T.CDI_ZeroBased -> Can.Expr -> IO Constraint +constrainListEntry : RTV -> T.CRA_Region -> Type -> T.CDI_ZeroBased -> T.CASTC_Expr -> IO Constraint constrainListEntry rtv region tipe index expr = - constrain rtv expr (FromContext region (CRET_ListEntry index) tipe) + constrain rtv expr (T.CRET_FromContext region (T.CRET_ListEntry index) tipe) -- CONSTRAIN IF EXPRESSIONS -constrainIf : RTV -> T.CRA_Region -> List ( Can.Expr, Can.Expr ) -> Can.Expr -> E.CRET_Expected Type -> IO Constraint +constrainIf : RTV -> T.CRA_Region -> List ( T.CASTC_Expr, T.CASTC_Expr ) -> T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrainIf rtv region branches final expected = let - boolExpect : CRET_Expected Type + boolExpect : T.CRET_Expected Type boolExpect = - FromContext region CRET_IfCondition Type.bool + T.CRET_FromContext region T.CRET_IfCondition Type.bool ( conditions, exprs ) = List.foldr (\( c, e ) ( cs, es ) -> ( c :: cs, e :: es )) ( [], [ final ] ) branches @@ -448,8 +446,8 @@ constrainIf rtv region branches final expected = |> IO.bind (\condCons -> case expected of - FromAnnotation name arity _ tipe -> - IO.indexedForA exprs (\index expr -> constrain rtv expr (FromAnnotation name arity (CRET_TypedIfBranch index) tipe)) + T.CRET_FromAnnotation name arity _ tipe -> + IO.indexedForA exprs (\index expr -> constrain rtv expr (T.CRET_FromAnnotation name arity (T.CRET_TypedIfBranch index) tipe)) |> IO.fmap (\branchCons -> CAnd (CAnd condCons :: branchCons) @@ -466,7 +464,7 @@ constrainIf rtv region branches final expected = in IO.indexedForA exprs (\index expr -> - constrain rtv expr (FromContext region (CRET_IfBranch index) branchType) + constrain rtv expr (T.CRET_FromContext region (T.CRET_IfBranch index) branchType) ) |> IO.fmap (\branchCons -> @@ -474,7 +472,7 @@ constrainIf rtv region branches final expected = (CAnd [ CAnd condCons , CAnd branchCons - , CEqual region CRET_If branchType expected + , CEqual region T.CRET_If branchType expected ] ) ) @@ -486,7 +484,7 @@ constrainIf rtv region branches final expected = -- CONSTRAIN CASE EXPRESSIONS -constrainCase : RTV -> T.CRA_Region -> Can.Expr -> List Can.CaseBranch -> CRET_Expected Type -> IO Constraint +constrainCase : RTV -> T.CRA_Region -> T.CASTC_Expr -> List T.CASTC_CaseBranch -> T.CRET_Expected Type -> IO Constraint constrainCase rtv region expr branches expected = Type.mkFlexVar |> IO.bind @@ -496,17 +494,17 @@ constrainCase rtv region expr branches expected = ptrnType = VarN ptrnVar in - constrain rtv expr (NoExpectation ptrnType) + constrain rtv expr (T.CRET_NoExpectation ptrnType) |> IO.bind (\exprCon -> case expected of - FromAnnotation name arity _ tipe -> + T.CRET_FromAnnotation name arity _ tipe -> IO.indexedForA branches (\index branch -> constrainCaseBranch rtv branch - (CRET_PFromContext region (CRET_PCaseMatch index) ptrnType) - (FromAnnotation name arity (CRET_TypedCaseBranch index) tipe) + (T.CRET_PFromContext region (T.CRET_PCaseMatch index) ptrnType) + (T.CRET_FromAnnotation name arity (T.CRET_TypedCaseBranch index) tipe) ) |> IO.fmap (\branchCons -> @@ -526,8 +524,8 @@ constrainCase rtv region expr branches expected = (\index branch -> constrainCaseBranch rtv branch - (CRET_PFromContext region (CRET_PCaseMatch index) ptrnType) - (FromContext region (CRET_CaseBranch index) branchType) + (T.CRET_PFromContext region (T.CRET_PCaseMatch index) ptrnType) + (T.CRET_FromContext region (T.CRET_CaseBranch index) branchType) ) |> IO.fmap (\branchCons -> @@ -535,7 +533,7 @@ constrainCase rtv region expr branches expected = (CAnd [ exprCon , CAnd branchCons - , CEqual region CRET_Case branchType expected + , CEqual region T.CRET_Case branchType expected ] ) ) @@ -544,8 +542,8 @@ constrainCase rtv region expr branches expected = ) -constrainCaseBranch : RTV -> Can.CaseBranch -> CRET_PExpected Type -> CRET_Expected Type -> IO Constraint -constrainCaseBranch rtv (Can.CaseBranch pattern expr) pExpect bExpect = +constrainCaseBranch : RTV -> T.CASTC_CaseBranch -> T.CRET_PExpected Type -> T.CRET_Expected Type -> IO Constraint +constrainCaseBranch rtv (T.CASTC_CaseBranch pattern expr) pExpect bExpect = Pattern.add pattern pExpect Pattern.emptyState |> IO.bind (\(Pattern.State headers pvars revCons) -> @@ -558,7 +556,7 @@ constrainCaseBranch rtv (Can.CaseBranch pattern expr) pExpect bExpect = -- CONSTRAIN RECORD -constrainRecord : RTV -> T.CRA_Region -> Dict String T.CDN_Name Can.Expr -> CRET_Expected Type -> IO Constraint +constrainRecord : RTV -> T.CRA_Region -> Dict String T.CDN_Name T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrainRecord rtv region fields expected = IO.traverseMap identity compare (constrainField rtv) fields |> IO.fmap @@ -574,7 +572,7 @@ constrainRecord rtv region fields expected = recordCon : Constraint recordCon = - CEqual region CRET_Record recordType expected + CEqual region T.CRET_Record recordType expected vars : List IO.Variable vars = @@ -588,7 +586,7 @@ constrainRecord rtv region fields expected = ) -constrainField : RTV -> Can.Expr -> IO ( IO.Variable, Type, Constraint ) +constrainField : RTV -> T.CASTC_Expr -> IO ( IO.Variable, Type, Constraint ) constrainField rtv expr = Type.mkFlexVar |> IO.bind @@ -598,7 +596,7 @@ constrainField rtv expr = tipe = VarN var in - constrain rtv expr (NoExpectation tipe) + constrain rtv expr (T.CRET_NoExpectation tipe) |> IO.fmap (\con -> ( var, tipe, con ) @@ -610,7 +608,7 @@ constrainField rtv expr = -- CONSTRAIN RECORD UPDATE -constrainUpdate : RTV -> T.CRA_Region -> T.CDN_Name -> Can.Expr -> Dict String T.CDN_Name Can.FieldUpdate -> CRET_Expected Type -> IO Constraint +constrainUpdate : RTV -> T.CRA_Region -> T.CDN_Name -> T.CASTC_Expr -> Dict String T.CDN_Name T.CASTC_FieldUpdate -> T.CRET_Expected Type -> IO Constraint constrainUpdate rtv region name expr fields expected = Type.mkFlexVar |> IO.bind @@ -633,11 +631,11 @@ constrainUpdate rtv region name expr fields expected = -- NOTE: fieldsType is separate so that Error propagates better fieldsCon : Constraint fieldsCon = - CEqual region CRET_Record recordType (NoExpectation fieldsType) + CEqual region T.CRET_Record recordType (T.CRET_NoExpectation fieldsType) recordCon : Constraint recordCon = - CEqual region CRET_Record recordType expected + CEqual region T.CRET_Record recordType expected vars : List IO.Variable vars = @@ -647,15 +645,15 @@ constrainUpdate rtv region name expr fields expected = cons = Dict.foldr compare (\_ ( _, _, c ) cs -> c :: cs) [ recordCon ] fieldDict in - constrain rtv expr (FromContext region (CRET_RecordUpdateKeys name fields) recordType) + constrain rtv expr (T.CRET_FromContext region (T.CRET_RecordUpdateKeys name fields) recordType) |> IO.fmap (\con -> Type.exists vars (CAnd (fieldsCon :: con :: cons))) ) ) ) -constrainUpdateField : RTV -> T.CRA_Region -> T.CDN_Name -> Can.FieldUpdate -> IO ( IO.Variable, Type, Constraint ) -constrainUpdateField rtv region field (Can.FieldUpdate _ expr) = +constrainUpdateField : RTV -> T.CRA_Region -> T.CDN_Name -> T.CASTC_FieldUpdate -> IO ( IO.Variable, Type, Constraint ) +constrainUpdateField rtv region field (T.CASTC_FieldUpdate _ expr) = Type.mkFlexVar |> IO.bind (\var -> @@ -664,7 +662,7 @@ constrainUpdateField rtv region field (Can.FieldUpdate _ expr) = tipe = VarN var in - constrain rtv expr (FromContext region (CRET_RecordUpdateValue field) tipe) + constrain rtv expr (T.CRET_FromContext region (T.CRET_RecordUpdateValue field) tipe) |> IO.fmap (\con -> ( var, tipe, con )) ) @@ -673,7 +671,7 @@ constrainUpdateField rtv region field (Can.FieldUpdate _ expr) = -- CONSTRAIN TUPLE -constrainTuple : RTV -> T.CRA_Region -> Can.Expr -> Can.Expr -> Maybe Can.Expr -> CRET_Expected Type -> IO Constraint +constrainTuple : RTV -> T.CRA_Region -> T.CASTC_Expr -> T.CASTC_Expr -> Maybe T.CASTC_Expr -> T.CRET_Expected Type -> IO Constraint constrainTuple rtv region a b maybeC expected = Type.mkFlexVar |> IO.bind @@ -690,10 +688,10 @@ constrainTuple rtv region a b maybeC expected = bType = VarN bVar in - constrain rtv a (NoExpectation aType) + constrain rtv a (T.CRET_NoExpectation aType) |> IO.bind (\aCon -> - constrain rtv b (NoExpectation bType) + constrain rtv b (T.CRET_NoExpectation bType) |> IO.bind (\bCon -> case maybeC of @@ -705,7 +703,7 @@ constrainTuple rtv region a b maybeC expected = tupleCon : Constraint tupleCon = - CEqual region CRET_Tuple tupleType expected + CEqual region T.CRET_Tuple tupleType expected in IO.pure (Type.exists [ aVar, bVar ] (CAnd [ aCon, bCon, tupleCon ])) @@ -718,7 +716,7 @@ constrainTuple rtv region a b maybeC expected = cType = VarN cVar in - constrain rtv c (NoExpectation cType) + constrain rtv c (T.CRET_NoExpectation cType) |> IO.fmap (\cCon -> let @@ -728,7 +726,7 @@ constrainTuple rtv region a b maybeC expected = tupleCon : Constraint tupleCon = - CEqual region CRET_Tuple tupleType expected + CEqual region T.CRET_Tuple tupleType expected in Type.exists [ aVar, bVar, cVar ] (CAnd [ aCon, bCon, cCon, tupleCon ]) ) @@ -743,7 +741,7 @@ constrainTuple rtv region a b maybeC expected = -- CONSTRAIN SHADER -constrainShader : T.CRA_Region -> T.CASTUS_Types -> CRET_Expected Type -> IO Constraint +constrainShader : T.CRA_Region -> T.CASTUS_Types -> T.CRET_Expected Type -> IO Constraint constrainShader region (T.CASTUS_Types attributes uniforms varyings) expected = Type.mkFlexVar |> IO.bind @@ -769,7 +767,7 @@ constrainShader region (T.CASTUS_Types attributes uniforms varyings) expected = , toShaderRecord varyings EmptyRecordN ] in - Type.exists [ attrVar, unifVar ] (CEqual region CRET_Shader shaderType expected) + Type.exists [ attrVar, unifVar ] (CEqual region T.CRET_Shader shaderType expected) ) ) @@ -812,7 +810,7 @@ glToType glType = -- CONSTRAIN DESTRUCTURES -constrainDestruct : RTV -> T.CRA_Region -> Can.Pattern -> Can.Expr -> Constraint -> IO Constraint +constrainDestruct : RTV -> T.CRA_Region -> T.CASTC_Pattern -> T.CASTC_Expr -> Constraint -> IO Constraint constrainDestruct rtv region pattern expr bodyCon = Type.mkFlexVar |> IO.bind @@ -822,10 +820,10 @@ constrainDestruct rtv region pattern expr bodyCon = patternType = VarN patternVar in - Pattern.add pattern (CRET_PNoExpectation patternType) Pattern.emptyState + Pattern.add pattern (T.CRET_PNoExpectation patternType) Pattern.emptyState |> IO.bind (\(Pattern.State headers pvars revCons) -> - constrain rtv expr (FromContext region CRET_Destructure patternType) + constrain rtv expr (T.CRET_FromContext region T.CRET_Destructure patternType) |> IO.fmap (\exprCon -> CLet [] (patternVar :: pvars) headers (CAnd (List.reverse (exprCon :: revCons))) bodyCon @@ -838,14 +836,14 @@ constrainDestruct rtv region pattern expr bodyCon = -- CONSTRAIN DEF -constrainDef : RTV -> Can.Def -> Constraint -> IO Constraint +constrainDef : RTV -> T.CASTC_Def -> Constraint -> IO Constraint constrainDef rtv def bodyCon = case def of - Can.Def (T.CRA_At region name) args expr -> + T.CASTC_Def (T.CRA_At region name) args expr -> constrainArgs args |> IO.bind (\(Args vars tipe resultType (Pattern.State headers pvars revCons)) -> - constrain rtv expr (NoExpectation resultType) + constrain rtv expr (T.CRET_NoExpectation resultType) |> IO.fmap (\exprCon -> CLet [] @@ -861,7 +859,7 @@ constrainDef rtv def bodyCon = ) ) - Can.TypedDef (T.CRA_At region name) freeVars typedArgs expr srcResultType -> + T.CASTC_TypedDef (T.CRA_At region name) freeVars typedArgs expr srcResultType -> let newNames : Dict String T.CDN_Name () newNames = @@ -879,9 +877,9 @@ constrainDef rtv def bodyCon = |> IO.bind (\(TypedArgs tipe resultType (Pattern.State headers pvars revCons)) -> let - expected : CRET_Expected Type + expected : T.CRET_Expected Type expected = - FromAnnotation name (List.length typedArgs) CRET_TypedBody resultType + T.CRET_FromAnnotation name (List.length typedArgs) T.CRET_TypedBody resultType in constrain newRtv expr expected |> IO.fmap @@ -914,12 +912,12 @@ emptyInfo = Info [] [] Dict.empty -constrainRecursiveDefs : RTV -> List Can.Def -> Constraint -> IO Constraint +constrainRecursiveDefs : RTV -> List T.CASTC_Def -> Constraint -> IO Constraint constrainRecursiveDefs rtv defs bodyCon = recDefsHelp rtv defs bodyCon emptyInfo emptyInfo -recDefsHelp : RTV -> List Can.Def -> Constraint -> Info -> Info -> IO Constraint +recDefsHelp : RTV -> List T.CASTC_Def -> Constraint -> Info -> Info -> IO Constraint recDefsHelp rtv defs bodyCon rigidInfo flexInfo = case defs of [] -> @@ -937,7 +935,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo = def :: otherDefs -> case def of - Can.Def (T.CRA_At region name) args expr -> + T.CASTC_Def (T.CRA_At region name) args expr -> let (Info flexVars flexCons flexHeaders) = flexInfo @@ -945,7 +943,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo = argsHelp args (Pattern.State Dict.empty flexVars []) |> IO.bind (\(Args newFlexVars tipe resultType (Pattern.State headers pvars revCons)) -> - constrain rtv expr (NoExpectation resultType) + constrain rtv expr (T.CRET_NoExpectation resultType) |> IO.bind (\exprCon -> let @@ -964,7 +962,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo = ) ) - Can.TypedDef (T.CRA_At region name) freeVars typedArgs expr srcResultType -> + T.CASTC_TypedDef (T.CRA_At region name) freeVars typedArgs expr srcResultType -> let newNames : Dict String T.CDN_Name () newNames = @@ -981,7 +979,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo = constrainTypedArgs newRtv name typedArgs srcResultType |> IO.bind (\(TypedArgs tipe resultType (Pattern.State headers pvars revCons)) -> - constrain newRtv expr (FromAnnotation name (List.length typedArgs) CRET_TypedBody resultType) + constrain newRtv expr (T.CRET_FromAnnotation name (List.length typedArgs) T.CRET_TypedBody resultType) |> IO.bind (\exprCon -> let @@ -1018,12 +1016,12 @@ type Args = Args (List IO.Variable) Type Type Pattern.State -constrainArgs : List Can.Pattern -> IO Args +constrainArgs : List T.CASTC_Pattern -> IO Args constrainArgs args = argsHelp args Pattern.emptyState -argsHelp : List Can.Pattern -> Pattern.State -> IO Args +argsHelp : List T.CASTC_Pattern -> Pattern.State -> IO Args argsHelp args state = case args of [] -> @@ -1047,7 +1045,7 @@ argsHelp args state = argType = VarN argVar in - Pattern.add pattern (CRET_PNoExpectation argType) state + Pattern.add pattern (T.CRET_PNoExpectation argType) state |> IO.bind (argsHelp otherArgs) |> IO.fmap (\(Args vars tipe result newState) -> @@ -1064,12 +1062,12 @@ type TypedArgs = TypedArgs Type Type Pattern.State -constrainTypedArgs : Dict String T.CDN_Name Type -> T.CDN_Name -> List ( Can.Pattern, T.CASTC_Type ) -> T.CASTC_Type -> IO TypedArgs +constrainTypedArgs : Dict String T.CDN_Name Type -> T.CDN_Name -> List ( T.CASTC_Pattern, T.CASTC_Type ) -> T.CASTC_Type -> IO TypedArgs constrainTypedArgs rtv name args srcResultType = typedArgsHelp rtv name Index.first args srcResultType Pattern.emptyState -typedArgsHelp : Dict String T.CDN_Name Type -> T.CDN_Name -> T.CDI_ZeroBased -> List ( Can.Pattern, T.CASTC_Type ) -> T.CASTC_Type -> Pattern.State -> IO TypedArgs +typedArgsHelp : Dict String T.CDN_Name Type -> T.CDN_Name -> T.CDI_ZeroBased -> List ( T.CASTC_Pattern, T.CASTC_Type ) -> T.CASTC_Type -> Pattern.State -> IO TypedArgs typedArgsHelp rtv name index args srcResultType state = case args of [] -> @@ -1084,9 +1082,9 @@ typedArgsHelp rtv name index args srcResultType state = |> IO.bind (\argType -> let - expected : CRET_PExpected Type + expected : T.CRET_PExpected Type expected = - CRET_PFromContext region (CRET_PTypedArg name index) argType + T.CRET_PFromContext region (T.CRET_PTypedArg name index) argType in Pattern.add pattern expected state |> IO.bind (typedArgsHelp rtv name (Index.next index) otherArgs srcResultType) diff --git a/src/Compiler/Type/Constrain/Module.elm b/src/Compiler/Type/Constrain/Module.elm index bed35a460..807efb8fd 100644 --- a/src/Compiler/Type/Constrain/Module.elm +++ b/src/Compiler/Type/Constrain/Module.elm @@ -4,7 +4,6 @@ import Compiler.AST.Canonical as Can import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName import Compiler.Reporting.Annotation as A -import Compiler.Reporting.Error.Type as E import Compiler.Type.Constrain.Expression as Expr import Compiler.Type.Instantiate as Instantiate import Compiler.Type.Type as Type exposing (Constraint(..), Type(..), mkFlexVar, nameToRigid) @@ -49,16 +48,16 @@ constrain (Can.Module home _ _ decls _ _ _ effects) = -- CONSTRAIN DECLARATIONS -constrainDecls : Can.Decls -> Constraint -> IO Constraint +constrainDecls : T.CASTC_Decls -> Constraint -> IO Constraint constrainDecls decls finalConstraint = case decls of - Can.Declare def otherDecls -> + T.CASTC_Declare def otherDecls -> IO.bind (Expr.constrainDef Dict.empty def) (constrainDecls otherDecls finalConstraint) - Can.DeclareRec def defs otherDecls -> + T.CASTC_DeclareRec def defs otherDecls -> IO.bind (Expr.constrainRecursiveDefs Dict.empty (def :: defs)) (constrainDecls otherDecls finalConstraint) - Can.SaveTheEnvironment -> + T.CASTC_SaveTheEnvironment -> IO.pure finalConstraint @@ -221,12 +220,12 @@ constrainEffects home r0 r1 r2 manager = effectCons : Constraint effectCons = CAnd - [ CLocal r0 "init" (E.NoExpectation (task state0)) - , CLocal r1 "onEffects" (E.NoExpectation onEffects) - , CLocal r2 "onSelfMsg" (E.NoExpectation onSelfMsg) - , CEqual r1 E.CRET_Effects state0 (E.NoExpectation state1) - , CEqual r2 E.CRET_Effects state0 (E.NoExpectation state2) - , CEqual r2 E.CRET_Effects self1 (E.NoExpectation self2) + [ CLocal r0 "init" (T.CRET_NoExpectation (task state0)) + , CLocal r1 "onEffects" (T.CRET_NoExpectation onEffects) + , CLocal r2 "onSelfMsg" (T.CRET_NoExpectation onSelfMsg) + , CEqual r1 T.CRET_Effects state0 (T.CRET_NoExpectation state1) + , CEqual r2 T.CRET_Effects state0 (T.CRET_NoExpectation state2) + , CEqual r2 T.CRET_Effects self1 (T.CRET_NoExpectation self2) ] in IO.fmap (CLet [] [ s0, s1, s2, m1, m2, sm1, sm2 ] Dict.empty effectCons) @@ -280,7 +279,7 @@ checkMap name home tipe constraint = mapCon : Constraint mapCon = - CLocal A.zero name (E.NoExpectation mapType) + CLocal A.zero name (T.CRET_NoExpectation mapType) in CLet [ a, b ] [] Dict.empty mapCon constraint ) diff --git a/src/Compiler/Type/Constrain/Pattern.elm b/src/Compiler/Type/Constrain/Pattern.elm index 87ab919cd..ee9baaf97 100644 --- a/src/Compiler/Type/Constrain/Pattern.elm +++ b/src/Compiler/Type/Constrain/Pattern.elm @@ -5,11 +5,9 @@ module Compiler.Type.Constrain.Pattern exposing , emptyState ) -import Compiler.AST.Canonical as Can import Compiler.Data.Index as Index import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName -import Compiler.Reporting.Error.Type as E import Compiler.Type.Instantiate as Instantiate import Compiler.Type.Type as Type exposing (Type) import Data.Map as Dict exposing (Dict) @@ -31,40 +29,40 @@ type alias Header = Dict String T.CDN_Name (T.CRA_Located Type) -add : Can.Pattern -> E.CRET_PExpected Type -> State -> IO State +add : T.CASTC_Pattern -> T.CRET_PExpected Type -> State -> IO State add (T.CRA_At region pattern) expectation state = case pattern of - Can.PAnything -> + T.CASTC_PAnything -> IO.pure state - Can.PVar name -> + T.CASTC_PVar name -> IO.pure (addToHeaders region name expectation state) - Can.PAlias realPattern name -> + T.CASTC_PAlias realPattern name -> add realPattern expectation (addToHeaders region name expectation state) - Can.PUnit -> + T.CASTC_PUnit -> let (State headers vars revCons) = state unitCon : Type.Constraint unitCon = - Type.CPattern region E.CRET_PUnit Type.UnitN expectation + Type.CPattern region T.CRET_PUnit Type.UnitN expectation in IO.pure (State headers vars (unitCon :: revCons)) - Can.PTuple a b maybeC -> + T.CASTC_PTuple a b maybeC -> addTuple region a b maybeC expectation state - Can.PCtor { home, type_, union, name, args } -> + T.CASTC_PCtor { home, type_, union, name, args } -> let (T.CASTC_Union typeVars _ _ _) = union in addCtor region home type_ typeVars name args expectation state - Can.PList patterns -> + T.CASTC_PList patterns -> Type.mkFlexVar |> IO.bind (\entryVar -> @@ -83,13 +81,13 @@ add (T.CRA_At region pattern) expectation state = let listCon : Type.Constraint listCon = - Type.CPattern region E.CRET_PList listType expectation + Type.CPattern region T.CRET_PList listType expectation in State headers (entryVar :: vars) (listCon :: revCons) ) ) - Can.PCons headPattern tailPattern -> + T.CASTC_PCons headPattern tailPattern -> Type.mkFlexVar |> IO.bind (\entryVar -> @@ -102,13 +100,13 @@ add (T.CRA_At region pattern) expectation state = listType = Type.AppN ModuleName.list Name.list [ entryType ] - headExpectation : E.CRET_PExpected Type + headExpectation : T.CRET_PExpected Type headExpectation = - E.CRET_PNoExpectation entryType + T.CRET_PNoExpectation entryType - tailExpectation : E.CRET_PExpected Type + tailExpectation : T.CRET_PExpected Type tailExpectation = - E.CRET_PFromContext region E.CRET_PTail listType + T.CRET_PFromContext region T.CRET_PTail listType in add tailPattern tailExpectation state |> IO.bind (add headPattern headExpectation) @@ -117,13 +115,13 @@ add (T.CRA_At region pattern) expectation state = let listCon : Type.Constraint listCon = - Type.CPattern region E.CRET_PList listType expectation + Type.CPattern region T.CRET_PList listType expectation in State headers (entryVar :: vars) (listCon :: revCons) ) ) - Can.PRecord fields -> + T.CASTC_PRecord fields -> Type.mkFlexVar |> IO.bind (\extVar -> @@ -149,7 +147,7 @@ add (T.CRA_At region pattern) expectation state = recordCon : Type.Constraint recordCon = - Type.CPattern region E.CRET_PRecord recordType expectation + Type.CPattern region T.CRET_PRecord recordType expectation in State (Dict.union headers (Dict.map (\_ v -> T.CRA_At region v) fieldTypes)) @@ -158,47 +156,47 @@ add (T.CRA_At region pattern) expectation state = ) ) - Can.PInt _ -> + T.CASTC_PInt _ -> let (State headers vars revCons) = state intCon : Type.Constraint intCon = - Type.CPattern region E.CRET_PInt Type.int expectation + Type.CPattern region T.CRET_PInt Type.int expectation in IO.pure (State headers vars (intCon :: revCons)) - Can.PStr _ -> + T.CASTC_PStr _ -> let (State headers vars revCons) = state strCon : Type.Constraint strCon = - Type.CPattern region E.CRET_PStr Type.string expectation + Type.CPattern region T.CRET_PStr Type.string expectation in IO.pure (State headers vars (strCon :: revCons)) - Can.PChr _ -> + T.CASTC_PChr _ -> let (State headers vars revCons) = state chrCon : Type.Constraint chrCon = - Type.CPattern region E.CRET_PChr Type.char expectation + Type.CPattern region T.CRET_PChr Type.char expectation in IO.pure (State headers vars (chrCon :: revCons)) - Can.PBool _ _ -> + T.CASTC_PBool _ _ -> let (State headers vars revCons) = state boolCon : Type.Constraint boolCon = - Type.CPattern region E.CRET_PBool Type.bool expectation + Type.CPattern region T.CRET_PBool Type.bool expectation in IO.pure (State headers vars (boolCon :: revCons)) @@ -212,7 +210,7 @@ emptyState = State Dict.empty [] [] -addToHeaders : T.CRA_Region -> T.CDN_Name -> E.CRET_PExpected Type -> State -> State +addToHeaders : T.CRA_Region -> T.CDN_Name -> T.CRET_PExpected Type -> State -> State addToHeaders region name expectation (State headers vars revCons) = let tipe : Type @@ -226,13 +224,13 @@ addToHeaders region name expectation (State headers vars revCons) = State newHeaders vars revCons -getType : E.CRET_PExpected Type -> Type +getType : T.CRET_PExpected Type -> Type getType expectation = case expectation of - E.CRET_PNoExpectation tipe -> + T.CRET_PNoExpectation tipe -> tipe - E.CRET_PFromContext _ _ tipe -> + T.CRET_PFromContext _ _ tipe -> tipe @@ -240,12 +238,12 @@ getType expectation = -- CONSTRAIN LIST -addEntry : T.CRA_Region -> Type -> State -> ( T.CDI_ZeroBased, Can.Pattern ) -> IO State +addEntry : T.CRA_Region -> Type -> State -> ( T.CDI_ZeroBased, T.CASTC_Pattern ) -> IO State addEntry listRegion tipe state ( index, pattern ) = let - expectation : E.CRET_PExpected Type + expectation : T.CRET_PExpected Type expectation = - E.CRET_PFromContext listRegion (E.CRET_PListEntry index) tipe + T.CRET_PFromContext listRegion (T.CRET_PListEntry index) tipe in add pattern expectation state @@ -254,7 +252,7 @@ addEntry listRegion tipe state ( index, pattern ) = -- CONSTRAIN TUPLE -addTuple : T.CRA_Region -> Can.Pattern -> Can.Pattern -> Maybe Can.Pattern -> E.CRET_PExpected Type -> State -> IO State +addTuple : T.CRA_Region -> T.CASTC_Pattern -> T.CASTC_Pattern -> Maybe T.CASTC_Pattern -> T.CRET_PExpected Type -> State -> IO State addTuple region a b maybeC expectation state = Type.mkFlexVar |> IO.bind @@ -280,7 +278,7 @@ addTuple region a b maybeC expectation state = let tupleCon : Type.Constraint tupleCon = - Type.CPattern region E.CRET_PTuple (Type.TupleN aType bType Nothing) expectation + Type.CPattern region T.CRET_PTuple (Type.TupleN aType bType Nothing) expectation in State headers (aVar :: bVar :: vars) (tupleCon :: revCons) ) @@ -302,7 +300,7 @@ addTuple region a b maybeC expectation state = let tupleCon : Type.Constraint tupleCon = - Type.CPattern region E.CRET_PTuple (Type.TupleN aType bType (Just cType)) expectation + Type.CPattern region T.CRET_PTuple (Type.TupleN aType bType (Just cType)) expectation in State headers (aVar :: bVar :: cVar :: vars) (tupleCon :: revCons) ) @@ -311,16 +309,16 @@ addTuple region a b maybeC expectation state = ) -simpleAdd : Can.Pattern -> Type -> State -> IO State +simpleAdd : T.CASTC_Pattern -> Type -> State -> IO State simpleAdd pattern patternType state = - add pattern (E.CRET_PNoExpectation patternType) state + add pattern (T.CRET_PNoExpectation patternType) state -- CONSTRAIN CONSTRUCTORS -addCtor : T.CRA_Region -> T.CEMN_Canonical -> T.CDN_Name -> List T.CDN_Name -> T.CDN_Name -> List Can.PatternCtorArg -> E.CRET_PExpected Type -> State -> IO State +addCtor : T.CRA_Region -> T.CEMN_Canonical -> T.CDN_Name -> List T.CDN_Name -> T.CDN_Name -> List T.CASTC_PatternCtorArg -> T.CRET_PExpected Type -> State -> IO State addCtor region home typeName typeVarNames ctorName args expectation state = IO.traverseList (\var -> IO.fmap (Tuple.pair var) (Type.nameToFlex var)) typeVarNames |> IO.bind @@ -344,7 +342,7 @@ addCtor region home typeName typeVarNames ctorName args expectation state = ctorCon : Type.Constraint ctorCon = - Type.CPattern region (E.CRET_PCtor ctorName) ctorType expectation + Type.CPattern region (T.CRET_PCtor ctorName) ctorType expectation in IO.pure <| State headers @@ -354,15 +352,15 @@ addCtor region home typeName typeVarNames ctorName args expectation state = ) -addCtorArg : T.CRA_Region -> T.CDN_Name -> Dict String T.CDN_Name Type -> State -> Can.PatternCtorArg -> IO State -addCtorArg region ctorName freeVarDict state (Can.PatternCtorArg index srcType pattern) = +addCtorArg : T.CRA_Region -> T.CDN_Name -> Dict String T.CDN_Name Type -> State -> T.CASTC_PatternCtorArg -> IO State +addCtorArg region ctorName freeVarDict state (T.CASTC_PatternCtorArg index srcType pattern) = Instantiate.fromSrcType freeVarDict srcType |> IO.bind (\tipe -> let - expectation : E.CRET_PExpected Type + expectation : T.CRET_PExpected Type expectation = - E.CRET_PFromContext region (E.CRET_PCtorArg ctorName index) tipe + T.CRET_PFromContext region (T.CRET_PCtorArg ctorName index) tipe in add pattern expectation state ) diff --git a/src/Compiler/Type/Error.elm b/src/Compiler/Type/Error.elm index af4bfa374..24807b09b 100644 --- a/src/Compiler/Type/Error.elm +++ b/src/Compiler/Type/Error.elm @@ -1,9 +1,6 @@ module Compiler.Type.Error exposing ( Direction(..) - , Extension(..) , Problem(..) - , Super(..) - , Type(..) , isChar , isFloat , isInt @@ -32,42 +29,10 @@ import Prelude import Types as T - --- ERROR TYPES - - -type Type - = Lambda Type Type (List Type) - | Infinite - | Error - | FlexVar T.CDN_Name - | FlexSuper Super T.CDN_Name - | RigidVar T.CDN_Name - | RigidSuper Super T.CDN_Name - | Type T.CEMN_Canonical T.CDN_Name (List Type) - | Record (Dict String T.CDN_Name Type) Extension - | Unit - | Tuple Type Type (Maybe Type) - | Alias T.CEMN_Canonical T.CDN_Name (List ( T.CDN_Name, Type )) Type - - -type Super - = Number - | Comparable - | Appendable - | CompAppend - - -type Extension - = Closed - | FlexOpen T.CDN_Name - | RigidOpen T.CDN_Name - - -iteratedDealias : Type -> Type +iteratedDealias : T.CTE_Type -> T.CTE_Type iteratedDealias tipe = case tipe of - Alias _ _ _ real -> + T.CTE_Alias _ _ _ real -> iteratedDealias real _ -> @@ -78,67 +43,67 @@ iteratedDealias tipe = -- TO DOC -toDoc : L.CRRTL_Localizer -> RT.Context -> Type -> D.Doc +toDoc : T.CRRTL_Localizer -> RT.Context -> T.CTE_Type -> D.Doc toDoc localizer ctx tipe = case tipe of - Lambda a b cs -> + T.CTE_Lambda a b cs -> RT.lambda ctx (toDoc localizer RT.Func a) (toDoc localizer RT.Func b) (List.map (toDoc localizer RT.Func) cs) - Infinite -> + T.CTE_Infinite -> D.fromChars "∞" - Error -> + T.CTE_Error -> D.fromChars "?" - FlexVar name -> + T.CTE_FlexVar name -> D.fromName name - FlexSuper _ name -> + T.CTE_FlexSuper _ name -> D.fromName name - RigidVar name -> + T.CTE_RigidVar name -> D.fromName name - RigidSuper _ name -> + T.CTE_RigidSuper _ name -> D.fromName name - Type home name args -> + T.CTE_Type home name args -> RT.apply ctx (L.toDoc localizer home name) (List.map (toDoc localizer RT.App) args) - Record fields ext -> + T.CTE_Record fields ext -> RT.record (fieldsToDocs localizer fields) (extToDoc ext) - Unit -> + T.CTE_Unit -> D.fromChars "()" - Tuple a b maybeC -> + T.CTE_Tuple a b maybeC -> RT.tuple (toDoc localizer RT.None a) (toDoc localizer RT.None b) (List.map (toDoc localizer RT.None) (Maybe.toList maybeC)) - Alias home name args _ -> + T.CTE_Alias home name args _ -> aliasToDoc localizer ctx home name args -aliasToDoc : L.CRRTL_Localizer -> RT.Context -> T.CEMN_Canonical -> T.CDN_Name -> List ( T.CDN_Name, Type ) -> D.Doc +aliasToDoc : T.CRRTL_Localizer -> RT.Context -> T.CEMN_Canonical -> T.CDN_Name -> List ( T.CDN_Name, T.CTE_Type ) -> D.Doc aliasToDoc localizer ctx home name args = RT.apply ctx (L.toDoc localizer home name) (List.map (toDoc localizer RT.App << Tuple.second) args) -fieldsToDocs : L.CRRTL_Localizer -> Dict String T.CDN_Name Type -> List ( D.Doc, D.Doc ) +fieldsToDocs : T.CRRTL_Localizer -> Dict String T.CDN_Name T.CTE_Type -> List ( D.Doc, D.Doc ) fieldsToDocs localizer fields = Dict.foldr compare (addField localizer) [] fields -addField : L.CRRTL_Localizer -> T.CDN_Name -> Type -> List ( D.Doc, D.Doc ) -> List ( D.Doc, D.Doc ) +addField : T.CRRTL_Localizer -> T.CDN_Name -> T.CTE_Type -> List ( D.Doc, D.Doc ) -> List ( D.Doc, D.Doc ) addField localizer fieldName fieldType docs = let f : D.Doc @@ -152,16 +117,16 @@ addField localizer fieldName fieldType docs = ( f, t ) :: docs -extToDoc : Extension -> Maybe D.Doc +extToDoc : T.CTE_Extension -> Maybe D.Doc extToDoc ext = case ext of - Closed -> + T.CTE_Closed -> Nothing - FlexOpen x -> + T.CTE_FlexOpen x -> Just (D.fromName x) - RigidOpen x -> + T.CTE_RigidOpen x -> Just (D.fromName x) @@ -187,9 +152,9 @@ type Problem | AnythingToBool | AnythingFromMaybe | ArityMismatch Int Int - | BadFlexSuper Direction Super Type - | BadRigidVar T.CDN_Name Type - | BadRigidSuper Super T.CDN_Name Type + | BadFlexSuper Direction T.CTE_Super T.CTE_Type + | BadRigidVar T.CDN_Name T.CTE_Type + | BadRigidSuper T.CTE_Super T.CDN_Name T.CTE_Type | FieldTypo T.CDN_Name (List T.CDN_Name) | FieldsMissing (List T.CDN_Name) @@ -238,7 +203,7 @@ merge status1 status2 = -- COMPARISON -toComparison : L.CRRTL_Localizer -> Type -> Type -> ( D.Doc, D.Doc, List Problem ) +toComparison : T.CRRTL_Localizer -> T.CTE_Type -> T.CTE_Type -> ( D.Doc, D.Doc, List Problem ) toComparison localizer tipe1 tipe2 = case toDiff localizer RT.None tipe1 tipe2 of Diff doc1 doc2 Similar -> @@ -248,67 +213,67 @@ toComparison localizer tipe1 tipe2 = ( doc1, doc2, Bag.toList problems ) -toDiff : L.CRRTL_Localizer -> RT.Context -> Type -> Type -> Diff D.Doc +toDiff : T.CRRTL_Localizer -> RT.Context -> T.CTE_Type -> T.CTE_Type -> Diff D.Doc toDiff localizer ctx tipe1 tipe2 = case ( tipe1, tipe2 ) of - ( Unit, Unit ) -> + ( T.CTE_Unit, T.CTE_Unit ) -> same localizer ctx tipe1 - ( Error, Error ) -> + ( T.CTE_Error, T.CTE_Error ) -> same localizer ctx tipe1 - ( Infinite, Infinite ) -> + ( T.CTE_Infinite, T.CTE_Infinite ) -> same localizer ctx tipe1 - ( FlexVar x, FlexVar y ) -> + ( T.CTE_FlexVar x, T.CTE_FlexVar y ) -> if x == y then same localizer ctx tipe1 else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( FlexSuper _ x, FlexSuper _ y ) -> + ( T.CTE_FlexSuper _ x, T.CTE_FlexSuper _ y ) -> if x == y then same localizer ctx tipe1 else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( RigidVar x, RigidVar y ) -> + ( T.CTE_RigidVar x, T.CTE_RigidVar y ) -> if x == y then same localizer ctx tipe1 else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( RigidSuper _ x, RigidSuper _ y ) -> + ( T.CTE_RigidSuper _ x, T.CTE_RigidSuper _ y ) -> if x == y then same localizer ctx tipe1 else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( FlexVar _, _ ) -> + ( T.CTE_FlexVar _, _ ) -> similar localizer ctx tipe1 tipe2 - ( _, FlexVar _ ) -> + ( _, T.CTE_FlexVar _ ) -> similar localizer ctx tipe1 tipe2 - ( FlexSuper s _, t ) -> + ( T.CTE_FlexSuper s _, t ) -> if isSuper s t then similar localizer ctx tipe1 tipe2 else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( t, FlexSuper s _ ) -> + ( t, T.CTE_FlexSuper s _ ) -> if isSuper s t then similar localizer ctx tipe1 tipe2 else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( Lambda a b cs, Lambda x y zs ) -> + ( T.CTE_Lambda a b cs, T.CTE_Lambda x y zs ) -> if List.length cs == List.length zs then toDiff localizer RT.Func a x |> fmapDiff (RT.lambda ctx) @@ -320,7 +285,7 @@ toDiff localizer ctx tipe1 tipe2 = else let - f : Type -> D.Doc + f : T.CTE_Type -> D.Doc f = toDoc localizer RT.Func in @@ -329,22 +294,22 @@ toDiff localizer ctx tipe1 tipe2 = (D.dullyellow (RT.lambda ctx (f x) (f y) (List.map f zs))) (Bag.one (ArityMismatch (2 + List.length cs) (2 + List.length zs))) - ( Tuple a b Nothing, Tuple x y Nothing ) -> + ( T.CTE_Tuple a b Nothing, T.CTE_Tuple x y Nothing ) -> toDiff localizer RT.None a x |> fmapDiff RT.tuple |> applyDiff (toDiff localizer RT.None b y) |> applyDiff (Diff [] [] Similar) - ( Tuple a b (Just c), Tuple x y (Just z) ) -> + ( T.CTE_Tuple a b (Just c), T.CTE_Tuple x y (Just z) ) -> toDiff localizer RT.None a x |> fmapDiff RT.tuple |> applyDiff (toDiff localizer RT.None b y) |> applyDiff (fmapDiff List.singleton (toDiff localizer RT.None c z)) - ( Record fields1 ext1, Record fields2 ext2 ) -> + ( T.CTE_Record fields1 ext1, T.CTE_Record fields2 ext2 ) -> diffRecord localizer fields1 ext1 fields2 ext2 - ( Type home1 name1 args1, Type home2 name2 args2 ) -> + ( T.CTE_Type home1 name1 args1, T.CTE_Type home2 name2 args2 ) -> if home1 == home2 && name1 == name2 then List.map2 (toDiff localizer RT.App) args1 args2 |> List.foldr (liftA2 (::)) (pureDiff []) @@ -360,7 +325,7 @@ toDiff localizer ctx tipe1 tipe2 = else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( Alias home1 name1 args1 _, Alias home2 name2 args2 _ ) -> + ( T.CTE_Alias home1 name1 args1 _, T.CTE_Alias home2 name2 args2 _ ) -> if home1 == home2 && name1 == name2 then List.map2 (toDiff localizer RT.App) (List.map Tuple.second args1) (List.map Tuple.second args2) |> List.foldr (liftA2 (::)) (pureDiff []) @@ -370,7 +335,7 @@ toDiff localizer ctx tipe1 tipe2 = toDiffOtherwise localizer ctx ( tipe1, tipe2 ) -- start trying to find specific problems (moved first check above) - ( Type home name [ t1 ], t2 ) -> + ( T.CTE_Type home name [ t1 ], t2 ) -> if isMaybe home name && isSimilar (toDiff localizer ctx t1 t2) then different (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [ toDoc localizer RT.App t1 ]) @@ -380,7 +345,7 @@ toDiff localizer ctx tipe1 tipe2 = else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( t1, Type home name [ t2 ] ) -> + ( t1, T.CTE_Type home name [ t2 ] ) -> if isList home name && isSimilar (toDiff localizer ctx t1 t2) then different (toDoc localizer ctx t1) @@ -390,14 +355,14 @@ toDiff localizer ctx tipe1 tipe2 = else toDiffOtherwise localizer ctx ( tipe1, tipe2 ) - ( Alias home1 name1 args1 t1, t2 ) -> + ( T.CTE_Alias home1 name1 args1 t1, t2 ) -> case diffAliasedRecord localizer t1 t2 of Just (Diff _ doc2 status) -> Diff (D.dullyellow (aliasToDoc localizer ctx home1 name1 args1)) doc2 status Nothing -> case tipe2 of - Type home2 name2 args2 -> + T.CTE_Type home2 name2 args2 -> if L.toChars localizer home1 name1 == L.toChars localizer home2 name2 then different (nameClashToDoc ctx localizer home1 name1 (List.map Tuple.second args1)) @@ -416,14 +381,14 @@ toDiff localizer ctx tipe1 tipe2 = (D.dullyellow (toDoc localizer ctx tipe2)) Bag.empty - ( _, Alias home2 name2 args2 _ ) -> + ( _, T.CTE_Alias home2 name2 args2 _ ) -> case diffAliasedRecord localizer tipe1 tipe2 of Just (Diff doc1 _ status) -> Diff doc1 (D.dullyellow (aliasToDoc localizer ctx home2 name2 args2)) status Nothing -> case tipe1 of - Type home1 name1 args1 -> + T.CTE_Type home1 name1 args1 -> if L.toChars localizer home1 name1 == L.toChars localizer home2 name2 then different (nameClashToDoc ctx localizer home1 name1 args1) @@ -446,7 +411,7 @@ toDiff localizer ctx tipe1 tipe2 = toDiffOtherwise localizer ctx pair -toDiffOtherwise : L.CRRTL_Localizer -> RT.Context -> ( Type, Type ) -> Diff D.Doc +toDiffOtherwise : T.CRRTL_Localizer -> RT.Context -> ( T.CTE_Type, T.CTE_Type ) -> Diff D.Doc toDiffOtherwise localizer ctx (( tipe1, tipe2 ) as pair) = let doc1 : D.Doc @@ -459,25 +424,25 @@ toDiffOtherwise localizer ctx (( tipe1, tipe2 ) as pair) = in different doc1 doc2 <| case pair of - ( RigidVar x, other ) -> + ( T.CTE_RigidVar x, other ) -> Bag.one <| BadRigidVar x other - ( FlexSuper s _, other ) -> + ( T.CTE_FlexSuper s _, other ) -> Bag.one <| BadFlexSuper Have s other - ( RigidSuper s x, other ) -> + ( T.CTE_RigidSuper s x, other ) -> Bag.one <| BadRigidSuper s x other - ( other, RigidVar x ) -> + ( other, T.CTE_RigidVar x ) -> Bag.one <| BadRigidVar x other - ( other, FlexSuper s _ ) -> + ( other, T.CTE_FlexSuper s _ ) -> Bag.one <| BadFlexSuper Need s other - ( other, RigidSuper s x ) -> + ( other, T.CTE_RigidSuper s x ) -> Bag.one <| BadRigidSuper s x other - ( Type home1 name1 [], Type home2 name2 [] ) -> + ( T.CTE_Type home1 name1 [], T.CTE_Type home2 name2 [] ) -> if isInt home1 name1 && isFloat home2 name2 then Bag.one <| IntFloat @@ -510,7 +475,7 @@ toDiffOtherwise localizer ctx (( tipe1, tipe2 ) as pair) = -- DIFF HELPERS -same : L.CRRTL_Localizer -> RT.Context -> Type -> Diff D.Doc +same : T.CRRTL_Localizer -> RT.Context -> T.CTE_Type -> Diff D.Doc same localizer ctx tipe = let doc : D.Doc @@ -520,7 +485,7 @@ same localizer ctx tipe = Diff doc doc Similar -similar : L.CRRTL_Localizer -> RT.Context -> Type -> Type -> Diff D.Doc +similar : T.CRRTL_Localizer -> RT.Context -> T.CTE_Type -> T.CTE_Type -> Diff D.Doc similar localizer ctx t1 t2 = Diff (toDoc localizer ctx t1) (toDoc localizer ctx t2) Similar @@ -583,35 +548,35 @@ isList home name = -- IS SUPER? -isSuper : Super -> Type -> Bool +isSuper : T.CTE_Super -> T.CTE_Type -> Bool isSuper super tipe = case iteratedDealias tipe of - Type h n args -> + T.CTE_Type h n args -> case super of - Number -> + T.CTE_Number -> isInt h n || isFloat h n - Comparable -> + T.CTE_Comparable -> isInt h n || isFloat h n || isString h n || isChar h n || isList h n && isSuper super (Prelude.head args) - Appendable -> + T.CTE_Appendable -> isString h n || isList h n - CompAppend -> - isString h n || isList h n && isSuper Comparable (Prelude.head args) + T.CTE_CompAppend -> + isString h n || isList h n && isSuper T.CTE_Comparable (Prelude.head args) - Tuple a b maybeC -> + T.CTE_Tuple a b maybeC -> case super of - Number -> + T.CTE_Number -> False - Comparable -> + T.CTE_Comparable -> isSuper super a && isSuper super b && Maybe.withDefault True (Maybe.map (isSuper super) maybeC) - Appendable -> + T.CTE_Appendable -> False - CompAppend -> + T.CTE_CompAppend -> False _ -> @@ -622,7 +587,7 @@ isSuper super tipe = -- NAME CLASH -nameClashToDoc : RT.Context -> L.CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> List Type -> D.Doc +nameClashToDoc : RT.Context -> T.CRRTL_Localizer -> T.CEMN_Canonical -> T.CDN_Name -> List T.CTE_Type -> D.Doc nameClashToDoc ctx localizer (T.CEMN_Canonical _ home) name args = RT.apply ctx (D.yellow (D.fromName home) |> D.a (D.dullyellow (D.fromChars "." |> D.a (D.fromName name)))) @@ -633,10 +598,10 @@ nameClashToDoc ctx localizer (T.CEMN_Canonical _ home) name args = -- DIFF ALIASED RECORD -diffAliasedRecord : L.CRRTL_Localizer -> Type -> Type -> Maybe (Diff D.Doc) +diffAliasedRecord : T.CRRTL_Localizer -> T.CTE_Type -> T.CTE_Type -> Maybe (Diff D.Doc) diffAliasedRecord localizer t1 t2 = case ( iteratedDealias t1, iteratedDealias t2 ) of - ( Record fields1 ext1, Record fields2 ext2 ) -> + ( T.CTE_Record fields1 ext1, T.CTE_Record fields2 ext2 ) -> Just (diffRecord localizer fields1 ext1 fields2 ext2) _ -> @@ -647,14 +612,14 @@ diffAliasedRecord localizer t1 t2 = -- RECORD DIFFS -diffRecord : L.CRRTL_Localizer -> Dict String T.CDN_Name Type -> Extension -> Dict String T.CDN_Name Type -> Extension -> Diff D.Doc +diffRecord : T.CRRTL_Localizer -> Dict String T.CDN_Name T.CTE_Type -> T.CTE_Extension -> Dict String T.CDN_Name T.CTE_Type -> T.CTE_Extension -> Diff D.Doc diffRecord localizer fields1 ext1 fields2 ext2 = let - toUnknownDocs : T.CDN_Name -> Type -> ( D.Doc, D.Doc ) + toUnknownDocs : T.CDN_Name -> T.CTE_Type -> ( D.Doc, D.Doc ) toUnknownDocs field tipe = ( D.dullyellow (D.fromName field), toDoc localizer RT.None tipe ) - toOverlapDocs : T.CDN_Name -> Type -> Type -> Diff ( D.Doc, D.Doc ) + toOverlapDocs : T.CDN_Name -> T.CTE_Type -> T.CTE_Type -> Diff ( D.Doc, D.Doc ) toOverlapDocs field t1 t2 = fmapDiff (Tuple.pair (D.fromName field)) <| toDiff localizer RT.None t1 t2 @@ -757,16 +722,16 @@ diffRecord localizer fields1 ext1 fields2 ext2 = Similar -hasFixedFields : Extension -> Bool +hasFixedFields : T.CTE_Extension -> Bool hasFixedFields ext = case ext of - Closed -> + T.CTE_Closed -> True - FlexOpen _ -> + T.CTE_FlexOpen _ -> False - RigidOpen _ -> + T.CTE_RigidOpen _ -> True @@ -774,7 +739,7 @@ hasFixedFields ext = -- DIFF RECORD EXTENSION -extToDiff : Extension -> Extension -> Diff (Maybe D.Doc) +extToDiff : T.CTE_Extension -> T.CTE_Extension -> Diff (Maybe D.Doc) extToDiff ext1 ext2 = let status : Status @@ -797,47 +762,47 @@ extToDiff ext1 ext2 = Diff (Maybe.map D.dullyellow extDoc1) (Maybe.map D.dullyellow extDoc2) status -extToStatus : Extension -> Extension -> Status +extToStatus : T.CTE_Extension -> T.CTE_Extension -> Status extToStatus ext1 ext2 = case ext1 of - Closed -> + T.CTE_Closed -> case ext2 of - Closed -> + T.CTE_Closed -> Similar - FlexOpen _ -> + T.CTE_FlexOpen _ -> Similar - RigidOpen _ -> + T.CTE_RigidOpen _ -> Different Bag.empty - FlexOpen _ -> + T.CTE_FlexOpen _ -> Similar - RigidOpen x -> + T.CTE_RigidOpen x -> case ext2 of - Closed -> + T.CTE_Closed -> Different Bag.empty - FlexOpen _ -> + T.CTE_FlexOpen _ -> Similar - RigidOpen y -> + T.CTE_RigidOpen y -> if x == y then Similar else - Different (Bag.one (BadRigidVar x (RigidVar y))) + Different (Bag.one (BadRigidVar x (T.CTE_RigidVar y))) -- ENCODERS and DECODERS -typeEncoder : Type -> Encode.Value +typeEncoder : T.CTE_Type -> Encode.Value typeEncoder type_ = case type_ of - Lambda x y zs -> + T.CTE_Lambda x y zs -> Encode.object [ ( "type", Encode.string "Lambda" ) , ( "x", typeEncoder x ) @@ -845,43 +810,43 @@ typeEncoder type_ = , ( "zs", Encode.list typeEncoder zs ) ] - Infinite -> + T.CTE_Infinite -> Encode.object [ ( "type", Encode.string "Infinite" ) ] - Error -> + T.CTE_Error -> Encode.object [ ( "type", Encode.string "Error" ) ] - FlexVar name -> + T.CTE_FlexVar name -> Encode.object [ ( "type", Encode.string "FlexVar" ) , ( "name", Encode.string name ) ] - FlexSuper s x -> + T.CTE_FlexSuper s x -> Encode.object [ ( "type", Encode.string "FlexSuper" ) , ( "s", superEncoder s ) , ( "x", Encode.string x ) ] - RigidVar name -> + T.CTE_RigidVar name -> Encode.object [ ( "type", Encode.string "RigidVar" ) , ( "name", Encode.string name ) ] - RigidSuper s x -> + T.CTE_RigidSuper s x -> Encode.object [ ( "type", Encode.string "RigidSuper" ) , ( "s", superEncoder s ) , ( "x", Encode.string x ) ] - Type home name args -> + T.CTE_Type home name args -> Encode.object [ ( "type", Encode.string "Type" ) , ( "home", ModuleName.canonicalEncoder home ) @@ -889,19 +854,19 @@ typeEncoder type_ = , ( "args", Encode.list typeEncoder args ) ] - Record msgType decoder -> + T.CTE_Record msgType decoder -> Encode.object [ ( "type", Encode.string "Record" ) , ( "msgType", EncodeX.assocListDict compare Encode.string typeEncoder msgType ) , ( "decoder", extensionEncoder decoder ) ] - Unit -> + T.CTE_Unit -> Encode.object [ ( "type", Encode.string "Unit" ) ] - Tuple a b maybeC -> + T.CTE_Tuple a b maybeC -> Encode.object [ ( "type", Encode.string "Tuple" ) , ( "a", typeEncoder a ) @@ -909,7 +874,7 @@ typeEncoder type_ = , ( "maybeC", EncodeX.maybe typeEncoder maybeC ) ] - Alias home name args tipe -> + T.CTE_Alias home name args tipe -> Encode.object [ ( "type", Encode.string "Alias" ) , ( "home", ModuleName.canonicalEncoder home ) @@ -919,62 +884,62 @@ typeEncoder type_ = ] -typeDecoder : Decode.Decoder Type +typeDecoder : Decode.Decoder T.CTE_Type typeDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Lambda" -> - Decode.map3 Lambda + Decode.map3 T.CTE_Lambda (Decode.field "x" typeDecoder) (Decode.field "y" typeDecoder) (Decode.field "zs" (Decode.list typeDecoder)) "Infinite" -> - Decode.succeed Infinite + Decode.succeed T.CTE_Infinite "Error" -> - Decode.succeed Error + Decode.succeed T.CTE_Error "FlexVar" -> - Decode.map FlexVar (Decode.field "name" Decode.string) + Decode.map T.CTE_FlexVar (Decode.field "name" Decode.string) "FlexSuper" -> - Decode.map2 FlexSuper + Decode.map2 T.CTE_FlexSuper (Decode.field "s" superDecoder) (Decode.field "x" Decode.string) "RigidVar" -> - Decode.map RigidVar (Decode.field "name" Decode.string) + Decode.map T.CTE_RigidVar (Decode.field "name" Decode.string) "RigidSuper" -> - Decode.map2 RigidSuper + Decode.map2 T.CTE_RigidSuper (Decode.field "s" superDecoder) (Decode.field "x" Decode.string) "Type" -> - Decode.map3 Type + Decode.map3 T.CTE_Type (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) (Decode.field "args" (Decode.list typeDecoder)) "Record" -> - Decode.map2 Record + Decode.map2 T.CTE_Record (Decode.field "msgType" (DecodeX.assocListDict identity Decode.string typeDecoder)) (Decode.field "decoder" extensionDecoder) "Unit" -> - Decode.succeed Unit + Decode.succeed T.CTE_Unit "Tuple" -> - Decode.map3 Tuple + Decode.map3 T.CTE_Tuple (Decode.field "a" typeDecoder) (Decode.field "b" typeDecoder) (Decode.field "maybeC" (Decode.maybe typeDecoder)) "Alias" -> - Decode.map4 Alias + Decode.map4 T.CTE_Alias (Decode.field "home" ModuleName.canonicalDecoder) (Decode.field "name" Decode.string) (Decode.field "args" (Decode.list (DecodeX.jsonPair Decode.string typeDecoder))) @@ -985,80 +950,80 @@ typeDecoder = ) -superEncoder : Super -> Encode.Value +superEncoder : T.CTE_Super -> Encode.Value superEncoder super = case super of - Number -> + T.CTE_Number -> Encode.string "Number" - Comparable -> + T.CTE_Comparable -> Encode.string "Comparable" - Appendable -> + T.CTE_Appendable -> Encode.string "Appendable" - CompAppend -> + T.CTE_CompAppend -> Encode.string "CompAppend" -superDecoder : Decode.Decoder Super +superDecoder : Decode.Decoder T.CTE_Super superDecoder = Decode.string |> Decode.andThen (\str -> case str of "Number" -> - Decode.succeed Number + Decode.succeed T.CTE_Number "Comparable" -> - Decode.succeed Comparable + Decode.succeed T.CTE_Comparable "Appendable" -> - Decode.succeed Appendable + Decode.succeed T.CTE_Appendable "CompAppend" -> - Decode.succeed CompAppend + Decode.succeed T.CTE_CompAppend _ -> Decode.fail ("Unknown Super: " ++ str) ) -extensionEncoder : Extension -> Encode.Value +extensionEncoder : T.CTE_Extension -> Encode.Value extensionEncoder extension = case extension of - Closed -> + T.CTE_Closed -> Encode.object [ ( "type", Encode.string "Closed" ) ] - FlexOpen x -> + T.CTE_FlexOpen x -> Encode.object [ ( "type", Encode.string "FlexOpen" ) , ( "x", Encode.string x ) ] - RigidOpen x -> + T.CTE_RigidOpen x -> Encode.object [ ( "type", Encode.string "RigidOpen" ) , ( "x", Encode.string x ) ] -extensionDecoder : Decode.Decoder Extension +extensionDecoder : Decode.Decoder T.CTE_Extension extensionDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Closed" -> - Decode.succeed Closed + Decode.succeed T.CTE_Closed "FlexOpen" -> - Decode.map FlexOpen (Decode.field "x" Decode.string) + Decode.map T.CTE_FlexOpen (Decode.field "x" Decode.string) "RigidOpen" -> - Decode.map RigidOpen (Decode.field "x" Decode.string) + Decode.map T.CTE_RigidOpen (Decode.field "x" Decode.string) _ -> Decode.fail ("Unknown Extension's type: " ++ type_) diff --git a/src/Compiler/Type/Solve.elm b/src/Compiler/Type/Solve.elm index f231f8a4d..286960e50 100644 --- a/src/Compiler/Type/Solve.elm +++ b/src/Compiler/Type/Solve.elm @@ -27,7 +27,7 @@ import Utils.Main as Utils -- RUN SOLVER -run : Constraint -> IO (Result (NE.Nonempty Error.CRET_Error) (Dict String T.CDN_Name T.CASTC_Annotation)) +run : Constraint -> IO (Result (NE.Nonempty T.CRET_Error) (Dict String T.CDN_Name T.CASTC_Annotation)) run constraint = MVector.replicate 8 [] |> IO.bind @@ -64,7 +64,7 @@ type alias Pools = type State - = State Env Mark (List Error.CRET_Error) + = State Env Mark (List T.CRET_Error) solve : Env -> Int -> Pools -> State -> Constraint -> IO State @@ -96,7 +96,7 @@ solve env rank pools ((State _ sMark sErrors) as state) constraint = |> IO.fmap (\_ -> addError state <| - Error.CRET_BadExpr region category actualType <| + T.CRET_BadExpr region category actualType <| Error.typeReplace expectation expectedType ) ) @@ -123,7 +123,7 @@ solve env rank pools ((State _ sMark sErrors) as state) constraint = |> IO.fmap (\_ -> addError state <| - Error.CRET_BadExpr region (Error.CRET_Local name) actualType <| + T.CRET_BadExpr region (T.CRET_Local name) actualType <| Error.typeReplace expectation expectedType ) ) @@ -150,7 +150,7 @@ solve env rank pools ((State _ sMark sErrors) as state) constraint = |> IO.fmap (\_ -> addError state <| - Error.CRET_BadExpr region (Error.CRET_Foreign name) actualType <| + T.CRET_BadExpr region (T.CRET_Foreign name) actualType <| Error.typeReplace expectation expectedType ) ) @@ -177,7 +177,7 @@ solve env rank pools ((State _ sMark sErrors) as state) constraint = |> IO.fmap (\_ -> addError state <| - Error.CRET_BadPattern region + T.CRET_BadPattern region category actualType (Error.ptypeReplace expectation expectedType) @@ -336,28 +336,28 @@ isGeneric var = -- EXPECTATIONS TO VARIABLE -expectedToVariable : Int -> Pools -> Error.CRET_Expected Type -> IO Variable +expectedToVariable : Int -> Pools -> T.CRET_Expected Type -> IO Variable expectedToVariable rank pools expectation = typeToVariable rank pools <| case expectation of - Error.NoExpectation tipe -> + T.CRET_NoExpectation tipe -> tipe - Error.FromContext _ _ tipe -> + T.CRET_FromContext _ _ tipe -> tipe - Error.FromAnnotation _ _ _ tipe -> + T.CRET_FromAnnotation _ _ _ tipe -> tipe -patternExpectationToVariable : Int -> Pools -> Error.CRET_PExpected Type -> IO Variable +patternExpectationToVariable : Int -> Pools -> T.CRET_PExpected Type -> IO Variable patternExpectationToVariable rank pools expectation = typeToVariable rank pools <| case expectation of - Error.CRET_PNoExpectation tipe -> + T.CRET_PNoExpectation tipe -> tipe - Error.CRET_PFromContext _ _ tipe -> + T.CRET_PFromContext _ _ tipe -> tipe @@ -365,7 +365,7 @@ patternExpectationToVariable rank pools expectation = -- ERROR HELPERS -addError : State -> Error.CRET_Error -> State +addError : State -> T.CRET_Error -> State addError (State savedEnv rank errors) err = State savedEnv rank (err :: errors) @@ -387,7 +387,7 @@ occurs state ( name, T.CRA_At region variable ) = |> IO.bind (\(Descriptor _ rank mark copy) -> UF.set variable (Descriptor IO.Error rank mark copy) - |> IO.fmap (\_ -> addError state (Error.CRET_InfiniteType region name errorType)) + |> IO.fmap (\_ -> addError state (T.CRET_InfiniteType region name errorType)) ) ) diff --git a/src/Compiler/Type/Type.elm b/src/Compiler/Type/Type.elm index e738baae8..8c50df4da 100644 --- a/src/Compiler/Type/Type.elm +++ b/src/Compiler/Type/Type.elm @@ -31,7 +31,6 @@ module Compiler.Type.Type exposing import Compiler.AST.Utils.Type as Type import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName -import Compiler.Reporting.Error.Type as E import Compiler.Type.Error as ET import Compiler.Type.UnionFind as UF import Control.Monad.State.TypeCheck.Strict as State exposing (StateT, liftIO) @@ -49,10 +48,10 @@ import Utils.Crash exposing (crash) type Constraint = CTrue | CSaveTheEnvironment - | CEqual T.CRA_Region E.CRET_Category Type (E.CRET_Expected Type) - | CLocal T.CRA_Region T.CDN_Name (E.CRET_Expected Type) - | CForeign T.CRA_Region T.CDN_Name T.CASTC_Annotation (E.CRET_Expected Type) - | CPattern T.CRA_Region E.CRET_PCategory Type (E.CRET_PExpected Type) + | CEqual T.CRA_Region T.CRET_Category Type (T.CRET_Expected Type) + | CLocal T.CRA_Region T.CDN_Name (T.CRET_Expected Type) + | CForeign T.CRA_Region T.CDN_Name T.CASTC_Annotation (T.CRET_Expected Type) + | CPattern T.CRA_Region T.CRET_PCategory Type (T.CRET_PExpected Type) | CAnd (List Constraint) | CLet (List Variable) (List Variable) (Dict String T.CDN_Name (T.CRA_Located Type)) Constraint Constraint @@ -410,7 +409,7 @@ fieldToCanType variable = -- TO ERROR TYPE -toErrorType : Variable -> IO ET.Type +toErrorType : Variable -> IO T.CTE_Type toErrorType variable = getVarNames variable Dict.empty |> IO.bind @@ -419,13 +418,13 @@ toErrorType variable = ) -variableToErrorType : Variable -> StateT NameState ET.Type +variableToErrorType : Variable -> StateT NameState T.CTE_Type variableToErrorType variable = liftIO (UF.get variable) |> State.bind (\(Descriptor content _ mark _) -> if mark == occursMark then - State.pure ET.Infinite + State.pure T.CTE_Infinite else liftIO (UF.modify variable (\(Descriptor content_ rank_ _ copy_) -> Descriptor content_ rank_ occursMark copy_)) @@ -441,7 +440,7 @@ variableToErrorType variable = ) -contentToErrorType : Variable -> Content -> StateT NameState ET.Type +contentToErrorType : Variable -> Content -> StateT NameState T.CTE_Type contentToErrorType variable content = case content of Structure term -> @@ -450,7 +449,7 @@ contentToErrorType variable content = FlexVar maybeName -> case maybeName of Just name -> - State.pure (ET.FlexVar name) + State.pure (T.CTE_FlexVar name) Nothing -> getFreshVarName @@ -462,13 +461,13 @@ contentToErrorType variable content = Descriptor (FlexVar (Just name)) rank mark copy ) ) - |> State.fmap (\_ -> ET.FlexVar name) + |> State.fmap (\_ -> T.CTE_FlexVar name) ) FlexSuper super maybeName -> case maybeName of Just name -> - State.pure (ET.FlexSuper (superToSuper super) name) + State.pure (T.CTE_FlexSuper (superToSuper super) name) Nothing -> getFreshSuperName super @@ -480,14 +479,14 @@ contentToErrorType variable content = Descriptor (FlexSuper super (Just name)) rank mark copy ) ) - |> State.fmap (\_ -> ET.FlexSuper (superToSuper super) name) + |> State.fmap (\_ -> T.CTE_FlexSuper (superToSuper super) name) ) RigidVar name -> - State.pure (ET.RigidVar name) + State.pure (T.CTE_RigidVar name) RigidSuper super name -> - State.pure (ET.RigidSuper (superToSuper super) name) + State.pure (T.CTE_RigidSuper (superToSuper super) name) Alias home name args realVariable -> State.traverseList (State.traverseTuple variableToErrorType) args @@ -496,36 +495,36 @@ contentToErrorType variable content = variableToErrorType realVariable |> State.fmap (\errType -> - ET.Alias home name errArgs errType + T.CTE_Alias home name errArgs errType ) ) Error -> - State.pure ET.Error + State.pure T.CTE_Error -superToSuper : SuperType -> ET.Super +superToSuper : SuperType -> T.CTE_Super superToSuper super = case super of Number -> - ET.Number + T.CTE_Number Comparable -> - ET.Comparable + T.CTE_Comparable Appendable -> - ET.Appendable + T.CTE_Appendable CompAppend -> - ET.CompAppend + T.CTE_CompAppend -termToErrorType : FlatType -> StateT NameState ET.Type +termToErrorType : FlatType -> StateT NameState T.CTE_Type termToErrorType term = case term of App1 home name args -> State.traverseList variableToErrorType args - |> State.fmap (ET.Type home name) + |> State.fmap (T.CTE_Type home name) Fun1 a b -> variableToErrorType a @@ -535,16 +534,16 @@ termToErrorType term = |> State.fmap (\result -> case result of - ET.Lambda arg1 arg2 others -> - ET.Lambda arg arg1 (arg2 :: others) + T.CTE_Lambda arg1 arg2 others -> + T.CTE_Lambda arg arg1 (arg2 :: others) _ -> - ET.Lambda arg result [] + T.CTE_Lambda arg result [] ) ) EmptyRecord1 -> - State.pure (ET.Record Dict.empty ET.Closed) + State.pure (T.CTE_Record Dict.empty T.CTE_Closed) Record1 fields extension -> State.traverseMap compare identity variableToErrorType fields @@ -555,14 +554,14 @@ termToErrorType term = |> State.fmap (\errExt -> case errExt of - ET.Record subFields subExt -> - ET.Record (Dict.union subFields errFields) subExt + T.CTE_Record subFields subExt -> + T.CTE_Record (Dict.union subFields errFields) subExt - ET.FlexVar ext -> - ET.Record errFields (ET.FlexOpen ext) + T.CTE_FlexVar ext -> + T.CTE_Record errFields (T.CTE_FlexOpen ext) - ET.RigidVar ext -> - ET.Record errFields (ET.RigidOpen ext) + T.CTE_RigidVar ext -> + T.CTE_Record errFields (T.CTE_RigidOpen ext) _ -> crash "Used toErrorType on a type that is not well-formed" @@ -570,10 +569,10 @@ termToErrorType term = ) Unit1 -> - State.pure ET.Unit + State.pure T.CTE_Unit Tuple1 a b maybeC -> - State.pure ET.Tuple + State.pure T.CTE_Tuple |> State.apply (variableToErrorType a) |> State.apply (variableToErrorType b) |> State.apply (State.traverseMaybe variableToErrorType maybeC) diff --git a/src/Compiler/Type/Unify.elm b/src/Compiler/Type/Unify.elm index a299ff50d..7d83b0402 100644 --- a/src/Compiler/Type/Unify.elm +++ b/src/Compiler/Type/Unify.elm @@ -21,7 +21,7 @@ import Utils.Main as Utils type Answer = AnswerOk (List IO.Variable) - | AnswerErr (List IO.Variable) Error.Type Error.Type + | AnswerErr (List IO.Variable) T.CTE_Type T.CTE_Type unify : IO.Variable -> IO.Variable -> IO Answer diff --git a/src/System/IO.elm b/src/System/IO.elm index 41c9d0313..2cce8a13c 100644 --- a/src/System/IO.elm +++ b/src/System/IO.elm @@ -12,7 +12,9 @@ port module System.IO exposing , putStr, putStrLn, getLine , ReplState(..), initialReplState , MVarSubscriber(..) - , MVarSubscriber_Maybe_BED_Status(..), MVarSubscriber_Maybe_CASTO_GlobalGraph(..), MVarSubscriber_Maybe_CASTO_LocalGraph(..) + , MVarSubscriber_Maybe_BED_Status(..) + , MVarSubscriber_Maybe_CASTO_GlobalGraph(..) + , MVarSubscriber_Maybe_CASTO_LocalGraph(..) ) {-| Ref.: @@ -78,6 +80,9 @@ port module System.IO exposing # MVar @docs MVarSubscriber +@docs MVarSubscriber_Maybe_BED_Status +@docs MVarSubscriber_Maybe_CASTO_GlobalGraph +@docs MVarSubscriber_Maybe_CASTO_LocalGraph -} diff --git a/src/Terminal/Diff.elm b/src/Terminal/Diff.elm index 96545ddc7..fc5079e6a 100644 --- a/src/Terminal/Diff.elm +++ b/src/Terminal/Diff.elm @@ -229,7 +229,7 @@ writeDiff oldDocs newDocs = changes = DD.diff oldDocs newDocs - localizer : L.CRRTL_Localizer + localizer : T.CRRTL_Localizer localizer = L.fromNames (Dict.union oldDocs newDocs) in @@ -240,7 +240,7 @@ writeDiff oldDocs newDocs = -- TO DOC -toDoc : L.CRRTL_Localizer -> PackageChanges -> D.Doc +toDoc : T.CRRTL_Localizer -> PackageChanges -> D.Doc toDoc localizer ((PackageChanges added changed removed) as changes) = if List.isEmpty added && Dict.isEmpty changed && List.isEmpty removed then D.fromChars "No API changes detected, so this is a" @@ -312,7 +312,7 @@ chunkToDoc (Chunk title magnitude details) = ] -changesToChunk : L.CRRTL_Localizer -> ( T.CDN_Name, ModuleChanges ) -> Chunk +changesToChunk : T.CRRTL_Localizer -> ( T.CDN_Name, ModuleChanges ) -> Chunk changesToChunk localizer ( name, (ModuleChanges unions aliases values binops) as changes ) = let magnitude : M.Magnitude @@ -377,8 +377,8 @@ changesToDoc categoryName unions aliases values binops = ++ values -unionToDoc : L.CRRTL_Localizer -> T.CDN_Name -> Docs.CED_Union -> D.Doc -unionToDoc localizer name (Docs.CED_Union _ tvars ctors) = +unionToDoc : T.CRRTL_Localizer -> T.CDN_Name -> T.CED_Union -> D.Doc +unionToDoc localizer name (T.CED_Union _ tvars ctors) = let setup : D.Doc setup = @@ -386,9 +386,9 @@ unionToDoc localizer name (Docs.CED_Union _ tvars ctors) = |> D.plus (D.fromName name) |> D.plus (D.hsep (List.map D.fromName tvars)) - ctorDoc : ( T.CDN_Name, List Type.CECT_Type ) -> D.Doc + ctorDoc : ( T.CDN_Name, List T.CECT_Type ) -> D.Doc ctorDoc ( ctor, tipes ) = - typeDoc localizer (Type.CECT_Type ctor tipes) + typeDoc localizer (T.CECT_Type ctor tipes) in D.hang 4 (D.sep @@ -400,8 +400,8 @@ unionToDoc localizer name (Docs.CED_Union _ tvars ctors) = ) -aliasToDoc : L.CRRTL_Localizer -> T.CDN_Name -> Docs.CED_Alias -> D.Doc -aliasToDoc localizer name (Docs.CED_Alias _ tvars tipe) = +aliasToDoc : T.CRRTL_Localizer -> T.CDN_Name -> T.CED_Alias -> D.Doc +aliasToDoc localizer name (T.CED_Alias _ tvars tipe) = let declaration : D.Doc declaration = @@ -415,13 +415,13 @@ aliasToDoc localizer name (Docs.CED_Alias _ tvars tipe) = D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ]) -valueToDoc : L.CRRTL_Localizer -> T.CDN_Name -> Docs.CED_Value -> D.Doc -valueToDoc localizer name (Docs.CED_Value _ tipe) = +valueToDoc : T.CRRTL_Localizer -> T.CDN_Name -> T.CED_Value -> D.Doc +valueToDoc localizer name (T.CED_Value _ tipe) = D.hang 4 <| D.sep [ D.fromName name |> D.plus (D.fromChars ":"), typeDoc localizer tipe ] -binopToDoc : L.CRRTL_Localizer -> T.CDN_Name -> Docs.CED_Binop -> D.Doc -binopToDoc localizer name (Docs.CED_Binop _ tipe associativity n) = +binopToDoc : T.CRRTL_Localizer -> T.CDN_Name -> T.CED_Binop -> D.Doc +binopToDoc localizer name (T.CED_Binop _ tipe associativity n) = let details : D.Doc details = @@ -458,6 +458,6 @@ binopToDoc localizer name (Docs.CED_Binop _ tipe associativity n) = ) -typeDoc : L.CRRTL_Localizer -> Type.CECT_Type -> D.Doc +typeDoc : T.CRRTL_Localizer -> T.CECT_Type -> D.Doc typeDoc localizer tipe = Type.toDoc localizer Type.None tipe diff --git a/src/Terminal/Repl.elm b/src/Terminal/Repl.elm index 60021dd79..e703268b5 100644 --- a/src/Terminal/Repl.elm +++ b/src/Terminal/Repl.elm @@ -468,22 +468,22 @@ startsWithKeyword keyword lines = ) -toExprPosition : String -> ES.CRES_Expr -> T.CPP_Row -> T.CPP_Col -> ( T.CPP_Row, T.CPP_Col ) +toExprPosition : String -> T.CRES_Expr -> T.CPP_Row -> T.CPP_Col -> ( T.CPP_Row, T.CPP_Col ) toExprPosition src expr row col = let - decl : ES.CRES_Decl + decl : T.CRES_Decl decl = - ES.CRES_DeclDef N.replValueToPrint (ES.CRES_DeclDefBody expr row col) row col + T.CRES_DeclDef N.replValueToPrint (T.CRES_DeclDefBody expr row col) row col in toDeclPosition src decl row col -toDeclPosition : String -> ES.CRES_Decl -> T.CPP_Row -> T.CPP_Col -> ( T.CPP_Row, T.CPP_Col ) +toDeclPosition : String -> T.CRES_Decl -> T.CPP_Row -> T.CPP_Col -> ( T.CPP_Row, T.CPP_Col ) toDeclPosition src decl r c = let - err : ES.CRES_Error + err : T.CRES_Error err = - ES.CRES_ParseError (ES.CRES_Declarations decl r c) + T.CRES_ParseError (T.CRES_Declarations decl r c) report : Report.Report report = diff --git a/src/Types.elm b/src/Types.elm index d5aeff937..cda93db17 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -1,9 +1,12 @@ -module Types exposing (..) +module Types exposing (BB_BResult(..), BB_CachedInterface(..), BB_ResultDict, BED_BuildID, BED_DocsStatus(..), BED_Local(..), BED_Status(..), BED_StatusDict, BF_Time(..), CASTC_Alias(..), CASTC_AliasType(..), CASTC_Annotation(..), CASTC_CaseBranch(..), CASTC_Ctor(..), CASTC_CtorOpts(..), CASTC_Decls(..), CASTC_Def(..), CASTC_Expr, CASTC_Expr_(..), CASTC_FieldType(..), CASTC_FieldUpdate(..), CASTC_FreeVars, CASTC_Pattern, CASTC_PatternCtorArg(..), CASTC_Pattern_(..), CASTC_Type(..), CASTC_Union(..), CASTO_Choice(..), CASTO_Decider(..), CASTO_Def(..), CASTO_Destructor(..), CASTO_EffectsType(..), CASTO_Expr(..), CASTO_Global(..), CASTO_GlobalGraph(..), CASTO_LocalGraph(..), CASTO_Main(..), CASTO_Node(..), CASTO_Path(..), CASTS_Alias(..), CASTS_Comment(..), CASTS_Def(..), CASTS_Docs(..), CASTS_Effects(..), CASTS_Exposed(..), CASTS_Exposing(..), CASTS_Expr, CASTS_Expr_(..), CASTS_Import(..), CASTS_Infix(..), CASTS_Manager(..), CASTS_Module(..), CASTS_Pattern, CASTS_Pattern_(..), CASTS_Port(..), CASTS_Privacy(..), CASTS_Type, CASTS_Type_(..), CASTS_Union(..), CASTS_Value(..), CASTS_VarType(..), CASTUB_Associativity(..), CASTUB_Precedence, CASTUS_Source(..), CASTUS_Type(..), CASTUS_Types(..), CDI_ZeroBased(..), CDN_Name, CECT_Type(..), CED_Alias(..), CED_Binop(..), CED_Comment, CED_Module(..), CED_Union(..), CED_Value(..), CEI_Alias(..), CEI_Binop(..), CEI_Interface(..), CEI_Union(..), CEK_Chunk(..), CEMN_Canonical(..), CEMN_Raw, CEP_Author, CEP_Name, CEP_Project, CNPM_Context(..), CNPM_Error(..), CNPM_Literal(..), CNPM_Pattern(..), CODT_Path(..), CODT_Test(..), CPP_Col, CPP_Row, CPP_Snippet(..), CPS_BadOperator(..), CRA_Located(..), CRA_Position(..), CRA_Region(..), CREC_BadArityContext(..), CREC_DuplicatePatternContext(..), CREC_Error(..), CREC_InvalidPayload(..), CREC_PortProblem(..), CREC_PossibleNames, CREC_VarKind(..), CRED_DefProblem(..), CRED_Error(..), CRED_NameProblem(..), CRED_SyntaxProblem(..), CREI_Error(..), CREI_Problem(..), CREM_Error(..), CRES_Case(..), CRES_Char(..), CRES_CustomType(..), CRES_Decl(..), CRES_DeclDef(..), CRES_DeclType(..), CRES_Def(..), CRES_Destruct(..), CRES_Error(..), CRES_Escape(..), CRES_Exposing(..), CRES_Expr(..), CRES_Func(..), CRES_If(..), CRES_Let(..), CRES_List_(..), CRES_Module(..), CRES_Number(..), CRES_PList(..), CRES_PRecord(..), CRES_PTuple(..), CRES_Pattern(..), CRES_Port(..), CRES_Record(..), CRES_Space(..), CRES_String_(..), CRES_TRecord(..), CRES_TTuple(..), CRES_Tuple(..), CRES_Type(..), CRES_TypeAlias(..), CRET_Category(..), CRET_Context(..), CRET_Error(..), CRET_Expected(..), CRET_MaybeName(..), CRET_PCategory(..), CRET_PContext(..), CRET_PExpected(..), CRET_SubContext(..), CRE_Error(..), CRE_Module, CRRTL_Exposing(..), CRRTL_Import, CRRTL_Localizer(..), CTE_Extension(..), CTE_Super(..), CTE_Type(..), FilePath, MVar(..)) {-| -} +import Compiler.Data.NonEmptyList as NE +import Compiler.Data.OneOrMore exposing (OneOrMore) import Data.Map exposing (Dict) import Data.Set exposing (EverySet) +import Time @@ -708,3 +711,1176 @@ type CODT_Path = CODT_Index CDI_ZeroBased CODT_Path | CODT_Unbox CODT_Path | CODT_Empty + + + +-- CHECK MODULE + + +{-| FIXME Builder.Build +-} +type alias BB_ResultDict = + Dict String CEMN_Raw (MVar BB_BResult) + + +{-| FIXME Builder.Build +-} +type BB_BResult + = BB_RNew BED_Local CEI_Interface CASTO_LocalGraph (Maybe CED_Module) + | BB_RSame BED_Local CEI_Interface CASTO_LocalGraph (Maybe CED_Module) + | BB_RCached Bool BED_BuildID (MVar BB_CachedInterface) + | BB_RNotFound CREI_Problem + | BB_RProblem CRE_Module + | BB_RBlocked + | BB_RForeign CEI_Interface + | BB_RKernel + + +{-| FIXME Builder.Build +-} +type BB_CachedInterface + = BB_Unneeded + | BB_Loaded CEI_Interface + | BB_Corrupted + + + +-- TIME + + +{-| FIXME Builder.File +-} +type BF_Time + = BF_Time Time.Posix + + + +-- DETAILS + + +{-| FIXME Builder.Elm.Details +-} +type alias BED_BuildID = + Int + + + +-- NOTE: we need two ways to detect if a file must be recompiled: +-- +-- (1) _time is the modification time from the last time we compiled the file. +-- By checking EQUALITY with the current modification time, we can detect file +-- saves and `git checkout` of previous versions. Both need a recompile. +-- +-- (2) _lastChange is the BuildID from the last time a new interface file was +-- generated, and _lastCompile is the BuildID from the last time the file was +-- compiled. These may be different if a file is recompiled but the interface +-- stayed the same. When the _lastCompile is LESS THAN the _lastChange of any +-- imports, we need to recompile. This can happen when a project has multiple +-- entrypoints and some modules are compiled less often than their imports. +-- + + +{-| FIXME Builder.Elm.Details +-} +type BED_Local + = BED_Local FilePath BF_Time (List CEMN_Raw) Bool BED_BuildID BED_BuildID + + + +-- DOCUMENTATION + + +{-| FIXME Compiler.Elm.Docs +-} +type CED_Module + = CED_Module CDN_Name CED_Comment (Dict String CDN_Name CED_Union) (Dict String CDN_Name CED_Alias) (Dict String CDN_Name CED_Value) (Dict String CDN_Name CED_Binop) + + +{-| FIXME Compiler.Elm.Docs +-} +type alias CED_Comment = + String + + +{-| FIXME Compiler.Elm.Docs +-} +type CED_Alias + = CED_Alias CED_Comment (List CDN_Name) CECT_Type + + +{-| FIXME Compiler.Elm.Docs +-} +type CED_Union + = CED_Union CED_Comment (List CDN_Name) (List ( CDN_Name, List CECT_Type )) + + +{-| FIXME Compiler.Elm.Docs +-} +type CED_Value + = CED_Value CED_Comment CECT_Type + + +{-| FIXME Compiler.Elm.Docs +-} +type CED_Binop + = CED_Binop CED_Comment CECT_Type CASTUB_Associativity CASTUB_Precedence + + + +-- TYPES + + +{-| FIXME Compiler.Elm.Compiler.Type +-} +type CECT_Type + = CECT_Lambda CECT_Type CECT_Type + | CECT_Var CDN_Name + | CECT_Type CDN_Name (List CECT_Type) + | CECT_Record (List ( CDN_Name, CECT_Type )) (Maybe CDN_Name) + | CECT_Unit + | CECT_Tuple CECT_Type CECT_Type (List CECT_Type) + + + +-- PATTERN + + +{-| FIXME Compiler.Nitpick.PatternMatches +-} +type CNPM_Pattern + = CNPM_Anything + | CNPM_Literal CNPM_Literal + | CNPM_Ctor CASTC_Union CDN_Name (List CNPM_Pattern) + + +{-| FIXME Compiler.Nitpick.PatternMatches +-} +type CNPM_Literal + = CNPM_Chr String + | CNPM_Str String + | CNPM_Int Int + + + +-- ERROR + + +{-| FIXME Compiler.Nitpick.PatternMatches +-} +type CNPM_Error + = CNPM_Incomplete CRA_Region CNPM_Context (List CNPM_Pattern) + | CNPM_Redundant CRA_Region CRA_Region Int + + +{-| FIXME Compiler.Nitpick.PatternMatches +-} +type CNPM_Context + = CNPM_BadArg + | CNPM_BadDestruct + | CNPM_BadCase + + + +-- OPERATOR + + +{-| FIXME Compiler.Parse.Symbol +-} +type CPS_BadOperator + = CPS_BadDot + | CPS_BadPipe + | CPS_BadArrow + | CPS_BadEquals + | CPS_BadHasType + + + +-- MODULE + + +{-| FIXME Compiler.Reporting.Error +-} +type alias CRE_Module = + { name : CEMN_Raw + , absolutePath : String + , modificationTime : BF_Time + , source : String + , error : CRE_Error + } + + + +-- ERRORS + + +{-| FIXME Compiler.Reporting.Error +-} +type CRE_Error + = CRE_BadSyntax CRES_Error + | CRE_BadImports (NE.Nonempty CREI_Error) + | CRE_BadNames (OneOrMore CREC_Error) + | CRE_BadTypes CRRTL_Localizer (NE.Nonempty CRET_Error) + | CRE_BadMains CRRTL_Localizer (OneOrMore CREM_Error) + | CRE_BadPatterns (NE.Nonempty CNPM_Error) + | CRE_BadDocs CRED_Error + + + +-- CANONICALIZATION ERRORS + + +{-| FIXME Compiler.Reporting.Error.Canonicalize +-} +type CREC_Error + = CREC_AnnotationTooShort CRA_Region CDN_Name CDI_ZeroBased Int + | CREC_AmbiguousVar CRA_Region (Maybe CDN_Name) CDN_Name CEMN_Canonical (OneOrMore CEMN_Canonical) + | CREC_AmbiguousType CRA_Region (Maybe CDN_Name) CDN_Name CEMN_Canonical (OneOrMore CEMN_Canonical) + | CREC_AmbiguousVariant CRA_Region (Maybe CDN_Name) CDN_Name CEMN_Canonical (OneOrMore CEMN_Canonical) + | CREC_AmbiguousBinop CRA_Region CDN_Name CEMN_Canonical (OneOrMore CEMN_Canonical) + | CREC_BadArity CRA_Region CREC_BadArityContext CDN_Name Int Int + | CREC_Binop CRA_Region CDN_Name CDN_Name + | CREC_DuplicateDecl CDN_Name CRA_Region CRA_Region + | CREC_DuplicateType CDN_Name CRA_Region CRA_Region + | CREC_DuplicateCtor CDN_Name CRA_Region CRA_Region + | CREC_DuplicateBinop CDN_Name CRA_Region CRA_Region + | CREC_DuplicateField CDN_Name CRA_Region CRA_Region + | CREC_DuplicateAliasArg CDN_Name CDN_Name CRA_Region CRA_Region + | CREC_DuplicateUnionArg CDN_Name CDN_Name CRA_Region CRA_Region + | CREC_DuplicatePattern CREC_DuplicatePatternContext CDN_Name CRA_Region CRA_Region + | CREC_EffectNotFound CRA_Region CDN_Name + | CREC_EffectFunctionNotFound CRA_Region CDN_Name + | CREC_ExportDuplicate CDN_Name CRA_Region CRA_Region + | CREC_ExportNotFound CRA_Region CREC_VarKind CDN_Name (List CDN_Name) + | CREC_ExportOpenAlias CRA_Region CDN_Name + | CREC_ImportCtorByName CRA_Region CDN_Name CDN_Name + | CREC_ImportNotFound CRA_Region CDN_Name (List CEMN_Canonical) + | CREC_ImportOpenAlias CRA_Region CDN_Name + | CREC_ImportExposingNotFound CRA_Region CEMN_Canonical CDN_Name (List CDN_Name) + | CREC_NotFoundVar CRA_Region (Maybe CDN_Name) CDN_Name CREC_PossibleNames + | CREC_NotFoundType CRA_Region (Maybe CDN_Name) CDN_Name CREC_PossibleNames + | CREC_NotFoundVariant CRA_Region (Maybe CDN_Name) CDN_Name CREC_PossibleNames + | CREC_NotFoundBinop CRA_Region CDN_Name (EverySet String CDN_Name) + | CREC_PatternHasRecordCtor CRA_Region CDN_Name + | CREC_PortPayloadInvalid CRA_Region CDN_Name CASTC_Type CREC_InvalidPayload + | CREC_PortTypeInvalid CRA_Region CDN_Name CREC_PortProblem + | CREC_RecursiveAlias CRA_Region CDN_Name (List CDN_Name) CASTS_Type (List CDN_Name) + | CREC_RecursiveDecl CRA_Region CDN_Name (List CDN_Name) + | CREC_RecursiveLet (CRA_Located CDN_Name) (List CDN_Name) + | CREC_Shadowing CDN_Name CRA_Region CRA_Region + | CREC_TupleLargerThanThree CRA_Region + | CREC_TypeVarsUnboundInUnion CRA_Region CDN_Name (List CDN_Name) ( CDN_Name, CRA_Region ) (List ( CDN_Name, CRA_Region )) + | CREC_TypeVarsMessedUpInAlias CRA_Region CDN_Name (List CDN_Name) (List ( CDN_Name, CRA_Region )) (List ( CDN_Name, CRA_Region )) + + +{-| FIXME Compiler.Reporting.Error.Canonicalize +-} +type CREC_BadArityContext + = CREC_TypeArity + | CREC_PatternArity + + +{-| FIXME Compiler.Reporting.Error.Canonicalize +-} +type CREC_DuplicatePatternContext + = CREC_DPLambdaArgs + | CREC_DPFuncArgs CDN_Name + | CREC_DPCaseBranch + | CREC_DPLetBinding + | CREC_DPDestruct + + +{-| FIXME Compiler.Reporting.Error.Canonicalize +-} +type CREC_InvalidPayload + = CREC_ExtendedRecord + | CREC_Function + | CREC_TypeVariable CDN_Name + | CREC_UnsupportedType CDN_Name + + +{-| FIXME Compiler.Reporting.Error.Canonicalize +-} +type CREC_PortProblem + = CREC_CmdNoArg + | CREC_CmdExtraArgs Int + | CREC_CmdBadMsg + | CREC_SubBad + | CREC_NotCmdOrSub + + +{-| FIXME Compiler.Reporting.Error.Canonicalize +-} +type alias CREC_PossibleNames = + { locals : EverySet String CDN_Name + , quals : Dict String CDN_Name (EverySet String CDN_Name) + } + + + +-- KIND + + +{-| FIXME Compiler.Reporting.Error.Canonicalize +-} +type CREC_VarKind + = CREC_BadOp + | CREC_BadVar + | CREC_BadPattern + | CREC_BadType + + +{-| FIXME Compiler.Reporting.Error.Docs +-} +type CRED_Error + = CRED_NoDocs CRA_Region + | CRED_ImplicitExposing CRA_Region + | CRED_SyntaxProblem CRED_SyntaxProblem + | CRED_NameProblems (NE.Nonempty CRED_NameProblem) + | CRED_DefProblems (NE.Nonempty CRED_DefProblem) + + +{-| FIXME Compiler.Reporting.Error.Docs +-} +type CRED_SyntaxProblem + = CRED_Op CPP_Row CPP_Col + | CRED_OpBad CPS_BadOperator CPP_Row CPP_Col + | CRED_Name CPP_Row CPP_Col + | CRED_Space CRES_Space CPP_Row CPP_Col + | CRED_Comma CPP_Row CPP_Col + | CRED_BadEnd CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Docs +-} +type CRED_NameProblem + = CRED_NameDuplicate CDN_Name CRA_Region CRA_Region + | CRED_NameOnlyInDocs CDN_Name CRA_Region + | CRED_NameOnlyInExports CDN_Name CRA_Region + + +{-| FIXME Compiler.Reporting.Error.Docs +-} +type CRED_DefProblem + = CRED_NoComment CDN_Name CRA_Region + | CRED_NoAnnotation CDN_Name CRA_Region + + + +-- ERROR + + +{-| FIXME Compiler.Reporting.Error.Import +-} +type CREI_Error + = CREI_Error CRA_Region CEMN_Raw (EverySet String CEMN_Raw) CREI_Problem + + +{-| FIXME Compiler.Reporting.Error.Import +-} +type CREI_Problem + = CREI_NotFound + | CREI_Ambiguous String (List String) CEP_Name (List CEP_Name) + | CREI_AmbiguousLocal String String (List String) + | CREI_AmbiguousForeign CEP_Name CEP_Name (List CEP_Name) + + + +-- ERROR + + +{-| FIXME Compiler.Reporting.Error.Main +-} +type CREM_Error + = CREM_BadType CRA_Region CASTC_Type + | CREM_BadCycle CRA_Region CDN_Name (List CDN_Name) + | CREM_BadFlags CRA_Region CASTC_Type CREC_InvalidPayload + + + +-- ALL SYNTAX ERRORS + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Error + = CRES_ModuleNameUnspecified CEMN_Raw + | CRES_ModuleNameMismatch CEMN_Raw (CRA_Located CEMN_Raw) + | CRES_UnexpectedPort CRA_Region + | CRES_NoPorts CRA_Region + | CRES_NoPortsInPackage (CRA_Located CDN_Name) + | CRES_NoPortModulesInPackage CRA_Region + | CRES_NoEffectsOutsideKernel CRA_Region + | CRES_ParseError CRES_Module + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Module + = CRES_ModuleSpace CRES_Space CPP_Row CPP_Col + | CRES_ModuleBadEnd CPP_Row CPP_Col + -- + | CRES_ModuleProblem CPP_Row CPP_Col + | CRES_ModuleName CPP_Row CPP_Col + | CRES_ModuleExposing CRES_Exposing CPP_Row CPP_Col + -- + | CRES_PortModuleProblem CPP_Row CPP_Col + | CRES_PortModuleName CPP_Row CPP_Col + | CRES_PortModuleExposing CRES_Exposing CPP_Row CPP_Col + -- + | CRES_Effect CPP_Row CPP_Col + -- + | CRES_FreshLine CPP_Row CPP_Col + -- + | CRES_ImportStart CPP_Row CPP_Col + | CRES_ImportName CPP_Row CPP_Col + | CRES_ImportAs CPP_Row CPP_Col + | CRES_ImportAlias CPP_Row CPP_Col + | CRES_ImportExposing CPP_Row CPP_Col + | CRES_ImportExposingList CRES_Exposing CPP_Row CPP_Col + | CRES_ImportEnd CPP_Row CPP_Col -- different based on col=1 or if greater + -- + | CRES_ImportIndentName CPP_Row CPP_Col + | CRES_ImportIndentAlias CPP_Row CPP_Col + | CRES_ImportIndentExposingList CPP_Row CPP_Col + -- + | CRES_Infix CPP_Row CPP_Col + -- + | CRES_Declarations CRES_Decl CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Exposing + = CRES_ExposingSpace CRES_Space CPP_Row CPP_Col + | CRES_ExposingStart CPP_Row CPP_Col + | CRES_ExposingValue CPP_Row CPP_Col + | CRES_ExposingOperator CPP_Row CPP_Col + | CRES_ExposingOperatorReserved CPS_BadOperator CPP_Row CPP_Col + | CRES_ExposingOperatorRightParen CPP_Row CPP_Col + | CRES_ExposingTypePrivacy CPP_Row CPP_Col + | CRES_ExposingEnd CPP_Row CPP_Col + -- + | CRES_ExposingIndentEnd CPP_Row CPP_Col + | CRES_ExposingIndentValue CPP_Row CPP_Col + + + +-- DECLARATIONS + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Decl + = CRES_DeclStart CPP_Row CPP_Col + | CRES_DeclSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_Port CRES_Port CPP_Row CPP_Col + | CRES_DeclType CRES_DeclType CPP_Row CPP_Col + | CRES_DeclDef CDN_Name CRES_DeclDef CPP_Row CPP_Col + -- + | CRES_DeclFreshLineAfterDocComment CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_DeclDef + = CRES_DeclDefSpace CRES_Space CPP_Row CPP_Col + | CRES_DeclDefEquals CPP_Row CPP_Col + | CRES_DeclDefType CRES_Type CPP_Row CPP_Col + | CRES_DeclDefArg CRES_Pattern CPP_Row CPP_Col + | CRES_DeclDefBody CRES_Expr CPP_Row CPP_Col + | CRES_DeclDefNameRepeat CPP_Row CPP_Col + | CRES_DeclDefNameMatch CDN_Name CPP_Row CPP_Col + -- + | CRES_DeclDefIndentType CPP_Row CPP_Col + | CRES_DeclDefIndentEquals CPP_Row CPP_Col + | CRES_DeclDefIndentBody CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Port + = CRES_PortSpace CRES_Space CPP_Row CPP_Col + | CRES_PortName CPP_Row CPP_Col + | CRES_PortColon CPP_Row CPP_Col + | CRES_PortType CRES_Type CPP_Row CPP_Col + | CRES_PortIndentName CPP_Row CPP_Col + | CRES_PortIndentColon CPP_Row CPP_Col + | CRES_PortIndentType CPP_Row CPP_Col + + + +-- TYPE DECLARATIONS + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_DeclType + = CRES_DT_Space CRES_Space CPP_Row CPP_Col + | CRES_DT_Name CPP_Row CPP_Col + | CRES_DT_Alias CRES_TypeAlias CPP_Row CPP_Col + | CRES_DT_Union CRES_CustomType CPP_Row CPP_Col + -- + | CRES_DT_IndentName CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_TypeAlias + = CRES_AliasSpace CRES_Space CPP_Row CPP_Col + | CRES_AliasName CPP_Row CPP_Col + | CRES_AliasEquals CPP_Row CPP_Col + | CRES_AliasBody CRES_Type CPP_Row CPP_Col + -- + | CRES_AliasIndentEquals CPP_Row CPP_Col + | CRES_AliasIndentBody CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_CustomType + = CRES_CT_Space CRES_Space CPP_Row CPP_Col + | CRES_CT_Name CPP_Row CPP_Col + | CRES_CT_Equals CPP_Row CPP_Col + | CRES_CT_Bar CPP_Row CPP_Col + | CRES_CT_Variant CPP_Row CPP_Col + | CRES_CT_VariantArg CRES_Type CPP_Row CPP_Col + -- + | CRES_CT_IndentEquals CPP_Row CPP_Col + | CRES_CT_IndentBar CPP_Row CPP_Col + | CRES_CT_IndentAfterBar CPP_Row CPP_Col + | CRES_CT_IndentAfterEquals CPP_Row CPP_Col + + + +-- EXPRESSIONS + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Expr + = CRES_Let CRES_Let CPP_Row CPP_Col + | CRES_Case CRES_Case CPP_Row CPP_Col + | CRES_If CRES_If CPP_Row CPP_Col + | CRES_List CRES_List_ CPP_Row CPP_Col + | CRES_Record CRES_Record CPP_Row CPP_Col + | CRES_Tuple CRES_Tuple CPP_Row CPP_Col + | CRES_Func CRES_Func CPP_Row CPP_Col + -- + | CRES_Dot CPP_Row CPP_Col + | CRES_Access CPP_Row CPP_Col + | CRES_OperatorRight CDN_Name CPP_Row CPP_Col + | CRES_OperatorReserved CPS_BadOperator CPP_Row CPP_Col + -- + | CRES_Start CPP_Row CPP_Col + | CRES_Char CRES_Char CPP_Row CPP_Col + | CRES_String_ CRES_String_ CPP_Row CPP_Col + | CRES_Number CRES_Number CPP_Row CPP_Col + | CRES_Space CRES_Space CPP_Row CPP_Col + | CRES_EndlessShader CPP_Row CPP_Col + | CRES_ShaderProblem String CPP_Row CPP_Col + | CRES_IndentOperatorRight CDN_Name CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Record + = CRES_RecordOpen CPP_Row CPP_Col + | CRES_RecordEnd CPP_Row CPP_Col + | CRES_RecordField CPP_Row CPP_Col + | CRES_RecordEquals CPP_Row CPP_Col + | CRES_RecordExpr CRES_Expr CPP_Row CPP_Col + | CRES_RecordSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_RecordIndentOpen CPP_Row CPP_Col + | CRES_RecordIndentEnd CPP_Row CPP_Col + | CRES_RecordIndentField CPP_Row CPP_Col + | CRES_RecordIndentEquals CPP_Row CPP_Col + | CRES_RecordIndentExpr CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Tuple + = CRES_TupleExpr CRES_Expr CPP_Row CPP_Col + | CRES_TupleSpace CRES_Space CPP_Row CPP_Col + | CRES_TupleEnd CPP_Row CPP_Col + | CRES_TupleOperatorClose CPP_Row CPP_Col + | CRES_TupleOperatorReserved CPS_BadOperator CPP_Row CPP_Col + -- + | CRES_TupleIndentExpr1 CPP_Row CPP_Col + | CRES_TupleIndentExprN CPP_Row CPP_Col + | CRES_TupleIndentEnd CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_List_ + = CRES_ListSpace CRES_Space CPP_Row CPP_Col + | CRES_ListOpen CPP_Row CPP_Col + | CRES_ListExpr CRES_Expr CPP_Row CPP_Col + | CRES_ListEnd CPP_Row CPP_Col + -- + | CRES_ListIndentOpen CPP_Row CPP_Col + | CRES_ListIndentEnd CPP_Row CPP_Col + | CRES_ListIndentExpr CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Func + = CRES_FuncSpace CRES_Space CPP_Row CPP_Col + | CRES_FuncArg CRES_Pattern CPP_Row CPP_Col + | CRES_FuncBody CRES_Expr CPP_Row CPP_Col + | CRES_FuncArrow CPP_Row CPP_Col + -- + | CRES_FuncIndentArg CPP_Row CPP_Col + | CRES_FuncIndentArrow CPP_Row CPP_Col + | CRES_FuncIndentBody CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Case + = CRES_CaseSpace CRES_Space CPP_Row CPP_Col + | CRES_CaseOf CPP_Row CPP_Col + | CRES_CasePattern CRES_Pattern CPP_Row CPP_Col + | CRES_CaseArrow CPP_Row CPP_Col + | CRES_CaseExpr CRES_Expr CPP_Row CPP_Col + | CRES_CaseBranch CRES_Expr CPP_Row CPP_Col + -- + | CRES_CaseIndentOf CPP_Row CPP_Col + | CRES_CaseIndentExpr CPP_Row CPP_Col + | CRES_CaseIndentPattern CPP_Row CPP_Col + | CRES_CaseIndentArrow CPP_Row CPP_Col + | CRES_CaseIndentBranch CPP_Row CPP_Col + | CRES_CasePatternAlignment Int CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_If + = CRES_IfSpace CRES_Space CPP_Row CPP_Col + | CRES_IfThen CPP_Row CPP_Col + | CRES_IfElse CPP_Row CPP_Col + | CRES_IfElseBranchStart CPP_Row CPP_Col + -- + | CRES_IfCondition CRES_Expr CPP_Row CPP_Col + | CRES_IfThenBranch CRES_Expr CPP_Row CPP_Col + | CRES_IfElseBranch CRES_Expr CPP_Row CPP_Col + -- + | CRES_IfIndentCondition CPP_Row CPP_Col + | CRES_IfIndentThen CPP_Row CPP_Col + | CRES_IfIndentThenBranch CPP_Row CPP_Col + | CRES_IfIndentElseBranch CPP_Row CPP_Col + | CRES_IfIndentElse CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Let + = CRES_LetSpace CRES_Space CPP_Row CPP_Col + | CRES_LetIn CPP_Row CPP_Col + | CRES_LetDefAlignment Int CPP_Row CPP_Col + | CRES_LetDefName CPP_Row CPP_Col + | CRES_LetDef CDN_Name CRES_Def CPP_Row CPP_Col + | CRES_LetDestruct CRES_Destruct CPP_Row CPP_Col + | CRES_LetBody CRES_Expr CPP_Row CPP_Col + | CRES_LetIndentDef CPP_Row CPP_Col + | CRES_LetIndentIn CPP_Row CPP_Col + | CRES_LetIndentBody CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Def + = CRES_DefSpace CRES_Space CPP_Row CPP_Col + | CRES_DefType CRES_Type CPP_Row CPP_Col + | CRES_DefNameRepeat CPP_Row CPP_Col + | CRES_DefNameMatch CDN_Name CPP_Row CPP_Col + | CRES_DefArg CRES_Pattern CPP_Row CPP_Col + | CRES_DefEquals CPP_Row CPP_Col + | CRES_DefBody CRES_Expr CPP_Row CPP_Col + | CRES_DefIndentEquals CPP_Row CPP_Col + | CRES_DefIndentType CPP_Row CPP_Col + | CRES_DefIndentBody CPP_Row CPP_Col + | CRES_DefAlignment Int CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Destruct + = CRES_DestructSpace CRES_Space CPP_Row CPP_Col + | CRES_DestructPattern CRES_Pattern CPP_Row CPP_Col + | CRES_DestructEquals CPP_Row CPP_Col + | CRES_DestructBody CRES_Expr CPP_Row CPP_Col + | CRES_DestructIndentEquals CPP_Row CPP_Col + | CRES_DestructIndentBody CPP_Row CPP_Col + + + +-- PATTERNS + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Pattern + = CRES_PRecord CRES_PRecord CPP_Row CPP_Col + | CRES_PTuple CRES_PTuple CPP_Row CPP_Col + | CRES_PList CRES_PList CPP_Row CPP_Col + -- + | CRES_PStart CPP_Row CPP_Col + | CRES_PChar CRES_Char CPP_Row CPP_Col + | CRES_PString CRES_String_ CPP_Row CPP_Col + | CRES_PNumber CRES_Number CPP_Row CPP_Col + | CRES_PFloat Int CPP_Row CPP_Col + | CRES_PAlias CPP_Row CPP_Col + | CRES_PWildcardNotVar CDN_Name Int CPP_Row CPP_Col + | CRES_PSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_PIndentStart CPP_Row CPP_Col + | CRES_PIndentAlias CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_PRecord + = CRES_PRecordOpen CPP_Row CPP_Col + | CRES_PRecordEnd CPP_Row CPP_Col + | CRES_PRecordField CPP_Row CPP_Col + | CRES_PRecordSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_PRecordIndentOpen CPP_Row CPP_Col + | CRES_PRecordIndentEnd CPP_Row CPP_Col + | CRES_PRecordIndentField CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_PTuple + = CRES_PTupleOpen CPP_Row CPP_Col + | CRES_PTupleEnd CPP_Row CPP_Col + | CRES_PTupleExpr CRES_Pattern CPP_Row CPP_Col + | CRES_PTupleSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_PTupleIndentEnd CPP_Row CPP_Col + | CRES_PTupleIndentExpr1 CPP_Row CPP_Col + | CRES_PTupleIndentExprN CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_PList + = CRES_PListOpen CPP_Row CPP_Col + | CRES_PListEnd CPP_Row CPP_Col + | CRES_PListExpr CRES_Pattern CPP_Row CPP_Col + | CRES_PListSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_PListIndentOpen CPP_Row CPP_Col + | CRES_PListIndentEnd CPP_Row CPP_Col + | CRES_PListIndentExpr CPP_Row CPP_Col + + + +-- TYPES + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Type + = CRES_TRecord CRES_TRecord CPP_Row CPP_Col + | CRES_TTuple CRES_TTuple CPP_Row CPP_Col + -- + | CRES_TStart CPP_Row CPP_Col + | CRES_TSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_TIndentStart CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_TRecord + = CRES_TRecordOpen CPP_Row CPP_Col + | CRES_TRecordEnd CPP_Row CPP_Col + -- + | CRES_TRecordField CPP_Row CPP_Col + | CRES_TRecordColon CPP_Row CPP_Col + | CRES_TRecordType CRES_Type CPP_Row CPP_Col + -- + | CRES_TRecordSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_TRecordIndentOpen CPP_Row CPP_Col + | CRES_TRecordIndentField CPP_Row CPP_Col + | CRES_TRecordIndentColon CPP_Row CPP_Col + | CRES_TRecordIndentType CPP_Row CPP_Col + | CRES_TRecordIndentEnd CPP_Row CPP_Col + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_TTuple + = CRES_TTupleOpen CPP_Row CPP_Col + | CRES_TTupleEnd CPP_Row CPP_Col + | CRES_TTupleType CRES_Type CPP_Row CPP_Col + | CRES_TTupleSpace CRES_Space CPP_Row CPP_Col + -- + | CRES_TTupleIndentType1 CPP_Row CPP_Col + | CRES_TTupleIndentTypeN CPP_Row CPP_Col + | CRES_TTupleIndentEnd CPP_Row CPP_Col + + + +-- LITERALS + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Char + = CRES_CharEndless + | CRES_CharEscape CRES_Escape + | CRES_CharNotString Int + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_String_ + = CRES_StringEndless_Single + | CRES_StringEndless_Multi + | CRES_StringEscape CRES_Escape + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Escape + = CRES_EscapeUnknown + | CRES_BadUnicodeFormat Int + | CRES_BadUnicodeCode Int + | CRES_BadUnicodeLength Int Int Int + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Number + = CRES_NumberEnd + | CRES_NumberDot Int + | CRES_NumberHexDigit + | CRES_NumberNoLeadingZero + + + +-- MISC + + +{-| FIXME Compiler.Reporting.Error.Syntax +-} +type CRES_Space + = CRES_HasTab + | CRES_EndlessMultiComment + + + +-- ERRORS + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_Error + = CRET_BadExpr CRA_Region CRET_Category CTE_Type (CRET_Expected CTE_Type) + | CRET_BadPattern CRA_Region CRET_PCategory CTE_Type (CRET_PExpected CTE_Type) + | CRET_InfiniteType CRA_Region CDN_Name CTE_Type + + + +-- EXPRESSION EXPECTATIONS + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_Expected tipe + = CRET_NoExpectation tipe + | CRET_FromContext CRA_Region CRET_Context tipe + | CRET_FromAnnotation CDN_Name Int CRET_SubContext tipe + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_Context + = CRET_ListEntry CDI_ZeroBased + | CRET_Negate + | CRET_OpLeft CDN_Name + | CRET_OpRight CDN_Name + | CRET_IfCondition + | CRET_IfBranch CDI_ZeroBased + | CRET_CaseBranch CDI_ZeroBased + | CRET_CallArity CRET_MaybeName Int + | CRET_CallArg CRET_MaybeName CDI_ZeroBased + | CRET_RecordAccess CRA_Region (Maybe CDN_Name) CRA_Region CDN_Name + | CRET_RecordUpdateKeys CDN_Name (Dict String CDN_Name CASTC_FieldUpdate) + | CRET_RecordUpdateValue CDN_Name + | CRET_Destructure + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_SubContext + = CRET_TypedIfBranch CDI_ZeroBased + | CRET_TypedCaseBranch CDI_ZeroBased + | CRET_TypedBody + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_MaybeName + = CRET_FuncName CDN_Name + | CRET_CtorName CDN_Name + | CRET_OpName CDN_Name + | CRET_NoName + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_Category + = CRET_List + | CRET_Number + | CRET_Float + | CRET_String + | CRET_Char + | CRET_If + | CRET_Case + | CRET_CallResult CRET_MaybeName + | CRET_Lambda + | CRET_Accessor CDN_Name + | CRET_Access CDN_Name + | CRET_Record + | CRET_Tuple + | CRET_Unit + | CRET_Shader + | CRET_Effects + | CRET_Local CDN_Name + | CRET_Foreign CDN_Name + + + +-- PATTERN EXPECTATIONS + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_PExpected tipe + = CRET_PNoExpectation tipe + | CRET_PFromContext CRA_Region CRET_PContext tipe + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_PContext + = CRET_PTypedArg CDN_Name CDI_ZeroBased + | CRET_PCaseMatch CDI_ZeroBased + | CRET_PCtorArg CDN_Name CDI_ZeroBased + | CRET_PListEntry CDI_ZeroBased + | CRET_PTail + + +{-| FIXME Compiler.Reporting.Error.Type +-} +type CRET_PCategory + = CRET_PRecord + | CRET_PUnit + | CRET_PTuple + | CRET_PList + | CRET_PCtor CDN_Name + | CRET_PInt + | CRET_PStr + | CRET_PChr + | CRET_PBool + + + +-- LOCALIZER + + +{-| FIXME Compiler.Reporting.Render.Type.Localizer +-} +type CRRTL_Localizer + = CRRTL_Localizer (Dict String CDN_Name CRRTL_Import) + + +{-| FIXME Compiler.Reporting.Render.Type.Localizer +-} +type alias CRRTL_Import = + { alias : Maybe CDN_Name + , exposing_ : CRRTL_Exposing + } + + +{-| FIXME Compiler.Reporting.Render.Type.Localizer +-} +type CRRTL_Exposing + = CRRTL_All + | CRRTL_Only (EverySet String CDN_Name) + + + +-- ERROR TYPES + + +{-| FIXME Compiler.Type.Error +-} +type CTE_Type + = CTE_Lambda CTE_Type CTE_Type (List CTE_Type) + | CTE_Infinite + | CTE_Error + | CTE_FlexVar CDN_Name + | CTE_FlexSuper CTE_Super CDN_Name + | CTE_RigidVar CDN_Name + | CTE_RigidSuper CTE_Super CDN_Name + | CTE_Type CEMN_Canonical CDN_Name (List CTE_Type) + | CTE_Record (Dict String CDN_Name CTE_Type) CTE_Extension + | CTE_Unit + | CTE_Tuple CTE_Type CTE_Type (Maybe CTE_Type) + | CTE_Alias CEMN_Canonical CDN_Name (List ( CDN_Name, CTE_Type )) CTE_Type + + +{-| FIXME Compiler.Type.Error +-} +type CTE_Super + = CTE_Number + | CTE_Comparable + | CTE_Appendable + | CTE_CompAppend + + +{-| FIXME Compiler.Type.Error +-} +type CTE_Extension + = CTE_Closed + | CTE_FlexOpen CDN_Name + | CTE_RigidOpen CDN_Name + + + +-- EXPRESSIONS + + +{-| FIXME Compiler.AST.Canonical +-} +type alias CASTC_Expr = + CRA_Located CASTC_Expr_ + + + +-- CACHE Annotations for type inference + + +{-| FIXME Compiler.AST.Canonical +-} +type CASTC_Expr_ + = CASTC_VarLocal CDN_Name + | CASTC_VarTopLevel CEMN_Canonical CDN_Name + | CASTC_VarKernel CDN_Name CDN_Name + | CASTC_VarForeign CEMN_Canonical CDN_Name CASTC_Annotation + | CASTC_VarCtor CASTC_CtorOpts CEMN_Canonical CDN_Name CDI_ZeroBased CASTC_Annotation + | CASTC_VarDebug CEMN_Canonical CDN_Name CASTC_Annotation + | CASTC_VarOperator CDN_Name CEMN_Canonical CDN_Name CASTC_Annotation -- CACHE real name for optimization + | CASTC_Chr String + | CASTC_Str String + | CASTC_Int Int + | CASTC_Float Float + | CASTC_List (List CASTC_Expr) + | CASTC_Negate CASTC_Expr + | CASTC_Binop CDN_Name CEMN_Canonical CDN_Name CASTC_Annotation CASTC_Expr CASTC_Expr -- CACHE real name for optimization + | CASTC_Lambda (List CASTC_Pattern) CASTC_Expr + | CASTC_Call CASTC_Expr (List CASTC_Expr) + | CASTC_If (List ( CASTC_Expr, CASTC_Expr )) CASTC_Expr + | CASTC_Let CASTC_Def CASTC_Expr + | CASTC_LetRec (List CASTC_Def) CASTC_Expr + | CASTC_LetDestruct CASTC_Pattern CASTC_Expr CASTC_Expr + | CASTC_Case CASTC_Expr (List CASTC_CaseBranch) + | CASTC_Accessor CDN_Name + | CASTC_Access CASTC_Expr (CRA_Located CDN_Name) + | CASTC_Update CDN_Name CASTC_Expr (Dict String CDN_Name CASTC_FieldUpdate) + | CASTC_Record (Dict String CDN_Name CASTC_Expr) + | CASTC_Unit + | CASTC_Tuple CASTC_Expr CASTC_Expr (Maybe CASTC_Expr) + | CASTC_Shader CASTUS_Source CASTUS_Types + + +{-| FIXME Compiler.AST.Canonical +-} +type CASTC_CaseBranch + = CASTC_CaseBranch CASTC_Pattern CASTC_Expr + + +{-| FIXME Compiler.AST.Canonical +-} +type CASTC_FieldUpdate + = CASTC_FieldUpdate CRA_Region CASTC_Expr + + + +-- DEFS + + +{-| FIXME Compiler.AST.Canonical +-} +type CASTC_Def + = CASTC_Def (CRA_Located CDN_Name) (List CASTC_Pattern) CASTC_Expr + | CASTC_TypedDef (CRA_Located CDN_Name) CASTC_FreeVars (List ( CASTC_Pattern, CASTC_Type )) CASTC_Expr CASTC_Type + + +{-| FIXME Compiler.AST.Canonical +-} +type CASTC_Decls + = CASTC_Declare CASTC_Def CASTC_Decls + | CASTC_DeclareRec CASTC_Def (List CASTC_Def) CASTC_Decls + | CASTC_SaveTheEnvironment + + + +-- PATTERNS + + +{-| FIXME Compiler.AST.Canonical +-} +type alias CASTC_Pattern = + CRA_Located CASTC_Pattern_ + + +{-| FIXME Compiler.AST.Canonical +-} +type CASTC_Pattern_ + = CASTC_PAnything + | CASTC_PVar CDN_Name + | CASTC_PRecord (List CDN_Name) + | CASTC_PAlias CASTC_Pattern CDN_Name + | CASTC_PUnit + | CASTC_PTuple CASTC_Pattern CASTC_Pattern (Maybe CASTC_Pattern) + | CASTC_PList (List CASTC_Pattern) + | CASTC_PCons CASTC_Pattern CASTC_Pattern + | CASTC_PBool CASTC_Union Bool + | CASTC_PChr String + | CASTC_PStr String + | CASTC_PInt Int + | CASTC_PCtor + -- CACHE p_home, p_type, and p_vars for type inference + -- CACHE p_index to replace p_name in PROD code gen + -- CACHE p_opts to allocate less in PROD code gen + -- CACHE p_alts and p_numAlts for exhaustiveness checker + { home : CEMN_Canonical + , type_ : CDN_Name + , union : CASTC_Union + , name : CDN_Name + , index : CDI_ZeroBased + , args : List CASTC_PatternCtorArg + } + + +{-| FIXME Compiler.AST.Canonical +-} +type CASTC_PatternCtorArg + = CASTC_PatternCtorArg + -- CACHE for destructors/errors + CDI_ZeroBased + -- CACHE for type inference + CASTC_Type + CASTC_Pattern