From a26f0f29c02bfb4ec56781397d60abeb498b8c12 Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Sat, 26 Nov 2022 13:35:19 +0100 Subject: [PATCH] massive cleanup --- app/Builtins.hs | 20 ++++++++++++++------ app/Code.hs | 5 +++-- app/Compiler.hs | 12 ++---------- app/Env.hs | 2 +- app/Frontend.hs | 24 ++++++++++++------------ app/IR.hs | 9 +++++++++ app/Interpreter.hs | 11 +++++++++++ app/Main.hs | 2 +- app/Parser.hs | 32 +++++++++++++++++++++++++++++--- 9 files changed, 82 insertions(+), 35 deletions(-) diff --git a/app/Builtins.hs b/app/Builtins.hs index 4c08884..cc0a4e9 100644 --- a/app/Builtins.hs +++ b/app/Builtins.hs @@ -1,17 +1,25 @@ module Builtins where import Code -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Trans.State.Lazy -import Data.Functor.Identity + ( Builtin(..) + , BuiltinFn + , Cho(..) + , Datum(..) + , Instr(..) + , Interp(..) + , heapStruct + ) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State.Lazy (get, gets, modify) +import Data.Functor.Identity (runIdentity) import Data.List (intercalate) import qualified Data.Map as M -import Env hiding (PrlgEnv) +import Env (PrlgEnv(..), findStruct) import qualified IR import Interpreter (backtrack) import qualified Operators as O -import System.Console.Haskeline +import System.Console.Haskeline (getInputChar, outputStr, outputStrLn) bi = Builtin diff --git a/app/Code.hs b/app/Code.hs index b1c474b..8bea782 100644 --- a/app/Code.hs +++ b/app/Code.hs @@ -2,11 +2,11 @@ module Code where -import Control.Monad.Trans.State.Lazy +import Control.Monad.Trans.State.Lazy (StateT) import qualified Data.Map as M import IR (Id(..), StrTable) import Operators (Ops) -import System.Console.Haskeline +import System.Console.Haskeline (InputT) data Datum = Atom Int -- unifies a constant @@ -73,6 +73,7 @@ data Builtin = instance Show Builtin where show _ = "Builtin _" +-- TODO are we actually going to use this? codeStruct :: Monad m => (Datum -> m a) diff --git a/app/Compiler.hs b/app/Compiler.hs index ecbd003..3c98d70 100644 --- a/app/Compiler.hs +++ b/app/Compiler.hs @@ -2,19 +2,11 @@ module Compiler where import Data.Char (isUpper) import Data.Containers.ListUtils (nubOrd) -import Data.List +import Data.List (elemIndex) import qualified Data.Map as M import Code (Code, Datum(..), Instr(..)) -import IR (Id(..), PrlgInt(..), PrlgStr(..), StrTable(..), strtablize) - -internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt) -internPrlg = go - where - go t (LiteralS str) = LiteralI <$> strtablize t str - go t (CallS str ps) = - let (t', i) = strtablize t str - in CallI (Id i $ length ps) <$> mapAccumL go t' ps +import IR (Id(..), PrlgInt(..), StrTable(..)) varname :: String -> Bool varname ('_':_) = True diff --git a/app/Env.hs b/app/Env.hs index 744762b..e873711 100644 --- a/app/Env.hs +++ b/app/Env.hs @@ -1,7 +1,7 @@ module Env where import Code (Interp(..), PrlgEnv) -import Control.Monad.Trans.State.Lazy +import Control.Monad.Trans.State.Lazy (gets, modify) import qualified IR withStrTable :: (IR.StrTable -> (IR.StrTable, a)) -> Env.PrlgEnv a diff --git a/app/Frontend.hs b/app/Frontend.hs index 8232b15..a5fa71f 100644 --- a/app/Frontend.hs +++ b/app/Frontend.hs @@ -3,28 +3,28 @@ module Frontend where import Builtins import Code (Interp(..)) import qualified Compiler as C -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Trans.State.Lazy +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State.Lazy (evalStateT, gets) import Data.Foldable (traverse_) import qualified Data.Map as M -import Env +import Env (PrlgEnv, findAtom, findStruct, withStrTable) import qualified IR import qualified Interpreter as I import qualified Parser as P import System.Console.Haskeline import qualified Text.Megaparsec as MP -import Text.Pretty.Simple +import qualified Text.Pretty.Simple as Ppr ppr :: Show a => a -> PrlgEnv () ppr x = liftIO $ - pPrintOpt - CheckColorTty - defaultOutputOptionsDarkBg - { outputOptionsCompactParens = True - , outputOptionsIndentAmount = 2 - , outputOptionsPageWidth = 80 + Ppr.pPrintOpt + Ppr.CheckColorTty + Ppr.defaultOutputOptionsDarkBg + { Ppr.outputOptionsCompactParens = True + , Ppr.outputOptionsIndentAmount = 2 + , Ppr.outputOptionsPageWidth = 80 } x @@ -45,7 +45,7 @@ interpret = (>> return True) . lex Left err -> lift . outputStrLn $ "expression parsing: " ++ err Right prlg -> intern prlg intern prlgs = do - prlgi <- withStrTable $ \st -> C.internPrlg st prlgs + prlgi <- withStrTable $ \st -> IR.internPrlg st prlgs underscore <- findAtom "_" prlgv <- withStrTable $ \st -> diff --git a/app/IR.hs b/app/IR.hs index fa987e5..ac929fa 100644 --- a/app/IR.hs +++ b/app/IR.hs @@ -1,5 +1,6 @@ module IR where +import Data.List (mapAccumL) import qualified Data.Map as M data PrlgStr @@ -31,3 +32,11 @@ strtablize t@(StrTable nxt fwd rev) str = case fwd M.!? str of Just i -> (t, i) _ -> (StrTable (nxt + 1) (M.insert str nxt fwd) (M.insert nxt str rev), nxt) + +internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt) +internPrlg = go + where + go t (LiteralS str) = LiteralI <$> strtablize t str + go t (CallS str ps) = + let (t', i) = strtablize t str + in CallI (Id i $ length ps) <$> mapAccumL go t' ps diff --git a/app/Interpreter.hs b/app/Interpreter.hs index ada3cf0..21340ef 100644 --- a/app/Interpreter.hs +++ b/app/Interpreter.hs @@ -2,7 +2,18 @@ module Interpreter where import Code + ( Builtin(..) + , Cho(..) + , Code + , Datum(..) + , Heap(..) + , Instr(..) + , Interp(..) + , emptyHeap + , emptyScope + ) import qualified Control.Monad.Trans.State.Lazy as St +import Env (PrlgEnv) --import Data.Function import qualified Data.Map as M diff --git a/app/Main.hs b/app/Main.hs index d394ee6..5f103f0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,7 +1,7 @@ module Main where import Frontend (interpreter) -import System.Console.Haskeline +import System.Console.Haskeline (defaultSettings, runInputT) main :: IO () main = runInputT defaultSettings interpreter diff --git a/app/Parser.hs b/app/Parser.hs index e710b75..a9e4473 100644 --- a/app/Parser.hs +++ b/app/Parser.hs @@ -8,14 +8,40 @@ module Parser import Control.Monad (void) import Data.Char + ( isAlpha + , isAlphaNum + , isMark + , isNumber + , isPunctuation + , isSpace + , isSymbol + ) import Data.List.NonEmpty (NonEmpty(..)) import Data.List.Split (splitOn) -import Data.Void +import Data.Void (Void) import Text.Megaparsec -import Text.Megaparsec.Char + ( Parsec + , PosState(..) + , SourcePos(..) + , TraversableStream(..) + , VisualStream(..) + , (<|>) + , choice + , eof + , many + , mkPos + , notFollowedBy + , oneOf + , satisfy + , single + , some + , try + , unPos + ) +import Text.Megaparsec.Char (string) import IR (PrlgStr(..)) -import Operators +import Operators (ArgKind(..), Fixity(..), Op(..), Ops) singleToks = ",;|()[]"