You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
65 lines
2.1 KiB
65 lines
2.1 KiB
{-# LANGUAGE BlockArguments #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
module Main where
|
|
|
|
import Control.Exception
|
|
|
|
import qualified Data.ByteString.Lazy as Bsl
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Data.Map.Strict as Map
|
|
import qualified Data.Text.IO as T
|
|
import qualified Data.Text as T
|
|
import Data.Text ( Text )
|
|
import Data.Foldable
|
|
|
|
import Elab.Monad
|
|
import Elab.Eval
|
|
import Elab
|
|
|
|
import Presyntax.Presyntax (Posn(Posn))
|
|
import Presyntax.Parser
|
|
import Presyntax.Tokens
|
|
import Presyntax.Lexer
|
|
|
|
import System.Exit
|
|
import Syntax.Pretty
|
|
|
|
main :: IO ()
|
|
main = do
|
|
t <- Bsl.readFile "test.tt"
|
|
let Right tks = runAlex t parseProg
|
|
env <- runElab (checkProgram tks) emptyEnv `catch` \e -> displayAndDie (T.decodeUtf8 (Bsl.toStrict t)) (e :: SomeException)
|
|
for_ (Map.toList (getEnv env)) $ \(n, x) -> putStrLn $ show n ++ " : " ++ showValue (zonk (fst x))
|
|
|
|
displayAndDie :: Exception e => Text -> e -> IO a
|
|
displayAndDie lines e = do
|
|
() <- throwIO e `catches` displayExceptions lines
|
|
exitFailure
|
|
|
|
displayExceptions :: Text -> [Handler ()]
|
|
displayExceptions lines =
|
|
[ Handler \(WhileChecking a b e) -> do
|
|
T.putStrLn $ squiggleUnder a b lines
|
|
displayExceptions' lines e
|
|
, Handler \(NotEqual ta tb) -> do
|
|
putStrLn . unlines $
|
|
[ "\x1b[1;31merror\x1b[0m: Mismatch between actual and expected types:"
|
|
, " * \x1b[1mActual\x1b[0m: " ++ showValue (zonk ta)
|
|
, " * \x1b[1mExpected\x1b[0m: " ++ showValue (zonk tb)
|
|
]
|
|
]
|
|
|
|
displayExceptions' :: Exception e => Text -> e -> IO ()
|
|
displayExceptions' lines e = displayAndDie lines e `catch` \(_ :: ExitCode) -> pure ()
|
|
|
|
squiggleUnder :: Posn -> Posn -> Text -> Text
|
|
squiggleUnder (Posn l c) (Posn l' c') file
|
|
| l == l' =
|
|
let
|
|
line = T.pack (show l) <> " | " <> T.lines file !! (l - 1)
|
|
padding = T.replicate (length (show l)) (T.singleton ' ') <> " |"
|
|
squiggle = T.replicate c " " <> T.pack "\x1b[1;31m" <> T.replicate (c' - c) "~" <> T.pack "\x1b[0m"
|
|
|
|
in T.unlines [ padding, line, padding <> squiggle ]
|
|
| otherwise = T.pack (show (Posn l c, Posn l' c'))
|