├── .config └── dotnet-tools.json ├── .devcontainer ├── Dockerfile └── devcontainer.json ├── .editorconfig ├── .fantomasignore ├── .gitattributes ├── .github └── workflows │ └── ci.yaml ├── .gitignore ├── LICENSE ├── Litsu.Run ├── Library.fs ├── Library.fsi └── Litsu.Run.fsproj ├── Litsu.Testing ├── .gitignore ├── Litsu.Testing.fsproj ├── Main.fs ├── Settings.fs └── Tests.fs ├── Litsu.sln ├── Litsu ├── .gitignore ├── Codegen.fs ├── Codegen.fsi ├── Compiler.fs ├── Compiler.fsi ├── LexYaccLexer.fsi ├── LexYaccLexer.fsl ├── LexYaccParser.fsi ├── LexYaccParser.fsy ├── Litsu.fsproj ├── Parser.fs ├── Parser.fsi ├── SyntaxTree.fs ├── SyntaxTree.fsi ├── Type.fs ├── Type.fsi ├── TypeEnv.fs ├── TypeEnv.fsi ├── Typing.fs └── Typing.fsi ├── README.md ├── litc ├── Main.fs └── litc.fsproj ├── tests ├── comment_unterminated.fail.lit ├── comments.lit ├── eq.lit ├── expr.lit ├── fail.lit ├── fib.lit ├── if.lit ├── let.lit ├── let_fun.lit ├── string.lit └── unit.lit ├── verified_output ├── tests.comments.lit.verified.txt ├── tests.eq.lit.verified.txt ├── tests.expr.lit.verified.txt ├── tests.fib.lit.verified.txt ├── tests.if.lit.verified.txt ├── tests.let.lit.verified.txt ├── tests.let_fun.lit.verified.txt ├── tests.string.lit.verified.txt └── tests.unit.lit.verified.txt └── z.yaml /.config/dotnet-tools.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": 1, 3 | "isRoot": true, 4 | "tools": { 5 | "fantomas": { 6 | "version": "5.0.0-beta-005", 7 | "commands": [ 8 | "fantomas" 9 | ] 10 | }, 11 | "dotnet-fsharplint": { 12 | "version": "0.21.2", 13 | "commands": [ 14 | "dotnet-fsharplint" 15 | ] 16 | } 17 | } 18 | } -------------------------------------------------------------------------------- /.devcontainer/Dockerfile: -------------------------------------------------------------------------------- 1 | # https://github.com/microsoft/vscode-dev-containers/tree/v0.245.0/containers/dotnet-fsharp/.devcontainer/base.Dockerfile 2 | 3 | ARG VARIANT="6.0-focal" 4 | FROM mcr.microsoft.com/vscode/devcontainers/dotnet:0-${VARIANT} 5 | 6 | curl -sSL gobinaries.com/zakuro9715/z | sh 7 | -------------------------------------------------------------------------------- /.devcontainer/devcontainer.json: -------------------------------------------------------------------------------- 1 | // For format details, see https://aka.ms/devcontainer.json. 2 | { 3 | "build": { 4 | "dockerfile": "Dockerfile" 5 | }, 6 | 7 | // Configure tool-specific properties. 8 | "customizations": { 9 | "vscode": { 10 | "extensions": [ 11 | "Ionide.Ionide-fsharp" 12 | ] 13 | } 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | [*.{fs,fsl,fsy,ml,mll,mly}] 2 | max_line_length = 99 3 | -------------------------------------------------------------------------------- /.fantomasignore: -------------------------------------------------------------------------------- 1 | LexYacc* 2 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # Set default behavior to automatically normalize line endings. 3 | ############################################################################### 4 | * text=auto 5 | 6 | ############################################################################### 7 | # Set default behavior for command prompt diff. 8 | # 9 | # This is need for earlier builds of msysgit that does not have it on by 10 | # default for csharp files. 11 | # Note: This is only used by command line 12 | ############################################################################### 13 | #*.cs diff=csharp 14 | 15 | ############################################################################### 16 | # Set the merge driver for project and solution files 17 | # 18 | # Merging from the command prompt will add diff markers to the files if there 19 | # are conflicts (Merging from VS is not affected by the settings below, in VS 20 | # the diff markers are never inserted). Diff markers may cause the following 21 | # file extensions to fail to load in VS. An alternative would be to treat 22 | # these files as binary and thus will always conflict and require user 23 | # intervention with every merge. To do so, just uncomment the entries below 24 | ############################################################################### 25 | #*.sln merge=binary 26 | #*.csproj merge=binary 27 | #*.vbproj merge=binary 28 | #*.vcxproj merge=binary 29 | #*.vcproj merge=binary 30 | #*.dbproj merge=binary 31 | #*.fsproj merge=binary 32 | #*.lsproj merge=binary 33 | #*.wixproj merge=binary 34 | #*.modelproj merge=binary 35 | #*.sqlproj merge=binary 36 | #*.wwaproj merge=binary 37 | 38 | ############################################################################### 39 | # behavior for image files 40 | # 41 | # image files are treated as binary by default. 42 | ############################################################################### 43 | #*.jpg binary 44 | #*.png binary 45 | #*.gif binary 46 | 47 | ############################################################################### 48 | # diff behavior for common document formats 49 | # 50 | # Convert binary document formats to text before diffing them. This feature 51 | # is only available from the command line. Turn it on by uncommenting the 52 | # entries below. 53 | ############################################################################### 54 | #*.doc diff=astextplain 55 | #*.DOC diff=astextplain 56 | #*.docx diff=astextplain 57 | #*.DOCX diff=astextplain 58 | #*.dot diff=astextplain 59 | #*.DOT diff=astextplain 60 | #*.pdf diff=astextplain 61 | #*.PDF diff=astextplain 62 | #*.rtf diff=astextplain 63 | #*.RTF diff=astextplain 64 | -------------------------------------------------------------------------------- /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ "main" ] 6 | pull_request: 7 | branches: [ "main" ] 8 | 9 | jobs: 10 | test: 11 | 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - uses: actions/checkout@v3 16 | - name: Setup .NET 17 | uses: actions/setup-dotnet@v2 18 | with: 19 | dotnet-version: 6.0.x 20 | - name: Restore dependencies 21 | run: dotnet restore 22 | - name: Build 23 | run: dotnet build --no-restore 24 | - name: Test 25 | run: dotnet test --no-build --verbosity normal 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | ## 4 | ## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore 5 | 6 | # User-specific files 7 | *.rsuser 8 | *.suo 9 | *.user 10 | *.userosscache 11 | *.sln.docstates 12 | 13 | # User-specific files (MonoDevelop/Xamarin Studio) 14 | *.userprefs 15 | 16 | # Mono auto generated files 17 | mono_crash.* 18 | 19 | # Build results 20 | [Dd]ebug/ 21 | [Dd]ebugPublic/ 22 | [Rr]elease/ 23 | [Rr]eleases/ 24 | x64/ 25 | x86/ 26 | [Ww][Ii][Nn]32/ 27 | [Aa][Rr][Mm]/ 28 | [Aa][Rr][Mm]64/ 29 | bld/ 30 | [Bb]in/ 31 | [Oo]bj/ 32 | [Oo]ut/ 33 | [Ll]og/ 34 | [Ll]ogs/ 35 | 36 | # Visual Studio 2015/2017 cache/options directory 37 | .vs/ 38 | # Uncomment if you have tasks that create the project's static files in wwwroot 39 | #wwwroot/ 40 | 41 | # Visual Studio 2017 auto generated files 42 | Generated\ Files/ 43 | 44 | # MSTest test Results 45 | [Tt]est[Rr]esult*/ 46 | [Bb]uild[Ll]og.* 47 | 48 | # NUnit 49 | *.VisualState.xml 50 | TestResult.xml 51 | nunit-*.xml 52 | 53 | # Build Results of an ATL Project 54 | [Dd]ebugPS/ 55 | [Rr]eleasePS/ 56 | dlldata.c 57 | 58 | # Benchmark Results 59 | BenchmarkDotNet.Artifacts/ 60 | 61 | # .NET Core 62 | project.lock.json 63 | project.fragment.lock.json 64 | artifacts/ 65 | 66 | # ASP.NET Scaffolding 67 | ScaffoldingReadMe.txt 68 | 69 | # StyleCop 70 | StyleCopReport.xml 71 | 72 | # Files built by Visual Studio 73 | *_i.c 74 | *_p.c 75 | *_h.h 76 | *.ilk 77 | *.meta 78 | *.obj 79 | *.iobj 80 | *.pch 81 | *.pdb 82 | *.ipdb 83 | *.pgc 84 | *.pgd 85 | *.rsp 86 | *.sbr 87 | *.tlb 88 | *.tli 89 | *.tlh 90 | *.tmp 91 | *.tmp_proj 92 | *_wpftmp.csproj 93 | *.log 94 | *.vspscc 95 | *.vssscc 96 | .builds 97 | *.pidb 98 | *.svclog 99 | *.scc 100 | 101 | # Chutzpah Test files 102 | _Chutzpah* 103 | 104 | # Visual C++ cache files 105 | ipch/ 106 | *.aps 107 | *.ncb 108 | *.opendb 109 | *.opensdf 110 | *.sdf 111 | *.cachefile 112 | *.VC.db 113 | *.VC.VC.opendb 114 | 115 | # Visual Studio profiler 116 | *.psess 117 | *.vsp 118 | *.vspx 119 | *.sap 120 | 121 | # Visual Studio Trace Files 122 | *.e2e 123 | 124 | # TFS 2012 Local Workspace 125 | $tf/ 126 | 127 | # Guidance Automation Toolkit 128 | *.gpState 129 | 130 | # ReSharper is a .NET coding add-in 131 | _ReSharper*/ 132 | *.[Rr]e[Ss]harper 133 | *.DotSettings.user 134 | 135 | # TeamCity is a build add-in 136 | _TeamCity* 137 | 138 | # DotCover is a Code Coverage Tool 139 | *.dotCover 140 | 141 | # AxoCover is a Code Coverage Tool 142 | .axoCover/* 143 | !.axoCover/settings.json 144 | 145 | # Coverlet is a free, cross platform Code Coverage Tool 146 | coverage*.json 147 | coverage*.xml 148 | coverage*.info 149 | 150 | # Visual Studio code coverage results 151 | *.coverage 152 | *.coveragexml 153 | 154 | # NCrunch 155 | _NCrunch_* 156 | .*crunch*.local.xml 157 | nCrunchTemp_* 158 | 159 | # MightyMoose 160 | *.mm.* 161 | AutoTest.Net/ 162 | 163 | # Web workbench (sass) 164 | .sass-cache/ 165 | 166 | # Installshield output folder 167 | [Ee]xpress/ 168 | 169 | # DocProject is a documentation generator add-in 170 | DocProject/buildhelp/ 171 | DocProject/Help/*.HxT 172 | DocProject/Help/*.HxC 173 | DocProject/Help/*.hhc 174 | DocProject/Help/*.hhk 175 | DocProject/Help/*.hhp 176 | DocProject/Help/Html2 177 | DocProject/Help/html 178 | 179 | # Click-Once directory 180 | publish/ 181 | 182 | # Publish Web Output 183 | *.[Pp]ublish.xml 184 | *.azurePubxml 185 | # Note: Comment the next line if you want to checkin your web deploy settings, 186 | # but database connection strings (with potential passwords) will be unencrypted 187 | *.pubxml 188 | *.publishproj 189 | 190 | # Microsoft Azure Web App publish settings. Comment the next line if you want to 191 | # checkin your Azure Web App publish settings, but sensitive information contained 192 | # in these scripts will be unencrypted 193 | PublishScripts/ 194 | 195 | # NuGet Packages 196 | *.nupkg 197 | # NuGet Symbol Packages 198 | *.snupkg 199 | # The packages folder can be ignored because of Package Restore 200 | **/[Pp]ackages/* 201 | # except build/, which is used as an MSBuild target. 202 | !**/[Pp]ackages/build/ 203 | # Uncomment if necessary however generally it will be regenerated when needed 204 | #!**/[Pp]ackages/repositories.config 205 | # NuGet v3's project.json files produces more ignorable files 206 | *.nuget.props 207 | *.nuget.targets 208 | 209 | # Microsoft Azure Build Output 210 | csx/ 211 | *.build.csdef 212 | 213 | # Microsoft Azure Emulator 214 | ecf/ 215 | rcf/ 216 | 217 | # Windows Store app package directories and files 218 | AppPackages/ 219 | BundleArtifacts/ 220 | Package.StoreAssociation.xml 221 | _pkginfo.txt 222 | *.appx 223 | *.appxbundle 224 | *.appxupload 225 | 226 | # Visual Studio cache files 227 | # files ending in .cache can be ignored 228 | *.[Cc]ache 229 | # but keep track of directories ending in .cache 230 | !?*.[Cc]ache/ 231 | 232 | # Others 233 | ClientBin/ 234 | ~$* 235 | *~ 236 | *.dbmdl 237 | *.dbproj.schemaview 238 | *.jfm 239 | *.pfx 240 | *.publishsettings 241 | orleans.codegen.cs 242 | 243 | # Including strong name files can present a security risk 244 | # (https://github.com/github/gitignore/pull/2483#issue-259490424) 245 | #*.snk 246 | 247 | # Since there are multiple workflows, uncomment next line to ignore bower_components 248 | # (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) 249 | #bower_components/ 250 | 251 | # RIA/Silverlight projects 252 | Generated_Code/ 253 | 254 | # Backup & report files from converting an old project file 255 | # to a newer Visual Studio version. Backup files are not needed, 256 | # because we have git ;-) 257 | _UpgradeReport_Files/ 258 | Backup*/ 259 | UpgradeLog*.XML 260 | UpgradeLog*.htm 261 | ServiceFabricBackup/ 262 | *.rptproj.bak 263 | 264 | # SQL Server files 265 | *.mdf 266 | *.ldf 267 | *.ndf 268 | 269 | # Business Intelligence projects 270 | *.rdl.data 271 | *.bim.layout 272 | *.bim_*.settings 273 | *.rptproj.rsuser 274 | *- [Bb]ackup.rdl 275 | *- [Bb]ackup ([0-9]).rdl 276 | *- [Bb]ackup ([0-9][0-9]).rdl 277 | 278 | # Microsoft Fakes 279 | FakesAssemblies/ 280 | 281 | # GhostDoc plugin setting file 282 | *.GhostDoc.xml 283 | 284 | # Node.js Tools for Visual Studio 285 | .ntvs_analysis.dat 286 | node_modules/ 287 | 288 | # Visual Studio 6 build log 289 | *.plg 290 | 291 | # Visual Studio 6 workspace options file 292 | *.opt 293 | 294 | # Visual Studio 6 auto-generated workspace file (contains which files were open etc.) 295 | *.vbw 296 | 297 | # Visual Studio LightSwitch build output 298 | **/*.HTMLClient/GeneratedArtifacts 299 | **/*.DesktopClient/GeneratedArtifacts 300 | **/*.DesktopClient/ModelManifest.xml 301 | **/*.Server/GeneratedArtifacts 302 | **/*.Server/ModelManifest.xml 303 | _Pvt_Extensions 304 | 305 | # Paket dependency manager 306 | .paket/paket.exe 307 | paket-files/ 308 | 309 | # FAKE - F# Make 310 | .fake/ 311 | 312 | # CodeRush personal settings 313 | .cr/personal 314 | 315 | # Python Tools for Visual Studio (PTVS) 316 | __pycache__/ 317 | *.pyc 318 | 319 | # Cake - Uncomment if you are using it 320 | # tools/** 321 | # !tools/packages.config 322 | 323 | # Tabs Studio 324 | *.tss 325 | 326 | # Telerik's JustMock configuration file 327 | *.jmconfig 328 | 329 | # BizTalk build output 330 | *.btp.cs 331 | *.btm.cs 332 | *.odx.cs 333 | *.xsd.cs 334 | 335 | # OpenCover UI analysis results 336 | OpenCover/ 337 | 338 | # Azure Stream Analytics local run output 339 | ASALocalRun/ 340 | 341 | # MSBuild Binary and Structured Log 342 | *.binlog 343 | 344 | # NVidia Nsight GPU debugger configuration file 345 | *.nvuser 346 | 347 | # MFractors (Xamarin productivity tool) working folder 348 | .mfractor/ 349 | 350 | # Local History for Visual Studio 351 | .localhistory/ 352 | 353 | # BeatPulse healthcheck temp database 354 | healthchecksdb 355 | 356 | # Backup folder for Package Reference Convert tool in Visual Studio 2017 357 | MigrationBackup/ 358 | 359 | # Ionide (cross platform F# VS Code tools) working folder 360 | .ionide/ 361 | 362 | # Fody - auto-generated XML schema 363 | FodyWeavers.xsd -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | 375 | -------------------------------------------------------------------------------- /Litsu.Run/Library.fs: -------------------------------------------------------------------------------- 1 | // Copyright (c) 2022 zakuro . All rights reserved. 2 | // 3 | // This Source Code Form is subject to the terms of the Mozilla Public 4 | // License, v. 2.0. If a copy of the MPL was not distributed with this 5 | // file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | 7 | module Litsu.Run 8 | 9 | open System 10 | open System.IO 11 | open System.Text 12 | open System.Diagnostics 13 | open CliWrap 14 | open Litsu.Compiler 15 | 16 | type Runner() = 17 | member _this.Run(code: string, ?stdin: Stream, ?stdout: Stream, ?stderr: Stream) : int = 18 | 19 | let stdin = defaultArg stdin (Console.OpenStandardInput()) 20 | let stdout = defaultArg stdout (Console.OpenStandardOutput()) 21 | let stderr = defaultArg stderr (Console.OpenStandardError()) 22 | 23 | let filename = $"litsu_{DateTime.UtcNow.Ticks}.sh" 24 | let outPath = Path.Join(Path.GetTempPath(), filename) 25 | 26 | use file = 27 | new StreamWriter( 28 | outPath, 29 | UTF8Encoding(false), 30 | FileStreamOptions( 31 | Access = FileAccess.ReadWrite, 32 | Mode = FileMode.Create, 33 | Options = FileOptions.DeleteOnClose 34 | ) 35 | ) 36 | 37 | compile code |> file.Write 38 | file.Flush() 39 | 40 | let cmd = Cli.Wrap("sh").WithArguments(outPath) 41 | let cmd = cmd.WithValidation(CommandResultValidation.None) 42 | let stdinPipe = PipeSource.FromStream(stdin) 43 | let cmd = cmd.WithStandardInputPipe(stdinPipe) 44 | let stdoutPipe = PipeTarget.ToStream(stdout) 45 | let cmd = cmd.WithStandardOutputPipe(stdoutPipe) 46 | let stderrPipe = PipeTarget.ToStream(stderr) 47 | let cmd = cmd.WithStandardErrorPipe(stderrPipe) 48 | 49 | let res = (cmd.ExecuteAsync().Task.Result) 50 | 51 | res.ExitCode 52 | 53 | let run code = Runner().Run code 54 | -------------------------------------------------------------------------------- /Litsu.Run/Library.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module Run = 4 | 5 | type Runner = 6 | 7 | new: unit -> Runner 8 | 9 | member 10 | Run: code: string * ?stdin: System.IO.Stream * 11 | ?stdout: System.IO.Stream * ?stderr: System.IO.Stream -> int 12 | 13 | val run: code: string -> int 14 | 15 | -------------------------------------------------------------------------------- /Litsu.Run/Litsu.Run.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | --allsigs 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /Litsu.Testing/.gitignore: -------------------------------------------------------------------------------- 1 | *.received.* 2 | -------------------------------------------------------------------------------- /Litsu.Testing/Litsu.Testing.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Exe 5 | net6.0 6 | false 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /Litsu.Testing/Main.fs: -------------------------------------------------------------------------------- 1 | module Litsu.Testing.Main 2 | 3 | open Expecto 4 | 5 | [] 6 | let main argv = 7 | Tests.runTestsInAssembly defaultConfig argv 8 | -------------------------------------------------------------------------------- /Litsu.Testing/Settings.fs: -------------------------------------------------------------------------------- 1 | // Copyright (c) 2022 zakuro . All rights reserved. 2 | // 3 | // This Source Code Form is subject to the terms of the Mozilla Public 4 | // License, v. 2.0. If a copy of the MPL was not distributed with this 5 | // file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | 7 | module Litsu.Testing.Settings 8 | 9 | open System.Runtime.CompilerServices 10 | open System.Runtime.InteropServices 11 | open VerifyTests 12 | open System.IO 13 | 14 | type Settings([] path: string) as this = 15 | inherit VerifySettings() 16 | let dir = Path.GetDirectoryName(path) 17 | let mutable solutionDirectory = dir 18 | 19 | do 20 | while Directory.GetFiles(solutionDirectory, "*.sln").Length = 0 do 21 | solutionDirectory <- Directory.GetParent(solutionDirectory).FullName 22 | 23 | do this.UseDirectory(this.OutputPath) 24 | 25 | member this.SolutionDirectory = solutionDirectory 26 | member this.OutputPath = Path.Combine(this.SolutionDirectory, "verified_output") 27 | -------------------------------------------------------------------------------- /Litsu.Testing/Tests.fs: -------------------------------------------------------------------------------- 1 | module Litsu.Testing.Tests 2 | 3 | open System.IO 4 | open Expecto 5 | open VerifyTests 6 | open VerifyExpecto 7 | open Litsu.Run 8 | open Litsu.Testing.Settings 9 | 10 | type RunResult = 11 | { ExitCode: int 12 | Stdout: string 13 | Stderr: string } 14 | 15 | let runCode code : string = 16 | use stdin = new MemoryStream() 17 | use out = new MemoryStream() 18 | 19 | let exitCode = Runner().Run(code, stdin, out, out) 20 | 21 | out.Seek(0, SeekOrigin.Begin) |> ignore 22 | using (new StreamReader(out)) (fun r -> r.ReadToEnd()) 23 | 24 | [] 25 | let tests = 26 | let settings = Settings() 27 | 28 | let testsDir = Path.Combine(settings.SolutionDirectory, "tests") 29 | 30 | let testFiles = 31 | let searchOption = SearchOption.AllDirectories 32 | Directory.GetFiles(testsDir, "*.lit", searchOption) |> Array.toList 33 | 34 | List.map 35 | (fun (testFilePath: string) -> 36 | let name = Path.GetFileName(testFilePath) 37 | let code = using (new StreamReader(testFilePath)) (fun r -> r.ReadToEnd()) 38 | 39 | testTask name { 40 | if name.EndsWith("fail.lit") then 41 | let message = sprintf "`%s` should be compile error" name 42 | Expect.throws (fun () -> runCode code |> ignore) message 43 | else 44 | do! Verifier.Verify(name, runCode code, settings, "tests") 45 | }) 46 | testFiles 47 | |> testList "tests" 48 | -------------------------------------------------------------------------------- /Litsu.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 17 4 | VisualStudioVersion = 17.0.32112.339 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Litsu", "Litsu\Litsu.fsproj", "{A44AE1AB-827E-48E4-AAC1-4584F1F44E55}" 7 | EndProject 8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "litc", "litc\litc.fsproj", "{0AC48E11-0BE4-4E37-9855-A88A7709F40A}" 9 | EndProject 10 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Litsu.Testing", "Litsu.Testing\Litsu.Testing.fsproj", "{5A6CC4AC-4E2A-4F86-9577-D802F3C6D6B5}" 11 | EndProject 12 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Litsu.Run", "Litsu.Run\Litsu.Run.fsproj", "{03F0F8D6-232E-4DFF-900E-332FD8D0A2A0}" 13 | EndProject 14 | Global 15 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 16 | Debug|Any CPU = Debug|Any CPU 17 | Release|Any CPU = Release|Any CPU 18 | EndGlobalSection 19 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 20 | {A44AE1AB-827E-48E4-AAC1-4584F1F44E55}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 21 | {A44AE1AB-827E-48E4-AAC1-4584F1F44E55}.Debug|Any CPU.Build.0 = Debug|Any CPU 22 | {A44AE1AB-827E-48E4-AAC1-4584F1F44E55}.Release|Any CPU.ActiveCfg = Release|Any CPU 23 | {A44AE1AB-827E-48E4-AAC1-4584F1F44E55}.Release|Any CPU.Build.0 = Release|Any CPU 24 | {0AC48E11-0BE4-4E37-9855-A88A7709F40A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 25 | {0AC48E11-0BE4-4E37-9855-A88A7709F40A}.Debug|Any CPU.Build.0 = Debug|Any CPU 26 | {0AC48E11-0BE4-4E37-9855-A88A7709F40A}.Release|Any CPU.ActiveCfg = Release|Any CPU 27 | {0AC48E11-0BE4-4E37-9855-A88A7709F40A}.Release|Any CPU.Build.0 = Release|Any CPU 28 | {5A6CC4AC-4E2A-4F86-9577-D802F3C6D6B5}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 29 | {5A6CC4AC-4E2A-4F86-9577-D802F3C6D6B5}.Debug|Any CPU.Build.0 = Debug|Any CPU 30 | {5A6CC4AC-4E2A-4F86-9577-D802F3C6D6B5}.Release|Any CPU.ActiveCfg = Release|Any CPU 31 | {5A6CC4AC-4E2A-4F86-9577-D802F3C6D6B5}.Release|Any CPU.Build.0 = Release|Any CPU 32 | {03F0F8D6-232E-4DFF-900E-332FD8D0A2A0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 33 | {03F0F8D6-232E-4DFF-900E-332FD8D0A2A0}.Debug|Any CPU.Build.0 = Debug|Any CPU 34 | {03F0F8D6-232E-4DFF-900E-332FD8D0A2A0}.Release|Any CPU.ActiveCfg = Release|Any CPU 35 | {03F0F8D6-232E-4DFF-900E-332FD8D0A2A0}.Release|Any CPU.Build.0 = Release|Any CPU 36 | EndGlobalSection 37 | GlobalSection(SolutionProperties) = preSolution 38 | HideSolutionNode = FALSE 39 | EndGlobalSection 40 | GlobalSection(ExtensibilityGlobals) = postSolution 41 | SolutionGuid = {2286EA33-24D0-4DA3-A48F-09EF17738D1E} 42 | EndGlobalSection 43 | EndGlobal 44 | -------------------------------------------------------------------------------- /Litsu/.gitignore: -------------------------------------------------------------------------------- 1 | LexYacc*.fs 2 | -------------------------------------------------------------------------------- /Litsu/Codegen.fs: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Copyright (c) 2022 zakuro . All rights reserved. *) 4 | (* *) 5 | (* This Source Code Form is subject to the terms of the Mozilla Public *) 6 | (* License, v. 2.0. If a copy of the MPL was not distributed with this *) 7 | (* file, You can obtain one at https://mozilla.org/MPL/2.0/. *) 8 | (* *) 9 | (***********************************************************************) 10 | 11 | module Litsu.Codegen 12 | 13 | open FSharp.Compatibility.OCaml.Pervasives 14 | open Litsu.SyntaxTree 15 | open Litsu.Type 16 | 17 | let unreachable () = failwith "Unreachable" 18 | 19 | type Context = { IndentN: int; Counter: int ref } 20 | 21 | let private newContext () : Context = { IndentN = 0; Counter = ref 0 } 22 | 23 | let private newInnerContext (ctx: Context) : Context = { ctx with IndentN = ctx.IndentN + 1 } 24 | 25 | let private varname (name: string) : string = sprintf "LITSU_%s" name 26 | 27 | let private sTrue, sFalse = ("true", "false") 28 | 29 | let private indentStr (n: int) : string = String.replicate n " " 30 | let private ctxIndentStr (ctx: Context) : string = indentStr ctx.IndentN 31 | 32 | type writeF = string -> unit 33 | 34 | let rec private genExpr (ctx: Context) (write: writeF) (expr: Expr) : unit = 35 | let filterArgs = List.filter (fun e -> typ e <> Type.Unit) 36 | 37 | let rec funcCall (wo: writeF) (fe: Expr) (args: Expr list) = 38 | sprintf 39 | "%s %s" 40 | (f wo fe) 41 | (String.concat " " (List.map (fun e -> sprintf "\"%s\"" (f wo e)) (filterArgs args))) 42 | 43 | and f (writeOuter: string -> unit) (expr: Expr) : string = 44 | let wo = writeOuter 45 | 46 | match expr with 47 | | Expr.Int (n) -> sprintf "%d" n 48 | | Expr.String (s) -> 49 | String.collect 50 | (function 51 | | '"' -> "\\\"" 52 | | '\\' -> "\\\\" 53 | | '$' -> "\\$" 54 | | c -> sprintf "%c" c) 55 | s 56 | | Expr.Unit -> "" 57 | | Expr.Infix (e) -> 58 | (match e.Op with 59 | | "+" 60 | | "-" 61 | | "*" 62 | | "/" 63 | | "%" -> 64 | (match e.Type with 65 | | Type.Int -> sprintf "$(( ( %s ) %s ( %s ) ))" (f wo e.Left) e.Op (f wo e.Right) 66 | | _ -> unreachable ()) 67 | | "=" 68 | | "<>" 69 | | "<" 70 | | ">" 71 | | "<=" 72 | | ">=" -> 73 | let op = 74 | (match e.Op with 75 | | "=" -> 76 | (match typ e.Left with 77 | | Type.Int -> "-eq" 78 | | _ -> "=") 79 | | "<>" -> 80 | (match typ e.Left with 81 | | Type.Int -> "-ne" 82 | | _ -> "!=") 83 | | "<" -> "-lt" 84 | | "<=" -> "-le" 85 | | ">" -> "-gt" 86 | | ">=" -> "-ge" 87 | | _ -> unreachable ()) 88 | 89 | let cond = sprintf "[ \"%s\" %s \"%s\" ]" (f wo e.Left) op (f wo e.Right) in 90 | sprintf "$(%s && printf '%s' || printf '%s')" cond sTrue sFalse 91 | | _ -> unreachable ()) 92 | | Expr.If (e) -> 93 | let mutable out = sprintf "$(if [ \"%s\" = '%s' ]\n" (f wo e.Cond) sTrue 94 | let writeInner s = out <- out + s 95 | let writeOuter s = out <- s + out 96 | writeInner (ctxIndentStr ctx) 97 | writeInner "then\n" 98 | genExpr { ctx with IndentN = ctx.IndentN + 1 } writeInner e.Expr1 99 | writeInner (ctxIndentStr ctx) 100 | writeInner "else\n" 101 | genExpr { ctx with IndentN = ctx.IndentN + 1 } writeInner e.Expr2 102 | writeInner (ctxIndentStr ctx) 103 | writeInner "fi)" 104 | out 105 | | Expr.Let (e) -> 106 | let mutable out = "$(" 107 | let writeInner s = out <- out + s 108 | let writeOuter s = out <- s + out 109 | let origCtx = ctx 110 | let ctx = newInnerContext origCtx 111 | 112 | if List.length e.Args > 0 then 113 | let fname = varname e.Name 114 | writeInner (sprintf "%s() {\n" fname) 115 | 116 | (fun () -> 117 | let ctx = newInnerContext ctx in 118 | 119 | List.iteri 120 | (fun i v -> 121 | writeInner ( 122 | sprintf "%s%s=$%d\n" (ctxIndentStr ctx) (varname v.Name) (i + 1) 123 | )) 124 | (List.filter (fun a -> a.Type <> Type.Unit) e.Args) 125 | 126 | genExpr ctx writeInner e.Expr1) 127 | () 128 | 129 | writeInner (sprintf "%s}\n" (ctxIndentStr ctx)) 130 | // This allows calling function with "${name} args" 131 | writeInner (sprintf "%s%s=%s\n" (ctxIndentStr ctx) fname fname) 132 | else 133 | writeInner (sprintf "%s=\"%s\"\n" (varname e.Name) (f wo e.Expr1)) 134 | 135 | genExpr ctx writeInner e.Expr2 136 | 137 | writeInner (ctxIndentStr origCtx) 138 | writeInner ")" 139 | out 140 | | Expr.App ({ Fun = fe 141 | Args = args 142 | Type = Type.Fun (targs, _) }) -> 143 | let fname = 144 | incr ctx.Counter 145 | sprintf "__anon_func_%d" ctx.Counter.contents 146 | 147 | match typ fe with 148 | | Type.Fun (ftargs, rt) -> 149 | writeOuter ( 150 | (sprintf "%s%s() %s \"$@\"\n" (ctxIndentStr ctx) fname (funcCall wo fe args)) 151 | + (sprintf "%s%s=%s;\n" (ctxIndentStr ctx) fname fname) 152 | ) 153 | 154 | sprintf "%s" fname 155 | | _ -> unreachable () 156 | // partial app 157 | //sprintf "%s() { %s; %s }" fname (String.concat ";" 158 | | Expr.App (e) -> sprintf "$(%s)" (funcCall wo e.Fun e.Args) 159 | | Expr.Var (e) -> sprintf "${%s}" (varname e.Name) 160 | 161 | let mutable out = "" 162 | let writeInner s = out <- out + s 163 | let writeOuter s = out <- s + out 164 | writeInner (ctxIndentStr ctx) 165 | 166 | writeInner ( 167 | sprintf 168 | "printf '%%s%s' \"%s\"\n" 169 | (match typ expr with 170 | | Type.Unit as t 171 | | Fun (_, t) when t = Type.Unit -> "" 172 | | _ -> "\\n") 173 | (f writeOuter expr) 174 | ) 175 | 176 | write out 177 | 178 | let private genNode (ctx: Context) (write: string -> unit) (node: Node) : unit = 179 | match node with 180 | | Expr (expr) -> genExpr ctx write expr 181 | 182 | let codegen (write: string -> unit) (prog: Program) : unit = 183 | List.map (genNode (newContext ()) write) prog.Nodes |> ignore 184 | -------------------------------------------------------------------------------- /Litsu/Codegen.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module Codegen = 4 | 5 | val unreachable: unit -> 'a 6 | 7 | type Context = 8 | { 9 | IndentN: int 10 | Counter: int ref 11 | } 12 | 13 | val private newContext: unit -> Context 14 | 15 | val private newInnerContext: ctx: Context -> Context 16 | 17 | val private varname: name: string -> string 18 | 19 | val private sTrue: string 20 | 21 | val sFalse: string 22 | 23 | val private indentStr: n: int -> string 24 | 25 | val private ctxIndentStr: ctx: Context -> string 26 | 27 | type writeF = string -> unit 28 | 29 | val private genExpr: 30 | ctx: Context -> write: writeF -> expr: SyntaxTree.Expr -> unit 31 | 32 | val private genNode: 33 | ctx: Context -> write: (string -> unit) -> node: SyntaxTree.Node 34 | -> unit 35 | 36 | val codegen: write: (string -> unit) -> prog: SyntaxTree.Program -> unit 37 | 38 | -------------------------------------------------------------------------------- /Litsu/Compiler.fs: -------------------------------------------------------------------------------- 1 | // Copyright (c) 2022 zakuro . All rights reserved. 2 | // 3 | // This Source Code Form is subject to the terms of the Mozilla Public 4 | // License, v. 2.0. If a copy of the MPL was not distributed with this 5 | // file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | 7 | module Litsu.Compiler 8 | 9 | open System.IO 10 | open System.Text 11 | open Litsu.Parser 12 | open Litsu.Typing 13 | open Litsu.Codegen 14 | 15 | let compile code = 16 | let out = StringBuilder() 17 | parse code |> check |> codegen (out.Append >> ignore) 18 | out.ToString() 19 | -------------------------------------------------------------------------------- /Litsu/Compiler.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module Compiler = 4 | 5 | val compile: code: string -> string 6 | 7 | -------------------------------------------------------------------------------- /Litsu/LexYaccLexer.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module internal LexYaccLexer = 4 | 5 | val lexeme: arg00: FSharp.Text.Lexing.LexBuffer -> string 6 | 7 | val newline: lexbuf: FSharp.Text.Lexing.LexBuffer<'a> -> unit 8 | 9 | val trans: uint16[] array 10 | 11 | val actions: uint16[] 12 | 13 | val _fslex_tables: FSharp.Text.Lexing.UnicodeTables 14 | 15 | val _fslex_dummy: unit -> 'a 16 | 17 | val read: 18 | lexbuf: FSharp.Text.Lexing.LexBuffer -> LexYaccParser.token 19 | 20 | val read_string: 21 | buf: string -> lexbuf: FSharp.Text.Lexing.LexBuffer 22 | -> LexYaccParser.token 23 | 24 | val comment: lexbuf: FSharp.Text.Lexing.LexBuffer -> unit 25 | 26 | -------------------------------------------------------------------------------- /Litsu/LexYaccLexer.fsl: -------------------------------------------------------------------------------- 1 | { 2 | open FSharp.Text.Lexing 3 | open Litsu.LexYaccParser 4 | 5 | let lexeme = LexBuffer<_>.LexemeString 6 | 7 | let newline (lexbuf: LexBuffer<_>) = 8 | lexbuf.StartPos <- lexbuf.StartPos.NextLine 9 | 10 | // fsharplint:disable 11 | } 12 | 13 | let whitespace = [' ' '\t'] 14 | let newline = ('\n' | '\r' '\n') 15 | let lComment = "//" [^ '\n' '\r']* 16 | 17 | let digit = ['0'-'9'] 18 | 19 | let int = digit+ 20 | 21 | 22 | let identStart = ['A'-'Z' 'a'-'z' '_'] 23 | let ident = identStart (identStart | digit)* 24 | 25 | rule read = parse 26 | | whitespace { read lexbuf } 27 | | lComment { read lexbuf } 28 | | "(*" { comment lexbuf; read lexbuf } 29 | | newline { newline lexbuf; read lexbuf } 30 | | "let" { LET } 31 | | "rec" { REC } 32 | | "in" { IN } 33 | | "if" { IF } 34 | | "then" { THEN } 35 | | "else" { ELSE } 36 | | int { INT(lexeme lexbuf |> int64) } 37 | | ';' { SEMICOLON } 38 | | '+' { PLUS } 39 | | '-' { MINUS } 40 | | '*' { MUL } 41 | | '/' { DIV } 42 | | '=' { EQ } 43 | | "<>" { LESS_GREATER } 44 | | '<' { LESS } 45 | | "<=" { LESS_EQ } 46 | | '>' { GREATER } 47 | | ">=" { GREATER_EQ } 48 | | '(' { LPAREN } 49 | | ')' { RPAREN } 50 | | '"' { read_string "" lexbuf } 51 | | ident { IDENT(lexeme lexbuf) } 52 | | eof { EOF } 53 | | _ { failwith ("ParseError" + LexBuffer<_>.LexemeString lexbuf) } 54 | 55 | and read_string buf = parse 56 | | "\\\"" { read_string (buf + "\"") lexbuf } 57 | | "\\\\" { read_string (buf + "\\") lexbuf } 58 | | '"' { STRING(buf) } 59 | | eof { failwith ("ParseError: string literal is not terminated") } 60 | | _ { read_string (buf + (lexeme lexbuf)) lexbuf } 61 | 62 | and comment = parse 63 | | "*)" { () } 64 | | "(*" { comment lexbuf; comment lexbuf } 65 | | eof { failwith ("ParseError: comment is not terminated") } 66 | | _ { comment lexbuf } 67 | -------------------------------------------------------------------------------- /Litsu/LexYaccParser.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module internal LexYaccParser = 4 | 5 | val parse_error_rich: 6 | (FSharp.Text.Parsing.ParseErrorContext<'a> -> 'b) option 7 | 8 | type token = 9 | | EQ 10 | | LESS_GREATER 11 | | LESS 12 | | LESS_EQ 13 | | GREATER 14 | | GREATER_EQ 15 | | PLUS 16 | | MINUS 17 | | MUL 18 | | DIV 19 | | LPAREN 20 | | RPAREN 21 | | SEMICOLON 22 | | IF 23 | | THEN 24 | | ELSE 25 | | LET 26 | | REC 27 | | IN 28 | | IDENT of string 29 | | STRING of string 30 | | INT of int64 31 | | EOF 32 | 33 | type tokenId = 34 | | TOKEN_EQ 35 | | TOKEN_LESS_GREATER 36 | | TOKEN_LESS 37 | | TOKEN_LESS_EQ 38 | | TOKEN_GREATER 39 | | TOKEN_GREATER_EQ 40 | | TOKEN_PLUS 41 | | TOKEN_MINUS 42 | | TOKEN_MUL 43 | | TOKEN_DIV 44 | | TOKEN_LPAREN 45 | | TOKEN_RPAREN 46 | | TOKEN_SEMICOLON 47 | | TOKEN_IF 48 | | TOKEN_THEN 49 | | TOKEN_ELSE 50 | | TOKEN_LET 51 | | TOKEN_REC 52 | | TOKEN_IN 53 | | TOKEN_IDENT 54 | | TOKEN_STRING 55 | | TOKEN_INT 56 | | TOKEN_EOF 57 | | TOKEN_end_of_input 58 | | TOKEN_error 59 | 60 | type nonTerminalId = 61 | | NONTERM__startprogram 62 | | NONTERM_program 63 | | NONTERM_nodes 64 | | NONTERM_rev_nodes 65 | | NONTERM_node 66 | | NONTERM_simple_expr 67 | | NONTERM_expr 68 | | NONTERM_formal_args 69 | | NONTERM_actual_args 70 | | NONTERM_rev_actual_args 71 | 72 | val tagOfToken: t: token -> int 73 | 74 | val tokenTagToTokenId: tokenIdx: int -> tokenId 75 | 76 | /// This function maps production indexes returned in syntax errors to strings representing the non terminal that would be produced by that production 77 | val prodIdxToNonTerminal: prodIdx: int -> nonTerminalId 78 | 79 | val _fsyacc_endOfInputTag: int 80 | 81 | val _fsyacc_tagOfErrorTerminal: int 82 | 83 | val token_to_string: t: token -> string 84 | 85 | val _fsyacc_dataOfToken: t: token -> System.Object 86 | 87 | val _fsyacc_gotos: uint16[] 88 | 89 | val _fsyacc_sparseGotoTableRowOffsets: uint16[] 90 | 91 | val _fsyacc_stateToProdIdxsTableElements: uint16[] 92 | 93 | val _fsyacc_stateToProdIdxsTableRowOffsets: uint16[] 94 | 95 | val _fsyacc_action_rows: int 96 | 97 | val _fsyacc_actionTableElements: uint16[] 98 | 99 | val _fsyacc_actionTableRowOffsets: uint16[] 100 | 101 | val _fsyacc_reductionSymbolCounts: uint16[] 102 | 103 | val _fsyacc_productionToNonTerminalTable: uint16[] 104 | 105 | val _fsyacc_immediateActions: uint16[] 106 | 107 | val _fsyacc_reductions: 108 | unit -> (FSharp.Text.Parsing.IParseState -> obj)[] 109 | 110 | val tables: FSharp.Text.Parsing.Tables 111 | 112 | val engine: 113 | lexer: (FSharp.Text.Lexing.LexBuffer<'a> -> token) 114 | -> lexbuf: FSharp.Text.Lexing.LexBuffer<'a> -> startState: int -> obj 115 | 116 | val program: 117 | lexer: (FSharp.Text.Lexing.LexBuffer<'a> -> token) 118 | -> lexbuf: FSharp.Text.Lexing.LexBuffer<'a> -> SyntaxTree.Program 119 | 120 | -------------------------------------------------------------------------------- /Litsu/LexYaccParser.fsy: -------------------------------------------------------------------------------- 1 | %{ 2 | open Litsu.SyntaxTree 3 | open Litsu.Type 4 | open FSharp.Text.Parsing 5 | 6 | // fsharplint:disable 7 | 8 | let parse_error_rich = Some(fun (ctx: ParseErrorContext<_>) -> failwith "xxx") 9 | %} 10 | 11 | %start program 12 | 13 | %token EOF 14 | %token INT 15 | %token STRING 16 | %token IDENT 17 | %token LET REC IN 18 | %token IF THEN ELSE 19 | %token SEMICOLON 20 | 21 | %token LPAREN RPAREN 22 | %token PLUS MINUS MUL DIV 23 | %token EQ LESS_GREATER LESS LESS_EQ GREATER GREATER_EQ 24 | 25 | // order by operator precedence 26 | %nonassoc IN 27 | %right prec_let 28 | %right prec_if 29 | %left EQ LESS_GREATER LESS LESS_EQ GREATER GREATER_EQ 30 | %left PLUS MINUS 31 | %left MUL DIV 32 | %left prec_app 33 | 34 | %type program 35 | 36 | %% 37 | 38 | program: nodes { { Nodes = $1 } } 39 | 40 | nodes: 41 | | { [] } 42 | | rev_nodes { List.rev $1 } 43 | 44 | rev_nodes: 45 | | node { [$1] } 46 | | rev_nodes node { $2 :: $1 } 47 | 48 | node: 49 | | expr { Node.Expr $1 } 50 | | expr SEMICOLON { Node.Expr $1 } 51 | 52 | simple_expr: 53 | | LPAREN expr RPAREN { $2 } 54 | | IDENT { Expr.Var({ Name = $1; Type = newType(); }) } 55 | | LPAREN RPAREN { Expr.Unit } 56 | | INT { Expr.Int($1) } 57 | | STRING { Expr.String($1) } 58 | 59 | expr: 60 | | simple_expr { $1 } 61 | | expr PLUS expr 62 | { Expr.Infix({ Op = "+"; Left = $1; Right = $3; Type = newType(); }) } 63 | | expr MINUS expr 64 | { Expr.Infix({ Op = "-"; Left = $1; Right = $3; Type = newType(); }) } 65 | | expr MUL expr 66 | { Expr.Infix({ Op = "*"; Left = $1; Right = $3; Type = newType(); }) } 67 | | expr DIV expr 68 | { Expr.Infix({ Op = "/"; Left = $1; Right = $3; Type = newType(); }) } 69 | | expr EQ expr 70 | { Expr.Infix({ Op = "="; Left = $1; Right = $3; Type = newType(); }) } 71 | | expr LESS_GREATER expr 72 | { Expr.Infix({ Op = "<>"; Left = $1; Right = $3; Type = newType(); }) } 73 | | expr LESS expr 74 | { Expr.Infix({ Op = "<"; Left = $1; Right = $3; Type = newType(); }) } 75 | | expr LESS_EQ expr 76 | { Expr.Infix({ Op = "<="; Left = $1; Right = $3; Type = newType(); }) } 77 | | expr GREATER expr 78 | { Expr.Infix({ Op = ">"; Left = $1; Right = $3; Type = newType(); }) } 79 | | expr GREATER_EQ expr 80 | { Expr.Infix({ Op = ">="; Left = $1; Right = $3; Type = newType(); }) } 81 | | simple_expr actual_args 82 | %prec prec_app 83 | { Expr.App({ Fun = $1; Args = $2; Type = newType(); }) } 84 | | LET IDENT formal_args EQ expr IN expr 85 | %prec prec_let 86 | { Expr.Let({ 87 | Name = $2 88 | Type = newType() 89 | IsRec = false 90 | Args = $3 91 | Expr1 = $5 92 | Expr2 = $7 }) } 93 | | LET REC IDENT formal_args EQ expr IN expr 94 | %prec prec_let 95 | { Expr.Let({ 96 | Name = $3 97 | Type = newType() 98 | IsRec = true 99 | Args = $4 100 | Expr1 = $6 101 | Expr2 = $8 }) } 102 | | IF expr THEN expr ELSE expr 103 | %prec prec_if 104 | { Expr.If({ Cond = $2; Expr1 = $4; Expr2 = $6; Type = newType(); }) } 105 | 106 | formal_args: 107 | | { [] } 108 | | IDENT formal_args 109 | { { Name = $1; Type = newType(); } :: $2 } 110 | | LPAREN RPAREN formal_args 111 | { { Name = ""; Type = Type.Unit; } :: $3 } 112 | | IDENT { [{ Name = $1; Type = newType(); }] } 113 | | LPAREN RPAREN { [{ Name = ""; Type = Type.Unit; }] } 114 | 115 | actual_args: 116 | | rev_actual_args 117 | { List.rev $1 } 118 | 119 | rev_actual_args: 120 | | rev_actual_args simple_expr 121 | { $2 :: $1 } 122 | | simple_expr 123 | { [$1] } 124 | -------------------------------------------------------------------------------- /Litsu/Litsu.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Library 5 | net6.0 6 | --allsigs 7 | 8 | 9 | 10 | 11 | 12 | 13 | --module Litsu.LexYaccParser --internal 14 | 15 | 16 | 17 | --module Litsu.LexYaccLexer --internal --unicode 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /Litsu/Parser.fs: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Copyright (c) 2022 zakuro . All rights reserved. *) 4 | (* *) 5 | (* This Source Code Form is subject to the terms of the Mozilla Public *) 6 | (* License, v. 2.0. If a copy of the MPL was not distributed with this *) 7 | (* file, You can obtain one at https://mozilla.org/MPL/2.0/. *) 8 | (* *) 9 | (***********************************************************************) 10 | 11 | module Litsu.Parser 12 | 13 | open FSharp.Text.Lexing 14 | open Litsu.SyntaxTree 15 | 16 | let parse text : SyntaxTree.Program = 17 | let lexbuf = LexBuffer.FromString text 18 | 19 | try 20 | LexYaccParser.program LexYaccLexer.read lexbuf 21 | with _ -> 22 | raise (SyntaxError(lexbuf.StartPos, None)) 23 | -------------------------------------------------------------------------------- /Litsu/Parser.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module Parser = 4 | 5 | val parse: text: string -> SyntaxTree.Program 6 | 7 | -------------------------------------------------------------------------------- /Litsu/SyntaxTree.fs: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Copyright (c) 2022 zakuro . All rights reserved. *) 4 | (* *) 5 | (* This Source Code Form is subject to the terms of the Mozilla Public *) 6 | (* License, v. 2.0. If a copy of the MPL was not distributed with this *) 7 | (* file, You can obtain one at https://mozilla.org/MPL/2.0/. *) 8 | (* *) 9 | (***********************************************************************) 10 | 11 | module Litsu.SyntaxTree 12 | 13 | open FSharp.Text.Lexing 14 | open Litsu.Type 15 | 16 | type Expr = 17 | | Int of int64 18 | | String of string 19 | | Unit 20 | | Infix of Infix 21 | | Let of Let 22 | | App of App 23 | | Var of Var 24 | | If of If 25 | 26 | and Infix = 27 | { Op: string 28 | Left: Expr 29 | Right: Expr 30 | Type: Type } 31 | 32 | and Let = 33 | { Name: string 34 | Type: Type 35 | Args: Var list 36 | IsRec: bool 37 | Expr1: Expr 38 | Expr2: Expr } 39 | 40 | and App = 41 | { Fun: Expr 42 | Args: Expr list 43 | Type: Type } 44 | 45 | and Var = { Name: string; Type: Type } 46 | 47 | and If = 48 | { Cond: Expr 49 | Expr1: Expr 50 | Expr2: Expr 51 | Type: Type } 52 | 53 | let rec typ: (Expr -> Type) = 54 | function 55 | | Expr.Int (_) -> Type.Int 56 | | Expr.String (_) -> Type.String 57 | | Expr.Unit -> Type.Unit 58 | | Expr.Infix ({ Type = t }) 59 | | Expr.If ({ Type = t }) 60 | | Expr.Let ({ Type = t }) 61 | | Expr.App ({ Type = t }) 62 | | Expr.Var ({ Type = t }) -> t 63 | 64 | type Node = Expr of Expr 65 | type Program = { Nodes: Node list } 66 | 67 | exception SyntaxError of Position * string option 68 | exception ExprException of Expr * string option 69 | -------------------------------------------------------------------------------- /Litsu/SyntaxTree.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module SyntaxTree = 4 | 5 | type Expr = 6 | | Int of int64 7 | | String of string 8 | | Unit 9 | | Infix of Infix 10 | | Let of Let 11 | | App of App 12 | | Var of Var 13 | | If of If 14 | 15 | and Infix = 16 | { 17 | Op: string 18 | Left: Expr 19 | Right: Expr 20 | Type: Type.Type 21 | } 22 | 23 | and Let = 24 | { 25 | Name: string 26 | Type: Type.Type 27 | Args: Var list 28 | IsRec: bool 29 | Expr1: Expr 30 | Expr2: Expr 31 | } 32 | 33 | and App = 34 | { 35 | Fun: Expr 36 | Args: Expr list 37 | Type: Type.Type 38 | } 39 | 40 | and Var = 41 | { 42 | Name: string 43 | Type: Type.Type 44 | } 45 | 46 | and If = 47 | { 48 | Cond: Expr 49 | Expr1: Expr 50 | Expr2: Expr 51 | Type: Type.Type 52 | } 53 | 54 | val typ: _arg1: Expr -> Type.Type 55 | 56 | type Node = | Expr of Expr 57 | 58 | type Program = 59 | { Nodes: Node list } 60 | 61 | exception SyntaxError of FSharp.Text.Lexing.Position * string option 62 | 63 | exception ExprException of Expr * string option 64 | 65 | -------------------------------------------------------------------------------- /Litsu/Type.fs: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Copyright (c) 2022 zakuro . All rights reserved. *) 4 | (* *) 5 | (* This Source Code Form is subject to the terms of the Mozilla Public *) 6 | (* License, v. 2.0. If a copy of the MPL was not distributed with this *) 7 | (* file, You can obtain one at https://mozilla.org/MPL/2.0/. *) 8 | (* *) 9 | (***********************************************************************) 10 | 11 | module Litsu.Type 12 | 13 | type Type = 14 | | Unknown 15 | | String 16 | | Int 17 | | Bool 18 | | Unit 19 | | Fun of Type list * Type 20 | | Var of Type option ref 21 | 22 | let newType () = Var(ref None) 23 | -------------------------------------------------------------------------------- /Litsu/Type.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module Type = 4 | 5 | type Type = 6 | | Unknown 7 | | String 8 | | Int 9 | | Bool 10 | | Unit 11 | | Fun of Type list * Type 12 | | Var of Type option ref 13 | 14 | val newType: unit -> Type 15 | 16 | -------------------------------------------------------------------------------- /Litsu/TypeEnv.fs: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Copyright (c) 2022 zakuro . All rights reserved. *) 4 | (* *) 5 | (* This Source Code Form is subject to the terms of the Mozilla Public *) 6 | (* License, v. 2.0. If a copy of the MPL was not distributed with this *) 7 | (* file, You can obtain one at https://mozilla.org/MPL/2.0/. *) 8 | (* *) 9 | (***********************************************************************) 10 | 11 | module Litsu.TypeEnv 12 | 13 | open Litsu.Type 14 | 15 | type TypeEnv = Map 16 | 17 | let add: (string -> Type -> TypeEnv -> TypeEnv) = Map.add 18 | 19 | let addList (items: (string * Type) list) (env: TypeEnv) : TypeEnv = 20 | List.fold (fun env (k, t) -> add k t env) env items 21 | 22 | let exists: string -> TypeEnv -> bool = Map.containsKey 23 | let find: (string -> TypeEnv -> Type) = Map.find 24 | let tryFind: (string -> TypeEnv -> Type option) = Map.tryFind 25 | -------------------------------------------------------------------------------- /Litsu/TypeEnv.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module TypeEnv = 4 | 5 | type TypeEnv = Map 6 | 7 | val add: (string -> Type.Type -> TypeEnv -> TypeEnv) 8 | 9 | val addList: items: (string * Type.Type) list -> env: TypeEnv -> TypeEnv 10 | 11 | val exists: (string -> TypeEnv -> bool) 12 | 13 | val find: (string -> TypeEnv -> Type.Type) 14 | 15 | val tryFind: (string -> TypeEnv -> Type.Type option) 16 | 17 | -------------------------------------------------------------------------------- /Litsu/Typing.fs: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Copyright (c) 2022 zakuro . All rights reserved. *) 4 | (* *) 5 | (* This Source Code Form is subject to the terms of the Mozilla Public *) 6 | (* License, v. 2.0. If a copy of the MPL was not distributed with this *) 7 | (* file, You can obtain one at https://mozilla.org/MPL/2.0/. *) 8 | (* *) 9 | (***********************************************************************) 10 | 11 | module Litsu.Typing 12 | 13 | open FSharp.Compatibility.OCaml 14 | open Litsu.Type 15 | open Litsu.TypeEnv 16 | open Litsu.SyntaxTree 17 | 18 | exception UnifyException of Type * Type 19 | exception UndefinedVariableException of string 20 | 21 | let rec occur r1 = 22 | function 23 | | Type.Var (r2) when r1 == r2 -> true 24 | | Type.Var ({ contents = None }) -> false 25 | | Type.Var ({ contents = Some (t2) }) -> occur r1 t2 26 | | _ -> false 27 | 28 | let rec unify (t1: Type) (t2: Type) = 29 | match t1, t2 with 30 | | Type.Int, Type.Int 31 | | Type.Bool, Type.Bool 32 | | Type.String, Type.String -> () 33 | | Type.Unit, Type.Unit -> () 34 | | Type.Fun (args1, rt1), Type.Fun (args2, rt2) -> 35 | (try 36 | List.iter2 unify args1 args2 37 | with Invalid_argument (_) -> 38 | raise (UnifyException(t1, t2))) 39 | 40 | unify rt1 rt2 41 | | Type.Var (r1), Type.Var (r2) when r1 == r2 -> () 42 | | Type.Var ({ contents = Some (t1') }), _ -> unify t1' t2 43 | | _, Type.Var ({ contents = Some (t2') }) -> unify t1 t2' 44 | | Type.Var ({ contents = None } as r1), _ -> 45 | if occur r1 t2 then 46 | raise (UnifyException(t1, t2)) 47 | 48 | r1 := Some(t2) 49 | | _, Type.Var ({ contents = None } as r2) -> 50 | if occur r2 t1 then 51 | raise (UnifyException(t1, t2)) 52 | 53 | r2 := Some(t1) 54 | | _, _ -> raise (UnifyException(t1, t2)) 55 | 56 | 57 | let rec derefType (t: Type) : Type = 58 | let dt = derefType in 59 | 60 | match t with 61 | | Type.Var ({ contents = None } as r) -> 62 | r := Some(Type.Unknown) 63 | Type.Unknown 64 | | Type.Var ({ contents = Some (t) } as r) -> 65 | let t = dt t in 66 | r := Some(t) 67 | t 68 | | Type.Fun (targs, t) -> Type.Fun(List.map dt targs, derefType t) 69 | | t -> t 70 | 71 | let rec derefExpr (expr: Expr) : Expr = 72 | let de = derefExpr in 73 | let dt = derefType in 74 | 75 | match expr with 76 | | Expr.Int (_) 77 | | Expr.String (_) 78 | | Expr.Unit as e -> e 79 | | Expr.Infix (e) -> 80 | Expr.Infix( 81 | { Op = e.Op 82 | Left = de e.Left 83 | Right = de e.Right 84 | Type = dt e.Type } 85 | ) 86 | | Expr.If (e) -> 87 | Expr.If( 88 | { Cond = de e.Cond 89 | Expr1 = de e.Expr1 90 | Expr2 = de e.Expr2 91 | Type = dt e.Type } 92 | ) 93 | | Expr.Let (e) -> 94 | Let( 95 | { Name = e.Name 96 | Type = dt e.Type 97 | Args = (List.map (fun v -> { Name = v.Name; Type = dt v.Type }) e.Args) 98 | IsRec = e.IsRec 99 | Expr1 = de e.Expr1 100 | Expr2 = de e.Expr2 } 101 | ) 102 | | Expr.App (e) -> 103 | Expr.App( 104 | { Fun = de e.Fun 105 | Args = List.map de e.Args 106 | Type = dt e.Type } 107 | ) 108 | | Expr.Var (e) -> Expr.Var({ Name = e.Name; Type = dt e.Type }) 109 | 110 | and derefNode: Node -> Node = 111 | function 112 | | Expr (expr) -> Node.Expr(derefExpr expr) 113 | 114 | let deref (p: Program) : Program = { Nodes = List.map derefNode p.Nodes } 115 | 116 | let rec infer (env: TypeEnv) (e: Expr) : Type = 117 | try 118 | match e with 119 | | Expr.Int (_) -> Type.Int 120 | | Expr.String (_) -> Type.String 121 | | Expr.Unit -> Type.Unit 122 | | Expr.Infix (e) -> 123 | let t1 = (infer env e.Left) 124 | let t2 = (infer env e.Right) 125 | unify t1 t2 126 | 127 | match e.Op with 128 | | "=" 129 | | "<>" 130 | | "<" 131 | | "<=" 132 | | ">" 133 | | ">=" -> unify e.Type Type.Bool 134 | | "+" 135 | | "-" 136 | | "*" 137 | | "/" -> unify e.Type t1 138 | | _ -> failwith (sprintf "Unknown operator `%s`" e.Op) 139 | 140 | e.Type 141 | | Expr.If (e) -> 142 | unify Type.Bool (infer env e.Cond) 143 | let t1 = (infer env e.Expr1) in 144 | let t2 = (infer env e.Expr2) in 145 | unify t1 t2 146 | unify e.Type t1 147 | e.Type 148 | | Expr.Let (e) -> 149 | let env = if e.IsRec then TypeEnv.add e.Name e.Type env else env 150 | 151 | unify 152 | e.Type 153 | (if List.length e.Args > 0 then 154 | Type.Fun( 155 | List.map (fun (a: Var) -> a.Type) e.Args, 156 | infer 157 | (TypeEnv.addList (List.map (fun a -> (a.Name, a.Type)) e.Args) env) 158 | e.Expr1 159 | ) 160 | else 161 | infer env e.Expr1) 162 | 163 | infer (if e.IsRec then env else TypeEnv.add e.Name e.Type env) e.Expr2 164 | | Expr.App (e) -> 165 | let ft = infer env e.Fun in 166 | let nargs = List.length e.Args in 167 | 168 | match ft with 169 | | (Fun (fargs, rt) 170 | | Type.Var ({ contents = Some (Fun (fargs, rt)) })) when List.length fargs > nargs -> 171 | // partial apply 172 | List.iter2 unify fargs[0 .. (nargs - 1)] (List.map (infer env) e.Args) 173 | unify e.Type (Fun(fargs[(nargs) .. (List.length fargs)], rt)) 174 | e.Type 175 | | _ -> 176 | unify ft (Type.Fun(List.map (infer env) e.Args, e.Type)) 177 | e.Type 178 | | Expr.Var (e) -> 179 | if TypeEnv.exists e.Name env then 180 | unify e.Type (TypeEnv.find e.Name env) 181 | e.Type 182 | else 183 | raise (UndefinedVariableException e.Name) 184 | with 185 | | UnifyException (t1, t2) -> 186 | raise (ExprException(e, Some(sprintf "mismatched type: %A and %A" t1 t2))) 187 | | e -> raise e 188 | 189 | let check (p: Program) : Program = 190 | let env = TypeEnv [] 191 | 192 | List.map 193 | (function 194 | | Expr (e) -> infer env e) 195 | p.Nodes 196 | |> ignore 197 | 198 | deref p 199 | -------------------------------------------------------------------------------- /Litsu/Typing.fsi: -------------------------------------------------------------------------------- 1 | namespace Litsu 2 | 3 | module Typing = 4 | 5 | exception UnifyException of Type.Type * Type.Type 6 | 7 | exception UndefinedVariableException of string 8 | 9 | val occur: r1: Type.Type option ref -> _arg1: Type.Type -> bool 10 | 11 | val unify: t1: Type.Type -> t2: Type.Type -> unit 12 | 13 | val derefType: t: Type.Type -> Type.Type 14 | 15 | val derefExpr: expr: SyntaxTree.Expr -> SyntaxTree.Expr 16 | 17 | val derefNode: _arg1: SyntaxTree.Node -> SyntaxTree.Node 18 | 19 | val deref: p: SyntaxTree.Program -> SyntaxTree.Program 20 | 21 | val infer: env: TypeEnv.TypeEnv -> e: SyntaxTree.Expr -> Type.Type 22 | 23 | val check: p: SyntaxTree.Program -> SyntaxTree.Program 24 | 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Litsu 2 | 3 | A statically-typed functional language that is transpiled into POSIX sh. 4 | 5 | ## Example 6 | 7 | ```ml 8 | (* fib.lit *) 9 | let rec fib n = 10 | if n <= 1 then 11 | n 12 | else 13 | fib (n - 1) + fib (n - 2) 14 | in fib 10 15 | ``` 16 | 17 | ``` 18 | $ litc fib.lit | sh 19 | 55 20 | ``` 21 | 22 | ## Build 23 | 24 | ``` 25 | $ dotnet build 26 | ``` 27 | -------------------------------------------------------------------------------- /litc/Main.fs: -------------------------------------------------------------------------------- 1 | // Copyright (c) 2022 zakuro . All rights reserved. 2 | // 3 | // This Source Code Form is subject to the terms of the Mozilla Public 4 | // License, v. 2.0. If a copy of the MPL was not distributed with this 5 | // file, You can obtain one at https://mozilla.org/MPL/2.0/. 6 | 7 | open Argu 8 | open System 9 | open System.IO 10 | open Litsu.SyntaxTree 11 | open Litsu.Parser 12 | open Litsu.Typing 13 | open Litsu.Compiler 14 | open Litsu.Run 15 | 16 | type MainArgs = 17 | | [] File of file: string 18 | | [] Run 19 | | [] Ast 20 | | [] TypedAst 21 | 22 | interface IArgParserTemplate with 23 | member this.Usage = 24 | match this with 25 | | File _ -> "input file" 26 | | Run _ -> "run after compile" 27 | | Ast _ -> "print ast" 28 | | TypedAst _ -> "print ast with type check" 29 | 30 | [] 31 | let main argv = 32 | let p = 33 | ArgumentParser.Create( 34 | programName = "litc", 35 | errorHandler = 36 | ProcessExiter( 37 | colorizer = 38 | function 39 | | ErrorCode.HelpText -> None 40 | | _ -> Some ConsoleColor.Red 41 | ) 42 | ) 43 | 44 | let results = p.ParseCommandLine argv 45 | 46 | let code = 47 | use file = 48 | (match results.GetResults(MainArgs.File) with 49 | | [] -> 50 | (if Console.IsInputRedirected then 51 | Console.In 52 | else 53 | p.PrintUsage() |> printf "%s" 54 | exit 0) 55 | | [ path ] -> new StreamReader(path) 56 | | _ -> eprintfn "too many input" |> exit 1) 57 | 58 | file.ReadToEnd() 59 | 60 | let (exitcode, out) = 61 | (try 62 | if results.TryGetResult(MainArgs.Ast) <> None then 63 | (0, parse code |> sprintf "%A\n") 64 | else if results.TryGetResult(MainArgs.TypedAst) <> None then 65 | (0, parse code |> check |> sprintf "%A\n") 66 | else if results.TryGetResult(MainArgs.Run) <> None then 67 | (run code, "") 68 | else 69 | (0, compile code |> sprintf "%s") 70 | with 71 | | SyntaxError (pos, None) -> (1, sprintf "%d:%d: %s\n" pos.Line pos.Column "SyntaxError") 72 | | SyntaxError (pos, Some (msg)) -> (1, sprintf "%d:%d: %s" pos.Line pos.Column msg) 73 | | ExprException (e, None) -> (1, sprintf "error at %A" e) 74 | | ExprException (e, Some (msg)) -> (1, sprintf "%s\n-- at --\n%A\n--------\n" msg e) 75 | | UndefinedVariableException (v) -> (1, sprintf "undefined variable `%s`\n" v)) 76 | 77 | (if exitcode = 0 then printf else eprintf) "%s" out 78 | exitcode 79 | -------------------------------------------------------------------------------- /litc/litc.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Exe 5 | net6.0 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /tests/comment_unterminated.fail.lit: -------------------------------------------------------------------------------- 1 | (* (* *) 2 | -------------------------------------------------------------------------------- /tests/comments.lit: -------------------------------------------------------------------------------- 1 | 0; 2 | // 1 3 | 2; 4 | (* 5 | 3.1 6 | (* 7 | 3.2 8 | (* 3.2.1 (* 3.2.1.1 *) *) 9 | )(( 10 | )() 11 | *) 12 | 3.3 13 | *) (* xx *) (* *) 14 | 4; 15 | -------------------------------------------------------------------------------- /tests/eq.lit: -------------------------------------------------------------------------------- 1 | 1 = 1; 2 | 1 + 1 = 3 - 1; 3 | 1 <> 1; 4 | 1 + 1 <> 3 - 1; 5 | 6 | 1 = 2; 7 | 1 + 2 = 2 - 1; 8 | 1 <> 2; 9 | 1 + 2 <> 2 - 1; 10 | 11 | 1 + 1 > 2 - 1; 12 | 1 + 1 >= 2 - 1; 13 | 1 + 1 < 2 - 1; 14 | 1 + 1 <= 2 - 1; 15 | 16 | 1 + 1 > 5 - 1; 17 | 1 + 1 >= 5 - 1; 18 | 1 + 1 < 5 - 1; 19 | 1 + 1 <= 5 - 1; 20 | 21 | 1 + 1 > 3 - 1; 22 | 1 + 1 >= 3 - 1; 23 | 1 + 1 < 3 - 1; 24 | 1 + 1 <= 3 - 1; 25 | -------------------------------------------------------------------------------- /tests/expr.lit: -------------------------------------------------------------------------------- 1 | 1 + 2; 2 | 1 - 2 - 3 + 4; 3 | (1 - 2) - (3 + 4); 4 | 2 * 2 + 5 / 3; 5 | 2 * (2 + 5) / 3; 6 | -------------------------------------------------------------------------------- /tests/fail.lit: -------------------------------------------------------------------------------- 1 | 1 + 2 | -------------------------------------------------------------------------------- /tests/fib.lit: -------------------------------------------------------------------------------- 1 | let rec fib n = 2 | if n <= 1 then 3 | n 4 | else 5 | fib (n - 1) + fib (n - 2) 6 | in fib 10 7 | -------------------------------------------------------------------------------- /tests/if.lit: -------------------------------------------------------------------------------- 1 | if 1 = 1 then 2 | 1 3 | else 4 | 0 5 | ; 6 | if 1 = 0 then 7 | 1 8 | else 9 | 0 10 | ; 11 | let i = 0 in 12 | if i = i then 13 | if i = 0 then 14 | if i = 1 then 15 | "i = i, i = 0, i = 1" 16 | else 17 | "i = i, i = 0, not i = 1" 18 | else 19 | "i = i, not i = 0" 20 | else 21 | "not i = i" 22 | ; 23 | -------------------------------------------------------------------------------- /tests/let.lit: -------------------------------------------------------------------------------- 1 | let n = 10 in n + 1; 2 | -------------------------------------------------------------------------------- /tests/let_fun.lit: -------------------------------------------------------------------------------- 1 | let f () = "unit" in f (); 2 | let add a b = a + b in add 1 2; 3 | let add a b = a + b in 4 | let add_alt = add in add_alt 2 2; 5 | let add a b = a + b in 6 | let inc = add 1 in 7 | inc 1 8 | -------------------------------------------------------------------------------- /tests/string.lit: -------------------------------------------------------------------------------- 1 | "abc\"\\${x}"; 2 | -------------------------------------------------------------------------------- /tests/unit.lit: -------------------------------------------------------------------------------- 1 | (); 2 | let f () = () in f (); 3 | let fa () a () = a in fa () "fa () a ()" (); 4 | if (let f () = () in f ()) = () then 5 | "f() is unit" 6 | else 7 | "f() is not unit" 8 | -------------------------------------------------------------------------------- /verified_output/tests.comments.lit.verified.txt: -------------------------------------------------------------------------------- 1 | 0 2 | 2 3 | 4 4 | -------------------------------------------------------------------------------- /verified_output/tests.eq.lit.verified.txt: -------------------------------------------------------------------------------- 1 | true 2 | true 3 | false 4 | false 5 | false 6 | false 7 | true 8 | true 9 | true 10 | true 11 | false 12 | false 13 | false 14 | false 15 | true 16 | true 17 | false 18 | true 19 | false 20 | true 21 | -------------------------------------------------------------------------------- /verified_output/tests.expr.lit.verified.txt: -------------------------------------------------------------------------------- 1 | 3 2 | 0 3 | -8 4 | 5 5 | 4 6 | -------------------------------------------------------------------------------- /verified_output/tests.fib.lit.verified.txt: -------------------------------------------------------------------------------- 1 | 55 2 | -------------------------------------------------------------------------------- /verified_output/tests.if.lit.verified.txt: -------------------------------------------------------------------------------- 1 | 1 2 | 0 3 | i = i, i = 0, not i = 1 4 | -------------------------------------------------------------------------------- /verified_output/tests.let.lit.verified.txt: -------------------------------------------------------------------------------- 1 | 11 2 | -------------------------------------------------------------------------------- /verified_output/tests.let_fun.lit.verified.txt: -------------------------------------------------------------------------------- 1 | unit 2 | 3 3 | 4 4 | 2 5 | -------------------------------------------------------------------------------- /verified_output/tests.string.lit.verified.txt: -------------------------------------------------------------------------------- 1 | abc"\${x} 2 | -------------------------------------------------------------------------------- /verified_output/tests.unit.lit.verified.txt: -------------------------------------------------------------------------------- 1 | fa () a () 2 | f() is unit 3 | -------------------------------------------------------------------------------- /z.yaml: -------------------------------------------------------------------------------- 1 | default: run 2 | tasks: 3 | run: dotnet run --project litc -- $@ 4 | build: dotnet build $@ 5 | test: dotnet test $@ 6 | tools: 7 | tasks: 8 | fantomas: dotnet tool run fantomas -- $@ 9 | fsharplint: dotnet tool run dotnet-fsharplint -- $@ 10 | fslex: dotnet ~/.nuget/packages/fslexyacc/*/build/fslex/netcoreapp3.1/fslex.dll -o - $@ 11 | fsyacc: dotnet ~/.nuget/packages/fslexyacc/10.*/build/fsyacc/*/fsyacc.dll -o - $@ 12 | fmt: z tools.fantomas ./**/*.fs -r $@ 13 | fmt.check: z fmt --check $@ 14 | lint: z tools.fsharplint lint Litsu.sln 15 | --------------------------------------------------------------------------------