aasam 0.1.0.0 → 0.2.0.0
raw patch · 7 files changed
+692/−669 lines, 7 filesdep +text
Dependencies added: text
Files
- LICENSE +201/−201
- README.md +3/−3
- aasam.cabal +43/−41
- lib/Aasam.hs +303/−291
- lib/Grammars.hs +54/−51
- lib/Util.hs +18/−18
- test/AasamTest.hs +70/−64
LICENSE view
@@ -1,201 +1,201 @@- Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright 2022 Alexander Lucas - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. + Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright 2022 Alexander Lucas++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
README.md view
@@ -1,3 +1,3 @@-# aasam - -This project is a fully-extended implementation of the algorithm ℳ from Annika Aasa's "Precedences in specifications and implementations of programming languages". It provides an interface for converting distfix (mixfix) precedence grammars into unambiguous context-free grammars. +# aasam++This project is a fully-extended implementation of the algorithm ℳ from Annika Aasa's "Precedences in specifications and implementations of programming languages". It provides an interface for converting distfix (mixfix) precedence grammars into unambiguous context-free grammars.
aasam.cabal view
@@ -1,41 +1,43 @@-cabal-version: 2.4 -name: aasam -version: 0.1.0.0 -license: Apache-2.0 -license-file: LICENSE -maintainer: mobotsar@protonmail.com -author: Alexander Lucas -bug-reports: https://gitlab.com/mobotsar/aasam -synopsis: - Convert distfix precedence grammars to unambiguous context-free grammars. - -description: - This project is a fully-extended implementation of the algorithm ℳ from Annika Aasa's "Precedences in specifications and implementations of programming languages". It provides an interface for converting distfix (mixfix) precedence grammars into unambiguous context-free grammars. - -category: parsing -extra-source-files: README.md - -library - exposed-modules: Aasam - hs-source-dirs: lib - other-modules: - Util - Grammars - - default-language: Haskell2010 - build-depends: - base ^>=4.15.1.0, - containers >=0.6.4 && <0.7 - -test-suite aasam-test - type: exitcode-stdio-1.0 - main-is: AasamTest.hs - hs-source-dirs: test - default-language: Haskell2010 - build-depends: - base ^>=4.15.1.0, - HUnit ==1.6.2.0, - test-framework ==0.8.2.0, - test-framework-hunit ==0.3.0.2, - containers >=0.6.4 && <0.7, - aasam +cabal-version: 2.4+name: aasam+version: 0.2.0.0+license: Apache-2.0+license-file: LICENSE+maintainer: mobotsar@protonmail.com+author: Alexander Lucas+bug-reports: https://gitlab.com/mobotsar/aasam+synopsis:+ Convert distfix precedence grammars to unambiguous context-free grammars.++description:+ This project is a fully-extended implementation of the algorithm ℳ from Annika Aasa's "Precedences in specifications and implementations of programming languages". It provides an interface for converting distfix (mixfix) precedence grammars into unambiguous context-free grammars.++category: parsing+extra-source-files: README.md++library+ exposed-modules: Aasam+ hs-source-dirs: lib+ other-modules:+ Util+ Grammars++ default-language: Haskell2010+ build-depends:+ base ^>=4.15.1.0,+ containers >=0.6.4 && <0.7,+ text >= 1.2.5 && < 1.3++test-suite aasam-test+ type: exitcode-stdio-1.0+ main-is: AasamTest.hs+ hs-source-dirs: test+ default-language: Haskell2010+ build-depends:+ base ^>=4.15.1.0,+ HUnit ==1.6.2.0,+ test-framework ==0.8.2.0,+ test-framework-hunit ==0.3.0.2,+ containers >=0.6.4 && <0.7,+ aasam,+ text >= 1.2.5 && < 1.3
lib/Aasam.hs view
@@ -1,291 +1,303 @@-module Aasam - ( m - , module Grammars - , AasamError(..) - ) where - -import Data.Function (on) -import Data.List (groupBy) -import qualified Data.List.NonEmpty as DLNe -import Data.List.NonEmpty (NonEmpty((:|))) -import Data.Set (Set, insert, union) -import qualified Data.Set as Set -import Grammars - ( CfgProduction - , CfgString - , ContextFree - , NonTerminal(..) - , Precedence - , PrecedenceProduction(..) - , Terminal(..) - ) -import Util ((>.), (|>), unwrapOr) - -import Data.Bifunctor (Bifunctor(bimap, second)) -import Data.Data (toConstr) -import qualified Data.Foldable -import qualified Data.List as List - -doGeneric :: PrecedenceProduction -> (Int -> NonEmpty String -> a) -> a -doGeneric (Prefix prec words) f = f prec words -doGeneric (Postfix prec words) f = f prec words -doGeneric (Infixl prec words) f = f prec words -doGeneric (Infixr prec words) f = f prec words -doGeneric (Closed words) f = f 0 words - -getWords :: PrecedenceProduction -> [String] -getWords = flip doGeneric (const DLNe.toList) - -prec :: PrecedenceProduction -> Int -prec = flip doGeneric const - -nt :: Int -> Int -> Int -> NonTerminal -nt prec p q = NonTerminal (show prec ++ show p ++ show q) - --- TODO: write a proper implementation of this that doesn't depend on List -groupSetBy :: Ord a => (a -> a -> Bool) -> Set a -> Set (Set a) -groupSetBy projection = Set.toList >. groupBy projection >. map Set.fromList >. Set.fromList - -makeClasses :: Precedence -> Set Precedence -makeClasses = groupSetBy fixeq - where - fixeq = on (==) toConstr - -- equivalence relation of fixity on precedence productions - -type UniquenessPair = (PrecedenceProduction, Precedence) - --- This function returns a set of upairs. A upair contains a production of a single precedence on the left, --- and the set of all productions of that precedence on the right (including the one on the left). -classToPairSet :: Precedence -> Set UniquenessPair -classToPairSet = groupSetBy preceq >. Set.map pair - where - pair :: Precedence -> UniquenessPair - pair prec = (Set.elemAt 0 prec, prec) - preceq :: PrecedenceProduction -> PrecedenceProduction -> Bool - preceq a b = prec a == prec b - -pairifyClasses :: Set Precedence -> Set (Set UniquenessPair) -pairifyClasses = Set.map classToPairSet - -type PqQuad = (Int, Int, PrecedenceProduction, Precedence) - -pqboundUPair :: Set UniquenessPair -> Set UniquenessPair -> UniquenessPair -> PqQuad -pqboundUPair pre post (r, s) = (greater pre $ prec r, greater post $ prec r, r, s) - where - greater :: Set UniquenessPair -> Int -> Int - greater upairs n = Set.size $ Set.filter ((n <) . prec . fst) upairs - -pqboundClasses :: Set UniquenessPair -> Set UniquenessPair -> Set (Set UniquenessPair) -> Set (Set PqQuad) -pqboundClasses pre post = Set.map (Set.map (pqboundUPair pre post)) - -intersperseStart :: NonEmpty String -> CfgString -intersperseStart = DLNe.map (Left . Terminal) >. DLNe.intersperse (Right (NonTerminal "!start")) >. DLNe.toList - -fill :: Precedence -> Set CfgProduction -> Set CfgProduction -fill s cfgprods = Set.union withTerminals withoutTerminals - where - (left, withoutTerminals) = Set.partition hasTerminal cfgprods - where - hasTerminal :: CfgProduction -> Bool - hasTerminal (_, words) = List.any isTerminal words - isTerminal :: Either Terminal NonTerminal -> Bool - isTerminal (Right (NonTerminal _)) = False - isTerminal (Left (Terminal _)) = True - withTerminals = fill' s left - -- TODO: write a proper implementation of this composition that doesn't depend on List - where - fill' :: Precedence -> Set CfgProduction -> Set CfgProduction - fill' s = Set.toList >. repeat >. zipWith reset (Set.toList s) >. concat >. Set.fromList - where - reset :: PrecedenceProduction -> [CfgProduction] -> [CfgProduction] - reset pp = map (second re) - where - re :: CfgString -> CfgString - re str = - case pp of - Infixl prec words -> kansas str words - Infixr prec words -> kansas str words - _ -> - error - "This is a bug in Aasam. Somehow, I got a CfgProduction that hasn't any terminals, or a Closed production." - where - kansas :: CfgString -> NonEmpty String -> CfgString - kansas str words = List.head str : intersperseStart words ++ [List.last str] - --- The CE production on `closedrule` must go to a non-terminal. --- Relevant terminals in these rules are all added by `fill`. Those added immediately in the rule bodies are just to signal to fill. --- If an "evil" non-terminal appears anywhere in the output of a *rule fuctions, that's a bug. -prerule :: Int -> Int -> PqQuad -> Set CfgProduction -prerule p q (_, _, r, s) = fill s $ Set.singleton (nt (prec r) p q, [Right (nt (prec r - 1) (p + 1) q)]) - -postrule :: Int -> Int -> PqQuad -> Set CfgProduction -postrule p q (_, _, r, s) = fill s $ Set.singleton (nt (prec r) p q, [Right (nt (prec r - 1) p (q + 1))]) - -inlrule :: Int -> Int -> PqQuad -> Set CfgProduction -inlrule p q (_, _, r, s) = fill s $ Set.fromList [a, b] - where - a = (nt (prec r) p q, [Right (nt (prec r) 0 q), Left (Terminal "evil"), Right (nt (prec r - 1) p 0)]) - b = (nt (prec r) p q, [Right (nt (prec r - 1) p q)]) - -inrrule :: Int -> Int -> PqQuad -> Set CfgProduction -inrrule p q (_, _, r, s) = fill s $ Set.fromList [a, b] - where - a = (nt (prec r) p q, [Right (nt (prec r - 1) 0 q), Left (Terminal "evil"), Right (nt (prec r) p 0)]) - b = (nt (prec r) p q, [Right (nt (prec r - 1) p q)]) - -closedrule :: Set UniquenessPair -> Set UniquenessPair -> Int -> Int -> PqQuad -> Set CfgProduction -closedrule pres posts p q (_, _, r, s) = insert ae isets `union` jsets - where - ae :: CfgProduction - ae = (nt 0 p q, [Right (NonTerminal "CE")]) - isets :: Set CfgProduction - isets = foldl (flip (union . ido)) Set.empty (zip (Set.toList pres) [1 .. p]) - where - ido :: (UniquenessPair, Int) -> Set CfgProduction - ido ((r, s), i) = - Set.singleton - (nt 0 p q, intersperseStart (getWords r |> DLNe.fromList) ++ [Right (nt (prec r) (p - i) 0)]) - jsets :: Set CfgProduction - jsets = foldl (flip (union . jdo)) Set.empty (zip (Set.toList posts) [1 .. q]) - where - jdo :: (UniquenessPair, Int) -> Set CfgProduction - jdo ((r, s), j) = - Set.singleton - (nt 0 p q, Right (nt (prec r) 0 (q - j)) : intersperseStart (getWords r |> DLNe.fromList)) - -convertClass :: (Int -> Int -> PqQuad -> Set CfgProduction) -> Set PqQuad -> Set CfgProduction -convertClass rule = foldl (flip (union . psets)) Set.empty - where - psets (pbound, qbound, r, s) = foldl (flip (union . qsets)) Set.empty [0 .. pbound] - where - qsets p = foldl ((. flip (rule p) (pbound, qbound, r, s)) . union) Set.empty [0 .. qbound] - -convertClasses :: Set UniquenessPair -> Set UniquenessPair -> Set (Set PqQuad) -> Set CfgProduction -convertClasses pres posts = Set.map convertClassBranching >. foldl union Set.empty - where - convertClassBranching :: Set PqQuad -> Set CfgProduction - convertClassBranching quads = convertClass rule quads - where - rule = - case Set.elemAt 0 quads of - (_, _, Infixl _ _, _) -> inlrule - (_, _, Infixr _ _, _) -> inrrule - (_, _, Prefix _ _, _) -> prerule - (_, _, Postfix _ _, _) -> postrule - (_, _, Closed _, _) -> closedrule pres posts --- |The type of errors. Contains a list of strings, each of which describes an error of the input grammar. -newtype AasamError = - AasamError [String] - deriving (Show, Eq, Ord) - --- |Takes a distfix precedence grammar. If there is an error, produces an 'AasamError', else produces a corresponding unambiguous context-free grammar. --- --- All possible errors are enumerated in the documentation for 'Precedence'. -m :: Precedence -> Either ContextFree AasamError -m precg = - if null errors - then Left (nt highestPrecedence 0 0, addCes (assignStart prods)) - else Right (AasamError errors) - where - errors :: [String] - errors = foldl fn [] [positive, noInitSubseq, noInitWhole, classesPrecDisjoint, precContinue] - where - fn :: [String] -> Maybe String -> [String] - fn a e = - case e of - Nothing -> a - Just err -> err : a - positive = - if all fn precg - then Nothing - else Just errstr - where - fn (Closed _) = True - fn x = prec x > 0 - errstr = "All precedences must be positive integers." - noInitSubseq = - if Set.disjoint initials subsequents - then Nothing - else Just errstr - where - (initials, subsequents) = foldl fn (Set.empty, Set.empty) precg - where - fn (i, s) e = (insert (head words) i, (tail words |> Set.fromList) `union` s) - where - words = getWords e - errstr = "No initial word may also be a subsequent word of another production." - noInitWhole = - if all fx precg - then Nothing - else Just errstr - where - fx x = all fy precg - where - fy y = getWords x `notPrefixedBy` getWords y || x == y - where - notPrefixedBy :: Eq a => [a] -> [a] -> Bool - notPrefixedBy [] [] = False - notPrefixedBy (_:_) [] = False - notPrefixedBy [] (_:_) = True - notPrefixedBy (x:xs) (y:ys) = x /= y || notPrefixedBy xs ys - errstr = "No initial sequence of words may also be the whole sequence of another production." - classesPrecDisjoint = - if allDisjoint precGroups - then Nothing - else Just errstr - where - allDisjoint :: Ord a => [Set a] -> Bool - allDisjoint (x:xs) = all (Set.disjoint x) xs && allDisjoint xs - allDisjoint [] = True - precGroups :: [Set Int] - precGroups = List.map (foldl (flip (insert . prec)) Set.empty) (Set.toList classes) - errstr = "No precedence of a production of one fixity may also be the precedence of a production of another fixity." - precContinue = - if precedences == Set.fromList [lowestPrecedence .. highestPrecedence] - then Nothing - else Just errstr - where - errstr = "The set of precedences must be either empty or the set of integers between 1 and greatest precedence, inclusive." - classes = makeClasses precg - upairClasses = pairifyClasses classes - (pre, post) = (findBy isPre, findBy isPost) - where - isPre clas = - case Set.elemAt 0 clas of - (Prefix _ _, _) -> True - _ -> False - isPost clas = - case Set.elemAt 0 clas of - (Postfix _ _, _) -> True - _ -> False - findBy f = unwrapOr Set.empty $ Data.Foldable.find f upairClasses - prods = pqboundClasses pre post upairClasses |> convertClasses pre post - addCes :: Set CfgProduction -> Set CfgProduction - addCes = union ces - where - ces :: Set CfgProduction - ces = - Set.filter isClosed precg |> - Set.map (\(Closed words) -> (NonTerminal "CE", intersperseStart words)) - where - isClosed :: PrecedenceProduction -> Bool - isClosed (Closed _) = True - isClosed _ = False - assignStart :: Set CfgProduction -> Set CfgProduction - assignStart = Set.map $ bimap lhsMap rhsMap - where - lhsMap :: NonTerminal -> NonTerminal - lhsMap lhs = - if lhs == NonTerminal "!start" - then nt highestPrecedence 0 0 - else lhs - rhsMap = map submap - where - submap :: Either Terminal NonTerminal -> Either Terminal NonTerminal - submap (Right x) = Right $ lhsMap x - submap y = y - (highestPrecedence, lowestPrecedence, precedences) = - foldl - (\(ha, la, pa) e -> (max (prec e) ha, min (prec e) la, prec e `insert` pa)) - (0, 0, Set.singleton 0) - precg +module Aasam+ ( m+ , module Grammars+ , AasamError(..)+ ) where++import Data.Function (on)+import Data.List (groupBy)+import qualified Data.List.NonEmpty as DLNe+import Data.List.NonEmpty (NonEmpty((:|)))+import Data.Set (Set, insert, union)+import qualified Data.Set as Set+import Grammars+ ( CfgProduction+ , CfgString+ , ContextFree+ , NonTerminal(..)+ , Precedence+ , PrecedenceProduction(..)+ , Terminal(..)+ )+import Util ((>.), (|>), unwrapOr)++import Data.Bifunctor (Bifunctor(bimap, second))+import Data.Data (toConstr)+import qualified Data.Foldable+import qualified Data.List as List++import qualified Data.Text as Text+import Data.Text (Text)++doGeneric :: PrecedenceProduction -> (Int -> NonEmpty Text -> a) -> a+doGeneric (Prefix prec words) f = f prec words+doGeneric (Postfix prec words) f = f prec words+doGeneric (Infixl prec words) f = f prec words+doGeneric (Infixr prec words) f = f prec words+doGeneric (Closed words) f = f 0 words++getWords :: PrecedenceProduction -> [Text]+getWords = flip doGeneric (const DLNe.toList)++prec :: PrecedenceProduction -> Int+prec = flip doGeneric const++nt :: Int -> Int -> Int -> NonTerminal+nt prec p q = (NonTerminal . Text.pack) (show prec ++ show p ++ show q)++-- TODO: write a proper implementation of this that doesn't depend on List+groupSetBy :: Ord a => (a -> a -> Bool) -> Set a -> Set (Set a)+groupSetBy projection = Set.toList >. groupBy projection >. map Set.fromList >. Set.fromList++makeClasses :: Precedence -> Set Precedence+makeClasses = groupSetBy fixeq+ where+ fixeq = on (==) toConstr+ -- equivalence relation of fixity on precedence productions++type UniquenessPair = (PrecedenceProduction, Precedence)++-- This function returns a set of upairs. A upair contains a production of a single precedence on the left,+-- and the set of all productions of that precedence on the right (including the one on the left).+classToPairSet :: Precedence -> Set UniquenessPair+classToPairSet = groupSetBy preceq >. Set.map pair+ where+ pair :: Precedence -> UniquenessPair+ pair prec = (Set.elemAt 0 prec, prec)+ preceq :: PrecedenceProduction -> PrecedenceProduction -> Bool+ preceq a b = prec a == prec b++pairifyClasses :: Set Precedence -> Set (Set UniquenessPair)+pairifyClasses = Set.map classToPairSet++type PqQuad = (Int, Int, PrecedenceProduction, Precedence)++pqboundUPair :: Set UniquenessPair -> Set UniquenessPair -> UniquenessPair -> PqQuad+pqboundUPair pre post (r, s) = (greater pre $ prec r, greater post $ prec r, r, s)+ where+ greater :: Set UniquenessPair -> Int -> Int+ greater upairs n = Set.size $ Set.filter ((n <) . prec . fst) upairs++pqboundClasses :: Set UniquenessPair -> Set UniquenessPair -> Set (Set UniquenessPair) -> Set (Set PqQuad)+pqboundClasses pre post = Set.map (Set.map (pqboundUPair pre post))++intersperseStart :: NonEmpty Text -> CfgString+intersperseStart =+ DLNe.map (Left . Terminal) >. DLNe.intersperse (Right ((NonTerminal . Text.pack) "!start")) >. DLNe.toList++fill :: Precedence -> Set CfgProduction -> Set CfgProduction+fill s cfgprods = Set.union withTerminals withoutTerminals+ where+ (left, withoutTerminals) = Set.partition hasTerminal cfgprods+ where+ hasTerminal :: CfgProduction -> Bool+ hasTerminal (_, words) = List.any isTerminal words+ isTerminal :: Either Terminal NonTerminal -> Bool+ isTerminal (Right (NonTerminal _)) = False+ isTerminal (Left (Terminal _)) = True+ withTerminals = fill' s left+ -- TODO: write a proper implementation of this composition that doesn't depend on List+ where+ fill' :: Precedence -> Set CfgProduction -> Set CfgProduction+ fill' s = Set.toList >. repeat >. zipWith reset (Set.toList s) >. concat >. Set.fromList+ where+ reset :: PrecedenceProduction -> [CfgProduction] -> [CfgProduction]+ reset pp = map (second re)+ where+ re :: CfgString -> CfgString+ re str =+ case pp of+ Infixl prec words -> kansas str words+ Infixr prec words -> kansas str words+ _ ->+ error+ "This is a bug in Aasam. Somehow, I got a CfgProduction that hasn't any terminals, or a Closed production."+ where+ kansas :: CfgString -> NonEmpty Text -> CfgString+ kansas str words = List.head str : intersperseStart words ++ [List.last str]++-- The CE production on `closedrule` must go to a non-terminal.+-- Relevant terminals in these rules are all added by `fill`. Those added immediately in the rule bodies are just to signal to fill.+-- If an "evil" non-terminal appears anywhere in the output of a *rule fuctions, that's a bug.+prerule :: Int -> Int -> PqQuad -> Set CfgProduction+prerule p q (_, _, r, s) = fill s $ Set.singleton (nt (prec r) p q, [Right (nt (prec r - 1) (p + 1) q)])++postrule :: Int -> Int -> PqQuad -> Set CfgProduction+postrule p q (_, _, r, s) = fill s $ Set.singleton (nt (prec r) p q, [Right (nt (prec r - 1) p (q + 1))])++inlrule :: Int -> Int -> PqQuad -> Set CfgProduction+inlrule p q (_, _, r, s) = fill s $ Set.fromList [a, b]+ where+ a =+ ( nt (prec r) p q+ , [Right (nt (prec r) 0 q), Left ((Terminal . Text.pack) "evil"), Right (nt (prec r - 1) p 0)])+ b = (nt (prec r) p q, [Right (nt (prec r - 1) p q)])++inrrule :: Int -> Int -> PqQuad -> Set CfgProduction+inrrule p q (_, _, r, s) = fill s $ Set.fromList [a, b]+ where+ a =+ ( nt (prec r) p q+ , [Right (nt (prec r - 1) 0 q), Left ((Terminal . Text.pack) "evil"), Right (nt (prec r) p 0)])+ b = (nt (prec r) p q, [Right (nt (prec r - 1) p q)])++closedrule :: Set UniquenessPair -> Set UniquenessPair -> Int -> Int -> PqQuad -> Set CfgProduction+closedrule pres posts p q (_, _, r, s) = insert ae isets `union` jsets+ where+ ae = (nt 0 p q, [Right ((NonTerminal . Text.pack) "CE")])+ isets :: Set CfgProduction+ isets = foldl (flip (union . ido)) Set.empty (zip (Set.toList pres) [1 .. p])+ where+ ido :: (UniquenessPair, Int) -> Set CfgProduction+ ido ((r, s), i) =+ Set.singleton+ (nt 0 p q, intersperseStart (getWords r |> DLNe.fromList) ++ [Right (nt (prec r) (p - i) 0)])+ jsets :: Set CfgProduction+ jsets = foldl (flip (union . jdo)) Set.empty (zip (Set.toList posts) [1 .. q])+ where+ jdo :: (UniquenessPair, Int) -> Set CfgProduction+ jdo ((r, s), j) =+ Set.singleton+ (nt 0 p q, Right (nt (prec r) 0 (q - j)) : intersperseStart (getWords r |> DLNe.fromList))++convertClass :: (Int -> Int -> PqQuad -> Set CfgProduction) -> Set PqQuad -> Set CfgProduction+convertClass rule = foldl (flip (union . psets)) Set.empty+ where+ psets (pbound, qbound, r, s) = foldl (flip (union . qsets)) Set.empty [0 .. pbound]+ where+ qsets p = foldl ((. flip (rule p) (pbound, qbound, r, s)) . union) Set.empty [0 .. qbound]++convertClasses :: Set UniquenessPair -> Set UniquenessPair -> Set (Set PqQuad) -> Set CfgProduction+convertClasses pres posts = Set.map convertClassBranching >. foldl union Set.empty+ where+ convertClassBranching :: Set PqQuad -> Set CfgProduction+ convertClassBranching quads = convertClass rule quads+ where+ rule =+ case Set.elemAt 0 quads of+ (_, _, Infixl _ _, _) -> inlrule+ (_, _, Infixr _ _, _) -> inrrule+ (_, _, Prefix _ _, _) -> prerule+ (_, _, Postfix _ _, _) -> postrule+ (_, _, Closed _, _) -> closedrule pres posts++-- |The type of errors. Contains a list of strings, each of which describes an error of the input grammar.+newtype AasamError =+ AasamError [Text]+ deriving (Show, Eq, Ord)++-- |Takes a distfix precedence grammar. If there is an error, produces an 'AasamError', else produces a corresponding unambiguous context-free grammar.+--+-- All possible errors are enumerated in the documentation for 'Precedence'.+m :: Precedence -> Either AasamError ContextFree+m precg =+ if null errors+ then Right (nt highestPrecedence 0 0, assignStart (addCes prods))+ else Left (AasamError errors)+ where+ errors = foldl fn [] [positive, noInitSubseq, noInitWhole, classesPrecDisjoint, precContinue]+ where+ fn :: [Text] -> Maybe Text -> [Text]+ fn a e =+ case e of+ Nothing -> a+ Just err -> err : a+ positive =+ if all fn precg+ then Nothing+ else Just errstr+ where+ fn (Closed _) = True+ fn x = prec x > 0+ errstr = Text.pack "All precedences must be positive integers."+ noInitSubseq =+ if Set.disjoint initials subsequents+ then Nothing+ else Just errstr+ where+ (initials, subsequents) = foldl fn (Set.empty, Set.empty) precg+ where+ fn (i, s) e = (insert (head words) i, (tail words |> Set.fromList) `union` s)+ where+ words = getWords e+ errstr = Text.pack "No initial word may also be a subsequent word of another production."+ noInitWhole =+ if all fx precg+ then Nothing+ else Just errstr+ where+ fx x = all fy precg+ where+ fy y = getWords x `notPrefixedBy` getWords y || x == y+ where+ notPrefixedBy :: Eq a => [a] -> [a] -> Bool+ notPrefixedBy [] [] = False+ notPrefixedBy (_:_) [] = False+ notPrefixedBy [] (_:_) = True+ notPrefixedBy (x:xs) (y:ys) = x /= y || notPrefixedBy xs ys+ errstr =+ Text.pack "No initial sequence of words may also be the whole sequence of another production."+ classesPrecDisjoint =+ if allDisjoint precGroups+ then Nothing+ else Just errstr+ where+ allDisjoint :: Ord a => [Set a] -> Bool+ allDisjoint (x:xs) = all (Set.disjoint x) xs && allDisjoint xs+ allDisjoint [] = True+ precGroups :: [Set Int]+ precGroups = List.map (foldl (flip (insert . prec)) Set.empty) (Set.toList classes)+ errstr =+ Text.pack+ "No precedence of a production of one fixity may also be the precedence of a production of another fixity."+ precContinue =+ if precedences == Set.fromList [lowestPrecedence .. highestPrecedence]+ then Nothing+ else Just errstr+ where+ errstr =+ Text.pack+ "The set of precedences must be either empty or the set of integers between 1 and greatest precedence, inclusive."+ classes = makeClasses precg+ upairClasses = pairifyClasses classes+ (pre, post) = (findBy isPre, findBy isPost)+ where+ isPre clas =+ case Set.elemAt 0 clas of+ (Prefix _ _, _) -> True+ _ -> False+ isPost clas =+ case Set.elemAt 0 clas of+ (Postfix _ _, _) -> True+ _ -> False+ findBy f = unwrapOr Set.empty $ Data.Foldable.find f upairClasses+ prods = pqboundClasses pre post upairClasses |> convertClasses pre post+ addCes :: Set CfgProduction -> Set CfgProduction+ addCes = union ces+ where+ ces :: Set CfgProduction+ ces =+ Set.filter isClosed precg |>+ Set.map (\(Closed words) -> ((NonTerminal . Text.pack) "CE", intersperseStart words))+ where+ isClosed :: PrecedenceProduction -> Bool+ isClosed (Closed _) = True+ isClosed _ = False+ assignStart :: Set CfgProduction -> Set CfgProduction+ assignStart = Set.map $ bimap lhsMap rhsMap+ where+ lhsMap :: NonTerminal -> NonTerminal+ lhsMap lhs =+ if lhs == (NonTerminal . Text.pack) "!start"+ then nt highestPrecedence 0 0+ else lhs+ rhsMap = map submap+ where+ submap :: Either Terminal NonTerminal -> Either Terminal NonTerminal+ submap (Right x) = Right $ lhsMap x+ submap y = y+ (highestPrecedence, lowestPrecedence, precedences) =+ foldl+ (\(ha, la, pa) e -> (max (prec e) ha, min (prec e) la, prec e `insert` pa))+ (0, 0, Set.singleton 0)+ precg
lib/Grammars.hs view
@@ -1,51 +1,54 @@-{-# LANGUAGE DeriveDataTypeable #-} - -module Grammars where - -import Data.Data (Data, Typeable) -import Data.List.NonEmpty (NonEmpty) -import Data.Set (Set) -import qualified Data.Set as Set - -newtype NonTerminal = - NonTerminal String - deriving (Eq, Ord, Show) - -newtype Terminal = - Terminal String - deriving (Eq, Ord, Show) - -type CfgString = [Either Terminal NonTerminal] - --- |The type of a context-free production. The left and right items correspond respectively to the left and right hand sides of a production rule. -type CfgProduction = (NonTerminal, CfgString) - --- |The type of a context-free gramar. On the left the starting non-terminal, and on the right is the set of productions in the grammar. -type ContextFree = (NonTerminal, Set CfgProduction) - --- |The type of a distfix precedence production. --- --- Int parameters are precedences. --- --- NonEmpty String parameters are lists of non-terminal symbols expressed as strings. --- The particular data constructor used implies the interspersal pattern of non-terminals in the terminal list when the production is interpreted. --- For example, --- --- > Infixl 1 (fromList ["?", ":"]) --- corresponds to the left-associative production, E -> E ? E : E. -data PrecedenceProduction - = Prefix Int (NonEmpty String) - | Postfix Int (NonEmpty String) - | Infixl Int (NonEmpty String) - | Infixr Int (NonEmpty String) - | Closed (NonEmpty String) - deriving (Eq, Ord, Show, Typeable, Data) - --- |The type of a distfix precedence grammar. The following must be true of any parameter to `Aasam.m`. --- --- * All precedences must be positive integers. --- * No initial word may also be a subsequent word of another production. --- * No initial sequence of words may also be the whole sequence of another production. --- * No precedence of a production of one fixity may also be the precedence of a production of another fixity. --- * The set of precedences must be either empty or the set of integers between 1 and greatest precedence, inclusive. -type Precedence = Set PrecedenceProduction +{-# LANGUAGE DeriveDataTypeable #-}++module Grammars where++import Data.Data (Data, Typeable)+import Data.List.NonEmpty (NonEmpty)+import Data.Set (Set)+import qualified Data.Set as Set++import qualified Data.Text as Text+import Data.Text (Text)++newtype NonTerminal =+ NonTerminal Text+ deriving (Eq, Ord, Show)++newtype Terminal =+ Terminal Text+ deriving (Eq, Ord, Show)++type CfgString = [Either Terminal NonTerminal]++-- |The type of a context-free production. The left and right items correspond respectively to the left and right hand sides of a production rule.+type CfgProduction = (NonTerminal, CfgString)++-- |The type of a context-free grammar. On the left the starting non-terminal, and on the right is the set of productions in the grammar.+type ContextFree = (NonTerminal, Set CfgProduction)++-- |The type of a distfix precedence production.+--+-- Int parameters are precedences.+--+-- NonEmpty Text parameters are lists of terminal symbols expressed as strings.+-- A particular data constructor implies a corresponding interspersal pattern of non-terminals in the terminal list when the production is interpreted.+-- For example,+--+-- > Infixl 1 (fromList ["?", ":"])+-- corresponds to the left-associative production, E -> E ? E : E.+data PrecedenceProduction+ = Prefix Int (NonEmpty Text)+ | Postfix Int (NonEmpty Text)+ | Infixl Int (NonEmpty Text)+ | Infixr Int (NonEmpty Text)+ | Closed (NonEmpty Text)+ deriving (Eq, Ord, Show, Typeable, Data)++-- |The type of a distfix precedence grammar. The following must be true of any parameter to `Aasam.m`.+--+-- * All precedences must be positive integers.+-- * No initial word may also be a subsequent word of another production.+-- * No initial sequence of words may also be the whole sequence of another production.+-- * No precedence of a production of one fixity may also be the precedence of a production of another fixity.+-- * The set of precedences must be either empty or the set of integers between 1 and greatest precedence, inclusive.+type Precedence = Set PrecedenceProduction
lib/Util.hs view
@@ -1,18 +1,18 @@-module Util where - -infixl 5 >. - -(>.) :: (a -> b) -> (b -> c) -> a -> c -(>.) = flip (.) - -infixl 4 |> - -(|>) :: a -> (a -> b) -> b -(|>) x f = f x - -unwrapOr :: a -> Maybe a -> a -unwrapOr _ (Just x) = x -unwrapOr y _ = y - -tup :: a -> b -> (a, b) -tup a b = (a, b) +module Util where++infixl 5 >.++(>.) :: (a -> b) -> (b -> c) -> a -> c+(>.) = flip (.)++infixl 4 |>++(|>) :: a -> (a -> b) -> b+(|>) x f = f x++unwrapOr :: a -> Maybe a -> a+unwrapOr _ (Just x) = x+unwrapOr y _ = y++tup :: a -> b -> (a, b)+tup a b = (a, b)
test/AasamTest.hs view
@@ -1,64 +1,70 @@-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} - -{-# HLINT ignore "Evaluate" #-} -module Main - ( main - ) where - -import Aasam -import qualified Data.List as List -import Data.List.NonEmpty (fromList, xor) -import qualified Data.Set as Set -import Test.Framework (defaultMain) -import Test.Framework.Providers.API (Test(Test)) -import Test.Framework.Providers.HUnit (hUnitTestToTests) -import Test.HUnit (Assertable(assert), Assertion, Test(..), assertEqual) - -testMap :: (Eq a, Show a) => [(String, a, a)] -> [Test.HUnit.Test] -testMap = List.map (\(label, x, y) -> TestLabel label (TestCase (assertEqual "" x y))) - -tests :: [Test.Framework.Providers.API.Test] -tests = hUnitTestToTests $ TestList labeledTests - -main :: IO () -main = defaultMain tests - -empt :: [a] -empt = [] - -labeledTests :: [Test.HUnit.Test] -labeledTests = - [] - -- ++ testMap [("okay", Just 20, Just (Set.size (snd (un (m pg0)))))] - ++ - testMap [("under", Nothing, Just (m pg2))] - -pg0 :: Precedence -pg0 = - Set.fromList - [ Postfix 4 (fromList ["?"]) - , Infixl 4 (fromList ["+"]) - , Infixl 0 (fromList ["+"]) - , Postfix 2 (fromList ["!", "?"]) - , Closed (fromList ["int"]) - ] - -un :: Either a b -> a -un (Left x) = x -un _ = error "fail" - -pg1 :: Set.Set PrecedenceProduction -pg1 = - Set.fromList - [ Infixr 2 (fromList ["="]) - , Prefix 1 (fromList ["λ", "."]) - , Closed (fromList ["x"]) - , Closed (fromList ["(", "$", ")"]) - ] - -pg2 :: Set.Set PrecedenceProduction -pg2 = Set.empty - -d :: Maybe ContextFree -> ContextFree -d (Just x) = x -d Nothing = (NonTerminal "String", Set.empty) +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++{-# HLINT ignore "Evaluate" #-}+module Main (main) where++import Aasam+import qualified Data.List as List+import Data.List.NonEmpty (fromList, NonEmpty)+import qualified Data.Set as Set+import Test.Framework (defaultMain)+import Test.Framework.Providers.API (Test(Test))+import Test.Framework.Providers.HUnit (hUnitTestToTests)+import Test.HUnit (Assertable(assert), Assertion, Test(..), assertEqual)++import qualified Data.Text as Text+import Data.Text (Text)++testMap :: (Eq a, Show a) => [(String, a, a)] -> [Test.HUnit.Test]+testMap = List.map (\(label, x, y) -> TestLabel label (TestCase (assertEqual "" x y)))++tests :: [Test.Framework.Providers.API.Test]+tests = hUnitTestToTests $ TestList labeledTests++fromList' :: [String] -> NonEmpty Text+fromList' = fromList . map Text.pack++main :: IO ()+main = defaultMain tests++empt :: [a]+empt = []++labeledTests :: [Test.HUnit.Test]+labeledTests =+ []+ -- ++ testMap [("okay", Just 20, Just (Set.size (snd (un (m pg0)))))]+ +++ testMap [("under", Nothing, Just (m pg2))]++pg0 :: Precedence+pg0 =+ Set.fromList+ [ Postfix 4 (fromList' ["?"])+ , Infixl 4 (fromList' ["+"])+ , Infixl 0 (fromList' ["+"])+ , Postfix 2 (fromList' ["!", "?"])+ , Closed (fromList' ["int"])+ ]++un :: Either a b -> a+un (Left x) = x+un _ = error "fail"++pg1 :: Set.Set PrecedenceProduction+pg1 =+ Set.fromList+ [ Infixr 2 (fromList' ["="])+ , Prefix 1 (fromList' ["λ", "."])+ , Closed (fromList' ["x"])+ , Closed (fromList' ["(", "$", ")"])+ ]++pg2 :: Set.Set PrecedenceProduction +pg2 = Set.fromList [Prefix 2 (fromList' ["if", " ", "then"]),+ Prefix 1 (fromList' ["if", "then", "else"]),+ Closed (fromList' ["x"])]++d :: Maybe ContextFree -> ContextFree+d (Just x) = x+d Nothing = ((NonTerminal . Text.pack) "", Set.empty)