├── .github └── workflows │ ├── csharp.yml │ ├── fsharp.yml │ ├── golang.yml │ └── ruby.yml ├── .gitignore ├── README.adoc ├── c ├── COPYING ├── crscl.c └── crscl.h ├── common-lisp └── pose.lisp ├── csharp ├── .gitignore ├── Pose.sln ├── src │ └── Pose │ │ ├── Pose.cs │ │ └── Pose.csproj └── tests │ └── Tests │ ├── PoseReaderTests.cs │ └── Tests.csproj ├── emacs-lisp └── pose.el ├── examples ├── hello.pose ├── numbers-and-symbols.pose ├── srfi.pose └── test │ ├── comment.pose │ ├── comment.result │ ├── decimal.pose │ ├── decimal.result │ ├── empty-list.pose │ ├── empty-list.result │ ├── integer.pose │ ├── integer.result │ ├── list-one-int.pose │ ├── list-one-int.result │ ├── list-within-list.pose │ ├── list-within-list.result │ ├── negative-decimal.pose │ ├── negative-decimal.result │ ├── negative-integer.pose │ ├── negative-integer.result │ ├── small-decimal.pose │ ├── small-decimal.result │ ├── small-negative-decimal.pose │ ├── small-negative-decimal.result │ ├── string-with-escape.pose │ ├── string-with-escape.result │ ├── symbol.pose │ ├── symbol.result │ ├── unicode-string.pose │ └── unicode-string.result ├── fsharp ├── .gitignore ├── Pose.sln ├── README.md ├── src │ └── Pose │ │ ├── Library.fs │ │ ├── Pose.fsproj │ │ └── pose.fsx └── tests │ └── Tests │ ├── Program.fs │ ├── Tests.fs │ └── Tests.fsproj ├── go ├── go.mod ├── pose.go └── pose_test.go ├── python ├── .gitignore ├── LICENSE ├── README.md ├── pyproject.toml ├── src │ └── pose_expr │ │ ├── __init__.py │ │ ├── reader.py │ │ └── writer.py └── tests │ └── tests.py ├── ruby ├── Gemfile ├── Gemfile.lock ├── Rakefile ├── pose.gemspec ├── pose.rb └── spec │ └── pose_spec.rb ├── scheme ├── pose.scm ├── pose.sld ├── pose.sls ├── test6.scm └── test7.scm ├── standard-ml └── pose.sml └── symbol.text /.github/workflows/csharp.yml: -------------------------------------------------------------------------------- 1 | name: dotnet C# 2 | 3 | on: 4 | push: 5 | paths: 6 | - 'csharp/**' 7 | pull_request: 8 | paths: 9 | - 'csharp/**' 10 | 11 | env: 12 | # Path to the solution file relative to the root of the project. 13 | SOLUTION_FILE_PATH: csharp 14 | 15 | 16 | jobs: 17 | build: 18 | runs-on: ubuntu-latest 19 | 20 | steps: 21 | - uses: actions/checkout@v2 22 | 23 | - name: Setup .NET Core 24 | uses: actions/setup-dotnet@v1 25 | with: 26 | dotnet-version: 5.0.100 27 | 28 | - name: Restore NuGet packages 29 | working-directory: ${{env.SOLUTION_FILE_PATH}} 30 | run: dotnet restore 31 | 32 | - name: Test 33 | working-directory: ${{env.SOLUTION_FILE_PATH}} 34 | run: dotnet test 35 | -------------------------------------------------------------------------------- /.github/workflows/fsharp.yml: -------------------------------------------------------------------------------- 1 | name: dotnet F# 2 | 3 | on: 4 | push: 5 | paths: 6 | - 'fsharp/**' 7 | pull_request: 8 | paths: 9 | - 'fsharp/**' 10 | 11 | env: 12 | # Path to the solution file relative to the root of the project. 13 | SOLUTION_FILE_PATH: fsharp 14 | 15 | 16 | jobs: 17 | build: 18 | runs-on: ubuntu-latest 19 | 20 | steps: 21 | - uses: actions/checkout@v2 22 | 23 | - name: Setup .NET Core 24 | uses: actions/setup-dotnet@v1 25 | with: 26 | dotnet-version: 5.0.100 27 | 28 | - name: Restore NuGet packages 29 | working-directory: ${{env.SOLUTION_FILE_PATH}} 30 | run: dotnet restore 31 | 32 | - name: Test 33 | working-directory: ${{env.SOLUTION_FILE_PATH}} 34 | run: dotnet test 35 | -------------------------------------------------------------------------------- /.github/workflows/golang.yml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | paths: 4 | - 'go/**' 5 | pull_request: 6 | paths: 7 | - 'go/**' 8 | 9 | name: GoLang 10 | env: 11 | # Where the project is located 12 | FILE_PATH: go 13 | 14 | jobs: 15 | test: 16 | strategy: 17 | matrix: 18 | go-version: [1.15.x, 1.16.x] 19 | os: [ubuntu-latest, macos-latest, windows-latest] 20 | runs-on: ${{ matrix.os }} 21 | steps: 22 | - name: Install Go 23 | uses: actions/setup-go@v2 24 | with: 25 | go-version: ${{ matrix.go-version }} 26 | - name: Checkout code 27 | uses: actions/checkout@v2 28 | - name: Test 29 | run: go test ./... 30 | working-directory: ${{env.FILE_PATH}} 31 | 32 | 33 | test-cache: 34 | runs-on: ubuntu-latest 35 | steps: 36 | - name: Install Go 37 | uses: actions/setup-go@v2 38 | with: 39 | go-version: 1.16.x 40 | - name: Checkout code 41 | uses: actions/checkout@v2 42 | - uses: actions/cache@v2 43 | with: 44 | # In order: 45 | # * Module download cache 46 | # * Build cache (Linux) 47 | # * Build cache (Mac) 48 | # * Build cache (Windows) 49 | path: | 50 | ~/go/pkg/mod 51 | ~/.cache/go-build 52 | ~/Library/Caches/go-build 53 | %LocalAppData%\go-build 54 | key: ${{ runner.os }}-go-${{ hashFiles('**/go.sum') }} 55 | restore-keys: | 56 | ${{ runner.os }}-go- 57 | - name: Test 58 | working-directory: ${{env.FILE_PATH}} 59 | run: go test ./... -------------------------------------------------------------------------------- /.github/workflows/ruby.yml: -------------------------------------------------------------------------------- 1 | # This workflow uses actions that are not certified by GitHub. 2 | # They are provided by a third-party and are governed by 3 | # separate terms of service, privacy policy, and support 4 | # documentation. 5 | # This workflow will download a prebuilt Ruby version, install dependencies and run tests with Rake 6 | # For more information see: https://github.com/marketplace/actions/setup-ruby-jruby-and-truffleruby 7 | 8 | name: Ruby 9 | 10 | env: 11 | # Path to the solution file relative to the root of the project. 12 | FILE_PATH: ruby 13 | 14 | on: 15 | push: 16 | paths: 17 | - 'ruby/**' 18 | pull_request: 19 | paths: 20 | - 'ruby/**' 21 | 22 | jobs: 23 | test: 24 | 25 | runs-on: ubuntu-latest 26 | strategy: 27 | matrix: 28 | ruby-version: ['2.6', '2.7', '3.0'] 29 | 30 | steps: 31 | - uses: actions/checkout@v2 32 | - name: Set up Ruby 33 | # To automatically get bug fixes and new Ruby versions for ruby/setup-ruby, 34 | # change this to (see https://github.com/ruby/setup-ruby#versioning): 35 | # uses: ruby/setup-ruby@v1 36 | uses: ruby/setup-ruby@473e4d8fe5dd94ee328fdfca9f8c9c7afc9dae5e 37 | with: 38 | ruby-version: ${{ matrix.ruby-version }} 39 | bundler-cache: true # runs 'bundle install' and caches installed gems automatically 40 | working-directory: ${{env.FILE_PATH}} 41 | - name: Run tests 42 | working-directory: ${{env.FILE_PATH}} 43 | run: bundle exec rake 44 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.*fsl 2 | *.elc 3 | *.fas 4 | *.fasl 5 | *.html 6 | *.lib 7 | -------------------------------------------------------------------------------- /README.adoc: -------------------------------------------------------------------------------- 1 | # Portable S-expressions (POSE) 2 | :toc: left 3 | 4 | ## Abstract 5 | 6 | S-expressions, short for _symbolic expressions_, are the syntactic 7 | backbone of the Lisp programming language family. While each dialect 8 | uses a slightly different variant for its native syntax, there is 9 | broad agreement on the fundamentals. This document gives a precise 10 | specification and a rationale for a syntax that is close to a least 11 | common denominator. 12 | 13 | Such a pidgin syntax is appropriate for the interchange of data files 14 | across language boundaries. It is also fit for code written in some of 15 | the kind of domain-specific languages that Lisp handles well. 16 | 17 | The proposed syntax is simple to implement in full. A reader is about 18 | 200 lines of code in a typical high-level language. The authors hope 19 | this will encourage the use of S-expressions beyond the Lisp 20 | community. 21 | 22 | ## Rationale 23 | 24 | ### The origin of S-expressions 25 | 26 | S-expressions first appeared in the paper that introduced the Lisp 27 | programming language, _Recursive Functions of Symbolic Expressions and 28 | Their Computation by Machine_ (McCarthy 1960). The expressions in that 29 | paper were made out of symbols and nested lists. 30 | 31 | This seminal form of S-expressions has since been extended with syntax 32 | for additional data types. Among them are numbers, strings, boolean 33 | values, sets, and maps (also known as hash tables or dictionaries). 34 | The ability to write comments has also been added. 35 | 36 | ### Data types 37 | 38 | In designing a portable S-expression syntax, the first decision is 39 | which data types to support. 40 | 41 | Lisp would lose its essence without the lists and symbols from 42 | McCarthy's paper. Any variant of S-expressions needs them. 43 | 44 | Numbers and strings are essential for practical use. 45 | 46 | Booleans are essential, but there is little agreement on how to 47 | represent them. 48 | 49 | Beyond lists, other collection types such as vectors, sets, maps, and 50 | user-defined record types, are omitted. 51 | 52 | Likewise, we omit explicit support for specialized data such as 53 | timestamps, units of measure, and file system pathnames. Values of 54 | these types are subject to so many idiosyncratic and changing rules 55 | that it's difficult to strike a balance between being comprehensive 56 | and being useful. 57 | 58 | ### Lists and vectors 59 | 60 | In everyday usage, the English word _list_ means any sequence of 61 | elements. Programmers define lists with mathematical precision: 62 | zero-element, one-element, and two-element lists still count as lists. 63 | 64 | The custom in Lisp is to implement a list as a _singly linked list_. 65 | This custom carries over to most functional programming languages. 66 | These languages use the word _vector_ for sequences (implemented using 67 | arrays or trees) supporting faster than O(n) random access, and 68 | reserve the word _list_ for O(n) linked lists. 69 | 70 | A linked list is a sequence of pairs where the first part of each pair 71 | contains a list element, and the second part points to the next pair. 72 | (In the last pair of the list, the second part is **nil**.) In 73 | statically typed functional languages this rule is enforced by the 74 | type system. In Lisp the rule is merely a convention, and each part of 75 | a pair can actually point to any type of object. That relaxation of 76 | the rule gives rise to the following special cases: 77 | 78 | * It's possible to construct a list where the second part of the last 79 | pair is neither a pair nor **nil**. In Lisp, we call such lists 80 | _dotted lists_, and the last (possibly the only) pair is a _dotted 81 | pair_. 82 | 83 | * When pairs are mutable, it's possible to construct a never-ending 84 | _circular list_ by making the second part of the last pair point 85 | back to an earlier pair in the list. Usually the last pair points 86 | back to the first pair, but it's possible for a list to start with a 87 | non-circular prefix which leads to a circular sublist. 88 | 89 | * Multiple lists can share sublists, and trees build out of pairs can 90 | share subtrees. Multiple pairs can point to the same pair in their 91 | second part. 92 | 93 | A notation supporting these special cases needs two notational aids: 94 | 95 | * A _consing dot_ that can be put before the final element of the list 96 | to make a dotted pair. 97 | 98 | * A syntax for _labels_ and _references_ to describe shared structure. 99 | 100 | We choose not to include either of those in POSE. Most languages 101 | outside of functional programming use vectors for their most idiomatic 102 | list-like data type, and even functional programming langauges forbid 103 | dotted pairs. We can also envision a future Lisp dialect where vectors 104 | (instead of lists) are the basic sequence type. In the interest of 105 | easier portability to all of these languages, it is better to avoid 106 | the special cases. A proper list like `(1 2 3)` is also easy for 107 | non-lispers to read and write without special instruction. 108 | 109 | One more restriction that statically typed languages have is that list 110 | elements all need to be of the same type. Since this is a semantic 111 | concern, not a syntax concern, we permit heterogeneous lists like Lisp 112 | and other dynamically languages do. In statically typed languages, a 113 | parser can be implemented by using a union type to cover the range of 114 | data types that can appear in S-expressions. 115 | 116 | ### Numbers 117 | 118 | Lisp dialects have traditionally supported an especially large variety 119 | of numbers, made the usage convenient, and specified numerical results 120 | quite precisely. In Lisp tradition, a full _numeric tower_ is: 121 | 122 | * Integer (negative and nonnegative, arbitrarily large magnitude). 123 | * Ratio of two integers. 124 | * Real number (implemented as floating point). 125 | * Complex number. 126 | 127 | Not all programming languages have complex numbers, and fewer still 128 | have ratios, making them problematic in a portable notation. Hence we 129 | stick to integers and floating point numbers in POSE. 130 | 131 | Lisp dialects tend to transparently switch numbers between 132 | machine-word size _fixnums_ to larger _bignums_ as required. There is 133 | no special syntax for bignums. Clojure breaks with Lisp tradition here 134 | by having a syntactic suffix for bignums. POSE sticks to tradition, 135 | and does not distinguish bignums and fixnums. 136 | 137 | Clojure adds another peculiarity to Lisp's traditionally clean number 138 | syntax: a leading zero causes a number to be interpreted in octal 139 | (base 8). This feature is borrowed from the C family, is a common 140 | source of confusion, and we argue that it is best avoided. However, it 141 | does s place a prerogative on the designer of a portable syntax to 142 | forbid leading zeros in order to avoid the ambiguity. 143 | 144 | Some Lisp implementations permit putting underscores between groups of 145 | digits for readability. This is convenient but not yet common, so we 146 | omit this feature from POSE. 147 | 148 | ### Symbols, strings, characters, and byte vectors 149 | 150 | Symbols and strings are two very similar data types that Lisp has long 151 | held separate. The name of a symbol is a string, but the symbol itself 152 | is not a string. The name has to be deliberately extracted in order to 153 | be handled as a string. In Common Lisp this is done by `symbol-name`, 154 | in Scheme by `symbol\->string`. 155 | 156 | Lisp started out with only symbols due to its origins in abstract 157 | computer science. Strings were added later. Most languages do not have 158 | a standard mapping from source code to the data structures in the 159 | language, and do not need a standard symbol type for that reason. All 160 | Lisp programs have a standard mapping to Lisp data, and symbols are 161 | the data type that corresponds to identifiers in Lisp programs. 162 | 163 | In Lisp, strings are used for most user-defined data. Lispers 164 | continually entertain the thought of merging symbols and strings into 165 | one data type but it won't work out. Both types are needed. 166 | 167 | Many Lisp dialects also have a character data type that is disjoint 168 | from the string and integer types. In Common Lisp and Scheme this is 169 | written as `#\a #\A #\space`. Since dialects are not unanimous in 170 | having a character type, and Unicode makes the concept of a character 171 | somewhat dubious, we omit the syntax from POSE. 172 | 173 | ### Case sensitivity in symbols 174 | 175 | For a long time, there has been a debate over whether Lisp symbols 176 | should be case-sensitive or case-insensitive. 177 | (Strings are always case sensitive for obvious reasons; there is no 178 | debate in the community about them.) Lisp is old enough that 179 | symbols used to be written in uppercase. When the Common Lisp standard 180 | came around, it dictated that lowercase or mixed-case symbols shall be 181 | normalized to uppercase equivalents when read in, with a reader option 182 | to change this behavior. Scheme has not traditionally dictated symbol 183 | case, but lowercase is the default starting with R^6^RS (2007). Almost 184 | all Scheme implementations are now case sensitive by default, and use 185 | lowercase. 186 | 187 | There is a clear long-term trend among programming languages that 188 | case sensitivity is winning, and more and more Lisp dialects and 189 | implementations are following suit. However, 190 | since most data is sent using lower case symbols anyway, 191 | and a case-insensitive recipient will throw away 192 | the difference between `foo`, `Foo`, and `FOO` 193 | if the native `read` procedure is used, POSE 194 | restricts letters in symbols to ASCII lower case only. 195 | 196 | ### Symbol packages, identifiers, and keywords 197 | 198 | Common Lisp puts symbols in packages; a symbol has two parts: the 199 | package name and the symbol name. These are separated by a colon as in 200 | `package:symbol`. If the colon is missing, the symbol is interned in 201 | the current package. If the colon is present but the package name is 202 | blank, the symbol is interned in the `KEYWORD` package. Symbols in 203 | this package are commonly known as keywords. A keyword is very much 204 | like an ordinary symbol but tends to serve as a special syntactic 205 | marker for things like named arguments in a function call. 206 | 207 | Many Lisp implementations outside of Common Lisp also have keywords, 208 | but it varies whether they are a kind of symbol or a disjoint 209 | datatype. 210 | 211 | Scheme syntax talks about identifiers instead of symbols. The 212 | distinction is important for hygienic macros, but is not important 213 | when dealing only with surface syntax, so we ignore identifiers here. 214 | 215 | POSE symbols do not have package names, only symbol names. POSE does 216 | not have keywords. In order to avoid problems with Common Lisp, POSE 217 | does not permit the traditional package marker `:` within symbol names. 218 | 219 | However, `:` is permitted at the beginning of a symbol for pragmatic 220 | reasons: it is very common to use keywords in Common Lisp data files 221 | to avoid dropping them into a random package when they are read. 222 | However, a single `:` is not a POSE symbol, nor is a token beginning 223 | with more than one `:`. POSE doesn't care if a symbol starts with `:` 224 | or not, as long as `:foo` is distinct from `foo`. 225 | 226 | Clojure uses the slash `/` as package name delimiter, and permits only 227 | one slash to appear in a symbol. We judge that this is too extreme a 228 | deviation from Lisp tradition, and POSE freely permits `/` in symbols. 229 | 230 | ### Distinguishing numbers from symbols 231 | 232 | The traditional way to parse Lisp is to start by treating a symbol and 233 | a number as the same type of token, and reserve a bunch of characters 234 | that may appear in such tokens. Each contiguous sequence of these 235 | characters is read as one token. The parser then tries to interpret 236 | the token as a number. If it succeeds, the token becomes that number. 237 | If it fails, the token becomes a symbol. 238 | 239 | For portable data, that has the unfortunate side effect that the same 240 | token that parses as a symbol in one Lisp dialect can parse as a 241 | number in another. 242 | 243 | For example, consider the standard functions to increment and 244 | decrement a number. In Common Lisp they are called by the symbols `1+` 245 | and `1-`. Standard Scheme would try and fail to interpret those tokens 246 | as numbers. MIT Scheme uses `1+` and `-1+` equivalent to `1-`. Clojure 247 | cannot read any of the preceding tokens as symbols, opting to spell 248 | out the names `inc` and `dec` instead. 249 | 250 | In POSE we use the following rule: 251 | 252 | * Any token starting with a digit `0..9` must be a valid number. 253 | 254 | * Any token starting with either `+` or `-` followed by a digit must 255 | be a valid number. 256 | 257 | * Any other token is a symbol. 258 | 259 | ### Booleans, nil, and the empty list 260 | 261 | Lisp dialects have a famous ambiguity involving `nil`. Two parentheses 262 | `()` are used to write an empty list. In many dialects an empty list 263 | is equivalent to the symbol `nil`. `nil` further doubles as the 264 | boolean value false, and a non-`nil` object stands for boolean true. 265 | Traditionally the symbol `t` is reserved as the default choice for a 266 | true object. 267 | 268 | The above conventions are arguably a bit of a hack, and there are 269 | dialects that disagree with all of them. This makes it tricky to 270 | standardize booleans in a portable notation. 271 | 272 | The following table shows what different dialects do: 273 | 274 | |=== 275 | |Common Lisp |`t` |`nil` 276 | |Emacs Lisp |`t` |`nil` 277 | |Autolisp |`t` |`nil` 278 | |Picolisp |`t` |`nil` 279 | |Newlisp |`true` |`nil` 280 | |Clojure / EDN |`true` |`false` 281 | |Lisp Flavored Erlang |`true` |`false` 282 | |Janet |`true` |`false` 283 | |Fennel |`true` |`false` 284 | |Urn |`true` |`false` 285 | |Hy |`True` |`False` 286 | |Scheme (R7RS alternative) |`#true` |`#false` 287 | |Scheme |`#t` |`#f` 288 | |=== 289 | 290 | The least ambiguous choice is by Scheme: `#t` and `#f` are the two 291 | values of a disjoint boolean data type; `()` is the empty list; and 292 | the symbols `nil` and `t` have no special meaning. We could use these 293 | conventions in a portable notation, but that would still leave an 294 | ambiguity in how to read it into Lisp dialects that conflate `nil` and 295 | `()` as the same object. 296 | 297 | We choose to dodge the issue in POSE by not saying anything about 298 | boolean values. Going by the above survey, the symbols `true`/`false` 299 | or `t`/`f` would make for a reasonable convention to represent 300 | booleans, but this is non-normative. 301 | 302 | ### Sets and maps 303 | 304 | POSE does not have sets or maps. Most substantial Lisp implementations 305 | have maps or hash-tables, but there is no standard read syntax for 306 | them. A set data type is not a de facto standard. Both sets and maps 307 | can be simulated with lists. 308 | 309 | ## Specification 310 | 311 | ### File name extension 312 | 313 | The suggested extension for a POSE file is `.pose`. This appears to be 314 | unused by any common program. 315 | 316 | ### MIME type 317 | 318 | The tentative plan is to register the internet media type `text/pose` 319 | with IANA. In the meantime, `text/x-pose` is suggested. 320 | 321 | ### Grammar 322 | 323 | ---- 324 | expressions = (atmosphere* expression)* atmosphere* 325 | 326 | atmosphere = whitespace | comment 327 | whitespace = HT | VT | FF | space | newline 328 | newline = CR | LF 329 | comment = ';' and all subsequent characters until newline or eof 330 | 331 | expression = list | string | number | symbol 332 | 333 | list = '(' expressions ')' 334 | 335 | string = '"' string-char* '"' 336 | string-char = string-esc | any-char-except-backslash 337 | string-esc = \\ | \" 338 | 339 | number = integer fraction exponent 340 | integer = minus? digit | minus? onenine digits 341 | digits = digit digits? 342 | fraction = "" | '.' digits 343 | exponent = "" | echar sign? digits 344 | 345 | symbol = wordsym | signsym | colonsym 346 | wordsym = wordsym-1st wordsym-cont* 347 | wordsym-1st = letter | punct-1st 348 | wordsym-cont = letter | punct-cont | digit 349 | signsym = sign signsym-rest? 350 | signsym-rest = signsym-2nd signsym-cont* 351 | signsym-2nd = letter | punct-cont 352 | signsym-cont = letter | punct-cont | digit 353 | colonsym = ':' wordsym 354 | punct-1st = '!' | '$' | '&' | '*' | '+' | '-' | '/' | '<' | '=' | '>' | '_' 355 | punct-cont = punct-1st | '.' | '?' | '@' 356 | 357 | letter = a-z 358 | digit = 0-9 359 | onenine = 1-9 360 | minus = '-' 361 | sign = '-' | '+' 362 | echar = 'e' | 'E' 363 | ---- 364 | 365 | ## Examples 366 | 367 | ---- 368 | ; comment 369 | ---- 370 | 371 | ---- 372 | () 373 | (1) 374 | (1 2) 375 | (1 2 3) 376 | (1 2 (3 (4)) 5) 377 | ---- 378 | 379 | ---- 380 | foo-bar 381 | ---- 382 | 383 | ---- 384 | "foo bar" 385 | "foo \\bar \" baz" 386 | ---- 387 | 388 | ---- 389 | 123 -123 leading zero not permitted 390 | 0.123 -0.123 zero required before the dot 391 | 123.45 -123.45 392 | ---- 393 | -------------------------------------------------------------------------------- /c/COPYING: -------------------------------------------------------------------------------- 1 | Copyright (c) 2006-2021 Marco Antoniotti, 2 | Dipartimento di Infromatica, Sistemistica e Comunicazioni, 3 | Universita` degli Studi di Milano-Bicocca, 4 | Milan, Italy 5 | 6 | Permission is hereby granted, without written agreement and without 7 | license or royalty fees, to use, copy, modify, and distribute this 8 | software and its documentation for any purpose, provided that the 9 | above copyright notice, those below and the following two 10 | paragraphs appear in all copies of this software. 11 | 12 | IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE TO ANY PARTY FOR DIRECT, 13 | INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF 14 | THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR(S), 15 | HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 16 | 17 | THE AUTHOR(S) UNIVERSITY, COMPANY AND/OR AFFILIATION SPECIFICALLY 18 | DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 20 | PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND 21 | THE AUTHOR(S) HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, 22 | UPDATES, ENHANCEMENTS, OR MODIFICATIONS. 23 | -------------------------------------------------------------------------------- /c/crscl.c: -------------------------------------------------------------------------------- 1 | /* -*- Mode: C -*- */ 2 | 3 | 4 | /* crscl.h -- "Contains a Reimplementation of a Subset of Common Lisp" 5 | * 6 | * This library contains a minimal reader sor a Lisp language. The 7 | * language is a subset of Common Lisp (sans READER-MACRO). 8 | */ 9 | 10 | /* Please see the file COPYING for licensing details. */ 11 | 12 | /* History: 13 | * 14 | * 2010 - Resurrected and updated. 15 | * 16 | * 2001 - ConVEX and VAL are complex system, hence they must contain a 17 | * buggy reimplementation of a subset of Common Lisp. 18 | * 19 | * 2000-08-19 Marco Antoniotti 20 | * The file (originally named 'lisp.h') comes from Berkeley and was 21 | * part of the SHIFT system (another "complex" system). It has not 22 | * changed much and the Berkeley Copyright must remain. 23 | * 24 | * 1996- This file is part of the SHIFT compiler. 25 | * 26 | * Originally written by Edward Wang (edward@edcom.com) 27 | * Modified 1995-96 by Luigi Semenzato, Berkeley PATH 28 | * luigi@fiat.its.berkeley.edu 29 | * January 1996 30 | */ 31 | 32 | #ifndef _CRSCL_LISP_I 33 | #define _CRSCL_LISP_I 34 | 35 | 36 | #include 37 | #include 38 | #include 39 | #include 40 | #include 41 | #include 42 | #include 43 | 44 | #ifndef WIN32 45 | #include 46 | #endif 47 | 48 | /* Added for character conversion 49 | * routines. 50 | */ 51 | #include 52 | 53 | #include "crscl.h" /* Was #include "lisp.h" */ 54 | 55 | 56 | /* shtab -- Symbol table support. */ 57 | 58 | #define L_HBITS 11 59 | #define L_HSHIFT 3 60 | #define L_HSIZE (1 << L_HBITS) 61 | #define L_HMASK (L_HSIZE - 1) 62 | 63 | lv* shtab[L_HSIZE]; 64 | 65 | 66 | /* List all the interface functions */ 67 | 68 | lv *intern(char *); 69 | int shash(char *); 70 | int crscl_table_size(); 71 | void clear_crscl_tables(); 72 | 73 | lv *read_sexpr(char *); 74 | lv *read_sexpr1(rs *); 75 | 76 | rs *make_stream(char *str, readstream_kind typ); 77 | inline rs *make_stream_stream(FILE *str); 78 | inline rs *make_string_stream(char *str); 79 | inline int stream_stream_p(rs *); 80 | inline int string_stream_p(rs *); 81 | inline void close_stream(rs *stream); 82 | 83 | lv *read_sexpr_list(rs *); 84 | lv *list_to_attrs(lv *); 85 | lv *read_sexpr_string(rs *); 86 | lv *read_sexpr_symbol(rs *); 87 | lv *read_sexpr_atom(rs *); 88 | lv *read_c_symbol(rs *); 89 | 90 | int write_sexpr(lv *, char *); 91 | void print(lv *); 92 | void write_sexpr1(lv *, FILE *); 93 | 94 | inline _Bool null(lv *); 95 | inline lv *cons(lv *, lv *); 96 | 97 | lv *string(const char *); 98 | lv *stringl(char *, int); 99 | inline lv *fixnum(int); 100 | inline lv *double_float(double); 101 | lv *symbol(char *); 102 | lv *node(lv *, lv *, lv *); 103 | lv *attr(lv *, lv *); 104 | #define attr2(a1, a2, n) attr(a1, attr(a2, n)) 105 | #define attr3(a1, a2, a3, n) attr2(a1, a2, attr(a3, n)) 106 | void set_attr(lv *attr, lv *node, lv *value); 107 | void push_attr(lv *attr, lv *node, lv *value); 108 | lv *other(void *x); 109 | lv *assoc(lv *, lv *); 110 | int length(lv *); 111 | lv *nth(int, lv *); 112 | lv *nthcdr(int, lv *); 113 | 114 | lv* getf(lv* plist, lv* indicator); 115 | lv* getf1(lv* plist, lv* indicator, lv* default_value); 116 | lv* plist_get(lv* sym, lv* indicator); 117 | lv* setf_get(lv* sym, lv* indicator, lv* value); 118 | 119 | lv *list(lv *, ...); 120 | lv *copy_tree(lv *); 121 | lv *copy_list(lv *); 122 | lv *nreverse(lv *); 123 | lv *nreverse2(lv *, lv *); 124 | lv *nconc(lv *, lv *); 125 | lv *append(lv *, lv *); 126 | lv *del_el(lv *, lv *); 127 | lv *mapcar(lv *(*)(lv *), lv *); 128 | lv *mapcarx(lv *(*)(), lv *, lv *); 129 | lv *mapcan(lv *(*)(lv *), lv *); 130 | void mapc(void (*)(lv *), lv *); 131 | void mapcx(void (*)(lv *, lv*), lv *, lv *); 132 | lv *member_op(lv *, lv *); 133 | lv *memq(lv *, lv *); 134 | lv *lalloc(void); 135 | void gc_set_root(lv *); 136 | void gc_clear_root(void); 137 | void gc(); 138 | void new_node_marker(); 139 | void mark_node(lv* node); 140 | int node_marked_p(lv* node); 141 | 142 | 143 | /* Internal functions. */ 144 | 145 | static void* 146 | crscl_malloc(size_t size, int errorp) 147 | { 148 | void* chunk = malloc(size); 149 | 150 | if (chunk != NULL) 151 | { 152 | return chunk; 153 | } 154 | else if (errorp) 155 | { 156 | fputs("CRSCL: error: unable to allocate memory.\n", stderr); 157 | fflush(stderr); 158 | exit(-1); 159 | } 160 | else 161 | { 162 | fputs("CRSCL: warning: unable to allocate memory.\n", stderr); 163 | fflush(stderr); 164 | return (void *) 0; 165 | } 166 | } 167 | 168 | static void* 169 | crscl_realloc(void* ptr, size_t size, int errorp) 170 | { 171 | void* chunk = realloc(ptr, size); 172 | 173 | if (chunk != NULL) 174 | return chunk; 175 | else if (errorp) 176 | { 177 | fputs("CRSCL: error: unable to reallocate memory.\n", stderr); 178 | fflush(stderr); 179 | exit(-1); 180 | } 181 | else 182 | { 183 | fputs("CRSCL: warning: unable to reallocate memory.\n", stderr); 184 | fflush(stderr); 185 | return (void *) 0; 186 | } 187 | } 188 | 189 | 190 | /* 191 | * A data-structure package that provides Lisp-like features 192 | */ 193 | 194 | inline int 195 | lv_type_of(lv* v) 196 | { 197 | if (v != 0) 198 | return v->type; 199 | else 200 | return L_CONS; 201 | } 202 | 203 | 204 | void 205 | fprint_lv_type(lv* v, FILE* fp) 206 | { 207 | switch (lv_type_of(v)) 208 | { 209 | case L_FREE: 210 | fputs("L_FREE", fp); 211 | break; 212 | case L_CONS: 213 | fputs("L_CONS", fp); 214 | break; 215 | case L_STRING: 216 | fputs("L_STRING", fp); 217 | break; 218 | case L_SYMBOL: 219 | fputs("L_SYMBOL", fp); 220 | break; 221 | case L_NODE: 222 | fputs("L_NODE", fp); 223 | break; 224 | case L_FIXNUM: 225 | fputs("L_FIXNUM", fp); 226 | break; 227 | case L_DOUBLE: 228 | fputs("L_DOUBLE", fp); 229 | break; 230 | default: 231 | fputs("L_OTHER", fp); 232 | break; 233 | } 234 | putc('\n', fp); 235 | } 236 | 237 | inline void 238 | print_lv_type(lv* v) 239 | { 240 | fprint_lv_type(v, stdout); 241 | } 242 | 243 | 244 | /* 245 | * Reader 246 | */ 247 | 248 | /* The reader *READ-BASE* for numbers. */ 249 | 250 | int crscl_read_base = 10; 251 | 252 | 253 | 254 | /* Some buffered read operations. 255 | * Ok, they are very incomplete, since the buffer is not associated 256 | * with the file pointer. Hence reading from more than one file while 257 | * doing 'lv_ungetc' will most likely wreak havok in your program. 258 | * 259 | * 2000-08-21 Marco Antoniotti 260 | */ 261 | 262 | /* A set of 64 stacks indexed by fileno(). */ 263 | 264 | #define CRSCL_MAX_OPEN_STREAMS 64 265 | 266 | struct lv_ungetc_stack 267 | { 268 | int top; 269 | unsigned char chars_stack[256]; 270 | }; 271 | 272 | static struct lv_ungetc_stack stacked_read_chars[CRSCL_MAX_OPEN_STREAMS]; 273 | static short lv_ungetc_stacks_initialized = 0; 274 | 275 | static void 276 | initialize_ungetc_stacks() 277 | { 278 | int i; 279 | 280 | for (i = 0; i < CRSCL_MAX_OPEN_STREAMS; i++) 281 | stacked_read_chars[i].top = -1; 282 | lv_ungetc_stacks_initialized = 1; 283 | } 284 | 285 | static int 286 | lv_fgetc(rs* stream) 287 | { 288 | if (stream->tag == file_stream) 289 | { 290 | FILE *fp = stream->u.file.fp; 291 | int fp_number = fileno(fp); 292 | 293 | if (! lv_ungetc_stacks_initialized) 294 | initialize_ungetc_stacks(); 295 | 296 | if (fp_number >= CRSCL_MAX_OPEN_STREAMS) 297 | { 298 | fprintf(stderr, 299 | "CRSCL: error: too many open streams (%d) for CRSCL.", 300 | fp_number); 301 | exit(1); 302 | } 303 | 304 | if (stacked_read_chars[fp_number].top == -1) 305 | return getc(fp); 306 | else 307 | { 308 | int st_top = stacked_read_chars[fp_number].top; 309 | 310 | (stacked_read_chars[fp_number].top)--; 311 | return (int) stacked_read_chars[fp_number].chars_stack[st_top]; 312 | } 313 | } 314 | else 315 | { 316 | if (stream->u.sp.consumed>=stream->u.sp.len) return EOF; 317 | return stream->u.sp.buf[stream->u.sp.consumed++]; 318 | } 319 | } 320 | 321 | static int 322 | lv_ungetc(int c, rs* stream) 323 | { 324 | if (stream->tag == file_stream) 325 | { 326 | FILE *fp = stream->u.file.fp; 327 | 328 | int fp_number = fileno(fp); 329 | int st_top; 330 | 331 | /* I should really double check the fileno anyway. I am just 332 | * assuming that you do not call 'lv_ungetc' before 'lv_fgetc'. 333 | */ 334 | 335 | st_top = ++(stacked_read_chars[fp_number].top); 336 | stacked_read_chars[fp_number].chars_stack[st_top] 337 | = (unsigned char) c; 338 | return c; 339 | } 340 | else 341 | { 342 | if (stream->u.sp.consumed==0) return EOF; 343 | stream->u.sp.consumed--; 344 | return c; 345 | } 346 | } 347 | 348 | 349 | lv * 350 | read_sexpr(char* file) 351 | { 352 | FILE *fp; 353 | lv *s; 354 | rs *stream; 355 | 356 | if ((fp = fopen(file, "r")) == 0) 357 | { 358 | fprintf(stderr, 359 | "CRSCL: error: cannot open file \"%s\" for reading.\n", 360 | file); 361 | fflush(stderr); 362 | return 0; 363 | } 364 | 365 | stream = (rs *) crscl_malloc(sizeof(rs), 1); 366 | stream->tag = file_stream; 367 | stream->u.file.fp = fp; 368 | stream->u.file.name = strdup(file); 369 | 370 | if (stream->u.file.name == NULL) 371 | { 372 | fputs("CRSCL: error: cannot allocate memory.\n", stderr); 373 | fflush(stderr); 374 | fclose(fp); 375 | free(stream); 376 | return 0; 377 | } 378 | 379 | s = read_sexpr1(stream); 380 | 381 | fclose(fp); 382 | free(stream->u.file.name); 383 | free(stream); 384 | return s; 385 | } 386 | 387 | 388 | rs * 389 | make_stream(char *str, readstream_kind typ) 390 | { 391 | FILE *fp; 392 | rs *stream; 393 | 394 | if (typ == file_stream) 395 | { 396 | if ((fp = fopen(str, "r")) == 0) 397 | { 398 | fprintf(stderr, "CRSCL: cannot open file \"%s\" for reading.\n", 399 | str); 400 | fflush(stderr); 401 | return 0; 402 | } 403 | stream = make_stream_stream(fp); 404 | 405 | free(stream->u.file.name); /* 'make_stream_stream' fills this 406 | * field with a dummy value. 407 | */ 408 | stream->u.file.name = strdup(str); 409 | if (stream->u.file.name == NULL) 410 | { 411 | fputs("CRSCL: error: cannot allocate memory.\n", stderr); 412 | fflush(stderr); 413 | fclose(fp); 414 | free(stream); 415 | return NULL; 416 | } 417 | return stream; 418 | } 419 | else 420 | return make_string_stream(str); 421 | } 422 | 423 | 424 | inline rs * 425 | make_string_stream(char *str) 426 | { 427 | rs *stream = (rs*) crscl_malloc(sizeof(rs), 1); 428 | 429 | stream->tag = string_stream; 430 | stream->u.sp.buf = str; 431 | stream->u.sp.len = strlen(str); 432 | stream->u.sp.consumed = 0; 433 | 434 | return stream; 435 | } 436 | 437 | 438 | inline rs * 439 | make_stream_stream(FILE *fp) 440 | { 441 | rs *stream = (rs*) crscl_malloc(sizeof(rs), 1); 442 | 443 | stream->tag = file_stream; 444 | stream->u.file.fp = fp; 445 | stream->u.file.name = strdup(""); 446 | 447 | return stream; 448 | } 449 | 450 | 451 | inline int 452 | stream_stream_p(rs* stream) 453 | { 454 | return stream->tag == file_stream; 455 | } 456 | 457 | inline int 458 | string_stream_p(rs* stream) 459 | { 460 | return stream->tag == string_stream; 461 | } 462 | 463 | inline void 464 | close_stream(rs *stream) 465 | { 466 | if (stream_stream_p(stream)) 467 | fclose(stream->u.file.fp); 468 | free(stream); 469 | } 470 | 471 | 472 | lv * 473 | read_sexpr1(rs* fp) 474 | { 475 | int c; 476 | lv *s; 477 | 478 | again: 479 | while ((c = lv_fgetc(fp)) != EOF 480 | && (c == ' ' || c == '\t' || c == '\n' || c == '\r')); /* Empty. */ 481 | switch (c) 482 | { 483 | case ';': 484 | for (; (c = lv_fgetc(fp)) != EOF && c != '\n';) 485 | ; 486 | goto again; 487 | case EOF: 488 | s = 0; 489 | break; 490 | case '(': 491 | s = read_sexpr_list(fp); 492 | break; 493 | case '"': 494 | s = read_sexpr_string(fp); 495 | break; 496 | default: 497 | lv_ungetc(c, fp); 498 | /* s = read_sexpr_symbol(fp); */ 499 | s = read_sexpr_atom(fp); 500 | } 501 | return s; 502 | } 503 | 504 | static int 505 | read_dot_for_pair(rs* fp) 506 | { 507 | int c, next_c; 508 | 509 | while ((c = lv_fgetc(fp)) != EOF && (c == ' ' || c == '\t' || c == '\n')); 510 | if (c == '.') 511 | { 512 | next_c = lv_fgetc(fp); 513 | if ((next_c != EOF) 514 | && (next_c == ' ' 515 | || next_c == '\t' 516 | || next_c == '\n')) 517 | { 518 | /* Good. We have a dot pair. */ 519 | return 1; 520 | } 521 | else if (next_c == EOF) 522 | { 523 | lv_ungetc(next_c, fp); 524 | return 0; 525 | } 526 | else 527 | { 528 | /* No dotted pair. */ 529 | lv_ungetc(next_c, fp); 530 | lv_ungetc(c, fp); 531 | return 0; 532 | } 533 | } 534 | else 535 | { 536 | lv_ungetc(c, fp); 537 | return 0; 538 | } 539 | } 540 | 541 | lv * 542 | read_sexpr_list(rs* fp) 543 | { 544 | int c; 545 | lv *s; 546 | 547 | while ((c = lv_fgetc(fp)) != EOF && (c == ' ' || c == '\t' || c == '\n')) 548 | ; 549 | switch (c) 550 | { 551 | case EOF: 552 | case ')': 553 | s = 0; 554 | break; 555 | default: 556 | lv_ungetc(c, fp); 557 | s = read_sexpr1(fp); 558 | if (read_dot_for_pair(fp)) 559 | { 560 | s = cons(s, read_sexpr1(fp)); 561 | /* Now consume the right parenthesis. */ 562 | while ((c = lv_fgetc(fp)) != EOF 563 | && (c == ' ' || c == '\t' || c == '\n')) 564 | ; 565 | if (c != ')') 566 | { 567 | fprintf(stderr, "CRSCL: read error: malformed dotted pair."); 568 | exit(1); 569 | } 570 | } 571 | else 572 | s = cons(s, read_sexpr_list(fp)); 573 | break; 574 | } 575 | return s; 576 | } 577 | 578 | 579 | static char *read_buf; 580 | static int read_bufsiz; 581 | 582 | lv * 583 | read_sexpr_string(rs* fp) 584 | { 585 | int c; 586 | int i = 0; 587 | 588 | if (read_buf == 0) 589 | { 590 | read_buf = crscl_malloc(read_bufsiz = 1024, 1); 591 | memset((void *) read_buf, 0, read_bufsiz); 592 | if (read_buf == 0) 593 | { 594 | fputs("CRSCL:read_sexpr_string: unable to allocate heap memory.\n", 595 | stderr); 596 | fflush(stderr); 597 | exit(1); 598 | } 599 | } 600 | for (; (c = lv_fgetc(fp)) != EOF && c != '"';) 601 | { 602 | if (c == '\\' && (c = lv_fgetc(fp)) == EOF) 603 | break; 604 | read_buf[i++] = c; 605 | if (i >= read_bufsiz) 606 | { 607 | read_buf = crscl_realloc((void *) read_buf, read_bufsiz *= 2, 1); 608 | } 609 | } 610 | read_buf[i++] = 0; 611 | return string(read_buf); 612 | } 613 | 614 | 615 | lv * 616 | read_sexpr_symbol(rs* fp) 617 | { 618 | int c; 619 | int i = 0; 620 | 621 | if (read_buf == 0) 622 | { 623 | read_buf = (char*) crscl_malloc(read_bufsiz = 1024, 1); 624 | memset((void *) read_buf, 0, read_bufsiz); 625 | } 626 | 627 | for (;;) 628 | { 629 | c = lv_fgetc(fp); 630 | switch (c) 631 | { 632 | case ';': 633 | case '(': 634 | case ')': 635 | case '"': 636 | case '&': 637 | lv_ungetc(c, fp); 638 | case EOF: 639 | case '\n': 640 | case '\r': 641 | case '\t': 642 | case '\f': 643 | case ' ': 644 | goto out; 645 | case '\\': 646 | if ((c = lv_fgetc(fp)) == EOF) 647 | goto out; 648 | } 649 | read_buf[i++] = c; 650 | if (i >= read_bufsiz) 651 | { 652 | read_buf = crscl_realloc((void *) read_buf, read_bufsiz *= 2, 1); 653 | } 654 | } 655 | out: 656 | read_buf[i++] = 0; 657 | return intern(read_buf); 658 | } 659 | 660 | static int 661 | read_buffer_as_fixnum(char* buffer, lv** fixnum_result) 662 | { 663 | char *end_ptr; 664 | long r = strtol(buffer, &end_ptr, crscl_read_base); 665 | 666 | if (*end_ptr != '\0') 667 | { 668 | *fixnum_result = nil; 669 | return 0; 670 | } 671 | if (r > INT_MAX) 672 | *fixnum_result = fixnum(INT_MAX); 673 | else if (r < INT_MIN) 674 | *fixnum_result = fixnum(INT_MIN); 675 | else if (errno == ERANGE && r == LONG_MAX) 676 | *fixnum_result = fixnum(INT_MAX); 677 | else if (errno == ERANGE && r == LONG_MIN) 678 | *fixnum_result = fixnum(INT_MIN); 679 | else 680 | *fixnum_result = fixnum((int) r); 681 | return 1; 682 | } 683 | 684 | 685 | static int 686 | read_buffer_as_double(char* buffer, lv** double_result) 687 | { 688 | char *end_ptr; 689 | double r = strtod(buffer, &end_ptr); 690 | 691 | if (*end_ptr != '\0') 692 | { 693 | *double_result = nil; 694 | return 0; 695 | } 696 | else 697 | *double_result = double_float(r); 698 | return 1; 699 | } 700 | 701 | 702 | 703 | lv* 704 | read_sexpr_atom(rs* fp) 705 | { 706 | int c; 707 | int i = 0; 708 | 709 | if (read_buf == 0) 710 | { 711 | read_buf = crscl_malloc(read_bufsiz = 1024, 1); 712 | memset((void *) read_buf, 0, read_bufsiz); 713 | } 714 | 715 | for (;;) 716 | { 717 | c = lv_fgetc(fp); 718 | switch (c) 719 | { 720 | case ';': 721 | case '(': 722 | case ')': 723 | case '"': 724 | case '&': 725 | lv_ungetc(c, fp); 726 | case EOF: 727 | case '\n': 728 | case '\r': 729 | case '\t': 730 | case '\f': 731 | case ' ': 732 | goto out; 733 | case '\\': 734 | if ((c = lv_fgetc(fp)) == EOF) 735 | goto out; 736 | } 737 | read_buf[i++] = c; 738 | if (i >= read_bufsiz) 739 | { 740 | read_buf = crscl_realloc((void *) read_buf, read_bufsiz *= 2, 1); 741 | } 742 | } 743 | out: 744 | { 745 | lv* fixnum_result; 746 | lv* double_result; 747 | 748 | read_buf[i++] = 0; 749 | /* if ((!strcmp(read_buf, "nil")) || (!strcmp(read_buf, "NIL"))) 750 | return nil; 751 | else 752 | */ 753 | if (read_buffer_as_fixnum(read_buf, &fixnum_result)) 754 | return fixnum_result; 755 | else if (read_buffer_as_double(read_buf, &double_result)) 756 | return double_result; 757 | else /* Assume a Symbol */ 758 | return intern(read_buf); 759 | } 760 | } 761 | 762 | 763 | lv * 764 | read_quoted_symbol(rs *fp) 765 | { 766 | int c; 767 | int i = 0; 768 | 769 | if (read_buf == 0) 770 | { 771 | read_buf = crscl_malloc(read_bufsiz = 1024, 1); 772 | memset((void *) read_buf, 0, read_bufsiz); 773 | } 774 | for (;;) 775 | { 776 | c = lv_fgetc(fp); 777 | switch (c) 778 | { 779 | case '|': 780 | goto out; 781 | case '\\': 782 | if ((c = lv_fgetc(fp)) == EOF) 783 | goto out; 784 | } 785 | read_buf[i++] = c; 786 | if (i >= read_bufsiz) 787 | { 788 | read_buf = crscl_realloc(read_buf, read_bufsiz *= 2, 1); 789 | } 790 | } 791 | out: 792 | read_buf[i++] = 0; 793 | return intern(read_buf); 794 | } 795 | 796 | 797 | lv * 798 | read_c_symbol2(rs *fp) 799 | { 800 | int c; 801 | int i = 0; 802 | 803 | if (read_buf == 0) 804 | { 805 | read_buf = crscl_malloc(read_bufsiz = 1024, 1); 806 | memset((void *) read_buf, 0, read_bufsiz); 807 | } 808 | for (;;) 809 | { 810 | c = lv_fgetc(fp); 811 | switch (c) 812 | { 813 | case ',': 814 | case ':': 815 | case ';': 816 | case '(': 817 | case ')': 818 | case '"': 819 | case '&': 820 | case '\n': 821 | case '\r': 822 | case '\t': 823 | case '\f': 824 | case ' ': 825 | lv_ungetc(c, fp); 826 | case EOF: 827 | goto out; 828 | case '\\': 829 | if ((c = lv_fgetc(fp)) == EOF) 830 | goto out; 831 | } 832 | read_buf[i++] = c; 833 | if (i >= read_bufsiz) 834 | { 835 | read_buf = crscl_realloc(read_buf, read_bufsiz *= 2, 1); 836 | } 837 | } 838 | out: 839 | read_buf[i++] = 0; 840 | return intern(read_buf); 841 | } 842 | 843 | 844 | lv * 845 | read_c_symbol(rs* fp) 846 | { 847 | int c; 848 | 849 | if ((c = lv_fgetc(fp)) == '"') 850 | { 851 | lv *x = read_sexpr_string(fp); 852 | return intern(str(x)); 853 | } 854 | else 855 | { 856 | lv_ungetc(c, fp); 857 | return read_c_symbol2(fp); 858 | } 859 | } 860 | 861 | 862 | /* 863 | * Print functions 864 | */ 865 | 866 | int 867 | write_sexpr(lv* s, char* file) 868 | { 869 | FILE *fp; 870 | 871 | if ((fp = fopen(file, "w")) == 0) 872 | { 873 | fprintf(stderr, 874 | "CRSCL: error: cannot open file \"%s\" for writing.", 875 | file); 876 | fflush(stderr); 877 | return -1; 878 | } 879 | write_sexpr1(s, fp); 880 | fclose(fp); 881 | return 0; 882 | } 883 | 884 | 885 | void 886 | print(lv* s) 887 | { 888 | write_sexpr1(s, stdout); 889 | } 890 | 891 | 892 | /* For debugging. 893 | */ 894 | void 895 | p(lv* s) 896 | { 897 | print(s); 898 | fflush(stdout); 899 | } 900 | 901 | 902 | /* For debugging. 903 | */ 904 | void 905 | f() 906 | { 907 | fflush(stdout); 908 | } 909 | 910 | /* For debugging. 911 | */ 912 | void 913 | pattr(char* as, lv* n) 914 | { 915 | p(attr(intern(as), n)); 916 | } 917 | 918 | static int dont_loop = 1; 919 | static int print_addresses = 0; 920 | static int print_level = 10; 921 | short print_nil_as_list = 0; 922 | 923 | static int sexpr_mark = 1; 924 | 925 | void 926 | write_sexpr1_(lv* s, FILE* fp, int level) 927 | { 928 | char *p; 929 | lv* sub_cons = nil; 930 | 931 | if (s == 0) 932 | { 933 | if (print_nil_as_list) 934 | fputs("()", fp); 935 | else 936 | fputs("nil", fp); 937 | return; 938 | } 939 | if (print_addresses) fprintf(fp, "0x%p: ", (void *) s); 940 | if (level >= print_level) 941 | { 942 | switch (s->type) 943 | { 944 | case L_CONS: 945 | fprintf(fp, "(...)"); 946 | return; 947 | case L_NODE: 948 | fprintf(fp, "#[...]"); 949 | return; 950 | } 951 | } 952 | if (dont_loop && s->mark) 953 | { 954 | switch (s->type) 955 | { 956 | case L_CONS: 957 | fprintf(fp, "#=%d()", s->mark); 958 | return; 959 | case L_NODE: 960 | fprintf(fp, "#=%d#[...]", s->mark); 961 | return; 962 | } 963 | } 964 | if (dont_loop) s->mark = sexpr_mark++; 965 | 966 | switch (s->type) 967 | { 968 | case L_CONS: 969 | fprintf(fp, "("); 970 | write_sexpr1_(hd(s), fp, level + 1); 971 | 972 | for (sub_cons = tl(s); sub_cons != nil; sub_cons = tl(sub_cons)) 973 | { 974 | if (dont_loop && sub_cons->mark) 975 | { 976 | switch (sub_cons->type) 977 | { 978 | case L_CONS: 979 | fprintf(fp, "#=%d()", s->mark); 980 | return; 981 | case L_NODE: 982 | fprintf(fp, "#=%d#[...]", s->mark); 983 | return; 984 | } 985 | } 986 | if (dont_loop) sub_cons->mark = sexpr_mark++; 987 | 988 | if (sub_cons->type == L_CONS) 989 | { 990 | fputc(' ', fp); 991 | write_sexpr1_(hd(sub_cons), fp, level + 1); 992 | } 993 | else 994 | { 995 | fputs(" . ", fp); 996 | write_sexpr1_(sub_cons, fp, level + 1); 997 | break; 998 | } 999 | } 1000 | 1001 | /* 1002 | while ((s = tl(s))) 1003 | { 1004 | if (s->type == L_CONS) 1005 | { 1006 | fprintf(fp, " "); 1007 | write_sexpr1_(hd(s), fp, level + 1); 1008 | } 1009 | else 1010 | { 1011 | fprintf(fp, " . "); 1012 | write_sexpr1_(s, fp, level + 1); 1013 | break; 1014 | } 1015 | } 1016 | */ 1017 | fputc(')', fp); 1018 | break; 1019 | 1020 | case L_STRING: 1021 | putc('"', fp); 1022 | for (p = str(s); *p; p++) 1023 | { 1024 | if (*p == '"') 1025 | putc('\\', fp); 1026 | putc(*p, fp); 1027 | } 1028 | putc('"', fp); 1029 | break; 1030 | 1031 | case L_FIXNUM: 1032 | fprintf(fp, "%d", intnum(s)); 1033 | break; 1034 | 1035 | case L_DOUBLE: 1036 | fprintf(fp, "%f", doublenum(s)); 1037 | break; 1038 | 1039 | case L_SYMBOL: 1040 | for (p = pname(s); *p; p++) 1041 | { 1042 | switch (*p) 1043 | { 1044 | case ';': 1045 | case '(': 1046 | case ')': 1047 | case '"': 1048 | case '&': 1049 | case '\n': 1050 | case '\r': 1051 | case '\t': 1052 | case '\f': 1053 | case ' ': 1054 | case '\\': 1055 | putc('\\', fp); 1056 | } 1057 | putc(*p, fp); 1058 | } 1059 | break; 1060 | 1061 | case L_NODE: 1062 | fprintf(fp, "#["); 1063 | write_sexpr1_(op(s), fp, level + 1); 1064 | if (args(s)) 1065 | { 1066 | fprintf(fp, " ARGUMENTS: "); 1067 | write_sexpr1_(args(s), fp, level + 1); 1068 | } 1069 | if (attrs(s)) 1070 | { 1071 | fprintf(fp, " ATTRIBUTES: "); 1072 | write_sexpr1_(attrs(s), fp, level + 1); 1073 | } 1074 | fputc(']', fp); 1075 | break; 1076 | 1077 | case L_OTHER: 1078 | fprintf(fp, "#", (void *) oth(s)); 1079 | break; 1080 | } 1081 | } 1082 | 1083 | static void markv(lv *, int); 1084 | 1085 | void write_sexpr1(lv *s, FILE* fp) 1086 | { 1087 | write_sexpr1_(s, fp, 0); 1088 | if (dont_loop) markv(s, 0); /* unmark, really. */ 1089 | } 1090 | 1091 | 1092 | /* 1093 | * Basic constructors and predicates. 1094 | */ 1095 | 1096 | inline _Bool 1097 | null(lv *x) { 1098 | return 1099 | x == nil 1100 | || x->type == L_NULL 1101 | || x == intern("nil") 1102 | || x == intern("NIL"); 1103 | } 1104 | 1105 | 1106 | inline lv * 1107 | cons(lv *a, lv *b) 1108 | { 1109 | lv *s; 1110 | 1111 | s = lalloc(); 1112 | s->type = L_CONS; 1113 | hd(s) = a; 1114 | 1115 | /* Special case for 'nil'. */ 1116 | tl(s) = null(b) ? nil : b; 1117 | return s; 1118 | } 1119 | 1120 | 1121 | lv * 1122 | string(const char* p) 1123 | { 1124 | lv *s; 1125 | 1126 | s = lalloc(); 1127 | s->type = L_STRING; 1128 | str(s) = crscl_malloc(strlen(p) + 1, 1); 1129 | memset((void *) str(s), 0, strlen(p) + 1); 1130 | strcpy(str(s), p); 1131 | return s; 1132 | } 1133 | 1134 | 1135 | lv * 1136 | stringl(char *p, int n) 1137 | { 1138 | lv *s; 1139 | 1140 | s = lalloc(); 1141 | s->type = L_STRING; 1142 | str(s) = crscl_malloc(n + 1, 1); 1143 | 1144 | memcpy(str(s), p, n); 1145 | str(s)[n] = 0; 1146 | return s; 1147 | } 1148 | 1149 | 1150 | inline lv * 1151 | fixnum(int v) 1152 | { 1153 | lv *s; 1154 | 1155 | s = lalloc(); 1156 | s->type = L_FIXNUM; 1157 | intnum(s) = v; 1158 | return s; 1159 | } 1160 | 1161 | 1162 | inline lv * 1163 | double_float(double d) 1164 | { 1165 | lv *s; 1166 | 1167 | s = lalloc(); 1168 | s->type = L_DOUBLE; 1169 | doublenum(s) = d; 1170 | return s; 1171 | } 1172 | 1173 | 1174 | lv * 1175 | symbol(char* pname) 1176 | { 1177 | lv *s; 1178 | 1179 | s = lalloc(); 1180 | s->type = L_SYMBOL; 1181 | pname(s) = (char*) crscl_malloc((strlen(pname) + 1) * sizeof(char), 1); 1182 | 1183 | /* pname(s) = malloc(strlen(pname) + 1); */ 1184 | /* if (pname(s) == 0) */ 1185 | /* { */ 1186 | /* fputs("lisp.c: unable to allocate heap memory.\n", stderr); */ 1187 | /* fflush(stderr); */ 1188 | /* exit(1); */ 1189 | /* } */ 1190 | 1191 | strcpy(pname(s), pname); 1192 | sindex(s) = 0; 1193 | plist(s) = 0; 1194 | return s; 1195 | } 1196 | 1197 | 1198 | lv * 1199 | node(lv* op, lv* args, lv* attrs) 1200 | { 1201 | lv *s; 1202 | 1203 | s = lalloc(); 1204 | s->type = L_NODE; 1205 | op(s) = op; 1206 | attrs(s) = attrs; 1207 | args(s) = args; 1208 | mark_attr(s) = 0; 1209 | return s; 1210 | } 1211 | 1212 | 1213 | lv * 1214 | other(void* x) 1215 | { 1216 | lv *s = lalloc(); 1217 | s->type = L_OTHER; 1218 | oth(s) = x; 1219 | mark_attr(s) = 0; 1220 | return s; 1221 | } 1222 | 1223 | 1224 | void 1225 | node_set_op(lv* s, lv* op) 1226 | { 1227 | op(s) = op; 1228 | } 1229 | 1230 | 1231 | /* Plist functions. */ 1232 | 1233 | lv * 1234 | getf(lv* plist, lv* indicator) 1235 | { 1236 | lv* indicator_ptr = memq(indicator, plist); 1237 | 1238 | if (indicator_ptr != nil) 1239 | return second(indicator_ptr); 1240 | else 1241 | return nil; 1242 | } 1243 | 1244 | 1245 | lv * 1246 | getf1(lv* plist, lv* indicator, lv* default_value) 1247 | { 1248 | lv* indicator_ptr = memq(indicator, plist); 1249 | 1250 | if (indicator_ptr != nil) 1251 | return second(indicator_ptr); 1252 | else 1253 | return default_value; 1254 | } 1255 | 1256 | lv* 1257 | plist_get(lv* sym, lv* indicator) 1258 | { 1259 | if (!symbolp(sym)) 1260 | { 1261 | fputs("CRSCL: plist_get called with a non symbol.\n", stderr); 1262 | fflush(stderr); 1263 | exit(1); 1264 | } 1265 | return getf(plist(sym), indicator); 1266 | } 1267 | 1268 | lv* 1269 | setf_get(lv* sym, lv* indicator, lv* value) 1270 | { 1271 | lv* indicator_ptr; 1272 | if (!symbolp(sym)) 1273 | { 1274 | fputs("CRSCL: plist_get called with a non symbol.\n", stderr); 1275 | fflush(stderr); 1276 | exit(1); 1277 | } 1278 | 1279 | indicator_ptr = memq(indicator, plist(sym)); 1280 | if (indicator_ptr != nil) 1281 | { 1282 | hd(tl(indicator_ptr)) = value; 1283 | } 1284 | else 1285 | { 1286 | plist(sym) = nconc(plist(sym), list2(indicator, value)); 1287 | } 1288 | return value; 1289 | } 1290 | 1291 | 1292 | /* Marking nodes. 1293 | */ 1294 | 1295 | int mark_number = 0; 1296 | 1297 | void 1298 | new_node_marker() 1299 | { 1300 | mark_number %= INT_MAX; /* Being paranoid. Marco Antoniotti 19970106 */ 1301 | mark_number++; 1302 | } 1303 | 1304 | void 1305 | mark_node(lv *node) 1306 | { 1307 | mark_attr(node) = mark_number; 1308 | } 1309 | 1310 | int 1311 | node_marked_p(lv *node) 1312 | { 1313 | return mark_attr(node) == mark_number; 1314 | } 1315 | 1316 | 1317 | /* 1318 | * Intern 1319 | */ 1320 | 1321 | lv * 1322 | intern(char* pname) 1323 | { 1324 | lv *s, **sp; 1325 | 1326 | /* The next cast is needed for some C compilers */ 1327 | 1328 | for (sp = (lv**) &shtab[shash(pname)]; (s = *sp); sp = &shlink(s)) 1329 | if (strcmp(pname(s), pname) == 0) 1330 | return s; 1331 | return *sp = symbol(pname); 1332 | } 1333 | 1334 | 1335 | int 1336 | shash(char* p) 1337 | { 1338 | unsigned h = 0; 1339 | 1340 | for (; *p; p++) 1341 | { 1342 | h ^= *(unsigned char *)p; 1343 | h = h >> (L_HBITS - L_HSHIFT) | h << L_HSHIFT; 1344 | h &= L_HMASK; 1345 | } 1346 | return h; 1347 | } 1348 | 1349 | 1350 | int 1351 | crscl_table_size() { return L_HSIZE; } 1352 | 1353 | 1354 | lv* 1355 | crscl_table_ref(int i) { return shtab[i]; } 1356 | 1357 | 1358 | void 1359 | clear_crscl_tables() 1360 | { 1361 | int __clr; 1362 | 1363 | for (__clr = 0; __clr < L_HSIZE; __clr++) shtab[__clr] = 0; 1364 | } 1365 | 1366 | 1367 | /* 1368 | * Standard Lisp-like functions 1369 | */ 1370 | 1371 | /* list -- 1372 | * WARNING. This function may be buggy due to the interpretation of 1373 | * the variable argument list. 1374 | * 1375 | * It needs to be fixed. 1376 | * 1377 | * 2000-08-20 Marco Antoniotti 1378 | */ 1379 | lv * 1380 | list(lv *a, ...) 1381 | { 1382 | va_list ap; 1383 | lv *s, *e, *arg; 1384 | 1385 | va_start(ap, a); 1386 | if (a == 0) 1387 | return 0; 1388 | e = s = cons(a, 0); 1389 | 1390 | while ((arg = va_arg(ap, lv *))) 1391 | e = tl(e) = cons(arg, 0); 1392 | va_end(ap); 1393 | return s; 1394 | } 1395 | 1396 | 1397 | int 1398 | length(lv* s) 1399 | { 1400 | int n = 0; 1401 | 1402 | if (s != 0) 1403 | { 1404 | assert(consp(s)); 1405 | for(; s; s = tl(s)) 1406 | n++; 1407 | } 1408 | return n; 1409 | } 1410 | 1411 | 1412 | lv * 1413 | nth(int n, lv* l) 1414 | { 1415 | int i = 0; 1416 | for(; l; l = tl(l), i++) 1417 | if (i == n) return hd(l); 1418 | return nil; 1419 | } 1420 | 1421 | lv * 1422 | nthcdr(int n, lv* l) 1423 | { 1424 | int i = 0; 1425 | 1426 | for(; l; l = tl(l), i++) 1427 | if (i == n) return l; 1428 | return nil; 1429 | } 1430 | 1431 | 1432 | 1433 | 1434 | lv * 1435 | copy_tree(lv* s) 1436 | { 1437 | if (s == 0) 1438 | return s; 1439 | switch (s->type) 1440 | { 1441 | case L_CONS: 1442 | return cons(copy_tree(hd(s)), copy_tree(tl(s))); 1443 | case L_STRING: 1444 | case L_SYMBOL: 1445 | return s; 1446 | case L_NODE: 1447 | return node(op(s), copy_tree(attrs(s)), copy_tree(args(s))); 1448 | default: 1449 | assert(0); 1450 | } 1451 | } 1452 | 1453 | 1454 | lv * 1455 | copy_list(lv* s) 1456 | { 1457 | lv *x = 0; 1458 | lv **p = &x; 1459 | 1460 | for (; s; s = tl(s)) 1461 | { 1462 | assert(s->type == L_CONS); 1463 | *p = cons(hd(s), 0); 1464 | p = &tl(*p); 1465 | } 1466 | return x; 1467 | } 1468 | 1469 | 1470 | lv * 1471 | assoc(lv* k, lv* al) 1472 | { 1473 | if (al) 1474 | { 1475 | if (eq(k, hd(hd(al)))) 1476 | { 1477 | return hd(al); 1478 | } 1479 | else 1480 | return assoc(k, tl(al)); 1481 | } 1482 | else 1483 | return nil; 1484 | } 1485 | 1486 | 1487 | void 1488 | reassoc_(lv* k, lv* v, lv** lp) 1489 | { 1490 | lv *x = assoc(k, *lp); 1491 | 1492 | if (x) 1493 | { 1494 | tl(x) = v; 1495 | } 1496 | else 1497 | { 1498 | apush(k, v, *lp); 1499 | } 1500 | } 1501 | 1502 | 1503 | lv * 1504 | attr(lv* symbol, lv* node) 1505 | { 1506 | lv *c = assoc(symbol, attrs(node)); 1507 | return c? tl(c) : nil; 1508 | } 1509 | 1510 | 1511 | void 1512 | set_attr(lv* symbol, lv* node, lv* value) 1513 | { 1514 | reassoc(symbol, value, attrs(node)); 1515 | } 1516 | 1517 | 1518 | /* Equivalent to set_attr(SYMBOL, NODE, cons(VALUE, attr(SYMBOL, NODE))) 1519 | */ 1520 | void 1521 | push_attr(lv* symbol, lv* node, lv* value) 1522 | { 1523 | lv *c = assoc(symbol, attrs(node)); 1524 | 1525 | if (c) 1526 | push(value, tl(c)); 1527 | else 1528 | apush(symbol, list1(value), attrs(node)); 1529 | } 1530 | 1531 | 1532 | lv * 1533 | nreverse(lv* s) 1534 | { 1535 | lv *x = 0; 1536 | 1537 | while (s) 1538 | { 1539 | lv *y; 1540 | 1541 | assert(s->type == L_CONS); 1542 | y = tl(s); 1543 | tl(s) = x; 1544 | x = s; 1545 | s = y; 1546 | } 1547 | return x; 1548 | } 1549 | 1550 | 1551 | lv * 1552 | nreverse2(lv* s, lv* e) 1553 | { 1554 | lv *x = 0; 1555 | 1556 | while (s != e) 1557 | { 1558 | lv *y; 1559 | 1560 | assert(s->type == L_CONS); 1561 | y = tl(s); 1562 | tl(s) = x; 1563 | x = s; 1564 | s = y; 1565 | } 1566 | return x; 1567 | } 1568 | 1569 | 1570 | lv * 1571 | nconc(lv* a, lv* b) 1572 | { 1573 | lv *x, *y; 1574 | 1575 | if (a == 0) 1576 | return b; 1577 | if (b == 0) 1578 | return a; 1579 | for (x = a; (y = tl(x)); x = y) 1580 | ; 1581 | tl(x) = b; 1582 | return a; 1583 | } 1584 | 1585 | 1586 | lv * 1587 | append(lv* a, lv* b) 1588 | { 1589 | lv *x, **p = &x; 1590 | 1591 | if (a == 0) return b; 1592 | if (b == 0) return a; 1593 | for (; a; a = tl(a)) 1594 | { 1595 | *p = cons(hd(a), nil); 1596 | p = &tl(*p); 1597 | } 1598 | *p = b; 1599 | return x; 1600 | } 1601 | 1602 | 1603 | lv * 1604 | del_el(lv* a, lv* b) 1605 | { 1606 | if (b == nil) 1607 | return b; 1608 | else if (a == first(b)) 1609 | return rest(b); 1610 | else 1611 | return cons(first(b), del_el(a, rest(b))); 1612 | } 1613 | 1614 | 1615 | lv * 1616 | mapcar(lv* (*f)(lv *), lv* s) 1617 | /* lv *(*f)(lv *); 1618 | lv *s; 1619 | */ 1620 | { 1621 | lv *x = 0; 1622 | lv **p = &x; 1623 | 1624 | for (; s; s = tl(s)) 1625 | { 1626 | assert(s->type == L_CONS); 1627 | *p = cons((*f)(hd(s)), 0); 1628 | p = &tl(*p); 1629 | } 1630 | return x; 1631 | } 1632 | 1633 | 1634 | lv * 1635 | mapcarx(lv* (*f)(lv *, lv *), lv* s, lv* a) 1636 | /* lv *(*f)(lv *, lv *); 1637 | lv *s; 1638 | lv *a; 1639 | */ 1640 | { 1641 | lv *x = 0; 1642 | lv **p = &x; 1643 | 1644 | for (; s; s = tl(s)) 1645 | { 1646 | assert(s->type == L_CONS); 1647 | *p = cons((*f)(hd(s), a), 0); 1648 | p = &tl(*p); 1649 | } 1650 | return x; 1651 | } 1652 | 1653 | 1654 | static lv* 1655 | mapcan_tr(lv* (*f)(lv *), lv* s, lv * acc) 1656 | { 1657 | if (s == nil) 1658 | return acc; 1659 | else 1660 | return mapcan_tr(f, tl(s), nconc(acc, (*f)(hd(s)))); 1661 | } 1662 | 1663 | 1664 | lv * 1665 | mapcan(lv* (*f)(lv *), lv* s) 1666 | { 1667 | return mapcan_tr(f, s, nil); 1668 | } 1669 | 1670 | 1671 | void 1672 | mapc(void (*f)(lv *), lv* s) 1673 | /* void (*f)(lv *); 1674 | lv *s; 1675 | */ 1676 | { 1677 | for (; s; s = tl(s)) 1678 | (*f)(hd(s)); 1679 | } 1680 | 1681 | 1682 | void 1683 | mapcx(void (*f)(lv *, lv*), lv* s, lv* a) 1684 | /* void (*f)(lv *, lv*); 1685 | lv *s, *a; 1686 | */ 1687 | { 1688 | for (; s; s = tl(s)) 1689 | (*f)(hd(s), a); 1690 | } 1691 | 1692 | 1693 | lv * 1694 | member_op(lv* s, lv* a) 1695 | { 1696 | for (; s; s = tl(s)) 1697 | { 1698 | if (nodep(hd(s)) && eq(op(hd(s)), a)) 1699 | break; 1700 | } 1701 | return s; 1702 | } 1703 | 1704 | 1705 | lv* 1706 | memq(lv* el, lv* l) 1707 | { 1708 | if (l == nil) 1709 | return nil; 1710 | else if (hd(l) == el) 1711 | return l; 1712 | else 1713 | return memq(el, tl(l)); 1714 | } 1715 | 1716 | 1717 | /* 1718 | * Allocation and collection 1719 | */ 1720 | 1721 | #define CHUNK 1024 1722 | lv *freelist; 1723 | lv *alloclist; 1724 | 1725 | 1726 | lv * 1727 | lalloc() 1728 | { 1729 | lv *p; 1730 | 1731 | again: 1732 | p = freelist; 1733 | if (p == 0) 1734 | { 1735 | int i; 1736 | 1737 | p = crscl_malloc(sizeof(*p) * CHUNK, 1); 1738 | memset(p, 0, (sizeof(*p) * CHUNK, 1)); 1739 | for (i = CHUNK; --i >= 0; p++) 1740 | { 1741 | p->type = L_FREE; 1742 | p->link = freelist; 1743 | freelist = p; 1744 | } 1745 | goto again; 1746 | } 1747 | freelist = p->link; 1748 | p->mark = 0; 1749 | p->flags = 0; 1750 | p->link = alloclist; 1751 | alloclist = p; 1752 | return p; 1753 | } 1754 | 1755 | 1756 | lv *rootlist; 1757 | 1758 | void 1759 | gc_set_root(lv* s) 1760 | { 1761 | rootlist = cons(s, rootlist); 1762 | } 1763 | 1764 | 1765 | void 1766 | gc_clear_root() 1767 | { 1768 | rootlist = 0; 1769 | } 1770 | 1771 | static void mark(lv *p); 1772 | static void sweep(); 1773 | static int mark_value = 1; 1774 | 1775 | void 1776 | gc() 1777 | { 1778 | mark(rootlist); 1779 | sweep(); 1780 | } 1781 | 1782 | 1783 | /* mark -- 1784 | * The old (commented) version used a poor man tail recursion trick, 1785 | * which may fool the compiler. At least I cannot understand why it 1786 | * shouldn't work. 1787 | * Therefore I wrote the fully recursive version which should instead 1788 | * work a little better. 1789 | * 1790 | * 2000-08-21 Marco Antoniotti 1791 | */ 1792 | 1793 | static void 1794 | mark(lv* p) 1795 | { 1796 | if (p == 0 || p->mark == mark_value) 1797 | return; 1798 | 1799 | p->mark = mark_value; 1800 | switch (p->type) 1801 | { 1802 | case L_STRING: 1803 | case L_OTHER: 1804 | case L_FIXNUM: 1805 | case L_DOUBLE: 1806 | break; 1807 | case L_SYMBOL: 1808 | mark(plist(p)); 1809 | break; 1810 | case L_CONS: 1811 | mark(hd(p)); 1812 | mark(tl(p)); 1813 | break; 1814 | case L_NODE: 1815 | if (op(p) != 0 && op(p)->type != L_SYMBOL) 1816 | mark(op(p)); 1817 | mark(attrs(p)); 1818 | mark(args(p)); 1819 | break; 1820 | default: 1821 | assert(0); 1822 | } 1823 | } 1824 | 1825 | /* Old version. 1826 | static void 1827 | mark(lv* p) 1828 | { 1829 | again: 1830 | if (p == 0 || p->mark == mark_value) return; 1831 | p->mark = mark_value; 1832 | switch (p->type) 1833 | { 1834 | case L_STRING: 1835 | case L_OTHER: 1836 | case L_FIXNUM: 1837 | case L_DOUBLE: 1838 | break; 1839 | case L_SYMBOL: 1840 | p = plist(p); 1841 | goto again; 1842 | case L_CONS: 1843 | mark(hd(p)); 1844 | p = tl(p); 1845 | goto again; 1846 | case L_NODE: 1847 | if (op(p) != 0 && op(p)->type != L_SYMBOL) 1848 | mark(op(p)); 1849 | mark(attrs(p)); 1850 | p = args(p); 1851 | goto again; 1852 | default: 1853 | assert(0); 1854 | } 1855 | } 1856 | */ 1857 | 1858 | 1859 | static void 1860 | unmark(lv* p) 1861 | { 1862 | if (p == 0 || p->mark == 0) return; 1863 | 1864 | p->mark = 0; 1865 | 1866 | switch (p->type) 1867 | { 1868 | case L_STRING: 1869 | case L_OTHER: 1870 | case L_FIXNUM: 1871 | case L_DOUBLE: 1872 | break; 1873 | case L_SYMBOL: 1874 | mark(plist(p)); 1875 | break; 1876 | case L_CONS: 1877 | mark(hd(p)); 1878 | mark(tl(p)); 1879 | break; 1880 | case L_NODE: 1881 | if (op(p) != 0 && op(p)->type != L_SYMBOL) 1882 | mark(op(p)); 1883 | mark(attrs(p)); 1884 | mark(args(p)); 1885 | break; 1886 | default: 1887 | assert(0); 1888 | } 1889 | } 1890 | 1891 | 1892 | static void 1893 | markv(lv* p, int v) 1894 | { 1895 | int old = mark_value; 1896 | 1897 | assert(old > 0); 1898 | 1899 | mark_value = v; 1900 | unmark(p); 1901 | /* mark(p); */ 1902 | mark_value = old; 1903 | } 1904 | 1905 | 1906 | /* For debugging. */ 1907 | int 1908 | check_zero_mark(lv* p) 1909 | { 1910 | if (p == 0) return 1; 1911 | 1912 | switch (p->type) 1913 | { 1914 | case L_STRING: 1915 | case L_OTHER: 1916 | case L_FIXNUM: 1917 | case L_DOUBLE: 1918 | return p->mark == 0; 1919 | break; 1920 | case L_SYMBOL: 1921 | if (p->mark != 0) 1922 | return 0; 1923 | else 1924 | return check_zero_mark(plist(p)); 1925 | break; 1926 | case L_CONS: 1927 | if (check_zero_mark(hd(p)) && check_zero_mark(tl(p))) 1928 | return p->mark == 0; 1929 | else 1930 | return 0; 1931 | break; 1932 | case L_NODE: 1933 | if (op(p) != 0 1934 | && op(p)->type != L_SYMBOL 1935 | && check_zero_mark(op(p)) 1936 | && check_zero_mark(attrs(p)) 1937 | && check_zero_mark(args(p))) 1938 | return p->mark == 0; 1939 | else 1940 | return 0; 1941 | break; 1942 | default: 1943 | assert(0); 1944 | } 1945 | return 0; 1946 | } 1947 | 1948 | static void 1949 | sweep() 1950 | { 1951 | lv *p, *q; 1952 | lv *a = 0; 1953 | lv *f = freelist; 1954 | 1955 | for (p = alloclist; p; p = q) 1956 | { 1957 | q = p->link; 1958 | if (p->flags & L_STATIC) 1959 | ; 1960 | else if (p->mark) 1961 | { 1962 | p->mark = 0; 1963 | p->link = a; 1964 | a = p; 1965 | } 1966 | else 1967 | { 1968 | switch (p->type) 1969 | { 1970 | case L_SYMBOL: 1971 | free(pname(p)); 1972 | break; 1973 | case L_STRING: 1974 | free(str(p)); 1975 | break; 1976 | } 1977 | p->type = L_FREE; 1978 | p->link = f; 1979 | f = p; 1980 | } 1981 | } 1982 | alloclist = a; 1983 | freelist = f; 1984 | } 1985 | 1986 | #endif /* _CRSCL_LISP_I */ 1987 | 1988 | /* end of file -- crscl.c -- */ 1989 | -------------------------------------------------------------------------------- /c/crscl.h: -------------------------------------------------------------------------------- 1 | /* -*- Mode: C -*- */ 2 | 3 | /* crscl.h -- "Contains a Reimplementation of a Subset of Common Lisp" 4 | * 5 | * This library contains a minimal reader sor a Lisp language. The 6 | * language is a subset of Common Lisp (sans READER-MACRO). 7 | */ 8 | 9 | /* Please see the file COPYING for licensing details. */ 10 | 11 | /* History: 12 | * 13 | * 2010 - Resurrected and updated. 14 | * 15 | * 2001 - ConVEX and VAL are complex system, hence they must contain a 16 | * buggy reimplementation of a subset of Common Lisp. 17 | * 18 | * 2000-08-19 Marco Antoniotti 19 | * The file (originally named 'lisp.h') comes from Berkeley and was 20 | * part of the SHIFT system (another "complex" system). It has not 21 | * changed much and the Berkeley Copyright must remain. 22 | * 23 | * 1996- This file is part of the SHIFT compiler. 24 | * 25 | * Originally written by Edward Wang (edward@edcom.com) 26 | * Modified 1995-96 by Luigi Semenzato, Berkeley PATH 27 | * luigi@fiat.its.berkeley.edu 28 | * January 1996 29 | */ 30 | 31 | #ifndef _CRSCL_LISP_H 32 | #define _CRSCL_LISP_H 33 | 34 | /* Setting up namespace and linkage for C++. 35 | * Since C++ programs do not necessarily include I must do 36 | * so here. 37 | */ 38 | #ifdef __cplusplus 39 | 40 | extern "C" { 41 | #include 42 | } 43 | 44 | namespace crscl { 45 | extern "C" { 46 | #endif 47 | 48 | /* Necessary #includes. */ 49 | 50 | #include 51 | 52 | /* The main Lisp object data structure. */ 53 | 54 | typedef struct lispval 55 | { 56 | short type; 57 | char flags; 58 | struct lispval *link; 59 | union 60 | { 61 | /* symbol */ 62 | struct 63 | { 64 | char *vpname; /* print name */ 65 | struct lispval *vshlink; /* hash link */ 66 | struct lispval *vplist; /* property list (an alist) */ 67 | short vsindex; /* used by hasher */ 68 | } s; 69 | 70 | /* cons cell */ 71 | struct 72 | { 73 | struct lispval *car, *cdr; 74 | } c; 75 | 76 | /* string */ 77 | struct 78 | { 79 | char *vstr; 80 | } t; 81 | 82 | /* fixnum */ 83 | struct 84 | { 85 | int vnum; 86 | } f; 87 | 88 | /* double */ 89 | struct 90 | { 91 | double vdnum; 92 | } d; 93 | 94 | /* IR node */ 95 | struct 96 | { 97 | struct lispval *vop; /* tag name (a symbol) */ 98 | struct lispval *vattrs; /* attributes (an alist) */ 99 | struct lispval *vargs; /* arguments */ 100 | int mark; 101 | } n; 102 | 103 | /* Other */ 104 | struct 105 | { 106 | void *x; 107 | } o; 108 | } u; 109 | 110 | /* Graph Traversal support for marking 111 | * 112 | * 2000-08-22 Marco Antoniotti 113 | */ 114 | int mark; 115 | short color; 116 | } lv; 117 | 118 | 119 | /* readstream -- A union type used to abstract the input stream. The 120 | * readstream_kind enumeration type is here as support. 121 | */ 122 | typedef enum _readstream_kind 123 | { 124 | file_stream = 0, 125 | string_stream 126 | } readstream_kind; 127 | 128 | 129 | typedef struct readstream 130 | { 131 | readstream_kind tag; 132 | union 133 | { 134 | struct { 135 | char *name; /* File name. */ 136 | FILE *fp; /* File pointer stream. */ 137 | } file; 138 | 139 | struct { /* String stream. */ 140 | char *buf; 141 | int consumed; 142 | int len; 143 | } sp; 144 | } u; 145 | } rs; 146 | 147 | 148 | /* Some useful aliases */ 149 | 150 | typedef lv* lv_t; 151 | typedef lv* symbol_t; 152 | typedef lv* cons_t; 153 | typedef lv* list_t; 154 | 155 | /* type */ 156 | #define L_FREE 0 157 | #define L_CONS 1 158 | #define L_STRING 2 159 | #define L_SYMBOL 3 160 | #define L_NODE 4 161 | #define L_FIXNUM 5 162 | #define L_DOUBLE 6 163 | #define L_NULL 7 164 | 165 | #define L_OTHER 255 166 | 167 | /* 168 | typedef enum l_type { 169 | L_FREE = 0, 170 | L_CONS, 171 | L_STRING, 172 | L_SYMBOL, 173 | L_NODE, 174 | L_FIXNUM, 175 | L_DOUBLE, 176 | L_NULL, 177 | 178 | L_OTHER = 255 179 | }; 180 | */ 181 | 182 | /* flags */ 183 | #define L_STATIC 0x0001 184 | 185 | /* 186 | * Encapsulation 187 | */ 188 | 189 | #define eq(x, y) ((x) == (y)) 190 | 191 | #define consp(x) ((x) != 0 && (x)->type == L_CONS) 192 | /* #define null(x) ((x) == nil) */ 193 | #define cons_or_null_p(x) (null(x) || consp(x)) 194 | 195 | extern inline _Bool null(lv *); 196 | 197 | 198 | #define hd(x) ((x)->u.c.car) 199 | #define tl(x) ((x)->u.c.cdr) 200 | 201 | #define stringp(x) ((x) != 0 && (x)->type == L_STRING) 202 | #define str(x) ((x)->u.t.vstr) 203 | 204 | #define fixnump(x) ((x) != 0 && (x)->type == L_FIXNUM) 205 | #define doublep(x) ((x) != 0 && (x)->type == L_DOUBLE) 206 | #define num(x) (lv_type_of(x) == L_FIXNUM \ 207 | ? ((x)->u.f.vnum) \ 208 | : ((x)->u.d.vdnum)) 209 | 210 | #define intnum(x) ((x)->u.f.vnum) 211 | #define doublenum(x) ((x)->u.d.vdnum) 212 | 213 | #define symbolp(x) ((x) != 0 && (x)->type == L_SYMBOL) 214 | #define pname(x) ((x)->u.s.vpname) 215 | #define plist(x) ((x)->u.s.vplist) 216 | #define sindex(x) ((x)->u.s.vsindex) 217 | #define shlink(x) ((x)->u.s.vshlink) 218 | 219 | #define nodep(x) ((x) != 0 && (x)->type == L_NODE) 220 | #define op(x) ((x)->u.n.vop) 221 | #define attrs(x) ((x)->u.n.vattrs) 222 | #define args(x) ((x)->u.n.vargs) 223 | #define arg1(x) first(args(x)) 224 | #define arg2(x) second(args(x)) 225 | #define arg3(x) third(args(x)) 226 | #define mark_attr(x) ((x)->u.n.mark) 227 | 228 | #define otherp(x) ((x) != 0 && (x)->type == L_OTHER) 229 | #define oth(y) ((y)->u.o.x) 230 | 231 | /* 232 | * Generally useful stuff 233 | */ 234 | 235 | #define first(x) hd(x) 236 | #define second(x) hd(tl(x)) 237 | #define third(x) hd(tl(tl(x))) 238 | #define fourth(x) hd(tl(tl(tl(x)))) 239 | #define fifth(x) hd(tl(tl(tl(tl(x))))) 240 | 241 | #define rest(x) tl(x) 242 | 243 | #define list1(x) cons(x, nil) 244 | #define list2(x, y) cons(x, list1(y)) 245 | #define list3(x, y, z) cons(x, list2(y, z)) 246 | #define list4(x, y, z, w) cons(x, list3(y, z, w)) 247 | 248 | #define push(x, l) ((l) = cons(x, l)) 249 | #define apush(x, y, l) push(cons(x, y), l) 250 | #define acons(x, y, l) cons(cons(x, y), l) 251 | #define reassoc(x, y, l) reassoc_(x, y, &l) 252 | 253 | #define add_attr(attr, node, value) apush(attr, value, attrs(node)) 254 | 255 | #define alist1(k1, v1) acons(k1, v1, nil) 256 | #define alist2(k1, v1, k2, v2) acons(k1, v1, alist1(k2, v2)) 257 | #define alist3(k1, v1, k2, v2, k3, v3) acons(k1, v1, alist2(k2, v2, k3, v3)) 258 | 259 | #define dolist(__crscl_x_temp__, __crscl_l_temp__) { \ 260 | lv *__crscl_x_temp__, *__crscl_l_local_temp__; \ 261 | for (__crscl_l_local_temp__ = (__crscl_l_temp__); \ 262 | __crscl_l_local_temp__ != (lv*) 0; \ 263 | __crscl_l_local_temp__ = tl(__crscl_l_local_temp__)) { \ 264 | __crscl_x_temp__ = hd(__crscl_l_local_temp__); { 265 | 266 | #define tsilod }}} 267 | #define end_dolist }}} 268 | 269 | #define strsave(x) (str(string(x))) 270 | #define strsavel(x, l) (str(stringl(x, l))) 271 | 272 | #define nil ((lv*) 0) 273 | 274 | /* 275 | * Symbol hashing 276 | */ 277 | 278 | /* Old. Se comment below 279 | #define L_HBITS 11 280 | #define L_HSHIFT 3 281 | #define L_HSIZE (1 << L_HBITS) 282 | #define L_HMASK (L_HSIZE - 1) 283 | */ 284 | 285 | #ifndef _CRSCL_LISP_I 286 | 287 | /* extern lv *shtab[]; 288 | * This variable needs to be allocated by the programs that want to 289 | * use the lisp library. 290 | * 291 | * A typical declaration would be 292 | 293 | lv* shtab[L_HSIZE]; 294 | 295 | * Marco Antoniotti 19971023 296 | * 297 | * 298 | * Better still, the two macro below can be safely used. 299 | * 300 | * 2000-08-19 Marco Antoniotti 301 | * 302 | * The presence of shtab here is not warranted. It was needed in the 303 | * old SHIFT embedded implementation because of some funky setup. But 304 | * the shtab is accessed solely via 'intern' and 'clear_crscl_tables', 305 | * hence it (and its support macros) can be removed from here. 306 | * 307 | * 2001-05-18 Marco Antoniotti 308 | */ 309 | 310 | /* Old 311 | #define INIT_CRSCL_TABLES() lv* shtab[L_HSIZE] 312 | #define USE_CRSCL_TABLES() extern lv* shtab[L_HSIZE] 313 | */ 314 | /* New definitions for back compatibility. */ 315 | #define INIT_CRSCL_TABLES() 316 | #define USE_CRSCL_TABLES() 317 | 318 | /* Old 319 | #define CLEAR_CRSCL_TABLES() { \ 320 | int __clr; \ 321 | for (__clr = 0; __clr < L_HSIZE ;__clr++) shtab[__clr] = 0; \ 322 | } 323 | */ 324 | 325 | /* New definition for back compatibility. */ 326 | #define CLEAR_CRSCL_TABLES() clear_crscl_tables() 327 | 328 | extern lv *intern(char *); 329 | extern int shash(char *); 330 | extern lv* crscl_table_ref(int t); 331 | extern int crscl_table_size(); 332 | extern void clear_crscl_tables(); 333 | 334 | #endif /* _CRSCL_LISP_I */ 335 | 336 | 337 | /* 338 | * Misc functions 339 | */ 340 | 341 | #ifndef _CRSCL_LISP_I 342 | 343 | extern rs *make_stream(char *str, readstream_kind typ); 344 | extern inline rs *make_stream_stream(FILE *); 345 | extern inline rs *make_string_stream(char *); 346 | extern inline int stream_stream_p(rs *); 347 | extern inline int string_stream_p(rs *); 348 | extern inline void close_stream(rs*); 349 | 350 | extern rs* standard_input; 351 | extern rs* standard_output; 352 | extern rs* standard_error; 353 | 354 | 355 | extern int crscl_read_base; 356 | extern lv *read_sexpr(char *); 357 | extern lv *read_sexpr1(rs *); 358 | extern lv *read_sexpr_list(rs *); 359 | extern lv *list_to_attrs(lv *); 360 | extern lv *read_sexpr_string(rs *); 361 | extern lv *read_sexpr_atom(rs *); 362 | extern lv *read_sexpr_symbol(rs *); 363 | extern lv *read_c_symbol(rs *); 364 | extern int write_sexpr(lv *, char *); 365 | extern void print(lv *); 366 | extern void write_sexpr1(lv *, FILE *); 367 | 368 | extern int lv_type_of(lv*); 369 | extern void fprint_lv_type(lv*, FILE*); 370 | extern void print_lv_type(lv*); 371 | 372 | extern inline lv *cons(lv *, lv *); 373 | extern lv *string(const char *); 374 | extern lv *stringl(char *, int); 375 | extern inline lv *fixnum(int); 376 | extern inline lv *double_float(double); 377 | extern lv *symbol(char *); 378 | extern lv *node(lv *, lv *, lv *); 379 | extern lv *attr(lv *, lv *); 380 | #define attr2(a1, a2, n) attr(a1, attr(a2, n)) 381 | #define attr3(a1, a2, a3, n) attr2(a1, a2, attr(a3, n)) 382 | extern void set_attr(lv *attr, lv *node, lv *value); 383 | extern void push_attr(lv *attr, lv *node, lv *value); 384 | extern lv *other(void *x); 385 | extern lv *assoc(lv *, lv *); 386 | extern int length(lv *); 387 | extern lv *nth(int, lv *); 388 | extern lv *nthcdr(int, lv *); 389 | 390 | extern lv* getf(lv* plist, lv* indicator); 391 | extern lv* getf1(lv* plist, lv* indicator, lv* default_value); 392 | extern lv* plist_get(lv* sym, lv* indicator); 393 | extern lv* setf_get(lv* sym, lv* indicator, lv* value); 394 | 395 | 396 | /* The 'list' function cannot reliably work in ANSI C environments, 397 | * due to the specs of . 398 | * Hence it is not made available. 399 | * 400 | * 2000-08-21 Marco Antoniotti 401 | */ 402 | /* extern lv *list(lv *, ...); */ 403 | 404 | extern lv *copy_tree(lv *); 405 | extern lv *copy_list(lv *); 406 | extern lv *nreverse(lv *); 407 | extern lv *nreverse2(lv *, lv *); 408 | extern lv *nconc(lv *, lv *); 409 | extern lv *append(lv *, lv *); 410 | extern lv *del_el(lv *, lv *); 411 | extern lv *mapcar(lv *(*)(lv *), lv *); 412 | extern lv *mapcarx(lv *(*)(), lv *, lv *); 413 | extern lv *mapcan(lv *(*)(lv *), lv *); 414 | extern void mapc(void (*)(lv *), lv *); 415 | extern void mapcx(void (*)(lv *, lv*), lv *, lv *); 416 | extern lv *member_op(lv *, lv *); 417 | extern lv *memq(lv *, lv *); 418 | extern lv *lalloc(void); 419 | extern void gc_set_root(lv *); 420 | extern void gc_clear_root(void); 421 | extern void gc(); 422 | extern void new_node_marker(); 423 | extern void mark_node(lv* node); 424 | extern int node_marked_p(lv* node); 425 | 426 | #endif /* _CRSCL_LISP_I */ 427 | 428 | #ifdef __cplusplus 429 | } /* extern "C" */ 430 | } /* namespace crscl */ 431 | #endif 432 | 433 | #endif /* _CRSCL_LISP_H */ 434 | 435 | /* end of file -- crscl.h -- */ 436 | -------------------------------------------------------------------------------- /common-lisp/pose.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright 2021 Lassi Kortela 2 | ;; SPDX-License-Identifier: ISC 3 | 4 | (defpackage #:pose 5 | (:use #:cl) 6 | (:shadow #:read) 7 | (:export #:read #:read-all #:*make-symbol*)) 8 | 9 | (in-package #:pose) 10 | 11 | (defvar +pose-eof+ (gensym "POSE-EOF-")) 12 | 13 | (defvar *make-symbol* #'intern) 14 | 15 | (defun pose-make-symbol (string) 16 | (funcall *make-symbol* string)) 17 | 18 | (defun pose-whitespace-char-p (char) 19 | (case char ((#\space #\tab #\newline #\return) t))) 20 | 21 | (defun pose-token-common-char-p (char) 22 | (or (char<= #\0 char #\9) 23 | (char<= #\A char #\Z) 24 | (char<= #\a char #\z) 25 | (not (null (position char "_$!?<=>+-*"))))) 26 | 27 | (defun pose-token-first-char-p (char) 28 | (or (pose-token-common-char-p char) 29 | (not (null (position char "/"))))) 30 | 31 | (defun pose-token-next-char-p (char) 32 | (or (pose-token-first-char-p char) 33 | (not (null (position char ".@~^%&"))))) 34 | 35 | (defun skip-char? (match) 36 | (let ((char (peek-char nil nil nil))) 37 | (and char 38 | (if (functionp match) (funcall match char) (char= match char)) 39 | (read-char)))) 40 | 41 | (defun skip-char* (match) 42 | (and (skip-char? match) 43 | (loop (unless (skip-char? match) (return t))))) 44 | 45 | (defun pose-valid-number-p (string) 46 | (with-input-from-string (*standard-input* string) 47 | (labels ((zero-to-nine-p (char) 48 | (char<= #\0 char #\9)) 49 | (one-to-nine-p (char) 50 | (char<= #\1 char #\9)) 51 | (dot-p (char) 52 | (char= #\. char)) 53 | (sign-p (char) 54 | (or (char= #\+ char) (char= #\- char))) 55 | (exponent-marker-p (char) 56 | (or (char= #\e char) (char= #\E char))) 57 | (read-fraction () 58 | (and (skip-char? #\.) 59 | (or (skip-char* #'zero-to-nine-p) 60 | (return-from pose-valid-number-p nil)))) 61 | (read-exponent () 62 | (and (skip-char? #'exponent-marker-p) 63 | (progn (skip-char? #'sign-p) 64 | (or (skip-char* #'zero-to-nine-p) 65 | (return-from pose-valid-number-p nil))))) 66 | (read-fraction-exponent () 67 | (read-fraction) 68 | (read-exponent) 69 | (null (peek-char nil nil nil))) 70 | (read-magnitude-fraction-exponent () 71 | (if (skip-char? #\0) 72 | (read-fraction-exponent) 73 | (and (skip-char? #'one-to-nine-p) 74 | (progn (skip-char* #'zero-to-nine-p) 75 | (read-fraction-exponent)))))) 76 | (skip-char? #\-) 77 | (read-magnitude-fraction-exponent)))) 78 | 79 | (defun parse-number-or-symbol (string) 80 | (or (and (pose-valid-number-p string) 81 | (read-from-string string)) 82 | (pose-make-symbol string))) 83 | 84 | (defun skip-rest-of-line (stream) 85 | (loop (let ((char (read-char stream nil))) 86 | (when (or (null char) (char= #\newline char)) 87 | (return))))) 88 | 89 | (defun skip-whitespace-and-comments (stream) 90 | (loop (let ((char (peek-char nil stream nil))) 91 | (cond ((null char) 92 | (return)) 93 | ((char= #\; char) 94 | (skip-rest-of-line stream)) 95 | ((pose-whitespace-char-p char) 96 | (read-char stream nil)) 97 | (t 98 | (return)))))) 99 | 100 | (defun read-token-as-string (stream) 101 | (let ((char (read-char stream nil))) 102 | (unless (pose-token-first-char-p char) 103 | (error "Not a token first char: ~S" char)) 104 | (with-output-to-string (out) 105 | (write-char char out) 106 | (loop (let ((char (peek-char nil stream nil))) 107 | (unless (and char (pose-token-next-char-p char)) 108 | (return)) 109 | (read-char stream nil) 110 | (write-char char out)))))) 111 | 112 | (declaim (ftype (function (stream) t) 113 | read-internal)) 114 | 115 | (defun pose-read-delimited-list (end-char stream) 116 | (let ((forms '())) 117 | (loop (progn (skip-whitespace-and-comments stream) 118 | (cond ((eql end-char (peek-char nil stream nil)) 119 | (read-char stream nil) 120 | (return (reverse forms))) 121 | (t 122 | (let ((form (read-internal stream))) 123 | (if (eq +pose-eof+ form) (error "Unterminated list") 124 | (push form forms))))))))) 125 | 126 | (defun read-string-escape (end-char stream) 127 | (let ((char (read-char stream nil))) 128 | (if (or (eql char #\\) 129 | (eql char end-char)) 130 | char 131 | (error "Unknown string escape: ~S" char)))) 132 | 133 | (defun read-delimited-string (end-char stream) 134 | (with-output-to-string (out) 135 | (loop (let ((char (read-char stream nil))) 136 | (cond ((null char) 137 | (error "Unterminated string: ~S" end-char)) 138 | ((char= end-char char) 139 | (return)) 140 | ((char= #\\ char) 141 | (write-char (read-string-escape end-char stream) out)) 142 | (t 143 | (write-char char out))))))) 144 | 145 | (defun read-internal (stream) 146 | (skip-whitespace-and-comments stream) 147 | (let ((char (peek-char nil stream nil))) 148 | (cond ((null char) 149 | +pose-eof+) 150 | ((pose-token-first-char-p char) 151 | (parse-number-or-symbol (read-token-as-string stream))) 152 | (t 153 | (let ((char (read-char stream nil))) 154 | (case char 155 | ((#\") (read-delimited-string #\" stream)) 156 | ((#\() (pose-read-delimited-list #\) stream)) 157 | ((#\)) (error "Stray closing parenthesis")) 158 | (t (error "Unknown character at top level: ~S" char)))))))) 159 | 160 | (defun read (&optional stream eof-error-p eof-value) 161 | (let ((stream (or stream *standard-input*))) 162 | (let ((form (read-internal stream))) 163 | (cond ((not (eq +pose-eof+ form)) form) 164 | (eof-error-p (error 'end-of-file)) 165 | (t eof-value))))) 166 | 167 | (defun read-all (&optional stream) 168 | (let ((stream (or stream *standard-input*))) 169 | (let ((forms '())) 170 | (loop (let ((form (read-internal stream))) 171 | (if (eq +pose-eof+ form) (return (reverse forms)) 172 | (push form forms))))))) 173 | -------------------------------------------------------------------------------- /csharp/.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | ## 4 | ## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore 5 | 6 | # User-specific files 7 | *.rsuser 8 | *.suo 9 | *.user 10 | *.userosscache 11 | *.sln.docstates 12 | 13 | # User-specific files (MonoDevelop/Xamarin Studio) 14 | *.userprefs 15 | 16 | # Mono auto generated files 17 | mono_crash.* 18 | 19 | # Build results 20 | [Dd]ebug/ 21 | [Dd]ebugPublic/ 22 | [Rr]elease/ 23 | [Rr]eleases/ 24 | x64/ 25 | x86/ 26 | [Aa][Rr][Mm]/ 27 | [Aa][Rr][Mm]64/ 28 | bld/ 29 | [Bb]in/ 30 | [Oo]bj/ 31 | [Ll]og/ 32 | [Ll]ogs/ 33 | 34 | # Visual Studio 2015/2017 cache/options directory 35 | .vs/ 36 | # Uncomment if you have tasks that create the project's static files in wwwroot 37 | #wwwroot/ 38 | 39 | # Visual Studio 2017 auto generated files 40 | Generated\ Files/ 41 | 42 | # MSTest test Results 43 | [Tt]est[Rr]esult*/ 44 | [Bb]uild[Ll]og.* 45 | 46 | # NUnit 47 | *.VisualState.xml 48 | TestResult.xml 49 | nunit-*.xml 50 | 51 | # Build Results of an ATL Project 52 | [Dd]ebugPS/ 53 | [Rr]eleasePS/ 54 | dlldata.c 55 | 56 | # Benchmark Results 57 | BenchmarkDotNet.Artifacts/ 58 | 59 | # .NET Core 60 | project.lock.json 61 | project.fragment.lock.json 62 | artifacts/ 63 | 64 | # Tye 65 | .tye/ 66 | 67 | # StyleCop 68 | StyleCopReport.xml 69 | 70 | # Files built by Visual Studio 71 | *_i.c 72 | *_p.c 73 | *_h.h 74 | *.ilk 75 | *.meta 76 | *.obj 77 | *.iobj 78 | *.pch 79 | *.pdb 80 | *.ipdb 81 | *.pgc 82 | *.pgd 83 | *.rsp 84 | *.sbr 85 | *.tlb 86 | *.tli 87 | *.tlh 88 | *.tmp 89 | *.tmp_proj 90 | *_wpftmp.csproj 91 | *.log 92 | *.vspscc 93 | *.vssscc 94 | .builds 95 | *.pidb 96 | *.svclog 97 | *.scc 98 | 99 | # Chutzpah Test files 100 | _Chutzpah* 101 | 102 | # Visual C++ cache files 103 | ipch/ 104 | *.aps 105 | *.ncb 106 | *.opendb 107 | *.opensdf 108 | *.sdf 109 | *.cachefile 110 | *.VC.db 111 | *.VC.VC.opendb 112 | 113 | # Visual Studio profiler 114 | *.psess 115 | *.vsp 116 | *.vspx 117 | *.sap 118 | 119 | # Visual Studio Trace Files 120 | *.e2e 121 | 122 | # TFS 2012 Local Workspace 123 | $tf/ 124 | 125 | # Guidance Automation Toolkit 126 | *.gpState 127 | 128 | # ReSharper is a .NET coding add-in 129 | _ReSharper*/ 130 | *.[Rr]e[Ss]harper 131 | *.DotSettings.user 132 | 133 | # TeamCity is a build add-in 134 | _TeamCity* 135 | 136 | # DotCover is a Code Coverage Tool 137 | *.dotCover 138 | 139 | # AxoCover is a Code Coverage Tool 140 | .axoCover/* 141 | !.axoCover/settings.json 142 | 143 | # Coverlet is a free, cross platform Code Coverage Tool 144 | coverage*[.json, .xml, .info] 145 | 146 | # Visual Studio code coverage results 147 | *.coverage 148 | *.coveragexml 149 | 150 | # NCrunch 151 | _NCrunch_* 152 | .*crunch*.local.xml 153 | nCrunchTemp_* 154 | 155 | # MightyMoose 156 | *.mm.* 157 | AutoTest.Net/ 158 | 159 | # Web workbench (sass) 160 | .sass-cache/ 161 | 162 | # Installshield output folder 163 | [Ee]xpress/ 164 | 165 | # DocProject is a documentation generator add-in 166 | DocProject/buildhelp/ 167 | DocProject/Help/*.HxT 168 | DocProject/Help/*.HxC 169 | DocProject/Help/*.hhc 170 | DocProject/Help/*.hhk 171 | DocProject/Help/*.hhp 172 | DocProject/Help/Html2 173 | DocProject/Help/html 174 | 175 | # Click-Once directory 176 | publish/ 177 | 178 | # Publish Web Output 179 | *.[Pp]ublish.xml 180 | *.azurePubxml 181 | # Note: Comment the next line if you want to checkin your web deploy settings, 182 | # but database connection strings (with potential passwords) will be unencrypted 183 | *.pubxml 184 | *.publishproj 185 | 186 | # Microsoft Azure Web App publish settings. Comment the next line if you want to 187 | # checkin your Azure Web App publish settings, but sensitive information contained 188 | # in these scripts will be unencrypted 189 | PublishScripts/ 190 | 191 | # NuGet Packages 192 | *.nupkg 193 | # NuGet Symbol Packages 194 | *.snupkg 195 | # The packages folder can be ignored because of Package Restore 196 | **/[Pp]ackages/* 197 | # except build/, which is used as an MSBuild target. 198 | !**/[Pp]ackages/build/ 199 | # Uncomment if necessary however generally it will be regenerated when needed 200 | #!**/[Pp]ackages/repositories.config 201 | # NuGet v3's project.json files produces more ignorable files 202 | *.nuget.props 203 | *.nuget.targets 204 | 205 | # Microsoft Azure Build Output 206 | csx/ 207 | *.build.csdef 208 | 209 | # Microsoft Azure Emulator 210 | ecf/ 211 | rcf/ 212 | 213 | # Windows Store app package directories and files 214 | AppPackages/ 215 | BundleArtifacts/ 216 | Package.StoreAssociation.xml 217 | _pkginfo.txt 218 | *.appx 219 | *.appxbundle 220 | *.appxupload 221 | 222 | # Visual Studio cache files 223 | # files ending in .cache can be ignored 224 | *.[Cc]ache 225 | # but keep track of directories ending in .cache 226 | !?*.[Cc]ache/ 227 | 228 | # Others 229 | ClientBin/ 230 | ~$* 231 | *~ 232 | *.dbmdl 233 | *.dbproj.schemaview 234 | *.jfm 235 | *.pfx 236 | *.publishsettings 237 | orleans.codegen.cs 238 | 239 | # Including strong name files can present a security risk 240 | # (https://github.com/github/gitignore/pull/2483#issue-259490424) 241 | #*.snk 242 | 243 | # Since there are multiple workflows, uncomment next line to ignore bower_components 244 | # (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) 245 | #bower_components/ 246 | 247 | # RIA/Silverlight projects 248 | Generated_Code/ 249 | 250 | # Backup & report files from converting an old project file 251 | # to a newer Visual Studio version. Backup files are not needed, 252 | # because we have git ;-) 253 | _UpgradeReport_Files/ 254 | Backup*/ 255 | UpgradeLog*.XML 256 | UpgradeLog*.htm 257 | ServiceFabricBackup/ 258 | *.rptproj.bak 259 | 260 | # SQL Server files 261 | *.mdf 262 | *.ldf 263 | *.ndf 264 | 265 | # Business Intelligence projects 266 | *.rdl.data 267 | *.bim.layout 268 | *.bim_*.settings 269 | *.rptproj.rsuser 270 | *- [Bb]ackup.rdl 271 | *- [Bb]ackup ([0-9]).rdl 272 | *- [Bb]ackup ([0-9][0-9]).rdl 273 | 274 | # Microsoft Fakes 275 | FakesAssemblies/ 276 | 277 | # GhostDoc plugin setting file 278 | *.GhostDoc.xml 279 | 280 | # Node.js Tools for Visual Studio 281 | .ntvs_analysis.dat 282 | node_modules/ 283 | 284 | # Visual Studio 6 build log 285 | *.plg 286 | 287 | # Visual Studio 6 workspace options file 288 | *.opt 289 | 290 | # Visual Studio 6 auto-generated workspace file (contains which files were open etc.) 291 | *.vbw 292 | 293 | # Visual Studio LightSwitch build output 294 | **/*.HTMLClient/GeneratedArtifacts 295 | **/*.DesktopClient/GeneratedArtifacts 296 | **/*.DesktopClient/ModelManifest.xml 297 | **/*.Server/GeneratedArtifacts 298 | **/*.Server/ModelManifest.xml 299 | _Pvt_Extensions 300 | 301 | # Paket dependency manager 302 | .paket/paket.exe 303 | paket-files/ 304 | 305 | # FAKE - F# Make 306 | .fake/ 307 | 308 | # Ionide - VsCode extension for F# Support 309 | .ionide/ 310 | 311 | # CodeRush personal settings 312 | .cr/personal 313 | 314 | # Python Tools for Visual Studio (PTVS) 315 | __pycache__/ 316 | *.pyc 317 | 318 | # Cake - Uncomment if you are using it 319 | # tools/** 320 | # !tools/packages.config 321 | 322 | # Tabs Studio 323 | *.tss 324 | 325 | # Telerik's JustMock configuration file 326 | *.jmconfig 327 | 328 | # BizTalk build output 329 | *.btp.cs 330 | *.btm.cs 331 | *.odx.cs 332 | *.xsd.cs 333 | 334 | # OpenCover UI analysis results 335 | OpenCover/ 336 | 337 | # Azure Stream Analytics local run output 338 | ASALocalRun/ 339 | 340 | # MSBuild Binary and Structured Log 341 | *.binlog 342 | 343 | # NVidia Nsight GPU debugger configuration file 344 | *.nvuser 345 | 346 | # MFractors (Xamarin productivity tool) working folder 347 | .mfractor/ 348 | 349 | # Local History for Visual Studio 350 | .localhistory/ 351 | 352 | # BeatPulse healthcheck temp database 353 | healthchecksdb 354 | 355 | # Backup folder for Package Reference Convert tool in Visual Studio 2017 356 | MigrationBackup/ 357 | 358 | # Ionide (cross platform F# VS Code tools) working folder 359 | .ionide/ 360 | 361 | ## 362 | ## Visual studio for Mac 363 | ## 364 | 365 | 366 | # globs 367 | Makefile.in 368 | *.userprefs 369 | *.usertasks 370 | config.make 371 | config.status 372 | aclocal.m4 373 | install-sh 374 | autom4te.cache/ 375 | *.tar.gz 376 | tarballs/ 377 | test-results/ 378 | 379 | # Mac bundle stuff 380 | *.dmg 381 | *.app 382 | 383 | # content below from: https://github.com/github/gitignore/blob/master/Global/macOS.gitignore 384 | # General 385 | .DS_Store 386 | .AppleDouble 387 | .LSOverride 388 | 389 | # Icon must end with two \r 390 | Icon 391 | 392 | 393 | # Thumbnails 394 | ._* 395 | 396 | # Files that might appear in the root of a volume 397 | .DocumentRevisions-V100 398 | .fseventsd 399 | .Spotlight-V100 400 | .TemporaryItems 401 | .Trashes 402 | .VolumeIcon.icns 403 | .com.apple.timemachine.donotpresent 404 | 405 | # Directories potentially created on remote AFP share 406 | .AppleDB 407 | .AppleDesktop 408 | Network Trash Folder 409 | Temporary Items 410 | .apdisk 411 | 412 | # content below from: https://github.com/github/gitignore/blob/master/Global/Windows.gitignore 413 | # Windows thumbnail cache files 414 | Thumbs.db 415 | ehthumbs.db 416 | ehthumbs_vista.db 417 | 418 | # Dump file 419 | *.stackdump 420 | 421 | # Folder config file 422 | [Dd]esktop.ini 423 | 424 | # Recycle Bin used on file shares 425 | $RECYCLE.BIN/ 426 | 427 | # Windows Installer files 428 | *.cab 429 | *.msi 430 | *.msix 431 | *.msm 432 | *.msp 433 | 434 | # Windows shortcuts 435 | *.lnk 436 | 437 | # JetBrains Rider 438 | .idea/ 439 | *.sln.iml 440 | 441 | ## 442 | ## Visual Studio Code 443 | ## 444 | .vscode/* 445 | !.vscode/settings.json 446 | !.vscode/tasks.json 447 | !.vscode/launch.json 448 | !.vscode/extensions.json 449 | -------------------------------------------------------------------------------- /csharp/Pose.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 16 4 | VisualStudioVersion = 16.6.30114.105 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "src", "src", "{5EEB672F-DD14-47FD-B96D-FD22902F0DA7}" 7 | EndProject 8 | Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Pose", "src\Pose\Pose.csproj", "{B422312B-701B-424C-918D-41F161A3168A}" 9 | EndProject 10 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{838041A4-9C24-4A1D-B401-9617F6A14728}" 11 | EndProject 12 | Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Tests", "tests\Tests\Tests.csproj", "{D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}" 13 | EndProject 14 | Global 15 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 16 | Debug|Any CPU = Debug|Any CPU 17 | Debug|x64 = Debug|x64 18 | Debug|x86 = Debug|x86 19 | Release|Any CPU = Release|Any CPU 20 | Release|x64 = Release|x64 21 | Release|x86 = Release|x86 22 | EndGlobalSection 23 | GlobalSection(SolutionProperties) = preSolution 24 | HideSolutionNode = FALSE 25 | EndGlobalSection 26 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 27 | {B422312B-701B-424C-918D-41F161A3168A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 28 | {B422312B-701B-424C-918D-41F161A3168A}.Debug|Any CPU.Build.0 = Debug|Any CPU 29 | {B422312B-701B-424C-918D-41F161A3168A}.Debug|x64.ActiveCfg = Debug|Any CPU 30 | {B422312B-701B-424C-918D-41F161A3168A}.Debug|x64.Build.0 = Debug|Any CPU 31 | {B422312B-701B-424C-918D-41F161A3168A}.Debug|x86.ActiveCfg = Debug|Any CPU 32 | {B422312B-701B-424C-918D-41F161A3168A}.Debug|x86.Build.0 = Debug|Any CPU 33 | {B422312B-701B-424C-918D-41F161A3168A}.Release|Any CPU.ActiveCfg = Release|Any CPU 34 | {B422312B-701B-424C-918D-41F161A3168A}.Release|Any CPU.Build.0 = Release|Any CPU 35 | {B422312B-701B-424C-918D-41F161A3168A}.Release|x64.ActiveCfg = Release|Any CPU 36 | {B422312B-701B-424C-918D-41F161A3168A}.Release|x64.Build.0 = Release|Any CPU 37 | {B422312B-701B-424C-918D-41F161A3168A}.Release|x86.ActiveCfg = Release|Any CPU 38 | {B422312B-701B-424C-918D-41F161A3168A}.Release|x86.Build.0 = Release|Any CPU 39 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 40 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Debug|Any CPU.Build.0 = Debug|Any CPU 41 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Debug|x64.ActiveCfg = Debug|Any CPU 42 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Debug|x64.Build.0 = Debug|Any CPU 43 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Debug|x86.ActiveCfg = Debug|Any CPU 44 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Debug|x86.Build.0 = Debug|Any CPU 45 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Release|Any CPU.ActiveCfg = Release|Any CPU 46 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Release|Any CPU.Build.0 = Release|Any CPU 47 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Release|x64.ActiveCfg = Release|Any CPU 48 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Release|x64.Build.0 = Release|Any CPU 49 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Release|x86.ActiveCfg = Release|Any CPU 50 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98}.Release|x86.Build.0 = Release|Any CPU 51 | EndGlobalSection 52 | GlobalSection(NestedProjects) = preSolution 53 | {B422312B-701B-424C-918D-41F161A3168A} = {5EEB672F-DD14-47FD-B96D-FD22902F0DA7} 54 | {D8C0723F-C3BE-4541-9DF6-E11A9B9CFB98} = {838041A4-9C24-4A1D-B401-9617F6A14728} 55 | EndGlobalSection 56 | EndGlobal 57 | -------------------------------------------------------------------------------- /csharp/src/Pose/Pose.cs: -------------------------------------------------------------------------------- 1 | // Copyright 2021 Lassi Kortela 2 | // Copyright 2021 Oskar Gewalli 3 | // SPDX-License-Identifier: ISC 4 | using System; 5 | using System.Collections.Generic; 6 | using System.IO; 7 | using System.Runtime.Serialization; 8 | using System.Text; 9 | using System.Threading.Tasks; 10 | 11 | namespace Pose 12 | { 13 | public interface IExpression 14 | { 15 | Task Write(StreamWriter wr); 16 | } 17 | public readonly struct List : IExpression 18 | { 19 | public List(IReadOnlyList value) 20 | { 21 | Value = value; 22 | } 23 | 24 | public IReadOnlyList Value { get; } 25 | 26 | 27 | public async Task Write(StreamWriter wr) 28 | { 29 | var n = Value.Count; 30 | if (n == 0) 31 | { 32 | await wr.WriteAsync("()"); 33 | return; 34 | } 35 | 36 | var prefix = "("; 37 | for (int i = 0; i < n; i++) 38 | { 39 | await wr.WriteAsync(prefix); 40 | await Value[i].Write(wr); 41 | prefix = " "; 42 | } 43 | await wr.WriteAsync(")"); 44 | } 45 | } 46 | public readonly struct Symbol : IExpression 47 | { 48 | public Symbol(string value) 49 | { 50 | Value = value; 51 | } 52 | 53 | public string Value { get; } 54 | public async Task Write(StreamWriter wr) 55 | { 56 | await wr.WriteAsync(Value); 57 | } 58 | } 59 | public readonly struct String : IExpression 60 | { 61 | public String(string value) 62 | { 63 | Value = value; 64 | } 65 | 66 | public string Value { get; } 67 | public async Task Write(StreamWriter wr) 68 | { 69 | await wr.WriteAsync($"\"{Escape(Value)}\""); 70 | } 71 | private static string Escape(string value) 72 | { 73 | char[] toEscape = "\\\"".ToCharArray(); 74 | var sb = new StringBuilder(); 75 | var currentIndex = 0; 76 | while (currentIndex < value.Length) 77 | { 78 | var indexOf = value.IndexOfAny(toEscape, currentIndex); 79 | if (indexOf >= 0) 80 | { 81 | var nextLength = indexOf - currentIndex; 82 | sb.Append(value.Substring(currentIndex, nextLength)); 83 | sb.Append("\\"); 84 | sb.Append(value.Substring(indexOf, 1)); 85 | currentIndex = indexOf + 1; 86 | } 87 | else 88 | { 89 | sb.Append(value.Substring(currentIndex, value.Length - currentIndex)); 90 | break; 91 | } 92 | } 93 | return sb.ToString(); 94 | } 95 | } 96 | public readonly struct Float64 : IExpression 97 | { 98 | public Float64(double value) 99 | { 100 | Value = value; 101 | } 102 | 103 | public double Value { get; } 104 | public async Task Write(StreamWriter wr) 105 | { 106 | // TODO: what should the output be here? 107 | await wr.WriteAsync($"{Value}"); 108 | } 109 | } 110 | public readonly struct FixInt : IExpression 111 | { 112 | public FixInt(int value) 113 | { 114 | Value = value; 115 | } 116 | 117 | public int Value { get; } 118 | public async Task Write(StreamWriter wr) 119 | { 120 | // TODO: what should the output be here? 121 | await wr.WriteAsync($"{Value}"); 122 | } 123 | } 124 | public readonly struct BigInt : IExpression 125 | { 126 | public BigInt(long value) 127 | { 128 | Value = value; 129 | } 130 | 131 | public long Value { get; } 132 | public async Task Write(StreamWriter wr) 133 | { 134 | // TODO: what should the output be here? 135 | await wr.WriteAsync($"{Value}"); 136 | } 137 | } 138 | public class PoseReader 139 | { 140 | private static bool IsWhitespaceByte(char c) 141 | { 142 | return (c == ' ') || (c == '\t') || (c == '\n') || (c == '\r'); 143 | } 144 | 145 | private static bool IsTokenFirstByte(char c) 146 | { 147 | return (('0' <= c && c <= '9') || 148 | ('A' <= c && c <= 'Z') || 149 | ('a' <= c && c <= 'z') || 150 | "_$!?<=>+-*/".Contains(c)); 151 | } 152 | 153 | private static bool IsTokenNextByte(char c) 154 | { 155 | return IsTokenFirstByte(c) || ".@~^%&".Contains(c); 156 | } 157 | 158 | private static IExpression ParseInteger(string s, int radix) 159 | { 160 | return new Symbol(s); 161 | } 162 | private static IExpression ParseNumberOrSymbol(string s, int radix) 163 | { 164 | return new Symbol(s); 165 | } 166 | 167 | private static char? PeekByte(BinaryReader reader) 168 | { 169 | if (reader.BaseStream.Position >= reader.BaseStream.Length) return null; 170 | var originalPosition = reader.BaseStream.Position; 171 | var read = reader.ReadChar(); 172 | reader.BaseStream.Position = originalPosition; 173 | return read; 174 | } 175 | 176 | private static void SkipRestOfLine(BinaryReader reader) 177 | { 178 | do 179 | { 180 | var c = reader.ReadChar(); 181 | if (c == '\n') break; 182 | } while (reader.BaseStream.Position < reader.BaseStream.Length); 183 | } 184 | private static void SkipWhitespaceAndComments(BinaryReader reader) 185 | { 186 | do 187 | { 188 | var c = PeekByte(reader); 189 | if (c is null) break; 190 | if (c == ';') 191 | { 192 | SkipRestOfLine(reader); 193 | } 194 | else if (IsWhitespaceByte(c.Value)) 195 | { 196 | reader.ReadChar(); 197 | } 198 | else 199 | { 200 | break; 201 | } 202 | } while (reader.BaseStream.Position < reader.BaseStream.Length); 203 | } 204 | 205 | 206 | static string ReadTokenAsString(BinaryReader rd) 207 | { 208 | var c1 = rd.ReadChar(); 209 | 210 | if (!IsTokenFirstByte(c1)) 211 | { 212 | throw new SyntaxErrorException("Not a token first byte"); 213 | } 214 | 215 | var ans = new StringBuilder(); 216 | ans.Append(c1); 217 | while (true) 218 | { 219 | var c = PeekByte(rd); 220 | if (c is null) 221 | { 222 | break; 223 | } 224 | 225 | if (!IsTokenNextByte(c.Value)) 226 | { 227 | break; 228 | } 229 | 230 | c = rd.ReadChar(); 231 | ans.Append(c); 232 | } 233 | 234 | return ans.ToString(); 235 | } 236 | 237 | 238 | private static IExpression ReadSharpsign(BinaryReader rd) 239 | { 240 | var c = rd.ReadChar(); 241 | var radix = c switch 242 | { 243 | 'b' => 2, 244 | 'o' => 8, 245 | 'x' => 16, 246 | _ => 0 247 | }; 248 | if (radix == 0) 249 | { 250 | throw new SyntaxErrorException("Unknown #"); 251 | } 252 | 253 | var token = ReadTokenAsString(rd); 254 | var value = ParseInteger(token, radix); 255 | /*if err != nil { 256 | return nil, makeSyntaxError("Cannot parse integer from token") 257 | }*/ 258 | return value; 259 | } 260 | 261 | private static IExpression ReadDelimitedList(BinaryReader rd, char endByte) 262 | { 263 | var exps = new List(); 264 | while (true) 265 | { 266 | SkipWhitespaceAndComments(rd); 267 | 268 | var c = PeekByte(rd); 269 | if (c is null) 270 | { 271 | throw new SyntaxErrorException("Unterminated list"); 272 | } 273 | else if (c == endByte) 274 | { 275 | rd.ReadChar(); 276 | break; 277 | } 278 | else 279 | { 280 | var exp = Read(rd); 281 | if (exp is null) 282 | { 283 | throw new SyntaxErrorException("Unterminated list"); 284 | } 285 | exps.Add(exp); 286 | } 287 | } 288 | 289 | return new List(exps.ToArray()); 290 | } 291 | 292 | private static char ReadStringEscape(BinaryReader rd, char endByte) 293 | { 294 | if (rd.BaseStream.Position >= rd.BaseStream.Length) 295 | { 296 | throw new SyntaxErrorException("Unterminated string escape"); 297 | } 298 | var c = rd.ReadChar(); 299 | switch (c) 300 | { 301 | case 'n': 302 | c = '\n'; 303 | break; 304 | case 't': 305 | c = '\t'; 306 | break; 307 | default: 308 | { 309 | if (c != '\\' && c != endByte) 310 | { 311 | throw new System.Data.SyntaxErrorException("Unknown string escape"); 312 | } 313 | break; 314 | } 315 | } 316 | return c; 317 | } 318 | 319 | private static string ReadDelimitedString(BinaryReader rd, char endByte) 320 | { 321 | var ans = new StringBuilder(); 322 | while (true) 323 | { 324 | if (rd.BaseStream.Position >= rd.BaseStream.Length) 325 | { 326 | throw new SyntaxErrorException("Unterminated string escape"); 327 | } 328 | var c = rd.ReadChar(); 329 | if (c == endByte) 330 | { 331 | break; 332 | } 333 | else if (c == '\\') 334 | { 335 | c = ReadStringEscape(rd, endByte); 336 | } 337 | 338 | ans.Append(c); 339 | } 340 | 341 | return ans.ToString(); 342 | } 343 | 344 | private static IExpression Read(BinaryReader rd) 345 | { 346 | SkipWhitespaceAndComments(rd); 347 | var c = PeekByte(rd); 348 | if (c is null) 349 | { 350 | return null; 351 | } 352 | 353 | if (IsTokenFirstByte(c.Value)) 354 | { 355 | var token = ReadTokenAsString(rd); 356 | return ParseNumberOrSymbol(token, default); 357 | } 358 | c = rd.ReadChar(); 359 | switch (c) 360 | { 361 | case '#': 362 | return ReadSharpsign(rd); 363 | case '|': 364 | { 365 | var s = ReadDelimitedString(rd, c.Value); 366 | return new Symbol(s); 367 | } 368 | case '"': 369 | { 370 | var s = ReadDelimitedString(rd, c.Value); 371 | return new String(s); 372 | } 373 | case '(': 374 | return ReadDelimitedList(rd, ')'); 375 | case ')': 376 | throw new SyntaxErrorException("Stray closing parenthesis"); 377 | default: 378 | throw new SyntaxErrorException($"Unknown byte at top level: {c}"); 379 | } 380 | } 381 | 382 | public IExpression[] ReadAll(BinaryReader rd) 383 | { 384 | var exps = new List(); 385 | while (true) 386 | { 387 | var exp = Read(rd); 388 | if (exp is null) break; 389 | exps.Add(exp); 390 | } 391 | 392 | return exps.ToArray(); 393 | } 394 | } 395 | 396 | [Serializable] 397 | public class SyntaxErrorException : Exception 398 | { 399 | public SyntaxErrorException() 400 | { 401 | } 402 | 403 | public SyntaxErrorException(string message) : base(message) 404 | { 405 | } 406 | 407 | public SyntaxErrorException(string message, Exception inner) : base(message, inner) 408 | { 409 | } 410 | 411 | protected SyntaxErrorException( 412 | SerializationInfo info, 413 | StreamingContext context) : base(info, context) 414 | { 415 | } 416 | } 417 | } 418 | -------------------------------------------------------------------------------- /csharp/src/Pose/Pose.csproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | netstandard2.1 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /csharp/tests/Tests/PoseReaderTests.cs: -------------------------------------------------------------------------------- 1 | // Copyright 2021 Lassi Kortela 2 | // Copyright 2021 Oskar Gewalli 3 | // SPDX-License-Identifier: ISC 4 | using System; 5 | using System.IO; 6 | using System.Linq; 7 | using System.Threading.Tasks; 8 | using Pose; 9 | using System.Collections.Generic; 10 | using Xunit; 11 | 12 | namespace Tests 13 | { 14 | public class PoseReaderTests 15 | { 16 | [Theory, 17 | InlineData("(symbol \"value\")", "(symbol \"value\")"), 18 | InlineData("\"value\"", "\"value\""), 19 | InlineData("; Foo", ""), 20 | InlineData(" ; Bar", ""), 21 | InlineData("( 1 2 (|asdo\\|aisdj| \"dfdosi dsi\"))", "(1 2 (asdo|aisdj \"dfdosi dsi\"))"), 22 | InlineData("()", "()"), 23 | ] 24 | public async Task Can_parse_and_stringify(string sample,string expected) 25 | { 26 | IExpression[] exps; 27 | { 28 | await using var stream = new MemoryStream(); 29 | using var rd = new BinaryReader(stream); 30 | await using var w = new StreamWriter(stream); 31 | await w.WriteAsync(sample); 32 | await w.FlushAsync(); 33 | stream.Seek(0, SeekOrigin.Begin); 34 | exps=new PoseReader().ReadAll(rd); 35 | } 36 | string written = null; 37 | { 38 | await using var stream = new MemoryStream(); 39 | await using var w = new StreamWriter(stream); 40 | foreach (var exp in exps) 41 | { 42 | await exp.Write(w); 43 | } 44 | await w.FlushAsync(); 45 | stream.Seek(0, SeekOrigin.Begin); 46 | 47 | using var rd = new StreamReader(stream); 48 | written = await rd.ReadToEndAsync(); 49 | } 50 | Assert.Equal(expected, written); 51 | } 52 | 53 | [Theory, 54 | MemberData(nameof(ExampleTestFiles))] 55 | public async Task Example_test_files_can_be_parsed_and_stringified(string file,string expectedFile) 56 | { 57 | IExpression[] exps; 58 | { 59 | using var stream = File.OpenRead(file); 60 | using var rd = new BinaryReader(stream); 61 | exps=new PoseReader().ReadAll(rd); 62 | } 63 | string written = null; 64 | { 65 | await using var stream = new MemoryStream(); 66 | await using var w = new StreamWriter(stream); 67 | foreach (var exp in exps) 68 | { 69 | await exp.Write(w); 70 | } 71 | await w.FlushAsync(); 72 | stream.Seek(0, SeekOrigin.Begin); 73 | 74 | using var rd = new StreamReader(stream); 75 | written = await rd.ReadToEndAsync(); 76 | } 77 | var expected = await File.ReadAllTextAsync(expectedFile); 78 | Assert.Equal(expected.Trim(), written.Trim()); 79 | } 80 | public static IEnumerable ExampleTestFiles => 81 | from file in Directory.EnumerateFiles(".","*.pose") 82 | select new object[]{file, Path.ChangeExtension(file, "result")}; 83 | 84 | } 85 | } 86 | -------------------------------------------------------------------------------- /csharp/tests/Tests/Tests.csproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net5.0 5 | 6 | false 7 | 8 | 9 | 10 | 11 | 12 | 13 | runtime; build; native; contentfiles; analyzers; buildtransitive 14 | all 15 | 16 | 17 | runtime; build; native; contentfiles; analyzers; buildtransitive 18 | all 19 | 20 | 21 | 22 | 23 | 24 | %(RecursiveDir)%(FileName)%(Extension) 25 | Always 26 | 27 | 28 | %(RecursiveDir)%(FileName)%(Extension) 29 | Always 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /emacs-lisp/pose.el: -------------------------------------------------------------------------------- 1 | ;; Copyright 2021 Lassi Kortela 2 | ;; SPDX-License-Identifier: ISC 3 | 4 | (defconst pose--eof (gensym "pose--eof-")) 5 | 6 | (defun pose--whitespace-char-p (char) 7 | (or (eql ?\s char) 8 | (eql ?\t char) 9 | (eql ?\n char))) 10 | 11 | (defun pose--token-first-char-p (char) 12 | (or (<= ?A char ?Z) 13 | (<= ?a char ?z) 14 | (<= ?0 char ?9) 15 | (not (not (string-match-p "[_$!?<=>+*/-]" (string char)))))) 16 | 17 | (defun pose--token-next-char-p (char) 18 | (or (pose--token-first-char-p char) 19 | (not (not (string-match-p "[.@~^%&]" (string char)))))) 20 | 21 | (defun pose--string-to-symbol (string) 22 | (make-symbol string)) 23 | 24 | (defun pose--parse-integer (string radix) 25 | nil) 26 | 27 | (defun pose--parse-number-or-symbol (string) 28 | (pose--string-to-symbol string)) 29 | 30 | (defun pose--peek-char () 31 | (if (eobp) nil (char-after))) 32 | 33 | (defun pose--read-char () 34 | (if (eobp) nil (prog1 (char-after) (goto-char (1+ (point)))))) 35 | 36 | (defun pose--skip-rest-of-line () 37 | (while (let ((char (pose--read-char))) 38 | (and char (not (eql ?\n char)))))) 39 | 40 | (defun pose--skip-whitespace-and-comments () 41 | (while (let ((char (pose--peek-char))) 42 | (cond ((not char) 43 | nil) 44 | ((eql ?\; char) 45 | (pose--skip-rest-of-line) 46 | t) 47 | ((pose--whitespace-char-p char) 48 | (pose--read-char) 49 | t) 50 | (t nil))))) 51 | 52 | (defun pose--read-token-as-string () 53 | (let ((char (pose--read-char))) 54 | (unless (pose--token-first-char-p char) 55 | (error "Not a token first char: %s" char)) 56 | (let ((chars (string char))) 57 | (while (let ((char (pose--peek-char))) 58 | (cond ((and char (pose--token-next-char-p char)) 59 | (setq chars (concat chars (string (pose--read-char))))) 60 | (t nil)))) 61 | chars))) 62 | 63 | (defun pose--read-sharpsign () 64 | (error "TODO")) 65 | 66 | (defun pose--read-delimited-list (end-char) 67 | (let ((forms '())) 68 | (while (progn (pose--skip-whitespace-and-comments) 69 | (not (when (eql end-char (pose--peek-char)) 70 | (pose--read-char) 71 | t))) 72 | (let ((form (pose--read-or-eof))) 73 | (if (eq pose--eof form) 74 | (error "Unterminated list") 75 | (push form forms)))) 76 | (reverse forms))) 77 | 78 | (defun pose--read-string-escape () 79 | (let ((char (pose--read-char))) 80 | (if (eql pose--eof char) 81 | (error "Unterminated string escape") 82 | (case char 83 | ((?\n) "\n") 84 | ((?\t) "\t") 85 | ((?\\ ?\| ?\") (string char)) 86 | (t (error "Unknown string escape: %s" (string char))))))) 87 | 88 | (defun pose--read-delimited-string (end-char) 89 | (let ((chars "") (more t)) 90 | (while more 91 | (let ((char (pose--read-char))) 92 | (cond ((eql pose--eof char) 93 | (error "Unterminated string, expecting %s" end-char)) 94 | ((eql end-char char) 95 | (setq more nil)) 96 | ((eql ?\\ char) 97 | (setq chars (concat chars (pose--read-string-escape)))) 98 | (t 99 | (setq chars (concat chars (string char))))))) 100 | chars)) 101 | 102 | (defun pose--read-or-eof () 103 | (pose--skip-whitespace-and-comments) 104 | (let ((char (pose--peek-char))) 105 | (cond ((not char) 106 | pose--eof) 107 | ((pose--token-first-char-p char) 108 | (pose--parse-number-or-symbol (pose--read-token-as-string))) 109 | (t 110 | (let ((char (pose--read-char))) 111 | (case char 112 | ((?\#) (pose--read-sharpsign)) 113 | ((?\|) (pose--string-to-symbol 114 | (pose--read-delimited-string ?\|))) 115 | ((?\") (pose--read-delimited-string ?\")) 116 | ((?\() (pose--read-delimited-list ?\))) 117 | ((?\)) (error "Stray closing parenthesis")) 118 | (else (error "Unknown character at top level: %S" char)))))))) 119 | 120 | (defun pose-read () 121 | (let ((form (pose--read-or-eof))) 122 | (if (eql pose--eof form) (signal 'end-of-file '()) form))) 123 | 124 | (defun pose-read-all () 125 | (let (forms form) 126 | (while (not (eql pose--eof (setq form (pose--read-or-eof)))) 127 | (push form forms)) 128 | (reverse forms))) 129 | 130 | (defun pose--write-with-vertical-bars-p (string) 131 | nil) 132 | 133 | (provide 'pose) 134 | -------------------------------------------------------------------------------- /examples/hello.pose: -------------------------------------------------------------------------------- 1 | ; Foo 2 | ; Bar 3 | 4 | ( 1 2 (|asdo\|aisdj| "dfdosi dsi")) 5 | () 6 | -------------------------------------------------------------------------------- /examples/numbers-and-symbols.pose: -------------------------------------------------------------------------------- 1 | 0 2 | -1 3 | -0.1 4 | 123 5 | 1234 6 | 1234e5 7 | 1234e+5 8 | 1234E+5 9 | 1234E-5 10 | -------------------------------------------------------------------------------- /examples/test/comment.pose: -------------------------------------------------------------------------------- 1 | ; comment -------------------------------------------------------------------------------- /examples/test/comment.result: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/s-expressions/pose/c17529a5dc436790dad977e2574d1224a4ec0ac8/examples/test/comment.result -------------------------------------------------------------------------------- /examples/test/decimal.pose: -------------------------------------------------------------------------------- 1 | 123.45 2 | -------------------------------------------------------------------------------- /examples/test/decimal.result: -------------------------------------------------------------------------------- 1 | 123.45 2 | -------------------------------------------------------------------------------- /examples/test/empty-list.pose: -------------------------------------------------------------------------------- 1 | () -------------------------------------------------------------------------------- /examples/test/empty-list.result: -------------------------------------------------------------------------------- 1 | () -------------------------------------------------------------------------------- /examples/test/integer.pose: -------------------------------------------------------------------------------- 1 | 123 2 | -------------------------------------------------------------------------------- /examples/test/integer.result: -------------------------------------------------------------------------------- 1 | 123 2 | -------------------------------------------------------------------------------- /examples/test/list-one-int.pose: -------------------------------------------------------------------------------- 1 | (1) -------------------------------------------------------------------------------- /examples/test/list-one-int.result: -------------------------------------------------------------------------------- 1 | (1) -------------------------------------------------------------------------------- /examples/test/list-within-list.pose: -------------------------------------------------------------------------------- 1 | (1 2 (3 (4)) 5) -------------------------------------------------------------------------------- /examples/test/list-within-list.result: -------------------------------------------------------------------------------- 1 | (1 2 (3 (4)) 5) -------------------------------------------------------------------------------- /examples/test/negative-decimal.pose: -------------------------------------------------------------------------------- 1 | -123.45 2 | -------------------------------------------------------------------------------- /examples/test/negative-decimal.result: -------------------------------------------------------------------------------- 1 | -123.45 2 | -------------------------------------------------------------------------------- /examples/test/negative-integer.pose: -------------------------------------------------------------------------------- 1 | -123 2 | -------------------------------------------------------------------------------- /examples/test/negative-integer.result: -------------------------------------------------------------------------------- 1 | -123 2 | -------------------------------------------------------------------------------- /examples/test/small-decimal.pose: -------------------------------------------------------------------------------- 1 | 0.123 2 | -------------------------------------------------------------------------------- /examples/test/small-decimal.result: -------------------------------------------------------------------------------- 1 | 0.123 2 | -------------------------------------------------------------------------------- /examples/test/small-negative-decimal.pose: -------------------------------------------------------------------------------- 1 | -0.123 2 | -------------------------------------------------------------------------------- /examples/test/small-negative-decimal.result: -------------------------------------------------------------------------------- 1 | -0.123 2 | -------------------------------------------------------------------------------- /examples/test/string-with-escape.pose: -------------------------------------------------------------------------------- 1 | "foo \\bar \" baz" 2 | -------------------------------------------------------------------------------- /examples/test/string-with-escape.result: -------------------------------------------------------------------------------- 1 | "foo \\bar \" baz" 2 | -------------------------------------------------------------------------------- /examples/test/symbol.pose: -------------------------------------------------------------------------------- 1 | foo-bar 2 | -------------------------------------------------------------------------------- /examples/test/symbol.result: -------------------------------------------------------------------------------- 1 | foo-bar 2 | -------------------------------------------------------------------------------- /examples/test/unicode-string.pose: -------------------------------------------------------------------------------- 1 | "语言处理 och sådant" -------------------------------------------------------------------------------- /examples/test/unicode-string.result: -------------------------------------------------------------------------------- 1 | "语言处理 och sådant" -------------------------------------------------------------------------------- /fsharp/.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | ## 4 | ## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore 5 | 6 | # User-specific files 7 | *.rsuser 8 | *.suo 9 | *.user 10 | *.userosscache 11 | *.sln.docstates 12 | 13 | # User-specific files (MonoDevelop/Xamarin Studio) 14 | *.userprefs 15 | 16 | # Mono auto generated files 17 | mono_crash.* 18 | 19 | # Build results 20 | [Dd]ebug/ 21 | [Dd]ebugPublic/ 22 | [Rr]elease/ 23 | [Rr]eleases/ 24 | x64/ 25 | x86/ 26 | [Aa][Rr][Mm]/ 27 | [Aa][Rr][Mm]64/ 28 | bld/ 29 | [Bb]in/ 30 | [Oo]bj/ 31 | [Ll]og/ 32 | [Ll]ogs/ 33 | 34 | # Visual Studio 2015/2017 cache/options directory 35 | .vs/ 36 | # Uncomment if you have tasks that create the project's static files in wwwroot 37 | #wwwroot/ 38 | 39 | # Visual Studio 2017 auto generated files 40 | Generated\ Files/ 41 | 42 | # MSTest test Results 43 | [Tt]est[Rr]esult*/ 44 | [Bb]uild[Ll]og.* 45 | 46 | # NUnit 47 | *.VisualState.xml 48 | TestResult.xml 49 | nunit-*.xml 50 | 51 | # Build Results of an ATL Project 52 | [Dd]ebugPS/ 53 | [Rr]eleasePS/ 54 | dlldata.c 55 | 56 | # Benchmark Results 57 | BenchmarkDotNet.Artifacts/ 58 | 59 | # .NET Core 60 | project.lock.json 61 | project.fragment.lock.json 62 | artifacts/ 63 | 64 | # Tye 65 | .tye/ 66 | 67 | # StyleCop 68 | StyleCopReport.xml 69 | 70 | # Files built by Visual Studio 71 | *_i.c 72 | *_p.c 73 | *_h.h 74 | *.ilk 75 | *.meta 76 | *.obj 77 | *.iobj 78 | *.pch 79 | *.pdb 80 | *.ipdb 81 | *.pgc 82 | *.pgd 83 | *.rsp 84 | *.sbr 85 | *.tlb 86 | *.tli 87 | *.tlh 88 | *.tmp 89 | *.tmp_proj 90 | *_wpftmp.csproj 91 | *.log 92 | *.vspscc 93 | *.vssscc 94 | .builds 95 | *.pidb 96 | *.svclog 97 | *.scc 98 | 99 | # Chutzpah Test files 100 | _Chutzpah* 101 | 102 | # Visual C++ cache files 103 | ipch/ 104 | *.aps 105 | *.ncb 106 | *.opendb 107 | *.opensdf 108 | *.sdf 109 | *.cachefile 110 | *.VC.db 111 | *.VC.VC.opendb 112 | 113 | # Visual Studio profiler 114 | *.psess 115 | *.vsp 116 | *.vspx 117 | *.sap 118 | 119 | # Visual Studio Trace Files 120 | *.e2e 121 | 122 | # TFS 2012 Local Workspace 123 | $tf/ 124 | 125 | # Guidance Automation Toolkit 126 | *.gpState 127 | 128 | # ReSharper is a .NET coding add-in 129 | _ReSharper*/ 130 | *.[Rr]e[Ss]harper 131 | *.DotSettings.user 132 | 133 | # TeamCity is a build add-in 134 | _TeamCity* 135 | 136 | # DotCover is a Code Coverage Tool 137 | *.dotCover 138 | 139 | # AxoCover is a Code Coverage Tool 140 | .axoCover/* 141 | !.axoCover/settings.json 142 | 143 | # Coverlet is a free, cross platform Code Coverage Tool 144 | coverage*[.json, .xml, .info] 145 | 146 | # Visual Studio code coverage results 147 | *.coverage 148 | *.coveragexml 149 | 150 | # NCrunch 151 | _NCrunch_* 152 | .*crunch*.local.xml 153 | nCrunchTemp_* 154 | 155 | # MightyMoose 156 | *.mm.* 157 | AutoTest.Net/ 158 | 159 | # Web workbench (sass) 160 | .sass-cache/ 161 | 162 | # Installshield output folder 163 | [Ee]xpress/ 164 | 165 | # DocProject is a documentation generator add-in 166 | DocProject/buildhelp/ 167 | DocProject/Help/*.HxT 168 | DocProject/Help/*.HxC 169 | DocProject/Help/*.hhc 170 | DocProject/Help/*.hhk 171 | DocProject/Help/*.hhp 172 | DocProject/Help/Html2 173 | DocProject/Help/html 174 | 175 | # Click-Once directory 176 | publish/ 177 | 178 | # Publish Web Output 179 | *.[Pp]ublish.xml 180 | *.azurePubxml 181 | # Note: Comment the next line if you want to checkin your web deploy settings, 182 | # but database connection strings (with potential passwords) will be unencrypted 183 | *.pubxml 184 | *.publishproj 185 | 186 | # Microsoft Azure Web App publish settings. Comment the next line if you want to 187 | # checkin your Azure Web App publish settings, but sensitive information contained 188 | # in these scripts will be unencrypted 189 | PublishScripts/ 190 | 191 | # NuGet Packages 192 | *.nupkg 193 | # NuGet Symbol Packages 194 | *.snupkg 195 | # The packages folder can be ignored because of Package Restore 196 | **/[Pp]ackages/* 197 | # except build/, which is used as an MSBuild target. 198 | !**/[Pp]ackages/build/ 199 | # Uncomment if necessary however generally it will be regenerated when needed 200 | #!**/[Pp]ackages/repositories.config 201 | # NuGet v3's project.json files produces more ignorable files 202 | *.nuget.props 203 | *.nuget.targets 204 | 205 | # Microsoft Azure Build Output 206 | csx/ 207 | *.build.csdef 208 | 209 | # Microsoft Azure Emulator 210 | ecf/ 211 | rcf/ 212 | 213 | # Windows Store app package directories and files 214 | AppPackages/ 215 | BundleArtifacts/ 216 | Package.StoreAssociation.xml 217 | _pkginfo.txt 218 | *.appx 219 | *.appxbundle 220 | *.appxupload 221 | 222 | # Visual Studio cache files 223 | # files ending in .cache can be ignored 224 | *.[Cc]ache 225 | # but keep track of directories ending in .cache 226 | !?*.[Cc]ache/ 227 | 228 | # Others 229 | ClientBin/ 230 | ~$* 231 | *~ 232 | *.dbmdl 233 | *.dbproj.schemaview 234 | *.jfm 235 | *.pfx 236 | *.publishsettings 237 | orleans.codegen.cs 238 | 239 | # Including strong name files can present a security risk 240 | # (https://github.com/github/gitignore/pull/2483#issue-259490424) 241 | #*.snk 242 | 243 | # Since there are multiple workflows, uncomment next line to ignore bower_components 244 | # (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) 245 | #bower_components/ 246 | 247 | # RIA/Silverlight projects 248 | Generated_Code/ 249 | 250 | # Backup & report files from converting an old project file 251 | # to a newer Visual Studio version. Backup files are not needed, 252 | # because we have git ;-) 253 | _UpgradeReport_Files/ 254 | Backup*/ 255 | UpgradeLog*.XML 256 | UpgradeLog*.htm 257 | ServiceFabricBackup/ 258 | *.rptproj.bak 259 | 260 | # SQL Server files 261 | *.mdf 262 | *.ldf 263 | *.ndf 264 | 265 | # Business Intelligence projects 266 | *.rdl.data 267 | *.bim.layout 268 | *.bim_*.settings 269 | *.rptproj.rsuser 270 | *- [Bb]ackup.rdl 271 | *- [Bb]ackup ([0-9]).rdl 272 | *- [Bb]ackup ([0-9][0-9]).rdl 273 | 274 | # Microsoft Fakes 275 | FakesAssemblies/ 276 | 277 | # GhostDoc plugin setting file 278 | *.GhostDoc.xml 279 | 280 | # Node.js Tools for Visual Studio 281 | .ntvs_analysis.dat 282 | node_modules/ 283 | 284 | # Visual Studio 6 build log 285 | *.plg 286 | 287 | # Visual Studio 6 workspace options file 288 | *.opt 289 | 290 | # Visual Studio 6 auto-generated workspace file (contains which files were open etc.) 291 | *.vbw 292 | 293 | # Visual Studio LightSwitch build output 294 | **/*.HTMLClient/GeneratedArtifacts 295 | **/*.DesktopClient/GeneratedArtifacts 296 | **/*.DesktopClient/ModelManifest.xml 297 | **/*.Server/GeneratedArtifacts 298 | **/*.Server/ModelManifest.xml 299 | _Pvt_Extensions 300 | 301 | # Paket dependency manager 302 | .paket/paket.exe 303 | paket-files/ 304 | 305 | # FAKE - F# Make 306 | .fake/ 307 | 308 | # Ionide - VsCode extension for F# Support 309 | .ionide/ 310 | 311 | # CodeRush personal settings 312 | .cr/personal 313 | 314 | # Python Tools for Visual Studio (PTVS) 315 | __pycache__/ 316 | *.pyc 317 | 318 | # Cake - Uncomment if you are using it 319 | # tools/** 320 | # !tools/packages.config 321 | 322 | # Tabs Studio 323 | *.tss 324 | 325 | # Telerik's JustMock configuration file 326 | *.jmconfig 327 | 328 | # BizTalk build output 329 | *.btp.cs 330 | *.btm.cs 331 | *.odx.cs 332 | *.xsd.cs 333 | 334 | # OpenCover UI analysis results 335 | OpenCover/ 336 | 337 | # Azure Stream Analytics local run output 338 | ASALocalRun/ 339 | 340 | # MSBuild Binary and Structured Log 341 | *.binlog 342 | 343 | # NVidia Nsight GPU debugger configuration file 344 | *.nvuser 345 | 346 | # MFractors (Xamarin productivity tool) working folder 347 | .mfractor/ 348 | 349 | # Local History for Visual Studio 350 | .localhistory/ 351 | 352 | # BeatPulse healthcheck temp database 353 | healthchecksdb 354 | 355 | # Backup folder for Package Reference Convert tool in Visual Studio 2017 356 | MigrationBackup/ 357 | 358 | # Ionide (cross platform F# VS Code tools) working folder 359 | .ionide/ 360 | 361 | ## 362 | ## Visual studio for Mac 363 | ## 364 | 365 | 366 | # globs 367 | Makefile.in 368 | *.userprefs 369 | *.usertasks 370 | config.make 371 | config.status 372 | aclocal.m4 373 | install-sh 374 | autom4te.cache/ 375 | *.tar.gz 376 | tarballs/ 377 | test-results/ 378 | 379 | # Mac bundle stuff 380 | *.dmg 381 | *.app 382 | 383 | # content below from: https://github.com/github/gitignore/blob/master/Global/macOS.gitignore 384 | # General 385 | .DS_Store 386 | .AppleDouble 387 | .LSOverride 388 | 389 | # Icon must end with two \r 390 | Icon 391 | 392 | 393 | # Thumbnails 394 | ._* 395 | 396 | # Files that might appear in the root of a volume 397 | .DocumentRevisions-V100 398 | .fseventsd 399 | .Spotlight-V100 400 | .TemporaryItems 401 | .Trashes 402 | .VolumeIcon.icns 403 | .com.apple.timemachine.donotpresent 404 | 405 | # Directories potentially created on remote AFP share 406 | .AppleDB 407 | .AppleDesktop 408 | Network Trash Folder 409 | Temporary Items 410 | .apdisk 411 | 412 | # content below from: https://github.com/github/gitignore/blob/master/Global/Windows.gitignore 413 | # Windows thumbnail cache files 414 | Thumbs.db 415 | ehthumbs.db 416 | ehthumbs_vista.db 417 | 418 | # Dump file 419 | *.stackdump 420 | 421 | # Folder config file 422 | [Dd]esktop.ini 423 | 424 | # Recycle Bin used on file shares 425 | $RECYCLE.BIN/ 426 | 427 | # Windows Installer files 428 | *.cab 429 | *.msi 430 | *.msix 431 | *.msm 432 | *.msp 433 | 434 | # Windows shortcuts 435 | *.lnk 436 | 437 | # JetBrains Rider 438 | .idea/ 439 | *.sln.iml 440 | 441 | ## 442 | ## Visual Studio Code 443 | ## 444 | .vscode/* 445 | !.vscode/settings.json 446 | !.vscode/tasks.json 447 | !.vscode/launch.json 448 | !.vscode/extensions.json 449 | -------------------------------------------------------------------------------- /fsharp/Pose.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 16 4 | VisualStudioVersion = 16.6.30114.105 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "src", "src", "{B6A8F503-CDFC-45DA-BBAB-61B9A71E412E}" 7 | EndProject 8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Pose", "src\Pose\Pose.fsproj", "{496CB28F-581F-451E-87EB-A4736A8CBBA3}" 9 | EndProject 10 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{A70C7E7E-08B9-455E-AC14-7F7B689D1B5B}" 11 | EndProject 12 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Tests", "tests\Tests\Tests.fsproj", "{C2586503-8C11-4C53-9F8C-1342EA72B3E9}" 13 | EndProject 14 | Global 15 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 16 | Debug|Any CPU = Debug|Any CPU 17 | Debug|x64 = Debug|x64 18 | Debug|x86 = Debug|x86 19 | Release|Any CPU = Release|Any CPU 20 | Release|x64 = Release|x64 21 | Release|x86 = Release|x86 22 | EndGlobalSection 23 | GlobalSection(SolutionProperties) = preSolution 24 | HideSolutionNode = FALSE 25 | EndGlobalSection 26 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 27 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 28 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Debug|Any CPU.Build.0 = Debug|Any CPU 29 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Debug|x64.ActiveCfg = Debug|Any CPU 30 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Debug|x64.Build.0 = Debug|Any CPU 31 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Debug|x86.ActiveCfg = Debug|Any CPU 32 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Debug|x86.Build.0 = Debug|Any CPU 33 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Release|Any CPU.ActiveCfg = Release|Any CPU 34 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Release|Any CPU.Build.0 = Release|Any CPU 35 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Release|x64.ActiveCfg = Release|Any CPU 36 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Release|x64.Build.0 = Release|Any CPU 37 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Release|x86.ActiveCfg = Release|Any CPU 38 | {496CB28F-581F-451E-87EB-A4736A8CBBA3}.Release|x86.Build.0 = Release|Any CPU 39 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 40 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Debug|Any CPU.Build.0 = Debug|Any CPU 41 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Debug|x64.ActiveCfg = Debug|Any CPU 42 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Debug|x64.Build.0 = Debug|Any CPU 43 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Debug|x86.ActiveCfg = Debug|Any CPU 44 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Debug|x86.Build.0 = Debug|Any CPU 45 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Release|Any CPU.ActiveCfg = Release|Any CPU 46 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Release|Any CPU.Build.0 = Release|Any CPU 47 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Release|x64.ActiveCfg = Release|Any CPU 48 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Release|x64.Build.0 = Release|Any CPU 49 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Release|x86.ActiveCfg = Release|Any CPU 50 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9}.Release|x86.Build.0 = Release|Any CPU 51 | EndGlobalSection 52 | GlobalSection(NestedProjects) = preSolution 53 | {496CB28F-581F-451E-87EB-A4736A8CBBA3} = {B6A8F503-CDFC-45DA-BBAB-61B9A71E412E} 54 | {C2586503-8C11-4C53-9F8C-1342EA72B3E9} = {A70C7E7E-08B9-455E-AC14-7F7B689D1B5B} 55 | EndGlobalSection 56 | EndGlobal 57 | -------------------------------------------------------------------------------- /fsharp/README.md: -------------------------------------------------------------------------------- 1 | # README 2 | 3 | F# implementation of pose. 4 | 5 | To test run 6 | 7 | ```sh 8 | dotnet test 9 | ``` 10 | 11 | once you have [dotnet](https://dotnet.microsoft.com/download) installed. 12 | 13 | -------------------------------------------------------------------------------- /fsharp/src/Pose/Library.fs: -------------------------------------------------------------------------------- 1 | // Copyright 2021 Lassi Kortela 2 | // Copyright 2021 Oskar Gewalli 3 | // SPDX-License-Identifier: ISC 4 | module Pose 5 | 6 | open System 7 | open System.Text.RegularExpressions 8 | 9 | exception SyntaxError of string; 10 | 11 | type Exp 12 | = EList of Exp list 13 | | ESymbol of string 14 | | EString of string 15 | | EReal of float //real 16 | | EInt of int 17 | | EIntInf of int64 //IntInf.int; 18 | module internal String= 19 | let implode (c:char list) = String (List.toArray c) 20 | 21 | let stringContainsChar (s:string) (goalChar:char) = s.Contains goalChar 22 | 23 | module internal Char= 24 | let ord (c:char) = int32 c 25 | 26 | let charIsWhitespace char = 27 | let cc = Char.ord char in 28 | (cc = 0x20) || (cc >= 0x09 && cc <= 0x0D) 29 | 30 | let charIsAlphabetic char = 31 | ((char >= 'A') && (char <= 'Z')) || 32 | ((char >= 'a') && (char <= 'z')) 33 | 34 | let charIsNumeric char = 35 | ((char >= '0') && (char <= '9')) 36 | 37 | let charIsTokenCommon char = 38 | ((charIsAlphabetic char) || 39 | (charIsNumeric char) || 40 | (stringContainsChar "_$!?<=>+-*" char)); 41 | 42 | let charIsTokenFirst char = 43 | ((charIsTokenCommon char) || 44 | (stringContainsChar "/" char)); 45 | 46 | let charIsTokenNext char = 47 | ((charIsTokenFirst char) || 48 | (stringContainsChar ".@~^%&" char)); 49 | 50 | let parseNumberOrSymbol string = 51 | ESymbol string; 52 | 53 | module internal TextIO= 54 | open System.IO 55 | let input1 (br:BinaryReader) = if br.BaseStream.Position < br.BaseStream.Length then Some (br.ReadChar()) else None; 56 | let lookahead (br:BinaryReader) = 57 | if br.BaseStream.Position < br.BaseStream.Length 58 | then 59 | let originalPosition = br.BaseStream.Position in 60 | let read = br.ReadChar() 61 | br.BaseStream.Position <- originalPosition 62 | Some read 63 | else None 64 | let output (s:StreamWriter,s1:string) = s.Write s1 65 | let output1 (s:StreamWriter,s1:char)= s.Write s1 66 | let rec skipRestOfLine stream = 67 | match TextIO.input1 stream with 68 | | None -> () 69 | | Some '\n' -> () 70 | | Some _ -> skipRestOfLine stream 71 | 72 | let rec skipWhitespaceAndComments stream = 73 | match TextIO.lookahead stream with 74 | | None -> () 75 | | Some ';' -> (skipRestOfLine stream; 76 | skipWhitespaceAndComments stream) 77 | | Some char -> if charIsWhitespace char then 78 | (TextIO.input1 stream; 79 | skipWhitespaceAndComments stream) 80 | else 81 | (); 82 | 83 | let readRestOfTokenAsString char stream = 84 | let rec loop chars = match TextIO.lookahead stream with 85 | | None -> chars 86 | | Some char -> if charIsTokenNext char then 87 | (TextIO.input1 stream; 88 | loop (char :: chars)) 89 | else 90 | chars 91 | in String.implode (List.rev (loop [])) 92 | 93 | let readTokenAsString stream = 94 | match TextIO.input1 stream with 95 | | None -> raise (SyntaxError "End-of-file while expecting token") 96 | | Some char -> if charIsTokenFirst char then 97 | raise (SyntaxError "Not a token first char") 98 | else 99 | readRestOfTokenAsString char stream; 100 | 101 | let readIntegerRadix radix stream = 102 | ESymbol (readTokenAsString stream); 103 | 104 | let readSharpsign stream = 105 | match TextIO.input1 stream with 106 | | None -> raise (SyntaxError "End-of-file while reading #") 107 | | Some 'b' -> readIntegerRadix 2 stream 108 | | Some 'o' -> readIntegerRadix 8 stream 109 | | Some 'x' -> readIntegerRadix 16 stream 110 | | Some char -> raise (SyntaxError "Unknown # character") 111 | 112 | let readStringEscape endChar stream = 113 | match TextIO.input1 stream with 114 | | None -> raise (SyntaxError "Unterminated string escape") 115 | | Some 'n' -> '\n' 116 | | Some 't' -> '\t' 117 | | Some char -> if (char = '\\') || (char = endChar) then 118 | char 119 | else 120 | raise (SyntaxError "Unknown string escape") 121 | 122 | let readDelimitedString endChar stream = 123 | let rec loop chars = 124 | match TextIO.input1 stream with 125 | | None -> raise (SyntaxError "Unterminated string") 126 | | Some char -> if char = endChar then 127 | chars 128 | else 129 | loop ((if char = '\\' then 130 | readStringEscape endChar stream 131 | else 132 | char) 133 | :: chars) 134 | in String.implode (List.rev (loop [])) 135 | 136 | let private read1 readList stream = 137 | (skipWhitespaceAndComments stream; 138 | match TextIO.lookahead stream with 139 | | None -> None 140 | | Some char -> 141 | Some (if charIsTokenFirst char then 142 | parseNumberOrSymbol (readRestOfTokenAsString char stream) 143 | else 144 | (TextIO.input1 stream; 145 | match char with 146 | | '"' -> EString (readDelimitedString char stream) 147 | | '|' -> ESymbol (readDelimitedString char stream) 148 | | '#' -> readSharpsign stream 149 | | '(' -> readList stream 150 | | ')' -> raise (SyntaxError "Stray closing parenthesis") 151 | | _ -> raise (SyntaxError 152 | "Unknown character at top level")))) 153 | let rec readList stream = 154 | let rec loop forms = 155 | (skipWhitespaceAndComments stream; 156 | match TextIO.lookahead stream with 157 | | Some ')' -> (TextIO.input1 stream; forms) 158 | | _ -> match read1 readList stream with 159 | | None -> raise (SyntaxError "Unterminated list") 160 | | Some form -> loop (form :: forms)) 161 | in EList (List.rev (loop [])) 162 | 163 | let read s = read1 readList s 164 | 165 | let readAll stream = 166 | let rec loop forms = 167 | match read stream with 168 | | None -> List.rev forms 169 | | Some form -> loop (form :: forms) 170 | in loop [] 171 | 172 | let private escapeString (s:string) = 173 | let toEscape = "\\\"" 174 | String.implode [ for char in s.ToCharArray() do if stringContainsChar toEscape char then yield '\\'; yield char; else yield char ] 175 | 176 | let rec write stream form = 177 | match form with 178 | | EList [] -> TextIO.output (stream, "()") 179 | | EList forms -> (let rec loop prefix = 180 | function 181 | | [] -> 182 | TextIO.output1 (stream, ')') 183 | | (form :: forms) -> 184 | (TextIO.output1 (stream, prefix); 185 | write stream form; 186 | loop ' ' forms) 187 | in loop '(' forms ) 188 | | ESymbol s -> TextIO.output (stream, s) 189 | | EString s -> TextIO.output (stream, sprintf "\"%s\"" (escapeString s)) 190 | | EReal n -> TextIO.output (stream, (string n)) 191 | | EInt n -> TextIO.output (stream, (string n)) 192 | | EIntInf n -> TextIO.output (stream, (string n)) 193 | 194 | let writeln stream form = 195 | (write stream form; 196 | TextIO.output1 (stream, '\n')) -------------------------------------------------------------------------------- /fsharp/src/Pose/Pose.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | netstandard2.1 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /fsharp/src/Pose/pose.fsx: -------------------------------------------------------------------------------- 1 | // Copyright 2021 Lassi Kortela 2 | // Copyright 2021 Oskar Gewalli 3 | // SPDX-License-Identifier: ISC 4 | #load "Library.fs" 5 | open System 6 | open Pose 7 | let testFile (filename: string)= 8 | use file = IO.File.OpenRead(filename) 9 | use rd = new IO.BinaryReader (file) 10 | try 11 | let read= readAll(rd) 12 | printfn "Read %s" filename 13 | with 14 | | e -> 15 | printfn "Failed to read %s" filename 16 | printfn "Got the error %A" e 17 | testFile(IO.Path.Combine(__SOURCE_DIRECTORY__, "..","..","..", "examples","hello.pose")) 18 | testFile(IO.Path.Combine(__SOURCE_DIRECTORY__, "..","..","..", "examples","srfi.pose")) 19 | -------------------------------------------------------------------------------- /fsharp/tests/Tests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /fsharp/tests/Tests/Tests.fs: -------------------------------------------------------------------------------- 1 | // Copyright 2021 Lassi Kortela 2 | // Copyright 2021 Oskar Gewalli 3 | // SPDX-License-Identifier: ISC 4 | module Tests 5 | 6 | open System 7 | open Xunit 8 | open Pose 9 | 10 | 11 | [] 18 | let ``Can parse and stringify`` (sample:string, expected:string) = 19 | let read = 20 | use stream = new IO.MemoryStream() 21 | use rd = new IO.BinaryReader (stream) 22 | use w = new IO.StreamWriter (stream) 23 | w.Write sample 24 | w.Flush () 25 | stream.Seek (0L, IO.SeekOrigin.Begin) |> ignore 26 | readAll rd 27 | let written = 28 | use stream = new IO.MemoryStream() 29 | use w = new IO.StreamWriter (stream) 30 | for e in read do write w e 31 | w.Flush () 32 | stream.Seek (0L, IO.SeekOrigin.Begin) |> ignore 33 | use rd = new IO.StreamReader (stream) 34 | rd.ReadToEnd() 35 | Assert.Equal(expected, written) 36 | 37 | let exampleTestFiles : seq = seq{ 38 | let files = IO.Directory.EnumerateFiles(".","*.pose") 39 | for file in files do 40 | yield [| file; IO.Path.ChangeExtension(file, "result") |] 41 | } 42 | 43 | [] 45 | let ``Can parse`` (file:string,result:string) = 46 | let read = 47 | use stream = IO.File.OpenRead file 48 | use rd = new IO.BinaryReader (stream) 49 | readAll rd 50 | let written = 51 | use stream = new IO.MemoryStream() 52 | use w = new IO.StreamWriter (stream) 53 | for e in read do writeln w e 54 | w.Flush () 55 | stream.Seek (0L, IO.SeekOrigin.Begin) |> ignore 56 | use rd = new IO.StreamReader (stream) 57 | rd.ReadToEnd() 58 | let expected = IO.File.ReadAllText result 59 | Assert.Equal(expected.Trim(), written.Trim()) 60 | 61 | -------------------------------------------------------------------------------- /fsharp/tests/Tests/Tests.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net5.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | %(RecursiveDir)%(FileName)%(Extension) 16 | Always 17 | 18 | 19 | %(RecursiveDir)%(FileName)%(Extension) 20 | Always 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | runtime; build; native; contentfiles; analyzers; buildtransitive 30 | all 31 | 32 | 33 | runtime; build; native; contentfiles; analyzers; buildtransitive 34 | all 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /go/go.mod: -------------------------------------------------------------------------------- 1 | module github.com/lassik/pose 2 | 3 | go 1.16 4 | -------------------------------------------------------------------------------- /go/pose.go: -------------------------------------------------------------------------------- 1 | // Copyright 2021 Lassi Kortela 2 | // Copyright 2021 Oskar Gewalli 3 | // SPDX-License-Identifier: ISC 4 | 5 | package pose 6 | 7 | import ( 8 | "bufio" 9 | "fmt" 10 | "io" 11 | "math/big" 12 | "strconv" 13 | "strings" 14 | ) 15 | 16 | type Exp interface { 17 | Write(wr io.Writer) error 18 | } 19 | 20 | type List struct { 21 | value []Exp 22 | } 23 | 24 | type Symbol struct { 25 | value string 26 | } 27 | 28 | type String struct { 29 | value string 30 | } 31 | 32 | type Float64 struct { 33 | value float64 34 | } 35 | 36 | type FixInt struct { 37 | value int 38 | } 39 | 40 | type BigInt struct { 41 | value big.Int 42 | } 43 | 44 | func (exp List) Write(wr io.Writer) error { 45 | n := len(exp.value) 46 | if n == 0 { 47 | _, err := io.WriteString(wr, "()") 48 | return err 49 | } 50 | prefix := "(" 51 | for i := 0; i < n; i += 1 { 52 | _, err := io.WriteString(wr, prefix) 53 | if err != nil { 54 | return err 55 | } 56 | err = exp.value[i].Write(wr) 57 | if err != nil { 58 | return err 59 | } 60 | prefix = " " 61 | } 62 | _, err := io.WriteString(wr, ")") 63 | if err != nil { 64 | return err 65 | } 66 | return nil 67 | } 68 | 69 | func (exp Symbol) Write(wr io.Writer) error { 70 | _, err := io.WriteString(wr, exp.value) 71 | return err 72 | } 73 | 74 | // IndexAny returns the index of the first instance of any Unicode code point 75 | // from chars in s, or -1 if no Unicode code point from chars is present in s. 76 | func IndexAnyFromIndex(s, chars string, index int) int { 77 | for i := index; i < len(s); i++ { 78 | c := rune(s[i]) 79 | if strings.IndexRune(chars, c) >= 0 { 80 | return i 81 | } 82 | } 83 | return -1 84 | } 85 | 86 | func Escape(value string) string { 87 | toEscape := "\\\"" 88 | var sb strings.Builder 89 | 90 | var currentIndex = 0 91 | for { 92 | if currentIndex >= len(value) { 93 | break 94 | } 95 | var indexOf = IndexAnyFromIndex(value, toEscape, currentIndex) 96 | if indexOf >= 0 { 97 | sb.WriteString(value[currentIndex:indexOf]) 98 | sb.WriteString("\\") 99 | sb.WriteString(value[indexOf : indexOf+1]) 100 | currentIndex = indexOf + 1 101 | } else { 102 | sb.WriteString(value[currentIndex:]) 103 | break 104 | } 105 | } 106 | return sb.String() 107 | } 108 | func (exp String) Write(wr io.Writer) error { 109 | _, err := io.WriteString(wr, "\""+Escape(exp.value)+"\"") 110 | return err 111 | } 112 | 113 | func (exp Float64) Write(wr io.Writer) error { 114 | _, err := io.WriteString(wr, strconv.FormatFloat(exp.value, 'f', 5, 64)) 115 | return err 116 | } 117 | 118 | func (exp FixInt) Write(wr io.Writer) error { 119 | _, err := io.WriteString(wr, strconv.Itoa(exp.value)) 120 | return err 121 | } 122 | 123 | func (exp BigInt) Write(wr io.Writer) error { 124 | _, err := io.WriteString(wr, exp.value.String()) 125 | return err 126 | } 127 | 128 | type SyntaxError struct { 129 | msg string 130 | } 131 | 132 | func (e SyntaxError) Error() string { 133 | return e.msg 134 | } 135 | 136 | func makeSyntaxError(msg string) SyntaxError { 137 | return SyntaxError{msg: msg} 138 | } 139 | 140 | func isWhitespaceByte(c byte) bool { 141 | return (c == ' ') || (c == '\t') || (c == '\n') || (c == '\r') 142 | } 143 | 144 | func isTokenFirstByte(c byte) bool { 145 | return (('0' <= c && c <= '9') || 146 | ('A' <= c && c <= 'Z') || 147 | ('a' <= c && c <= 'z') || 148 | strings.ContainsRune("_$!?<=>+-*/", rune(c))) 149 | } 150 | 151 | func isTokenNextByte(c byte) bool { 152 | return isTokenFirstByte(c) || strings.ContainsRune(".@~^%&", rune(c)) 153 | } 154 | 155 | func parseInteger(s string, radix int) (Exp, error) { 156 | return Symbol{value: s}, nil 157 | } 158 | 159 | func parseNumberOrSymbol(s string) (Exp, error) { 160 | return Symbol{value: s}, nil 161 | } 162 | 163 | func peekByte(rd *bufio.Reader) (byte, error) { 164 | c, err := rd.ReadByte() 165 | if err != nil { 166 | return 0, err 167 | } 168 | err = rd.UnreadByte() 169 | if err != nil { 170 | return 0, err 171 | } 172 | return c, nil 173 | } 174 | 175 | func skipRestOfLine(rd *bufio.Reader) error { 176 | for { 177 | c, err := rd.ReadByte() 178 | if err == io.EOF { 179 | break 180 | } else if err != nil { 181 | return err 182 | } else if c == '\n' { 183 | break 184 | } 185 | } 186 | return nil 187 | } 188 | 189 | func skipWhitespaceAndComments(rd *bufio.Reader) error { 190 | for { 191 | c, err := peekByte(rd) 192 | if err == io.EOF { 193 | break 194 | } else if err != nil { 195 | return err 196 | } else if c == ';' { 197 | err = skipRestOfLine(rd) 198 | if err != nil { 199 | return err 200 | } 201 | } else if isWhitespaceByte(c) { 202 | _, err := rd.ReadByte() 203 | if err != nil { 204 | return err 205 | } 206 | } else { 207 | break 208 | } 209 | } 210 | return nil 211 | } 212 | 213 | func readTokenAsString(rd *bufio.Reader) (string, error) { 214 | c, err := rd.ReadByte() 215 | if err != nil { 216 | return "", err 217 | } 218 | if !isTokenFirstByte(c) { 219 | return "", makeSyntaxError("Not a token first byte") 220 | } 221 | var ans strings.Builder 222 | ans.WriteByte(c) 223 | for { 224 | c, err := peekByte(rd) 225 | if err == io.EOF { 226 | break 227 | } else if err != nil { 228 | return "", err 229 | } else if !isTokenNextByte(c) { 230 | break 231 | } 232 | c, err = rd.ReadByte() 233 | if err != nil { 234 | return "", err 235 | } 236 | ans.WriteByte(c) 237 | } 238 | return ans.String(), nil 239 | } 240 | 241 | func readSharpsign(rd *bufio.Reader) (Exp, error) { 242 | c, err := rd.ReadByte() 243 | radix := 0 244 | switch c { 245 | case 'b': 246 | radix = 2 247 | case 'o': 248 | radix = 8 249 | case 'x': 250 | radix = 16 251 | } 252 | if radix == 0 { 253 | return nil, makeSyntaxError("Unknown #") 254 | } 255 | token, err := readTokenAsString(rd) 256 | if err != nil { 257 | return nil, err 258 | } 259 | value, err := parseInteger(token, radix) 260 | if err != nil { 261 | return nil, makeSyntaxError("Cannot parse integer from token") 262 | } 263 | return value, nil 264 | } 265 | 266 | func readDelimitedList(rd *bufio.Reader, endByte byte) (Exp, error) { 267 | exps := []Exp{} 268 | for { 269 | err := skipWhitespaceAndComments(rd) 270 | if err != nil { 271 | return nil, err 272 | } 273 | c, err := peekByte(rd) 274 | if err == io.EOF { 275 | return nil, makeSyntaxError("Unterminated list") 276 | } else if err != nil { 277 | return nil, err 278 | } else if c == endByte { 279 | _, err := rd.ReadByte() 280 | if err != nil { 281 | return nil, err 282 | } 283 | break 284 | } else { 285 | exp, err := Read(rd) 286 | if err != nil { 287 | return nil, makeSyntaxError("Unterminated list") 288 | } 289 | exps = append(exps, exp) 290 | } 291 | } 292 | return List{value: exps}, nil 293 | } 294 | 295 | func readStringEscape(rd *bufio.Reader, endByte byte) (byte, error) { 296 | c, err := rd.ReadByte() 297 | if err == io.EOF { 298 | return 0, makeSyntaxError("Unterminated string escape") 299 | } else if err != nil { 300 | return 0, err 301 | } else if c == 'n' { 302 | c = '\n' 303 | } else if c == 't' { 304 | c = '\t' 305 | } else if c != '\\' && c != endByte { 306 | return 0, makeSyntaxError("Unknown string escape") 307 | } 308 | return c, nil 309 | } 310 | 311 | func readDelimitedString(rd *bufio.Reader, endByte byte) (string, error) { 312 | var ans strings.Builder 313 | for { 314 | c, err := rd.ReadByte() 315 | if c == endByte { 316 | break 317 | } else if err == io.EOF { 318 | return "", makeSyntaxError("Unterminated string") 319 | } else if err != nil { 320 | return "", err 321 | } else if c == '\\' { 322 | var err error 323 | c, err = readStringEscape(rd, endByte) 324 | if err != nil { 325 | return "", err 326 | } 327 | } 328 | ans.WriteByte(c) 329 | } 330 | return ans.String(), nil 331 | } 332 | 333 | func Read(rd *bufio.Reader) (Exp, error) { 334 | err := skipWhitespaceAndComments(rd) 335 | if err != nil { 336 | return nil, err 337 | } 338 | c, err := peekByte(rd) 339 | if err != nil { 340 | return nil, err 341 | } else if isTokenFirstByte(c) { 342 | token, err := readTokenAsString(rd) 343 | if err != nil { 344 | return nil, err 345 | } 346 | return parseNumberOrSymbol(token) 347 | } else { 348 | c, err := rd.ReadByte() 349 | if err != nil { 350 | return nil, err 351 | } else if c == '#' { 352 | return readSharpsign(rd) 353 | } else if c == '|' { 354 | s, err := readDelimitedString(rd, c) 355 | if err != nil { 356 | return nil, err 357 | } 358 | return Symbol{value: s}, nil 359 | } else if c == '"' { 360 | s, err := readDelimitedString(rd, c) 361 | if err != nil { 362 | return nil, err 363 | } 364 | return String{value: s}, nil 365 | } else if c == '(' { 366 | return readDelimitedList(rd, ')') 367 | } else if c == ')' { 368 | return nil, makeSyntaxError("Stray closing parenthesis") 369 | } else { 370 | return nil, makeSyntaxError( 371 | fmt.Sprintf("Unknown byte at top level: 0x%02x '%c'", c, c)) 372 | } 373 | } 374 | } 375 | 376 | func ReadAll(rd *bufio.Reader) ([]Exp, error) { 377 | exps := []Exp{} 378 | for { 379 | exp, err := Read(rd) 380 | if err == io.EOF { 381 | break 382 | } else if err != nil { 383 | return nil, err 384 | } 385 | exps = append(exps, exp) 386 | } 387 | return exps, nil 388 | } 389 | -------------------------------------------------------------------------------- /go/pose_test.go: -------------------------------------------------------------------------------- 1 | // Copyright 2021 Lassi Kortela 2 | // SPDX-License-Identifier: ISC 3 | 4 | package pose 5 | 6 | import ( 7 | "bufio" 8 | "bytes" 9 | "io" 10 | "io/ioutil" 11 | "os" 12 | "strings" 13 | "testing" 14 | ) 15 | 16 | func testFile(t *testing.T, filename string) { 17 | file, err := os.Open(filename) 18 | if err != nil { 19 | t.Error(err) 20 | } 21 | defer file.Close() 22 | rd := bufio.NewReader(file) 23 | exps, err := ReadAll(rd) 24 | if err != nil { 25 | t.Error(err) 26 | return 27 | } 28 | _ = exps 29 | } 30 | 31 | func testFileMatches(t *testing.T, filename string, filenameExpected string) { 32 | file, err := os.Open(filename) 33 | if err != nil { 34 | t.Error(err) 35 | } 36 | defer file.Close() 37 | rd := bufio.NewReader(file) 38 | exps, err := ReadAll(rd) 39 | if err != nil { 40 | t.Error(err) 41 | return 42 | } 43 | buf := new(bytes.Buffer) 44 | 45 | for i, exp := range exps { 46 | exp.Write(buf) 47 | if i > 0 { 48 | io.WriteString(buf, "\n") 49 | } 50 | } 51 | output := strings.Trim(buf.String(), "\r\n") 52 | bytesExpected, err := ioutil.ReadFile(filenameExpected) 53 | expected := strings.Trim(string(bytesExpected), "\r\n") 54 | if err != nil { 55 | t.Fatal(err) 56 | return 57 | } 58 | if output != expected { 59 | t.Errorf("output %v not equal to expected %v", output, expected) 60 | return 61 | } 62 | } 63 | 64 | func testSampleEqualsOutput(t *testing.T, sample string, expected string) { 65 | rbuf := new(bytes.Buffer) 66 | _, err1 := rbuf.WriteString(sample) 67 | if err1 != nil { 68 | t.Error(err1) 69 | return 70 | } 71 | 72 | rd := bufio.NewReader(rbuf) 73 | exps, err := ReadAll(rd) 74 | if err != nil { 75 | t.Error(err) 76 | t.Errorf("could not read sample %s", sample) 77 | return 78 | } 79 | buf := new(bytes.Buffer) 80 | 81 | for i, exp := range exps { 82 | exp.Write(buf) 83 | if i > 0 { 84 | io.WriteString(buf, "\n") 85 | } 86 | } 87 | output := buf.String() 88 | if output != expected { 89 | t.Errorf("output %v not equal to expected %v", output, expected) 90 | return 91 | } 92 | } 93 | 94 | func TestSRFI(t *testing.T) { 95 | testSampleEqualsOutput(t, "(symbol \"value\")", "(symbol \"value\")") 96 | testSampleEqualsOutput(t, "; Foo", "") 97 | testSampleEqualsOutput(t, " ; Bar", "") 98 | testSampleEqualsOutput(t, "( 1 2 (|asdo\\|aisdj| \"dfdosi dsi\"))", "(1 2 (asdo|aisdj \"dfdosi dsi\"))") 99 | testSampleEqualsOutput(t, "()", "()") 100 | 101 | testFile(t, "../examples/hello.pose") 102 | testFile(t, "../examples/srfi.pose") 103 | 104 | files, err := ioutil.ReadDir("../examples/test") 105 | if err != nil { 106 | t.Fatal(err) 107 | return 108 | } 109 | 110 | for _, file := range files { 111 | if !file.IsDir() && strings.HasSuffix(file.Name(), ".pose") { 112 | testFileMatches(t, "../examples/test/"+file.Name(), "../examples/test/"+(strings.Replace(file.Name(), ".pose", ".result", 1))) 113 | } 114 | } 115 | } 116 | -------------------------------------------------------------------------------- /python/.gitignore: -------------------------------------------------------------------------------- 1 | *.pyc 2 | *.tar.gz 3 | *.whl 4 | -------------------------------------------------------------------------------- /python/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2021, 2022, 2023 Lassi Kortela 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice (including the 12 | next paragraph) shall be included in all copies or substantial 13 | portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 18 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 19 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 20 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 21 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /python/README.md: -------------------------------------------------------------------------------- 1 | # Portable S-expressions (POSE) for Python 2 | 3 | This library works on Python 3. 4 | 5 | We'd like to add Python 2 support with guidance from a Python expert. 6 | -------------------------------------------------------------------------------- /python/pyproject.toml: -------------------------------------------------------------------------------- 1 | [project] 2 | name = "pose_expr" 3 | version = "0.1.0" 4 | authors = [ 5 | { name="Lassi Kortela", email="lassi@lassi.io" }, 6 | ] 7 | description = "Portable S-expressions (POSE)" 8 | readme = "README.md" 9 | license = { file="LICENSE" } 10 | requires-python = ">=3.7" 11 | classifiers = [ 12 | "Programming Language :: Python :: 3", 13 | "License :: OSI Approved :: MIT License", 14 | "Operating System :: OS Independent", 15 | ] 16 | 17 | [project.urls] 18 | "Homepage" = "https://www.s-expressions.org/" 19 | "Bug Tracker" = "https://github.com/s-expressions/pose/issues" 20 | 21 | [build-system] 22 | requires = ["hatchling"] 23 | build-backend = "hatchling.build" 24 | -------------------------------------------------------------------------------- /python/src/pose_expr/__init__.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env python3 2 | 3 | # Copyright 2021 Lassi Kortela 4 | # SPDX-License-Identifier: ISC 5 | 6 | import string 7 | 8 | 9 | def is_whitespace_char(ch): 10 | return (ch == " ") or (ch == "\t") or (ch == "\n") or (ch == "\r") 11 | 12 | 13 | def is_token_first_char(ch): 14 | return ( 15 | (ch in string.digits) or (ch in string.ascii_letters) or (ch in "_$!?<=>+-*/") 16 | ) 17 | 18 | 19 | def is_token_next_char(ch): 20 | return is_token_first_char(ch) or (ch in ".@~^%&") 21 | 22 | 23 | class Symbol: 24 | def __init__(self, name): 25 | self.name = name 26 | 27 | def __repr__(self): 28 | return repr(self.name) 29 | 30 | def __str__(self): 31 | return self.name 32 | 33 | def iswritable(self): 34 | return True 35 | 36 | 37 | class PoseSyntaxError(Exception): 38 | pass 39 | -------------------------------------------------------------------------------- /python/src/pose_expr/reader.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env python3 2 | 3 | # Copyright 2021 Lassi Kortela 4 | # SPDX-License-Identifier: ISC 5 | 6 | import json 7 | import string 8 | 9 | from pose_expr import ( 10 | is_whitespace_char, 11 | is_token_first_char, 12 | is_token_next_char, 13 | PoseSyntaxError, 14 | Symbol, 15 | ) 16 | 17 | 18 | def parse_number_or_symbol(s): 19 | n = None 20 | try: 21 | n = json.loads(s) 22 | except json.decoder.JSONDecodeError: 23 | pass 24 | if isinstance(n, int) or isinstance(n, float): 25 | return n 26 | return Symbol(s) 27 | 28 | 29 | class PoseReader: 30 | def __init__(self, stream): 31 | self.stream = stream 32 | self.lastchar = "" 33 | 34 | def peek_char(self): 35 | if self.lastchar == "": 36 | self.lastchar = self.stream.read(1) 37 | return self.lastchar 38 | 39 | def read_char(self): 40 | ch = self.peek_char() 41 | self.lastchar = "" 42 | return ch 43 | 44 | def skip_rest_of_line(self): 45 | while True: 46 | ch = self.read_char() 47 | if ch == "\n" or ch == "": 48 | break 49 | 50 | def skip_whitespace_and_comments(self): 51 | while True: 52 | ch = self.peek_char() 53 | if ch == "": 54 | break 55 | elif ch == ";": 56 | self.skip_rest_of_line() 57 | elif is_whitespace_char(ch): 58 | self.read_char() 59 | else: 60 | break 61 | 62 | def read_token_as_string(self): 63 | ch = self.read_char() 64 | if not is_token_first_char(ch): 65 | raise PoseSyntaxError("Not a token first char") 66 | s = ch 67 | while True: 68 | ch = self.peek_char() 69 | if ch == "" or not is_token_next_char(ch): 70 | break 71 | s += self.read_char() 72 | return s 73 | 74 | def read_sharpsign(self): 75 | ch = self.read_char() 76 | radix = {"b": 2, "o": 8, "x": 16}.get(ch) 77 | if radix is None: 78 | raise PoseSyntaxError("Unknown #") 79 | token = self.read_token_as_string() 80 | value = parse_integer(token, radix) 81 | if value is None: 82 | raise PoseSyntaxError("Cannot parse integer from token") 83 | return value 84 | 85 | def read_delimited_list(self, end_char): 86 | forms = [] 87 | while True: 88 | self.skip_whitespace_and_comments() 89 | if self.peek_char() == end_char: 90 | self.read_char() 91 | break 92 | else: 93 | forms.append(self.read()) 94 | return forms 95 | 96 | def read_delimited_string(self, end_char): 97 | s = "" 98 | while True: 99 | ch = self.read_char() 100 | if ch == "": 101 | raise PoseSyntaxError("Unterminated string") 102 | elif ch == end_char: 103 | break 104 | elif ch == "\\": 105 | ch = self.read_char() 106 | if ch == "": 107 | raise PoseSyntaxError("Unterminated string escape") 108 | else: 109 | raw = { 110 | '"': '"', 111 | "|": "|", 112 | "n": "\n", 113 | "t": "\t", 114 | "\\": "\\", 115 | }.get(ch) 116 | if raw is None: 117 | raise PoseSyntaxError("Unknown string escape") 118 | s += raw 119 | else: 120 | s += ch 121 | return s 122 | 123 | def read(self): 124 | self.skip_whitespace_and_comments() 125 | ch = self.peek_char() 126 | if ch == "": 127 | raise EOFError() 128 | elif is_token_first_char(ch): 129 | return parse_number_or_symbol(self.read_token_as_string()) 130 | else: 131 | ch = self.read_char() 132 | if ch == "#": 133 | return self.read_sharpsign() 134 | elif ch == "|": 135 | return Symbol(self.read_delimited_string("|")) 136 | elif ch == '"': 137 | return self.read_delimited_string('"') 138 | elif ch == "(": 139 | return self.read_delimited_list(")") 140 | elif ch == ")": 141 | raise PoseSyntaxError("Stray closing parenthesis") 142 | else: 143 | raise PoseSyntaxError("Unknown character at top level") 144 | 145 | def read_all(self): 146 | forms = [] 147 | try: 148 | while True: 149 | forms.append(self.read()) 150 | except EOFError: 151 | return forms 152 | -------------------------------------------------------------------------------- /python/src/pose_expr/writer.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env python3 2 | 3 | # Copyright 2022 Lassi Kortela 4 | # SPDX-License-Identifier: ISC 5 | 6 | import io 7 | import math 8 | 9 | from pose_expr import Symbol 10 | 11 | 12 | class PoseWriter: 13 | def __init__(self, stream): 14 | self.stream = stream 15 | 16 | def write(self, obj): 17 | if isinstance(obj, float): 18 | if not math.isfinite(obj): 19 | raise ValueError(cannot(obj)) 20 | self.stream.write(str(obj)) 21 | elif isinstance(obj, int): 22 | self.stream.write(str(obj)) 23 | elif isinstance(obj, str): 24 | self.stream.write('"') 25 | for ch in obj: 26 | if ch in '"\\': 27 | self.stream.write("\\") 28 | self.stream.write(ch) 29 | self.stream.write('"') 30 | elif isinstance(obj, Symbol): 31 | if obj.iswritable(): 32 | self.stream.write(str(obj)) 33 | else: 34 | raise TypeError(cannot(obj)) 35 | elif isinstance(obj, list): 36 | self.stream.write("(") 37 | if len(obj): 38 | self.write(obj[0]) 39 | for i in range(1, len(obj)): 40 | self.stream.write(" ") 41 | self.write(obj[i]) 42 | self.stream.write(")") 43 | else: 44 | raise TypeError(cannot(obj)) 45 | 46 | def write_all(self, objects): 47 | for obj in objects: 48 | self.write(obj) 49 | 50 | @classmethod 51 | def to_string(cls, obj): 52 | with io.StringIO() as stream: 53 | cls(stream).write(obj) 54 | return stream.getvalue() 55 | 56 | @staticmethod 57 | def cannot(obj): 58 | return "POSE cannot represent {}".format(repr(obj)) 59 | -------------------------------------------------------------------------------- /python/tests/tests.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env python3 2 | 3 | import io 4 | import unittest 5 | 6 | from pose_expr import PoseSyntaxError 7 | from pose_expr.reader import PoseReader 8 | from pose_expr.writer import PoseWriter 9 | 10 | 11 | class TestPoseReader(unittest.TestCase): 12 | def test_smoke(self): 13 | self.assertEqual(PoseReader(io.StringIO("(1 2 3)")).read_all(), [[1, 2, 3]]) 14 | with self.assertRaises(EOFError): 15 | PoseReader(io.StringIO("(")).read() 16 | with self.assertRaises(PoseSyntaxError): 17 | PoseReader(io.StringIO(")")).read() 18 | 19 | 20 | if __name__ == "__main__": 21 | unittest.main() 22 | -------------------------------------------------------------------------------- /ruby/Gemfile: -------------------------------------------------------------------------------- 1 | source 'https://rubygems.org' 2 | gemspec 3 | -------------------------------------------------------------------------------- /ruby/Gemfile.lock: -------------------------------------------------------------------------------- 1 | PATH 2 | remote: . 3 | specs: 4 | pose (0.0.1) 5 | 6 | GEM 7 | remote: https://rubygems.org/ 8 | specs: 9 | diff-lcs (1.4.4) 10 | rake (13.0.3) 11 | rspec (3.10.0) 12 | rspec-core (~> 3.10.0) 13 | rspec-expectations (~> 3.10.0) 14 | rspec-mocks (~> 3.10.0) 15 | rspec-core (3.10.1) 16 | rspec-support (~> 3.10.0) 17 | rspec-expectations (3.10.1) 18 | diff-lcs (>= 1.2.0, < 2.0) 19 | rspec-support (~> 3.10.0) 20 | rspec-mocks (3.10.2) 21 | diff-lcs (>= 1.2.0, < 2.0) 22 | rspec-support (~> 3.10.0) 23 | rspec-support (3.10.2) 24 | 25 | PLATFORMS 26 | ruby 27 | 28 | DEPENDENCIES 29 | bundler 30 | pose! 31 | rake 32 | rspec 33 | 34 | BUNDLED WITH 35 | 2.1.4 36 | -------------------------------------------------------------------------------- /ruby/Rakefile: -------------------------------------------------------------------------------- 1 | require "bundler/gem_tasks" 2 | require 'rspec/core/rake_task' 3 | 4 | RSpec::Core::RakeTask.new(:spec) 5 | 6 | task :default => :spec -------------------------------------------------------------------------------- /ruby/pose.gemspec: -------------------------------------------------------------------------------- 1 | # coding: utf-8 2 | lib = File.expand_path('.', __FILE__) 3 | $LOAD_PATH.unshift(lib) unless $LOAD_PATH.include?(lib) 4 | 5 | Gem::Specification.new do |spec| 6 | spec.name = "pose" 7 | spec.version = "0.0.1" 8 | spec.authors = ["Lassi Kortela"] 9 | spec.email = ["lassi@lassi.io"] 10 | spec.summary = "Portable S-expressions (POSE)" 11 | spec.homepage = "https://github.com/s-expressions/pose" 12 | spec.license = "ISC" 13 | 14 | spec.files = `git ls-files`.split($/) 15 | spec.executables = spec.files.grep(%r{^bin/}) { |f| File.basename(f) } 16 | spec.test_files = spec.files.grep(%r{^(test|spec|features)/}) 17 | spec.require_paths = ["lib"] 18 | 19 | spec.add_development_dependency "bundler" 20 | spec.add_development_dependency "rake" 21 | spec.add_development_dependency "rspec" 22 | end -------------------------------------------------------------------------------- /ruby/pose.rb: -------------------------------------------------------------------------------- 1 | # Copyright 2021 Lassi Kortela 2 | # SPDX-License-Identifier: ISC 3 | 4 | def whitespace_char?(c) 5 | (c == " ") or (c == "\t") or (c == "\n") or (c == "\r") 6 | end 7 | 8 | def token_first_char?(c) 9 | (("0" <= c and c <= "9") or 10 | ("A" <= c and c <= "Z") or 11 | ("a" <= c and c <= "z") or 12 | "_$!?<=>+-*/".include?(c)) 13 | end 14 | 15 | def token_next_char?(c) 16 | token_first_char?(c) or ".@~^%&".include?(c) 17 | end 18 | 19 | class PoseSyntaxError < StandardError 20 | end 21 | 22 | def parse_number_or_symbol(s) 23 | return s.to_sym 24 | end 25 | 26 | class PoseReader 27 | def initialize(io) 28 | super() 29 | @io = io 30 | end 31 | 32 | def peek_char 33 | c = @io.getc 34 | @io.ungetc(c) unless c == nil 35 | c 36 | end 37 | 38 | def read_char 39 | @io.getc 40 | end 41 | 42 | def skip_rest_of_line 43 | loop do 44 | c = read_char 45 | if c == "\n" or c == nil 46 | break 47 | end 48 | end 49 | end 50 | 51 | def skip_whitespace_and_comments 52 | loop do 53 | c = peek_char 54 | if c == nil 55 | break 56 | elsif c == ";" 57 | skip_rest_of_line 58 | elsif whitespace_char?(c) 59 | read_char 60 | else 61 | break 62 | end 63 | end 64 | end 65 | 66 | def read_token_as_string 67 | c = read_char 68 | if not token_first_char?(c) 69 | raise PoseSyntaxError("Not a token first char") 70 | end 71 | s = c 72 | loop do 73 | c = peek_char 74 | if c == nil or not token_next_char?(c) 75 | break 76 | end 77 | s += read_char 78 | end 79 | s 80 | end 81 | 82 | def read_sharpsign 83 | c = read_char 84 | radix = { "b" => 2, "o" => 8, "x" => 16 }[c] 85 | if radix == nil 86 | raise PoseSyntaxError("Unknown #") 87 | end 88 | token = read_token_as_string 89 | value = parse_integer(token, radix) 90 | if value == nil 91 | raise PoseSyntaxError("Cannot parse integer from token") 92 | end 93 | value 94 | end 95 | 96 | def read_delimited_list(end_char) 97 | forms = [] 98 | loop do 99 | skip_whitespace_and_comments 100 | if peek_char == end_char 101 | read_char 102 | break 103 | else 104 | begin 105 | forms.append(read) 106 | rescue EOFError 107 | raise PoseSyntaxError("Unterminated list") 108 | end 109 | end 110 | end 111 | forms 112 | end 113 | 114 | def read_delimited_string(end_char) 115 | s = "" 116 | loop do 117 | c = read_char 118 | if c == nil 119 | raise PoseSyntaxError("Unterminated string") 120 | elsif c == end_char 121 | break 122 | elsif c == "\\" 123 | c = read_char 124 | if c == nil 125 | raise PoseSyntaxError("Unterminated string escape") 126 | else 127 | raw = { 128 | '"' => '"', 129 | "|" => "|", 130 | "n" => "\n", 131 | "t" => "\t", 132 | "\\" => "\\", 133 | }[c] 134 | if raw == nil 135 | raise PoseSyntaxError("Unknown string escape") 136 | end 137 | s += raw 138 | end 139 | else 140 | s += c 141 | end 142 | end 143 | s 144 | end 145 | 146 | def read 147 | skip_whitespace_and_comments 148 | c = peek_char 149 | if c == nil 150 | raise EOFError 151 | elsif token_first_char?(c) 152 | parse_number_or_symbol(read_token_as_string) 153 | else 154 | c = read_char 155 | if c == "#" 156 | read_sharpsign 157 | elsif c == "|" 158 | read_delimited_string("|").to_sym 159 | elsif c == '"' 160 | read_delimited_string('"') 161 | elsif c == "(" 162 | read_delimited_list(")") 163 | elsif c == ")" 164 | raise PoseSyntaxError("Stray closing parenthesis") 165 | else 166 | raise PoseSyntaxError("Unknown character at top level") 167 | end 168 | end 169 | end 170 | 171 | def read_all 172 | forms = [] 173 | begin 174 | loop do 175 | forms.append(read) 176 | end 177 | rescue EOFError 178 | forms 179 | end 180 | end 181 | end 182 | -------------------------------------------------------------------------------- /ruby/spec/pose_spec.rb: -------------------------------------------------------------------------------- 1 | require_relative '../pose' 2 | 3 | def read_all(str) 4 | PoseReader.new(StringIO.new(str)).read_all 5 | end 6 | 7 | describe "sample expressions" do 8 | it "can parse simple expressions" do 9 | expect(read_all("(symbol \"value\")")).to eq [[:symbol, "value"]] 10 | expect(read_all("; Foo")).to eq [] 11 | expect(read_all(" ; Bar")).to eq [] 12 | expect(read_all("( 1 2 (|asdo\\|aisdj| \"dfdosi dsi\"))")).to eq [[:"1", :"2", [:"asdo|aisdj", "dfdosi dsi"]]] 13 | expect(read_all("()")).to eq [[]] 14 | end 15 | end -------------------------------------------------------------------------------- /scheme/pose.scm: -------------------------------------------------------------------------------- 1 | ;; Copyright 2021 Lassi Kortela 2 | ;; SPDX-License-Identifier: ISC 3 | 4 | (define (pose-whitespace? char) 5 | (or (char=? #\x20 char) (char<=? #\x09 char #\x0D))) 6 | 7 | (define (string-member? string char) 8 | (let loop ((i (- (string-length string) 1))) 9 | (and (>= i 0) (or (char=? char (string-ref string i)) 10 | (loop (- i 1)))))) 11 | 12 | (define (pose-token-common-char? char) 13 | (or (char<=? #\0 char #\9) 14 | (char<=? #\A char #\Z) 15 | (char<=? #\a char #\z) 16 | (string-member? "_$!?<=>+-*" char))) 17 | 18 | (define (pose-token-first-char? char) 19 | (or (pose-token-common-char? char) 20 | (string-member? "/" char))) 21 | 22 | (define (pose-token-next-char? char) 23 | (or (pose-token-first-char? char) 24 | (string-member? ".@~^%&" char))) 25 | 26 | (define (make-float idigits fdigits fcount edigits) 27 | ) 28 | 29 | (define (parse-digits radix s i) 30 | #f) 31 | 32 | (define (parse-sign-and-digits radix s i) 33 | (cond ((looking-at? #\+ s i) (+ (parse-digits radix s (+ i 1)))) 34 | ((looking-at? #\- s i) (- (parse-digits radix s (+ i 1)))) 35 | (else (parse-digits radix s i)))) 36 | 37 | (define (parse-decimal-or-symbol s) 38 | (let*-values 39 | (((i ipart) (parse-sign-and-digits 10 s 0)) 40 | ((i fpart) (and ipart (< i n) (char=? 41 | (if . (parse-digits 10 s i)))) 42 | ((i epart) (and ipart (if e (parse-sign-and-digits 10 s 0)))) 43 | ((done?) (= i len))) 44 | (cond ((not ipart) (string->symbol s)) 45 | ((not done?) (error "Bad decimal number" s)) 46 | ((or fpart epart) (make-float ipart fpart epart)) 47 | (else ipart)))) 48 | 49 | (define (skip-rest-of-line) 50 | (let ((char (read-char))) 51 | (unless (or (eof-object? char) (char=? #\newline char)) 52 | (skip-rest-of-line)))) 53 | 54 | (define (skip-whitespace-and-comments) 55 | (let ((char (peek-char))) 56 | (cond ((eof-object? char) #f) 57 | ((char=? #\; char) 58 | (skip-rest-of-line) 59 | (skip-whitespace-and-comments)) 60 | ((pose-whitespace? char) 61 | (read-char) 62 | (skip-whitespace-and-comments))))) 63 | 64 | (define (read-token-as-string) 65 | (let ((char (read-char))) 66 | (unless (pose-token-first-char? char) 67 | (error "Not a token first char" char)) 68 | (let loop ((chars (list char))) 69 | (let ((char (peek-char))) 70 | (if (or (eof-object? char) (not (pose-token-next-char? char))) 71 | (list->string (reverse chars)) 72 | (loop (cons (read-char) chars))))))) 73 | 74 | (define (read-sharpsign) 75 | (let* ((radix (let ((char (read-char))) 76 | (case char 77 | ((#\b) 2) 78 | ((#\o) 8) 79 | ((#\x) 16) 80 | (else (error "Unknown #" char))))) 81 | (token (read-token-as-string)) 82 | (ipart (parse-sign-and-digits radix s 0))) 83 | (if (and ipart done?) ipart 84 | (error "Cannot parse integer from token" token radix)))) 85 | 86 | (define (read-delimited-list end-char) 87 | (let loop ((forms '())) 88 | (skip-whitespace-and-comments) 89 | (cond ((eqv? end-char (peek-char)) 90 | (read-char) 91 | (reverse forms)) 92 | (else 93 | (let ((form (pose-read))) 94 | (if (eof-object? form) (error "Unterminated list") 95 | (loop (cons form forms)))))))) 96 | 97 | (define (read-delimited-string end-char) 98 | (let loop ((chars '())) 99 | (let ((char (read-char))) 100 | (cond ((eof-object? char) 101 | (error "Unterminated string" end-char)) 102 | ((char=? end-char char) 103 | (list->string (reverse chars))) 104 | ((char=? #\\ char) 105 | (let ((char (read-char))) 106 | (if (eof-object? char) 107 | (error "Unterminated string escape") 108 | (loop 109 | (cons (case char 110 | ((#\n) #\newline) 111 | ((#\t) #\tab) 112 | ((#\\ #\| #\") char) 113 | (else (error "Unknown string escape" char))) 114 | chars))))) 115 | (else 116 | (loop (cons char chars))))))) 117 | 118 | (define (pose-read) 119 | (skip-whitespace-and-comments) 120 | (let ((char (peek-char))) 121 | (cond ((eof-object? char) 122 | (eof-object)) 123 | ((pose-token-first-char? char) 124 | (parse-number-or-symbol (read-token-as-string))) 125 | (else 126 | (let ((char (read-char))) 127 | (case char 128 | ((#\#) (read-sharpsign)) 129 | ((#\|) (string->symbol (read-delimited-string #\|))) 130 | ((#\") (read-delimited-string #\")) 131 | ((#\() (read-delimited-list #\))) 132 | ((#\)) (error "Stray closing parenthesis")) 133 | (else (error "Unknown character at top level" char)))))))) 134 | 135 | (define (pose-read-all) 136 | (let loop ((forms '())) 137 | (let ((form (pose-read))) 138 | (if (eof-object? form) (reverse forms) 139 | (loop (cons form forms)))))) 140 | -------------------------------------------------------------------------------- /scheme/pose.sld: -------------------------------------------------------------------------------- 1 | ;; Copyright 2021 Lassi Kortela 2 | ;; SPDX-License-Identifier: ISC 3 | 4 | (define-library (pose) 5 | (export pose-read pose-read-all) 6 | (import (scheme base)) 7 | (include "pose.scm")) 8 | -------------------------------------------------------------------------------- /scheme/pose.sls: -------------------------------------------------------------------------------- 1 | ;; Copyright 2021 Lassi Kortela 2 | ;; SPDX-License-Identifier: ISC 3 | 4 | (library (pose) 5 | (export pose-read pose-read-all) 6 | (import (rnrs) (srfi private include)) 7 | (include/resolve () "pose.scm")) 8 | -------------------------------------------------------------------------------- /scheme/test6.scm: -------------------------------------------------------------------------------- 1 | (import (rnrs) (pose)) 2 | 3 | (define (writeln x) (write x) (newline)) 4 | 5 | (for-each writeln (pose-read-all)) 6 | -------------------------------------------------------------------------------- /scheme/test7.scm: -------------------------------------------------------------------------------- 1 | (import (scheme base) (scheme file) (scheme write) (pose)) 2 | 3 | (define (writeln x) (write x) (newline)) 4 | 5 | (for-each writeln (pose-read-all)) 6 | -------------------------------------------------------------------------------- /standard-ml/pose.sml: -------------------------------------------------------------------------------- 1 | (* Copyright 2021 Lassi Kortela *) 2 | (* SPDX-License-Identifier: ISC *) 3 | 4 | exception SyntaxError of string; 5 | 6 | datatype Exp 7 | = EList of Exp list 8 | | ESymbol of string 9 | | EString of string 10 | | EReal of real 11 | | EInt of int 12 | | EIntInf of IntInf.int; 13 | 14 | fun stringContainsChar s goalChar = 15 | let fun loop 0 = false 16 | | loop i = let val char = String.sub (s, i-1) in 17 | if char = goalChar then 18 | true 19 | else 20 | loop (i-1) 21 | end 22 | in loop (String.size s) end; 23 | 24 | fun charIsWhitespace char = 25 | let val cc = Char.ord char in 26 | (cc = 0x20) orelse (cc >= 0x09 andalso cc <= 0x0D) 27 | end; 28 | 29 | fun charIsAlphabetic char = 30 | ((char >= #"A") andalso (char <= #"Z")) orelse 31 | ((char >= #"a") andalso (char <= #"z")); 32 | 33 | fun charIsNumeric char = 34 | ((char >= #"0") andalso (char <= #"9")); 35 | 36 | fun charIsTokenCommon char = 37 | ((charIsAlphabetic char) orelse 38 | (charIsNumeric char) orelse 39 | (stringContainsChar "_$!?<=>+-*" char)); 40 | 41 | fun charIsTokenFirst char = 42 | ((charIsTokenCommon char) orelse 43 | (stringContainsChar "/" char)); 44 | 45 | fun charIsTokenNext char = 46 | ((charIsTokenFirst char) orelse 47 | (stringContainsChar ".@~^%&" char)); 48 | 49 | fun parseNumberOrSymbol string = 50 | ESymbol string; 51 | 52 | fun skipRestOfLine stream = 53 | case TextIO.input1 stream 54 | of NONE => () 55 | | SOME #"\n" => () 56 | | SOME _ => skipRestOfLine stream; 57 | 58 | fun skipWhitespaceAndComments stream = 59 | case TextIO.lookahead stream 60 | of NONE => () 61 | | SOME #";" => (skipRestOfLine stream; 62 | skipWhitespaceAndComments stream) 63 | | SOME char => if charIsWhitespace char then 64 | (TextIO.input1 stream; 65 | skipWhitespaceAndComments stream) 66 | else 67 | (); 68 | 69 | fun readRestOfTokenAsString char stream = 70 | let fun loop chars = case TextIO.lookahead stream 71 | of NONE => chars 72 | | SOME char => if charIsTokenNext char then 73 | (TextIO.input1 stream; 74 | loop (char :: chars)) 75 | else 76 | chars 77 | in String.implode (List.rev (loop [])) end; 78 | 79 | fun readTokenAsString stream = 80 | case TextIO.input1 stream 81 | of NONE => raise SyntaxError "End-of-file while expecting token" 82 | | SOME char => if charIsTokenFirst char then 83 | raise SyntaxError "Not a token first char" 84 | else 85 | readRestOfTokenAsString char stream; 86 | 87 | fun readIntegerRadix radix stream = 88 | ESymbol (readTokenAsString stream); 89 | 90 | fun readSharpsign stream = 91 | case TextIO.input1 stream 92 | of NONE => raise SyntaxError "End-of-file while reading #" 93 | | SOME #"b" => readIntegerRadix 2 stream 94 | | SOME #"o" => readIntegerRadix 8 stream 95 | | SOME #"x" => readIntegerRadix 16 stream 96 | | SOME char => raise SyntaxError "Unknown # character"; 97 | 98 | fun readStringEscape endChar stream = 99 | case TextIO.input1 stream 100 | of NONE => raise SyntaxError "Unterminated string escape" 101 | | SOME #"n" => #"\n" 102 | | SOME #"t" => #"\t" 103 | | SOME char => if (char = #"\\") orelse (char = endChar) then 104 | char 105 | else 106 | raise SyntaxError "Unknown string escape"; 107 | 108 | fun readDelimitedString endChar stream = 109 | let fun loop chars = 110 | case TextIO.input1 stream 111 | of NONE => raise SyntaxError "Unterminated string" 112 | | SOME char => if char = endChar then 113 | chars 114 | else 115 | loop ((if char = #"\\" then 116 | readStringEscape endChar stream 117 | else 118 | char) 119 | :: chars) 120 | in String.implode (List.rev (loop [])) end; 121 | 122 | fun readList stream = 123 | let fun loop forms = 124 | (skipWhitespaceAndComments stream; 125 | case TextIO.lookahead stream 126 | of SOME #")" => (TextIO.input1 stream; forms) 127 | | _ => case read stream 128 | of NONE => raise SyntaxError "Unterminated list" 129 | | SOME form => loop (form :: forms)) 130 | in EList (List.rev (loop [])) end 131 | and read stream = 132 | (skipWhitespaceAndComments stream; 133 | case TextIO.lookahead stream 134 | of NONE => NONE 135 | | SOME char => 136 | SOME (if charIsTokenFirst char then 137 | parseNumberOrSymbol (readRestOfTokenAsString char stream) 138 | else 139 | (TextIO.input1 stream; 140 | case char 141 | of #"\"" => EString (readDelimitedString char stream) 142 | | #"|" => ESymbol (readDelimitedString char stream) 143 | | #"#" => readSharpsign stream 144 | | #"(" => readList stream 145 | | #")" => raise SyntaxError "Stray closing parenthesis" 146 | | _ => raise SyntaxError 147 | "Unknown character at top level"))); 148 | 149 | fun readAll stream = 150 | let fun loop forms = 151 | case read stream 152 | of NONE => List.rev forms 153 | | SOME form => loop (form :: forms) 154 | in loop [] end; 155 | 156 | fun write stream form = 157 | case form 158 | of EList [] => TextIO.output (stream, "()") 159 | | EList forms => (let fun loop prefix [] = 160 | TextIO.output1 (stream, #")") 161 | | loop prefix (form :: forms) = 162 | (TextIO.output1 (stream, prefix); 163 | write stream form; 164 | loop #" " forms) 165 | in loop #"(" forms end) 166 | | ESymbol s => TextIO.output (stream, s) 167 | | EString s => TextIO.output (stream, s) 168 | | EReal n => TextIO.output (stream, (Real.toString n)) 169 | | EInt n => TextIO.output (stream, (Int.toString n)) 170 | | EIntInf n => TextIO.output (stream, (IntInf.toString n)); 171 | 172 | fun writeln stream form = 173 | (write stream form; 174 | TextIO.output1 (stream, #"\n")); 175 | 176 | List.app (writeln TextIO.stdOut) (readAll TextIO.stdIn); 177 | -------------------------------------------------------------------------------- /symbol.text: -------------------------------------------------------------------------------- 1 | Portable Lisp symbol syntax 2 | 3 | Punctuation permitted in symbols 4 | 5 | ! suffix for destructive operators (Scheme, Clojure) 6 | $ no particular meaning 7 | & prefix for lambda list keywords (Common Lisp) 8 | * prefix and suffix for dynamic variables (Common Lisp); math operator 9 | + prefix and suffix for constants (Common Lisp); math operator 10 | - word delimiter in multi-word symbols; math operator 11 | / math operator 12 | < math operator 13 | = math operator 14 | > math operator 15 | _ word delimiter in multi-word symbols (occasionally) 16 | 17 | Punctuation permitted in symbols, but not as the first character 18 | 19 | . consing dot; prefix for instance method call (Clojure) 20 | ? prefix for character literal (Emacs Lisp); suffix for predicate (Scheme, Clojure) 21 | @ prefix for splice operation (Kawa Scheme) 22 | 23 | Punctuation permitted in symbols, but only as the first character: 24 | 25 | : prefix for keyword (CL, some Schemes); 26 | disallowed as infix for symbol package (Common Lisp); 27 | symbols beginning with more than one : are disallowed 28 | 29 | Punctuation not allowed anywhere in a symbol 30 | 31 | # prefix for syntax extension; comment (Janet) 32 | % prefix for character literal (Interlisp) 33 | ' prefix for quote 34 | , prefix for unquote 35 | ; prefix for comment 36 | \ prefix for character literal (Clojure); infix for string escape 37 | ^ prefix for metadata attached to an object (Clojure) 38 | ` prefix for backquote/quasiquote 39 | ~ prefix for unquote (Clojure) 40 | 41 | Punctuation not allowed anywhere in a symbol (paired) 42 | 43 | "" string literal 44 | () paired delimiters 45 | [] paired delimiters (Clojure, Scheme) 46 | {} maps and sets (Clojure) 47 | || symbol written using string syntax (Common Lisp, Scheme) 48 | --------------------------------------------------------------------------------