diff --git a/phino.cabal b/phino.cabal --- a/phino.cabal +++ b/phino.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: phino -version: 0.0.0.38 +version: 0.0.0.39 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at diff --git a/src/Dataize.hs b/src/Dataize.hs --- a/src/Dataize.hs +++ b/src/Dataize.hs @@ -153,9 +153,6 @@ Just morphed -> dataize' morphed prog _ -> pure Nothing -toDouble :: Integer -> Double -toDouble = fromIntegral - atom :: String -> Expression -> DataizeContext -> IO (Maybe Expression) atom "L_org_eolang_number_plus" self ctx = do left <- dataize' (ExDispatch self (AtLabel "x")) ctx diff --git a/src/Functions.hs b/src/Functions.hs --- a/src/Functions.hs +++ b/src/Functions.hs @@ -11,6 +11,7 @@ import Control.Monad (replicateM, when) import qualified Data.ByteString.Char8 as B import Data.Char (intToDigit) +import Data.Functor import Data.Set (Set) import qualified Data.Set import GHC.IO (unsafePerformIO) @@ -26,7 +27,7 @@ import Text.Printf (printf) import qualified Yaml as Y -buildTerm :: String -> [Y.ExtraArgument] -> Subst -> Program -> IO Term +buildTerm :: BuildTermFunc buildTerm "contextualize" = _contextualize buildTerm "scope" = _scope buildTerm "random-tau" = _randomTau @@ -38,31 +39,36 @@ buildTerm "tau" = _tau buildTerm "string" = _string buildTerm "number" = _number -buildTerm func = _unsupported func +buildTerm "sum" = _sum +buildTerm func = _unsupported func -argToStrBytes :: Y.ExtraArgument -> Subst -> Program -> IO String -argToStrBytes (Y.ArgBytes bytes) subst _ = do - bts <- buildBytesThrows bytes subst - pure (btsToUnescapedStr bts) -argToStrBytes (Y.ArgExpression expr) subst prog = do +argToBytes :: Y.ExtraArgument -> Subst -> Program -> IO Bytes +argToBytes (Y.ArgBytes bytes) subst _ = buildBytesThrows bytes subst +argToBytes (Y.ArgExpression expr) subst prog = do (TeBytes bts) <- _dataize [Y.ArgExpression expr] subst prog - pure (btsToUnescapedStr bts) -argToStrBytes arg _ _ = throwIO (userError (printf "Can't extract bytes from given argument: %s" (prettyExtraArg arg))) + pure bts +argToBytes arg _ _ = throwIO (userError (printf "Can't extract bytes from given argument: %s" (prettyExtraArg arg))) -_contextualize :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +argToString :: Y.ExtraArgument -> Subst -> Program -> IO String +argToString arg subst prog = argToBytes arg subst prog <&> btsToUnescapedStr + +argToNumber :: Y.ExtraArgument -> Subst -> Program -> IO Double +argToNumber arg subst prog = argToBytes arg subst prog <&> either toDouble id . btsToNum + +_contextualize :: BuildTermMethod _contextualize [Y.ArgExpression expr, Y.ArgExpression context] subst prog = do (expr', _) <- buildExpressionThrows expr subst (context', _) <- buildExpressionThrows context subst pure (TeExpression (contextualize expr' context' prog)) _contextualize _ _ _ = throwIO (userError "Function contextualize() requires exactly 2 arguments as expression") -_scope :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_scope :: BuildTermMethod _scope [Y.ArgExpression expr] subst _ = do (_, scope) <- buildExpressionThrows expr subst pure (TeExpression scope) _scope _ _ _ = throwIO (userError "Function scope() requires exactly 1 argument as expression") -_randomTau :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_randomTau :: BuildTermMethod _randomTau args subst _ = do attrs <- argsToAttrs args tau <- randomTau attrs @@ -95,7 +101,7 @@ tau <- randomString "a🌵%d" if tau `elem` attrs then randomTau attrs else pure tau -_dataize :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_dataize :: BuildTermMethod _dataize [Y.ArgBytes bytes] subst _ = do bts <- buildBytesThrows bytes subst pure (TeBytes bts) @@ -106,18 +112,18 @@ _ -> throwIO (userError "Only data objects and bytes are supported by 'dataize' function now") _dataize _ _ _ = throwIO (userError "Function dataize() requires exactly 1 argument as expression or bytes") -_concat :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_concat :: BuildTermMethod _concat args subst prog = do - args' <- traverse (\arg -> argToStrBytes arg subst prog) args + args' <- traverse (\arg -> argToString arg subst prog) args pure (TeExpression (DataString (strToBts (concat args')))) -_sed :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_sed :: BuildTermMethod _sed args subst prog = do when (length args < 2) (throwIO (userError "Function sed() requires at least two arguments")) args' <- traverse ( \arg -> do - bts <- argToStrBytes arg subst prog + bts <- argToString arg subst prog pure (B.pack bts) ) args @@ -156,27 +162,27 @@ | h == '/' -> (acc, rest) | otherwise -> nextUntilSlash rest (B.snoc acc h) escape -_randomString :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_randomString :: BuildTermMethod _randomString [arg] subst prog = do - pat <- argToStrBytes arg subst prog + pat <- argToString arg subst prog str <- randomString pat pure (TeExpression (DataString (strToBts str))) _randomString _ _ _ = throwIO (userError "Function random-string() requires exactly 1 dataizable argument") -_size :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_size :: BuildTermMethod _size [Y.ArgBinding (BiMeta meta)] subst _ = do bds <- buildBindingThrows (BiMeta meta) subst pure (TeExpression (DataNumber (numToBts (fromIntegral (length bds))))) _size _ _ _ = throwIO (userError "Function size() requires exactly 1 meta binding") -_tau :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_tau :: BuildTermMethod _tau [Y.ArgExpression expr] subst prog = do TeBytes bts <- _dataize [Y.ArgExpression expr] subst prog attr <- parseAttributeThrows (btsToUnescapedStr bts) pure (TeAttribute attr) _tau _ _ _ = throwIO (userError "Function tau() requires exactly 1 argument as expression") -_string :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_string :: BuildTermMethod _string [Y.ArgExpression expr] subst _ = do (expr', _) <- buildExpressionThrows expr subst str <- case expr' of @@ -196,7 +202,7 @@ pure (TeExpression (DataString (strToBts (prettyAttribute attr')))) _string _ _ _ = throwIO (userError "Function string() requires exactly 1 argument as attribute or data expression (Φ̇.number or Φ̇.string)") -_number :: [Y.ExtraArgument] -> Subst -> Program -> IO Term +_number :: BuildTermMethod _number [Y.ArgExpression expr] subst _ = do (expr', _) <- buildExpressionThrows expr subst case expr' of @@ -206,5 +212,10 @@ _ -> throwIO (userError (printf "Function number() expects expression to be 'Φ̇.string', but got:\n%s" (prettyExpression' expr'))) _number _ _ _ = throwIO (userError "Function number() requires exactly 1 argument as 'Φ̇.string'") -_unsupported :: String -> [Y.ExtraArgument] -> Subst -> Program -> IO Term +_sum :: BuildTermMethod +_sum args subst prog = do + nums <- traverse (\arg -> argToNumber arg subst prog) args + pure (TeExpression (DataNumber (numToBts (sum nums)))) + +_unsupported :: BuildTermFunc _unsupported func _ _ _ = throwIO (userError (printf "Function %s() is not supported or does not exist" func)) diff --git a/src/Misc.hs b/src/Misc.hs --- a/src/Misc.hs +++ b/src/Misc.hs @@ -18,6 +18,7 @@ allPathsIn, ensuredFile, shuffle, + toDouble, btsToUnescapedStr, pattern DataObject, pattern DataString, @@ -134,6 +135,11 @@ else return [path] ) return (concat paths) + +-- >>> toDouble 5 +-- 5.0 +toDouble :: Integer -> Double +toDouble = fromIntegral -- >>> btsToWord8 BtEmpty -- [] diff --git a/src/Term.hs b/src/Term.hs --- a/src/Term.hs +++ b/src/Term.hs @@ -15,4 +15,6 @@ data Term = TeExpression Expression | TeAttribute Attribute | TeBytes Bytes -type BuildTermFunc = String -> [ExtraArgument] -> Subst -> Program -> IO Term +type BuildTermMethod = [ExtraArgument] -> Subst -> Program -> IO Term + +type BuildTermFunc = String -> BuildTermMethod diff --git a/src/Yaml.hs b/src/Yaml.hs --- a/src/Yaml.hs +++ b/src/Yaml.hs @@ -169,6 +169,7 @@ data Rule = Rule { name :: Maybe String, + description :: Maybe String, pattern :: Expression, result :: Expression, when :: Maybe Condition,