baskell-0.1: src/Main.hs
{-# LANGUAGE CPP #-}
{-------------------------------------------------------------------------------
Copyright: Bernie Pope 2004
Module: Main
Description: The top module in baskell. Implements the
read-eval-print loop of the interpreter.
Primary Authors: Bernie Pope
-------------------------------------------------------------------------------}
{-
This file is part of baskell.
baskell is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
baskell is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with baskell; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
module Main where
import Pretty
( prettyText )
import Parser
( parse )
import AST
( Program (..)
, Decl (..)
, Exp
, emptyProgram
, isEmptyProgram
)
import System.IO
( stdout
, hSetBuffering
, BufferMode (NoBuffering)
)
import Reduce
( runExp
, buildEnv
, Env
, joinEnv
)
import Primitives
( primDecls
, primTypes
)
import Data.Char
( isSpace )
import Rename
( renameExp
, renameProgram
)
import Type
( Type )
import TypeCheck
( typeCheckExpression
, typeCheckProgram
, Constraint
, renderConstraints
)
import Control.Monad
( when )
import Depend
( depend
, printDepends
)
import Help
( printHelp )
import CmdLine
( Command (..)
, getCommand
, initializeCmdLine
)
import Control.Concurrent
( myThreadId
, ThreadId
)
import System.Posix.Signals
( sigINT
, installHandler
, Handler (..)
)
import Control.Exception
( try
, throwTo
, Exception (..)
)
--------------------------------------------------------------------------------
-- the state of the interpreter
data State
= State
{ state_prelude :: Program -- the Prelude functions
, state_currentProgram :: Program -- the functions of a loaded module
, state_currentEnv :: Env -- prims + prelude + current
, state_primEnv :: Env -- primitive functions
, state_primTypes :: [Constraint] -- types of primitive functions
, state_preludeTypes :: [Constraint] -- types of Prelude functions
, state_currentTypes :: [Constraint] -- types of loaded module
, state_count :: Int -- unique number (for fresh vars)
}
main :: IO ()
main = do
catchCtrlC
hSetBuffering stdout NoBuffering
initializeCmdLine
putStrLn "Welcome to Baskell"
putStrLn "Bernie's Amazing Super-Kool Equational Low-fat Language"
initState <- initialiseState
putStrLn "Type :h for help"
repLoop initState
catchCtrlC :: IO Handler
catchCtrlC
= do thisThread <- myThreadId
installHandler sigINT (Catch (hupHandler thisThread)) Nothing
where
hupHandler :: ThreadId -> IO ()
hupHandler theThread
= throwTo theThread (ErrorCall "Interrupt Signal")
-- initialise the state of the debugger
-- * set up the primitive functions
-- * load the Prelude
initialiseState :: IO State
initialiseState = do
putStrLn "Loading the Prelude..."
let (renamedPrims, primCount)
= renameProgram (Program primDecls) 0
primEnv = buildEnv renamedPrims
primState = State
{ state_prelude = emptyProgram
, state_currentProgram = emptyProgram
, state_currentEnv = primEnv
, state_primEnv = primEnv
, state_primTypes = primTypes
, state_preludeTypes = []
, state_currentTypes = []
, state_count = primCount
}
preludeState <- load primState "Prelude.bs"
return $ preludeState
{ state_prelude = state_currentProgram preludeState
, state_currentProgram = emptyProgram
, state_preludeTypes = state_currentTypes preludeState
, state_currentTypes = []
}
-- the Read Eval Print Loop of the interpreter
repLoop :: State -> IO ()
repLoop state = do
command <- getCommand
case command of
Load file -> do
newState <- load state file
repLoop newState
Eval exp -> do
result <- try $ eval state exp
case result of
Left e -> putStrLn "Interrupted!"
Right () -> return ()
repLoop state
Type exp -> typeExp state exp >> repLoop state
Browse -> browse state >> repLoop state
Quit -> putStrLn "Leaving baskell."
Help -> printHelp >> repLoop state
#ifdef DEBUG
ShowAST -> do
putStrLn "The abstract syntax tree:"
print $ state_currentProgram state
repLoop state
ShowDepend -> do
putStrLn "Function dependencies:"
printDepends $ state_currentProgram state
repLoop state
#endif
-- evaluate an expression from the command line
eval :: State -> Exp -> IO ()
eval state exp
= do let renamedExp = renameExp exp (state_count state)
finalForm = runExp (state_currentEnv state) renamedExp
putStrLn $ prettyText finalForm
-- infer the type of an expression on the command line
typeExp :: State -> Exp -> IO ()
typeExp state exp
= do let renamedExp = renameExp exp (state_count state)
assumptions = state_primTypes state ++
state_preludeTypes state ++
state_currentTypes state
typeCheckExpression assumptions renamedExp
-- load a user defined Baskell module
load :: State -> FilePath -> IO State
load state file = do
contents <- safeReadFile file
if null contents
then return state
else parseRenameAndType state file contents
-- parse a file, rename identifiers, and type check it
-- if successful update the state of the interpreter
parseRenameAndType :: State -> FilePath -> String -> IO State
parseRenameAndType state file contents
= do case parse file contents of
Left e
-> do putStrLn $ "Parse error: " ++ show e
putStrLn $ file ++ " not loaded"
return state
Right program
-> do putStrLn $ "Load of " ++ file ++ " successful"
let oldCount = state_count state
(renamed, count) = renameProgram program oldCount
assumptions = state_primTypes state ++
state_preludeTypes state
programTypes <- typeCheckProgram assumptions renamed
let primEnv = state_primEnv state
preludeEnv = buildEnv $ state_prelude state
thisProgEnv = buildEnv renamed
currentEnv = primEnv `joinEnv`
preludeEnv `joinEnv`
thisProgEnv
return $
state
{ state_currentProgram = renamed
, state_currentEnv = currentEnv
, state_count = count
, state_currentTypes = programTypes
}
-- try to read a file but catch exceptions
safeReadFile :: FilePath -> IO String
safeReadFile file
= catch (readFile file)
$ \e -> do putStrLn $ show e
putStrLn "Program not loaded"
return []
-- print the types of the primitive functions, Prelude functions
-- and functions from a loaded module if one exists
browse :: State -> IO ()
browse state
= do display "\n--- Primitive functions ---\n" $ state_primTypes state
display "\n--- The Prelude ---\n" $ state_preludeTypes state
display "\n--- The current program ---\n" $ state_currentTypes state
where
display :: String -> [Constraint] -> IO ()
display header types
= when (not $ null types) $
do putStrLn header
putStrLn $ renderConstraints types