Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
PoorScript Interpleter (Extensible Effects version)
module Main where
import Control.Alt
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Aff
import Control.Monad.Eff.Exception
import Control.Monad.Aff.Console (log, logShow)
import Control.Lazy (fix)
import Control.Monad.ST
import Control.Monad.Eff.Class
import Data.Int
import Data.Either
import Data.Identity
import Data.List (List(Nil, Cons), (:), many)
import Data.Traversable
import Data.Map (Map, fromFoldable, lookup, empty, insert)
import Data.Tuple
import Data.Maybe (maybe)
import Node.FS.Aff
import Node.FS
import Node.Encoding
import Prelude
import Text.Parsing.Parser
import Text.Parsing.Parser.Language
import Text.Parsing.Parser.Token (GenTokenParser, makeTokenParser)
import Text.Parsing.Parser.String
import Text.Parsing.Parser.Combinators (sepBy1)
-- Syntax tree
data Expression = Boolean Boolean
| Number Number
| String String
| List (List Expression)
| Assignment String Expression
instance eq_Expression :: Eq Expression where
eq (Boolean x) (Boolean y) = x == y
eq (Number x) (Number y) = x == y
eq (String x) (String y) = x == y
eq (List xs) (List ys) = xs == ys
eq _ _ = false
instance show_Expression :: Show Expression where
show (Boolean x) = show x
show (Number x) = show x
show (String x) = show x
show (List xs) = show xs
show (Assignment key value) = key <> "=" <> show value
-- parser
lexer :: GenTokenParser String Identity
lexer = makeTokenParser emptyDef
program :: Parser String Expression
program = lexer.whiteSpace *> expression <* eof
where
sign = (char '-' *> pure negate) <|> (char '+' *> pure id) <|> pure id
number = Number <$> (sign <*> (either toNumber id <$> lexer.naturalOrFloat))
string = String <$> lexer.stringLiteral
list expression = List <$> lexer.brackets (sepBy1 expression lexer.comma)
assignment expression = Assignment <$> lexer.identifier <*> (lexer.symbol "=" *> expression)
expression = fix \expression -> string <|> number <|> list expression <|> assignment expression
-- evaluator
newtype State h = State {
operators :: Map String (STRef h (State h) -> List Expression -> Eff (err :: EXCEPTION, st :: ST h) Expression),
variables :: Map String Expression
}
eval :: forall h . STRef h (State h) -> Expression -> Eff (err :: EXCEPTION, st :: ST h) Expression
eval ref = go
where
go :: Expression -> Eff (err :: EXCEPTION, st :: ST h) Expression
go (Number n) = pure (Number n)
go (String s) = pure (String s)
go (Boolean b) = pure (Boolean b)
go (List (String op : args)) = do
State st <- readSTRef ref
maybe (throw ("Unknown operator: " <> op)) (\f -> f ref args) (lookup op st.operators)
go (Assignment key value) = do
value' <- go value
modifySTRef ref \(State s) -> State s { variables = insert key value' s.variables }
pure value'
go _ = throw "Invalid expression"
operators :: forall h . Map String (STRef h (State h) -> List Expression -> Eff (st :: ST h, err :: EXCEPTION) Expression)
operators = fromFoldable [
Tuple "+" $ fromOp (+),
Tuple "-" $ fromOp (-),
Tuple "*" $ fromOp (*),
Tuple "/" $ fromOp (/),
Tuple "=" \ref args -> case args of
x : xs -> do
x' <- eval ref x
xs' <- for xs (eval ref)
pure $ Boolean $ all ((==) x') xs'
_ -> throw "Invalid args in =",
Tuple "set" \ref args -> case args of
key : value : _ -> do
key' <- eval ref key
case key' of
String key'' -> do
value' <- eval ref value
modifySTRef ref \(State s) -> State s { variables = insert key'' value' s.variables }
pure value'
_ -> throw "the key is not a string"
_ -> throw "Invalid args",
Tuple "get" \ref args -> case args of
String k : Nil -> do
State state <- readSTRef ref
maybe (throw "No Variable") pure (lookup k state.variables)
_ -> throw "Invalid args",
Tuple "until" \ref args -> case args of
cond: body: _ -> let go retVal = do
c <- eval ref cond
case c of
Boolean b | not b -> do
eval ref body
go retVal
Boolean b | b -> pure retVal
_ -> throw "Invalid args in until"
in go (Boolean false)
_ -> throw "Invalid args in until",
Tuple "step" \ref args -> case args of
x: xs -> foldl (*>) (eval ref x) (eval ref <$> xs)
_ -> throw "too few args"
]
where
fromOp :: forall h . (Number -> Number -> Number) -> STRef h (State h) -> List Expression -> Eff (st :: ST h, err :: EXCEPTION) Expression
fromOp f ref Nil = throw "Too few args"
fromOp f ref (x : xs) = do
x' <- evalNum ref x
xs' <- for xs (evalNum ref)
pure $ Number $ foldl f x' xs'
evalNum :: forall h . STRef h (State h) -> Expression -> Eff (st :: ST h, err :: EXCEPTION) Number
evalNum ref n = do
n' <- eval ref n
case n' of
Number n -> pure n
_ -> throw "The Argument is not a number"
main :: Eff (fs :: FS, console :: CONSOLE, err :: EXCEPTION) Unit
main = void $ launchAff do
files <- readdir "test"
for files \file -> do
source <- readTextFile UTF8 ("test/" <> file)
case runParser source program of
Left err -> log $ file <> ": Syntax Error " <> show err
Right program -> do
let result = pureST do
ref <- newSTRef (State { operators, variables: empty })
try (eval ref program)
case result of
Right value -> log $ file <> ": " <> show value
Left err -> log $ file <> ": " <> show err
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment