amelia
/
setoid


{-# LANGUAGE LambdaCase #-}

module Main where


import Presyntax.Parser


import System.Environment (getArgs)

import Elaboration

import Elaboration.Monad

import Control.Monad.Reader

import Syntax

import Evaluate (elabMetas, zonk, evaluate, quote)

import Syntax.Pretty

import Data.Foldable

import Control.Concurrent

import qualified Data.IntMap.Strict as Map

import Value (Meta(Solved, Unsolved))


main :: IO ()

main = do

 [path] <- getArgs

 text <- readFile path

 x <-

 case parseString body text of

 Left e -> error (show e)

 Right x -> pure x


 swapMVar elabMetas mempty

 swapMVar elabNext 0


 t <- runElab ((,) <$> infer x <*> ask) emptyElabState

 case t of

 Left e -> traverse_ (putStrLn . showProgError text) e

 Right ((x, t), e) -> do

 metas <- readMVar elabMetas

 for_ (Map.toList metas) $ \case

 (n, Unsolved names v) ->

 putStrLn $ '?':show n ++ " : " ++ showWithPrec names 0 (quote (Lvl (length names)) (zonk v)) "" ++ " = ? "

 (n, Solved v) ->

 putStrLn $ '?':show n ++ " = " ++ showTerm 0 (quote (Lvl 0) v) ""


 putStrLn . flip id "" $ showTerm 0 x

 putStrLn . flip id "" $ showString "Type: " . showTerm 0 (quote (Lvl 0) (zonk t))

 let t = quote (Lvl 0) . zonk . evaluate (elabEnv e) $ x

 putStrLn $ "Normal form: " ++ showTerm 0 t ""


showProgError :: String -> ProgError -> String

showProgError text (ProgError e sl sc el ec)

 | sl == el, sl < length (lines text) =

 let code = lines text

 line = code !! sl


 linum = show sl


 caretLine = replicate (length linum) ' ' ++ " | " ++ replicate sc ' ' ++ "^" ++ replicate (ec - sc) '~'

 paddedLine = replicate (length linum) ' ' ++ " | "

 in unlines [ paddedLine

 , linum ++ " | " ++ line

 , caretLine

 , showElabError e ""

 ]

 | otherwise = showElabError e ""