victory
This commit is contained in:
parent
0f9e8018ea
commit
fd5c53f019
|
@ -30,61 +30,30 @@
|
|||
(parameterize ([cmd-line-mode? #t])
|
||||
(do-place)))))
|
||||
|
||||
|
||||
(provide txtadv-program)
|
||||
(define #'(txtadv-program _section ...)
|
||||
#'(module-begin _section ...))
|
||||
(define #'txtadv-program #'module-begin)
|
||||
|
||||
(provide verb-section)
|
||||
(define-inverting #'(verb-section _verb-item ...)
|
||||
(define #'(verb-section
|
||||
((_name0 . _transitive0?)
|
||||
(_name . _transitive?) ... _desc) ...)
|
||||
(inject-syntax ([#'in-verbs (shared-syntax 'in-verbs)])
|
||||
#'(define-verbs in-verbs
|
||||
_verb-item ...)))
|
||||
|
||||
|
||||
(provide verb-item)
|
||||
(define-inverting #'(verb-item (_name0 _transitive0?) (_name _transitive?) ... _desc)
|
||||
#`[_name0 #,@(if (syntax->datum #'_transitive0?) #'(_) #'()) (= _name ...) _desc])
|
||||
|
||||
(provide verb-name)
|
||||
(define-cases #'verb-name
|
||||
[#'(_ _id) #'(_id #f)]
|
||||
[#'(_ _id _underscore) #'(_id #t)])
|
||||
[_name0 #,@(if (syntax->datum #'_transitive0?) #'(_) #'()) (= _name ...) _desc] ...)))
|
||||
|
||||
(provide everywhere-section)
|
||||
(define-inverting #'(everywhere-section [_name _desc] ...)
|
||||
(define #'(everywhere-section [_id _desc] ...)
|
||||
#'(define-everywhere everywhere-actions
|
||||
([_name _desc] ...)))
|
||||
|
||||
(provide id-desc)
|
||||
(define-inverting #'(id-desc _id _desc)
|
||||
#'(_id _desc))
|
||||
([_id _desc] ...)))
|
||||
|
||||
(provide things-section)
|
||||
(define-inverting #'(things-section _thing ...)
|
||||
#'(begin _thing ...))
|
||||
|
||||
(provide thing-item)
|
||||
(define-inverting #'(thing-item _thingname (_actionname _actiondesc) ...)
|
||||
#'(define-thing _thingname [_actionname _actiondesc] ...))
|
||||
(define #'(things-section (_thingname (_actionname _actiondesc) ...) ...)
|
||||
#'(begin (define-thing _thingname [_actionname _actiondesc] ...) ...))
|
||||
|
||||
(provide places-section)
|
||||
(define-inverting #'(places-section _placeitem ...)
|
||||
#'(begin _placeitem ...))
|
||||
|
||||
(provide place-item)
|
||||
(define-inverting #'(place-item _place-id _place-desc [_place-item ...] [_actionname _actiondesc] ...)
|
||||
#'(define-place _place-id _place-desc [_place-item ...] ([_actionname _actiondesc] ...)))
|
||||
|
||||
(provide place-descrip)
|
||||
(define #'(place-descrip _desc) #'_desc)
|
||||
|
||||
(provide place-items)
|
||||
(define-inverting #'(place-items _id ...) #'(_id ...))
|
||||
|
||||
(provide place-name)
|
||||
(define-cases #'place-name
|
||||
[#'(_ _id) #'_id])
|
||||
|
||||
(define #'(places-section (_place-id _place-desc [_place-item ...] [_actionname _actiondesc] ...) ...)
|
||||
#'(begin (define-place _place-id _place-desc [_place-item ...] ([_actionname _actiondesc] ...)) ...))
|
||||
|
||||
(provide s-exp)
|
||||
(define-cases-inverting #'s-exp
|
||||
|
|
|
@ -4,28 +4,24 @@ txtadv-program : verb-section everywhere-section things-section places-section s
|
|||
|
||||
verb-section : <"===VERBS==="> verb-item+
|
||||
|
||||
verb-item : verb-name+ s-exp
|
||||
<verb-item> : verb-name+ s-exp
|
||||
|
||||
verb-name : [<",">] ID ["_"]
|
||||
<verb-name> : [<",">] ID ["_"]
|
||||
|
||||
everywhere-section : <"===EVERYWHERE==="> id-desc+
|
||||
|
||||
things-section : <"===THINGS==="> thing-item+
|
||||
|
||||
thing-item : DASHED-NAME id-desc+
|
||||
<thing-item> : DASHED-NAME id-desc+
|
||||
|
||||
places-section : <"===PLACES==="> place-item+
|
||||
|
||||
place-item : DASHED-NAME place-descrip place-items id-desc+
|
||||
<place-item> : DASHED-NAME STRING place-items id-desc+
|
||||
|
||||
place-descrip : STRING ; `place-desc` is already used in expander
|
||||
<place-items> : <"["> ([<",">] ID)* <"]">
|
||||
|
||||
place-items : <"["> place-name* <"]"> ; `place-things` is already used
|
||||
start-section : <"===START==="> ID
|
||||
|
||||
place-name : [<",">] ID
|
||||
|
||||
start-section : <"===START==="> place-name
|
||||
|
||||
id-desc : ID s-exp
|
||||
<id-desc> : ID s-exp
|
||||
|
||||
s-exp : ID | STRING | <"("> s-exp* <")">
|
|
@ -165,7 +165,9 @@ This would be the place to check a syntax property for hiding.
|
|||
(define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:splice? [splice #f] . componentss)
|
||||
(let ([spliced-componentss (append-map (λ(cs)
|
||||
(if (and (pair? cs) (syntax-property (car cs) 'splice))
|
||||
(list (cdr (syntax->list (car cs)))) ; pop off the rule name and splice its components into this rule
|
||||
(list (list (syntax-case (car cs) ()
|
||||
[(rule-name c ...)
|
||||
#'(c ...)])))
|
||||
(list cs))) componentss)])
|
||||
(syntax-property
|
||||
(datum->syntax #f
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
":"
|
||||
(token 'STRING "'hello world'")
|
||||
"}")))
|
||||
'(json (object ":")))
|
||||
'(json (object (":"))))
|
||||
|
||||
|
||||
(check-equal?
|
||||
|
|
Loading…
Reference in New Issue
Block a user