Make it actually work

elm-package.json

@@ -9,10 +9,12 @@
     "exposed-modules": [],
     "dependencies": {
         "Bogdanp/elm-combine": "3.1.1 <= v < 4.0.0",
-        "elm-community/ratio": "1.1.0 <= v < 2.0.0",
+        "elm-community/list-split": "1.0.2 <= v < 2.0.0",
         "elm-lang/core": "5.1.1 <= v < 6.0.0",
         "elm-lang/html": "2.0.0 <= v < 3.0.0",
+        "fiatjaf/hashbow-elm": "1.0.0 <= v < 2.0.0",
         "gilbertkennen/bigint": "1.0.1 <= v < 2.0.0",
+        "kintail/input-widget": "1.0.6 <= v < 2.0.0",
         "mgold/elm-nonempty-list": "3.1.0 <= v < 4.0.0"
     },
     "elm-version": "0.18.0 <= v < 0.19.0"

src/Eval.elm

@@ -1,25 +1,33 @@
 module Eval exposing (..)
 
 import Expr exposing (..)
-import Ratio exposing (Rational(..))
+import Numerics exposing (Rational(..))
 import Dict exposing (Dict(..))
-import List.Nonempty as Nonempty exposing (Nonempty(..))
+import Util exposing (..)
-import Stack exposing (..)
 
-type Error = MathematicalImpossibility | StackUnderflow Int | OpNotFound OpName
+type Error = MathematicalImpossibility | StackUnderflow Int | OpNotFound String | ParseError String
 
-type alias Partial = (OpName, List Value, Int)
+type alias Partial = (String, List Value, Int)
 
 type Value =
     Rational Rational | Partial Partial
 
-evalGroup : List Expr -> Result Error (List Value)
+type Context = Context (Dict String Op) Int
-evalGroup g =
+type alias Op = Context -> List Value -> Result Error (List Value)
-    List.foldl (\expr result -> Result.andThen (\stack -> evalRec expr stack) result) (Ok []) g
+
+getOps : Context -> Dict String Op
+getOps (Context o _) = o
+
+getFlopControl : Context -> Int
+getFlopControl (Context _ f) = f
+
+evalGroup : Context -> List Expr -> Result Error (List Value)
+evalGroup ctx g =
+    List.foldl (\expr result -> Result.andThen (\stack -> evalRec ctx expr stack) result) (Ok []) g
 
 -- If anything but a StackUnderflow results, just let it go through.
 -- If StackUnderflow occurs, convert it to Partial and push the Partial to stack.
-handleOpResult : OpName -> List Value -> Result Error (List Value) -> Result Error (List Value)
+handleOpResult : String -> List Value -> Result Error (List Value) -> Result Error (List Value)
 handleOpResult opname stack r =
     case r of
         Ok x -> r
@@ -30,63 +38,33 @@ handleOpResult opname stack r =
                     |> Ok
                 _ -> r
 
-evalRec : Expr -> List Value -> Result Error (List Value)
+runOp : Context -> String -> List Value -> Result Error (List Value)
-evalRec e s =
+runOp ctx name stack =
+    case Dict.get name (getOps ctx) of
+        Just opF ->
+            opF ctx stack
+            |> handleOpResult name stack
+        Nothing -> OpNotFound name |> Err
+
+evalRec : Context -> Expr -> List Value -> Result Error (List Value)
+evalRec ctx e s =
     case e of
-        Num x ->
+        Float x ->
-            Ratio.fromInt x
+            floatToRatio (getFlopControl ctx) x
+            |> Rational
+            |> \v -> v::s
+            |> Ok
+        Int x ->
+            Numerics.fromInt x
             |> Rational
             |> \v -> v::s
             |> Ok
         Group g ->
-            evalGroup g
+            evalGroup ctx g
             |> Result.map (\groupStack -> groupStack ++ s)
         Op o ->
-            case Dict.get o ops of
+            runOp ctx o s
-                Just opF ->
-                    opF s
-                    |> handleOpResult o s
-                Nothing -> OpNotFound o |> Err
 
