73 lines
2.5 KiB
Haskell
73 lines
2.5 KiB
Haskell
module Nix.Eval where
|
|
|
|
import Control.Applicative
|
|
import Control.Arrow
|
|
import Control.Monad hiding (forM_, mapM, sequence)
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Text as T
|
|
import Data.Traversable
|
|
import Nix.Types
|
|
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
|
|
sequence)
|
|
|
|
buildArgument :: NValue -> NValue -> NValue
|
|
buildArgument paramSpec arg =
|
|
-- Having the typed lambda calculus would make this code much safer.
|
|
Fix $ NVSet $ case paramSpec of
|
|
Fix (NVArgSet s) ->
|
|
case arg of
|
|
Fix (NVSet s') ->
|
|
Map.foldlWithKey' (go s') Map.empty s
|
|
_ -> error "Unexpected function environment"
|
|
Fix (NVConstant (NSym name)) -> Map.singleton name arg
|
|
_ -> error $ "Unexpected param spec: " ++ show paramSpec
|
|
where
|
|
go env m k v = case Map.lookup k env of
|
|
Nothing
|
|
| Just v' <- v -> Map.insert k v' m
|
|
| otherwise -> error $ "Could not find " ++ show k
|
|
Just v' -> Map.insert k v' m
|
|
|
|
evalExpr :: NExpr -> NValue -> IO NValue
|
|
evalExpr = cata phi
|
|
where
|
|
phi :: NExprF (NValue -> IO NValue) -> NValue -> IO NValue
|
|
phi (NConstant x) = const $ return $ Fix $ NVConstant x
|
|
|
|
phi (NList l) = \env ->
|
|
Fix . NVList <$> mapM ($ env) l
|
|
|
|
phi (NConcat l) = \env ->
|
|
Fix . NVConstant . NStr . T.concat
|
|
<$> mapM (fmap valueText . ($ env)) l
|
|
|
|
phi (NArgSet _xs) = error "Cannot evaluate an argument set"
|
|
|
|
phi (NSet _b xs) = \env ->
|
|
Fix . NVSet . Map.fromList
|
|
<$> mapM (fmap (first valueText) . go env) xs
|
|
where
|
|
go env (x, y) = liftM2 (,) (x env) (y env)
|
|
|
|
phi (NLet _v _e) = error "let: not implemented"
|
|
phi (NIf _i _t _e) = error "if: not implemented"
|
|
phi (NWith _c _v) = error "with: not implemented"
|
|
phi (NAssert _e _v) = error "assert: not implemented"
|
|
phi (NVar _v) = error "var: not implemented"
|
|
|
|
phi (NApp fun x) = \env -> do
|
|
fun' <- fun env
|
|
case fun' of
|
|
Fix (NVFunction argset f) -> do
|
|
arg <- x env
|
|
let arg' = buildArgument argset arg
|
|
f arg'
|
|
_ -> error "Attempt to call non-function"
|
|
|
|
phi (NAbs a b) = \env -> do
|
|
-- jww (2014-06-28): arglists should not receive the current
|
|
-- environment, but rather should recursively view their own arg
|
|
-- set
|
|
args <- a env
|
|
return $ Fix $ NVFunction args b
|