| | 51 | |
| | 52 | op1Min :: Val -> Eval Val |
| | 53 | op1Min v = op1MinMax (== False) v |
| | 54 | |
| | 55 | op1Max :: Val -> Eval Val |
| | 56 | op1Max v = op1MinMax (== True) v |
| | 57 | |
| | 58 | -- min_or_max is a function which negates truth/falsehood. |
| | 59 | -- This is necessary as op1MinMax should cope with min() as well as max(). |
| | 60 | op1MinMax :: (Bool -> Bool) -> Val -> Eval Val |
| | 61 | op1MinMax min_or_max v = do |
| | 62 | -- We want to have a real Haskell list |
| | 63 | args <- fromVal v |
| | 64 | -- Extract our comparator sub, or Nothing if none was specified |
| | 65 | (valList, cmp) <- case args of |
| | 66 | (v:vs) -> do |
| | 67 | ifValTypeIsa v "Code" |
| | 68 | (return (vs, Just v)) |
| | 69 | (ifValTypeIsa (last args) "Code" |
| | 70 | (return (init args, Just $ last args)) |
| | 71 | (return (args, Nothing))) |
| | 72 | _ -> return (args, Nothing) |
| | 73 | -- Now let our helper function do the rest |
| | 74 | op1MinMax' min_or_max cmp valList |
| | 75 | where |
| | 76 | op1MinMax' :: (Bool -> Bool) -> (Maybe Val) -> [Val] -> Eval Val |
| | 77 | -- The min or max of an empty list is undef. |
| | 78 | op1MinMax' _ _ [] = return undef |
| | 79 | -- We have to supply our own comparator... |
| | 80 | op1MinMax' _ Nothing valList = foldM default_compare (head valList) valList |
| | 81 | -- or use the one of the user |
| | 82 | op1MinMax' min_or_max (Just subVal) valList = do |
| | 83 | sub <- fromVal subVal |
| | 84 | evl <- asks envEval |
| | 85 | -- Here we execute the user's sub |
| | 86 | foldM (\a b -> do |
| | 87 | rv <- local (\e -> e{ envContext = cxtItem "Int" }) $ do |
| | 88 | evl (App (Val sub) [Val a, Val b] []) |
| | 89 | int <- fromVal rv |
| | 90 | -- If the return value from the sub was |
| | 91 | -- -1 ==> a < b |
| | 92 | -- 0 ==> a == b |
| | 93 | -- +1 ==> a > b |
| | 94 | -- We call min_or_max so we can work for both min() and max(). |
| | 95 | return $ if min_or_max (int > (0::VInt)) then a else b) (head valList) valList |
| | 96 | -- This is the default comparision function, which will be used if the user |
| | 97 | -- hasn't specified a own comparision function. |
| | 98 | default_compare a b = do |
| | 99 | a' <- vCastRat a |
| | 100 | b' <- vCastRat b |
| | 101 | let cmp = if a' < b' then (-1) else if a' == b' then 0 else 1 |
| | 102 | return $ if min_or_max (cmp > (0::VInt)) then a else b |
