added function evaluation + equal
This commit is contained in:
parent
acf3becf62
commit
2dace09a0d
2 changed files with 33 additions and 20 deletions
|
@ -17,31 +17,39 @@ import qualified Lish.InternalCommands as InternalCommands
|
|||
import Lish.Types hiding (show)
|
||||
|
||||
-- | The main evaluation function
|
||||
-- TODO: its real type should be something isomorphic to
|
||||
-- its real type should be something isomorphic to
|
||||
-- (SExp,Environment) -> IO (SExp, Environment)
|
||||
reduceLambda :: SExp -> StateT Env IO SExp
|
||||
reduceLambda (Lambda (expr:exprs)) = do
|
||||
reduced <- reduceLambda expr
|
||||
env <- get
|
||||
liftIO $ print env
|
||||
liftIO $ print reduced
|
||||
liftIO $ print exprs
|
||||
case reduced of
|
||||
Atom f -> do
|
||||
resultInternal <- tryInternalCommand f exprs
|
||||
case resultInternal of
|
||||
Just x -> return x
|
||||
Nothing -> do
|
||||
resultEnv <- tryEnvCommand f exprs
|
||||
case resultEnv of
|
||||
Just x -> return x
|
||||
redred <- reduceLambda reduced
|
||||
if redred /= reduced
|
||||
then reduceLambda (Lambda (reduced:exprs))
|
||||
else do
|
||||
-- DEBUG --env <- get
|
||||
-- DEBUG --liftIO $ do
|
||||
-- DEBUG -- putText "Lambda:"
|
||||
-- DEBUG -- print $ (expr:exprs)
|
||||
-- DEBUG -- putText "Env:"
|
||||
-- DEBUG -- print env
|
||||
-- DEBUG -- putText "Reduced Head:"
|
||||
-- DEBUG -- print reduced
|
||||
case reduced of
|
||||
Atom f -> do
|
||||
resultInternal <- tryInternalCommand f exprs
|
||||
case resultInternal of
|
||||
Just x -> return x
|
||||
Nothing -> do
|
||||
reducedArgs <- mapM reduceLambda exprs
|
||||
executeShell (Lambda ((Atom f):reducedArgs))
|
||||
f@(Fn _ _ _) -> applyFn f exprs
|
||||
s -> do
|
||||
reducedArgs <- mapM reduceLambda exprs
|
||||
executeShell (Lambda (s:reducedArgs))
|
||||
resultEnv <- tryEnvCommand f exprs
|
||||
case resultEnv of
|
||||
Just x -> return x
|
||||
Nothing -> do
|
||||
reducedArgs <- mapM reduceLambda exprs
|
||||
executeShell (Lambda ((Atom f):reducedArgs))
|
||||
f@(Fn _ _ _) -> applyFn f exprs
|
||||
s -> do
|
||||
reducedArgs <- mapM reduceLambda exprs
|
||||
executeShell (Lambda (s:reducedArgs))
|
||||
reduceLambda (Atom x) = do
|
||||
env <- get
|
||||
case Map.lookup x env of
|
||||
|
|
|
@ -101,6 +101,10 @@ toWaitingStream :: ReduceUnawareCommand
|
|||
toWaitingStream (Stream (Just h) :[]) = return (WaitingStream (Just h))
|
||||
toWaitingStream _ = return Void
|
||||
|
||||
equal :: ReduceUnawareCommand
|
||||
equal (x:y:[]) = return (Bool (x == y))
|
||||
equal args = evalErr $ "= need two args, got" <> (toS (show args))
|
||||
|
||||
toStrictCmd :: ReduceUnawareCommand -> Command
|
||||
toStrictCmd f reducer sexps = do
|
||||
reduced <- mapM reducer sexps
|
||||
|
@ -140,6 +144,7 @@ strictCommands = [ ("prn", prn)
|
|||
, ("$",getenv)
|
||||
, ("str",str)
|
||||
, ("atom",atom)
|
||||
, ("=",equal)
|
||||
-- binary operators
|
||||
, ("+",binop (+))
|
||||
, ("-",binop (-))
|
||||
|
|
Loading…
Reference in a new issue