Thun/implementations/scheme-chicken/joy.scm

61 lines
1.9 KiB
Scheme

(import (chicken string))
(define (string-replace str from to)
(string-intersperse (string-split str from #t) to))
(define (tokenize str)
(string-split
(string-replace (string-replace str "]" " ] ") "[" " [ ")))
(define (tokenator token)
(cond ((string->number token) (string->number token))
((string=? token "true") #t)
((string=? token "false") #f)
(else token)))
(define (expect-right-bracket tokens acc)
(if (null? tokens)
(/ 2 0)
(expect-right-bracket-lookahead (car tokens) (cdr tokens) acc)))
(define (expect-right-bracket-lookahead token tokens acc)
(cond ((string=? token "]") (values acc tokens))
((string=? token "[")
(receive (sub_list rest) (expect-right-bracket tokens '())
(receive (el rrest) (expect-right-bracket rest acc)
(values (cons sub_list el) rrest))))
(else
(receive (el rest) (expect-right-bracket tokens acc)
(values (cons (tokenator token) el) rest)))))
(define (one-token-lookahead token tokens)
(cond ((string=? token "]") (/ 1 0))
((string=? token "[") (expect-right-bracket tokens '()))
(else (values (tokenator token) tokens))))
(define (parse0 tokens acc)
(if (null? tokens)
acc
(receive (term rest_of_tokens)
(one-token-lookahead (car tokens) (cdr tokens))
(cons term (parse0 rest_of_tokens acc)))))
(define (parse tokens) (parse0 tokens '()))
(define (text-to-expression text) (parse (tokenize text)))
(define (joy-term-to-string term)
(cond ((boolean? term) (if term "true" "false"))
((number? term) (->string term))
((list? term) (conc "[" (joy-expression-to-string term) "]"))
(else term)))
(define (joy-expression-to-string expr)
(string-intersperse (map joy-term-to-string expr) " "))
(display (joy-expression-to-string (text-to-expression "ab cd [[ ]] 234 [true] false")))
(newline)