├── .gitignore ├── .vscode └── tasks.json ├── LICENSE ├── README.md ├── RuCalculus.cabal ├── Setup.hs ├── doc ├── Manual.md └── Tutorial1.md ├── libru ├── 列.入 ├── 序对.入 └── 甲.入 ├── samples ├── 入.入 ├── 合并.入 ├── 对.入 ├── 导数.入 ├── 小于.入 ├── 引.入 ├── 快排.入 ├── 斐氏列.入 ├── 斐氏列线性.入 ├── 测.入 ├── 问好.入 └── 阶乘.入 ├── src ├── AST.hs ├── HostFuncs.hs ├── Interp.hs ├── Main.hs ├── MonadicParse.hs └── TypeChecker.hs └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | stack.yaml.lock 3 | 4 | .vscode 5 | 6 | dist 7 | dist-* 8 | cabal-dev 9 | *.o 10 | *.hi 11 | *.hie 12 | *.chi 13 | *.chs.h 14 | *.dyn_o 15 | *.dyn_hi 16 | .hpc 17 | .hsenv 18 | .cabal-sandbox/ 19 | cabal.sandbox.config 20 | *.prof 21 | *.aux 22 | *.hp 23 | *.eventlog 24 | .stack-work/ 25 | cabal.project.local 26 | cabal.project.local~ 27 | .HTF/ 28 | .ghc.environment.* 29 | -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | 2 | { 3 | // Automatically created by phoityne-vscode extension. 4 | 5 | "version": "2.0.0", 6 | "presentation": { 7 | "reveal": "always", 8 | "panel": "new" 9 | }, 10 | "tasks": [ 11 | { 12 | // F7 13 | "group": { 14 | "kind": "build", 15 | "isDefault": true 16 | }, 17 | "label": "haskell build", 18 | "type": "shell", 19 | //"command": "cabal configure && cabal build" 20 | "command": "stack build" 21 | }, 22 | { 23 | // F6 24 | "group": "build", 25 | "type": "shell", 26 | "label": "haskell clean & build", 27 | //"command": "cabal clean && cabal configure && cabal build" 28 | "command": "stack clean && stack build" 29 | //"command": "stack clean ; stack build" // for powershell 30 | }, 31 | { 32 | // F8 33 | "group": { 34 | "kind": "test", 35 | "isDefault": true 36 | }, 37 | "type": "shell", 38 | "label": "haskell test", 39 | //"command": "cabal test" 40 | "command": "stack test" 41 | }, 42 | { 43 | // F6 44 | "isBackground": true, 45 | "type": "shell", 46 | "label": "haskell watch", 47 | "command": "stack build --test --no-run-tests --file-watch" 48 | } 49 | ] 50 | } 51 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 入墨答（Rumbda Calculus） 2 | 3 | "入墨答"（又称Rumbda Calculus，RuCalculus，入算术，或者入语言）是一种用中文表示lambda演算的函数式编程语言。该项目致力于让lambda演算贴合中文（文言文），因而加入大量变种语法以适应各类语言习惯。 由于基于lambda演算，在很多情况下入语言的代码将会更加清晰而简练（例如[斐氏列线性.入](./samples/斐氏列线性.入)和[快排.入](./samples/快排.入)） 。 4 | 5 | - 入墨答是lambda的谐音 6 | - 入象征λ 7 | - 墨，即笔墨，象征汉字 8 | - 答，即答题，象征演算 9 | - 故，入墨答即为“λ汉字演算”。 10 | 11 | 12 | 项目刚刚启动，功能和文档尚不完全，欢迎贡献任何力量。 13 | 14 | ## Quick Start 15 | 16 | 使用入语言解释器： 17 | ``` 18 | RuCalculus 源代码.入 19 | RuCalculus 源代码.入 -d # 逐步打印演算过程 20 | ``` 21 | 22 | 使用stack启动入语言解释器： 23 | ``` 24 | stack run -- 源代码.入 25 | ``` 26 | 27 | ## Highlight grammar features 28 | 29 | - 入 30 | ``` 31 | 入甲得甲 // 等价于 lambda x. x， 如你所见，入是lambda的象形文字 32 | ``` 33 | - 自带丫（y组合子）的let 34 | ``` 35 | 以甲为1 // 等价于 let 甲 = 1 36 | 以函为入甲得甲 // 差不多等价于 function 函(甲) {return 甲} 37 | ``` 38 | - 单参数函数多种语序、更符合中文习惯： 39 | ``` 40 | 甲之【平方】 // 等价于 square x，相当于 pipeline，左结合 41 | 【平方】取甲者 // 等价于 square x 42 | 【平方】取根为甲者 // 等价于 square x，但“根”在语法中并无实际含义，仅增加可读性 43 | ``` 44 | - 双参数函数求值的多变语法： 45 | ``` 46 | 甲与乙之和 // 等价于 ((和 甲) 乙) 47 | 甲与乙相等 // 等价于 ((等 甲) 乙) 48 | 甲亏于乙 // 等价于 ((亏 甲) 乙)，也就是甲小于乙 49 | ``` 50 | - 多参数函数科里化： 51 | ``` 52 | 甲之盈 // 等价于 lambda y. greater x y，即取甲“盈”过的数，也就是判断是否小于甲的函数 53 | ``` 54 | - 另外，除了用于标识符分词的方括号【】外，各种标点符号、空白字符均可任意增减，仅为美观，无实际语义 55 | 56 | ## Sample 57 | 58 | ``` 59 | 以【快速排序】为： 60 | 入列 61 | 令列同于元时取元 62 | 否则 63 | 以【首项】为：列之首 64 | 以【亏列】为：筛取【原列】为列者、取【条件】为【首项】之盈者 // 此处可莉化，filter函数为：入甲 得 首项 盈于 甲，即筛选比首项小的元素 65 | 以【等列】为：筛取【原列】为列者、取【条件】为【首项】之等者 66 | 以【盈列】为：筛取【原列】为列者、取【条件】为【首项】之亏者 67 | 以【亏序】为：【亏列】之【快速排序】 // 递归 68 | 以【盈序】为：【盈列】之【快速排序】 69 | 则得【亏序】衔于【等列】衔于【盈序】 70 | ``` 71 | 72 | 在[samples](./samples/)目录下可以查看现有的范例程序。 73 | 74 | ## A poem 75 | 76 | ``` 77 | 丫 78 | SOL 79 | 入函入程程再程 |注: lambda 函 lambda 程.. (程 程) 80 | 取之再函复其声 |注: 函(...)，相当于重复下一个式子，即复其声 81 | 入式得函式之式 |注: (...) lambda 式 函(式 式) 82 | 即入新式唤自身 |注: (...)式 = 式(...)式，成为y组合子，实现递归，即唤(call)自身 83 | ``` 84 | 85 | ## Documents 86 | 87 | - [语法手册](./doc/Manual.md) 88 | - [教程1：入门](./doc/Tutorial1.md) 89 | 90 | ## Acknowledgements 91 | 92 | 这些是灵感来源： 93 | - [wenyan-lang](https://github.com/wenyan-lang/wenyan) 94 | - [yuyan](https://github.com/yuyan-lang/yuyan/) 95 | - [dongbei](https://github.com/zhanyong-wan/dongbei) 96 | 97 | 这些是编译/解释器优化方案： 98 | _暂无_ 99 | -------------------------------------------------------------------------------- /RuCalculus.cabal: -------------------------------------------------------------------------------- 1 | name: RuCalculus 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | license: Apache 6 | license-file: LICENSE 7 | build-type: Simple 8 | cabal-version: >=1.10 9 | extra-source-files: README.md 10 | 11 | executable RuCalculus 12 | hs-source-dirs: src 13 | main-is: Main.hs 14 | other-modules: AST 15 | , TypeChecker 16 | , HostFuncs 17 | , MonadicParse 18 | , Interp 19 | default-language: Haskell2010 20 | build-depends: base >= 4.7 && < 5 21 | , parsec 22 | , unicode-show 23 | , mtl 24 | , containers 25 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /doc/Manual.md: -------------------------------------------------------------------------------- 1 | # Manual 2 | 3 | ## 语法特性 4 | 5 | 基本语法 6 | 7 | | 关键词 | 解释 | 例 | Formal | 备注 | 8 | | ------------- | ---------- | ------------- | ----------- | ---- | 9 | | 入..得 | lambda | 入甲得甲 | lambda x. x | | 10 | | 取..者 | app | 函取甲者 | f x | | 11 | | 取..为..者 | app | 函取参为甲者 | f x | “参”无实际意义，仅为语法通顺；并不要求参的名称与lambda所给参数名相同。 | 12 | | 之 | 后序app | 甲之函 | f x | 可实现pipeline，如甲之【函1】之【函2】。 | 13 | | ..与..之 | 二元函数app | 甲与乙之和 | + x y | 可以科里化，相当于传入两个参数。 | 14 | | 【】 | 多字标识符 | 【埃克斯】 | x | 【甲】与甲并不是同一个标识符。 | 15 | 16 | 语法糖 17 | 18 | | 关键词 | 解释 | 例 | Formal | 备注 | 19 | | ------------- | ---------- | ------------- | ----------- | ---- | 20 | | “” | 字符串常量 | “你好，入语言” | | 与haskell类似，字符串是list的语法糖，而list是用pair实现的。详见“序对.入”和“列.入”。 | 21 | | 以..为..则 | let | 以甲为1则甲 | let x = 1 in x | 自带y组合子，可以递归。| 22 | | 令..时取..否则 | if else | 令甲等于1时取1否则取0 | if x=1 then 1 else 0 | 可以多个令嵌套。 | 23 | | ..与..相 | 二元函数求值 | 甲与乙相等 | = x y | 等价于..与..之。 | 24 | | .. 于 | 二元函数求值 | 甲盈于乙 | > x y | 等价于..与..之。 | 25 | | 引 | include | 引【./libru/甲.入】 | | 目前仅支持以当前路径（pwd）为相对路径寻址，本质上相当于Y组合子。 | 26 | 27 | 28 | ## 基于haskell的库函数 29 | 30 | 这些函数将被自动包含。 31 | 32 | | 名称 | 功能 | lazy eval | 33 | | ------------- | --------------------------------- | ------- | 34 | | 真 | 二者取前者（丘奇布尔） | 是 | 35 | | 伪 | 二者取后者（丘奇布尔） | 是 | 36 | | 和 | 加法 | 否 | 37 | | 差 | 减法 | 否 | 38 | | 盈 | 大于 | 否 | 39 | | 亏 | 小于 | 否 | 40 | | 【或盈】 | 大于等于 | 否 | 41 | | 【或亏】 | 小于等于 | 否 | 42 | | 积 | 乘法 | 否 | 43 | | 商 | 除法 | 否 | 44 | | 余 | 除法求余数（haskell mod） | 否 | 45 | | 同 | 相等；若类型不同为false | 否 | 46 | | 等 | 相等；若类型不同则报错 | 否 | 47 | | 异 | 不相等；若类型不同也为真 | 否 | 48 | | 书 | 打印值 | 否 | 49 | | 【活字印刷】 | 打印值对应的unicode汉字 | 否 | 50 | 51 | ## 基于入的库函数 52 | 53 | 这些函数需要手动“引”。 54 | 55 | ### 序对.入 56 | 57 | | 名称 | 参数 | 功能 | 58 | | ------------- | --------------------- | ------------------------------------- | 59 | | 对 | 入甲，入乙，入【首次】 | 构造一个有序对；可根据【首次】选择前后项 | 60 | | 前 | 入甲，入乙 | 二者取前者（丘奇布尔），对取前者 | 61 | | 后 | 入甲，入乙 | 二者取后者（丘奇布尔），对取后者 | 62 | | 首 | 入对 | 序对取前者，对之首 （请结合“之”与“取”的含义理解）| 63 | | 次 | 入对 | 序对取后者，对之次 | 64 | 65 | ### 列.入 66 | 67 | | 名称 | 参数 | 功能 | 68 | | ------------- | --------------------- | ------------------------------------- | 69 | | 衔 | 入【列1】，入【列2】 | 衔接两个列表 | 70 | | 筛 | 入【原列】，入【条件】 | 筛选列表中符合条件的元素 | 71 | | 【列印】 | 入列 | 打印列表元素 | 72 | | 【串印】 | 入串 | 打印字符串 | 73 | -------------------------------------------------------------------------------- /doc/Tutorial1.md: -------------------------------------------------------------------------------- 1 | # Tutorial 1：入门 2 | 3 | ## 从“入”门开始 4 | 5 | 正如你所见，入演算名字中的“入”是lambda的象形文字。入演算本质上是一个无类型lambda演算，所以熟悉函数式编程的用户应该能很快通过[速查手册](Manual.md)来理解它的功能。不过无论如何，我们都从头开始。 6 | 7 | 和其他所有的tutorial一样， 我们将会以打印“你好，入语言！”作为我们的终极目标。但是作为一个函数式语言，想要达到这一目的并没有那么简单。 8 | 9 | ### 头等函数 10 | 11 | 头等函数（First Class Function），或者第一类函数，是指函数是入语言的一等公民。和其他函数式语言类似，一切都是函数。常数是函数，入表达式是函数，application也是函数。 12 | 13 | ### 入表达式 14 | 15 | 最简单的入语言程序是一个入（即lambda，下同）表达式。它表示一个匿名函数。例如： 16 | ``` 17 | 入甲得甲 18 | ``` 19 | 20 | 它相当于： 21 | ``` 22 | lambda x. x 23 | ``` 24 | 25 | 也就是一个“将参数映射到其自身”的函数（俗称id函数）。比较凑巧的是，入字不仅仅和lambda长得很像，而且恰有“输入参数”的意思。 26 | 27 | 运行你会得到： 28 | 29 | ``` 30 | (lambda "甲" . "甲") 31 | ``` 32 | 33 | 它被解析为了类似于lambda表达式的格式，但是变量名会保留。 34 | 35 | ### Application 36 | 37 | 为函数提供参数可以apply。例如： 38 | 39 | ``` 40 | 1之入甲得甲 41 | ``` 42 | 43 | 对应的lambda是： 44 | ``` 45 | (lambda x. x) 1 46 | ``` 47 | 48 | 你会得到输出： 49 | ``` 50 | (ValInt 1) 51 | ``` 52 | 53 | 这里ValInt表示它是一个整数。 54 | 55 | ### 优先级 56 | 57 | 那么我们尝试另一种写法： 58 | 59 | ``` 60 | 入甲得甲，取甲为1者 61 | ``` 62 | 63 | 你可能会期待得到和上一个案例同样的输出，但是实际上你会得到： 64 | 65 | ``` 66 | (lambda "甲" . (apply "甲" (ValInt 1))) 67 | ``` 68 | 69 | 可以看到，入语言将后续的整个部分当做了lambda表达式的函数部分。这是因为入语言会进行贪心匹配尽可能长的源代码，而后半部分“甲取甲为1者”也是一个合法的表达式。 70 | 71 | 遗憾的是，为了贴合文言文中并没有标点符号的习惯，入语言并没有括号，所以一元函数和二元函数之间会有二义性。但是我们也有其他的解决方法。 72 | 73 | ### 以为 74 | 75 | 接下来我们使用let来规避上面的问题。 76 | 77 | ``` 78 | 以自为入甲得甲 79 | 则自取1者 80 | ``` 81 | 82 | 这样我们就为id函数取了一个中文名：“自”。然后再对1使用“自”函数，得到的当然就是它自己。在手册中提到了“以..为”语法是自带y组合子的。对于不熟悉y组合子的用户，可以先不了解它，只需要知道它可以让函数的名字对函数内部可见，从而可以实现递归。 83 | 84 | ### 二元函数 85 | 86 | 很多常见的运算都是二元运算。在入语言当中，它们当然也是函数。 87 | 88 | ``` 89 | 入甲入乙得甲与乙之和 90 | ``` 91 | 92 | 得到的结果是 93 | ``` 94 | (lambda "甲" . (lambda "乙" . (apply (apply <和: (? -> (? -> ?))> "甲") "乙"))) 95 | ``` 96 | 97 | 简单来说，就是先输入两个参数，然后将“和函数”应用到它们上面。 98 | 99 | ### 二元函数求值 100 | 101 | 接下来的这个程序将会同时展示以“之”格式和“取”格式求值的方法。它们唯一的区别在于函数一个在前、一个在后。 102 | 103 | ``` 104 | 以【加法】为：入甲入乙得甲与乙之和 105 | 则【加法】取甲为1者取乙为2者 106 | ``` 107 | 108 | 方括号【】是用来支持多余一个汉字的标识符的，因为中文没有空格，我们只能通过这样的方式来进行分词。我们基于自带函数“和”定义了一个两个整数相加的函数“【加法】”。事实上，“【加法】”与“和”是等价的。 109 | 110 | 之后，我们对【加法】分别进行了两次“取”，输入了两个参数。于是【加法】函数计算了二者之和。 111 | 112 | ``` 113 | (ValInt 3) 114 | ``` 115 | 116 | 顺带一提，虽然程序里面有换行、空格、冒号等符号，但是对于入语言而言它们没有意义，都是可以省略的。加上仅仅是为了美观。 117 | 118 | ### 科里化 119 | 120 | 我们可以看看对于一个二元函数如果只给定一个参数会发生什么。 121 | 122 | ``` 123 | 以【加法】为：入甲入乙得甲与乙之和 124 | 则【加法】取甲为1者 125 | ``` 126 | 127 | 输出为 128 | 129 | ``` 130 | (lambda "乙" . (apply (apply <和: (? -> (? -> ?))> (ValInt 1)) "乙")) 131 | ``` 132 | 133 | 可以看到，我们得到的是一个一元函数，接受一个“乙”参数，然后将和函数应用于1与乙之上。这个1替代了原本“甲”的位置，是因为“取甲为1者”将1作为参数送给了函数的第一个“形参”（这里借用一下过程式语言的概念）。这样“每次只给一个参数”的演算方法被称为“科里化”。 134 | 135 | ## 列表 136 | 137 | 但是我们现在离打印一个字符串还很远。因为我们的基础数据类型只有ValInt（整数）和ValNum（实数），并没有ValString。虽然我们可以用ValInt存储unicode编码，但也只解决了单个字符Char的问题。我们需要列表来把Char串成String。 138 | 139 | ### 有序对（二元组） 140 | 141 | 一个有序对就是两个值甲、乙，并且提供一个机制来选择是甲还是乙。当然，它也是函数。实现有序对可以参考之前科里化的思路：先输入两个值，然后再输入一个“【首次】”函数，来选择到底是首还是次。 142 | 143 | ``` 144 | 以对为：入甲入乙入【首次】得甲与乙之【首次】 145 | 则1与2之对 146 | ``` 147 | 148 | 结果为： 149 | 150 | ``` 151 | (lambda "【首次】" . (apply (apply "【首次】" (ValInt 1)) (ValInt 2))) 152 | ``` 153 | 154 | 可以看到，1和2的值已经被科里化“写入”了这个函数，只需要再来一个“首次”来选择它们。而首次的实现就更简单了： 155 | 156 | ``` 157 | 以前为：入甲入乙得甲 158 | 以后为：入甲入乙得乙 159 | ``` 160 | 161 | 很明显，前就是两个数取前面那个，后就是两个数取后面那个。完整代码： 162 | 163 | ``` 164 | 以对为：入甲入乙入【首次】得甲与乙之【首次】 165 | 166 | 以前为：入甲入乙得甲 167 | 以后为：入甲入乙得乙 168 | 169 | 以【一二】为：1与2之对 170 | 171 | 则 【一二】取前者 172 | ``` 173 | 174 | 打印出了“前者”，也就是： 175 | 176 | ``` 177 | (ValInt 1) 178 | ``` 179 | 180 | ### 递归 181 | 182 | 函数可以调用自己，来实现更为复杂的功能。我们以最经典的递归案例：求阶乘，作为例子。 183 | 184 | 一个正整数的阶乘等于从它到1的所有整数之积。0的阶乘是1。据此，我们可以大致得到思路： 185 | 186 | - 如果参数甲和0相同，值为1 187 | - 否则，值为甲和“甲减一的阶乘”之积 188 | 189 | 写成入就是： 190 | 191 | ``` 192 | 以【阶乘】为： 193 | 入甲 194 | 令甲等于0时取1 195 | 否则取甲与【阶乘】取甲与1之差者之积 196 | 197 | 则10之【阶乘】 198 | ``` 199 | 200 | 结果为： 201 | 202 | ``` 203 | (ValInt 3628800) 204 | ``` 205 | 206 | 可以看到入语言还是相当通顺的。 207 | 208 | ### 链表 209 | 210 | 有数据结构基础的用户应该知道，列表可以用链表实现，而链表的节点包含一个数据项和一个next项、且最后一项的next为0。这和刚刚定义的“序对”是一致的。因此我们可以用链表来实现列表。 211 | 212 | 对于每一个元素，我们令“前者”为数据项，“后者”为列表剩下的部分，然后，我们用一个叫做“元”的东西表示空。即： 213 | 214 | ``` 215 | 引【./libru/列.入】 216 | 217 | 以列为 218 | 1与2与3与元之对之对之对 219 | ``` 220 | 221 | 如果用(first, second)来表示一个序对，那么这个列就是： 222 | 223 | ``` 224 | (1, (2, (3, null))) 225 | ``` 226 | 227 | 执行上述代码，得到的结果是相似的： 228 | 229 | ``` 230 | (lambda "【首次】" . (apply (apply "【首次】" (ValInt 1)) (lambda "【首次】" . (apply (apply "【首次】" (ValInt 2)) (lambda "【首次】" . (apply (apply "【首次】" (ValInt 3)) (ValUnit))))))) 231 | ``` 232 | 233 | ### 列印 234 | 235 | 接下来我们要打印列表。打印列表和构造列表正好相反：每次只需要打印列表的第一个元素，然后递归调用列印打印剩下的部分。由于我们用“元”作为列表的结束，所以如果当前列表是“元”，递归就停下来。 236 | 237 | ``` 238 | 引【./libru/序对.入】 239 | 240 | 以【列印】为： 241 | 入列 242 | 令列与元相同时取元 243 | 否则 244 | 以_为列之首之书， 245 | 以_为【列印】取列为列之次者 246 | 则得元 247 | 248 | 以列为： 249 | 1与2与3与元之对之对之对 250 | 251 | 则列之【列印】 252 | ``` 253 | 254 | 这里我们使用了引来避免重复定义“序对”。另外，我们使用了_这个名字，来忽略掉用不到的求值结果；但是_仅仅是一个标识符而已。同样，这个函数的返回值也是无用的，所以我们返回了“元”。 255 | 256 | 打印的结果为： 257 | 258 | ``` 259 | (ValInt 1)(ValInt 2)(ValInt 3) 260 | ``` 261 | 262 | 实际上，【./libru/列.入】里面自带了一个美化了打印结果的【列印】函数，不需要自己再定义了。 263 | 264 | ### 丘奇布尔 265 | 266 | 为了思路的连贯性，我们刚刚跳过了对“令……时取”的解释，即便它是自明的。这里还是补充解释一下。 267 | 268 | 令语法本身也是一个语法糖，是为了实现if-then-else的效果，根据条件从两个或更多取值中选择一个。还记得如何从序对中选择元素吗？ 269 | 270 | ``` 271 | 以真为入甲入乙得甲 272 | 以伪为入甲入乙得乙 273 | ``` 274 | 275 | 这样，如果条件为真，那么就会得到一个“取前者”的真函数，这样就会选择紧跟着“取”后面的第一个选项。否则，就会得到“取后者”的伪函数，从而选择第二个选项。在第二个选项中，我们也可以递归地选择第一个或者第二个，直到某一个条件满足为止。 276 | 277 | 这一实现被称为丘奇布尔。 278 | 279 | ### 串 280 | 281 | 现在终于有了列表，我们可以定义字符串了。正如前文所说，字符串可以用整数列表实现。入语言内置了语法糖来实现字符串到列表的转化，我们可以直接使用： 282 | 283 | ``` 284 | 引【./libru/列.入】 285 | 286 | 以串为“123” 287 | 288 | 则串 289 | ``` 290 | 291 | 结果为： 292 | ``` 293 | (lambda "【首次】" . (apply (apply "【首次】" (ValInt 49)) (lambda "【首次】" . (apply (apply "【首次】" (ValInt 50)) (lambda "【首次】" . (apply (apply "【首次】" (ValInt 51)) (ValUnit))))))) 294 | ``` 295 | 296 | 我们可以注意到这个结果的形式和刚刚用“对”手动构造的列表非常相似，只不过数值是49，50和51。熟悉ascii码的用户应该能注意到它们正是'1'、'2'和'3'的ascii码。 297 | 298 | ### 串印 299 | 300 | 最后我们来打印字符串。有一个问题在于，我们存的是ValInt，该如何转化为对应的字符呢？ 301 | 302 | 所幸入语言提供了【活字印刷】术，可以直接调用并打印单个整数对应的汉字。仿造刚才列印的思路，我们有： 303 | 304 | ``` 305 | 以【串印】为： 306 | 入列 307 | 令列与元相同时取元 308 | 否则 309 | 以甲为列之首之【活字印刷】， 310 | 以乙为列之次之【串印】， 311 | 则得元 312 | ``` 313 | 314 | ### 你好，入语言！ 315 | 316 | 最后我们来享受我们的成果。上面这些函数都由【./libru/列.入】提供，我们只需要“引”用一下： 317 | 318 | ``` 319 | 引【./libru/列.入】 320 | 321 | 以串为“你好，入语言！” 322 | 则串之【串印】 323 | ``` 324 | 325 | 终于，屏幕上出现了 326 | 327 | ``` 328 | 你好，入语言！ 329 | ``` 330 | 331 | 万事开头难，虽然还有很多问题没有解释，但是这意味着我们终于走出了第一步。 332 | 333 | 下一篇教程（正在编写中）将会介绍入语言的一些特性和陷阱。 334 | -------------------------------------------------------------------------------- /libru/列.入: -------------------------------------------------------------------------------- 1 | 引【./libru/序对.入】 2 | 3 | 以衔为： 4 | 入甲入乙 5 | 令甲与元相同时取乙 6 | 否则 7 | 以【首项】为甲之首 8 | 以【余列】为甲之次 9 | 以【并列】为衔取【余列】者、取乙者 10 | 则得【首项】与【并列】之对 11 | 12 | 以筛为： 13 | 入列入【可取】 14 | 令列与元相同时取元 15 | 否则 16 | 以【首项】为列之首 17 | 以【余列】为列之次 18 | 以【筛列】为筛取【余列】者、取【可取】者 19 | 则得 20 | 令【首项】之【可取】时取【首项】与【筛列】之对 21 | 否则取【筛列】 22 | 23 | 以【串印】为： 24 | 入列 25 | 令列与元相同时取元 26 | 否则 27 | 以甲为列之首之【活字印刷】， 28 | 以乙为列之次之【串印】， 29 | 则得元 30 | 31 | 以【列印'】为： 32 | 入列入【前缀】 33 | 令列与元相同时取元 34 | 否则 35 | 以_为【前缀】之【串印】， 36 | 以_为列之首之书， 37 | 以符为 38 | 令列之次同于元时取“” 39 | 否则取“， 40 | ”， 41 | 以_为符之【串印】， 42 | 以_为【列印'】取列为列之次者、取【前缀】为“ ”者， 43 | 则得元 44 | 45 | 以【列印】为： 46 | 入列，得 47 | 以_为“【”之【串印】 48 | 以_为【列印'】取列为列者、取【前缀】为“”者 49 | 以_为“】”之【串印】 50 | 则得元 51 | -------------------------------------------------------------------------------- /libru/序对.入: -------------------------------------------------------------------------------- 1 | 以对为：入甲入乙入【首次】得甲与乙之【首次】 2 | 以前为：入甲入乙得甲 3 | 以后为：入甲入乙得乙 4 | 以首为：入对得对取前者 5 | 以次为：入对得对取后者 6 | -------------------------------------------------------------------------------- /libru/甲.入: -------------------------------------------------------------------------------- 1 | 以甲为1 -------------------------------------------------------------------------------- /samples/入.入: -------------------------------------------------------------------------------- 1 | 以【加法】为：入甲入乙得甲与乙之和 2 | 则【加法】取甲为1者取乙为2者 -------------------------------------------------------------------------------- /samples/合并.入: -------------------------------------------------------------------------------- 1 | 引【./libru/列.入】 2 | 3 | 以【合并】为： 4 | 入甲入乙 5 | 令甲与元相同时取乙 6 | 否则 7 | 以【首项】为甲之首 8 | 以【余列】为甲之次 9 | 以【并列】为【合并】取【余列】者、取乙者 10 | 则得【首项】与【并列】之对 11 | 12 | 以【列一】为1与2与3与元之对之对之对 13 | 以【列二】为4与5与6与元之对之对之对 14 | 以【并列】为【列一】与【列二】之【合并】 15 | 16 | 则【并列】之【列印】 -------------------------------------------------------------------------------- /samples/对.入: -------------------------------------------------------------------------------- 1 | 引【./libru/列.入】 2 | 3 | 以列为 4 | 1与2与3与元之对之对之对 5 | 6 | 则得列之【列印】 -------------------------------------------------------------------------------- /samples/导数.入: -------------------------------------------------------------------------------- 1 | 以【微元】为0.01， 2 | 以【导数】为入函入甲得：函取甲与【微元】之和者，与函取甲者之差，与【微元】之商， 3 | 以【二次元】为入甲得甲与甲之积， 4 | 并以【二次元之导数】为【二次元】之【导数】，则 5 | 3.0之【二次元之导数】 -------------------------------------------------------------------------------- /samples/小于.入: -------------------------------------------------------------------------------- 1 | 引【./libru/列.入】 2 | 3 | 以甲为 令 1 盈于 2 时取1否则取0 4 | 以乙为 令 1 亏于 2 时取1否则取0 5 | 以丙为 令 1 【或盈】于 2 时取1否则取0 6 | 以丁为 令 1 【或亏】于 2 时取1否则取0 7 | 以戊为 令 1 【或盈】于 1 时取1否则取0 8 | 以己为 令 1 【或亏】于 1 时取1否则取0 9 | 以庚为 令 1 等于 1 时取1否则取0 10 | 11 | 以列为 12 | 甲与乙与丙与丁与戊与己与庚与元之对之对之对之对之对之对之对 13 | 14 | 则列之【列印】 -------------------------------------------------------------------------------- /samples/引.入: -------------------------------------------------------------------------------- 1 | 引【./libru/甲.入】 2 | 3 | 甲 -------------------------------------------------------------------------------- /samples/快排.入: -------------------------------------------------------------------------------- 1 | 引【./libru/列.入】 2 | 3 | 以【快速排序】为： 4 | 入列 5 | 令列同于元时取元 6 | 否则 7 | 以【首项】为：列之首 8 | 以【亏列】为：筛取【原列】为列者、取【条件】为【首项】之盈者 9 | 以【等列】为：筛取【原列】为列者、取【条件】为【首项】之等者 10 | 以【盈列】为：筛取【原列】为列者、取【条件】为【首项】之亏者 11 | 以【亏序】为：【亏列】之【快速排序】 12 | 以【盈序】为：【盈列】之【快速排序】 13 | 则得【亏序】衔于【等列】衔于【盈序】 14 | 15 | 以【列一】为8与1与7与2与6与3与5与4与元之对之对之对之对之对之对之对之对 16 | 以【列二】为1与3与5与7与2与4与6与8与元之对之对之对之对之对之对之对之对 17 | 以【列三】为【列一】衔于【列二】 18 | 以【列四】为【列三】之【快速排序】 19 | 20 | 则【列四】之【列印】 -------------------------------------------------------------------------------- /samples/斐氏列.入: -------------------------------------------------------------------------------- 1 | 引【./libru/列.入】 2 | 3 | 以【斐氏列项】为： 4 | 入甲 5 | 令甲与0相等时取1 6 | 令甲与1相等时取1 7 | 否则取【斐氏列项】取甲与1之差者与【斐氏列项】取甲与2之差者之和 8 | 9 | 以【斐氏列】为： 10 | 入甲 11 | 令甲与0相等时取元 12 | 否则取 13 | 【斐氏列项】取甲者 14 | 与 15 | 【斐氏列】取甲与1之差者 16 | 之对 17 | 18 | 则【斐氏列】取10者之【列印】 -------------------------------------------------------------------------------- /samples/斐氏列线性.入: -------------------------------------------------------------------------------- 1 | 引【./libru/列.入】 2 | 3 | 以【斐氏列】为： 4 | 入甲 5 | 令甲与0相等时取1与元之对 6 | 令甲与1相等时取1与1与元之对之对 7 | 否则 8 | 以【前项】为【斐氏列】取甲与1之差者， 9 | 以【甲减一】为【前项】之首， 10 | 以【甲减二】为【前项】之次之首， 11 | 并以【新项】为【甲减一】与【甲减二】之和 12 | 则得 13 | 【新项】与【前项】之对 14 | 15 | 则【斐氏列】取200者之【列印】 -------------------------------------------------------------------------------- /samples/测.入: -------------------------------------------------------------------------------- 1 | 以函为： 2 | 入甲得 3 | 令甲与1相同时取1 4 | 否则取0 5 | 则1之函 -------------------------------------------------------------------------------- /samples/问好.入: -------------------------------------------------------------------------------- 1 | 引【./libru/列.入】 2 | 3 | 以串为“你好，入语言！” 4 | 则串之【串印】 -------------------------------------------------------------------------------- /samples/阶乘.入: -------------------------------------------------------------------------------- 1 | 以【阶乘】为： 2 | 入甲 3 | 令甲与0相等时取1 4 | 否则取甲与【阶乘】取甲与1之差者之积 5 | 6 | 则10之【阶乘】 -------------------------------------------------------------------------------- /src/AST.hs: -------------------------------------------------------------------------------- 1 | module AST where 2 | import Text.Show.Unicode 3 | 4 | type Variable = String 5 | 6 | data ValueType 7 | = ValTypeInt 8 | | ValTypeNum 9 | | ValTypeUnit 10 | deriving Eq 11 | 12 | instance Show ValueType where 13 | show ValTypeInt = "整" 14 | show ValTypeNum = "实" 15 | show ValTypeUnit = "元" 16 | 17 | data Type 18 | = TypeVal ValueType 19 | | TypeFunc Type Type 20 | | TypeFuncDelay Variable Expr 21 | | TypeFuncDelayWithResultType Variable Expr Type 22 | 23 | instance Show Type where 24 | show (TypeVal v) = show v 25 | show (TypeFunc a b) = "(" ++ show a ++ " -> " ++ show b ++ ")" 26 | show (TypeFuncDelay _ _) = "(? -> ?)" 27 | show (TypeFuncDelayWithResultType _ _ t) = "(? -> " ++ show t ++ ")" 28 | 29 | data Value 30 | = ValInt Integer 31 | | ValNum Double 32 | | ValUnit 33 | | ValPair Value Value 34 | deriving (Show, Eq, Ord) 35 | 36 | type IsLazy = Bool 37 | 38 | data Expr 39 | = ExprVar Variable 40 | | ExprLambda Variable Expr 41 | | ExprApply Expr Expr 42 | | ExprValue Value 43 | | ExprHostFunc String Type IsLazy (Expr -> IO (Either String Expr)) 44 | | ExprInclude Variable Expr 45 | 46 | instance Show Expr where 47 | show (ExprValue val) = "(" ++ ushow val ++ ")" 48 | show (ExprVar var) = ushow var 49 | show (ExprLambda var exp) = "(lambda " ++ ushow var ++ " . " ++ ushow exp ++ ")" 50 | show (ExprApply exp1 exp2) = "(apply " ++ ushow exp1 ++ " " ++ ushow exp2 ++ ")" 51 | show (ExprHostFunc name t _ _) = "<" ++ name ++ ": " ++ show t ++ ">" 52 | show (ExprInclude var exp) = "" 53 | -------------------------------------------------------------------------------- /src/HostFuncs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module HostFuncs where 3 | import AST 4 | import Data.Char 5 | import TypeChecker 6 | import Text.Show.Unicode 7 | 8 | type ParamsCount = Int 9 | type CurriedHostFunc = Expr -> IO (Either String Expr) 10 | type UncurriedHostFunc = [Expr] -> IO (Either String Expr) 11 | type HostFuncQuad = (String, Type, IsLazy, CurriedHostFunc) 12 | 13 | pack' :: IsLazy -> String -> Type -> ParamsCount -> UncurriedHostFunc -> [Expr] -> CurriedHostFunc 14 | pack' _ name t 1 f args = \arg -> f (reverse $ arg : args) 15 | pack' l name t n f args = \arg -> 16 | pure $ Right $ ExprHostFunc name t l $ pack' l name nextType (n - 1) f (arg : args) 17 | where nextType = case t of TypeFunc _ b -> b 18 | TypeFuncDelay a b -> TypeFuncDelay a b 19 | TypeFuncDelayWithResultType _ _ a -> a 20 | _ -> error "Can not pack function with non-function type" 21 | 22 | apply' :: Variable -> Expr -> Expr -> Expr 23 | apply' var val (ExprVar v) 24 | | v == var = val 25 | | otherwise = ExprVar v 26 | apply' var val (ExprLambda v e) 27 | | var == v = ExprLambda v e 28 | | otherwise = ExprLambda v $ apply' var val e 29 | apply' var val (ExprApply a b) = ExprApply (apply' var val a) (apply' var val b) 30 | apply' _ _ (ExprValue v) = ExprValue v 31 | apply' _ _ (ExprHostFunc name t isLazy f) = ExprHostFunc name t isLazy f 32 | apply' _ _ (ExprInclude v e) = ExprInclude v e 33 | 34 | injectHostFunctions :: [(String, Type, IsLazy, Expr -> IO (Either String Expr))] -> Expr -> Expr 35 | injectHostFunctions ls e = foldl (\e (name, t, l, f) -> apply' name (ExprHostFunc name t l f) e) e ls 36 | 37 | makeUntypedHostFuncType :: ParamsCount -> Type -> Type 38 | makeUntypedHostFuncType 0 resultType = resultType 39 | makeUntypedHostFuncType n resultType = 40 | TypeFuncDelayWithResultType "" (ExprVar "") $ makeUntypedHostFuncType (n - 1) resultType 41 | 42 | 43 | packUntyped :: IsLazy -> String -> ParamsCount -> UncurriedHostFunc -> HostFuncQuad 44 | packUntyped isLazy name params f 45 | | params <= 0 = error "packUntyped: params <= 0" 46 | | otherwise = 47 | (name, t, isLazy, pack' isLazy name t params f []) 48 | where 49 | dummyType = TypeFuncDelay "" $ ExprVar "" 50 | t = makeUntypedHostFuncType (params - 1) dummyType 51 | 52 | packResultTyped :: IsLazy -> String -> ParamsCount -> Type -> UncurriedHostFunc -> HostFuncQuad 53 | packResultTyped isLazy name params returnType f 54 | | params <= 0 = error "packResultTyped: params <= 0" 55 | | otherwise = 56 | (name, t, isLazy, pack' isLazy name t params f []) 57 | where t = makeUntypedHostFuncType params returnType 58 | 59 | packTyped :: IsLazy -> String -> [Type] -> Type -> UncurriedHostFunc -> HostFuncQuad 60 | packTyped isLazy name paramTypes returnType f 61 | | null paramTypes = error "packTyped: paramTypes is null." 62 | | otherwise = 63 | (name, typeOfFunc, isLazy, pack' isLazy name typeOfFunc (length paramTypes) f []) 64 | where typeOfFunc = foldr TypeFunc returnType paramTypes 65 | 66 | hostFuncs :: [HostFuncQuad] 67 | hostFuncs = 68 | [ 69 | true', 70 | false', 71 | 72 | sum, 73 | sub, 74 | prod, 75 | div, 76 | mod, 77 | 78 | gt, 79 | lt, 80 | ge, 81 | le, 82 | 83 | identical, 84 | equal, 85 | unequal, 86 | 87 | print', 88 | printZi 89 | ] 90 | where 91 | 92 | true' = packUntyped True "真" 2 $ \[a, b] -> pure $ Right $ a 93 | false' = packUntyped True "伪" 2 $ \[a, b] -> pure $ Right $ b 94 | 95 | boolean cond = do 96 | case (if cond then true' else false') of 97 | (name, t, l, f) -> (ExprHostFunc name t l f) 98 | 99 | sum = packUntyped False "和" 2 $ \[a, b] -> 100 | pure $ 101 | case (a, b) of 102 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ ExprValue $ ValInt $ a' + b' 103 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ ExprValue $ ValNum $ a' + b' 104 | (ExprValue (ValUnit), ExprValue (ValUnit)) -> Right $ ExprValue $ ValUnit 105 | _ -> Left "参数非数，且亦数类也" 106 | 107 | sub = packUntyped False "差" 2 $ \[a, b] -> 108 | pure $ case (a, b) of 109 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ ExprValue $ ValInt $ a' - b' 110 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ ExprValue $ ValNum $ a' - b' 111 | _ -> Left "参数非数也，且亦数类也" 112 | 113 | gt = packUntyped False "盈" 2 $ \[a, b] -> 114 | pure $ case (a, b) of 115 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ boolean $ a' > b' 116 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ boolean $ a' > b' 117 | _ -> Left "参数非数也，且亦数类也" 118 | 119 | lt = packUntyped False "亏" 2 $ \[a, b] -> 120 | pure $ case (a, b) of 121 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ boolean $ a' < b' 122 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ boolean $ a' < b' 123 | _ -> Left "参数非数也，且亦数类也" 124 | 125 | ge = packUntyped False "【或盈】" 2 $ \[a, b] -> 126 | pure $ case (a, b) of 127 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ boolean $ a' >= b' 128 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ boolean $ a' >= b' 129 | _ -> Left "参数非数也，且亦数类也" 130 | 131 | le = packUntyped False "【或亏】" 2 $ \[a, b] -> 132 | pure $ case (a, b) of 133 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ boolean $ a' <= b' 134 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ boolean $ a' <= b' 135 | _ -> Left "参数非数也，且亦数类也" 136 | 137 | prod = packUntyped False "积" 2 $ \[a, b] -> 138 | pure $ case (a, b) of 139 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ ExprValue $ ValInt $ a' * b' 140 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ ExprValue $ ValNum $ a' * b' 141 | _ -> Left "参数非数也，且亦数类也" 142 | 143 | div = packUntyped False "商" 2 $ \[a, b] -> 144 | pure $ case (a, b) of 145 | (ExprValue (ValInt _), ExprValue (ValInt 0)) -> Left "为法不能零" 146 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ ExprValue $ ValInt $ a' `Prelude.div` b' 147 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ ExprValue $ ValNum $ a' / b' 148 | _ -> Left "参数非数也，且亦数类也" 149 | 150 | mod = packUntyped False "余" 2 $ \[a, b] -> 151 | pure $ case (a, b) of 152 | (ExprValue (ValInt _), ExprValue (ValInt 0)) -> Left "为法不能零" 153 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ ExprValue $ ValInt $ a' `Prelude.mod` b' 154 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Left "不能实数求余" 155 | _ -> Left "参数非数也，且亦数类也" 156 | 157 | identical = packUntyped False "同" 2 $ \[a, b] -> 158 | pure $ case (a, b) of 159 | (ExprValue a', ExprValue b') -> Right $ boolean $ a' == b' 160 | _ -> Right $ boolean $ False 161 | 162 | equal = packUntyped False "等" 2 $ \[a, b] -> 163 | pure $ case (a, b) of 164 | (ExprValue a', ExprValue b') -> Right $ boolean $ a' == b' 165 | _ -> Left ((ushow a) ++ "与" ++ (ushow b) ++ "：参数非值也") 166 | 167 | unequal = packUntyped False "异" 2 $ \[a, b] -> 168 | pure $ case (a, b) of 169 | (ExprValue (ValInt a'), ExprValue (ValInt b')) -> Right $ boolean $ a' /= b' 170 | (ExprValue (ValNum a'), ExprValue (ValNum b')) -> Right $ boolean $ a' /= b' 171 | _ -> Right $ boolean $ True 172 | 173 | print' = packResultTyped False "书" 1 (TypeVal ValTypeUnit) $ \[a] -> 174 | putStr (show a) >> pure (Right $ ExprValue ValUnit) 175 | 176 | printZi = packResultTyped False "【活字印刷】" 1 (TypeVal ValTypeUnit) $ \[a] -> 177 | case (a) of 178 | ExprValue (ValInt a') -> putStr (urecover [chr (fromIntegral a' :: Int)]) >> pure (Right $ ExprValue ValUnit) 179 | _ -> pure $ Left ((ushow a) ++ "：参数非整数也，寻其活字而不得") 180 | 181 | 182 | -------------------------------------------------------------------------------- /src/Interp.hs: -------------------------------------------------------------------------------- 1 | 2 | module Interp where 3 | import AST 4 | import MonadicParse 5 | 6 | import Data.Map as M 7 | import Control.Monad.Except 8 | import Control.Exception 9 | import qualified Text.Parsec as Text.Parsec.Error 10 | import HostFuncs 11 | 12 | data Atom 13 | = AtomValue Value 14 | | AtomClos InterpEnv Variable Expr 15 | | AtomHost InterpEnv String Type IsLazy (Expr -> IO (Either String Expr)) 16 | 17 | instance Show Atom where 18 | show (AtomValue val) = show val 19 | show (AtomClos _ _ _) = "" 20 | show (AtomHost name _ _ _ _) = show name 21 | 22 | type InterpEnv = M.Map Variable Atom 23 | 24 | data InterpError 25 | = UnboundedVariable Variable 26 | | CannotApply Expr Expr 27 | | HostFuncError String 28 | | UnresolvedInclude 29 | | IncludeError Text.Parsec.Error.ParseError 30 | | NotAnAtom Expr 31 | deriving (Show) 32 | 33 | removeHeadTail :: String -> String 34 | removeHeadTail str = Prelude.filter (/='】') (Prelude.filter (/='【') str) 35 | 36 | interp :: InterpEnv -> Expr -> ExceptT InterpError IO Atom 37 | interp env (ExprValue val) = 38 | return $ AtomValue val 39 | interp env (ExprVar x) = 40 | case M.lookup x env of 41 | Just atom -> return atom 42 | Nothing -> throwError (UnboundedVariable x) 43 | interp env (ExprLambda x e) = 44 | return $ AtomClos env x e 45 | interp env (ExprApply e1 e2) = do 46 | e1' <- interp env e1 47 | case e1' of 48 | (AtomClos env' arg body) -> do 49 | e2' <- interp env e2 50 | interp (M.insert arg e2' env') body 51 | (AtomHost env' name typ isLazy f) -> do 52 | e2' <- if isLazy 53 | then return e2 54 | else do 55 | e2' <- interp env e2 56 | case e2' of 57 | AtomValue val -> return $ ExprValue val 58 | AtomClos env var expr -> return $ ExprLambda var expr 59 | _ -> throwError (NotAnAtom e2) 60 | res <- lift $ f e2' 61 | case res of 62 | Left err -> throwError (HostFuncError err) 63 | Right exp -> interp env exp 64 | _ -> throwError (CannotApply e1 e2) 65 | interp env (ExprHostFunc name t isLazy f) = 66 | return $ AtomHost env name t isLazy f 67 | interp env (ExprInclude var expr) = do 68 | lib <- lift $ parseRu (removeHeadTail var) expr 69 | case lib of 70 | Left err -> throwError $ IncludeError err 71 | Right exp -> interp env $ injectHostFunctions hostFuncs exp 72 | 73 | runInterp :: Expr -> IO (Either InterpError Atom) 74 | runInterp expr = runExceptT $ interp M.empty expr -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | 4 | module Main where 5 | 6 | import MonadicParse as MP 7 | import AST 8 | import HostFuncs 9 | import Text.Parsec 10 | import Text.Show.Unicode 11 | import qualified System.Environment 12 | import Interp 13 | 14 | data Option = Option { debug :: Bool, file :: Maybe String } 15 | 16 | parseOption :: Option -> [String] -> Either String Option 17 | parseOption o [] = Right o 18 | parseOption Option { debug = True } ("-d":_) = Left "\'-d\'标记仅可使用一次" 19 | parseOption o ("-d":xs) = parseOption o { debug = True } xs 20 | parseOption Option { file = Just _} (_:_) = Left "仅可指定一个要执行的文件" 21 | parseOption o (file:xs) = parseOption o { file = Just file } xs 22 | 23 | help :: IO () 24 | help = putStr $ unlines 25 | [ 26 | "入算术", 27 | "作者（排名分先后）：SOL、AntonPing、许兴逸", 28 | "", 29 | "行此术：", 30 | " ./RuCalculus ", 31 | "" 32 | ] 33 | 34 | runProgram :: Option -> IO () 35 | runProgram Option { debug = debug, file = Just file } = 36 | let expr = parseRu file (AST.ExprValue AST.ValUnit) 37 | runCode = runInterp . injectHostFunctions hostFuncs in 38 | expr >>= \case 39 | Left err -> print err 40 | Right x -> do 41 | res <- runCode x 42 | case res of 43 | Left err -> print err 44 | Right (AtomValue ValUnit) -> putStrLn "" 45 | Right atom -> print atom 46 | return () 47 | runProgram _ = help 48 | 49 | main :: IO () 50 | main = System.Environment.getArgs >>= either putStrLn runProgram . parseOption Option { debug = False, file = Nothing } 51 | -------------------------------------------------------------------------------- /src/MonadicParse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | module MonadicParse where 4 | import AST 5 | import Data.Char 6 | import Text.Parsec 7 | import qualified Text.Parsec.Token as P 8 | import Text.Parsec.Language (haskellDef) 9 | import Text.Parsec.String (parseFromFile) 10 | 11 | ruChar :: Parsec String st Char 12 | ruChar = noneOf "令时入之取者也以为并否则即元引【】" 13 | 14 | ruWhiteSpace :: Parsec String st Char 15 | ruWhiteSpace = oneOf " \t\n、，：！？得。" 16 | 17 | ruSpaces :: Parsec String st () 18 | ruSpaces = optional (many ruWhiteSpace) 19 | 20 | concatParser :: [Parsec String st String] -> (Parsec String st String) 21 | concatParser [] = error "此列为空" 22 | concatParser [s] = s 23 | concatParser (s:xs) = fmap (++) s <*> concatParser xs 24 | 25 | variable :: Parsec String st AST.Variable 26 | variable = try ( concatParser [ruString "【", many (noneOf "】"), ruString "】"] ) 27 | <|> count 1 (ruChar) 28 | 29 | lexer = P.makeTokenParser haskellDef 30 | value :: Parsec String st Value 31 | value = fmap ValNum (try (P.float lexer)) 32 | <|> fmap ValInt (try (P.integer lexer)) 33 | <|> try (do _ <- ruString "元" 34 | return ValUnit) 35 | 36 | ruString str = do _ <- ruSpaces 37 | res <- string str 38 | _ <- ruSpaces 39 | return res 40 | 41 | stringConstant' :: Parsec String st Expr 42 | stringConstant' = try (do _ <- string "”" 43 | return $ ExprValue ValUnit) 44 | <|> try (do c <- noneOf "”" 45 | rest <- stringConstant' 46 | return $ ExprApply (ExprApply (ExprVar "对") (ExprValue (ValInt (toInteger (ord c))))) rest) 47 | 48 | stringConstant :: Parsec String st Expr 49 | stringConstant = do _ <- string "“" 50 | lst <- stringConstant' 51 | return lst 52 | 53 | exprValue = stringConstant <|> fmap ExprValue value 54 | exprVariable = fmap ExprVar variable 55 | 56 | exprLambda :: Parsec String st Expr 57 | exprLambda = do _ <- ruString "入" 58 | var <- variable 59 | _ <- try(ruString "") 60 | exp <- expr 61 | return $ ExprLambda var exp 62 | 63 | exprApplyBin :: Expr -> (Parsec String st Expr) 64 | exprApplyBin exp2 = (do _ <- ruString "与" 65 | t1 <- exprR 66 | exp3 <- (try (exprApplyBin t1)) <|> (return t1) 67 | _ <- try (ruString "之") <|> (ruString "相") 68 | exp1 <- exprR 69 | return (ExprApply (ExprApply exp1 exp2) exp3)) 70 | 71 | exprApplyBin2 :: Expr -> (Parsec String st Expr) 72 | exprApplyBin2 exp2 = (do exp1 <- exprR 73 | _ <- try (ruString "于") 74 | t1 <- exprR 75 | exp3 <- (try (exprApplyBin t1)) <|> (return t1) 76 | return (ExprApply (ExprApply exp1 exp2) exp3)) 77 | 78 | exprApplyUni :: Expr -> (Parsec String st Expr) 79 | exprApplyUni exp2 = (do _ <- ruString "之" 80 | exp1 <- exprR 81 | return (ExprApply exp1 exp2)) 82 | 83 | exprApply :: Parsec String st Expr 84 | exprApply = do exp2 <- exprR 85 | rest exp2 86 | where rest exp2 = (do x <- (try (exprApplyBin exp2)) 87 | rest x) 88 | <|> (do x <- (try (exprApplyBin2 exp2)) 89 | rest x) 90 | <|> (do x <- (try (exprApplyUni exp2)) 91 | rest x) 92 | <|> return exp2 93 | 94 | exprApplyRev :: Parsec String st Expr 95 | exprApplyRev = do exp1 <- try exprLambda 96 | <|> try exprValue 97 | <|> try exprVariable 98 | rest exp1 99 | where rest exp1 = try (do _ <- ruString "取" 100 | _ <- variable 101 | _ <- ruString "为" 102 | exp2 <- expr 103 | _ <- ruString "者" 104 | rest $ ExprApply exp1 exp2) 105 | <|> try (do _ <- ruString "取" 106 | exp2 <- expr 107 | _ <- ruString "者" 108 | rest $ ExprApply exp1 exp2) 109 | <|> return exp1 110 | 111 | -------------------------------------------------------- 112 | 113 | eta = ExprLambda "z" (ExprApply (ExprApply (ExprVar "y") (ExprVar "y")) (ExprVar "z")) 114 | form = ExprLambda "y" (ExprApply (ExprVar "x") eta) 115 | ycomb = ExprLambda "x" (ExprApply form form) 116 | 117 | exprLet :: Expr -> (Parsec String st Expr) 118 | exprLet exp = do 119 | _ <- ruString "以" 120 | var <- variable 121 | _ <- ruString "为" 122 | exp1 <- (try exprMatch) <|> (try exprApply) 123 | exp2 <- try(do _ <- try (ruString "并") <|> try (ruString "则") 124 | exp2 <- expr 125 | return exp2) 126 | <|> try (exprLet exp) 127 | <|> try(do _ <- eof 128 | return exp) 129 | return $ ExprApply (ExprLambda var exp2) (ExprApply ycomb (ExprLambda var exp1)) 130 | 131 | exprMatch :: Parsec String st Expr 132 | exprMatch = do _ <- ruString "令" 133 | exp1 <- expr 134 | _ <- ruString "时" 135 | _ <- optional $ ruString "取" 136 | exp2 <- expr 137 | exp3 <- exprMatch 138 | <|> try ( do _ <- ruString "否则" 139 | _ <- optional $ ruString "取" 140 | exp3 <- expr 141 | return exp3) 142 | <|> (do return (ExprValue ValUnit)) 143 | return $ ExprApply (ExprApply exp1 exp2) exp3 144 | 145 | -------------------------------------------------------- 146 | 147 | exprR :: Parsec String st Expr 148 | exprR = try exprApplyRev 149 | <|> try exprLambda 150 | <|> try exprValue 151 | <|> try exprVariable 152 | 153 | expr :: Parsec String st Expr 154 | expr = do 155 | _ <- ruSpaces 156 | res <- (try (exprLet (ExprValue ValUnit))) <|> (try exprMatch) <|> (try exprApply) 157 | _ <- ruSpaces 158 | return res 159 | 160 | exprInclude :: Expr -> (Parsec String st Expr) 161 | exprInclude env = do 162 | _ <- ruString "引" 163 | fname <- variable 164 | exp <- exprOrInclude env 165 | return $ (ExprInclude fname exp) 166 | 167 | exprOrInclude :: Expr -> (Parsec String st Expr) 168 | exprOrInclude exp = do 169 | _ <- ruSpaces 170 | res <- (try (exprInclude exp)) <|> (try (exprLet exp)) <|> (try expr) 171 | _ <- ruSpaces 172 | return res 173 | 174 | parseRu :: FilePath -> Expr -> IO (Either ParseError Expr) 175 | parseRu file exp = parseFromFile (exprOrInclude exp) file 176 | -------------------------------------------------------------------------------- /src/TypeChecker.hs: -------------------------------------------------------------------------------- 1 | module TypeChecker where 2 | import AST 3 | 4 | type Env = [(String, Type)] 5 | 6 | data TypeError 7 | = TypeErrorUnboundedVariable Variable 8 | | TypeErrorNotFunc (Type, Expr) 9 | | TypeErrorApplyFailure (Type, Expr) (Type, Expr) 10 | deriving Show 11 | 12 | 13 | (===) :: Type -> Type -> Bool 14 | TypeVal v === TypeVal v' = v == v' 15 | TypeFunc a b === TypeFunc c d = a === c && b === d 16 | TypeFuncDelay _ _ === TypeFuncDelay _ _ = True 17 | TypeFuncDelayWithResultType _ _ t1 === TypeFuncDelayWithResultType _ _ t2 = t1 === t2 18 | 19 | TypeFuncDelay _ _ === TypeFuncDelayWithResultType {} = True 20 | TypeFuncDelay _ _ === TypeFunc _ _ = True 21 | TypeFuncDelayWithResultType _ _ t1 === TypeFunc _ t2 = t1 === t2 22 | 23 | _ === _ = False 24 | 25 | 26 | checkType' :: Env -> Expr -> Either TypeError Type 27 | checkType' env (ExprVar v) = 28 | case lookup v env of 29 | Nothing -> Left $ TypeErrorUnboundedVariable v 30 | Just t -> Right t 31 | checkType' env (ExprLambda v e) = 32 | case checkType' env e of 33 | Left (TypeErrorUnboundedVariable _) -> Right $ TypeFuncDelay v e 34 | Right t -> Right $ TypeFuncDelayWithResultType v e t 35 | Left x -> Left x 36 | checkType' env (ExprApply func val) = do 37 | tArg <- checkType' env val 38 | tFunc <- checkType' env func 39 | case tFunc of 40 | TypeFuncDelay v body -> checkType' ((v, tArg) : env) body 41 | TypeFuncDelayWithResultType v body _ -> checkType' ((v, tArg) : env) body 42 | TypeFunc a b -> 43 | if a === tArg 44 | then Right b 45 | else Left $ TypeErrorApplyFailure (tFunc, func) (tArg, val) 46 | _ -> Left $ TypeErrorNotFunc (tFunc, func) 47 | 48 | checkType' _ (ExprValue (ValInt _)) = Right $ TypeVal ValTypeInt 49 | checkType' _ (ExprValue (ValNum _)) = Right $ TypeVal ValTypeNum 50 | checkType' _ (ExprValue ValUnit) = Right $ TypeVal ValTypeUnit 51 | checkType' _ (ExprHostFunc _ t _ _) = Right t 52 | 53 | checkType :: Expr -> Either TypeError Type 54 | checkType = checkType' [] 55 | 56 | testTypeChecker :: IO () 57 | testTypeChecker = 58 | print $ checkType $ 59 | ExprApply (ExprLambda "a" $ ExprLambda "b" $ ExprVar "a") $ ExprValue $ ValInt 1 60 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-19.6 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | # extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=2.7" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | --------------------------------------------------------------------------------