140 lines
3.9 KiB
Racket
140 lines
3.9 KiB
Racket
(module turtle racket/base
|
|
(provide (except-out (all-defined-out) :decode-embedded :encode-embedded)
|
|
(rename-out
|
|
(:decode-embedded decode-embedded:turtle)
|
|
(:encode-embedded encode-embedded:turtle)))
|
|
(require preserves)
|
|
(require preserves-schema/methods)
|
|
(require preserves-schema/support)
|
|
(require racket/match)
|
|
(require racket/set)
|
|
(require racket/dict)
|
|
(require (only-in racket/generic define/generic))
|
|
(define :decode-embedded values)
|
|
(define :encode-embedded values)
|
|
(struct
|
|
Block
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match
|
|
preservable
|
|
((Block src) (for/list ((item (in-list src))) (*->preserve item)))))))
|
|
(define (parse-Block input)
|
|
(match
|
|
input
|
|
((list (app parse-Token (and dest (not (== eof)))) ...) (Block dest))
|
|
(_ eof)))
|
|
(define parse-Block! (parse-success-or-error 'parse-Block parse-Block))
|
|
(struct
|
|
Program
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match preservable ((Program src) (*->preserve src))))))
|
|
(define (parse-Program input)
|
|
(match
|
|
input
|
|
((app parse-Block (and dest (not (== eof)))) (Program dest))
|
|
(_ eof)))
|
|
(define parse-Program! (parse-success-or-error 'parse-Program parse-Program))
|
|
(struct
|
|
Shape
|
|
(program)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match
|
|
preservable
|
|
((Shape ?program) (record 'turtle (list (*->preserve ?program))))))))
|
|
(define (parse-Shape input)
|
|
(match
|
|
input
|
|
((and dest
|
|
(record
|
|
'turtle
|
|
(list (app parse-Program (and ?program (not (== eof)))))))
|
|
(Shape ?program))
|
|
(_ eof)))
|
|
(define parse-Shape! (parse-success-or-error 'parse-Shape parse-Shape))
|
|
(define (Token? p)
|
|
(or (Token-i? p)
|
|
(Token-d? p)
|
|
(Token-b? p)
|
|
(Token-s? p)
|
|
(Token-v? p)
|
|
(Token-block? p)))
|
|
(struct
|
|
Token-i
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match preservable ((Token-i src) (*->preserve src))))))
|
|
(struct
|
|
Token-d
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match preservable ((Token-d src) (exact->inexact (*->preserve src)))))))
|
|
(struct
|
|
Token-b
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match preservable ((Token-b src) (*->preserve src))))))
|
|
(struct
|
|
Token-s
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match preservable ((Token-s src) (*->preserve src))))))
|
|
(struct
|
|
Token-v
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match preservable ((Token-v src) (*->preserve src))))))
|
|
(struct
|
|
Token-block
|
|
(value)
|
|
#:transparent
|
|
#:methods
|
|
gen:preservable
|
|
((define/generic *->preserve ->preserve)
|
|
(define (->preserve preservable)
|
|
(match preservable ((Token-block src) (*->preserve src))))))
|
|
(define (parse-Token input)
|
|
(match
|
|
input
|
|
((and dest (? exact-integer?)) (Token-i dest))
|
|
((and dest (? flonum?)) (Token-d dest))
|
|
((and dest (? boolean?)) (Token-b dest))
|
|
((and dest (? string?)) (Token-s dest))
|
|
((and dest (? symbol?)) (Token-v dest))
|
|
((app parse-Block (and dest (not (== eof)))) (Token-block dest))
|
|
(_ eof)))
|
|
(define parse-Token! (parse-success-or-error 'parse-Token parse-Token)))
|