Make div dispatch on value types

This commit is contained in:
John Wiegley 2018-04-28 15:01:12 -07:00
parent d0b5ccde77
commit 3b304561f7
3 changed files with 14 additions and 1 deletions

View file

@ -134,7 +134,7 @@ builtinsList = sequence [
)
, add TopLevel "derivationStrict" derivationStrict_
, add TopLevel "dirOf" dirOf
, add' Normal "div" (arity2 (div @Integer))
, add2 Normal "div" div_
, add2 Normal "elem" elem_
, add2 Normal "elemAt" elemAt_
, add Normal "fetchTarball" fetchTarball
@ -272,6 +272,16 @@ unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of
length_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
length_ = toValue . (length :: [NThunk m] -> Int) <=< fromValue
div_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
div_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
(NVConstant (NInt x), NVConstant (NInt y)) ->
toNix (floor (fromInteger x / fromInteger y :: Double) :: Integer)
(NVConstant (NFloat x), NVConstant (NInt y)) -> toNix (x / fromInteger y)
(NVConstant (NInt x), NVConstant (NFloat y)) -> toNix (fromInteger x / y)
(NVConstant (NFloat x), NVConstant (NFloat y)) -> toNix (x / y)
(_, _) ->
throwError $ Division x' y'
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM _ [] = return False
anyM p (x:xs) = do

View file

@ -123,6 +123,8 @@ renderValueFrame :: (MonadReader e m, Has e Options, MonadFile m)
renderValueFrame level = pure . (:[]) . \case
ForcingThunk -> text "ForcingThunk"
ConcerningValue _v -> text "ConcerningValue"
Comparison _ _ -> text "Comparing"
Division _ _ -> text "Dividing"
Coercion x y ->
text desc <> text (describeValue x)

View file

@ -317,6 +317,7 @@ data ValueFrame m
= ForcingThunk
| ConcerningValue (NValue m)
| Comparison (NValue m) (NValue m)
| Division (NValue m) (NValue m)
| Coercion ValueType ValueType
| CoercionToJsonNF (NValueNF m)
| CoercionFromJson A.Value