[ MIRROR ] An interpreter for a Lisp-like language git.ngill.net/nls.git
Something went wrong. Try again.
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394{-# LANGUAGE OverloadedStrings #-}
module Util ( aToRValue, rToAValue, lookupEnv, define, defineUnchecked, undefine, mergeFrame, mapAccumM, extendEnv, reduceEnv, extractParam, pureWithEnv, )where
import qualified Data.Map as Mimport qualified Data.Text as Timport Types
-- directly convert a AST value to a runtime valueaToRValue :: NlsAstValue -> NlsRunValueaToRValue (ANumber n) = RNumber naToRValue (AString s) = RString saToRValue (ASymbol s) = RSymbol saToRValue (AList xs) = RList (map aToRValue xs)
-- convert a runtime value to an AST valuerToAValue :: NlsRunValue -> Either T.Text NlsAstValuerToAValue (RSymbol s) = pure $ ASymbol srToAValue (RNumber n) = pure $ ANumber nrToAValue (RString s) = pure $ AString srToAValue (RBool True) = pure $ ASymbol "true"rToAValue (RBool False) = pure $ ASymbol "false"rToAValue (RList xs) = AList <$> mapM rToAValue xsrToAValue (RFunction _) = Left "cannot eval a function"rToAValue (RModule _) = Left "cannot eval a module"rToAValue RUnit = Left "cannot eval an empty unit"
-- lookup a key recursively in an environmentlookupEnv :: String -> Env -> Maybe NlsThunklookupEnv key env = case M.lookup key (frame env) of Just v -> Just v Nothing -> parent env >>= lookupEnv key
-- define a binding in the current environmentdefine :: String -> NlsThunk -> Env -> Either T.Text Envdefine key val env = case M.lookup key (frame env) of Just _ -> Left ("cannot shadow binding " <> T.pack key <> " in current frame") Nothing -> Right env {frame = M.insert key val (frame env)}
-- define without checking shadow rulesdefineUnchecked :: String -> NlsThunk -> Env -> EnvdefineUnchecked key val env = env {frame = M.insert key val (frame env)}
-- remove a binding from the current frameundefine :: String -> Env -> Either T.Text Envundefine key env = case M.lookup key (frame env) of Just _ -> Right env {frame = M.delete key (frame env)} Nothing -> Left ("binding " <> T.pack key <> " not found in current frame")
-- merge a frame into an environmentmergeFrame :: Frame -> Env -> EnvmergeFrame f env = env {frame = M.union f (frame env)}
mapAccumM :: (Monad m) => (acc -> x -> m (y, acc)) -> acc -> [x] -> m ([y], acc)mapAccumM _ acc [] = pure ([], acc)mapAccumM f acc (x : xs) = do (y, acc') <- f acc x (ys, acc'') <- mapAccumM f acc' xs pure (y : ys, acc'')
-- extend environment into a new frameextendEnv :: Env -> EnvextendEnv env = Env {frame = M.empty, parent = Just env}
-- drop the current frame, returning to old environmentreduceEnv :: Env -> Maybe EnvreduceEnv env = do p <- parent env pure p
extractParam :: NlsAstValue -> Eval StringextractParam (ASymbol s) = Right sextractParam _ = Left "lambda parameter is not a symbol"
pureWithEnv :: NlsRunValue -> Env -> Eval (NlsRunValue, Env)pureWithEnv val env = pure (val, env)