├── .gitignore ├── .travis.yml ├── README.md ├── dub.json ├── dub.selections.json ├── epcompat ├── .gitignore ├── dub.json ├── dub.selections.json └── source │ └── epcompat │ ├── array.d │ ├── enumeration.d │ ├── file.d │ ├── initial.d │ ├── interval.d │ ├── ordinal.d │ ├── package.d │ ├── set.d │ └── string.d ├── examples ├── arraybase │ ├── dub.json │ └── source │ │ └── arraybase.pas ├── arrayc │ ├── .gitignore │ ├── dub.json │ ├── dub.selections.json │ ├── manual_translation │ │ └── arrayc.d │ └── source │ │ └── main.d ├── hello │ ├── .gitignore │ ├── dub.json │ └── source │ │ └── hello.pas └── schema │ └── manual_translation │ ├── dub.selections.json │ └── schema.d ├── runtests.d └── source ├── README.txt ├── epgrammar.d ├── generate.d ├── main.d ├── make.d └── p2d.d /.gitignore: -------------------------------------------------------------------------------- 1 | .dub 2 | docs.json 3 | __dummy.html 4 | docs/ 5 | pascal2d.so 6 | pascal2d.dylib 7 | pascal2d.dll 8 | pascal2d.a 9 | pascal2d.lib 10 | pascal2d-test-* 11 | *.exe 12 | *.o 13 | *.obj 14 | *.lst 15 | source/epparser.d 16 | source/._.DS_Store 17 | ._.DS_Store 18 | .DS_Store 19 | source/.DS_Store 20 | epcompat/pascal2d_epcompat.lib 21 | examples/hello/source/hello.d 22 | epcompat/epcompat.lib 23 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: d 2 | 3 | # Define the encypted variable GH_REPO_TOKEN 4 | env: 5 | global: 6 | secure: V14fiIfC9noIUoEELlgq/1ejid8srPdT3Ut5t3Y+LlUcs901PtaVf/DaYaN9ZvqF5zZVhJ1t8v5Fys/V2nOns7dNmA1D6CEXj9tpgh9AzTZvmiWNTlgAzTWcMgwqZKy5nloq/n1No3nMXvh+VFEw9/wTX6e3h26ve04T8B5DY/EcCofL4UxZjqPtyTinx04RSF41MPTfl/yTCAiQuZW7tcgh9IDez9qjRip96v72iTOIjhvcZIuECW0f80EzNZwMVNcX/j8iC0JMf8tPOAiF07apMLjyKSy8coF/MknnafGIdjDXgg3ebgWF1hPZUhehjUPkm8a0VHxGH2iJxJHzxYu2gKAq4f0ZjQn8KJHz7XJ7rE7E7Awiz7vzNGBIekAhzF7K0L0yK1FbvllwcitGoOl4wWmOyIu9Ckmlgc5usUdUua8lYrwjbjLtzIset0Zfx7t+EIFtSQwN3PZj8nS91zxbl3Y4WBtAr8rJZR6aPG21dgy3BJFcDwQ7sfqU2XiAkA58DNPAPP2En1jDcGHJS3qdcez4LUt9jLKtil3DJXkY7LAS86g0c/jnEKynp1+GJ0RPEbz/xwT9gHVGGlKa/SQaql+cv3VTJAV85ERZTogKltmdVcPqoH3Kex0hY/n9PehNu7MuEUiURz0Fi9/8oxZqJHpVl7rTkTXe+DCZEZA= 7 | 8 | sudo: false 9 | 10 | branches: 11 | only: 12 | - master 13 | 14 | addons: 15 | apt: 16 | packages: 17 | - libevent-dev 18 | 19 | # Build steps 20 | script: 21 | # Workaround https://github.com/dlang/dub/issues/1474 22 | - dub generate sublimetext 23 | - dub test --compiler=${DC} 24 | - dub test pascal2d:epcompat --compiler=${DC} 25 | - cd epcompat && dub build --config="ddox" -b ddox && cd .. 26 | 27 | # Deploy using travis builtin GitHub Pages support 28 | deploy: 29 | provider: pages 30 | skip_cleanup: true 31 | local_dir: "epcompat/docs" 32 | github_token: "$GH_REPO_TOKEN" 33 | on: 34 | branch: master 35 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/veelo/Pascal2D.svg?branch=master)](https://travis-ci.org/veelo/Pascal2D) 2 | 3 | # Pascal2D 4 | 5 | **Pascal2D** is a transcompiler that translates [ISO 10206 Extended Pascal](http://pascal-central.com/docs/iso10206.pdf) (EP) to D, 6 | with support for some non-standard [Prospero](https://web.archive.org/web/20131023234615/http://www.prosperosoftware.com:80/) 7 | extensions. 8 | 9 | The goal is to translate around 500 kloc of proprietary source code, see the 10 | [DConf 2017 talk](https://www.youtube.com/watch?v=t5y9dVMdI7I&list=PL3jwVPmk_PRxo23yyoc0Ip_cP3-rCm7eB&index=21) (with 11 | [continuation](https://www.youtube.com/watch?v=3ugQ1FFGkLY)) for some background information. You can also read 12 | [how an engineering company chose tomigrate to D](https://dlang.org/blog/2018/06/20/how-an-engineering-company-chose-to-migrate-to-d/). 13 | 14 | ## Current status 15 | 16 | What you see here is the initial development of *Pascal2D*, developed in open source prior to the decision of 17 | [SARC](https://www.sarc.nl) to go ahead with translation of all its EP code. _For the time being, SARC management has decided to fund 18 | further development off-line. If you have any interest in this project, for any reason, please 19 | [do get in contact](https://www.sarc.nl/contact/), we'd love to hear from you_. We are very reasonable people and I'm sure we can work 20 | something out. 21 | 22 | ## Getting started 23 | Given you have installed a [D compiler](https://dlang.org/download.html) and a [git client](https://git-scm.com/downloads/), 24 | clone the Pascal2D repository and do 25 | ```shell 26 | cd Pascal2D 27 | dub build 28 | ``` 29 | This will produce the `pascal2d` executable that can then be used to translate a Pascal source file, say `example.pas`, like 30 | so: 31 | ``` 32 | pascal2d example.pas > example.d 33 | ``` 34 | Optionally, the syntax tree of the Pascal file can be produced in HTML format by passing the `--syntax_tree` or `-s` argument. 35 | 36 | 37 | ## Minimal example 38 | In [examples/hello/source/hello.pas](examples/hello/source/hello.pas) you will find this Pascal source: 39 | ```Pascal 40 | program hello(output); 41 | 42 | begin 43 | writeln('Hello D''s "World"!'); 44 | end. 45 | ``` 46 | Calling dub in that directory 47 | ``` 48 | cd examples\hello 49 | dub 50 | ``` 51 | will translate, compile and run that file. The translated file ends up in `examples\hello\source\hello.d` and looks like this: 52 | ```D 53 | import std.stdio; 54 | 55 | // Program name: hello 56 | void main(string[] args) 57 | { 58 | writeln("Hello D's \"World\"!"); 59 | } 60 | ``` 61 | 62 | ## Compatibility library *epcompat* 63 | Translated sources depend on the [epcompat sub package](https://github.com/veelo/Pascal2D/tree/master/epcompat), which is a library that provides type compatibility with and implements features of Extended Pascal. Some of its modules can be of value in hand written D code as wel, the [*epcompat* API](https://veelo.github.io/Pascal2D/) is available online. 64 | 65 | ## Array example 66 | In Extended Pascal, arrays can start at any index value. The example [examples/arraybase](examples/arraybase) shows how this is translated, including writing such array's to binary file. This is the Extended Pascal source: 67 | ```Pascal 68 | program arraybase(input,output); 69 | 70 | type t = array[2..20] of integer; 71 | var a : t; 72 | n : integer; 73 | f : bindable file of t; 74 | 75 | begin 76 | for n := 2 to 20 do 77 | a[n] := n; 78 | writeln('Size of t in bytes is ',sizeof(a):1); 79 | if openwrite(f,'array.dat') then 80 | begin 81 | write(f,a); 82 | close(f); 83 | end; 84 | end. 85 | ``` 86 | Calling `dub` in that directory translates this into the following working D code, using [dfmt](https://code.dlang.org/packages/dfmt) to fixup formatting: 87 | ```D 88 | import epcompat; 89 | import std.stdio; 90 | 91 | // Program name: arraybase 92 | alias t = StaticArray!(int, 2, 20); 93 | 94 | t a; 95 | int n; 96 | Bindable!t f; 97 | 98 | void main(string[] args) 99 | { 100 | for (n = 2; n <= 20; n++) 101 | a[n] = n; 102 | writeln("Size of t in bytes is ", a.sizeof); 103 | if (openwrite(f, "array.dat")) 104 | { 105 | epcompat.write(f, a); 106 | close(f); 107 | } 108 | } 109 | ``` 110 | 111 | ## Running tests 112 | The following script will run unit tests, transcompile examples, run them and check their output to make sure they work as expected: 113 | ```shell 114 | rdmd runtests.d 115 | ``` 116 | -------------------------------------------------------------------------------- /dub.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "pascal2d", 3 | "description": "Transcompiler from Prospero Extended Pascal to D.", 4 | "authors": [ 5 | "Bastiaan N. Veelo" 6 | ], 7 | "copyright": "Copyright © 2018, Bastiaan N. Veelo, SARC B.V.", 8 | "license": "boost", 9 | "dependencies": { 10 | "pegged": "~>0.4.2", 11 | "pascal2d:epcompat": "*" 12 | }, 13 | "subPackages": [ 14 | "./epcompat", 15 | "./examples/hello" 16 | ], 17 | "excludedSourceFiles": [ 18 | "source/epgrammar.d", 19 | "source/generate.d", 20 | "source/make.d" 21 | ], 22 | "preGenerateCommands": [ 23 | "cd $PACKAGE_DIR/source && rdmd make.d $PEGGED_PACKAGE_DIR" 24 | ] 25 | } 26 | -------------------------------------------------------------------------------- /dub.selections.json: -------------------------------------------------------------------------------- 1 | { 2 | "fileVersion": 1, 3 | "versions": { 4 | "pegged": "0.4.3" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /epcompat/.gitignore: -------------------------------------------------------------------------------- 1 | .dub 2 | docs.json 3 | __dummy.html 4 | *.o 5 | *.obj 6 | __test__*__ 7 | -------------------------------------------------------------------------------- /epcompat/dub.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "epcompat", 3 | "authors": [ 4 | "Bastiaan Veelo" 5 | ], 6 | "description": "Extended Pascal compatibility.", 7 | "copyright": "Copyright © 2017, SARC B.V.", 8 | "license": "boost", 9 | "configurations": [ 10 | { 11 | "name": "library" 12 | }, 13 | { 14 | "name": "unittest" 15 | }, 16 | { 17 | "COMMENT": "dub build --config=\"ddox\" -b ddox", 18 | "name": "ddox", 19 | "COMMENT": "Because of https://issues.dlang.org/show_bug.cgi?id=18211", 20 | "excludedSourceFiles": [ 21 | "source/epcompat/enumeration.d" 22 | ], 23 | "versions": ["ddox"] 24 | } 25 | ], 26 | "-ddoxFilterArgs": [ 27 | "--unittest-examples", 28 | "--min-protection=Protected" 29 | ], 30 | "-ddoxTool": "scod" 31 | } 32 | -------------------------------------------------------------------------------- /epcompat/dub.selections.json: -------------------------------------------------------------------------------- 1 | { 2 | "fileVersion": 1, 3 | "versions": { 4 | "botan": "1.12.9", 5 | "botan-math": "1.0.3", 6 | "diet-ng": "1.4.5", 7 | "eventcore": "0.8.34", 8 | "libasync": "0.8.3", 9 | "libevent": "2.0.2+2.0.16", 10 | "memutils": "0.4.10", 11 | "openssl": "1.1.6+1.0.1g", 12 | "stdx-allocator": "2.77.1", 13 | "taggedalgebraic": "0.10.11", 14 | "vibe-core": "1.4.0", 15 | "vibe-d": "0.8.3" 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/array.d: -------------------------------------------------------------------------------- 1 | module epcompat.array; 2 | 3 | // Test with rdmd -m64 -main -unittest -debug -g source\epcompat\array.d 4 | 5 | // TODO multi-dimansional arrays. Need to support different types for different dimensions? 6 | 7 | 8 | struct StaticArray(T, E) if (is(E == enum)) 9 | { 10 | T[E.max - E.min + 1] _payload; 11 | 12 | alias _payload this; 13 | 14 | /** 15 | Indexing operators yield or modify the value at a specified $(D_PARAM index). 16 | 17 | Precondition: `first <= index <= last` 18 | 19 | Complexity: $(BIGOH 1) 20 | */ 21 | 22 | // Support e = arr[5]; 23 | ref inout(T) opIndex(E index) inout { 24 | assert(index >= E.min); 25 | assert(index <= E.max); 26 | return _payload[index - E.min]; 27 | } 28 | 29 | /// ditto 30 | // Support arr[5] = e; 31 | void opIndexAssign(U : T)(auto ref U value, E index) { 32 | assert(index >= E.min); 33 | assert(index <= E.max); 34 | _payload[index - E.min] = value; 35 | } 36 | 37 | /// ditto 38 | // Support foreach(e; arr). 39 | int opApply(scope int delegate(ref T) dg) 40 | { 41 | int result = 0; 42 | 43 | for (int i = 0; i < _payload.length; i++) 44 | { 45 | result = dg(_payload[i]); 46 | if (result) 47 | break; 48 | } 49 | return result; 50 | } 51 | 52 | /// ditto 53 | // Support foreach(i, e; arr). 54 | int opApply(scope int delegate(E index, ref T) dg) 55 | { 56 | import std.conv; 57 | int result = 0; 58 | 59 | for (size_t i = 0; i < _payload.length; i++) 60 | { 61 | result = dg(to!E(i + to!ptrdiff_t(E.min)), _payload[i]); 62 | if (result) 63 | break; 64 | } 65 | return result; 66 | } 67 | 68 | /** 69 | Write to binary file. 70 | */ 71 | import epcompat.file; 72 | void toFile(T)(Bindable!T f) 73 | { 74 | f.f.lock; 75 | toFile(f.f); 76 | f.f.unlock; 77 | } 78 | import std.stdio; 79 | void toFile(File f) 80 | { 81 | f.rawWrite(_payload); 82 | } 83 | /// ditto 84 | void toFile(string fileName) 85 | { 86 | auto f = File(fileName, "wb"); 87 | f.lock; 88 | toFile(f); 89 | f.unlock; 90 | } 91 | } 92 | 93 | unittest 94 | { 95 | import epcompat.enumeration; 96 | enum E {One, Two, Three, Four} 97 | mixin withEnum!E; 98 | StaticArray!(int, E) arr1; 99 | assert(arr1.length == 4); 100 | arr1[Two] = 2; 101 | assert(arr1[Two] == 2); 102 | arr1[Four] = 4; 103 | assert(arr1[Four] == 4); 104 | 105 | StaticArray!(StaticArray!(int, E), -1, 1) arr2; 106 | arr2[-1][One] = 10; 107 | arr2[ 0][Two] = 20; 108 | arr2[ 1][Three] = 30; 109 | arr2[-1][Four] = 40; 110 | arr2[ 0][One] = 50; 111 | arr2[ 1][Four] = 60; 112 | assert(arr2[-1][One] == 10); 113 | assert(arr2[ 0][Two] == 20); 114 | assert(arr2[ 1][Three] == 30); 115 | assert(arr2[-1][Four] == 40); 116 | assert(arr2[ 0][One] == 50); 117 | assert(arr2[ 1][Four] == 60); 118 | assert(!__traits(compiles, arr2[One][-1])); 119 | } 120 | 121 | 122 | /** 123 | A fixed-length array on type $(D_PARAM T) with an index that runs from 124 | $(D_PARAM first) to $(D_PARAM last) inclusive. The bounds are supplied at 125 | compile-time. 126 | */ 127 | 128 | align(1): 129 | struct StaticArray(T, ptrdiff_t first, ptrdiff_t last) 130 | { 131 | align(1): 132 | T[last - first + 1] _payload; // Cannot be private. 133 | 134 | alias _payload this; 135 | 136 | /** 137 | Indexing operators yield or modify the value at a specified $(D_PARAM index). 138 | 139 | Precondition: `first <= index <= last` 140 | 141 | Complexity: $(BIGOH 1) 142 | */ 143 | 144 | // Support e = arr[5]; 145 | ref inout(T) opIndex(ptrdiff_t index) inout { 146 | assert(index >= first); 147 | assert(index <= last); 148 | return _payload[index - first]; 149 | } 150 | 151 | /// ditto 152 | // Support arr[5] = e; 153 | void opIndexAssign(U : T)(auto ref U value, ptrdiff_t index) { 154 | assert(index >= first); 155 | assert(index <= last); 156 | _payload[index - first] = value; 157 | } 158 | 159 | /// ditto 160 | // Support foreach(e; arr). 161 | int opApply(scope int delegate(ref T) dg) 162 | { 163 | int result = 0; 164 | 165 | for (int i = 0; i < _payload.length; i++) 166 | { 167 | result = dg(_payload[i]); 168 | if (result) 169 | break; 170 | } 171 | return result; 172 | } 173 | 174 | /// ditto 175 | // Support foreach(i, e; arr). 176 | int opApply(scope int delegate(ptrdiff_t index, ref T) dg) 177 | { 178 | int result = 0; 179 | 180 | for (size_t i = 0; i < _payload.length; i++) 181 | { 182 | result = dg(i + first, _payload[i]); 183 | if (result) 184 | break; 185 | } 186 | return result; 187 | } 188 | 189 | /** 190 | Write to binary file. 191 | */ 192 | import epcompat.file; 193 | void toFile(T)(Bindable!T f) 194 | { 195 | f.f.lock; 196 | toFile(f.f); 197 | f.f.unlock; 198 | } 199 | import std.stdio; 200 | void toFile(File f) 201 | { 202 | f.rawWrite(_payload); 203 | } 204 | /// ditto 205 | void toFile(string fileName) 206 | { 207 | auto f = File(fileName, "wb"); 208 | f.lock; 209 | toFile(f); 210 | f.unlock; 211 | } 212 | } 213 | 214 | /// 215 | unittest { 216 | StaticArray!(int, -10, 10) arr; 217 | assert(arr.length == 21); 218 | assert(arr.sizeof == arr.length * int.sizeof); 219 | 220 | foreach (ref e; arr) 221 | e = 42; 222 | assert(arr[-10] == 42); 223 | assert(arr[0] == 42); 224 | assert(arr[10] == 42); 225 | 226 | import std.conv : to; 227 | foreach (i, ref e; arr) 228 | e = i.to!int; // i is of type size_t. 229 | assert(arr[-10] == -10); 230 | assert(arr[0] == 0); 231 | assert(arr[5] == 5); 232 | assert(arr[10] == 10); 233 | 234 | arr[5] = 15; 235 | assert(arr[5] == 15); 236 | } 237 | 238 | 239 | import epcompat.interval; 240 | 241 | /** 242 | A variable-length array on type $(D_PARAM T) with an index of type $(D_PARAM I) 243 | that runs from $(D_PARAM first) to $(D_PARAM last) inclusive. The bounds are 244 | supplied at run-time. 245 | */ 246 | align(1): 247 | struct Array(T, I = int) 248 | { 249 | align(1): 250 | private: 251 | I m_first; 252 | I m_last; 253 | public: 254 | T[] _payload; 255 | alias _payload this; 256 | @property I first() const {return m_first;} 257 | @property I last() const {return m_last;} 258 | /** 259 | Sets new first index. 260 | 261 | Existing values will move. 262 | */ 263 | @property I first(I new_first) { 264 | _payload.length = m_last - new_first + 1; 265 | return m_first = new_first; 266 | } 267 | /** 268 | Resize to new last index. 269 | */ 270 | @property I last(I new_last) { 271 | _payload.length = new_last - m_first + 1; 272 | return m_last = new_last; 273 | } 274 | /** 275 | Resize to new first and last boundaries. 276 | 277 | If the first index is changed, existing values will move. 278 | */ 279 | void resize(I new_first, I new_last) { 280 | // New elements are default initialized. 281 | // To leave out initialisation see https://dlang.org/library/std/array/uninitialized_array.html 282 | _payload.length = new_last - new_first + 1; 283 | m_first = new_first; 284 | m_last = new_last; 285 | } 286 | 287 | /** 288 | Construct an Array from first to last inclusive. 289 | */ 290 | this(I first, I last) 291 | { 292 | resize(first, last); 293 | } 294 | /** 295 | Construct an Array on an interval i. 296 | */ 297 | this(Interval!I i) 298 | { 299 | resize(i.low, i.high); 300 | } 301 | 302 | /** 303 | Indexing operators yield or modify the value at a specified $(D_PARAM index). 304 | 305 | Precondition: $(D first <= index <= last) 306 | 307 | Complexity: $(BIGOH 1) 308 | */ 309 | // Support e = arr[5]; 310 | ref inout(T) opIndex(I index) inout { 311 | assert(index >= first); 312 | assert(index <= last); 313 | return _payload[index - first]; 314 | } 315 | 316 | // Support arr[5] = e; 317 | void opIndexAssign(U : T)(auto ref U value, I index) { 318 | assert(index >= first); 319 | assert(index <= last); 320 | _payload[index - first] = value; 321 | } 322 | 323 | // Support foreach(e; arr). 324 | int opApply(scope int delegate(ref T) dg) 325 | { 326 | int result = 0; 327 | 328 | for (int i = 0; i < _payload.length; i++) 329 | { 330 | result = dg(_payload[i]); 331 | if (result) 332 | break; 333 | } 334 | return result; 335 | } 336 | 337 | // Support foreach(i, e; arr). 338 | int opApply(scope int delegate(I index, ref T) dg) 339 | { 340 | import std.conv; 341 | int result = 0; 342 | 343 | for (ptrdiff_t i = 0; i < _payload.length; i++) 344 | { 345 | result = dg(to!I(i + to!ptrdiff_t(first)), _payload[i]); 346 | if (result) 347 | break; 348 | } 349 | return result; 350 | } 351 | 352 | // Write to binary file. 353 | import epcompat.file; 354 | void toFile(T)(Bindable!T f) 355 | { 356 | f.f.lock; 357 | toFile(f.f); 358 | f.f.unlock; 359 | } 360 | import std.stdio; 361 | void toFile(File f) 362 | { 363 | f.rawWrite(_payload); 364 | } 365 | // Write to binary file. 366 | void toFile(string fileName) 367 | { 368 | auto f = File(fileName, "wb"); 369 | f.lock; 370 | toFile(f); 371 | f.unlock; 372 | } 373 | // Read from binary file. 374 | void fromFile(File f) 375 | { 376 | f.rawRead(_payload); 377 | } 378 | // Read from binary file. 379 | void fromFile(string fileName) 380 | { 381 | auto f = File(fileName, "b"); 382 | f.lock; 383 | fromFile(f); 384 | f.unlock; 385 | } 386 | } 387 | 388 | /// 389 | unittest { 390 | auto arr = Array!int(-10, 10); 391 | assert(arr.length == 21); 392 | import std.stdio; 393 | // writeln("arr.length * int.sizeof = ", arr.length * int.sizeof); 394 | // assert(arr.sizeof == arr.length * int.sizeof); // 94 != 32 (in 64 bit) 94 != 16 (in 32 bit). FIXME 395 | 396 | foreach (ref e; arr) 397 | e = 42; 398 | assert(arr[-10] == 42); 399 | assert(arr[0] == 42); 400 | assert(arr[10] == 42); 401 | 402 | import std.conv : to; 403 | foreach (i, ref e; arr) 404 | e = i.to!int; // i is of type size_t. 405 | assert(arr[-10] == -10); 406 | assert(arr[0] == 0); 407 | assert(arr[5] == 5); 408 | assert(arr[10] == 10); 409 | 410 | arr[5] = 15; 411 | assert(arr[5] == 15); 412 | } 413 | 414 | /// 415 | unittest { // schema array toFile/fromFile 416 | // type s(low,high:integer) = array[low..high] of integer; 417 | struct s 418 | { 419 | @disable this(); 420 | this(int low, int high) 421 | { 422 | this.low = low; 423 | this.high = high; 424 | _payload = Array!int(low, high); 425 | } 426 | immutable int low, high; 427 | private: 428 | Array!int _payload; 429 | alias _payload this; 430 | } 431 | 432 | s t1 = s(-5, 5); 433 | for (int n = t1.low; n <= t1.high; n++) 434 | t1[n] = n * 3; 435 | import std.stdio; 436 | File tmp = File.tmpfile(); 437 | t1.toFile(tmp); 438 | tmp.flush; 439 | 440 | assert(tmp.size == 11 * int.sizeof); 441 | 442 | tmp.rewind; 443 | auto buf = tmp.rawRead(new int[cast(uint)(tmp.size)]); 444 | foreach (i, b; buf) 445 | assert(b == (i - 5) * 3); 446 | 447 | tmp.rewind; 448 | s t2 = s(-5, 5); 449 | t2.fromFile(tmp); 450 | assert(t2 == t1); 451 | } 452 | 453 | /// 454 | unittest 455 | { 456 | auto arr = Array!char(interval(5, 25)); 457 | assert(arr.length == 21); 458 | arr[5] = 'a'; 459 | assert(arr[5] == 'a'); 460 | arr[25] = 'b'; 461 | assert(arr[25] == 'b'); 462 | 463 | auto arr2 = Array!(int, char)(interval('a', 'g')); 464 | assert(arr2.length == 7); 465 | arr2['a'] = 2; 466 | assert(arr2['a'] == 2); 467 | arr2['b'] = 4; 468 | assert(arr2['b'] == 4); 469 | 470 | // See also http://forum.dlang.org/post/akibggljgcmmacsbahmm@forum.dlang.org 471 | import epcompat.enumeration; 472 | enum E {One, Two, Three, Four} 473 | mixin withEnum!E; 474 | auto arr3 = Array!(int, E)(One, Four); 475 | assert(arr3.length == 4); 476 | arr3[Two] = 2; 477 | assert(arr3[Two] == 2); 478 | arr3[Four] = 4; 479 | assert(arr3[Four] == 4); 480 | } 481 | 482 | 483 | 484 | /* Notitie aangaande alternatieve implementaties. 485 | Een alternatief voor de hier gebruikte aanpak is gebaseerd op een truc uit Press et al 486 | "Numerical Recipes in C": 487 | 488 | float b[4], *bb; 489 | bb = b - 1; 490 | 491 | Door de pointer verschuiving is nu bb[1] tot bb[4] te gebruiken, wat equivalent is aan b[0] tot b[3]. 492 | De D-implementatie hiervan is nog terug te vinden op 493 | http://192.168.36.202/trac/browser/zandbak/Pascal2017/D/epcompat/source/epcompat/array.d?rev=15430#L137 494 | 495 | Echter, door analyse van de door Prospero gegenereerde assembly is gebleken dat Prospero achter de 496 | schermen met 0-based arrays werkt, en het startpunt van de index aftrekt bij elke indexering, dus ten 497 | koste van een kleine overhead. Hoewel pointer verschuiving die overhead elimineert, zijn er 498 | meerdere nadelen: 499 | 500 | - Door een extra laag van indirectie is het helemaal niet zeker dat het efficienter is, de 501 | kans op cache-misses is groter. 502 | - Het is theoretisch mogelijk dat de verschoven pointer niet representeerbaar is omdat 503 | deze buiten (size_t.min, size_t.max] komt te liggen, wat fataal zou zijn. 504 | - Door een eigenschap van D wordt de inhoud van de array niet meegerekend in .sizeof(). 505 | 506 | Nog een ander alternatief is gebruik van D slices: 507 | 508 | float b[5]; // Loopt van 0..4, gebruikt worden 1..4. 509 | float _b[] = b[1..$]; // Deelt de elementen 1..4 van b, gebruikt voor addrof en opslag. 510 | 511 | Hier wordt 1 element te veel gealloceerd, wat zou werken voor kleine positive offsets, maar je moet 512 | oppassen dat je b gebruikt voor indiceren en _b voor opslag. Bij inlezen is ook weer conversie 513 | nodig. Dit werkt niet voor negatieve offsets. 514 | 515 | Daarom is gekozen om het zelfde te doen als Prospero: elke index corrigeren, zonder dat dat in de 516 | code zichtbaar is. 517 | */ 518 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/enumeration.d: -------------------------------------------------------------------------------- 1 | module epcompat.enumeration; 2 | 3 | /** 4 | Aliases the members of the enum to bring them into scope so that they 5 | can be used without surrounding them with a $(D with) statement or 6 | prepending them with the enum name. 7 | */ 8 | mixin template withEnum(E) if (is(E == enum)) 9 | { 10 | import std.traits; 11 | import std.format; 12 | static foreach (i, member; EnumMembers!E) 13 | mixin(format!"alias %s = %s.%s;\n"(member, __traits(identifier, E), member)); 14 | } 15 | 16 | /// 17 | unittest 18 | { 19 | enum Enumer {One, Four = 4, Five, Six, Ten = 10} 20 | mixin withEnum!(Enumer); 21 | static assert(One == Enumer.One); 22 | static assert(Four == Enumer.Four); 23 | } -------------------------------------------------------------------------------- /epcompat/source/epcompat/file.d: -------------------------------------------------------------------------------- 1 | /// Implements Prospero file i/o. 2 | module epcompat.file; 3 | private import std.stdio; 4 | 5 | struct Bindable(T) 6 | { 7 | alias ComponentType = T; 8 | string filename; 9 | File f; 10 | } 11 | 12 | // Local Prospero extension 13 | bool openwrite(T)(ref Bindable!T f, string filename) 14 | { 15 | import std.exception; 16 | try { 17 | f.filename = filename; 18 | // TODO if T is text, use "w+" 19 | f.f = File(filename, "wb+"); 20 | } 21 | catch (ErrnoException e) { 22 | return false; 23 | } 24 | assert(f.f.isOpen); 25 | return true; 26 | } 27 | 28 | // Local Prospero extension 29 | void close(T)(ref Bindable!T f) 30 | { 31 | f.f.close; 32 | } 33 | 34 | //Built-in procedure 35 | void write(T, S...)(Bindable!T f, S args) 36 | { 37 | static foreach(arg; args) 38 | arg.toFile!T(f); 39 | } 40 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/initial.d: -------------------------------------------------------------------------------- 1 | module epcompat.initial; 2 | 3 | // Test with rdmd -m64 -main -unittest -debug -g source\epcompat\initial.d 4 | 5 | /** 6 | Creates a type that is mostly $(PARAM T), only with a different initial value of $(PARAM val). 7 | 8 | It differs from https://dlang.org/library/std/typecons/typedef.html in that `typedef` takes care to 9 | create a new type that does not implicitly convert to the base type, whereas we try to stay 10 | compatible with the base type. 11 | */ 12 | struct Initial(T, T val) 13 | { 14 | T _payload = val; 15 | alias _payload this; 16 | 17 | this(T v) 18 | { 19 | _payload = v; 20 | } 21 | 22 | // https://dlang.org/blog/2017/02/13/a-new-import-idiom/ 23 | private template from(string moduleName) 24 | { 25 | mixin("import from = " ~ moduleName ~ ";"); 26 | } 27 | 28 | void toString(scope void delegate(const(char)[]) sink, from!"std.format".FormatSpec!char fmt) 29 | { 30 | import std.array : appender; 31 | import std.format : formatValue; 32 | auto w = appender!string(); 33 | formatValue(w, _payload, fmt); 34 | sink(w.data); 35 | } 36 | } 37 | 38 | /// 39 | unittest 40 | { 41 | alias int1 = Initial!(int, 1); 42 | static assert(int1.init == 1); // typeof(int1.init) == int1 43 | static assert(int1.sizeof == int.sizeof); 44 | 45 | int1 i; 46 | assert(i == 1); 47 | int1 ii = 2; 48 | assert(ii == 2); 49 | assert(ii.init == 1); 50 | assert(int1.init == 1); 51 | 52 | void f(int val) 53 | { 54 | assert(val == 1); 55 | } 56 | f(i); 57 | 58 | int i0; 59 | assert(i0 == 0); 60 | i = i0; 61 | assert(i == 0); 62 | assert(i.init == 1); 63 | i0 = ii; 64 | assert(i0 == 2); 65 | assert(i0.init == 0); 66 | 67 | import std.string; 68 | assert(format("%6d", ii) == " 2"); 69 | } 70 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/interval.d: -------------------------------------------------------------------------------- 1 | /** 2 | Implements intervals between two inclusive values of ordinal type, or `char` or 3 | enum. 4 | */ 5 | module epcompat.interval; 6 | 7 | /** 8 | Defines an interval between two inclusive extremes on an explicitly supplied 9 | base type. 10 | */ 11 | struct Interval(T) 12 | { 13 | immutable T low, high; 14 | this (T low, T high) 15 | in { 16 | assert(low <= high); 17 | } do { 18 | this.low = low; 19 | this.high = high; 20 | } 21 | this (T single) { 22 | low = single; 23 | high = single; 24 | } 25 | } 26 | 27 | /// 28 | unittest 29 | { 30 | auto i1 = Interval!byte(10, 20); 31 | auto i2 = Interval!byte(15); 32 | assert(i1.low == 10); 33 | assert(i1.high == 20); 34 | assert(i2.low == 15); 35 | assert(i2.high == 15); 36 | } 37 | 38 | /// 39 | unittest 40 | { 41 | import epcompat.enumeration; 42 | enum Count {One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten} 43 | mixin withEnum!Count; 44 | auto i1 = Interval!Count(Three, Six); 45 | auto i2 = Interval!Count(Eight, Ten); 46 | assert(i1.low == Three); 47 | assert(i1.high == Six); 48 | assert(i2.low == Eight); 49 | assert(i2.high == Ten); 50 | } 51 | 52 | 53 | /** 54 | Constructor of an $(D Interval) on an implicitly derived base type. 55 | */ 56 | template interval(T) 57 | { 58 | Interval!T interval(T a) 59 | { 60 | return Interval!T(a); 61 | } 62 | Interval!T interval(T a, T b) 63 | { 64 | return Interval!T(a, b); 65 | } 66 | } 67 | 68 | import std.traits; 69 | enum isOrdinalType(T) = isIntegral!T || isSomeChar!T || isBoolean!T; 70 | 71 | unittest 72 | { 73 | static assert(isOrdinalType!int); 74 | static assert(isOrdinalType!uint); 75 | enum E {One, Two, Three, Four} 76 | static assert(isOrdinalType!E); 77 | static assert(isOrdinalType!bool); 78 | static assert(isOrdinalType!char); 79 | static assert(isOrdinalType!wchar); 80 | static assert(isOrdinalType!byte); 81 | static assert(isOrdinalType!ubyte); 82 | static assert(isOrdinalType!short); 83 | static assert(isOrdinalType!ushort); 84 | static assert(isOrdinalType!long); 85 | static assert(isOrdinalType!ulong); 86 | static assert(!isOrdinalType!(int[])); 87 | static assert(!isOrdinalType!float); 88 | } 89 | 90 | template isOrdinalInterval(T) 91 | { 92 | static if (isArray!T) 93 | { 94 | //static if (T.length == 2) 95 | //{ 96 | template tt(U : U[]) 97 | { 98 | static if (isOrdinalType!U) 99 | enum tt = true; 100 | else 101 | enum tt = false; 102 | } 103 | 104 | enum isOrdinalInterval = tt!T; 105 | //} 106 | // else enum isOrdinalInterval = false; 107 | } 108 | else enum isOrdinalInterval = false; 109 | } 110 | 111 | unittest 112 | { 113 | int[2] a; 114 | static assert(isOrdinalInterval!(typeof(a))); 115 | static assert(isOrdinalInterval!(int[2])); 116 | //static assert(!isOrdinalInterval!(int[3])); 117 | static assert(!isOrdinalInterval!(int)); 118 | enum E {One, Two, Three} 119 | E[2] aa = [E.One, E.Three]; 120 | static assert(isOrdinalInterval!(typeof(aa))); 121 | } 122 | 123 | template areIntervalsCompatibleTo(U, V...) 124 | { 125 | import std.range.primitives: ElementEncodingType; 126 | static if (V.length == 0) 127 | { 128 | enum areIntervalsCompatibleTo = true; 129 | } 130 | else static if (isOrdinalInterval!U) 131 | { 132 | static if (areIntervalsCompatibleTo!(ElementEncodingType!U, V)) 133 | { 134 | enum areIntervalsCompatibleTo = true; 135 | } 136 | else 137 | { 138 | enum areIntervalsCompatibleTo = false; 139 | } 140 | } 141 | else 142 | { 143 | static if (isOrdinalInterval!(V[0])) 144 | { 145 | static if (is(ElementEncodingType!(V[0]) == U) && areIntervalsCompatibleTo!(U, V[1..$])) 146 | { 147 | enum areIntervalsCompatibleTo = true; 148 | } 149 | else 150 | { 151 | enum areIntervalsCompatibleTo = false; 152 | } 153 | } 154 | else 155 | { 156 | static if (is(V[0] == U) && areIntervalsCompatibleTo!(U, V[1..$])) 157 | { 158 | enum areIntervalsCompatibleTo = true; 159 | } 160 | else 161 | { 162 | enum areIntervalsCompatibleTo = false; 163 | } 164 | } 165 | } 166 | } 167 | 168 | unittest 169 | { 170 | static assert(areIntervalsCompatibleTo!(int, int)); 171 | static assert(areIntervalsCompatibleTo!(int, int[2])); 172 | static assert(areIntervalsCompatibleTo!(int[2], int)); 173 | static assert(areIntervalsCompatibleTo!(int, int[2], int, int, int[2], int[2])); 174 | static assert(!areIntervalsCompatibleTo!(int, uint)); 175 | } 176 | 177 | template compatibleIntervals(T...) 178 | { 179 | static if (T.length == 0 || T.length == 1) 180 | { 181 | enum compatibleIntervals = true; 182 | } 183 | else static if (areIntervalsCompatibleTo!(T[0], T[1..$])) 184 | { 185 | enum compatibleIntervals = true; 186 | } 187 | else 188 | { 189 | enum compatibleIntervals = false; 190 | } 191 | } 192 | 193 | unittest 194 | { 195 | static assert(compatibleIntervals!(int, int[2], int, int, int[2], int[2])); 196 | static assert(compatibleIntervals!(int, int, int[2], int, int, int[2], int[2])); 197 | static assert(compatibleIntervals!(int[2], int, int, int[2], int[2])); 198 | static assert(compatibleIntervals!(int[2], int[2], int, int, int[2], int[2])); 199 | bool f(Args...)(Args args) 200 | { 201 | static if (compatibleIntervals!Args) 202 | return true; 203 | else 204 | return false; 205 | } 206 | static assert(f(2, [3, 4], 5, 6, [7, 9])); 207 | } 208 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/ordinal.d: -------------------------------------------------------------------------------- 1 | module epcompat.ordinal; 2 | 3 | import std.traits; 4 | 5 | /** 6 | An integral type with specified inclusive bounds. 7 | 8 | No bounds checking is implemented. 9 | 10 | See also bound.d in https://code.dlang.org/packages/phobos-next 11 | */ 12 | // TODO Normaal gesproken zijn EP ranges altijd integers, maar wanneer deel van een packed record wordt 13 | // het kleinst mogelijke base type gezocht. Dat wordt hier geimplementeerd. Maar voor 1-1 compatibiliteit 14 | // is het nodig dat configureerbaar te maken. Helaas heb ik geen trait gevonden voor het opvragen van align(). 15 | struct Ordinal(alias lower, alias upper) if (isIntegral!(typeof(lower)) && 16 | isIntegral!(typeof(upper))) 17 | { 18 | static assert(lower < upper); 19 | 20 | private mixin template implementation(T) 21 | { 22 | T _payload = init; 23 | static T init() 24 | { 25 | return lower; 26 | } 27 | static T min() 28 | { 29 | return lower; 30 | } 31 | static T max() 32 | { 33 | return upper; 34 | } 35 | this(long from) 36 | { 37 | opAssign(from); 38 | } 39 | T opAssign(long from) 40 | { 41 | import std.conv; 42 | return _payload = to!T(from); 43 | } 44 | import std.typecons; 45 | mixin Proxy!_payload; 46 | alias _payload this; 47 | } 48 | 49 | static if (lower < 0) 50 | { 51 | static if (lower >= byte.min && upper <= byte.max) 52 | { 53 | mixin implementation!byte; 54 | } 55 | else static if (lower >= short.min && upper <= short.max) 56 | { 57 | mixin implementation!short; 58 | } 59 | else static if (lower >= int.min && upper <= int.max) 60 | { 61 | mixin implementation!int; 62 | } 63 | else 64 | { 65 | static assert(lower >= long.min && upper <= long.max); 66 | mixin implementation!long; 67 | } 68 | } 69 | else 70 | { 71 | static if (upper <= ubyte.max) 72 | { 73 | mixin implementation!ubyte; 74 | } 75 | else static if (upper <= ushort.max) 76 | { 77 | mixin implementation!ushort; 78 | } 79 | else static if (upper <= uint.max) 80 | { 81 | mixin implementation!uint; 82 | } 83 | else 84 | { 85 | static assert(upper <= ulong.max); 86 | mixin implementation!ulong; 87 | } 88 | } 89 | } 90 | 91 | unittest 92 | { 93 | Ordinal!(-3, 10) o1; 94 | assert(o1.min == -3); 95 | assert(o1.max == 10); 96 | assert(o1.sizeof == 1); 97 | 98 | static assert(!__traits(compiles, Ordinal!(33, 6))); // 33 > 6 99 | static assert(Ordinal!(0, 255).sizeof == 1); 100 | static assert(Ordinal!(-1, 255).sizeof == 2); 101 | static assert(Ordinal!(-1, 127).sizeof == 1); 102 | static assert(Ordinal!(-1, 70000).sizeof == 4); 103 | 104 | alias O2 = Ordinal!(10, 300); 105 | static assert(O2.min == 10); 106 | static assert(O2.max == 300); 107 | static assert(O2.init == 10); 108 | O2 o2; 109 | assert(o2 == 10); 110 | assert(o2.min == 10); 111 | assert(o2.max == 300); 112 | assert(o2.sizeof == 2); 113 | 114 | o2 = 20; 115 | o2 = 300; 116 | 117 | import std.conv; 118 | ushort us = to!ushort(o2 + 10); 119 | assert(us == 310); 120 | o2 = us - 10; 121 | assert(o2 == 300); 122 | 123 | int i = o2; 124 | assert(i == 300); 125 | o2 = i - 10; 126 | 127 | o1 = 10; 128 | o2 = o1; 129 | assert(o2 == 10); 130 | o2++; 131 | assert(o2 == 11); 132 | 133 | void intfun(int) {} 134 | void o2fun(O2 arg) {} 135 | intfun(o2); 136 | o2fun(o2); 137 | o2fun(O2(o1)); 138 | o2fun(O2(10L)); 139 | // http://forum.dlang.org/post/mailman.1513.1310326809.14074.digitalmars-d-learn@puremagic.com 140 | //o2fun(o1); // No implicit argument conversion, sadly. 141 | //o2fun(10); // No implicit argument conversion, sadly. 142 | 143 | // TODO bounds check: 144 | //us = 9; 145 | //o2fun(O2(us)); // FIXME Should be illegal. 146 | //o2fun(O2(9)); // FIXME Should be illegal. 147 | //import std.exception; 148 | //assertThrown(o2 = 9); 149 | //assertThrown(o2 = 301); 150 | //o1 = 10; 151 | //assertThrown(o1++); 152 | } 153 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/package.d: -------------------------------------------------------------------------------- 1 | /** 2 | Provides type compatibility with, and comparable features to Extended Pascal. 3 | 4 | This is the library that translated Pascal sources rely on. It also provides 5 | features that can be of value in hand-written D code. The epcompat library is 6 | supplied as a dub sub package so it supports that use case. 7 | 8 | $(TABLE 9 | $(TR $(TH Module) $(TH Purpose)) 10 | 11 | $(TR $(TD $(LINK2 epcompat/array, array)) $(TD 12 | Fixed length array types that can start at any index. 13 | )) 14 | $(TR $(TD $(LINK2 epcompat/enumeration, enumeration)) $(TD 15 | Brings the members of an enumeration into scope, as if the following 16 | code would be in a `with` block. 17 | )) 18 | $(TR $(TD $(LINK2 epcompat/file, file)) $(TD 19 | Implementation of EP file i/o and local Prospero extensions. 20 | )) 21 | $(TR $(TD $(LINK2 epcompat/initial, initial)) $(TD 22 | Changes `.init` to a custom default value. 23 | )) 24 | $(TR $(TD $(LINK2 epcompat/ordinal, ordinal)) $(TD 25 | An integral type with specific inclusive bounds. 26 | )) 27 | $(TR $(TD $(LINK2 epcompat/set, set)) $(TD 28 | Sets of integral values, ordinal values or members of enumerations. 29 | )) 30 | $(TR $(TD $(LINK2 epcompat/string, string)) $(TD 31 | String types that are compatible with native D `string`, and binary 32 | compatible with Prospero Extended Pascal strings in file i/o. 33 | )) 34 | ) 35 | */ 36 | 37 | module epcompat; 38 | 39 | public import epcompat.array; 40 | public import epcompat.string; 41 | public import epcompat.file; 42 | public import epcompat.initial; 43 | public import epcompat.interval; 44 | public import epcompat.set; 45 | public import epcompat.ordinal; 46 | version(ddox) {} else // https://issues.dlang.org/show_bug.cgi?id=18211 47 | public import epcompat.enumeration; 48 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/set.d: -------------------------------------------------------------------------------- 1 | /// Implements sets of values of ordinal type, including `char` and `enum` members. 2 | module epcompat.set; 3 | 4 | import epcompat.interval; 5 | 6 | /** 7 | The Set type supports set operations. Sets can be instantiated with an explicitly 8 | specified base type, in which case the range of values that the Set can contain 9 | is limited by the base type. Sets can also be constructed with an implicitly 10 | derived base type using the set() functions, where the underlying data is managed 11 | dynamically and the range of values that the set can contain is only limited by 12 | the available memory. Base types are ordinal types like the standard signed and 13 | unsigned integer types of various sizes, but also char types, booleans and custom 14 | enumerations. 15 | */ 16 | struct Set(T) 17 | { 18 | import std.bitmanip; 19 | import std.traits; 20 | import std.conv; 21 | static bool staticArray() 22 | { 23 | return ((isUnsigned!T && T.max <= ushort.max) || 24 | (T.min >= short.min && T.max <= short.max)); 25 | } 26 | static if (staticArray) 27 | { // Cover the complete range of possible values in T. 28 | this (Interval!T[] ar...) { // Allows construction from any number of Intervals. 29 | init(); 30 | foreach(i; ar) { 31 | foreach(b; i.low .. i.high+1) 32 | bits[b - minval] = true; 33 | } 34 | } 35 | } 36 | else 37 | { // The range of possible values of T is too large to fit in the bitarray completely. 38 | // Manage bitarray dynamically. 39 | this (Interval!T[] ar...) { // Allows construction from any number of Intervals. 40 | import std.algorithm.comparison; 41 | int low = int.max; 42 | int high = int.min; 43 | foreach(i; ar) { 44 | low = min(low, i.low); 45 | high = max(high, i.high); 46 | } 47 | minval = to!T(low); 48 | bits.length = (high >= low) ? high + 1 - low : 0; 49 | foreach(i; ar) { 50 | foreach(b; i.low .. i.high+1) 51 | bits[b - minval] = true; 52 | } 53 | } 54 | } 55 | /** 56 | Support for set operations. 57 | "+": set union 58 | "-": set difference 59 | "*": set intersection 60 | "%": set symmetric difference (A + B - A * B) 61 | 62 | See also https://dlang.org/phobos/std_algorithm_setops.html 63 | https://github.com/BBasile/iz/blob/master/import/iz/enumset.d 64 | https://dlang.org/library/std/typecons/flag.html 65 | */ 66 | Set!T opBinary(string op)(Set!T rhs) 67 | if (op == "+" || op == "-" /*|| op == "&" || op == "^"*/) 68 | { 69 | Set!T compatibleOpBinary(const ref Set!T comp_l, const ref Set!T comp_r) 70 | in { 71 | assert(comp_l.bits.length == comp_r.bits.length); 72 | assert(comp_l.minval == comp_r.minval); 73 | } do { 74 | Set!T ret; 75 | ret.minval = comp_l.minval; 76 | ret.bits.length = comp_l.bits.length; 77 | static if (op == "+") 78 | ret.bits = comp_l.bits | comp_r.bits; 79 | else 80 | mixin("ret.bits = comp_l.bits " ~ op ~ " comp_r.bits;"); 81 | return ret; 82 | } 83 | 84 | static if (staticArray) 85 | { 86 | return compatibleOpBinary(this, rhs); 87 | } 88 | else 89 | { 90 | if (minval == rhs.minval && bits.length == rhs.bits.length) 91 | { 92 | return compatibleOpBinary(this, rhs); 93 | } 94 | else 95 | { 96 | import std.algorithm.comparison; 97 | auto minminval = min(minval, rhs.minval); 98 | auto maxlength = max((bits.length + minval), (rhs.bits.length + rhs.minval)) - minminval; 99 | Set!T thisset, rhsset; 100 | thisset.bits = this.bits.dup; 101 | thisset.bits.length = maxlength; 102 | if (minminval < minval) 103 | thisset.bits <<= (minval - minminval); 104 | thisset.minval = minminval; 105 | rhsset.bits = rhs.bits.dup; 106 | rhsset.bits.length = maxlength; 107 | if (minminval < rhs.minval) 108 | rhsset.bits <<= (rhs.minval - minminval); 109 | rhsset.minval = minminval; 110 | return compatibleOpBinary(thisset, rhsset); 111 | } 112 | } 113 | } 114 | /// ditto (+= etc) 115 | Set!T opOpAssign(string op)(const Set!T rhs) 116 | if (op == "+" || op == "-" /*|| op == "&" || op == "^"*/) 117 | { 118 | Set!T compatibleOpOpAssign(const Set!T comp_r) 119 | in { 120 | assert(this.bits.length = comp_r.bits.length); 121 | assert(this.minval == comp_r.minval); 122 | } do { 123 | static if (op == "+") 124 | this.bits |= comp_r.bits; 125 | else 126 | mixin("this.bits " ~ op ~ "= comp_r.bits;"); 127 | return this; 128 | } 129 | 130 | static if (staticArray) 131 | { 132 | return compatibleOpOpAssign(rhs); 133 | } 134 | else 135 | { 136 | if (minval == rhs.minval && bits.length == rhs.bits.length) 137 | { 138 | return compatibleOpOpAssign(rhs); 139 | } 140 | else 141 | { 142 | import std.algorithm.comparison; 143 | auto minminval = min(minval, rhs.minval); 144 | auto maxlength = max((bits.length + minval), (rhs.bits.length + rhs.minval)) - minminval; 145 | Set!T rhsset; 146 | this.bits.length = maxlength; 147 | if (minminval < minval) 148 | this.bits <<= (minval - minminval); 149 | this.minval = minminval; 150 | rhsset.bits = rhs.bits.dup; 151 | rhsset.bits.length = maxlength; 152 | if (minminval < rhs.minval) 153 | rhsset.bits <<= (rhs.minval - minminval); 154 | rhsset.minval = minminval; 155 | return compatibleOpOpAssign(rhsset); 156 | } 157 | } 158 | } 159 | 160 | /** 161 | Returns the cardinality of the set (the number of members). O(n). 162 | */ 163 | size_t card() 164 | { 165 | size_t c = 0; 166 | foreach (b; bits) 167 | if (b) 168 | c++; 169 | return c; 170 | } 171 | /** 172 | Support for $(D foreach) loops over members of the $(D Set). 173 | */ 174 | int opApply(scope int delegate(T) dg) const 175 | { 176 | int result; 177 | 178 | foreach (immutable i; bits.bitsSet) 179 | { 180 | result = dg(to!T(to!int(i) + minval)); 181 | if (result) 182 | break; 183 | } 184 | return result; 185 | } 186 | /** 187 | Support for set membership testing using $(D in). 188 | */ 189 | bool opBinaryRight(string op)(T t) if (op == "in") 190 | { 191 | if (t - minval < 0) 192 | return false; 193 | if (t - minval >= bits.length) 194 | return false; 195 | return bits[t - minval]; 196 | } 197 | private: 198 | BitArray bits; 199 | T minval = T.min; 200 | static if (staticArray) 201 | { 202 | void init() 203 | in { 204 | assert(bits.length == 0); 205 | } do { 206 | bits.length = to!int(T.max) + 1 - to!int(minval); 207 | } 208 | } 209 | } 210 | 211 | 212 | /// 213 | unittest 214 | { 215 | auto i1 = Interval!byte(10, 20); 216 | auto i2 = Interval!byte(15); 217 | byte a = 7; 218 | auto s1 = Set!byte(i1, i2, Interval!byte(a)); 219 | assert(7 in s1); 220 | } 221 | 222 | /// 223 | unittest 224 | { 225 | auto s1 = Set!byte(Interval!byte(10, 20)); 226 | assert(5 !in s1); 227 | assert(20 in s1); 228 | 229 | enum Count {One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten} 230 | auto i1 = Interval!Count(Count.Three, Count.Six); 231 | auto i2 = Interval!Count(Count.Eight, Count.Ten); 232 | auto s2 = Set!Count(i1, i2); 233 | assert(s2.card == 7); 234 | assert(Count.Nine in s2); 235 | s2 -= Set!Count(i2); 236 | assert(s2.card == 4); 237 | assert(Count.Four in s2); 238 | assert(Count.Nine !in s2); 239 | } 240 | 241 | 242 | /** 243 | This struct serves only a range-based interface for convenient construction 244 | of Sets implemented on an explicitly supplied base type. 245 | */ 246 | struct SetFactory(T) 247 | { 248 | import core.stdc.stdarg; // Necessary on Posix. 249 | @disable this(); 250 | static Transfer opSlice(size_t pos)(T start, T end) 251 | { 252 | return Transfer(start, end); 253 | } 254 | static Set!T opIndex(...) 255 | { 256 | import core.vararg; 257 | Set!T s; 258 | s.init; 259 | for (int i = 0; i < _arguments.length; i++) 260 | { 261 | if (_arguments[i] == typeid(int)) 262 | { 263 | s = s + Set!T(Interval!T(cast(T)va_arg!(int)(_argptr))); 264 | } 265 | else if (_arguments[i] == typeid(T)) 266 | { 267 | s = s + Set!T(Interval!T(va_arg!(T)(_argptr))); 268 | } 269 | else if (_arguments[i] == typeid(Transfer)) 270 | { 271 | Transfer t = va_arg!(Transfer)(_argptr); 272 | s = s + Set!T(Interval!T(t.start, t.end)); 273 | } 274 | else { 275 | import std.stdio; 276 | writeln("!!!!!else ", _arguments[i]); 277 | assert(0); 278 | } 279 | } 280 | return s; 281 | } 282 | private: 283 | struct Transfer 284 | { 285 | T start, end; 286 | } 287 | } 288 | 289 | /// 290 | unittest 291 | { 292 | auto s0 = SetFactory!byte[1, 4..7, 10]; 293 | 294 | enum Count {One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten} 295 | auto s1 = SetFactory!Count[Count.Three, Count.Six .. Count.Nine]; 296 | 297 | auto s2 = SetFactory!char['a'..'z']; 298 | assert('b' in s2); 299 | assert('A' !in s2); 300 | 301 | with (Count) { 302 | auto s3 = SetFactory!Count[Six, Two .. Four]; 303 | assert(Two in s3); 304 | assert(Three in s3); 305 | assert(Four in s3); 306 | assert(Six in s3); 307 | } 308 | 309 | auto s5 = SetFactory!char[]; // Empty set. 310 | assert(s5.card() == 0); 311 | } 312 | 313 | /** 314 | Constructor of a $(D Set) on an implicitly derived base type with a given 315 | sequence of intervals. 316 | */ 317 | auto set(T)(Interval!T[] ar...) 318 | { 319 | return Set!T(ar); 320 | } 321 | /** 322 | Constructor of the empty set. 323 | */ 324 | Set!int set() // Empty set. 325 | { 326 | return Set!int(); 327 | } 328 | 329 | /// 330 | unittest 331 | { 332 | auto s1 = set(interval('a'), interval('e', 'g')); 333 | assert('f' in s1); 334 | auto s2 = set(interval(6), interval(10, 14)); 335 | assert(11 in s2); 336 | auto s3 = set(interval(8, 12)); 337 | auto s4 = s2 - s3; 338 | assert(11 !in s4); 339 | assert(6 in s4); 340 | assert(13 in s4); 341 | auto s5 = set(); 342 | assert(s5.card == 0); 343 | } 344 | 345 | /// 346 | unittest 347 | { 348 | assert(4 in set(interval(0, 10))); 349 | assert(4 !in set(interval(-3, 3))); 350 | assert(-4 !in set(interval(-3, 3))); 351 | enum Count {One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten} 352 | auto i1 = interval(Count.Three, Count.Six); 353 | auto i2 = interval(Count.Eight, Count.Ten); 354 | auto s1 = set(i1, i2); 355 | assert(s1.card == 7); 356 | assert(Count.Nine in s1); 357 | assert(Count.Seven !in s1); 358 | s1 -= set(i2); 359 | assert(s1.card == 4); 360 | assert(Count.Four in s1); 361 | assert(Count.Nine !in s1); 362 | } 363 | 364 | /** 365 | Constructor of $(D Set)s on an implicitly derived base type. It cannot support 366 | the range-like notation for $(D Interval)s like $(D SetFactory) does, but offers 367 | a 2-element array notation for intervals. 368 | */ 369 | auto set(Args...)(Args args) if (compatibleIntervals!Args) 370 | { 371 | static assert(Args.length > 0); // set() is already implemented. 372 | static if (isOrdinalInterval!(Args[0])) 373 | auto s = set(interval(args[0][0], args[0][1])); 374 | else 375 | auto s = set(interval(args[0])); 376 | static foreach (i, a; args[1..$]) 377 | { 378 | static if (isOrdinalInterval!(Args[i+1])) 379 | s += set(interval(a[0], a[1])); 380 | else 381 | s += set(interval(a)); 382 | } 383 | return s; 384 | } 385 | 386 | /// 387 | unittest 388 | { 389 | int i = 5; 390 | auto s1 = set(1); 391 | auto s2 = set(1, [1,2], i); 392 | assert(2 in s2); 393 | enum Count {One, Two, Three, Four, Five} 394 | auto s3 = set([Count.Three, Count.Five]); 395 | s3 += set(Count.One); 396 | assert(Count.Four in s3); 397 | assert(Count.One in s3); 398 | assert(Count.Two !in s3); 399 | } 400 | -------------------------------------------------------------------------------- /epcompat/source/epcompat/string.d: -------------------------------------------------------------------------------- 1 | /** 2 | Provides compatibility between D strings and the binary Extended Pascal formats 3 | of ShortString and String, for file i/o using the fromFile and toFile methods. 4 | 5 | Special care is given to strings embedded in aggregate types such as structs and unions. 6 | 7 | Authors: Bastiaan Veelo 8 | Copyright: SARC B.V. 9 | License: Boost. 10 | */ 11 | 12 | module epcompat.string; 13 | import std.stdio : File; 14 | 15 | //version = VerboseStdOut; 16 | version (VerboseStdOut) 17 | { 18 | import std.stdio; 19 | } 20 | 21 | 22 | /** 23 | To be used as an attribute to string members of structs for specifying the file format. 24 | 25 | Examples: 26 | -------------------- 27 | Struct S 28 | { 29 | @EPString(80) string str = "Hello"; 30 | } 31 | -------------------- 32 | */ 33 | struct EPString 34 | { 35 | ushort capacity; 36 | } 37 | 38 | 39 | /** 40 | To be used as an attribute to string members of structs for specifying the file format. 41 | 42 | Examples: 43 | -------------------- 44 | Struct S 45 | { 46 | @EPShortString(80) string str = "Hello"; 47 | } 48 | -------------------- 49 | */ 50 | struct EPShortString 51 | { 52 | ubyte capacity; 53 | } 54 | 55 | 56 | unittest // UDA 57 | { 58 | @EPString(80) string str = "Hello"; 59 | import std.traits; 60 | assert(hasUDA!(str, EPString)); 61 | } 62 | 63 | 64 | /** 65 | Writes a string to file in standard Extended Pascal string format. 66 | 67 | This format consists of the string contents, truncated or padded with `'\0'` upto `capacity`, followed by 68 | two bytes (`ushort`) stating the length of the padding. 69 | 70 | Params: 71 | str = The string to write. 72 | capacity = The length of the written data section. If the length of `str` exceeds `capacity` then trunctation 73 | will happen. The written string is padded with `'\0'` upto `capacity`. 74 | file = The file to write to. 75 | 76 | Throws: Exception (only in debug mode) if `str.length > capacity`. 77 | 78 | See_Also: readEPString, writeAsEPShortString. 79 | */ 80 | void writeAsEPString(string str, ushort capacity, File file) 81 | in { 82 | assert(capacity > 0); 83 | } 84 | body { 85 | import std.algorithm.mutation : copy; 86 | import std.range : repeat; 87 | import std.algorithm.comparison : min; 88 | import std.conv : to; 89 | immutable ushort pad = (str.length > capacity) ? 0 : to!ushort(capacity - str.length); 90 | str[0..min($, capacity)].copy(file.lockingBinaryWriter); 91 | '\0'.repeat(pad).copy(file.lockingBinaryWriter); 92 | (&pad)[0 .. 1].copy(file.lockingBinaryWriter); 93 | // I am not sure we want to throw here, because if it isn't catched somewhere then the program terminates. 94 | // We can also choose to truncate silently (I think Prospero does the same, if not compiled with range checking, which we don't). 95 | // Version debug for now. 96 | debug { 97 | import std.exception : enforce; 98 | enforce(str.length <= capacity, "String will be written to file truncated, discarding " ~ to!string(str.length - capacity) ~ " characters."); 99 | } 100 | } 101 | 102 | 103 | unittest // writeAsEPString 104 | { 105 | import std.stdio; 106 | File tmp = File.tmpfile(); 107 | writeAsEPString("Jan Karel is een proleet", 80, tmp); 108 | tmp.flush; 109 | 110 | assert(tmp.size == 82); 111 | 112 | tmp.rewind; 113 | auto buf = tmp.rawRead(new char[cast(uint)(tmp.size)]); 114 | foreach (i, b; buf) 115 | { 116 | switch (i) { 117 | case 0: 118 | assert(b == 'J'); 119 | break; 120 | case 1, 5: 121 | assert(b == 'a'); 122 | break; 123 | case 2, 15: 124 | assert(b == 'n'); 125 | break; 126 | case 3, 9, 12, 16: 127 | assert(b == ' '); 128 | break; 129 | case 4: 130 | assert(b == 'K'); 131 | break; 132 | case 6: 133 | assert(b == 'r'); 134 | break; 135 | case 7, 21, 22: 136 | assert(b == 'e'); 137 | break; 138 | case 8, 20: 139 | assert(b == 'l'); 140 | break; 141 | case 10: 142 | assert(b == 'i'); 143 | break; 144 | case 11: 145 | assert(b == 's'); 146 | break; 147 | case 13, 14: 148 | assert(b == 'e'); 149 | break; 150 | case 17: 151 | assert(b == 'p'); 152 | break; 153 | case 18: 154 | assert(b == 'r'); 155 | break; 156 | case 19: 157 | assert(b == 'o'); 158 | break; 159 | case 23: 160 | assert(b == 't'); 161 | break; 162 | case 24: .. case 79: 163 | assert(b == '\0'); 164 | break; 165 | case 80: 166 | assert(b == 56); // 80 - 24 167 | break; 168 | case 81: 169 | assert(b == '\0'); 170 | break; 171 | default: 172 | assert(false); 173 | } 174 | } 175 | } 176 | 177 | unittest // truncation 178 | { 179 | import std.stdio; 180 | import std.exception; 181 | File tmp = File.tmpfile(); 182 | enum str = "Jan Karel is een proleet"; 183 | debug 184 | { 185 | assertThrown(writeAsEPString(str, 10, tmp)); // <=== 186 | } else { 187 | writeAsEPString(str, 10, tmp); 188 | } 189 | tmp.flush; 190 | 191 | assert(tmp.size == 12); 192 | 193 | tmp.rewind; 194 | auto buf = tmp.rawRead(new char[cast(uint)(tmp.size)]); 195 | foreach (i, b; buf) 196 | { 197 | switch (i) { 198 | case 0: 199 | assert(b == 'J'); 200 | break; 201 | case 1, 5: 202 | assert(b == 'a'); 203 | break; 204 | case 2: 205 | assert(b == 'n'); 206 | break; 207 | case 3, 9: 208 | assert(b == ' '); 209 | break; 210 | case 4: 211 | assert(b == 'K'); 212 | break; 213 | case 6: 214 | assert(b == 'r'); 215 | break; 216 | case 7: 217 | assert(b == 'e'); 218 | break; 219 | case 8: 220 | assert(b == 'l'); 221 | break; 222 | case 10, 11: 223 | assert(b == '\0'); 224 | break; 225 | default: 226 | assert(false); 227 | } 228 | } 229 | } 230 | 231 | 232 | /** 233 | Reads a string in standard Extended Pascal string format. 234 | 235 | This format consists of the string contents, truncated or padded with `'\0'` upto `capacity`, followed by 236 | two bytes (`ushort`) stating the length of the padding. 237 | 238 | Params: 239 | capacity = The length of the data section to be read, excluding the two byte suffix. 240 | file = The file to read from. 241 | 242 | Returns: the string as read from file. 243 | 244 | See_Also: writeAsEPString, readEPShortString. 245 | */ 246 | string readEPString(ushort capacity, File file) 247 | { 248 | string str = file.rawRead(new char[capacity]).idup; 249 | auto l = file.rawRead(new ushort[1]); 250 | return str[0 .. capacity - l[0]]; 251 | } 252 | 253 | 254 | /// 255 | unittest // readEPString 256 | { 257 | enum str = "Jan Karel is een proleet"; 258 | import std.stdio; 259 | File tmp = File.tmpfile(); 260 | writeAsEPString(str, 80, tmp); 261 | tmp.flush; 262 | 263 | assert(tmp.size == 82); 264 | 265 | tmp.rewind; 266 | assert(readEPString(80, tmp) == str); 267 | } 268 | 269 | 270 | /** 271 | Writes a string to file in standard Pascal shortstring format. 272 | 273 | In this format, the first written byte represents the length of the string. The string itself follows, truncated or 274 | padded with `'\0'` upto `capacity`. 275 | 276 | Params: 277 | str = The string to write. 278 | capacity = The length of the written data section. If the length of `str` exceeds `capacity` then trunctation 279 | will happen. The written string is padded with `'\0'` upto `capacity`. 280 | file = The file to write to. 281 | 282 | Throws: Exception (only in debug mode) if `str.length > capacity`. 283 | 284 | See_Also: readEPShortString, writeAsEPString. 285 | */ 286 | void writeAsEPShortString(string str, ubyte capacity, File file) 287 | in { 288 | assert(capacity > 0); 289 | } 290 | body { 291 | import std.algorithm.mutation : copy; 292 | import std.range : repeat; 293 | import std.algorithm.comparison : min; 294 | import std.conv : to; 295 | immutable ubyte pad = (str.length > capacity) ? 0 : to!ubyte(capacity - str.length); 296 | immutable ubyte l = to!ubyte(capacity - pad); 297 | (&l)[0 .. 1].copy(file.lockingBinaryWriter); 298 | str[0..min($, capacity)].copy(file.lockingBinaryWriter); 299 | '\0'.repeat(pad).copy(file.lockingBinaryWriter); 300 | // I am not sure we want to throw here, because if it isn't catched somewhere then the program terminates. 301 | // We can also choose to truncate silently (I think Prospero does the same, if not compiled with range checking, which we don't). 302 | // Version debug for now. 303 | debug { 304 | import std.exception : enforce; 305 | enforce(str.length <= capacity, "String will be written to file truncated, discarding " ~ to!string(str.length - capacity) ~ " characters."); 306 | } 307 | } 308 | 309 | 310 | unittest // writeAsEPShortString 311 | { 312 | import std.stdio; 313 | File tmp = File.tmpfile(); 314 | writeAsEPShortString("Jan Karel is een proleet", 80, tmp); 315 | tmp.flush; 316 | 317 | assert(tmp.size == 81); 318 | 319 | tmp.rewind; 320 | auto buf = tmp.rawRead(new char[cast(uint)(tmp.size)]); 321 | foreach (i, b; buf) 322 | { 323 | switch (i - 1) { 324 | case -1: 325 | assert(b == 24); // length 326 | break; 327 | case 0: 328 | assert(b == 'J'); 329 | break; 330 | case 1, 5: 331 | assert(b == 'a'); 332 | break; 333 | case 2, 15: 334 | assert(b == 'n'); 335 | break; 336 | case 3, 9, 12, 16: 337 | assert(b == ' '); 338 | break; 339 | case 4: 340 | assert(b == 'K'); 341 | break; 342 | case 6: 343 | assert(b == 'r'); 344 | break; 345 | case 7, 21, 22: 346 | assert(b == 'e'); 347 | break; 348 | case 8, 20: 349 | assert(b == 'l'); 350 | break; 351 | case 10: 352 | assert(b == 'i'); 353 | break; 354 | case 11: 355 | assert(b == 's'); 356 | break; 357 | case 13, 14: 358 | assert(b == 'e'); 359 | break; 360 | case 17: 361 | assert(b == 'p'); 362 | break; 363 | case 18: 364 | assert(b == 'r'); 365 | break; 366 | case 19: 367 | assert(b == 'o'); 368 | break; 369 | case 23: 370 | assert(b == 't'); 371 | break; 372 | case 24: .. case 79: 373 | assert(b == '\0'); 374 | break; 375 | default: 376 | assert(false); 377 | } 378 | } 379 | } 380 | 381 | 382 | /** 383 | Reads a string in standard Pascal shortstring format. 384 | 385 | In this format, the first written byte represents the length of the string. The string itself follows, truncated or 386 | padded with `'\0'` upto `capacity`. 387 | 388 | Params: 389 | capacity = The length of the data section to be read, excluding the one byte prefix. 390 | file = The file to read from. 391 | 392 | Returns: the string as read from file. 393 | 394 | See_Also: writeAsEPShortString, readEPString. 395 | */ 396 | string readEPShortString(ushort capacity, File file) 397 | { 398 | auto l = file.rawRead(new ubyte[1]); 399 | return file.rawRead(new char[capacity])[0 .. l[0]].idup; 400 | } 401 | 402 | 403 | /// 404 | unittest // readEPShortString 405 | { 406 | enum str = "Jan Karel is een proleet"; 407 | import std.stdio; 408 | File tmp = File.tmpfile(); 409 | writeAsEPShortString(str, 80, tmp); 410 | tmp.flush; 411 | 412 | assert(tmp.size == 81); 413 | 414 | tmp.rewind; 415 | assert(readEPShortString(80, tmp) == str); 416 | } 417 | 418 | 419 | /** 420 | Writes structs to file. 421 | 422 | It looks at the members of the struct and selects the appropriate method: 423 | $(UL 424 | $(LI If the type of the member has a `toFile` member, it calls `toFile(f)` on it.) 425 | $(LI If the member is itself a struct, it recurses by calling `toFile(f)` on it.) 426 | $(LI If the member is a string, it checks that its format and capacity are defined 427 | with either an `@EPString(n)` UDA or `@EPShortString(n)` UDA, and then calls 428 | `writeAsEPString` or `writeAsEPShortString` respectively. A missing UDA is an error 429 | and reported at compile time.) 430 | $(LI In all other cases the member is written using `std.stdio.File.rawWrite`.) 431 | ) 432 | 433 | Params: 434 | s = The struct variable to write. 435 | f = The File to write to. 436 | 437 | See_Also: fromFile. 438 | */ 439 | void toFile(S)(S s, File f) if (is(S == struct)) 440 | { 441 | import std.traits; 442 | import std.stdio; 443 | version (VerboseStdOut) { writeln("===== toFile ", __traits(identifier, S), " has fields ", [FieldNameTuple!S]); } 444 | static if (!hasIndirections!S) 445 | { 446 | version (VerboseStdOut) { write("toFile: ", __traits(identifier, S), " [No indirections: rawWrite] "); } 447 | f.rawWrite((&s)[0 .. 1]); 448 | version (VerboseStdOut) { writeln(s); } 449 | } 450 | else 451 | // FIXME handle anonimous unions https://forum.dlang.org/post/zwpctoccawmkwfoqkoyf@forum.dlang.org 452 | // Currently, all overlapping members are written to file. 453 | // http://192.168.36.202/SARCwiki/index.php/Fileformaat 454 | // Best is to not support unions, detect them at compile time. 455 | foreach(field; FieldNameTuple!S) 456 | { 457 | version (VerboseStdOut) { write("toFile: ", __traits(identifier, S), ".", field, " "); } 458 | static if (hasMember!(typeof(__traits(getMember, s, field)), "toFile")) // TODO use isSomeFunction or isCallable 459 | { 460 | version (VerboseStdOut) { writeln("[calling function]"); pragma(msg, field); } 461 | __traits(getMember, s, field).toFile(f); 462 | } 463 | else static if (is(typeof(__traits(getMember, s, field)) == struct)) 464 | { 465 | version (VerboseStdOut) { writeln("[recursing]"); } 466 | toFile!(typeof(__traits(getMember, s, field)))(__traits(getMember, s, field), f); // Recursion. 467 | } 468 | else static if (is(typeof(__traits(getMember, s, field)) == string)) 469 | { 470 | //toFile!(__traits(getMember, s, field))(f); // TODO. Difficult? 471 | static if (hasUDA!(__traits(getMember, s, field), EPString)) 472 | { 473 | version (VerboseStdOut) { writeln("[EPString]"); } 474 | enum capacity = getUDAs!(__traits(getMember, s, field), EPString)[0].capacity; 475 | static assert(capacity > 0); 476 | writeAsEPString(__traits(getMember, s, field), capacity, f); 477 | } 478 | else static if (hasUDA!(__traits(getMember, s, field), EPShortString)) 479 | { 480 | version (VerboseStdOut) { writeln("[EPShortString]"); } 481 | enum capacity = getUDAs!(__traits(getMember, s, field), EPShortString)[0].capacity; 482 | static assert(capacity > 0); 483 | writeAsEPShortString(__traits(getMember, s, field), capacity, f); 484 | } 485 | else static assert(false, `Need an @EPString(n) or @EPShortString(n) in front of ` ~ fullyQualifiedName!S ~ `.` ~ field ); 486 | } 487 | else static if(!isFunction!(__traits(getMember, s, field))) { 488 | version (VerboseStdOut) { writeln("[rawWrite]"); } 489 | f.rawWrite((&__traits(getMember, s, field))[0 .. 1]); 490 | } 491 | } 492 | } 493 | /** 494 | Where s is an alias to a string annotated with either an `@EPString(n)` UDA or `@EPShortString(n)` UDA, 495 | writes s to file f in the appropriate Prospero formats. 496 | */ 497 | /* Seems we need an alias to get the UDA over. But how to constrain this to strings? */ 498 | void toFile(alias s)(File f) //if (/*isSomeString!(typeOf!(s))*/ isType!s) 499 | { 500 | import std.traits; 501 | static if (hasUDA!(s, EPString)) 502 | { 503 | version (VerboseStdOut) { writeln("[EPString]"); } 504 | enum capacity = getUDAs!(s, EPString)[0].capacity; 505 | static assert(capacity > 0); 506 | writeAsEPString(s, capacity, f); 507 | } 508 | else static if (hasUDA!(s, EPShortString)) 509 | { 510 | version (VerboseStdOut) { writeln("[EPShortString]"); } 511 | enum capacity = getUDAs!(s, EPShortString)[0].capacity; 512 | static assert(capacity > 0); 513 | writeAsEPShortString(s, capacity, f); 514 | } 515 | else static assert(false, `Need an @EPString(n) or @EPShortString(n) in front of ` + s.stringof); 516 | } 517 | 518 | 519 | /// 520 | unittest // Writing structs with strings. 521 | { 522 | import std.stdio; 523 | 524 | struct MyType 525 | { 526 | ubyte b = 0xF; 527 | @EPShortString(5) string str = "Hello"; 528 | // string error; // Must produce a compile time error. OK. 529 | } 530 | struct Record 531 | { 532 | int i; 533 | @EPString(10) string str = "World!"; 534 | MyType n; 535 | } 536 | 537 | Record r; 538 | r.str = "Mars!"; 539 | r.n.str = "Bye"; 540 | 541 | File tmp = File.tmpfile(); 542 | r.toFile(tmp); // <=== 543 | tmp.flush; 544 | 545 | assert(tmp.size == 4 // int i 546 | + 10 // String 547 | + 2 // String unused length 548 | + 1 // ubyte 549 | + 1 // ShortString length 550 | + 5 // ShortString 551 | ); 552 | 553 | tmp.rewind; 554 | auto buf = tmp.rawRead(new ubyte[cast(uint)(tmp.size)]); 555 | 556 | foreach (i, b; buf) 557 | { 558 | final switch (i) 559 | { 560 | case 0, 1, 2, 3, 9, 10, 11, 12, 13, 15, 21, 22: 561 | assert(b == 0x0); 562 | break; 563 | case 4: 564 | assert(b == 'M'); 565 | break; 566 | case 5: 567 | assert(b == 'a'); 568 | break; 569 | case 6: 570 | assert(b == 'r'); 571 | break; 572 | case 7: 573 | assert(b == 's'); 574 | break; 575 | case 8: 576 | assert(b == '!'); 577 | break; 578 | case 14: 579 | assert(b == 5); // unused length EP string 580 | break; 581 | case 16: 582 | assert(b == 0xF); 583 | break; 584 | case 17: 585 | assert(b == 3); // length of EP short string 586 | break; 587 | case 18: 588 | assert(b == 'B'); 589 | break; 590 | case 19: 591 | assert(b == 'y'); 592 | break; 593 | case 20: 594 | assert(b == 'e'); 595 | break; 596 | } 597 | } 598 | } 599 | /// 600 | unittest // Writing string variables to file. 601 | { 602 | @EPShortString(5) string str1 = "Hello"; 603 | @EPString(10) string str2 = "World!"; 604 | 605 | File tmp = File.tmpfile(); 606 | toFile!str1(tmp); 607 | toFile!str2(tmp); 608 | tmp.flush; 609 | 610 | assert(tmp.size == 1 // ShortString length 611 | + 5 // ShortString 612 | + 10 // String 613 | + 2 // String unused length 614 | ); 615 | 616 | tmp.rewind; 617 | auto buf = tmp.rawRead(new ubyte[cast(uint)(tmp.size)]); 618 | 619 | foreach (i, b; buf) 620 | { 621 | final switch (i) 622 | { 623 | case 12, 13, 14, 15, 17: 624 | assert(b == 0x0); 625 | break; 626 | case 0: 627 | assert(b == 5); // length of EP short string 628 | break; 629 | case 1: 630 | assert(b == 'H'); 631 | break; 632 | case 2: 633 | assert(b == 'e'); 634 | break; 635 | case 3, 4, 9: 636 | assert(b == 'l'); 637 | break; 638 | case 5: 639 | assert(b == 'o'); 640 | break; 641 | case 6: 642 | assert(b == 'W'); 643 | break; 644 | case 7: 645 | assert(b == 'o'); 646 | break; 647 | case 8: 648 | assert(b == 'r'); 649 | break; 650 | case 10: 651 | assert(b == 'd'); 652 | break; 653 | case 11: 654 | assert(b == '!'); 655 | break; 656 | case 16: 657 | assert(b == 4); // unused length EP string 658 | break; 659 | } 660 | } 661 | 662 | } 663 | 664 | 665 | /** 666 | Reads structs from file. 667 | 668 | It looks at the members of the struct and selects the appropriate method: 669 | $(UL 670 | $(LI If the type of the member has a `fromFile` member, it calls `fromFile(f)` on it.) 671 | $(LI If the member is itself a struct, it recurses by calling `fromFile(f)` on it.) 672 | $(LI If the member is a string, it checks that its format and capacity are defined 673 | with either an `@EPString(n)` UDA or `@EPShortString(n)` UDA, and then calls 674 | `readEPString` or `readEPShortString` respectively. A missing UDA is an error 675 | and reported at compile time.) 676 | $(LI In all other cases the member is read using `std.stdio.File.rawRead`.) 677 | ) 678 | 679 | Params: 680 | s = The struct variable to read. 681 | f = The File to read from. 682 | 683 | See_Also: toFile. 684 | */ 685 | void fromFile(S)(ref S s, File f) if (is(S == struct)) 686 | { 687 | import std.traits; 688 | import std.range; 689 | version (VerboseStdOut) { writeln("===== fromFile ", __traits(identifier, S), " has fields ", [FieldNameTuple!S]); } 690 | static if (!hasIndirections!S) 691 | { 692 | version (VerboseStdOut) { write("fromFile: ", __traits(identifier, S), " [No indirections: rawRead] "); } 693 | f.rawRead((&s)[0 .. 1]); 694 | version (VerboseStdOut) { writeln(s); } 695 | } 696 | else 697 | foreach(field; FieldNameTuple!S) 698 | { 699 | version (VerboseStdOut) { write("fromFile: ", __traits(identifier, S), ".", field, " "); } 700 | static if (hasMember!(typeof(__traits(getMember, s, field)), "fromFile")) // TODO use isSomeFunction or isCallable 701 | { 702 | version (VerboseStdOut) { writeln("[calling function]"); pragma(msg, field); } 703 | //version (VerboseStdOut) { writeln(__traits(identifier, __traits(getMember, s, field).fromFile(f))); } 704 | __traits(getMember, s, field).fromFile(f); 705 | } 706 | // FIXME https://forum.dlang.org/post/zwpctoccawmkwfoqkoyf@forum.dlang.org 707 | // http://192.168.36.202/SARCwiki/index.php/Fileformaat 708 | // Best is to not support unions, detect them at compile time. 709 | /* else static if (is(typeof(__traits(getMember, s, field)) == union)) 710 | { 711 | static if (!hasIndirections!(typeof(field))) 712 | { 713 | version (VerboseStdOut) { write("[Union without indirections: rawRead] "); } 714 | f.rawRead((&__traits(getMember, s, field))[0 .. 1]); 715 | } 716 | else static assert(false, "Union " ~ __traits(identifier, S) ~ "." ~ field ~ " has indirections, it needs a fromFile member function."); 717 | }*/ 718 | else static if (is(typeof(__traits(getMember, s, field)) == struct)) 719 | { 720 | version (VerboseStdOut) { writeln("[recursing]"); } 721 | fromFile!(typeof(__traits(getMember, s, field)))(__traits(getMember, s, field), f); // Recursion. 722 | } 723 | else static if (is(typeof(__traits(getMember, s, field)) == string)) 724 | { 725 | // TODO use function. 726 | static if (hasUDA!(__traits(getMember, s, field), EPString)) 727 | { 728 | version (VerboseStdOut) { writeln("[EPString]"); } 729 | enum capacity = getUDAs!(__traits(getMember, s, field), EPString)[0].capacity; 730 | static assert(capacity > 0); 731 | __traits(getMember, s, field) = readEPString(capacity, f); 732 | } 733 | else static if (hasUDA!(__traits(getMember, s, field), EPShortString)) 734 | { 735 | version (VerboseStdOut) { writeln("[EPShortString]"); } 736 | enum capacity = getUDAs!(__traits(getMember, s, field), EPShortString)[0].capacity; 737 | static assert(capacity > 0); 738 | __traits(getMember, s, field) = readEPShortString(capacity, f); 739 | } 740 | else static assert(false, `Need an @EPString(n) or @EPShortString(n) in front of ` ~ fullyQualifiedName!S ~ `.` ~ field ); 741 | } 742 | else static if(!isFunction!(__traits(getMember, s, field))) 743 | { 744 | version (VerboseStdOut) { writeln("[rawRead]"); } 745 | f.rawRead((&__traits(getMember, s, field))[0 .. 1]); 746 | } 747 | //version (VerboseStdOut) { writeln(" (", __traits(getMember, s, field), ")"); } // String80._payload is not visible from std.format 748 | } 749 | } 750 | /** 751 | Where s is an alias to a string annotated with either an `@EPString(n)` UDA or `@EPShortString(n)` UDA, 752 | reads s from file f in the appropriate Prospero formats. 753 | */ 754 | void fromFile(alias s)(File f) //if (/*isSomeString!(typeOf!(s))*/ isType!s) 755 | { 756 | import std.stdio; 757 | import std.traits; 758 | static if (hasUDA!(s, EPString)) 759 | { 760 | version (VerboseStdOut) { writeln("[EPString]"); } 761 | enum capacity = getUDAs!(s, EPString)[0].capacity; 762 | static assert(capacity > 0); 763 | s = readEPString(capacity, f); 764 | } 765 | else static if (hasUDA!(s, EPShortString)) 766 | { 767 | version (VerboseStdOut) { writeln("[EPShortString]");} 768 | enum capacity = getUDAs!(s, EPShortString)[0].capacity; 769 | static assert(capacity > 0); 770 | s = readEPShortString(capacity, f); 771 | } 772 | else static assert(false, `Need an @EPString(n) or @EPShortString(n) in front of ` + s.stringof); 773 | } 774 | 775 | 776 | /// 777 | unittest // Reading structs with strings. 778 | { 779 | import std.stdio; 780 | 781 | struct MyType 782 | { 783 | ubyte b = 0xF; 784 | @EPShortString(5) string str = "Hello"; 785 | } 786 | struct Record 787 | { 788 | int i; 789 | @EPString(10) string str = "World!"; 790 | MyType n; 791 | } 792 | 793 | Record r; 794 | r.str = "Mars!"; 795 | r.n.str = "Bye"; 796 | 797 | File tmp = File.tmpfile(); 798 | r.toFile(tmp); // <=== 799 | tmp.flush; 800 | tmp.rewind; 801 | 802 | Record rec; 803 | rec.fromFile(tmp); 804 | assert(rec == r); 805 | } 806 | 807 | 808 | /// 809 | unittest // Reading unions without indirections. 810 | { 811 | import std.stdio; 812 | 813 | enum soort_subcompartiment_type {rechthoek, extern_subcompartiment} 814 | 815 | struct subcompartiment_type 816 | { 817 | int start_opgebouwde_tank; 818 | struct { 819 | soort_subcompartiment_type soort_subcompartiment; 820 | union { 821 | struct {int one, two, three, four;}; 822 | struct {double d_one, d_two;} 823 | } 824 | } 825 | } 826 | 827 | subcompartiment_type sc; 828 | sc.soort_subcompartiment = soort_subcompartiment_type.rechthoek; 829 | sc.one = 1; 830 | sc.three = 3; 831 | 832 | File tmp = File.tmpfile(); 833 | sc.toFile(tmp); // <=== 834 | tmp.flush; 835 | tmp.rewind; 836 | 837 | subcompartiment_type sc2; 838 | sc2.fromFile(tmp); 839 | assert(sc2 == sc); 840 | } 841 | 842 | 843 | /// 844 | unittest // Reading unions with indirections. 845 | { 846 | import std.stdio; 847 | 848 | enum soort_subcompartiment_type {rechthoek, extern_subcompartiment} 849 | 850 | struct subcompartiment_type 851 | { 852 | int start_opgebouwde_tank; 853 | struct { 854 | soort_subcompartiment_type soort_subcompartiment; 855 | union { 856 | struct {int one, two, three, four;}; 857 | struct {double d_one, d_two; 858 | @EPString(80) string name; 859 | } 860 | } 861 | } 862 | } 863 | 864 | subcompartiment_type sc; 865 | sc.soort_subcompartiment = soort_subcompartiment_type.rechthoek; 866 | sc.one = 1; 867 | sc.three = 3; 868 | sc.name = "John Doe"; 869 | 870 | File tmp = File.tmpfile(); 871 | sc.toFile(tmp); // <=== 872 | tmp.flush; 873 | tmp.rewind; 874 | 875 | subcompartiment_type sc2; 876 | sc2.fromFile(tmp); 877 | assert(sc2 == sc); 878 | } 879 | 880 | 881 | unittest // Defining EP string types with given capacity. 882 | { 883 | struct String80 884 | { 885 | @EPString(80) private string _payload; // FIXME private means public whithin the same file. 886 | alias _payload this; 887 | } 888 | 889 | String80 str; 890 | str = "Jan Karel is een proleet"; 891 | 892 | void testValueString(string s) 893 | { 894 | assert(s == "Jan Karel is een proleet"); 895 | s = "CHANGED"; // No effect? Good. 896 | } 897 | 898 | void testReferenceString(ref string s) 899 | { 900 | assert(s == "Jan Karel is een proleet"); 901 | s = "CHANGED"; // With effect! Good. 902 | } 903 | 904 | testValueString(str); 905 | assert(str == "Jan Karel is een proleet"); 906 | 907 | testReferenceString(str); 908 | assert(str == "CHANGED"); 909 | 910 | struct Record 911 | { 912 | String80 str; 913 | } 914 | 915 | Record rec; 916 | rec.str = "Jan, kerel!"; 917 | 918 | File tmp = File.tmpfile(); 919 | rec.toFile(tmp); // <=== 920 | tmp.flush; 921 | assert(tmp.size == 82); 922 | tmp.rewind; 923 | 924 | Record rec2; 925 | rec2.fromFile(tmp); 926 | assert(rec2 == rec); 927 | assert(rec2.str == "Jan, kerel!"); 928 | } 929 | 930 | 931 | unittest // Run-time capacity 932 | { 933 | // Strings are always "dynamic". 934 | string sptr; 935 | // sptr = new string; // There is no equivalent to sptr = new String(200); 936 | sptr = "dynamische toekomst"; 937 | assert(sptr == "dynamische toekomst"); 938 | sptr.destroy; 939 | assert(sptr == ""); 940 | sptr = null; 941 | assert(sptr == ""); 942 | 943 | // Newing a string (slice of immutable char) makes no sense. 944 | // But it is possible to new an array of mutable char, although the above is preferred: 945 | char[] ptr = new char[200]; 946 | ptr[0 .. 5] = 'a'; 947 | assert(ptr.length == 200); 948 | assert(ptr[0 .. 5] == "aaaaa"); 949 | assert(ptr[6] == char.init); 950 | ptr.destroy; 951 | assert(ptr.length == 0); 952 | assert(sptr == ""); 953 | ptr = null; 954 | assert(ptr.length == 0); 955 | assert(sptr == ""); 956 | } 957 | 958 | /** 959 | Returns a string with any whitespace trimmed from str. 960 | */ 961 | string trim(string str) 962 | { 963 | import std.string; 964 | return strip(fromStringz(str.ptr)); 965 | } 966 | -------------------------------------------------------------------------------- /examples/arraybase/dub.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "arraybase", 3 | "description": "Transcompilation of arraybase.pas.", 4 | "authors": [ 5 | "Bastiaan N. Veelo" 6 | ], 7 | "copyright": "Copyright © 2018, Bastiaan N. Veelo, SARC B.V.", 8 | "license": "boost", 9 | "targetType": "executable", 10 | "dependencies": { 11 | "pascal2d": { 12 | "path": "../..", 13 | "version": "*" 14 | }, 15 | "pascal2d:epcompat": { 16 | "path": "../..", 17 | "version": "*" 18 | } 19 | }, 20 | "configurations": [ 21 | { 22 | "name": "application", 23 | "targetType": "executable" 24 | } 25 | ], 26 | "preGenerateCommands": [ 27 | "cd ../.. && dub build", 28 | "cd $PACKAGE_DIR/source && $PACKAGE_DIR/../../pascal2d arraybase.pas > arraybase.d", 29 | "dub run dfmt -- --inplace $PACKAGE_DIR/source/arraybase.d" 30 | ] 31 | } 32 | -------------------------------------------------------------------------------- /examples/arraybase/source/arraybase.pas: -------------------------------------------------------------------------------- 1 | program arraybase(input,output); 2 | 3 | type t = array[2..20] of integer; 4 | var a : t; 5 | n : integer; 6 | f : bindable file of t; 7 | 8 | begin 9 | for n := 2 to 20 do 10 | a[n] := n; 11 | writeln('Size of t in bytes is ',sizeof(a):1); 12 | if openwrite(f,'array.dat') then 13 | begin 14 | write(f,a); 15 | close(f); 16 | end; 17 | end. 18 | 19 | -------------------------------------------------------------------------------- /examples/arrayc/.gitignore: -------------------------------------------------------------------------------- 1 | .dub 2 | docs.json 3 | __dummy.html 4 | docs/ 5 | arrayc.so 6 | arrayc.dylib 7 | arrayc.dll 8 | arrayc.a 9 | arrayc.lib 10 | arrayc-test-* 11 | *.exe 12 | *.o 13 | *.obj 14 | *.lst 15 | -------------------------------------------------------------------------------- /examples/arrayc/dub.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "arrayc", 3 | "description": "Transcompilation of arrayc.pas.", 4 | "authors": [ 5 | "Bastiaan N. Veelo" 6 | ], 7 | "copyright": "Copyright © 2018, Bastiaan N. Veelo, SARC B.V.", 8 | "license": "boost", 9 | "dependencies": { 10 | "pascal2d": { 11 | "path": "../..", 12 | "version": "*" 13 | }, 14 | "pascal2d:epcompat": { 15 | "path": "../..", 16 | "version": "*" 17 | } 18 | } 19 | } -------------------------------------------------------------------------------- /examples/arrayc/dub.selections.json: -------------------------------------------------------------------------------- 1 | { 2 | "fileVersion": 1, 3 | "versions": { 4 | "pascal2d": {"path":"../.."}, 5 | "pegged": "0.4.3" 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /examples/arrayc/manual_translation/arrayc.d: -------------------------------------------------------------------------------- 1 | // rdmd -I"..\..\..\epcompat\source" arrayc.d 2 | 3 | /* 4 | PROGRAM arrayc (output); 5 | 6 | TYPE days = (sun,mon,tues,weds,thurs,fri,sat); 7 | dname = string(8); 8 | 9 | VAR d: days; 10 | 11 | FUNCTION DayName (fd: days): dname; 12 | TYPE abbrevs = ARRAY [days] OF 13 | PACKED ARRAY [1..5] OF char; 14 | CONST DayNames = abbrevs 15 | [ sun: 'Sun'; mon: 'Mon'; tues: 'Tues'; 16 | weds: 'Weds'; thurs: 'Thurs'; fri: 'Fri'; 17 | sat: 'Satur' ]; 18 | BEGIN 19 | DayName := trim(DayNames[fd]) + 'day'; 20 | END {DayName}; 21 | 22 | BEGIN {program} 23 | FOR d := fri DOWNTO mon DO writeln(DayName(d)); 24 | END. 25 | */ 26 | 27 | import std.stdio; 28 | import epcompat; 29 | 30 | enum days {sun, mon, tues, weds, thurs, fri, sat}; 31 | mixin withEnum!days; 32 | 33 | @EPString(8) alias dname = string; // Variable length instead of fixed. 34 | 35 | days d; 36 | 37 | dname DayName(days fd) 38 | { 39 | /* Idiomatic D, using associate array. 40 | alias abbrevs = string[days]; 41 | immutable abbrevs DayNames = [sun: "Sun", mon: "Mon", tues: "Tues", 42 | weds: "Weds", thurs: "Thurs", fri: "Fri", 43 | sat: "Satur"]; 44 | */ 45 | alias abbrevs = StaticArray!(StaticArray!(char, 1, 5), days); 46 | // http://forum.dlang.org/post/wbxaefufzeytvjkjfpyv@forum.dlang.org 47 | // https://dlang.org/phobos/std_exception.html#assumeUnique 48 | immutable abbrevs DayNames = { 49 | abbrevs ret; 50 | foreach(i, ref e; ret) 51 | final switch (i) { 52 | case sun: 53 | e = "Sun"; 54 | break; 55 | case mon: 56 | e = "Mon"; 57 | break; 58 | case tues: 59 | e = "Tues"; 60 | break; 61 | case weds: 62 | e = "Weds"; 63 | break; 64 | case thurs: 65 | e = "Thurs"; 66 | break; 67 | case fri: 68 | e = "Fri"; 69 | break; 70 | case sat: 71 | e = "Satur"; 72 | break; 73 | } 74 | return cast(immutable(abbrevs)) ret; 75 | }(); 76 | return trim(DayNames[fd]) ~ "day"; 77 | } 78 | 79 | void main() 80 | { 81 | //foreach_reverse (d; mon..sat) 82 | // writeln(DayName(d)); 83 | for (d = fri; d >= mon; d--) 84 | writeln(DayName(d)); 85 | } 86 | -------------------------------------------------------------------------------- /examples/arrayc/source/main.d: -------------------------------------------------------------------------------- 1 | import std.stdio; 2 | import epparser; 3 | import p2d; 4 | 5 | void test(const string pascal) 6 | { 7 | auto parseTree = EP(pascal); 8 | writeln("PASCAL:"); 9 | writeln(pascal); 10 | writeln("\nD:"); 11 | writeln(toD(parseTree)); 12 | import pegged.tohtml; 13 | toHTML(parseTree, "test"); 14 | } 15 | 16 | void main() 17 | { 18 | version (tracer) 19 | { 20 | traceNothing; 21 | } 22 | /*test( 23 | `program MyTest(output); 24 | 25 | (* Say 26 | hello. } 27 | begin 28 | writeln( {Inline comment.} 'Hello D''s \"World\"!' {Inline comment.} {One more {thing.}); 29 | writeln; {Empty} 30 | writeln(''); {Empty string} 31 | writeln('a'); {String} 32 | end. 33 | `);*/ 34 | 35 | assert(EP.TypeDefinitionPart( 36 | `TYPE abbrevs = ARRAY [days] OF 37 | PACKED ARRAY [1..5] OF char;` 38 | ).successful); 39 | assert(EP.ConstantDefinitionPart( 40 | `CONST DayNames = abbrevs 41 | [ sun: 'Sun'; mon: 'Mon'; tues: 'Tues'; 42 | weds: 'Weds'; thurs: 'Thurs'; fri: 'Fri'; 43 | sat: 'Satur' ]; 44 | `).successful); 45 | assert(EP.ProcedureAndFunctionDeclarationPart( 46 | `FUNCTION DayName (fd: days): dname; 47 | { Elements of the array constant DayNames can be 48 | selected with a variable index } 49 | TYPE abbrevs = ARRAY [days] OF 50 | PACKED ARRAY [1..5] OF char; 51 | CONST DayNames = abbrevs 52 | [ sun: 'Sun'; mon: 'Mon'; tues: 'Tues'; 53 | weds: 'Weds'; thurs: 'Thurs'; fri: 'Fri'; 54 | sat: 'Satur' ]; 55 | BEGIN 56 | DayName := trim(DayNames[fd]) + 'day'; 57 | END {DayName}; 58 | `).successful); 59 | 60 | version (tracer) 61 | { 62 | import std.experimental.logger; 63 | sharedLog = new TraceLogger("TraceLog.txt"); 64 | bool cond (string ruleName) 65 | { 66 | static startTrace = false; 67 | if (ruleName.startsWith("EP.FunctionDeclaration")) 68 | startTrace = true; 69 | return startTrace && ruleName.startsWith("EP"); 70 | } 71 | /*setTraceConditionFunction(&cond);*/ 72 | setTraceConditionFunction(ruleName => ruleName.startsWith("EP")); 73 | /*traceAll;*/ 74 | } 75 | 76 | test("PROGRAM arrayc (output); 77 | 78 | { Extended Pascal examples http://ideone.com/YXpi4n } 79 | { Array constant & constant access } 80 | 81 | TYPE days = (sun,mon {First work day},tues,weds,thurs,fri, {Party!} sat); 82 | dname = string(8); 83 | 84 | VAR d: days; 85 | 86 | FUNCTION DayName (fd: days): dname; 87 | { Elements of the array constant DayNames can be 88 | selected with a variable index } 89 | TYPE abbrevs = ARRAY [days] OF 90 | PACKED ARRAY [1..5] OF char; 91 | CONST DayNames = abbrevs 92 | [ sun: 'Sun'; mon: 'Mon'; tues: 'Tues'; 93 | weds: 'Weds'; thurs: 'Thurs'; fri: 'Fri'; 94 | sat: 'Satur' ]; 95 | BEGIN 96 | DayName := trim(DayNames[fd]) + 'day'; 97 | END {DayName}; 98 | 99 | BEGIN {program} 100 | FOR d := fri DOWNTO mon DO writeln(DayName(d)); 101 | END. 102 | 103 | { Generated output is: 104 | Friday 105 | Thursday 106 | Wedsday 107 | Tuesday 108 | Monday 109 | } 110 | "); 111 | 112 | /* 113 | enum code = " 114 | PROGRAM arrayc (output); 115 | 116 | { Extended Pascal examples http://ideone.com/YXpi4n } 117 | { Array constant & constant access } 118 | 119 | TYPE days = (sun,mon {First work day},tues,weds,thurs,fri,sat); 120 | dname = string(8); 121 | 122 | VAR d: days; 123 | 124 | FUNCTION DayName (fd: days): dname; 125 | 126 | { Elements of the array constant DayNames can be 127 | selected with a variable index } 128 | TYPE abbrevs = ARRAY [days] OF 129 | PACKED ARRAY [1..5] OF char; 130 | CONST DayNames = abbrevs 131 | [ sun: 'Sun'; mon: 'Mon'; tues: 'Tues'; 132 | weds: 'Weds'; thurs: 'Thurs'; fri: 'Fri'; 133 | sat: 'Satur' ]; 134 | BEGIN 135 | DayName := trim(DayNames[fd]) + 'day'; 136 | END {DayName}; 137 | 138 | BEGIN {program} 139 | FOR d := fri DOWNTO mon DO writeln(DayName(d)); 140 | END. 141 | 142 | { Generated output is: 143 | Friday 144 | Thursday 145 | Wedsday 146 | Tuesday 147 | Monday 148 | } 149 | "; 150 | 151 | void bench() 152 | { 153 | EP(code); 154 | } 155 | 156 | import std.datetime; 157 | import std.conv : to; 158 | auto r = benchmark!(bench)(1); 159 | writeln("Duration ", to!Duration(r[0])); 160 | */ 161 | } 162 | 163 | 164 | unittest { 165 | string input = 166 | `program MyTest(output); 167 | 168 | begin 169 | writeln('Hello D''s "World"!'); 170 | end. 171 | `; 172 | /+ 173 | import std.experimental.logger; 174 | sharedLog = new FileLogger("TraceLog.txt", LogLevel.all); 175 | bool cond (string ruleName) 176 | { 177 | return (ruleName.startsWith("EP") && !ruleName.startsWith("EP.Literal")); 178 | } 179 | setTraceConditionFunction(&cond); 180 | /*setTraceConditionFunction(ruleName => ruleName.startsWith("EP"));*/ 181 | /*traceAll;*/ 182 | +/ 183 | auto parsed = EP(input); 184 | assert(equal(toD(parsed), 185 | `import std.stdio; 186 | 187 | int main(string[] args) 188 | { 189 | writeln("Hello D's \"World\"!"); 190 | } 191 | `)); 192 | } 193 | -------------------------------------------------------------------------------- /examples/hello/.gitignore: -------------------------------------------------------------------------------- 1 | .dub 2 | docs.json 3 | __dummy.html 4 | docs/ 5 | hello.so 6 | hello.dylib 7 | hello.dll 8 | hello.a 9 | hello.lib 10 | hello-test-* 11 | *.exe 12 | *.o 13 | *.obj 14 | *.lst 15 | -------------------------------------------------------------------------------- /examples/hello/dub.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "hello", 3 | "description": "Transcompilation of hello world.", 4 | "authors": [ 5 | "Bastiaan N. Veelo" 6 | ], 7 | "copyright": "Copyright © 2018, Bastiaan N. Veelo, SARC B.V.", 8 | "license": "boost", 9 | "targetType": "executable", 10 | "dependencies": { 11 | "pascal2d:epcompat": { 12 | "path": "../..", 13 | "version": "*" 14 | } 15 | }, 16 | "configurations": [ 17 | { 18 | "name": "application", 19 | "targetType": "executable" 20 | } 21 | ], 22 | "preGenerateCommands": [ 23 | "cd ../.. && dub build", 24 | "cd $PACKAGE_DIR/source && $PACKAGE_DIR/../../pascal2d hello.pas > hello.d" 25 | ] 26 | } 27 | -------------------------------------------------------------------------------- /examples/hello/source/hello.pas: -------------------------------------------------------------------------------- 1 | program hello(output); 2 | 3 | begin 4 | writeln('Hello D''s "World"!'); 5 | end. 6 | -------------------------------------------------------------------------------- /examples/schema/manual_translation/dub.selections.json: -------------------------------------------------------------------------------- 1 | { 2 | "fileVersion": 1, 3 | "versions": { 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /examples/schema/manual_translation/schema.d: -------------------------------------------------------------------------------- 1 | // rdmd -I"..\..\..\epcompat\source" schema.d 2 | 3 | /* 4 | 5 | // http://www.gnu-pascal.de/gpc/Schema-Types.html 6 | program Schema1Demo; 7 | type 8 | PositiveInteger = 1 .. MaxInt; 9 | RealArray (n: Integer) = array [1 .. n] of Real; 10 | Matrix (n, m: PositiveInteger) = array [1 .. n, 1 .. m] of Integer; 11 | 12 | var 13 | foo: RealArray (42); 14 | mat: Matrix(4, 7); 15 | i: PositiveInteger; 16 | n, m : integer; 17 | 18 | begin 19 | WriteLn (foo.n) { yields 42 } 20 | foo[1] := 10; 21 | writeln(foo[1]); 22 | 23 | i := 0; 24 | for n := 1 to mat.n do 25 | for m := 1 to mat.m do 26 | begin 27 | mat[n][m] := i; 28 | i := i + 1; 29 | end; 30 | 31 | for n := 1 to mat.n do 32 | begin 33 | for m := 1 to mat.m do 34 | write(mat[n][m]); 35 | writeln; 36 | end; 37 | end. 38 | 39 | */ 40 | 41 | import std.stdio; 42 | import epcompat; 43 | 44 | alias PositiveInteger = Ordinal!(1, int.max); 45 | 46 | struct RealArray 47 | { 48 | Array!double _payload; 49 | alias _payload this; 50 | immutable int n; 51 | @disable this(); 52 | this(int n) 53 | { 54 | this.n = n; 55 | _payload = Array!double(1, n); 56 | } 57 | } 58 | 59 | struct Matrix 60 | { 61 | Array!(Array!int) _payload; 62 | alias _payload this; 63 | immutable PositiveInteger n, m; 64 | @disable this(); 65 | this(PositiveInteger n, PositiveInteger m) 66 | { 67 | this.n = n; 68 | this.m = m; 69 | _payload.resize(1, n); 70 | foreach(ref row; _payload) 71 | row.resize(1, m); 72 | } 73 | } 74 | 75 | auto foo = RealArray(42); 76 | auto mat = Matrix(PositiveInteger(4), PositiveInteger(7)); 77 | 78 | void main() 79 | { 80 | import std.format; 81 | 82 | writeln(foo.n); 83 | foo[1] = 10; 84 | writeln(foo[1]); 85 | 86 | PositiveInteger i = 0; 87 | for (int n = 1; n <= mat.n; n++) 88 | for (int m = 1; m <= mat.m; m++) 89 | mat[n][m] = i++; 90 | for (int n = 1; n <= mat.n; n++) { 91 | for (int m = 1; m <= mat.m; m++) 92 | write(format!"%6d"(mat[n][m])); 93 | writeln; 94 | } 95 | } 96 | -------------------------------------------------------------------------------- /runtests.d: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env rdmd 2 | 3 | import std.process; 4 | import std.stdio; 5 | import std.file : remove, exists, readText; 6 | import std.algorithm; 7 | import std.ascii; 8 | 9 | enum outlog = "output.log"; 10 | 11 | int main() 12 | { 13 | if (exists(outlog)) { 14 | writeln("\"" ~ outlog ~ "\" still exists. Aborting."); 15 | return 0; 16 | } 17 | 18 | 19 | writeln("=== runtests: starting \"dub test\""); 20 | auto pid = spawnProcess(["dub", "test"], 21 | std.stdio.stdin, 22 | std.stdio.stdout, 23 | std.stdio.stderr); 24 | if (wait(pid) != 0) { 25 | return 0; 26 | } 27 | writeln("=== runtests: completed \"dub test\""); 28 | 29 | 30 | writeln("=== runtests: starting \"dub test pascal2d:epcompat\""); 31 | pid = spawnProcess(["dub", "test", "pascal2d:epcompat"], 32 | std.stdio.stdin, 33 | std.stdio.stdout, 34 | std.stdio.stderr); 35 | if (wait(pid) != 0) { 36 | return 0; 37 | } 38 | writeln("=== runtests: completed \"dub test pascal2d:epcompat\""); 39 | 40 | 41 | writeln("=== runtests: testing example \"hello\""); 42 | pid = spawnProcess(["dub", "build"], 43 | std.stdio.stdin, 44 | std.stdio.stdout, 45 | std.stdio.stderr, 46 | null, Config.none, "examples\\hello"); 47 | if (wait(pid) != 0) { 48 | return 0; 49 | } 50 | auto outfile = File(outlog, "w"); 51 | pid = spawnProcess(["examples\\hello\\hello.exe"], 52 | std.stdio.stdin, 53 | outfile, 54 | std.stdio.stderr, 55 | null, Config.none, "examples\\hello"); 56 | if (wait(pid) != 0) { 57 | return 0; 58 | } else { 59 | string actual = readText(outlog); 60 | auto expected = "Hello D's \"World\"!" ~ newline; 61 | if (cmp(actual, expected) != 0) { 62 | writeln("Unexpected output. See " ~ outlog ~ "."); 63 | writeln("EXPECTED OUTPUT:"); 64 | writeln(expected); 65 | writeln("ACTUAL OUTPUT:"); 66 | writeln(actual); 67 | return 0; 68 | } else { 69 | remove(outlog); 70 | } 71 | } 72 | writeln("=== runtests: completed example \"hello\""); 73 | 74 | 75 | writeln("=== runtests: testing example \"arraybase\""); 76 | pid = spawnProcess(["dub", "build"], 77 | std.stdio.stdin, 78 | std.stdio.stdout, 79 | std.stdio.stderr, 80 | null, Config.none, "examples\\arraybase"); 81 | if (wait(pid) != 0) { 82 | return 0; 83 | } 84 | outfile = File(outlog, "w"); 85 | pid = spawnProcess(["examples\\arraybase\\arraybase.exe"], 86 | std.stdio.stdin, 87 | outfile, 88 | std.stdio.stderr, 89 | null, Config.none, "examples\\arraybase"); 90 | if (wait(pid) != 0) { 91 | return 0; 92 | } else { 93 | string actual = readText(outlog); 94 | auto expected = "Size of t in bytes is 76" ~ newline; 95 | if (cmp(actual, expected) != 0) { 96 | writeln("Unexpected output. See " ~ outlog ~ "."); 97 | writeln("EXPECTED OUTPUT:"); 98 | writeln(expected); 99 | writeln("ACTUAL OUTPUT:"); 100 | writeln(actual); 101 | return 0; 102 | } else { 103 | remove(outlog); 104 | } 105 | enum arraydat = "examples\\arraybase\\array.dat"; 106 | import std.file; 107 | assert(getSize(arraydat) == 76); 108 | assert(cmp(cast(int[])read(arraydat), 109 | [2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]) == 0); 110 | } 111 | writeln("=== runtests: completed example \"arraybase\""); 112 | 113 | 114 | return 1; 115 | } -------------------------------------------------------------------------------- /source/README.txt: -------------------------------------------------------------------------------- 1 | Run p2d: 2 | 3 | dub 4 | 5 | Run unittests: 6 | 7 | dub test -------------------------------------------------------------------------------- /source/epgrammar.d: -------------------------------------------------------------------------------- 1 | module epgrammar; 2 | 3 | // Extended Pascal grammar. 4 | // Comments refer to the section numbers in the standard: 5 | // http://dx.doi.org/10.1109/IEEESTD.1990.101061 6 | // http://pascal-central.com/docs/iso10206.pdf 7 | // 8 | // Uses extended PEG syntax: 9 | // https://github.com/PhilippeSigaud/Pegged/wiki/Extended-PEG-Syntax 10 | // 11 | // Minor edits have been made, marked with BNV, with the following objectives: 12 | // 1 - Retain layout and comments. 13 | // 2 - Reorder choices from long to short in order to get the longest match. 14 | // 3 - Identify certain identifiers in the translator. 15 | 16 | enum EPgrammar = ` 17 | EP: 18 | BNVCompileUnit <- Program eoi 19 | 20 | # 6.1.1 21 | Digit <- digit 22 | Letter <- [a-zA-Z] 23 | 24 | # 6.1.3 25 | BNVAnyIdentifier <~ Letter ( "_"? ( Letter / Digit ) )* 26 | Identifier <- BNVAnyIdentifier {failOnWordSymbol} 27 | 28 | # 6.1.4 (complete) 29 | RemoteDirective <- "forward"i / "external"i 30 | 31 | # 6.1.5 (complete) 32 | InterfaceDirective <- "interface"i / "external"i 33 | 34 | # 6.1.6 (complete) 35 | ImplementationDirective <- "implementation"i 36 | 37 | # 6.1.7 (complete) 38 | SignedNumber <- SignedInteger / SignedReal 39 | SignedReal <~ Sign? UnsignedReal 40 | SignedInteger <~ Sign? UnsignedInteger 41 | UnsignedNumber <- UnsignedInteger / UnsignedReal 42 | Sign <- [-+] 43 | UnsignedReal <~ DigitSequence "." FractionalPart ( [eE] ScaleFactor )? / DigitSequence [eE] ScaleFactor 44 | UnsignedInteger <- DigitSequence 45 | FractionalPart <- DigitSequence 46 | ScaleFactor <~ Sign? DigitSequence 47 | DigitSequence <~ digits 48 | Number <~ SignedNumber / Sign? ( DigitSequence "." / "." FractionalPart ) ( [eE] ScaleFactor )? 49 | ExtendedDigit <- Digit / Letter 50 | ExtendedNumber <- UnsignedInteger "#" ExtendedDigit+ 51 | 52 | # 6.1.8 (complete) 53 | Label <- DigitSequence 54 | 55 | # 6.1.9 (complete) 56 | CharacterString <- "'" StringElement* "'" 57 | StringElement <- ApostropheImage / StringCharacter 58 | ApostropheImage <- "''" 59 | StringCharacter <- !"'" . 60 | 61 | # 6.1.10 Token separators 62 | Spacing <~ blank+ # BNV Do not discard spacing. 63 | _ <- ( Spacing / TrailingComment / InlineComment )+ 64 | Comment <- ( :Spacing / TrailingComment / InlineComment )+ 65 | CommentOpen <- "{" / "(*" 66 | CommentClose <- "}" / "*)" 67 | CommentContent <~ ( !CommentClose . )* 68 | InlineComment <- CommentOpen CommentContent CommentClose !endOfLine 69 | TrailingComment <- CommentOpen CommentContent CommentClose &endOfLine 70 | 71 | # 6.2.1 (complete) 72 | Block <- ImportPart ( _? LabelDeclarationPart / ConstantDefinitionPart / TypeDefinitionPart / VariableDeclarationPart / ProcedureAndFunctionDeclarationPart )* _? StatementPart _? 73 | ImportPart <- (:"import"i _ ( ImportSpecification _? :";" _? )+ )? 74 | LabelDeclarationPart <- :"label"i _ Label ( _? "," _? Label )* _? :";" _? 75 | ConstantDefinitionPart <- :"const"i _ ( ConstantDefinition _? :";" _? )+ 76 | TypeDefinitionPart <- :TYPE _ ( ( TypeDefinition / SchemaDefinition) _? :";" _? )+ 77 | VariableDeclarationPart <- :"var"i _ ( VariableDeclaration _? :";" _? )+ 78 | ProcedureAndFunctionDeclarationPart <- ( ( ProcedureDeclaration / FunctionDeclaration ) _? :";" _? )* 79 | StatementPart <- CompoundStatement 80 | 81 | # 6.3.1 (complete) 82 | ConstantDefinition <- Identifier _? "=" _? ConstantExpression 83 | ConstantIdentifier <- RequiredConstantIdentifier / Identifier 84 | ConstantName <- ( ImportedInterfaceIdentifier _? DOT _? )? ConstantIdentifier 85 | 86 | # 6.4.1 (complete) 87 | TypeDefinition <- BNVTypeDefName _? "=" _? TypeDenoter 88 | TypeDenoter <- (BINDABLE _ )? ( DiscriminatedSchema / NewType / TypeInquiry / TypeName ) _? InitialStateSpecifier? # BNV Put DiscriminatedSchema first, TypeName last. 89 | NewType <- NewStructuredType / NewOrdinalType / NewPointerType / RestrictedType # BNV Put NewStructuredType first. 90 | #SimpleTypeName <- TypeName # BNV Semantic only 91 | StructuredTypeName <- ArrayTypeName / RecordTypeName / SetTypeName / FileTypeName 92 | ArrayTypeName <- TypeName 93 | RecordTypeName <- TypeName 94 | SetTypeName <- TypeName 95 | FileTypeName <- TypeName 96 | #PointerTypeName <- TypeName # BNV Semantic only 97 | TypeIdentifier <- RequiredTypeIdentifier / Identifier 98 | TypeName <- ( ImportedInterfaceIdentifier _? DOT _? )? TypeIdentifier 99 | #BNV extensions 100 | BNVTypeDefName <- Identifier 101 | 102 | # 6.4.2.1 (complete) 103 | #SimpleType <- OrdinalType / RealTypeName / ComplexTypeName # BNV Semantic only 104 | OrdinalType <- NewOrdinalType / OrdinalTypeName / TypeInquiry / DiscriminatedSchema 105 | NewOrdinalType <- EnumeratedType / SubrangeType 106 | OrdinalTypeName <- TypeName 107 | #RealTypeName <- TypeName # BNV Semantic only 108 | #ComplexTypeName <- TypeName # BNV Semantic only 109 | 110 | # 6.4.2.3 (complete) 111 | EnumeratedType <- "(" _? IdentifierList _? ")" 112 | IdentifierList <- Identifier ( _? COMMA _? Identifier )* 113 | 114 | # 6.4.2.4 (complete) 115 | SubrangeType <- SubrangeBound _? ".." _? SubrangeBound 116 | SubrangeBound <- Expression 117 | 118 | # 6.4.2.5 (complete) 119 | RestrictedType <- :RESTRICTED _ TypeName 120 | 121 | # 6.4.3.1 (complete) 122 | #StructuredType <- NewStructuredType / StructuredTypeName # BNV Semantic only 123 | NewStructuredType <- :PACKED? _? UnpackedStructuredType 124 | UnpackedStructuredType <- ArrayType / RecordType / SetType / FileType 125 | 126 | # 6.4.3.2 (complete) 127 | ArrayType <- :ARRAY _? "[" _? IndexType ( _? COMMA _? IndexType )* _? "]" _? :OF _ ComponentType 128 | IndexType <- OrdinalType 129 | ComponentType <- TypeDenoter 130 | 131 | # 6.4.3.3 String types. TODO 132 | 133 | # 6.4.3.4 (complete) 134 | RecordType <- :RECORD _ FieldList _ :END 135 | FieldList <- ( ( FixedPart ( _? ";" _? VariantPart )? / VariantPart ) _? ";"? )? 136 | FixedPart <- RecordSection ( _? ";" _? RecordSection )* 137 | RecordSection <- IdentifierList _? ":" _? TypeDenoter 138 | FieldIdentifier <- Identifier 139 | VariantPart <- :CASE _ VariantSelector _ :OF _ ( VariantListElement ( _? ";" _? VariantListElement )* ( _? ":"? _? VariantPartCompleter )? / VariantPartCompleter ) 140 | VariantListElement <- CaseConstantList _? ":" _? VariantDenoter 141 | VariantPartCompleter <- OTHERWISE _ VariantDenoter 142 | VariantDenoter <- "(" _? FieldList _? ")" 143 | VariantSelector <- ( TagField _? ":" _? )? TagType / DiscriminantIdentifier 144 | TagField <- Identifier 145 | TagType <- OrdinalTypeName 146 | CaseConstantList <- CaseRange ( _? "," _? CaseRange )* 147 | CaseRange <- CaseConstant ( _? ".." _? CaseConstant )? 148 | CaseConstant <- ConstantExpression 149 | 150 | # 6.4.3.5 (complete) 151 | SetType <- :SET _ :OF _ BaseType 152 | BaseType <- OrdinalType 153 | 154 | # 6.4.3.6 (complete) 155 | FileType <- :FILE ( _? "[" _? IndexType _? "]" )? _ :OF _ ComponentType 156 | 157 | # 6.4.4 (complete) 158 | #PointerType <- NewPointerType / PointerTypeName # BNV Semantic only 159 | NewPointerType <- :"^" _? DomainType 160 | DomainType <- TypeName / SchemaName 161 | 162 | # 6.4.7 (complete) 163 | SchemaDefinition <- ( Identifier _? "=" _? SchemaName ) / ( Identifier _? FormalDiscriminantPart _? "=" _? TypeDenoter ) 164 | FormalDiscriminantPart <- "(" _? DiscriminantSpecification ( _? ";" _? DiscriminantSpecification )* _? ")" 165 | DiscriminantSpecification <- IdentifierList _? ":" _? OrdinalTypeName 166 | DiscriminantIdentifier <- Identifier 167 | SchemaIdentifier <- Identifier 168 | SchemaName <- ( ImportedInterfaceIdentifier _? "." _? )? SchemaIdentifier 169 | 170 | # 6.4.8 (complete) 171 | DiscriminatedSchema <- SchemaName _? ActualDiscriminantPart 172 | ActualDiscriminantPart <- "(" _? DiscriminantValue _? ( "," _? DiscriminantValue _? )* ")" 173 | DiscriminantValue <- Expression 174 | 175 | # 6.4.9 (complete) 176 | TypeInquiry <- :TYPE _ :OF _ TypeInquiryObject 177 | TypeInquiryObject <- VariableName / ParameterIdentifier 178 | 179 | # 6.5.1 (complete) 180 | VariableDeclaration <- IdentifierList _? ":" _? TypeDenoter 181 | VariableIdentifier <- Identifier 182 | VariableName <- ( ImportedInterfaceIdentifier _? DOT _? )? VariableIdentifier 183 | #VariableAccess <- EntireVariable / ComponentVariable / IdentifiedVariable / BufferVariable / SubstringVariable / FunctionIdentifiedVariable 184 | VariableAccess <- ComponentVariable / IdentifiedVariable / BufferVariable / SubstringVariable / FunctionIdentifiedVariable / EntireVariable # BNV moved EntireVariable last 185 | 186 | # 6.5.2 (complete) 187 | EntireVariable <- VariableName 188 | 189 | # 6.5.3.1 (complete) 190 | ComponentVariable <- IndexedVariable / FieldDesignator 191 | 192 | # 6.5.3.2 (complete) 193 | IndexedVariable <- (ArrayVariable _? ^"[" _? IndexExpression ( _? ^"," _? IndexExpression )* _? ^"]" ) / ( StringVariable _? ^"[" _? IndexExpression _? ^"]" ) 194 | ArrayVariable <- VariableAccess 195 | StringVariable <- VariableAccess 196 | IndexExpression <- Expression 197 | 198 | # 6.5.3.3 (complete) 199 | FieldDesignator <- ( RecordVariable "." FieldSpecifier ) / FieldDesignatorIdentifier 200 | RecordVariable <- VariableAccess 201 | FieldSpecifier <- FieldIdentifier 202 | 203 | # 6.5.4 (complete) 204 | IdentifiedVariable <- PointerVariable :"^" 205 | PointerVariable <- VariableAccess 206 | 207 | # 6.5.5 (complete) 208 | BufferVariable <- FileVariable :"^" 209 | FileVariable <- VariableAccess 210 | 211 | # 6.5.6 (complete) 212 | SubstringVariable <- StringVariable _? "[" _? IndexExpression _? ".." _? IndexExpression _? "]" 213 | 214 | # 6.6 (complete) 215 | InitialStateSpecifier <- "value"i _ ComponentValue 216 | 217 | # 6.7.1 (complete) 218 | ProcedureDeclaration <- ProcedureHeading _? ";" _? RemoteDirective 219 | / ProcedureIdentification _? ";" _? ProcedureBlock 220 | / ProcedureHeading _? ";" _? ProcedureBlock 221 | ProcedureHeading <- "procedure"i _ Identifier _ FormalParameterList? 222 | ProcedureIdentification <- "procedure"i _ ProcedureIdentifier 223 | ProcedureIdentifier <- Identifier 224 | ProcedureBlock <- Block 225 | ProcedureName <- ( ImportedInterfaceIdentifier _? DOT _? )? ProcedureIdentifier 226 | 227 | # 6.7.2 (complete) 228 | FunctionDeclaration <- FunctionHeading _? ";" _? RemoteDirective 229 | / FunctionIdentification _? ";" _? FunctionBlock 230 | / FunctionHeading _? ";" _? FunctionBlock 231 | FunctionHeading <- :"function"i _ Identifier _? FormalParameterList? _? ResultVariableSpecification? _? ":" _? ResultType 232 | ResultVariableSpecification <- "=" _? Identifier 233 | FunctionIdentification <- :"function"i _ FunctionIdentifier 234 | FunctionIdentifier <- Identifier 235 | ResultType <- TypeName 236 | FunctionBlock <- Block 237 | FunctionName <- ( ImportedInterfaceIdentifier _? DOT _? )? FunctionIdentifier 238 | 239 | # 6.7.3.1 (complete) 240 | FormalParameterList <- "(" _? FormalParameterSection ( _? ";" _? FormalParameterSection )* _? ")" 241 | FormalParameterSection <- ValueParameterSpecification 242 | / VariableParameterSpecification 243 | / ProceduralParameterSpecification 244 | / FunctionalParameterSpecification 245 | / ConformantArrayParameterSpecification # BNV moved from section 6.7.3.7.1 246 | ValueParameterSpecification <- (PROTECTED _ )? IdentifierList _? ":" _? ParameterForm 247 | VariableParameterSpecification <- (PROTECTED _ )? "var"i _ IdentifierList _? ":" _? ParameterForm 248 | ParameterForm <- TypeName / SchemaName / TypeInquiry 249 | ParameterIdentifier <- Identifier 250 | ProceduralParameterSpecification <- ProcedureHeading 251 | FunctionalParameterSpecification <- FunctionHeading 252 | 253 | # 6.7.3.7.1 254 | # FormalParameterSection <- ConformantArrayParameterSpecification # BNV Moved to section 6.7.3.1 255 | ConformantArrayParameterSpecification <- ( PROTECTED _ )? ( ValueConformantArraySpecification / VariableConformantArraySpecification ) 256 | ValueConformantArraySpecification <- IdentifierList _? ":" _? ConformantArrayForm 257 | VariableConformantArraySpecification <- "var"i _ IdentifierList _? ":" _? ConformantArrayForm 258 | ConformantArrayForm <- PackedConformantArrayForm / UnpackedConformantArrayForm 259 | PackedConformantArrayForm <- "packed"i _ "array"i _? "[" _? IndexTypeSpecification _? "]" _? "of"i _? TypeName 260 | UnpackedConformantArrayForm <- "array"i _? "[" _? IndexTypeSpecification ( _? ";" _? IndexTypeSpecification )* _? "]" _? "of"i _? TypeName 261 | IndexTypeSpecification <- Identifier _? ".." _? Identifier _? ":" _? OrdinalTypeName 262 | # TODO mistake in standard? 263 | # Primary <- BoundIdentifier 264 | # BoundIdentifier <- Identifier 265 | 266 | # 6.7.5 Required procedures TODO 267 | 268 | # 6.7.5.5 (complete) 269 | ReadstrParameterList <- "(" _? StringExpression _? "," _? VariableAccess ( _? "," _? VariableAccess )* _? ")" 270 | StringExpression <- Expression 271 | WritestrParameterList <- "(" _? StringVariable _? "," _? WriteParameter ( _? "," _? WriteParameter )* _? ")" 272 | 273 | # 6.7.6 Required functions TODO 274 | 275 | # 6.8.1 (complete) 276 | Expression <- SimpleExpression ( _? RelationalOperator _? SimpleExpression)? 277 | SimpleExpression <- Sign? _? Term ( _? AddingOperator _? Term )* 278 | Term <- Factor ( _? MultiplyingOperator _? Factor )* 279 | Factor <- Primary ( _? ExponentiatingOperator _? Primary )? 280 | Primary <- UnsignedConstant 281 | / SetConstructor 282 | / "(" _? Expression _? ")" 283 | / NOT _? Primary 284 | / StructuredValueConstructor 285 | / LocalFunctionAccess # BNV Local Prospero language additions 286 | / FunctionAccess # BNV Moved after StructuredValueConstructor 287 | / ConstantAccess # BNV Moved after StructuredValueConstructor and FunctionAccess 288 | / SchemaDiscriminant # BNV Moved after StructuredValueConstructor and FunctionAccess 289 | / VariableAccess # BNV Moved after StructuredValueConstructor 290 | / DiscriminantIdentifier 291 | UnsignedConstant <- UnsignedNumber / CharacterString / NIL / ExtendedNumber 292 | SetConstructor <- "[" _? ( MemberDesignator ( _? "," _? MemberDesignator )* )? _? "]" 293 | MemberDesignator <- Expression ( _? ".." _? Expression )? 294 | 295 | # 6.8.2 (complete) 296 | ConstantExpression <- Expression 297 | 298 | # 6.8.3.1 (complete) 299 | ExponentiatingOperator <- "**" / POW 300 | MultiplyingOperator <- "*" / "/" / DIV / MOD / AND / AND_THEN 301 | AddingOperator <- "+" / "-" / "><" / OR / OR_ELSE 302 | RelationalOperator <- "=" / "<>" / "<=" / "<" / ">=" / ">" / IN 303 | 304 | # 6.8.3.2 Arithmetic operators TODO? 305 | 306 | # 6.8.3.3 307 | BooleanExpression <- Expression 308 | 309 | # 6.8.3.4 Set operators TODO 310 | 311 | # 6.8.3.6 String operator TODO 312 | 313 | # 6.8.4 (complete) 314 | SchemaDiscriminant <- ( VariableAccess / ConstantAccess ) _? "." _? DiscriminantSpecifier / SchemaDiscriminantIdentifier 315 | DiscriminantSpecifier <- DiscriminantIdentifier 316 | 317 | 318 | # 6.8.5 (complete) 319 | FunctionDesignator <- FunctionName ( _? ActualParameterList )? 320 | ActualParameterList <- ^"(" _? ActualParameter ( _? ^"," _? ActualParameter )* _? ^")" 321 | ActualParameter <- Expression / VariableAccess / ProcedureName / FunctionName 322 | 323 | # 6.8.6.1 (complete) 324 | FunctionAccess <- EntireFunctionAccess / ComponentFunctionAccess / SubstringFunctionAccess 325 | ComponentFunctionAccess <- IndexedFunctionAccess / RecordFunctionAccess 326 | EntireFunctionAccess <- FunctionDesignator 327 | 328 | # 6.8.6.2 (complete) 329 | IndexedFunctionAccess <- ArrayFunction _? "[" _? IndexExpression ( _? "," _? IndexExpression )* _? "]" 330 | ArrayFunction <- FunctionAccess 331 | StringFunction <- FunctionAccess 332 | 333 | # 6.8.6.3 (complete) 334 | RecordFunctionAccess <- RecordFunction _? "." _? FieldSpecifier 335 | RecordFunction <- FunctionAccess 336 | 337 | # 6.8.6.4 (complete) 338 | FunctionIdentifiedVariable <- PointerFunction _? "^" 339 | PointerFunction <- FunctionAccess 340 | 341 | # 6.8.6.5 (complete) 342 | SubstringFunctionAccess <- StringFunction _? "[" _? IndexExpression _? ".." _? IndexExpression _? "]" 343 | 344 | # 6.8.7.1 (complete) 345 | StructuredValueConstructor <- ArrayTypeName _? ArrayValue / RecordTypeName _? RecordValue / SetTypeName _? SetValue 346 | ComponentValue <- Expression / ArrayValue / RecordValue 347 | 348 | # 6.8.7.2 (complete) 349 | ArrayValue <- "[" _? ( ArrayValueElement ( _? ";" _? ArrayValueElement )* _? ";"? )? ( _? ArrayValueCompleter _? ";"? )? _? "]" 350 | ArrayValueElement <- CaseConstantList _? ":" _? ComponentValue 351 | ArrayValueCompleter <- OTHERWISE _? ComponentValue 352 | 353 | # 6.8.7.3 (complete) 354 | RecordValue <- "[" _? FieldListValue _? "]" 355 | FieldListValue <- ( ( FixedPartValue ( _? ";" _? VariantPartValue )? / VariantPartValue ) _? ";"? )? 356 | FixedPartValue <- FieldValue ( _? ";" _? FieldValue )* 357 | FieldValue <- FieldIdentifier ( _? ";" FieldIdentifier )* _? ":" _? ComponentValue 358 | VariantPartValue <- CASE _ ( TagFieldIdentifier _? ":" _?)? ConstantTagValue _? OF _? "[" _? FieldListValue _? "]" 359 | ConstantTagValue <- ConstantExpression 360 | TagFieldIdentifier <- FieldIdentifier 361 | 362 | # 6.8.7.4 (complete) 363 | SetValue <- SetConstructor 364 | 365 | # 6.8.8.1 (complete) 366 | ConstantAccess <- ConstantAccessComponent / ConstantName 367 | ConstantAccessComponent <- IndexedConstant / FieldDesignatedConstant / SubstringConstant 368 | 369 | # 6.8.8.2 (complete) 370 | IndexedConstant <- ArrayConstant _? "[" _? IndexExpression ( _? "," _? IndexExpression )* _? "]" / StringConstant _? "[" _? IndexExpression _? "]" 371 | ArrayConstant <- ConstantAccess 372 | StringConstant <- ConstantAccess 373 | 374 | # 6.8.8.3 (complete) 375 | FieldDesignatedConstant <- RecordConstant _? "." _? FieldSpecifier / ConstantFieldIdentifier 376 | RecordConstant <- ConstantAccess 377 | 378 | # 6.8.8.4 (complete) 379 | SubstringConstant <- StringConstant _? "[" _? IndexExpression _? ".." _? IndexExpression _? "]" 380 | 381 | # 6.9.1 (complete) 382 | Statement <- ( Label _? ":" _? )? ( StructuredStatement / SimpleStatement ) # BNV Moved SimpleStatement last, so StructuredStatement is tried before EmptyStatement. 383 | 384 | # 6.9.2.1 (complete) 385 | # SimpleStatement <- EmptyStatement / AssignmentStatement / ProcedureStatement / GotoStatement # Standard 386 | SimpleStatement <- AssignmentStatement / ProcedureStatement / GotoStatement / EmptyStatement # BNV Moved EmptyStatement last, try real statements first. 387 | EmptyStatement <- eps 388 | 389 | # 6.9.2.2 (complete) 390 | AssignmentStatement <- ( VariableAccess / FunctionIdentifier ) _? ^":=" _? Expression 391 | 392 | # 6.9.2.3 (complete) #BNV Extended for required procedures. 393 | ProcedureStatement <- 394 | / READ _? ReadParameterList 395 | / READLN _? ReadlnParameterList 396 | / READSTR _? ReadstrParameterList 397 | / WRITE _? WriteParameterList 398 | / WRITELN _? WritelnParameterList? 399 | / WRITESTR _? WritestrParameterList 400 | / ProcedureName _? ActualParameterList? 401 | 402 | # 6.9.2.4 (complete) 403 | GotoStatement <- "goto"i _ Label 404 | 405 | # 6.9.3.1 (complete) 406 | StructuredStatement <- CompoundStatement / ConditionalStatement / RepetitiveStatement / WithStatement 407 | StatementSequence <- Statement ( _? ";" _? Statement )* 408 | 409 | # 6.9.3.2 (complete) 410 | CompoundStatement <- :BEGIN _? StatementSequence _? :END 411 | 412 | # 6.9.3.3 (complete) 413 | ConditionalStatement <- IfStatement / CaseStatement 414 | 415 | # 6.9.3.4 (complete) 416 | IfStatement <- IF _? BooleanExpression _? "then"i _? Statement ElsePart? 417 | ElsePart <- ELSE _? Statement 418 | 419 | # 6.9.3.5 (complete) 420 | CaseStatement <- "case"i _ CaseIndex _ "of"i _ ( CaseListElement ( _? ";" _? CaseListElement )* ( _? ";"? _? CaseStatementCompleter )? / _? CaseStatementCompleter ) _? ";"? _? "end"i 421 | CaseIndex <- Expression 422 | CaseListElement <- CaseConstantList _? ":" _? Statement 423 | CaseStatementCompleter <- "otherwise"i _ StatementSequence 424 | 425 | # 6.9.3.6 (complete) 426 | RepetitiveStatement <- RepeatStatement / WhileStatement / ForStatement 427 | 428 | # 6.9.3.7 (complete) 429 | RepeatStatement <- "repeat"i _ StatementSequence _ "until"i _ BooleanExpression 430 | 431 | # 6.9.3.8 (complete) 432 | WhileStatement <- "while"i _ BooleanExpression _ "do"i _ Statement 433 | 434 | # 6.9.3.9.1 (complete) 435 | ForStatement <- "for"i _ ControlVariable _? IterationClause _ "do"i _ Statement 436 | ControlVariable <- EntireVariable 437 | IterationClause <- SequenceIteration / SetMemberIteration 438 | 439 | # 6.9.3.9.2 (complete) 440 | SequenceIteration <- ":=" _? InitialValue _ ( TO / DOWNTO ) _ FinalValue 441 | InitialValue <- Expression 442 | FinalValue <- Expression 443 | 444 | # 6.9.3.9.3 (complete) 445 | SetMemberIteration <- "in"i _ SetExpression 446 | SetExpression <- Expression 447 | 448 | # 6.9.3.10 (complete) 449 | WithStatement <- "with"i _ WithList _ "do"i _ Statement 450 | WithList <- WithElement ( _? "," _? WithElement)* 451 | WithElement <- VariableAccess / ConstantAccess 452 | FieldDesignatorIdentifier <- Identifier 453 | ConstantFieldIdentifier <- Identifier 454 | SchemaDiscriminantIdentifier <- Identifier 455 | 456 | # 6.9.4 Threats 457 | 458 | # 6.10.1 (complete) 459 | ReadParameterList <- "(" _? ( FileVariable _? "," _? )? VariableAccess _? ( _? "," _? VariableAccess )* _? ")" 460 | 461 | # 6.10.2 (complete) 462 | ReadlnParameterList <- ( "(" _? ( FileVariable / VariableAccess ) ( _? "," _? VariableAccess )* _? ")" )? 463 | 464 | # 6.10.3 (complete) 465 | WriteParameterList <- ^"(" _? ( FileVariable _? ^"," _? )? WriteParameter ( _? ^"," _? WriteParameter )* _? ^")" 466 | WriteParameter <- Expression ( _? ":" _? Expression ( _? ":" _? Expression )? )? 467 | 468 | # 6.10.4 (complete) 469 | WritelnParameterList <- ( ^"(" _? ( WriteParameter / FileVariable ) ( _? ^"," _? WriteParameter )* _? ^")" )? # BNV put WriteParameter before FileVariable. 470 | 471 | # 6.11.1 (complete) 472 | ModuleDeclaration <- ModuleHeadeing ( _? ";" _? ModuleBlock )? / 473 | ModuleIdentification _? ";" _? ModuleBlock 474 | ModuleHeadeing <- "module"i Comment? BNVModuleName Comment? InterfaceDirective? Comment? ( "(" ModuleParameterList ")" Comment? )? ";" _? InterfaceSpecificationPart _? ImportPart _? ( ConstantDefinitionPart / TypeDefinitionPart / VariableDeclarationPart / ProcedureAndFunctionHeadingPart)* _? END 475 | ModuleParameterList <- IdentifierList 476 | ProcedureAndFunctionHeadingPart <- ( ProcedureHeading / FunctionHeading ) _? ";" 477 | ModuleIdentification <- "module"i Comment? ModuleIdenifier Comment? ImplementationDirective 478 | ModuleIdenifier <- Identifier 479 | ModuleBlock <- ImportPart ( ConstantDefinitionPart / TypeDefinitionPart / VariableDeclarationPart / ProcedureAndFunctionDeclarationPart )* _? InitializationPart? _? FinalizationPart? _? END 480 | InitializationPart <- "to"i _? "begin"i _? "do"i _? Statement _? ";" 481 | FinalizationPart <- "to"i _? "end"i _? "do"i _? Statement _? ";" 482 | BNVModuleName <- Identifier 483 | 484 | # 6.11.2 (complete) 485 | InterfaceSpecificationPart <- "export"i _? ( ExportPart _? ";" )+ 486 | ExportPart <- Identifier _? "=" _? "(" _? ExportList _? ")" 487 | ExportList <- ( ExportClause / ExportRange ) ( _? "," _? ( ExportClause / ExportRange ) )* 488 | ExportClause <- ExportableName / ExportRenamingClause 489 | ExportRenamingClause <- ExportableName _? "=>" _? Identifier 490 | ExportableName <- ConstantName / TypeName / SchemaName / ( PROTECTED? _?VariableName ) / ProcedureName / FunctionName 491 | ExportRange <- FirstConstantName _? ".." _? LastConstantName 492 | FirstConstantName <- ConstantName 493 | LastConstantName <- ConstantName 494 | ConstituentIdentifier <- Identifier 495 | InterfaceIdentifier <- Identifier 496 | 497 | # 6.11.3 (complete) 498 | ImportSpecification <- InterfaceIdentifier AccessQualifier? ImportQualifier? 499 | AccessQualifier <- QUALIFIED 500 | ImportQualifier <- SelectiveImportOption? "(" ImportList ")" 501 | SelectiveImportOption <- ONLY 502 | ImportList <- ImportClause ("," ImportClause)* 503 | ImportClause <- ConstituentIdentifier / ImportRenamingClause 504 | ImportRenamingClause <- ConstituentIdentifier "=>" Identifier 505 | ImportedInterfaceIdentifier <- Identifier 506 | 507 | # 6.11.4 Required interfaces TODO 508 | 509 | # 6.12 (complete) 510 | MainProgramDeclaration <- ProgramHeading _? ";" :Spacing? MainProgramBlock # BNV Discarding newlines that have no correspondence in D. 511 | ProgramHeading <- PROGRAM Comment? BNVProgramName ( Comment? "(" ProgramParameterList ")" )? 512 | ProgramParameterList <- IdentifierList 513 | MainProgramBlock <- _? Block 514 | # BNV extensions 515 | BNVProgramName <- Identifier 516 | 517 | # 6.13 518 | Program <- _? ProgramBlock _? 519 | ProgramBlock <- ( ProgramComponent _? )+ 520 | ProgramComponent <- ( MainProgramDeclaration _? "." ) / ( ModuleDeclaration _? "." ) 521 | 522 | # Keywords 523 | PROGRAM <- "program"i 524 | ONLY <- "only"i 525 | QUALIFIED <- "qualified"i 526 | BEGIN <- "begin"i 527 | END <- "end"i 528 | POW <- "pow"i 529 | DIV <- "div"i 530 | MOD <- "mod"i 531 | AND <- "and"i 532 | AND_THEN <- "and_then"i 533 | OR <- "or"i 534 | OR_ELSE <- "or_else"i 535 | IN <- "in"i 536 | NIL <- "nil"i 537 | NOT <- "not"i 538 | TYPE <- "type"i 539 | BINDABLE <- "bindable"i 540 | RESTRICTED <- "restricted"i 541 | PACKED <- "packed"i 542 | ARRAY <- "array"i 543 | OF <- "of"i 544 | RECORD <- "record"i 545 | CASE <- "case"i 546 | OTHERWISE <- "otherwise"i 547 | SET <- "set"i 548 | FILE <- "file"i 549 | PROTECTED <- "protected"i 550 | TO <- "to"i 551 | DOWNTO <- "downto"i 552 | IF <- "if"i 553 | ELSE <- "else"i 554 | 555 | # Separators 556 | COMMA <- "," 557 | DOT <- "." 558 | 559 | # Required procedures (6.7.4) 560 | READ <- "read"i 561 | READLN <- "readln"i 562 | READSTR <- "readstr"i 563 | WRITE <- "write"i 564 | WRITELN <- "writeln"i 565 | WRITESTR <- "writestr"i 566 | 567 | # Required simple types and constant identifiers (6.4.2.2) 568 | RequiredTypeIdentifier <- INTEGER / REAL / BOOLEAN / CHAR / COMPLEX 569 | INTEGER <- "integer"i 570 | REAL <- "real"i 571 | BOOLEAN <- "boolean"i 572 | CHAR <- "char"i 573 | COMPLEX <- "complex"i 574 | RequiredConstantIdentifier <- MAXINT / MINREAL / MAXREAL / EPSREAL / FALSE / TRUE / MINCHAR / MAXCHAR 575 | MAXINT <- "maxint"i 576 | MINREAL <- "minreal"i 577 | MAXREAL <- "maxreal"i 578 | EPSREAL <- "epsreal"i 579 | FALSE <- "false"i 580 | TRUE <- "true"i 581 | MINCHAR <- "minchar"i 582 | MAXCHAR <- "maxchar"i 583 | 584 | # Local Prospero language extensions 585 | LocalFunctionAccess <- LocalSizeof 586 | LocalSizeof <- "sizeof"i _? "(" _? ( VariableAccess / TypeName ) _? ")" 587 | `; 588 | -------------------------------------------------------------------------------- /source/generate.d: -------------------------------------------------------------------------------- 1 | /** 2 | * Recreate the EP parser from the grammar. 3 | */ 4 | 5 | import pegged.grammar; 6 | import epgrammar; 7 | 8 | void main() 9 | { 10 | auto header = ` 11 | PT failOnWordSymbol(PT)(PT p) 12 | { 13 | import std.uni: sicmp; 14 | // 6.1.2 15 | if (sicmp(p.matches[0], "AND") == 0 || 16 | sicmp(p.matches[0], "AND_THEN") == 0 || 17 | sicmp(p.matches[0], "ARRAY") == 0 || 18 | sicmp(p.matches[0], "BEGIN") == 0 || 19 | sicmp(p.matches[0], "BINDABLE") == 0 || 20 | sicmp(p.matches[0], "CASE") == 0 || 21 | sicmp(p.matches[0], "CONST") == 0 || 22 | sicmp(p.matches[0], "DIV") == 0 || 23 | sicmp(p.matches[0], "DO") == 0 || 24 | sicmp(p.matches[0], "DOWNTO") == 0 || 25 | sicmp(p.matches[0], "ELSE") == 0 || 26 | sicmp(p.matches[0], "END") == 0 || 27 | sicmp(p.matches[0], "EXPORT") == 0 || 28 | sicmp(p.matches[0], "FILE") == 0 || 29 | sicmp(p.matches[0], "FOR") == 0 || 30 | sicmp(p.matches[0], "FUNCTION") == 0 || 31 | sicmp(p.matches[0], "GOTO") == 0 || 32 | sicmp(p.matches[0], "IF") == 0 || 33 | sicmp(p.matches[0], "IMPORT") == 0 || 34 | sicmp(p.matches[0], "IN") == 0 || 35 | sicmp(p.matches[0], "LABEL") == 0 || 36 | sicmp(p.matches[0], "MOD") == 0 || 37 | sicmp(p.matches[0], "MODULE") == 0 || 38 | sicmp(p.matches[0], "NIL") == 0 || 39 | sicmp(p.matches[0], "NOT") == 0 || 40 | sicmp(p.matches[0], "OF") == 0 || 41 | sicmp(p.matches[0], "ONLY") == 0 || 42 | sicmp(p.matches[0], "OR") == 0 || 43 | sicmp(p.matches[0], "OR_ELSE") == 0 || 44 | sicmp(p.matches[0], "OTHERWISE") == 0 || 45 | sicmp(p.matches[0], "PACKED") == 0 || 46 | sicmp(p.matches[0], "POW") == 0 || 47 | sicmp(p.matches[0], "PROCEDURE") == 0 || 48 | sicmp(p.matches[0], "PROGRAM") == 0 || 49 | sicmp(p.matches[0], "PROTECTED") == 0 || 50 | sicmp(p.matches[0], "QUALIFIED") == 0 || 51 | sicmp(p.matches[0], "RECORD") == 0 || 52 | sicmp(p.matches[0], "REPEAT") == 0 || 53 | sicmp(p.matches[0], "RESTRICTED") == 0 || 54 | sicmp(p.matches[0], "SET") == 0 || 55 | sicmp(p.matches[0], "THEN") == 0 || 56 | sicmp(p.matches[0], "TO") == 0 || 57 | sicmp(p.matches[0], "TYPE") == 0 || 58 | sicmp(p.matches[0], "UNTIL") == 0 || 59 | sicmp(p.matches[0], "VALUE") == 0 || 60 | sicmp(p.matches[0], "VAR") == 0 || 61 | sicmp(p.matches[0], "WHILE") == 0 || 62 | sicmp(p.matches[0], "WITH") == 0) 63 | { 64 | p.successful = false; 65 | } 66 | return p; 67 | } 68 | `; 69 | asModule!()("epparser", "epparser", EPgrammar, header); 70 | } 71 | -------------------------------------------------------------------------------- /source/main.d: -------------------------------------------------------------------------------- 1 | import std.stdio; 2 | import std.file; 3 | import std.getopt; 4 | import std.string: chomp; 5 | import pegged.tohtml; 6 | import epparser; 7 | import p2d; 8 | 9 | version(unittest) { 10 | // Unit tests are run without arguments, don't error. 11 | void main(){}; 12 | } else 13 | 14 | int main(string[] args) 15 | { 16 | bool syntax_tree = false; 17 | GetoptResult helpInforation; 18 | try { 19 | helpInforation = getopt( 20 | args, 21 | "syntax_tree|s", "Generate an HTML file with the syntax tree in .", &syntax_tree 22 | ); 23 | } 24 | catch (std.getopt.GetOptException e) { 25 | writeln(args[0] ~ ": " ~ e.msg ~ ". See " ~ args[0] ~ " --help"); 26 | return 1; 27 | } 28 | 29 | if (helpInforation.helpWanted || 30 | args.length != 2) 31 | { 32 | defaultGetoptPrinter("Transcompile Extended Pascal into D.\n" ~ 33 | "Usage: " ~ args[0] ~ " [-s][-h] > ", 34 | helpInforation.options); 35 | return 1; 36 | } 37 | 38 | auto parsed = EP(readText(args[1])); 39 | if (syntax_tree) 40 | toHTML(parsed, args[1].chomp(".pas")~".html"); 41 | writeln(toD(parsed)); 42 | 43 | return 0; 44 | } 45 | -------------------------------------------------------------------------------- /source/make.d: -------------------------------------------------------------------------------- 1 | int main(string[] opts) 2 | in {assert(opts.length == 2);} do 3 | { 4 | enum source1 = "epgrammar.d"; 5 | enum source2 = "generate.d"; 6 | enum target = "epparser.d"; 7 | 8 | import std.file; 9 | import std.datetime.systime; 10 | if (timeLastModified(source1) >= timeLastModified(target, SysTime.min) || 11 | timeLastModified(source2) >= timeLastModified(target, SysTime.min) || 12 | timeLastModified(__FILE__) >= timeLastModified(target, SysTime.min)) 13 | { 14 | import std.process; 15 | import std.stdio; 16 | auto args = ["rdmd", "-I" ~ opts[1], "generate.d"]; 17 | foreach (arg; args) 18 | write(arg, " "); 19 | writeln; 20 | auto dmd = execute(args); 21 | if (dmd.status != 0) 22 | { 23 | writeln("Compilation failed:\n", dmd.output); 24 | return 1; 25 | } 26 | } 27 | return 0; 28 | } -------------------------------------------------------------------------------- /source/p2d.d: -------------------------------------------------------------------------------- 1 | module p2d; 2 | 3 | import std.stdio; 4 | 5 | import epparser; 6 | import std.string: strip, stripLeft; 7 | import std.algorithm: equal; 8 | import std.uni : icmp; 9 | import std.ascii : newline; 10 | 11 | unittest // Extended Pascal comments 12 | { 13 | assert(EP.TrailingComment("(* Mixed. }\n").successful, "Mixed opening and closing comment notations."); 14 | assert(EP.InlineComment("(* Mixed. }").successful, "Mixed opening and closing comment notations, inline."); 15 | assert(EP.InlineComment("{Multi word comment.}").successful, "Multi-word comment."); 16 | assert(EP.InlineComment("{Multi line 17 | comment. With \n 18 | \"escapes\"}").successful, "Multi-line comment."); 19 | 20 | // The EP standard does not allow nested comments. 21 | assert(!EP("(* Here comes a {nested} comment.}").successful, "Comments cannot nest."); 22 | } 23 | 24 | 25 | string toD(const ref ParseTree p) 26 | { 27 | import std.container; 28 | auto imports = new RedBlackTree!string; 29 | 30 | string programName; 31 | 32 | static string escapeString(const string s) 33 | { 34 | import std.array; 35 | return s.replace("\"", "\\\""); // TODO consider translate() 36 | } 37 | 38 | static string contents(const ref ParseTree p) 39 | { 40 | return p.input[p.begin .. p.end]; 41 | } 42 | 43 | static bool childExists(const ref ParseTree p, const string name) 44 | { 45 | foreach(child; p.children) { 46 | if(equal(child.name, name) || childExists(child, name)) 47 | return true; 48 | } 49 | return false; 50 | } 51 | 52 | string parseToCode(const ref ParseTree p) 53 | { 54 | string parseChildren(const ref ParseTree p, string delegate(const ref ParseTree) parser = &parseToCode) 55 | { 56 | string result; 57 | foreach(child; p.children) // child is a ParseTree. 58 | result ~= parser(child); 59 | return result; 60 | } // parseChildren 61 | 62 | // In parseToCode. 63 | string parseDefaults(const ref ParseTree p) 64 | { 65 | import std.algorithm.searching; 66 | import std.algorithm.iteration: filter; 67 | import std.conv; 68 | switch(p.name) 69 | { 70 | case "EP._", "EP.Comment": 71 | return parseChildren(p, &parseDefaults); 72 | case "EP.TrailingComment", "EP.InlineComment": 73 | assert(p.children.length == 3); 74 | assert(equal(p.children[1].name, "EP.CommentContent")); 75 | auto contentString = contents(p.children[1]); 76 | if(equal(p.name, "EP.TrailingComment") && !canFind(contentString, "\n")) 77 | return "//" ~ contentString; // End-of-line comment. 78 | return "/*" ~ contentString ~ "*/"; // Ordinary comment. 79 | // These translate verbally 80 | case "EP.Spacing": 81 | return contents(p).filter!(a => a != '\r').to!string; // Remove '\r', is inserted depending on platform. 82 | case "fail": 83 | writeln("PARSE ERROR: " ~ p.toString); 84 | assert(0, "Parse unsuccessful"); 85 | default: 86 | if(startsWith(p.name, "Literal") || startsWith(p.name, "CILiteral")) // Disregard keywords etc. 87 | { 88 | writeln("LOG: Found literal ", contents(p)); 89 | return ""; 90 | } 91 | writeln(p.name ~ " is unhandled at ", __FILE__, ":", __LINE__); 92 | return ""; 93 | } 94 | } // parseDefaults 95 | 96 | // In parseToCode. 97 | import std.typecons: Tuple, tuple; 98 | Tuple!(string, "name", string, "matches")[] readIdentifierList(const ref ParseTree p) 99 | in { 100 | assert(p.name == "EP.IdentifierList"); 101 | } 102 | do { 103 | Tuple!(string, "name", string, "matches")[] identifiers; 104 | string name, matches; 105 | foreach (child; p.children) 106 | { 107 | switch (child.name) 108 | { 109 | case "EP.Identifier": 110 | name = contents(child); 111 | matches ~= name; 112 | break; 113 | case "EP.COMMA": 114 | identifiers ~= tuple!("name", "matches")(name, matches); 115 | matches = ""; 116 | break; 117 | default: 118 | matches ~= parseDefaults(child); 119 | } 120 | } 121 | identifiers ~= tuple!("name", "matches")(name, matches); 122 | return identifiers; 123 | } // readIdentifierList 124 | 125 | // In parseToCode. 126 | // TypeDenoter is used in TypeDefinition, (array) ComponentType, RecordSection, SchemaDefinition, VariableDeclaration 127 | // The problem is that D does not have the simple type denoter from Pascal where everything is to the right of ':' or '='. 128 | // In D the /kind/ of type (enum, class, struct) comes first, then the identifier (unless anonymous), then the definition. 129 | enum TypeDenoterKind {Alias, Enum} 130 | void readTypeDenoter(const ref ParseTree p, ref string type, ref string initialValue, ref string additional_statements, ref string annotation, ref TypeDenoterKind kind) 131 | in { 132 | assert(p.name == "EP.TypeDenoter"); 133 | } 134 | do { 135 | // In readTypeDenoter. 136 | string parseArrayType(const ref ParseTree p) 137 | in { 138 | assert(p.name == "EP.ArrayType"); 139 | } 140 | do { 141 | string lastIndex, result, component, comments; 142 | string readIndexType(const ref ParseTree p) 143 | in { 144 | assert(p.name == "EP.IndexType" || 145 | p.name == "EP.OrdinalType" || 146 | p.name == "EP.NewOrdinalType"); 147 | } 148 | do { 149 | string result; 150 | foreach (child; p.children) 151 | { 152 | switch (child.name) 153 | { 154 | case "EP.OrdinalType", "EP.NewOrdinalType": 155 | return readIndexType(child); 156 | case "EP.SubrangeType": { 157 | short boundCount = 0; 158 | foreach (subrangeChild; child.children) 159 | { 160 | final switch (subrangeChild.name) 161 | { 162 | case "EP._": 163 | result ~= strip(parseDefaults(subrangeChild)); 164 | break; 165 | case "EP.SubrangeBound": 166 | if (boundCount++ > 0) 167 | result ~= ", "; 168 | result ~= parseToCode(subrangeChild); 169 | break; 170 | } 171 | } 172 | break; 173 | } 174 | default: 175 | result ~= parseToCode(child); 176 | break; 177 | } 178 | } 179 | return result; 180 | } 181 | 182 | foreach(child; p.children) 183 | { 184 | final switch (child.name) 185 | { 186 | case "EP.IndexType": 187 | lastIndex = readIndexType(child); 188 | break; 189 | case "EP.COMMA": 190 | assert(0, "Multi-dimansional array needs work."); 191 | //if (comments.length > 0) { 192 | // lastIndex ~= " " ~ comments; 193 | // comments = ""; 194 | //} 195 | //indices ~= indices; 196 | //lastIndex = ""; 197 | //break; 198 | case "EP.ComponentType": { 199 | string ini, add, ann; 200 | TypeDenoterKind kind; 201 | assert(child.children[0].name == "EP.TypeDenoter"); 202 | readTypeDenoter(child.children[0], component, ini, add, ann, kind); 203 | // We don't really know what to do with these yet, but we probably don't need to: 204 | assert(ini.length == 0); 205 | assert(add.length == 0); 206 | assert(ann.length == 0); 207 | break; 208 | } 209 | case "EP._": 210 | comments ~= strip(parseDefaults(child)); //TODO 211 | } 212 | } 213 | imports.insert("epcompat"); 214 | return "StaticArray!(" ~ component ~ ", " ~ lastIndex ~ ")"; 215 | } // parseArrayType 216 | 217 | bool isBindable = false; 218 | kind = TypeDenoterKind.Alias; 219 | foreach (child; p.children) // Children of TypeDenoter 220 | { 221 | switch (child.name) 222 | { 223 | case "EP.BINDABLE": 224 | isBindable = true; 225 | break; 226 | case "EP.DiscriminatedSchema": { 227 | assert(child.children[0].name == "EP.SchemaName"); 228 | auto schemaname = contents(child.children[0]); 229 | import std.algorithm.searching; 230 | auto c = countUntil!"a.name == b"(child.children, "EP.ActualDiscriminantPart"); 231 | assert(c >= 0); 232 | assert(child.children[c].name == "EP.ActualDiscriminantPart"); 233 | if (icmp(schemaname, "string") == 0) { 234 | imports.insert("epcompat"); 235 | annotation = "@EPString" ~ contents(child.children[c]); 236 | type = "string"; 237 | } 238 | else if (icmp(schemaname, "shortstring") == 0) { 239 | imports.insert("epcompat"); 240 | annotation = "@EPShortString" ~ contents(child.children[c]); 241 | type = "string"; 242 | } 243 | else 244 | type ~= parseToCode(child); // Other discriminated schema. 245 | break; 246 | } 247 | case "EP.InitialStateSpecifier": 248 | initialValue ~= parseToCode(child); 249 | break; 250 | case "EP.NewType": { 251 | auto newTypeChild = child.children[0]; 252 | switch (newTypeChild.name) { 253 | case "EP.NewOrdinalType": { 254 | auto newOrdinalChild = newTypeChild.children[0]; 255 | final switch (newOrdinalChild.name) { 256 | case "EP.EnumeratedType": { 257 | kind = TypeDenoterKind.Enum; 258 | type ~= "{"; 259 | foreach (enumChild; newOrdinalChild.children) { 260 | final switch (enumChild.name) { 261 | case "EP._": 262 | type ~= strip(parseDefaults(enumChild)); 263 | break; 264 | case "EP.IdentifierList": { 265 | foreach(i, ident; readIdentifierList(enumChild)) 266 | { 267 | if (i > 0) 268 | type ~= ", "; 269 | type ~= ident.matches; 270 | } 271 | break; 272 | } 273 | } 274 | } 275 | type ~= "}"; 276 | break; 277 | } 278 | case "EP.SubrangeType": 279 | writeln(newOrdinalChild.name ~ " is unhandled at ", __FILE__, ":", __LINE__); 280 | break; 281 | } 282 | break; 283 | } 284 | case "EP.NewStructuredType": { 285 | foreach (newStructuredChild; newTypeChild.children) 286 | final switch (newStructuredChild.name) { 287 | case "EP._": 288 | type ~= strip(parseDefaults(newStructuredChild)); 289 | break; 290 | case "EP.UnpackedStructuredType": { 291 | auto unpackedStructuredChild = newStructuredChild.children[0]; 292 | final switch (unpackedStructuredChild.name) { 293 | case "EP.ArrayType": 294 | type ~= parseArrayType(unpackedStructuredChild); 295 | break; 296 | case "EP.FileType": 297 | assert(isBindable); 298 | foreach (fileChild; unpackedStructuredChild.children) 299 | final switch (fileChild.name) { 300 | case "EP._": 301 | type ~= strip(parseDefaults(fileChild)); 302 | break; 303 | case "EP.IndexType": 304 | writeln("EP.IndexType is unhandled at ", __FILE__, ":", __LINE__); 305 | break; 306 | case "EP.ComponentType": 307 | string ini, add, ann, component; 308 | TypeDenoterKind componentKind; 309 | assert(fileChild.children[0].name == "EP.TypeDenoter"); 310 | readTypeDenoter(fileChild.children[0], component, ini, add, ann, componentKind); 311 | // We don't really know what to do with these yet, but we probably don't need to: 312 | assert(ini.length == 0); 313 | assert(add.length == 0); 314 | assert(ann.length == 0); 315 | assert(componentKind == TypeDenoterKind.Alias); 316 | type ~= "Bindable!" ~ component; 317 | break; 318 | } 319 | break; 320 | case "EP.RecordType", "EP.SetType": 321 | writeln(unpackedStructuredChild.name ~ " is unhandled at ", __FILE__, ":", __LINE__); 322 | break; 323 | } 324 | } 325 | } 326 | break; 327 | } 328 | default: 329 | writeln(newTypeChild.name ~ " is unhandled at ", __FILE__, ":", __LINE__); 330 | } 331 | break; 332 | } 333 | default: 334 | type ~= parseToCode(child); 335 | break; 336 | } 337 | } 338 | } // readTypeDenoter 339 | 340 | // In parseToCode. 341 | string parseTypeDefinition(const ref ParseTree p) 342 | in { 343 | assert(p.name == "EP.TypeDefinition"); 344 | } 345 | do { 346 | string typeDefName; 347 | 348 | // Body parseTypeDefinition 349 | string comments, type, initialValue, additional_statements, annotation; 350 | TypeDenoterKind kind; 351 | foreach (child; p.children) 352 | { 353 | switch (child.name) 354 | { 355 | case "EP.BNVTypeDefName": 356 | typeDefName = contents(child); 357 | break; 358 | case "EP._": 359 | comments ~= strip(parseDefaults(child)); // TODO 360 | break; 361 | case "EP.TypeDenoter": 362 | readTypeDenoter(child, type, initialValue /*TODO*/, additional_statements, annotation, kind); 363 | break; 364 | default: 365 | assert(0); 366 | } 367 | } 368 | 369 | final switch (kind) 370 | { 371 | case TypeDenoterKind.Alias: { 372 | if (annotation.length > 0) annotation ~= " "; 373 | if (comments.length > 0) comments ~= " "; 374 | string result = annotation ~ "alias " ~ typeDefName ~ " = " ~ comments ~ type ~ ";"; 375 | return result ~ additional_statements ~ newline; 376 | } 377 | case TypeDenoterKind.Enum: { 378 | imports.insert("epcompat"); 379 | return "enum " ~ typeDefName ~ " " ~ type ~ ";" ~ newline ~ 380 | "mixin withEnum!" ~ typeDefName ~ ";"; 381 | } 382 | } 383 | } // parseTypeDefinition 384 | 385 | // In parseToCode. 386 | string parseTypeInquiry(const ref ParseTree p) 387 | in { 388 | assert(p.name == "EP.TypeInquiry"); 389 | } 390 | do { 391 | string result; 392 | foreach(child; p.children) 393 | { 394 | switch (child.name) 395 | { 396 | case "EP._": 397 | result ~= strip(parseToCode(child)); 398 | break; 399 | default: 400 | result ~= parseToCode(child); 401 | break; 402 | } 403 | } 404 | return "typeof(" ~ result ~ ")"; 405 | } // parseTypeInquiry 406 | 407 | // In parseToCode. 408 | string parseVariableDeclaration(const ref ParseTree p) 409 | in { 410 | assert(p.name == "EP.VariableDeclaration"); 411 | } 412 | do { 413 | // TODO We could keep a list of declared variables and correct any deviations of case in 414 | // subsequent uses, to convert from the case-insensitive Pascal to case-sensitive D. 415 | 416 | import std.range.primitives; 417 | string comments, type, initialValue, additional_statements, annotation; 418 | string[] variables; 419 | TypeDenoterKind kind; 420 | 421 | foreach (child; p.children) 422 | { 423 | switch (child.name) 424 | { 425 | case "EP.IdentifierList": 426 | foreach (grandchild; child.children) 427 | variables ~= parseToCode(grandchild); 428 | break; 429 | case "EP._": 430 | comments ~= strip(parseDefaults(child)); /* TODO */ 431 | break; 432 | case "EP.TypeDenoter": 433 | readTypeDenoter(child, type, initialValue, additional_statements /*TODO*/, annotation /*TODO*/, kind /*TODO*/); 434 | break; 435 | default: 436 | assert(0); 437 | } 438 | } 439 | 440 | if (!initialValue.empty) 441 | foreach (i, var; variables) 442 | variables[i] = var ~ "(" ~ initialValue ~ ")"; 443 | 444 | string result = type ~ " " ~ variables[0]; 445 | foreach (var; variables[1..$]) 446 | result ~= ", " ~ var; 447 | return result ~ ";"; 448 | } // parseVariableDeclaration 449 | 450 | // In parseToCode. 451 | string parseFormalParameterList(const ref ParseTree p) 452 | in { 453 | assert(p.name == "EP.FormalParameterList"); 454 | } 455 | do { 456 | bool first = true; 457 | string parseFormalParameterSection(const ref ParseTree p) 458 | in { 459 | assert(p.name == "EP.FormalParameterSection"); 460 | } 461 | do { 462 | string parseValueParameterSpecification(const ref ParseTree p) 463 | in { 464 | assert(p.name == "EP.ValueParameterSpecification"); 465 | } 466 | do { 467 | bool isConst = false; 468 | Tuple!(string, "name", string, "matches")[] identifiers; 469 | string result, theType, comments; 470 | foreach (child; p.children) 471 | { 472 | switch (child.name) 473 | { 474 | case "EP.PROTECTED": 475 | isConst = true; 476 | break; 477 | case "EP.IdentifierList": 478 | identifiers = readIdentifierList(child); 479 | break; 480 | case "EP.ParameterForm": 481 | theType = contents(child); 482 | break; 483 | default: 484 | comments ~= parseDefaults(child); 485 | } 486 | } 487 | foreach(i, ident; identifiers) 488 | { 489 | if (i > 0) 490 | result ~= ", "; 491 | if (isConst) 492 | result ~= "const "; 493 | result ~= theType ~ " " ~ ident.matches; 494 | } 495 | result ~= comments; 496 | return result; 497 | } // parseValueParameterSpecification 498 | 499 | string result; 500 | if (!first) 501 | result ~= ", "; 502 | first = false; 503 | switch (p.children[0].name) // FormalParameterSection has 1 child. 504 | { 505 | case "EP.ValueParameterSpecification": 506 | result ~= parseValueParameterSpecification(p.children[0]); 507 | break; 508 | default: 509 | writeln("TODO: " ~ p.children[0].name); 510 | } 511 | return result; 512 | } // parseFormalParameterSection 513 | 514 | string result; 515 | foreach (child; p.children) 516 | if (child.name == "EP.FormalParameterSection") 517 | result ~= parseFormalParameterSection(child); 518 | else 519 | result ~= parseDefaults(child); 520 | return "(" ~ result ~ ")"; 521 | } // parseFormalParameterList 522 | 523 | // In parseToCode. 524 | string parseFunctionDeclaration(const ref ParseTree p) 525 | in { 526 | assert(p.name == "EP.FunctionDeclaration"); 527 | } 528 | do { 529 | string result, name, resultVariable, resultType, block; 530 | 531 | string parseHeading(const ref ParseTree p) 532 | in { 533 | assert(p.name == "EP.FunctionHeading"); 534 | } 535 | do { 536 | string comments, heading; 537 | foreach(child; p.children[1..$]) 538 | { 539 | switch (child.name) 540 | { 541 | case "EP.Identifier": 542 | name = contents(child); 543 | heading = name; 544 | break; 545 | case "EP.FormalParameterList": 546 | heading ~= parseFormalParameterList(child); 547 | break; 548 | case "EP.ResultVariableSpecification": 549 | resultVariable = contents(child); 550 | break; 551 | case "EP.ResultType": 552 | resultType = contents(child); 553 | heading = resultType ~ " " ~ heading; 554 | break; 555 | default: 556 | comments ~= parseDefaults(child); 557 | } 558 | } 559 | heading ~= comments; 560 | return heading; 561 | } // parseHeading 562 | 563 | string parseFunctionBlockChildren(const ref ParseTree p) 564 | { 565 | if (p.name == "EP.StatementPart") { 566 | assert(p.children.length == 1 && p.children[0].name == "EP.CompoundStatement"); 567 | return parseChildren(p.children[0]); // Omits curly braces of ordinary CompoundStatement. 568 | } 569 | return parseToCode(p); 570 | } 571 | 572 | foreach (child; p.children) 573 | { 574 | switch (child.name) 575 | { 576 | case "EP.FunctionHeading": 577 | result ~= parseHeading(child); 578 | break; 579 | case "EP.FunctionBlock": 580 | assert(child.children.length == 1 && child.children[0].name == "EP.Block"); 581 | result ~= "{" ~ parseChildren(child.children[0], &parseFunctionBlockChildren) ~ "}"; 582 | break; 583 | case "EP._": 584 | result ~= parseDefaults(child); 585 | break; 586 | default: 587 | writeln(child.name ~ " is unhandled at ", __FILE__, ":", __LINE__); 588 | } 589 | } 590 | 591 | return result; 592 | } // parseFunctionDeclaration 593 | 594 | // In parseToCode. 595 | string parseForStatement(const ref ParseTree p) 596 | in { 597 | assert(p.name == "EP.ForStatement"); 598 | } 599 | do { 600 | string result = "for "; 601 | string variable; 602 | 603 | string parseSequenceIteration(const ref ParseTree iteration) 604 | { 605 | string initial_val, final_val, comment; 606 | bool increasing = true; 607 | foreach (child; iteration.children) 608 | final switch (child.name) 609 | { 610 | case "EP.InitialValue": 611 | initial_val = parseToCode(child.children[0]); 612 | break; 613 | case "EP.TO": 614 | break; 615 | case "EP.DOWNTO": 616 | increasing = false; 617 | break; 618 | case "EP.FinalValue": 619 | final_val = parseToCode(child.children[0]); 620 | break; 621 | case "EP._": 622 | comment ~= stripLeft(parseDefaults(child)); 623 | break; 624 | } 625 | return "(" ~ variable ~ " = " ~ initial_val ~ "; " ~ 626 | variable ~ (increasing ? " <= " : " >= ") ~ final_val ~ "; " ~ 627 | variable ~ (increasing ? "++" : "--") ~ ")" ~ comment; 628 | } 629 | 630 | foreach (child; p.children) 631 | final switch (child.name) 632 | { 633 | case "EP.ControlVariable": 634 | variable = contents(child); 635 | break; 636 | case "EP.IterationClause": 637 | final switch (child.children[0].name) 638 | { 639 | case "EP.SequenceIteration": 640 | result ~= parseSequenceIteration(child.children[0]); 641 | break; 642 | case "EP.SetMemberIteration": 643 | writeln(child.children[0].name ~ " is unhandled at ", __FILE__, ":", __LINE__); 644 | break; 645 | } 646 | break; 647 | case "EP.Statement": 648 | result ~= parseToCode(child); 649 | break; 650 | case "EP._": 651 | result ~= parseDefaults(child); 652 | break; 653 | } 654 | return result; 655 | } // parseForStatement 656 | 657 | // In parseToCode. 658 | string parseIfStatement(const ref ParseTree p) 659 | in { 660 | assert(p.name == "EP.IfStatement"); 661 | } 662 | do { 663 | string result; 664 | foreach (child; p.children) 665 | final switch (child.name) 666 | { 667 | case "EP.IF": 668 | result ~= "if"; 669 | break; 670 | case "EP.BooleanExpression": 671 | result ~= "(" ~ parseToCode(child) ~ ")"; 672 | break; 673 | case "EP.Statement": 674 | result ~= parseToCode(child); 675 | break; 676 | case "EP._": 677 | result ~= parseDefaults(child); 678 | break; 679 | case "EP.ELSE": 680 | result ~= "else"; 681 | break; 682 | case "EP.ElsePart": 683 | result ~= parseIfStatement(child); 684 | break; 685 | } 686 | return result; 687 | } // parseIfStatement 688 | 689 | // In parseToCode. 690 | string parseLocalSizeof(const ref ParseTree p) 691 | in { 692 | assert(p.name == "EP.LocalSizeof"); 693 | } 694 | do { 695 | string comment, subject; 696 | foreach (child; p.children) 697 | final switch (child.name) 698 | { 699 | case "EP._": 700 | comment ~= strip(parseDefaults(child)); 701 | break; 702 | case "EP.VariableAccess", 703 | "EP.TypeName": 704 | subject = contents(child); 705 | break; 706 | } 707 | return subject ~ ".sizeof" ~ comment; 708 | } // parseLocalSizeof 709 | 710 | // In parseToCode. 711 | string parseWriteParameter(const ref ParseTree p) 712 | { 713 | import std.string; 714 | string[] expressions; 715 | string comment; 716 | foreach (child; p.children) 717 | final switch (child.name) 718 | { 719 | case "EP.Expression": 720 | expressions ~= parseToCode(child); 721 | break; 722 | case "EP._": 723 | comment ~= stripLeft(parseDefaults(child)); 724 | break; 725 | } 726 | if (expressions.length == 1) { 727 | bool numeric = expressions[0].isNumeric; 728 | bool floating = numeric && expressions[0].indexOf('.') >= 0; 729 | if (floating) // default width for reals: 14 730 | return expressions[0] ~ ".format!\"%14g\""; 731 | if (numeric) // default width for integers: 6 732 | return expressions[0] ~ ".format!\"%6d\""; 733 | return expressions[0]; 734 | } 735 | if (expressions.length == 2) { 736 | if (cmp(expressions[1], "1") == 0) 737 | return expressions[0]; 738 | return expressions[0] ~ ".format!\"%" ~ expressions[1] ~ "s\""; 739 | } 740 | assert(expressions.length == 3); 741 | return expressions[0] ~ ".format!\"%" ~ expressions[1] ~ "." ~ expressions[2] ~ "g\""; 742 | } 743 | 744 | // In parseToCode. 745 | string parseMainProgramBlock(const ref ParseTree p) 746 | in { 747 | assert(p.name == "EP.MainProgramBlock" || p.name == "EP.Block"); 748 | } 749 | do { 750 | string result; 751 | foreach (child; p.children) 752 | switch (child.name) 753 | { 754 | case "EP.Block": 755 | result ~= parseMainProgramBlock(child); 756 | break; 757 | case "EP.StatementPart": 758 | // TODO check whether the return type should be void or int, depending on invocations of "return". 759 | result ~= "void main(string[] args)\n" ~ parseChildren(child); 760 | break; 761 | default: 762 | result ~= parseToCode(child); 763 | } 764 | return result; 765 | } // parseMainProgramBlock 766 | 767 | // Body parseToCode 768 | import std.range.primitives; 769 | import std.string : translate; 770 | switch(p.name) 771 | { 772 | case "EP": 773 | return parseToCode(p.children[0]); // The grammar result has only one child: the start rule's parse tree. 774 | // These just recurse into their children. 775 | case "EP.BNVCompileUnit", 776 | "EP.Program", "EP.ProgramBlock", "EP.Block", "EP.ProgramComponent", 777 | "EP.MainProgramDeclaration", "EP.ProgramHeading", 778 | "EP.StatementSequence", "EP.Statement", "EP.ProcedureStatement", 779 | "EP.WriteParameterList", 780 | "EP.WritelnParameterList", 781 | "EP.FileVariable", 782 | "EP.Expression", "EP.SimpleExpression", "EP.Term", "EP.Factor", 783 | "EP.Primary", "EP.UnsignedConstant", "EP.StringElement", 784 | "EP.TypeDefinitionPart", "EP.VariableDeclarationPart", 785 | "EP.ProcedureAndFunctionDeclarationPart", 786 | "EP.StatementPart", 787 | "EP.TypeInquiryObject", 788 | "EP.VariableName", 789 | "EP.SubrangeBound", 790 | "EP.TypeName", 791 | "EP.OrdinalTypeName", 792 | "EP.TypeIdentifier", 793 | "EP.RequiredTypeIdentifier", 794 | "EP.ConstantIdentifier", 795 | "EP.RequiredConstantIdentifier", 796 | "EP.UnsignedNumber", 797 | "EP.UnsignedInteger", 798 | "EP.ConstantDefinitionPart", 799 | "EP.StructuredStatement", 800 | "EP.RepetitiveStatement", 801 | "EP.AssignmentStatement", 802 | "EP.VariableAccess", 803 | "EP.ComponentVariable", 804 | "EP.IndexedVariable", 805 | "EP.ArrayVariable", 806 | "EP.FieldDesignator", 807 | "EP.FieldDesignatorIdentifier", 808 | "EP.IndexExpression", 809 | "EP.FunctionAccess", 810 | "EP.EntireFunctionAccess", 811 | "EP.FunctionDesignator", 812 | "EP.FunctionName", 813 | "EP.FunctionIdentifier", 814 | "EP.ActualParameterList", 815 | "EP.ActualParameter", 816 | "EP.ConditionalStatement", 817 | "EP.BooleanExpression", 818 | "EP.LocalFunctionAccess": 819 | return parseChildren(p); 820 | case "EP.MainProgramBlock": 821 | return parseMainProgramBlock(p); 822 | case "EP.BNVProgramName": 823 | programName = contents(p); 824 | return "// Program name: " ~ programName ~ "\n"; 825 | case "EP.ProgramParameterList": 826 | imports.insert("std.stdio"); 827 | return ""; 828 | case "EP.TypeDefinition": 829 | return parseTypeDefinition(p); 830 | case "EP.TypeInquiry": 831 | return parseTypeInquiry(p); 832 | case "EP.CompoundStatement": 833 | return "{" ~ parseChildren(p) ~ "}"; 834 | case "EP.SimpleStatement": 835 | if (p.children[0].name == "EP.EmptyStatement") 836 | return ""; 837 | return parseChildren(p) ~ ";"; 838 | case "EP.CharacterString": 839 | string result; 840 | foreach(child; p.children) 841 | result ~= parseToCode(child); 842 | return "\"" ~ escapeString(result) ~ "\""; 843 | case "EP.ApostropheImage": 844 | return "'"; 845 | case "EP.WriteParameter": 846 | return parseWriteParameter(p); 847 | case "EP.DiscriminatedSchema": 848 | { 849 | assert(icmp(contents(p.children[0]), "string") != 0, "string schema should have been handled in readTypeDenoter"); 850 | writeln("generic " ~ p.name ~ " is unhandled at ", __FILE__, ":", __LINE__); 851 | return ""; 852 | } 853 | case "EP.VariableDeclaration": 854 | return parseVariableDeclaration(p); 855 | case "EP.FunctionDeclaration": 856 | return parseFunctionDeclaration(p); 857 | case "EP.ForStatement": 858 | return parseForStatement(p); 859 | case "EP.IfStatement": 860 | return parseIfStatement(p); 861 | case "literal!(\":=\")": 862 | return "="; 863 | case "EP.LocalSizeof": 864 | return parseLocalSizeof(p); 865 | 866 | // These translate verbally 867 | case "EP.ProcedureName", 868 | "EP.StringCharacter", 869 | "EP.Identifier", 870 | "EP.ParameterIdentifier", 871 | "EP.ImportedInterfaceIdentifier", 872 | "EP.DOT", 873 | "EP.DigitSequence", 874 | "literal!(\",\")", 875 | "literal!(\"(\")", 876 | "literal!(\")\")", 877 | "literal!(\"[\")", 878 | "literal!(\"]\")": 879 | return contents(p); 880 | 881 | // These are ignored 882 | case "EP.PROGRAM", "EP.BEGIN", "EP.END", "EP.EmptyStatement": 883 | return ""; 884 | 885 | // Required procedures 886 | case "EP.WRITE": 887 | return "epcompat.write"; 888 | case "EP.WRITELN": 889 | return "writeln"; 890 | 891 | // Required simple type identifiers 892 | case "EP.INTEGER": return "int"; 893 | case "EP.REAL": return "double"; 894 | case "EP.BOOLEAN": return "bool"; 895 | case "EP.CHAR": return "char"; 896 | case "EP.COMPLEX": 897 | writeln(p.name ~ " is unhandled at ", __FILE__, ":", __LINE__); 898 | return ""; 899 | 900 | // Required constant identifiers 901 | case "EP.MAXINT": return "int.max"; 902 | case "EP.MINREAL": return "double.min_normal"; 903 | case "EP.MAXREAL": return "double.max"; 904 | case "EP.EPSREAL": return "double.epsilon"; 905 | case "EP.FALSE": return "false"; 906 | case "EP.TRUE": return "true"; 907 | case "EP.MINCHAR": return "char.min"; 908 | case "EP.MAXCHAR": return "char.max"; 909 | 910 | default: 911 | return parseDefaults(p); 912 | } 913 | } // parseToCode 914 | 915 | // body toD 916 | 917 | auto code = parseToCode(p); 918 | 919 | string importDeclaration; 920 | foreach(imp; imports[]) { 921 | importDeclaration ~= "import " ~ imp ~ ";\n"; 922 | } 923 | 924 | return importDeclaration ~ "\n" ~ code; 925 | } // toD 926 | 927 | 928 | unittest { 929 | string input = 930 | `program MyTest(output); 931 | 932 | begin 933 | writeln('Hello D''s "World"!'); 934 | end. 935 | `; 936 | /+ 937 | import std.experimental.logger; 938 | sharedLog = new FileLogger("TraceLog.txt", LogLevel.all); 939 | bool cond (string ruleName) 940 | { 941 | return (ruleName.startsWith("EP") && !ruleName.startsWith("EP.Literal")); 942 | } 943 | setTraceConditionFunction(&cond); 944 | /*setTraceConditionFunction(ruleName => ruleName.startsWith("EP"));*/ 945 | /*traceAll;*/ 946 | +/ 947 | auto parsed = EP(input); 948 | assert(__traits(compiles, toD(parsed))); 949 | } 950 | --------------------------------------------------------------------------------