Add range op

This commit is contained in:
osmarks 2017-08-18 14:18:26 +01:00
parent c988be4fe4
commit 8c10af72a4
2 changed files with 32 additions and 11 deletions

View File

@ -9,6 +9,7 @@ type Op
| Multiply | Multiply
| Divide | Divide
| Exponent | Exponent
| Range
type Expr type Expr
= Num Float = Num Float
@ -31,6 +32,7 @@ op =
<|> stringIs "*" Multiply <|> stringIs "*" Multiply
<|> stringIs "/" Divide <|> stringIs "/" Divide
<|> stringIs "^" Exponent <|> stringIs "^" Exponent
<|> stringIs "range" Range
|> map Op |> map Op
group : Parser () Expr group : Parser () Expr

View File

@ -55,20 +55,35 @@ view model =
] ++ calcOutput ] ++ calcOutput
) )
-- Run a binary operation on a stack - returns updated stack or an error listToStack : List a -> Stack a
binOp : (Float -> Float -> Float) -> Stack Float -> Result String (Stack Float) listToStack =
binOp f s = List.foldr Stack.push Stack.initialise
let (maybeX, s1) = Stack.pop s
(maybeY, s2) = Stack.pop s1 prependList : List a -> Stack a -> Stack a
maybeXY = Maybe.map2 (,) maybeX maybeY prependList from to =
result = Maybe.map (\(x, y) -> f y x) maybeXY -- x and y swapped round - this makes "5 1 /" become 5 instead of 0.2. List.foldr Stack.push to from
finalStack = Maybe.map (\r -> Stack.push r s2) result
in Result.fromMaybe "Stack underflow" finalStack
prepend : Stack a -> Stack a -> Stack a prepend : Stack a -> Stack a -> Stack a
prepend from to = prepend from to =
Stack.toList from prependList (Stack.toList from) to
|> List.foldr Stack.push to
type alias StackFunction = Stack Float -> Result String (Stack Float)
-- Runs a binary operation which returns a list on a stack
binListOutOp : (Float -> Float -> List Float) -> StackFunction
binListOutOp f s =
let
(maybeX, s1) = Stack.pop s
(maybeY, s2) = Stack.pop s1
in Maybe.map2 (,) maybeX maybeY
|> Maybe.map (\(x, y) -> f y x) -- x and y swapped round - this makes "5 1 /" become 5 instead of 0.2.
|> Maybe.map (\r -> prependList r s2)
|> Result.fromMaybe "Stack underflow"
-- Runs a binary operation on a stack
binOp : (Float -> Float -> Float) -> StackFunction
binOp f =
binListOutOp (\x y -> f x y |> List.singleton)
evalRec : Expr -> Stack Float -> Result String (Stack Float) evalRec : Expr -> Stack Float -> Result String (Stack Float)
evalRec expr s = evalRec expr s =
@ -85,6 +100,10 @@ evalRec expr s =
Multiply -> binOp (*) s Multiply -> binOp (*) s
Divide -> binOp (/) s Divide -> binOp (/) s
Exponent -> binOp (^) s Exponent -> binOp (^) s
Range ->
binListOutOp (\x y ->
List.range (floor x) (floor y)
|> List.map toFloat) s
eval : Expr -> Result (List String) (List Float) eval : Expr -> Result (List String) (List Float)
eval e = eval e =