-eval : Expr -> Result Error (List Value)
+eval : Context -> Expr -> Result Error (List Value)
-eval e =
+eval ctx e =
-    evalRec e []
+    evalRec ctx e []
-
-type alias Op = List Value -> Result Error (List Value)
-
-ops : Dict OpName Op
-ops = Dict.fromList [
-    ("/", binaryOp Ratio.divide),
-    ("+", binaryOp Ratio.add),
-    ("*", binaryOp Ratio.multiply),
-    ("-", binaryOp Ratio.subtract)
-    ]
-
-getNums : List Value -> Int -> Result Int (List Value, Nonempty Ratio.Rational)
-getNums stack qty = 
-    let selectRationals = Nonempty.map (\v -> case v of
-        Rational r -> r
-        _ -> Ratio.fromInt 0)
-    in 
-        Stack.pick (\v -> case v of
-            Rational r -> True
-            _ -> False) stack qty
-        |> Result.map (\(stack, nums) -> (stack, selectRationals nums))
-
-binaryOp : (Rational -> Rational -> Rational) -> Op
-binaryOp f stack =
-    getNums stack 2 
-    |> Result.mapError StackUnderflow
-    |> Debug.log "BINOP"
-    |> Result.map (\(stack, numbers) -> (f (Nonempty.get 0 numbers) (Nonempty.get 1 numbers) |> Rational)::stack)
-
-prettyPrintValue : Value -> String
-prettyPrintValue v = case v of
-    Rational r -> Ratio.toFloat r |> toString
-    Partial (op, stack, missing) -> String.join " " <| ["Partial:", op, "["] ++ List.map prettyPrintValue stack ++ ["]", toString missing]
-
-prettyPrintError : Error -> String
-prettyPrintError e = case e of
-    MathematicalImpossibility -> "Does not compute"
-    OpNotFound n -> String.concat ["Operator \"", n, "\" not found"]
-    StackUnderflow n -> String.join " " ["Stack underflowed by", toString n, "items"]

src/Expr.elm

@@ -1,20 +1,19 @@
-module Expr exposing (Expr(..), OpName, parse)
+module Expr exposing (Expr(..), parse)
 
 import Combine exposing (..)
 import Combine.Num as Num
-import Combine.Char as Char
+import BigInt exposing (..)
-
-type alias OpName = String
 
 type Expr 
-    = Num Int
+    = Float Float
-    | Op OpName
+    | Int BigInt
+    | Op String
     | Group (List Expr)
 
 num : Parser () Expr
 num =
-    (Num <$> Num.int)
+    (Float <$> Num.float) <|> (Int << Maybe.withDefault (BigInt.fromInt 0) << BigInt.fromString <$> regex "\\d+")
-    <?> "expected a number (int)"
+    <?> "expected a number (float or int)"
 
 acceptableOperatorName : Parser () String
 acceptableOperatorName =

src/Main.elm

@@ -3,56 +3,143 @@ module Main exposing (..)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
+import Kintail.InputWidget as Input
+import Hashbow
 
-import Expr exposing (Expr(..), OpName)
+import Expr exposing (Expr(..))
-import Eval exposing (eval)
+import Eval exposing (eval, Error(..), Value(..))
+import Ops exposing (calcOps, opDocs)
 
-import Ratio
+import Numerics
+import BigInt
+import Dict exposing (Dict(..))
 
 main = Html.beginnerProgram { model = model, update = update, view = view }
 
+type OutputConf = Float | FormattedRational
+
 type alias Model =
