diff options
| -rw-r--r-- | src/Helper.hs | 20 | ||||
| -rw-r--r-- | src/Parser.hs | 34 | ||||
| -rw-r--r-- | std/Float.bruijn | 19 | ||||
| -rw-r--r-- | std/Math/Rational.bruijn | 87 |
4 files changed, 140 insertions, 20 deletions
diff --git a/src/Helper.hs b/src/Helper.hs index 695d63f..3617cfc 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -20,6 +20,9 @@ import Data.Maybe ( fromMaybe , isNothing ) import GHC.Generics ( Generic ) +import GHC.Real ( denominator + , numerator + ) import Text.Megaparsec invalidProgramState :: a @@ -370,7 +373,7 @@ humanifyString :: Expression -> Maybe String humanifyString e = do es <- unlistify e str <- mapM binaryToChar' es - pure str + pure $ "\"" <> str <> "\"" humanifyPair :: Expression -> Maybe String humanifyPair e = do @@ -381,6 +384,21 @@ humanifyPair e = do --- +floatToRational :: Rational -> Expression +floatToRational f = Abstraction + (Application (Application (Bruijn 0) (decimalToTernary p)) + (decimalToTernary $ q - 1) + ) + where + p = numerator f + q = denominator f + +floatToReal :: Rational -> Expression +floatToReal f = Bruijn 0 + +floatToComplex :: Rational -> Expression +floatToComplex f = Bruijn 0 + -- Dec to Bal3 in Bruijn encoding: reversed application with 0=>0; 1=>1; T=>2; end=>3 -- e.g. 0=0=[[[[3]]]]; 2=1T=[[[[2 (1 3)]]]] -5=T11=[[[[1 (1 (2 3))]]]] decimalToTernary :: Integer -> Expression diff --git a/src/Parser.hs b/src/Parser.hs index 57d6f58..a63b4a2 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -8,6 +8,7 @@ import Control.Monad ( ap , void ) import Data.Void +import GHC.Real ( (%) ) import Helper import Text.Megaparsec hiding ( parseTest ) import Text.Megaparsec.Char @@ -135,6 +136,38 @@ parseNumeral = do number :: Parser Integer number = ap sign nat +-- parsed float a.b to rational p/q +convertToRational :: Integer -> Integer -> Rational +convertToRational a b = + let denominator :: Integer + denominator = 10 ^ length (show b) + numerator = b + a * denominator + common = gcd numerator denominator + in (numerator `div` common) % (denominator `div` common) + +parseFloat :: Parser Expression +parseFloat = do + _ <- string "(" <?> "float start" + num <- signedFloat <?> "signed float" + base <- try (oneOf "frc") <|> return 'f' + _ <- string ")" <?> "float end" + pure $ f base num + where + f 'f' = floatToRational + f 'r' = floatToReal + f 'c' = floatToComplex -- TODO: imaginary + f _ = invalidProgramState + sign :: Parser (Rational -> Rational) + sign = (char '-' >> return negate) <|> (char '+' >> return id) + float :: Parser Rational + float = do + a <- read <$> some digitChar <?> "digits" + _ <- char '.' <?> "float delimiter" + b <- read <$> some digitChar <?> "digits" + return $ convertToRational a b + signedFloat :: Parser Rational + signedFloat = ap sign float + specialEscape :: Parser Char specialEscape = choice (zipWith (\c r -> r <$ char c) "bnfrt\\\"/" "\b\n\f\r\t\\\"/") @@ -201,6 +234,7 @@ parseSingleton = let parseSingletonExpression = parseBruijn <|> try parseNumeral + <|> try parseFloat <|> parseString <|> try parseChar <|> parseQuote diff --git a/std/Float.bruijn b/std/Float.bruijn deleted file mode 100644 index c272d2b..0000000 --- a/std/Float.bruijn +++ /dev/null @@ -1,19 +0,0 @@ -# MIT License, Copyright (c) 2022 Marvin Borner -# Arbitrary-precision floating-point arithmetic implementation using -# (+3.14) = pair (+3) (+14) - -# This is completely WIP and only intended as a proof of concept - -:import std/Combinator . -:import std/Number . -:import std/Pair . - -pi (+3) : (+14159) - -# generates a float from a normal balanced ternary number -float! \…:… (+0) - -# adds two floating numbers -# TODO: Carry support -# - needed: mod, div (?) -> ternary carry != decimal carry -add zip-with …+… diff --git a/std/Math/Rational.bruijn b/std/Math/Rational.bruijn new file mode 100644 index 0000000..4c2f046 --- /dev/null +++ b/std/Math/Rational.bruijn @@ -0,0 +1,87 @@ +# ideas by u/DaVinci103 +# MIT License, Copyright (c) 2024 Marvin Borner + +# (p : q) ⇔ (1 / (q + 1)) + +:import std/Combinator . +:import std/Logic . +:import std/Pair . +:import std/Math N + +# returns true if two rational numbers are equal +eq? &[[&[[N.eq? (N.mul 3 N.++0) (N.mul N.++2 1)]]]] ⧗ Rational → Rational → Boolean + +…=?… eq? + +:test (((+1) : (+3)) =? ((+2) : (+7))) (true) +:test ((+0.5) =? (+0.5)) (true) +:test ((+42.0) =? (+42.0)) (true) +:test ((+0.4) =? (+0.5)) (false) + +# finds smallest equivalent representation of a rational number +compress &[[[(N.div 2 0) : N.--(N.div N.++1 0)] (N.gcd 1 N.++0)]] ⧗ Rational → Rational + +%‣ compress + +:test (%((+4) : (+1)) =? (+2.0)) (true) +:test (%((+4) : (+7)) =? (+0.5)) (true) + +# adds two rational numbers +add &[[&[[p : q]]]] ⧗ Rational → Rational → Rational + p N.add (N.mul 3 N.++0) (N.mul 1 N.++2) + q N.add (N.mul 2 0) (N.add 2 0) + +…+… add + +:test ((+0.5) + (+0.5) =? (+1.0)) (true) +:test ((+1.8) + (+1.2) =? (+3.0)) (true) +:test ((-1.8) + (+1.2) =? (-0.6)) (true) + +# subtracts two rational numbers +sub &[[&[[p : q]]]] ⧗ Rational → Rational → Rational + p N.sub (N.mul 3 N.++0) (N.mul 1 N.++2) + q N.add (N.mul 2 0) (N.add 2 0) + +…-… sub + +:test ((+0.5) - (+0.5) =? (+0.0)) (true) +:test ((+3.0) - (+1.8) =? (+1.2)) (true) +:test ((+1.8) - (-1.2) =? (+3.0)) (true) + +# negates a rational number +negate &[[N.-1 : 0]] ⧗ Rational → Rational + +-‣ negate + +:test (-(+0.0) =? (+0.0)) (true) +:test (-(+4.2) =? (-4.2)) (true) +:test (-(-4.2) =? (+4.2)) (true) + +# multiplies two rational numbers +mul &[[&[[p : q]]]] ⧗ Rational → Rational → Rational + p N.mul 3 1 + q N.add (N.mul 2 0) (N.add 2 0) + +…⋅… mul + +:test ((+5.0) ⋅ (+5.0) =? (+25.0)) (true) +:test ((+1.8) ⋅ (+1.2) =? (+2.16)) (true) + +# finds the multiplicative inverse of a rational number +invert &[[N.compare-case eq gt lt 1 (+0)]] ⧗ Rational → Rational + eq Ω + gt N.++0 : N.--1 + lt N.-(N.++0) : N.--(N.-1) + +~‣ invert + +:test (~(+0.5) =? (+2.0)) (true) +:test (~(-0.5) =? (-2.0)) (true) + +# divides two rational numbers +div [[1 ⋅ ~0]] ⧗ Rational → Rational → Rational + +…/… div + +:test ((+8.0) / (+4.0) =? (+2.0)) (true) +:test ((+18.0) / (+12.0) =? (+1.5)) (true) |