massive cleanup
This commit is contained in:
parent
58367975ae
commit
a26f0f29c0
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ->
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 = ",;|()[]"
|
||||
|
||||
|
|
Loading…
Reference in a new issue