initial commit.
This commit is contained in:
commit
db4fa87d4b
3 changed files with 194 additions and 0 deletions
1
LICENCE
Normal file
1
LICENCE
Normal file
|
@ -0,0 +1 @@
|
||||||
|
Public domain or CC0 depending on what suits your jurisdiction best.
|
45
README.md
Normal file
45
README.md
Normal file
|
@ -0,0 +1,45 @@
|
||||||
|
at-expr for guile. Almost.
|
||||||
|
|
||||||
|
Use like this:
|
||||||
|
|
||||||
|
``` scheme
|
||||||
|
#@list[1 2 3]{This is the fun part.
|
||||||
|
It also handles newlines and indentation.}
|
||||||
|
|
||||||
|
;;=> (1 2 3 "This is the fun part." "\n" "It also handles newlines and indentation.")
|
||||||
|
```
|
||||||
|
|
||||||
|
It differs from Racket's at-expr in that it is not a proper reader extension, but a hack using guile's read-hash-extend. I never had the time nor energy to find all the edge cases and work them out, so no fancy things.
|
||||||
|
|
||||||
|
# One weird thing
|
||||||
|
|
||||||
|
``` scheme
|
||||||
|
;; Any at-expr in the squiggly part of an at-expr should start without the #.
|
||||||
|
#@list{Here I want proper scheme expr: @(+ 1 2).
|
||||||
|
Look. No pound sign.}
|
||||||
|
;; ("Here I want proper scheme expr: " 3 ". " "\n" "Look. No pound sign.")
|
||||||
|
```
|
||||||
|
|
||||||
|
# grammar
|
||||||
|
|
||||||
|
```
|
||||||
|
@<cmd><[args ...]{squiggly ...}
|
||||||
|
Where all parts are optional, but you have to have at least one.
|
||||||
|
|
||||||
|
cmd and args are read with guile's normal reader. Squiggly is special. Any normal text between { and } is read as a string. If an @ is found, whatever follows is interpreted as an at-expr. To write a literal at, you have to do @"@".
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
#@list(1 2 3) ;;=> (list 1 2 3)
|
||||||
|
#@list{My name is: @(read)} => (list "My name is: " (read))
|
||||||
|
#@+(1 2) ;; => (+ 1 2)
|
||||||
|
#@list{I can handle
|
||||||
|
source code indentation.
|
||||||
|
This line is indented by one space.}
|
||||||
|
;; => ("I can handle" "\n" "source code indentation." "\n" " This line is indented by one space.")
|
||||||
|
|
||||||
|
```
|
||||||
|
|
||||||
|
# Licence
|
||||||
|
|
||||||
|
Public domain or CC0 at your discretion.
|
148
syntax/at-expr.scm
Normal file
148
syntax/at-expr.scm
Normal file
|
@ -0,0 +1,148 @@
|
||||||
|
;; Something not unlike racket's at-expr.
|
||||||
|
;; I, Linus Björnstam, release this into the public domain.
|
||||||
|
;; If public domain is not applicable in your jurisdiction
|
||||||
|
;; you may use this under the Creative Commons 0 licence.
|
||||||
|
;; I hope you have fun, though.
|
||||||
|
|
||||||
|
|
||||||
|
(define-module (syntax at-expr)
|
||||||
|
#:use-module (ice-9 rdelim)
|
||||||
|
#:use-module (sxml simple)
|
||||||
|
#:use-module (sxml transform)
|
||||||
|
#:use-module (srfi srfi-1))
|
||||||
|
|
||||||
|
(define (fix-atexp sexp)
|
||||||
|
(define (untext tag str)
|
||||||
|
str)
|
||||||
|
(define (unstr tag pos str) str)
|
||||||
|
(define (undefault . args) args)
|
||||||
|
(define (unatexp tag pos atexp)
|
||||||
|
atexp)
|
||||||
|
(pre-post-order sexp `((atexpr . ,unatexp)
|
||||||
|
(str . ,unstr)
|
||||||
|
(*text* . ,untext)
|
||||||
|
(*default* . ,undefault))))
|
||||||
|
|
||||||
|
(read-hash-extend #\@ (lambda (chr port) (define res (read-atexp port))
|
||||||
|
(fix-atexp res)))
|
||||||
|
|
||||||
|
(define dispatch-char #\@)
|
||||||
|
|
||||||
|
(read-enable 'curly-infix)
|
||||||
|
|
||||||
|
(define (get-output-string-and-close port)
|
||||||
|
(let ((res (get-output-string port)))
|
||||||
|
(close-port port)
|
||||||
|
res))
|
||||||
|
(define (port-unwritten? port)
|
||||||
|
(and (= 0 (port-column port))
|
||||||
|
(= 0 (port-line port))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (skip-whitespace port)
|
||||||
|
(when (char-whitespace? (peek-char port))
|
||||||
|
(read-char port)
|
||||||
|
(skip-whitespace port)))
|
||||||
|
|
||||||
|
|
||||||
|
(define (skip-at-most-n-whitespace port n)
|
||||||
|
(let loop ((c 0))
|
||||||
|
(cond
|
||||||
|
((= c n) n)
|
||||||
|
((eq? #\space (peek-char port))
|
||||||
|
(read-char port)
|
||||||
|
(loop (+ c 1)))
|
||||||
|
((eq? #\newline (peek-char port))
|
||||||
|
n)
|
||||||
|
(else c))))
|
||||||
|
|
||||||
|
;; TODO: just skip spaces in "\n \n"
|
||||||
|
(define* (read-squiggly port #:optional (skip-space 0) (squiggly-delimiter #f))
|
||||||
|
(define sp (open-output-string))
|
||||||
|
(define line (port-line port))
|
||||||
|
(define col (port-column port))
|
||||||
|
(define (string str)
|
||||||
|
`(str (@ (line ,line) (column ,col)) ,str))
|
||||||
|
(let loop ((ch (peek-char port)))
|
||||||
|
(cond
|
||||||
|
((or (eof-object? ch)
|
||||||
|
(and squiggly-delimiter (eq? ch #\})))
|
||||||
|
(read-char port)
|
||||||
|
(if (port-unwritten? sp)
|
||||||
|
'()
|
||||||
|
(list (string (get-output-string-and-close sp)))))
|
||||||
|
((eq? ch dispatch-char)
|
||||||
|
(read-char port)
|
||||||
|
(let* ((output-str (get-output-string-and-close sp))
|
||||||
|
(atexp (read-atexp port))
|
||||||
|
(rest (read-squiggly port skip-space squiggly-delimiter)))
|
||||||
|
(if (string-null? output-str)
|
||||||
|
(cons atexp rest)
|
||||||
|
(cons* (string output-str) atexp rest))))
|
||||||
|
((eq? ch #\newline)
|
||||||
|
(read-char port)
|
||||||
|
(let* ((new-skip-space? (skip-at-most-n-whitespace port skip-space))
|
||||||
|
(str (get-output-string-and-close sp))
|
||||||
|
(skip-space (if (string-null? str) skip-space new-skip-space?))
|
||||||
|
(rest (read-squiggly port skip-space squiggly-delimiter)))
|
||||||
|
(if (string-null? str)
|
||||||
|
(cons "\n" rest)
|
||||||
|
(cons* (string str) "\n" rest))))
|
||||||
|
(else
|
||||||
|
(display (read-char port) sp)
|
||||||
|
(loop (peek-char port))))))
|
||||||
|
|
||||||
|
(define (read-atexp port)
|
||||||
|
(define invalid-start-chars (string->list "]})"))
|
||||||
|
(define line (port-line port))
|
||||||
|
(define col (port-column port))
|
||||||
|
(define (command-part)
|
||||||
|
(define invalid-starts (string->list "[]{}()"))
|
||||||
|
(define ch (peek-char port))
|
||||||
|
(when (eof-object? ch)
|
||||||
|
(error "Invalid atexpr at" line ': col))
|
||||||
|
(if (memq (peek-char port) invalid-starts)
|
||||||
|
#f
|
||||||
|
(list (read port))))
|
||||||
|
(define (arg-part)
|
||||||
|
(if (memq (peek-char port) '(#\[ #\())
|
||||||
|
(begin
|
||||||
|
(read-char port)
|
||||||
|
(let loop ((ch (peek-char port)))
|
||||||
|
(cond
|
||||||
|
((eof-object? ch) (error "invalid atexp at " line ': col))
|
||||||
|
((memq ch '(#\] #\)))
|
||||||
|
(read-char port)
|
||||||
|
'())
|
||||||
|
(else
|
||||||
|
(let ((res (read port)))
|
||||||
|
(skip-whitespace port)
|
||||||
|
(cons res (loop (peek-char port))))))))
|
||||||
|
#f))
|
||||||
|
(define (squiggly-part)
|
||||||
|
(if (eq? (peek-char port) #\{)
|
||||||
|
(begin
|
||||||
|
(read-char port)
|
||||||
|
(read-squiggly port (port-column port) #t))
|
||||||
|
#f))
|
||||||
|
(define ch (peek-char port))
|
||||||
|
(when (or (eof-object? ch)
|
||||||
|
(char-whitespace? ch)
|
||||||
|
(memq ch invalid-start-chars))
|
||||||
|
(error "reading of at-expr failed at port position: " line ': col))
|
||||||
|
|
||||||
|
(let* ((command? (command-part))
|
||||||
|
(arg? (arg-part))
|
||||||
|
(squiggly? (squiggly-part)))
|
||||||
|
(unless (or command? arg? squiggly?)
|
||||||
|
(error "Invalid atexpr at" line ': col))
|
||||||
|
`(atexpr (@ (line ,line) (column ,col)) ,(compile-atexp command? arg? squiggly?))))
|
||||||
|
|
||||||
|
(define (compile-atexp command arg squiggly)
|
||||||
|
(define (include arg)
|
||||||
|
(or arg '()))
|
||||||
|
(if (and command (not arg) (not squiggly))
|
||||||
|
(car command)
|
||||||
|
`(,@(include command)
|
||||||
|
,@(include arg)
|
||||||
|
,@(include squiggly))))
|
Loading…
Add table
Add a link
Reference in a new issue