-    { result : Result String (List Eval.Value)
+    { result : Result Error (List Eval.Value)
     , expression : String
+    , outputSetting : OutputConf
+    , floatingPointControl : Float
     }
 
 model : Model
 model =
     { result = Ok []
     , expression = ""
+    , outputSetting = FormattedRational
+    , floatingPointControl = 6
     }
 
-type Msg = ExpressionTyped String
+type Msg = ExpressionTyped String | SwitchOutputConf OutputConf | AdjustFloatingPointControl Float
+
+-- Converts the slider input to an int suitable for use as the floating point accuracy/precision setting
+toFlopControl : Float -> Int
+toFlopControl f =
+    10 ^ f |> floor
 
 update : Msg -> Model -> Model
 update msg model =
     case msg of
         ExpressionTyped str ->
             Expr.parse ("(" ++ str ++ ")") -- wrap str in brackets so it's recognized as a group
-            |> Result.andThen (eval >> Result.mapError Eval.prettyPrintError)
+            |> Result.mapError ParseError
+            |> Result.andThen (eval (Eval.Context calcOps <| toFlopControl model.floatingPointControl))
             |> \r -> { model | result = r, expression = str }
+        SwitchOutputConf c ->
+            { model | outputSetting = c }
+        AdjustFloatingPointControl f ->
+            { model | floatingPointControl = f }
 
-error : String -> Html a
+-- Pretty-print an Error
+error : Error -> Html a
 error err =
-    div [class "error"] [text err]
+    let
+        prettyPrint e =
+            case e of
+                MathematicalImpossibility -> "Does not compute"
+                OpNotFound o -> String.join " " ["Operator not found: ", o]
+                StackUnderflow x -> String.join " " ["Stack underflowed by", toString x, "items"]
+                ParseError e -> String.join " " ["Parse error:", e]
+    in
+        div [class "error"] [text <| prettyPrint err]
 
-stackItem : Eval.Value -> Html a
+-- Renders a Value as an item in a stack
-stackItem n =
+stackItem : OutputConf -> Eval.Value -> Html a
-    let asString = Eval.prettyPrintValue n
+stackItem conf v =
-        minWidth = toString (String.length asString) ++ "em"
+    let
-    in div [class "item", style [("min-width", minWidth)]] [text asString]
+        anyText = toString >> text
+        bigintText = BigInt.toString >> text
+        center = List.singleton >> div [class "horizontal-center"]
+        displayFormattedRational r =
+            [ center <| bigintText <| Numerics.numerator r ] ++
+            if Numerics.denominator r /= BigInt.fromInt 1 then
+                [ hr [] []
+                , center <| bigintText <| Numerics.denominator r
+                ]
+            else []
+
+        inner = case v of
+            Rational r -> case conf of
+                FormattedRational -> [div [class "formatted-rational"] <| displayFormattedRational r]
+                Float -> [anyText <| Numerics.toFloat r]
+            Partial (op, stack, needs) -> 
+                [div [class "partial"]
+                    [ div [class "partial-op"] [text op]
+                    , div [class "partial-missing"] [text <| String.join " " ["Missing", toString needs, "values"]]
+                    , div [class "partial-stack"] <| List.map (stackItem conf) stack
+                    ]]
+    in
+        div [class "item"] inner
+
+-- The controls for number formatting
+formatControl : OutputConf -> Html OutputConf
+formatControl c =
+    let
+        radioButton txt msg = label [] [Input.radioButton [] msg c, text txt]
+    in
+        div []
+            [ radioButton "Rational (formatted)" FormattedRational
+            , br [] []
+            , radioButton "Decimal (via floating point, may break)" Float
+            ]
+
+floatingPointControl : Float -> Html Float
+floatingPointControl f =
+    let
+        slider = Input.slider [class "float-slider"] { min = 1, max = 12, step = 0.5 } f
+    in
+        label [class "float-slider-label"] [slider, text "Floating Point Accuracy/Precision Adjuster"]
+
+displayDocs : Dict String String -> List (Html a)
+displayDocs docs =
+    let
+        docsL = Dict.toList docs
+        entry (op, desc) = div [class "op"] 
+            [ span [class "op-name", style [("background-color", Hashbow.hashbow op)]] [text op]
+            , span [class "op-desc"] [text desc]
+            ]
+    in
+        List.map entry docsL
 
 view : Model -> Html Msg
 view model =
-    let calcOutput = 
+    let stack = 
         case model.result of
             Ok stack ->
                 List.reverse stack -- Puts first items at the top, for nicer looks
-                |> List.map stackItem
+                |> List.map (stackItem model.outputSetting)
             Err outputError ->
                 [error outputError]
     in div [class "rpncalc"] (
-        [ div [] calcOutput
+        [ div [class "stack"] stack
-        , input [onInput ExpressionTyped, value model.expression, class "exprinput"] []
+        , input [onInput ExpressionTyped, value model.expression, class "exprinput", autofocus True, placeholder "Expression"] []
+        , div [class "config-panel"] 
+            [ formatControl model.outputSetting |> Html.map SwitchOutputConf
+            , floatingPointControl model.floatingPointControl |> Html.map AdjustFloatingPointControl
+            ]
+        , div [class "docs"] (displayDocs Ops.opDocs)
         ]
     )

src/Numerics.elm

@@ -0,0 +1,337 @@
+module Numerics
+    exposing
+        ( gcd
+        , add
+        , subtract
+        , multiply
+        , multiplyByInt
+        , divide
+        , divideByInt
+        , divideIntBy
+        , negate
+        , invert
+        , Rational
+        , over
+        , denominator
+        , numerator
+        , split
+        , toFloat
+        , fromInt
+        , eq
+        , ne
+        , gt
+        , lt
+        , ge
+        , le
+        , compare
+        , max
+        , min
+        , isZero
+        , isInfinite
+        , round
+        , floor
+        , ceiling
+        , truncate
+        , bigintToFloat
+        )
+
+{-| A simple module providing a ratio type for rational numbers
+
+# Types
+@docs Rational
+
+# Construction
+@docs over, fromInt
+
+# Comparison
+@docs eq, ne, gt, lt, ge, le, max, min, compare
+
+# Mathematics
+@docs add, subtract, multiply, multiplyByInt
+@docs divide, divideByInt, divideIntBy, negate
+@docs isZero, isInfinite, round, floor, ceiling, truncate
+
+# Elimination
+@docs numerator, denominator, split
+
+# Utils
+@docs gcd, invert, toFloat
+
+-}
+
+import Basics exposing (..)
+import BigInt exposing (..)
+
+{-| "Arbitrary" (up to `max_int` size) precision fractional numbers. Think of
+    it as the length of a rigid bar that you've constructed from a bunch of
+    initial bars of the same fixed length
+    by the operations of gluing bars together and shrinking a
+    given bar so that an integer number of copies of it glues together to
+    make another given bar.
+
+-}
+type Rational
+    = Rational BigInt BigInt
+
+
+{-| The biggest number that divides both arguments (the greatest common divisor).
+-}
+gcd : BigInt -> BigInt -> BigInt
+gcd a b =
+    if b == BigInt.fromInt 0 then
+        a
+    else
+        gcd b (BigInt.mod a b)
+
+{- Normalisation of rationals with negative denominators
+
+   Rational 1 (-3) becomes Rational (-1) 3
+
+   Rational (-1) (-3) becomes Rational 1 3
+-}
+
+
+normalize (Rational p q) =
+    let
+        k = BigInt.mul
+            (gcd p q)
+                  (if BigInt.lt q (BigInt.fromInt 0) then
+                    BigInt.fromInt -1
+                   else
+                    BigInt.fromInt 1
+                  )
+    in
+        Rational (BigInt.div p k) (BigInt.div q k)
+
+
+
+{- Add or subtract two rationals :-
+   f can be (+) or (-)
+-}
+
+
+addsub : (BigInt -> BigInt -> BigInt) -> Rational -> Rational -> Rational
+addsub f (Rational a b) (Rational c d) =
+    normalize (Rational (f (BigInt.mul a d) (BigInt.mul b c)) (BigInt.mul b d))
+
+
+{-| Addition. It's like gluing together two bars of the given lengths.
+-}
+add : Rational -> Rational -> Rational
+add =
+    addsub BigInt.add
+
+
+{-| subtraction. Is it like ungluing two bars of the given lengths?
+-}
+subtract : Rational -> Rational -> Rational
+subtract =
+    addsub BigInt.sub
+
+
+{-| Mulitplication. `mulitply x (c / d)` is the length of the bar that you'd get
+    if you glued `c` copies of a bar of length `x` end-to-end and then shrunk it
+    down enough so that `d` copies of the shrunken bar would fit in the big
+    glued bar.
+-}
+multiply : Rational -> Rational -> Rational
+multiply (Rational a b) (Rational c d) =
+    normalize (Rational (BigInt.mul a c) (BigInt.mul b d))
+
+
+{-| Multiply a rational by an BigInt
+-}
+multiplyByInt : Rational -> BigInt -> Rational
+multiplyByInt (Rational a b) i =
+    normalize (Rational (BigInt.mul a i) b)
+
+
+{-| Divide two rationals
+-}
+divide : Rational -> Rational -> Rational
+divide r (Rational c d) =
+    multiply r (Rational d c)
+
+
+{-| Divide a rational by an BigInt
+-}
+divideByInt : Rational -> BigInt -> Rational
+divideByInt r i =
+    normalize (divide r (fromInt i))
+
+
+{-| Divide an BigInt by a rational
+-}
+divideIntBy : BigInt -> Rational -> Rational
+divideIntBy i r =
+    normalize (divide (fromInt i) r)
+
+
+
+{- This implementation gives the wrong precedence
+   divideByInt r i =
+     normalize (multiplyByInt (invert r) i)
+-}
+
+
+{-| multiplication by `-1`.
+-}
+negate : Rational -> Rational
+negate (Rational a b) =
+    Rational (BigInt.negate a) b
+
+
+{-| invert the rational. r becomes 1/r.
+-}
+invert : Rational -> Rational
+invert (Rational a b) =
+    normalize (Rational b a)
+
+
+{-| `over x y` is like `x / y`.
+-}
+over : BigInt -> BigInt -> Rational
+over x y =
+    if (BigInt.lt y <| BigInt.fromInt 0) then
+        normalize (Rational (BigInt.negate x) (BigInt.negate y))
+    else
+        normalize (Rational x y)
+
+
+{-| `fromInt x = over x 1`
+-}
+fromInt : BigInt -> Rational
+fromInt x =
+    over x (BigInt.fromInt 1)
+
+
+{-| -}
+numerator : Rational -> BigInt
+numerator (Rational a _) =
+    a
+
+
+{-| -}
+denominator : Rational -> BigInt
+denominator (Rational _ b) =
+    b
+
+
+{-| `split x = (numerator x, denominator x)`
+-}
+split : Rational -> ( BigInt, BigInt )
+split (Rational a b) =
+    ( a, b )
+
+bigintToFloat : BigInt -> Float
+bigintToFloat b =
+    let res = BigInt.toString b |> String.toInt
+    in case res of
+        Ok x -> Basics.toFloat x
+        Err e -> 0
+
+{-| -}
+toFloat : Rational -> Float
+toFloat (Rational a b) =
+    bigintToFloat a / bigintToFloat b
+
+
+{-| -}
+eq : Rational -> Rational -> Bool
+eq a b =
+    rel (==) a b
+
+
+{-| -}
+ne : Rational -> Rational -> Bool
+ne a b =
+    rel (/=) a b
+
+
+{-| -}
+gt : Rational -> Rational -> Bool
+gt a b =
+    rel BigInt.gt a b
+
+
+{-| -}
+lt : Rational -> Rational -> Bool
+lt a b =
+    rel BigInt.lt a b
+
+
+{-| -}
+ge : Rational -> Rational -> Bool
+ge a b =
+    rel BigInt.gte a b
+
+
+{-| -}
+le : Rational -> Rational -> Bool
+le a b =
+    rel BigInt.lte a b
+
+
+{-| -}
+compare : Rational -> Rational -> Order
+compare a b =
+    Basics.compare (toFloat a) (toFloat b)
+
+
+{-| -}
+max : Rational -> Rational -> Rational
+max a b =
+    if gt a b then
+        a
+    else
+        b
+
+
+{-| -}
+min : Rational -> Rational -> Rational
+min a b =
+    if lt a b then
+        a
+    else
+        b
+
+
+{-| -}
+isZero : Rational -> Bool
+isZero r =
+    (BigInt.fromInt 0) == (numerator r)
+
+
+{-| -}
+isInfinite : Rational -> Bool
+isInfinite r =
+    (BigInt.fromInt 0) == (denominator r)
+
+
+{-| -}
+round : Rational -> Int
+round =
+    toFloat >> Basics.round
+
+
+{-| -}
+floor : Rational -> Int
+floor =
+    toFloat >> Basics.floor
+
+
+{-| -}
+ceiling : Rational -> Int
+ceiling =
+    toFloat >> Basics.ceiling
+
+
+{-| -}
+truncate : Rational -> Int
+truncate =
+    toFloat >> Basics.truncate
+
+
+rel : (BigInt -> BigInt -> Bool) -> Rational -> Rational -> Bool
+rel relop a b =
+    relop (BigInt.mul (numerator a) (denominator b)) (BigInt.mul (numerator b) (denominator a))

src/Ops.elm

@@ -0,0 +1,169 @@
+module Ops exposing (calcOps, opDocs)
+
+import Numerics exposing (Rational(..))
+import Dict exposing (Dict(..))
+import List.Nonempty as Nonempty exposing (Nonempty(..))
+import Stack exposing (..)
+import Eval exposing (Partial, Value(..), Error(..), Op, evalRec, getOps, Context(..), getFlopControl)
+import Util exposing (..)
+import BigInt exposing (..)
+import List.Split as Split
+
+calcOps : Dict String Op
+calcOps = Dict.fromList 
+    [ ("/", binaryRationalOp Numerics.divide)
+    , ("+", binaryRationalOp Numerics.add)
+    , ("*", binaryRationalOp Numerics.multiply)
+    , ("-", binaryRationalOp Numerics.subtract)
+    , ("neg", unaryRationalOp Numerics.negate)
+    , ("inv", unaryRationalOp Numerics.invert)
+    , ("sqrt", unaryFloatOp sqrt)
+    , ("^", binaryFloatOp (^))
+    , ("nth", binaryFloatOp (\x y -> x ^ (1 / y)))
+    , ("constant.pi", floatConstant pi)
+    , ("constant.e", floatConstant e)
+    , ("constant.phi", floatConstant 1.618033988749894848204586834)
+    , ("run", runPartial)
+    , ("map", map)
+    , ("dup", duplicate)
+    , ("drp", drop)
+    , ("fld", fold)
+    , ("ran", range)
+    , ("y", y)
+    ]
+
+opDocs : Dict String String
+opDocs = Dict.fromList 
+    [ ("Partial (type)", "Generated when an op would otherwise stack-underflow; the op's name, a capture of the current stack, and the amount of values needed to evaluate.")
+    , ("Rational (type)", "Basically a fraction. These are used internally for almost all computation.")
+    , ("Floating Point Accuracy/Precision Adjuster", "This controls the balance between precision and accuracy with floating point conversion. If it is too high, big numbers run through floating-point functions or entered will produce crazy results.")
+    , ("+", "What do YOU think?")
+    , ("-", "Destroys the universe.")
+    , ("/", "Divides x by y.")
+    , ("*", "Multiplies x by y.")
+    , ("neg", "Negates x (-x).")
+    , ("inv", "Reciprocal (1 x /).")
+    , ("sqrt", "Square root (x 0.5 ^). Uses floats.")
+    , ("^", "Exponent (x to the power of y). Uses floats.")
+    , ("nth", "Y-th root of X (x y inv ^). Uses floats")
+    , ("constant.pi", "π, the ratio of a circle's circumference to its diameter.")
+    , ("constant.e", "Euler's constant, bizarrely common in lots of maths.")
+    , ("constant.phi", "The Golden Ratio (1 5 sqrt + 2 /) - also turns up a lot.")
+    , ("run", "Uses the current stack to attempt to evaluate a Partial.")
+    , ("map", "Runs a Partial over all other values in the stack.")
+    , ("dup", "Copies the top item on the stack.")
+    , ("drp", "Deletes the top item on the stack.")
+    , ("fld", "Works through the stack top-to-bottom, using a Partial to combine each value it encounters with its accumulator. It returns the accumulator when done.")
+    , ("ran", "Puts onto the stack all numbers between x and y - inclusive. Uses floats.")
+    ]
+
+getNums : List Value -> Int -> Result Error (List Value, Nonempty Numerics.Rational)
+getNums stack qty = 
+    let selectRationals = Nonempty.map (\v -> case v of
+        Rational r -> r
+        _ -> Numerics.fromInt <| BigInt.fromInt 0)
+    in 
+        Stack.pick (\v -> case v of
+            Rational r -> True
+            _ -> False) stack qty
+        |> Result.map (\(stack, nums) -> (stack, selectRationals nums))
+        |> Result.mapError StackUnderflow
+
+binaryOp : (Rational -> a) -> (a -> Rational) -> (a -> a -> a) -> Op
+binaryOp fromRat toRat f _ stack =
+    getNums stack 2 
+    |> Result.map (\(stack, numbers) -> (f (Nonempty.get 0 numbers |> fromRat) (Nonempty.get 1 numbers |> fromRat) |> toRat |> Rational)::stack)
+
+binaryRationalOp : (Rational -> Rational -> Rational) -> Op
+binaryRationalOp =
+    binaryOp identity identity
+
+binaryFloatOp : (Float -> Float -> Float) -> Op
+binaryFloatOp f ctx =
+    binaryOp Numerics.toFloat (floatToRatio (getFlopControl ctx)) f ctx
+
+unaryOp : (Rational -> a) -> (a -> Rational) -> (a -> a) -> Op
+unaryOp fromRat toRat f _ stack =
+    getNums stack 1
+    |> Result.map (\(stack, numbers) -> (f (Nonempty.head numbers |> fromRat) |> toRat |> Rational)::stack)
+
+unaryRationalOp : (Rational -> Rational) -> Op
+unaryRationalOp =
+    unaryOp identity identity
+
+unaryFloatOp : (Float -> Float) -> Op
+unaryFloatOp f ctx =
+    unaryOp Numerics.toFloat (floatToRatio (getFlopControl ctx)) f ctx
+
+constant : (a -> Rational) -> a -> Op
+constant conv x _ stack = (Rational (conv x))::stack |> Ok
+
+rationalConstant : Rational -> Op
+rationalConstant =
+    constant identity
+
+floatConstant : Float -> Op
+floatConstant x ctx = constant (floatToRatio (getFlopControl ctx)) x ctx
+
+filterPartial : Value -> Bool
+filterPartial v = case v of
+    Partial _ -> True
+    _ -> False
+
+partialFunction : (List Value -> Context -> Partial -> Result Error (List Value)) -> Op
+partialFunction f ctx stack =
+    Stack.pick filterPartial stack 1
+    |> \res -> case res of
+        Ok (stack, partial) -> case Nonempty.head partial of
+            Partial p ->
+                f stack ctx p
+            _ -> Ok stack
+        Err e -> StackUnderflow e |> Err
+
+runPartial : Op
+runPartial =
+    partialFunction (\stack ctx (op, capturedStack, _) -> Eval.runOp ctx op (capturedStack ++ stack))
+
+map : Op
+map =
+    partialFunction <| \stack ctx (op, captured, needs) ->
+        Split.chunksOfLeft needs stack
+        |> List.map (\args -> Eval.runOp ctx op (args ++ captured))
+        |> List.foldl (\output result -> case output of
+            Ok newStack -> Result.map (\s -> newStack ++ s) result
+            Err e -> Err e
+        ) (Ok [])
+
+duplicate : Op
+duplicate ctx stack =
+    List.head stack
+    |> Result.fromMaybe (StackUnderflow 1)
+    |> Result.map (\head -> head::stack)
+
+drop : Op
+drop ctx stack =
+    Stack.pop stack
+    |> Result.fromMaybe (StackUnderflow 1)
+    |> Result.map (\(head, stack) -> stack)
+
+fold : Op
+fold = 
+    partialFunction <| \stack ctx (op, captured, needs) ->
+        Stack.pop stack
+        |> Result.fromMaybe (StackUnderflow 1)
+        |> Result.andThen (\(start, newStack) ->
+            List.foldl (\x res -> Result.andThen (\accStack -> Eval.runOp ctx op (x::accStack)) res) (Ok [start]) newStack)
+
+range : Op
+range ctx stack =
+    let
+        get ix v = Nonempty.get ix v |> Numerics.floor
+    in
+        getNums stack 2
+        |> Result.map (
+            \(newStack, values) -> List.range (get 0 values) (get 1 values) |> List.map (BigInt.fromInt >> Numerics.fromInt >> Rational))
+
+y : Op
+y =
+    partialFunction <| \stack ctx (op, captured, needs) ->
+        Eval.runOp ctx op (Partial ("y", [Partial (op, captured, needs)], 1)::stack)

src/Stack.elm

@@ -20,4 +20,8 @@ pick pred stack qty =
             |> Result.fromMaybe qty
             |> Result.map (\v -> (newStack, v))
         else
-            Err <| qty - num
+            Err <| qty - num
+
+pop : List a -> Maybe (a, List a)
+pop l = 
+    List.head l |> Maybe.map (\h -> (h, List.tail l |> Maybe.withDefault []))

src/Util.elm

@@ -0,0 +1,11 @@
+module Util exposing (..)
+
+import Numerics exposing (Rational(..))
+import BigInt exposing (BigInt(..))
+
+floatToRatio : Int -> Float -> Rational
+floatToRatio accuracy f =
+    let
+        acc = BigInt.fromInt accuracy
+    in
+        Numerics.over (f * Numerics.bigintToFloat acc |> floor |> BigInt.fromInt) acc

style.css

@@ -6,8 +6,8 @@
 }
 
 .item {
-    width: 10vw;
+    min-width: 10em;
-    height: 10vw;
+    min-height: 10em;
     border: 1px solid black;
     margin-top: -1px;
     display: flex;
@@ -15,8 +15,78 @@
     align-items: center;
 }
 
+.float-slider {
+    border: 1px solid lightgray;
+    margin-left: 0.2em;
+    margin-right: 0.2em;
+}
+
+.float-slider-label {
+    display: flex;
+    align-items: center;
+}
+
+.partial {
+    text-align: center;
+    padding: 1em;
+}
+
+.horizontal-center {
+    display: flex;
+    justify-content: center;
+}
+
+.partial-stack {
+    font-size: 0.8em;
+    padding: 1em;
+}
+
+.formatted-rational {
+    width: 33%;
+}
+
+hr {
+    width: 100%;
+}
+
 .exprinput {
     margin-top: 1vh;
     width: 100%;
     font-size: 1.2em;
+}
+
+.config-panel {
+    background: lightgray;
+    padding: 1em;
+    margin-top: 1em;
+}
+
+.docs {
+    text-align: left;
+    width: 100%;
+    display: flex;
+    justify-content: space-around;
+    margin-top: 3em;
+    flex-wrap: wrap;
+}
+
+.op {
+    background: #8cb7c6;
+    display: flex;
+    align-items: center;
+    margin: 1em;
+    max-width: 40vw;
+}
+
+.op-desc {
+    padding: 1em;
+}
+
+.op-name {
+    height: 100%;
+    display: flex;
+    align-items: center;
+    justify-content: center;
+    padding-left: 1em;
+    padding-right: 1em;
 }