diff --git a/.github/workflows/ghc.yml b/.github/workflows/ghc.yml index 42eee0293..9b8b86911 100644 --- a/.github/workflows/ghc.yml +++ b/.github/workflows/ghc.yml @@ -55,7 +55,6 @@ jobs: pattern: | eo-phi-normalizer/**/*.hs !${{ env.syntax-dir }}/**/*.hs - !eo-phi-normalizer/Setup.hs - uses: haskell-actions/hlint-setup@v2 @@ -105,10 +104,6 @@ jobs: submodules: true ref: ${{ github.ref }} - - name: Set codepage on Windows - if: ${{ runner.os == 'Windows' }} - run: chcp 65001 - - name: Restore Syntax files id: restore-syntax-files uses: actions/cache/restore@v4 @@ -163,10 +158,6 @@ jobs: submodules: true ref: ${{ github.ref }} - - name: Set codepage on Windows - if: ${{ runner.os == 'Windows' }} - run: chcp 65001 - - name: Restore Syntax files id: restore-syntax-files uses: actions/cache/restore@v4 diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 11ed4b22a..40dc8acd6 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -25,5 +25,4 @@ repos: exclude: | (?x)^( eo-phi-normalizer/src/Language/EO/Phi/Syntax/| - eo-phi-normalizer/Setup.hs - ) \ No newline at end of file + ) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 9eba55712..1340524ae 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -14,6 +14,10 @@ Check open issues ([link](https://github.com/objectionary/eo-phi-normalizer/issu ## Enter the repository + + + + Clone and enter the project repository. ```sh @@ -21,6 +25,8 @@ git clone https://github.com/objectionary/eo-phi-normalizer --recurse-submodules cd eo-phi-normalizer ``` + + ## Install stack We recommend using [stack](https://docs.haskellstack.org/en/stable) for quick local development and testing. diff --git a/eo-phi-normalizer/Setup.hs b/eo-phi-normalizer/Setup.hs index f3577e176..93243d2c9 100644 --- a/eo-phi-normalizer/Setup.hs +++ b/eo-phi-normalizer/Setup.hs @@ -21,7 +21,9 @@ -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -- SOFTWARE. {- FOURMOLU_ENABLE -} -{-# LANGUAGE CPP #-} + +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -- Source: https://github.com/haskell/cabal/issues/6726#issuecomment-918663262 @@ -30,65 +32,77 @@ -- for the parsers included in Ogma. module Main (main) where +import Control.Exception (Handler (..), SomeException, catches, displayException, evaluate) +import Data.ByteString as BS (readFile, writeFile) import Data.List (intercalate) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Distribution.Simple (defaultMainWithHooks, hookedPrograms, postConf, preBuild, simpleUserHooks) import Distribution.Simple.Program (Program (..), findProgramVersion, simpleProgram) +import Main.Utf8 (withUtf8) import PyF (fmt) -import System.Exit (ExitCode (..)) +import System.Exit (ExitCode (..), exitWith) +import System.IO.CodePage (withCP65001) import System.Process (callCommand) -import Text.Printf (printf) -import Control.Exception (evaluate) + +readFile' :: FilePath -> IO Text +readFile' = (decodeUtf8 <$>) . BS.readFile + +writeFile' :: FilePath -> Text -> IO () +writeFile' path = BS.writeFile path . encodeUtf8 + +withCorrectLocale :: IO a -> IO a +withCorrectLocale act = do + let withCorrectLocale' = withCP65001 . withUtf8 + withCorrectLocale' act + `catches` [ Handler $ \(x :: ExitCode) -> exitWith x + , Handler $ \(x :: SomeException) -> + withCorrectLocale' do + putStrLn (displayException x) + exitWith (ExitFailure 1) + ] -- | Run BNFC, happy, and alex on the grammar before the actual build step. -- -- All options for bnfc are hard-coded here. main :: IO () main = - defaultMainWithHooks $ - simpleUserHooks - { hookedPrograms = [bnfcProgram] - , postConf = \args flags packageDesc localBuildInfo -> do - let - isWindows = -#ifdef mingw32_HOST_OS - True -#else - False -#endif - -- See the details on the command form in https://github.com/objectionary/eo-phi-normalizer/issues/347#issuecomment-2117097070 - addLicense :: FilePath -> IO () - addLicense file = do - let readFile' path = do - content <- readFile path - evaluate (length content) - pure content - targetFile = "src/Language/EO/Phi/Syntax/" <> file - license <- readFile' "LICENSE" - let licenseFormatted = printf "{-\n%s-}\n\n" license - code <- readFile' targetFile - evaluate (length license) - writeFile targetFile (licenseFormatted <> code) - - command = intercalate "; " $ - [ "set -ex" ] <> - [ "chcp.com" | isWindows ] <> - [ "chcp.com 65001" | isWindows ] <> - [ "bnfc --haskell -d -p Language.EO.Phi --generic -o src/ grammar/EO/Phi/Syntax.cf"] <> - [ "cd src/Language/EO/Phi/Syntax" ] <> - [ "alex Lex.x" ] <> - [ "happy Par.y" ] <> - [ "true" ] - - fullCommand = [fmt|bash -c ' {command} '|] - - putStrLn fullCommand - - _ <- callCommand fullCommand - _ <- addLicense "Abs.hs" - _ <- addLicense "Print.hs" - - postConf simpleUserHooks args flags packageDesc localBuildInfo - } + withCorrectLocale $ + defaultMainWithHooks $ + simpleUserHooks + { hookedPrograms = [bnfcProgram] + , postConf = \args flags packageDesc localBuildInfo -> do + let + addLicense :: FilePath -> IO () + addLicense file = do + let targetFile = "src/Language/EO/Phi/Syntax/" <> file + license <- readFile' "LICENSE" + let licenseFormatted = [fmt|{{-\n{license}-}}\n\n|] :: Text + code <- readFile' targetFile + writeFile' targetFile (licenseFormatted <> code) + + -- See the details on the command form in https://github.com/objectionary/eo-phi-normalizer/issues/347#issuecomment-2117097070 + command = + intercalate + "; " + [ "set -ex" + , "bnfc --haskell -d -p Language.EO.Phi --generic -o src/ grammar/EO/Phi/Syntax.cf" + , "cd src/Language/EO/Phi/Syntax" + , "alex Lex.x" + , "happy Par.y" + , "true" + ] + + fullCommand = [fmt|bash -c ' {command} '|] + + putStrLn fullCommand + + _ <- callCommand fullCommand + _ <- addLicense "Abs.hs" + _ <- addLicense "Print.hs" + + postConf simpleUserHooks args flags packageDesc localBuildInfo + } -- | NOTE: This should be in Cabal.Distribution.Simple.Program.Builtin. bnfcProgram :: Program diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs index b03b81483..8d77f7106 100644 --- a/eo-phi-normalizer/app/Main.hs +++ b/eo-phi-normalizer/app/Main.hs @@ -51,7 +51,7 @@ module Main (main) where -import Control.Exception (Exception (..), SomeException, catch, throw) +import Control.Exception (Exception (..), SomeException, catch, throwIO) import Control.Lens.Lens ((&)) import Control.Lens.Operators ((?~)) import Control.Monad (forM, unless, when) @@ -63,9 +63,11 @@ import Data.List (intercalate, isPrefixOf) import Data.Maybe (fromMaybe) import Data.Text.Internal.Builder (toLazyText) import Data.Text.Lazy as TL (unpack) +import Data.Text.Lazy.Manipulate (toOrdinal) import Data.Version (showVersion) import Data.Yaml (decodeFileThrow, decodeThrow) import GHC.Generics (Generic) +import Language.EO.Locale (withCorrectLocale) import Language.EO.Phi (Binding (..), Bytes (Bytes), Object (..), Program (Program), parseProgram, printTree) import Language.EO.Phi.Dataize import Language.EO.Phi.Dataize.Context @@ -84,7 +86,6 @@ import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRuleNamed, par import Language.EO.Phi.Syntax (desugar, wrapBytesInBytes, wrapTermination) import Language.EO.Phi.ToLaTeX import Language.EO.Test.YamlSpec (spec) -import Main.Utf8 import Options.Applicative hiding (metavar) import Options.Applicative qualified as Optparse (metavar) import Paths_eo_phi_normalizer (version) @@ -470,14 +471,14 @@ getFile = \case Just file' -> doesFileExist file' >>= \case True -> pure (Just file') - False -> throw $ FileDoesNotExist file' + False -> throwIO $ FileDoesNotExist file' getProgram :: Maybe FilePath -> IO Program getProgram inputFile = do inputFile' <- getFile inputFile - src <- maybe getContents' readFile inputFile' `catch` (throw . CouldNotRead . show @SomeException) + src <- maybe getContents' readFile inputFile' `catch` (throwIO . CouldNotRead . show @SomeException) case parseProgram src of - Left err -> throw $ CouldNotParse err + Left err -> throwIO $ CouldNotParse err Right program -> pure program getLoggers :: Maybe FilePath -> IO (String -> IO (), String -> IO ()) @@ -514,7 +515,7 @@ getMetrics' program bindingsPath = do getMetrics :: Maybe String -> Maybe FilePath -> IO ProgramMetrics getMetrics bindingsPath inputFile = do program <- getProgram inputFile - either throw pure (getMetrics' program bindingsPath) + either throwIO pure (getMetrics' program bindingsPath) injectLamdbaPackage :: [Binding] -> [Binding] injectLamdbaPackage bs @@ -570,7 +571,7 @@ wrapRawBytesIn = \case -- * Main main :: IO () -main = withUtf8 do +main = withCorrectLocale do opts <- customExecParser pprefs (cliOpts (showVersion version)) let printAsProgramOrAsObject = \case Formation bindings' -> printTree $ Program bindings' @@ -601,9 +602,9 @@ main = withUtf8 do Nothing -> do ruleSet :: RuleSet <- decodeThrow $(embedFileRelative "test/eo/phi/rules/new.yaml") return (False, ruleSet.title, convertRuleNamed <$> ruleSet.rules) - unless (single || json || (chain && latex)) $ logStrLn ruleSetTitle + unless (single || json || latex) $ logStrLn ruleSetTitle bindingsWithDeps <- case deepMergePrograms (program' : deps) of - Left err -> throw (CouldNotMergeDependencies err) + Left err -> throwIO (CouldNotMergeDependencies err) Right (Program bindingsWithDeps) -> return bindingsWithDeps let Program bindings = program' uniqueResults @@ -615,7 +616,24 @@ main = withUtf8 do limits = ApplicationLimits maxDepth (maxGrowthFactor * objectSize (Formation bindings)) ctx = (defaultContext rules (Formation bindingsWithDeps)){builtinRules = builtin} -- IMPORTANT: context contains dependencies! totalResults = length uniqueResults - when (null uniqueResults || null (head uniqueResults)) (throw CouldNotNormalize) + inLatexDocument :: IO () -> IO () + inLatexDocument logContent = do + logStrLn + [fmtTrim| + % {ruleSetTitle} + + \\documentclass{{article}} + \\usepackage{{eolang}} + \\begin{{document}} + |] + logContent + logStrLn "\n\\end{document}" + inPhiEquation :: String -> IO () + inPhiEquation phiExpr = do + logStrLn "\\begin{phiquation*}" + logStrLn [fmtTrim|{phiExpr}|] + logStrLn "\\end{phiquation*}" + when (null uniqueResults || null (head uniqueResults)) (throwIO CouldNotNormalize) if | single && json -> logStrLn @@ -634,25 +652,29 @@ main = withUtf8 do { input = printTree program' , output = (logEntryToPair . fmap printAsProgramOrAsObject <$>) <$> uniqueResults } - | chain && latex -> do - logStrLn - [fmtTrim| - % {ruleSetTitle} - - \\documentclass{{article}} - \\usepackage{{eolang}} - \\begin{{document}} - |] - forM_ uniqueResults $ \steps -> do + | chain && latex -> inLatexDocument $ do + forM_ (zip [1 ..] uniqueResults) $ \(index, steps) -> do let latexLines = toLatexString (Formation bindings) : (toLatexString . (.logEntryLog) <$> steps) transitions :: [String] = ((\x -> [fmt| \\trans_{{\\rulename{{{logEntryMessage x}}}}} \n|]) <$> steps) <> ["."] - linesCombined :: String = fold $ zipWith (\latexLine transition -> [fmt|{latexLine}{transition}|]) latexLines transitions - logStrLn "\\begin{phiquation*}" - logStrLn [fmtTrim|{linesCombined}|] - logStrLn "\\end{phiquation*}" - logStrLn "\n\\end{document}" + trailingTransitions :: [String] = "" : repeat [fmt| \\trans |] + linesCombined :: String = + fold $ + zipWith3 + ( \trailingTrans latexLine transition -> + [fmt|{trailingTrans}{latexLine}{transition}|] + ) + trailingTransitions + latexLines + transitions + unless (length uniqueResults == 1) $ + logStrLn + [fmt|\nThis is the {unpack (toOrdinal index)} possible chain of normalizing rewritings:\n|] + inPhiEquation linesCombined | latex -> - logStrLn . toLatexString $ logEntryLog (head (head uniqueResults)) + inLatexDocument $ + inPhiEquation $ + toLatexString $ + logEntryLog (head (head uniqueResults)) | otherwise -> do logStrLn "Input:" logStrLn (printTree program') @@ -672,7 +694,7 @@ main = withUtf8 do program' <- getProgram inputFile deps <- mapM (getProgram . Just) dependencies bindingsWithDeps <- case deepMergePrograms (program' : deps) of - Left err -> throw (CouldNotMergeDependencies err) + Left err -> throwIO (CouldNotMergeDependencies err) Right (Program bindingsWithDeps) -> return bindingsWithDeps (builtin, _ruleSetTitle, rules) <- case rulesPath of diff --git a/eo-phi-normalizer/eo-phi-normalizer.cabal b/eo-phi-normalizer/eo-phi-normalizer.cabal index 5c9df3b0b..943255baf 100644 --- a/eo-phi-normalizer/eo-phi-normalizer.cabal +++ b/eo-phi-normalizer/eo-phi-normalizer.cabal @@ -202,10 +202,15 @@ custom-setup Cabal >=2.4.0.1 && <4.0 , PyF , base >=4.11.0.0 && <5.0 + , bytestring + , code-page , process >=1.6.3.0 + , text + , with-utf8 library exposed-modules: + Language.EO.Locale Language.EO.Phi Language.EO.Phi.Dataize Language.EO.Phi.Dataize.Atoms @@ -255,6 +260,7 @@ library , blaze-markup , bytestring , cereal + , code-page , containers , directory , file-embed >=0.0.16.0 @@ -269,7 +275,9 @@ library , scientific , template-haskell , text + , text-manipulate , unordered-containers + , with-utf8 , yaml default-language: Haskell2010 @@ -297,6 +305,7 @@ executable eo-phi-normalizer , blaze-markup , bytestring , cereal + , code-page , containers , directory , eo-phi-normalizer @@ -313,6 +322,7 @@ executable eo-phi-normalizer , scientific , template-haskell , text + , text-manipulate , unordered-containers , with-utf8 , yaml @@ -322,6 +332,7 @@ test-suite doctests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: + Language.EO.Locale Language.EO.Phi Language.EO.Phi.Dataize Language.EO.Phi.Dataize.Atoms @@ -371,6 +382,7 @@ test-suite doctests , blaze-markup , bytestring , cereal + , code-page , containers , directory , doctest-parallel @@ -387,7 +399,9 @@ test-suite doctests , scientific , template-haskell , text + , text-manipulate , unordered-containers + , with-utf8 , yaml default-language: Haskell2010 @@ -423,6 +437,7 @@ test-suite spec , blaze-markup , bytestring , cereal + , code-page , containers , directory , eo-phi-normalizer @@ -439,6 +454,7 @@ test-suite spec , scientific , template-haskell , text + , text-manipulate , unordered-containers , with-utf8 , yaml diff --git a/eo-phi-normalizer/package.yaml b/eo-phi-normalizer/package.yaml index cf6209ac8..10b1dee07 100644 --- a/eo-phi-normalizer/package.yaml +++ b/eo-phi-normalizer/package.yaml @@ -53,8 +53,12 @@ custom-setup: dependencies: - base >= 4.11.0.0 && < 5.0 - Cabal >= 2.4.0.1 && < 4.0 + - code-page - process >= 1.6.3.0 + - text - PyF + - bytestring + - with-utf8 build-tools: alex: ">= 3.2.4" @@ -76,6 +80,7 @@ dependencies: - hspec-core - text - template-haskell + - text-manipulate - blaze-html - blaze-markup - scientific @@ -86,6 +91,8 @@ dependencies: - hashable - unordered-containers - containers + - code-page + - with-utf8 default-extensions: - ImportQualifiedPost @@ -122,7 +129,6 @@ executables: - -rtsopts - -with-rtsopts=-N dependencies: - - with-utf8 - eo-phi-normalizer - optparse-applicative - aeson-pretty @@ -137,7 +143,6 @@ tests: - -with-rtsopts=-N dependencies: - eo-phi-normalizer - - with-utf8 - hspec - hspec-discover - QuickCheck diff --git a/eo-phi-normalizer/src/Language/EO/Locale.hs b/eo-phi-normalizer/src/Language/EO/Locale.hs new file mode 100644 index 000000000..071229f15 --- /dev/null +++ b/eo-phi-normalizer/src/Language/EO/Locale.hs @@ -0,0 +1,43 @@ +{- FOURMOLU_DISABLE -} +-- The MIT License (MIT) + +-- Copyright (c) 2016-2024 Objectionary.com + +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: + +-- The above copyright notice and this permission notice shall be included +-- in all copies or substantial portions of the Software. + +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +{- FOURMOLU_ENABLE -} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Language.EO.Locale where + +import Control.Exception (Exception (..), Handler (..), SomeException, catches) +import Main.Utf8 (withUtf8) +import System.Exit (ExitCode (..), exitWith) +import System.IO.CodePage (withCP65001) + +withCorrectLocale :: IO a -> IO a +withCorrectLocale act = do + let withCorrectLocale' = withCP65001 . withUtf8 + withCorrectLocale' act + `catches` [ Handler $ \(x :: ExitCode) -> exitWith x + , Handler $ \(x :: SomeException) -> + withCorrectLocale' do + putStrLn (displayException x) + exitWith (ExitFailure 1) + ] diff --git a/eo-phi-normalizer/src/Language/EO/Phi.hs b/eo-phi-normalizer/src/Language/EO/Phi.hs index e055a36c2..055295d44 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi.hs @@ -36,13 +36,12 @@ import Language.EO.Phi.Syntax.Abs qualified as Phi import Language.EO.Phi.Syntax.Par qualified as Phi import Language.EO.Phi.Normalize +import Language.EO.Phi.Rules.Common (parseWith) import Language.EO.Phi.Syntax -- | Parse a 'Program' or return a parsing error. parseProgram :: String -> Either String Phi.Program -parseProgram input = Phi.pProgram tokens - where - tokens = Phi.myLexer input +parseProgram = parseWith Phi.pProgram -- | Parse an 'Object' or return a parsing error. parseObject :: String -> Either String Phi.Object diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs b/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs index 9deefb960..14b3aa9f3 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs @@ -27,6 +27,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} diff --git a/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs b/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs index a881acd1d..241b64b07 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs @@ -111,7 +111,7 @@ inMathMode = (" $ " <>) . (<> " $ ") instance ToLatex RuleContext where toLatex RuleContext{..} = maybe mempty (\x -> inMathMode $ toLatex GlobalObject <> " -> " <> toLatex x) global_object - <> maybe mempty (\x -> (inMathMode $ toLatex x) <> " is the scope of the redex") current_object + <> maybe mempty (\x -> inMathMode (toLatex x) <> " is the scope of the redex") current_object <> maybe mempty (\x -> toLatex x <> " is the current attribute") current_attribute instance ToLatex RuleAttribute where diff --git a/eo-phi-normalizer/test/Main.hs b/eo-phi-normalizer/test/Main.hs index cec86ad6b..ab33535a0 100644 --- a/eo-phi-normalizer/test/Main.hs +++ b/eo-phi-normalizer/test/Main.hs @@ -23,9 +23,9 @@ {- FOURMOLU_ENABLE -} module Main where -import Main.Utf8 +import Language.EO.Locale (withCorrectLocale) import Spec qualified import Test.Hspec.Runner main :: IO () -main = withUtf8 $ hspecWith defaultConfig Spec.spec +main = withCorrectLocale $ hspecWith defaultConfig Spec.spec diff --git a/flake.nix b/flake.nix index c21f540df..35500ebea 100644 --- a/flake.nix +++ b/flake.nix @@ -199,7 +199,7 @@ let name = "update-markdown"; text = '' - mdsh + set -ex ${lib.concatMapStringsSep "\n" (x: "mdsh -i site/docs/src/${x} --work_dir .") [ "common/celsius.md" @@ -215,7 +215,7 @@ "contributing.md" ]} - cp site/docs/docs/markdown/contributing.md CONTRIBUTING.md + cp site/docs/src/contributing.md CONTRIBUTING.md rm celsius.phi diff --git a/package-lock.json b/package-lock.json index 3192a3672..4920cd377 100644 --- a/package-lock.json +++ b/package-lock.json @@ -499,9 +499,9 @@ "dev": true }, "node_modules/prettier": { - "version": "3.4.1", - "resolved": "https://registry.npmjs.org/prettier/-/prettier-3.4.1.tgz", - "integrity": "sha512-G+YdqtITVZmOJje6QkXQWzl3fSfMxFwm1tjTyo9exhkmWSqC4Yhd1+lug++IlR2mvRVAxEDDWYkQdeSztajqgg==", + "version": "3.4.2", + "resolved": "https://registry.npmjs.org/prettier/-/prettier-3.4.2.tgz", + "integrity": "sha512-e9MewbtFo+Fevyuxn/4rrcDAaq0IYxPGLvObpQjiZBMAzB9IGmzlnG9RZy3FFas+eBMu2vA0CszMeduow5dIuQ==", "dev": true, "license": "MIT", "bin": { diff --git a/scripts/update-markdown.sh b/scripts/update-markdown.sh index 1c98cd177..be981c241 100755 --- a/scripts/update-markdown.sh +++ b/scripts/update-markdown.sh @@ -25,7 +25,7 @@ # This file was generated automatically. # You can edit the script in 'flake.nix' -mdsh +set -ex mdsh -i site/docs/src/common/celsius.md --work_dir . mdsh -i site/docs/src/eo-phi-normalizer.md --work_dir . @@ -39,9 +39,9 @@ mdsh -i site/docs/src/eo-phi-normalizer/print-rules.md --work_dir . mdsh -i site/docs/src/eo-phi-normalizer/test.md --work_dir . mdsh -i site/docs/src/contributing.md --work_dir . -cp site/docs/docs/markdown/contributing.md CONTRIBUTING.md +cp site/docs/src/contributing.md CONTRIBUTING.md -rm celsius.phi +rm celsius.phi bar.phi npm i npx prettier -w "**/*.md" diff --git a/site/docs/src/contributing.md b/site/docs/src/contributing.md index 8ab559876..1340524ae 100644 --- a/site/docs/src/contributing.md +++ b/site/docs/src/contributing.md @@ -14,7 +14,18 @@ Check open issues ([link](https://github.com/objectionary/eo-phi-normalizer/issu ## Enter the repository -{{#include ./common/enter-repository.md}} + + + + +Clone and enter the project repository. + +```sh +git clone https://github.com/objectionary/eo-phi-normalizer --recurse-submodules +cd eo-phi-normalizer +``` + + ## Install stack diff --git a/site/docs/src/eo-phi-normalizer/metrics.md b/site/docs/src/eo-phi-normalizer/metrics.md index 293a0152e..646be075d 100644 --- a/site/docs/src/eo-phi-normalizer/metrics.md +++ b/site/docs/src/eo-phi-normalizer/metrics.md @@ -18,7 +18,7 @@ eo-phi-normalizer metrics --help ```console Usage: eo-phi-normalizer metrics [FILE] [-o|--output-file FILE] - [-b|--bindings-path PATH] + [-b|--bindings-path PATH] Collect metrics for a PHI program. @@ -44,10 +44,10 @@ eo-phi-normalizer metrics celsius.phi { "bindings-by-path-metrics": null, "program-metrics": { - "applications": 3, - "dataless": 6, - "dispatches": 6, - "formations": 8 + "applications": 4, + "dataless": 1, + "dispatches": 9, + "formations": 3 } } ``` @@ -62,10 +62,10 @@ cat celsius.phi | eo-phi-normalizer metrics { "bindings-by-path-metrics": null, "program-metrics": { - "applications": 3, - "dataless": 6, - "dispatches": 6, - "formations": 8 + "applications": 4, + "dataless": 1, + "dispatches": 9, + "formations": 3 } } ``` @@ -73,7 +73,7 @@ cat celsius.phi | eo-phi-normalizer metrics ### `--bindings-path` ```$ as console -eo-phi-normalizer metrics --bindings-path org.eolang celsius.phi +eo-phi-normalizer metrics --bindings-path '' celsius.phi ``` ```console @@ -82,21 +82,30 @@ eo-phi-normalizer metrics --bindings-path org.eolang celsius.phi "bindings-metrics": [ { "metrics": { - "applications": 0, - "dataless": 3, - "dispatches": 0, - "formations": 3 + "applications": 2, + "dataless": 0, + "dispatches": 6, + "formations": 0 }, - "name": "float" + "name": "c" + }, + { + "metrics": { + "applications": 2, + "dataless": 0, + "dispatches": 3, + "formations": 2 + }, + "name": "result" } ], - "path": "org.eolang" + "path": "" }, "program-metrics": { - "applications": 3, - "dataless": 6, - "dispatches": 6, - "formations": 8 + "applications": 4, + "dataless": 1, + "dispatches": 9, + "formations": 3 } } ``` diff --git a/site/docs/src/eo-phi-normalizer/rewrite.md b/site/docs/src/eo-phi-normalizer/rewrite.md index 6825a1ce1..1a75255c4 100644 --- a/site/docs/src/eo-phi-normalizer/rewrite.md +++ b/site/docs/src/eo-phi-normalizer/rewrite.md @@ -166,6 +166,51 @@ Result 1 out of 1: ---------------------------------------------------- ``` +### `--chain` `--tex` + +```$ as tex +printf "{⟦ m ↦ ⟦ x ↦ ⟦ t ↦ ⟦ Δ ⤍ 42- ⟧ ⟧.t ⟧.x ⟧}" > bar.phi + +eo-phi-normalizer rewrite --chain --tex bar.phi +``` + +```tex +% Rule set following Nov 2024 revision + +\documentclass{article} +\usepackage{eolang} +\begin{document} + + +This is the 1st possible chain of normalizing rewritings: + +\begin{phiquation*} +[[ m -> [[ x -> [[ t -> [[ D> 42- ]] ]].t ]].x ]] \trans_{\rulename{DOT}} + \trans [[ m -> [[ x -> [[ D> 42- ]]( ^ -> [[ t -> [[ D> 42- ]] ]] ) ]].x ]] \trans_{\rulename{DOT}} + \trans [[ m -> [[ D> 42- ]]( ^ -> [[ t -> [[ D> 42- ]] ]] )( ^ -> [[ x -> [[ D> 42- ]]( ^ -> [[ t -> [[ D> 42- ]] ]] ) ]] ) ]] \trans_{\rulename{RHO}} + \trans [[ m -> [[ D> 42-, ^ -> [[ t -> [[ D> 42- ]] ]] ]]( )( ^ -> [[ x -> [[ D> 42- ]]( ^ -> [[ t -> [[ D> 42- ]] ]] ) ]] ) ]] \trans_{\rulename{DUP}} + \trans [[ m -> [[ D> 42-, ^ -> [[ t -> [[ D> 42- ]] ]] ]]( ^ -> [[ x -> [[ D> 42- ]]( ^ -> [[ t -> [[ D> 42- ]] ]] ) ]] ) ]] \trans_{\rulename{STAY}} + \trans [[ m -> [[ ^ -> [[ t -> [[ D> 42- ]] ]], D> 42- ]]( ) ]] \trans_{\rulename{DUP}} + \trans [[ m -> [[ ^ -> [[ t -> [[ D> 42- ]] ]], D> 42- ]] ]] \trans_{\rulename{Normal form}} + \trans [[ m -> [[ ^ -> [[ t -> [[ D> 42- ]] ]], D> 42- ]] ]]. +\end{phiquation*} + +This is the 2nd possible chain of normalizing rewritings: + +\begin{phiquation*} +[[ m -> [[ x -> [[ t -> [[ D> 42- ]] ]].t ]].x ]] \trans_{\rulename{DOT}} + \trans [[ m -> [[ x -> [[ D> 42- ]]( ^ -> [[ t -> [[ D> 42- ]] ]] ) ]].x ]] \trans_{\rulename{RHO}} + \trans [[ m -> [[ x -> [[ D> 42-, ^ -> [[ t -> [[ D> 42- ]] ]] ]]( ) ]].x ]] \trans_{\rulename{DUP}} + \trans [[ m -> [[ x -> [[ D> 42-, ^ -> [[ t -> [[ D> 42- ]] ]] ]] ]].x ]] \trans_{\rulename{DOT}} + \trans [[ m -> [[ D> 42-, ^ -> [[ t -> [[ D> 42- ]] ]] ]]( ^ -> [[ x -> [[ D> 42-, ^ -> [[ t -> [[ D> 42- ]] ]] ]] ]] ) ]] \trans_{\rulename{STAY}} + \trans [[ m -> [[ ^ -> [[ t -> [[ D> 42- ]] ]], D> 42- ]]( ) ]] \trans_{\rulename{DUP}} + \trans [[ m -> [[ ^ -> [[ t -> [[ D> 42- ]] ]], D> 42- ]] ]] \trans_{\rulename{Normal form}} + \trans [[ m -> [[ ^ -> [[ t -> [[ D> 42- ]] ]], D> 42- ]] ]]. +\end{phiquation*} + +\end{document} +``` + ### `--json` ```$ as json @@ -235,6 +280,26 @@ eo-phi-normalizer rewrite --single --json --rules ./eo-phi-normalizer/test/eo/ph "{\n ⟦\n c ↦ Φ.org.eolang.float (\n as-bytes ↦ Φ.org.eolang.bytes (\n Δ ⤍ 40-39-00-00-00-00-00-00\n )\n ),\n result ↦ ξ.c.times (\n x ↦ ⟦\n Δ ⤍ 3F-FC-CC-CC-CC-CC-CC-CD\n ⟧\n )\n .plus (\n x ↦ ⟦\n Δ ⤍ 40-40-00-00-00-00-00-00\n ⟧\n ),\n λ ⤍ Package\n ⟧\n}" ``` +### `--tex` + +```$ as tex +eo-phi-normalizer rewrite --tex bar.phi +``` + +```tex +% Rule set following Nov 2024 revision + +\documentclass{article} +\usepackage{eolang} +\begin{document} + +\begin{phiquation*} +[[ m -> [[ ^ -> [[ t -> [[ D> 42- ]] ]], D> 42- ]] ]] +\end{phiquation*} + +\end{document} +``` + ### `--output-file FILE` Redirects the output to file of the given path instead of `stdout`.