From 2502b1adb0243eb61b156920a6df389c3f883ac4 Mon Sep 17 00:00:00 2001
From: Marvin Borner
Date: Tue, 26 Jul 2022 13:52:10 +0200
Subject: Stupidity
---
src/Eval.hs | 78 ++++++++++++++++++++++++++++++++++++-------------------------
1 file changed, 46 insertions(+), 32 deletions(-)
(limited to 'src/Eval.hs')
diff --git a/src/Eval.hs b/src/Eval.hs
index 23c388e..c9c784e 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -8,6 +8,7 @@ import Control.Monad.State
import qualified Control.Monad.State.Strict as StrictState
import qualified Data.BitString as Bit
import qualified Data.ByteString as Byte
+import Data.Either
import Data.List
import Debug.Trace
import Helper
@@ -48,42 +49,55 @@ loadFile path = do
Right file ->
eval (filter (not . null) $ split "\n\n" file) (EnvState []) False
-evalVar :: String -> Program (Failable Expression)
-evalVar var = state $ \e ->
- ( case lookup var (map fst e) of
- Nothing -> Left $ UndeclaredFunction var
- Just x -> Right x
- , e
- )
-
-evalApp :: Expression -> Expression -> Program (Failable Expression)
-evalApp f g =
- evalExp f
+-- TODO: Add subdefs ([Program (Failable Expression)]) to State somehow
+evalVar
+ :: String -> [Program (Failable Expression)] -> Program (Failable Expression)
+evalVar var sub = state $ \e ->
+ let find name env = case lookup name env of
+ Nothing -> Left $ UndeclaredFunction var
+ Just x -> Right x
+ -- search in sub env
+ subs = map (\s -> let (res, env') = s `runState` e in find var env') sub
+ in case rights subs of
+ (head : rst) -> (Right head, e)
+ _ -> (find var e, e) -- search in global env
+
+evalApp
+ :: Expression
+ -> Expression
+ -> [Program (Failable Expression)]
+ -> Program (Failable Expression)
+evalApp f g sub =
+ evalExp f sub
>>= (\case
Left e -> pure $ Left e
- Right f' -> fmap (Application f') <$> evalExp g
+ Right f' -> fmap (Application f') <$> evalExp g sub
)
-evalExp :: Expression -> Program (Failable Expression)
-evalExp idx@(Bruijn _ ) = pure $ Right idx
-evalExp ( Variable var) = evalVar var
-evalExp ( Abstraction exp) = evalExp exp >>= pure . fmap Abstraction
-evalExp ( Application f g) = evalApp f g
+evalExp
+ :: Expression
+ -> [Program (Failable Expression)]
+ -> Program (Failable Expression)
+evalExp idx@(Bruijn _ ) _ = pure $ Right idx
+evalExp ( Variable var) sub = evalVar var sub
+evalExp ( Abstraction exp) sub = evalExp exp sub >>= pure . fmap Abstraction
+evalExp ( Application f g) sub = evalApp f g sub
evalDefine :: String -> Expression -> [EnvDef] -> Program (Failable Expression)
evalDefine name exp sub =
- evalExp exp
- >>= (\case
- Left e -> pure $ Left e
- Right f -> modify (((name, f), sub) :) >> pure (Right f)
- )
+ let sub' = fmap (\(name, exp) -> evalDefine name exp []) sub
+ in evalExp exp sub'
+ >>= (\case
+ Left e -> pure $ Left e
+ Right f -> modify ((name, f) :) >> pure (Right f)
+ )
evalTest :: Expression -> Expression -> Program (Failable Instruction)
evalTest exp1 exp2 =
- evalExp exp1
+ evalExp exp1 []
>>= (\case
Left exp1 -> pure $ Left exp1
- Right exp1 -> fmap (Test exp1) <$> evalExp exp2
+ Right exp1 -> fmap (Test exp1) <$> evalExp exp2 []
)
eval :: [String] -> EnvState -> Bool -> IO EnvState
@@ -95,8 +109,8 @@ eval (block : bs) state@(EnvState env) isRepl =
Left err -> putStrLn (errorBundlePretty err) >> eval bs state isRepl
Right instr -> case instr of
Define name exp sub ->
- -- TODO: sub: [Instruction] -> [EnvDef] (rec-mapping or sth?)
- let (res, env') = evalDefine name exp [] `runState` env
+ let subenv = [ (name, exp) | (Define name exp _) <- sub ]
+ (res, env') = evalDefine name exp subenv `runState` env
in case res of
Left err ->
putStrLn (show err) >> eval bs (EnvState env') isRepl
@@ -113,10 +127,10 @@ eval (block : bs) state@(EnvState env) isRepl =
let prefix | null namespace = takeBaseName path ++ "."
| namespace == "." = ""
| otherwise = namespace ++ "."
- env' <- pure $ map (\((n, e), s) -> ((prefix ++ n, e), s)) env'
+ env' <- pure $ map (\(n, e) -> (prefix ++ n, e)) env'
eval bs (EnvState $ env <> env') False -- import => isRepl = False
Evaluate exp ->
- let (res, env') = evalExp exp `runState` env
+ let (res, env') = evalExp exp [] `runState` env
in
putStrLn
(case res of
@@ -153,12 +167,12 @@ eval (block : bs) state@(EnvState env) isRepl =
evalFunc :: String -> Environment -> Maybe Expression
evalFunc func env = do
- exp <- lookup func $ map fst env
+ exp <- lookup func env
pure $ reduce exp
evalMainFunc :: Environment -> Expression -> Maybe Expression
evalMainFunc env arg = do
- exp <- lookup "main" $ map fst env
+ exp <- lookup "main" env
pure $ reduce $ Application exp arg
evalFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO ()
@@ -192,8 +206,8 @@ repl state =
lookupCompletion :: String -> M [Completion]
lookupCompletion str = do
(EnvState env) <- StrictState.get
- return $ map (\((s, _), _) -> Completion s s False) $ filter
- (\((s, _), _) -> str `isPrefixOf` s)
+ return $ map (\(s, _) -> Completion s s False) $ filter
+ (\(s, _) -> str `isPrefixOf` s)
env
completionSettings :: String -> Settings M
--
cgit v1.2.3