From 5fd92be7d2c86487b6b30ce35d513d1aa67448eb Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Mon, 4 Dec 2023 19:11:05 -0700 Subject: [PATCH 01/37] Language Server --- .gitignore | 3 +- koka.cabal | 36 +- package.yaml | 14 +- readme.md | 59 +- src/Backend/C/FromCore.hs | 1 + src/Common/ColorScheme.hs | 2 +- src/Common/Error.hs | 112 ++-- src/Common/File.hs | 3 +- src/Common/Range.hs | 6 +- src/Common/Syntax.hs | 3 +- src/Compiler/Compile.hs | 588 +++++++++++------- src/Compiler/Module.hs | 18 +- src/Compiler/Options.hs | 67 +- src/Core/AnalysisMatch.hs | 2 +- src/Core/CTail.hs | 2 +- src/Core/Check.hs | 2 +- src/Core/CheckFBIP.hs | 2 +- src/Core/Core.hs | 26 +- src/Core/FunLift.hs | 2 +- src/Core/Inline.hs | 2 +- src/Core/Monadic.hs | 2 +- src/Core/MonadicLift.hs | 2 +- src/Core/OpenResolve.hs | 2 +- src/Core/Parse.hs | 10 +- src/Core/Simplify.hs | 2 +- src/Core/Specialize.hs | 2 +- src/Core/UnReturn.hs | 2 +- src/Core/Unroll.hs | 2 +- src/Interpreter/Interpret.hs | 12 +- src/Kind/Constructors.hs | 5 +- src/Kind/ImportMap.hs | 2 +- src/Kind/Infer.hs | 2 +- src/LanguageServer/Conversions.hs | 118 ++++ src/LanguageServer/Handler/Commands.hs | 63 ++ src/LanguageServer/Handler/Completion.hs | 436 +++++++++++++ src/LanguageServer/Handler/Definition.hs | 52 ++ src/LanguageServer/Handler/DocumentSymbol.hs | 168 +++++ src/LanguageServer/Handler/Hover.hs | 66 ++ src/LanguageServer/Handler/TextDocument.hs | 194 ++++++ src/LanguageServer/Handlers.hs | 120 ++++ src/LanguageServer/Monad.hs | 176 ++++++ src/LanguageServer/Run.hs | 94 +++ src/Lib/Printer.hs | 197 ++++-- src/Main.hs | 17 +- src/Static/FixityResolve.hs | 4 +- src/Syntax/Lexer.hs | 435 ++++++------- src/Syntax/Lexer.x | 1 + src/Syntax/Parse.hs | 118 ++-- src/Syntax/RangeMap.hs | 22 +- src/Type/Infer.hs | 5 +- src/Type/InferMonad.hs | 2 +- src/Type/Pretty.hs | 5 +- stack.yaml | 4 + .../images/koka-logo-filled-blue.svg | 61 ++ .../images/koka-logo-filled.svg | 59 ++ .../vscode/koka.language-koka/package.json | 289 ++++++--- .../vscode/koka.language-koka/src/debugger.ts | 267 ++++++++ .../koka.language-koka/src/extension.ts | 365 +++++++++++ .../koka.language-koka/src/workspace.ts | 146 +++++ .../vscode/koka.language-koka/tsconfig.json | 17 + util/install.bat | 2 +- util/install.sh | 2 +- 62 files changed, 3768 insertions(+), 732 deletions(-) create mode 100644 src/LanguageServer/Conversions.hs create mode 100644 src/LanguageServer/Handler/Commands.hs create mode 100644 src/LanguageServer/Handler/Completion.hs create mode 100644 src/LanguageServer/Handler/Definition.hs create mode 100644 src/LanguageServer/Handler/DocumentSymbol.hs create mode 100644 src/LanguageServer/Handler/Hover.hs create mode 100644 src/LanguageServer/Handler/TextDocument.hs create mode 100644 src/LanguageServer/Handlers.hs create mode 100644 src/LanguageServer/Monad.hs create mode 100644 src/LanguageServer/Run.hs create mode 100644 support/vscode/koka.language-koka/images/koka-logo-filled-blue.svg create mode 100644 support/vscode/koka.language-koka/images/koka-logo-filled.svg create mode 100644 support/vscode/koka.language-koka/src/debugger.ts create mode 100644 support/vscode/koka.language-koka/src/extension.ts create mode 100644 support/vscode/koka.language-koka/src/workspace.ts create mode 100644 support/vscode/koka.language-koka/tsconfig.json diff --git a/.gitignore b/.gitignore index 96efdba0c..490e5debb 100644 --- a/.gitignore +++ b/.gitignore @@ -4,7 +4,6 @@ .DS_Store .vs/ .vscode/ -.koka/ node_modules/ out/ bundle/ @@ -30,3 +29,5 @@ test.kk /*.cmake bench test/bench +.koka +scratch diff --git a/koka.cabal b/koka.cabal index 90bf0f927..3537b8d2d 100644 --- a/koka.cabal +++ b/koka.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack @@ -92,6 +92,16 @@ executable koka Kind.Repr Kind.Synonym Kind.Unify + LanguageServer.Conversions + LanguageServer.Handler.Commands + LanguageServer.Handler.Completion + LanguageServer.Handler.Definition + LanguageServer.Handler.DocumentSymbol + LanguageServer.Handler.Hover + LanguageServer.Handler.TextDocument + LanguageServer.Handlers + LanguageServer.Monad + LanguageServer.Run Lib.JSON Lib.PPrint Lib.Printer @@ -132,7 +142,7 @@ executable koka other-extensions: CPP OverloadedStrings - ghc-options: -rtsopts -j8 + ghc-options: -rtsopts -j8 -O2 -threaded "-with-rtsopts=-N8" cpp-options: -DKOKA_MAIN="koka" -DKOKA_VARIANT="release" -DKOKA_VERSION="2.4.3" -DREADLINE=0 include-dirs: src/Platform/cpp/Platform @@ -141,16 +151,25 @@ executable koka build-tools: alex build-depends: - array + aeson + , array + , async , base >=4.9 , bytestring + , co-log-core , containers , directory , isocline >=1.0.6 + , lens + , lsp , mtl + , network + , network-simple , parsec , process + , stm , text + , text-rope , time default-language: Haskell2010 if os(windows) @@ -167,9 +186,12 @@ test-suite koka-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - array + aeson + , array + , async , base >=4.9 , bytestring + , co-log-core , containers , directory , extra @@ -178,10 +200,16 @@ test-suite koka-test , hspec-core , isocline >=1.0.6 , json + , lens + , lsp , mtl + , network + , network-simple , parsec , process , regex-compat >=0.95.2.1 + , stm , text + , text-rope , time default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 0b625d72d..b36996dc3 100644 --- a/package.yaml +++ b/package.yaml @@ -19,15 +19,24 @@ description: Please see the README on GitHub at = 4.9 + - aeson - array + - async - bytestring - containers + - co-log-core - directory + - lens + - lsp - mtl - parsec - process + - stm - text + - text-rope - time + - network-simple + - network - isocline >= 1.0.6 executables: @@ -48,8 +57,11 @@ executables: build-tools: - alex ghc-options: - - -rtsopts + - -rtsopts - -j8 + - -O2 + - -threaded + - '"-with-rtsopts=-N8"' cpp-options: - -DKOKA_MAIN="koka" - -DKOKA_VARIANT="release" diff --git a/readme.md b/readme.md index 45ac329fe..fea42eb06 100644 --- a/readme.md +++ b/readme.md @@ -279,9 +279,6 @@ More advanced projects: * [x] Update the JavaScript backend to 1) use modern modules instead of amdefine, 2) use the new bigints instead of bigint.js, and 3) add support for int64. (landed in the `dev` branch) * [x] Port `std/text/regex` from v1 (using PCRE) -* [ ] A language server for Visual Studio Code and Atom. Koka can already generate a - typed [range map](src/Syntax/RangeMap.hs) so this should be managable. Partially done: see PR #100 (by @fwcd) -- it just - needs work on packaging it to make it easy to build and install as part of the Koka installer. * [ ] Package management of Koka modules. * [x] Compile to WASM (using emscripten on the current C backend) * [ ] Improve compilation of local state to use local variables directly (in C) without allocation. Tricky though due to multiple resumptions. @@ -318,6 +315,17 @@ The following is the immediate todo list to be completed in the coming months: * [ ] Port `std/async` (using `libuv`). * [ ] Proper overloading with (a form of) type classes. (in design phase). +LSP Related Tasks: +* [ ] Generate completions for effect handlers (with empty bodies of all the functions) +* [ ] Generate show / (==) for datatypes +* [ ] Find References +* [ ] Generate Type Annotations + +Extension Related Tasks: + +VSCode: +* [ ] Add support for debugging an executable + Contact me if you are interested in tackling some of these :-) # Build Notes @@ -460,6 +468,51 @@ $ out\v2.0.5\cl-release\test_bench_koka_rbtree --kktime info: elapsed: 1.483s, user: 1.484s, sys: 0.000s, rss: 164mb ``` +## Language Server + +The language server is started by running the koka compilter with the --language-server flag +and then connecting to it with a client that supports the Language Server Protocol (LSP) + +For example, using VSCode, install the Koka extension or run the extension debug configuration in the project. +Open up a folder and start editing `.kk` files. (The extension finds the koka executable and then automatically starts the language server for you). + +The VSCode extension searches in the following locations for the koka executable: +- A koka development environment in ~/koka +- A local install ~/.local/bin +- The PATH environment variable + +To specify the command to start the language server manually, such as to provide additional flags to the koka compiler override the `koka.languageServer.command` VSCode setting. +To specify the current working directory to run the compiler from use the `koka.languageServer.cwd` setting. If there are problems with the language server, you can enable the `koka.languageServer.trace.server` setting to see the language server logs, or turn off the language server by setting the `koka.languageServer.enable` setting to `false`. + +To develop the language server, you can use this VSCode debug configuration (add the configuration to .vscode/launch.json). + +```json +{ + // Use IntelliSense to learn about possible attributes. + // Hover to view descriptions of existing attributes. + // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 + "version": "0.2.0", + "configurations": [ + { + "name": "Launch Extension", + "request": "launch", + "type": "extensionHost", + "args": [ + "--extensionDevelopmentPath=${workspaceFolder}/support/vscode/koka.language-koka" + ], + "outFiles": [ + "${workspaceFolder}/support/vscode/koka.language-koka/out/**/*.js" + ] + } +] +} +``` + +- Run `npm install && npm run build` in the `support/vscode/koka.language-koka` directory +- Update the LSP server in the `src/LanguageServer` directory with your changes +- Run `stack build` +- Restart the debug configuration and make sure a notification pops up that you are using the development version of the koka sdk + ## Older Release Notes * `v2.1.9`, 2021-06-23: initial support for cross-module specialization (by Steven Fontanella). diff --git a/src/Backend/C/FromCore.hs b/src/Backend/C/FromCore.hs index 02cc06cf3..0ae20637f 100644 --- a/src/Backend/C/FromCore.hs +++ b/src/Backend/C/FromCore.hs @@ -2663,6 +2663,7 @@ reserved , "instanceof" , "new" , "return" + , "register" , "switch" , "this" , "throw" diff --git a/src/Common/ColorScheme.hs b/src/Common/ColorScheme.hs index 7094ca3a1..13d4061cb 100644 --- a/src/Common/ColorScheme.hs +++ b/src/Common/ColorScheme.hs @@ -55,7 +55,7 @@ data ColorScheme = ColorScheme , colorTypeSpecial :: Color , colorTypeParam :: Color , colorNameQual :: Color - } + } deriving (Show) -- | The default color scheme defaultColorScheme, darkColorScheme, lightColorScheme :: ColorScheme diff --git a/src/Common/Error.hs b/src/Common/Error.hs index 204af4a0b..5e3065e00 100644 --- a/src/Common/Error.hs +++ b/src/Common/Error.hs @@ -9,9 +9,9 @@ Internal error monad. -} ----------------------------------------------------------------------------- -module Common.Error( Error, ErrorMessage(..), errorMsg, ok - , catchError, checkError, warningMsg, addWarnings, ignoreWarnings - , ppErrorMessage, errorWarning ) where +module Common.Error( Error, ErrorMessage(..), errorMsg, errorMsgPartial, ok + , catchError, checkError, checkPartial, setPartial, warningMsg, addWarnings, addPartialResult, ignoreWarnings + , ppErrorMessage, errorWarning, prettyWarnings ) where import Control.Monad import Control.Monad.Fail @@ -25,8 +25,8 @@ import Common.Message Errors --------------------------------------------------------------------------} -- | Error monad -data Error a = Error !ErrorMessage ![(Range,Doc)] - | Ok !a ![(Range,Doc)] +data Error b a = Error !ErrorMessage ![(Range,Doc)] (Maybe b) -- B is a partial result + | Ok !a ![(Range,Doc)] (Maybe b) -- | Error messages @@ -41,35 +41,61 @@ data ErrorMessage = ErrorGeneral !Range !Doc deriving (Show) -- | Check an 'Error' -checkError :: Error a -> Either ErrorMessage (a,[(Range,Doc)]) +checkError :: Error b a -> Either ErrorMessage (a,[(Range,Doc)]) checkError err = case err of - Error msg w -> Left (errorWarning w msg) - Ok x w -> Right (x,w) + Error msg w m -> Left (errorWarning w msg) + Ok x w m -> Right (x,w) -catchError :: Error a -> (ErrorMessage -> Error a) -> Error a +checkPartial :: Error b a -> Either (ErrorMessage, Maybe b) (a,[(Range,Doc)], Maybe b) +checkPartial err + = case err of + Error msg w m -> Left (errorWarning w msg,m) + Ok x w m -> Right (x,w,m) + +setPartial :: Maybe c -> Error b a -> Error c a +setPartial c err + = case err of + Error msg w m -> Error msg w c + Ok x w m -> Ok x w c + +catchError :: Error b a -> (ErrorMessage -> Error b a) -> Error b a catchError err handle = case err of - Error msg w -> addWarnings w (handle msg) - Ok x w -> Ok x w + Error msg w m -> addPartialResult (addWarnings w (handle msg)) m + Ok x w m -> Ok x w m -ok :: a -> Error a -ok x = Ok x [] +ok :: a -> Error b a +ok x = Ok x [] Nothing -errorMsg :: ErrorMessage -> Error a -errorMsg msg = Error msg [] +errorMsg :: ErrorMessage -> Error b a +errorMsg msg = Error msg [] Nothing -warningMsg :: (Range,Doc) -> Error () -warningMsg w - = Ok () [w] +errorMsgPartial :: ErrorMessage -> Maybe b -> Error b a +errorMsgPartial msg b = Error msg [] b +warningMsg :: (Range,Doc) -> Error b () +warningMsg w + = Ok () [w] Nothing -addWarnings :: [(Range,Doc)] -> Error a -> Error a +addWarnings :: [(Range,Doc)] -> Error b a -> Error b a addWarnings [] err = err addWarnings ws err = case err of - Error msg ws2 -> Error msg (ws ++ ws2) - Ok x ws2 -> Ok x (ws ++ ws2) + Error msg ws2 m -> Error msg (ws ++ ws2) m + Ok x ws2 m -> Ok x (ws ++ ws2) m + +addPartialResult :: Error b a -> Maybe b -> Error b a +addPartialResult err m + = case err of + Error msg ws m1 -> Error msg ws (m1 <|> m) + Ok x ws m1 -> Ok x ws (m1 <|> m) + +overridePartialResult :: Error b a -> Maybe b -> Error b a +overridePartialResult err m + = case err of + Error msg ws m1 -> Error msg ws (m <|> m1) + Ok x ws m1 -> Ok x ws (m <|> m1) errorWarning :: [(Range,Doc)] -> ErrorMessage -> ErrorMessage errorWarning [] msg = msg @@ -91,10 +117,10 @@ errorMerge err1 err2 unwarn (ErrorWarning warnings msg) = (warnings, msg) unwarn msg = ([],msg) -ignoreWarnings :: Error a -> Error a -ignoreWarnings (Error (ErrorWarning _ err) _) = Error err [] -ignoreWarnings (Error err _) = Error err [] -ignoreWarnings (Ok x _) = Ok x [] +ignoreWarnings :: Error b a -> Error b a +ignoreWarnings (Error (ErrorWarning _ err) _ m) = Error err [] m +ignoreWarnings (Error err _ m) = Error err [] m +ignoreWarnings (Ok x _ m) = Ok x [] m {-------------------------------------------------------------------------- pretty @@ -129,34 +155,34 @@ prettyWarnings endToo cscheme warnings {-------------------------------------------------------------------------- instances --------------------------------------------------------------------------} -instance Functor Error where +instance Functor (Error b) where fmap f e = case e of - Ok x w -> Ok (f x) w - Error msg w -> Error msg w + Ok x w m -> Ok (f x) w m + Error msg w m -> Error msg w m -instance Applicative Error where - pure x = Ok x [] - (<*>) = ap +instance Applicative (Error b) where + pure x = Ok x [] Nothing + (<*>) = ap -instance Monad Error where +instance Monad (Error b) where -- return = pure e >>= f = case e of - Ok x w -> addWarnings w (f x) - Error msg w -> Error msg w + Ok x w m -> addPartialResult (addWarnings w (f x)) m + Error msg w m -> Error msg w m -instance MonadFail Error where - fail s = Error (ErrorGeneral rangeNull (text s)) [] +instance MonadFail (Error b) where + fail s = Error (ErrorGeneral rangeNull (text s)) [] Nothing -instance MonadPlus Error where - mzero = Error ErrorZero [] +instance MonadPlus (Error b) where + mzero = Error ErrorZero [] Nothing mplus e1 e2 = case e1 of - Ok _ _ -> e1 - Error m1 w1 -> case e2 of - Ok _ _ -> e2 - Error m2 w2 -> Error (errorMerge m1 m2) (w1 ++ w2) + Ok{} -> e1 + Error m1 w1 m11 -> case e2 of + Ok{} -> addPartialResult e2 m11 + Error m2 w2 m12 -> Error (errorMerge m1 m2) (w1 ++ w2) (m12 `mplus` m11) -instance Alternative Error where +instance Alternative (Error b) where (<|>) = mplus empty = mzero diff --git a/src/Common/File.hs b/src/Common/File.hs index 739b60c35..c62811934 100644 --- a/src/Common/File.hs +++ b/src/Common/File.hs @@ -305,7 +305,8 @@ readTextFile :: FilePath -> IO (Maybe String) readTextFile fpath = B.exCatch (do content <- readFile fpath return (if null content then Just content else (seq (last content) $ Just content))) - (\exn -> return Nothing) + (\exn -> -- trace ("reading file " ++ fpath ++ " exception: " ++ exn) + return Nothing) writeTextFile :: FilePath -> String -> IO () writeTextFile fpath content diff --git a/src/Common/Range.hs b/src/Common/Range.hs index 9e46c9245..01c9ec789 100644 --- a/src/Common/Range.hs +++ b/src/Common/Range.hs @@ -14,7 +14,7 @@ module Common.Range ( Pos, makePos, minPos, maxPos, posColumn, posLine, posOfs , posMove8, posMoves8, posNull , Range, showFullRange - , makeRange, rangeNull, combineRange, rangeEnd, rangeStart + , makeRange, rangeNull, combineRange, rangeEnd, rangeStart, rangeLength , Ranged( getRange ), combineRanged , combineRangeds, combineRanges, extendRange , Source(Source,sourceName, sourceBString), sourceText, sourceFromRange @@ -275,6 +275,10 @@ rangeStart (Range p1 p2) = p1 rangeEnd :: Range -> Pos rangeEnd (Range p1 p2) = p2 +-- | Return the length of a range +rangeLength :: Range -> Int +rangeLength (Range p1 p2) = posOfs p2 - posOfs p1 + -- | Return the source of a range rangeSource :: Range -> Source rangeSource = posSource . rangeStart diff --git a/src/Common/Syntax.hs b/src/Common/Syntax.hs index 4c3fae317..172107cfb 100644 --- a/src/Common/Syntax.hs +++ b/src/Common/Syntax.hs @@ -147,7 +147,7 @@ isHandlerNormal _ = False data OperationSort - = OpVal | OpFun | OpExcept | OpControlRaw | OpControl + = OpVal | OpFun | OpExcept | OpControlRaw | OpControl | OpControlErr deriving (Eq,Ord) instance Show OperationSort where @@ -157,6 +157,7 @@ instance Show OperationSort where OpExcept -> "brk" OpControl -> "ctl" OpControlRaw -> "rawctl" + OpControlErr -> "" readOperationSort :: String -> Maybe OperationSort readOperationSort s diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index d16cbdc6e..1620ecd9b 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -9,6 +9,7 @@ Main module. -} ----------------------------------------------------------------------------- +{-# LANGUAGE InstanceSigs #-} module Compiler.Compile( -- * Compile compileFile , compileModule @@ -19,6 +20,7 @@ module Compiler.Compile( -- * Compile , compileValueDef, compileTypeDef , compileProgram , gammaFind + , codeGen -- * Types , Module(..) @@ -32,8 +34,8 @@ import Lib.Trace ( trace ) import Data.Char ( isAlphaNum, toLower, isSpace ) import System.Directory ( createDirectoryIfMissing, canonicalizePath, getCurrentDirectory, doesDirectoryExist ) -import Data.Maybe ( catMaybes ) -import Data.List ( isPrefixOf, intersperse ) +import Data.Maybe ( catMaybes, fromJust ) +import Data.List ( isPrefixOf, intersperse, intercalate ) import qualified Data.Set as S import Control.Applicative import Control.Monad ( ap, when ) @@ -51,7 +53,7 @@ import Common.Syntax import Common.Unique import Syntax.Syntax -- import Syntax.Lexer ( readInput ) -import Syntax.Parse ( parseProgramFromFile, parseValueDef, parseExpression, parseTypeDef, parseType ) +import Syntax.Parse ( parseProgramFromFile, parseValueDef, parseExpression, parseTypeDef, parseType, parseProgramFromString ) import Syntax.RangeMap import Syntax.Colorize ( colorize ) @@ -85,7 +87,7 @@ import Type.Pretty hiding ( verbose ) import Compiler.Options ( Flags(..), CC(..), BuildType(..), buildType, ccFlagsBuildFromFlags, unquote, prettyEnvFromFlags, colorSchemeFromFlags, prettyIncludePath, isValueFromFlags, fullBuildDir, outName, buildVariant, osName, targetExeExtension, - conanSettingsFromFlags, vcpkgFindRoot, onWindows, onMacOS) + conanSettingsFromFlags, vcpkgFindRoot, onWindows, onMacOS, Mode (ModeLanguageServer)) import Compiler.Module @@ -113,6 +115,7 @@ import Compiler.Package import Lib.Trace import qualified Data.Map +import Core.Core (Core(coreProgImports)) {-------------------------------------------------------------------------- @@ -127,47 +130,50 @@ data Terminal = Terminal{ termError :: ErrorMessage -> IO () } -data IOErr a = IOErr (IO (Error a)) +data IOErr b a = IOErr (IO (Error b a)) -runIOErr :: IOErr a -> IO (Error a) +runIOErr :: IOErr b a -> IO (Error b a) runIOErr (IOErr ie) = ie -liftError :: Error a -> IOErr a +liftErrorPartial :: c -> Error b a -> IOErr c a +liftErrorPartial partialT err = IOErr (return $ setPartial (Just partialT) err) + +liftError :: Error c a -> IOErr c a liftError err = IOErr (return err) -liftIO :: IO a -> IOErr a +liftIO :: IO a -> IOErr b a liftIO io = IOErr (do x <- io return (return x)) -lift :: IO (Error a) -> IOErr a +lift :: IO (Error b a) -> IOErr b a lift ie = IOErr ie -instance Functor IOErr where +instance Functor (IOErr b) where fmap f (IOErr ie) = IOErr (fmap (fmap f) ie) -instance Applicative IOErr where +instance Applicative (IOErr b) where pure x = IOErr (return (return x)) (<*>) = ap -instance Monad IOErr where +instance Monad (IOErr b) where -- return = pure (IOErr ie) >>= f = IOErr (do err <- ie - case checkError err of - Right (x,w) -> case f x of + case checkPartial err of + Right (x,w,b) -> case f x of IOErr ie' -> do err <- ie' - return (addWarnings w err) - Left msg -> return (errorMsg msg )) + return (addPartialResult (addWarnings w err) b) + Left (msg, b) -> return (errorMsgPartial msg b)) -instance F.MonadFail IOErr where +instance F.MonadFail (IOErr b) where fail = liftError . fail -bindIO :: IO (Error a) -> (a -> IO (Error b)) -> IO (Error b) +bindIO :: IO (Error b a) -> (a -> IO (Error b c)) -> IO (Error b c) bindIO io f = do err <- io - case checkError err of - Left msg -> return (errorMsg msg) - Right (x,w) -> fmap (addWarnings w) (f x) + case checkPartial err of + Left (msg, b) -> return (errorMsgPartial msg b) + Right (x,w,b) -> fmap (flip addPartialResult b . addWarnings w) (f x) gammaFind name g = case (gammaLookupQ name g) of @@ -175,33 +181,33 @@ gammaFind name g [] -> failure ("Compiler.Compile.gammaFind: can't locate " ++ show name) _ -> failure ("Compiler.Compile.gammaFind: multiple definitions for " ++ show name) - - - -compileExpression :: Terminal -> Flags -> Loaded -> CompileTarget () -> UserProgram -> Int -> String -> IO (Error Loaded) +compileExpression :: Terminal -> Flags -> Loaded -> CompileTarget () -> UserProgram -> Int -> String -> IO (Error Loaded Loaded) compileExpression term flags loaded compileTarget program line input = runIOErr $ do let qnameExpr = (qualify (getName program) nameExpr) - def <- liftError (parseExpression (semiInsert flags) (show nameInteractiveModule) line qnameExpr input) + def <- liftErrorPartial loaded (parseExpression (semiInsert flags) (show nameInteractiveModule) line qnameExpr input) let programDef = programAddDefs program [] [def] -- specialized code: either just call the expression, or wrap in a show function case compileTarget of -- run a particular entry point Executable name () | name /= nameExpr - -> compileProgram' term flags (loadedModules loaded) compileTarget "" programDef - + -> do + (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules loaded) [] compileTarget "" programDef [] + return ld -- entry point is the expression: compile twice: -- first to get the type of the expression and create a 'show' wrapper, -- then to actually run the program | otherwise - -> do ld <- compileProgram' term flags{ evaluate = False } (loadedModules loaded) Object {-compileTarget-} "" programDef + -> do (ld, f) <- compileProgram' (const Nothing) term flags{ evaluate = False } (loadedModules loaded) [] Object {-compileTarget-} "" programDef [] let tp = infoType (gammaFind qnameExpr (loadedGamma ld)) (_,_,rho) = splitPredType tp -- _ <- liftError $ checkUnhandledEffects flags loaded nameExpr rangeNull rho case splitFunType rho of -- return unit: just run the expression (for its assumed side effect) Just (_,_,tres) | isTypeUnit tres - -> compileProgram' term flags (loadedModules ld) compileTarget "" programDef + -> do + (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules ld) [] compileTarget "" programDef [] + return ld -- check if there is a show function, or use generic print if not. Just (_,_,tres) -> do -- ld <- compileProgram' term flags (loadedModules ld0) Nothing "" programDef @@ -218,16 +224,18 @@ compileExpression term flags loaded compileTarget program line input [mkApp (Var qnameShow False r) [mkApp (Var qnameExpr False r) []]] let defMain = Def (ValueBinder (qualify (getName program) nameMain) () (Lam [] expression r) r r) r Public (defFun []) InlineNever "" let programDef' = programAddDefs programDef [] [defMain] - compileProgram' term flags (loadedModules ld) (Executable nameMain ()) "" programDef' + compileProgram' (const Nothing) term flags (loadedModules ld) [] (Executable nameMain ()) "" programDef' [] return ld - _ -> liftError $ errorMsg (ErrorGeneral rangeNull (text "no 'show' function defined for values of type:" <+> ppType (prettyEnvFromFlags flags) tres)) + _ -> liftErrorPartial loaded $ errorMsg (ErrorGeneral rangeNull (text "no 'show' function defined for values of type:" <+> ppType (prettyEnvFromFlags flags) tres)) -- mkApp (Var (qualify nameSystemCore (newName "gprintln")) False r) -- [mkApp (Var nameExpr False r) []] Nothing -> failure ("Compile.Compile.compileExpression: should not happen") -- no evaluation - _ -> compileProgram' term flags (loadedModules loaded) compileTarget "" programDef + _ -> do + (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules loaded) [] compileTarget "" programDef [] + return ld errorModuleNotFound :: Flags -> Range -> Name -> ErrorMessage @@ -249,30 +257,31 @@ prettyEnv loaded flags = (prettyEnvFromFlags flags){ context = loadedName loaded, importsMap = loadedImportMap loaded } -compileType :: Terminal -> Flags -> Loaded -> UserProgram -> Int -> String -> IO (Error Loaded) +compileType :: Terminal -> Flags -> Loaded -> UserProgram -> Int -> String -> IO (Error Loaded Loaded) compileType term flags loaded program line input = runIOErr $ do let qnameType = qualify (getName program) nameType - tdef <- liftError $ parseType (semiInsert flags) (show nameInteractiveModule) line nameType input + tdef <- liftErrorPartial loaded $ parseType (semiInsert flags) (show nameInteractiveModule) line nameType input let programDef = programAddDefs (programRemoveAllDefs program) [tdef] [] -- typeCheck (loaded) flags line programDef - compileProgram' term flags (loadedModules loaded) Object "" programDef + (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules loaded) [] Object "" programDef [] + return ld -compileValueDef :: Terminal -> Flags -> Loaded -> UserProgram -> Int -> String -> IO (Error (Name,Loaded)) +compileValueDef :: Terminal -> Flags -> Loaded -> UserProgram -> Int -> String -> IO (Error Loaded (Name,Loaded)) compileValueDef term flags loaded program line input = runIOErr $ - do def <- liftError $ parseValueDef (semiInsert flags) (show nameInteractiveModule) line input + do def <- liftErrorPartial loaded $ parseValueDef (semiInsert flags) (show nameInteractiveModule) line input let programDef = programAddDefs program [] [def] - ld <- compileProgram' term flags (loadedModules loaded) Object "" programDef + (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules loaded) [] Object "" programDef [] return (qualify (getName program) (defName def),ld) -compileTypeDef :: Terminal -> Flags -> Loaded -> UserProgram -> Int -> String -> IO (Error (Name,Loaded)) +compileTypeDef :: Terminal -> Flags -> Loaded -> UserProgram -> Int -> String -> IO (Error Loaded (Name,Loaded)) compileTypeDef term flags loaded program line input = runIOErr $ - do (tdef,cdefs) <- liftError $ parseTypeDef (semiInsert flags) (show nameInteractiveModule) line input + do (tdef,cdefs) <- liftErrorPartial loaded $ parseTypeDef (semiInsert flags) (show nameInteractiveModule) line input let programDef = programAddDefs program [tdef] cdefs - ld <- compileProgram' term flags (loadedModules loaded) Object "" programDef + (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules loaded) [] Object "" programDef [] return (qualify (getName program) (typeDefName tdef),ld) @@ -281,35 +290,37 @@ compileTypeDef term flags loaded program line input These are meant to be called from the interpreter/main compiler ---------------------------------------------------------------} -compileModuleOrFile :: Terminal -> Flags -> Modules -> String -> Bool -> IO (Error Loaded) -compileModuleOrFile term flags modules fname force - | any (not . validModChar) fname = compileFile term flags modules Object fname +compileModuleOrFile :: (FilePath -> Maybe (BString, FileTime)) -> Maybe BString -> Terminal -> Flags -> Modules -> Modules -> String -> Bool -> CompileTarget () -> [Name] -> IO (Error Loaded (Loaded, Maybe FilePath)) +compileModuleOrFile maybeContents contents term flags modules cachedModules fname force compileTarget importPath + | any (not . validModChar) fname = compileFile maybeContents contents term flags modules cachedModules compileTarget importPath fname | otherwise = -- trace ("compileModuleOrFile: " ++ show fname ++ ", modules: " ++ show (map modName modules)) $ - do let modName = pathToModuleName fname - exist <- searchModule flags "" modName - case (exist) of + do + let modName = pathToModuleName fname + exist <- searchModule flags "" modName + case (exist) of Just (fpath) -> compileModule term (if force then flags{ forceModule = fpath } else flags) - modules modName - _ -> do fexist <- searchSourceFile flags "" fname - runIOErr $ - case (fexist) of - Just (root,stem) - -> compileProgramFromFile term flags modules Object root stem - Nothing - -> liftError $ errorMsg $ errorFileNotFound flags fname + modules cachedModules modName compileTarget importPath + _ -> do + fexist <- searchSourceFile flags "" fname + runIOErr $ + case (fexist) of + Just (root,stem) + -> compileProgramFromFile maybeContents contents term flags modules cachedModules Object importPath root stem + Nothing + -> liftError $ errorMsg $ errorFileNotFound flags fname where validModChar c = isAlphaNum c || c `elem` "/_" -compileFile :: Terminal -> Flags -> Modules -> CompileTarget () -> FilePath -> IO (Error Loaded) -compileFile term flags modules compileTarget fpath +compileFile :: (FilePath -> Maybe (BString, FileTime)) -> Maybe BString -> Terminal -> Flags -> Modules -> Modules -> CompileTarget () -> [Name] -> FilePath -> IO (Error Loaded (Loaded, Maybe FilePath)) +compileFile maybeContents contents term flags modules cachedModules compileTarget importPath fpath = runIOErr $ do mbP <- liftIO $ searchSourceFile flags "" fpath case mbP of Nothing -> liftError $ errorMsg (errorFileNotFound flags fpath) Just (root,stem) - -> compileProgramFromFile term flags modules compileTarget root stem + -> compileProgramFromFile maybeContents contents term flags modules cachedModules compileTarget importPath root stem -- | Make a file path relative to a set of given paths: return the (maximal) root and stem -- if it is not relative to the paths, return dirname/notdir @@ -322,34 +333,32 @@ makeRelativeToPaths paths fname (root,stem) -compileModule :: Terminal -> Flags -> Modules -> Name -> IO (Error Loaded) -compileModule term flags modules name -- todo: take force into account +compileModule :: Terminal -> Flags -> Modules -> Modules -> Name -> CompileTarget () -> [Name] -> IO (Error Loaded (Loaded, Maybe FilePath)) +compileModule term flags modules cachedModules name compileTarget importPath -- todo: take force into account = runIOErr $ do let imp = ImpProgram (Import name name rangeNull Private) - loaded <- resolveImports name term flags "" initialLoaded{ loadedModules = modules } [imp] + loaded <- resolveImports compileTarget (const Nothing) (newName "") term flags "" initialLoaded{ loadedModules = modules } cachedModules importPath [imp] -- trace ("compileModule: loaded modules: " ++ show (map modName (loadedModules loaded))) $ return () case filter (\m -> modName m == name) (loadedModules loaded) of - (mod:_) -> return loaded{ loadedModule = mod } + (mod:_) -> return (loaded{ loadedModule = mod }, Nothing) [] -> fail $ "Compiler.Compile.compileModule: module not found in imports: " ++ show name ++ " not in " ++ show (map (show . modName) (loadedModules loaded)) {--------------------------------------------------------------- Internal compilation ---------------------------------------------------------------} -compileProgram :: Terminal -> Flags -> Modules -> CompileTarget () -> FilePath -> UserProgram -> IO (Error Loaded) -compileProgram term flags modules compileTarget fname program - = runIOErr $ compileProgram' term flags modules compileTarget fname program +compileProgram :: Terminal -> Flags -> Modules -> Modules -> CompileTarget () -> FilePath -> UserProgram -> [Name] -> IO (Error Loaded (Loaded, Maybe FilePath)) +compileProgram term flags modules cachedModules compileTarget fname program importPath + = runIOErr $ compileProgram' (const Nothing) term flags modules cachedModules compileTarget fname program importPath - -compileProgramFromFile :: Terminal -> Flags -> Modules -> CompileTarget () -> FilePath -> FilePath -> IOErr Loaded -compileProgramFromFile term flags modules compileTarget rootPath stem +compileProgramFromFile :: (FilePath -> Maybe (BString, FileTime)) -> Maybe BString -> Terminal -> Flags -> Modules -> Modules -> CompileTarget () -> [Name] -> FilePath -> FilePath -> IOErr Loaded (Loaded, Maybe FilePath) +compileProgramFromFile maybeContents contents term flags modules cachedModules compileTarget importPath rootPath stem = do let fname = joinPath rootPath stem -- trace ("compileProgramFromFile: " ++ show fname ++ ", modules: " ++ show (map modName modules)) $ return () liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "compile:") <+> color (colorSource (colorScheme flags)) (text (normalizeWith '/' fname))) - liftIO $ termPhase term ("parsing " ++ fname) exist <- liftIO $ doesFileExist fname if (exist) then return () else liftError $ errorMsg (errorFileNotFound flags fname) - program <- lift $ parseProgramFromFile (semiInsert flags) fname + program <- lift $ case contents of { Just x -> return $ parseProgramFromString (semiInsert flags) x fname; _ -> parseProgramFromFile (semiInsert flags) fname} let isSuffix = -- asciiEncode True (noexts stem) `endsWith` asciiEncode True (show (programName program)) -- map (\c -> if isPathSep c then '/' else c) (noexts stem) show (pathToModuleName (noexts stem)) `endsWith` show (programName program) @@ -364,42 +373,50 @@ compileProgramFromFile term flags modules compileTarget rootPath stem parens (ppcolor colorSource $ text $ dquote $ stem) )) let stemName = nameFromFile stem - compileProgram' term flags modules compileTarget fname program{ programName = stemName } + -- let flags2 = flags{forceModule = fname} + compileProgram' maybeContents term flags modules cachedModules compileTarget fname program{ programName = stemName } importPath nameFromFile :: FilePath -> Name nameFromFile fname = pathToModuleName $ dropWhile isPathSep $ noexts fname data CompileTarget a - = Object + = InMemory + | Object | Library | Executable { entry :: Name, info :: a } isExecutable (Executable _ _) = True isExecutable _ = False -compileProgram' :: Terminal -> Flags -> Modules -> CompileTarget () -> FilePath -> UserProgram -> IOErr Loaded -compileProgram' term flags modules compileTarget fname program +compileProgram' :: (FilePath -> Maybe (BString, FileTime)) -> Terminal -> Flags -> Modules -> Modules -> CompileTarget () -> FilePath -> UserProgram -> [Name] -> IOErr Loaded (Loaded, Maybe FilePath) +compileProgram' maybeContents term flags modules cachedModules compileTarget fname program importPath = do liftIO $ termPhase term ("compile program' " ++ show (getName program)) - ftime <- liftIO (getFileTimeOrCurrent fname) let name = getName program outIFace = outName flags (showModName name) ++ ifaceExtension - mod = (moduleNull name){ + ftime <- liftIO (getCurrentFileTime fname maybeContents) + iftime <- liftIO (maybeGetCurrentFileTime outIFace (const Nothing)) + let mod = (moduleNull name){ modPath = outIFace, modSourcePath = fname, modProgram = (Just program), - modCore = failure "Compiler.Compile.compileProgram: recursive module import", - modTime = ftime + modCore = failure ("Compiler.Compile.compileProgram: recursive module import (" ++ fname ++ ")"), + modSourceTime = ftime, + modTime = iftime, + modOutputTime = iftime } allmods = addOrReplaceModule mod modules loaded = initialLoaded { loadedModule = mod , loadedModules = allmods } + depTarget = case compileTarget of + InMemory -> InMemory + _ -> Object -- trace ("compile file: " ++ show fname ++ "\n time: " ++ show ftime ++ "\n latest: " ++ show (loadedLatest loaded)) $ return () liftIO $ termPhase term ("resolve imports " ++ show (getName program)) - loaded1 <- resolveImports (getName program) term flags (dirname fname) loaded (map ImpProgram (programImports program)) - --trace (" loaded modules: " ++ show (map modName (loadedModules loaded1))) $ return () - --trace ("------\nloaded1:\n" ++ show (loadedNewtypes loaded1) ++ "\n----") $ return () + loaded1 <- resolveImports depTarget maybeContents (getName program) term flags (dirname fname) loaded cachedModules importPath (map ImpProgram (programImports program)) + -- trace (" loaded modules: " ++ show (map modName (loadedModules loaded1))) $ return () + --trace ("------\nloaded1:\n" ++ show (loadedNewtypes loaded1) ++ "\n----") $ return () -- trace ("inlines: " ++ show (loadedInlines loaded1)) $ return () if (name /= nameInteractiveModule || verbose flags > 0) @@ -412,7 +429,8 @@ compileProgram' term flags modules compileTarget fname program (imp:_) -> importVis imp -- TODO: get max in if (modName mod == name) then [] else [Core.Import (modName mod) (modPackagePath mod) vis (Core.coreProgDoc (modCore mod))] - (loaded2a, coreDoc) <- liftError $ typeCheck loaded1 flags 0 coreImports program + + (loaded2a, coreDoc) <- liftErrorPartial loaded1 $ typeCheck loaded1 flags 0 coreImports program ftime when (showCore flags) $ liftIO (termDoc term (vcat [ text "-------------------------", @@ -422,6 +440,8 @@ compileProgram' term flags modules compileTarget fname program text "-------------------------" ])) + -- use time of type check as modTime + time <- liftIO getCurrentTime -- cull imports to only the real dependencies let mod = loadedModule loaded2a inlineDefs = case (modInlines mod) of @@ -430,50 +450,68 @@ compileProgram' term flags modules compileTarget fname program deps = Core.dependencies inlineDefs (modCore mod) imps = filter (\imp -> isPublic (Core.importVis imp) || Core.importName imp == nameSystemCore || S.member (Core.importName imp) deps) (Core.coreProgImports (modCore mod)) - mod' = mod{ modCore = (modCore mod){ Core.coreProgImports = imps } } + mod' = mod{ modCore = (modCore mod){ Core.coreProgImports = imps }, modTime = Just time } loaded2 = loaded2a{ loadedModule = mod' } -- codegen liftIO $ termPhase term ("codegen " ++ show (getName program)) - (newTarget,loaded3) <- liftError $ - case compileTarget of - Executable entryName _ - -> let mainName = if (isQualified entryName) then entryName else qualify (getName program) (entryName) in - case gammaLookupQ mainName (loadedGamma loaded2) of - [] -> errorMsg (ErrorGeneral rangeNull (text "there is no 'main' function defined" <-> text "hint: use the '-l' flag to generate a library?")) - infos-> let mainType = TFun [] (TCon (TypeCon nameTpIO kindEffect)) typeUnit -- just for display, so IO can be TCon - isMainType tp = case expandSyn tp of - TFun [] eff resTp -> True -- resTp == typeUnit - _ -> False - in case filter (isMainType . infoType) infos of - [InfoFun{infoType=tp,infoRange=r}] - -> do mbF <- checkUnhandledEffects flags loaded2 mainName r tp - case mbF of - Nothing -> return (Executable mainName tp, loaded2) - Just f -> - let mainName2 = qualify (getName program) (newHiddenName "hmain") - expression = App (Var (if (isHiddenName mainName) then mainName -- .expr - else unqualify mainName -- main - ) False r) [] r - defMain = Def (ValueBinder (unqualify mainName2) () (Lam [] (f expression) r) r r) r Public (defFun []) InlineNever "" - program2 = programAddDefs program [] [defMain] - in do (loaded3,_) <- ignoreWarnings $ typeCheck loaded1 flags 0 coreImports program2 - return (Executable mainName2 tp, loaded3) -- TODO: refine the type of main2 - [info] - -> errorMsg (ErrorGeneral (infoRange info) (text "'main' must be declared as a function (fun)")) - [] -> errorMsg (ErrorGeneral rangeNull (text "the type of 'main' must be a function without arguments" <-> - table [(text "expected type", ppType (prettyEnvFromFlags flags) mainType) - ,(text "inferred type", ppType (prettyEnvFromFlags flags) (head (map infoType infos)))])) - _ -> errorMsg (ErrorGeneral rangeNull (text "found multiple definitions for the 'main' function")) - Object -> return (Object,loaded2) - Library -> return (Library,loaded2) - - loaded4 <- liftIO $ codeGen term flags newTarget loaded3 + (newTarget,loaded3) <- doCodeGen term flags loaded2 loaded1 compileTarget program coreImports + (loaded4, outFile) <- liftIO $ case newTarget of + InMemory -> return (loaded3{loadedModule = (loadedModule loaded3){modOutputTime = Nothing}}, Nothing) + _ -> do + -- TODO: Get output file time and check if it is different from the source time used to type-check + (loadedNew, mbRun) <- codeGen term flags newTarget loaded3 + -- run the program + when (evaluate flags && isExecutable newTarget) $ + compilerCatch "program run" term () $ + case mbRun of + Just (_,run) -> do termPhase term "evaluate" + termDoc term space + run + _ -> termDoc term space + return (loadedNew, fmap fst mbRun) -- liftIO $ termDoc term (text $ show (loadedGamma loaded4)) - -- trace (" final loaded modules: " ++ show (map modName (loadedModules loaded4))) $ return () - return loaded4{ loadedModules = addOrReplaceModule (loadedModule loaded4) (loadedModules loaded4) } - -checkUnhandledEffects :: Flags -> Loaded -> Name -> Range -> Type -> Error (Maybe (UserExpr -> UserExpr)) + --trace (" final loaded modules: " ++ show (map modName (loadedModules loaded4))) $ return () + return (loaded4{ loadedModules = addOrReplaceModule (loadedModule loaded4) (loadedModules loaded4) }, outFile) + +doCodeGen :: Terminal -> Flags -> Loaded -> Loaded -> CompileTarget a -> Program UserType UserKind -> [Core.Import] -> IOErr Loaded (CompileTarget Scheme, Loaded) +doCodeGen term flags loaded0 loaded1 compileTarget program coreImports = do + liftIO $ termPhase term ("codegen " ++ show (getName program)) + liftErrorPartial loaded1 $ + case compileTarget of + Executable entryName _ + -> let mainName = if (isQualified entryName) then entryName else qualify (getName program) (entryName) in + case gammaLookupQ mainName (loadedGamma loaded0) of + [] -> errorMsg (ErrorGeneral rangeNull (text "there is no 'main' function defined" <-> text "hint: use the '-l' flag to generate a library?")) + infos-> let mainType = TFun [] (TCon (TypeCon nameTpIO kindEffect)) typeUnit -- just for display, so IO can be TCon + isMainType tp = case expandSyn tp of + TFun [] eff resTp -> True -- resTp == typeUnit + _ -> False + in case filter (isMainType . infoType) infos of + [InfoFun{infoType=tp,infoRange=r}] + -> do mbF <- checkUnhandledEffects flags loaded0 mainName r tp + case mbF of + Nothing -> return (Executable mainName tp, loaded0) + Just f -> + let mainName2 = qualify (getName program) (newHiddenName "hmain") + expression = App (Var (if (isHiddenName mainName) then mainName -- .expr + else unqualify mainName -- main + ) False r) [] r + defMain = Def (ValueBinder (unqualify mainName2) () (Lam [] (f expression) r) r r) r Public (defFun []) InlineNever "" + program2 = programAddDefs program [] [defMain] + in do (loaded3,_) <- ignoreWarnings $ typeCheck loaded1 flags 0 coreImports program2 (modSourceTime $ loadedModule loaded1) + return (Executable mainName2 tp, loaded3) -- TODO: refine the type of main2 + [info] + -> errorMsg (ErrorGeneral (infoRange info) (text "'main' must be declared as a function (fun)")) + [] -> errorMsg (ErrorGeneral rangeNull (text "the type of 'main' must be a function without arguments" <-> + table [(text "expected type", ppType (prettyEnvFromFlags flags) mainType) + ,(text "inferred type", ppType (prettyEnvFromFlags flags) (head (map infoType infos)))])) + _ -> errorMsg (ErrorGeneral rangeNull (text "found multiple definitions for the 'main' function")) + Object -> return (Object,loaded0) + Library -> return (Library,loaded0) + InMemory -> return (InMemory,loaded0) + +checkUnhandledEffects :: Flags -> Loaded -> Name -> Range -> Type -> Error Loaded (Maybe (UserExpr -> UserExpr)) checkUnhandledEffects flags loaded name range tp = case expandSyn tp of TFun _ eff _ @@ -484,7 +522,7 @@ checkUnhandledEffects flags loaded name range tp where exclude = [nameTpCps,nameTpNamed] -- nameTpAsync - combine :: Effect -> Maybe (UserExpr -> UserExpr) -> [Effect] -> Error (Maybe (UserExpr -> UserExpr)) + combine :: Effect -> Maybe (UserExpr -> UserExpr) -> [Effect] -> Error Loaded (Maybe (UserExpr -> UserExpr)) combine eff mf [] = return mf combine eff mf (l:ls) = case getHandledEffectX exclude l of Nothing -> combine eff mf ls @@ -526,26 +564,26 @@ impFullName (ImpProgram imp) = importFullName imp impFullName (ImpCore cimp) = Core.importName cimp -resolveImports :: Name -> Terminal -> Flags -> FilePath -> Loaded -> [ModImport] -> IOErr (Loaded) -resolveImports mname term flags currentDir loaded0 imports0 +resolveImports :: CompileTarget () -> (FilePath -> Maybe (BString, FileTime)) -> Name -> Terminal -> Flags -> FilePath -> Loaded -> Modules -> [Name] -> [ModImport] -> IOErr Loaded Loaded +resolveImports compileTarget maybeContents mname term flags currentDir loaded0 cachedModules importPath imports0 = do -- trace (show mname ++ ": resolving imports: current modules: " ++ show (map (show . modName) (loadedModules loaded0)) ++ "\n") $ return () - (imports,resolved) <- resolveImportModules mname term flags currentDir (removeModule mname (loadedModules loaded0)) imports0 + (imports,resolved) <- resolveImportModules compileTarget maybeContents mname term flags currentDir (removeModule mname (loadedModules loaded0)) cachedModules (mname:importPath) imports0 -- trace (show mname ++ ": resolved imports, imported: " ++ show (map (show . modName) imports) ++ "\n resolved to: " ++ show (map (show . modName) resolved) ++ "\n") $ return () let load msg loaded [] = return loaded load msg loaded (mod:mods) = do let (loaded1,errs) = loadedImportModule (isValueFromFlags flags) loaded mod (rangeNull) (modName mod) -- trace ("loaded " ++ msg ++ " module: " ++ show (modName mod)) $ return () - mapM_ (\err -> liftError (errorMsg err)) errs + mapM_ (\err -> liftErrorPartial loaded0 (errorMsg err)) errs load msg loaded1 mods - loadInlines :: Loaded -> Module -> IOErr [Core.InlineDef] + loadInlines :: Loaded -> Module -> IOErr Loaded [Core.InlineDef] loadInlines loaded mod = case modInlines mod of Right idefs -> return idefs Left parseInlines -> do -- trace ("load module inline defs: " ++ show (modName mod)) $ return () - liftError $ parseInlines (loadedGamma loaded) -- process inlines after all have been loaded + liftErrorPartial loaded $ parseInlines (loadedGamma loaded) -- process inlines after all have been loaded loadedImp <- load "import" loaded0 imports @@ -557,19 +595,23 @@ resolveImports mname term flags currentDir loaded0 imports0 -- trace ("resolved inlines: " ++ show (length inlineDefss, length inlineDefs)) $ return () return loadedImp{ loadedModules = modsFull, loadedInlines = inlines } -resolveImportModules :: Name -> Terminal -> Flags -> FilePath -> [Module] -> [ModImport] -> IOErr ([Module],[Module]) -resolveImportModules mname term flags currentDir resolved [] +resolveImportModules :: CompileTarget () -> (FilePath -> Maybe (BString, FileTime)) -> Name -> Terminal -> Flags -> FilePath -> [Module] -> Modules -> [Name] -> [ModImport] -> IOErr Loaded ([Module],[Module]) +resolveImportModules compileTarget maybeContents mname term flags currentDir resolved cachedModules importPath [] = return ([],resolved) -resolveImportModules mname term flags currentDir resolved0 (imp:imps) - = do -- trace (show mname ++ ": resolving imported modules: " ++ show (impName imp) ++ ", resolved: " ++ show (map (show . modName) resolved0)) $ return () +resolveImportModules compileTarget maybeContents mname term flags currentDir resolved0 cachedModules importPath (imp:imps) + = if impName imp `elem` importPath then do + liftError $ errorMsg $ ErrorStatic [(getRange imp, text "cyclic module dependency detected when importing: " <+> ppName (prettyEnvFromFlags flags) mname <+> text " import path: " <-> vsep (reverse (map (ppName (prettyEnvFromFlags flags)) importPath)))] + return (resolved0,resolved0) + else + do -- trace ("\t" ++ show mname ++ ": resolving imported modules: " ++ show (impName imp) ++ ", resolved: " ++ show (map (show . modName) resolved0) ++ ", path:" ++ show importPath) $ return () (mod,resolved1) <- case filter (\m -> impName imp == modName m) resolved0 of (mod:_) -> return (mod,resolved0) - _ -> resolveModule term flags currentDir resolved0 imp - -- trace (" newly resolved from " ++ show (modName mod) ++ ": " ++ show (map (show . modName) resolved1)) $ return () + _ -> resolveModule compileTarget maybeContents term flags currentDir resolved0 cachedModules importPath imp + -- trace ("\tnewly resolved from " ++ show (modName mod) ++ ": " ++ show (map (show . modName) resolved1)) $ return () let imports = Core.coreProgImports $ modCore mod pubImports = map ImpCore (filter (\imp -> Core.importVis imp == Public) imports) -- trace (" resolve further imports (from " ++ show (modName mod) ++ ") (added module: " ++ show (impName imp) ++ " public imports: " ++ show (map (show . impName) pubImports) ++ ")") $ return () - (needed,resolved2) <- resolveImportModules mname term flags currentDir resolved1 (pubImports ++ imps) + (needed,resolved2) <- resolveImportModules compileTarget maybeContents mname term flags currentDir resolved1 cachedModules importPath (pubImports ++ imps) let needed1 = filter (\m -> modName m /= modName mod) needed -- no dups return (mod:needed1,resolved2) @@ -584,9 +626,26 @@ searchModule flags currentDir name Nothing -> searchPackageIface flags currentDir Nothing name Just iface -> return (Just iface) - -resolveModule :: Terminal -> Flags -> FilePath -> [Module] -> ModImport -> IOErr (Module,[Module]) -resolveModule term flags currentDir modules mimp +getCurrentFileTime :: FilePath -> (FilePath -> Maybe (BString, FileTime)) -> IO FileTime +getCurrentFileTime fp maybeContents = do + f <- realPath fp + case maybeContents f of + Just (_, t) -> return t + Nothing -> getFileTimeOrCurrent fp + +maybeGetCurrentFileTime :: FilePath -> (FilePath -> Maybe (BString, FileTime)) -> IO (Maybe FileTime) +maybeGetCurrentFileTime fp maybeContents = do + f <- realPath fp + case maybeContents f of + Just (_, t) -> return $ Just t + Nothing -> do + -- trace ("File " ++ show fp ++ " not in virtual filesystem") $ return () + ft <- getFileTime fp + if ft == fileTime0 then return Nothing else return $ -- (trace $ "Get maybe " ++ show ft) $ + Just ft + +resolveModule :: CompileTarget () -> (FilePath -> Maybe (BString, FileTime)) -> Terminal -> Flags -> FilePath -> [Module] -> Modules -> [Name] -> ModImport -> IOErr Loaded (Module,[Module]) +resolveModule compileTarget maybeContents term flags currentDir modules cachedModules importPath mimp = -- trace ("resolve module: " ++ show (impFullName mimp) ++ ", resolved: " ++ show (map (show . modName) modules) ++ ", in " ++ show currentDir) $ case mimp of -- program import @@ -604,15 +663,15 @@ resolveModule term flags currentDir modules mimp Nothing -> liftError $ errorMsg $ errorModuleNotFound flags (importRange imp) name Just iface -> -- it is a package interface do -- TODO: check there is no (left-over) iface in the outputDir? - loadFromIface iface "" "" - Just iface -> do loadFromIface iface "" "" + loadFromIface iface "" "" (importName imp) + Just iface -> do loadFromIface iface "" "" (importName imp) Just (root,stem,mname) -> -- source found, search output iface do mbIface <- liftIO $ searchOutputIface flags mname - -- trace ("load from program: " ++ show (mbSource,mbIface)) $ return () + -- trace ("load from program: " ++ show (mbSource,mbIface)) $ return () case mbIface of - Nothing -> loadFromSource modules root stem - Just iface -> loadDepend iface root stem + Nothing -> loadFromSource False False modules root stem mname + Just iface -> loadDepend iface root stem mname -- core import in source ImpCore cimp | (null (Core.importPackage cimp)) && (currentDir == fullBuildDir flags) -> @@ -623,14 +682,14 @@ resolveModule term flags currentDir modules mimp (Nothing,Nothing) -> liftError $ errorMsg $ errorModuleNotFound flags rangeNull name (Nothing,Just (root,stem,mname)) - -> loadFromSource modules root stem + -> loadFromSource False False modules root stem mname (Just iface,Nothing) -> do let cscheme = (colorSchemeFromFlags flags) liftIO $ termDoc term $ color (colorWarning cscheme) $ text "warning: interface" <+> color (colorModule cscheme) (pretty name) <+> text "found but no corresponding source module" - loadFromIface iface "" "" + loadFromIface iface "" "" (Core.importName cimp) (Just iface,Just (root,stem,mname)) - -> loadDepend iface root stem + -> loadDepend iface root stem mname -- core import of package ImpCore cimp -> @@ -638,37 +697,80 @@ resolveModule term flags currentDir modules mimp -- trace ("core import pkg: " ++ Core.importPackage cimp ++ "/" ++ show name ++ ": found: " ++ show (mbIface)) $ return () case mbIface of Nothing -> liftError $ errorMsg $ errorModuleNotFound flags rangeNull name - Just iface -> loadFromIface iface "" "" + Just iface -> loadFromIface iface "" "" (Core.importName cimp) where name = impFullName mimp - loadDepend iface root stem - = do let srcpath = joinPath root stem - ifaceTime <- liftIO $ getFileTimeOrCurrent iface - sourceTime <- liftIO $ getFileTimeOrCurrent srcpath + tryLoadFromCache :: Name -> FilePath -> FilePath -> IOErr Loaded (Maybe (Module, Modules)) + tryLoadFromCache mname root stem + = do + let srcpath = joinPath root stem + sourceTime0 <- liftIO $ maybeGetCurrentFileTime srcpath maybeContents + case sourceTime0 of + Nothing -> trace ("Error " ++ show srcpath ++ " doesn't exist") $ return Nothing + Just sourceTime -> + case lookupImportName mname cachedModules of + Just mod -> + if srcpath /= forceModule flags && modSourceTime mod == sourceTime + then do + -- trace ("Loading module " ++ show mname ++ " from cache") $ return () + x <- loadFromModule (modPath mod) root stem mod + return $ Just x + else + -- trace ("Found mod " ++ show mname ++ " in cache but was forced or old modTime " ++ show (modSourceTime mod) ++ " srctime " ++ show sourceTime ++ " force " ++ forceModule flags ) + return Nothing + _ -> + -- trace ("Could not find mod " ++ show mname ++ " in cache " ++ show (map modSourcePath cachedModules)) $ + return Nothing + + loadDepend iface root stem mname + = -- trace ("loadDepend " ++ iface ++ " " ++ root ++ "/" ++ stem) $ + do let srcpath = joinPath root stem + ifaceTime <- liftIO $ getCurrentFileTime iface maybeContents + sourceTime <- liftIO $ getCurrentFileTime srcpath maybeContents + -- trace ("loadDepend: " ++ show (ifaceTime, sourceTime)) $ return () case lookupImport iface modules of - Just mod -> - if (srcpath /= forceModule flags && modTime mod >= sourceTime) - then -- trace ("module " ++ show (name) ++ " already loaded") $ - -- loadFromModule iface root stem mod - return (mod,modules) -- TODO: revise! do proper dependency checking instead.. - else -- trace ("module " ++ show ( name) ++ " already loaded but not recent enough..\n " ++ show (modTime mod, sourceTime)) $ - loadFromSource modules root stem - Nothing -> - -- trace ("module " ++ show (name) ++ " not yet loaded") $ - if (not (rebuild flags) && srcpath /= forceModule flags && ifaceTime >= sourceTime) - then loadFromIface iface root stem - else loadFromSource modules root stem - - loadFromSource modules1 root fname - = -- trace ("loadFromSource: " ++ root ++ "/" ++ fname) $ - do loadedImp <- compileProgramFromFile term flags modules1 Object root fname - let mod = loadedModule loadedImp - allmods = addOrReplaceModule mod modules - return (mod, loadedModules loadedImp) - - loadFromIface iface root stem + Just mod -> + if (srcpath /= forceModule flags && modSourceTime mod == sourceTime) + then -- trace ("module " ++ show (name) ++ " already loaded") $ + -- loadFromModule iface root stem mod + return (mod,modules) -- TODO: revise! do proper dependency checking instead.. + else if (not (rebuild flags) && srcpath /= forceModule flags && ifaceTime >= sourceTime) + then loadFromIface iface root stem mname + else loadFromSource False True modules root stem (nameFromFile iface) + _ -> do + cached <- tryLoadFromCache mname root stem + case cached of + Just (mod, mods) -> + do liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "reusing:") <+> + color (colorSource (colorScheme flags)) + (pretty (nameFromFile iface))) + return (mod, mods) + Nothing -> + -- trace ("module " ++ show (name) ++ " not yet loaded") $ + if (not (rebuild flags) && srcpath /= forceModule flags && ifaceTime >= sourceTime) + then loadFromIface iface root stem mname + else loadFromSource False True modules root stem (nameFromFile iface) + + loadFromSource force genUpdate modules1 root fname mname + = -- trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " " ++ root ++ "/" ++ fname) $ + do + cached <- if force then return Nothing else tryLoadFromCache mname root fname + case cached of + Just (mod, modules) -> + do liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "reusing:") <+> + color (colorSource (colorScheme flags)) + (pretty mname)) + return (mod, modules) + _ -> do + f <- liftIO $ realPath fname + (loadedImp, _) <- compileProgramFromFile maybeContents (fst <$> maybeContents f) term flags modules1 cachedModules (if genUpdate then Object else compileTarget) importPath root fname + let mod = loadedModule loadedImp + allmods = addOrReplaceModule mod modules + return (mod, loadedModules loadedImp) + + loadFromIface iface root stem mname = -- trace ("loadFromIFace: " ++ iface ++ ": " ++ root ++ "/" ++ stem ++ "\n in modules: " ++ show (map modName modules)) $ do let (pkgQname,pkgLocal) = packageInfoFromDir (packages flags) (dirname iface) loadMessage msg = liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text msg) <+> @@ -679,15 +781,24 @@ resolveModule term flags currentDir modules mimp -> do loadMessage "reusing:" return mod Nothing - -> do loadMessage "loading:" - ftime <- liftIO $ getFileTime iface - (core,parseInlines) <- lift $ parseCore iface - -- let core = uniquefy core0 - outIFace <- liftIO $ copyIFaceToOutputDir term flags iface core - let mod = Module (Core.coreName core) outIFace (joinPath root stem) pkgQname pkgLocal [] - Nothing -- (error ("getting program from core interface: " ++ iface)) - core (Left parseInlines) Nothing ftime - return mod + -> do + cached <- tryLoadFromCache mname root stem + case cached of + Just (mod, mods) -> + do loadMessage "reusing:" + return mod + Nothing -> do + loadMessage "loading:" + iftime <- liftIO $ getFileTime iface + ftime <- liftIO $ getCurrentFileTime (joinPath root stem) maybeContents + mbCore <- liftIO $ parseCore iface + (core,parseInlines) <- liftError mbCore + -- let core = uniquefy core0 + outIFace <- liftIO $ copyIFaceToOutputDir term flags iface core + let mod = Module (Core.coreName core) outIFace (joinPath root stem) pkgQname pkgLocal [] + Nothing -- (error ("getting program from core interface: " ++ iface)) + core True (Left parseInlines) Nothing ftime (Just iftime) Nothing + return mod loadFromModule (modPath mod){-iface-} root stem mod loadFromModule iface root source mod @@ -696,15 +807,42 @@ resolveModule term flags currentDir modules mimp -- , loadedModules = allmods -- } -- (loadedImp,impss) <- resolveImports term flags (dirname iface) loaded (map ImpCore (Core.coreProgImports (modCore mod))) - (imports,resolved1) <- resolveImportModules name term flags (dirname iface) modules (map ImpCore (Core.coreProgImports (modCore mod))) - let latest = maxFileTimes (map modTime imports) - -- trace ("loaded iface: " ++ show iface ++ "\n time: " ++ show (modTime mod) ++ "\n latest: " ++ show (latest)) $ return () - if (latest >= modTime mod + (imports,resolved1) <- resolveImportModules compileTarget maybeContents name term flags (dirname iface) modules cachedModules (name:importPath) (map ImpCore (Core.coreProgImports (modCore mod))) + let latest = maxFileTimes (map modSourceTime imports) + + let allmods = addOrReplaceModule mod resolved1 + result = (mod{ modSourcePath = joinPath root source }, allmods) + -- trace ("loaded iface: " ++ show iface ++ "\n time: " ++ show (modTime mod) ++ "\n latest: " ++ show (latest)) $ return () + if (latest > (fromJust $ modTime mod) && not (null source)) -- happens if no source is present but (package) depencies have updated... - then loadFromSource resolved1 root source -- load from source after all - else do liftIO $ copyPkgIFaceToOutputDir term flags iface (modCore mod) (modPackageQPath mod) imports - let allmods = addOrReplaceModule mod resolved1 - return (mod{ modSourcePath = joinPath root source }, allmods) + then do + -- trace ("iface " ++ show (modName mod) ++ " is out of date, reloading..." ++ (show (modTime mod) ++ " dependencies:\n" ++ intercalate "\n" (map (\m -> show (modName m, modTime m)) imports))) $ return () + -- load from source after all + loadFromSource True True resolved1 root source (nameFromFile iface) + else + -- trace ("using loaded module: " ++ show (modName mod)) $ + case compileTarget of + InMemory -> return result + _ -> do + -- trace ("loaded module requires compiling") $ return () + outputTime <- liftIO $ getFileTime iface + if fromJust (modTime mod) > outputTime then do + -- (imports,resolved1) <- resolveImportModules Object maybeContents name term flags (dirname iface) modules cachedModules (name:importPath) (map ImpCore (Core.coreProgImports (modCore mod))) + let allmods = addOrReplaceModule mod resolved1 + -- Compile from cache if CompileTarget is Executable / Object and module is InMemory and outputFileTime < modTime + liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "generating:") <+> + color (colorSource (colorScheme flags)) + (pretty (modName mod))) + liftIO $ copyPkgIFaceToOutputDir term flags iface (modCore mod) (modPackageQPath mod) imports + let loaded = initialLoaded { + loadedModule = mod, + loadedModules = allmods + } + (newLoaded, _) <- liftIO $! codeGen term flags Object loaded + return (loadedModule newLoaded, loadedModules newLoaded) + else return result + + lookupImport :: FilePath {- interface name -} -> Modules -> Maybe Module @@ -712,7 +850,18 @@ lookupImport imp [] = Nothing lookupImport imp (mod:mods) = if (modPath mod == imp) then Just (mod) - else lookupImport imp mods + else + -- trace ("lookupImport: " ++ show imp ++ " /= " ++ show (modPath mod)) $ + lookupImport imp mods + +lookupImportName :: Name -> Modules -> Maybe Module +lookupImportName imp [] = Nothing +lookupImportName imp (mod:mods) + = if modName mod == imp + then Just mod + else + -- trace ("lookupImportName: " ++ show imp ++ " /= " ++ show (modName mod)) $ + lookupImportName imp mods searchPackageIface :: Flags -> FilePath -> Maybe PackageName -> Name -> IO (Maybe FilePath) @@ -774,8 +923,8 @@ searchIncludeIface flags currentDir name {--------------------------------------------------------------- ---------------------------------------------------------------} -typeCheck :: Loaded -> Flags -> Int -> [Core.Import] -> UserProgram -> Error (Loaded,Doc) -typeCheck loaded flags line coreImports program +typeCheck :: Loaded -> Flags -> Int -> [Core.Import] -> UserProgram -> FileTime -> Error Loaded (Loaded,Doc) +typeCheck loaded flags line coreImports program srcTime = do -- static checks -- program1 <- {- mergeSignatures (colorSchemeFromFlags flags) -} (implicitPromotion program) let program0 = -- implicitPromotion (loadedConstructors loaded) @@ -788,7 +937,6 @@ typeCheck loaded flags line coreImports program fixitiesAll = fixitiesNew [(name,fix) | FixDef name fix rng vis <- programFixDefs program0] (program2,_) <- fixityResolve (colorSchemeFromFlags flags) (fixitiesCompose (loadedFixities loaded) fixitiesAll) program0 - let warnings = warnings1 fname = sourceName (programSource program) module1 = (moduleNull (getName program)) @@ -796,6 +944,8 @@ typeCheck loaded flags line coreImports program , modPath = outName flags (showModName (getName program)) ++ ifaceExtension , modProgram = Just program , modWarnings = warnings + , modSourceTime = srcTime + , modCompiled = True } -- module0 = loadedModule loaded fixitiesPub = fixitiesNew [(name,fix) | FixDef name fix rng vis <- programFixDefs program0, vis == Public] @@ -809,7 +959,7 @@ typeCheck loaded flags line coreImports program addWarnings warnings (inferCheck loaded1 flags line coreImports program2 ) -inferCheck :: Loaded -> Flags -> Int -> [Core.Import] -> UserProgram -> Error (Loaded,Doc) +inferCheck :: Loaded -> Flags -> Int -> [Core.Import] -> UserProgram -> Error Loaded (Loaded,Doc) inferCheck loaded0 flags line coreImports program = Core.runCorePhase (loadedUnique loaded0) $ do -- kind inference @@ -819,7 +969,7 @@ inferCheck loaded0 flags line coreImports program (isValueFromFlags flags) (colorSchemeFromFlags flags) (platform flags) - (if (outHtml flags > 0) then Just rangeMapNew else Nothing) + (if (outHtml flags > 0 || genRangeMap flags) then Just rangeMapNew else Nothing) (loadedImportMap loaded0) (loadedKGamma loaded0) (loadedSynonyms loaded0) @@ -840,14 +990,13 @@ inferCheck loaded0 flags line coreImports program traceDefGroups title = do dgs <- Core.getCoreDefs - -- let doc = Core.Pretty.prettyCore (prettyEnvFromFlags flags){ coreIface = False, coreShowDef = True } C [] + -- let doc = Core.Pretty.prettyCore (prettyEnvFromFlags flags){ coreIface = False, coreShowDef = True } C [] -- (coreProgram{ Core.coreProgDefs = dgs }) trace (unlines (["","/* -----------------", title, "--------------- */"] ++ -- ++ [show doc])) $ return () map showDef (Core.flattenDefGroups dgs))) $ return () where showDef def = show (Core.Pretty.prettyDef (penv{coreShowDef=True}) def) - - + -- Type inference (gamma,cdefs,mbRangeMap) <- inferTypes @@ -903,7 +1052,7 @@ inferCheck loaded0 flags line coreImports program simplifyDupN -- traceDefGroups "inlined" - -- specialize + -- specialize specializeDefs <- if (isPrimitiveModule (Core.coreProgName coreProgram)) then return [] else Core.withCoreDefs (\defs -> extractSpecializeDefs (loadedInlines loaded) defs) -- traceM ("Spec defs:\n" ++ unlines (map show specializeDefs)) @@ -943,7 +1092,7 @@ inferCheck loaded0 flags line coreImports program -- simplify open applications (needed before inlining open defs) simplifyNoDup - -- traceDefGroups "open resolved" + -- traceDefGroups "open resolved" -- monadic lifting to create fast inlined paths monadicLift penv @@ -1007,9 +1156,9 @@ capitalize s _ -> s -codeGen :: Terminal -> Flags -> CompileTarget Type -> Loaded -> IO Loaded +codeGen :: Terminal -> Flags -> CompileTarget Type -> Loaded -> IO (Loaded, Maybe (FilePath, IO())) codeGen term flags compileTarget loaded - = compilerCatch "code generation" term loaded $ + = compilerCatch "code generation" term (loaded, Nothing) $ do let mod = loadedModule loaded outBase = outName flags (showModName (modName mod)) @@ -1053,12 +1202,12 @@ codeGen term flags compileTarget loaded withNewFilePrinter (outBase ++ ".xmp.html") $ \printer -> genDoc cenv (loadedKGamma loaded) (loadedGamma loaded) (modCore mod) printer - mbRun <- backend term flags (loadedModules loaded) compileTarget outBase (modCore mod) + mbRun <- backend term flags (loadedModules loaded) compileTarget outBase (modCore mod) -- write interface file last so on any error it will not be written writeDocW 10000 outIface ifaceDoc ftime <- getFileTimeOrCurrent outIface - let mod1 = (loadedModule loaded){ modTime = ftime } + let mod1 = (loadedModule loaded){ modTime = Just ftime, modOutputTime = Just ftime } loaded1 = loaded{ loadedModule = mod1 } -- copy final exe if -o is given @@ -1076,16 +1225,7 @@ codeGen term flags compileTarget loaded color (colorSource (colorScheme flags)) (text (normalizeWith pathSep exe)) _ -> return () - -- run the program - when ((evaluate flags && isExecutable compileTarget)) $ - compilerCatch "program run" term () $ - case mbRun of - Just (_,run) -> do termPhase term $ "evaluate" - termDoc term $ space - run - _ -> termDoc term $ space - - return loaded1 -- { loadedArities = arities, loadedExternals = externals } + return (loaded1, mbRun) -- { loadedArities = arities, loadedExternals = externals } where concatMaybe :: [Maybe a] -> [a] concatMaybe mbs = concatMap (maybe [] (\x -> [x])) mbs @@ -1099,7 +1239,7 @@ codeGen term flags compileTarget loaded -- imported modules. newtypesAll = foldr1 newtypesCompose (map (extractNewtypes . modCore) (loadedModule loaded : loadedModules loaded)) in codeGenC (modSourcePath (loadedModule loaded)) - -- (loadedNewtypes loaded) + -- (loadedNewtypes loaded) newtypesAll (loadedBorrowed loaded) (loadedUnique loaded) @@ -1218,9 +1358,6 @@ codeGenJS term flags modules compileTarget outBase core do let stksize = if (stackSize flags == 0) then 100000 else (stackSize flags `div` 1024) return (Just (outjs, runCommand term flags [node flags,"--stack-size=" ++ show stksize,outjs])) - - - codeGenC :: FilePath -> Newtypes -> Borrowed -> Int -> Terminal -> Flags -> [Module] -> CompileTarget Type -> FilePath -> Core.Core -> IO (Maybe (FilePath,IO ())) codeGenC sourceFile newtypes borrowed0 unique0 term flags modules compileTarget outBase core0 = -- compilerCatch "c compilation" term Nothing $ @@ -1251,9 +1388,9 @@ codeGenC sourceFile newtypes borrowed0 unique0 term flags modules compileTarget let cc = ccomp flags eimports = externalImportsFromCore (target flags) bcore clibs = clibsFromCore flags bcore - extraIncDirs <- fmap concat $ mapM (copyCLibrary term flags cc) eimports + extraIncDirs <- concat <$> mapM (copyCLibrary term flags cc) eimports - -- compile + -- compile ccompile term flags cc outBase extraIncDirs [outC] -- compile and link? @@ -1270,16 +1407,15 @@ codeGenC sourceFile newtypes borrowed0 unique0 term flags modules compileTarget -- cmakeLib term flags cc "kklib" (ccLibFile cc "kklib") cmakeGeneratorFlag kklibObj <- kklibBuild term flags cc "kklib" (ccObjFile cc "kklib") - let objs = [kklibObj] ++ - [outName flags (ccObjFile cc (showModName mname)) - | mname <- (map modName modules ++ [Core.coreProgName core0])] + let objs = kklibObj : [outName flags (ccObjFile cc (showModName mname)) + | mname <- map modName modules ++ [Core.coreProgName core0]] syslibs= concat [csyslibsFromCore flags mcore | mcore <- map modCore modules] ++ ccompLinkSysLibs flags ++ (if onWindows && not (isTargetWasm (target flags)) then ["bcrypt","psapi","advapi32"] else ["m","pthread"]) libs = -- ["kklib"] -- [normalizeWith '/' (outName flags (ccLibFile cc "kklib"))] ++ ccompLinkLibs flags - -- ++ + -- ++ clibs ++ concat [clibsFromCore flags mcore | mcore <- map modCore modules] @@ -1377,7 +1513,7 @@ copyCLibrary term flags cc eimport Just (libPath,includes) -> do termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "library:") <+> color (colorSource (colorScheme flags)) (text libPath)) - -- this also renames a suffixed libname to a canonical name (e.g. /pcre2-8d.lib -> /pcre2-8.lib) + -- this also renames a suffixed libname to a canonical name (e.g. /pcre2-8d.lib -> /pcre2-8.lib) copyBinaryIfNewer (rebuild flags) libPath (outName flags (ccLibFile cc clib)) return includes Nothing diff --git a/src/Compiler/Module.hs b/src/Compiler/Module.hs index 1c1bd29f9..5551ae2a7 100644 --- a/src/Compiler/Module.hs +++ b/src/Compiler/Module.hs @@ -46,6 +46,7 @@ import Core.Borrowed ( Borrowed, borrowedEmpty, borrowedExtendICore ) import Syntax.RangeMap import Compiler.Package ( PackageName, joinPkg ) import qualified Core.Core as Core +import Data.Maybe (fromJust) {-------------------------------------------------------------------------- Compilation @@ -61,9 +62,12 @@ data Module = Module{ modName :: Name , modWarnings :: [(Range,Doc)] , modProgram :: Maybe (Program UserType UserKind) -- not for interfaces , modCore :: Core.Core - , modInlines :: Either (Gamma -> Error [Core.InlineDef]) ([Core.InlineDef]) + , modCompiled :: Bool + , modInlines :: Either (Gamma -> Error () [Core.InlineDef]) ([Core.InlineDef]) , modRangeMap :: Maybe RangeMap - , modTime :: FileTime + , modSourceTime :: FileTime + , modTime :: Maybe FileTime + , modOutputTime :: Maybe FileTime } data Loaded = Loaded{ loadedGamma :: Gamma @@ -80,9 +84,13 @@ data Loaded = Loaded{ loadedGamma :: Gamma , loadedBorrowed :: Borrowed } +instance Show Loaded where + show ld + = show (map modName $ loadedModules ld) + loadedLatest :: Loaded -> FileTime loadedLatest loaded - = maxFileTimes (map modTime (loadedModules loaded)) + = maxFileTimes (map (fromJust . modTime) (loadedModules loaded)) initialLoaded :: Loaded initialLoaded @@ -101,7 +109,7 @@ initialLoaded moduleNull :: Name -> Module moduleNull modName - = Module (modName) "" "" "" "" [] Nothing (Core.coreNull modName) (Left (\g -> return [])) Nothing fileTime0 + = Module (modName) "" "" "" "" [] Nothing (Core.coreNull modName) False (Left (\g -> return [])) Nothing fileTime0 Nothing Nothing loadedName :: Loaded -> Name loadedName ld @@ -162,7 +170,7 @@ addOrReplaceModule :: Module -> Modules -> Modules addOrReplaceModule mod [] = [mod] addOrReplaceModule mod (m:ms) - = if (modPath mod == modPath m) + = if modPath mod == modPath m then mod:ms else m : addOrReplaceModule mod ms diff --git a/src/Compiler/Options.hs b/src/Compiler/Options.hs index 34663405d..ba9de32be 100644 --- a/src/Compiler/Options.hs +++ b/src/Compiler/Options.hs @@ -18,12 +18,14 @@ module Compiler.Options( -- * Command line options , colorSchemeFromFlags , prettyIncludePath , isValueFromFlags + , updateFlagsFromArgs , CC(..), BuildType(..), ccFlagsBuildFromFlags , buildType, unquote , outName, fullBuildDir, buildVariant , cpuArch, osName , optionCompletions , targetExeExtension + , targets , conanSettingsFromFlags , vcpkgFindRoot , onWindows, onMacOS @@ -83,11 +85,13 @@ prettyIncludePath flags data Mode = ModeHelp | ModeVersion - | ModeCompiler { files :: [FilePath] } - | ModeInteractive { files :: [FilePath] } + | ModeCompiler { files :: [FilePath] } + | ModeInteractive { files :: [FilePath] } + | ModeLanguageServer { files :: [FilePath] } data Option = Interactive + | LanguageServer | Version | Help | Flag (Flags -> Flags) @@ -165,6 +169,8 @@ data Flags , coreCheck :: Bool , enableMon :: Bool , semiInsert :: Bool + , genRangeMap :: Bool + , languageServerPort :: Int , localBinDir :: FilePath -- directory of koka executable , localDir :: FilePath -- install prefix: /usr/local , localLibDir :: FilePath -- precompiled object files: /lib/koka/v2.x.x /-/libkklib.a, /-/std_core.kki, ... @@ -261,6 +267,8 @@ flagsNull False -- coreCheck True -- enableMonadic True -- semi colon insertion + False -- generate range map + 6061 -- language server port "" -- koka executable dir "" -- prefix dir (default: /..) "" -- localLib dir @@ -292,6 +300,9 @@ isVersion _ = False isInteractive Interactive = True isInteractive _ = False +isLanguageServer LanguageServer = True +isLanguageServer _ = False + isValueFromFlags flags = dataInfoIsValue @@ -308,6 +319,7 @@ options = (\(xss,yss) -> (concat xss, concat yss)) $ unzip [ option ['?','h'] ["help"] (NoArg Help) "show this information" , option [] ["version"] (NoArg Version) "show the compiler version" , option ['p'] ["prompt"] (NoArg Interactive) "interactive mode" + , option [] ["language-server"] (NoArg LanguageServer) "language server mode" , flag ['e'] ["execute"] (\b f -> f{evaluate= b}) "compile and execute" , flag ['c'] ["compile"] (\b f -> f{evaluate= not b}) "only compile, do not execute (default)" , option ['i'] ["include"] (OptArg includePathFlag "dirs") "add to module search path (empty resets)" @@ -388,6 +400,7 @@ options = (\(xss,yss) -> (concat xss, concat yss)) $ unzip , hide $ fflag ["specialize"] (\b f -> f{optSpecialize=b}) "enable inline specialization" , hide $ fflag ["unroll"] (\b f -> f{optUnroll=(if b then 1 else 0)}) "enable recursive definition unrolling" , hide $ fflag ["eagerpatbind"] (\b f -> f{optEagerPatBind=b}) "load pattern fields as early as possible" + , numOption 6061 "port" [] ["lsport"] (\i f -> f{languageServerPort=i}) "Language Server port to connect to" -- deprecated , hide $ option [] ["cmake"] (ReqArg cmakeFlag "cmd") "use to invoke cmake" @@ -440,24 +453,6 @@ options = (\(xss,yss) -> (concat xss, concat yss)) $ unzip configstr short long opts argDesc f desc = config short long (map (\s -> (s,s)) opts) argDesc f desc - - targets :: [(String,Flags -> Flags)] - targets = - [("c", \f -> f{ target=C LibC, platform=platform64 }), - ("c64", \f -> f{ target=C LibC, platform=platform64 }), - ("c32", \f -> f{ target=C LibC, platform=platform32 }), - ("c64c", \f -> f{ target=C LibC, platform=platform64c }), - ("js", \f -> f{ target=JS JsNode, platform=platformJS }), - ("jsnode", \f -> f{ target=JS JsNode, platform=platformJS }), - ("jsweb", \f -> f{ target=JS JsWeb, platform=platformJS }), - ("wasm", \f -> f{ target=C Wasm, platform=platform32 }), - ("wasm32", \f -> f{ target=C Wasm, platform=platform32 }), - ("wasm64", \f -> f{ target=C Wasm, platform=platform64 }), - ("wasmjs", \f -> f{ target=C WasmJs, platform=platform32 }), - ("wasmweb",\f -> f{ target=C WasmWeb, platform=platform32 }), - ("cs", \f -> f{ target=CS, platform=platformCS }) - ] - targetFlag t f = case lookup t targets of Just update -> update f @@ -593,6 +588,23 @@ readHtmlBases s (_:post) -> (pre,post) _ -> ("",xs) +targets :: [(String,Flags -> Flags)] +targets = + [("c", \f -> f{ target=C LibC, platform=platform64 }), + ("c64", \f -> f{ target=C LibC, platform=platform64 }), + ("c32", \f -> f{ target=C LibC, platform=platform32 }), + ("c64c", \f -> f{ target=C LibC, platform=platform64c }), + ("js", \f -> f{ target=JS JsNode, platform=platformJS }), + ("jsnode", \f -> f{ target=JS JsNode, platform=platformJS }), + ("jsweb", \f -> f{ target=JS JsWeb, platform=platformJS }), + ("wasm", \f -> f{ target=C Wasm, platform=platform32 }), + ("wasm32", \f -> f{ target=C Wasm, platform=platform32 }), + ("wasm64", \f -> f{ target=C Wasm, platform=platform64 }), + ("wasmjs", \f -> f{ target=C WasmJs, platform=platform32 }), + ("wasmweb",\f -> f{ target=C WasmWeb, platform=platform32 }), + ("cs", \f -> f{ target=CS, platform=platformCS }) + ] + -- | Environment table environment :: [ (String, String, (String -> [String]), String) ] environment @@ -632,6 +644,18 @@ getOptions extra args <- getArgs processOptions flagsNull (env ++ words extra ++ args) +updateFlagsFromArgs :: Flags -> String -> Maybe Flags +updateFlagsFromArgs flags0 args = + let + (preOpts,postOpts) = span (/="--") (words args) + flags1 = case postOpts of + [] -> flags0 + (_:rest) -> flags0{ execOpts = concat (map (++" ") rest) } + (options,files,errs0) = getOpt Permute optionsAll preOpts + errs = errs0 ++ extractErrors options + in if (null errs) + then Just $ extractFlags flags1 options else Nothing + processOptions :: Flags -> [String] -> IO (Flags,Flags,Mode) processOptions flags0 opts = let (preOpts,postOpts) = span (/="--") opts @@ -645,6 +669,7 @@ processOptions flags0 opts mode = if (any isHelp options) then ModeHelp else if (any isVersion options) then ModeVersion else if (any isInteractive options) then ModeInteractive files + else if (any isLanguageServer options) then ModeLanguageServer files else if (null files) then ModeInteractive files else ModeCompiler files flags = case mode of @@ -720,7 +745,9 @@ processOptions flags0 opts useStdAlloc = stdAlloc, editor = ed, includePath = (localShareDir ++ "/lib") : includePath flags, + genRangeMap = outHtml flags > 0 || any isLanguageServer options, vcpkgTriplet= triplet + {- vcpkgRoot = vcpkgRoot, diff --git a/src/Core/AnalysisMatch.hs b/src/Core/AnalysisMatch.hs index 0cc0f47aa..9ace1eda7 100644 --- a/src/Core/AnalysisMatch.hs +++ b/src/Core/AnalysisMatch.hs @@ -207,7 +207,7 @@ lookupConInfos newtypes tp = case expandSyn tp of TCon tcon -> case lookupDataInfo newtypes (typeconName tcon) of Just di -> dataInfoGetConInfos di -- [] for open or literals - Nothing -> trace ("Core.AnalysisMatch.lookupConInfos: not found: " ++ show (typeconName tcon) ++ ": " ++ show newtypes) $ + Nothing -> trace ("Core.AnalysisMatch.lookupConInfos: not found: " ++ show (typeconName tcon)) $ [] TApp t targs -> lookupConInfos newtypes t -- list _ -> -- trace ("Core.AnalysisMatch.lookupConInfos: not a tcon: " ++ show (pretty t)) $ diff --git a/src/Core/CTail.hs b/src/Core/CTail.hs index 2f5afdc8c..436f59a4f 100644 --- a/src/Core/CTail.hs +++ b/src/Core/CTail.hs @@ -43,7 +43,7 @@ import Core.Pretty -------------------------------------------------------------------------- -- Reference count transformation -------------------------------------------------------------------------- -ctailOptimize :: Pretty.Env -> Newtypes -> Gamma -> Bool -> CorePhase () +ctailOptimize :: Pretty.Env -> Newtypes -> Gamma -> Bool -> CorePhase b () ctailOptimize penv newtypes gamma useContextPath = liftCorePhaseUniq $ \uniq defs -> runUnique uniq (uctailOptimize penv newtypes gamma useContextPath defs) diff --git a/src/Core/Check.hs b/src/Core/Check.hs index 4a7413295..6c0193381 100644 --- a/src/Core/Check.hs +++ b/src/Core/Check.hs @@ -43,7 +43,7 @@ import qualified Type.Operations as Op ( instantiateNoEx ) import qualified Data.Set as S -checkCore :: Bool -> Bool -> Env -> Gamma -> CorePhase () +checkCore :: Bool -> Bool -> Env -> Gamma -> CorePhase b () checkCore liberalEffects allowPartialApps prettyEnv gamma = do uniq <- unique defGroups <- getCoreDefs diff --git a/src/Core/CheckFBIP.hs b/src/Core/CheckFBIP.hs index 586a979f3..a7b157320 100644 --- a/src/Core/CheckFBIP.hs +++ b/src/Core/CheckFBIP.hs @@ -53,7 +53,7 @@ trace s x = x -checkFBIP :: Pretty.Env -> Platform -> Newtypes -> Borrowed -> Gamma -> CorePhase () +checkFBIP :: Pretty.Env -> Platform -> Newtypes -> Borrowed -> Gamma -> CorePhase b () checkFBIP penv platform newtypes borrowed gamma = do uniq <- unique defGroups <- getCoreDefs diff --git a/src/Core/Core.hs b/src/Core/Core.hs index cd017a517..4cd8e6af1 100644 --- a/src/Core/Core.hs +++ b/src/Core/Core.hs @@ -609,55 +609,55 @@ instance Show InlineDef where = "InlineDef " ++ show sort ++ " " ++ show name ++ " " ++ (if isRec then "rec " else "") ++ show kind ++ " " ++ show cost ++ " " ++ show specArgs -newtype CorePhase a = CP (Int -> DefGroups -> Error (CPState a)) +newtype CorePhase b a = CP (Int -> DefGroups -> Error b (CPState a)) data CPState a = CPState !a !Int !DefGroups -instance Functor CorePhase where +instance Functor (CorePhase b) where fmap f (CP cp) = CP (\uniq defs -> do (CPState x uniq' defs') <- cp uniq defs return (CPState (f x) uniq' defs')) -instance Applicative CorePhase where +instance Applicative (CorePhase b) where pure x = CP (\uniq defs -> return (CPState x uniq defs)) (<*>) = ap -instance Monad CorePhase where +instance Monad (CorePhase b) where -- return = pure (CP cp) >>= f = CP (\uniq defs -> do (CPState x uniq' defs') <- cp uniq defs case f x of CP cp' -> cp' uniq' defs') -instance HasUnique CorePhase where +instance HasUnique (CorePhase b) where updateUnique f = CP (\uniq defs -> return (CPState uniq (f uniq) defs)) setUnique uniq = CP (\_ defs -> return (CPState () uniq defs)) unique = CP (\uniq defs -> return (CPState uniq uniq defs)) -getCoreDefs :: CorePhase DefGroups +getCoreDefs :: CorePhase b DefGroups getCoreDefs = CP (\uniq defs -> return (CPState defs uniq defs)) -setCoreDefs :: DefGroups -> CorePhase () +setCoreDefs :: DefGroups -> CorePhase b () setCoreDefs defs = CP (\uniq _ -> return (CPState () uniq defs)) -withCoreDefs :: (DefGroups -> a) -> CorePhase a +withCoreDefs :: (DefGroups -> a) -> CorePhase b a withCoreDefs f = do defs <- getCoreDefs return (f defs) -runCorePhase :: Int -> CorePhase a -> Error a +runCorePhase :: Int -> CorePhase b a -> Error b a runCorePhase uniq (CP cp) = do (CPState x _ _) <- cp uniq [] return x -liftCorePhaseUniq :: (Int -> DefGroups -> (DefGroups,Int)) -> CorePhase () +liftCorePhaseUniq :: (Int -> DefGroups -> (DefGroups,Int)) -> CorePhase b () liftCorePhaseUniq f = CP (\uniq defs -> let (defs',uniq') = f uniq defs in return (CPState () uniq' defs')) -liftCorePhase :: (DefGroups -> DefGroups) -> CorePhase () +liftCorePhase :: (DefGroups -> DefGroups) -> CorePhase b () liftCorePhase f = liftCorePhaseUniq (\u defs -> (f defs, u)) -liftError :: Error a -> CorePhase a +liftError :: Error b a -> CorePhase b a liftError err = CP (\uniq defs -> do x <- err return (CPState x uniq defs)) @@ -1333,7 +1333,7 @@ depType tp TCon tc -> depName (typeConName tc) TVar _ -> S.empty TApp tp tps -> depsUnions (map depType (tp:tps)) - TSyn syn args tp -> depsUnions (map depType (tp:args)) + TSyn syn args tp -> depsUnions (depName (typesynName syn):(map depType (tp:args))) depDef :: Def -> Deps depDef def = depsUnions [depType (defType def), depExpr (defExpr def)] diff --git a/src/Core/FunLift.hs b/src/Core/FunLift.hs index 25e0c8a41..89ed41bcb 100644 --- a/src/Core/FunLift.hs +++ b/src/Core/FunLift.hs @@ -51,7 +51,7 @@ traceGroups dgs showDG (DefNonRec def) = show (defName def) -liftFunctions :: Pretty.Env -> CorePhase () +liftFunctions :: Pretty.Env -> CorePhase b () liftFunctions penv = liftCorePhaseUniq $ \uniq defs -> runLift penv uniq (liftDefGroups True defs) diff --git a/src/Core/Inline.hs b/src/Core/Inline.hs index be7bb9ce4..f35b101ea 100644 --- a/src/Core/Inline.hs +++ b/src/Core/Inline.hs @@ -49,7 +49,7 @@ trace s x = -inlineDefs :: Pretty.Env -> Int -> Inlines -> CorePhase () +inlineDefs :: Pretty.Env -> Int -> Inlines -> CorePhase b () inlineDefs penv inlineMax inlines = liftCorePhaseUniq $ \uniq defs -> runInl penv inlineMax uniq inlines $ diff --git a/src/Core/Monadic.hs b/src/Core/Monadic.hs index db1e87470..ba8b05241 100644 --- a/src/Core/Monadic.hs +++ b/src/Core/Monadic.hs @@ -47,7 +47,7 @@ trace s x = -- Lib.Trace.trace s x -monTransform :: Pretty.Env -> CorePhase () +monTransform :: Pretty.Env -> CorePhase b () monTransform penv = liftCorePhaseUniq $ \uniq defs -> runMon penv uniq (monDefGroups defs) diff --git a/src/Core/MonadicLift.hs b/src/Core/MonadicLift.hs index 58ab7cb0f..862a8d014 100644 --- a/src/Core/MonadicLift.hs +++ b/src/Core/MonadicLift.hs @@ -40,7 +40,7 @@ trace s x = Lib.Trace.trace s x -monadicLift :: Pretty.Env -> CorePhase () +monadicLift :: Pretty.Env -> CorePhase b () monadicLift penv = liftCorePhaseUniq $ \uniq defs -> runLift penv uniq (liftDefGroups True defs) diff --git a/src/Core/OpenResolve.hs b/src/Core/OpenResolve.hs index 6c7e97157..8796ba7e5 100644 --- a/src/Core/OpenResolve.hs +++ b/src/Core/OpenResolve.hs @@ -46,7 +46,7 @@ trace s x = data Env = Env{ penv :: Pretty.Env, gamma :: Gamma } -openResolve :: Pretty.Env -> Gamma -> CorePhase () +openResolve :: Pretty.Env -> Gamma -> CorePhase b () openResolve penv gamma = liftCorePhase $ \defs -> resDefGroups (Env penv gamma) defs diff --git a/src/Core/Parse.hs b/src/Core/Parse.hs index aa89febbb..b583aff1f 100644 --- a/src/Core/Parse.hs +++ b/src/Core/Parse.hs @@ -41,12 +41,12 @@ import Lib.Trace {-------------------------------------------------------------------------- Parse core interface files --------------------------------------------------------------------------} -type ParseInlines = Gamma -> Error [InlineDef] +type ParseInlines = Gamma -> Error () [InlineDef] -parseCore :: FilePath -> IO (Error (Core, ParseInlines)) +parseCore :: FilePath -> IO (Error b (Core, ParseInlines)) parseCore fname = do input <- readInput fname - return (lexParse False (requalify . allowDotIds) program fname 1 input) + return $ ignoreSyntaxWarnings $ lexParse False (requalify . allowDotIds) program fname 1 input requalify :: [Lexeme] -> [Lexeme] requalify lexs @@ -107,7 +107,7 @@ allowDotIds lexs parseInlines :: Core -> Source -> Env -> [Lexeme] -> ParseInlines parseInlines prog source env inlines gamma - = parseLexemes (pInlines env{ gamma = gamma }) source inlines + = ignoreSyntaxWarnings $ parseLexemes (pInlines env{ gamma = gamma }) source inlines pInlines :: Env -> LexParser [InlineDef] pInlines env @@ -1046,7 +1046,7 @@ envLookupCon :: Env -> Name -> LexParser NameInfo envLookupCon env name = case gammaLookupExactCon name (gamma env) of [con@(InfoCon{})] -> return con - res -> fail $ "unknown constructor: " ++ show name ++ ": " ++ show res -- ++ ":\n" ++ show (gamma env) + res -> fail $ "when parsing " ++ show (modName env) ++ " unknown constructor: " ++ show name ++ ": " ++ show res -- ++ ":\n" ++ show (gamma env) envLookupVar :: Env -> Name -> LexParser Expr envLookupVar env name diff --git a/src/Core/Simplify.hs b/src/Core/Simplify.hs index 1ceb78a72..81a5505c2 100644 --- a/src/Core/Simplify.hs +++ b/src/Core/Simplify.hs @@ -40,7 +40,7 @@ import qualified Data.Set as S -- data Env = Env{ inlineMap :: M.NameMap Expr } -- data Info = Info{ occurrences :: M.NameMap Int } -simplifyDefs :: Pretty.Env -> Bool -> Bool -> Int -> Int -> CorePhase () +simplifyDefs :: Pretty.Env -> Bool -> Bool -> Int -> Int -> CorePhase b () simplifyDefs penv unsafe ndebug nRuns duplicationMax = liftCorePhaseUniq $ \uniq defs -> runSimplify unsafe ndebug duplicationMax uniq penv (simplifyN nRuns (uniquefyDefBodies defs)) diff --git a/src/Core/Specialize.hs b/src/Core/Specialize.hs index 176fd655b..669387595 100644 --- a/src/Core/Specialize.hs +++ b/src/Core/Specialize.hs @@ -87,7 +87,7 @@ runSpecM uniq readState specM = Specialization --------------------------------------------------------------------------} -specialize :: Inlines -> Env -> CorePhase () +specialize :: Inlines -> Env -> CorePhase b () specialize specEnv penv = liftCorePhaseUniq $ \uniq defs -> -- TODO: use uniqe int to generate names and remove call to uniquefyDefGroups? diff --git a/src/Core/UnReturn.hs b/src/Core/UnReturn.hs index 0f18eb58a..31968792d 100644 --- a/src/Core/UnReturn.hs +++ b/src/Core/UnReturn.hs @@ -47,7 +47,7 @@ trace s x = -- Lib.Trace.trace s x -unreturn :: Pretty.Env -> CorePhase () +unreturn :: Pretty.Env -> CorePhase b () unreturn penv = liftCorePhaseUniq $ \uniq defs -> runUR penv uniq (urTopDefGroups defs) diff --git a/src/Core/Unroll.hs b/src/Core/Unroll.hs index 69275b1e2..3b4fc6bcb 100644 --- a/src/Core/Unroll.hs +++ b/src/Core/Unroll.hs @@ -61,7 +61,7 @@ trace s x = -unrollDefs :: Pretty.Env -> Int -> CorePhase () +unrollDefs :: Pretty.Env -> Int -> CorePhase b () unrollDefs penv unrollMax = liftCorePhaseUniq $ \uniq defs -> runUnroll penv unrollMax uniq $ diff --git a/src/Interpreter/Interpret.hs b/src/Interpreter/Interpret.hs index b464bfa35..10ebdd665 100644 --- a/src/Interpreter/Interpret.hs +++ b/src/Interpreter/Interpret.hs @@ -273,7 +273,7 @@ loadFilesErr term startSt fileNames force -} walk [] startSt fileNames where - walk :: [Module] -> State -> [FilePath] -> IO (Error State) + walk :: [Module] -> State -> [FilePath] -> IO (Error b State) walk imports st files = case files of [] -> do if (not (null imports) && verbose (flags st) > 0) @@ -292,12 +292,12 @@ loadFilesErr term startSt fileNames force then compileFile term (flags st) (loadedModules (loaded0 st)) Object fname else compileModule term (flags st) (loadedModules (loaded0 st)) (newName fname) -} - compileModuleOrFile term (flags st) [] {- (loadedModules (loaded0 st)) -} fname force + compileModuleOrFile (const Nothing) Nothing term (flags st) [] [] {- (loadedModules (loaded0 st)) -} fname force Object [] ; case checkError err of Left msg -> do messageErrorMsgLnLn st msg return (errorMsg msg) - Right (ld,warnings) + Right ((ld, _), warnings) -> do{ -- let warnings = modWarnings (loadedModule ld) ; err <- if not (null warnings) then do let msg = ErrorWarning warnings ErrorZero @@ -352,14 +352,14 @@ docNotFound cscheme path name {-------------------------------------------------------------------------- Helpers --------------------------------------------------------------------------} -checkInfer :: State -> Bool -> Error Loaded -> (Loaded -> IO ()) -> IO () +checkInfer :: State -> Bool -> Error b Loaded -> (Loaded -> IO ()) -> IO () checkInfer st = checkInferWith st "" id checkInfer2 st = checkInferWith st "" (\(a,c) -> c) -checkInfer3 :: State -> String -> Bool -> Error (a,b,Loaded) -> ((a,b,Loaded) -> IO ()) -> IO () +checkInfer3 :: State -> String -> Bool -> Error b (a,b,Loaded) -> ((a,b,Loaded) -> IO ()) -> IO () checkInfer3 st line = checkInferWith st line (\(a,b,c) -> c) -checkInferWith :: State -> String -> (a -> Loaded) -> Bool -> Error a -> (a -> IO ()) -> IO () +checkInferWith :: State -> String -> (a -> Loaded) -> Bool -> Error b a -> (a -> IO ()) -> IO () checkInferWith st line getLoaded showMarker err f = case checkError err of Left msg -> do when showMarker (maybeMessageMarker st (getRange msg)) diff --git a/src/Kind/Constructors.hs b/src/Kind/Constructors.hs index 27ec2ea40..d1d3808ee 100644 --- a/src/Kind/Constructors.hs +++ b/src/Kind/Constructors.hs @@ -15,7 +15,7 @@ module Kind.Constructors( -- * Constructors , constructorsExtend, constructorsLookup, constructorsFind , constructorsIsEmpty , constructorsFindScheme - , constructorsSet + , constructorsSet, constructorsList , constructorsCompose, constructorsFromList , extractConstructors -- * Pretty @@ -78,6 +78,9 @@ constructorsSet :: Constructors -> S.NameSet constructorsSet (Constructors m) = S.fromList (M.keys m) +constructorsList :: Constructors -> [(Name, ConInfo)] +constructorsList (Constructors m) + = M.toList m {-------------------------------------------------------------------------- Pretty printing diff --git a/src/Kind/ImportMap.hs b/src/Kind/ImportMap.hs index c8aaa9f59..a7066ff9c 100644 --- a/src/Kind/ImportMap.hs +++ b/src/Kind/ImportMap.hs @@ -36,7 +36,7 @@ importsExtend name fullName imp = let rpath = reverse $ splitModuleName name in case lookup rpath imp of Nothing -> Just ((rpath,fullName):imp) - Just _ -> Nothing + Just fullName1 -> if fullName == fullName1 then Just imp else Nothing -- | @importsExpand name map@ takes a qualified name (@core/int@) and expands -- it to its real fully qualified name (@std/core/int@). It also returns diff --git a/src/Kind/Infer.hs b/src/Kind/Infer.hs index 63906bd87..eacc12529 100644 --- a/src/Kind/Infer.hs +++ b/src/Kind/Infer.hs @@ -79,7 +79,7 @@ inferKinds -> Synonyms -- ^ Initial list of synonyms -> Newtypes -- ^ Initial list of data types -> Program UserType UserKind -- ^ Original program - -> Core.CorePhase + -> Core.CorePhase b ( DefGroups Type -- Translated program (containing translated types) -- , Gamma -- Gamma containing generated functions, i.e type scheme for every constructor , KGamma -- updated kind gamma diff --git a/src/LanguageServer/Conversions.hs b/src/LanguageServer/Conversions.hs new file mode 100644 index 000000000..1bc8eacf4 --- /dev/null +++ b/src/LanguageServer/Conversions.hs @@ -0,0 +1,118 @@ +----------------------------------------------------------------------------- +-- Conversions between LSP types and internal types, e.g. positions/ranges +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} + +module LanguageServer.Conversions + ( -- * Conversions to LSP types + toLspPos, + toLspRange, + toLspLocation, + toLspLocationLink, + toLspDiagnostics, + toLspErrorDiagnostics, + toLspWarningDiagnostic, + + -- * Conversions from LSP types + fromLspPos, + fromLspRange, + fromLspLocation, + + -- * Get loaded module from URI + loadedModuleFromUri + ) +where +import GHC.Generics hiding (UInt) +import qualified Common.Error as E +import qualified Common.Range as R +import qualified Data.Text as T +import qualified Language.LSP.Protocol.Types as J +import Colog.Core +import Language.LSP.Protocol.Types (UInt) +import Lib.PPrint (Doc) +import qualified Syntax.RangeMap as R +import Compiler.Module (Module (..), Loaded (..)) +import Data.Maybe (fromMaybe) +import Data.List (find) +import Common.File (normalize) + +toLspPos :: R.Pos -> J.Position +toLspPos p = + J.Position (fromIntegral (max 0 (R.posLine p - 1))) (fromIntegral (max 0 (R.posColumn p - 1)))-- LSP positions are zero-based + +toLspRange :: R.Range -> J.Range +toLspRange r = + J.Range (J.Position l1 c1) (J.Position l2 $ c2 + 1) -- LSP range ends are exclusive + where + J.Position l1 c1 = toLspPos $ R.rangeStart r + J.Position l2 c2 = toLspPos $ R.rangeEnd r + +toLspLocation :: R.Range -> J.Location +toLspLocation r = + J.Location uri (toLspRange r) + where + uri = J.filePathToUri $ R.sourceName $ R.rangeSource r + +toLspLocationLink :: R.RangeInfo -> R.Range -> J.LocationLink +toLspLocationLink src r = + J.LocationLink Nothing uri (toLspRange r) (toLspRange r) + where + uri = J.filePathToUri $ R.sourceName $ R.rangeSource r + +toLspDiagnostics :: T.Text -> E.Error b a -> [J.Diagnostic] +toLspDiagnostics src err = + case E.checkError err of + Right (_, ws) -> map (uncurry $ toLspWarningDiagnostic src) ws + Left e -> toLspErrorDiagnostics src e + +toLspErrorDiagnostics :: T.Text -> E.ErrorMessage -> [J.Diagnostic] +toLspErrorDiagnostics src e = + case e of + E.ErrorGeneral r doc -> [makeDiagnostic J.DiagnosticSeverity_Error src r doc] + E.ErrorParse r doc -> [makeDiagnostic J.DiagnosticSeverity_Error src r doc] + E.ErrorStatic rds -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds + E.ErrorKind rds -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds + E.ErrorType rds -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds + E.ErrorWarning rds e' -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds ++ toLspErrorDiagnostics src e' + E.ErrorIO doc -> [makeDiagnostic J.DiagnosticSeverity_Error src R.rangeNull doc] + E.ErrorZero -> [] + +toLspWarningDiagnostic :: T.Text -> R.Range -> Doc -> J.Diagnostic +toLspWarningDiagnostic = + makeDiagnostic J.DiagnosticSeverity_Warning + +makeDiagnostic :: J.DiagnosticSeverity -> T.Text -> R.Range -> Doc -> J.Diagnostic +makeDiagnostic s src r doc = + J.Diagnostic range severity code codeDescription source message tags related dataX + where + range = toLspRange r + severity = Just s + code = Nothing + codeDescription = Nothing + source = Just src + message = T.pack $ show doc + tags + | "is unused" `T.isInfixOf` message = Just [J.DiagnosticTag_Unnecessary] + | otherwise = Nothing + related = Nothing + dataX = Nothing + +fromLspPos :: J.Uri -> J.Position -> R.Pos +fromLspPos uri (J.Position l c) = + R.makePos src (-1) (fromIntegral l + 1) (fromIntegral c + 1) + where + src = case J.uriToFilePath uri of + Just filePath -> R.Source (normalize filePath) R.bstringEmpty -- TODO: Read file here (and compute the offset correctly) + Nothing -> R.sourceNull + +fromLspRange :: J.Uri -> J.Range -> R.Range +fromLspRange uri (J.Range s e) = R.makeRange (fromLspPos uri s) (fromLspPos uri e) + +fromLspLocation :: J.Location -> R.Range +fromLspLocation (J.Location uri rng) = fromLspRange uri rng + +loadedModuleFromUri :: Maybe Loaded -> J.Uri -> Maybe Module +loadedModuleFromUri l uri = + case l of + Nothing -> Nothing + Just l -> find (\m -> maybe "" normalize (J.uriToFilePath uri) == modSourcePath m) $ loadedModules l diff --git a/src/LanguageServer/Handler/Commands.hs b/src/LanguageServer/Handler/Commands.hs new file mode 100644 index 000000000..629a1ba5c --- /dev/null +++ b/src/LanguageServer/Handler/Commands.hs @@ -0,0 +1,63 @@ +----------------------------------------------------------------------------- +-- The LSP handlers that handles initialization +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} + +module LanguageServer.Handler.Commands (initializedHandler, commandHandler) where + +import Compiler.Options (Flags (outFinalPath), targets, commandLineHelp, updateFlagsFromArgs) +import Language.LSP.Server (Handlers, LspM, notificationHandler, sendNotification, MonadLsp, getVirtualFiles, withIndefiniteProgress, requestHandler) +import qualified Language.LSP.Protocol.Types as J +import qualified Data.Text as T +import LanguageServer.Monad (LSM, getFlags, getTerminal) +import qualified Language.LSP.Protocol.Message as J +import Data.Aeson as Json +import qualified Language.LSP.Protocol.Lens as J +import Control.Lens ((^.)) +import Data.Maybe (mapMaybe, fromJust, fromMaybe) +import GHC.Base (Type) +import LanguageServer.Handler.TextDocument (recompileFile) +import Compiler.Compile (CompileTarget(..), Terminal (termError, termPhaseDoc)) +import Common.Name (newName) +import qualified Language.LSP.Server as J +import Control.Monad.Trans (liftIO) + +initializedHandler :: Handlers LSM +initializedHandler = notificationHandler J.SMethod_Initialized $ \_not -> sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info "Initialized language server." + +targetFlag :: String -> Flags -> Flags +targetFlag t f + = case lookup t targets of + Just update -> update f + Nothing -> f + +commandHandler :: Handlers LSM +commandHandler = requestHandler J.SMethod_WorkspaceExecuteCommand $ \req resp -> do + flags <- getFlags + let J.ExecuteCommandParams _ command commandParams = req ^. J.params + if command == "koka/genCode" then + case commandParams of + Just [Json.String filePath, Json.String additionalArgs] -> do + term <- getTerminal + newFlags <- case updateFlagsFromArgs flags (T.unpack additionalArgs) of + Just flags' -> return flags' + Nothing -> do + doc <- liftIO (commandLineHelp flags) + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid arguments " <> additionalArgs + liftIO $ termPhaseDoc term doc + return flags + withIndefiniteProgress (T.pack "Compiling " <> filePath) J.NotCancellable $ do + res <- recompileFile (Executable (newName "main") ()) (J.filePathToUri $ T.unpack filePath) Nothing False newFlags + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack ("Finished generating code for main file " ++ T.unpack filePath ++ " " ++ fromMaybe "No Compiled File" res) + resp $ Right $ case res of {Just filePath -> J.InL $ Json.String $ T.pack filePath; Nothing -> J.InR J.Null} + _ -> do + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid parameters" + resp $ Right $ J.InR J.Null + else + do + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Unknown command" ++ show req) + resp $ Right $ J.InR J.Null + +liftMaybe:: Monad m => Maybe (m ()) -> m () +liftMaybe Nothing = return () +liftMaybe (Just m) = m diff --git a/src/LanguageServer/Handler/Completion.hs b/src/LanguageServer/Handler/Completion.hs new file mode 100644 index 000000000..5cf0a96b0 --- /dev/null +++ b/src/LanguageServer/Handler/Completion.hs @@ -0,0 +1,436 @@ +----------------------------------------------------------------------------- +-- The LSP handler that provides code completions +----------------------------------------------------------------------------- +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} + +module LanguageServer.Handler.Completion + ( completionHandler, + ) +where + +import Common.Name (Name (..)) +import Compiler.Module (Loaded (..)) +import Control.Lens ((^.)) +import qualified Data.Map as M +import Data.Maybe (maybeToList, fromMaybe, fromJust) +import qualified Data.Text.Utf16.Rope as Rope +import qualified Data.Set as S +import qualified Data.Text as T +import Kind.Constructors (ConInfo (..), Constructors, constructorsList) +import Kind.Synonym (SynInfo (..), Synonyms, synonymsToList) +import Language.LSP.Server (Handlers, getVirtualFile, requestHandler) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J +import Language.LSP.VFS (VirtualFile (VirtualFile)) +import LanguageServer.Monad (LSM, getLoaded) +import Lib.PPrint (Pretty (..)) +import Syntax.Lexer (reservedNames) +import Type.Assumption + ( Gamma, + NameInfo + ( InfoCon, + InfoExternal, + InfoFun, + InfoImport, + InfoVal, + infoAlias, + infoArity, + infoCName, + infoCon, + infoFormat, + infoFullName, + infoIsVar, + infoRange, + infoType, + infoVis + ), + gammaList, + ) +import qualified Language.LSP.Protocol.Message as J +import Data.Char (isUpper, isAlphaNum) +import Compiler.Compile (Module (..)) +import Type.Type (Type(..), splitFunType, splitFunScheme) +import Syntax.RangeMap (rangeMapFindAt, rangeInfoType) +import LanguageServer.Conversions (fromLspPos, loadedModuleFromUri) +import Common.Range (makePos, posNull, Range, rangeNull) +import LanguageServer.Handler.Hover (formatRangeInfoHover) +import Type.Unify (runUnify, unify, runUnifyEx, matchArguments) +import Data.Either (isRight) +import Lib.Trace (trace) +import Type.InferMonad (subst, instantiate) +import Type.TypeVar (tvsEmpty) +import Data.ByteString (intercalate) +import Control.Monad.ST (runST) +import Language.LSP.Protocol.Types (InsertTextFormat(InsertTextFormat_Snippet)) + +completionHandler :: Handlers LSM +completionHandler = requestHandler J.SMethod_TextDocumentCompletion $ \req responder -> do + let J.CompletionParams doc pos _ _ context = req ^. J.params + uri = doc ^. J.uri + normUri = J.toNormalizedUri uri + loaded <- getLoaded + vfile <- getVirtualFile normUri + let items = do + l <- maybeToList loaded + lm <- maybeToList $ loadedModuleFromUri loaded uri + vf <- maybeToList vfile + pi <- maybeToList =<< getCompletionInfo pos vf lm uri + findCompletions l lm pi + responder $ Right $ J.InL items + +-- | Describes the line at the current cursor position +data PositionInfo = PositionInfo + { fullLine :: !T.Text + -- ^ The full contents of the line the cursor is at + , argument :: !T.Text + , searchTerm :: !T.Text + , cursorPos :: !J.Position + -- ^ The cursor position + , argumentType :: Maybe Type + , isFunctionCompletion :: Bool + } deriving (Show,Eq) + +getCompletionInfo :: Monad m => J.Position -> VirtualFile -> Module -> J.Uri -> m (Maybe PositionInfo) +getCompletionInfo pos@(J.Position l c) (VirtualFile _ _ ropetext) mod uri = + let rm = (fromJust $ modRangeMap mod) in + let result = Just $ fromMaybe (PositionInfo "" "" "" pos Nothing False) $ do -- Maybe monad + let lastMaybe [] = Nothing + lastMaybe xs = Just $ last xs + + let currentRope = fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext + beforePos <- Rope.toText . fst <$> Rope.splitAt (fromIntegral c + 1) currentRope + currentWord <- + if | T.null beforePos -> Just "" + | T.last beforePos == ' ' -> Just "" -- Up to whitespace but not including it + | otherwise -> lastMaybe (T.words beforePos) + + let parts = T.split (=='.') -- The () are for operators and / is for qualified names otherwise everything must be adjacent + $ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("()-_./'"::String)) currentWord + + case reverse parts of + [] -> Nothing + (x:xs) -> do + trace ("parts: " ++ show parts) $ return () + let modName = case filter (not .T.null) xs of {x:xs -> x; [] -> ""} + argumentText <- Rope.toText . fst <$> Rope.splitAt (fromIntegral c) currentRope + let isFunctionCompletion = if | T.null argumentText -> False + | T.findIndex (== '.') argumentText > T.findIndex (== ' ') argumentText -> True + | otherwise -> False + newC = c - fromIntegral (T.length x + (if isFunctionCompletion then 1 else 0)) + let currentType = + if isFunctionCompletion then + let currentRange = fromLspPos uri (J.Position l newC) in + do + (range, rangeInfo) <- rangeMapFindAt currentRange rm + t <- rangeInfoType rangeInfo + case splitFunType t of + Just (pars,eff,res) -> Just res + Nothing -> Just t + else Nothing + -- currentRope is already a single line, but it may include an enclosing '\n' + let curLine = T.dropWhileEnd (== '\n') $ Rope.toText currentRope + let pi = PositionInfo curLine modName x pos currentType isFunctionCompletion + return $ trace (show pi) pi + in + trace (show result) $ return result + +-- TODO: Complete local variables +-- TODO: Show documentation comments in completion docs + +filterInfix :: PositionInfo -> T.Text -> Bool +filterInfix pinfo n = (searchTerm pinfo `T.isInfixOf` n) && (('.' /= T.head n) || ".Hnd-" `T.isPrefixOf` n) + +filterInfixConstructors :: PositionInfo -> T.Text -> Bool +filterInfixConstructors pinfo n = (searchTerm pinfo `T.isInfixOf` n) && (('.' /= T.head n) || ".Hnd-" `T.isPrefixOf` n) + +findCompletions :: Loaded -> Module -> PositionInfo -> [J.CompletionItem] +findCompletions loaded mod pinfo@PositionInfo{isFunctionCompletion = fcomplete} = filter (filterInfix pinfo . (^. J.label)) completions + where + curModName = modName mod + search = searchTerm pinfo + gamma = loadedGamma loaded + constrs = loadedConstructors loaded + syns = loadedSynonyms loaded + completions = + if fcomplete then valueCompletions curModName gamma pinfo else keywordCompletions curModName + ++ valueCompletions curModName gamma pinfo + ++ constructorCompletions curModName constrs + ++ synonymCompletions curModName syns + +-- TODO: Type completions, ideally only inside type expressions +-- ++ newtypeCompletions ntypes + +typeUnifies :: Type -> Maybe Type -> Bool +typeUnifies t1 t2 = + case t2 of + Nothing -> True + Just t2 -> let (res, _, _) = (runUnifyEx 0 $ matchArguments True rangeNull tvsEmpty t1 [t2] [] Nothing) in isRight res + +valueCompletions :: Name -> Gamma -> PositionInfo -> [J.CompletionItem] +valueCompletions curModName gamma pinfo@PositionInfo{argumentType=tp, searchTerm=search, isFunctionCompletion} = map toItem . filter matchInfo $ filter (\(n, ni) -> filterInfix pinfo $ T.pack $ nameId n) $ gammaList gamma + where + isHandler n = '.' == T.head n + matchInfo :: (Name, NameInfo) -> Bool + matchInfo (n, ninfo) = case ninfo of + InfoVal {infoType} -> typeUnifies infoType tp + InfoFun {infoType} -> typeUnifies infoType tp + InfoExternal {infoType} -> typeUnifies infoType tp + InfoImport {infoType} -> typeUnifies infoType tp + InfoCon {infoType } -> typeUnifies infoType tp + toItem (n, ninfo) = case ninfo of + InfoCon {infoCon} | isHandler $ T.pack (nameId n) -> makeHandlerCompletionItem curModName infoCon d rng (fullLine pinfo) + InfoFun {infoType} -> makeFunctionCompletionItem curModName n d infoType isFunctionCompletion rng (fullLine pinfo) + InfoVal {infoType} -> case splitFunScheme infoType of + Just (tvars, tpreds, pars, eff, res) -> makeFunctionCompletionItem curModName n d infoType isFunctionCompletion rng (fullLine pinfo) + Nothing -> makeCompletionItem curModName n k d + _ -> makeCompletionItem curModName n k d + where + pos@(J.Position l c) = cursorPos pinfo + rng = J.Range (J.Position l $ c - fromIntegral (T.length search)) pos + k = case ninfo of + InfoVal {..} -> J.CompletionItemKind_Constant + InfoFun {..} -> J.CompletionItemKind_Function + InfoExternal {..} -> J.CompletionItemKind_Reference + InfoImport {..} -> J.CompletionItemKind_Module + InfoCon {infoCon = ConInfo {conInfoParams = ps}} + | not (null ps) -> J.CompletionItemKind_Constructor + | otherwise -> J.CompletionItemKind_EnumMember + d = show $ pretty $ infoType ninfo + +constructorCompletions :: Name -> Constructors -> [J.CompletionItem] +constructorCompletions curModName cstrs = map toItem $ filter (\(n,ci) -> '.' /= T.head (T.pack $ nameId n)) (constructorsList cstrs) + where + toItem (n, cinfo) = makeCompletionItem curModName n k d + where + ps = conInfoParams cinfo + k + | not (null ps) = J.CompletionItemKind_Constructor + | otherwise = J.CompletionItemKind_EnumMember + d = show $ pretty $ conInfoType cinfo + +synonymCompletions :: Name -> Synonyms -> [J.CompletionItem] +synonymCompletions curModName = map toItem . synonymsToList + where + toItem sinfo = makeCompletionItem curModName n J.CompletionItemKind_Interface d + where + n = synInfoName sinfo + d = show $ pretty $ synInfoType sinfo + +keywordCompletions :: Name -> [J.CompletionItem] +keywordCompletions curModName = map toItem $ S.toList reservedNames + where + toItem s = makeSimpleCompletionItem curModName s J.CompletionItemKind_Keyword + +makeCompletionItem :: Name -> Name -> J.CompletionItemKind -> String -> J.CompletionItem +makeCompletionItem curModName n k d = + J.CompletionItem + label + labelDetails + kind + tags + detail + doc + deprecated + preselect + sortText + filterText + insertText + insertTextFormat + insertTextMode + textEdit + textEditText + additionalTextEdits + commitChars + command + xdata + where + label = T.pack $ nameId n + labelDetails = Nothing + kind = Just k + tags = Nothing + detail = Just $ T.pack d + doc = Just $ J.InL $ T.pack $ nameModule n + deprecated = Just False + preselect = Nothing + sortText = Just $ if nameId curModName == nameModule n then T.pack $ "0" ++ nameId n else T.pack $ "2" ++ nameId n + filterText = Nothing + insertText = Nothing + insertTextFormat = Nothing + insertTextMode = Nothing + textEdit = Nothing + textEditText = Nothing + additionalTextEdits = Nothing + commitChars = Just [T.pack "\t"] + command = Nothing + xdata = Nothing + +makeFunctionCompletionItem :: Name -> Name -> String -> Type -> Bool -> J.Range -> T.Text-> J.CompletionItem +makeFunctionCompletionItem curModName funName d funType accessor rng line = + J.CompletionItem + label + labelDetails + kind + tags + detail + doc + deprecated + preselect + sortText + filterText + insertText + insertTextFormat + insertTextMode + textEdit + textEditText + additionalTextEdits + commitChars + command + xdata + where + label = T.pack $ nameId funName + indentation = T.length $ T.takeWhile (== ' ') line + trailingFunIndentation = T.replicate indentation " " + labelDetails = Nothing + kind = Just J.CompletionItemKind_Snippet + tags = Nothing + detail = Just $ T.pack d + doc = Just $ J.InL $ T.pack $ nameModule funName + deprecated = Just False + preselect = Nothing + sortText = Just $ if nameId curModName == nameModule funName then "0" <> label else "2" <> label + filterText = Just label + insertText = Nothing + insertTextFormat = Just InsertTextFormat_Snippet + insertTextMode = Nothing + arguments = case splitFunScheme funType + of Just (tvars, tpreds, pars, eff, res) -> pars + Nothing -> [] + numArgs = length arguments - (if accessor then 1 else 0) + trailingFunArgTp = case arguments + of [] -> Nothing + xs -> let arg = last xs + in case splitFunScheme (snd arg) of + Nothing -> Nothing + Just (_, _, args, _, _) -> Just args + argumentsText = + if numArgs == 0 then trace ("No function arguments for " ++ show label) $ T.pack "" + else case trailingFunArgTp of + Nothing -> "(" <> T.intercalate "," (map (\i -> T.pack $ "$" ++ show i) [1..numArgs]) <> ")" + Just tp -> + let mainArgs = "(" <> T.intercalate "," (map (\i -> T.pack $ "$" ++ show i) [1..numArgs-1]) <> ")" + in mainArgs <> " fn(" <> T.intercalate "," (map (\i -> T.pack $ "$" ++ show i) [numArgs..numArgs+length tp-1]) <> ")\n" <> trailingFunIndentation <> "()" + textEdit = Just $ J.InL $ J.TextEdit rng $ label <> argumentsText + textEditText = Nothing + additionalTextEdits = Nothing + commitChars = Just [T.pack "\t"] + command = Nothing + xdata = Nothing + +makeHandlerCompletionItem :: Name -> ConInfo -> String -> J.Range -> T.Text -> J.CompletionItem +makeHandlerCompletionItem curModName conInfo d r line = + J.CompletionItem + label + labelDetails + kind + tags + detail + doc + deprecated + preselect + sortText + filterText + insertText + insertTextFormat + insertTextMode + textEdit + textEditText + additionalTextEdits + commitChars + command + xdata + where + indentation = T.length $ T.takeWhile (== ' ') line + clauseIndentation = T.replicate indentation " " + clauseBodyIndentation = T.replicate (indentation + 2) " " + typeName = conInfoTypeName conInfo + typeNameId = T.replace ".hnd-" "" $ T.pack $ nameId typeName + label = "handler for " <> typeNameId + labelDetails = Nothing + kind = Just J.CompletionItemKind_Snippet + tags = Nothing + detail = Just $ T.pack d + doc = Just $ J.InL $ T.pack $ nameModule typeName + deprecated = Just False + preselect = Nothing + sortText = Just $ if nameId curModName == nameModule typeName then "0" <> typeNameId else "2" <> typeNameId + filterText = Just typeNameId + insertText = Nothing + insertTextFormat = Just InsertTextFormat_Snippet + insertTextMode = Nothing + handlerClause :: (Int, [T.Text]) -> (Name, Type) -> (Int, [T.Text]) + handlerClause (i, acc) (name, tp) = + -- TODO: Consider adding snippet locations for the body of the handlers as well + if T.isPrefixOf "val" newName then + (i + 1, acc ++ [clauseIndentation <> newName <> " = $" <> T.pack (show (i + 1))]) + else (if not (null funArgs) then fst (last funArgs) + 1 else 1, acc ++ [clauseIndentation <> newName <> "(" <> T.intercalate "," (map snd funArgs) <> ")\n" <> clauseBodyIndentation <> "()"]) + where + funArgs = zipWith (\i s -> (i, T.pack $ "$" ++ show (i + 1))) [i..] (handlerArgs newName tp) + newName = T.replace "brk" "final ctl" $ T.replace "-" " " (T.pack (show name)) + textEdit = Just $ J.InL $ J.TextEdit r $ "handler\n" <> T.intercalate "\n" (snd (foldl handlerClause (1, []) (conInfoParams conInfo))) + textEditText = Nothing + additionalTextEdits = Nothing + commitChars = Just [T.pack "\t"] + command = Nothing + xdata = Nothing + +handlerArgs :: T.Text -> Type -> [Type] +handlerArgs name tp = + case tp of + TApp _ args -> if T.isPrefixOf "val" name then take (length args - 3) args else take (length args - 4) args + _ -> [] + +makeSimpleCompletionItem :: Name -> String -> J.CompletionItemKind -> J.CompletionItem +makeSimpleCompletionItem curModName l k = + J.CompletionItem + label + labelDetails + kind + tags + detail + doc + deprecated + preselect + sortText + filterText + insertText + insertTextFormat + insertTextMode + textEdit + textEditText + additionalTextEdits + commitChars + command + xdata + where + label = T.pack l + labelDetails = Nothing + kind = Just k + tags = Nothing + detail = Nothing + doc = Nothing + deprecated = Just False + preselect = Nothing + sortText = Just $ T.pack $ "1" ++ l + filterText = Nothing + insertText = Nothing + insertTextFormat = Nothing + insertTextMode = Nothing + textEdit = Nothing + textEditText = Nothing + additionalTextEdits = Nothing + commitChars = Just [T.pack "\t"] + command = Nothing + xdata = Nothing diff --git a/src/LanguageServer/Handler/Definition.hs b/src/LanguageServer/Handler/Definition.hs new file mode 100644 index 000000000..9b93fe4b8 --- /dev/null +++ b/src/LanguageServer/Handler/Definition.hs @@ -0,0 +1,52 @@ +----------------------------------------------------------------------------- +-- The LSP handler that provides ctrl-click definitions +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} + +module LanguageServer.Handler.Definition (definitionHandler) where + +import Compiler.Module (Loaded (..), loadedModule, modRangeMap) +import Control.Lens ((^.)) +import qualified Data.Map as M +import Data.Maybe (maybeToList) +import Kind.Constructors (conInfoRange, constructorsLookup) +import Kind.Newtypes (dataInfoRange, newtypesLookupAny) +import Kind.Synonym (synInfoRange, synonymsLookup) +import Language.LSP.Server (Handlers, requestHandler) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J +import LanguageServer.Conversions (fromLspPos, toLspLocation, toLspLocationLink) +import LanguageServer.Monad (LSM, getLoaded) +import Syntax.RangeMap (RangeInfo (..), rangeMapFindAt) +import Type.Assumption (gammaLookupQ, infoRange) +import qualified Language.LSP.Protocol.Message as J + +definitionHandler :: Handlers LSM +definitionHandler = requestHandler J.SMethod_TextDocumentDefinition $ \req responder -> do + let J.DefinitionParams doc pos _ _ = req ^. J.params + uri = doc ^. J.uri + loaded <- getLoaded + let defs = do + l <- maybeToList loaded + rmap <- maybeToList $ modRangeMap $ loadedModule l + (_, rinfo) <- maybeToList $ rangeMapFindAt (fromLspPos uri pos) rmap + findDefinitions l rinfo + responder $ Right $ J.InR $ J.InL defs + +-- Finds the definition locations of the element +-- represented by the given range info. +findDefinitions :: Loaded -> RangeInfo -> [J.DefinitionLink] +findDefinitions loaded rinfo = case rinfo of + Id qname _ _ -> + let rngs = + map infoRange (gammaLookupQ qname gamma) + ++ map conInfoRange (maybeToList $ constructorsLookup qname constrs) + ++ map synInfoRange (maybeToList $ synonymsLookup qname synonyms) + ++ map dataInfoRange (maybeToList $ newtypesLookupAny qname newtypes) + in map (J.DefinitionLink . toLspLocationLink rinfo) rngs + _ -> [] + where + gamma = loadedGamma loaded + constrs = loadedConstructors loaded + synonyms = loadedSynonyms loaded + newtypes = loadedNewtypes loaded diff --git a/src/LanguageServer/Handler/DocumentSymbol.hs b/src/LanguageServer/Handler/DocumentSymbol.hs new file mode 100644 index 000000000..a788e8e72 --- /dev/null +++ b/src/LanguageServer/Handler/DocumentSymbol.hs @@ -0,0 +1,168 @@ +----------------------------------------------------------------------------- +-- The LSP handler that provides a document symbol tree +-- (sometimes presented as 'outline' in the client's GUI) +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings, FlexibleInstances, RecordWildCards #-} +module LanguageServer.Handler.DocumentSymbol( documentSymbolHandler + ) where + +import qualified Common.Range as R +import Common.Syntax ( DefSort (..) ) +import Common.Name ( Name (..) ) +import Compiler.Module ( modProgram, loadedModule, Loaded (..) ) +import Control.Lens ( (^.) ) +import qualified Data.Map as M +import Data.Maybe ( maybeToList ) +import qualified Data.Text as T +import Language.LSP.Server ( Handlers, requestHandler ) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J +import LanguageServer.Conversions ( toLspRange ) +import LanguageServer.Monad ( LSM, getLoaded ) +import Syntax.Syntax +import qualified Language.LSP.Protocol.Message as J + +documentSymbolHandler :: Handlers LSM +documentSymbolHandler = requestHandler J.SMethod_TextDocumentDocumentSymbol $ \req responder -> do + let J.DocumentSymbolParams _ _ doc = req ^. J.params + uri = doc ^. J.uri + loaded <- getLoaded + let symbols = findDocumentSymbols =<< maybeToList loaded + responder $ Right $ J.InR $ J.InL symbols + +-- Traverses the syntax tree to find document symbols +findDocumentSymbols :: Loaded -> [J.DocumentSymbol] +findDocumentSymbols loaded = do + prog <- maybeToList $ modProgram $ loadedModule loaded + symbols prog + +class HasSymbols a where + symbols :: a -> [J.DocumentSymbol] + +instance HasSymbols a => HasSymbols (Maybe a) where + symbols = maybe [] symbols + +instance HasSymbols a => HasSymbols [a] where + symbols = (symbols =<<) + +instance HasSymbols () where + symbols = const [] + +instance HasSymbols UserProgram where + symbols prog = symbols (programTypeDefs prog) ++ symbols (programDefs prog) + +-- Type definition instances + +instance HasSymbols UserTypeDefGroup where + symbols tdg = case tdg of + TypeDefRec tds -> symbols tds + TypeDefNonRec td -> symbols td + +instance HasSymbols UserTypeDef where + symbols td = [makeSymbol n k r cs] + where + b = typeDefBinder td + n = tbinderName b + r = typeDefRange td + k = case td of + Synonym {..} -> J.SymbolKind_Interface + DataType {typeDefConstrs = ctrs} | length ctrs > 1 -> J.SymbolKind_Enum + | otherwise -> J.SymbolKind_Struct + cs = case td of + DataType {typeDefConstrs = ctrs} -> symbols ctrs + _ -> [] + +instance HasSymbols UserUserCon where + symbols c = [makeSymbol n k r []] + where + n = userconName c + ps = userconParams c + k | not (null ps) = J.SymbolKind_Constructor + | otherwise = J.SymbolKind_EnumMember + r = userconRange c + +-- Value definition instances + +instance HasSymbols UserDefGroup where + symbols dg = case dg of + DefRec ds -> symbols ds + DefNonRec d -> symbols d + +instance HasSymbols UserDef where + symbols d = [makeSymbol n k r cs] + where + b = defBinder d + k = case defSort d of + DefFun _ _ -> J.SymbolKind_Function + DefVal -> J.SymbolKind_Constant + DefVar -> J.SymbolKind_Variable + n = binderName b + r = defRange d + cs = symbols $ binderExpr b + +instance HasSymbols e => HasSymbols (ValueBinder t e) where + symbols b = [makeSymbol n k r cs] + where + k = J.SymbolKind_Constant + n = binderName b + r = binderRange b + cs = symbols $ binderExpr b + +instance HasSymbols UserExpr where + symbols ex = case ex of + Lam bs e _ -> symbols bs ++ symbols e + Let dg e _ -> symbols dg ++ symbols e + Bind d e _ -> symbols d ++ symbols e + App e nes _ -> symbols e ++ symbols (map snd nes) + Ann e _ _ -> symbols e + Case e bs _ -> symbols e ++ symbols bs + Parens e _ _ -> symbols e + Handler _ _ _ _ _ bs e1 e2 e3 hbs _ _ -> symbols bs ++ symbols e1 + ++ symbols e2 + ++ symbols e3 + ++ symbols hbs + Inject _ e _ _ -> symbols e + _ -> [] -- TODO: Handle other types of (nested) expressions + +instance HasSymbols UserHandlerBranch where + symbols hb = [makeSymbol n J.SymbolKind_Function r cs] + where + n = hbranchName hb + r = hbranchNameRange hb + e = hbranchExpr hb + ps = hbranchPars hb + cs = symbols ps ++ symbols e + +instance HasSymbols UserBranch where + symbols b = symbols p ++ symbols gs + where + p = branchPattern b + gs = branchGuards b + +instance HasSymbols UserGuard where + symbols g = symbols t ++ symbols e + where + t = guardTest g + e = guardExpr g + +instance HasSymbols UserPattern where + symbols pat = case pat of + PatVar b -> let n = binderName b + r = binderRange b + in [makeSymbol n J.SymbolKind_Constant r []] + PatAnn p _ _ -> symbols p + PatCon _ ps _ _ -> symbols $ map snd ps + PatParens p _ -> symbols p + _ -> [] + +makeSymbol :: Name -> J.SymbolKind -> R.Range -> [J.DocumentSymbol] -> J.DocumentSymbol +makeSymbol n k r cs = J.DocumentSymbol name detail kind tags deprecated range selRange children + where + name = T.pack $ nameId n + detail = Just $ T.pack $ nameModule n + kind = k + tags = Just [] + deprecated = Just False + range = toLspRange r + selRange = range + children = Just cs diff --git a/src/LanguageServer/Handler/Hover.hs b/src/LanguageServer/Handler/Hover.hs new file mode 100644 index 000000000..54613da07 --- /dev/null +++ b/src/LanguageServer/Handler/Hover.hs @@ -0,0 +1,66 @@ +----------------------------------------------------------------------------- +-- The LSP handler that provides hover tooltips +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module LanguageServer.Handler.Hover (hoverHandler, formatRangeInfoHover) where + +import Compiler.Module (loadedModule, modRangeMap, Loaded (loadedModules), Module (modPath, modSourcePath)) +import Control.Lens ((^.)) +import qualified Data.Map as M +import qualified Data.Text as T +import Language.LSP.Server (Handlers, sendNotification, requestHandler) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J +import LanguageServer.Conversions (fromLspPos, toLspRange) +import LanguageServer.Monad (LSM, getLoaded, getLoadedModule, getHtmlPrinter, getFlags) +import Lib.PPrint (Pretty (..), Doc, text, (<+>), color) +import Syntax.RangeMap (NameInfo (..), RangeInfo (..), rangeMapFindAt) +import qualified Language.LSP.Protocol.Message as J +import Control.Monad.Cont (liftIO) +import Type.Pretty (ppScheme, defaultEnv, Env(..)) +import Common.ColorScheme (ColorScheme (colorNameQual)) +import Kind.Pretty (prettyKind) +import Common.Name (nameNil) +import Kind.ImportMap (importsEmpty) +import Compiler.Options (Flags, colorSchemeFromFlags, prettyEnvFromFlags) + +hoverHandler :: Handlers LSM +hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do + let J.HoverParams doc pos _ = req ^. J.params + uri = doc ^. J.uri + loaded <- getLoadedModule uri + flags <- getFlags + let res = do + l <- loaded + rmap <- modRangeMap l + rangeMapFindAt (fromLspPos uri pos) rmap + case res of + Just (r, rinfo) -> do + print <- getHtmlPrinter + x <- liftIO $ formatRangeInfoHover print flags rinfo + let hc = J.InL $ J.mkMarkdown x + rsp = J.Hover hc $ Just $ toLspRange r + responder $ Right $ J.InL rsp + Nothing -> responder $ Right $ J.InR J.Null + +prettyEnv flags ctx imports = (prettyEnvFromFlags flags){ context = ctx, importsMap = imports } + +-- Pretty-prints type/kind information to a hover tooltip +formatRangeInfoHover :: (Doc -> IO T.Text) -> Flags -> RangeInfo -> IO T.Text +formatRangeInfoHover print flags rinfo = + let colors = colorSchemeFromFlags flags in + case rinfo of + Id qname info isdef -> + print $ (color (colorNameQual colors) $ pretty qname) <+> text " : " <+> case info of + NIValue tp -> ppScheme (prettyEnv flags nameNil importsEmpty) tp + NICon tp -> ppScheme (prettyEnv flags nameNil importsEmpty) tp + NITypeCon k -> prettyKind colors k + NITypeVar k -> prettyKind colors k + NIModule -> text "module" + NIKind -> text "kind" + Decl s name mname -> print $ text s <+> text " " <+> pretty name + Block s -> return $ T.pack s + Error doc -> print $ text "Error: " <+> doc + Warning doc -> print $ text "Warning: " <+> doc diff --git a/src/LanguageServer/Handler/TextDocument.hs b/src/LanguageServer/Handler/TextDocument.hs new file mode 100644 index 000000000..7c99af4b4 --- /dev/null +++ b/src/LanguageServer/Handler/TextDocument.hs @@ -0,0 +1,194 @@ +----------------------------------------------------------------------------- +-- The LSP handlers that handle changes to the document +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} + +module LanguageServer.Handler.TextDocument + ( didOpenHandler, + didChangeHandler, + didSaveHandler, + didCloseHandler, + recompileFile, + persistModules, + ) +where + +import Common.Error (Error, checkPartial) +import Compiler.Compile (Terminal (..), compileModuleOrFile, Loaded (..), CompileTarget (..), compileFile, codeGen) +import Control.Lens ((^.)) +import Control.Monad.Trans (liftIO) +import qualified Data.Map as M +import Data.Maybe (fromJust, fromMaybe) +import qualified Data.Text as T +import Language.LSP.Diagnostics (partitionBySource) +import Language.LSP.Server (Handlers, flushDiagnosticsBySource, publishDiagnostics, sendNotification, getVirtualFile, getVirtualFiles, notificationHandler) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J +import LanguageServer.Conversions (toLspDiagnostics) +import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded) +import Language.LSP.VFS (virtualFileText, VFS(..), VirtualFile, file_version, virtualFileVersion) +import qualified Data.Text.Encoding as T +import Data.Functor ((<&>)) +import qualified Language.LSP.Protocol.Message as J +import Data.ByteString (ByteString) +import Data.Map (Map) +import Text.Read (readMaybe) +import Debug.Trace (trace) +import Control.Exception (try) +import qualified Control.Exception as Exc +import Compiler.Options (Flags) +import Common.File (getFileTime, FileTime, getFileTimeOrCurrent, getCurrentTime, normalize) +import GHC.IO (unsafePerformIO) +import Compiler.Module (Module(..)) +import Control.Monad (when, foldM) +import Data.Time (addUTCTime, addLocalTime) +import qualified Data.ByteString as J + +didOpenHandler :: Handlers LSM +didOpenHandler = notificationHandler J.SMethod_TextDocumentDidOpen $ \msg -> do + let uri = msg ^. J.params . J.textDocument . J.uri + let version = msg ^. J.params . J.textDocument . J.version + flags <- getFlags + _ <- recompileFile InMemory uri (Just version) False flags + return () + +didChangeHandler :: Handlers LSM +didChangeHandler = notificationHandler J.SMethod_TextDocumentDidChange $ \msg -> do + let uri = msg ^. J.params . J.textDocument . J.uri + let version = msg ^. J.params . J.textDocument . J.version + flags <- getFlags + _ <- recompileFile InMemory uri (Just version) False flags + return () + +didSaveHandler :: Handlers LSM +didSaveHandler = notificationHandler J.SMethod_TextDocumentDidSave $ \msg -> do + let uri = msg ^. J.params . J.textDocument . J.uri + flags <- getFlags + _ <- recompileFile InMemory uri Nothing False flags + return () + +didCloseHandler :: Handlers LSM +didCloseHandler = notificationHandler J.SMethod_TextDocumentDidClose $ \_msg -> do + -- TODO: Remove file from LSM state? + return () + +maybeContents :: Map FilePath (ByteString, FileTime, J.Int32) -> FilePath -> Maybe (ByteString, FileTime) +maybeContents vfs uri = do + -- trace ("Maybe contents " ++ show uri ++ " " ++ show (M.keys vfs)) $ return () + (text, ftime, vers) <- M.lookup uri vfs + return (text, ftime) + +diffVFS :: Map FilePath (ByteString, FileTime, J.Int32) -> Map J.NormalizedUri VirtualFile -> LSM (Map FilePath (ByteString, FileTime, J.Int32)) +diffVFS oldvfs vfs = + foldM (\acc (k, v) -> + let newK = normalize $ J.fromNormalizedFilePath $ fromJust $ J.uriToNormalizedFilePath k + text = T.encodeUtf8 $ virtualFileText v + vers = virtualFileVersion v + in case M.lookup newK oldvfs of + Just old@(_, _, vOld) -> + if vOld == vers then + return $ M.insert newK old acc + else do + time <- liftIO getCurrentTime + return $ M.insert newK (text, time, vers) acc + Nothing -> do + time <- liftIO $ getFileTime newK + -- trace ("New file " ++ show newK ++ " " ++ show time) $ return () + return $ M.insert newK (text, time, vers) acc) + M.empty (M.toList vfs) + +-- Recompiles the given file, stores the compilation result in +-- LSM's state and emits diagnostics. +recompileFile :: CompileTarget () -> J.Uri -> Maybe J.Int32 -> Bool -> Flags -> LSM (Maybe FilePath) +recompileFile compileTarget uri version force flags = + case J.uriToFilePath uri of + Just filePath0 -> do + let filePath = normalize filePath0 + -- Recompile the file + vFiles <- getVirtualFiles + let vfs = _vfsMap vFiles + oldvfs <- documentInfos <$> getLSState + newvfs <- diffVFS oldvfs vfs + modifyLSState (\old -> old{documentInfos = newvfs}) + let contents = fst <$> maybeContents newvfs filePath + loaded1 <- getLoaded + let modules = do + l <- loaded1 + return $ loadedModule l : loadedModules l + term <- getTerminal + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath + + let resultIO :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) + resultIO = try $ compileFile (maybeContents newvfs) contents term flags [] (if force then [] else fromMaybe [] modules) compileTarget [] filePath + result <- liftIO resultIO + case result of + Right res -> do + outFile <- case checkPartial res of + Right ((l, outFile), _, _) -> do + putLoaded l + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ "Successfully compiled " <> T.pack filePath + return outFile + Left (e, m) -> do + case m of + Nothing -> + trace ("Error when compiling, no cached modules " ++ show e) $ + return () + Just l -> do + trace ("Error when compiling have cached" ++ show (map modSourcePath $ loadedModules l)) $ return () + putLoaded l + removeLoaded (loadedModule l) + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Error when compiling " ++ show e) <> T.pack filePath + return Nothing + -- Emit the diagnostics (errors and warnings) + let diagSrc = T.pack "koka" + diags = toLspDiagnostics diagSrc res + diagsBySrc = partitionBySource diags + maxDiags = 100 + if null diags + then flushDiagnosticsBySource maxDiags (Just diagSrc) + else publishDiagnostics maxDiags normUri version diagsBySrc + return outFile + Left e -> do + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) + sendNotification J.SMethod_WindowShowMessage $ J.ShowMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) + return Nothing + Nothing -> return Nothing + where + normUri = J.toNormalizedUri uri + +persistModules :: LSM () +persistModules = do + mld <- getLoaded + case mld of + Just ld -> mapM_ persistModule (loadedModules ld) + Nothing -> return () + +persistModule :: Module -> LSM () +persistModule m = do + return () + -- TODO: This works, but needs to check that the dependencies are persisted first. + -- let generate = do + -- -- trace "Generating" $ return () + -- mld <- getLoaded + -- case mld of + -- Just loaded -> do + -- term <- getTerminal + -- flags <- getFlags + -- (loaded, file) <- liftIO $ codeGen term flags Object loaded{loadedModule = m} + -- putLoaded loaded + -- return () + -- Nothing -> return () + -- -- trace ("Module " ++ show (modName m)) $ + -- case modOutputTime m of + -- Nothing -> do + -- -- trace "No output time" $ return () + -- generate + -- -- If it has been 5 seconds since the last time the module was changed + -- -- and it isn't updated on disk persist again. + -- -- We don't do it all the time, because with virtual files and editor changes it would be too much + -- Just t -> do + -- ct <- liftIO getCurrentTime + -- when ((ct > addUTCTime 5 (modTime m)) && (modTime m > t)) $ do + -- -- trace ("Last output time" ++ show t) $ return () + -- generate + -- return () \ No newline at end of file diff --git a/src/LanguageServer/Handlers.hs b/src/LanguageServer/Handlers.hs new file mode 100644 index 000000000..802ace351 --- /dev/null +++ b/src/LanguageServer/Handlers.hs @@ -0,0 +1,120 @@ +----------------------------------------------------------------------------- +-- The request handlers used by the language server +----------------------------------------------------------------------------- +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE GADTs #-} + +module LanguageServer.Handlers (ReactorInput(..), lspHandlers) where + +import Compiler.Options (Flags) +import Language.LSP.Server (Handlers, notificationHandler, Handler, mapHandlers, MonadLsp (..)) +import LanguageServer.Handler.Completion (completionHandler) +import LanguageServer.Handler.Definition (definitionHandler) +import LanguageServer.Handler.DocumentSymbol (documentSymbolHandler) +import LanguageServer.Handler.Hover (hoverHandler) +import LanguageServer.Handler.Commands (initializedHandler, commandHandler) +import LanguageServer.Handler.TextDocument (didChangeHandler, didCloseHandler, didOpenHandler, didSaveHandler) +import LanguageServer.Monad (LSM, runLSM, putLSState, LSState (..)) +import Language.LSP.Protocol.Message (TRequestMessage(..), TNotificationMessage(..), Method, MessageDirection(..), MessageKind(..), SMethod (..), SomeLspId (SomeLspId), LspId (..), NotificationMessage (..), ResponseError (..)) +import Control.Monad.Trans (lift) +import Control.Monad.Reader (MonadReader(ask)) + +import GHC.Conc (atomically) +import Control.Monad.IO.Class (liftIO) + +import Control.Concurrent.STM.TChan +import Control.Concurrent.MVar (readMVar) +import Control.Lens ((^.)) +import Control.Concurrent (modifyMVar) +import Control.Concurrent.Async +import Control.Concurrent.STM +import qualified Data.Map as M +import qualified Data.Set as S +import Language.LSP.Protocol.Lens hiding (retry) +import Prelude hiding (id) +import qualified Language.LSP.Protocol.Types as J +import Language.LSP.Protocol.Types (DidChangeTextDocumentParams(..), VersionedTextDocumentIdentifier (..)) +import Control.Monad (when, unless) +import qualified Data.Text as T + +newtype ReactorInput = ReactorAction (IO ()) + +lspHandlers rin = mapHandlers goReq goNot handle where + goReq :: forall (a :: Method ClientToServer Request). Handler LSM a -> Handler LSM a + goReq f msg@TRequestMessage{_id} k = do + env <- getLspEnv + state <- lift ask + let newId = SomeLspId _id + stVal <- liftIO $ readMVar state + liftIO $ atomically $ modifyTVar (pendingRequests stVal) $ \t -> S.insert newId t + + let waitForCancel reqId = atomically $ do + cancelled <- readTVar (cancelledRequests stVal) + unless (reqId `S.member` cancelled) retry + liftIO $ atomically $ writeTChan rin $ -- check if canceled and if so don't run + ReactorAction $ do + cancelOrRes <- race (waitForCancel newId) $ do + cancelled <- readTVarIO (cancelledRequests stVal) + if newId `S.member` cancelled then runLSM (k $ Left $ ResponseError (J.InL J.LSPErrorCodes_RequestCancelled) (T.pack "") Nothing) state env else + runLSM (f msg k) state env + case cancelOrRes of + Left () -> return () + Right res -> pure res + liftIO $ atomically $ do + modifyTVar (pendingRequests stVal) $ \t -> S.delete newId t + modifyTVar (cancelledRequests stVal) $ \t -> S.delete newId t + + + goNot :: forall (a :: Method ClientToServer Notification). Handler LSM a -> Handler LSM a + goNot f msg = do + env <- getLspEnv + state <- lift ask + stVal <- liftIO $ readMVar state + let mtd = msg ^. method + case mtd of + SMethod_TextDocumentDidChange -> do + -- If text document change command, and a new change comes in with a newer version for the same file, cancel the old one + let TNotificationMessage{_params=DidChangeTextDocumentParams{_textDocument=VersionedTextDocumentIdentifier{_uri, _version}}} = msg + stateV <- liftIO $ readMVar state + liftIO $ atomically $ modifyTVar (documentVersions stateV) $ \t -> M.insert _uri _version t + liftIO $ atomically $ writeTChan rin $ + ReactorAction $ do + versions <- readTVarIO (documentVersions stVal) + when (M.lookup _uri versions == Just _version) $ runLSM (f msg) state env + _ -> + liftIO $ atomically $ writeTChan rin $ + ReactorAction (runLSM (f msg) state env) + +handle = handlers + +handlers :: Handlers LSM +handlers = + mconcat + [ initializedHandler, + didOpenHandler, + didChangeHandler, + didSaveHandler, + didCloseHandler, + hoverHandler, + definitionHandler, + documentSymbolHandler, + completionHandler, + cancelHandler, + commandHandler + ] + +cancelHandler :: Handlers LSM +cancelHandler = + notificationHandler SMethod_CancelRequest $ \msg -> + do + let id_ = msg ^. params ^. id + state <- lift ask + stateV <- liftIO $ readMVar state + _ <- liftIO $ atomically $ modifyTVar (cancelledRequests stateV) $ \t -> S.insert (SomeLspId (toLspId id_)) t + return () + where toLspId (J.InL x) = IdInt x + toLspId (J.InR y) = IdString y \ No newline at end of file diff --git a/src/LanguageServer/Monad.hs b/src/LanguageServer/Monad.hs new file mode 100644 index 000000000..3145bc907 --- /dev/null +++ b/src/LanguageServer/Monad.hs @@ -0,0 +1,176 @@ +----------------------------------------------------------------------------- +-- The language server's monad that holds state (e.g. loaded/compiled modules) +----------------------------------------------------------------------------- +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +module LanguageServer.Monad + ( LSState (..), + defaultLSState, + newLSStateVar, + LSM, + getLSState, + getTerminal, + getFlags, + putLSState, + modifyLSState, + getLoaded, + putLoaded,removeLoaded, + getLoadedModule, + getColorScheme, + getHtmlPrinter, + runLSM, + ) +where + +import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, putMVar, readMVar, newEmptyMVar) +import Control.Monad.Reader (ReaderT, ask, runReaderT) +import Control.Monad.Trans (lift, liftIO) +import qualified Data.Map as M +import qualified Data.Text as T +import Language.LSP.Server (LanguageContextEnv, LspT, runLspT, sendNotification, Handlers) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J + +import Compiler.Compile (Terminal (..), Loaded (..), Module (..)) +import Lib.PPrint (Pretty(..), asString, writePrettyLn, Doc) +import Control.Concurrent.Chan (readChan) +import Type.Pretty (ppType, defaultEnv, Env (context, importsMap), ppScheme) +import qualified Language.LSP.Server as J +import GHC.Base (Type) +import Lib.Printer (withColorPrinter, withColor, writeLn, ansiDefault, AnsiStringPrinter (AnsiString), Color (Red), ColorPrinter (PAnsiString, PHtmlText), withHtmlTextPrinter, HtmlTextPrinter (..)) +import Compiler.Options (Flags (..), prettyEnvFromFlags, verbose) +import Common.Error (ppErrorMessage) +import Common.ColorScheme (colorSource, ColorScheme) +import Common.Name (nameNil) +import Kind.ImportMap (importsEmpty) +import Platform.Var (newVar, takeVar) +import Debug.Trace (trace) + +import Control.Monad.STM +import Control.Concurrent.STM.TChan +import Control.Concurrent +import GHC.Conc (atomically) +import Control.Concurrent.STM (newTVarIO, TVar) +import qualified Data.Set as Set +import Control.Concurrent.STM.TMVar (TMVar) +import LanguageServer.Conversions (loadedModuleFromUri) +import qualified Data.ByteString as D +import Platform.Filetime (FileTime) + +-- The language server's state, e.g. holding loaded/compiled modules. +data LSState = LSState { + lsLoaded :: Maybe Loaded, + messages :: TChan (String, J.MessageType), + flags:: Flags, + terminal:: Terminal, + htmlPrinter :: Doc -> IO T.Text, + pendingRequests :: TVar (Set.Set J.SomeLspId), + cancelledRequests :: TVar (Set.Set J.SomeLspId), + documentVersions :: TVar (M.Map J.Uri J.Int32), + documentInfos :: M.Map FilePath (D.ByteString, FileTime, J.Int32) } + +trimnl :: [Char] -> [Char] +trimnl str = reverse $ dropWhile (`elem` "\n\r\t ") $ reverse str + +htmlTextColorPrinter :: Doc -> IO T.Text +htmlTextColorPrinter doc + = do + stringVar <- newVar (T.pack "") + let printer = PHtmlText (HtmlTextPrinter stringVar) + writePrettyLn printer doc + takeVar stringVar + +defaultLSState :: Flags -> IO LSState +defaultLSState flags = do + msgChan <- atomically newTChan :: IO (TChan (String, J.MessageType)) + pendingRequests <- newTVarIO Set.empty + cancelledRequests <- newTVarIO Set.empty + fileVersions <- newTVarIO M.empty + let withNewPrinter f = do + ansiConsole <- newVar ansiDefault + stringVar <- newVar "" + let p = AnsiString ansiConsole stringVar + tp <- (f . PAnsiString) p + ansiString <- takeVar stringVar + atomically $ writeTChan msgChan (trimnl ansiString, tp) + let cscheme = colorScheme flags + prettyEnv flags ctx imports = (prettyEnvFromFlags flags){ context = ctx, importsMap = imports } + term = Terminal (\err -> withNewPrinter $ \p -> do putErrorMessage p (showSpan flags) cscheme err; return J.MessageType_Error) + (if verbose flags > 1 then (\msg -> withNewPrinter $ \p -> do withColor p (colorSource cscheme) (writeLn p msg); return J.MessageType_Info) + else (\_ -> return ())) + (if verbose flags > 0 then (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) else (\_ -> return ())) + (\tp -> withNewPrinter $ \p -> do putScheme p (prettyEnv flags nameNil importsEmpty) tp; return J.MessageType_Info) + (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) + return LSState {lsLoaded = Nothing, messages = msgChan, terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, documentInfos = M.empty, documentVersions = fileVersions} + +putScheme p env tp + = writePrettyLn p (ppScheme env tp) + +putErrorMessage p endToo cscheme err + = writePrettyLn p (ppErrorMessage endToo cscheme err) + +newLSStateVar :: Flags -> IO (MVar LSState) +newLSStateVar flags = defaultLSState flags >>= newMVar + +-- The monad holding (thread-safe) state used by the language server. +type LSM = LspT () (ReaderT (MVar LSState) IO) + +-- Fetches the language server's state inside the LSM monad +getLSState :: LSM LSState +getLSState = do + stVar <- lift ask + liftIO $ readMVar stVar + +-- Replaces the language server's state inside the LSM monad +putLSState :: LSState -> LSM () +putLSState s = do + stVar <- lift ask + liftIO $ putMVar stVar s + +-- Updates the language server's state inside the LSM monad +modifyLSState :: (LSState -> LSState) -> LSM () +modifyLSState m = do + stVar <- lift ask + liftIO $ modifyMVar stVar $ \s -> return (m s, ()) + +-- Fetches the loaded state holding compiled modules +getLoaded :: LSM (Maybe Loaded) +getLoaded = lsLoaded <$> getLSState + +-- Fetches the loaded state holding compiled modules +getFlags :: LSM Flags +getFlags = flags <$> getLSState + +getHtmlPrinter :: LSM (Doc -> IO T.Text) +getHtmlPrinter = htmlPrinter <$> getLSState + +getColorScheme :: LSM ColorScheme +getColorScheme = colorScheme <$> getFlags + +-- Replaces the loaded state holding compiled modules +putLoaded :: Loaded -> LSM () +putLoaded l = modifyLSState $ \s -> s {lsLoaded = case lsLoaded s of {Nothing -> Just l; Just l' -> Just $ mergeLoaded l l'}} + +removeLoaded :: Module -> LSM () +removeLoaded m = modifyLSState $ \s -> s {lsLoaded = case lsLoaded s of {Nothing -> Nothing; Just l -> Just $ l{loadedModules = filter (\m' -> modName m' /= modName m) (loadedModules l)}}} + +getLoadedModule :: J.Uri -> LSM (Maybe Module) +getLoadedModule uri = do + lmaybe <- getLoaded + return $ loadedModuleFromUri lmaybe uri + +-- Runs the language server's state monad. +runLSM :: LSM a -> MVar LSState -> LanguageContextEnv () -> IO a +runLSM lsm stVar cfg = runReaderT (runLspT cfg lsm) stVar + +getTerminal :: LSM Terminal +getTerminal = terminal <$> getLSState + +mergeLoaded :: Loaded -> Loaded -> Loaded +mergeLoaded newL oldL = + let compiledName = modName $ loadedModule newL + newModules = filter (\m -> modName m /= compiledName) (loadedModules newL) + newModNames = compiledName:map modName newModules + news = loadedModule newL:newModules ++ filter (\m -> modName m `notElem` newModNames) (loadedModules oldL) in + newL{loadedModules= filter modCompiled news} diff --git a/src/LanguageServer/Run.hs b/src/LanguageServer/Run.hs new file mode 100644 index 000000000..7532f23ec --- /dev/null +++ b/src/LanguageServer/Run.hs @@ -0,0 +1,94 @@ +----------------------------------------------------------------------------- +-- The language server's main module +----------------------------------------------------------------------------- +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +module LanguageServer.Run (runLanguageServer) where + +import Compiler.Options (Flags (languageServerPort)) +import Control.Monad (void, forever) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.STM +import Control.Concurrent.STM.TChan +import Control.Concurrent +import Language.LSP.Server +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J +import qualified Language.LSP.Server as J +import LanguageServer.Handlers +import LanguageServer.Monad (newLSStateVar, runLSM, LSM, getLSState, LSState (messages)) +import Colog.Core (LogAction, WithSeverity) +import qualified Colog.Core as L +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Language.LSP.Logging (defaultClientLogger) +import Network.Simple.TCP +import Network.Socket hiding (connect) +import GHC.IO.IOMode (IOMode(ReadWriteMode)) +import GHC.Conc (atomically) +import LanguageServer.Handler.TextDocument (persistModules) + +runLanguageServer :: Flags -> [FilePath] -> IO () +runLanguageServer flags files = do + connect "127.0.0.1" (show $ languageServerPort flags) (\(socket, _) -> do + handle <- socketToHandle socket ReadWriteMode + state <- newLSStateVar flags + initStateVal <- liftIO $ readMVar state + rin <- atomically newTChan :: IO (TChan ReactorInput) + void $ + runServerWithHandles + ioLogger + lspLogger + handle + handle + $ + ServerDefinition + { onConfigurationChange = const $ pure $ Right (), + doInitialize = \env _ -> forkIO (reactor rin) >> forkIO (messageHandler (messages initStateVal) env) >> pure (Right env), + staticHandlers = \_caps -> lspHandlers rin, + interpretHandler = \env -> Iso (\lsm -> runLSM lsm state env) liftIO, + options = + defaultOptions + { optTextDocumentSync = Just syncOptions, + optExecuteCommandCommands = Just [T.pack "koka/genCode"] + -- optCompletionTriggerCharacters = Just ['.', ':', '/'] + -- TODO: ? https://www.stackage.org/haddock/lts-18.21/lsp-1.2.0.0/src/Language.LSP.Server.Core.html#Options + }, + defaultConfig = () + }) + where + prettyMsg l = "[" <> show (L.getSeverity l) <> "] " <> show (L.getMsg l) <> "\n\n" + ioLogger :: LogAction IO (WithSeverity LspServerLog) + ioLogger = L.cmap prettyMsg L.logStringStdout + stderrLogger :: LogAction IO (WithSeverity T.Text) + stderrLogger = L.cmap show L.logStringStderr + lspLogger :: LogAction (LspM config) (WithSeverity LspServerLog) + lspLogger = + let clientLogger = L.cmap (fmap (T.pack . show)) defaultClientLogger + in clientLogger <> L.hoistLogAction liftIO ioLogger + syncOptions = + J.TextDocumentSyncOptions + (Just True) -- open/close notifications + (Just J.TextDocumentSyncKind_Incremental) -- changes + (Just False) -- will save + (Just False) -- will save (wait until requests are sent to server) + (Just $ J.InR $ J.SaveOptions $ Just False) -- trigger on save, but dont send document + +messageHandler :: TChan (String, J.MessageType) -> LanguageContextEnv () -> IO () +messageHandler msgs env = do + forever $ do + (msg, msgType) <- atomically $ readTChan msgs + mVar <- newEmptyMVar + runLSM (sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams msgType $ T.pack msg) mVar env + +reactor :: TChan ReactorInput -> IO () +reactor inp = do + forever $ do + ReactorAction act <- atomically $ readTChan inp + act + +doPersist state env = + forever $ do + threadDelay 1000000 + runLSM persistModules state env diff --git a/src/Lib/Printer.hs b/src/Lib/Printer.hs index 6f154d06a..c9821966c 100644 --- a/src/Lib/Printer.hs +++ b/src/Lib/Printer.hs @@ -10,28 +10,30 @@ Only the color of 'stdout' is influenced by these functions. -} ----------------------------------------------------------------------------- -module Lib.Printer( +module Lib.Printer( -- * Color Color(..) -- * Printer - , Printer( write, writeText, writeLn, writeTextLn, flush, + , Printer( write, writeText, writeLn, writeTextLn, flush, withColor, withBackColor, withReverse, withUnderline -- ,setColor, setBackColor, setReverse, setUnderline - ) + ) -- * Printers , MonoPrinter, withMonoPrinter - , ColorPrinter, withColorPrinter, withNoColorPrinter, withFileNoColorPrinter, isAnsiPrinter, isConsolePrinter + , ColorPrinter(..), withColorPrinter, withNoColorPrinter, withFileNoColorPrinter, isAnsiPrinter, isConsolePrinter , AnsiPrinter, withAnsiPrinter + , AnsiStringPrinter(..), HtmlTextPrinter(..) , withFilePrinter, withNewFilePrinter - , withHtmlPrinter, withHtmlColorPrinter + , withHtmlPrinter, withHtmlColorPrinter, withHtmlTextPrinter -- * Misc. , ansiWithColor + , ansiDefault , ansiColor ) where import Data.List( intersperse ) -- import Data.Char( toLower ) -import System.IO ( hFlush, stdout, hPutStr, hPutStrLn, openFile, IOMode(..), hClose, Handle ) +import System.IO ( hFlush, stdout, hPutStr, hPutStrLn, openFile, IOMode(..), hClose, Handle ) import Platform.Var( Var, newVar, putVar, takeVar ) import Platform.Runtime( finally ) import Platform.Config( exeExtension ) @@ -47,7 +49,7 @@ import System.Console.Isocline( withTerm, termWriteLn, termWrite, termFlush ) {-------------------------------------------------------------------------- Printer ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} -- | A printer is an abstraction for something where we can send -- character output to. class Printer p where @@ -69,7 +71,7 @@ class Printer p where {-------------------------------------------------------------------------- Interface ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} -- | Available colors on a console. Normally, background colors are -- converted to their /dark/ variant. data Color = Black @@ -95,7 +97,7 @@ data Color = Black {-------------------------------------------------------------------------- Simple monochrome printer ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} -- | On windows, we cannot print unicode characters :-( sanitize :: String -> String @@ -135,7 +137,7 @@ instance Printer MonoPrinter where {-------------------------------------------------------------------------- Simple file printer ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} -- | File printer newtype FilePrinter = FilePrinter Handle @@ -177,7 +179,7 @@ instance Printer FilePrinter where {-------------------------------------------------------------------------- Standard ANSI escape sequences ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} -- | Use a color printer that uses ANSI escape sequences. withAnsiPrinter :: (AnsiPrinter -> IO a) -> IO a withAnsiPrinter f @@ -186,7 +188,7 @@ withAnsiPrinter f finally (f (Ansi ansi)) (do ansiEscapeIO seqReset hFlush stdout) -ansiDefault +ansiDefault = AnsiConsole ColorDefault ColorDefault False False @@ -214,6 +216,47 @@ instance Printer AnsiPrinter where setUnderline p u = unit $ ansiSetConsole p (\con -> con{ underline = u }) +data AnsiStringPrinter = AnsiString (Var AnsiConsole) (Var String) + +instance Printer AnsiStringPrinter where + write (AnsiString c st) s = do + st' <- takeVar st + putVar st (st' ++ s) + writeText (AnsiString c st) s = do + st' <- takeVar st + putVar st (st' ++ T.unpack s) + writeLn (AnsiString c st) s = do + st' <- takeVar st + putVar st (st' ++ s ++ "\n") + writeTextLn (AnsiString c st) s = do + st' <- takeVar st + putVar st (st' ++ T.unpack s ++ "\n") + flush p = return () -- hFlush stdout + withColor p c io = ansiStringWithConsole p (\con -> con{ fcolor = c }) io + withBackColor p c io = ansiStringWithConsole p (\con -> con{ bcolor = c }) io + withReverse p r io = ansiStringWithConsole p (\con -> con{ invert = r }) io + withUnderline p u io = ansiStringWithConsole p (\con -> con{ underline = u }) io + setColor p c = unit $ ansiStringSetConsole p (\con -> con{ fcolor = c }) + setBackColor p c = unit $ ansiStringSetConsole p (\con -> con{ bcolor = c }) + setReverse p r = unit $ ansiStringSetConsole p (\con -> con{ invert = r }) + setUnderline p u = unit $ ansiStringSetConsole p (\con -> con{ underline = u }) + + + +ansiStringWithConsole :: AnsiStringPrinter -> (AnsiConsole -> AnsiConsole) -> IO a -> IO a +ansiStringWithConsole p f io + = do old <- ansiStringSetConsole p f + finally io (ansiStringSetConsole p (const old)) + +ansiStringSetConsole :: AnsiStringPrinter -> (AnsiConsole -> AnsiConsole) -> IO AnsiConsole +ansiStringSetConsole (AnsiString varAnsi varString) f + = do con <- takeVar varAnsi + let new = f con + str <- takeVar varString + putVar varString $ str ++ T.unpack (ansiEscape (seqSetConsole con new)) + putVar varAnsi new + return con + -- | Helper function to put a string into a certain color ansiWithColor :: Color -> String -> String ansiWithColor color s @@ -229,7 +272,7 @@ unit io -- Console code ansiWithConsole :: AnsiPrinter -> (AnsiConsole -> AnsiConsole) -> IO a -> IO a -ansiWithConsole p f io +ansiWithConsole p f io = do old <- ansiSetConsole p f finally io (ansiSetConsole p (const old)) @@ -246,8 +289,8 @@ ansiEscapeIO xs | null xs = return () | otherwise = termWrite (T.unpack {-T.putStr-} (ansiEscape xs)) - - + + ansiEscape :: [T.Text] -> T.Text ansiEscape xs | null xs = T.empty @@ -262,19 +305,19 @@ seqSetConsole old new where reset = concat [seqReset - ,seqReverse (invert new) - ,seqUnderline (underline new) + ,seqReverse (invert new) + ,seqUnderline (underline new) ,seqColor False (fcolor new) ,seqColor True (bcolor new)] - diff = concat + diff = concat [max seqReverse invert ,max seqUnderline underline ,max (seqColor False) fcolor ,max (seqColor True) bcolor ] - max f field + max f field = if (field old /= field new) then f (field new) else [] seqReset :: [T.Text] @@ -300,21 +343,23 @@ seqColor backGround c ansiColor :: Color -> Int -ansiColor c +ansiColor c = let i = fromEnum c - in if (i < 8) then 30 + i + in if (i < 8) then 30 + i else if (i < 16) then 90 + i - 8 else 39 {-------------------------------------------------------------------------- Color console code ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} -- | A color printer supports colored output data ColorPrinter = PCon ConsolePrinter | PAnsi AnsiPrinter + | PAnsiString AnsiStringPrinter | PMono MonoPrinter | PFile FilePrinter | PHTML HtmlPrinter + | PHtmlText HtmlTextPrinter -- | Use a color-enabled printer. withColorPrinter :: (ColorPrinter -> IO b) -> IO b @@ -343,43 +388,46 @@ withFileNoColorPrinter fname f -- | Is this an ANSI printer? isAnsiPrinter :: ColorPrinter -> Bool -isAnsiPrinter cp +isAnsiPrinter cp = case cp of PAnsi ansi -> True + PAnsiString ansi -> True _ -> False isConsolePrinter :: ColorPrinter -> Bool -isConsolePrinter cp +isConsolePrinter cp = case cp of PCon _ -> True _ -> False instance Printer ColorPrinter where - write p s = cmap p write write write write write s - writeLn p s = cmap p writeLn writeLn writeLn writeLn writeLn s - flush p = cmap p flush flush flush flush flush - withColor p c io = cmap p withColor withColor withColor withColor withColor c io - withBackColor p c io = cmap p withBackColor withBackColor withBackColor withBackColor withBackColor c io - withReverse p r io = cmap p withReverse withReverse withReverse withReverse withReverse r io - withUnderline p u io = cmap p withUnderline withUnderline withUnderline withUnderline withUnderline u io - setColor p c = cmap p setColor setColor setColor setColor setColor c - setBackColor p c = cmap p setBackColor setBackColor setBackColor setBackColor setBackColor c - setReverse p r = cmap p setReverse setReverse setReverse setReverse setReverse r - setUnderline p u = cmap p setUnderline setUnderline setUnderline setUnderline setUnderline u - -cmap p f g h i j + write p s = cmap p write write write write write write write s + writeLn p s = cmap p writeLn writeLn writeLn writeLn writeLn writeLn writeLn s + flush p = cmap p flush flush flush flush flush flush flush + withColor p c io = cmap p withColor withColor withColor withColor withColor withColor withColor c io + withBackColor p c io = cmap p withBackColor withBackColor withBackColor withBackColor withBackColor withBackColor withBackColor c io + withReverse p r io = cmap p withReverse withReverse withReverse withReverse withReverse withReverse withReverse r io + withUnderline p u io = cmap p withUnderline withUnderline withUnderline withUnderline withUnderline withUnderline withUnderline u io + setColor p c = cmap p setColor setColor setColor setColor setColor setColor setColor c + setBackColor p c = cmap p setBackColor setBackColor setBackColor setBackColor setBackColor setBackColor setBackColor c + setReverse p r = cmap p setReverse setReverse setReverse setReverse setReverse setReverse setReverse r + setUnderline p u = cmap p setUnderline setUnderline setUnderline setUnderline setUnderline setUnderline setUnderline u + +cmap p f g h i j k l = case p of - PCon cp -> f cp - PAnsi ap -> g ap + PCon cp -> f cp + PAnsi ap -> g ap PMono mp -> h mp PFile fp -> i fp PHTML hp -> j hp + PAnsiString as -> k as + PHtmlText ht -> l ht {-------------------------------------------------------------------------- Windows console code ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} -- | Windows console printer newtype ConsolePrinter = ConsolePrinter () @@ -391,7 +439,7 @@ instance Printer ConsolePrinter where flush p = hFlush stdout withColor p c io = Con.bracketConsole (do Con.setColor c; io) withBackColor p c io = Con.bracketConsole (do Con.setBackColor c; io) - withReverse p r io = Con.bracketConsole (do Con.setReverse r; io) + withReverse p r io = Con.bracketConsole (do Con.setReverse r; io) withUnderline p u io = Con.bracketConsole (do Con.setUnderline u; io) setColor p c = Con.setColor c setBackColor p c = Con.setBackColor c @@ -401,7 +449,7 @@ instance Printer ConsolePrinter where {-------------------------------------------------------------------------- HTML printer ---------------------------------------------------------------------------} +--------------------------------------------------------------------------} data HtmlPrinter = HtmlPrinter () withHtmlPrinter :: (HtmlPrinter -> IO a) -> IO a @@ -423,6 +471,39 @@ instance Printer HtmlPrinter where setReverse p r = return () setUnderline p u = return () + +{-------------------------------------------------------------------------- + HTML Text printer +--------------------------------------------------------------------------} +data HtmlTextPrinter = HtmlTextPrinter (Var T.Text) + +withHtmlTextPrinter :: (HtmlTextPrinter -> IO a) -> IO a +withHtmlTextPrinter f + = do + stringVar <- newVar (T.pack "") + f (HtmlTextPrinter stringVar) + +addHtml :: HtmlTextPrinter -> T.Text -> IO () +addHtml (HtmlTextPrinter stringVar) s = do + old <- takeVar stringVar + putVar stringVar (old <> s) + +instance Printer HtmlTextPrinter where + write p s = addHtml p $ T.pack $ htmlEscape s + writeText p s = addHtml p s + writeLn p s = addHtml p $ T.pack $ htmlEscape (s ++ "\n") + writeTextLn p s = addHtml p (s <> T.pack "\n") + flush p = return () + withColor p c io = htmlTextSpan p (T.pack "color") (htmlColor2 c) io + withBackColor p c io = htmlTextSpan p (T.pack "background-color") (htmlColor2 c) io + withReverse p r io = {- no supported -} io + withUnderline p u io = htmlTextSpan p (T.pack "text-decoration") (T.pack "underline") io + setColor p c = return () + setBackColor p c = return () + setReverse p r = return () + setUnderline p u = return () + + htmlSpan :: T.Text -> T.Text -> IO a -> IO a htmlSpan prop val io = do T.putStr $ T.pack " prop <> T.pack ":" <> val <> T.pack ";'>") + x <- io + addHtml p (T.pack "") + return x + htmlColor :: Color -> T.Text htmlColor c - = case c of + = case c of ColorDefault -> T.pack "black" _ -> T.toLower (T.pack $ show c) +-- VSCode sanitizes spans to only allow colors with hex codes +htmlColor2 :: Color -> T.Text +htmlColor2 c + = case c of + ColorDefault -> T.pack "#000000" + Black -> T.pack "#000000" + White -> T.pack "#ffffff" + DarkRed -> T.pack "#8B0000" + DarkGreen -> T.pack "#006400" + DarkYellow -> T.pack "#8B8000" + DarkBlue -> T.pack "#00008B" + DarkMagenta -> T.pack "#8B008B" + DarkCyan -> T.pack "#008B8B" + Gray -> T.pack "#808080" + DarkGray -> T.pack "#A9A9A9" + Red -> T.pack "#FF0000" + Green -> T.pack "#008000" + Yellow -> T.pack "#FFFF00" + Blue -> T.pack "#0000FF" + Magenta -> T.pack "#FF00FF" + Cyan -> T.pack "#00FFFF" + htmlEscape s = concatMap escape s where diff --git a/src/Main.hs b/src/Main.hs index 80914e08e..2b1d75238 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -29,6 +29,7 @@ import Interpreter.Interpret ( interpret ) import Kind.ImportMap ( importsEmpty ) import Kind.Synonym ( synonymsIsEmpty, ppSynonyms, synonymsFilter ) import Kind.Assumption ( kgammaFilter ) +import LanguageServer.Run ( runLanguageServer ) import Type.Assumption ( ppGamma, ppGammaHidden, gammaFilter, createNameInfoX, gammaNew ) import Type.Pretty ( ppScheme, Env(context,importsMap) ) @@ -53,7 +54,7 @@ mainArgs args = do (flags,flags0,mode) <- getOptions args let with = if (not (null (redirectOutput flags))) then withFileNoColorPrinter (redirectOutput flags) - else if (console flags == "html") + else if (console flags == "html") then withHtmlColorPrinter else if (console flags == "ansi") then withColorPrinter @@ -73,26 +74,28 @@ mainMode flags flags0 mode p ModeHelp -> showHelp flags p ModeVersion - -> withNoColorPrinter (\monop -> showVersion flags monop) + -> withNoColorPrinter (showVersion flags) ModeCompiler files -> mapM_ (compile p flags) files ModeInteractive files -> interpret p flags flags0 files + ModeLanguageServer files + -> runLanguageServer flags files compile :: ColorPrinter -> Flags -> FilePath -> IO () compile p flags fname = do let exec = Executable (newName "main") () - err <- compileFile term flags [] - (if (not (evaluate flags)) then (if library flags then Library else exec) else exec) fname + err <- compileFile (const Nothing) Nothing term flags [] [] + (if (not (evaluate flags)) then (if library flags then Library else exec) else exec) [] fname case checkError err of Left msg -> do putPrettyLn p (ppErrorMessage (showSpan flags) cscheme msg) -- exitFailure -- don't fail for tests - Right (Loaded gamma kgamma synonyms newtypes constructors _ imports _ - (Module modName _ _ _ _ _warnings rawProgram core _ _ modTime) _ _ _ - , warnings) + Right ((Loaded gamma kgamma synonyms newtypes constructors _ imports _ + (Module modName _ _ _ _ _warnings rawProgram core _ _ _ modTime _ _) _ _ _ + , _), warnings) -> do when (not (null warnings)) (let msg = ErrorWarning warnings ErrorZero in putPrettyLn p (ppErrorMessage (showSpan flags) cscheme msg)) diff --git a/src/Static/FixityResolve.hs b/src/Static/FixityResolve.hs index 04ca9c65f..bf8d4c302 100644 --- a/src/Static/FixityResolve.hs +++ b/src/Static/FixityResolve.hs @@ -31,7 +31,7 @@ import Common.Range import Common.Syntax import Syntax.Syntax -fixityResolve :: ColorScheme -> Fixities -> UserProgram -> Error (UserProgram,Fixities) +fixityResolve :: ColorScheme -> Fixities -> UserProgram -> Error b (UserProgram,Fixities) fixityResolve cscheme fixMap (Program source modName nameRange tdgroups defs importdefs externals fixdefs doc) = let fixMap1 = fixitiesCompose fixMap (extractFixMap fixdefs) in do defs1 <- runFixM fixMap1 (resolveDefs defs) @@ -164,7 +164,7 @@ fixitiesNew fs data FixM a = FixM (Fixities -> Res a) data Res a = Res !a ![(Range,Doc)] -runFixM :: Fixities -> FixM a -> Error a +runFixM :: Fixities -> FixM a -> Error b a runFixM fixities (FixM f) = case f fixities of Res x errors -> if null errors then return x else errorMsg (ErrorStatic errors) diff --git a/src/Syntax/Lexer.hs b/src/Syntax/Lexer.hs index 947014f72..9c01b16c5 100644 --- a/src/Syntax/Lexer.hs +++ b/src/Syntax/Lexer.hs @@ -7,6 +7,7 @@ module Syntax.Lexer( lexing, lexer , module Syntax.Lexeme , readInput, extractLiterate + , reservedNames ) where import Lib.Trace @@ -30,11 +31,11 @@ import Data.Word( Word8 ) #endif #if __GLASGOW_HASKELL__ >= 503 import Data.Array -import Data.Array.Base (unsafeAt) #else import Array #endif #if __GLASGOW_HASKELL__ >= 503 +import Data.Array.Base (unsafeAt) import GHC.Exts #else import GlaExts @@ -43,21 +44,21 @@ alex_tab_size :: Int alex_tab_size = 8 alex_base :: AlexAddr alex_base = AlexA# - "\xf8\xff\xff\xff\x6e\x00\x00\x00\x5a\x01\x00\x00\x46\x02\x00\x00\x31\x03\x00\x00\x1d\x04\x00\x00\xea\x04\x00\x00\x44\x05\x00\x00\xda\xff\xff\xff\x67\x05\x00\x00\xdb\xff\xff\xff\xdf\xff\xff\xff\xe0\xff\xff\xff\xe1\xff\xff\xff\x56\x05\x00\x00\xe2\xff\xff\xff\x5d\x00\x00\x00\xd4\x01\x00\x00\x68\x05\x00\x00\x2a\x02\x00\x00\xa8\x05\x00\x00\x21\x06\x00\x00\x61\x06\x00\x00\xf6\x00\x00\x00\x00\x07\x00\x00\xa9\x01\x00\x00\x80\x03\x00\x00\x6c\x04\x00\x00\xe4\x04\x00\x00\x19\x06\x00\x00\x30\x06\x00\x00\x10\x07\x00\x00\xef\x06\x00\x00\x9e\x00\x00\x00\x2f\x07\x00\x00\x5f\x07\x00\x00\x6a\x02\x00\x00\x9f\x07\x00\x00\xcf\x07\x00\x00\xbf\x02\x00\x00\x0f\x08\x00\x00\x3f\x08\x00\x00\x47\x03\x00\x00\x7f\x08\x00\x00\x0f\x09\x00\x00\xe6\x08\x00\x00\xab\x03\x00\x00\x26\x09\x00\x00\x66\x09\x00\x00\xf6\x09\x00\x00\x0d\x0a\x00\x00\xd4\x09\x00\x00\x14\x0a\x00\x00\x34\x0a\x00\x00\x54\x0a\x00\x00\x94\x0a\x00\x00\xb4\x0a\x00\x00\xd4\x0a\x00\x00\x14\x0b\x00\x00\x34\x0b\x00\x00\x54\x0b\x00\x00\x94\x0b\x00\x00\xb4\x0b\x00\x00\x44\x0c\x00\x00\x0b\x0c\x00\x00\x4b\x0c\x00\x00\x6b\x0c\x00\x00\xab\x0c\x00\x00\x3b\x0d\x00\x00\x52\x0d\x00\x00\x43\x0d\x00\x00\x8a\xff\xff\xff\x83\x0d\x00\x00\x8b\xff\xff\xff\xc3\x0d\x00\x00\x8c\xff\xff\xff\x03\x00\x00\x00\x03\x0e\x00\x00\x8e\xff\xff\xff\x05\x00\x00\x00\x93\x0e\x00\x00\x7a\x0e\x00\x00\x90\xff\xff\xff\x0a\x0f\x00\x00\x3b\x01\x00\x00\xc0\x01\x00\x00\xcf\x01\x00\x00\xe0\x01\x00\x00\xca\x02\x00\x00\xf1\xff\xff\xff\x00\x00\x00\x00\x37\x0f\x00\x00\x5a\x0f\x00\x00\x7d\x0f\x00\x00\x9b\x0f\x00\x00\xeb\xff\xff\xff\xef\x0f\x00\x00\x52\x00\x00\x00\x00\x00\x00\x00\x43\x10\x00\x00\x53\x00\x00\x00\x97\x10\x00\x00\xec\xff\xff\xff\xe5\x10\x00\x00\x3f\x11\x00\x00\x00\x00\x00\x00\x4f\x11\x00\x00\xa7\x03\x00\x00\xb7\x03\x00\x00\x74\x11\x00\x00\x97\x11\x00\x00\xb5\x11\x00\x00\xda\x11\x00\x00\xfd\x11\x00\x00\x00\x00\x00\x00\x20\x12\x00\x00\x43\x12\x00\x00\x66\x12\x00\x00\xa2\x12\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xff\xff\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x01\x13\x00\x00\xf4\xff\xff\xff\x0d\x00\x00\x00\xd6\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x12\x00\x00\x33\x04\x00\x00\xd5\x13\x00\x00\x2b\x14\x00\x00\x6b\x14\x00\x00\x8b\x14\x00\x00\x4e\x00\x00\x00\x62\x05\x00\x00\xcb\x14\x00\x00\xfc\xff\xff\xff\x82\x15\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x71\x15\x00\x00\xdf\x06\x00\x00\xf7\x15\x00\x00\x17\x16\x00\x00\x57\x16\x00\x00\x77\x16\x00\x00\xb7\x16\x00\x00\xff\xff\xff\xff\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x17\x00\x00\x56\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x17\x00\x00\xd6\x08\x00\x00\xe3\x17\x00\x00\x03\x18\x00\x00\x43\x18\x00\x00\x63\x18\x00\x00\xa3\x18\x00\x00\x07\x00\x00\x00\x7e\x00\x00\x00\x5a\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x19\x00\x00\xdd\x09\x00\x00\xcf\x19\x00\x00\xef\x19\x00\x00\x2f\x1a\x00\x00\x4f\x1a\x00\x00\x7f\x00\x00\x00\x8f\x1a\x00\x00\x0a\x00\x00\x00\x46\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x1b\x00\x00\x0c\x0c\x00\x00\xbb\x1b\x00\x00\xdb\x1b\x00\x00\x1b\x1c\x00\x00\x3b\x1c\x00\x00\x81\x00\x00\x00\x7b\x1c\x00\x00\xaf\x00\x00\x00"# + "\xf8\xff\xff\xff\x6e\x00\x00\x00\x5a\x01\x00\x00\x46\x02\x00\x00\x31\x03\x00\x00\x1d\x04\x00\x00\xea\x04\x00\x00\x44\x05\x00\x00\xda\xff\xff\xff\x67\x05\x00\x00\xdb\xff\xff\xff\xdf\xff\xff\xff\xe0\xff\xff\xff\xe1\xff\xff\xff\x56\x05\x00\x00\xe2\xff\xff\xff\x5d\x00\x00\x00\xd4\x01\x00\x00\x68\x05\x00\x00\x2a\x02\x00\x00\xa8\x05\x00\x00\x21\x06\x00\x00\x61\x06\x00\x00\x00\x07\x00\x00\xa9\x01\x00\x00\x80\x03\x00\x00\x6c\x04\x00\x00\xe4\x04\x00\x00\x19\x06\x00\x00\x30\x06\x00\x00\x10\x07\x00\x00\xef\x06\x00\x00\x9d\x00\x00\x00\x2f\x07\x00\x00\x5f\x07\x00\x00\xe8\x00\x00\x00\x9f\x07\x00\x00\xcf\x07\x00\x00\x6a\x02\x00\x00\x0f\x08\x00\x00\x3f\x08\x00\x00\xbf\x02\x00\x00\x7f\x08\x00\x00\x0f\x09\x00\x00\xe6\x08\x00\x00\x47\x03\x00\x00\x26\x09\x00\x00\x66\x09\x00\x00\xf6\x09\x00\x00\xbd\x09\x00\x00\xfd\x09\x00\x00\x1d\x0a\x00\x00\x3d\x0a\x00\x00\x7d\x0a\x00\x00\x9d\x0a\x00\x00\xbd\x0a\x00\x00\xfd\x0a\x00\x00\x1d\x0b\x00\x00\x3d\x0b\x00\x00\x7d\x0b\x00\x00\x9d\x0b\x00\x00\x2d\x0c\x00\x00\xf4\x0b\x00\x00\x34\x0c\x00\x00\x54\x0c\x00\x00\x94\x0c\x00\x00\x24\x0d\x00\x00\x0b\x0d\x00\x00\x4b\x0d\x00\x00\x8b\x0d\x00\x00\x01\x00\x00\x00\xcb\x0d\x00\x00\x02\x00\x00\x00\x5b\x0e\x00\x00\x42\x0e\x00\x00\xeb\xff\xff\xff\xd2\x0e\x00\x00\xc0\x01\x00\x00\xe9\x0e\x00\x00\xcf\x01\x00\x00\xe0\x01\x00\x00\xfe\x03\x00\x00\xca\x02\x00\x00\xa7\x03\x00\x00\xea\xff\xff\xff\xec\xff\xff\xff\x18\x0f\x00\x00\x3b\x0f\x00\x00\x5e\x0f\x00\x00\x7c\x0f\x00\x00\xe9\xff\xff\xff\xd0\x0f\x00\x00\x52\x00\x00\x00\x00\x00\x00\x00\x24\x10\x00\x00\x7d\x10\x00\x00\x53\x00\x00\x00\xd1\x10\x00\x00\xed\xff\xff\xff\x1f\x11\x00\x00\x79\x11\x00\x00\x00\x00\x00\x00\x89\x11\x00\x00\xb7\x03\x00\x00\xae\x11\x00\x00\x83\x04\x00\x00\x42\x05\x00\x00\xef\x11\x00\x00\x12\x12\x00\x00\xdc\x11\x00\x00\x3f\x12\x00\x00\x00\x00\x00\x00\x62\x12\x00\x00\x85\x12\x00\x00\xa8\x12\x00\x00\xe4\x12\x00\x00\xe7\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xee\xff\xff\xff\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x43\x13\x00\x00\x0d\x00\x00\x00\x18\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x13\x00\x00\x3d\x04\x00\x00\x17\x14\x00\x00\x6d\x14\x00\x00\xad\x14\x00\x00\xcd\x14\x00\x00\x2e\x00\x00\x00\x62\x05\x00\x00\x0d\x15\x00\x00\xc4\x15\x00\x00\xf0\xff\xff\xff\x00\x00\x00\x00\xb3\x15\x00\x00\xdf\x06\x00\x00\x39\x16\x00\x00\x59\x16\x00\x00\x99\x16\x00\x00\xb9\x16\x00\x00\xf9\x16\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x17\x00\x00\x4d\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x9f\x17\x00\x00\xd6\x08\x00\x00\x25\x18\x00\x00\x45\x18\x00\x00\x85\x18\x00\x00\xa5\x18\x00\x00\xe5\x18\x00\x00\x73\x00\x00\x00\x9c\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x19\x00\x00\xbe\x09\x00\x00\x11\x1a\x00\x00\x31\x1a\x00\x00\x71\x1a\x00\x00\x91\x1a\x00\x00\x75\x00\x00\x00\xd1\x1a\x00\x00\x88\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x1b\x00\x00\xf5\x0b\x00\x00\xfd\x1b\x00\x00\x1d\x1c\x00\x00\x5d\x1c\x00\x00\x7d\x1c\x00\x00\x76\x00\x00\x00\xbd\x1c\x00\x00"# alex_table :: AlexAddr alex_table = AlexA# - "\x00\x00\x7f\x00\x5a\x00\x62\x00\x72\x00\x83\x00\x7a\x00\x7b\x00\x7c\x00\x7e\x00\xbc\x00\xb0\x00\xa3\x00\xa3\x00\x94\x00\x94\x00\x84\x00\x59\x00\x5f\x00\x66\x00\x7a\x00\x7f\x00\x79\x00\x5a\x00\x59\x00\x73\x00\x78\x00\x5d\x00\x73\x00\x73\x00\x73\x00\x81\x00\x68\x00\x69\x00\x73\x00\x73\x00\x69\x00\x76\x00\x73\x00\x77\x00\x6f\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x73\x00\x69\x00\x74\x00\x73\x00\x74\x00\x73\x00\x82\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x69\x00\x73\x00\x69\x00\x73\x00\x67\x00\x88\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x69\x00\x75\x00\x69\x00\x73\x00\xa3\x00\xa3\x00\x61\x00\x64\x00\xaf\x00\x84\x00\x95\x00\x5b\x00\x94\x00\x94\x00\x06\x00\x06\x00\x5c\x00\x7e\x00\xa1\x00\xa2\x00\xa3\x00\xa3\x00\xb1\x00\xb0\x00\xbd\x00\x00\x00\x00\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa4\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa5\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x7e\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\xae\x00\xbc\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xad\x00\xaa\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xac\x00\xab\x00\xac\x00\xac\x00\xa7\x00\xa9\x00\xa9\x00\xa9\x00\xa8\x00\xb0\x00\xb1\x00\x00\x00\x55\x00\xb9\x00\x55\x00\x00\x00\x00\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x57\x00\x7e\x00\x57\x00\x00\x00\x00\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x00\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\xbb\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xb6\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb7\x00\xb8\x00\xb8\x00\xb3\x00\xb5\x00\xb5\x00\xb5\x00\xb4\x00\xbc\x00\xbd\x00\x7e\x00\x00\x00\xc5\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x00\x00\x00\x00\xc7\x00\x00\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc6\x00\xc2\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc4\x00\xc3\x00\xc4\x00\xc4\x00\xbf\x00\xc1\x00\xc1\x00\xc1\x00\xc0\x00\x88\x00\x00\x00\x00\x00\x90\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x00\x00\x00\x00\x84\x00\x84\x00\x87\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x91\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x93\x00\x00\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x92\x00\x8d\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8e\x00\x8f\x00\x8f\x00\x8a\x00\x8c\x00\x8c\x00\x8c\x00\x8b\x00\x94\x00\x94\x00\x00\x00\x00\x00\xa0\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x00\x00\x00\x00\x94\x00\x94\x00\x96\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x00\x00\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9e\x00\x9b\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9d\x00\x9c\x00\x9d\x00\x9d\x00\x98\x00\x9a\x00\x9a\x00\x9a\x00\x99\x00\x18\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x62\x00\x07\x00\x07\x00\x00\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x85\x00\x00\x00\x00\x00\x00\x00\x09\x00\x85\x00\x09\x00\x09\x00\x09\x00\x09\x00\x00\x00\x7e\x00\x72\x00\x09\x00\x09\x00\x00\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x09\x00\x07\x00\x09\x00\x09\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x07\x00\x00\x00\x07\x00\x09\x00\x0b\x00\x09\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x0b\x00\x1d\x00\x00\x00\x00\x00\x31\x00\x7e\x00\x85\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x85\x00\x1e\x00\x00\x00\x00\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x7e\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x00\x00\x07\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x07\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x00\x00\x00\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x07\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x3f\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x00\x00\x00\x00\x00\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x00\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x00\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x50\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x86\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5b\x00\x00\x00\x5b\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x5b\x00\x00\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x5c\x00\x5c\x00\x5c\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x5c\x00\x00\x00\x5c\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5b\x00\x5c\x00\x5c\x00\x5c\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x5d\x00\x00\x00\x5d\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x5c\x00\x5d\x00\x5d\x00\x5d\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x5c\x00\x00\x00\x5c\x00\x5d\x00\x00\x00\x5d\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x5e\x00\x5d\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x06\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x60\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x00\x00\x06\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x00\x00\x00\x00\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x00\x00\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x65\x00\x67\x00\x00\x00\x00\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x00\x00\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x09\x00\x00\x00\x09\x00\x09\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x09\x00\x09\x00\x00\x00\x09\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x09\x00\x09\x00\x09\x00\x09\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\x00\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x58\x00\x00\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x6d\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x54\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x73\x00\x56\x00\x73\x00\x73\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x73\x00\x73\x00\x00\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x71\x00\x73\x00\x71\x00\x73\x00\x56\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x73\x00\x73\x00\x00\x00\x73\x00\x73\x00\x00\x00\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x73\x00\x73\x00\x71\x00\x73\x00\x71\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x73\x00\x73\x00\x00\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x73\x00\x73\x00\x00\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x71\x00\x73\x00\x71\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x73\x00\x73\x00\x00\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x71\x00\x73\x00\x71\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x73\x00\x00\x00\x00\x00\x00\x00\x73\x00\x73\x00\x00\x00\x73\x00\x73\x00\x00\x00\x6f\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x6e\x00\x73\x00\x00\x00\x73\x00\x73\x00\x73\x00\x73\x00\x70\x00\x00\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x73\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x00\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x13\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x15\x00\x15\x00\x10\x00\x12\x00\x12\x00\x12\x00\x11\x00\x84\x00\x84\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x00\x00\x52\x00\x00\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x40\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x41\x00\x42\x00\x42\x00\x2d\x00\x2f\x00\x2f\x00\x2f\x00\x2e\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x51\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x94\x00\x94\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\x00\x94\x00\x00\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x00\x00\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x3c\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3d\x00\x3e\x00\x3e\x00\x29\x00\x2b\x00\x2b\x00\x2b\x00\x2a\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x3e\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\x94\x00\xa3\x00\xa3\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\x00\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\x00\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x00\x00\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x39\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3a\x00\x3b\x00\x3b\x00\x26\x00\x28\x00\x28\x00\x28\x00\x27\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x3b\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xa3\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x00\x00\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x36\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x37\x00\x38\x00\x38\x00\x23\x00\x25\x00\x25\x00\x25\x00\x24\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x38\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\x48\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xbc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x00\x00\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x33\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x34\x00\x35\x00\x35\x00\x20\x00\x22\x00\x22\x00\x22\x00\x21\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\x46\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + "\x00\x00\x7c\x00\x55\x00\x5d\x00\x6f\x00\x7f\x00\x77\x00\x78\x00\x79\x00\x7b\x00\x54\x00\x9c\x00\x8f\x00\x76\x00\x4b\x00\x58\x00\x5a\x00\x56\x00\x7c\x00\x90\x00\x62\x00\x77\x00\x57\x00\x55\x00\x54\x00\x70\x00\x75\x00\x70\x00\x70\x00\x70\x00\x70\x00\x7e\x00\x64\x00\x65\x00\x70\x00\x70\x00\x65\x00\x73\x00\x70\x00\x74\x00\x6a\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x70\x00\x65\x00\x71\x00\x70\x00\x71\x00\x70\x00\x84\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x65\x00\x70\x00\x65\x00\x70\x00\x63\x00\x8f\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5f\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x65\x00\x72\x00\x65\x00\x70\x00\x9c\x00\x9c\x00\x5c\x00\x60\x00\xa7\x00\x9a\x00\x9c\x00\x9b\x00\xa9\x00\xb4\x00\x06\x00\x06\x00\x00\x00\x7b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9d\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9e\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa3\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa4\x00\xa5\x00\xa5\x00\xa0\x00\xa2\x00\xa2\x00\xa2\x00\xa1\x00\xa8\x00\xa9\x00\x00\x00\x00\x00\xb1\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x50\x00\x7b\x00\x50\x00\x00\x00\x00\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x00\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x00\x00\x00\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xb2\x00\xae\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xb0\x00\xaf\x00\xb0\x00\xb0\x00\xab\x00\xad\x00\xad\x00\xad\x00\xac\x00\xb3\x00\xb4\x00\x7b\x00\x00\x00\xbc\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x00\x00\x00\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xbd\x00\xb9\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xbb\x00\xba\x00\xbb\x00\xbb\x00\xb6\x00\xb8\x00\xb8\x00\xb8\x00\xb7\x00\x84\x00\x00\x00\x00\x00\x8c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x00\x00\x00\x00\x80\x00\x80\x00\x83\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x8d\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x00\x00\x00\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x8e\x00\x89\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8a\x00\x8b\x00\x8b\x00\x86\x00\x88\x00\x88\x00\x88\x00\x87\x00\x8f\x00\x8f\x00\x00\x00\x53\x00\x99\x00\x53\x00\x00\x00\x00\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x8f\x00\x90\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x69\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x98\x00\x95\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x97\x00\x96\x00\x97\x00\x97\x00\x92\x00\x94\x00\x94\x00\x94\x00\x93\x00\x17\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x5d\x00\x07\x00\x07\x00\x52\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x81\x00\x00\x00\x00\x00\x51\x00\x09\x00\x81\x00\x09\x00\x09\x00\x09\x00\x09\x00\x00\x00\x7b\x00\x6f\x00\x09\x00\x09\x00\x00\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x09\x00\x07\x00\x09\x00\x09\x00\x09\x00\x09\x00\x51\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x07\x00\x00\x00\x07\x00\x09\x00\x0b\x00\x09\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x0b\x00\x1c\x00\x00\x00\x00\x00\x30\x00\x7b\x00\x81\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x81\x00\x1d\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x2f\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x7b\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x00\x00\x07\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x07\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x00\x00\x00\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x07\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x41\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x42\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x49\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x56\x00\x00\x00\x56\x00\x56\x00\x56\x00\x56\x00\x00\x00\x00\x00\x00\x00\x56\x00\x56\x00\x00\x00\x56\x00\x56\x00\x00\x00\x00\x00\x00\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x00\x00\x00\x00\x56\x00\x00\x00\x56\x00\x56\x00\x56\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x56\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x58\x00\x58\x00\x58\x00\x58\x00\x00\x00\x00\x00\x00\x00\x58\x00\x58\x00\x00\x00\x58\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x56\x00\x57\x00\x58\x00\x57\x00\x58\x00\x58\x00\x58\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x00\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x00\x00\x57\x00\x00\x00\x57\x00\x58\x00\x00\x00\x58\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x00\x00\x00\x00\x00\x00\x58\x00\x59\x00\x58\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x59\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x06\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x06\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x76\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x06\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x00\x00\x00\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x00\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x61\x00\x63\x00\x00\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x00\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x63\x00\x09\x00\x00\x00\x09\x00\x09\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x09\x00\x09\x00\x00\x00\x09\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x09\x00\x09\x00\x09\x00\x09\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x52\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x4f\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x00\x00\x00\x00\x4e\x00\x00\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x68\x00\x00\x00\x70\x00\x00\x00\x6e\x00\x70\x00\x6e\x00\x70\x00\x00\x00\x4e\x00\x4f\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x52\x00\x00\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x6b\x00\x00\x00\x51\x00\x6e\x00\x00\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x00\x00\x70\x00\x00\x00\x6e\x00\x70\x00\x6e\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x6e\x00\x70\x00\x6e\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x6e\x00\x70\x00\x6e\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x70\x00\x00\x00\x00\x00\x00\x00\x70\x00\x70\x00\x00\x00\x70\x00\x70\x00\x00\x00\x6a\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x6c\x00\x70\x00\x00\x00\x70\x00\x70\x00\x70\x00\x70\x00\x6d\x00\x00\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x00\x00\x70\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x00\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x13\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x15\x00\x15\x00\x10\x00\x12\x00\x12\x00\x12\x00\x11\x00\x80\x00\x80\x00\x00\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x00\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x3e\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x40\x00\x3f\x00\x40\x00\x40\x00\x2c\x00\x2e\x00\x2e\x00\x2e\x00\x2d\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x4a\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x80\x00\x8f\x00\x8f\x00\x00\x00\x00\x00\x48\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x8f\x00\x00\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x3a\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3b\x00\x3c\x00\x3c\x00\x28\x00\x2a\x00\x2a\x00\x2a\x00\x29\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x3c\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x47\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x8f\x00\x9c\x00\x9c\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x37\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x38\x00\x39\x00\x39\x00\x25\x00\x27\x00\x27\x00\x27\x00\x26\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x45\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x34\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x35\x00\x36\x00\x36\x00\x22\x00\x24\x00\x24\x00\x24\x00\x23\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\x44\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xa8\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x31\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x32\x00\x33\x00\x33\x00\x1f\x00\x21\x00\x21\x00\x21\x00\x20\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\x43\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# alex_check :: AlexAddr alex_check = AlexA# - "\xff\xff\x09\x00\x0a\x00\x29\x00\x29\x00\x0d\x00\x27\x00\x27\x00\x27\x00\x27\x00\x80\x00\x80\x00\x80\x00\x0a\x00\x80\x00\x0a\x00\x80\x00\x20\x00\x27\x00\x27\x00\x27\x00\x09\x00\x22\x00\x0a\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x0a\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x09\x00\x0a\x00\x27\x00\x27\x00\x0d\x00\x80\x00\x22\x00\x2a\x00\x80\x00\x0a\x00\x2f\x00\x2f\x00\x2f\x00\x27\x00\x2f\x00\x2a\x00\x80\x00\x0a\x00\x0a\x00\x80\x00\x0a\x00\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x27\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xc0\x00\x80\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x09\x00\x0a\x00\xff\xff\x2b\x00\x0d\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x80\x00\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2b\x00\x27\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x09\x00\x0a\x00\x27\x00\xff\xff\x0d\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x28\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x22\x00\xff\xff\xff\xff\xff\xff\x21\x00\x27\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x27\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x6e\x00\x5e\x00\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x27\x00\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x27\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\xff\xff\x5e\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\x7c\x00\x5f\x00\x7e\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x70\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x21\x00\x65\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x65\x00\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x21\x00\x5e\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\x2b\x00\x2c\x00\x2d\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + "\xff\xff\x09\x00\x0a\x00\x29\x00\x29\x00\x0d\x00\x27\x00\x27\x00\x27\x00\x27\x00\x20\x00\x0a\x00\x0a\x00\x22\x00\x23\x00\x23\x00\x27\x00\x2a\x00\x09\x00\x23\x00\x27\x00\x27\x00\x2f\x00\x0a\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x0a\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x0a\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x09\x00\x0a\x00\x27\x00\x27\x00\x0d\x00\x2f\x00\x0a\x00\x2a\x00\x0a\x00\x0a\x00\x2f\x00\x2f\x00\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2b\x00\x27\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x09\x00\x0a\x00\x27\x00\xff\xff\x0d\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x09\x00\x0a\x00\xff\xff\x2b\x00\x0d\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x28\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\x2e\x00\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x22\x00\xff\xff\xff\xff\x45\x00\x21\x00\x27\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x27\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x65\x00\xff\xff\xff\xff\xff\xff\x55\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x55\x00\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x6e\x00\x5e\x00\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x27\x00\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x27\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\xff\xff\x5e\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\x7c\x00\x5f\x00\x7e\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x22\x00\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\x50\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x2e\x00\x70\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x45\x00\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x5c\x00\x21\x00\x5e\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\x2b\x00\x2c\x00\x2d\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# alex_deflt :: AlexAddr alex_deflt = AlexA# - "\x80\x00\xa6\x00\xb2\x00\xbe\x00\x89\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + "\x7d\x00\x9f\x00\xaa\x00\xb5\x00\x85\x00\x91\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# -alex_accept = listArray (0 :: Int, 199) +alex_accept = listArray (0 :: Int, 189) [ AlexAccNone , AlexAccNone , AlexAccNone @@ -142,16 +143,6 @@ alex_accept = listArray (0 :: Int, 199) , AlexAccNone , AlexAccNone , AlexAccNone - , AlexAccNone - , AlexAccNone - , AlexAccNone - , AlexAccNone - , AlexAccNone - , AlexAcc 111 - , AlexAcc 110 - , AlexAcc 109 - , AlexAcc 108 - , AlexAccPred 107 (alexPrevCharMatches(\c -> c >= '\n' && c <= '\n' || False))(AlexAcc 106) , AlexAcc 105 , AlexAcc 104 , AlexAcc 103 @@ -260,122 +251,116 @@ alex_accept = listArray (0 :: Int, 199) , AlexAcc 0 ] -alex_actions = array (0 :: Int, 112) - [ (111,alex_action_0) - , (110,alex_action_1) - , (109,alex_action_2) - , (108,alex_action_3) - , (107,alex_action_4) - , (106,alex_action_19) - , (105,alex_action_5) - , (104,alex_action_5) - , (103,alex_action_6) - , (102,alex_action_6) - , (101,alex_action_7) - , (100,alex_action_8) - , (99,alex_action_8) - , (98,alex_action_9) - , (97,alex_action_9) - , (96,alex_action_10) - , (95,alex_action_11) - , (94,alex_action_11) - , (93,alex_action_12) - , (92,alex_action_12) - , (91,alex_action_13) - , (90,alex_action_14) - , (89,alex_action_15) - , (88,alex_action_15) - , (87,alex_action_16) - , (86,alex_action_17) - , (85,alex_action_18) - , (84,alex_action_19) - , (83,alex_action_19) - , (82,alex_action_19) - , (81,alex_action_19) - , (80,alex_action_19) - , (79,alex_action_20) - , (78,alex_action_21) - , (77,alex_action_22) - , (76,alex_action_23) - , (75,alex_action_24) - , (74,alex_action_25) - , (73,alex_action_25) - , (72,alex_action_26) - , (71,alex_action_27) - , (70,alex_action_27) - , (69,alex_action_27) - , (68,alex_action_27) - , (67,alex_action_28) - , (66,alex_action_29) - , (65,alex_action_30) - , (64,alex_action_31) - , (63,alex_action_32) - , (62,alex_action_33) - , (61,alex_action_33) - , (60,alex_action_33) - , (59,alex_action_33) - , (58,alex_action_33) - , (57,alex_action_33) - , (56,alex_action_33) - , (55,alex_action_33) - , (54,alex_action_33) - , (53,alex_action_33) - , (52,alex_action_33) - , (51,alex_action_34) - , (50,alex_action_35) - , (49,alex_action_36) - , (48,alex_action_37) - , (47,alex_action_37) - , (46,alex_action_37) - , (45,alex_action_37) - , (44,alex_action_37) - , (43,alex_action_37) - , (42,alex_action_37) - , (41,alex_action_37) - , (40,alex_action_37) - , (39,alex_action_37) - , (38,alex_action_38) - , (37,alex_action_39) - , (36,alex_action_40) - , (35,alex_action_41) - , (34,alex_action_41) - , (33,alex_action_42) - , (32,alex_action_42) - , (31,alex_action_42) - , (30,alex_action_42) - , (29,alex_action_42) - , (28,alex_action_42) - , (27,alex_action_42) - , (26,alex_action_42) - , (25,alex_action_42) - , (24,alex_action_42) - , (23,alex_action_43) - , (22,alex_action_44) - , (21,alex_action_45) - , (20,alex_action_45) - , (19,alex_action_45) - , (18,alex_action_45) - , (17,alex_action_45) - , (16,alex_action_45) - , (15,alex_action_45) - , (14,alex_action_45) - , (13,alex_action_45) - , (12,alex_action_45) - , (11,alex_action_46) - , (10,alex_action_47) - , (9,alex_action_48) - , (8,alex_action_48) - , (7,alex_action_48) - , (6,alex_action_48) - , (5,alex_action_48) - , (4,alex_action_48) - , (3,alex_action_48) - , (2,alex_action_48) - , (1,alex_action_48) - , (0,alex_action_48) +alex_actions = array (0 :: Int, 106) + [ (105,alex_action_0) + , (104,alex_action_1) + , (103,alex_action_2) + , (102,alex_action_3) + , (101,alex_action_4) + , (100,alex_action_5) + , (99,alex_action_5) + , (98,alex_action_6) + , (97,alex_action_6) + , (96,alex_action_7) + , (95,alex_action_8) + , (94,alex_action_8) + , (93,alex_action_8) + , (92,alex_action_9) + , (91,alex_action_9) + , (90,alex_action_10) + , (89,alex_action_11) + , (88,alex_action_11) + , (87,alex_action_12) + , (86,alex_action_12) + , (85,alex_action_13) + , (84,alex_action_13) + , (83,alex_action_14) + , (82,alex_action_14) + , (81,alex_action_14) + , (80,alex_action_15) + , (79,alex_action_16) + , (78,alex_action_17) + , (77,alex_action_18) + , (76,alex_action_18) + , (75,alex_action_18) + , (74,alex_action_18) + , (73,alex_action_18) + , (72,alex_action_19) + , (71,alex_action_20) + , (70,alex_action_21) + , (69,alex_action_22) + , (68,alex_action_23) + , (67,alex_action_24) + , (66,alex_action_24) + , (65,alex_action_25) + , (64,alex_action_26) + , (63,alex_action_26) + , (62,alex_action_26) + , (61,alex_action_27) + , (60,alex_action_28) + , (59,alex_action_29) + , (58,alex_action_30) + , (57,alex_action_31) + , (56,alex_action_32) + , (55,alex_action_32) + , (54,alex_action_32) + , (53,alex_action_32) + , (52,alex_action_32) + , (51,alex_action_32) + , (50,alex_action_32) + , (49,alex_action_32) + , (48,alex_action_32) + , (47,alex_action_32) + , (46,alex_action_33) + , (45,alex_action_34) + , (44,alex_action_35) + , (43,alex_action_35) + , (42,alex_action_35) + , (41,alex_action_35) + , (40,alex_action_35) + , (39,alex_action_35) + , (38,alex_action_35) + , (37,alex_action_35) + , (36,alex_action_35) + , (35,alex_action_36) + , (34,alex_action_37) + , (33,alex_action_38) + , (32,alex_action_39) + , (31,alex_action_39) + , (30,alex_action_40) + , (29,alex_action_40) + , (28,alex_action_40) + , (27,alex_action_40) + , (26,alex_action_40) + , (25,alex_action_40) + , (24,alex_action_40) + , (23,alex_action_40) + , (22,alex_action_40) + , (21,alex_action_41) + , (20,alex_action_42) + , (19,alex_action_43) + , (18,alex_action_43) + , (17,alex_action_43) + , (16,alex_action_43) + , (15,alex_action_43) + , (14,alex_action_43) + , (13,alex_action_43) + , (12,alex_action_43) + , (11,alex_action_43) + , (10,alex_action_44) + , (9,alex_action_45) + , (8,alex_action_46) + , (7,alex_action_46) + , (6,alex_action_46) + , (5,alex_action_46) + , (4,alex_action_46) + , (3,alex_action_46) + , (2,alex_action_46) + , (1,alex_action_46) + , (0,alex_action_46) ] -{-# LINE 203 "src/Syntax/Lexer.x" #-} +{-# LINE 216 "src/Syntax/Lexer.x" #-} ----------------------------------------------------------- -- helpers @@ -414,6 +399,11 @@ fromHexEsc :: String -> Char fromHexEsc s = toEnum $ digitsToNum 16 s +startsWith :: String -> String -> Bool +startsWith s [] = True +startsWith [] _ = False +startsWith (c:cs) (p:ps) = if (p==c) then startsWith cs ps else False + ----------------------------------------------------------- -- Reserved ----------------------------------------------------------- @@ -433,26 +423,26 @@ reservedNames , "type", "alias" , "struct", "enum", "con" , "val", "fun", "fn", "extern", "var" - , "control", "rcontrol", "except" + , "ctl", "final", "raw" , "if", "then", "else", "elif" , "return", "match", "with", "in" , "forall", "exists", "some" - , "private", "public", "abstract" + , "pub", "abstract" , "module", "import", "as" - -- alternatives - , "pub" - -- effect handlers , "handler", "handle" , "effect", "receffect" , "named" , "mask" - , "override" - , "unsafe" -- future + , "override" -- deprecated + , "private", "public" -- use pub + , "rawctl", "brk" -- use raw ctl, and final ctl + -- alternative names for backwards paper compatability + , "control", "rcontrol", "except" , "ambient", "context" -- use effcet , "inject" -- use mask , "use", "using" -- use with instead @@ -468,6 +458,7 @@ reservedNames , "." , ":" , "->" + , "<-" , ":=" , "|" ] @@ -557,6 +548,7 @@ data State = State { pos :: !Pos -- current position , previous :: !Char , current :: !BString , previousLex :: Lex + , rawEnd :: String } type Action = BString -> State -> State -> (Maybe Lex, State) @@ -604,6 +596,16 @@ withmore action = \bs st0 st1 -> action (B.concat (reverse (bs : retained st1))) st0 st1{ retained = [] } +rawdelim :: Action -> Action +rawdelim action + = \bs st0 st1 -> let s = bstringToString bs + delim = "\"" ++ replicate (length s - 2) '#' + in -- trace ("raw delim: " ++ show delim) $ + action bs st0 st1{ rawEnd = delim } + +withRawDelim :: (String -> String -> Action) -> Action +withRawDelim f + = \bs st0 st1 -> (f (bstringToString bs) (rawEnd st1)) bs st0 st1 constant x = token (\_ -> x) @@ -637,10 +639,10 @@ lexer sourceName lineNo input lexing :: Source -> Int -> BString -> [Lexeme] lexing source lineNo input = let initPos = makePos source 0 lineNo 1 - initSt = State initPos initPos [0] [] '\n' input (LexWhite "") + initSt = State initPos initPos [0] [] '\n' input (LexWhite "") "\"" in go initSt where go st = - -- trace ("scan: " ++ show (pos st) ++ ": <" ++ show (head (states st)) ++ ">: " ++ show (BC.take 5 (current st))) $ + -- trace ("scan: start: " ++ show (startPos st) ++ ", " ++ show (pos st) ++ ": <" ++ show (head (states st)) ++ ">: " ++ show (BC.take 5 (current st))) $ let idx0 = B.length (current st) in case alexScan st (head (states st)) of AlexEOF -> [] @@ -661,7 +663,7 @@ lexing source lineNo input Nothing -> go st2 -- more Just token -> let range = makeRange (startPos st) (before (pos st2)) ltoken = lparen token (previousLex st1) - in -- trace ("result: " ++ showFullRange range ++ ": " ++ show ltoken) $ + in -- trace ("token: " ++ showFullRange range ++ ": " ++ show ltoken) $ seq range $ Lexeme range ltoken : go st2{ startPos = pos st2, previousLex = ltoken } lparen token prev @@ -710,48 +712,56 @@ alex_action_8 = string $ \s -> if isReserved s alex_action_9 = string $ LexCons . newName alex_action_10 = string $ LexWildCard . newName alex_action_11 = string $ LexSpecial -alex_action_12 = string $ \s -> LexFloat (read s) s -alex_action_13 = string $ \s -> LexFloat (parseHexFloat s) s -alex_action_14 = string $ \s -> LexInt (parseNum s) s -alex_action_15 = string $ \s -> LexInt (parseNum s) s -alex_action_16 = string $ LexOp . newName -alex_action_17 = less 1 $ string $ \s -> if (s=="|") then LexKeyword s "" else LexOp (newName s) -alex_action_18 = string $ LexIdOp . newName . stripParens -alex_action_19 = string $ \s -> if isReserved s +alex_action_12 = string $ \s -> LexFloat (read (filter (/='_') s)) s +alex_action_13 = string $ \s -> LexFloat (parseHexFloat (filter (/='_') s)) s +alex_action_14 = string $ \s -> LexInt (parseNum (filter (/='_') s)) s +alex_action_15 = string $ LexOp . newName +alex_action_16 = less 1 $ string $ \s -> if (s=="|") then LexKeyword s "" else LexOp (newName s) +alex_action_17 = string $ LexIdOp . newName . stripParens +alex_action_18 = string $ \s -> if isReserved s then LexKeyword s "" else if isPrefixOp s then LexPrefix (newName s) else LexOp (newName s) -alex_action_20 = next stringlit $ more (const B.empty) -alex_action_21 = next stringraw $ more (const B.empty) -alex_action_22 = string $ LexChar . fromCharEsc . head . drop 2 -alex_action_23 = string $ LexChar . fromHexEsc . init . drop 3 -alex_action_24 = string $ LexChar . head . tail -alex_action_25 = string $ \s -> LexError ("illegal character literal: " ++ show (head (tail s))) -alex_action_26 = string $ \s -> LexError ("tab characters: configure your editor to use spaces instead (soft tab)") -alex_action_27 = string $ \s -> LexError ("illegal character: " ++ show s ++ (if (s=="\t") then " (replace tabs with spaces)" else "")) -alex_action_28 = more id -alex_action_29 = more fromCharEscB -alex_action_30 = more fromHexEscB -alex_action_31 = pop $ \_ -> withmore (string LexString . B.init) -alex_action_32 = pop $ \_ -> constant (LexError "string literal ended by a new line") -alex_action_33 = string $ \s -> LexError ("illegal character in string: " ++ show s) -alex_action_34 = more id -alex_action_35 = more B.tail -alex_action_36 = pop $ \_ -> withmore (string LexString . B.init) -alex_action_37 = string $ \s -> LexError ("illegal character in raw string: " ++ show s) -alex_action_38 = pop $ \state -> if state==comment then more id +alex_action_19 = next stringlit $ more (const B.empty) +alex_action_20 = next stringraw $ rawdelim $ more (const B.empty) +alex_action_21 = string $ LexChar . fromCharEsc . head . drop 2 +alex_action_22 = string $ LexChar . fromHexEsc . init . drop 3 +alex_action_23 = string $ LexChar . head . tail +alex_action_24 = string $ \s -> LexError ("illegal character literal: " ++ show (head (tail s))) +alex_action_25 = string $ \s -> LexError ("tab characters: configure your editor to use spaces instead (soft tab)") +alex_action_26 = string $ \s -> LexError ("illegal character: " ++ show s ++ (if (s=="\t") then " (replace tabs with spaces)" else "")) +alex_action_27 = more id +alex_action_28 = more fromCharEscB +alex_action_29 = more fromHexEscB +alex_action_30 = pop $ \_ -> withmore (string LexString . B.init) +alex_action_31 = pop $ \_ -> constant (LexError "string literal ended by a new line") +alex_action_32 = string $ \s -> LexError ("illegal character in string: " ++ show s) +alex_action_33 = more id +alex_action_34 = withRawDelim $ \s delim -> + if (s == delim) + then -- done + pop $ \_ -> less (length delim) $ withmore $ + string (LexString . reverse . drop (length delim) . reverse) + else if (length s > length delim) + then -- too many terminating hashse + string $ \s -> LexError ("raw string: too many '#' terminators in raw string (expecting " ++ show (length delim - 1) ++ ")") + else -- continue + more id + +alex_action_35 = string $ \s -> LexError ("illegal character in raw string: " ++ show s) +alex_action_36 = pop $ \state -> if state==comment then more id else withmore (string $ LexComment . filter (/='\r')) -alex_action_39 = push $ more id -alex_action_40 = more id +alex_action_37 = push $ more id +alex_action_38 = more id +alex_action_39 = more id +alex_action_40 = string $ \s -> LexError ("illegal character in comment: " ++ show s) alex_action_41 = more id -alex_action_42 = string $ \s -> LexError ("illegal character in comment: " ++ show s) -alex_action_43 = more id -alex_action_44 = pop $ \_ -> withmore (string $ LexComment . filter (/='\r')) -alex_action_45 = string $ \s -> LexError ("illegal character in line comment: " ++ show s) -alex_action_46 = more id -alex_action_47 = pop $ \_ -> withmore (string $ LexComment . filter (/='\r')) -alex_action_48 = string $ \s -> LexError ("illegal character in line directive: " ++ show s) +alex_action_42 = pop $ \_ -> withmore (string $ LexComment . filter (/='\r')) +alex_action_43 = string $ \s -> LexError ("illegal character in line comment: " ++ show s) +alex_action_44 = more id +alex_action_45 = pop $ \_ -> withmore (string $ LexComment . filter (/='\r')) +alex_action_46 = string $ \s -> LexError ("illegal character in line directive: " ++ show s) {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE @@ -778,6 +788,7 @@ alex_action_48 = string $ \s -> LexError ("illegal character in line directive: + -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) @@ -812,6 +823,7 @@ uncheckedShiftL# = shiftL# #endif {-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr :: AlexAddr -> Int# -> Int# alexIndexInt16OffAddr (AlexA# arr) off = #ifdef WORDS_BIGENDIAN narrow16Int# i @@ -821,7 +833,10 @@ alexIndexInt16OffAddr (AlexA# arr) off = low = int2Word# (ord# (indexCharOffAddr# arr off')) off' = off *# 2# #else - indexInt16OffAddr# arr off +#if __GLASGOW_HASKELL__ >= 901 + int16ToInt# +#endif + (indexInt16OffAddr# arr off) #endif @@ -829,6 +844,7 @@ alexIndexInt16OffAddr (AlexA# arr) off = {-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr :: AlexAddr -> Int# -> Int# alexIndexInt32OffAddr (AlexA# arr) off = #ifdef WORDS_BIGENDIAN narrow32Int# i @@ -842,7 +858,10 @@ alexIndexInt32OffAddr (AlexA# arr) off = b0 = int2Word# (ord# (indexCharOffAddr# arr off')) off' = off *# 4# #else - indexInt32OffAddr# arr off +#if __GLASGOW_HASKELL__ >= 901 + int32ToInt# +#endif + (indexInt32OffAddr# arr off) #endif @@ -939,16 +958,16 @@ alex_scan_tkn user__ orig_input len input__ s last_acc = check_accs (AlexAcc a ) = AlexLastAcc a input__ (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input__ (I# (len)) - check_accs (AlexAccPred a predx rest) - | predx user__ orig_input (I# (len)) input__ - = AlexLastAcc a input__ (I# (len)) - | otherwise - = check_accs rest - check_accs (AlexAccSkipPred predx rest) - | predx user__ orig_input (I# (len)) input__ - = AlexLastSkip input__ (I# (len)) - | otherwise - = check_accs rest + + + + + + + + + + data AlexLastAcc @@ -961,31 +980,31 @@ data AlexAcc user | AlexAcc Int | AlexAccSkip - | AlexAccPred Int (AlexAccPred user) (AlexAcc user) - | AlexAccSkipPred (AlexAccPred user) (AlexAcc user) -type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool --- ----------------------------------------------------------------------------- --- Predicates on a rule -alexAndPred p1 p2 user__ in1 len in2 - = p1 user__ in1 len in2 && p2 user__ in1 len in2 ---alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__ -alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__) ---alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__ ---alexRightContext :: Int -> AlexAccPred _ -alexRightContext (I# (sc)) user__ _ _ input__ = - case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of - (AlexNone, _) -> False - _ -> True - -- TODO: there's no need to find the longest - -- match when checking the right context, just - -- the first match will do. + + + + + + + + + + + + + + + + + + + + diff --git a/src/Syntax/Lexer.x b/src/Syntax/Lexer.x index 380d1ce59..38d2bfdf6 100644 --- a/src/Syntax/Lexer.x +++ b/src/Syntax/Lexer.x @@ -11,6 +11,7 @@ module Syntax.Lexer( lexing, lexer , module Syntax.Lexeme , readInput, extractLiterate + , reservedNames ) where import Lib.Trace diff --git a/src/Syntax/Parse.hs b/src/Syntax/Parse.hs index 215530c55..6aac5cf79 100644 --- a/src/Syntax/Parse.hs +++ b/src/Syntax/Parse.hs @@ -9,14 +9,14 @@ Parse concrete syntax. -} ----------------------------------------------------------------------------- -module Syntax.Parse( parseProgramFromFile +module Syntax.Parse( parseProgramFromFile, parseProgramFromString , parseValueDef , parseTypeDef , parseExpression , parseType -- used by the core parser - , lexParse, parseLex, LexParser, parseLexemes, parseInline + , lexParse, parseLex, LexParser, parseLexemes, parseInline, ignoreSyntaxWarnings , visibility, modulepath, importAlias, parseFip , tbinderId, constructorId, funid, paramid @@ -44,6 +44,7 @@ import Text.Parsec hiding (space,tab,lower,upper,alphaNum,sourceName,optional) import Text.Parsec.Error import Text.Parsec.Pos (newPos) +import Common.Error as Err import Common.Name import Common.NamePrim import Common.Range hiding (after) @@ -60,12 +61,13 @@ import Syntax.Lexeme import Syntax.Lexer ( lexing ) import Syntax.Layout ( layout ) import Syntax.Promote ( promote, promoteType, quantify, promoteFree ) +import Common.ColorScheme (defaultColorScheme) ----------------------------------------------------------- -- Parser on token stream ----------------------------------------------------------- -type LexParser a = Parsec [Lexeme] () a -- GenParser Lexeme () a +type LexParser a = Parsec [Lexeme] [(String, Range)] a -- GenParser Lexeme () a parseLex :: Lex -> LexParser Lexeme parseLex lex @@ -82,50 +84,81 @@ optional p = do { p; return True } <|> return False ----------------------------------------------------------- -- Parse varieties ----------------------------------------------------------- -parseProgramFromFile :: Bool -> FilePath -> IO (Error UserProgram) +parseProgramFromFile :: Bool -> FilePath -> IO (Error a UserProgram) parseProgramFromFile semiInsert fname = do input <- readInput fname - return (lexParse semiInsert id program fname 1 input) - - -parseValueDef :: Bool -> FilePath -> Int -> String -> Error UserDef + let result = parseProgramFromString semiInsert input fname + case checkError result of + Right (a, warnings) -> + do + logSyntaxWarnings warnings + return result + Left err -> return result + +logSyntaxWarnings :: [(Range, Doc)] -> IO () +logSyntaxWarnings warnings + = putPretty (prettyWarnings True defaultColorScheme warnings) + +parseProgramFromString :: Bool -> BString -> FilePath -> Error a UserProgram +parseProgramFromString semiInsert input fname + = do (result, syntaxWarnings) <- lexParse semiInsert id program fname 1 input + addWarnings (map (\(s, r) -> (r, text s)) syntaxWarnings) $ return result + +parseValueDef :: Bool -> FilePath -> Int -> String -> Error () UserDef parseValueDef semiInsert sourceName line input = lexParseS semiInsert (const valueDefinition) sourceName line input -parseTypeDef :: Bool -> FilePath -> Int -> String -> Error (UserTypeDef,[UserDef]) +parseTypeDef :: Bool -> FilePath -> Int -> String -> Error () (UserTypeDef,[UserDef]) parseTypeDef semiInsert sourceName line input = lexParseS semiInsert (const typeDefinition) sourceName line input -parseType :: Bool -> FilePath -> Int -> Name -> String -> Error UserTypeDef +parseType :: Bool -> FilePath -> Int -> Name -> String -> Error () UserTypeDef parseType semiInsert sourceName line name input = lexParseS semiInsert (const (userType name)) sourceName line input -parseExpression :: Bool -> FilePath -> Int -> Name -> String -> Error UserDef +parseExpression :: Bool -> FilePath -> Int -> Name -> String -> Error () UserDef parseExpression semiInsert sourceName line name input = lexParseS semiInsert (const (expression name)) sourceName line input -lexParseS semiInsert p sourceName line str - = lexParse semiInsert id p sourceName line (stringToBString str) +ignoreSyntaxWarnings :: Error b (a, [(String, Range)]) -> Error b a +ignoreSyntaxWarnings result = + do (x, syntaxWarnings) <- result + return x -lexParse :: Bool -> ([Lexeme]-> [Lexeme]) -> (Source -> LexParser a) -> FilePath -> Int -> BString -> Error a +lexParseS :: Bool -> (Source -> LexParser b) -> FilePath -> Int -> String -> Error a b +lexParseS semiInsert p sourceName line str + = do + (result, syntaxWarnings) <- (lexParse semiInsert id p sourceName line (stringToBString str)) + return $ trace (concat (intersperse "\n" (map fst syntaxWarnings))) $ result + +runStateParser :: LexParser a -> SourceName -> [Lexeme] -> Either ParseError (a, [(String, Range)]) +runStateParser p sourceName lex = + runParser (pp p) [] sourceName lex + where + pp p = + do r <- p + s <- getState + return (r, s) + +lexParse :: Bool -> ([Lexeme]-> [Lexeme]) -> (Source -> LexParser a) -> FilePath -> Int -> BString -> Error b (a, [(String, Range)]) lexParse semiInsert preprocess p sourceName line rawinput = let source = Source sourceName rawinput input = if (isLiteralDoc sourceName) then extractLiterate rawinput else rawinput xs = lexing source line input lexemes = preprocess $ layout semiInsert xs in -- trace (unlines (map show lexemes)) $ - case (parse (p source) sourceName lexemes) of + case (runStateParser (p source) sourceName lexemes) of Left err -> makeParseError (errorRangeLexeme xs source) err Right x -> return x -parseLexemes :: LexParser a -> Source -> [Lexeme] -> Error a +parseLexemes :: LexParser a -> Source -> [Lexeme] -> Error () (a, [(String, Range)]) parseLexemes p source@(Source sourceName _) lexemes - = case (parse p sourceName lexemes) of + = case (runStateParser p sourceName lexemes) of Left err -> makeParseError (errorRangeLexeme lexemes source) err Right x -> return x -makeParseError :: (ParseError -> Range) -> ParseError -> Error a +makeParseError :: (ParseError -> Range) -> ParseError -> Error b a makeParseError toRange perr = errorMsg (ErrorParse (toRange perr) errorDoc) where @@ -296,7 +329,7 @@ visibility vis = do rng <- keywordOr "pub" ["public"] return (Public,rng) <|> do rng <- keyword "private" - pwarningMessage "using 'private' is deprecated, only use 'pub' to make declarations public" + pwarningMessage "using 'private' is deprecated, only use 'pub' to make declarations public" rng return (Private,rng) <|> return (vis,rangeNull) @@ -318,7 +351,7 @@ externDecl dvis <|> try ( do (krng,_) <- dockeyword "extern" specialId "include" - warnDeprecated "include" "import" + warnDeprecated "include" "import" krng return (Left (externalImport krng))) <|> try ( do (vis,vrng) <- visibility dvis @@ -1182,9 +1215,9 @@ parseFip = do isTail <- do specialId "tail" return True <|> return False - ( do specialId "fip" + ( do rng <- specialId "fip" alloc <- parseFipAlloc - when isTail $ pwarningMessage "a 'fip' function implies already 'tail'" + when isTail $ pwarningMessage "a 'fip' function implies already 'tail'" rng return (Fip alloc) <|> do specialId "fbip" @@ -1528,13 +1561,13 @@ lambda alts return (ann fun) ifexpr - = do rng <- keyword "if" + = do rng <- do keyword "if" tst <- ntlexpr (texpr,eexprs,eexpr) <- do texpr <- returnexpr return (texpr, [], Var nameUnit False (after (getRange texpr))) <|> - do texpr <- thenexpr + do texpr <- thenexpr rng eexprs <- many elif eexpr <- do keyword "else" blockexpr @@ -1554,18 +1587,18 @@ ifexpr return fullMatch where elif - = do keyword "elif" + = do rng <- keyword "elif" tst <- ntlexpr -- parens expr - texpr <- thenexpr + texpr <- thenexpr rng return (tst,texpr) - thenexpr + thenexpr rng = do keyword "then" blockexpr <|> do pos <- getPosition expr <- blockexpr - pwarning $ "warning " ++ show pos ++ ": using an 'if' without 'then' is deprecated.\n hint: add the 'then' keyword." + pwarning ("warning " ++ show pos ++ ": using an 'if' without 'then' is deprecated.\n hint: add the 'then' keyword.") rng return expr returnexpr @@ -1730,7 +1763,7 @@ handlerOp :: LexParser (Clause, Maybe (UserExpr -> UserExpr)) handlerOp = do rng <- keyword "return" (name,prng,tp) <- do (name,prng) <- paramid - pwarningMessage "'return x' is deprecated; use 'return(x)' instead." + pwarningMessage "'return x' is deprecated; use 'return(x)' instead." prng tp <- optionMaybe typeAnnotPar return (name,prng,tp) <|> @@ -1772,9 +1805,11 @@ handlerOp <|> -- deprecated do lookAhead qidentifier - pwarningMessage "using a bare operation is deprecated.\n hint: start with 'val', 'fun', 'brk', or 'ctl' instead." - return OpControl + return OpControlErr (name, nameRng) <- qidentifier + if opSort == OpControlErr then + pwarningMessage "using a bare operation is deprecated.\n hint: start with 'val', 'fun', 'brk', or 'ctl' instead." nameRng + else return () (oppars,prng) <- opParams expr <- bodyexpr let rexpr = expr -- if (resumeKind /= ResumeTail) then expr else resumeCall expr pars nameRng @@ -1824,7 +1859,7 @@ guards return [Guard guardTrue exp] <|> do exp <- block - pwarningMessage "use '->' for pattern matches" + pwarningMessage "use '->' for pattern matches" (getRange exp) return [Guard guardTrue exp] guardBar @@ -2841,7 +2876,7 @@ specialIdOr kw deprecated = choice (specialId kw : map deprecate deprecated) where deprecate k = do rng <- specialId k - warnDeprecated k kw + warnDeprecated k kw rng return rng @@ -2851,7 +2886,7 @@ keywordOr kw deprecated = choice (keyword kw : map deprecate deprecated) where deprecate k = do rng <- keyword k - warnDeprecated k kw + warnDeprecated k kw rng return rng dockeywordOr :: String -> [String] -> LexParser (Range,String) @@ -2860,7 +2895,7 @@ dockeywordOr kw deprecated = choice (dockeyword kw : map deprecate deprecated) where deprecate k = do x <- dockeyword k - warnDeprecated k kw + warnDeprecated k kw (fst x) return x @@ -2877,18 +2912,17 @@ dockeyword s show s -warnDeprecated dep new +warnDeprecated dep new rng = do pos <- getPosition - pwarning $ "warning " ++ show pos ++ ": keyword \"" ++ dep ++ "\" is deprecated. Consider using \"" ++ new ++ "\" instead." + pwarning ("warning " ++ show pos ++ ": keyword \"" ++ dep ++ "\" is deprecated. Consider using \"" ++ new ++ "\" instead.") rng -pwarningMessage msg +pwarningMessage msg rng = do pos <- getPosition - pwarning $ "warning " ++ show pos ++ ": " ++ msg - -pwarning :: String -> LexParser () -pwarning msg = traceM msg + pwarning ("warning " ++ show pos ++ ": " ++ msg) rng +pwarning :: String -> Range -> LexParser () +pwarning msg rng = modifyState (\prev -> prev ++ [(msg, rng)]) uniqueRngHiddenName :: Range -> String -> Name diff --git a/src/Syntax/RangeMap.hs b/src/Syntax/RangeMap.hs index d1b259200..95a8626a4 100644 --- a/src/Syntax/RangeMap.hs +++ b/src/Syntax/RangeMap.hs @@ -10,7 +10,9 @@ module Syntax.RangeMap( RangeMap, RangeInfo(..), NameInfo(..) , rangeMapInsert , rangeMapSort , rangeMapLookup + , rangeMapFindAt , rangeMapAppend + , rangeInfoType , mangle , mangleConName , mangleTypeName @@ -19,7 +21,7 @@ module Syntax.RangeMap( RangeMap, RangeInfo(..), NameInfo(..) -- import Lib.Trace import Data.Char ( isSpace ) import Common.Failure -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, minimumBy) import Lib.PPrint import Common.Range import Common.Name @@ -31,6 +33,7 @@ import Type.TypeVar import Type.Pretty() newtype RangeMap = RM [(Range,RangeInfo)] + deriving Show mangleConName :: Name -> Name mangleConName name @@ -161,6 +164,23 @@ rangeMapLookup r (RM rm) eq (_,ri1) (_,ri2) = (EQ == compare ((fromEnum ri1) `div` 10) ((fromEnum ri2) `div` 10)) cmp (_,ri1) (_,ri2) = compare (fromEnum ri1) (fromEnum ri2) +rangeMapFindAt :: Pos -> RangeMap -> Maybe (Range, RangeInfo) +rangeMapFindAt pos (RM rm) + = shortestRange $ filter (containsPos . fst) rm + where + containsPos rng = rangeStart rng <= pos && rangeEnd rng >= pos + shortestRange [] = Nothing + shortestRange rs = Just $ minimumBy cmp rs + cmp (r1,_) (r2,_) = compare (rangeLength r1) (rangeLength r2) + +rangeInfoType :: RangeInfo -> Maybe Type +rangeInfoType ri + = case ri of + Id _ info _ -> case info of + NIValue tp -> Just tp + NICon tp -> Just tp + _ -> Nothing + _ -> Nothing instance HasTypeVar RangeMap where sub `substitute` (RM rm) diff --git a/src/Type/Infer.hs b/src/Type/Infer.hs index c1ce327e3..a79fe99d1 100644 --- a/src/Type/Infer.hs +++ b/src/Type/Infer.hs @@ -82,7 +82,7 @@ traceDoc fdoc = do penv <- getPrettyEnv Infer Types --------------------------------------------------------------------------} inferTypes :: Env -> Maybe RM.RangeMap -> Synonyms -> Newtypes -> Constructors -> ImportMap -> Gamma -> Name -> DefGroups Type - -> Core.CorePhase (Gamma, Core.DefGroups, Maybe RM.RangeMap ) + -> Core.CorePhase b (Gamma, Core.DefGroups, Maybe RM.RangeMap ) inferTypes prettyEnv mbRangeMap syns newTypes cons imports gamma0 context defs = -- error "Type.Infer.inferTypes: not yet implemented" -- return (gamma0,[],uniq0) @@ -1022,6 +1022,7 @@ inferHandler propagated expect handlerSort handlerScoped allowMask OpControlRaw -> let eff0 = effectExtend heff eff resumeContextTp = typeResumeContext resumeArg eff eff0 res in (nameClause "control-raw" (length pars), pars ++ [ValueBinder (newName "rcontext") (Just resumeContextTp) () hrng patRng]) + OpControlErr -> failure "Type.Infer.inferHandler: using a bare operation is deprecated.\n hint: start with 'val', 'fun', 'brk', or 'ctl' instead." -- _ -> failure $ "Type.Infer.inferHandler: unexpected resume kind: " ++ show rkind -- traceDoc $ \penv -> text "resolving:" <+> text (showPlain opName) <+> text ", under effect:" <+> text (showPlain effectName) (_,gtp,_) <- resolveFunName (if isQualified opName then opName else qualify (qualifier effectName) opName) @@ -1331,7 +1332,7 @@ inferApp propagated expect fun nargs rng cargs = [Core.Var (Core.TName var (Core.typeOf arg)) Core.InfoNone | (var,(_,arg)) <- vargs] if (Core.isTotal fcore) then return (Core.makeLet defs (coreApp fcore cargs)) - else do fname <- uniqueName "fun" + else do fname <- uniqueName "fct" let fdef = Core.DefNonRec (Core.Def fname ftp fcore Core.Private (defFun [] {-all own, TODO: maintain borrow annotations?-}) InlineAuto rangeNull "") fvar = Core.Var (Core.TName fname ftp) Core.InfoNone return (Core.Let (fdef:defs) (coreApp fvar cargs)) diff --git a/src/Type/InferMonad.hs b/src/Type/InferMonad.hs index 3b51aaa4f..6c4ab520b 100644 --- a/src/Type/InferMonad.hs +++ b/src/Type/InferMonad.hs @@ -851,7 +851,7 @@ data Env = Env{ prettyEnv :: !Pretty.Env data St = St{ uniq :: !Int, sub :: !Sub, preds :: ![Evidence], holeAllowed :: !Bool, mbRangeMap :: Maybe RangeMap } -runInfer :: Pretty.Env -> Maybe RangeMap -> Synonyms -> Newtypes -> ImportMap -> Gamma -> Name -> Int -> Inf a -> Error (a,Int,Maybe RangeMap) +runInfer :: Pretty.Env -> Maybe RangeMap -> Synonyms -> Newtypes -> ImportMap -> Gamma -> Name -> Int -> Inf a -> Error b (a,Int,Maybe RangeMap) runInfer env mbrm syns newTypes imports assumption context unique (Inf f) = case f (Env env context (newName "") False newTypes syns assumption infgammaEmpty imports False False) (St unique subNull [] False mbrm) of diff --git a/src/Type/Pretty.hs b/src/Type/Pretty.hs index 82b075f74..c3c9f302c 100644 --- a/src/Type/Pretty.hs +++ b/src/Type/Pretty.hs @@ -192,8 +192,9 @@ ppSchemeEffect env tp prettyDefFunType :: Env -> [ParamInfo] -> Scheme -> Doc prettyDefFunType env pinfos tp - = let (Just params,pre,post) = ppDeclType env pinfos tp - in pre <.> parens (commaSep (map ppParam params)) <+> text "->" <+> post + = case ppDeclType env pinfos tp of + (Just params,pre,post) -> pre <.> parens (commaSep (map ppParam params)) <+> text "->" <+> post + (Nothing,pre,post) -> pre <+> text "()" <+> text "->" <+> post where ppParam (name,pinfo,tpDoc) = (case pinfo of Borrow -> text "^" <+> (if nameNil == name then text "_" else ppName env name) <+> text ": " diff --git a/stack.yaml b/stack.yaml index b805dfb2c..ab1ae3dfc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -29,6 +29,10 @@ extra-deps: - regex-compat-0.95.2.1 # only needed for koka-test (use 0.95.1.4 for pre lts-21.0) - json-0.10 # only needed for koka-test - isocline-1.0.7 +- lsp-2.1.0.0 # only needed for language server +- lsp-types-2.0.1.0 # only needed for language server +- text-rope-0.2 # needed for lsp +- co-log-core-0.3.2.0 # needed for lsp rebuild-ghc-options: true allow-newer: true diff --git a/support/vscode/koka.language-koka/images/koka-logo-filled-blue.svg b/support/vscode/koka.language-koka/images/koka-logo-filled-blue.svg new file mode 100644 index 000000000..57dae21ba --- /dev/null +++ b/support/vscode/koka.language-koka/images/koka-logo-filled-blue.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + diff --git a/support/vscode/koka.language-koka/images/koka-logo-filled.svg b/support/vscode/koka.language-koka/images/koka-logo-filled.svg new file mode 100644 index 000000000..3e978d609 --- /dev/null +++ b/support/vscode/koka.language-koka/images/koka-logo-filled.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + diff --git a/support/vscode/koka.language-koka/package.json b/support/vscode/koka.language-koka/package.json index 38f9d28e3..aaa93d990 100644 --- a/support/vscode/koka.language-koka/package.json +++ b/support/vscode/koka.language-koka/package.json @@ -1,84 +1,223 @@ { - "name": "language-koka", - "displayName": "Koka Syntax Highlighting", - "description": "Official syntax support for the Koka programming language.", - "version": "2.0.5", - "publisher": "koka", - "engines": { - "vscode": "^1.0.0" - }, - "icon": "images/koka-logo-filled.png", - "galleryBanner": { - "color": "#293845", - "theme": "dark" - }, - "files": [ - "syntaxes/*.json", - "images/", - "README.md" - ], - "keywords": [ - "koka", - "effect", - "handler", + "name": "language-koka", + "displayName": "Koka Syntax Highlighting", + "description": "Official syntax support for the Koka programming language.", + "version": "2.4.3", + "publisher": "koka", + "engines": { + "vscode": ">=1.81.0" + }, + "icon": "images/koka-logo-filled.png", + "galleryBanner": { + "color": "#293845", + "theme": "dark" + }, + "files": [ + "syntaxes/*.json", + "images/", + "README.md" + ], + "keywords": [ + "koka", + "effect", + "handler", "koka-lang" - ], - "license": "MIT", - "homepage": "https://koka-lang.github.io", - "repository": { - "type": "git", - "url": "https://github.com/koka-lang/koka" - }, - "bugs": { - "url": "https://github.com/koka-lang/koka/issues" - }, - "categories": [ - "Programming Languages" - ], + ], + "license": "MIT", + "homepage": "https://koka-lang.github.io", + "repository": { + "type": "git", + "url": "https://github.com/koka-lang/koka" + }, + "bugs": { + "url": "https://github.com/koka-lang/koka/issues" + }, + "categories": [ + "Programming Languages", + "Debuggers" + ], + "main": "./out/extension", + "activationEvents": [ + "workspaceContains:**/*.kk" + ], "contributes": { - "configuration": { - "type": "object", - "title": "Koka configuration", - "properties": { - "koka.indentationRules.enabled": { - "type": "boolean", - "default": true, - "description": "Set to 'false' to disable automatically increasing indent on newlines after '{', 'match' etc." - } - } - }, + "languages": [ + { + "id": "koka", + "aliases": [ + "Koka", + "koka-lang" + ], + "extensions": [ + ".kk", + ".kki", + ".kkc" + ], + "configuration": "./koka-configuration.json", + "icon": { + "light": "./images/koka-logo-filled-blue.svg", + "dark": "./images/koka-logo-filled-blue.svg" + } + } + ], + "grammars": [ + { + "language": "koka", + "scopeName": "source.koka", + "path": "./syntaxes/koka.json" + } + ], + "configuration": { + "type": "object", + "title": "Koka", + "properties": { + "koka.indentationRules.enabled": { + "type": "boolean", + "default": true, + "description": "Set to 'false' to disable automatically increasing indent on newlines after '{', 'match' etc." + }, + "koka.languageServer.enabled": { + "type": "boolean", + "default": true, + "description": "Set to 'true' to enable smarter language support (e.g. hover, code completion, ...) for Koka. Requires specifying the path to the Koka compiler under 'koka.languageServer.path'." + }, + "koka.languageServer.kokaExecutable": { + "type": "string", + "default": null, + "description": "The command to launch the Koka language server (by default the extension assumes that 'koka' is on your PATH)" + }, + "koka.languageServer.additionalArgs": { + "type": "string", + "default": null, + "description": "Additional arguments to send to the compiler when starting the language server" + }, + "koka.languageServer.cwd": { + "type": "string", + "default": "", + "description": "If specified, the directory in which the language server will be executed." + }, + "koka.debugExtension": { + "type": "boolean", + "default": true, + "description": "Whether to log stdin / stdout trace information from the language server subprocess." + }, + "koka.languageServer.trace.server": { + "scope": "window", + "type": "string", + "enum": [ + "off", + "messages", + "verbose" + ], + "default": "off", + "description": "Traces the communication between VS Code and the language server." + } + } + }, "configurationDefaults": { "[koka]": { "editor.tabSize": 2, "editor.insertSpaces": true } }, - "languages": [ - { - "id": "koka", - "aliases": [ - "Koka", - "koka-lang" - ], - "extensions": [ - ".kk", - ".kki", - ".kkc" - ], - "configuration": "./koka-configuration.json" - } - ], - "grammars": [ - { - "language": "koka", - "scopeName": "source.koka", - "path": "./syntaxes/koka.json" - } - ] - }, - "scripts": { - }, - "devDependencies": { - "vscode": "^1.0.0" - } -} + "commands": [ + { + "command": "koka.restartLanguageServer", + "title": "Koka: Restart Language Server" + }, + { + "command": "koka.downloadLatest", + "title": "Koka: Download and Install Latest Version" + }, + { + "command": "koka.uninstall", + "title": "Koka: Uninstall System SDK" + }, + { + "command": "koka.startWithoutDebugging", + "title": "Koka: Run current file" + }, + { + "command": "koka.selectTarget", + "title": "Koka: Set compilation target" + }, + { + "command": "koka.selectSDK", + "title": "Koka: Set sdk path" + }, + { + "command": "koka.showLSPOutput", + "title": "Koka: Show Language Server Output" + } + ], + "debuggers": [ + { + "type": "koka", + "label": "Koka Debugger", + "runtime": "node", + "languages": [ + "koka" + ], + "configurationAttributes": { + "launch": { + "required": [ + "program" + ], + "properties": { + "program": { + "type": "string", + "description": "File to run the main function from", + "default": "${workspaceFolder}/${command:AskForProgramName}" + }, + "args": { + "type": "string", + "description": "Additional args to pass to the compiler (separate by -- to pass args to the program)" + } + } + } + }, + "initialConfigurations": [ + { + "name": "Debug Koka Program", + "type": "koka", + "request": "launch", + "program": "" + } + ], + "configurationSnippets": [ + { + "label": "Koka: Run", + "description": "Compile and run a Koka program", + "body": { + "type": "koka", + "request": "launch", + "program": "${0}", + "name": "${0}" + } + } + ], + "variables": { + "AskForProgramName": "extension.language-koka.getProgramName" + } + } + ] + }, + "scripts": { + "build": "tsc", + "watch": "tsc -w", + "package": "vsce package", + "publish": "vsce publish" + }, + "devDependencies": { + "@types/node": "^20.5.6", + "@types/vscode": "1.81.0", + "@vscode/vsce": "^2.22.0", + "typescript": "^5.2.2" + }, + "dependencies": { + "@vscode/debugadapter": "^1.61.0", + "@vscode/debugprotocol": "^1.61.0", + "await-notify": "1.0.1", + "vscode-languageclient": "^8.1.0" + } +} \ No newline at end of file diff --git a/support/vscode/koka.language-koka/src/debugger.ts b/support/vscode/koka.language-koka/src/debugger.ts new file mode 100644 index 000000000..33f0fb0f9 --- /dev/null +++ b/support/vscode/koka.language-koka/src/debugger.ts @@ -0,0 +1,267 @@ +import * as child_process from 'child_process' +import * as fs from "fs" + +import { + Logger, logger, + LoggingDebugSession, + InitializedEvent, TerminatedEvent, OutputEvent, + Thread, +} from '@vscode/debugadapter' +import { DebugProtocol } from '@vscode/debugprotocol' +import { EventEmitter } from 'events' +import { KokaConfig } from './workspace' +import { Subject } from 'await-notify' +import * as path from 'path' +import { + LanguageClient, + ExecuteCommandRequest, + ExecuteCommandParams, +} from 'vscode-languageclient/node' + +/* + * This interface describes the mock-debug specific launch attributes + * (which are not part of the Debug Adapter Protocol). + * The schema for these attributes lives in the package.json of the mock-debug extension. + * The interface should always match this schema. + */ +interface LaunchRequestArguments extends DebugProtocol.LaunchRequestArguments { + /** An absolute path to the "program" to debug. */ + program: string + /** Additional arguments */ + args?: string + /** enable logging the Debug Adapter Protocol */ + trace?: boolean +} + +export class KokaDebugSession extends LoggingDebugSession { + + // we don't support multiple threads, so we can use a hardcoded ID for the default thread + private static THREAD_ID = 1 + + private _configurationDone = new Subject() + + private _runtime: KokaRuntime + /** + * Creates a new debug adapter that is used for one debug session. + * We configure the default implementation of a debug adapter here. + */ + + + public constructor(private readonly config: KokaConfig, private readonly client: LanguageClient) { + super("koka-debug.txt") + + // this debugger uses zero-based lines and columns + this.setDebuggerLinesStartAt1(false) + this.setDebuggerColumnsStartAt1(false) + + this._runtime = new KokaRuntime(config, client) + + // setup event handlers + this._runtime.on('output', (text, category) => { + const e: DebugProtocol.OutputEvent = new OutputEvent(`${text}\n`) + e.body.category = category + + this.sendEvent(e) + }) + this._runtime.on('end', () => { + this.sendEvent(new TerminatedEvent()) + }) + } + + /** + * The 'initialize' request is the first request called by the frontend + * to interrogate the features the debug adapter provides. + */ + protected initializeRequest(response: DebugProtocol.InitializeResponse, args: DebugProtocol.InitializeRequestArguments): void { + + // build and return the capabilities of this debug adapter: + response.body = response.body || {} + + // the adapter implements the configurationDoneRequest. + response.body.supportsConfigurationDoneRequest = true + + // make VS Code not use 'evaluate' when hovering over source + response.body.supportsEvaluateForHovers = false + + // make VS Code not show a 'step back' button + response.body.supportsStepBack = false + + // make VS Code not support data breakpoints + response.body.supportsDataBreakpoints = false + + // make VS Code not support completion in REPL + response.body.supportsCompletionsRequest = false + response.body.completionTriggerCharacters = [] + + // make VS Code send cancelRequests + response.body.supportsCancelRequest = true + response.body.supportsTerminateRequest = true + + // make VS Code not send the breakpointLocations request + response.body.supportsBreakpointLocationsRequest = false + + this.sendResponse(response) + + // we request configurations early by sending an 'initializeRequest' to the frontend. + // The frontend will end the configuration sequence by calling 'configurationDone' request. + this.sendEvent(new InitializedEvent()) + } + + /** + * Called at the end of the configuration sequence. + * Indicates that all breakpoints etc. have been sent to the DA and that the 'launch' can start. + */ + protected configurationDoneRequest(response: DebugProtocol.ConfigurationDoneResponse, args: DebugProtocol.ConfigurationDoneArguments): void { + super.configurationDoneRequest(response, args) + + // notify the launchRequest that configuration has finished + this._configurationDone.notify() + } + + protected async launchRequest(response: DebugProtocol.LaunchResponse, args: LaunchRequestArguments) { + + // make sure to 'Stop' the buffered logging if 'trace' is not set + logger.setup(args.trace ? Logger.LogLevel.Verbose : Logger.LogLevel.Stop, false) + + // wait until configuration has finished (and configurationDoneRequest has been called) + // No configuration of breakpoints etc is currently supported so set a low timeout + await this._configurationDone.wait(1) + + // start the program in the runtime + this._runtime.start(args) + + this.sendResponse(response) + } + + protected threadsRequest(response: DebugProtocol.ThreadsResponse): void { + + // debug runtime supports no threads so just return a default thread. + response.body = { + threads: [ + new Thread(KokaDebugSession.THREAD_ID, "main thread") + ] + } + this.sendResponse(response) + } + + protected async terminateRequest(response: DebugProtocol.TerminateResponse, args: DebugProtocol.TerminateArguments, request?: DebugProtocol.Request) { + await this._runtime.cancel() + response.success = true + response.message = "terminated" + this.sendResponse(response) + } + + protected async cancelRequest(response: DebugProtocol.CancelResponse, args: DebugProtocol.CancelArguments) { + await this._runtime.cancel() + response.success = true + response.message = "cancelled" + this.sendResponse(response) + } +} + +class KokaRuntime extends EventEmitter { + + constructor(private readonly config: KokaConfig, private readonly client: LanguageClient) { + super() + } + ps?: child_process.ChildProcess | null + + public async start(args: LaunchRequestArguments) { + const target = this.config.target + let compilerTarget + switch (target) { + case 'C': + compilerTarget = 'c' + break + case 'JS': + compilerTarget = 'js' + break + case 'WASM': + compilerTarget = 'wasm' + break + case 'C#': + compilerTarget = 'cs' + break + default: + compilerTarget = 'c' + break + } + // Args that are parsed by the compiler are in the args field. This leaves the rest of the object open for + let additionalArgs = "--target=" + compilerTarget + if (args.args) { + additionalArgs = additionalArgs + " " + args.args + } + try { + const resp = await this.client.sendRequest(ExecuteCommandRequest.type, { command: 'koka/genCode', arguments: [args.program, additionalArgs] }) + console.log(`Generated code at ${resp}`) + if (!resp) { + this.emit('output', `Error generating code, see language server output for specifics`, 'stderr') + this.emit('end', -1) + return; + } + if (!fs.existsSync(path.join(this.config.cwd, resp))) { + console.log(`Error finding code at ${resp}`) + this.emit('end', -1) + return; + } + if (target == 'C') { + // console.log(`Executing ${this.config.command} -e ${file} -i${this.config.cwd}`) + this.ps = child_process.spawn(resp, [], { cwd: this.config.cwd, env: process.env }) + this.ps.stdout?.on('data', (data) => { + this.emit('output', data.toString().trim(), 'stdout') + }) + this.ps.stderr?.on('data', (data) => { + this.emit('output', data.toString().trim(), 'stderr') + }) + this.ps.on('close', (code) => { + this.emit('end', code) + this.ps = null + }) + } + // else if (target == 'JS' || target == 'WASM') { + // const realTarget = target == 'JS' ? 'jsweb' : 'wasmweb' + // // TODO: Better configuration for wasm / js build outputs + // const webBuildDir = path.join(this.config.cwd, 'web', 'build') + // console.log(`Executing ${this.config.command} --target=${realTarget} ${file} -i${this.config.cwd} --outputdir=${webBuildDir}`) + // this.ps = child_process.exec(`${this.config.command} --target=${realTarget} ${file} -i${this.config.cwd} --outputdir=${webBuildDir}`, (exitCode, stdout, stderr) => { + // // TODO: separate output streams for compile versus running? + // if (stdout) { + // this.emit('output', stdout, 'stdout') + // } + // if (stderr) { + // this.emit('output', stderr, 'stderr') + // } + // if (exitCode) { + // this.emit('output', `Compiler exited with error status ${exitCode}`, 'stderr') + // this.emit('end') + // } else { + // this.emit('output', `Compiler exited succesfully`, 'stdout') + // this.emit('end') + // } + // }) + // } else { + // // TODO: Support C# + // this.emit('end') + // } + + } catch (e) { + this.emit('output', `Error generating code: ${e}`, 'stderr') + this.emit('end', -1) + } + } + + public async cancel() { + if (this.ps) { + const result = await this.ps.kill() + if (!result) { + console.log("Escalating process kill to SIGKILL") + await this.ps.kill(9) + } + this.ps = null + this.emit('output', `Compile was cancelled`, 'stdout') + this.emit('end', 1) + } else { + console.log("No process to cancel?") + } + } +} \ No newline at end of file diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts new file mode 100644 index 000000000..7ac831eb1 --- /dev/null +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -0,0 +1,365 @@ +import * as vscode from 'vscode' +import * as path from 'path' +import * as child_process from 'child_process' + +import { + LanguageClient, + LanguageClientOptions, + RevealOutputChannelOn, + StreamInfo, +} from 'vscode-languageclient/node' + +import { KokaConfig, downloadSDK, scanForSDK, uninstallSDK } from './workspace' +import { CancellationToken, CodeLens, DebugConfiguration, DebugConfigurationProvider, EventEmitter, ProviderResult, TextDocument, WorkspaceFolder } from 'vscode' +import { KokaDebugSession } from './debugger' +import { AddressInfo, Server, createServer } from 'net' + +let stderrOutputChannel: vscode.OutputChannel +let stdoutOutputChannel: vscode.OutputChannel +let languageServer: KokaLanguageServer; + +export async function activate(context: vscode.ExtensionContext) { + const vsConfig = vscode.workspace.getConfiguration('koka') + // We can always create the client, as it does nothing as long as it is not started + console.log(`Koka: language server enabled ${vsConfig.get('languageServer.enabled')}`) + const { sdkPath, allSDKs } = scanForSDK(vsConfig) + const config = new KokaConfig(vsConfig, sdkPath, allSDKs) + if (!config.command) { + vscode.window.showInformationMessage(`Koka SDK found but not working ${config.sdkPath}\n All SDKs: ${allSDKs}`) + return + } + if (config.debugExtension) { + stderrOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stderr') + stdoutOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stdout') + context.subscriptions.push(stderrOutputChannel) + context.subscriptions.push(stdoutOutputChannel) + } + languageServer = new KokaLanguageServer() + if (vsConfig.get('languageServer.enabled')) { + await languageServer.start(config, context) + } + createCommands(context, vsConfig, config) + + // Debug Adaptor stuff + context.subscriptions.push(vscode.commands.registerCommand('extension.language-koka.getProgramName', c => { + return vscode.window.showInputBox({ + placeHolder: "Please enter the name of a koka file in the workspace folder", + value: path.relative(config.cwd, vscode.window.activeTextEditor?.document.fileName || '') || 'test.kk' + }) + })) + + // register a configuration provider for 'koka' debug type + const provider = new KokaRunConfigurationProvider() + context.subscriptions.push(vscode.debug.registerDebugConfigurationProvider('koka', provider)) + + // debug adapters can be run in different ways by using a vscode.DebugAdapterDescriptorFactory: + // run the debug adapter as a separate process + let factory = new InlineDebugAdapterFactory(config) + + context.subscriptions.push(vscode.debug.registerDebugAdapterDescriptorFactory('koka', factory)) + + + const codeLensProvider = new MainCodeLensProvider(config) + context.subscriptions.push(vscode.languages.registerCodeLensProvider({ language: "koka", scheme: "file" }, codeLensProvider)) +} + +class KokaLanguageServer { + languageClient?: LanguageClient + languageServerProcess?: child_process.ChildProcess + socketServer?: Server + outputChannel?: vscode.OutputChannel + lspWriteEmitter: vscode.EventEmitter = new vscode.EventEmitter(); + lspPty?: vscode.Pseudoterminal + lspTerminal?: vscode.Terminal + + showOutputChannel() { + if (!this.lspTerminal?.exitStatus) { + this.outputChannel?.show() + } else if (this.lspPty) { + this.lspTerminal = vscode.window.createTerminal({ + name: 'Koka Language Server', + pty: this.lspPty, + isTransient: true + }) + this.lspTerminal.show() + } + } + + async start(config: KokaConfig, context: vscode.ExtensionContext) { + console.log(`Koka: Language Server ${config.command} ${config.langServerArgs.join(" ")} Workspace: ${config.cwd}`) + let self = this; + function serverOptions(): Promise { + return new Promise((resolve, reject) => { + let timeout = setTimeout(() => { + reject("Server took too long to connect") + }, 3000) + self.socketServer = createServer((s) => { + console.log("Got Connection to Client") + clearTimeout(timeout) + resolve({ writer: s, reader: s }) + }).listen(0, "127.0.0.1", () => { + const port = (self.socketServer!.address() as AddressInfo).port + console.log(`Starting language server in ${config.cwd} on port ${port}`) + self.languageServerProcess = child_process.spawn(config.command, [...config.langServerArgs, `--lsport=${port}`], { + cwd: config.cwd, + env: process.env, + }) + if (config.debugExtension) { + self.languageServerProcess?.stderr?.on('data', (data) => { + stderrOutputChannel.append(`${data.toString()}`) + }) + self.languageServerProcess?.stdout?.on('data', (data) => { + stdoutOutputChannel.append(`${data.toString()}`) + }) + } + }) + }) + } + // This issue: https://github.com/microsoft/vscode/issues/571 + // This sample: https://github.com/ShMcK/vscode-pseudoterminal/blob/master/src/extension.ts + this.lspPty = { + onDidWrite: (listener) => this.lspWriteEmitter.event((e) => listener(e.replace('\r\n', '\n').replace('\n', '\r\n'))), + open: () => { }, + close: () => { } + }; + this.lspTerminal = vscode.window.createTerminal({ + name: 'Koka Language Server', + pty: this.lspPty, + isTransient: true + }) + this.outputChannel = { + name: 'Koka Language Server', + append: (value: string) => this.lspWriteEmitter.fire(value), + appendLine: (value: string) => { + this.lspWriteEmitter.fire(value) + this.lspWriteEmitter.fire('\r\n') + }, + clear: () => { + this.lspWriteEmitter.fire("\x1b[2J\x1b[3J\x1b[;H") + }, + show: () => this.lspTerminal?.show(), + hide: () => this.lspTerminal?.hide(), + dispose: () => { + this.lspTerminal?.dispose() + this.lspWriteEmitter.dispose() + this.lspPty?.close() + }, + replace: (v) => { + this.lspWriteEmitter.fire("\x1b[2J\x1b[3J\x1b[;H") + this.lspWriteEmitter.fire(v) + }, + + }; + const clientOptions: LanguageClientOptions = { + documentSelector: [{ language: 'koka', scheme: 'file' }], + outputChannel: this.outputChannel, + revealOutputChannelOn: RevealOutputChannelOn.Never, + markdown: { + isTrusted: true, + supportHtml: true, + } + } + this.languageClient = new LanguageClient( + 'Koka Language Client', + serverOptions, + clientOptions, + ) + context.subscriptions.push(this) + + return await this.languageClient.start() + } + + async dispose() { + try { + await this.languageClient?.stop() + await this.languageClient?.dispose() + const result = this.languageServerProcess?.kill('SIGINT') + if (!result) { + console.log("Failed to end language server with SIGINT, trying SIGTERM") + this.languageServerProcess?.kill() + } + this.socketServer?.close() + // TODO: Does the terminal need to be disposed or is that handled by disposing the client + } catch { + // Ignore for now, the process should automatically die when the server / client closes the connection + } + } +} + +export async function deactivate() { +} + +function createCommands( + context: vscode.ExtensionContext, + config: vscode.WorkspaceConfiguration, + kokaConfig: KokaConfig, +) { + context.subscriptions.push( + vscode.commands.registerCommand('koka.startWithoutDebugging', (resource: vscode.Uri) => { + const launchConfig = + { + name: `koka run: ${resource.path}`, + request: "launch", + type: "koka", + program: resource.fsPath, + } + console.log(`Launch config ${launchConfig}`) + vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) + }), + vscode.commands.registerCommand('koka.downloadLatest', (resource: vscode.Uri) => { + downloadSDK() + }), + vscode.commands.registerCommand('koka.uninstall', (resource: vscode.Uri) => { + uninstallSDK() + }), + vscode.commands.registerCommand('koka.restartLanguageServer', () => { + if (!config.get('languageServer.enabled')) + return vscode.window.showErrorMessage('Language server is not enabled') + + vscode.window.withProgress( + { + location: vscode.ProgressLocation.Notification, + title: 'Koka', + cancellable: false, + }, + async (progress, token) => { + progress.report({ message: 'Restarting language server' }) + await languageServer.dispose() + const languageServerIdx = context.subscriptions.indexOf(languageServer) + if (languageServerIdx != -1) { + context.subscriptions.splice(languageServerIdx, 1) + } + + const { sdkPath, allSDKs } = scanForSDK(config) + const newConfig = new KokaConfig(config, sdkPath, allSDKs) + languageServer = new KokaLanguageServer() + await languageServer.start(newConfig, context) + + progress.report({ + message: 'Language server restarted', + increment: 100, + }) + // Wait 2 seconds to allow user to read message + await new Promise((resolve) => setTimeout(resolve, 2000)) + }, + ) + vscode.window.createQuickPick + }), + vscode.commands.registerCommand('koka.selectSDK', async () => { + const { sdkPath, allSDKs } = scanForSDK(config) + kokaConfig.allSDKs = allSDKs + const result = await vscode.window.showQuickPick(kokaConfig.allSDKs) + if (result) kokaConfig.selectSDK(result) + selectSDKMenuItem.tooltip = `${kokaConfig.sdkPath}` + await vscode.commands.executeCommand('koka.restartLanguageServer') + }), + vscode.commands.registerCommand('koka.selectTarget', async () => { + const result = await vscode.window.showQuickPick(['C', 'WASM', 'JS', 'C#']) + if (result) kokaConfig.selectTarget(result) + selectCompileTarget.text = `Koka Backend: ${kokaConfig.target}` + }), + vscode.commands.registerCommand('koka.showLSPOutput', async () => { + languageServer.showOutputChannel() + }) + ) + + // create a new status bar item that we can now manage + const selectSDKMenuItem = vscode.window.createStatusBarItem(vscode.StatusBarAlignment.Right, 100) + selectSDKMenuItem.command = 'koka.selectSDK' + context.subscriptions.push(selectSDKMenuItem) + selectSDKMenuItem.show() + selectSDKMenuItem.text = `Koka SDK` + selectSDKMenuItem.tooltip = `${kokaConfig.sdkPath}` + + // create a new status bar item that we can now manage + const selectCompileTarget = vscode.window.createStatusBarItem(vscode.StatusBarAlignment.Right, 100) + selectCompileTarget.command = 'koka.selectTarget' + context.subscriptions.push(selectCompileTarget) + selectCompileTarget.show() + selectCompileTarget.text = `Koka Backend: ${kokaConfig.target}` + +} + + +class KokaRunConfigurationProvider implements DebugConfigurationProvider { + + /** + * Massage a debug configuration just before a debug session is being launched, + * e.g. add all missing attributes to the debug configuration. + */ + resolveDebugConfiguration(folder: WorkspaceFolder | undefined, config: DebugConfiguration, token?: CancellationToken): ProviderResult { + // if launch.json is missing or empty + if (!config.type && !config.request && !config.name) { + const editor = vscode.window.activeTextEditor + if (editor && editor.document.languageId === 'koka') { + config.type = 'koka' + config.name = 'Launch' + config.request = 'launch' + config.program = '${file}' + config.stopOnEntry = true + } + } + + if (!config.program) { + return vscode.window.showInformationMessage("Cannot find a program to debug").then(_ => { + return undefined // abort launch + }) + } + + return config + } +} + +class InlineDebugAdapterFactory implements vscode.DebugAdapterDescriptorFactory { + + constructor(private readonly config: KokaConfig) { } + + createDebugAdapterDescriptor(_session: vscode.DebugSession): ProviderResult { + if (languageServer.languageClient) + return new vscode.DebugAdapterInlineImplementation(new KokaDebugSession(this.config, languageServer.languageClient)) + } +} + + +class MainCodeLensProvider implements vscode.CodeLensProvider { + private onDidChangeCodeLensesEmitter: EventEmitter = new EventEmitter() + + constructor(private readonly config: KokaConfig) { } + + public async provideCodeLenses(document: TextDocument, token: CancellationToken): Promise { + const doc = document.getText() + const main = doc.indexOf('\nfun main') + if (main < 0) { + if (doc.startsWith('fun main')) { + return [this.createCodeLens(document, 0)] + } else { + const main1 = doc.indexOf(`\npub fun main`) + if (main1 < 0) { + if (doc.startsWith('pub fun main')) { + return [this.createCodeLens(document, 0)] + } + return [] + } else { + return [this.createCodeLens(document, main1 + 1)] + } + } + } + return [this.createCodeLens(document, main + 1)] + } + + private createCodeLens(document: TextDocument, offset: number): CodeLens { + return new CodeLens( + toRange(document, offset, 'main'.length), + { + arguments: [document.uri], + command: "koka.startWithoutDebugging", + title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)}`, + } + ) + } + +} + +function toRange(document: TextDocument, offset: number, length: number): vscode.Range { + return new vscode.Range(document.positionAt(offset), document.positionAt(offset + length)) +} \ No newline at end of file diff --git a/support/vscode/koka.language-koka/src/workspace.ts b/support/vscode/koka.language-koka/src/workspace.ts new file mode 100644 index 000000000..4e37380ad --- /dev/null +++ b/support/vscode/koka.language-koka/src/workspace.ts @@ -0,0 +1,146 @@ +import * as path from "path" +import * as fs from "fs" +import * as vs from "vscode" +import * as os from "os" +import * as vscode from "vscode" +import * as child_process from "child_process" + +interface SDKs { sdkPath: string, allSDKs: string[] } +const kokaExeName = os.platform() === "win32" ? "koka.exe" : "koka" + +const home = os.homedir(); +export function scanForSDK(config: vscode.WorkspaceConfiguration): SDKs | undefined { + const processPath = (process.env.PATH as string) || "" + const paths = processPath.split(path.delimiter).filter((p) => p) + + const dev = path.join(home, 'koka') + let defaultSDK = "" + let allSDKs = [] + if (fs.existsSync(dev)) { + + let command = 'stack path --local-install-root' + const ghc = `${home}/.ghcup/env` + if (fs.existsSync(ghc)) { + // Linux ghcup installation does not show up in vscode's process.PATH, + // ensure stack uses the correct ghc by sourcing the ghcup env script + command = `${process.env.SHELL} -c "source ${ghc} && stack path --local-install-root"` + } + + const options = { cwd: dev, env: process.env } + const result = child_process.execSync(command, options) + const devPath = result.toString().trim(); + // Prioritize dev + const sdkPath = path.join(devPath, 'bin', kokaExeName) + if (fs.existsSync(sdkPath)) { + vs.window.showInformationMessage("Koka dev SDK found!") + console.log("Koka: Using dev build of koka at " + devPath) + defaultSDK = sdkPath + allSDKs.push(defaultSDK) + } else { + vs.window.showInformationMessage("Koka dev environment found, but no built SDK") + } + } + + const local = path.join(home, '.local/bin') + for (const p of [local].concat(paths)) { + if (fs.existsSync(path.join(p, kokaExeName))) { + console.log("Koka: Found build of koka at " + p) + const sdkPath = path.join(p, kokaExeName) + allSDKs.push(sdkPath) + if (defaultSDK === "") { + vs.window.showInformationMessage(`Using Koka SDK at ${p}`) + defaultSDK = sdkPath + } + } + } + if (defaultSDK === "" && !config.get('languageServer.kokaExecutable')) { + console.log('Koka: No Koka SDK found') + vs.window.showWarningMessage("Koka SDK not found on path or in ~/.local/bin") + downloadSDK() + } + return { sdkPath: defaultSDK, allSDKs: allSDKs } +} + +export async function downloadSDK() { + const decision = await vscode.window.showInformationMessage( + `Download and Install the lastest Koka, continue?`, + { modal: true }, + 'Yes', + 'No' + ) + if (decision == 'No'){ + return + } + let command = "curl -sSL https://github.com/koka-lang/koka/releases/latest/download/install.sh | sh" + if (os.platform() === "win32") { + command = "curl -sSL -o %tmp%\install-koka.bat https://github.com/koka-lang/koka/releases/latest/download/install.bat && %tmp%\install-koka.bat" + } + const term = vscode.window.createTerminal({name: "Install Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Installing Koka, restart your editor when finished"}) + term.sendText(command) + term.show() +} + +export async function uninstallSDK() { + const decision = await vscode.window.showInformationMessage( + `Uninstall the system Koka installation, continue?`, + { modal: true }, + 'Yes', + 'No' + ) + if (decision == 'No'){ + return + } + let command = "curl -sSL https://github.com/koka-lang/koka/releases/latest/download/install.sh | sh -s -- -u -f" + if (os.platform() === "win32") { + command = "curl -sSL -o %tmp%\install-koka.bat https://github.com/koka-lang/koka/releases/latest/download/install.bat && %tmp%\install-koka.bat -u -f" + } + const term = vscode.window.createTerminal({name: "Uninstall Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Uninstalling Koka, you can close the terminal when done"}) + term.sendText(command) + term.show() +} + +const DefaultShellPath = os.platform() === "win32" ? "C:\Windows\System32\cmd.exe" : null + +export class KokaConfig { + constructor(config: vscode.WorkspaceConfiguration, sdkPath: string, allSDKs: string[]) { + this.config = config + this.debugExtension = config.get('debugExtension') as boolean + this.defaultSDK = sdkPath + this.sdkPath = config.get('languageServer.kokaExecutable') as string || sdkPath + this.allSDKs = allSDKs + this.cwd = config.get('languageServer.cwd') as string || vscode.workspace.workspaceFolders![0].uri.fsPath + this.langServerArgs = [] + this.additionalArgs = config.get('languageServer.additionalArgs') as string[] || [] + this.selectSDK(this.sdkPath) + this.target = "C" + } + defaultSDK: string + sdkPath: string + allSDKs: string[] + config: vscode.WorkspaceConfiguration + debugExtension: boolean + command?: string | null + langServerArgs: string[] + additionalArgs: string[] + target: string + cwd: string + + selectSDK(path: string) { + if (!fs.existsSync(path)) { + console.log(`Koka executable not found at this location ${path}`) + this.command = null + return + } + // Test we can execute the sdk command + fs.accessSync(path, fs.constants.X_OK) + this.command = this.sdkPath + this.langServerArgs = ["--language-server", `-i${this.cwd}`, ...this.additionalArgs] + } + + selectTarget(t: string) { + if (!["C", "JS", "WASM", "C#"].includes(t)) { + return + } + this.target = t + } +} \ No newline at end of file diff --git a/support/vscode/koka.language-koka/tsconfig.json b/support/vscode/koka.language-koka/tsconfig.json new file mode 100644 index 000000000..3cae2e758 --- /dev/null +++ b/support/vscode/koka.language-koka/tsconfig.json @@ -0,0 +1,17 @@ +{ + "compilerOptions": { + "module": "commonjs", + "target": "es2020", + "lib": [ + "es2020" + ], + "outDir": "out", + "sourceMap": true, + "strict": false, + "rootDir": "src" + }, + "exclude": [ + "node_modules", + ".vscode-test" + ] +} \ No newline at end of file diff --git a/util/install.bat b/util/install.bat index d337f5331..7f52eb483 100644 --- a/util/install.bat +++ b/util/install.bat @@ -4,7 +4,7 @@ rem Installation script for Koka; use -h to see command line options. rem ------------------------------------------------------------------ setlocal -set KOKA_VERSION=v2.4.2 +set KOKA_VERSION=v2.4.3 set KOKA_PREFIX=%LOCALAPPDATA%\koka set KOKA_UNINSTALL=N set KOKA_HELP=N diff --git a/util/install.sh b/util/install.sh index 0e3e5ddfc..80e9de862 100755 --- a/util/install.sh +++ b/util/install.sh @@ -4,7 +4,7 @@ # Installation script for Koka; use -h to see command line options. #----------------------------------------------------------------------------- -VERSION="v2.4.2" +VERSION="v2.4.3" MODE="install" # or uninstall PREFIX="/usr/local" QUIET="" From db0bad6122851327c9794202d70b5f4c7e5eb90b Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Mon, 4 Dec 2023 19:58:29 -0700 Subject: [PATCH 02/37] better type environment for pretty --- src/LanguageServer/Handler/Hover.hs | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/src/LanguageServer/Handler/Hover.hs b/src/LanguageServer/Handler/Hover.hs index 54613da07..dd8bf5268 100644 --- a/src/LanguageServer/Handler/Hover.hs +++ b/src/LanguageServer/Handler/Hover.hs @@ -6,7 +6,7 @@ module LanguageServer.Handler.Hover (hoverHandler, formatRangeInfoHover) where -import Compiler.Module (loadedModule, modRangeMap, Loaded (loadedModules), Module (modPath, modSourcePath)) +import Compiler.Module (loadedModule, modRangeMap, Loaded (loadedModules, loadedImportMap), Module (modPath, modSourcePath)) import Control.Lens ((^.)) import qualified Data.Map as M import qualified Data.Text as T @@ -23,23 +23,28 @@ import Type.Pretty (ppScheme, defaultEnv, Env(..)) import Common.ColorScheme (ColorScheme (colorNameQual)) import Kind.Pretty (prettyKind) import Common.Name (nameNil) -import Kind.ImportMap (importsEmpty) +import Kind.ImportMap (importsEmpty, ImportMap) import Compiler.Options (Flags, colorSchemeFromFlags, prettyEnvFromFlags) +import Compiler.Compile (modName) +import Type.Type (Name) hoverHandler :: Handlers LSM hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do let J.HoverParams doc pos _ = req ^. J.params uri = doc ^. J.uri - loaded <- getLoadedModule uri + loadedMod <- getLoadedModule uri + loaded <- getLoaded flags <- getFlags let res = do + mod <- loadedMod l <- loaded - rmap <- modRangeMap l - rangeMapFindAt (fromLspPos uri pos) rmap + rmap <- modRangeMap mod + (r, rinfo) <- rangeMapFindAt (fromLspPos uri pos) rmap + return (modName mod, loadedImportMap l, r, rinfo) case res of - Just (r, rinfo) -> do + Just (mName, imports, r, rinfo) -> do print <- getHtmlPrinter - x <- liftIO $ formatRangeInfoHover print flags rinfo + x <- liftIO $ formatRangeInfoHover print flags mName imports rinfo let hc = J.InL $ J.mkMarkdown x rsp = J.Hover hc $ Just $ toLspRange r responder $ Right $ J.InL rsp @@ -48,14 +53,14 @@ hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do prettyEnv flags ctx imports = (prettyEnvFromFlags flags){ context = ctx, importsMap = imports } -- Pretty-prints type/kind information to a hover tooltip -formatRangeInfoHover :: (Doc -> IO T.Text) -> Flags -> RangeInfo -> IO T.Text -formatRangeInfoHover print flags rinfo = +formatRangeInfoHover :: (Doc -> IO T.Text) -> Flags -> Name -> ImportMap ->RangeInfo -> IO T.Text +formatRangeInfoHover print flags mName imports rinfo = let colors = colorSchemeFromFlags flags in case rinfo of Id qname info isdef -> - print $ (color (colorNameQual colors) $ pretty qname) <+> text " : " <+> case info of - NIValue tp -> ppScheme (prettyEnv flags nameNil importsEmpty) tp - NICon tp -> ppScheme (prettyEnv flags nameNil importsEmpty) tp + print $ color (colorNameQual colors) (pretty qname) <+> text " : " <+> case info of + NIValue tp -> ppScheme (prettyEnv flags mName imports) tp + NICon tp -> ppScheme (prettyEnv flags mName imports) tp NITypeCon k -> prettyKind colors k NITypeVar k -> prettyKind colors k NIModule -> text "module" From a0c0d23f49344f8efcc6e117b3dd7373cecff954 Mon Sep 17 00:00:00 2001 From: Daan Leijen Date: Mon, 4 Dec 2023 19:32:35 -0800 Subject: [PATCH 03/37] update logo colors --- samples/basic/rbtree.kk | 8 +-- ...led-blue.svg => koka-logo-filled-dark.svg} | 12 ++-- .../images/koka-logo-filled-light.svg | 62 +++++++++++++++++++ .../vscode/koka.language-koka/package.json | 4 +- 4 files changed, 74 insertions(+), 12 deletions(-) rename support/vscode/koka.language-koka/images/{koka-logo-filled-blue.svg => koka-logo-filled-dark.svg} (95%) create mode 100644 support/vscode/koka.language-koka/images/koka-logo-filled-light.svg diff --git a/samples/basic/rbtree.kk b/samples/basic/rbtree.kk index f6d4ca7d2..22f737f82 100644 --- a/samples/basic/rbtree.kk +++ b/samples/basic/rbtree.kk @@ -15,7 +15,7 @@ type color type tree Node(color : color, left : tree, key : int, value : a, right : tree) Leaf - + fun is-red(t : tree) : bool match t @@ -32,7 +32,7 @@ fun balance-left(l :tree, k : int, v : a, r : tree) : tree Node(_, lx, kx, vx, rx) -> Node(Black, Node(Red, lx, kx, vx, rx), k, v, r) Leaf -> Leaf - + fun balance-right(l : tree, k : int, v : a, r : tree) : tree @@ -44,7 +44,7 @@ fun balance-right(l : tree, k : int, v : a, r : tree) : tree Node(_, lx, kx, vx, rx) -> Node(Black, l, k, v, Node(Red, lx, kx, vx, rx)) Leaf -> Leaf - + fun ins(t : tree, k : int, v : a) : tree match t @@ -88,7 +88,7 @@ fun make-tree(n : int) : tree // Count the nodes with `True` values. -fun count( t : tree ) : int +fun count( t : tree ) : int t.fold(0) fn(k,v,r) if v then r + 1 else r diff --git a/support/vscode/koka.language-koka/images/koka-logo-filled-blue.svg b/support/vscode/koka.language-koka/images/koka-logo-filled-dark.svg similarity index 95% rename from support/vscode/koka.language-koka/images/koka-logo-filled-blue.svg rename to support/vscode/koka.language-koka/images/koka-logo-filled-dark.svg index 57dae21ba..1e529e0ab 100644 --- a/support/vscode/koka.language-koka/images/koka-logo-filled-blue.svg +++ b/support/vscode/koka.language-koka/images/koka-logo-filled-dark.svg @@ -4,11 +4,11 @@ diff --git a/support/vscode/koka.language-koka/images/koka-logo-filled-light.svg b/support/vscode/koka.language-koka/images/koka-logo-filled-light.svg new file mode 100644 index 000000000..1fe64b495 --- /dev/null +++ b/support/vscode/koka.language-koka/images/koka-logo-filled-light.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + diff --git a/support/vscode/koka.language-koka/package.json b/support/vscode/koka.language-koka/package.json index aaa93d990..68c0a5095 100644 --- a/support/vscode/koka.language-koka/package.json +++ b/support/vscode/koka.language-koka/package.json @@ -55,8 +55,8 @@ ], "configuration": "./koka-configuration.json", "icon": { - "light": "./images/koka-logo-filled-blue.svg", - "dark": "./images/koka-logo-filled-blue.svg" + "light": "./images/koka-logo-filled-light.svg", + "dark": "./images/koka-logo-filled-dark.svg" } } ], From 80a2d30eb390feb6aa04bd9e955dd65a98c5c685 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Mon, 4 Dec 2023 21:27:12 -0700 Subject: [PATCH 04/37] fix normalization of paths using realPath to get correct capitalization on windows, and using normalize in a few more places --- src/Compiler/Compile.hs | 8 ++++---- src/LanguageServer/Handler/TextDocument.hs | 9 +++++---- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index 1620ecd9b..4cfed8c7f 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -353,7 +353,7 @@ compileProgram term flags modules cachedModules compileTarget fname program impo compileProgramFromFile :: (FilePath -> Maybe (BString, FileTime)) -> Maybe BString -> Terminal -> Flags -> Modules -> Modules -> CompileTarget () -> [Name] -> FilePath -> FilePath -> IOErr Loaded (Loaded, Maybe FilePath) compileProgramFromFile maybeContents contents term flags modules cachedModules compileTarget importPath rootPath stem - = do let fname = joinPath rootPath stem + = do fname <- liftIO $ realPath $ normalize $ joinPath rootPath stem -- trace ("compileProgramFromFile: " ++ show fname ++ ", modules: " ++ show (map modName modules)) $ return () liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "compile:") <+> color (colorSource (colorScheme flags)) (text (normalizeWith '/' fname))) exist <- liftIO $ doesFileExist fname @@ -629,14 +629,14 @@ searchModule flags currentDir name getCurrentFileTime :: FilePath -> (FilePath -> Maybe (BString, FileTime)) -> IO FileTime getCurrentFileTime fp maybeContents = do f <- realPath fp - case maybeContents f of + case maybeContents (normalize f) of Just (_, t) -> return t Nothing -> getFileTimeOrCurrent fp maybeGetCurrentFileTime :: FilePath -> (FilePath -> Maybe (BString, FileTime)) -> IO (Maybe FileTime) maybeGetCurrentFileTime fp maybeContents = do f <- realPath fp - case maybeContents f of + case maybeContents (normalize f) of Just (_, t) -> return $ Just t Nothing -> do -- trace ("File " ++ show fp ++ " not in virtual filesystem") $ return () @@ -765,7 +765,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return (mod, modules) _ -> do f <- liftIO $ realPath fname - (loadedImp, _) <- compileProgramFromFile maybeContents (fst <$> maybeContents f) term flags modules1 cachedModules (if genUpdate then Object else compileTarget) importPath root fname + (loadedImp, _) <- compileProgramFromFile maybeContents (fst <$> maybeContents (normalize f)) term flags modules1 cachedModules (if genUpdate then Object else compileTarget) importPath root fname let mod = loadedModule loadedImp allmods = addOrReplaceModule mod modules return (mod, loadedModules loadedImp) diff --git a/src/LanguageServer/Handler/TextDocument.hs b/src/LanguageServer/Handler/TextDocument.hs index 7c99af4b4..96bf5be6d 100644 --- a/src/LanguageServer/Handler/TextDocument.hs +++ b/src/LanguageServer/Handler/TextDocument.hs @@ -37,7 +37,7 @@ import Debug.Trace (trace) import Control.Exception (try) import qualified Control.Exception as Exc import Compiler.Options (Flags) -import Common.File (getFileTime, FileTime, getFileTimeOrCurrent, getCurrentTime, normalize) +import Common.File (getFileTime, FileTime, getFileTimeOrCurrent, getCurrentTime, normalize, realPath) import GHC.IO (unsafePerformIO) import Compiler.Module (Module(..)) import Control.Monad (when, foldM) @@ -86,8 +86,8 @@ diffVFS oldvfs vfs = vers = virtualFileVersion v in case M.lookup newK oldvfs of Just old@(_, _, vOld) -> - if vOld == vers then - return $ M.insert newK old acc + if vOld == vers then + return $ M.insert newK old acc else do time <- liftIO getCurrentTime return $ M.insert newK (text, time, vers) acc @@ -103,7 +103,8 @@ recompileFile :: CompileTarget () -> J.Uri -> Maybe J.Int32 -> Bool -> Flags -> recompileFile compileTarget uri version force flags = case J.uriToFilePath uri of Just filePath0 -> do - let filePath = normalize filePath0 + path <- liftIO $ realPath filePath0 + let filePath = normalize path -- Recompile the file vFiles <- getVirtualFiles let vfs = _vfsMap vFiles From 489843ed4cf4690a5e0477f1cf6caa1b7ddbba86 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 9 Dec 2023 12:12:14 -0700 Subject: [PATCH 05/37] fix long paths on hover --- src/Compiler/Compile.hs | 11 +++++------ src/LanguageServer/Handler/Hover.hs | 13 +++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index 4cfed8c7f..e247ceb11 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -715,7 +715,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo if srcpath /= forceModule flags && modSourceTime mod == sourceTime then do -- trace ("Loading module " ++ show mname ++ " from cache") $ return () - x <- loadFromModule (modPath mod) root stem mod + x <- loadFromModule mname (modPath mod) root stem mod return $ Just x else -- trace ("Found mod " ++ show mname ++ " in cache but was forced or old modTime " ++ show (modSourceTime mod) ++ " srctime " ++ show sourceTime ++ " force " ++ forceModule flags ) @@ -734,11 +734,10 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo Just mod -> if (srcpath /= forceModule flags && modSourceTime mod == sourceTime) then -- trace ("module " ++ show (name) ++ " already loaded") $ - -- loadFromModule iface root stem mod return (mod,modules) -- TODO: revise! do proper dependency checking instead.. else if (not (rebuild flags) && srcpath /= forceModule flags && ifaceTime >= sourceTime) then loadFromIface iface root stem mname - else loadFromSource False True modules root stem (nameFromFile iface) + else loadFromSource False True modules root stem mname _ -> do cached <- tryLoadFromCache mname root stem case cached of @@ -751,7 +750,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo -- trace ("module " ++ show (name) ++ " not yet loaded") $ if (not (rebuild flags) && srcpath /= forceModule flags && ifaceTime >= sourceTime) then loadFromIface iface root stem mname - else loadFromSource False True modules root stem (nameFromFile iface) + else loadFromSource False True modules root stem mname loadFromSource force genUpdate modules1 root fname mname = -- trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " " ++ root ++ "/" ++ fname) $ @@ -799,9 +798,9 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo Nothing -- (error ("getting program from core interface: " ++ iface)) core True (Left parseInlines) Nothing ftime (Just iftime) Nothing return mod - loadFromModule (modPath mod){-iface-} root stem mod + loadFromModule mname (modPath mod){-iface-} root stem mod - loadFromModule iface root source mod + loadFromModule mname iface root source mod = -- trace ("load from module: " ++ iface ++ ": " ++ root ++ "/" ++ source) $ do -- loaded = initialLoaded { loadedModule = mod -- , loadedModules = allmods diff --git a/src/LanguageServer/Handler/Hover.hs b/src/LanguageServer/Handler/Hover.hs index dd8bf5268..c2d2110b1 100644 --- a/src/LanguageServer/Handler/Hover.hs +++ b/src/LanguageServer/Handler/Hover.hs @@ -19,8 +19,8 @@ import Lib.PPrint (Pretty (..), Doc, text, (<+>), color) import Syntax.RangeMap (NameInfo (..), RangeInfo (..), rangeMapFindAt) import qualified Language.LSP.Protocol.Message as J import Control.Monad.Cont (liftIO) -import Type.Pretty (ppScheme, defaultEnv, Env(..)) -import Common.ColorScheme (ColorScheme (colorNameQual)) +import Type.Pretty (ppScheme, defaultEnv, Env(..), ppName) +import Common.ColorScheme (ColorScheme (colorNameQual, colorSource), Color (Gray)) import Kind.Pretty (prettyKind) import Common.Name (nameNil) import Kind.ImportMap (importsEmpty, ImportMap) @@ -55,12 +55,13 @@ prettyEnv flags ctx imports = (prettyEnvFromFlags flags){ context = ctx, imports -- Pretty-prints type/kind information to a hover tooltip formatRangeInfoHover :: (Doc -> IO T.Text) -> Flags -> Name -> ImportMap ->RangeInfo -> IO T.Text formatRangeInfoHover print flags mName imports rinfo = - let colors = colorSchemeFromFlags flags in + let colors = colorSchemeFromFlags flags + env = prettyEnv flags mName imports in case rinfo of Id qname info isdef -> - print $ color (colorNameQual colors) (pretty qname) <+> text " : " <+> case info of - NIValue tp -> ppScheme (prettyEnv flags mName imports) tp - NICon tp -> ppScheme (prettyEnv flags mName imports) tp + print $ (ppName env{colors=colors{colorSource = Gray}} qname) <+> text " : " <+> case info of + NIValue tp -> ppScheme env tp + NICon tp -> ppScheme env tp NITypeCon k -> prettyKind colors k NITypeVar k -> prettyKind colors k NIModule -> text "module" From a6a0d8bd328999b181b21f2b50f82ec0fbe2d22e Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 9 Dec 2023 14:42:03 -0700 Subject: [PATCH 06/37] additional normalization of import paths, and moduleSourcePaths --- src/Compiler/Compile.hs | 60 ++++++++++++------------ src/Compiler/Options.hs | 3 +- src/LanguageServer/Conversions.hs | 14 ++++-- src/LanguageServer/Handler/Completion.hs | 4 +- src/LanguageServer/Handler/Hover.hs | 2 +- src/LanguageServer/Monad.hs | 2 +- 6 files changed, 46 insertions(+), 39 deletions(-) diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index e247ceb11..2c69b6b26 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -320,7 +320,10 @@ compileFile maybeContents contents term flags modules cachedModules compileTarge case mbP of Nothing -> liftError $ errorMsg (errorFileNotFound flags fpath) Just (root,stem) - -> compileProgramFromFile maybeContents contents term flags modules cachedModules compileTarget importPath root stem + -> do + -- trace ("Includes : " ++ show (includePath flags)) $ return () + -- trace ("Root: " ++ root ++ " STEM: " ++ stem) $ return () + compileProgramFromFile maybeContents contents term flags modules cachedModules compileTarget importPath root stem -- | Make a file path relative to a set of given paths: return the (maximal) root and stem -- if it is not relative to the paths, return dirname/notdir @@ -398,7 +401,7 @@ compileProgram' maybeContents term flags modules cachedModules compileTarget fna iftime <- liftIO (maybeGetCurrentFileTime outIFace (const Nothing)) let mod = (moduleNull name){ modPath = outIFace, - modSourcePath = fname, + modSourcePath = normalize fname, modProgram = (Just program), modCore = failure ("Compiler.Compile.compileProgram: recursive module import (" ++ fname ++ ")"), modSourceTime = ftime, @@ -715,7 +718,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo if srcpath /= forceModule flags && modSourceTime mod == sourceTime then do -- trace ("Loading module " ++ show mname ++ " from cache") $ return () - x <- loadFromModule mname (modPath mod) root stem mod + x <- loadFromModule mname (modPath mod) root stem srcpath mod return $ Just x else -- trace ("Found mod " ++ show mname ++ " in cache but was forced or old modTime " ++ show (modSourceTime mod) ++ " srctime " ++ show sourceTime ++ " force " ++ forceModule flags ) @@ -725,7 +728,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return Nothing loadDepend iface root stem mname - = -- trace ("loadDepend " ++ iface ++ " " ++ root ++ "/" ++ stem) $ + = -- trace ("loadDepend " ++ iface ++ " root: " ++ root ++ " stem: " ++ stem) $ do let srcpath = joinPath root stem ifaceTime <- liftIO $ getCurrentFileTime iface maybeContents sourceTime <- liftIO $ getCurrentFileTime srcpath maybeContents @@ -752,10 +755,11 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo then loadFromIface iface root stem mname else loadFromSource False True modules root stem mname - loadFromSource force genUpdate modules1 root fname mname - = -- trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " " ++ root ++ "/" ++ fname) $ + loadFromSource force genUpdate modules1 root stem mname + = -- trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " root:" ++ root ++ " stem:" ++ stem) $ do - cached <- if force then return Nothing else tryLoadFromCache mname root fname + let fname = joinPath root stem + cached <- if force then return Nothing else tryLoadFromCache mname root stem case cached of Just (mod, modules) -> do liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "reusing:") <+> @@ -764,7 +768,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return (mod, modules) _ -> do f <- liftIO $ realPath fname - (loadedImp, _) <- compileProgramFromFile maybeContents (fst <$> maybeContents (normalize f)) term flags modules1 cachedModules (if genUpdate then Object else compileTarget) importPath root fname + (loadedImp, _) <- compileProgramFromFile maybeContents (fst <$> maybeContents (normalize f)) term flags modules1 cachedModules (if genUpdate then Object else compileTarget) importPath root stem let mod = loadedModule loadedImp allmods = addOrReplaceModule mod modules return (mod, loadedModules loadedImp) @@ -781,26 +785,20 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return mod Nothing -> do - cached <- tryLoadFromCache mname root stem - case cached of - Just (mod, mods) -> - do loadMessage "reusing:" - return mod - Nothing -> do - loadMessage "loading:" - iftime <- liftIO $ getFileTime iface - ftime <- liftIO $ getCurrentFileTime (joinPath root stem) maybeContents - mbCore <- liftIO $ parseCore iface - (core,parseInlines) <- liftError mbCore - -- let core = uniquefy core0 - outIFace <- liftIO $ copyIFaceToOutputDir term flags iface core - let mod = Module (Core.coreName core) outIFace (joinPath root stem) pkgQname pkgLocal [] - Nothing -- (error ("getting program from core interface: " ++ iface)) - core True (Left parseInlines) Nothing ftime (Just iftime) Nothing - return mod - loadFromModule mname (modPath mod){-iface-} root stem mod - - loadFromModule mname iface root source mod + loadMessage "loading:" + iftime <- liftIO $ getFileTime iface + ftime <- liftIO $ getCurrentFileTime (joinPath root stem) maybeContents + mbCore <- liftIO $ parseCore iface + (core,parseInlines) <- liftError mbCore + -- let core = uniquefy core0 + outIFace <- liftIO $ copyIFaceToOutputDir term flags iface core + let mod = Module (Core.coreName core) outIFace (joinPath root stem) pkgQname pkgLocal [] + Nothing -- (error ("getting program from core interface: " ++ iface)) + core True (Left parseInlines) Nothing ftime (Just iftime) Nothing + return mod + loadFromModule mname (modPath mod){-iface-} root stem (joinPath root stem) mod + + loadFromModule mname iface root stem source mod = -- trace ("load from module: " ++ iface ++ ": " ++ root ++ "/" ++ source) $ do -- loaded = initialLoaded { loadedModule = mod -- , loadedModules = allmods @@ -810,14 +808,14 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo let latest = maxFileTimes (map modSourceTime imports) let allmods = addOrReplaceModule mod resolved1 - result = (mod{ modSourcePath = joinPath root source }, allmods) + result = (mod{ modSourcePath = normalize $ joinPath root stem }, allmods) -- trace ("loaded iface: " ++ show iface ++ "\n time: " ++ show (modTime mod) ++ "\n latest: " ++ show (latest)) $ return () if (latest > (fromJust $ modTime mod) && not (null source)) -- happens if no source is present but (package) depencies have updated... then do -- trace ("iface " ++ show (modName mod) ++ " is out of date, reloading..." ++ (show (modTime mod) ++ " dependencies:\n" ++ intercalate "\n" (map (\m -> show (modName m, modTime m)) imports))) $ return () -- load from source after all - loadFromSource True True resolved1 root source (nameFromFile iface) + loadFromSource True True resolved1 root stem (nameFromFile iface) else -- trace ("using loaded module: " ++ show (modName mod)) $ case compileTarget of @@ -939,7 +937,7 @@ typeCheck loaded flags line coreImports program srcTime let warnings = warnings1 fname = sourceName (programSource program) module1 = (moduleNull (getName program)) - { modSourcePath = fname + { modSourcePath = normalize fname , modPath = outName flags (showModName (getName program)) ++ ifaceExtension , modProgram = Just program , modWarnings = warnings diff --git a/src/Compiler/Options.hs b/src/Compiler/Options.hs index ba9de32be..4c2a9c588 100644 --- a/src/Compiler/Options.hs +++ b/src/Compiler/Options.hs @@ -683,6 +683,7 @@ processOptions flags0 opts (localDir,localLibDir,localShareDir,localBinDir) <- getKokaDirs (localLibDir flags) (localShareDir flags) buildDir + normalizedIncludes <- mapM realPath (includePath flags) -- cc ccmd <- if (ccompPath flags == "") then detectCC (target flags) @@ -744,7 +745,7 @@ processOptions flags0 opts asan = asan, useStdAlloc = stdAlloc, editor = ed, - includePath = (localShareDir ++ "/lib") : includePath flags, + includePath = (localShareDir ++ "/lib") : (map normalize normalizedIncludes), genRangeMap = outHtml flags > 0 || any isLanguageServer options, vcpkgTriplet= triplet diff --git a/src/LanguageServer/Conversions.hs b/src/LanguageServer/Conversions.hs index 1bc8eacf4..61ed765f8 100644 --- a/src/LanguageServer/Conversions.hs +++ b/src/LanguageServer/Conversions.hs @@ -34,7 +34,7 @@ import qualified Syntax.RangeMap as R import Compiler.Module (Module (..), Loaded (..)) import Data.Maybe (fromMaybe) import Data.List (find) -import Common.File (normalize) +import Common.File (normalize, realPath) toLspPos :: R.Pos -> J.Position toLspPos p = @@ -111,8 +111,14 @@ fromLspRange uri (J.Range s e) = R.makeRange (fromLspPos uri s) (fromLspPos uri fromLspLocation :: J.Location -> R.Range fromLspLocation (J.Location uri rng) = fromLspRange uri rng -loadedModuleFromUri :: Maybe Loaded -> J.Uri -> Maybe Module +loadedModuleFromUri :: Maybe Loaded -> J.Uri -> IO (Maybe Module) loadedModuleFromUri l uri = case l of - Nothing -> Nothing - Just l -> find (\m -> maybe "" normalize (J.uriToFilePath uri) == modSourcePath m) $ loadedModules l + Nothing -> return Nothing + Just l -> + case J.uriToFilePath uri of + Nothing -> return Nothing + Just uri -> do + path <- realPath uri + let p = normalize path + return $ find (\m -> p == modSourcePath m) $ loadedModules l diff --git a/src/LanguageServer/Handler/Completion.hs b/src/LanguageServer/Handler/Completion.hs index 5cf0a96b0..79c6b55be 100644 --- a/src/LanguageServer/Handler/Completion.hs +++ b/src/LanguageServer/Handler/Completion.hs @@ -65,6 +65,7 @@ import Type.TypeVar (tvsEmpty) import Data.ByteString (intercalate) import Control.Monad.ST (runST) import Language.LSP.Protocol.Types (InsertTextFormat(InsertTextFormat_Snippet)) +import Control.Monad.IO.Class (liftIO) completionHandler :: Handlers LSM completionHandler = requestHandler J.SMethod_TextDocumentCompletion $ \req responder -> do @@ -72,10 +73,11 @@ completionHandler = requestHandler J.SMethod_TextDocumentCompletion $ \req respo uri = doc ^. J.uri normUri = J.toNormalizedUri uri loaded <- getLoaded + loadedM <- liftIO $ loadedModuleFromUri loaded uri vfile <- getVirtualFile normUri let items = do l <- maybeToList loaded - lm <- maybeToList $ loadedModuleFromUri loaded uri + lm <- maybeToList $ loadedM vf <- maybeToList vfile pi <- maybeToList =<< getCompletionInfo pos vf lm uri findCompletions l lm pi diff --git a/src/LanguageServer/Handler/Hover.hs b/src/LanguageServer/Handler/Hover.hs index c2d2110b1..dc786c36e 100644 --- a/src/LanguageServer/Handler/Hover.hs +++ b/src/LanguageServer/Handler/Hover.hs @@ -53,7 +53,7 @@ hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do prettyEnv flags ctx imports = (prettyEnvFromFlags flags){ context = ctx, importsMap = imports } -- Pretty-prints type/kind information to a hover tooltip -formatRangeInfoHover :: (Doc -> IO T.Text) -> Flags -> Name -> ImportMap ->RangeInfo -> IO T.Text +formatRangeInfoHover :: (Doc -> IO T.Text) -> Flags -> Name -> ImportMap -> RangeInfo -> IO T.Text formatRangeInfoHover print flags mName imports rinfo = let colors = colorSchemeFromFlags flags env = prettyEnv flags mName imports in diff --git a/src/LanguageServer/Monad.hs b/src/LanguageServer/Monad.hs index 3145bc907..9b5a03104 100644 --- a/src/LanguageServer/Monad.hs +++ b/src/LanguageServer/Monad.hs @@ -158,7 +158,7 @@ removeLoaded m = modifyLSState $ \s -> s {lsLoaded = case lsLoaded s of {Nothing getLoadedModule :: J.Uri -> LSM (Maybe Module) getLoadedModule uri = do lmaybe <- getLoaded - return $ loadedModuleFromUri lmaybe uri + liftIO $ loadedModuleFromUri lmaybe uri -- Runs the language server's state monad. runLSM :: LSM a -> MVar LSState -> LanguageContextEnv () -> IO a From 51c53caf1edc7fd9f72f6ad139c193ec8ed567fe Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 9 Dec 2023 21:30:21 -0700 Subject: [PATCH 07/37] fix a bunch of things and add test runners --- src/Compiler/Compile.hs | 57 ++++++++------- src/Compiler/Module.hs | 3 +- src/Interpreter/Interpret.hs | 11 +-- src/LanguageServer/Handler/Commands.hs | 30 +++++++- src/LanguageServer/Handler/Completion.hs | 2 +- src/LanguageServer/Handler/Definition.hs | 2 +- src/LanguageServer/Handler/DocumentSymbol.hs | 2 +- src/LanguageServer/Handler/Hover.hs | 2 +- src/LanguageServer/Handler/TextDocument.hs | 70 +++++++++++++++---- src/LanguageServer/Monad.hs | 40 +++++++---- src/LanguageServer/Run.hs | 2 +- src/Main.hs | 2 +- .../vscode/koka.language-koka/src/debugger.ts | 10 ++- .../koka.language-koka/src/extension.ts | 62 +++++++++++----- 14 files changed, 208 insertions(+), 87 deletions(-) diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index 2c69b6b26..0354cfa0e 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -181,7 +181,7 @@ gammaFind name g [] -> failure ("Compiler.Compile.gammaFind: can't locate " ++ show name) _ -> failure ("Compiler.Compile.gammaFind: multiple definitions for " ++ show name) -compileExpression :: Terminal -> Flags -> Loaded -> CompileTarget () -> UserProgram -> Int -> String -> IO (Error Loaded Loaded) +compileExpression :: Terminal -> Flags -> Loaded -> CompileTarget () -> UserProgram -> Int -> String -> IO (Error Loaded (Loaded, Maybe FilePath)) compileExpression term flags loaded compileTarget program line input = runIOErr $ do let qnameExpr = (qualify (getName program) nameExpr) @@ -191,9 +191,7 @@ compileExpression term flags loaded compileTarget program line input case compileTarget of -- run a particular entry point Executable name () | name /= nameExpr - -> do - (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules loaded) [] compileTarget "" programDef [] - return ld + -> compileProgram' (const Nothing) term flags (loadedModules loaded) [] compileTarget "" programDef [] -- entry point is the expression: compile twice: -- first to get the type of the expression and create a 'show' wrapper, -- then to actually run the program @@ -205,9 +203,7 @@ compileExpression term flags loaded compileTarget program line input case splitFunType rho of -- return unit: just run the expression (for its assumed side effect) Just (_,_,tres) | isTypeUnit tres - -> do - (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules ld) [] compileTarget "" programDef [] - return ld + -> compileProgram' (const Nothing) term flags (loadedModules ld) [] compileTarget "" programDef [] -- check if there is a show function, or use generic print if not. Just (_,_,tres) -> do -- ld <- compileProgram' term flags (loadedModules ld0) Nothing "" programDef @@ -225,7 +221,6 @@ compileExpression term flags loaded compileTarget program line input let defMain = Def (ValueBinder (qualify (getName program) nameMain) () (Lam [] expression r) r r) r Public (defFun []) InlineNever "" let programDef' = programAddDefs programDef [] [defMain] compileProgram' (const Nothing) term flags (loadedModules ld) [] (Executable nameMain ()) "" programDef' [] - return ld _ -> liftErrorPartial loaded $ errorMsg (ErrorGeneral rangeNull (text "no 'show' function defined for values of type:" <+> ppType (prettyEnvFromFlags flags) tres)) -- mkApp (Var (qualify nameSystemCore (newName "gprintln")) False r) @@ -233,9 +228,7 @@ compileExpression term flags loaded compileTarget program line input Nothing -> failure ("Compile.Compile.compileExpression: should not happen") -- no evaluation - _ -> do - (ld, _) <- compileProgram' (const Nothing) term flags (loadedModules loaded) [] compileTarget "" programDef [] - return ld + _ -> compileProgram' (const Nothing) term flags (loadedModules loaded) [] compileTarget "" programDef [] errorModuleNotFound :: Flags -> Range -> Name -> ErrorMessage @@ -387,7 +380,11 @@ data CompileTarget a = InMemory | Object | Library - | Executable { entry :: Name, info :: a } + | Executable { entry :: Name, info :: a } deriving Show + +isInMemory :: CompileTarget a -> Bool +isInMemory InMemory = True +isInMemory _ = False isExecutable (Executable _ _) = True isExecutable _ = False @@ -608,7 +605,10 @@ resolveImportModules compileTarget maybeContents mname term flags currentDir res else do -- trace ("\t" ++ show mname ++ ": resolving imported modules: " ++ show (impName imp) ++ ", resolved: " ++ show (map (show . modName) resolved0) ++ ", path:" ++ show importPath) $ return () (mod,resolved1) <- case filter (\m -> impName imp == modName m) resolved0 of - (mod:_) -> return (mod,resolved0) + (mod:_) -> + if modInMemory mod && not (isInMemory compileTarget) then resolveModule compileTarget maybeContents term flags currentDir resolved0 cachedModules importPath imp + else + return (mod,resolved0) _ -> resolveModule compileTarget maybeContents term flags currentDir resolved0 cachedModules importPath imp -- trace ("\tnewly resolved from " ++ show (modName mod) ++ ": " ++ show (map (show . modName) resolved1)) $ return () let imports = Core.coreProgImports $ modCore mod @@ -717,7 +717,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo Just mod -> if srcpath /= forceModule flags && modSourceTime mod == sourceTime then do - -- trace ("Loading module " ++ show mname ++ " from cache") $ return () + trace ("Loading module " ++ show mname ++ " from cache") $ return () x <- loadFromModule mname (modPath mod) root stem srcpath mod return $ Just x else @@ -728,7 +728,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return Nothing loadDepend iface root stem mname - = -- trace ("loadDepend " ++ iface ++ " root: " ++ root ++ " stem: " ++ stem) $ + = trace ("loadDepend " ++ iface ++ " root: " ++ root ++ " stem: " ++ stem) $ do let srcpath = joinPath root stem ifaceTime <- liftIO $ getCurrentFileTime iface maybeContents sourceTime <- liftIO $ getCurrentFileTime srcpath maybeContents @@ -756,12 +756,15 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo else loadFromSource False True modules root stem mname loadFromSource force genUpdate modules1 root stem mname - = -- trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " root:" ++ root ++ " stem:" ++ stem) $ + = trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " root:" ++ root ++ " stem:" ++ stem) $ do let fname = joinPath root stem - cached <- if force then return Nothing else tryLoadFromCache mname root stem + cached <- tryLoadFromCache mname root stem + mbIface <- liftIO $ searchOutputIface flags name + let noNeedsGen = isJust mbIface || isInMemory compileTarget + trace ("loadFromSource: " ++ show (force, genUpdate, noNeedsGen, mbIface, compileTarget)) $ return () case cached of - Just (mod, modules) -> + Just (mod, modules) | not genUpdate && not force && noNeedsGen -> do liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "reusing:") <+> color (colorSource (colorScheme flags)) (pretty mname)) @@ -774,7 +777,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return (mod, loadedModules loadedImp) loadFromIface iface root stem mname - = -- trace ("loadFromIFace: " ++ iface ++ ": " ++ root ++ "/" ++ stem ++ "\n in modules: " ++ show (map modName modules)) $ + = trace ("loadFromIFace: " ++ iface ++ ": root:" ++ root ++ " stem:" ++ stem ++ "\n in modules: " ++ show (map modName modules)) $ do let (pkgQname,pkgLocal) = packageInfoFromDir (packages flags) (dirname iface) loadMessage msg = liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text msg) <+> color (colorSource (colorScheme flags)) @@ -794,12 +797,12 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo outIFace <- liftIO $ copyIFaceToOutputDir term flags iface core let mod = Module (Core.coreName core) outIFace (joinPath root stem) pkgQname pkgLocal [] Nothing -- (error ("getting program from core interface: " ++ iface)) - core True (Left parseInlines) Nothing ftime (Just iftime) Nothing + core True False (Left parseInlines) Nothing ftime (Just iftime) Nothing return mod loadFromModule mname (modPath mod){-iface-} root stem (joinPath root stem) mod loadFromModule mname iface root stem source mod - = -- trace ("load from module: " ++ iface ++ ": " ++ root ++ "/" ++ source) $ + = trace ("load from module: " ++ iface ++ ": " ++ root ++ "/" ++ source) $ do -- loaded = initialLoaded { loadedModule = mod -- , loadedModules = allmods -- } @@ -813,15 +816,15 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo if (latest > (fromJust $ modTime mod) && not (null source)) -- happens if no source is present but (package) depencies have updated... then do - -- trace ("iface " ++ show (modName mod) ++ " is out of date, reloading..." ++ (show (modTime mod) ++ " dependencies:\n" ++ intercalate "\n" (map (\m -> show (modName m, modTime m)) imports))) $ return () + trace ("iface " ++ show (modName mod) ++ " is out of date, reloading..." ++ (show (modTime mod) ++ " dependencies:\n" ++ intercalate "\n" (map (\m -> show (modName m, modTime m)) imports))) $ return () -- load from source after all loadFromSource True True resolved1 root stem (nameFromFile iface) else - -- trace ("using loaded module: " ++ show (modName mod)) $ + trace ("using loaded module: " ++ show (modName mod) ++ " compile target " ++ show compileTarget) $ case compileTarget of InMemory -> return result _ -> do - -- trace ("loaded module requires compiling") $ return () + trace ("loaded module requires compiling") $ return () outputTime <- liftIO $ getFileTime iface if fromJust (modTime mod) > outputTime then do -- (imports,resolved1) <- resolveImportModules Object maybeContents name term flags (dirname iface) modules cachedModules (name:importPath) (map ImpCore (Core.coreProgImports (modCore mod))) @@ -942,7 +945,6 @@ typeCheck loaded flags line coreImports program srcTime , modProgram = Just program , modWarnings = warnings , modSourceTime = srcTime - , modCompiled = True } -- module0 = loadedModule loaded fixitiesPub = fixitiesNew [(name,fix) | FixDef name fix rng vis <- programFixDefs program0, vis == Public] @@ -1130,7 +1132,8 @@ inferCheck loaded0 flags line coreImports program , loadedModule = (loadedModule loaded){ modCore = coreProgramFinal, modRangeMap = mbRangeMap, - modInlines = Right allInlineDefs + modInlines = Right allInlineDefs, + modCompiled = True } , loadedInlines = inlinesExtends allInlineDefs (loadedInlines loaded) } @@ -1204,7 +1207,7 @@ codeGen term flags compileTarget loaded -- write interface file last so on any error it will not be written writeDocW 10000 outIface ifaceDoc ftime <- getFileTimeOrCurrent outIface - let mod1 = (loadedModule loaded){ modTime = Just ftime, modOutputTime = Just ftime } + let mod1 = (loadedModule loaded){ modTime = Just ftime, modOutputTime = Just ftime, modInMemory=False } loaded1 = loaded{ loadedModule = mod1 } -- copy final exe if -o is given diff --git a/src/Compiler/Module.hs b/src/Compiler/Module.hs index 5551ae2a7..e9eecae6e 100644 --- a/src/Compiler/Module.hs +++ b/src/Compiler/Module.hs @@ -63,6 +63,7 @@ data Module = Module{ modName :: Name , modProgram :: Maybe (Program UserType UserKind) -- not for interfaces , modCore :: Core.Core , modCompiled :: Bool + , modInMemory :: Bool , modInlines :: Either (Gamma -> Error () [Core.InlineDef]) ([Core.InlineDef]) , modRangeMap :: Maybe RangeMap , modSourceTime :: FileTime @@ -109,7 +110,7 @@ initialLoaded moduleNull :: Name -> Module moduleNull modName - = Module (modName) "" "" "" "" [] Nothing (Core.coreNull modName) False (Left (\g -> return [])) Nothing fileTime0 Nothing Nothing + = Module (modName) "" "" "" "" [] Nothing (Core.coreNull modName) False True (Left (\g -> return [])) Nothing fileTime0 Nothing Nothing loadedName :: Loaded -> Name loadedName ld diff --git a/src/Interpreter/Interpret.hs b/src/Interpreter/Interpret.hs index 10ebdd665..78c3f52d4 100644 --- a/src/Interpreter/Interpret.hs +++ b/src/Interpreter/Interpret.hs @@ -127,7 +127,7 @@ command st cmd = let term = terminal st in do{ case cmd of Eval line -> do{ err <- compileExpression term (flags st) (loaded st) (Executable nameExpr ()) (program st) bigLine line - ; checkInferWith st line id True err $ \ld -> + ; checkInferWith st line fst True err $ \(ld, _) -> do if (not (evaluate (flags st))) then let tp = infoType $ gammaFind (qualify nameInteractive nameExpr) (loadedGamma ld) in messageSchemeEffect st tp @@ -136,7 +136,7 @@ command st cmd } Define line -> do err <- compileValueDef term (flags st) (loaded st) (program st) (lineNo st) line - checkInfer2 st True err $ \(defName,ld) -> + checkInfer2Snd st True err $ \(defName,ld) -> do{ let tp = infoType $ gammaFind defName (loadedGamma ld) tpdoc = prettyScheme st tp sig = show defName ++ " :: " ++ show tpdoc @@ -149,7 +149,7 @@ command st cmd } TypeOf line -> do err <- compileExpression term (flags st) (loaded st) Object (program st) bigLine line - checkInfer st True err $ \ld -> + checkInfer2Fst st True err $ \(ld, _) -> do{ let tp = infoType $ gammaFind (qualify nameInteractive nameExpr) (loadedGamma ld) ; messageSchemeEffect st tp ; interpreter st{ loaded = ld } -- (loaded st){ loadedModules = loadedModules ld }} @@ -164,7 +164,7 @@ command st cmd TypeDef line-> -- trace ("modules: " ++ show (map (show . modName . loadedModule) (loadedModules st))) $ do err <- compileTypeDef term (flags st) (loaded st) (program st) (lineNo st) line - checkInfer2 st True err $ \(defName, ld) -> + checkInfer2Snd st True err $ \(defName, ld) -> do{ let (qname,kind) = kgammaFind (getName (program st)) defName (loadedKGamma ld) ; messagePrettyLnLn st (text (show defName) <+> text "::" <+> pretty kind) ; interpreter st{ program = maybe (program st) id $ modProgram (loadedModule ld) @@ -354,7 +354,8 @@ docNotFound cscheme path name --------------------------------------------------------------------------} checkInfer :: State -> Bool -> Error b Loaded -> (Loaded -> IO ()) -> IO () checkInfer st = checkInferWith st "" id -checkInfer2 st = checkInferWith st "" (\(a,c) -> c) +checkInfer2Snd st = checkInferWith st "" snd +checkInfer2Fst st = checkInferWith st "" fst checkInfer3 :: State -> String -> Bool -> Error b (a,b,Loaded) -> ((a,b,Loaded) -> IO ()) -> IO () checkInfer3 st line = checkInferWith st line (\(a,b,c) -> c) diff --git a/src/LanguageServer/Handler/Commands.hs b/src/LanguageServer/Handler/Commands.hs index 629a1ba5c..5d4e4eb1c 100644 --- a/src/LanguageServer/Handler/Commands.hs +++ b/src/LanguageServer/Handler/Commands.hs @@ -9,18 +9,23 @@ import Compiler.Options (Flags (outFinalPath), targets, commandLineHelp, updateF import Language.LSP.Server (Handlers, LspM, notificationHandler, sendNotification, MonadLsp, getVirtualFiles, withIndefiniteProgress, requestHandler) import qualified Language.LSP.Protocol.Types as J import qualified Data.Text as T -import LanguageServer.Monad (LSM, getFlags, getTerminal) +import LanguageServer.Monad (LSM, getFlags, getTerminal, getModules, getLoaded) import qualified Language.LSP.Protocol.Message as J import Data.Aeson as Json import qualified Language.LSP.Protocol.Lens as J import Control.Lens ((^.)) import Data.Maybe (mapMaybe, fromJust, fromMaybe) import GHC.Base (Type) -import LanguageServer.Handler.TextDocument (recompileFile) -import Compiler.Compile (CompileTarget(..), Terminal (termError, termPhaseDoc)) +import LanguageServer.Handler.TextDocument (recompileFile, compileEditorExpression) +import Compiler.Compile (CompileTarget(..), Terminal (termError, termPhaseDoc), compileExpression, Module (..)) import Common.Name (newName) import qualified Language.LSP.Server as J import Control.Monad.Trans (liftIO) +import Syntax.Syntax (programAddImports, programNull, Import (..)) +import Common.NamePrim (nameInteractiveModule) +import Compiler.Module (Loaded(..)) +import Common.Range (rangeNull) +import Core.Core (Visibility(Private)) initializedHandler :: Handlers LSM initializedHandler = notificationHandler J.SMethod_Initialized $ \_not -> sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info "Initialized language server." @@ -53,6 +58,25 @@ commandHandler = requestHandler J.SMethod_WorkspaceExecuteCommand $ \req resp -> _ -> do sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid parameters" resp $ Right $ J.InR J.Null + else if command == "koka/interpretExpression" then + case commandParams of + Just [Json.String filePath, Json.String functionName, Json.String additionalArgs] -> do + term <- getTerminal + newFlags <- case updateFlagsFromArgs flags (T.unpack additionalArgs) of + Just flags' -> return flags' + Nothing -> do + doc <- liftIO (commandLineHelp flags) + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid arguments " <> additionalArgs + liftIO $ termPhaseDoc term doc + return flags + withIndefiniteProgress (T.pack "Interpreting " <> functionName) J.NotCancellable $ do + -- term flags loaded compileTarget program line input + res <- compileEditorExpression (J.filePathToUri $ T.unpack filePath) newFlags (T.unpack filePath) (T.unpack functionName) + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack ("Finished generating code for interpreting function " ++ T.unpack functionName ++ " in file " ++ T.unpack filePath ++ " Result: " ++ fromMaybe "No Compiled File" res) + resp $ Right $ case res of {Just filePath -> J.InL $ Json.String $ T.pack filePath; Nothing -> J.InR J.Null} + _ -> do + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid parameters" + resp $ Right $ J.InR J.Null else do sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Unknown command" ++ show req) diff --git a/src/LanguageServer/Handler/Completion.hs b/src/LanguageServer/Handler/Completion.hs index 79c6b55be..8cd6f31bf 100644 --- a/src/LanguageServer/Handler/Completion.hs +++ b/src/LanguageServer/Handler/Completion.hs @@ -72,7 +72,7 @@ completionHandler = requestHandler J.SMethod_TextDocumentCompletion $ \req respo let J.CompletionParams doc pos _ _ context = req ^. J.params uri = doc ^. J.uri normUri = J.toNormalizedUri uri - loaded <- getLoaded + loaded <- getLoaded uri loadedM <- liftIO $ loadedModuleFromUri loaded uri vfile <- getVirtualFile normUri let items = do diff --git a/src/LanguageServer/Handler/Definition.hs b/src/LanguageServer/Handler/Definition.hs index 9b93fe4b8..78105c912 100644 --- a/src/LanguageServer/Handler/Definition.hs +++ b/src/LanguageServer/Handler/Definition.hs @@ -25,7 +25,7 @@ definitionHandler :: Handlers LSM definitionHandler = requestHandler J.SMethod_TextDocumentDefinition $ \req responder -> do let J.DefinitionParams doc pos _ _ = req ^. J.params uri = doc ^. J.uri - loaded <- getLoaded + loaded <- getLoaded uri let defs = do l <- maybeToList loaded rmap <- maybeToList $ modRangeMap $ loadedModule l diff --git a/src/LanguageServer/Handler/DocumentSymbol.hs b/src/LanguageServer/Handler/DocumentSymbol.hs index a788e8e72..e471d1d6a 100644 --- a/src/LanguageServer/Handler/DocumentSymbol.hs +++ b/src/LanguageServer/Handler/DocumentSymbol.hs @@ -26,7 +26,7 @@ documentSymbolHandler :: Handlers LSM documentSymbolHandler = requestHandler J.SMethod_TextDocumentDocumentSymbol $ \req responder -> do let J.DocumentSymbolParams _ _ doc = req ^. J.params uri = doc ^. J.uri - loaded <- getLoaded + loaded <- getLoaded uri let symbols = findDocumentSymbols =<< maybeToList loaded responder $ Right $ J.InR $ J.InL symbols diff --git a/src/LanguageServer/Handler/Hover.hs b/src/LanguageServer/Handler/Hover.hs index dc786c36e..0574770dd 100644 --- a/src/LanguageServer/Handler/Hover.hs +++ b/src/LanguageServer/Handler/Hover.hs @@ -33,7 +33,7 @@ hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do let J.HoverParams doc pos _ = req ^. J.params uri = doc ^. J.uri loadedMod <- getLoadedModule uri - loaded <- getLoaded + loaded <- getLoaded uri flags <- getFlags let res = do mod <- loadedMod diff --git a/src/LanguageServer/Handler/TextDocument.hs b/src/LanguageServer/Handler/TextDocument.hs index 96bf5be6d..465b29940 100644 --- a/src/LanguageServer/Handler/TextDocument.hs +++ b/src/LanguageServer/Handler/TextDocument.hs @@ -9,12 +9,13 @@ module LanguageServer.Handler.TextDocument didSaveHandler, didCloseHandler, recompileFile, + compileEditorExpression, persistModules, ) where import Common.Error (Error, checkPartial) -import Compiler.Compile (Terminal (..), compileModuleOrFile, Loaded (..), CompileTarget (..), compileFile, codeGen) +import Compiler.Compile (Terminal (..), compileModuleOrFile, Loaded (..), CompileTarget (..), compileFile, codeGen, compileExpression) import Control.Lens ((^.)) import Control.Monad.Trans (liftIO) import qualified Data.Map as M @@ -25,7 +26,7 @@ import Language.LSP.Server (Handlers, flushDiagnosticsBySource, publishDiagnosti import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import LanguageServer.Conversions (toLspDiagnostics) -import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded) +import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded, getModules) import Language.LSP.VFS (virtualFileText, VFS(..), VirtualFile, file_version, virtualFileVersion) import qualified Data.Text.Encoding as T import Data.Functor ((<&>)) @@ -43,6 +44,12 @@ import Compiler.Module (Module(..)) import Control.Monad (when, foldM) import Data.Time (addUTCTime, addLocalTime) import qualified Data.ByteString as J +import Syntax.Syntax (programNull, programAddImports) +import Common.Range (rangeNull) +import Core.Core (Visibility(Private)) +import Common.NamePrim (nameInteractiveModule, nameExpr, nameSystemCore) +import Common.Name (newName) +import Syntax.Syntax (Import(..)) didOpenHandler :: Handlers LSM didOpenHandler = notificationHandler J.SMethod_TextDocumentDidOpen $ \msg -> do @@ -97,6 +104,50 @@ diffVFS oldvfs vfs = return $ M.insert newK (text, time, vers) acc) M.empty (M.toList vfs) +compileEditorExpression :: J.Uri -> Flags -> String -> String -> LSM (Maybe FilePath) +compileEditorExpression uri flags filePath functionName = do + let normUri = J.toNormalizedUri uri + term <- getTerminal + loaded <- getLoaded uri + case loaded of + Just loaded -> do + let mod = loadedModule loaded + let imports = [Import nameSystemCore nameSystemCore rangeNull Private, Import (modName mod) (modName mod) rangeNull Private] + let resultIO :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) + resultIO = try $ compileExpression term flags loaded (Executable nameExpr ()) (programAddImports (programNull nameInteractiveModule) imports) 0 (functionName ++ "()") + result <- liftIO resultIO + case result of + Right res -> do + outFile <- case checkPartial res of + Right ((l, outFile), _, _) -> do + putLoaded l + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ "Successfully compiled " <> T.pack filePath + return outFile + Left (e, m) -> do + case m of + Nothing -> + trace ("Error when compiling, no cached modules " ++ show e) $ + return () + Just l -> do + trace ("Error when compiling have cached" ++ show (map modSourcePath $ loadedModules l)) $ return () + putLoaded l + removeLoaded (loadedModule l) + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Error when compiling " ++ show e) <> T.pack filePath + return Nothing + -- Emit the diagnostics (errors and warnings) + let diagSrc = T.pack "koka" + diags = toLspDiagnostics diagSrc res + diagsBySrc = partitionBySource diags + maxDiags = 100 + if null diags + then flushDiagnosticsBySource maxDiags (Just diagSrc) + else publishDiagnostics maxDiags normUri Nothing diagsBySrc + return outFile + Left e -> do + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) + sendNotification J.SMethod_WindowShowMessage $ J.ShowMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) + return Nothing + -- Recompiles the given file, stores the compilation result in -- LSM's state and emits diagnostics. recompileFile :: CompileTarget () -> J.Uri -> Maybe J.Int32 -> Bool -> Flags -> LSM (Maybe FilePath) @@ -112,15 +163,12 @@ recompileFile compileTarget uri version force flags = newvfs <- diffVFS oldvfs vfs modifyLSState (\old -> old{documentInfos = newvfs}) let contents = fst <$> maybeContents newvfs filePath - loaded1 <- getLoaded - let modules = do - l <- loaded1 - return $ loadedModule l : loadedModules l + modules <- getModules term <- getTerminal sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath let resultIO :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) - resultIO = try $ compileFile (maybeContents newvfs) contents term flags [] (if force then [] else fromMaybe [] modules) compileTarget [] filePath + resultIO = try $ compileFile (maybeContents newvfs) contents term flags [] (if force then [] else modules) compileTarget [] filePath result <- liftIO resultIO case result of Right res -> do @@ -159,11 +207,9 @@ recompileFile compileTarget uri version force flags = persistModules :: LSM () persistModules = do - mld <- getLoaded - case mld of - Just ld -> mapM_ persistModule (loadedModules ld) - Nothing -> return () - + mld <- getModules + mapM_ persistModule mld -- TODO: Dependency ordering + persistModule :: Module -> LSM () persistModule m = do return () diff --git a/src/LanguageServer/Monad.hs b/src/LanguageServer/Monad.hs index 9b5a03104..f11dc167b 100644 --- a/src/LanguageServer/Monad.hs +++ b/src/LanguageServer/Monad.hs @@ -17,6 +17,7 @@ module LanguageServer.Monad getLoaded, putLoaded,removeLoaded, getLoadedModule, + getModules, getColorScheme, getHtmlPrinter, runLSM, @@ -57,10 +58,13 @@ import Control.Concurrent.STM.TMVar (TMVar) import LanguageServer.Conversions (loadedModuleFromUri) import qualified Data.ByteString as D import Platform.Filetime (FileTime) +import Common.File (realPath,normalize) +import Compiler.Module (Modules) -- The language server's state, e.g. holding loaded/compiled modules. data LSState = LSState { - lsLoaded :: Maybe Loaded, + lsModules :: [Module], + lsLoaded :: M.Map FilePath Loaded, messages :: TChan (String, J.MessageType), flags:: Flags, terminal:: Terminal, @@ -102,7 +106,7 @@ defaultLSState flags = do (if verbose flags > 0 then (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) else (\_ -> return ())) (\tp -> withNewPrinter $ \p -> do putScheme p (prettyEnv flags nameNil importsEmpty) tp; return J.MessageType_Info) (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) - return LSState {lsLoaded = Nothing, messages = msgChan, terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, documentInfos = M.empty, documentVersions = fileVersions} + return LSState {lsLoaded = M.empty,lsModules=[], messages = msgChan, terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, documentInfos = M.empty, documentVersions = fileVersions} putScheme p env tp = writePrettyLn p (ppScheme env tp) @@ -134,9 +138,19 @@ modifyLSState m = do stVar <- lift ask liftIO $ modifyMVar stVar $ \s -> return (m s, ()) +getModules :: LSM Modules +getModules = lsModules <$> getLSState + -- Fetches the loaded state holding compiled modules -getLoaded :: LSM (Maybe Loaded) -getLoaded = lsLoaded <$> getLSState +getLoaded :: J.Uri -> LSM (Maybe Loaded) +getLoaded uri = do + st <- getLSState + case J.uriToFilePath uri of + Nothing -> return Nothing + Just uri -> do + path <- liftIO $ realPath uri + let p = normalize path + return $ M.lookup p (lsLoaded st) -- Fetches the loaded state holding compiled modules getFlags :: LSM Flags @@ -150,14 +164,14 @@ getColorScheme = colorScheme <$> getFlags -- Replaces the loaded state holding compiled modules putLoaded :: Loaded -> LSM () -putLoaded l = modifyLSState $ \s -> s {lsLoaded = case lsLoaded s of {Nothing -> Just l; Just l' -> Just $ mergeLoaded l l'}} +putLoaded l = modifyLSState $ \s -> s {lsModules = mergeModules (loadedModule l:loadedModules l) (lsModules s), lsLoaded = M.insert (modSourcePath $ loadedModule l) l (lsLoaded s)} removeLoaded :: Module -> LSM () -removeLoaded m = modifyLSState $ \s -> s {lsLoaded = case lsLoaded s of {Nothing -> Nothing; Just l -> Just $ l{loadedModules = filter (\m' -> modName m' /= modName m) (loadedModules l)}}} +removeLoaded m = modifyLSState $ \s -> s {lsModules = filter (\m1 -> modName m1 /= modName m) (lsModules s), lsLoaded = M.delete (modSourcePath m) (lsLoaded s)} getLoadedModule :: J.Uri -> LSM (Maybe Module) getLoadedModule uri = do - lmaybe <- getLoaded + lmaybe <- getLoaded uri liftIO $ loadedModuleFromUri lmaybe uri -- Runs the language server's state monad. @@ -167,10 +181,8 @@ runLSM lsm stVar cfg = runReaderT (runLspT cfg lsm) stVar getTerminal :: LSM Terminal getTerminal = terminal <$> getLSState -mergeLoaded :: Loaded -> Loaded -> Loaded -mergeLoaded newL oldL = - let compiledName = modName $ loadedModule newL - newModules = filter (\m -> modName m /= compiledName) (loadedModules newL) - newModNames = compiledName:map modName newModules - news = loadedModule newL:newModules ++ filter (\m -> modName m `notElem` newModNames) (loadedModules oldL) in - newL{loadedModules= filter modCompiled news} +mergeModules :: Modules -> Modules -> Modules +mergeModules newModules oldModules = + let nModValid = filter modCompiled newModules -- only add modules that sucessfully compiled + newModNames = map modName nModValid + in nModValid ++ filter (\m -> modName m `notElem` newModNames) oldModules diff --git a/src/LanguageServer/Run.hs b/src/LanguageServer/Run.hs index 7532f23ec..14ab6cacb 100644 --- a/src/LanguageServer/Run.hs +++ b/src/LanguageServer/Run.hs @@ -51,7 +51,7 @@ runLanguageServer flags files = do options = defaultOptions { optTextDocumentSync = Just syncOptions, - optExecuteCommandCommands = Just [T.pack "koka/genCode"] + optExecuteCommandCommands = Just [T.pack "koka/genCode", T.pack "koka/interpretExpression"] -- optCompletionTriggerCharacters = Just ['.', ':', '/'] -- TODO: ? https://www.stackage.org/haddock/lts-18.21/lsp-1.2.0.0/src/Language.LSP.Server.Core.html#Options }, diff --git a/src/Main.hs b/src/Main.hs index 2b1d75238..3e638dbb0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -94,7 +94,7 @@ compile p flags fname -- exitFailure -- don't fail for tests Right ((Loaded gamma kgamma synonyms newtypes constructors _ imports _ - (Module modName _ _ _ _ _warnings rawProgram core _ _ _ modTime _ _) _ _ _ + (Module modName _ _ _ _ _ rawProgram core _ _ _ _ modTime _ _) _ _ _ , _), warnings) -> do when (not (null warnings)) (let msg = ErrorWarning warnings ErrorZero diff --git a/support/vscode/koka.language-koka/src/debugger.ts b/support/vscode/koka.language-koka/src/debugger.ts index 33f0fb0f9..f2ff5fcbd 100644 --- a/support/vscode/koka.language-koka/src/debugger.ts +++ b/support/vscode/koka.language-koka/src/debugger.ts @@ -31,6 +31,8 @@ interface LaunchRequestArguments extends DebugProtocol.LaunchRequestArguments { args?: string /** enable logging the Debug Adapter Protocol */ trace?: boolean + /** A single function to run (must have no effects and return a type that is showable)*/ + functionName?: string } export class KokaDebugSession extends LoggingDebugSession { @@ -166,6 +168,7 @@ class KokaRuntime extends EventEmitter { } ps?: child_process.ChildProcess | null + public async start(args: LaunchRequestArguments) { const target = this.config.target let compilerTarget @@ -192,7 +195,12 @@ class KokaRuntime extends EventEmitter { additionalArgs = additionalArgs + " " + args.args } try { - const resp = await this.client.sendRequest(ExecuteCommandRequest.type, { command: 'koka/genCode', arguments: [args.program, additionalArgs] }) + let resp = null + if (args.functionName) { + resp = await this.client.sendRequest(ExecuteCommandRequest.type, { command: 'koka/interpretExpression', arguments: [args.program, args.functionName, additionalArgs] }) + } else { + resp = await this.client.sendRequest(ExecuteCommandRequest.type, { command: 'koka/genCode', arguments: [args.program, additionalArgs] }) + } console.log(`Generated code at ${resp}`) if (!resp) { this.emit('output', `Error generating code, see language server output for specifics`, 'stderr') diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts index 7ac831eb1..263168cdf 100644 --- a/support/vscode/koka.language-koka/src/extension.ts +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -206,6 +206,18 @@ function createCommands( console.log(`Launch config ${launchConfig}`) vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) }), + vscode.commands.registerCommand('koka.interpretExpression', (resource: vscode.Uri, functionName: string) => { + const launchConfig = + { + name: `koka run: ${resource.path}`, + request: "launch", + type: "koka", + program: resource.fsPath, + functionName: functionName + } + console.log(`Launch config ${launchConfig}`) + vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) + }), vscode.commands.registerCommand('koka.downloadLatest', (resource: vscode.Uri) => { downloadSDK() }), @@ -328,28 +340,32 @@ class MainCodeLensProvider implements vscode.CodeLensProvider { public async provideCodeLenses(document: TextDocument, token: CancellationToken): Promise { const doc = document.getText() - const main = doc.indexOf('\nfun main') - if (main < 0) { - if (doc.startsWith('fun main')) { - return [this.createCodeLens(document, 0)] - } else { - const main1 = doc.indexOf(`\npub fun main`) - if (main1 < 0) { - if (doc.startsWith('pub fun main')) { - return [this.createCodeLens(document, 0)] - } - return [] - } else { - return [this.createCodeLens(document, main1 + 1)] - } - } + const re_main = /((?<=\n)|^)((pub\s+)?fun\s+main\(\))/g; + const re_test = /((?<=\n)|^)((pub\s+)?fun\s+(test\w*)\(\))/g; + let lenses = []; + let match = null; + console.log("Scanning document for main and test function"); + while (match = re_main.exec(doc)) { + lenses.push(this.createMainCodeLens(document, match.index, match[0].length)) + } + while (match = re_test.exec(doc)) { + console.log(match[4]); + } + console.log("Scanning document for main and test function") + while (match = re_main.exec(doc)) { + console.log(match); + + } + while (match = re_test.exec(doc)) { + console.log(match); + lenses.push(this.createTestCodeLens(document, match.index, match[4], match[0].length)) } - return [this.createCodeLens(document, main + 1)] + return lenses } - private createCodeLens(document: TextDocument, offset: number): CodeLens { + private createMainCodeLens(document: TextDocument, offset: number, len: number): CodeLens { return new CodeLens( - toRange(document, offset, 'main'.length), + toRange(document, offset, len), { arguments: [document.uri], command: "koka.startWithoutDebugging", @@ -358,6 +374,16 @@ class MainCodeLensProvider implements vscode.CodeLensProvider { ) } + private createTestCodeLens(document: TextDocument, offset: number, functionName: string, len: number): CodeLens { + return new CodeLens( + toRange(document, offset, len), + { + arguments: [document.uri, functionName], + command: "koka.interpretExpression", + title: `Run ${functionName}`, + } + ) + } } function toRange(document: TextDocument, offset: number, length: number): vscode.Range { From 59f4bc94d89392496e537fab74fb778a01866967 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 9 Dec 2023 21:34:11 -0700 Subject: [PATCH 08/37] remove some trace statements --- src/Compiler/Compile.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index 0354cfa0e..5ede236c1 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -717,7 +717,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo Just mod -> if srcpath /= forceModule flags && modSourceTime mod == sourceTime then do - trace ("Loading module " ++ show mname ++ " from cache") $ return () + -- trace ("Loading module " ++ show mname ++ " from cache") $ return () x <- loadFromModule mname (modPath mod) root stem srcpath mod return $ Just x else @@ -728,7 +728,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return Nothing loadDepend iface root stem mname - = trace ("loadDepend " ++ iface ++ " root: " ++ root ++ " stem: " ++ stem) $ + = -- trace ("loadDepend " ++ iface ++ " root: " ++ root ++ " stem: " ++ stem) $ do let srcpath = joinPath root stem ifaceTime <- liftIO $ getCurrentFileTime iface maybeContents sourceTime <- liftIO $ getCurrentFileTime srcpath maybeContents @@ -756,13 +756,13 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo else loadFromSource False True modules root stem mname loadFromSource force genUpdate modules1 root stem mname - = trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " root:" ++ root ++ " stem:" ++ stem) $ + = -- trace ("loadFromSource: " ++ show force ++ " " ++ " update " ++ show genUpdate ++ " root:" ++ root ++ " stem:" ++ stem) $ do let fname = joinPath root stem cached <- tryLoadFromCache mname root stem mbIface <- liftIO $ searchOutputIface flags name let noNeedsGen = isJust mbIface || isInMemory compileTarget - trace ("loadFromSource: " ++ show (force, genUpdate, noNeedsGen, mbIface, compileTarget)) $ return () + -- trace ("loadFromSource: " ++ show (force, genUpdate, noNeedsGen, mbIface, compileTarget)) $ return () case cached of Just (mod, modules) | not genUpdate && not force && noNeedsGen -> do liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text "reusing:") <+> @@ -777,7 +777,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo return (mod, loadedModules loadedImp) loadFromIface iface root stem mname - = trace ("loadFromIFace: " ++ iface ++ ": root:" ++ root ++ " stem:" ++ stem ++ "\n in modules: " ++ show (map modName modules)) $ + = -- trace ("loadFromIFace: " ++ iface ++ ": root:" ++ root ++ " stem:" ++ stem ++ "\n in modules: " ++ show (map modName modules)) $ do let (pkgQname,pkgLocal) = packageInfoFromDir (packages flags) (dirname iface) loadMessage msg = liftIO $ termPhaseDoc term (color (colorInterpreter (colorScheme flags)) (text msg) <+> color (colorSource (colorScheme flags)) @@ -802,7 +802,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo loadFromModule mname (modPath mod){-iface-} root stem (joinPath root stem) mod loadFromModule mname iface root stem source mod - = trace ("load from module: " ++ iface ++ ": " ++ root ++ "/" ++ source) $ + = -- trace ("load from module: " ++ iface ++ ": " ++ root ++ "/" ++ source) $ do -- loaded = initialLoaded { loadedModule = mod -- , loadedModules = allmods -- } @@ -820,11 +820,11 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo -- load from source after all loadFromSource True True resolved1 root stem (nameFromFile iface) else - trace ("using loaded module: " ++ show (modName mod) ++ " compile target " ++ show compileTarget) $ + -- trace ("using loaded module: " ++ show (modName mod) ++ " compile target " ++ show compileTarget) $ case compileTarget of InMemory -> return result _ -> do - trace ("loaded module requires compiling") $ return () + -- trace ("loaded module requires compiling") $ return () outputTime <- liftIO $ getFileTime iface if fromJust (modTime mod) > outputTime then do -- (imports,resolved1) <- resolveImportModules Object maybeContents name term flags (dirname iface) modules cachedModules (name:importPath) (map ImpCore (Core.coreProgImports (modCore mod))) From c549db3991f43e93af01e2b114c4318cc069d9c3 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 9 Dec 2023 21:36:13 -0700 Subject: [PATCH 09/37] allow loadedModules of loaded since I'm keeping each loaded state separately now --- src/LanguageServer/Handler/TextDocument.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/LanguageServer/Handler/TextDocument.hs b/src/LanguageServer/Handler/TextDocument.hs index 465b29940..f6e2d1978 100644 --- a/src/LanguageServer/Handler/TextDocument.hs +++ b/src/LanguageServer/Handler/TextDocument.hs @@ -164,11 +164,12 @@ recompileFile compileTarget uri version force flags = modifyLSState (\old -> old{documentInfos = newvfs}) let contents = fst <$> maybeContents newvfs filePath modules <- getModules + loaded <- getLoaded uri term <- getTerminal sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath let resultIO :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) - resultIO = try $ compileFile (maybeContents newvfs) contents term flags [] (if force then [] else modules) compileTarget [] filePath + resultIO = try $ compileFile (maybeContents newvfs) contents term flags (maybe [] loadedModules loaded) (if force then [] else modules) compileTarget [] filePath result <- liftIO resultIO case result of Right res -> do From fc0f56621b1514e2807226c48a4ed4e3f1eb54f0 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 9 Dec 2023 22:38:51 -0700 Subject: [PATCH 10/37] update comment --- src/LanguageServer/Handler/TextDocument.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/LanguageServer/Handler/TextDocument.hs b/src/LanguageServer/Handler/TextDocument.hs index f6e2d1978..550d76d41 100644 --- a/src/LanguageServer/Handler/TextDocument.hs +++ b/src/LanguageServer/Handler/TextDocument.hs @@ -169,7 +169,8 @@ recompileFile compileTarget uri version force flags = sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath let resultIO :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) - resultIO = try $ compileFile (maybeContents newvfs) contents term flags (maybe [] loadedModules loaded) (if force then [] else modules) compileTarget [] filePath + -- Don't use the cached modules as regular modules (they may be out of date, so we want to resolveImports fully over again) + resultIO = try $ compileFile (maybeContents newvfs) contents term flags [] (if force then [] else modules) compileTarget [] filePath result <- liftIO resultIO case result of Right res -> do From 0b8e81a9585d07b69bc146d81e3afdbc941b66e6 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 9 Dec 2023 22:43:17 -0700 Subject: [PATCH 11/37] remove additional trace --- src/Compiler/Compile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index 5ede236c1..9d396eba4 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -816,7 +816,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo if (latest > (fromJust $ modTime mod) && not (null source)) -- happens if no source is present but (package) depencies have updated... then do - trace ("iface " ++ show (modName mod) ++ " is out of date, reloading..." ++ (show (modTime mod) ++ " dependencies:\n" ++ intercalate "\n" (map (\m -> show (modName m, modTime m)) imports))) $ return () + -- trace ("iface " ++ show (modName mod) ++ " is out of date, reloading..." ++ (show (modTime mod) ++ " dependencies:\n" ++ intercalate "\n" (map (\m -> show (modName m, modTime m)) imports))) $ return () -- load from source after all loadFromSource True True resolved1 root stem (nameFromFile iface) else From 957e39c486a35b1c1ba61443c871f19e5d1ba04a Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Mon, 11 Dec 2023 09:51:47 -0700 Subject: [PATCH 12/37] a bit more strict --- src/LanguageServer/Monad.hs | 20 ++++++++++---------- src/LanguageServer/Run.hs | 9 ++++----- 2 files changed, 14 insertions(+), 15 deletions(-) diff --git a/src/LanguageServer/Monad.hs b/src/LanguageServer/Monad.hs index f11dc167b..c936ddd5e 100644 --- a/src/LanguageServer/Monad.hs +++ b/src/LanguageServer/Monad.hs @@ -27,7 +27,7 @@ where import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, putMVar, readMVar, newEmptyMVar) import Control.Monad.Reader (ReaderT, ask, runReaderT) import Control.Monad.Trans (lift, liftIO) -import qualified Data.Map as M +import qualified Data.Map.Strict as M import qualified Data.Text as T import Language.LSP.Server (LanguageContextEnv, LspT, runLspT, sendNotification, Handlers) import qualified Language.LSP.Protocol.Types as J @@ -63,16 +63,16 @@ import Compiler.Module (Modules) -- The language server's state, e.g. holding loaded/compiled modules. data LSState = LSState { - lsModules :: [Module], - lsLoaded :: M.Map FilePath Loaded, - messages :: TChan (String, J.MessageType), - flags:: Flags, - terminal:: Terminal, + lsModules :: ![Module], + lsLoaded :: !(M.Map FilePath Loaded), + messages :: !(TChan (String, J.MessageType)), + flags:: !Flags, + terminal:: !Terminal, htmlPrinter :: Doc -> IO T.Text, - pendingRequests :: TVar (Set.Set J.SomeLspId), - cancelledRequests :: TVar (Set.Set J.SomeLspId), - documentVersions :: TVar (M.Map J.Uri J.Int32), - documentInfos :: M.Map FilePath (D.ByteString, FileTime, J.Int32) } + pendingRequests :: !(TVar (Set.Set J.SomeLspId)), + cancelledRequests :: !(TVar (Set.Set J.SomeLspId)), + documentVersions :: !(TVar (M.Map J.Uri J.Int32)), + documentInfos :: !(M.Map FilePath (D.ByteString, FileTime, J.Int32)) } trimnl :: [Char] -> [Char] trimnl str = reverse $ dropWhile (`elem` "\n\r\t ") $ reverse str diff --git a/src/LanguageServer/Run.hs b/src/LanguageServer/Run.hs index 14ab6cacb..04703915d 100644 --- a/src/LanguageServer/Run.hs +++ b/src/LanguageServer/Run.hs @@ -45,7 +45,7 @@ runLanguageServer flags files = do $ ServerDefinition { onConfigurationChange = const $ pure $ Right (), - doInitialize = \env _ -> forkIO (reactor rin) >> forkIO (messageHandler (messages initStateVal) env) >> pure (Right env), + doInitialize = \env _ -> forkIO (reactor rin) >> forkIO (messageHandler (messages initStateVal) env state) >> pure (Right env), staticHandlers = \_caps -> lspHandlers rin, interpretHandler = \env -> Iso (\lsm -> runLSM lsm state env) liftIO, options = @@ -75,12 +75,11 @@ runLanguageServer flags files = do (Just False) -- will save (wait until requests are sent to server) (Just $ J.InR $ J.SaveOptions $ Just False) -- trigger on save, but dont send document -messageHandler :: TChan (String, J.MessageType) -> LanguageContextEnv () -> IO () -messageHandler msgs env = do +messageHandler :: TChan (String, J.MessageType) -> LanguageContextEnv () -> MVar LSState -> IO () +messageHandler msgs env state = do forever $ do (msg, msgType) <- atomically $ readTChan msgs - mVar <- newEmptyMVar - runLSM (sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams msgType $ T.pack msg) mVar env + runLSM (sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams msgType $ T.pack msg) state env reactor :: TChan ReactorInput -> IO () reactor inp = do From e151de2aece084a00243dc95ea63d85257f51b3c Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Mon, 11 Dec 2023 23:28:52 -0700 Subject: [PATCH 13/37] more precise diagnostics (correct files and clearing / persisting at better times) --- src/LanguageServer/Conversions.hs | 37 +++++++++++++--------- src/LanguageServer/Handler/TextDocument.hs | 18 +++++++---- src/LanguageServer/Monad.hs | 20 ++++++++++-- 3 files changed, 51 insertions(+), 24 deletions(-) diff --git a/src/LanguageServer/Conversions.hs b/src/LanguageServer/Conversions.hs index 61ed765f8..c7597a51e 100644 --- a/src/LanguageServer/Conversions.hs +++ b/src/LanguageServer/Conversions.hs @@ -27,6 +27,7 @@ import qualified Common.Error as E import qualified Common.Range as R import qualified Data.Text as T import qualified Language.LSP.Protocol.Types as J +import Data.Map.Strict as M hiding (map) import Colog.Core import Language.LSP.Protocol.Types (UInt) import Lib.PPrint (Doc) @@ -35,6 +36,7 @@ import Compiler.Module (Module (..), Loaded (..)) import Data.Maybe (fromMaybe) import Data.List (find) import Common.File (normalize, realPath) +import Common.Range (sourceNull, Source (sourceName)) toLspPos :: R.Pos -> J.Position toLspPos p = @@ -59,23 +61,28 @@ toLspLocationLink src r = where uri = J.filePathToUri $ R.sourceName $ R.rangeSource r -toLspDiagnostics :: T.Text -> E.Error b a -> [J.Diagnostic] -toLspDiagnostics src err = +toLspDiagnostics :: J.NormalizedUri -> T.Text -> E.Error b a -> M.Map J.NormalizedUri [J.Diagnostic] +toLspDiagnostics uri src err = case E.checkError err of - Right (_, ws) -> map (uncurry $ toLspWarningDiagnostic src) ws - Left e -> toLspErrorDiagnostics src e + Right (_, ws) -> M.fromList $ map (\(r, doc) -> (uriFromRange r uri, [toLspWarningDiagnostic src r doc])) ws + Left e -> toLspErrorDiagnostics uri src e -toLspErrorDiagnostics :: T.Text -> E.ErrorMessage -> [J.Diagnostic] -toLspErrorDiagnostics src e = +toLspErrorDiagnostics :: J.NormalizedUri -> T.Text -> E.ErrorMessage -> M.Map J.NormalizedUri [J.Diagnostic] +toLspErrorDiagnostics uri src e = case e of - E.ErrorGeneral r doc -> [makeDiagnostic J.DiagnosticSeverity_Error src r doc] - E.ErrorParse r doc -> [makeDiagnostic J.DiagnosticSeverity_Error src r doc] - E.ErrorStatic rds -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds - E.ErrorKind rds -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds - E.ErrorType rds -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds - E.ErrorWarning rds e' -> map (uncurry $ makeDiagnostic J.DiagnosticSeverity_Error src) rds ++ toLspErrorDiagnostics src e' - E.ErrorIO doc -> [makeDiagnostic J.DiagnosticSeverity_Error src R.rangeNull doc] - E.ErrorZero -> [] + E.ErrorGeneral r doc -> M.singleton (uriFromRange r uri) [makeDiagnostic J.DiagnosticSeverity_Error src r doc] + E.ErrorParse r doc -> M.singleton (uriFromRange r uri) [makeDiagnostic J.DiagnosticSeverity_Error src r doc] + E.ErrorStatic rds -> mapRangeDocs rds + E.ErrorKind rds -> mapRangeDocs rds + E.ErrorType rds -> mapRangeDocs rds + E.ErrorWarning rds e' -> M.unionWith (++) (mapRangeDocs rds) (toLspErrorDiagnostics uri src e') + E.ErrorIO doc -> M.singleton uri [makeDiagnostic J.DiagnosticSeverity_Error src R.rangeNull doc] + E.ErrorZero -> M.empty + where mapRangeDocs rds = M.fromList $ map (\(r, doc) -> (uriFromRange r uri, [makeDiagnostic J.DiagnosticSeverity_Error src r doc])) rds + +uriFromRange :: R.Range -> J.NormalizedUri -> J.NormalizedUri +uriFromRange r uri = + if R.rangeSource r == sourceNull then uri else J.toNormalizedUri $ J.filePathToUri $ sourceName (R.rangeSource r) toLspWarningDiagnostic :: T.Text -> R.Range -> Doc -> J.Diagnostic toLspWarningDiagnostic = @@ -86,10 +93,10 @@ makeDiagnostic s src r doc = J.Diagnostic range severity code codeDescription source message tags related dataX where range = toLspRange r + source = Just src severity = Just s code = Nothing codeDescription = Nothing - source = Just src message = T.pack $ show doc tags | "is unused" `T.isInfixOf` message = Just [J.DiagnosticTag_Unnecessary] diff --git a/src/LanguageServer/Handler/TextDocument.hs b/src/LanguageServer/Handler/TextDocument.hs index 550d76d41..7a8affdd3 100644 --- a/src/LanguageServer/Handler/TextDocument.hs +++ b/src/LanguageServer/Handler/TextDocument.hs @@ -26,7 +26,7 @@ import Language.LSP.Server (Handlers, flushDiagnosticsBySource, publishDiagnosti import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import LanguageServer.Conversions (toLspDiagnostics) -import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded, getModules) +import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded, getModules, putDiagnostics, getDiagnostics, clearDiagnostics) import Language.LSP.VFS (virtualFileText, VFS(..), VirtualFile, file_version, virtualFileVersion) import qualified Data.Text.Encoding as T import Data.Functor ((<&>)) @@ -136,12 +136,14 @@ compileEditorExpression uri flags filePath functionName = do return Nothing -- Emit the diagnostics (errors and warnings) let diagSrc = T.pack "koka" - diags = toLspDiagnostics diagSrc res - diagsBySrc = partitionBySource diags + diags = toLspDiagnostics normUri diagSrc res + diagsBySrc = M.map partitionBySource diags maxDiags = 100 + if null diags then clearDiagnostics normUri else putDiagnostics diags + diags <- getDiagnostics if null diags then flushDiagnosticsBySource maxDiags (Just diagSrc) - else publishDiagnostics maxDiags normUri Nothing diagsBySrc + else mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) return outFile Left e -> do sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) @@ -192,12 +194,14 @@ recompileFile compileTarget uri version force flags = return Nothing -- Emit the diagnostics (errors and warnings) let diagSrc = T.pack "koka" - diags = toLspDiagnostics diagSrc res - diagsBySrc = partitionBySource diags + diags = toLspDiagnostics normUri diagSrc res + diagsBySrc = M.map partitionBySource diags maxDiags = 100 + if null diags then clearDiagnostics normUri else putDiagnostics diags + diags <- getDiagnostics if null diags then flushDiagnosticsBySource maxDiags (Just diagSrc) - else publishDiagnostics maxDiags normUri version diagsBySrc + else mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) return outFile Left e -> do sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) diff --git a/src/LanguageServer/Monad.hs b/src/LanguageServer/Monad.hs index c936ddd5e..bf547fddf 100644 --- a/src/LanguageServer/Monad.hs +++ b/src/LanguageServer/Monad.hs @@ -20,6 +20,9 @@ module LanguageServer.Monad getModules, getColorScheme, getHtmlPrinter, + getDiagnostics, + putDiagnostics, + clearDiagnostics, runLSM, ) where @@ -60,6 +63,7 @@ import qualified Data.ByteString as D import Platform.Filetime (FileTime) import Common.File (realPath,normalize) import Compiler.Module (Modules) +import Data.Maybe (fromMaybe) -- The language server's state, e.g. holding loaded/compiled modules. data LSState = LSState { @@ -72,7 +76,9 @@ data LSState = LSState { pendingRequests :: !(TVar (Set.Set J.SomeLspId)), cancelledRequests :: !(TVar (Set.Set J.SomeLspId)), documentVersions :: !(TVar (M.Map J.Uri J.Int32)), - documentInfos :: !(M.Map FilePath (D.ByteString, FileTime, J.Int32)) } + documentInfos :: !(M.Map FilePath (D.ByteString, FileTime, J.Int32)), + diagnostics :: !(M.Map J.NormalizedUri [J.Diagnostic]) +} trimnl :: [Char] -> [Char] trimnl str = reverse $ dropWhile (`elem` "\n\r\t ") $ reverse str @@ -106,7 +112,7 @@ defaultLSState flags = do (if verbose flags > 0 then (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) else (\_ -> return ())) (\tp -> withNewPrinter $ \p -> do putScheme p (prettyEnv flags nameNil importsEmpty) tp; return J.MessageType_Info) (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) - return LSState {lsLoaded = M.empty,lsModules=[], messages = msgChan, terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, documentInfos = M.empty, documentVersions = fileVersions} + return LSState {lsLoaded = M.empty,lsModules=[], messages = msgChan, terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, documentInfos = M.empty, documentVersions = fileVersions, diagnostics = M.empty} putScheme p env tp = writePrettyLn p (ppScheme env tp) @@ -141,6 +147,16 @@ modifyLSState m = do getModules :: LSM Modules getModules = lsModules <$> getLSState +putDiagnostics :: M.Map J.NormalizedUri [J.Diagnostic] -> LSM () +putDiagnostics diags = -- Left biased union prefers more recent diagnostics + modifyLSState $ \s -> s {diagnostics = M.union diags (diagnostics s)} + +getDiagnostics :: LSM (M.Map J.NormalizedUri [J.Diagnostic]) +getDiagnostics = diagnostics <$> getLSState + +clearDiagnostics :: J.NormalizedUri -> LSM () +clearDiagnostics uri = modifyLSState $ \s -> s {diagnostics = M.delete uri (diagnostics s)} + -- Fetches the loaded state holding compiled modules getLoaded :: J.Uri -> LSM (Maybe Loaded) getLoaded uri = do From 3707e2444a17566e0fc2471b93dfa22dc4d6051a Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Tue, 12 Dec 2023 11:07:09 -0700 Subject: [PATCH 14/37] Add inlay types and fix buffering of stdout --- koka.cabal | 3 +- src/Kind/Infer.hs | 4 +- src/LanguageServer/Handler/Completion.hs | 11 ++- src/LanguageServer/Handler/Hover.hs | 3 +- src/LanguageServer/Handler/InlayHints.hs | 81 +++++++++++++++++++ src/LanguageServer/Handlers.hs | 4 +- src/LanguageServer/Run.hs | 11 ++- src/Syntax/Colorize.hs | 2 +- src/Syntax/RangeMap.hs | 19 +++-- src/Type/Infer.hs | 24 +++--- stack.yaml | 4 +- .../vscode/koka.language-koka/package.json | 5 +- 12 files changed, 138 insertions(+), 33 deletions(-) create mode 100644 src/LanguageServer/Handler/InlayHints.hs diff --git a/koka.cabal b/koka.cabal index 3537b8d2d..a8c9d3a2f 100644 --- a/koka.cabal +++ b/koka.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -98,6 +98,7 @@ executable koka LanguageServer.Handler.Definition LanguageServer.Handler.DocumentSymbol LanguageServer.Handler.Hover + LanguageServer.Handler.InlayHints LanguageServer.Handler.TextDocument LanguageServer.Handlers LanguageServer.Monad diff --git a/src/Kind/Infer.hs b/src/Kind/Infer.hs index eacc12529..6ee46456d 100644 --- a/src/Kind/Infer.hs +++ b/src/Kind/Infer.hs @@ -405,7 +405,7 @@ infExternal names (External name tp pinfos nameRng rng calls vis fip doc) canonicalName n qname if (isHiddenName name) then return () - else do addRangeInfo nameRng (Id qname (NIValue tp') True) + else do addRangeInfo nameRng (Id qname (NIValue tp' True) True) addRangeInfo rng (Decl "external" qname (mangle cname tp')) -- trace ("infExternal: " ++ show cname ++ ": " ++ show (pretty tp')) $ return (Core.External cname tp' pinfos (map (formatCall tp') calls) @@ -966,7 +966,7 @@ resolveConParam idmap (vis,vb) Just e -> {- do e' <- infExpr e return (Just e') -} return (Just (failure "Kind.Infer.resolveConParam: optional parameter expression in constructor")) - addRangeInfo (binderNameRange vb) (Id (binderName vb) (NIValue tp) True) + addRangeInfo (binderNameRange vb) (Id (binderName vb) (NIValue tp True) True) return (vis,vb{ binderType = tp, binderExpr = expr }) -- | @resolveType@ takes: a map from locally quantified type name variables to types, diff --git a/src/LanguageServer/Handler/Completion.hs b/src/LanguageServer/Handler/Completion.hs index 8cd6f31bf..2a52413ac 100644 --- a/src/LanguageServer/Handler/Completion.hs +++ b/src/LanguageServer/Handler/Completion.hs @@ -115,7 +115,7 @@ getCompletionInfo pos@(J.Position l c) (VirtualFile _ _ ropetext) mod uri = case reverse parts of [] -> Nothing (x:xs) -> do - trace ("parts: " ++ show parts) $ return () + -- trace ("parts: " ++ show parts) $ return () let modName = case filter (not .T.null) xs of {x:xs -> x; [] -> ""} argumentText <- Rope.toText . fst <$> Rope.splitAt (fromIntegral c) currentRope let isFunctionCompletion = if | T.null argumentText -> False @@ -135,9 +135,11 @@ getCompletionInfo pos@(J.Position l c) (VirtualFile _ _ ropetext) mod uri = -- currentRope is already a single line, but it may include an enclosing '\n' let curLine = T.dropWhileEnd (== '\n') $ Rope.toText currentRope let pi = PositionInfo curLine modName x pos currentType isFunctionCompletion - return $ trace (show pi) pi + return -- $ trace (show pi) + pi in - trace (show result) $ return result + -- trace (show result) $ + return result -- TODO: Complete local variables -- TODO: Show documentation comments in completion docs @@ -318,7 +320,8 @@ makeFunctionCompletionItem curModName funName d funType accessor rng line = Nothing -> Nothing Just (_, _, args, _, _) -> Just args argumentsText = - if numArgs == 0 then trace ("No function arguments for " ++ show label) $ T.pack "" + if numArgs == 0 then -- trace ("No function arguments for " ++ show label) $ + T.pack "" else case trailingFunArgTp of Nothing -> "(" <> T.intercalate "," (map (\i -> T.pack $ "$" ++ show i) [1..numArgs]) <> ")" Just tp -> diff --git a/src/LanguageServer/Handler/Hover.hs b/src/LanguageServer/Handler/Hover.hs index 0574770dd..4b2c89feb 100644 --- a/src/LanguageServer/Handler/Hover.hs +++ b/src/LanguageServer/Handler/Hover.hs @@ -8,7 +8,6 @@ module LanguageServer.Handler.Hover (hoverHandler, formatRangeInfoHover) where import Compiler.Module (loadedModule, modRangeMap, Loaded (loadedModules, loadedImportMap), Module (modPath, modSourcePath)) import Control.Lens ((^.)) -import qualified Data.Map as M import qualified Data.Text as T import Language.LSP.Server (Handlers, sendNotification, requestHandler) import qualified Language.LSP.Protocol.Types as J @@ -60,7 +59,7 @@ formatRangeInfoHover print flags mName imports rinfo = case rinfo of Id qname info isdef -> print $ (ppName env{colors=colors{colorSource = Gray}} qname) <+> text " : " <+> case info of - NIValue tp -> ppScheme env tp + NIValue tp _ -> ppScheme env tp NICon tp -> ppScheme env tp NITypeCon k -> prettyKind colors k NITypeVar k -> prettyKind colors k diff --git a/src/LanguageServer/Handler/InlayHints.hs b/src/LanguageServer/Handler/InlayHints.hs new file mode 100644 index 000000000..73197fa2e --- /dev/null +++ b/src/LanguageServer/Handler/InlayHints.hs @@ -0,0 +1,81 @@ +----------------------------------------------------------------------------- +-- The LSP handler that provides hover tooltips +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} + +module LanguageServer.Handler.InlayHints (inlayHintsHandler) where + +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J +import qualified Language.LSP.Protocol.Lens as J +import Language.LSP.Server (Handlers, sendNotification, requestHandler) +import LanguageServer.Monad (LSM, getLoaded, getLoadedModule, getFlags) +import LanguageServer.Conversions (fromLspPos, toLspRange, toLspPos, fromLspRange) +import LanguageServer.Handler.Hover (formatRangeInfoHover) +import qualified Data.Text as T +import Common.Range (Range (..), rangeEnd, Pos(..), rangeNull, posNull) +import Syntax.RangeMap (NameInfo (..), RangeInfo (..), rangeMapFindIn) +import Control.Lens ((^.)) +import Data.Maybe (mapMaybe) +import Type.Pretty (ppType, Env (..), defaultEnv, ppScheme) +import Common.Name (Name) +import Compiler.Compile (Module(..), Loaded (..)) +import Kind.ImportMap (ImportMap) +import Compiler.Options (prettyEnvFromFlags) +-- import Debug.Trace (trace) + +inlayHintsHandler :: Handlers LSM +inlayHintsHandler = requestHandler J.SMethod_TextDocumentInlayHint $ \req responder -> do + let J.InlayHintParams prog doc rng = req ^. J.params + uri = doc ^. J.uri + newRng = fromLspRange uri rng + loadedMod <- getLoadedModule uri + loaded <- getLoaded uri + flags <- getFlags + let toInlayHint :: ImportMap -> Name -> (Range, RangeInfo) -> Maybe J.InlayHint + toInlayHint imports modName (rng, rngInfo) = + let env = (prettyEnvFromFlags flags){ context = modName, importsMap = imports } in + let rngEnd = rangeEnd rng + shouldShow = + (rngEnd /= posNull) && + case rngInfo of + Id _ info _ -> case info of + NIValue _ isAnnotated -> not isAnnotated + NICon _ -> False + NITypeCon _ -> False + NITypeVar _ -> False + NIModule -> False + NIKind -> False + Decl{} -> False + Block _ -> False + Error _ -> False + Warning _ -> False + in + if shouldShow then + Just $ J.InlayHint (toLspPos rngEnd{posColumn = posColumn rngEnd + 1}) (J.InL $ T.pack $ formatInfo env modName rngInfo) (Just J.InlayHintKind_Type) Nothing Nothing (Just True) (Just True) Nothing + else Nothing + rsp = do + l <- loaded + lm <- loadedMod + rmap <- modRangeMap lm + -- trace (show $ rangeMapFindIn newRng rmap) $ return () + return $ mapMaybe (toInlayHint (loadedImportMap l) (modName lm)) $ rangeMapFindIn newRng rmap + case rsp of + Nothing -> responder $ Right $ J.InR J.Null + Just rsp -> responder $ Right $ J.InL rsp + +-- Pretty-prints type/kind information to a hover tooltip +formatInfo :: Env -> Name -> RangeInfo -> String +formatInfo env modName rinfo = case rinfo of + Id qname info isdef -> + case info of + NIValue tp _ -> " : " ++ show (ppScheme env tp) + NICon tp -> "" + NITypeCon k -> "" + NITypeVar k -> "" + NIModule -> "" + NIKind -> "" + Decl s name mname -> "" + Block s -> "" + Error doc -> "Error: " ++ show doc + Warning doc -> "Warning: " ++ show doc \ No newline at end of file diff --git a/src/LanguageServer/Handlers.hs b/src/LanguageServer/Handlers.hs index 802ace351..a00930b6c 100644 --- a/src/LanguageServer/Handlers.hs +++ b/src/LanguageServer/Handlers.hs @@ -16,6 +16,7 @@ import LanguageServer.Handler.Completion (completionHandler) import LanguageServer.Handler.Definition (definitionHandler) import LanguageServer.Handler.DocumentSymbol (documentSymbolHandler) import LanguageServer.Handler.Hover (hoverHandler) +import LanguageServer.Handler.InlayHints (inlayHintsHandler) import LanguageServer.Handler.Commands (initializedHandler, commandHandler) import LanguageServer.Handler.TextDocument (didChangeHandler, didCloseHandler, didOpenHandler, didSaveHandler) import LanguageServer.Monad (LSM, runLSM, putLSState, LSState (..)) @@ -104,7 +105,8 @@ handlers = documentSymbolHandler, completionHandler, cancelHandler, - commandHandler + commandHandler, + inlayHintsHandler ] cancelHandler :: Handlers LSM diff --git a/src/LanguageServer/Run.hs b/src/LanguageServer/Run.hs index 04703915d..ff4108d71 100644 --- a/src/LanguageServer/Run.hs +++ b/src/LanguageServer/Run.hs @@ -28,9 +28,12 @@ import Network.Socket hiding (connect) import GHC.IO.IOMode (IOMode(ReadWriteMode)) import GHC.Conc (atomically) import LanguageServer.Handler.TextDocument (persistModules) +import GHC.IO.Handle (BufferMode(NoBuffering), hSetBuffering) +import GHC.IO.StdHandles (stdout) runLanguageServer :: Flags -> [FilePath] -> IO () runLanguageServer flags files = do + hSetBuffering stdout LineBuffering connect "127.0.0.1" (show $ languageServerPort flags) (\(socket, _) -> do handle <- socketToHandle socket ReadWriteMode state <- newLSStateVar flags @@ -44,7 +47,10 @@ runLanguageServer flags files = do handle $ ServerDefinition - { onConfigurationChange = const $ pure $ Right (), + { parseConfig = const $ const $ Right (), + onConfigChange = const $ pure (), + defaultConfig = (), + configSection = T.pack "koka", doInitialize = \env _ -> forkIO (reactor rin) >> forkIO (messageHandler (messages initStateVal) env state) >> pure (Right env), staticHandlers = \_caps -> lspHandlers rin, interpretHandler = \env -> Iso (\lsm -> runLSM lsm state env) liftIO, @@ -54,8 +60,7 @@ runLanguageServer flags files = do optExecuteCommandCommands = Just [T.pack "koka/genCode", T.pack "koka/interpretExpression"] -- optCompletionTriggerCharacters = Just ['.', ':', '/'] -- TODO: ? https://www.stackage.org/haddock/lts-18.21/lsp-1.2.0.0/src/Language.LSP.Server.Core.html#Options - }, - defaultConfig = () + } }) where prettyMsg l = "[" <> show (L.getSeverity l) <> "] " <> show (L.getMsg l) <> "\n\n" diff --git a/src/Syntax/Colorize.hs b/src/Syntax/Colorize.hs index 39f3cff62..75ab84139 100644 --- a/src/Syntax/Colorize.hs +++ b/src/Syntax/Colorize.hs @@ -152,7 +152,7 @@ transform isLiterate rng rangeMap env lexeme content in (ranges, case info of - NIValue tp -> signature env toLit isLiterate "type" qname (mangle qname tp) (showType env tp) $ + NIValue tp _ -> signature env toLit isLiterate "type" qname (mangle qname tp) (showType env tp) $ (case lexeme of (Lexeme _ (LexKeyword _ _)) -> cspan "keyword" pcontent -- for 'return' _ -> pcontent) NICon tp -> signature env toLit isLiterate "type" qname (mangleConName qname) (showType env tp) $ cspan "constructor" pcontent diff --git a/src/Syntax/RangeMap.hs b/src/Syntax/RangeMap.hs index 95a8626a4..ea993b12b 100644 --- a/src/Syntax/RangeMap.hs +++ b/src/Syntax/RangeMap.hs @@ -11,6 +11,7 @@ module Syntax.RangeMap( RangeMap, RangeInfo(..), NameInfo(..) , rangeMapSort , rangeMapLookup , rangeMapFindAt + , rangeMapFindIn , rangeMapAppend , rangeInfoType , mangle @@ -64,7 +65,7 @@ data RangeInfo | Id Name NameInfo Bool -- qualified name, info, is the definition data NameInfo - = NIValue Type + = NIValue Type Bool -- Has annotated type already | NICon Type | NITypeCon Kind | NITypeVar Kind @@ -101,7 +102,7 @@ penalty name instance Enum NameInfo where fromEnum ni = case ni of - NIValue _ -> 1 + NIValue _ _ -> 1 NICon _ -> 2 NITypeCon _ -> 3 NITypeVar _ -> 4 @@ -164,6 +165,12 @@ rangeMapLookup r (RM rm) eq (_,ri1) (_,ri2) = (EQ == compare ((fromEnum ri1) `div` 10) ((fromEnum ri2) `div` 10)) cmp (_,ri1) (_,ri2) = compare (fromEnum ri1) (fromEnum ri2) +rangeMapFindIn :: Range -> RangeMap -> [(Range, RangeInfo)] +rangeMapFindIn rng (RM rm) + = filter (\(rng, info) -> rangeStart rng >= start || rangeEnd rng <= end) rm + where start = rangeStart rng + end = rangeEnd rng + rangeMapFindAt :: Pos -> RangeMap -> Maybe (Range, RangeInfo) rangeMapFindAt pos (RM rm) = shortestRange $ filter (containsPos . fst) rm @@ -177,7 +184,7 @@ rangeInfoType :: RangeInfo -> Maybe Type rangeInfoType ri = case ri of Id _ info _ -> case info of - NIValue tp -> Just tp + NIValue tp _ -> Just tp NICon tp -> Just tp _ -> Nothing _ -> Nothing @@ -205,18 +212,18 @@ instance HasTypeVar RangeInfo where instance HasTypeVar NameInfo where sub `substitute` ni = case ni of - NIValue tp -> NIValue (sub `substitute` tp) + NIValue tp annotated -> NIValue (sub `substitute` tp) annotated NICon tp -> NICon (sub `substitute` tp) _ -> ni ftv ni = case ni of - NIValue tp -> ftv tp + NIValue tp _ -> ftv tp NICon tp -> ftv tp _ -> tvsEmpty btv ni = case ni of - NIValue tp -> btv tp + NIValue tp _ -> btv tp NICon tp -> btv tp _ -> tvsEmpty diff --git a/src/Type/Infer.hs b/src/Type/Infer.hs index a79fe99d1..a909ccde5 100644 --- a/src/Type/Infer.hs +++ b/src/Type/Infer.hs @@ -273,7 +273,7 @@ addRangeInfoCoreDef topLevel mod def coreDef = let qname = if (topLevel && not (isQualified (Core.defName coreDef))) then qualify mod (Core.defName coreDef) else Core.defName coreDef - in do addRangeInfo (Core.defNameRange coreDef) (RM.Id qname (RM.NIValue (Core.defType coreDef)) True) + in do addRangeInfo (Core.defNameRange coreDef) (RM.Id qname (RM.NIValue (Core.defType coreDef) True) True) addRangeInfo (defRange def) (RM.Decl (if defIsVal def then "val" else "fun") qname (RM.mangle qname (Core.defType coreDef))) @@ -460,6 +460,10 @@ inferDef expect (Def (ValueBinder name mbTp expr nameRng vrng) rng vis sort inl else return () subst (Core.Def name resTp resCore vis sort inl nameRng doc) -- must 'subst' since the total unification can cause substitution. (see test/type/hr1a) +isAnnotatedBinder :: ValueBinder (Maybe Type) x -> Bool +isAnnotatedBinder (ValueBinder _ Just{} _ _ _) = True +isAnnotatedBinder _ = False + inferBindDef :: Def Type -> Inf (Effect,Core.Def) inferBindDef (Def (ValueBinder name () expr nameRng vrng) rng vis sort inl doc) = -- trace ("infer bind def: " ++ show name ++ ", var?:" ++ show (sort==DefVar)) $ @@ -478,7 +482,7 @@ inferBindDef (Def (ValueBinder name () expr nameRng vrng) rng vis sort inl doc) return (Core.Def name refTp refExpr vis sort inl nameRng doc) if (not (isWildcard name)) - then addRangeInfo nameRng (RM.Id name (RM.NIValue (Core.defType coreDef)) True) + then addRangeInfo nameRng (RM.Id name (RM.NIValue (Core.defType coreDef) (isAnnot expr)) True) else if (isTypeUnit (Core.typeOf coreDef)) then return () else do seff <- subst eff @@ -608,7 +612,7 @@ inferExpr propagated expect (Lam binders body rng) else let b = head polyBinders in typeError (rng) (binderNameRange b) (text "unannotated parameters cannot be polymorphic") (binderType b) [(text "hint",text "annotate the parameter with a polymorphic type")] - mapM_ (\(binder,tp) -> addRangeInfo (binderNameRange binder) (RM.Id (binderName binder) (RM.NIValue tp) True)) (zip binders1 parTypes2) + mapM_ (\(arg,binder,tp) -> addRangeInfo (binderNameRange binder) (RM.Id (binderName binder) (RM.NIValue tp (case arg of {Just s -> True; Nothing -> False})) True)) (zip3 propArgs binders1 parTypes2) eff <- freshEffect return (ftp, eff, fcore ) @@ -640,7 +644,7 @@ inferExpr propagated expect (App (Var name _ nameRng) [(_,expr)] rng) | name == -> do inferUnify (checkReturn rng) (getRange expr) retTp tp resTp <- Op.freshTVar kindStar Meta let typeReturn = typeFun [(nameNil,tp)] typeTotal resTp - addRangeInfo nameRng (RM.Id (newName "return") (RM.NIValue tp) False) + addRangeInfo nameRng (RM.Id (newName "return") (RM.NIValue tp True) False) return (resTp, eff, Core.App (Core.Var (Core.TName nameReturn typeReturn) (Core.InfoExternal [(Default,"return #1")])) [core]) -- | Assign expression @@ -907,7 +911,7 @@ inferExpr propagated expect (Lit lit) inferExpr propagated expect (Parens expr name rng) = do (tp,eff,core) <- inferExpr propagated expect expr if (name /= nameNil) - then do addRangeInfo rng (RM.Id name (RM.NIValue tp) True) + then do addRangeInfo rng (RM.Id name (RM.NIValue tp True) True) else return () return (tp,eff,core) @@ -1441,21 +1445,21 @@ inferVar propagated expect name rng isRhs [(Nothing,App (Var nameByref False irng) [(Nothing,Var name False irng)] irng)] irng) name rng) - addRangeInfo rng (RM.Id qname (RM.NIValue tp1) False) + addRangeInfo rng (RM.Id qname (RM.NIValue tp1 True) False) -- traceDoc $ \env -> text " deref" <+> pretty name <+> text "to" <+> ppType env tp1 return (tp1,eff1,core1) else case info of InfoVal{ infoIsVar = True } | isRhs -- is it a right-hand side variable? -> do (tp1,eff1,core1) <- inferExpr propagated expect (App (Var nameDeref False rng) [(Nothing,App (Var nameByref False rng) [(Nothing,Var name False rng)] rng)] rng) - addRangeInfo rng (RM.Id qname (RM.NIValue tp1) False) + addRangeInfo rng (RM.Id qname (RM.NIValue tp1 True) False) return (tp1,eff1,core1) InfoVal{} | isValueOperation tp - -> do addRangeInfo rng (RM.Id qname (RM.NIValue tp) True) + -> do addRangeInfo rng (RM.Id qname (RM.NIValue tp True) True) inferExpr propagated expect (App (Var (toValueOperationName qname) False rangeNull) [] rangeNull) _ -> -- inferVarX propagated expect name rng qname1 tp1 info1 do let coreVar = coreExprFromNameInfo qname info -- traceDoc $ \env -> text "inferVar:" <+> pretty name <+> text ":" <+> text (show info) <.> text ":" <+> ppType env tp - addRangeInfo rng (RM.Id (infoCanonicalName qname info) (RM.NIValue tp) False) + addRangeInfo rng (RM.Id (infoCanonicalName qname info) (RM.NIValue tp True) False) (itp,coref) <- maybeInstantiate rng expect tp sitp <- subst itp -- traceDoc $ \env -> (text " Type.Infer.Var: " <+> pretty name <.> colon <+> ppType env{showIds=True} sitp) @@ -1638,7 +1642,7 @@ inferPattern matchType branchRange (PatVar binder) withPattern inferPart Nothing -- it is a variable indeed -> -} - do addRangeInfo (binderNameRange binder) (RM.Id (binderName binder) (RM.NIValue matchType) True) + do addRangeInfo (binderNameRange binder) (RM.Id (binderName binder) (RM.NIValue matchType (isAnnotatedBinder binder)) True) case (binderType binder) of Just tp -> inferUnify (checkAnn (getRange binder)) (binderNameRange binder) matchType tp Nothing -> return () diff --git a/stack.yaml b/stack.yaml index ab1ae3dfc..f16179709 100644 --- a/stack.yaml +++ b/stack.yaml @@ -29,8 +29,8 @@ extra-deps: - regex-compat-0.95.2.1 # only needed for koka-test (use 0.95.1.4 for pre lts-21.0) - json-0.10 # only needed for koka-test - isocline-1.0.7 -- lsp-2.1.0.0 # only needed for language server -- lsp-types-2.0.1.0 # only needed for language server +- lsp-2.3.0.0 # only needed for language server +- lsp-types-2.1.0.0 # only needed for language server - text-rope-0.2 # needed for lsp - co-log-core-0.3.2.0 # needed for lsp diff --git a/support/vscode/koka.language-koka/package.json b/support/vscode/koka.language-koka/package.json index 68c0a5095..dc540ebc2 100644 --- a/support/vscode/koka.language-koka/package.json +++ b/support/vscode/koka.language-koka/package.json @@ -87,7 +87,10 @@ "description": "The command to launch the Koka language server (by default the extension assumes that 'koka' is on your PATH)" }, "koka.languageServer.additionalArgs": { - "type": "string", + "type": "array", + "items": { + "type": "string" + }, "default": null, "description": "Additional arguments to send to the compiler when starting the language server" }, From 29129fc7145ed5d05c71efb63ef7594302496f69 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Tue, 12 Dec 2023 12:46:48 -0700 Subject: [PATCH 15/37] fix buffering --- src/LanguageServer/Run.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/LanguageServer/Run.hs b/src/LanguageServer/Run.hs index ff4108d71..1e70f89c0 100644 --- a/src/LanguageServer/Run.hs +++ b/src/LanguageServer/Run.hs @@ -28,12 +28,13 @@ import Network.Socket hiding (connect) import GHC.IO.IOMode (IOMode(ReadWriteMode)) import GHC.Conc (atomically) import LanguageServer.Handler.TextDocument (persistModules) -import GHC.IO.Handle (BufferMode(NoBuffering), hSetBuffering) -import GHC.IO.StdHandles (stdout) +import GHC.IO.Handle (BufferMode(LineBuffering), hSetBuffering) +import GHC.IO.StdHandles (stdout, stderr) runLanguageServer :: Flags -> [FilePath] -> IO () runLanguageServer flags files = do hSetBuffering stdout LineBuffering + hSetBuffering stderr LineBuffering connect "127.0.0.1" (show $ languageServerPort flags) (\(socket, _) -> do handle <- socketToHandle socket ReadWriteMode state <- newLSStateVar flags From d4bb2f32ed859acf3912033cd37fa23794c92906 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Tue, 12 Dec 2023 22:10:51 -0700 Subject: [PATCH 16/37] clean up a few small things with the extension --- support/vscode/koka.language-koka/src/extension.ts | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts index 263168cdf..6591cb50e 100644 --- a/support/vscode/koka.language-koka/src/extension.ts +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -25,8 +25,8 @@ export async function activate(context: vscode.ExtensionContext) { const { sdkPath, allSDKs } = scanForSDK(vsConfig) const config = new KokaConfig(vsConfig, sdkPath, allSDKs) if (!config.command) { - vscode.window.showInformationMessage(`Koka SDK found but not working ${config.sdkPath}\n All SDKs: ${allSDKs}`) - return + vscode.window.showInformationMessage(`Koka SDK not functional: tried initializing from path: ${config.sdkPath}\n All SDKs: ${allSDKs}`) + return // No use initializing the rest of the extension's features } if (config.debugExtension) { stderrOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stderr') @@ -218,10 +218,10 @@ function createCommands( console.log(`Launch config ${launchConfig}`) vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) }), - vscode.commands.registerCommand('koka.downloadLatest', (resource: vscode.Uri) => { + vscode.commands.registerCommand('koka.downloadLatest', () => { downloadSDK() }), - vscode.commands.registerCommand('koka.uninstall', (resource: vscode.Uri) => { + vscode.commands.registerCommand('koka.uninstall', () => { uninstallSDK() }), vscode.commands.registerCommand('koka.restartLanguageServer', () => { From 5b8e40faa1c0ec9388df5c57c35963655882366c Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Tue, 12 Dec 2023 22:24:10 -0700 Subject: [PATCH 17/37] update test function regex --- support/vscode/koka.language-koka/src/extension.ts | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts index 6591cb50e..40fe13738 100644 --- a/support/vscode/koka.language-koka/src/extension.ts +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -341,7 +341,7 @@ class MainCodeLensProvider implements vscode.CodeLensProvider { public async provideCodeLenses(document: TextDocument, token: CancellationToken): Promise { const doc = document.getText() const re_main = /((?<=\n)|^)((pub\s+)?fun\s+main\(\))/g; - const re_test = /((?<=\n)|^)((pub\s+)?fun\s+(test\w*)\(\))/g; + const re_test = /((?<=\n)|^)((pub\s+)?fun\s+(test[\w-]*)\(\))/g; let lenses = []; let match = null; console.log("Scanning document for main and test function"); From 5c16595ec3cc35f29676b50a1395969dff525486 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Thu, 14 Dec 2023 21:53:39 -0700 Subject: [PATCH 18/37] Create a separate main function that doesn't include language server. Also add a ton of comments --- app/Main.hs | 145 ++++++++++ koka.cabal | 92 +++++- .../LanguageServer/Conversions.hs | 18 +- .../LanguageServer/Handler/Commands.hs | 63 ++--- .../LanguageServer/Handler/Completion.hs | 15 +- .../LanguageServer/Handler/Definition.hs | 3 +- .../LanguageServer/Handler/DocumentSymbol.hs | 94 ++++-- .../LanguageServer/Handler/Hover.hs | 31 +- .../LanguageServer/Handler/InlayHints.hs | 69 +++-- .../LanguageServer/Handler/TextDocument.hs | 267 ++++++++++++++++++ .../LanguageServer/Handlers.hs | 100 ++++--- {src => lang-server}/LanguageServer/Monad.hs | 177 +++++++----- {src => lang-server}/LanguageServer/Run.hs | 23 +- {src => lang-server}/Main.hs | 0 package.yaml | 66 +++-- src/Compiler/Compile.hs | 12 +- src/Compiler/Options.hs | 2 +- src/Interpreter/Interpret.hs | 4 +- src/LanguageServer/Handler/TextDocument.hs | 247 ---------------- src/Syntax/Syntax.hs | 7 + src/Type/Pretty.hs | 12 +- 21 files changed, 897 insertions(+), 550 deletions(-) create mode 100644 app/Main.hs rename {src => lang-server}/LanguageServer/Conversions.hs (90%) rename {src => lang-server}/LanguageServer/Handler/Commands.hs (68%) rename {src => lang-server}/LanguageServer/Handler/Completion.hs (96%) rename {src => lang-server}/LanguageServer/Handler/Definition.hs (96%) rename {src => lang-server}/LanguageServer/Handler/DocumentSymbol.hs (60%) rename {src => lang-server}/LanguageServer/Handler/Hover.hs (74%) rename {src => lang-server}/LanguageServer/Handler/InlayHints.hs (53%) create mode 100644 lang-server/LanguageServer/Handler/TextDocument.hs rename {src => lang-server}/LanguageServer/Handlers.hs (70%) rename {src => lang-server}/LanguageServer/Monad.hs (83%) rename {src => lang-server}/LanguageServer/Run.hs (77%) rename {src => lang-server}/Main.hs (100%) delete mode 100644 src/LanguageServer/Handler/TextDocument.hs diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 000000000..2e1cf927b --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,145 @@ +------------------------------------------------------------------------------ +-- Copyright 2012-2021, Microsoft Research, Daan Leijen. +-- +-- This is free software; you can redistribute it and/or modify it under the +-- terms of the Apache License, Version 2.0. A copy of the License can be +-- found in the LICENSE file at the root of this distribution. +----------------------------------------------------------------------------- +{- + Main module. +-} +----------------------------------------------------------------------------- +module Main where + +import System.Exit ( exitFailure ) +import Control.Monad ( when ) + +import Platform.Config +import Lib.PPrint ( Pretty(pretty), writePrettyLn ) +import Lib.Printer +import Common.ColorScheme +import Common.Failure ( catchIO ) +import Common.Error +import Common.Name +import Common.File ( joinPath ) +import Compiler.Options +import Compiler.Compile ( compileFile, CompileTarget(..), Module(..), Loaded(..), Terminal(..) ) +import Core.Core ( coreProgDefs, flattenDefGroups, defType, Def(..) ) +import Interpreter.Interpret ( interpret ) +import Kind.ImportMap ( importsEmpty ) +import Kind.Synonym ( synonymsIsEmpty, ppSynonyms, synonymsFilter ) +import Kind.Assumption ( kgammaFilter ) +import Type.Assumption ( ppGamma, ppGammaHidden, gammaFilter, createNameInfoX, gammaNew ) +import Type.Pretty ( ppScheme, Env(context,importsMap) ) + + +-- compiled entry +main = mainArgs "" + +-- ghci entry +maing = maingg "" +maindoc = maingg "--html" +mainjs = maingg "--target=js" +maincs = maingg "--target=cs" + +maingg extraOptions + = mainArgs ("-ilib -itest --verbose " ++ extraOptions) + +-- hugs entry +mainh = mainArgs "-ilib -itest --console=raw" + + +mainArgs args + = do (flags,flags0,mode) <- getOptions args + let with = if (not (null (redirectOutput flags))) + then withFileNoColorPrinter (redirectOutput flags) + else if (console flags == "html") + then withHtmlColorPrinter + else if (console flags == "ansi") + then withColorPrinter + else withNoColorPrinter + with (mainMode flags flags0 mode) + `catchIO` \err -> + do if ("ExitFailure" `isPrefix` err) + then return () + else putStr err + exitFailure + where + isPrefix s t = (s == take (length s) t) + +mainMode :: Flags -> Flags -> Mode -> ColorPrinter -> IO () +mainMode flags flags0 mode p + = case mode of + ModeHelp + -> showHelp flags p + ModeVersion + -> withNoColorPrinter (showVersion flags) + ModeCompiler files + -> mapM_ (compile p flags) files + ModeInteractive files + -> interpret p flags flags0 files + ModeLanguageServer files + -> do + putStr "Language server mode not supported in this build.\n" + exitFailure + + +compile :: ColorPrinter -> Flags -> FilePath -> IO () +compile p flags fname + = do let exec = Executable (newName "main") () + err <- compileFile (const Nothing) Nothing term flags [] [] + (if (not (evaluate flags)) then (if library flags then Library else exec) else exec) [] fname + case checkError err of + Left msg + -> do putPrettyLn p (ppErrorMessage (showSpan flags) cscheme msg) + -- exitFailure -- don't fail for tests + + Right ((Loaded gamma kgamma synonyms newtypes constructors _ imports _ + (Module modName _ _ _ _ _ rawProgram core _ _ _ _ modTime _ _) _ _ _ + , _), warnings) + -> do when (not (null warnings)) + (let msg = ErrorWarning warnings ErrorZero + in putPrettyLn p (ppErrorMessage (showSpan flags) cscheme msg)) + when (showKindSigs flags) $ do + putPrettyLn p (pretty (kgammaFilter modName kgamma)) + let localSyns = synonymsFilter modName synonyms + when (not (synonymsIsEmpty localSyns)) + (putPrettyLn p (ppSynonyms (prettyEnv flags modName imports) localSyns)) + + if showHiddenTypeSigs flags then do + -- workaround since private defs aren't in gamma + putPrettyLn p $ ppGammaHidden (prettyEnv flags modName imports) $ gammaFilter modName $ gammaFromDefGroups $ coreProgDefs core + else if showTypeSigs flags then + putPrettyLn p $ ppGamma (prettyEnv flags modName imports) $ gammaFilter modName gamma + else pure () + where + term + = Terminal (putErrorMessage p (showSpan flags) cscheme) + (if (verbose flags > 1) then (\msg -> withColor p (colorSource cscheme) (writeLn p msg)) + else (\_ -> return ())) + (if (verbose flags > 0) then writePrettyLn p else (\_ -> return ())) + (putScheme p (prettyEnv flags nameNil importsEmpty)) + (writePrettyLn p) + + cscheme + = colorSchemeFromFlags flags + + prettyEnv flags ctx imports + = (prettyEnvFromFlags flags){ context = ctx, importsMap = imports } + +gammaFromDefGroups groups = gammaNew $ map defToGammaEntry $ flattenDefGroups groups + where + defToGammaEntry def = (defName def, createNameInfoX (defVis def) (defName def) (defSort def) (defNameRange def) (defType def)) + +putScheme p env tp + = putPrettyLn p (ppScheme env tp) + +putErrorMessage p endToo cscheme err + = putPrettyLn p (ppErrorMessage endToo cscheme err) + +putPhase p cscheme msg + = withColor p (colorInterpreter cscheme) (writeLn p msg) + +putPrettyLn p doc + = do writePrettyLn p doc + writeLn p "" diff --git a/koka.cabal b/koka.cabal index a8c9d3a2f..8fc8de448 100644 --- a/koka.cabal +++ b/koka.cabal @@ -21,9 +21,8 @@ source-repository head type: git location: https://github.com/koka-lang/koka -executable koka - main-is: Main.hs - other-modules: +library + exposed-modules: Backend.C.Box Backend.C.FromCore Backend.C.Parc @@ -92,17 +91,6 @@ executable koka Kind.Repr Kind.Synonym Kind.Unify - LanguageServer.Conversions - LanguageServer.Handler.Commands - LanguageServer.Handler.Completion - LanguageServer.Handler.Definition - LanguageServer.Handler.DocumentSymbol - LanguageServer.Handler.Hover - LanguageServer.Handler.InlayHints - LanguageServer.Handler.TextDocument - LanguageServer.Handlers - LanguageServer.Monad - LanguageServer.Run Lib.JSON Lib.PPrint Lib.Printer @@ -136,6 +124,7 @@ executable koka Platform.ReadLine Platform.Runtime Platform.Var + other-modules: Paths_koka hs-source-dirs: src @@ -143,7 +132,7 @@ executable koka other-extensions: CPP OverloadedStrings - ghc-options: -rtsopts -j8 -O2 -threaded "-with-rtsopts=-N8" + ghc-options: -j8 -O2 cpp-options: -DKOKA_MAIN="koka" -DKOKA_VARIANT="release" -DKOKA_VERSION="2.4.3" -DREADLINE=0 include-dirs: src/Platform/cpp/Platform @@ -178,6 +167,79 @@ executable koka if os(darwin) cpp-options: -DDARWIN +executable koka + main-is: Main.hs + other-modules: + LanguageServer.Conversions + LanguageServer.Handler.Commands + LanguageServer.Handler.Completion + LanguageServer.Handler.Definition + LanguageServer.Handler.DocumentSymbol + LanguageServer.Handler.Hover + LanguageServer.Handler.InlayHints + LanguageServer.Handler.TextDocument + LanguageServer.Handlers + LanguageServer.Monad + LanguageServer.Run + Paths_koka + hs-source-dirs: + lang-server + ghc-options: -rtsopts -j8 -O2 -threaded "-with-rtsopts=-N8" + build-depends: + aeson + , array + , async + , base >=4.9 + , bytestring + , co-log-core + , containers + , directory + , isocline >=1.0.6 + , koka + , lens + , lsp + , mtl + , network + , network-simple + , parsec + , process + , stm + , text + , text-rope + , time + default-language: Haskell2010 + +executable koka-nolsp + main-is: Main.hs + other-modules: + Paths_koka + hs-source-dirs: + app + ghc-options: -rtsopts -j8 -O2 -threaded "-with-rtsopts=-N8" + build-depends: + aeson + , array + , async + , base >=4.9 + , bytestring + , co-log-core + , containers + , directory + , isocline >=1.0.6 + , koka + , lens + , lsp + , mtl + , network + , network-simple + , parsec + , process + , stm + , text + , text-rope + , time + default-language: Haskell2010 + test-suite koka-test type: exitcode-stdio-1.0 main-is: Spec.hs diff --git a/src/LanguageServer/Conversions.hs b/lang-server/LanguageServer/Conversions.hs similarity index 90% rename from src/LanguageServer/Conversions.hs rename to lang-server/LanguageServer/Conversions.hs index c7597a51e..2f70280a6 100644 --- a/src/LanguageServer/Conversions.hs +++ b/lang-server/LanguageServer/Conversions.hs @@ -16,10 +16,7 @@ module LanguageServer.Conversions -- * Conversions from LSP types fromLspPos, fromLspRange, - fromLspLocation, - - -- * Get loaded module from URI - loadedModuleFromUri + fromLspLocation ) where import GHC.Generics hiding (UInt) @@ -34,7 +31,6 @@ import Lib.PPrint (Doc) import qualified Syntax.RangeMap as R import Compiler.Module (Module (..), Loaded (..)) import Data.Maybe (fromMaybe) -import Data.List (find) import Common.File (normalize, realPath) import Common.Range (sourceNull, Source (sourceName)) @@ -117,15 +113,3 @@ fromLspRange uri (J.Range s e) = R.makeRange (fromLspPos uri s) (fromLspPos uri fromLspLocation :: J.Location -> R.Range fromLspLocation (J.Location uri rng) = fromLspRange uri rng - -loadedModuleFromUri :: Maybe Loaded -> J.Uri -> IO (Maybe Module) -loadedModuleFromUri l uri = - case l of - Nothing -> return Nothing - Just l -> - case J.uriToFilePath uri of - Nothing -> return Nothing - Just uri -> do - path <- realPath uri - let p = normalize path - return $ find (\m -> p == modSourcePath m) $ loadedModules l diff --git a/src/LanguageServer/Handler/Commands.hs b/lang-server/LanguageServer/Handler/Commands.hs similarity index 68% rename from src/LanguageServer/Handler/Commands.hs rename to lang-server/LanguageServer/Handler/Commands.hs index 5d4e4eb1c..753044f54 100644 --- a/src/LanguageServer/Handler/Commands.hs +++ b/lang-server/LanguageServer/Handler/Commands.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} -module LanguageServer.Handler.Commands (initializedHandler, commandHandler) where +module LanguageServer.Handler.Commands (commandHandler) where import Compiler.Options (Flags (outFinalPath), targets, commandLineHelp, updateFlagsFromArgs) import Language.LSP.Server (Handlers, LspM, notificationHandler, sendNotification, MonadLsp, getVirtualFiles, withIndefiniteProgress, requestHandler) @@ -27,61 +27,56 @@ import Compiler.Module (Loaded(..)) import Common.Range (rangeNull) import Core.Core (Visibility(Private)) -initializedHandler :: Handlers LSM -initializedHandler = notificationHandler J.SMethod_Initialized $ \_not -> sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info "Initialized language server." - -targetFlag :: String -> Flags -> Flags -targetFlag t f - = case lookup t targets of - Just update -> update f - Nothing -> f - +-- Handles custom commands that we support clients to call commandHandler :: Handlers LSM commandHandler = requestHandler J.SMethod_WorkspaceExecuteCommand $ \req resp -> do - flags <- getFlags let J.ExecuteCommandParams _ command commandParams = req ^. J.params + flags <- getFlags if command == "koka/genCode" then case commandParams of + -- koka/genCode filePath "...args to parse" Just [Json.String filePath, Json.String additionalArgs] -> do - term <- getTerminal - newFlags <- case updateFlagsFromArgs flags (T.unpack additionalArgs) of - Just flags' -> return flags' - Nothing -> do - doc <- liftIO (commandLineHelp flags) - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid arguments " <> additionalArgs - liftIO $ termPhaseDoc term doc - return flags + -- Update the flags with the specified arguments + newFlags <- getNewFlags flags additionalArgs + -- Recompile the file, but with executable target withIndefiniteProgress (T.pack "Compiling " <> filePath) J.NotCancellable $ do res <- recompileFile (Executable (newName "main") ()) (J.filePathToUri $ T.unpack filePath) Nothing False newFlags sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack ("Finished generating code for main file " ++ T.unpack filePath ++ " " ++ fromMaybe "No Compiled File" res) + -- Send the executable file location back to the client in case it wants to run it resp $ Right $ case res of {Just filePath -> J.InL $ Json.String $ T.pack filePath; Nothing -> J.InR J.Null} - _ -> do - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid parameters" + _ -> do + -- Client didn't send the right parameters for this command + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid parameters for koka/genCode" resp $ Right $ J.InR J.Null else if command == "koka/interpretExpression" then case commandParams of + -- The `filePath` where a top level function is defined by the name `functionName`, and any additional flags Just [Json.String filePath, Json.String functionName, Json.String additionalArgs] -> do - term <- getTerminal - newFlags <- case updateFlagsFromArgs flags (T.unpack additionalArgs) of - Just flags' -> return flags' - Nothing -> do - doc <- liftIO (commandLineHelp flags) - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid arguments " <> additionalArgs - liftIO $ termPhaseDoc term doc - return flags + -- Update the flags with the specified arguments + newFlags <- getNewFlags flags additionalArgs + -- Compile the expression, but with the interpret target withIndefiniteProgress (T.pack "Interpreting " <> functionName) J.NotCancellable $ do - -- term flags loaded compileTarget program line input + -- compile the expression res <- compileEditorExpression (J.filePathToUri $ T.unpack filePath) newFlags (T.unpack filePath) (T.unpack functionName) sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack ("Finished generating code for interpreting function " ++ T.unpack functionName ++ " in file " ++ T.unpack filePath ++ " Result: " ++ fromMaybe "No Compiled File" res) + -- Send the executable file location back to the client in case it wants to run it resp $ Right $ case res of {Just filePath -> J.InL $ Json.String $ T.pack filePath; Nothing -> J.InR J.Null} _ -> do - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid parameters" + -- Client didn't send the right parameters for this command + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid parameters for koka/interpretExpression" resp $ Right $ J.InR J.Null else do sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Unknown command" ++ show req) resp $ Right $ J.InR J.Null -liftMaybe:: Monad m => Maybe (m ()) -> m () -liftMaybe Nothing = return () -liftMaybe (Just m) = m +getNewFlags :: Flags -> T.Text -> LSM Flags +getNewFlags flags args = do + term <- getTerminal + case updateFlagsFromArgs flags (T.unpack args) of + Just flags' -> return flags' + Nothing -> do + doc <- liftIO (commandLineHelp flags) + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack "Invalid arguments " <> args + liftIO $ termPhaseDoc term doc + return flags \ No newline at end of file diff --git a/src/LanguageServer/Handler/Completion.hs b/lang-server/LanguageServer/Handler/Completion.hs similarity index 96% rename from src/LanguageServer/Handler/Completion.hs rename to lang-server/LanguageServer/Handler/Completion.hs index 2a52413ac..dccac00a1 100644 --- a/src/LanguageServer/Handler/Completion.hs +++ b/lang-server/LanguageServer/Handler/Completion.hs @@ -25,7 +25,7 @@ import Language.LSP.Server (Handlers, getVirtualFile, requestHandler) import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import Language.LSP.VFS (VirtualFile (VirtualFile)) -import LanguageServer.Monad (LSM, getLoaded) +import LanguageServer.Monad (LSM, getLoaded, getLoadedModule) import Lib.PPrint (Pretty (..)) import Syntax.Lexer (reservedNames) import Type.Assumption @@ -54,7 +54,7 @@ import Data.Char (isUpper, isAlphaNum) import Compiler.Compile (Module (..)) import Type.Type (Type(..), splitFunType, splitFunScheme) import Syntax.RangeMap (rangeMapFindAt, rangeInfoType) -import LanguageServer.Conversions (fromLspPos, loadedModuleFromUri) +import LanguageServer.Conversions (fromLspPos) import Common.Range (makePos, posNull, Range, rangeNull) import LanguageServer.Handler.Hover (formatRangeInfoHover) import Type.Unify (runUnify, unify, runUnifyEx, matchArguments) @@ -67,23 +67,27 @@ import Control.Monad.ST (runST) import Language.LSP.Protocol.Types (InsertTextFormat(InsertTextFormat_Snippet)) import Control.Monad.IO.Class (liftIO) +-- Gets tab completion results for a document location +-- This is a pretty complicated handler because it has to do a lot of work completionHandler :: Handlers LSM completionHandler = requestHandler J.SMethod_TextDocumentCompletion $ \req responder -> do let J.CompletionParams doc pos _ _ context = req ^. J.params uri = doc ^. J.uri normUri = J.toNormalizedUri uri loaded <- getLoaded uri - loadedM <- liftIO $ loadedModuleFromUri loaded uri + loadedM <- getLoadedModule uri vfile <- getVirtualFile normUri - let items = do + let items = do-- list monad l <- maybeToList loaded - lm <- maybeToList $ loadedM + lm <- maybeToList loadedM vf <- maybeToList vfile pi <- maybeToList =<< getCompletionInfo pos vf lm uri findCompletions l lm pi responder $ Right $ J.InL items -- | Describes the line at the current cursor position +-- We need a bit more information than the PositionInfo provided by the LSP library +-- So we duplicate a bit of code from the LSP library here data PositionInfo = PositionInfo { fullLine :: !T.Text -- ^ The full contents of the line the cursor is at @@ -92,6 +96,7 @@ data PositionInfo = PositionInfo , cursorPos :: !J.Position -- ^ The cursor position , argumentType :: Maybe Type + -- Determines if it is a function completion (. is just prior to the cursor) , isFunctionCompletion :: Bool } deriving (Show,Eq) diff --git a/src/LanguageServer/Handler/Definition.hs b/lang-server/LanguageServer/Handler/Definition.hs similarity index 96% rename from src/LanguageServer/Handler/Definition.hs rename to lang-server/LanguageServer/Handler/Definition.hs index 78105c912..8067d5f19 100644 --- a/src/LanguageServer/Handler/Definition.hs +++ b/lang-server/LanguageServer/Handler/Definition.hs @@ -21,12 +21,13 @@ import Syntax.RangeMap (RangeInfo (..), rangeMapFindAt) import Type.Assumption (gammaLookupQ, infoRange) import qualified Language.LSP.Protocol.Message as J +-- Finds the definitions of the element under the cursor. definitionHandler :: Handlers LSM definitionHandler = requestHandler J.SMethod_TextDocumentDefinition $ \req responder -> do let J.DefinitionParams doc pos _ _ = req ^. J.params uri = doc ^. J.uri loaded <- getLoaded uri - let defs = do + let defs = do -- maybe monad l <- maybeToList loaded rmap <- maybeToList $ modRangeMap $ loadedModule l (_, rinfo) <- maybeToList $ rangeMapFindAt (fromLspPos uri pos) rmap diff --git a/src/LanguageServer/Handler/DocumentSymbol.hs b/lang-server/LanguageServer/Handler/DocumentSymbol.hs similarity index 60% rename from src/LanguageServer/Handler/DocumentSymbol.hs rename to lang-server/LanguageServer/Handler/DocumentSymbol.hs index e471d1d6a..4458aa6f4 100644 --- a/src/LanguageServer/Handler/DocumentSymbol.hs +++ b/lang-server/LanguageServer/Handler/DocumentSymbol.hs @@ -7,8 +7,8 @@ module LanguageServer.Handler.DocumentSymbol( documentSymbolHandler ) where import qualified Common.Range as R -import Common.Syntax ( DefSort (..) ) -import Common.Name ( Name (..) ) +import Common.Syntax ( DefSort (..), Visibility ) +import Common.Name ( Name (..), isHiddenName ) import Compiler.Module ( modProgram, loadedModule, Loaded (..) ) import Control.Lens ( (^.) ) import qualified Data.Map as M @@ -21,7 +21,18 @@ import LanguageServer.Conversions ( toLspRange ) import LanguageServer.Monad ( LSM, getLoaded ) import Syntax.Syntax import qualified Language.LSP.Protocol.Message as J - +import Common.NamePrim (nameNull, namePhantom) + +-- The LSP handler that provides the symbol tree of a document +-- Symbols include +-- File / Module / Namespace / Package / Class / Method / Property / Field / Constructor / Enum / Interface / Function / Variable +-- Constant / String / Number / Boolean / Array / Object / Key / Null / EnumMember / Struct / Event / Operator / TypeParameter +-- +-- Koka only reports a subset of these including +-- Interface (for synonyms) +-- Enum (types with more than one constructor) / EnumMember (constructors) / Field (fields) / TypeParameter (type parameters) +-- Struct (types with one constructor) / Constructor (constructor) / Field (fields) / TypeParameter (type parameters) +-- Constant / Function / Variable / Number / String documentSymbolHandler :: Handlers LSM documentSymbolHandler = requestHandler J.SMethod_TextDocumentDocumentSymbol $ \req responder -> do let J.DocumentSymbolParams _ _ doc = req ^. J.params @@ -59,37 +70,57 @@ instance HasSymbols UserTypeDefGroup where TypeDefNonRec td -> symbols td instance HasSymbols UserTypeDef where - symbols td = [makeSymbol n k r cs] + symbols td = makeSymbolSelect n k r rngSelect cs where b = typeDefBinder td n = tbinderName b + rngSelect = tbinderNameRange b r = typeDefRange td k = case td of Synonym {..} -> J.SymbolKind_Interface DataType {typeDefConstrs = ctrs} | length ctrs > 1 -> J.SymbolKind_Enum | otherwise -> J.SymbolKind_Struct cs = case td of - DataType {typeDefConstrs = ctrs} -> symbols ctrs - _ -> [] + DataType {typeDefConstrs = ctrs, typeDefParams=params} | length ctrs > 1 -> symbols ctrs ++ symbols params + DataType {typeDefParams=params} -> symbols params + Synonym {typeDefParams = params} -> symbols params + +instance HasSymbols (TypeBinder k) where + symbols b = [] -- makeSymbol n k r [] + where + n = tbinderName b + r = tbinderRange b + k = J.SymbolKind_TypeParameter instance HasSymbols UserUserCon where - symbols c = [makeSymbol n k r []] + symbols c = makeSymbolSelect n k r rngSelect cs where n = userconName c + rngSelect = userconNameRange c ps = userconParams c k | not (null ps) = J.SymbolKind_Constructor | otherwise = J.SymbolKind_EnumMember r = userconRange c + cs = symbols ps ++ symbols (userconExists c) --- Value definition instances +type UserConParam = (Visibility,ValueBinder UserType (Maybe (Expr UserType))) +instance HasSymbols UserConParam where + symbols (v, b) = makeSymbolSelect n k r rngSelect cs + where + n = binderName b + rngSelect = binderNameRange b + r = binderRange b + k = J.SymbolKind_Field + cs = symbols (binderExpr b) +-- Value definition instances instance HasSymbols UserDefGroup where symbols dg = case dg of DefRec ds -> symbols ds DefNonRec d -> symbols d instance HasSymbols UserDef where - symbols d = [makeSymbol n k r cs] + symbols d = makeSymbolSelect n k r rngSelect cs where b = defBinder d k = case defSort d of @@ -98,14 +129,16 @@ instance HasSymbols UserDef where DefVar -> J.SymbolKind_Variable n = binderName b r = defRange d + rngSelect = binderNameRange b cs = symbols $ binderExpr b instance HasSymbols e => HasSymbols (ValueBinder t e) where - symbols b = [makeSymbol n k r cs] + symbols b = makeSymbolSelect n k r rngSelect cs where k = J.SymbolKind_Constant n = binderName b r = binderRange b + rngSelect = binderNameRange b cs = symbols $ binderExpr b instance HasSymbols UserExpr where @@ -122,14 +155,26 @@ instance HasSymbols UserExpr where ++ symbols e3 ++ symbols hbs Inject _ e _ _ -> symbols e - _ -> [] -- TODO: Handle other types of (nested) expressions + Var n _ r -> makeSymbol n J.SymbolKind_Variable r [] + Lit l -> symbols l + +instance HasSymbols Lit where + symbols l = + let (s,k) = case l of + LitChar c _ -> (show c, J.SymbolKind_Constant) + LitInt i _ -> (show i, J.SymbolKind_Number) + LitFloat f _ -> (show f, J.SymbolKind_Number) + LitString s _ -> (show s, J.SymbolKind_String) + in [J.DocumentSymbol (T.pack s) Nothing k Nothing Nothing rng rng Nothing ] + where rng = toLspRange $ litRange l instance HasSymbols UserHandlerBranch where - symbols hb = [makeSymbol n J.SymbolKind_Function r cs] + symbols hb = makeSymbolSelect n J.SymbolKind_Function r rngSelect cs where n = hbranchName hb - r = hbranchNameRange hb + rngSelect = hbranchNameRange hb e = hbranchExpr hb + r = rngSelect `R.combineRange` R.getRange e ps = hbranchPars hb cs = symbols ps ++ symbols e @@ -149,14 +194,29 @@ instance HasSymbols UserPattern where symbols pat = case pat of PatVar b -> let n = binderName b r = binderRange b - in [makeSymbol n J.SymbolKind_Constant r []] + in makeSymbol n J.SymbolKind_Constant r [] PatAnn p _ _ -> symbols p PatCon _ ps _ _ -> symbols $ map snd ps PatParens p _ -> symbols p - _ -> [] + PatLit l -> symbols l + PatWild _ -> [] + +makeSymbolSelect :: Name -> J.SymbolKind -> R.Range -> R.Range -> [J.DocumentSymbol] -> [J.DocumentSymbol] +makeSymbolSelect n k r rngSelect cs = + [J.DocumentSymbol name detail kind tags deprecated range selRange children | nameId n /= "" && not (isHiddenName n) && n /= namePhantom] + where + name = T.pack $ nameId n + detail = Just $ T.pack $ nameModule n + kind = k + tags = Just [] + deprecated = Just False + range = toLspRange (r `R.combineRange` rngSelect) + selRange = toLspRange rngSelect + children = Just cs -makeSymbol :: Name -> J.SymbolKind -> R.Range -> [J.DocumentSymbol] -> J.DocumentSymbol -makeSymbol n k r cs = J.DocumentSymbol name detail kind tags deprecated range selRange children +makeSymbol :: Name -> J.SymbolKind -> R.Range -> [J.DocumentSymbol] -> [J.DocumentSymbol] +makeSymbol n k r cs = + [J.DocumentSymbol name detail kind tags deprecated range selRange children | nameId n /= "" && not (isHiddenName n) && n /= namePhantom] where name = T.pack $ nameId n detail = Just $ T.pack $ nameModule n diff --git a/src/LanguageServer/Handler/Hover.hs b/lang-server/LanguageServer/Handler/Hover.hs similarity index 74% rename from src/LanguageServer/Handler/Hover.hs rename to lang-server/LanguageServer/Handler/Hover.hs index 4b2c89feb..e8d0f45bf 100644 --- a/src/LanguageServer/Handler/Hover.hs +++ b/lang-server/LanguageServer/Handler/Hover.hs @@ -27,45 +27,46 @@ import Compiler.Options (Flags, colorSchemeFromFlags, prettyEnvFromFlags) import Compiler.Compile (modName) import Type.Type (Name) +-- Handles hover requests hoverHandler :: Handlers LSM hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do let J.HoverParams doc pos _ = req ^. J.params uri = doc ^. J.uri loadedMod <- getLoadedModule uri loaded <- getLoaded uri - flags <- getFlags - let res = do + let res = do -- maybe monad mod <- loadedMod l <- loaded rmap <- modRangeMap mod + -- Find the range info at the given position (r, rinfo) <- rangeMapFindAt (fromLspPos uri pos) rmap return (modName mod, loadedImportMap l, r, rinfo) case res of Just (mName, imports, r, rinfo) -> do + -- Get the html-printer and flags print <- getHtmlPrinter - x <- liftIO $ formatRangeInfoHover print flags mName imports rinfo + flags <- getFlags + let env = (prettyEnvFromFlags flags){ context = mName, importsMap = imports } + colors = colorSchemeFromFlags flags + x <- liftIO $ print $ formatRangeInfoHover env colors rinfo let hc = J.InL $ J.mkMarkdown x rsp = J.Hover hc $ Just $ toLspRange r responder $ Right $ J.InL rsp Nothing -> responder $ Right $ J.InR J.Null -prettyEnv flags ctx imports = (prettyEnvFromFlags flags){ context = ctx, importsMap = imports } - --- Pretty-prints type/kind information to a hover tooltip -formatRangeInfoHover :: (Doc -> IO T.Text) -> Flags -> Name -> ImportMap -> RangeInfo -> IO T.Text -formatRangeInfoHover print flags mName imports rinfo = - let colors = colorSchemeFromFlags flags - env = prettyEnv flags mName imports in +-- Pretty-prints type/kind information to a hover tooltip given a type pretty environment, color scheme +formatRangeInfoHover :: Env -> ColorScheme -> RangeInfo -> Doc +formatRangeInfoHover env colors rinfo = case rinfo of Id qname info isdef -> - print $ (ppName env{colors=colors{colorSource = Gray}} qname) <+> text " : " <+> case info of + ppName env{colors=colors{colorSource = Gray}} qname <+> text " : " <+> case info of NIValue tp _ -> ppScheme env tp NICon tp -> ppScheme env tp NITypeCon k -> prettyKind colors k NITypeVar k -> prettyKind colors k NIModule -> text "module" NIKind -> text "kind" - Decl s name mname -> print $ text s <+> text " " <+> pretty name - Block s -> return $ T.pack s - Error doc -> print $ text "Error: " <+> doc - Warning doc -> print $ text "Warning: " <+> doc + Decl s name mname -> text s <+> text " " <+> pretty name + Block s -> text s + Error doc -> text "Error: " <+> doc + Warning doc -> text "Warning: " <+> doc diff --git a/src/LanguageServer/Handler/InlayHints.hs b/lang-server/LanguageServer/Handler/InlayHints.hs similarity index 53% rename from src/LanguageServer/Handler/InlayHints.hs rename to lang-server/LanguageServer/Handler/InlayHints.hs index 73197fa2e..bc3e7174b 100644 --- a/src/LanguageServer/Handler/InlayHints.hs +++ b/lang-server/LanguageServer/Handler/InlayHints.hs @@ -21,9 +21,10 @@ import Type.Pretty (ppType, Env (..), defaultEnv, ppScheme) import Common.Name (Name) import Compiler.Compile (Module(..), Loaded (..)) import Kind.ImportMap (ImportMap) -import Compiler.Options (prettyEnvFromFlags) +import Compiler.Options (prettyEnvFromFlags, Flags) -- import Debug.Trace (trace) +-- The LSP handler that provides inlay hints (inline type annotations etc) inlayHintsHandler :: Handlers LSM inlayHintsHandler = requestHandler J.SMethod_TextDocumentInlayHint $ \req responder -> do let J.InlayHintParams prog doc rng = req ^. J.params @@ -32,50 +33,44 @@ inlayHintsHandler = requestHandler J.SMethod_TextDocumentInlayHint $ \req respon loadedMod <- getLoadedModule uri loaded <- getLoaded uri flags <- getFlags - let toInlayHint :: ImportMap -> Name -> (Range, RangeInfo) -> Maybe J.InlayHint - toInlayHint imports modName (rng, rngInfo) = - let env = (prettyEnvFromFlags flags){ context = modName, importsMap = imports } in - let rngEnd = rangeEnd rng - shouldShow = - (rngEnd /= posNull) && - case rngInfo of - Id _ info _ -> case info of - NIValue _ isAnnotated -> not isAnnotated - NICon _ -> False - NITypeCon _ -> False - NITypeVar _ -> False - NIModule -> False - NIKind -> False - Decl{} -> False - Block _ -> False - Error _ -> False - Warning _ -> False - in - if shouldShow then - Just $ J.InlayHint (toLspPos rngEnd{posColumn = posColumn rngEnd + 1}) (J.InL $ T.pack $ formatInfo env modName rngInfo) (Just J.InlayHintKind_Type) Nothing Nothing (Just True) (Just True) Nothing - else Nothing - rsp = do + let rsp = do -- maybe monad l <- loaded lm <- loadedMod rmap <- modRangeMap lm -- trace (show $ rangeMapFindIn newRng rmap) $ return () - return $ mapMaybe (toInlayHint (loadedImportMap l) (modName lm)) $ rangeMapFindIn newRng rmap + let env = (prettyEnvFromFlags flags){ context = modName lm, importsMap = loadedImportMap l, showFlavours=False } + return $ mapMaybe (toInlayHint env (modName lm)) $ rangeMapFindIn newRng rmap case rsp of Nothing -> responder $ Right $ J.InR J.Null Just rsp -> responder $ Right $ J.InL rsp --- Pretty-prints type/kind information to a hover tooltip -formatInfo :: Env -> Name -> RangeInfo -> String +-- Takes a range and range info and returns an inlay hint if it should be shown +toInlayHint :: Env -> Name -> (Range, RangeInfo) -> Maybe J.InlayHint +toInlayHint env modName (rng, rngInfo) = do + let rngEnd = rangeEnd rng + -- should show identifier hint if it's not annotated already + shouldShow = + (rngEnd /= posNull) && + case rngInfo of + Id _ info _ -> case info of + NIValue _ isAnnotated -> not isAnnotated + _ -> False + _ -> False + if shouldShow then + let position = toLspPos rngEnd{posColumn = posColumn rngEnd + 1} in + let info = T.pack <$> formatInfo env modName rngInfo in + case info of + Just typeString -> + -- If there is a type to show, show it along with a text edit to accept the type suggestion + Just $ J.InlayHint position (J.InL typeString) (Just J.InlayHintKind_Type) (Just [J.TextEdit (J.Range position position) typeString]) Nothing (Just True) (Just True) Nothing + Nothing -> Nothing + else Nothing + +-- Pretty-prints type information for an inlay hint +formatInfo :: Env -> Name -> RangeInfo -> Maybe String formatInfo env modName rinfo = case rinfo of Id qname info isdef -> case info of - NIValue tp _ -> " : " ++ show (ppScheme env tp) - NICon tp -> "" - NITypeCon k -> "" - NITypeVar k -> "" - NIModule -> "" - NIKind -> "" - Decl s name mname -> "" - Block s -> "" - Error doc -> "Error: " ++ show doc - Warning doc -> "Warning: " ++ show doc \ No newline at end of file + NIValue tp _ -> Just $ " : " ++ show (ppScheme env tp) + _ -> Nothing + _ -> Nothing \ No newline at end of file diff --git a/lang-server/LanguageServer/Handler/TextDocument.hs b/lang-server/LanguageServer/Handler/TextDocument.hs new file mode 100644 index 000000000..6a33740a4 --- /dev/null +++ b/lang-server/LanguageServer/Handler/TextDocument.hs @@ -0,0 +1,267 @@ +----------------------------------------------------------------------------- +-- The LSP handlers that handle changes to the document +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} + +module LanguageServer.Handler.TextDocument + ( didOpenHandler, + didChangeHandler, + didSaveHandler, + didCloseHandler, + recompileFile, + compileEditorExpression, + persistModules, + ) +where + +import Common.Error (Error, checkPartial) +import Compiler.Compile (Terminal (..), compileModuleOrFile, Loaded (..), CompileTarget (..), compileFile, codeGen, compileExpression) +import Control.Lens ((^.)) +import Control.Monad.Trans (liftIO) +import qualified Data.Map as M +import Data.Maybe (fromJust, fromMaybe) +import qualified Data.Text as T +import Language.LSP.Diagnostics (partitionBySource) +import Language.LSP.Server (Handlers, flushDiagnosticsBySource, publishDiagnostics, sendNotification, getVirtualFile, getVirtualFiles, notificationHandler) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J +import LanguageServer.Conversions (toLspDiagnostics) +import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded, getModules, putDiagnostics, getDiagnostics, clearDiagnostics, removeLoadedUri) +import Language.LSP.VFS (virtualFileText, VFS(..), VirtualFile, file_version, virtualFileVersion) +import qualified Data.Text.Encoding as T +import Data.Functor ((<&>)) +import qualified Language.LSP.Protocol.Message as J +import Data.ByteString (ByteString) +import Data.Map (Map) +import Text.Read (readMaybe) +import Debug.Trace (trace) +import Control.Exception (try) +import qualified Control.Exception as Exc +import Compiler.Options (Flags) +import Common.File (getFileTime, FileTime, getFileTimeOrCurrent, getCurrentTime, normalize, realPath) +import GHC.IO (unsafePerformIO) +import Compiler.Module (Module(..)) +import Control.Monad (when, foldM) +import Data.Time (addUTCTime, addLocalTime) +import qualified Data.ByteString as J +import Syntax.Syntax ( programNull, programAddImports, Import(..) ) +import Common.Range (rangeNull) +import Core.Core (Visibility(Private)) +import Common.NamePrim (nameInteractiveModule, nameExpr, nameSystemCore) +import Common.Name (newName) + +-- Compile the file on opening +didOpenHandler :: Handlers LSM +didOpenHandler = notificationHandler J.SMethod_TextDocumentDidOpen $ \msg -> do + let uri = msg ^. J.params . J.textDocument . J.uri + let version = msg ^. J.params . J.textDocument . J.version + flags <- getFlags + _ <- recompileFile InMemory uri (Just version) False flags + return () + +-- Recompile the file on changes +didChangeHandler :: Handlers LSM +didChangeHandler = notificationHandler J.SMethod_TextDocumentDidChange $ \msg -> do + let uri = msg ^. J.params . J.textDocument . J.uri + let version = msg ^. J.params . J.textDocument . J.version + flags <- getFlags + _ <- recompileFile InMemory uri (Just version) False flags + return () + +-- Saving a file just recompiles it +didSaveHandler :: Handlers LSM +didSaveHandler = notificationHandler J.SMethod_TextDocumentDidSave $ \msg -> do + let uri = msg ^. J.params . J.textDocument . J.uri + flags <- getFlags + _ <- recompileFile InMemory uri Nothing False flags + return () + +-- Closing the file +didCloseHandler :: Handlers LSM +didCloseHandler = notificationHandler J.SMethod_TextDocumentDidClose $ \msg -> do + let uri = msg ^. J.params . J.textDocument . J.uri + removeLoadedUri uri + -- Don't remove diagnostics so the file stays red in the editor, and problems are shown, but do remove the compilation state + return () + +-- Retreives a file from the virtual file system, returning the contents and the last modified time +maybeContents :: Map FilePath (ByteString, FileTime, J.Int32) -> FilePath -> Maybe (ByteString, FileTime) +maybeContents vfs uri = do + -- trace ("Maybe contents " ++ show uri ++ " " ++ show (M.keys vfs)) $ return () + (text, ftime, vers) <- M.lookup uri vfs + return (text, ftime) + +-- Creates a diff of the virtual file system including keeping track of version numbers and last modified times +-- Modified times are not present in the LSP libraris's virtual file system, so we do it ourselves +diffVFS :: Map FilePath (ByteString, FileTime, J.Int32) -> Map J.NormalizedUri VirtualFile -> LSM (Map FilePath (ByteString, FileTime, J.Int32)) +diffVFS oldvfs vfs = + -- Fold over the new map, creating a new map that has the same keys as the new map + foldM (\acc (k, v) -> do + -- Get the key as a normalized file path + path0 <- liftIO $ realPath $ J.fromNormalizedFilePath $ fromJust $ J.uriToNormalizedFilePath k + let newK = normalize path0 + -- New file contents & verson + let text = T.encodeUtf8 $ virtualFileText v + vers = virtualFileVersion v + case M.lookup newK oldvfs of + Just old@(_, _, vOld) -> + -- If the key is in the old map, and the version number is the same, keep the old value + if vOld == vers then + return $ M.insert newK old acc + else do + -- Otherwise update the value with a new timestamp + time <- liftIO getCurrentTime + return $ M.insert newK (text, time, vers) acc + Nothing -> do + -- If the key wasn't already present in the map, get it's file time from disk (since it was just opened / created) + time <- liftIO $ getFileTimeOrCurrent newK + -- trace ("New file " ++ show newK ++ " " ++ show time) $ return () + return $ M.insert newK (text, time, vers) acc) + M.empty (M.toList vfs) + +-- Updates the virtual file system in the LSM state +updateVFS :: LSM (Map FilePath (ByteString, FileTime, J.Int32)) +updateVFS = do + -- Get the virtual files + vFiles <- getVirtualFiles + -- Get the full map + let vfs = _vfsMap vFiles + -- Get the old virtual files we have stored + oldvfs <- documentInfos <$> getLSState + -- Diff the virtual files + newvfs <- diffVFS oldvfs vfs + -- Update the virtual files in the state + modifyLSState (\old -> old{documentInfos = newvfs}) + return newvfs + +-- Compiles a single expression (calling a top level function with no arguments) - such as a test method +compileEditorExpression :: J.Uri -> Flags -> String -> String -> LSM (Maybe FilePath) +compileEditorExpression uri flags filePath functionName = do + loaded <- getLoaded uri + case loaded of + Just loaded -> do + let mod = loadedModule loaded + -- Get the virtual files + vfs <- documentInfos <$> getLSState + -- Set up the imports for the expression (core and the module) + let imports = [Import nameSystemCore nameSystemCore rangeNull Private, Import (modName mod) (modName mod) rangeNull Private] + program = programAddImports (programNull nameInteractiveModule) imports + term <- getTerminal + -- reusing interpreter compilation entry point + let resultIO = compileExpression (maybeContents vfs) term flags loaded (Executable nameExpr ()) program 0 (functionName ++ "()") + processCompilationResult normUri filePath False resultIO + Nothing -> do + return Nothing + where normUri = J.toNormalizedUri uri + +-- Recompiles the given file, stores the compilation result in +-- LSM's state and emits diagnostics +recompileFile :: CompileTarget () -> J.Uri -> Maybe J.Int32 -> Bool -> Flags -> LSM (Maybe FilePath) +recompileFile compileTarget uri version force flags = + case J.uriToFilePath uri of + Just filePath0 -> do + -- Get the file path + path <- liftIO $ realPath filePath0 + let filePath = normalize path + -- Update the virtual file system + newvfs <- updateVFS + -- Get the file contents + let contents = fst <$> maybeContents newvfs filePath + modules <- getModules + term <- getTerminal + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath + -- Don't use the cached modules as regular modules (they may be out of date, so we want to resolveImports fully over again) + let resultIO = compileFile (maybeContents newvfs) contents term flags [] (if force then [] else modules) compileTarget [] filePath + processCompilationResult normUri filePath True resultIO + Nothing -> return Nothing + where + normUri = J.toNormalizedUri uri + +-- Processes the result of a compilation, updating the loaded state and emitting diagnostics +-- Returns the executable file path if compilation succeeded +processCompilationResult :: J.NormalizedUri -> FilePath -> Bool -> IO (Error Loaded (Loaded, Maybe FilePath)) -> LSM (Maybe FilePath) +processCompilationResult normUri filePath update doIO = do + let ioResult :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) + ioResult = try doIO + result <- liftIO ioResult + case result of + Left e -> do + -- Compilation threw an exception, put it in the log, as well as a notification + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) + sendNotification J.SMethod_WindowShowMessage $ J.ShowMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) + return Nothing + Right res -> do + -- No exception - so check the result of the compilation + outFile <- case checkPartial res of + Right ((l, outFile), _, _) -> do + -- Compilation succeeded + when update $ putLoaded l -- update the loaded state for this file + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ "Successfully compiled " <> T.pack filePath + return outFile -- return the executable file path + Left (e, m) -> do + -- Compilation failed + case m of + Nothing -> + trace ("Error when compiling, no cached modules " ++ show e) $ + return () + Just l -> do + trace ("Error when compiling have cached" ++ show (map modSourcePath $ loadedModules l)) $ return () + when update $ putLoaded l + removeLoaded (loadedModule l) + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Error when compiling " ++ show e) <> T.pack filePath + return Nothing + -- Emit the diagnostics (errors and warnings) + let diagSrc = T.pack "koka" + diags = toLspDiagnostics normUri diagSrc res + maxDiags = 100 + -- Union with the current file mapped to an empty list, since we want to clear diagnostics for this file when it is an error in another file + diags' = M.union (M.fromList [(normUri, [])]) diags + -- Clear diagnostics for this file if there are no errors / warnings + if null diags then clearDiagnostics normUri else putDiagnostics diags' + -- Get all the diagnostics for all files (language server doesn't support updating diagnostics for a single file) + diags <- getDiagnostics + -- Partition them by source (koka, typescript, linterx, etc.) -- we should only have koka for now + let diagsBySrc = M.map partitionBySource diags + if null diags + -- If there are no diagnostics clear all koka diagnostics + then flushDiagnosticsBySource maxDiags (Just diagSrc) + -- Otherwise report all diagnostics + else mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) + return outFile + +-- Persists all modules to disk +persistModules :: LSM () +persistModules = do + mld <- getModules + mapM_ persistModule mld -- TODO: Dependency ordering + +-- Persist a single module to disk (not yet implemented) +persistModule :: Module -> LSM () +persistModule m = do + return () + -- TODO: This works, but needs to check that the dependencies are persisted first. + -- let generate = do + -- -- trace "Generating" $ return () + -- mld <- getLoaded + -- case mld of + -- Just loaded -> do + -- term <- getTerminal + -- flags <- getFlags + -- (loaded, file) <- liftIO $ codeGen term flags Object loaded{loadedModule = m} + -- putLoaded loaded + -- return () + -- Nothing -> return () + -- -- trace ("Module " ++ show (modName m)) $ + -- case modOutputTime m of + -- Nothing -> do + -- -- trace "No output time" $ return () + -- generate + -- -- If it has been 5 seconds since the last time the module was changed + -- -- and it isn't updated on disk persist again. + -- -- We don't do it all the time, because with virtual files and editor changes it would be too much + -- Just t -> do + -- ct <- liftIO getCurrentTime + -- when ((ct > addUTCTime 5 (modTime m)) && (modTime m > t)) $ do + -- -- trace ("Last output time" ++ show t) $ return () + -- generate + -- return () \ No newline at end of file diff --git a/src/LanguageServer/Handlers.hs b/lang-server/LanguageServer/Handlers.hs similarity index 70% rename from src/LanguageServer/Handlers.hs rename to lang-server/LanguageServer/Handlers.hs index a00930b6c..21c7c1bb6 100644 --- a/src/LanguageServer/Handlers.hs +++ b/lang-server/LanguageServer/Handlers.hs @@ -11,13 +11,13 @@ module LanguageServer.Handlers (ReactorInput(..), lspHandlers) where import Compiler.Options (Flags) -import Language.LSP.Server (Handlers, notificationHandler, Handler, mapHandlers, MonadLsp (..)) +import Language.LSP.Server (Handlers, notificationHandler, sendNotification, Handler, mapHandlers, MonadLsp (..)) import LanguageServer.Handler.Completion (completionHandler) import LanguageServer.Handler.Definition (definitionHandler) import LanguageServer.Handler.DocumentSymbol (documentSymbolHandler) import LanguageServer.Handler.Hover (hoverHandler) import LanguageServer.Handler.InlayHints (inlayHintsHandler) -import LanguageServer.Handler.Commands (initializedHandler, commandHandler) +import LanguageServer.Handler.Commands (commandHandler) import LanguageServer.Handler.TextDocument (didChangeHandler, didCloseHandler, didOpenHandler, didSaveHandler) import LanguageServer.Monad (LSM, runLSM, putLSState, LSState (..)) import Language.LSP.Protocol.Message (TRequestMessage(..), TNotificationMessage(..), Method, MessageDirection(..), MessageKind(..), SMethod (..), SomeLspId (SomeLspId), LspId (..), NotificationMessage (..), ResponseError (..)) @@ -38,38 +38,84 @@ import qualified Data.Set as S import Language.LSP.Protocol.Lens hiding (retry) import Prelude hiding (id) import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J import Language.LSP.Protocol.Types (DidChangeTextDocumentParams(..), VersionedTextDocumentIdentifier (..)) + import Control.Monad (when, unless) import qualified Data.Text as T newtype ReactorInput = ReactorAction (IO ()) -lspHandlers rin = mapHandlers goReq goNot handle where +-- A list of all the handlers we support +handlers :: Handlers LSM +handlers = + mconcat + [ initializedHandler, + didOpenHandler, + didChangeHandler, + didSaveHandler, + didCloseHandler, + hoverHandler, + definitionHandler, + documentSymbolHandler, + completionHandler, + cancelHandler, + commandHandler, + inlayHintsHandler + ] + +-- Handles the initialized notification +initializedHandler :: Handlers LSM +initializedHandler = notificationHandler J.SMethod_Initialized $ \_not -> sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info (T.pack "Initialized language server.") + +-- Handles cancel requests +cancelHandler :: Handlers LSM +cancelHandler = + notificationHandler SMethod_CancelRequest $ \msg -> + do + let id_ = msg ^. params ^. id + state <- lift ask + stateV <- liftIO $ readMVar state + -- Add the request id to the cancelled requests set + _ <- liftIO $ atomically $ modifyTVar (cancelledRequests stateV) $ \t -> S.insert (SomeLspId (toLspId id_)) t + return () + where toLspId (J.InL x) = IdInt x + toLspId (J.InR y) = IdString y + +-- Wraps the normal handler with a function that runs a request in a separate thread and races it with a cancel +lspHandlers rin = mapHandlers goReq goNot handlers where + -- For requests (which can be canceled, and the client expects a response) goReq :: forall (a :: Method ClientToServer Request). Handler LSM a -> Handler LSM a goReq f msg@TRequestMessage{_id} k = do env <- getLspEnv state <- lift ask let newId = SomeLspId _id stVal <- liftIO $ readMVar state + -- Inserts the request into the pending requests set liftIO $ atomically $ modifyTVar (pendingRequests stVal) $ \t -> S.insert newId t - + + -- Spins in a loop waiting for changes to the cancelled requests set and if the request is in there it finishes the thread let waitForCancel reqId = atomically $ do cancelled <- readTVar (cancelledRequests stVal) unless (reqId `S.member` cancelled) retry + -- adds a task to the reactor to run the request in a separate thread liftIO $ atomically $ writeTChan rin $ -- check if canceled and if so don't run ReactorAction $ do + -- To run it we race against the cancel cancelOrRes <- race (waitForCancel newId) $ do cancelled <- readTVarIO (cancelledRequests stVal) - if newId `S.member` cancelled then runLSM (k $ Left $ ResponseError (J.InL J.LSPErrorCodes_RequestCancelled) (T.pack "") Nothing) state env else - runLSM (f msg k) state env - case cancelOrRes of + -- If the request is cancelled before we start we return a cancelled error + if newId `S.member` cancelled then runLSM (k $ Left $ ResponseError (J.InL J.LSPErrorCodes_RequestCancelled) (T.pack "") Nothing) state env + -- Otherwise we run the request + else runLSM (f msg k) state env + liftIO $ atomically $ do -- After it finishes we remove it from the pending requests set and canceled set + modifyTVar (pendingRequests stVal) $ \t -> S.delete newId t + modifyTVar (cancelledRequests stVal) $ \t -> S.delete newId t + case cancelOrRes of -- Finally we return the result of the request Left () -> return () Right res -> pure res - liftIO $ atomically $ do - modifyTVar (pendingRequests stVal) $ \t -> S.delete newId t - modifyTVar (cancelledRequests stVal) $ \t -> S.delete newId t - + -- For notifications from the client (which are just fire and forget for the client) goNot :: forall (a :: Method ClientToServer Notification). Handler LSM a -> Handler LSM a goNot f msg = do env <- getLspEnv @@ -84,39 +130,9 @@ lspHandlers rin = mapHandlers goReq goNot handle where liftIO $ atomically $ modifyTVar (documentVersions stateV) $ \t -> M.insert _uri _version t liftIO $ atomically $ writeTChan rin $ ReactorAction $ do + -- When running the request we check if the version is the same as the latest version, if not we don't run the change handler versions <- readTVarIO (documentVersions stVal) when (M.lookup _uri versions == Just _version) $ runLSM (f msg) state env _ -> liftIO $ atomically $ writeTChan rin $ ReactorAction (runLSM (f msg) state env) - -handle = handlers - -handlers :: Handlers LSM -handlers = - mconcat - [ initializedHandler, - didOpenHandler, - didChangeHandler, - didSaveHandler, - didCloseHandler, - hoverHandler, - definitionHandler, - documentSymbolHandler, - completionHandler, - cancelHandler, - commandHandler, - inlayHintsHandler - ] - -cancelHandler :: Handlers LSM -cancelHandler = - notificationHandler SMethod_CancelRequest $ \msg -> - do - let id_ = msg ^. params ^. id - state <- lift ask - stateV <- liftIO $ readMVar state - _ <- liftIO $ atomically $ modifyTVar (cancelledRequests stateV) $ \t -> S.insert (SomeLspId (toLspId id_)) t - return () - where toLspId (J.InL x) = IdInt x - toLspId (J.InR y) = IdString y \ No newline at end of file diff --git a/src/LanguageServer/Monad.hs b/lang-server/LanguageServer/Monad.hs similarity index 83% rename from src/LanguageServer/Monad.hs rename to lang-server/LanguageServer/Monad.hs index bf547fddf..408624e85 100644 --- a/src/LanguageServer/Monad.hs +++ b/lang-server/LanguageServer/Monad.hs @@ -9,20 +9,11 @@ module LanguageServer.Monad defaultLSState, newLSStateVar, LSM, - getLSState, - getTerminal, - getFlags, - putLSState, - modifyLSState, - getLoaded, - putLoaded,removeLoaded, - getLoadedModule, + getTerminal,getFlags,getColorScheme,getHtmlPrinter, + getLSState,putLSState,modifyLSState, + getLoaded,putLoaded,removeLoaded, removeLoadedUri,getLoadedModule, getModules, - getColorScheme, - getHtmlPrinter, - getDiagnostics, - putDiagnostics, - clearDiagnostics, + getDiagnostics,putDiagnostics,clearDiagnostics, runLSM, ) where @@ -58,12 +49,12 @@ import GHC.Conc (atomically) import Control.Concurrent.STM (newTVarIO, TVar) import qualified Data.Set as Set import Control.Concurrent.STM.TMVar (TMVar) -import LanguageServer.Conversions (loadedModuleFromUri) import qualified Data.ByteString as D import Platform.Filetime (FileTime) import Common.File (realPath,normalize) import Compiler.Module (Modules) import Data.Maybe (fromMaybe) +import Data.List (find) -- The language server's state, e.g. holding loaded/compiled modules. data LSState = LSState { @@ -80,16 +71,34 @@ data LSState = LSState { diagnostics :: !(M.Map J.NormalizedUri [J.Diagnostic]) } -trimnl :: [Char] -> [Char] -trimnl str = reverse $ dropWhile (`elem` "\n\r\t ") $ reverse str +-- The monad holding (thread-safe) state used by the language server. +type LSM = LspT () (ReaderT (MVar LSState) IO) + +-- Runs the language server's state monad. +runLSM :: LSM a -> MVar LSState -> LanguageContextEnv () -> IO a +runLSM lsm stVar cfg = runReaderT (runLspT cfg lsm) stVar + +newLSStateVar :: Flags -> IO (MVar LSState) +newLSStateVar flags = defaultLSState flags >>= newMVar + +-- Fetches the language server's state inside the LSM monad +getLSState :: LSM LSState +getLSState = do + stVar <- lift ask + liftIO $ readMVar stVar + +-- Replaces the language server's state inside the LSM monad +putLSState :: LSState -> LSM () +putLSState s = do + stVar <- lift ask + liftIO $ putMVar stVar s + +-- Updates the language server's state inside the LSM monad +modifyLSState :: (LSState -> LSState) -> LSM () +modifyLSState m = do + stVar <- lift ask + liftIO $ modifyMVar stVar $ \s -> return (m s, ()) -htmlTextColorPrinter :: Doc -> IO T.Text -htmlTextColorPrinter doc - = do - stringVar <- newVar (T.pack "") - let printer = PHtmlText (HtmlTextPrinter stringVar) - writePrettyLn printer doc - takeVar stringVar defaultLSState :: Flags -> IO LSState defaultLSState flags = do @@ -97,6 +106,9 @@ defaultLSState flags = do pendingRequests <- newTVarIO Set.empty cancelledRequests <- newTVarIO Set.empty fileVersions <- newTVarIO M.empty + -- Trim trailing whitespace and newlines from the end of a string + let trimnl :: [Char] -> [Char] + trimnl str = reverse $ dropWhile (`elem` "\n\r\t ") $ reverse str let withNewPrinter f = do ansiConsole <- newVar ansiDefault stringVar <- newVar "" @@ -114,69 +126,59 @@ defaultLSState flags = do (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) return LSState {lsLoaded = M.empty,lsModules=[], messages = msgChan, terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, documentInfos = M.empty, documentVersions = fileVersions, diagnostics = M.empty} +htmlTextColorPrinter :: Doc -> IO T.Text +htmlTextColorPrinter doc + = do + stringVar <- newVar (T.pack "") + let printer = PHtmlText (HtmlTextPrinter stringVar) + writePrettyLn printer doc + takeVar stringVar + putScheme p env tp = writePrettyLn p (ppScheme env tp) putErrorMessage p endToo cscheme err = writePrettyLn p (ppErrorMessage endToo cscheme err) -newLSStateVar :: Flags -> IO (MVar LSState) -newLSStateVar flags = defaultLSState flags >>= newMVar - --- The monad holding (thread-safe) state used by the language server. -type LSM = LspT () (ReaderT (MVar LSState) IO) - --- Fetches the language server's state inside the LSM monad -getLSState :: LSM LSState -getLSState = do - stVar <- lift ask - liftIO $ readMVar stVar +-- Fetches the terminal used for printing messages +getTerminal :: LSM Terminal +getTerminal = terminal <$> getLSState --- Replaces the language server's state inside the LSM monad -putLSState :: LSState -> LSM () -putLSState s = do - stVar <- lift ask - liftIO $ putMVar stVar s +-- Fetches the loaded state holding compiled modules +getFlags :: LSM Flags +getFlags = flags <$> getLSState --- Updates the language server's state inside the LSM monad -modifyLSState :: (LSState -> LSState) -> LSM () -modifyLSState m = do - stVar <- lift ask - liftIO $ modifyMVar stVar $ \s -> return (m s, ()) +-- Fetches the html printer used for printing markdown compatible text +getHtmlPrinter :: LSM (Doc -> IO T.Text) +getHtmlPrinter = htmlPrinter <$> getLSState -getModules :: LSM Modules -getModules = lsModules <$> getLSState +-- Fetches the color scheme used for coloring markdown compatible text +getColorScheme :: LSM ColorScheme +getColorScheme = colorScheme <$> getFlags -putDiagnostics :: M.Map J.NormalizedUri [J.Diagnostic] -> LSM () -putDiagnostics diags = -- Left biased union prefers more recent diagnostics - modifyLSState $ \s -> s {diagnostics = M.union diags (diagnostics s)} +-- Diagnostics getDiagnostics :: LSM (M.Map J.NormalizedUri [J.Diagnostic]) getDiagnostics = diagnostics <$> getLSState +-- Clear diagnostics for a file clearDiagnostics :: J.NormalizedUri -> LSM () clearDiagnostics uri = modifyLSState $ \s -> s {diagnostics = M.delete uri (diagnostics s)} --- Fetches the loaded state holding compiled modules -getLoaded :: J.Uri -> LSM (Maybe Loaded) -getLoaded uri = do - st <- getLSState - case J.uriToFilePath uri of - Nothing -> return Nothing - Just uri -> do - path <- liftIO $ realPath uri - let p = normalize path - return $ M.lookup p (lsLoaded st) +putDiagnostics :: M.Map J.NormalizedUri [J.Diagnostic] -> LSM () +putDiagnostics diags = -- Left biased union prefers more recent diagnostics + modifyLSState $ \s -> s {diagnostics = M.union diags (diagnostics s)} --- Fetches the loaded state holding compiled modules -getFlags :: LSM Flags -getFlags = flags <$> getLSState -getHtmlPrinter :: LSM (Doc -> IO T.Text) -getHtmlPrinter = htmlPrinter <$> getLSState +-- Fetches all the most recent succesfully compiled modules (for incremental compilation) +getModules :: LSM Modules +getModules = lsModules <$> getLSState -getColorScheme :: LSM ColorScheme -getColorScheme = colorScheme <$> getFlags +mergeModules :: Modules -> Modules -> Modules +mergeModules newModules oldModules = + let nModValid = filter modCompiled newModules -- only add modules that sucessfully compiled + newModNames = map modName nModValid + in nModValid ++ filter (\m -> modName m `notElem` newModNames) oldModules -- Replaces the loaded state holding compiled modules putLoaded :: Loaded -> LSM () @@ -190,15 +192,36 @@ getLoadedModule uri = do lmaybe <- getLoaded uri liftIO $ loadedModuleFromUri lmaybe uri --- Runs the language server's state monad. -runLSM :: LSM a -> MVar LSState -> LanguageContextEnv () -> IO a -runLSM lsm stVar cfg = runReaderT (runLspT cfg lsm) stVar - -getTerminal :: LSM Terminal -getTerminal = terminal <$> getLSState +loadedModuleFromUri :: Maybe Loaded -> J.Uri -> IO (Maybe Module) +loadedModuleFromUri l uri = + case l of + Nothing -> return Nothing + Just l -> + case J.uriToFilePath uri of + Nothing -> return Nothing + Just uri -> do + path <- realPath uri + let p = normalize path + return $ find (\m -> p == modSourcePath m) $ loadedModules l + +-- Removes a loaded module from the loaded state holding compiled modules +removeLoadedUri :: J.Uri -> LSM () +removeLoadedUri uri = do + st <- getLSState + case J.uriToFilePath uri of + Nothing -> return () + Just path -> do + path0 <- liftIO $ realPath path + let path = normalize path0 + putLSState $ st {lsLoaded = M.delete path (lsLoaded st)} -mergeModules :: Modules -> Modules -> Modules -mergeModules newModules oldModules = - let nModValid = filter modCompiled newModules -- only add modules that sucessfully compiled - newModNames = map modName nModValid - in nModValid ++ filter (\m -> modName m `notElem` newModNames) oldModules +-- Fetches the loaded state holding compiled modules +getLoaded :: J.Uri -> LSM (Maybe Loaded) +getLoaded uri = do + st <- getLSState + case J.uriToFilePath uri of + Nothing -> return Nothing + Just uri -> do + path <- liftIO $ realPath uri + let p = normalize path + return $ M.lookup p (lsLoaded st) \ No newline at end of file diff --git a/src/LanguageServer/Run.hs b/lang-server/LanguageServer/Run.hs similarity index 77% rename from src/LanguageServer/Run.hs rename to lang-server/LanguageServer/Run.hs index 1e70f89c0..edc6a4c9a 100644 --- a/src/LanguageServer/Run.hs +++ b/lang-server/LanguageServer/Run.hs @@ -6,6 +6,7 @@ {-# LANGUAGE DataKinds #-} module LanguageServer.Run (runLanguageServer) where +import System.Exit ( exitFailure ) import Compiler.Options (Flags (languageServerPort)) import Control.Monad (void, forever) import Control.Monad.IO.Class (liftIO) @@ -33,12 +34,22 @@ import GHC.IO.StdHandles (stdout, stderr) runLanguageServer :: Flags -> [FilePath] -> IO () runLanguageServer flags files = do + if languageServerPort flags == -1 then do + putStr "No port specified for language server\n. Use --lsport= to specify a port." + exitFailure + else return () + -- Have to set line buffering, otherwise the client doesn't receive data until buffers fill up hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering + -- Connect to localhost on the port given by the client connect "127.0.0.1" (show $ languageServerPort flags) (\(socket, _) -> do + -- Create a handle to the client from the socket handle <- socketToHandle socket ReadWriteMode + -- Create a new language server state state <- newLSStateVar flags - initStateVal <- liftIO $ readMVar state + -- Get the message channel + messageChan <- liftIO $ messages <$> readMVar state + -- Create a new channel for the reactor to receive messages on rin <- atomically newTChan :: IO (TChan ReactorInput) void $ runServerWithHandles @@ -52,7 +63,8 @@ runLanguageServer flags files = do onConfigChange = const $ pure (), defaultConfig = (), configSection = T.pack "koka", - doInitialize = \env _ -> forkIO (reactor rin) >> forkIO (messageHandler (messages initStateVal) env state) >> pure (Right env), + -- Two threads, the request thread and the message thread (so we can send messages to the client, while the compilation is happening) + doInitialize = \env _ -> forkIO (reactor rin) >> forkIO (messageHandler messageChan env state) >> pure (Right env), staticHandlers = \_caps -> lspHandlers rin, interpretHandler = \env -> Iso (\lsm -> runLSM lsm state env) liftIO, options = @@ -65,10 +77,10 @@ runLanguageServer flags files = do }) where prettyMsg l = "[" <> show (L.getSeverity l) <> "] " <> show (L.getMsg l) <> "\n\n" + -- io logger, prints all log level messages to stdout ioLogger :: LogAction IO (WithSeverity LspServerLog) ioLogger = L.cmap prettyMsg L.logStringStdout - stderrLogger :: LogAction IO (WithSeverity T.Text) - stderrLogger = L.cmap show L.logStringStderr + -- lsp logger, prints all messages to stdout and to the client lspLogger :: LogAction (LspM config) (WithSeverity LspServerLog) lspLogger = let clientLogger = L.cmap (fmap (T.pack . show)) defaultClientLogger @@ -81,18 +93,21 @@ runLanguageServer flags files = do (Just False) -- will save (wait until requests are sent to server) (Just $ J.InR $ J.SaveOptions $ Just False) -- trigger on save, but dont send document +-- Handles messages to send to the client, just spins and sends messageHandler :: TChan (String, J.MessageType) -> LanguageContextEnv () -> MVar LSState -> IO () messageHandler msgs env state = do forever $ do (msg, msgType) <- atomically $ readTChan msgs runLSM (sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams msgType $ T.pack msg) state env +-- Runs in a loop, getting the next queued request and executing it reactor :: TChan ReactorInput -> IO () reactor inp = do forever $ do ReactorAction act <- atomically $ readTChan inp act +-- TODO: Finish persisting modules in a separate thread doPersist state env = forever $ do threadDelay 1000000 diff --git a/src/Main.hs b/lang-server/Main.hs similarity index 100% rename from src/Main.hs rename to lang-server/Main.hs diff --git a/package.yaml b/package.yaml index b36996dc3..198e140f5 100644 --- a/package.yaml +++ b/package.yaml @@ -38,40 +38,56 @@ dependencies: - network-simple - network - isocline >= 1.0.6 - + +library: + other-extensions: + - CPP + - OverloadedStrings + source-dirs: + - src + - src/Platform/cpp + c-sources: + - src/Platform/cpp/Platform/cconsole.c + include-dirs: + - src/Platform/cpp/Platform + build-tools: + - alex + ghc-options: + - -j8 + - -O2 + cpp-options: + - -DKOKA_MAIN="koka" + - -DKOKA_VARIANT="release" + - -DKOKA_VERSION="2.4.3" + - -DREADLINE=0 # 1:getline, 2:readline, 3:haskeline, or 0:isocline + when: + - condition: os(windows) + cpp-options: -DWINDOWS + - condition: os(darwin) + cpp-options: -DDARWIN + executables: koka: main: Main.hs - # source-dirs: app - # dependencies: koka - other-extensions: - - CPP - - OverloadedStrings - source-dirs: - - src - - src/Platform/cpp - c-sources: - - src/Platform/cpp/Platform/cconsole.c - include-dirs: - - src/Platform/cpp/Platform - build-tools: - - alex + source-dirs: lang-server + dependencies: koka + ghc-options: + - -rtsopts + - -j8 + - -O2 + - -threaded + - '"-with-rtsopts=-N8"' + + koka-nolsp: + main: Main.hs + source-dirs: app + dependencies: koka ghc-options: - -rtsopts - -j8 - -O2 - -threaded - '"-with-rtsopts=-N8"' - cpp-options: - - -DKOKA_MAIN="koka" - - -DKOKA_VARIANT="release" - - -DKOKA_VERSION="2.4.3" - - -DREADLINE=0 # 1:getline, 2:readline, 3:haskeline, or 0:isocline - when: - - condition: os(windows) - cpp-options: -DWINDOWS - - condition: os(darwin) - cpp-options: -DDARWIN tests: koka-test: diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index 9d396eba4..12d1b18e8 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -181,8 +181,8 @@ gammaFind name g [] -> failure ("Compiler.Compile.gammaFind: can't locate " ++ show name) _ -> failure ("Compiler.Compile.gammaFind: multiple definitions for " ++ show name) -compileExpression :: Terminal -> Flags -> Loaded -> CompileTarget () -> UserProgram -> Int -> String -> IO (Error Loaded (Loaded, Maybe FilePath)) -compileExpression term flags loaded compileTarget program line input +compileExpression :: (FilePath -> Maybe (BString, FileTime)) -> Terminal -> Flags -> Loaded -> CompileTarget () -> UserProgram -> Int -> String -> IO (Error Loaded (Loaded, Maybe FilePath)) +compileExpression maybeContents term flags loaded compileTarget program line input = runIOErr $ do let qnameExpr = (qualify (getName program) nameExpr) def <- liftErrorPartial loaded (parseExpression (semiInsert flags) (show nameInteractiveModule) line qnameExpr input) @@ -191,19 +191,19 @@ compileExpression term flags loaded compileTarget program line input case compileTarget of -- run a particular entry point Executable name () | name /= nameExpr - -> compileProgram' (const Nothing) term flags (loadedModules loaded) [] compileTarget "" programDef [] + -> compileProgram' maybeContents term flags (loadedModules loaded) [] compileTarget "" programDef [] -- entry point is the expression: compile twice: -- first to get the type of the expression and create a 'show' wrapper, -- then to actually run the program | otherwise - -> do (ld, f) <- compileProgram' (const Nothing) term flags{ evaluate = False } (loadedModules loaded) [] Object {-compileTarget-} "" programDef [] + -> do (ld, f) <- compileProgram' maybeContents term flags{ evaluate = False } (loadedModules loaded) [] Object {-compileTarget-} "" programDef [] let tp = infoType (gammaFind qnameExpr (loadedGamma ld)) (_,_,rho) = splitPredType tp -- _ <- liftError $ checkUnhandledEffects flags loaded nameExpr rangeNull rho case splitFunType rho of -- return unit: just run the expression (for its assumed side effect) Just (_,_,tres) | isTypeUnit tres - -> compileProgram' (const Nothing) term flags (loadedModules ld) [] compileTarget "" programDef [] + -> compileProgram' maybeContents term flags (loadedModules ld) [] compileTarget "" programDef [] -- check if there is a show function, or use generic print if not. Just (_,_,tres) -> do -- ld <- compileProgram' term flags (loadedModules ld0) Nothing "" programDef @@ -220,7 +220,7 @@ compileExpression term flags loaded compileTarget program line input [mkApp (Var qnameShow False r) [mkApp (Var qnameExpr False r) []]] let defMain = Def (ValueBinder (qualify (getName program) nameMain) () (Lam [] expression r) r r) r Public (defFun []) InlineNever "" let programDef' = programAddDefs programDef [] [defMain] - compileProgram' (const Nothing) term flags (loadedModules ld) [] (Executable nameMain ()) "" programDef' [] + compileProgram' maybeContents term flags (loadedModules ld) [] (Executable nameMain ()) "" programDef' [] _ -> liftErrorPartial loaded $ errorMsg (ErrorGeneral rangeNull (text "no 'show' function defined for values of type:" <+> ppType (prettyEnvFromFlags flags) tres)) -- mkApp (Var (qualify nameSystemCore (newName "gprintln")) False r) diff --git a/src/Compiler/Options.hs b/src/Compiler/Options.hs index 4c2a9c588..36199f0be 100644 --- a/src/Compiler/Options.hs +++ b/src/Compiler/Options.hs @@ -400,7 +400,7 @@ options = (\(xss,yss) -> (concat xss, concat yss)) $ unzip , hide $ fflag ["specialize"] (\b f -> f{optSpecialize=b}) "enable inline specialization" , hide $ fflag ["unroll"] (\b f -> f{optUnroll=(if b then 1 else 0)}) "enable recursive definition unrolling" , hide $ fflag ["eagerpatbind"] (\b f -> f{optEagerPatBind=b}) "load pattern fields as early as possible" - , numOption 6061 "port" [] ["lsport"] (\i f -> f{languageServerPort=i}) "Language Server port to connect to" + , numOption (-1) "port" [] ["lsport"] (\i f -> f{languageServerPort=i}) "Language Server port to connect to" -- deprecated , hide $ option [] ["cmake"] (ReqArg cmakeFlag "cmd") "use to invoke cmake" diff --git a/src/Interpreter/Interpret.hs b/src/Interpreter/Interpret.hs index 78c3f52d4..056a48f84 100644 --- a/src/Interpreter/Interpret.hs +++ b/src/Interpreter/Interpret.hs @@ -126,7 +126,7 @@ command :: State -> Command -> IO () command st cmd = let term = terminal st in do{ case cmd of - Eval line -> do{ err <- compileExpression term (flags st) (loaded st) (Executable nameExpr ()) (program st) bigLine line + Eval line -> do{ err <- compileExpression (const Nothing) term (flags st) (loaded st) (Executable nameExpr ()) (program st) bigLine line ; checkInferWith st line fst True err $ \(ld, _) -> do if (not (evaluate (flags st))) then let tp = infoType $ gammaFind (qualify nameInteractive nameExpr) (loadedGamma ld) @@ -148,7 +148,7 @@ command st cmd } } - TypeOf line -> do err <- compileExpression term (flags st) (loaded st) Object (program st) bigLine line + TypeOf line -> do err <- compileExpression (const Nothing) term (flags st) (loaded st) Object (program st) bigLine line checkInfer2Fst st True err $ \(ld, _) -> do{ let tp = infoType $ gammaFind (qualify nameInteractive nameExpr) (loadedGamma ld) ; messageSchemeEffect st tp diff --git a/src/LanguageServer/Handler/TextDocument.hs b/src/LanguageServer/Handler/TextDocument.hs deleted file mode 100644 index 7a8affdd3..000000000 --- a/src/LanguageServer/Handler/TextDocument.hs +++ /dev/null @@ -1,247 +0,0 @@ ------------------------------------------------------------------------------ --- The LSP handlers that handle changes to the document ------------------------------------------------------------------------------ -{-# LANGUAGE OverloadedStrings #-} - -module LanguageServer.Handler.TextDocument - ( didOpenHandler, - didChangeHandler, - didSaveHandler, - didCloseHandler, - recompileFile, - compileEditorExpression, - persistModules, - ) -where - -import Common.Error (Error, checkPartial) -import Compiler.Compile (Terminal (..), compileModuleOrFile, Loaded (..), CompileTarget (..), compileFile, codeGen, compileExpression) -import Control.Lens ((^.)) -import Control.Monad.Trans (liftIO) -import qualified Data.Map as M -import Data.Maybe (fromJust, fromMaybe) -import qualified Data.Text as T -import Language.LSP.Diagnostics (partitionBySource) -import Language.LSP.Server (Handlers, flushDiagnosticsBySource, publishDiagnostics, sendNotification, getVirtualFile, getVirtualFiles, notificationHandler) -import qualified Language.LSP.Protocol.Types as J -import qualified Language.LSP.Protocol.Lens as J -import LanguageServer.Conversions (toLspDiagnostics) -import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded, getModules, putDiagnostics, getDiagnostics, clearDiagnostics) -import Language.LSP.VFS (virtualFileText, VFS(..), VirtualFile, file_version, virtualFileVersion) -import qualified Data.Text.Encoding as T -import Data.Functor ((<&>)) -import qualified Language.LSP.Protocol.Message as J -import Data.ByteString (ByteString) -import Data.Map (Map) -import Text.Read (readMaybe) -import Debug.Trace (trace) -import Control.Exception (try) -import qualified Control.Exception as Exc -import Compiler.Options (Flags) -import Common.File (getFileTime, FileTime, getFileTimeOrCurrent, getCurrentTime, normalize, realPath) -import GHC.IO (unsafePerformIO) -import Compiler.Module (Module(..)) -import Control.Monad (when, foldM) -import Data.Time (addUTCTime, addLocalTime) -import qualified Data.ByteString as J -import Syntax.Syntax (programNull, programAddImports) -import Common.Range (rangeNull) -import Core.Core (Visibility(Private)) -import Common.NamePrim (nameInteractiveModule, nameExpr, nameSystemCore) -import Common.Name (newName) -import Syntax.Syntax (Import(..)) - -didOpenHandler :: Handlers LSM -didOpenHandler = notificationHandler J.SMethod_TextDocumentDidOpen $ \msg -> do - let uri = msg ^. J.params . J.textDocument . J.uri - let version = msg ^. J.params . J.textDocument . J.version - flags <- getFlags - _ <- recompileFile InMemory uri (Just version) False flags - return () - -didChangeHandler :: Handlers LSM -didChangeHandler = notificationHandler J.SMethod_TextDocumentDidChange $ \msg -> do - let uri = msg ^. J.params . J.textDocument . J.uri - let version = msg ^. J.params . J.textDocument . J.version - flags <- getFlags - _ <- recompileFile InMemory uri (Just version) False flags - return () - -didSaveHandler :: Handlers LSM -didSaveHandler = notificationHandler J.SMethod_TextDocumentDidSave $ \msg -> do - let uri = msg ^. J.params . J.textDocument . J.uri - flags <- getFlags - _ <- recompileFile InMemory uri Nothing False flags - return () - -didCloseHandler :: Handlers LSM -didCloseHandler = notificationHandler J.SMethod_TextDocumentDidClose $ \_msg -> do - -- TODO: Remove file from LSM state? - return () - -maybeContents :: Map FilePath (ByteString, FileTime, J.Int32) -> FilePath -> Maybe (ByteString, FileTime) -maybeContents vfs uri = do - -- trace ("Maybe contents " ++ show uri ++ " " ++ show (M.keys vfs)) $ return () - (text, ftime, vers) <- M.lookup uri vfs - return (text, ftime) - -diffVFS :: Map FilePath (ByteString, FileTime, J.Int32) -> Map J.NormalizedUri VirtualFile -> LSM (Map FilePath (ByteString, FileTime, J.Int32)) -diffVFS oldvfs vfs = - foldM (\acc (k, v) -> - let newK = normalize $ J.fromNormalizedFilePath $ fromJust $ J.uriToNormalizedFilePath k - text = T.encodeUtf8 $ virtualFileText v - vers = virtualFileVersion v - in case M.lookup newK oldvfs of - Just old@(_, _, vOld) -> - if vOld == vers then - return $ M.insert newK old acc - else do - time <- liftIO getCurrentTime - return $ M.insert newK (text, time, vers) acc - Nothing -> do - time <- liftIO $ getFileTime newK - -- trace ("New file " ++ show newK ++ " " ++ show time) $ return () - return $ M.insert newK (text, time, vers) acc) - M.empty (M.toList vfs) - -compileEditorExpression :: J.Uri -> Flags -> String -> String -> LSM (Maybe FilePath) -compileEditorExpression uri flags filePath functionName = do - let normUri = J.toNormalizedUri uri - term <- getTerminal - loaded <- getLoaded uri - case loaded of - Just loaded -> do - let mod = loadedModule loaded - let imports = [Import nameSystemCore nameSystemCore rangeNull Private, Import (modName mod) (modName mod) rangeNull Private] - let resultIO :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) - resultIO = try $ compileExpression term flags loaded (Executable nameExpr ()) (programAddImports (programNull nameInteractiveModule) imports) 0 (functionName ++ "()") - result <- liftIO resultIO - case result of - Right res -> do - outFile <- case checkPartial res of - Right ((l, outFile), _, _) -> do - putLoaded l - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ "Successfully compiled " <> T.pack filePath - return outFile - Left (e, m) -> do - case m of - Nothing -> - trace ("Error when compiling, no cached modules " ++ show e) $ - return () - Just l -> do - trace ("Error when compiling have cached" ++ show (map modSourcePath $ loadedModules l)) $ return () - putLoaded l - removeLoaded (loadedModule l) - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Error when compiling " ++ show e) <> T.pack filePath - return Nothing - -- Emit the diagnostics (errors and warnings) - let diagSrc = T.pack "koka" - diags = toLspDiagnostics normUri diagSrc res - diagsBySrc = M.map partitionBySource diags - maxDiags = 100 - if null diags then clearDiagnostics normUri else putDiagnostics diags - diags <- getDiagnostics - if null diags - then flushDiagnosticsBySource maxDiags (Just diagSrc) - else mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) - return outFile - Left e -> do - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) - sendNotification J.SMethod_WindowShowMessage $ J.ShowMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) - return Nothing - --- Recompiles the given file, stores the compilation result in --- LSM's state and emits diagnostics. -recompileFile :: CompileTarget () -> J.Uri -> Maybe J.Int32 -> Bool -> Flags -> LSM (Maybe FilePath) -recompileFile compileTarget uri version force flags = - case J.uriToFilePath uri of - Just filePath0 -> do - path <- liftIO $ realPath filePath0 - let filePath = normalize path - -- Recompile the file - vFiles <- getVirtualFiles - let vfs = _vfsMap vFiles - oldvfs <- documentInfos <$> getLSState - newvfs <- diffVFS oldvfs vfs - modifyLSState (\old -> old{documentInfos = newvfs}) - let contents = fst <$> maybeContents newvfs filePath - modules <- getModules - loaded <- getLoaded uri - term <- getTerminal - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath - - let resultIO :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) - -- Don't use the cached modules as regular modules (they may be out of date, so we want to resolveImports fully over again) - resultIO = try $ compileFile (maybeContents newvfs) contents term flags [] (if force then [] else modules) compileTarget [] filePath - result <- liftIO resultIO - case result of - Right res -> do - outFile <- case checkPartial res of - Right ((l, outFile), _, _) -> do - putLoaded l - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ "Successfully compiled " <> T.pack filePath - return outFile - Left (e, m) -> do - case m of - Nothing -> - trace ("Error when compiling, no cached modules " ++ show e) $ - return () - Just l -> do - trace ("Error when compiling have cached" ++ show (map modSourcePath $ loadedModules l)) $ return () - putLoaded l - removeLoaded (loadedModule l) - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ T.pack ("Error when compiling " ++ show e) <> T.pack filePath - return Nothing - -- Emit the diagnostics (errors and warnings) - let diagSrc = T.pack "koka" - diags = toLspDiagnostics normUri diagSrc res - diagsBySrc = M.map partitionBySource diags - maxDiags = 100 - if null diags then clearDiagnostics normUri else putDiagnostics diags - diags <- getDiagnostics - if null diags - then flushDiagnosticsBySource maxDiags (Just diagSrc) - else mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) - return outFile - Left e -> do - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) - sendNotification J.SMethod_WindowShowMessage $ J.ShowMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) - return Nothing - Nothing -> return Nothing - where - normUri = J.toNormalizedUri uri - -persistModules :: LSM () -persistModules = do - mld <- getModules - mapM_ persistModule mld -- TODO: Dependency ordering - -persistModule :: Module -> LSM () -persistModule m = do - return () - -- TODO: This works, but needs to check that the dependencies are persisted first. - -- let generate = do - -- -- trace "Generating" $ return () - -- mld <- getLoaded - -- case mld of - -- Just loaded -> do - -- term <- getTerminal - -- flags <- getFlags - -- (loaded, file) <- liftIO $ codeGen term flags Object loaded{loadedModule = m} - -- putLoaded loaded - -- return () - -- Nothing -> return () - -- -- trace ("Module " ++ show (modName m)) $ - -- case modOutputTime m of - -- Nothing -> do - -- -- trace "No output time" $ return () - -- generate - -- -- If it has been 5 seconds since the last time the module was changed - -- -- and it isn't updated on disk persist again. - -- -- We don't do it all the time, because with virtual files and editor changes it would be too much - -- Just t -> do - -- ct <- liftIO getCurrentTime - -- when ((ct > addUTCTime 5 (modTime m)) && (modTime m > t)) $ do - -- -- trace ("Last output time" ++ show t) $ return () - -- generate - -- return () \ No newline at end of file diff --git a/src/Syntax/Syntax.hs b/src/Syntax/Syntax.hs index f7e8fc1d6..709f5d458 100644 --- a/src/Syntax/Syntax.hs +++ b/src/Syntax/Syntax.hs @@ -284,6 +284,13 @@ data Lit | LitString String Range deriving (Show) +litRange :: Lit -> Range +litRange lit + = case lit of + LitInt _ range -> range + LitFloat _ range -> range + LitChar _ range -> range + LitString _ range -> range stripExpr :: Expr t -> Expr t stripExpr (Parens e _ _) = stripExpr e diff --git a/src/Type/Pretty.hs b/src/Type/Pretty.hs index c3c9f302c..b10e6c71e 100644 --- a/src/Type/Pretty.hs +++ b/src/Type/Pretty.hs @@ -126,6 +126,7 @@ type TvScheme = M.Map TypeVar (Prec -> Doc) -- | Pretty print environment for types. data Env = Env{ showKinds :: Bool , showIds :: Bool -- show id numbers + , showFlavours :: Bool , expandSynonyms :: Bool , colors :: ColorScheme , nice :: Nice @@ -156,7 +157,7 @@ data Env = Env{ showKinds :: Bool -- | Default pretty print environment defaultEnv :: Env defaultEnv - = Env False False False + = Env False False False False defaultColorScheme niceEmpty (precTop-1) M.empty (newName "Main") (importsEmpty) False False [] @@ -461,10 +462,11 @@ ppTypeVar :: Env -> TypeVar -> Doc ppTypeVar env (TypeVar id kind flavour) = colorByKindDef env kind colorTypeVar $ wrapKind (showKinds env) env kind $ - (case flavour of - Meta -> text "_" - Skolem -> if (coreIface env) then text "__" else text "$" - _ -> empty) <.> nicePretty (nice env) id <.> (if (showIds env) then text ("=" ++ show id) else empty) + let flav = case flavour of + Meta -> text "_" + Skolem -> if (coreIface env) then text "__" else text "$" + _ -> empty in + (if showFlavours env then flav else empty) <.> nicePretty (nice env) id <.> (if (showIds env) then text ("=" ++ show id) else empty) ppTypeCon :: Env -> TypeCon -> Doc ppTypeCon env (TypeCon name kind) From dba7b7d0f64d17af51e4b5ebd0abd3b84fcc2142 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Thu, 14 Dec 2023 22:18:24 -0700 Subject: [PATCH 19/37] fix error union --- lang-server/LanguageServer/Handler/TextDocument.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lang-server/LanguageServer/Handler/TextDocument.hs b/lang-server/LanguageServer/Handler/TextDocument.hs index 6a33740a4..c1d3c12bc 100644 --- a/lang-server/LanguageServer/Handler/TextDocument.hs +++ b/lang-server/LanguageServer/Handler/TextDocument.hs @@ -215,7 +215,7 @@ processCompilationResult normUri filePath update doIO = do diags = toLspDiagnostics normUri diagSrc res maxDiags = 100 -- Union with the current file mapped to an empty list, since we want to clear diagnostics for this file when it is an error in another file - diags' = M.union (M.fromList [(normUri, [])]) diags + diags' = M.union diags (M.fromList [(normUri, [])]) -- Clear diagnostics for this file if there are no errors / warnings if null diags then clearDiagnostics normUri else putDiagnostics diags' -- Get all the diagnostics for all files (language server doesn't support updating diagnostics for a single file) From 1eb0c86135a677e515559ae062786d67d5ff5dd6 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 08:41:46 -0700 Subject: [PATCH 20/37] add support for running example* functions and reorganize vscode extension --- .../koka.language-koka/src/code-lens.ts | 69 ++++ .../koka.language-koka/src/extension.ts | 378 +++++------------- .../koka.language-koka/src/lang-server.ts | 150 +++++++ 3 files changed, 320 insertions(+), 277 deletions(-) create mode 100644 support/vscode/koka.language-koka/src/code-lens.ts create mode 100644 support/vscode/koka.language-koka/src/lang-server.ts diff --git a/support/vscode/koka.language-koka/src/code-lens.ts b/support/vscode/koka.language-koka/src/code-lens.ts new file mode 100644 index 000000000..c9141ab81 --- /dev/null +++ b/support/vscode/koka.language-koka/src/code-lens.ts @@ -0,0 +1,69 @@ +import path = require("path"); +import * as vscode from "vscode" +import { KokaConfig } from "./workspace"; + +export class MainCodeLensProvider implements vscode.CodeLensProvider { + private onDidChangeCodeLensesEmitter: vscode.EventEmitter = new vscode.EventEmitter() + + constructor(private readonly config: KokaConfig) { } + + public async provideCodeLenses(document: vscode.TextDocument, token: vscode.CancellationToken): Promise { + const doc = document.getText() + const re_main = /((?<=\n)|^)((pub\s+)?fun\s+main\(\))/g; + const re_test = /((?<=\n)|^)((pub\s+)?fun\s+(test[\w-]*)\(\))/g; + const re_example = /((?<=\n)|^)((pub\s+)?fun\s+(example[\w-]*)\(\))/g; + let lenses = []; + let match = null; + let has_main = false; + console.log("Koka: Scanning document for main and test function"); + while (match = re_main.exec(doc)) { + if (has_main){ + console.log("Koka: Found multiple main functions. This is not supported in the compiler.") + return []; + } + has_main = true; + lenses.push(this.createMainCodeLens(document, match.index, match[0].length)) + } + while (match = re_test.exec(doc)) { + if (has_main){ + console.log("Koka: Found both a main and a test function. Only the main function will be runnable via code lens.") + break; + } + lenses.push(this.createTestCodeLens(document, match.index, match[4], match[0].length)) + } + while (match = re_example.exec(doc)) { + if (has_main){ + console.log("Koka: Found both a main and an example function. Only the main function will be runnable via code lens.") + break; + } + lenses.push(this.createTestCodeLens(document, match.index, match[4], match[0].length)) + } + return lenses + } + + private createMainCodeLens(document: vscode.TextDocument, offset: number, len: number): vscode.CodeLens { + return new vscode.CodeLens( + toRange(document, offset, len), + { + arguments: [document.uri], + command: "koka.startWithoutDebugging", + title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)}`, + } + ) + } + + private createTestCodeLens(document: vscode.TextDocument, offset: number, functionName: string, len: number): vscode.CodeLens { + return new vscode.CodeLens( + toRange(document, offset, len), + { + arguments: [document.uri, functionName], + command: "koka.interpretExpression", + title: `Run ${functionName}`, + } + ) + } +} + +function toRange(document: vscode.TextDocument, offset: number, length: number): vscode.Range { + return new vscode.Range(document.positionAt(offset), document.positionAt(offset + length)) +} \ No newline at end of file diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts index 40fe13738..863929c49 100644 --- a/support/vscode/koka.language-koka/src/extension.ts +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -1,233 +1,109 @@ import * as vscode from 'vscode' import * as path from 'path' -import * as child_process from 'child_process' - -import { - LanguageClient, - LanguageClientOptions, - RevealOutputChannelOn, - StreamInfo, -} from 'vscode-languageclient/node' import { KokaConfig, downloadSDK, scanForSDK, uninstallSDK } from './workspace' -import { CancellationToken, CodeLens, DebugConfiguration, DebugConfigurationProvider, EventEmitter, ProviderResult, TextDocument, WorkspaceFolder } from 'vscode' +import { CancellationToken, DebugConfiguration, DebugConfigurationProvider, ProviderResult, WorkspaceFolder } from 'vscode' import { KokaDebugSession } from './debugger' -import { AddressInfo, Server, createServer } from 'net' +import { KokaLanguageServer } from './lang-server' +import { MainCodeLensProvider } from './code-lens' -let stderrOutputChannel: vscode.OutputChannel -let stdoutOutputChannel: vscode.OutputChannel let languageServer: KokaLanguageServer; +export async function deactivate() {} + export async function activate(context: vscode.ExtensionContext) { const vsConfig = vscode.workspace.getConfiguration('koka') // We can always create the client, as it does nothing as long as it is not started console.log(`Koka: language server enabled ${vsConfig.get('languageServer.enabled')}`) const { sdkPath, allSDKs } = scanForSDK(vsConfig) - const config = new KokaConfig(vsConfig, sdkPath, allSDKs) - if (!config.command) { - vscode.window.showInformationMessage(`Koka SDK not functional: tried initializing from path: ${config.sdkPath}\n All SDKs: ${allSDKs}`) + const kokaConfig = new KokaConfig(vsConfig, sdkPath, allSDKs) + if (!kokaConfig.command) { + vscode.window.showInformationMessage(`Koka SDK not functional: tried initializing from path: ${kokaConfig.sdkPath}\n All SDKs: ${allSDKs}`) return // No use initializing the rest of the extension's features } - if (config.debugExtension) { - stderrOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stderr') - stdoutOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stdout') - context.subscriptions.push(stderrOutputChannel) - context.subscriptions.push(stdoutOutputChannel) - } - languageServer = new KokaLanguageServer() - if (vsConfig.get('languageServer.enabled')) { - await languageServer.start(config, context) - } - createCommands(context, vsConfig, config) - // Debug Adaptor stuff - context.subscriptions.push(vscode.commands.registerCommand('extension.language-koka.getProgramName', c => { - return vscode.window.showInputBox({ - placeHolder: "Please enter the name of a koka file in the workspace folder", - value: path.relative(config.cwd, vscode.window.activeTextEditor?.document.fileName || '') || 'test.kk' - }) - })) - - // register a configuration provider for 'koka' debug type - const provider = new KokaRunConfigurationProvider() - context.subscriptions.push(vscode.debug.registerDebugConfigurationProvider('koka', provider)) + // Create commands that do not depend on the language server + createBasicCommands(context); - // debug adapters can be run in different ways by using a vscode.DebugAdapterDescriptorFactory: - // run the debug adapter as a separate process - let factory = new InlineDebugAdapterFactory(config) + if (vsConfig.get('languageServer.enabled')) { + languageServer = new KokaLanguageServer() + await languageServer.start(kokaConfig, context) + } else { + return + } - context.subscriptions.push(vscode.debug.registerDebugAdapterDescriptorFactory('koka', factory)) + // create a new status bar item that we can now manage + const selectSDKMenuItem = vscode.window.createStatusBarItem(vscode.StatusBarAlignment.Right, 100) + selectSDKMenuItem.command = 'koka.selectSDK' + context.subscriptions.push(selectSDKMenuItem) + selectSDKMenuItem.show() + selectSDKMenuItem.text = `Koka SDK` + selectSDKMenuItem.tooltip = `${kokaConfig.sdkPath}` + // create a new status bar item that we can now manage + const selectCompileTarget = vscode.window.createStatusBarItem(vscode.StatusBarAlignment.Right, 100) + selectCompileTarget.command = 'koka.selectTarget' + context.subscriptions.push(selectCompileTarget) + selectCompileTarget.show() + selectCompileTarget.text = `Koka Backend: ${kokaConfig.target}` - const codeLensProvider = new MainCodeLensProvider(config) - context.subscriptions.push(vscode.languages.registerCodeLensProvider({ language: "koka", scheme: "file" }, codeLensProvider)) + // Register debug adapter + registerDebugConfiguration(context, kokaConfig) + // Initialize commands + createCommands(context, vsConfig, kokaConfig, selectSDKMenuItem, selectCompileTarget) + // Code lens (run and test) + context.subscriptions.push( + vscode.languages.registerCodeLensProvider({ language: "koka", scheme: "file" }, new MainCodeLensProvider(kokaConfig)) + ) } -class KokaLanguageServer { - languageClient?: LanguageClient - languageServerProcess?: child_process.ChildProcess - socketServer?: Server - outputChannel?: vscode.OutputChannel - lspWriteEmitter: vscode.EventEmitter = new vscode.EventEmitter(); - lspPty?: vscode.Pseudoterminal - lspTerminal?: vscode.Terminal - - showOutputChannel() { - if (!this.lspTerminal?.exitStatus) { - this.outputChannel?.show() - } else if (this.lspPty) { - this.lspTerminal = vscode.window.createTerminal({ - name: 'Koka Language Server', - pty: this.lspPty, - isTransient: true - }) - this.lspTerminal.show() - } - } - - async start(config: KokaConfig, context: vscode.ExtensionContext) { - console.log(`Koka: Language Server ${config.command} ${config.langServerArgs.join(" ")} Workspace: ${config.cwd}`) - let self = this; - function serverOptions(): Promise { - return new Promise((resolve, reject) => { - let timeout = setTimeout(() => { - reject("Server took too long to connect") - }, 3000) - self.socketServer = createServer((s) => { - console.log("Got Connection to Client") - clearTimeout(timeout) - resolve({ writer: s, reader: s }) - }).listen(0, "127.0.0.1", () => { - const port = (self.socketServer!.address() as AddressInfo).port - console.log(`Starting language server in ${config.cwd} on port ${port}`) - self.languageServerProcess = child_process.spawn(config.command, [...config.langServerArgs, `--lsport=${port}`], { - cwd: config.cwd, - env: process.env, - }) - if (config.debugExtension) { - self.languageServerProcess?.stderr?.on('data', (data) => { - stderrOutputChannel.append(`${data.toString()}`) - }) - self.languageServerProcess?.stdout?.on('data', (data) => { - stdoutOutputChannel.append(`${data.toString()}`) - }) - } - }) - }) - } - // This issue: https://github.com/microsoft/vscode/issues/571 - // This sample: https://github.com/ShMcK/vscode-pseudoterminal/blob/master/src/extension.ts - this.lspPty = { - onDidWrite: (listener) => this.lspWriteEmitter.event((e) => listener(e.replace('\r\n', '\n').replace('\n', '\r\n'))), - open: () => { }, - close: () => { } - }; - this.lspTerminal = vscode.window.createTerminal({ - name: 'Koka Language Server', - pty: this.lspPty, - isTransient: true +// These commands do not depend on the language server +function createBasicCommands(context: vscode.ExtensionContext) { + context.subscriptions.push( + // SDK management + vscode.commands.registerCommand('koka.downloadLatest', () => { + downloadSDK() + }), + vscode.commands.registerCommand('koka.uninstall', () => { + uninstallSDK() }) - this.outputChannel = { - name: 'Koka Language Server', - append: (value: string) => this.lspWriteEmitter.fire(value), - appendLine: (value: string) => { - this.lspWriteEmitter.fire(value) - this.lspWriteEmitter.fire('\r\n') - }, - clear: () => { - this.lspWriteEmitter.fire("\x1b[2J\x1b[3J\x1b[;H") - }, - show: () => this.lspTerminal?.show(), - hide: () => this.lspTerminal?.hide(), - dispose: () => { - this.lspTerminal?.dispose() - this.lspWriteEmitter.dispose() - this.lspPty?.close() - }, - replace: (v) => { - this.lspWriteEmitter.fire("\x1b[2J\x1b[3J\x1b[;H") - this.lspWriteEmitter.fire(v) - }, - - }; - const clientOptions: LanguageClientOptions = { - documentSelector: [{ language: 'koka', scheme: 'file' }], - outputChannel: this.outputChannel, - revealOutputChannelOn: RevealOutputChannelOn.Never, - markdown: { - isTrusted: true, - supportHtml: true, - } - } - this.languageClient = new LanguageClient( - 'Koka Language Client', - serverOptions, - clientOptions, - ) - context.subscriptions.push(this) - - return await this.languageClient.start() - } - - async dispose() { - try { - await this.languageClient?.stop() - await this.languageClient?.dispose() - const result = this.languageServerProcess?.kill('SIGINT') - if (!result) { - console.log("Failed to end language server with SIGINT, trying SIGTERM") - this.languageServerProcess?.kill() - } - this.socketServer?.close() - // TODO: Does the terminal need to be disposed or is that handled by disposing the client - } catch { - // Ignore for now, the process should automatically die when the server / client closes the connection - } - } + ) } -export async function deactivate() { +// Register's some things that are needed for debugging +function registerDebugConfiguration(context: vscode.ExtensionContext, kokaConfig: KokaConfig) { + context.subscriptions.push( + // register a configuration provider for 'koka' debug type + vscode.debug.registerDebugConfigurationProvider('koka', new KokaRunConfigurationProvider()), + // run tests / run main + vscode.debug.registerDebugAdapterDescriptorFactory('koka', new InlineDebugAdapterFactory(kokaConfig)) + ) } +// Create all of the commands that can be used via the vscode api function createCommands( context: vscode.ExtensionContext, config: vscode.WorkspaceConfiguration, kokaConfig: KokaConfig, + selectSDKMenuItem: vscode.StatusBarItem, + selectCompileTarget: vscode.StatusBarItem, ) { context.subscriptions.push( - vscode.commands.registerCommand('koka.startWithoutDebugging', (resource: vscode.Uri) => { - const launchConfig = - { - name: `koka run: ${resource.path}`, - request: "launch", - type: "koka", - program: resource.fsPath, - } - console.log(`Launch config ${launchConfig}`) - vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) - }), - vscode.commands.registerCommand('koka.interpretExpression', (resource: vscode.Uri, functionName: string) => { - const launchConfig = - { - name: `koka run: ${resource.path}`, - request: "launch", - type: "koka", - program: resource.fsPath, - functionName: functionName - } - console.log(`Launch config ${launchConfig}`) - vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) - }), - vscode.commands.registerCommand('koka.downloadLatest', () => { - downloadSDK() + vscode.commands.registerCommand('koka.selectSDK', async () => { + const { sdkPath, allSDKs } = scanForSDK(config) + kokaConfig.allSDKs = allSDKs + const result = await vscode.window.showQuickPick(kokaConfig.allSDKs) + if (result) kokaConfig.selectSDK(result) + selectSDKMenuItem.tooltip = `${kokaConfig.sdkPath}` + await vscode.commands.executeCommand('koka.restartLanguageServer') }), - vscode.commands.registerCommand('koka.uninstall', () => { - uninstallSDK() + // Language Server management + vscode.commands.registerCommand('koka.showLSPOutput', async () => { + languageServer.showOutputChannel() }), vscode.commands.registerCommand('koka.restartLanguageServer', () => { if (!config.get('languageServer.enabled')) return vscode.window.showErrorMessage('Language server is not enabled') - vscode.window.withProgress( { location: vscode.ProgressLocation.Notification, @@ -255,41 +131,47 @@ function createCommands( await new Promise((resolve) => setTimeout(resolve, 2000)) }, ) - vscode.window.createQuickPick - }), - vscode.commands.registerCommand('koka.selectSDK', async () => { - const { sdkPath, allSDKs } = scanForSDK(config) - kokaConfig.allSDKs = allSDKs - const result = await vscode.window.showQuickPick(kokaConfig.allSDKs) - if (result) kokaConfig.selectSDK(result) - selectSDKMenuItem.tooltip = `${kokaConfig.sdkPath}` - await vscode.commands.executeCommand('koka.restartLanguageServer') }), + // Configuration vscode.commands.registerCommand('koka.selectTarget', async () => { const result = await vscode.window.showQuickPick(['C', 'WASM', 'JS', 'C#']) if (result) kokaConfig.selectTarget(result) selectCompileTarget.text = `Koka Backend: ${kokaConfig.target}` }), - vscode.commands.registerCommand('koka.showLSPOutput', async () => { - languageServer.showOutputChannel() - }) + // Debug Adaptor stuff + vscode.commands.registerCommand('extension.language-koka.getProgramName', c => { + return vscode.window.showInputBox({ + placeHolder: "Please enter the name of a koka file in the workspace folder", + value: path.relative(config.cwd, vscode.window.activeTextEditor?.document.fileName || '') || 'test.kk' + }) + }), + // Start a program given just a path + vscode.commands.registerCommand('koka.startWithoutDebugging', (resource: vscode.Uri) => { + const launchConfig = + { + name: `koka run: ${resource.path}`, + request: "launch", + type: "koka", + program: resource.fsPath, + } + console.log(`Launch config ${launchConfig}`) + vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) + }), + // Start a program given a path and a function name + vscode.commands.registerCommand('koka.interpretExpression', (resource: vscode.Uri, functionName: string) => { + const launchConfig = + { + name: `koka run: ${resource.path}`, + request: "launch", + type: "koka", + program: resource.fsPath, + functionName: functionName + } + console.log(`Launch config ${launchConfig}`) + vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) + }), ) - // create a new status bar item that we can now manage - const selectSDKMenuItem = vscode.window.createStatusBarItem(vscode.StatusBarAlignment.Right, 100) - selectSDKMenuItem.command = 'koka.selectSDK' - context.subscriptions.push(selectSDKMenuItem) - selectSDKMenuItem.show() - selectSDKMenuItem.text = `Koka SDK` - selectSDKMenuItem.tooltip = `${kokaConfig.sdkPath}` - - // create a new status bar item that we can now manage - const selectCompileTarget = vscode.window.createStatusBarItem(vscode.StatusBarAlignment.Right, 100) - selectCompileTarget.command = 'koka.selectTarget' - context.subscriptions.push(selectCompileTarget) - selectCompileTarget.show() - selectCompileTarget.text = `Koka Backend: ${kokaConfig.target}` - } @@ -330,62 +212,4 @@ class InlineDebugAdapterFactory implements vscode.DebugAdapterDescriptorFactory if (languageServer.languageClient) return new vscode.DebugAdapterInlineImplementation(new KokaDebugSession(this.config, languageServer.languageClient)) } -} - - -class MainCodeLensProvider implements vscode.CodeLensProvider { - private onDidChangeCodeLensesEmitter: EventEmitter = new EventEmitter() - - constructor(private readonly config: KokaConfig) { } - - public async provideCodeLenses(document: TextDocument, token: CancellationToken): Promise { - const doc = document.getText() - const re_main = /((?<=\n)|^)((pub\s+)?fun\s+main\(\))/g; - const re_test = /((?<=\n)|^)((pub\s+)?fun\s+(test[\w-]*)\(\))/g; - let lenses = []; - let match = null; - console.log("Scanning document for main and test function"); - while (match = re_main.exec(doc)) { - lenses.push(this.createMainCodeLens(document, match.index, match[0].length)) - } - while (match = re_test.exec(doc)) { - console.log(match[4]); - } - console.log("Scanning document for main and test function") - while (match = re_main.exec(doc)) { - console.log(match); - - } - while (match = re_test.exec(doc)) { - console.log(match); - lenses.push(this.createTestCodeLens(document, match.index, match[4], match[0].length)) - } - return lenses - } - - private createMainCodeLens(document: TextDocument, offset: number, len: number): CodeLens { - return new CodeLens( - toRange(document, offset, len), - { - arguments: [document.uri], - command: "koka.startWithoutDebugging", - title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)}`, - } - ) - } - - private createTestCodeLens(document: TextDocument, offset: number, functionName: string, len: number): CodeLens { - return new CodeLens( - toRange(document, offset, len), - { - arguments: [document.uri, functionName], - command: "koka.interpretExpression", - title: `Run ${functionName}`, - } - ) - } -} - -function toRange(document: TextDocument, offset: number, length: number): vscode.Range { - return new vscode.Range(document.positionAt(offset), document.positionAt(offset + length)) } \ No newline at end of file diff --git a/support/vscode/koka.language-koka/src/lang-server.ts b/support/vscode/koka.language-koka/src/lang-server.ts new file mode 100644 index 000000000..979867c36 --- /dev/null +++ b/support/vscode/koka.language-koka/src/lang-server.ts @@ -0,0 +1,150 @@ + +import * as vscode from "vscode" +import * as child_process from "child_process" +import { AddressInfo, Server, createServer } from 'net' + +import { + LanguageClient, + LanguageClientOptions, + RevealOutputChannelOn, + StreamInfo, +} from 'vscode-languageclient/node' +import { KokaConfig } from "./workspace" + +let firstRun = true; +export class KokaLanguageServer { + languageClient?: LanguageClient + languageServerProcess?: child_process.ChildProcess + socketServer?: Server + outputChannel?: vscode.OutputChannel + lspWriteEmitter: vscode.EventEmitter = new vscode.EventEmitter(); + lspPty?: vscode.Pseudoterminal + lspTerminal?: vscode.Terminal + stderrOutputChannel?: vscode.OutputChannel + stdoutOutputChannel?: vscode.OutputChannel + + KokaLanguageServer(context: vscode.ExtensionContext) { + if (firstRun) { + this.stderrOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stderr') + this.stdoutOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stdout') + context.subscriptions.push(this.stderrOutputChannel) + context.subscriptions.push(this.stdoutOutputChannel) + firstRun = false; + } + } + + showOutputChannel() { + if (!this.lspTerminal?.exitStatus) { + this.outputChannel?.show() + } else if (this.lspPty) { + this.lspTerminal = vscode.window.createTerminal({ + name: 'Koka Language Server', + pty: this.lspPty, + isTransient: true + }) + this.lspTerminal.show() + } + } + + async start(config: KokaConfig, context: vscode.ExtensionContext) { + console.log(`Koka: Language Server ${config.command} ${config.langServerArgs.join(" ")} Workspace: ${config.cwd}`) + let self = this; + function serverOptions(): Promise { + return new Promise((resolve, reject) => { + let timeout = setTimeout(() => { + reject("Server took too long to connect") + }, 3000) + self.socketServer = createServer((s) => { + console.log("Got Connection to Client") + clearTimeout(timeout) + resolve({ writer: s, reader: s }) + }).listen(0, "127.0.0.1", () => { + const port = (self.socketServer!.address() as AddressInfo).port + console.log(`Starting language server in ${config.cwd} on port ${port}`) + self.languageServerProcess = child_process.spawn(config.command, [...config.langServerArgs, `--lsport=${port}`], { + cwd: config.cwd, + env: process.env, + }) + if (config.debugExtension) { + self.languageServerProcess?.stderr?.on('data', (data) => { + this.stderrOutputChannel.append(`${data.toString()}`) + }) + self.languageServerProcess?.stdout?.on('data', (data) => { + this.stdoutOutputChannel.append(`${data.toString()}`) + }) + } + }) + }) + } + // This issue: https://github.com/microsoft/vscode/issues/571 + // This sample: https://github.com/ShMcK/vscode-pseudoterminal/blob/master/src/extension.ts + this.lspPty = { + onDidWrite: (listener) => this.lspWriteEmitter.event((e) => listener(e.replace('\r\n', '\n').replace('\n', '\r\n'))), + open: () => { }, + close: () => { } + }; + this.lspTerminal = vscode.window.createTerminal({ + name: 'Koka Language Server', + pty: this.lspPty, + isTransient: true + }) + this.outputChannel = { + name: 'Koka Language Server', + append: (value: string) => this.lspWriteEmitter.fire(value), + appendLine: (value: string) => { + this.lspWriteEmitter.fire(value) + this.lspWriteEmitter.fire('\r\n') + }, + clear: () => { + this.lspWriteEmitter.fire("\x1b[2J\x1b[3J\x1b[;H") + }, + show: () => this.lspTerminal?.show(), + hide: () => this.lspTerminal?.hide(), + dispose: () => { + this.lspTerminal?.dispose() + this.lspWriteEmitter.dispose() + this.lspPty?.close() + }, + replace: (v) => { + this.lspWriteEmitter.fire("\x1b[2J\x1b[3J\x1b[;H") + this.lspWriteEmitter.fire(v) + }, + + }; + const clientOptions: LanguageClientOptions = { + documentSelector: [{ language: 'koka', scheme: 'file' }], + outputChannel: this.outputChannel, + revealOutputChannelOn: RevealOutputChannelOn.Never, + markdown: { + isTrusted: true, + supportHtml: true, + } + } + this.languageClient = new LanguageClient( + 'Koka Language Client', + serverOptions, + clientOptions, + ) + context.subscriptions.push(this) + + return await this.languageClient.start() + } + + async dispose() { + try { + this.stdoutOutputChannel.clear(); + this.stderrOutputChannel.clear(); + await this.languageClient?.stop() + await this.languageClient?.dispose() + const result = this.languageServerProcess?.kill('SIGINT') + if (!result) { + console.log("Failed to end language server with SIGINT, trying SIGTERM") + this.languageServerProcess?.kill() + } + this.socketServer?.close() + // TODO: Does the terminal need to be disposed or is that handled by disposing the client + } catch { + // Ignore for now, the process should automatically die when the server / client closes the connection + } + } +} \ No newline at end of file From b776bc29c1581c82fcfd42d9e17aeca3eb16b077 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 10:16:08 -0700 Subject: [PATCH 21/37] add folding handler --- koka.cabal | 1 + lang-server/LanguageServer/Handler/Folding.hs | 156 ++++++++++++++++++ lang-server/LanguageServer/Handlers.hs | 4 +- 3 files changed, 160 insertions(+), 1 deletion(-) create mode 100644 lang-server/LanguageServer/Handler/Folding.hs diff --git a/koka.cabal b/koka.cabal index 8fc8de448..7eeec72ae 100644 --- a/koka.cabal +++ b/koka.cabal @@ -175,6 +175,7 @@ executable koka LanguageServer.Handler.Completion LanguageServer.Handler.Definition LanguageServer.Handler.DocumentSymbol + LanguageServer.Handler.Folding LanguageServer.Handler.Hover LanguageServer.Handler.InlayHints LanguageServer.Handler.TextDocument diff --git a/lang-server/LanguageServer/Handler/Folding.hs b/lang-server/LanguageServer/Handler/Folding.hs new file mode 100644 index 000000000..72e498666 --- /dev/null +++ b/lang-server/LanguageServer/Handler/Folding.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE RecordWildCards, FlexibleInstances #-} +module LanguageServer.Handler.Folding(foldingHandler) where + +import qualified Common.Range as R +import Compiler.Module (loadedModule, Loaded, Module) +import Control.Lens ((^.)) +import qualified Data.Text as T +import Language.LSP.Server (Handlers, requestHandler) +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J +import LanguageServer.Conversions (fromLspPos, toLspRange) +import LanguageServer.Monad (LSM, getLoaded) +import qualified Language.LSP.Protocol.Message as J +import Common.Name (nameNil, Name (nameId)) +import Compiler.Compile (modName, Module (modProgram)) +import Data.Maybe (maybeToList) +import Syntax.Syntax +import Common.Syntax +import Language.LSP.Protocol.Types (FoldingRangeKind(FoldingRangeKind_Region)) +import Type.Pretty (ppName) +import Common.Range (Pos(..), Ranged (getRange)) + +-- Handles hover requests +foldingHandler :: Handlers LSM +foldingHandler = requestHandler J.SMethod_TextDocumentFoldingRange $ \req responder -> do + let J.FoldingRangeParams _ _ doc = req ^. J.params + uri = doc ^. J.uri + loaded <- getLoaded uri + let foldings = findFoldingRanges =<< maybeToList loaded + responder $ Right $ J.InL foldings + + +-- Traverses the syntax tree to find document foldings +findFoldingRanges :: Loaded -> [J.FoldingRange] +findFoldingRanges loaded = do + prog <- maybeToList $ modProgram $ loadedModule loaded + foldings prog + + +class HasFoldingRanges a where + foldings :: a -> [J.FoldingRange] + +instance HasFoldingRanges a => HasFoldingRanges (Maybe a) where + foldings = maybe [] foldings + +instance HasFoldingRanges a => HasFoldingRanges [a] where + foldings = (foldings =<<) + +instance HasFoldingRanges () where + foldings = const [] + +instance HasFoldingRanges UserProgram where + foldings prog = foldings (programTypeDefs prog) ++ foldings (programDefs prog) + +-- Type definition instances + +instance HasFoldingRanges UserTypeDefGroup where + foldings tdg = case tdg of + TypeDefRec tds -> foldings tds + TypeDefNonRec td -> foldings td + +instance HasFoldingRanges UserTypeDef where + foldings td = makeFolding r n + where + b = typeDefBinder td + n = tbinderName b + r = typeDefRange td + +instance HasFoldingRanges UserUserCon where + foldings c = makeFolding r n ++ cs + where + n = userconName c + r = userconRange c + cs = foldings (userconParams c) + +type UserConParam = (Visibility,ValueBinder UserType (Maybe (Expr UserType))) +instance HasFoldingRanges UserConParam where + foldings (v, b) = makeFolding r n ++ cs + where + n = binderName b + r = binderRange b + cs = foldings (binderExpr b) + +-- Value definition instances +instance HasFoldingRanges UserDefGroup where + foldings dg = case dg of + DefRec ds -> foldings ds + DefNonRec d -> foldings d + +instance HasFoldingRanges UserDef where + foldings d = makeFolding r n ++ cs + where + b = defBinder d + n = binderName b + r = defRange d + cs = foldings $ binderExpr b + +instance HasFoldingRanges e => HasFoldingRanges (ValueBinder t e) where + foldings b = makeFolding r n ++ cs + where + n = binderName b + r = binderRange b + cs = foldings $ binderExpr b + +instance HasFoldingRanges UserExpr where + foldings ex = case ex of + Lam bs e r -> foldings bs ++ foldings e ++ makeFoldingNoName r + Let (DefRec dfs) e r -> concatMap foldings dfs ++ foldings e + Let (DefNonRec df) e r -> foldings df ++ foldings e + Bind d e r -> foldings d ++ foldings e ++ makeFolding r (getName d) + App e nes _ -> foldings e ++ foldings (map snd nes) + Ann e _ r -> foldings e ++ makeFoldingNoName r + Case e bs r -> foldings e ++ foldings bs ++ makeFoldingNoName r + Parens e _ _ -> foldings e + Handler _ _ _ _ _ bs e1 e2 e3 hbs _ r -> foldings bs ++ foldings e1 + ++ foldings e2 + ++ foldings e3 + ++ foldings hbs ++ makeFoldingNoName r + Inject _ e _ _ -> foldings e + _ -> [] + +instance HasFoldingRanges UserHandlerBranch where + foldings hb = makeFolding r n ++ cs + where + n = hbranchName hb + e = hbranchExpr hb + r = R.getRange (hbranchNameRange hb) `R.combineRange` R.getRange e + ps = hbranchPars hb + cs = foldings ps ++ foldings e + +instance HasFoldingRanges UserBranch where + foldings b = foldings gs + where + p = branchPattern b + gs = branchGuards b + +instance HasFoldingRanges UserGuard where + foldings g = foldings t ++ foldings e + where + t = guardTest g + e = guardExpr g + +makeFoldingNoName :: R.Range -> [J.FoldingRange] +makeFoldingNoName r = [J.FoldingRange lineStart (Just charStart) lineEnd (Just charEnd) (Just J.FoldingRangeKind_Region) Nothing | rangeSpansLine r] + where J.Range {_start=J.Position{_line=lineStart, _character=charStart}, _end=J.Position{_line=lineEnd, _character=charEnd}} = toLspRange r + +makeFolding :: R.Range -> Name -> [J.FoldingRange] +makeFolding r n = + [J.FoldingRange lineStart (Just charStart) lineEnd (Just charEnd) (Just J.FoldingRangeKind_Region) (Just (T.pack $ nameId n)) | rangeSpansLine r] + where J.Range {_start=J.Position{_line=lineStart, _character=charStart}, _end=J.Position{_line=lineEnd, _character=charEnd}} = toLspRange r + + +rangeSpansLine :: R.Range -> Bool +rangeSpansLine r = lineStart /= lineEnd + where lineStart = posLine $ R.rangeStart r + lineEnd = posLine $ R.rangeEnd r diff --git a/lang-server/LanguageServer/Handlers.hs b/lang-server/LanguageServer/Handlers.hs index 21c7c1bb6..cd0a9e2a8 100644 --- a/lang-server/LanguageServer/Handlers.hs +++ b/lang-server/LanguageServer/Handlers.hs @@ -18,6 +18,7 @@ import LanguageServer.Handler.DocumentSymbol (documentSymbolHandler) import LanguageServer.Handler.Hover (hoverHandler) import LanguageServer.Handler.InlayHints (inlayHintsHandler) import LanguageServer.Handler.Commands (commandHandler) +import LanguageServer.Handler.Folding (foldingHandler) import LanguageServer.Handler.TextDocument (didChangeHandler, didCloseHandler, didOpenHandler, didSaveHandler) import LanguageServer.Monad (LSM, runLSM, putLSState, LSState (..)) import Language.LSP.Protocol.Message (TRequestMessage(..), TNotificationMessage(..), Method, MessageDirection(..), MessageKind(..), SMethod (..), SomeLspId (SomeLspId), LspId (..), NotificationMessage (..), ResponseError (..)) @@ -61,7 +62,8 @@ handlers = completionHandler, cancelHandler, commandHandler, - inlayHintsHandler + inlayHintsHandler, + foldingHandler ] -- Handles the initialized notification From 935288b3bc82b57b8deb724e842a243abfb758d2 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 12:03:22 -0700 Subject: [PATCH 22/37] better hover colors and a few other fixes --- .../LanguageServer/Handler/Completion.hs | 15 +++-- .../LanguageServer/Handler/Definition.hs | 29 ++++++++- lang-server/LanguageServer/Handler/Hover.hs | 44 ++++++++++--- lang-server/LanguageServer/Handlers.hs | 12 +++- lang-server/LanguageServer/Monad.hs | 62 ++++++++++++++----- lang-server/LanguageServer/Run.hs | 2 + src/Common/ColorScheme.hs | 43 ++++++++++++- src/Syntax/RangeMap.hs | 17 ++++- .../koka.language-koka/src/extension.ts | 6 +- .../koka.language-koka/src/lang-server.ts | 31 ++++++---- 10 files changed, 204 insertions(+), 57 deletions(-) diff --git a/lang-server/LanguageServer/Handler/Completion.hs b/lang-server/LanguageServer/Handler/Completion.hs index dccac00a1..1f2bf5d7c 100644 --- a/lang-server/LanguageServer/Handler/Completion.hs +++ b/lang-server/LanguageServer/Handler/Completion.hs @@ -130,12 +130,15 @@ getCompletionInfo pos@(J.Position l c) (VirtualFile _ _ ropetext) mod uri = let currentType = if isFunctionCompletion then let currentRange = fromLspPos uri (J.Position l newC) in - do - (range, rangeInfo) <- rangeMapFindAt currentRange rm - t <- rangeInfoType rangeInfo - case splitFunType t of - Just (pars,eff,res) -> Just res - Nothing -> Just t + do -- maybe monad + ri <- rangeMapFindAt currentRange rm + case ri of + [(r, rangeInfo)] -> do + t <- rangeInfoType rangeInfo + case splitFunType t of + Just (pars,eff,res) -> Just res + Nothing -> Just t + _ -> Nothing else Nothing -- currentRope is already a single line, but it may include an enclosing '\n' let curLine = T.dropWhileEnd (== '\n') $ Rope.toText currentRope diff --git a/lang-server/LanguageServer/Handler/Definition.hs b/lang-server/LanguageServer/Handler/Definition.hs index 8067d5f19..a6e761258 100644 --- a/lang-server/LanguageServer/Handler/Definition.hs +++ b/lang-server/LanguageServer/Handler/Definition.hs @@ -8,6 +8,8 @@ module LanguageServer.Handler.Definition (definitionHandler) where import Compiler.Module (Loaded (..), loadedModule, modRangeMap) import Control.Lens ((^.)) import qualified Data.Map as M +import Common.Range as R +import Data.Foldable(maximumBy) import Data.Maybe (maybeToList) import Kind.Constructors (conInfoRange, constructorsLookup) import Kind.Newtypes (dataInfoRange, newtypesLookupAny) @@ -17,7 +19,7 @@ import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import LanguageServer.Conversions (fromLspPos, toLspLocation, toLspLocationLink) import LanguageServer.Monad (LSM, getLoaded) -import Syntax.RangeMap (RangeInfo (..), rangeMapFindAt) +import Syntax.RangeMap (RangeInfo (..), rangeMapFindAt, NameInfo (..)) import Type.Assumption (gammaLookupQ, infoRange) import qualified Language.LSP.Protocol.Message as J @@ -30,10 +32,31 @@ definitionHandler = requestHandler J.SMethod_TextDocumentDefinition $ \req respo let defs = do -- maybe monad l <- maybeToList loaded rmap <- maybeToList $ modRangeMap $ loadedModule l - (_, rinfo) <- maybeToList $ rangeMapFindAt (fromLspPos uri pos) rmap - findDefinitions l rinfo + rm <- maybeToList $ rangeMapFindAt (fromLspPos uri pos) rmap + case rangeMapBestDefinition rm of + Just (r, rinfo) -> findDefinitions l rinfo + Nothing -> [] responder $ Right $ J.InR $ J.InL defs +-- Get best rangemap info for a given position +rangeMapBestDefinition rm = + case rm of + [] -> Nothing + [r] -> Just r + xs -> Just $ maximumBy (\a b -> compare (rangeInfoPriority a) (rangeInfoPriority b)) xs + +rangeInfoPriority :: (Range,RangeInfo) -> Int +rangeInfoPriority (r,ri) = + case ri of + Block _ -> -1 + Id _ (NICon{}) True -> 3 + Id _ _ True -> 2 + Id _ _ _ -> 0 + Decl "con" _ _ -> 3 -- Constructors are more important than other decls (such as automatically generated ones) + Decl _ _ _ -> 1 + Warning _ -> 4 + Error _ -> 5 + -- Finds the definition locations of the element -- represented by the given range info. findDefinitions :: Loaded -> RangeInfo -> [J.DefinitionLink] diff --git a/lang-server/LanguageServer/Handler/Hover.hs b/lang-server/LanguageServer/Handler/Hover.hs index e8d0f45bf..934e02313 100644 --- a/lang-server/LanguageServer/Handler/Hover.hs +++ b/lang-server/LanguageServer/Handler/Hover.hs @@ -7,25 +7,28 @@ module LanguageServer.Handler.Hover (hoverHandler, formatRangeInfoHover) where import Compiler.Module (loadedModule, modRangeMap, Loaded (loadedModules, loadedImportMap), Module (modPath, modSourcePath)) +import Compiler.Options (Flags, colorSchemeFromFlags, prettyEnvFromFlags) +import Compiler.Compile (modName) +import Data.Foldable(maximumBy) import Control.Lens ((^.)) +import Control.Monad.Cont (liftIO) +import Common.Range as R +import Common.Name (nameNil) +import Common.ColorScheme (ColorScheme (colorNameQual, colorSource), Color (Gray)) import qualified Data.Text as T -import Language.LSP.Server (Handlers, sendNotification, requestHandler) import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J +import Syntax.RangeMap (NameInfo (..), RangeInfo (..), rangeMapFindAt) +import Language.LSP.Server (Handlers, sendNotification, requestHandler) import LanguageServer.Conversions (fromLspPos, toLspRange) import LanguageServer.Monad (LSM, getLoaded, getLoadedModule, getHtmlPrinter, getFlags) import Lib.PPrint (Pretty (..), Doc, text, (<+>), color) -import Syntax.RangeMap (NameInfo (..), RangeInfo (..), rangeMapFindAt) -import qualified Language.LSP.Protocol.Message as J -import Control.Monad.Cont (liftIO) import Type.Pretty (ppScheme, defaultEnv, Env(..), ppName) -import Common.ColorScheme (ColorScheme (colorNameQual, colorSource), Color (Gray)) import Kind.Pretty (prettyKind) -import Common.Name (nameNil) import Kind.ImportMap (importsEmpty, ImportMap) -import Compiler.Options (Flags, colorSchemeFromFlags, prettyEnvFromFlags) -import Compiler.Compile (modName) import Type.Type (Name) +import Debug.Trace (trace) -- Handles hover requests hoverHandler :: Handlers LSM @@ -39,7 +42,9 @@ hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do l <- loaded rmap <- modRangeMap mod -- Find the range info at the given position - (r, rinfo) <- rangeMapFindAt (fromLspPos uri pos) rmap + rm <- rangeMapFindAt (fromLspPos uri pos) rmap + trace (show rm) $ return () + (r, rinfo) <- rangeMapBestHover rm return (modName mod, loadedImportMap l, r, rinfo) case res of Just (mName, imports, r, rinfo) -> do @@ -54,12 +59,31 @@ hoverHandler = requestHandler J.SMethod_TextDocumentHover $ \req responder -> do responder $ Right $ J.InL rsp Nothing -> responder $ Right $ J.InR J.Null +-- Get best rangemap info for a given position +rangeMapBestHover rm = + case rm of + [] -> Nothing + [r] -> Just r + xs -> Just $ maximumBy (\a b -> compare (rangeInfoPriority a) (rangeInfoPriority b)) xs + +rangeInfoPriority :: (Range,RangeInfo) -> Int +rangeInfoPriority (r,ri) = + case ri of + Block _ -> -1 + Id _ (NICon{}) True -> 3 + Id _ _ True -> 2 + Id _ _ _ -> 0 + Decl "con" _ _ -> 3 -- Constructors are more important than other decls (such as automatically generated ones) + Decl _ _ _ -> 1 + Warning _ -> 4 + Error _ -> 5 + -- Pretty-prints type/kind information to a hover tooltip given a type pretty environment, color scheme formatRangeInfoHover :: Env -> ColorScheme -> RangeInfo -> Doc formatRangeInfoHover env colors rinfo = case rinfo of Id qname info isdef -> - ppName env{colors=colors{colorSource = Gray}} qname <+> text " : " <+> case info of + ppName env qname <+> text " : " <+> case info of NIValue tp _ -> ppScheme env tp NICon tp -> ppScheme env tp NITypeCon k -> prettyKind colors k diff --git a/lang-server/LanguageServer/Handlers.hs b/lang-server/LanguageServer/Handlers.hs index cd0a9e2a8..c8ca42fe1 100644 --- a/lang-server/LanguageServer/Handlers.hs +++ b/lang-server/LanguageServer/Handlers.hs @@ -20,7 +20,7 @@ import LanguageServer.Handler.InlayHints (inlayHintsHandler) import LanguageServer.Handler.Commands (commandHandler) import LanguageServer.Handler.Folding (foldingHandler) import LanguageServer.Handler.TextDocument (didChangeHandler, didCloseHandler, didOpenHandler, didSaveHandler) -import LanguageServer.Monad (LSM, runLSM, putLSState, LSState (..)) +import LanguageServer.Monad (LSM, runLSM, LSState (..), updateConfig) import Language.LSP.Protocol.Message (TRequestMessage(..), TNotificationMessage(..), Method, MessageDirection(..), MessageKind(..), SMethod (..), SomeLspId (SomeLspId), LspId (..), NotificationMessage (..), ResponseError (..)) import Control.Monad.Trans (lift) import Control.Monad.Reader (MonadReader(ask)) @@ -44,6 +44,7 @@ import Language.LSP.Protocol.Types (DidChangeTextDocumentParams(..), VersionedTe import Control.Monad (when, unless) import qualified Data.Text as T +import qualified Debug.Trace as Debug newtype ReactorInput = ReactorAction (IO ()) @@ -63,9 +64,16 @@ handlers = cancelHandler, commandHandler, inlayHintsHandler, - foldingHandler + foldingHandler, + configurationChangeHandler ] +configurationChangeHandler :: Handlers LSM +configurationChangeHandler = notificationHandler J.SMethod_WorkspaceDidChangeConfiguration $ \_not -> do + let J.DidChangeConfigurationParams{_settings} = _not ^. params + updateConfig _settings + return () + -- Handles the initialized notification initializedHandler :: Handlers LSM initializedHandler = notificationHandler J.SMethod_Initialized $ \_not -> sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info (T.pack "Initialized language server.") diff --git a/lang-server/LanguageServer/Monad.hs b/lang-server/LanguageServer/Monad.hs index 408624e85..3d1c0b540 100644 --- a/lang-server/LanguageServer/Monad.hs +++ b/lang-server/LanguageServer/Monad.hs @@ -4,15 +4,18 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} + module LanguageServer.Monad ( LSState (..), defaultLSState, newLSStateVar, LSM, getTerminal,getFlags,getColorScheme,getHtmlPrinter, - getLSState,putLSState,modifyLSState, - getLoaded,putLoaded,removeLoaded, removeLoadedUri,getLoadedModule, + getLSState,modifyLSState, + getLoaded,putLoaded,removeLoaded,removeLoadedUri,getLoadedModule, getModules, + updateConfig, getDiagnostics,putDiagnostics,clearDiagnostics, runLSM, ) @@ -32,7 +35,7 @@ import Lib.PPrint (Pretty(..), asString, writePrettyLn, Doc) import Control.Concurrent.Chan (readChan) import Type.Pretty (ppType, defaultEnv, Env (context, importsMap), ppScheme) import qualified Language.LSP.Server as J -import GHC.Base (Type) +import GHC.Base (Type, Alternative (..)) import Lib.Printer (withColorPrinter, withColor, writeLn, ansiDefault, AnsiStringPrinter (AnsiString), Color (Red), ColorPrinter (PAnsiString, PHtmlText), withHtmlTextPrinter, HtmlTextPrinter (..)) import Compiler.Options (Flags (..), prettyEnvFromFlags, verbose) import Common.Error (ppErrorMessage) @@ -55,6 +58,9 @@ import Common.File (realPath,normalize) import Compiler.Module (Modules) import Data.Maybe (fromMaybe) import Data.List (find) +import qualified Data.Aeson as A +import Data.Aeson.Types +import Common.ColorScheme (darkColorScheme, lightColorScheme) -- The language server's state, e.g. holding loaded/compiled modules. data LSState = LSState { @@ -68,7 +74,8 @@ data LSState = LSState { cancelledRequests :: !(TVar (Set.Set J.SomeLspId)), documentVersions :: !(TVar (M.Map J.Uri J.Int32)), documentInfos :: !(M.Map FilePath (D.ByteString, FileTime, J.Int32)), - diagnostics :: !(M.Map J.NormalizedUri [J.Diagnostic]) + diagnostics :: !(M.Map J.NormalizedUri [J.Diagnostic]), + config :: Config } -- The monad holding (thread-safe) state used by the language server. @@ -87,19 +94,12 @@ getLSState = do stVar <- lift ask liftIO $ readMVar stVar --- Replaces the language server's state inside the LSM monad -putLSState :: LSState -> LSM () -putLSState s = do - stVar <- lift ask - liftIO $ putMVar stVar s - -- Updates the language server's state inside the LSM monad modifyLSState :: (LSState -> LSState) -> LSM () modifyLSState m = do stVar <- lift ask liftIO $ modifyMVar stVar $ \s -> return (m s, ()) - defaultLSState :: Flags -> IO LSState defaultLSState flags = do msgChan <- atomically newTChan :: IO (TChan (String, J.MessageType)) @@ -108,7 +108,7 @@ defaultLSState flags = do fileVersions <- newTVarIO M.empty -- Trim trailing whitespace and newlines from the end of a string let trimnl :: [Char] -> [Char] - trimnl str = reverse $ dropWhile (`elem` "\n\r\t ") $ reverse str + trimnl str = reverse $ dropWhile (`T.elem` "\n\r\t ") $ reverse str let withNewPrinter f = do ansiConsole <- newVar ansiDefault stringVar <- newVar "" @@ -124,7 +124,11 @@ defaultLSState flags = do (if verbose flags > 0 then (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) else (\_ -> return ())) (\tp -> withNewPrinter $ \p -> do putScheme p (prettyEnv flags nameNil importsEmpty) tp; return J.MessageType_Info) (\msg -> withNewPrinter $ \p -> do writePrettyLn p msg; return J.MessageType_Info) - return LSState {lsLoaded = M.empty,lsModules=[], messages = msgChan, terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, documentInfos = M.empty, documentVersions = fileVersions, diagnostics = M.empty} + return LSState { + lsLoaded = M.empty, lsModules=[], + messages = msgChan, pendingRequests=pendingRequests, cancelledRequests=cancelledRequests, config=Config{colors=Colors{mode="dark"}}, + terminal = term, htmlPrinter = htmlTextColorPrinter, flags = flags, + documentInfos = M.empty, documentVersions = fileVersions, diagnostics = M.empty} htmlTextColorPrinter :: Doc -> IO T.Text htmlTextColorPrinter doc @@ -140,6 +144,35 @@ putScheme p env tp putErrorMessage p endToo cscheme err = writePrettyLn p (ppErrorMessage endToo cscheme err) +data Config = Config { + colors :: Colors +} +data Colors = Colors { + mode :: String +} + +instance FromJSON Colors where + parseJSON (A.Object v) = Colors <$> v .: "mode" + parseJSON _ = empty + +instance FromJSON Config where + parseJSON (A.Object v) = Config <$> v .: "colors" + parseJSON _ = empty + +updateConfig :: A.Value -> LSM () +updateConfig cfg = + case fromJSON cfg of + A.Success cfg -> do + modifyLSState $ \s -> + let s' = s{config=cfg} in + if mode (colors cfg) == "dark" then + trace "setting color scheme to dark" $ + s'{flags=(flags s'){colorScheme=darkColorScheme}} + else + trace "setting color scheme to light" $ + s'{flags=(flags s'){colorScheme=lightColorScheme}} + + -- Fetches the terminal used for printing messages getTerminal :: LSM Terminal getTerminal = terminal <$> getLSState @@ -207,13 +240,12 @@ loadedModuleFromUri l uri = -- Removes a loaded module from the loaded state holding compiled modules removeLoadedUri :: J.Uri -> LSM () removeLoadedUri uri = do - st <- getLSState case J.uriToFilePath uri of Nothing -> return () Just path -> do path0 <- liftIO $ realPath path let path = normalize path0 - putLSState $ st {lsLoaded = M.delete path (lsLoaded st)} + modifyLSState (\st -> st {lsLoaded = M.delete path (lsLoaded st)}) -- Fetches the loaded state holding compiled modules getLoaded :: J.Uri -> LSM (Maybe Loaded) diff --git a/lang-server/LanguageServer/Run.hs b/lang-server/LanguageServer/Run.hs index edc6a4c9a..9bac99b7f 100644 --- a/lang-server/LanguageServer/Run.hs +++ b/lang-server/LanguageServer/Run.hs @@ -80,6 +80,8 @@ runLanguageServer flags files = do -- io logger, prints all log level messages to stdout ioLogger :: LogAction IO (WithSeverity LspServerLog) ioLogger = L.cmap prettyMsg L.logStringStdout + stderrLogger :: LogAction IO (WithSeverity T.Text) + stderrLogger = L.cmap show L.logStringStderr -- lsp logger, prints all messages to stdout and to the client lspLogger :: LogAction (LspM config) (WithSeverity LspServerLog) lspLogger = diff --git a/src/Common/ColorScheme.hs b/src/Common/ColorScheme.hs index 13d4061cb..840a55efe 100644 --- a/src/Common/ColorScheme.hs +++ b/src/Common/ColorScheme.hs @@ -12,6 +12,8 @@ module Common.ColorScheme( ColorScheme(..) , Color(..) , defaultColorScheme + , darkColorScheme + , lightColorScheme -- * Flags , readColorFlags , ansiColor @@ -89,7 +91,7 @@ darkColorScheme , colorTypeKeywordOp = colorType c -- colorReservedOp c , colorTypeParam = colorParameter c } - in c + in defaultTo c White lightColorScheme = let c = darkColorScheme { @@ -104,7 +106,44 @@ lightColorScheme , colorMarker = colorInterpreter c , colorString = Red } - in c + in defaultTo c Black + +defaultColor :: Color -> Color -> Color +defaultColor color clr + = if (clr == ColorDefault) then color else clr + +defaultTo :: ColorScheme -> Color -> ColorScheme +defaultTo cs color = + cs{ colorType = defaultColor color $ colorType cs + , colorParameter = defaultColor color $ colorParameter cs + , colorKind = defaultColor color $ colorKind cs + , colorMarker = defaultColor color $ colorMarker cs + , colorWarning = defaultColor color $ colorWarning cs + , colorError = defaultColor color $ colorError cs + , colorSource = defaultColor color $ colorSource cs + , colorInterpreter = defaultColor color $ colorInterpreter cs + , colorCommand = defaultColor color $ colorCommand cs + , colorKeyword = defaultColor color $ colorKeyword cs + , colorEffect = defaultColor color $ colorEffect cs + , colorRange = defaultColor color $ colorRange cs + , colorSep = defaultColor color $ colorSep cs + -- syntax coloring + , colorComment = defaultColor color $ colorComment cs + , colorReserved = defaultColor color $ colorReserved cs + , colorReservedOp = defaultColor color $ colorReservedOp cs + , colorSpecial = defaultColor color $ colorSpecial cs + , colorString = defaultColor color $ colorString cs + , colorNumber = defaultColor color $ colorNumber cs + , colorModule = defaultColor color $ colorModule cs + , colorCons = defaultColor color $ colorCons cs + , colorTypeCon = defaultColor color $ colorTypeCon cs + , colorTypeVar = defaultColor color $ colorTypeVar cs + , colorTypeKeyword = defaultColor color $ colorTypeKeyword cs + , colorTypeKeywordOp = defaultColor color $ colorTypeKeywordOp cs + , colorTypeSpecial = defaultColor color $ colorTypeSpecial cs + , colorTypeParam = defaultColor color $ colorTypeParam cs + , colorNameQual = defaultColor color $ colorNameQual cs + } emptyColorScheme = makeColorScheme ColorDefault diff --git a/src/Syntax/RangeMap.hs b/src/Syntax/RangeMap.hs index ea993b12b..b85c1f936 100644 --- a/src/Syntax/RangeMap.hs +++ b/src/Syntax/RangeMap.hs @@ -22,7 +22,7 @@ module Syntax.RangeMap( RangeMap, RangeInfo(..), NameInfo(..) -- import Lib.Trace import Data.Char ( isSpace ) import Common.Failure -import Data.List (sortBy, groupBy, minimumBy) +import Data.List (sortBy, groupBy, minimumBy, foldl') import Lib.PPrint import Common.Range import Common.Name @@ -32,6 +32,7 @@ import Type.Type import Kind.Kind import Type.TypeVar import Type.Pretty() +import Data.Maybe (fromMaybe) newtype RangeMap = RM [(Range,RangeInfo)] deriving Show @@ -171,15 +172,25 @@ rangeMapFindIn rng (RM rm) where start = rangeStart rng end = rangeEnd rng -rangeMapFindAt :: Pos -> RangeMap -> Maybe (Range, RangeInfo) +rangeMapFindAt :: Pos -> RangeMap -> Maybe [(Range, RangeInfo)] rangeMapFindAt pos (RM rm) = shortestRange $ filter (containsPos . fst) rm where containsPos rng = rangeStart rng <= pos && rangeEnd rng >= pos shortestRange [] = Nothing - shortestRange rs = Just $ minimumBy cmp rs + shortestRange rs = Just $ minimumByList cmp rs cmp (r1,_) (r2,_) = compare (rangeLength r1) (rangeLength r2) +minimumByList :: Foldable t => (a -> a -> Ordering) -> t a -> [a] +minimumByList cmp la = fromMaybe [] (foldl' min' Nothing la) + where + min' mx y = Just $! case mx of + Nothing -> [y] + Just (x:xs) -> case cmp x y of + GT -> [y] + EQ -> y:x:xs + _ -> x:xs + rangeInfoType :: RangeInfo -> Maybe Type rangeInfoType ri = case ri of diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts index 863929c49..e7bc0617d 100644 --- a/support/vscode/koka.language-koka/src/extension.ts +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -9,7 +9,7 @@ import { MainCodeLensProvider } from './code-lens' let languageServer: KokaLanguageServer; -export async function deactivate() {} +export async function deactivate() { } export async function activate(context: vscode.ExtensionContext) { const vsConfig = vscode.workspace.getConfiguration('koka') @@ -26,7 +26,7 @@ export async function activate(context: vscode.ExtensionContext) { createBasicCommands(context); if (vsConfig.get('languageServer.enabled')) { - languageServer = new KokaLanguageServer() + languageServer = new KokaLanguageServer(context) await languageServer.start(kokaConfig, context) } else { return @@ -120,7 +120,7 @@ function createCommands( const { sdkPath, allSDKs } = scanForSDK(config) const newConfig = new KokaConfig(config, sdkPath, allSDKs) - languageServer = new KokaLanguageServer() + languageServer = new KokaLanguageServer(context) await languageServer.start(newConfig, context) progress.report({ diff --git a/support/vscode/koka.language-koka/src/lang-server.ts b/support/vscode/koka.language-koka/src/lang-server.ts index 979867c36..74019c992 100644 --- a/support/vscode/koka.language-koka/src/lang-server.ts +++ b/support/vscode/koka.language-koka/src/lang-server.ts @@ -4,6 +4,7 @@ import * as child_process from "child_process" import { AddressInfo, Server, createServer } from 'net' import { + DidChangeConfigurationNotification, LanguageClient, LanguageClientOptions, RevealOutputChannelOn, @@ -11,7 +12,10 @@ import { } from 'vscode-languageclient/node' import { KokaConfig } from "./workspace" -let firstRun = true; +let stderrOutputChannel: vscode.OutputChannel +let stdoutOutputChannel: vscode.OutputChannel +let firstRun = true + export class KokaLanguageServer { languageClient?: LanguageClient languageServerProcess?: child_process.ChildProcess @@ -20,15 +24,13 @@ export class KokaLanguageServer { lspWriteEmitter: vscode.EventEmitter = new vscode.EventEmitter(); lspPty?: vscode.Pseudoterminal lspTerminal?: vscode.Terminal - stderrOutputChannel?: vscode.OutputChannel - stdoutOutputChannel?: vscode.OutputChannel - KokaLanguageServer(context: vscode.ExtensionContext) { + constructor(context: vscode.ExtensionContext) { if (firstRun) { - this.stderrOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stderr') - this.stdoutOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stdout') - context.subscriptions.push(this.stderrOutputChannel) - context.subscriptions.push(this.stdoutOutputChannel) + stderrOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stderr') + stdoutOutputChannel = vscode.window.createOutputChannel('Koka Language Server Stdout') + context.subscriptions.push(stderrOutputChannel) + context.subscriptions.push(stdoutOutputChannel) firstRun = false; } } @@ -67,10 +69,12 @@ export class KokaLanguageServer { }) if (config.debugExtension) { self.languageServerProcess?.stderr?.on('data', (data) => { - this.stderrOutputChannel.append(`${data.toString()}`) + // console.log(data.toString()) + stderrOutputChannel.append(`${data.toString()}`) }) self.languageServerProcess?.stdout?.on('data', (data) => { - this.stdoutOutputChannel.append(`${data.toString()}`) + // console.log(data.toString()) + stdoutOutputChannel.append(`${data.toString()}`) }) } }) @@ -127,13 +131,14 @@ export class KokaLanguageServer { ) context.subscriptions.push(this) - return await this.languageClient.start() + await this.languageClient.start() + let isDark = vscode.window.activeColorTheme.kind == vscode.ColorThemeKind.Dark + this.languageClient.sendNotification(DidChangeConfigurationNotification.type, { settings: { colors: { mode: isDark ? "dark" : "light" } } }) + return this.languageClient } async dispose() { try { - this.stdoutOutputChannel.clear(); - this.stderrOutputChannel.clear(); await this.languageClient?.stop() await this.languageClient?.dispose() const result = this.languageServerProcess?.kill('SIGINT') From 6a4e02e18b7e0148ca74b1b0f42edb4453c864a9 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 13:47:22 -0700 Subject: [PATCH 23/37] fix diagnostic issue --- lang-server/LanguageServer/Handler/TextDocument.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lang-server/LanguageServer/Handler/TextDocument.hs b/lang-server/LanguageServer/Handler/TextDocument.hs index c1d3c12bc..9faf30474 100644 --- a/lang-server/LanguageServer/Handler/TextDocument.hs +++ b/lang-server/LanguageServer/Handler/TextDocument.hs @@ -226,7 +226,9 @@ processCompilationResult normUri filePath update doIO = do -- If there are no diagnostics clear all koka diagnostics then flushDiagnosticsBySource maxDiags (Just diagSrc) -- Otherwise report all diagnostics - else mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) + else do + flushDiagnosticsBySource maxDiags (Just diagSrc) + mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) return outFile -- Persists all modules to disk From eba708f661c7e42e30ea8c8c2bb95bd5e30e4b67 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 14:53:47 -0700 Subject: [PATCH 24/37] update diagnostics --- lang-server/LanguageServer/Conversions.hs | 1 + .../LanguageServer/Handler/TextDocument.hs | 23 +++++++++++++------ 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/lang-server/LanguageServer/Conversions.hs b/lang-server/LanguageServer/Conversions.hs index 2f70280a6..0060ef176 100644 --- a/lang-server/LanguageServer/Conversions.hs +++ b/lang-server/LanguageServer/Conversions.hs @@ -12,6 +12,7 @@ module LanguageServer.Conversions toLspDiagnostics, toLspErrorDiagnostics, toLspWarningDiagnostic, + makeDiagnostic, -- * Conversions from LSP types fromLspPos, diff --git a/lang-server/LanguageServer/Handler/TextDocument.hs b/lang-server/LanguageServer/Handler/TextDocument.hs index 9faf30474..42fce61a0 100644 --- a/lang-server/LanguageServer/Handler/TextDocument.hs +++ b/lang-server/LanguageServer/Handler/TextDocument.hs @@ -25,7 +25,7 @@ import Language.LSP.Diagnostics (partitionBySource) import Language.LSP.Server (Handlers, flushDiagnosticsBySource, publishDiagnostics, sendNotification, getVirtualFile, getVirtualFiles, notificationHandler) import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J -import LanguageServer.Conversions (toLspDiagnostics) +import LanguageServer.Conversions (toLspDiagnostics, makeDiagnostic) import LanguageServer.Monad (LSM, getLoaded, putLoaded, getTerminal, getFlags, LSState (documentInfos), getLSState, modifyLSState, removeLoaded, getModules, putDiagnostics, getDiagnostics, clearDiagnostics, removeLoadedUri) import Language.LSP.VFS (virtualFileText, VFS(..), VirtualFile, file_version, virtualFileVersion) import qualified Data.Text.Encoding as T @@ -49,6 +49,7 @@ import Common.Range (rangeNull) import Core.Core (Visibility(Private)) import Common.NamePrim (nameInteractiveModule, nameExpr, nameSystemCore) import Common.Name (newName) +import Lib.PPrint (text) -- Compile the file on opening didOpenHandler :: Handlers LSM @@ -108,11 +109,11 @@ diffVFS oldvfs vfs = -- If the key is in the old map, and the version number is the same, keep the old value if vOld == vers then return $ M.insert newK old acc - else do + else do -- Otherwise update the value with a new timestamp time <- liftIO getCurrentTime return $ M.insert newK (text, time, vers) acc - Nothing -> do + Nothing -> do -- If the key wasn't already present in the map, get it's file time from disk (since it was just opened / created) time <- liftIO $ getFileTimeOrCurrent newK -- trace ("New file " ++ show newK ++ " " ++ show time) $ return () @@ -169,7 +170,7 @@ recompileFile compileTarget uri version force flags = let contents = fst <$> maybeContents newvfs filePath modules <- getModules term <- getTerminal - sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath + sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack $ "Recompiling " ++ filePath -- Don't use the cached modules as regular modules (they may be out of date, so we want to resolveImports fully over again) let resultIO = compileFile (maybeContents newvfs) contents term flags [] (if force then [] else modules) compileTarget [] filePath processCompilationResult normUri filePath True resultIO @@ -182,13 +183,21 @@ recompileFile compileTarget uri version force flags = processCompilationResult :: J.NormalizedUri -> FilePath -> Bool -> IO (Error Loaded (Loaded, Maybe FilePath)) -> LSM (Maybe FilePath) processCompilationResult normUri filePath update doIO = do let ioResult :: IO (Either Exc.SomeException (Error Loaded (Loaded, Maybe FilePath))) - ioResult = try doIO + ioResult = try doIO result <- liftIO ioResult case result of - Left e -> do + Left e -> do -- Compilation threw an exception, put it in the log, as well as a notification sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) sendNotification J.SMethod_WindowShowMessage $ J.ShowMessageParams J.MessageType_Error $ "When compiling file " <> T.pack filePath <> T.pack (" compiler threw exception " ++ show e) + let diagSrc = T.pack "koka" + maxDiags = 100 + diags = M.fromList [(normUri, [makeDiagnostic J.DiagnosticSeverity_Error diagSrc rangeNull (text $ show e)])] + putDiagnostics diags + diags <- getDiagnostics + let diagsBySrc = M.map partitionBySource diags + flushDiagnosticsBySource maxDiags (Just diagSrc) + mapM_ (\(uri, diags) -> publishDiagnostics maxDiags uri Nothing diags) (M.toList diagsBySrc) return Nothing Right res -> do -- No exception - so check the result of the compilation @@ -198,7 +207,7 @@ processCompilationResult normUri filePath update doIO = do when update $ putLoaded l -- update the loaded state for this file sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ "Successfully compiled " <> T.pack filePath return outFile -- return the executable file path - Left (e, m) -> do + Left (e, m) -> do -- Compilation failed case m of Nothing -> From d20336b8d96d3683d15617f1fc8ad53afca47d75 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 15:45:10 -0700 Subject: [PATCH 25/37] rearrange dependencies --- koka.cabal | 33 +++------------------------------ package.yaml | 21 +++++++++++---------- 2 files changed, 14 insertions(+), 40 deletions(-) diff --git a/koka.cabal b/koka.cabal index 7eeec72ae..a121dd8c4 100644 --- a/koka.cabal +++ b/koka.cabal @@ -141,25 +141,16 @@ library build-tools: alex build-depends: - aeson - , array - , async + array , base >=4.9 , bytestring - , co-log-core , containers , directory , isocline >=1.0.6 - , lens - , lsp , mtl - , network - , network-simple , parsec , process - , stm , text - , text-rope , time default-language: Haskell2010 if os(windows) @@ -218,26 +209,17 @@ executable koka-nolsp app ghc-options: -rtsopts -j8 -O2 -threaded "-with-rtsopts=-N8" build-depends: - aeson - , array - , async + array , base >=4.9 , bytestring - , co-log-core , containers , directory , isocline >=1.0.6 , koka - , lens - , lsp , mtl - , network - , network-simple , parsec , process - , stm , text - , text-rope , time default-language: Haskell2010 @@ -250,12 +232,9 @@ test-suite koka-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - aeson - , array - , async + array , base >=4.9 , bytestring - , co-log-core , containers , directory , extra @@ -264,16 +243,10 @@ test-suite koka-test , hspec-core , isocline >=1.0.6 , json - , lens - , lsp , mtl - , network - , network-simple , parsec , process , regex-compat >=0.95.2.1 - , stm , text - , text-rope , time default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 198e140f5..0881012d9 100644 --- a/package.yaml +++ b/package.yaml @@ -19,24 +19,15 @@ description: Please see the README on GitHub at = 4.9 - - aeson - array - - async - bytestring - containers - - co-log-core - directory - - lens - - lsp - mtl - parsec - process - - stm - text - - text-rope - time - - network-simple - - network - isocline >= 1.0.6 library: @@ -70,7 +61,17 @@ executables: koka: main: Main.hs source-dirs: lang-server - dependencies: koka + dependencies: + - aeson + - async + - co-log-core + - koka + - lens + - lsp + - network-simple + - network + - text-rope + - stm ghc-options: - -rtsopts - -j8 From 8fc7229ad7b67ba40abe7410b065dacef1dd1871 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 17:05:06 -0700 Subject: [PATCH 26/37] add config option on debug --- support/vscode/koka.language-koka/package.json | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/support/vscode/koka.language-koka/package.json b/support/vscode/koka.language-koka/package.json index dc540ebc2..80e669f71 100644 --- a/support/vscode/koka.language-koka/package.json +++ b/support/vscode/koka.language-koka/package.json @@ -172,6 +172,11 @@ "description": "File to run the main function from", "default": "${workspaceFolder}/${command:AskForProgramName}" }, + "functionName": { + "type": "string", + "description": "Name of the function to run", + "default": "main" + }, "args": { "type": "string", "description": "Additional args to pass to the compiler (separate by -- to pass args to the program)" From 64021fd2e1f77b10ab21fd1ae38c2622b64c783d Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Fri, 15 Dec 2023 17:12:14 -0700 Subject: [PATCH 27/37] fix path --- support/vscode/koka.language-koka/src/workspace.ts | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/support/vscode/koka.language-koka/src/workspace.ts b/support/vscode/koka.language-koka/src/workspace.ts index 4e37380ad..2b6eceae8 100644 --- a/support/vscode/koka.language-koka/src/workspace.ts +++ b/support/vscode/koka.language-koka/src/workspace.ts @@ -57,7 +57,7 @@ export function scanForSDK(config: vscode.WorkspaceConfiguration): SDKs | undefi console.log('Koka: No Koka SDK found') vs.window.showWarningMessage("Koka SDK not found on path or in ~/.local/bin") downloadSDK() - } + } return { sdkPath: defaultSDK, allSDKs: allSDKs } } @@ -68,14 +68,14 @@ export async function downloadSDK() { 'Yes', 'No' ) - if (decision == 'No'){ + if (decision == 'No') { return } let command = "curl -sSL https://github.com/koka-lang/koka/releases/latest/download/install.sh | sh" if (os.platform() === "win32") { command = "curl -sSL -o %tmp%\install-koka.bat https://github.com/koka-lang/koka/releases/latest/download/install.bat && %tmp%\install-koka.bat" } - const term = vscode.window.createTerminal({name: "Install Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Installing Koka, restart your editor when finished"}) + const term = vscode.window.createTerminal({ name: "Install Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Installing Koka, restart your editor when finished" }) term.sendText(command) term.show() } @@ -87,19 +87,19 @@ export async function uninstallSDK() { 'Yes', 'No' ) - if (decision == 'No'){ + if (decision == 'No') { return } let command = "curl -sSL https://github.com/koka-lang/koka/releases/latest/download/install.sh | sh -s -- -u -f" if (os.platform() === "win32") { command = "curl -sSL -o %tmp%\install-koka.bat https://github.com/koka-lang/koka/releases/latest/download/install.bat && %tmp%\install-koka.bat -u -f" } - const term = vscode.window.createTerminal({name: "Uninstall Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Uninstalling Koka, you can close the terminal when done"}) + const term = vscode.window.createTerminal({ name: "Uninstall Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Uninstalling Koka, you can close the terminal when done" }) term.sendText(command) term.show() } -const DefaultShellPath = os.platform() === "win32" ? "C:\Windows\System32\cmd.exe" : null +const DefaultShellPath = os.platform() === "win32" ? "C:\\Windows\\System32\\cmd.exe" : null export class KokaConfig { constructor(config: vscode.WorkspaceConfiguration, sdkPath: string, allSDKs: string[]) { From 436ded8b398412f9240521066a1e14be2aff2630 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 16 Dec 2023 10:56:14 -0700 Subject: [PATCH 28/37] fix exit result --- app/Main.hs | 27 ++++++++++++++++++++------- lang-server/Main.hs | 27 ++++++++++++++++++++------- 2 files changed, 40 insertions(+), 14 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 2e1cf927b..212cd0468 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -12,7 +12,7 @@ module Main where import System.Exit ( exitFailure ) -import Control.Monad ( when ) +import Control.Monad ( when, foldM ) import Platform.Config import Lib.PPrint ( Pretty(pretty), writePrettyLn ) @@ -31,7 +31,8 @@ import Kind.Synonym ( synonymsIsEmpty, ppSynonyms, synonymsFilter ) import Kind.Assumption ( kgammaFilter ) import Type.Assumption ( ppGamma, ppGammaHidden, gammaFilter, createNameInfoX, gammaNew ) import Type.Pretty ( ppScheme, Env(context,importsMap) ) - +import System.IO (hPutStrLn, stderr) +import Data.List (intercalate) -- compiled entry main = mainArgs "" @@ -75,7 +76,17 @@ mainMode flags flags0 mode p ModeVersion -> withNoColorPrinter (showVersion flags) ModeCompiler files - -> mapM_ (compile p flags) files + -> do + errFiles <- foldM (\errfiles file -> + do + res <- compile p flags file + if res then return errfiles + else return (file:errfiles) + ) [] files + if null errFiles then return () + else do + hPutStrLn stderr ("Failed to compile " ++ intercalate "," files) + exitFailure ModeInteractive files -> interpret p flags flags0 files ModeLanguageServer files @@ -84,7 +95,7 @@ mainMode flags flags0 mode p exitFailure -compile :: ColorPrinter -> Flags -> FilePath -> IO () +compile :: ColorPrinter -> Flags -> FilePath -> IO Bool compile p flags fname = do let exec = Executable (newName "main") () err <- compileFile (const Nothing) Nothing term flags [] [] @@ -93,7 +104,7 @@ compile p flags fname Left msg -> do putPrettyLn p (ppErrorMessage (showSpan flags) cscheme msg) -- exitFailure -- don't fail for tests - + return False Right ((Loaded gamma kgamma synonyms newtypes constructors _ imports _ (Module modName _ _ _ _ _ rawProgram core _ _ _ _ modTime _ _) _ _ _ , _), warnings) @@ -109,9 +120,11 @@ compile p flags fname if showHiddenTypeSigs flags then do -- workaround since private defs aren't in gamma putPrettyLn p $ ppGammaHidden (prettyEnv flags modName imports) $ gammaFilter modName $ gammaFromDefGroups $ coreProgDefs core - else if showTypeSigs flags then + return True + else if showTypeSigs flags then do putPrettyLn p $ ppGamma (prettyEnv flags modName imports) $ gammaFilter modName gamma - else pure () + return True + else return True where term = Terminal (putErrorMessage p (showSpan flags) cscheme) diff --git a/lang-server/Main.hs b/lang-server/Main.hs index 3e638dbb0..833855f58 100644 --- a/lang-server/Main.hs +++ b/lang-server/Main.hs @@ -12,7 +12,7 @@ module Main where import System.Exit ( exitFailure ) -import Control.Monad ( when ) +import Control.Monad ( when, foldM ) import Platform.Config import Lib.PPrint ( Pretty(pretty), writePrettyLn ) @@ -32,7 +32,8 @@ import Kind.Assumption ( kgammaFilter ) import LanguageServer.Run ( runLanguageServer ) import Type.Assumption ( ppGamma, ppGammaHidden, gammaFilter, createNameInfoX, gammaNew ) import Type.Pretty ( ppScheme, Env(context,importsMap) ) - +import System.IO (hPutStrLn, stderr) +import Data.List (intercalate) -- compiled entry main = mainArgs "" @@ -76,14 +77,24 @@ mainMode flags flags0 mode p ModeVersion -> withNoColorPrinter (showVersion flags) ModeCompiler files - -> mapM_ (compile p flags) files + -> do + errFiles <- foldM (\errfiles file -> + do + res <- compile p flags file + if res then return errfiles + else return (file:errfiles) + ) [] files + if null errFiles then return () + else do + hPutStrLn stderr ("Failed to compile " ++ intercalate "," files) + exitFailure ModeInteractive files -> interpret p flags flags0 files ModeLanguageServer files -> runLanguageServer flags files -compile :: ColorPrinter -> Flags -> FilePath -> IO () +compile :: ColorPrinter -> Flags -> FilePath -> IO Bool compile p flags fname = do let exec = Executable (newName "main") () err <- compileFile (const Nothing) Nothing term flags [] [] @@ -92,7 +103,7 @@ compile p flags fname Left msg -> do putPrettyLn p (ppErrorMessage (showSpan flags) cscheme msg) -- exitFailure -- don't fail for tests - + return False Right ((Loaded gamma kgamma synonyms newtypes constructors _ imports _ (Module modName _ _ _ _ _ rawProgram core _ _ _ _ modTime _ _) _ _ _ , _), warnings) @@ -108,9 +119,11 @@ compile p flags fname if showHiddenTypeSigs flags then do -- workaround since private defs aren't in gamma putPrettyLn p $ ppGammaHidden (prettyEnv flags modName imports) $ gammaFilter modName $ gammaFromDefGroups $ coreProgDefs core - else if showTypeSigs flags then + return True + else if showTypeSigs flags then do putPrettyLn p $ ppGamma (prettyEnv flags modName imports) $ gammaFilter modName gamma - else pure () + return True + else return True where term = Terminal (putErrorMessage p (showSpan flags) cscheme) From 4d506af30b43babd1812c8a825583155ec6f3bd6 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 16 Dec 2023 11:49:20 -0700 Subject: [PATCH 29/37] fix program arguments, recompiling on flags changed, and adding release build --- .../LanguageServer/Handler/Commands.hs | 6 ++- .../LanguageServer/Handler/TextDocument.hs | 8 ++-- src/Common/ColorScheme.hs | 2 +- src/Common/Syntax.hs | 2 +- src/Compiler/Options.hs | 6 ++- src/Compiler/Package.hs | 4 +- .../vscode/koka.language-koka/package.json | 12 ++++- .../koka.language-koka/src/code-lens.ts | 47 +++++++++++++------ .../vscode/koka.language-koka/src/debugger.ts | 14 +++--- .../koka.language-koka/src/extension.ts | 10 ++-- 10 files changed, 75 insertions(+), 36 deletions(-) diff --git a/lang-server/LanguageServer/Handler/Commands.hs b/lang-server/LanguageServer/Handler/Commands.hs index 753044f54..c0c45ed15 100644 --- a/lang-server/LanguageServer/Handler/Commands.hs +++ b/lang-server/LanguageServer/Handler/Commands.hs @@ -38,9 +38,10 @@ commandHandler = requestHandler J.SMethod_WorkspaceExecuteCommand $ \req resp -> Just [Json.String filePath, Json.String additionalArgs] -> do -- Update the flags with the specified arguments newFlags <- getNewFlags flags additionalArgs + let forceRecompilation = flags /= newFlags -- Recompile the file, but with executable target withIndefiniteProgress (T.pack "Compiling " <> filePath) J.NotCancellable $ do - res <- recompileFile (Executable (newName "main") ()) (J.filePathToUri $ T.unpack filePath) Nothing False newFlags + res <- recompileFile (Executable (newName "main") ()) (J.filePathToUri $ T.unpack filePath) Nothing forceRecompilation newFlags sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack ("Finished generating code for main file " ++ T.unpack filePath ++ " " ++ fromMaybe "No Compiled File" res) -- Send the executable file location back to the client in case it wants to run it resp $ Right $ case res of {Just filePath -> J.InL $ Json.String $ T.pack filePath; Nothing -> J.InR J.Null} @@ -54,10 +55,11 @@ commandHandler = requestHandler J.SMethod_WorkspaceExecuteCommand $ \req resp -> Just [Json.String filePath, Json.String functionName, Json.String additionalArgs] -> do -- Update the flags with the specified arguments newFlags <- getNewFlags flags additionalArgs + let forceRecompilation = flags /= newFlags -- Compile the expression, but with the interpret target withIndefiniteProgress (T.pack "Interpreting " <> functionName) J.NotCancellable $ do -- compile the expression - res <- compileEditorExpression (J.filePathToUri $ T.unpack filePath) newFlags (T.unpack filePath) (T.unpack functionName) + res <- compileEditorExpression (J.filePathToUri $ T.unpack filePath) newFlags forceRecompilation (T.unpack filePath) (T.unpack functionName) sendNotification J.SMethod_WindowLogMessage $ J.LogMessageParams J.MessageType_Info $ T.pack ("Finished generating code for interpreting function " ++ T.unpack functionName ++ " in file " ++ T.unpack filePath ++ " Result: " ++ fromMaybe "No Compiled File" res) -- Send the executable file location back to the client in case it wants to run it resp $ Right $ case res of {Just filePath -> J.InL $ Json.String $ T.pack filePath; Nothing -> J.InR J.Null} diff --git a/lang-server/LanguageServer/Handler/TextDocument.hs b/lang-server/LanguageServer/Handler/TextDocument.hs index 42fce61a0..85502a4dd 100644 --- a/lang-server/LanguageServer/Handler/TextDocument.hs +++ b/lang-server/LanguageServer/Handler/TextDocument.hs @@ -40,7 +40,7 @@ import qualified Control.Exception as Exc import Compiler.Options (Flags) import Common.File (getFileTime, FileTime, getFileTimeOrCurrent, getCurrentTime, normalize, realPath) import GHC.IO (unsafePerformIO) -import Compiler.Module (Module(..)) +import Compiler.Module (Module(..), initialLoaded) import Control.Monad (when, foldM) import Data.Time (addUTCTime, addLocalTime) import qualified Data.ByteString as J @@ -136,8 +136,8 @@ updateVFS = do return newvfs -- Compiles a single expression (calling a top level function with no arguments) - such as a test method -compileEditorExpression :: J.Uri -> Flags -> String -> String -> LSM (Maybe FilePath) -compileEditorExpression uri flags filePath functionName = do +compileEditorExpression :: J.Uri -> Flags -> Bool -> String -> String -> LSM (Maybe FilePath) +compileEditorExpression uri flags force filePath functionName = do loaded <- getLoaded uri case loaded of Just loaded -> do @@ -149,7 +149,7 @@ compileEditorExpression uri flags filePath functionName = do program = programAddImports (programNull nameInteractiveModule) imports term <- getTerminal -- reusing interpreter compilation entry point - let resultIO = compileExpression (maybeContents vfs) term flags loaded (Executable nameExpr ()) program 0 (functionName ++ "()") + let resultIO = compileExpression (maybeContents vfs) term flags (if force then initialLoaded else loaded) (Executable nameExpr ()) program 0 (functionName ++ "()") processCompilationResult normUri filePath False resultIO Nothing -> do return Nothing diff --git a/src/Common/ColorScheme.hs b/src/Common/ColorScheme.hs index 840a55efe..22fa00fc2 100644 --- a/src/Common/ColorScheme.hs +++ b/src/Common/ColorScheme.hs @@ -57,7 +57,7 @@ data ColorScheme = ColorScheme , colorTypeSpecial :: Color , colorTypeParam :: Color , colorNameQual :: Color - } deriving (Show) + } deriving (Show, Eq) -- | The default color scheme defaultColorScheme, darkColorScheme, lightColorScheme :: ColorScheme diff --git a/src/Common/Syntax.hs b/src/Common/Syntax.hs index 172107cfb..1189233ef 100644 --- a/src/Common/Syntax.hs +++ b/src/Common/Syntax.hs @@ -75,7 +75,7 @@ data Platform = Platform{ sizePtr :: Int -- sizeof(intptr_t) , sizeSize :: Int -- sizeof(size_t) , sizeField :: Int -- sizeof(kk_field_t), usually intptr_t but may be smaller for compression , sizeHeader:: Int -- used for correct alignment calculation - } + } deriving Eq platform32, platform64, platform64c, platformJS, platformCS :: Platform platform32 = Platform 4 4 4 8 diff --git a/src/Compiler/Options.hs b/src/Compiler/Options.hs index 36199f0be..cdfab08af 100644 --- a/src/Compiler/Options.hs +++ b/src/Compiler/Options.hs @@ -192,7 +192,7 @@ data Flags , useStdAlloc :: Bool -- don't use mimalloc for better asan and valgrind support , optSpecialize :: Bool , mimallocStats :: Bool - } + } deriving Eq flagsNull :: Flags flagsNull @@ -942,6 +942,10 @@ data CC = CC{ ccName :: String, ccObjFile :: String -> FilePath -- make object file namen } +instance Eq CC where + CC{ccName = name1, ccPath = path1, ccFlags = flags1, ccFlagsBuild = flagsB1, ccFlagsCompile= flagsC1, ccFlagsLink=flagsL1} == + CC{ccName = name2, ccPath = path2, ccFlags = flags2, ccFlagsBuild = flagsB2, ccFlagsCompile= flagsC2, ccFlagsLink=flagsL2} + = name1 == name2 && path1 == path2 && flags1 == flags2 && flagsB1 == flagsB2 && flagsC1 == flagsC2 && flagsL1 == flagsL2 targetExeExtension target = case target of diff --git a/src/Compiler/Package.hs b/src/Compiler/Package.hs index f855f788e..e6858cfef 100644 --- a/src/Compiler/Package.hs +++ b/src/Compiler/Package.hs @@ -38,12 +38,12 @@ import Lib.JSON type PackageName = String data Packages = Packages { packages :: [Package], - roots :: [FilePath] } + roots :: [FilePath] } deriving Eq data Package = Package { pkgDir :: FilePath, -- /x/node_modules/A/lib pkgQualName :: PackageName, -- A/B/C pkgLocal :: FilePath, -- lib - pkgSub :: [Package] } + pkgSub :: [Package] } deriving Eq packagesEmpty :: Packages packagesEmpty = Packages [] [] diff --git a/support/vscode/koka.language-koka/package.json b/support/vscode/koka.language-koka/package.json index 80e669f71..cf55abef3 100644 --- a/support/vscode/koka.language-koka/package.json +++ b/support/vscode/koka.language-koka/package.json @@ -177,9 +177,17 @@ "description": "Name of the function to run", "default": "main" }, - "args": { + "compilerArgs": { "type": "string", - "description": "Additional args to pass to the compiler (separate by -- to pass args to the program)" + "description": "Additional args to pass to the compiler\n Args that are intended to be forwarded to the program should be specified in programArgs\n (e.g. --showtime should be in programArgs as --kktime)" + }, + "programArgs": { + "type": "array", + "items": { + "type": "string" + }, + "default": null, + "description": "Additional args to pass to the program" } } } diff --git a/support/vscode/koka.language-koka/src/code-lens.ts b/support/vscode/koka.language-koka/src/code-lens.ts index c9141ab81..7526421d6 100644 --- a/support/vscode/koka.language-koka/src/code-lens.ts +++ b/support/vscode/koka.language-koka/src/code-lens.ts @@ -17,50 +17,69 @@ export class MainCodeLensProvider implements vscode.CodeLensProvider { let has_main = false; console.log("Koka: Scanning document for main and test function"); while (match = re_main.exec(doc)) { - if (has_main){ + if (has_main) { console.log("Koka: Found multiple main functions. This is not supported in the compiler.") return []; } has_main = true; - lenses.push(this.createMainCodeLens(document, match.index, match[0].length)) + lenses.push(...this.createMainCodeLens(document, match.index, match[0].length)) } while (match = re_test.exec(doc)) { - if (has_main){ + if (has_main) { console.log("Koka: Found both a main and a test function. Only the main function will be runnable via code lens.") break; } - lenses.push(this.createTestCodeLens(document, match.index, match[4], match[0].length)) + lenses.push(...this.createTestCodeLens(document, match.index, match[4], match[0].length)) } while (match = re_example.exec(doc)) { - if (has_main){ + if (has_main) { console.log("Koka: Found both a main and an example function. Only the main function will be runnable via code lens.") break; } - lenses.push(this.createTestCodeLens(document, match.index, match[4], match[0].length)) + lenses.push(...this.createTestCodeLens(document, match.index, match[4], match[0].length)) } return lenses } - private createMainCodeLens(document: vscode.TextDocument, offset: number, len: number): vscode.CodeLens { - return new vscode.CodeLens( + private createMainCodeLens(document: vscode.TextDocument, offset: number, len: number): vscode.CodeLens[] { + return [new vscode.CodeLens( toRange(document, offset, len), { arguments: [document.uri], command: "koka.startWithoutDebugging", - title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)}`, - } - ) + title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)} (debug)`, + }, + ), new vscode.CodeLens( + toRange(document, offset, len), + { + arguments: [document.uri, "-O2", ["--kktime"]], + command: "koka.startWithoutDebugging", + title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)} (release)`, + tooltip: "Run with compilation flag -O2\nGive argument --kktime to the executable" + }, + ), + ] } - private createTestCodeLens(document: vscode.TextDocument, offset: number, functionName: string, len: number): vscode.CodeLens { - return new vscode.CodeLens( + private createTestCodeLens(document: vscode.TextDocument, offset: number, functionName: string, len: number): vscode.CodeLens[] { + return [new vscode.CodeLens( toRange(document, offset, len), { arguments: [document.uri, functionName], command: "koka.interpretExpression", - title: `Run ${functionName}`, + title: `Run ${functionName} (debug)`, + } + ), + new vscode.CodeLens( + toRange(document, offset, len), + { + arguments: [document.uri, functionName, "-O2", ["--kktime"]], + command: "koka.interpretExpression", + title: `Run ${functionName} (release)`, + tooltip: "Run with compilation flag -O2\nGive argument --kktime to the executable" } ) + ] } } diff --git a/support/vscode/koka.language-koka/src/debugger.ts b/support/vscode/koka.language-koka/src/debugger.ts index f2ff5fcbd..690be2aa3 100644 --- a/support/vscode/koka.language-koka/src/debugger.ts +++ b/support/vscode/koka.language-koka/src/debugger.ts @@ -28,7 +28,9 @@ interface LaunchRequestArguments extends DebugProtocol.LaunchRequestArguments { /** An absolute path to the "program" to debug. */ program: string /** Additional arguments */ - args?: string + compilerArgs?: string + /** Additional arguments */ + programArgs?: string[] /** enable logging the Debug Adapter Protocol */ trace?: boolean /** A single function to run (must have no effects and return a type that is showable)*/ @@ -191,11 +193,11 @@ class KokaRuntime extends EventEmitter { } // Args that are parsed by the compiler are in the args field. This leaves the rest of the object open for let additionalArgs = "--target=" + compilerTarget - if (args.args) { - additionalArgs = additionalArgs + " " + args.args + if (args.compilerArgs) { + additionalArgs = additionalArgs + " " + args.compilerArgs } try { - let resp = null + let resp = null if (args.functionName) { resp = await this.client.sendRequest(ExecuteCommandRequest.type, { command: 'koka/interpretExpression', arguments: [args.program, args.functionName, additionalArgs] }) } else { @@ -213,8 +215,8 @@ class KokaRuntime extends EventEmitter { return; } if (target == 'C') { - // console.log(`Executing ${this.config.command} -e ${file} -i${this.config.cwd}`) - this.ps = child_process.spawn(resp, [], { cwd: this.config.cwd, env: process.env }) + console.log(`Executing ${resp} ${args.programArgs ?? []}`) + this.ps = child_process.spawn(resp, args.programArgs ?? [], { cwd: this.config.cwd, env: process.env }) this.ps.stdout?.on('data', (data) => { this.emit('output', data.toString().trim(), 'stdout') }) diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts index e7bc0617d..1de30085a 100644 --- a/support/vscode/koka.language-koka/src/extension.ts +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -146,26 +146,30 @@ function createCommands( }) }), // Start a program given just a path - vscode.commands.registerCommand('koka.startWithoutDebugging', (resource: vscode.Uri) => { + vscode.commands.registerCommand('koka.startWithoutDebugging', (resource: vscode.Uri, compilerArgs?: string, programArgs?: string[]) => { const launchConfig = { name: `koka run: ${resource.path}`, request: "launch", type: "koka", program: resource.fsPath, + compilerArgs, + programArgs } console.log(`Launch config ${launchConfig}`) vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) }), // Start a program given a path and a function name - vscode.commands.registerCommand('koka.interpretExpression', (resource: vscode.Uri, functionName: string) => { + vscode.commands.registerCommand('koka.interpretExpression', (resource: vscode.Uri, functionName: string, compilerArgs?: string, programArgs?: string[]) => { const launchConfig = { name: `koka run: ${resource.path}`, request: "launch", type: "koka", program: resource.fsPath, - functionName: functionName + functionName, + compilerArgs, + programArgs } console.log(`Launch config ${launchConfig}`) vscode.debug.startDebugging(vscode.workspace.getWorkspaceFolder(resource), launchConfig as vscode.DebugConfiguration) From 2f742c332a42d8c7546b8c932e95a546d116f0d3 Mon Sep 17 00:00:00 2001 From: Daan Leijen Date: Sat, 16 Dec 2023 12:34:44 -0800 Subject: [PATCH 30/37] move app and lang-server under src/Main --- koka.cabal | 6 +++--- package.yaml | 10 +++++----- samples/basic/fibonacci.kk | 8 +++++--- .../Main/langserver}/LanguageServer/Conversions.hs | 0 .../langserver}/LanguageServer/Handler/Commands.hs | 0 .../langserver}/LanguageServer/Handler/Completion.hs | 0 .../langserver}/LanguageServer/Handler/Definition.hs | 0 .../LanguageServer/Handler/DocumentSymbol.hs | 0 .../Main/langserver}/LanguageServer/Handler/Folding.hs | 0 .../Main/langserver}/LanguageServer/Handler/Hover.hs | 0 .../langserver}/LanguageServer/Handler/InlayHints.hs | 0 .../langserver}/LanguageServer/Handler/TextDocument.hs | 0 .../Main/langserver}/LanguageServer/Handlers.hs | 0 .../Main/langserver}/LanguageServer/Monad.hs | 0 .../Main/langserver}/LanguageServer/Run.hs | 0 {lang-server => src/Main/langserver}/Main.hs | 0 {app => src/Main/plain}/Main.hs | 6 +++--- 17 files changed, 16 insertions(+), 14 deletions(-) rename {lang-server => src/Main/langserver}/LanguageServer/Conversions.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/Commands.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/Completion.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/Definition.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/DocumentSymbol.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/Folding.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/Hover.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/InlayHints.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handler/TextDocument.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Handlers.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Monad.hs (100%) rename {lang-server => src/Main/langserver}/LanguageServer/Run.hs (100%) rename {lang-server => src/Main/langserver}/Main.hs (100%) rename {app => src/Main/plain}/Main.hs (98%) diff --git a/koka.cabal b/koka.cabal index a121dd8c4..340b12a77 100644 --- a/koka.cabal +++ b/koka.cabal @@ -175,7 +175,7 @@ executable koka LanguageServer.Run Paths_koka hs-source-dirs: - lang-server + src/Main/langserver ghc-options: -rtsopts -j8 -O2 -threaded "-with-rtsopts=-N8" build-depends: aeson @@ -201,12 +201,12 @@ executable koka , time default-language: Haskell2010 -executable koka-nolsp +executable koka-plain main-is: Main.hs other-modules: Paths_koka hs-source-dirs: - app + src/Main/plain ghc-options: -rtsopts -j8 -O2 -threaded "-with-rtsopts=-N8" build-depends: array diff --git a/package.yaml b/package.yaml index 0881012d9..e61a05039 100644 --- a/package.yaml +++ b/package.yaml @@ -47,7 +47,7 @@ library: - -j8 - -O2 cpp-options: - - -DKOKA_MAIN="koka" + - -DKOKA_MAIN="koka" - -DKOKA_VARIANT="release" - -DKOKA_VERSION="2.4.3" - -DREADLINE=0 # 1:getline, 2:readline, 3:haskeline, or 0:isocline @@ -60,8 +60,8 @@ library: executables: koka: main: Main.hs - source-dirs: lang-server - dependencies: + source-dirs: src/Main/langserver + dependencies: - aeson - async - co-log-core @@ -79,9 +79,9 @@ executables: - -threaded - '"-with-rtsopts=-N8"' - koka-nolsp: + koka-plain: main: Main.hs - source-dirs: app + source-dirs: src/Main/plain dependencies: koka ghc-options: - -rtsopts diff --git a/samples/basic/fibonacci.kk b/samples/basic/fibonacci.kk index 6f8d20ce7..fa4c02f69 100644 --- a/samples/basic/fibonacci.kk +++ b/samples/basic/fibonacci.kk @@ -1,14 +1,16 @@ module fibonacci -pub fun main() +pub fun main() val n = 10000 println("The " ++ n.show ++ "th fibonacci number is " ++ fibonacci(10000).show) -fun fibonacci(n : int) : div int +fun fibonacci(n : int) : div int fib(n, 0, 1) -fun fib(n : int, x1 : int, x2 : int) : div int +fun fib(n : int, x1 : int, x2 : int) : div int if n<=0 then x1 else fib(n - 1, x2, x1+x2) +fun testx() + fibonacci(100).println diff --git a/lang-server/LanguageServer/Conversions.hs b/src/Main/langserver/LanguageServer/Conversions.hs similarity index 100% rename from lang-server/LanguageServer/Conversions.hs rename to src/Main/langserver/LanguageServer/Conversions.hs diff --git a/lang-server/LanguageServer/Handler/Commands.hs b/src/Main/langserver/LanguageServer/Handler/Commands.hs similarity index 100% rename from lang-server/LanguageServer/Handler/Commands.hs rename to src/Main/langserver/LanguageServer/Handler/Commands.hs diff --git a/lang-server/LanguageServer/Handler/Completion.hs b/src/Main/langserver/LanguageServer/Handler/Completion.hs similarity index 100% rename from lang-server/LanguageServer/Handler/Completion.hs rename to src/Main/langserver/LanguageServer/Handler/Completion.hs diff --git a/lang-server/LanguageServer/Handler/Definition.hs b/src/Main/langserver/LanguageServer/Handler/Definition.hs similarity index 100% rename from lang-server/LanguageServer/Handler/Definition.hs rename to src/Main/langserver/LanguageServer/Handler/Definition.hs diff --git a/lang-server/LanguageServer/Handler/DocumentSymbol.hs b/src/Main/langserver/LanguageServer/Handler/DocumentSymbol.hs similarity index 100% rename from lang-server/LanguageServer/Handler/DocumentSymbol.hs rename to src/Main/langserver/LanguageServer/Handler/DocumentSymbol.hs diff --git a/lang-server/LanguageServer/Handler/Folding.hs b/src/Main/langserver/LanguageServer/Handler/Folding.hs similarity index 100% rename from lang-server/LanguageServer/Handler/Folding.hs rename to src/Main/langserver/LanguageServer/Handler/Folding.hs diff --git a/lang-server/LanguageServer/Handler/Hover.hs b/src/Main/langserver/LanguageServer/Handler/Hover.hs similarity index 100% rename from lang-server/LanguageServer/Handler/Hover.hs rename to src/Main/langserver/LanguageServer/Handler/Hover.hs diff --git a/lang-server/LanguageServer/Handler/InlayHints.hs b/src/Main/langserver/LanguageServer/Handler/InlayHints.hs similarity index 100% rename from lang-server/LanguageServer/Handler/InlayHints.hs rename to src/Main/langserver/LanguageServer/Handler/InlayHints.hs diff --git a/lang-server/LanguageServer/Handler/TextDocument.hs b/src/Main/langserver/LanguageServer/Handler/TextDocument.hs similarity index 100% rename from lang-server/LanguageServer/Handler/TextDocument.hs rename to src/Main/langserver/LanguageServer/Handler/TextDocument.hs diff --git a/lang-server/LanguageServer/Handlers.hs b/src/Main/langserver/LanguageServer/Handlers.hs similarity index 100% rename from lang-server/LanguageServer/Handlers.hs rename to src/Main/langserver/LanguageServer/Handlers.hs diff --git a/lang-server/LanguageServer/Monad.hs b/src/Main/langserver/LanguageServer/Monad.hs similarity index 100% rename from lang-server/LanguageServer/Monad.hs rename to src/Main/langserver/LanguageServer/Monad.hs diff --git a/lang-server/LanguageServer/Run.hs b/src/Main/langserver/LanguageServer/Run.hs similarity index 100% rename from lang-server/LanguageServer/Run.hs rename to src/Main/langserver/LanguageServer/Run.hs diff --git a/lang-server/Main.hs b/src/Main/langserver/Main.hs similarity index 100% rename from lang-server/Main.hs rename to src/Main/langserver/Main.hs diff --git a/app/Main.hs b/src/Main/plain/Main.hs similarity index 98% rename from app/Main.hs rename to src/Main/plain/Main.hs index 212cd0468..4f0f4488b 100644 --- a/app/Main.hs +++ b/src/Main/plain/Main.hs @@ -76,8 +76,8 @@ mainMode flags flags0 mode p ModeVersion -> withNoColorPrinter (showVersion flags) ModeCompiler files - -> do - errFiles <- foldM (\errfiles file -> + -> do + errFiles <- foldM (\errfiles file -> do res <- compile p flags file if res then return errfiles @@ -90,7 +90,7 @@ mainMode flags flags0 mode p ModeInteractive files -> interpret p flags flags0 files ModeLanguageServer files - -> do + -> do putStr "Language server mode not supported in this build.\n" exitFailure From dbd91462fae36495ca8c87ce5d9357071c651009 Mon Sep 17 00:00:00 2001 From: Daan Leijen Date: Sat, 16 Dec 2023 13:17:52 -0800 Subject: [PATCH 31/37] add readmes --- src/Main/README.md | 9 +++++++++ support/vscode/README.md | 20 ++++++++++++++++++++ 2 files changed, 29 insertions(+) create mode 100644 src/Main/README.md create mode 100644 support/vscode/README.md diff --git a/src/Main/README.md b/src/Main/README.md new file mode 100644 index 000000000..417464f68 --- /dev/null +++ b/src/Main/README.md @@ -0,0 +1,9 @@ +There are the main front-ends for the Koka compiler: + +- `langserver`: the regular Koka compiler with VS code language server support. + See also `support/vscode` for the VS code extension. + +- `plain`: Koka compiler + interpreter without language server support; this is mainly + to support platforms where the Haskell language server library does not build. + + diff --git a/support/vscode/README.md b/support/vscode/README.md new file mode 100644 index 000000000..2c58fd422 --- /dev/null +++ b/support/vscode/README.md @@ -0,0 +1,20 @@ +This contains the sources for building the VS code extension (VSIX). + +To build the extension first install nodejs/npm: + +> cd support/vscode/koka.language-koka +> npm run build +> npm run package + +and install the resulting `.vsix` extension either by right-clicking in VS code and select `install extension`, +or run: + +> code --install-extension language-koka-.vsix + +In the extension you may need to go to the settings and set the path +to the Koka executable. If you like to use the build version use: + +> stack path --local-install-root + +to get the local install root directory where `/bin/koka` is +the path to local executable. From a80bc58cf4a11f033ffe9a2c494542f3db767761 Mon Sep 17 00:00:00 2001 From: Daan Leijen Date: Sat, 16 Dec 2023 14:10:40 -0800 Subject: [PATCH 32/37] rename some koka language server setting; update readme, update centering of koka image --- samples/basic/fibonacci.kk | 2 +- support/vscode/koka.language-koka/README.md | 33 +++++++++++++++---- .../images/koka-logo-filled-dark.svg | 2 +- .../images/koka-logo-filled-light.svg | 2 +- .../images/koka-logo-filled.svg | 2 +- .../vscode/koka.language-koka/package.json | 26 +++++++-------- .../koka.language-koka/src/workspace.ts | 10 +++--- 7 files changed, 48 insertions(+), 29 deletions(-) diff --git a/samples/basic/fibonacci.kk b/samples/basic/fibonacci.kk index fa4c02f69..d164ab977 100644 --- a/samples/basic/fibonacci.kk +++ b/samples/basic/fibonacci.kk @@ -12,5 +12,5 @@ fun fibonacci(n : int) : div int fun fib(n : int, x1 : int, x2 : int) : div int if n<=0 then x1 else fib(n - 1, x2, x1+x2) -fun testx() +pub fun testx() fibonacci(100).println diff --git a/support/vscode/koka.language-koka/README.md b/support/vscode/koka.language-koka/README.md index ba1a1323e..580743f7a 100644 --- a/support/vscode/koka.language-koka/README.md +++ b/support/vscode/koka.language-koka/README.md @@ -1,11 +1,30 @@ -# Koka Syntax Highlighting +# Koka Syntax Highlighting and Language Server -Syntax highlighting support for the +Syntax highlighting and language server support for the Koka programming language in Visual Studio Code. Visit for more information. -## Token Classes +## Language Server + +The language server continously analyses the code to show +parse- and type errors, complete identifiers, +show type information on hover, and +can execute `main`, `test-xxx`, and `example-xxx` functions +directly in the debug console. + +### Customize + +The extension shows "inlay hints" for inferred types of parameters +and local declarations. You can toggle inlay hints on- and +off in the editor inlay hints settings. +In the extension settings, you can also set the Koka compiler +path and specific compiler flags manually. + + +## Syntax Highlighting + +### Token Classes * `koka.conid`: constructors. * `koka.op`: operators. @@ -24,12 +43,12 @@ Visit for more information. * `koka.comment`(`.line`|`.block`): comments. * `koka.comment.doc`(`.emph`|`.pre`|`.pre.type`|`.pre.block`): documentation inside a comment. -## Customize +### Customize You can customize the Koka syntax highlighting by editing -the `settings.json` file of VS Code (press `Ctrl/Cmd+Shift+P` and +the `settings.json` file of VS Code (press `Ctrl/Cmd+Shift+P` and select "Open Settings (JSON)" to open it). -Then add a [editor.tokenColorCustomizations](https://code.visualstudio.com/docs/getstarted/themes#_editor-syntax-highlighting) +Then add a [editor.tokenColorCustomizations](https://code.visualstudio.com/docs/getstarted/themes#_editor-syntax-highlighting) entry, for example: ```json "editor.tokenColorCustomizations": { @@ -45,7 +64,7 @@ entry, for example: }, { "scope": "koka.id.decl.function", "settings": { "foreground": "#cac199" } - }, + }, ] } ``` diff --git a/support/vscode/koka.language-koka/images/koka-logo-filled-dark.svg b/support/vscode/koka.language-koka/images/koka-logo-filled-dark.svg index 1e529e0ab..087ee37cc 100644 --- a/support/vscode/koka.language-koka/images/koka-logo-filled-dark.svg +++ b/support/vscode/koka.language-koka/images/koka-logo-filled-dark.svg @@ -4,7 +4,7 @@ Date: Sat, 16 Dec 2023 15:19:35 -0700 Subject: [PATCH 33/37] update extension --- package.yaml | 1 + src/Compiler/Compile.hs | 6 +- src/Compiler/Module.hs | 5 +- src/Main/langserver/LanguageServer/Monad.hs | 4 +- support/vscode/koka.language-koka/README.md | 33 ++++++- .../vscode/koka.language-koka/package.json | 2 + .../koka.language-koka/src/extension.ts | 51 +++++++---- .../koka.language-koka/src/workspace.ts | 91 +++++++++++++++++-- 8 files changed, 156 insertions(+), 37 deletions(-) diff --git a/package.yaml b/package.yaml index e61a05039..43cfaa3e6 100644 --- a/package.yaml +++ b/package.yaml @@ -4,6 +4,7 @@ # - util/install.bat # - util/Dockerfile # - util/minbuild +# - support/vscode/koka.language-koka/src/workspace.ts name: koka version: 2.4.3 diff --git a/src/Compiler/Compile.hs b/src/Compiler/Compile.hs index 12d1b18e8..98a966970 100644 --- a/src/Compiler/Compile.hs +++ b/src/Compiler/Compile.hs @@ -606,7 +606,7 @@ resolveImportModules compileTarget maybeContents mname term flags currentDir res do -- trace ("\t" ++ show mname ++ ": resolving imported modules: " ++ show (impName imp) ++ ", resolved: " ++ show (map (show . modName) resolved0) ++ ", path:" ++ show importPath) $ return () (mod,resolved1) <- case filter (\m -> impName imp == modName m) resolved0 of (mod:_) -> - if modInMemory mod && not (isInMemory compileTarget) then resolveModule compileTarget maybeContents term flags currentDir resolved0 cachedModules importPath imp + if modInMemory mod && not (isInMemory compileTarget) || Just flags /= modCompiled mod then resolveModule compileTarget maybeContents term flags currentDir resolved0 cachedModules importPath imp else return (mod,resolved0) _ -> resolveModule compileTarget maybeContents term flags currentDir resolved0 cachedModules importPath imp @@ -797,7 +797,7 @@ resolveModule compileTarget maybeContents term flags currentDir modules cachedMo outIFace <- liftIO $ copyIFaceToOutputDir term flags iface core let mod = Module (Core.coreName core) outIFace (joinPath root stem) pkgQname pkgLocal [] Nothing -- (error ("getting program from core interface: " ++ iface)) - core True False (Left parseInlines) Nothing ftime (Just iftime) Nothing + core (Just flags) False (Left parseInlines) Nothing ftime (Just iftime) Nothing return mod loadFromModule mname (modPath mod){-iface-} root stem (joinPath root stem) mod @@ -1133,7 +1133,7 @@ inferCheck loaded0 flags line coreImports program modCore = coreProgramFinal, modRangeMap = mbRangeMap, modInlines = Right allInlineDefs, - modCompiled = True + modCompiled = Just flags } , loadedInlines = inlinesExtends allInlineDefs (loadedInlines loaded) } diff --git a/src/Compiler/Module.hs b/src/Compiler/Module.hs index e9eecae6e..377e63f2c 100644 --- a/src/Compiler/Module.hs +++ b/src/Compiler/Module.hs @@ -47,6 +47,7 @@ import Syntax.RangeMap import Compiler.Package ( PackageName, joinPkg ) import qualified Core.Core as Core import Data.Maybe (fromJust) +import Compiler.Options (Flags) {-------------------------------------------------------------------------- Compilation @@ -62,7 +63,7 @@ data Module = Module{ modName :: Name , modWarnings :: [(Range,Doc)] , modProgram :: Maybe (Program UserType UserKind) -- not for interfaces , modCore :: Core.Core - , modCompiled :: Bool + , modCompiled :: Maybe Flags , modInMemory :: Bool , modInlines :: Either (Gamma -> Error () [Core.InlineDef]) ([Core.InlineDef]) , modRangeMap :: Maybe RangeMap @@ -110,7 +111,7 @@ initialLoaded moduleNull :: Name -> Module moduleNull modName - = Module (modName) "" "" "" "" [] Nothing (Core.coreNull modName) False True (Left (\g -> return [])) Nothing fileTime0 Nothing Nothing + = Module (modName) "" "" "" "" [] Nothing (Core.coreNull modName) Nothing True (Left (\g -> return [])) Nothing fileTime0 Nothing Nothing loadedName :: Loaded -> Name loadedName ld diff --git a/src/Main/langserver/LanguageServer/Monad.hs b/src/Main/langserver/LanguageServer/Monad.hs index 3d1c0b540..129ce8943 100644 --- a/src/Main/langserver/LanguageServer/Monad.hs +++ b/src/Main/langserver/LanguageServer/Monad.hs @@ -56,7 +56,7 @@ import qualified Data.ByteString as D import Platform.Filetime (FileTime) import Common.File (realPath,normalize) import Compiler.Module (Modules) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Data.List (find) import qualified Data.Aeson as A import Data.Aeson.Types @@ -209,7 +209,7 @@ getModules = lsModules <$> getLSState mergeModules :: Modules -> Modules -> Modules mergeModules newModules oldModules = - let nModValid = filter modCompiled newModules -- only add modules that sucessfully compiled + let nModValid = filter (\m -> isJust (modCompiled m)) newModules -- only add modules that sucessfully compiled newModNames = map modName nModValid in nModValid ++ filter (\m -> modName m `notElem` newModNames) oldModules diff --git a/support/vscode/koka.language-koka/README.md b/support/vscode/koka.language-koka/README.md index 580743f7a..562c87a46 100644 --- a/support/vscode/koka.language-koka/README.md +++ b/support/vscode/koka.language-koka/README.md @@ -3,6 +3,8 @@ Syntax highlighting and language server support for the Koka programming language in Visual Studio Code. +Also includes language server support, and easy installation of the latest Koka SDK. + Visit for more information. ## Language Server @@ -22,9 +24,12 @@ In the extension settings, you can also set the Koka compiler path and specific compiler flags manually. -## Syntax Highlighting +## Easy Installation +Open the command panel in VSCode `(Ctrl/Cmd+Shift+P)` and run the `Koka: Download and Install Latest Version` command. (Start typing the command and it should surface to the top.) + +If Koka doesn't detect an existing installation, it will prompt to run this command automatically. -### Token Classes +## Token Classes * `koka.conid`: constructors. * `koka.op`: operators. @@ -69,3 +74,27 @@ entry, for example: } ``` +## Language Server Support +By default the language server support is enabled. To disable it, add the following to your `settings.json` file: +```json +{ + "koka.languageServer.enabled": false, +} +``` + +If you would like additional arguments to all invocations of the compiler, you can add them to your `settings.json` file: +```json +{ + "koka.languageServer.additionalArgs": ["--verbose"], +} +``` + +To change the current working directory for the language server (by default the first workspace folder), add the following to your `settings.json` file: +```json +{ + "koka.languageServer.cwd": "/path/to/working/directory", +} +``` + +The language server opens an extra terminal which shows the output of the compiler. This can be closed, but a new terminal will be opened whenever the language server is restarted. You can also reopen it by running the `Koka: Show Language Server Output` command in the vscode command panel `(Ctrl/Cmd+Shift+P)`. + diff --git a/support/vscode/koka.language-koka/package.json b/support/vscode/koka.language-koka/package.json index c4dab51b8..3bca00f86 100644 --- a/support/vscode/koka.language-koka/package.json +++ b/support/vscode/koka.language-koka/package.json @@ -228,11 +228,13 @@ "@types/node": "^20.5.6", "@types/vscode": "1.81.0", "@vscode/vsce": "^2.22.0", + "@types/semver": "^7.5.6", "typescript": "^5.2.2" }, "dependencies": { "@vscode/debugadapter": "^1.61.0", "@vscode/debugprotocol": "^1.61.0", + "semver": "^7.5.4", "await-notify": "1.0.1", "vscode-languageclient": "^8.1.0" } diff --git a/support/vscode/koka.language-koka/src/extension.ts b/support/vscode/koka.language-koka/src/extension.ts index 1de30085a..f3f989860 100644 --- a/support/vscode/koka.language-koka/src/extension.ts +++ b/support/vscode/koka.language-koka/src/extension.ts @@ -12,25 +12,29 @@ let languageServer: KokaLanguageServer; export async function deactivate() { } export async function activate(context: vscode.ExtensionContext) { - const vsConfig = vscode.workspace.getConfiguration('koka') - // We can always create the client, as it does nothing as long as it is not started + const vsConfig = vscode.workspace.getConfiguration('koka') // All configuration parameters are prefixed with koka console.log(`Koka: language server enabled ${vsConfig.get('languageServer.enabled')}`) - const { sdkPath, allSDKs } = scanForSDK(vsConfig) + + // Create commands that do not depend on the language server + createBasicCommands(context, vsConfig); + console.log(context.globalStorageUri); + if (!vsConfig.get('languageServer.enabled')) { + return + } + + const sdk = await scanForSDK(context, vsConfig) + if (!sdk){ + return; + } + const { sdkPath, allSDKs } = sdk const kokaConfig = new KokaConfig(vsConfig, sdkPath, allSDKs) if (!kokaConfig.command) { vscode.window.showInformationMessage(`Koka SDK not functional: tried initializing from path: ${kokaConfig.sdkPath}\n All SDKs: ${allSDKs}`) return // No use initializing the rest of the extension's features } - // Create commands that do not depend on the language server - createBasicCommands(context); - - if (vsConfig.get('languageServer.enabled')) { - languageServer = new KokaLanguageServer(context) - await languageServer.start(kokaConfig, context) - } else { - return - } + languageServer = new KokaLanguageServer(context) + await languageServer.start(kokaConfig, context) // create a new status bar item that we can now manage const selectSDKMenuItem = vscode.window.createStatusBarItem(vscode.StatusBarAlignment.Right, 100) @@ -58,14 +62,16 @@ export async function activate(context: vscode.ExtensionContext) { } // These commands do not depend on the language server -function createBasicCommands(context: vscode.ExtensionContext) { +function createBasicCommands(context: vscode.ExtensionContext, config: vscode.WorkspaceConfiguration) { context.subscriptions.push( // SDK management - vscode.commands.registerCommand('koka.downloadLatest', () => { - downloadSDK() + vscode.commands.registerCommand('koka.downloadLatest', async () => { + // Reset the download flag + await context.globalState.update('koka-download', true) + downloadSDK(context, config, true, undefined) }), vscode.commands.registerCommand('koka.uninstall', () => { - uninstallSDK() + uninstallSDK(context) }) ) } @@ -90,7 +96,11 @@ function createCommands( ) { context.subscriptions.push( vscode.commands.registerCommand('koka.selectSDK', async () => { - const { sdkPath, allSDKs } = scanForSDK(config) + const sdk = await scanForSDK(context, config) + if (!sdk) { + return; + } + const { sdkPath, allSDKs } = sdk kokaConfig.allSDKs = allSDKs const result = await vscode.window.showQuickPick(kokaConfig.allSDKs) if (result) kokaConfig.selectSDK(result) @@ -116,9 +126,12 @@ function createCommands( const languageServerIdx = context.subscriptions.indexOf(languageServer) if (languageServerIdx != -1) { context.subscriptions.splice(languageServerIdx, 1) + } + const sdk = await scanForSDK(context, config) + if (!sdk) { + return; } - - const { sdkPath, allSDKs } = scanForSDK(config) + const { sdkPath, allSDKs } = sdk const newConfig = new KokaConfig(config, sdkPath, allSDKs) languageServer = new KokaLanguageServer(context) await languageServer.start(newConfig, context) diff --git a/support/vscode/koka.language-koka/src/workspace.ts b/support/vscode/koka.language-koka/src/workspace.ts index 6da3fa4dd..22ae81683 100644 --- a/support/vscode/koka.language-koka/src/workspace.ts +++ b/support/vscode/koka.language-koka/src/workspace.ts @@ -4,12 +4,14 @@ import * as vs from "vscode" import * as os from "os" import * as vscode from "vscode" import * as child_process from "child_process" +import * as semver from "semver" interface SDKs { sdkPath: string, allSDKs: string[] } const kokaExeName = os.platform() === "win32" ? "koka.exe" : "koka" +const latestVersion = "2.4.2" const home = os.homedir(); -export function scanForSDK(config: vscode.WorkspaceConfiguration): SDKs | undefined { +export async function scanForSDK(context: vscode.ExtensionContext, config: vscode.WorkspaceConfiguration): Promise { const processPath = (process.env.PATH as string) || "" const paths = processPath.split(path.delimiter).filter((p) => p) @@ -56,31 +58,102 @@ export function scanForSDK(config: vscode.WorkspaceConfiguration): SDKs | undefi if (defaultSDK === "" && !config.get('languageServer.compiler')) { console.log('Koka: No Koka SDK found') vs.window.showWarningMessage("Koka SDK not found on path or in ~/.local/bin") - downloadSDK() + return await downloadSDK(context, config, false, undefined) + } else if (semver.lt(getSDKVersion(defaultSDK), latestVersion) ) { + return await downloadSDK(context, config, true, {sdkPath: defaultSDK, allSDKs: allSDKs }) } return { sdkPath: defaultSDK, allSDKs: allSDKs } } -export async function downloadSDK() { +function getSDKVersion(sdkPath: string): string { + const options = { env: process.env } + const result = child_process.execSync(`${sdkPath} --version`, options) + const versionRegex = /version: ([0-9]+\.[0-9]+.[0-9]+)/g; + const match = versionRegex.exec(result.toString()) + console.log("Koka: Found version " + match[1].toString()) + return match[1].toString(); +} + +export async function downloadSDK(context: vscode.ExtensionContext, config: vscode.WorkspaceConfiguration, upgrade: boolean, old: (SDKs|undefined)): Promise { + const response = context.globalState.get('koka-download') + if (response === false){ + return old; + } const decision = await vscode.window.showInformationMessage( - `Download and Install the lastest Koka, continue?`, + `${upgrade ? "There is an update for koka available\n\n" : ""}Download and Install Koka, continue?`, { modal: true }, 'Yes', 'No' ) if (decision == 'No') { - return + await context.globalState.update('koka-download', false) + return old; } - let command = "curl -sSL https://github.com/koka-lang/koka/releases/latest/download/install.sh | sh" + let command = "curl -sSL https://github.com/koka-lang/koka/releases/latest/download/install.sh | sh && exit" if (os.platform() === "win32") { - command = "curl -sSL -o %tmp%\install-koka.bat https://github.com/koka-lang/koka/releases/latest/download/install.bat && %tmp%\install-koka.bat" + command = "curl -sSL -o %tmp%\install-koka.bat https://github.com/koka-lang/koka/releases/latest/download/install.bat && %tmp%\install-koka.bat && exit" } - const term = vscode.window.createTerminal({ name: "Install Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Installing Koka, restart your editor when finished" }) + const term = vscode.window.createTerminal({ name: "Install Koka", cwd: home, shellPath: DefaultShellPath, isTransient: true, message: "Installing Koka" }) term.sendText(command) term.show() + let dispose: vscode.Disposable | undefined = undefined; + const result = await new Promise((resolve, reject) => { + let finished = false; + // Race between a 30 second timeout on watching terminals + // and the terminal finishing installation + setTimeout(() => { + if (!finished){ + console.log("Koka: Installation timed out") + resolve(undefined); + finished = true; + } + }, 30000); + dispose = vscode.window.onDidCloseTerminal(async (t) => { + console.log("Terminal closed") + if (t === term) { + console.log("Koka: Installation finished") + const sdk = await scanForSDK(context, config); + if (!finished){ + const {sdkPath, allSDKs} = sdk + if (sdkPath){ + console.log(path.join(sdkPath)) + const sdkRoot = path.dirname(path.dirname(sdkPath)) + const examples = path.join(sdkRoot, "share", "koka", `v${latestVersion}`, "lib", "samples") + if (fs.existsSync(examples)) { + let dest = path.join(context.globalStorageUri.fsPath, "samples") + fs.cp(examples, dest, {recursive:true}, async (err) => { + if (!err){ + const decision = await vscode.window.showInformationMessage( + `Open Koka's latest samples folder?`, + { modal: true }, + 'Yes', + 'Yes (new window)', + 'No' + ) + if (decision == 'No') { + return; + } + const examplesUri = vscode.Uri.file(dest) + vscode.commands.executeCommand('vscode.openFolder', examplesUri, {forceNewWindow : decision == 'Yes (new window)'}) + } + }) + + } + console.log(examples) + resolve(sdk); + } else { + resolve(undefined) + } + finished = true; + } + } + }) + }) + dispose?.dispose() + return result; } -export async function uninstallSDK() { +export async function uninstallSDK(context: vscode.ExtensionContext) { const decision = await vscode.window.showInformationMessage( `Uninstall the system Koka installation, continue?`, { modal: true }, From 96cdcdc60c69f0011bb8726ac5922d88f4812047 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 16 Dec 2023 15:31:43 -0700 Subject: [PATCH 34/37] update readme --- support/vscode/koka.language-koka/README.md | 85 +++++++++++++++------ 1 file changed, 60 insertions(+), 25 deletions(-) diff --git a/support/vscode/koka.language-koka/README.md b/support/vscode/koka.language-koka/README.md index 562c87a46..f25ed0a3d 100644 --- a/support/vscode/koka.language-koka/README.md +++ b/support/vscode/koka.language-koka/README.md @@ -15,6 +15,11 @@ show type information on hover, and can execute `main`, `test-xxx`, and `example-xxx` functions directly in the debug console. +### Easy SDK Installation +Open the command panel in VSCode `(Ctrl/Cmd+Shift+P)` and run the `Koka: Download and Install Latest Version` command. (Start typing the command and it should surface to the top.) + +If Koka doesn't detect an existing installation, it will prompt to run this command automatically. + ### Customize The extension shows "inlay hints" for inferred types of parameters @@ -23,11 +28,58 @@ off in the editor inlay hints settings. In the extension settings, you can also set the Koka compiler path and specific compiler flags manually. +### Running Files -## Easy Installation -Open the command panel in VSCode `(Ctrl/Cmd+Shift+P)` and run the `Koka: Download and Install Latest Version` command. (Start typing the command and it should surface to the top.) +You can create custom run configurations in your `launch.json` file, just like any other programming language. +For koka you have the following options: +```json +{ + "type": "koka", + "request": "launch", + "program": "", // The path to the file you want to run + "name": "", // The name as you want it to appear in the run configurations dropdown + "functionName": "", // optional function name to run (must be a function that doesn't use any effects other than io effects and returns a showable value) + "programArgs": [], // optional arguments you want to give to the compiled program + "compilerArgs": "", // optional arguments you want to give to the compiler (e.g. --verbose or -O2) +} +``` -If Koka doesn't detect an existing installation, it will prompt to run this command automatically. +Although it pulls up the debug panels, it doesn't support debugging yet. + +Compilation progress will be shown in the language server Terminal window, but the debug console will be used to show the output of the program. + + +### Language Server Configuration + +By default the language server support is enabled. To disable it, add the following to your `settings.json` file: +```json +{ + "koka.languageServer.enabled": false, +} +``` + +If you would like additional arguments to all invocations of the compiler, you can add them to your `settings.json` file: +```json +{ + "koka.languageServer.additionalArgs": ["--verbose"], +} +``` + +To change the current working directory for the language server (by default the first workspace folder), add the following to your `settings.json` file: +```json +{ + "koka.languageServer.cwd": "/path/to/working/directory", +} +``` + +### Supported Language Server Aspects +- [x] Diagnostics +- [x] Code completion +- [x] Hover information +- [x] Find definitions +- [x] Inlay hints +- [x] Document outline +- [x] Code folding ranges ## Token Classes @@ -74,27 +126,10 @@ entry, for example: } ``` -## Language Server Support -By default the language server support is enabled. To disable it, add the following to your `settings.json` file: -```json -{ - "koka.languageServer.enabled": false, -} -``` - -If you would like additional arguments to all invocations of the compiler, you can add them to your `settings.json` file: -```json -{ - "koka.languageServer.additionalArgs": ["--verbose"], -} -``` - -To change the current working directory for the language server (by default the first workspace folder), add the following to your `settings.json` file: -```json -{ - "koka.languageServer.cwd": "/path/to/working/directory", -} -``` +## Extension Commands -The language server opens an extra terminal which shows the output of the compiler. This can be closed, but a new terminal will be opened whenever the language server is restarted. You can also reopen it by running the `Koka: Show Language Server Output` command in the vscode command panel `(Ctrl/Cmd+Shift+P)`. +The language server opens an extra terminal which shows the output of the compiler. +This can be closed, but a new terminal will be opened whenever the language server is restarted. +You can also reopen it by running the `Koka: Show Language Server Output` command in the vscode command panel `(Ctrl/Cmd+Shift+P)`. +To uninstall the Koka SDK run the `Koka: Uninstall System SDK` command in the vscode command panel `(Ctrl/Cmd+Shift+P)`. From c607f91eb8e5cf84a7020495d1e54da8dcc81ccf Mon Sep 17 00:00:00 2001 From: Daan Leijen Date: Sat, 16 Dec 2023 14:37:46 -0800 Subject: [PATCH 35/37] update code lens description and tooltip --- LICENSE | 240 +++++++++--------- samples/basic/fibonacci.kk | 6 +- .../koka.language-koka/src/code-lens.ts | 14 +- 3 files changed, 133 insertions(+), 127 deletions(-) diff --git a/LICENSE b/LICENSE index 5454086ac..82b129365 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ -Copyright 2012-2021, Microsoft Research, Daan Leijen. +Copyright 2012-2023, Microsoft Research, Daan Leijen. -Koka is free software; You can redistribute it and/or +Koka is free software; You can redistribute it and/or modify it under the terms of this license. @@ -13,185 +13,185 @@ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. -"License" shall mean the terms and conditions for use, reproduction, and +"License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. -"Licensor" shall mean the copyright owner or entity authorized by the +"Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. -"Legal Entity" shall mean the union of the acting entity and all other -entities that control, are controlled by, or are under common control -with that entity. For the purposes of this definition, "control" means -(i) the power, direct or indirect, to cause the direction or management -of such entity, whether by contract or otherwise, or (ii) ownership of -fifty percent (50%) or more of the outstanding shares, or (iii) +"Legal Entity" shall mean the union of the acting entity and all other +entities that control, are controlled by, or are under common control +with that entity. For the purposes of this definition, "control" means +(i) the power, direct or indirect, to cause the direction or management +of such entity, whether by contract or otherwise, or (ii) ownership of +fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. -"You" (or "Your") shall mean an individual or Legal Entity exercising +"You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. -"Source" form shall mean the preferred form for making modifications, -including but not limited to software source code, documentation source, +"Source" form shall mean the preferred form for making modifications, +including but not limited to software source code, documentation source, and configuration files. -"Object" form shall mean any form resulting from mechanical -transformation or translation of a Source form, including but not limited -to compiled object code, generated documentation, and conversions to +"Object" form shall mean any form resulting from mechanical +transformation or translation of a Source form, including but not limited +to compiled object code, generated documentation, and conversions to other media types. -"Work" shall mean the work of authorship, whether in Source or Object -form, made available under the License, as indicated by a copyright -notice that is included in or attached to the work (an example is +"Work" shall mean the work of authorship, whether in Source or Object +form, made available under the License, as indicated by a copyright +notice that is included in or attached to the work (an example is provided in the Appendix below). -"Derivative Works" shall mean any work, whether in Source or Object form, -that is based on (or derived from) the Work and for which the editorial -revisions, annotations, elaborations, or other modifications represent, -as a whole, an original work of authorship. For the purposes of this -License, Derivative Works shall not include works that remain separable -from, or merely link (or bind by name) to the interfaces of, the Work and +"Derivative Works" shall mean any work, whether in Source or Object form, +that is based on (or derived from) the Work and for which the editorial +revisions, annotations, elaborations, or other modifications represent, +as a whole, an original work of authorship. For the purposes of this +License, Derivative Works shall not include works that remain separable +from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. -"Contribution" shall mean any work of authorship, including the original -version of the Work and any modifications or additions to that Work or -Derivative Works thereof, that is intentionally submitted to Licensor for -inclusion in the Work by the copyright owner or by an individual or Legal -Entity authorized to submit on behalf of the copyright owner. For the -purposes of this definition, "submitted" means any form of electronic, -verbal, or written communication sent to the Licensor or its -representatives, including but not limited to communication on electronic -mailing lists, source code control systems, and issue tracking systems -that are managed by, or on behalf of, the Licensor for the purpose of -discussing and improving the Work, but excluding communication that is -conspicuously marked or otherwise designated in writing by the copyright +"Contribution" shall mean any work of authorship, including the original +version of the Work and any modifications or additions to that Work or +Derivative Works thereof, that is intentionally submitted to Licensor for +inclusion in the Work by the copyright owner or by an individual or Legal +Entity authorized to submit on behalf of the copyright owner. For the +purposes of this definition, "submitted" means any form of electronic, +verbal, or written communication sent to the Licensor or its +representatives, including but not limited to communication on electronic +mailing lists, source code control systems, and issue tracking systems +that are managed by, or on behalf of, the Licensor for the purpose of +discussing and improving the Work, but excluding communication that is +conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." -"Contributor" shall mean Licensor and any individual or Legal Entity on -behalf of whom a Contribution has been received by Licensor and +"Contributor" shall mean Licensor and any individual or Legal Entity on +behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. -Subject to the terms and conditions of this License, each Contributor -hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, -royalty-free, irrevocable copyright license to reproduce, prepare -Derivative Works of, publicly display, publicly perform, sublicense, and +Subject to the terms and conditions of this License, each Contributor +hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, +royalty-free, irrevocable copyright license to reproduce, prepare +Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. -Subject to the terms and conditions of this License, each Contributor -hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, -royalty-free, irrevocable (except as stated in this section) patent -license to make, have made, use, offer to sell, sell, import, and -otherwise transfer the Work, where such license applies only to those -patent claims licensable by such Contributor that are necessarily -infringed by their Contribution(s) alone or by combination of their -Contribution(s) with the Work to which such Contribution(s) was -submitted. If You institute patent litigation against any entity -(including a cross-claim or counterclaim in a lawsuit) alleging that the -Work or a Contribution incorporated within the Work constitutes direct or -contributory patent infringement, then any patent licenses granted to You -under this License for that Work shall terminate as of the date such +Subject to the terms and conditions of this License, each Contributor +hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, +royalty-free, irrevocable (except as stated in this section) patent +license to make, have made, use, offer to sell, sell, import, and +otherwise transfer the Work, where such license applies only to those +patent claims licensable by such Contributor that are necessarily +infringed by their Contribution(s) alone or by combination of their +Contribution(s) with the Work to which such Contribution(s) was +submitted. If You institute patent litigation against any entity +(including a cross-claim or counterclaim in a lawsuit) alleging that the +Work or a Contribution incorporated within the Work constitutes direct or +contributory patent infringement, then any patent licenses granted to You +under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. -You may reproduce and distribute copies of the Work or Derivative Works -thereof in any medium, with or without modifications, and in Source or +You may reproduce and distribute copies of the Work or Derivative Works +thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: -You must give any other recipients of the Work or Derivative Works a copy +You must give any other recipients of the Work or Derivative Works a copy of this License; and -You must cause any modified files to carry prominent notices stating that +You must cause any modified files to carry prominent notices stating that You changed the files; and -You must retain, in the Source form of any Derivative Works that You -distribute, all copyright, patent, trademark, and attribution notices -from the Source form of the Work, excluding those notices that do not +You must retain, in the Source form of any Derivative Works that You +distribute, all copyright, patent, trademark, and attribution notices +from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and -If the Work includes a "NOTICE" text file as part of its distribution, -then any Derivative Works that You distribute must include a readable -copy of the attribution notices contained within such NOTICE file, -excluding those notices that do not pertain to any part of the Derivative -Works, in at least one of the following places: within a NOTICE text file -distributed as part of the Derivative Works; within the Source form or -documentation, if provided along with the Derivative Works; or, within a -display generated by the Derivative Works, if and wherever such -third-party notices normally appear. The contents of the NOTICE file are -for informational purposes only and do not modify the License. You may -add Your own attribution notices within Derivative Works that You -distribute, alongside or as an addendum to the NOTICE text from the Work, -provided that such additional attribution notices cannot be construed as +If the Work includes a "NOTICE" text file as part of its distribution, +then any Derivative Works that You distribute must include a readable +copy of the attribution notices contained within such NOTICE file, +excluding those notices that do not pertain to any part of the Derivative +Works, in at least one of the following places: within a NOTICE text file +distributed as part of the Derivative Works; within the Source form or +documentation, if provided along with the Derivative Works; or, within a +display generated by the Derivative Works, if and wherever such +third-party notices normally appear. The contents of the NOTICE file are +for informational purposes only and do not modify the License. You may +add Your own attribution notices within Derivative Works that You +distribute, alongside or as an addendum to the NOTICE text from the Work, +provided that such additional attribution notices cannot be construed as modifying the License. -You may add Your own copyright statement to Your modifications and may -provide additional or different license terms and conditions for use, -reproduction, or distribution of Your modifications, or for any such -Derivative Works as a whole, provided Your use, reproduction, and -distribution of the Work otherwise complies with the conditions stated in +You may add Your own copyright statement to Your modifications and may +provide additional or different license terms and conditions for use, +reproduction, or distribution of Your modifications, or for any such +Derivative Works as a whole, provided Your use, reproduction, and +distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. -Unless You explicitly state otherwise, any Contribution intentionally -submitted for inclusion in the Work by You to the Licensor shall be under -the terms and conditions of this License, without any additional terms or -conditions. Notwithstanding the above, nothing herein shall supersede or -modify the terms of any separate license agreement you may have executed +Unless You explicitly state otherwise, any Contribution intentionally +submitted for inclusion in the Work by You to the Licensor shall be under +the terms and conditions of this License, without any additional terms or +conditions. Notwithstanding the above, nothing herein shall supersede or +modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. -This License does not grant permission to use the trade names, -trademarks, service marks, or product names of the Licensor, except as -required for reasonable and customary use in describing the origin of the +This License does not grant permission to use the trade names, +trademarks, service marks, or product names of the Licensor, except as +required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. -Unless required by applicable law or agreed to in writing, Licensor -provides the Work (and each Contributor provides its Contributions) on an -"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either -express or implied, including, without limitation, any warranties or -conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A -PARTICULAR PURPOSE. You are solely responsible for determining the -appropriateness of using or redistributing the Work and assume any risks +Unless required by applicable law or agreed to in writing, Licensor +provides the Work (and each Contributor provides its Contributions) on an +"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either +express or implied, including, without limitation, any warranties or +conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A +PARTICULAR PURPOSE. You are solely responsible for determining the +appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. -In no event and under no legal theory, whether in tort (including -negligence), contract, or otherwise, unless required by applicable law -(such as deliberate and grossly negligent acts) or agreed to in writing, -shall any Contributor be liable to You for damages, including any direct, -indirect, special, incidental, or consequential damages of any character -arising as a result of this License or out of the use or inability to use -the Work (including but not limited to damages for loss of goodwill, work -stoppage, computer failure or malfunction, or any and all other -commercial damages or losses), even if such Contributor has been advised +In no event and under no legal theory, whether in tort (including +negligence), contract, or otherwise, unless required by applicable law +(such as deliberate and grossly negligent acts) or agreed to in writing, +shall any Contributor be liable to You for damages, including any direct, +indirect, special, incidental, or consequential damages of any character +arising as a result of this License or out of the use or inability to use +the Work (including but not limited to damages for loss of goodwill, work +stoppage, computer failure or malfunction, or any and all other +commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. -While redistributing the Work or Derivative Works thereof, You may choose -to offer, and charge a fee for, acceptance of support, warranty, -indemnity, or other liability obligations and/or rights consistent with -this License. However, in accepting such obligations, You may act only on -Your own behalf and on Your sole responsibility, not on behalf of any -other Contributor, and only if You agree to indemnify, defend, and hold -each Contributor harmless for any liability incurred by, or claims -asserted against, such Contributor by reason of your accepting any such +While redistributing the Work or Derivative Works thereof, You may choose +to offer, and charge a fee for, acceptance of support, warranty, +indemnity, or other liability obligations and/or rights consistent with +this License. However, in accepting such obligations, You may act only on +Your own behalf and on Your sole responsibility, not on behalf of any +other Contributor, and only if You agree to indemnify, defend, and hold +each Contributor harmless for any liability incurred by, or claims +asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work -To apply the Apache License to your work, attach the following -boilerplate notice, with the fields enclosed by brackets "[]" replaced -with your own identifying information. (Don't include the brackets!) The -text should be enclosed in the appropriate comment syntax for the file -format. We also recommend that a file or class name and description of -purpose be included on the same "printed page" as the copyright notice +To apply the Apache License to your work, attach the following +boilerplate notice, with the fields enclosed by brackets "[]" replaced +with your own identifying information. (Don't include the brackets!) The +text should be enclosed in the appropriate comment syntax for the file +format. We also recommend that a file or class name and description of +purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] @@ -204,7 +204,7 @@ for easier identification within third-party archives. Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. diff --git a/samples/basic/fibonacci.kk b/samples/basic/fibonacci.kk index d164ab977..2cb62599f 100644 --- a/samples/basic/fibonacci.kk +++ b/samples/basic/fibonacci.kk @@ -1,6 +1,6 @@ module fibonacci -pub fun main() +pub fun mainx() val n = 10000 println("The " ++ n.show ++ "th fibonacci number is " ++ fibonacci(10000).show) @@ -14,3 +14,7 @@ fun fib(n : int, x1 : int, x2 : int) : div int pub fun testx() fibonacci(100).println + + +pub fun test2() + fibonacci(1000).println diff --git a/support/vscode/koka.language-koka/src/code-lens.ts b/support/vscode/koka.language-koka/src/code-lens.ts index 7526421d6..30fd44f89 100644 --- a/support/vscode/koka.language-koka/src/code-lens.ts +++ b/support/vscode/koka.language-koka/src/code-lens.ts @@ -47,15 +47,16 @@ export class MainCodeLensProvider implements vscode.CodeLensProvider { { arguments: [document.uri], command: "koka.startWithoutDebugging", - title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)} (debug)`, + title: "run debug", // `Run ${path.relative(this.config.cwd, document.uri.fsPath)} (debug)`, + tooltip: "Compile and run in debug mode" }, ), new vscode.CodeLens( toRange(document, offset, len), { arguments: [document.uri, "-O2", ["--kktime"]], command: "koka.startWithoutDebugging", - title: `Run ${path.relative(this.config.cwd, document.uri.fsPath)} (release)`, - tooltip: "Run with compilation flag -O2\nGive argument --kktime to the executable" + title: `optimized`, // `Run ${path.relative(this.config.cwd, document.uri.fsPath)} (release)`, + tooltip: "Compile with flag -O2\nRun executable with flag --kktime" }, ), ] @@ -67,7 +68,8 @@ export class MainCodeLensProvider implements vscode.CodeLensProvider { { arguments: [document.uri, functionName], command: "koka.interpretExpression", - title: `Run ${functionName} (debug)`, + title: "run debug", //`Run ${functionName} (debug)`, + tooltip: "Compile and run in debug mode" } ), new vscode.CodeLens( @@ -75,8 +77,8 @@ export class MainCodeLensProvider implements vscode.CodeLensProvider { { arguments: [document.uri, functionName, "-O2", ["--kktime"]], command: "koka.interpretExpression", - title: `Run ${functionName} (release)`, - tooltip: "Run with compilation flag -O2\nGive argument --kktime to the executable" + title: `optimized`, // `Run ${functionName} (release)`, + tooltip: "Compile with flag -O2\nRun executable with flag --kktime" } ) ] From 13b4b8d9a4dd798beee9c95bb15ff7c94e0a0da2 Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 16 Dec 2023 15:42:51 -0700 Subject: [PATCH 36/37] fix readme to reflect renaming --- support/vscode/koka.language-koka/README.md | 2 +- support/vscode/koka.language-koka/src/workspace.ts | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/support/vscode/koka.language-koka/README.md b/support/vscode/koka.language-koka/README.md index f25ed0a3d..d0e3fc2af 100644 --- a/support/vscode/koka.language-koka/README.md +++ b/support/vscode/koka.language-koka/README.md @@ -61,7 +61,7 @@ By default the language server support is enabled. To disable it, add the follow If you would like additional arguments to all invocations of the compiler, you can add them to your `settings.json` file: ```json { - "koka.languageServer.additionalArgs": ["--verbose"], + "koka.languageServer.compilerArgs": ["--verbose"], } ``` diff --git a/support/vscode/koka.language-koka/src/workspace.ts b/support/vscode/koka.language-koka/src/workspace.ts index 22ae81683..28d6949a1 100644 --- a/support/vscode/koka.language-koka/src/workspace.ts +++ b/support/vscode/koka.language-koka/src/workspace.ts @@ -200,7 +200,7 @@ export class KokaConfig { selectSDK(path: string) { if (!fs.existsSync(path)) { - console.log(`Koka executable not found at this location ${path}`) + console.log(`Koka compiler not found at this location ${path}`) this.command = null return } From 04c2fba3720c5b3a92161428c266f309fabe382e Mon Sep 17 00:00:00 2001 From: Tim Whiting Date: Sat, 16 Dec 2023 16:00:21 -0700 Subject: [PATCH 37/37] fix custom sdk path --- package.yaml | 1 + support/vscode/koka.language-koka/src/workspace.ts | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/package.yaml b/package.yaml index 43cfaa3e6..3175bf8b6 100644 --- a/package.yaml +++ b/package.yaml @@ -5,6 +5,7 @@ # - util/Dockerfile # - util/minbuild # - support/vscode/koka.language-koka/src/workspace.ts +# - support/vscode/koka.language-koka/package.json name: koka version: 2.4.3 diff --git a/support/vscode/koka.language-koka/src/workspace.ts b/support/vscode/koka.language-koka/src/workspace.ts index 28d6949a1..9ae2d6a6b 100644 --- a/support/vscode/koka.language-koka/src/workspace.ts +++ b/support/vscode/koka.language-koka/src/workspace.ts @@ -8,7 +8,7 @@ import * as semver from "semver" interface SDKs { sdkPath: string, allSDKs: string[] } const kokaExeName = os.platform() === "win32" ? "koka.exe" : "koka" -const latestVersion = "2.4.2" +const latestVersion = "2.4.3" const home = os.homedir(); export async function scanForSDK(context: vscode.ExtensionContext, config: vscode.WorkspaceConfiguration): Promise { @@ -55,6 +55,7 @@ export async function scanForSDK(context: vscode.ExtensionContext, config: vscod } } } + defaultSDK = config.get('languageServer.compiler') as string || defaultSDK if (defaultSDK === "" && !config.get('languageServer.compiler')) { console.log('Koka: No Koka SDK found') vs.window.showWarningMessage("Koka SDK not found on path or in ~/.local/bin") @@ -179,7 +180,7 @@ export class KokaConfig { this.config = config this.debugExtension = config.get('debugExtension') as boolean this.defaultSDK = sdkPath - this.sdkPath = config.get('languageServer.compiler') as string || sdkPath + this.sdkPath = sdkPath this.allSDKs = allSDKs this.cwd = config.get('languageServer.cwd') as string || vscode.workspace.workspaceFolders![0].uri.fsPath this.langServerArgs = []