suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Found quick&dirty way to embed the result of (init) whenever hlite is used. Added removed-but-with-another-style modes -/ -= -+

Browse Source
This commit is contained in:
Georges Dupéron 2017-05-22 04:25:23 +02:00
parent ddf8b602b2
commit a8a0eb8a28
2 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
diff1.rkt
View File

@ -1,7 +1,6 @@
#lang at-exp racket/base #lang at-exp racket/base
(provide hlite (provide hlite)
init)
(require hyper-literate (require hyper-literate
(for-syntax syntax/parse (for-syntax syntax/parse
@ -106,6 +105,9 @@
[(and (identifier? g) (free-identifier=? g #'=)) '=] [(and (identifier? g) (free-identifier=? g #'=)) '=]
[(and (identifier? g) (free-identifier=? g #'-)) '-] [(and (identifier? g) (free-identifier=? g #'-)) '-]
[(and (identifier? g) (free-identifier=? g #'+)) '+] [(and (identifier? g) (free-identifier=? g #'+)) '+]
[(and (identifier? g) (free-identifier=? g #'-/)) '-/]
[(and (identifier? g) (free-identifier=? g #'-=)) '-=]
[(and (identifier? g) (free-identifier=? g #'-+)) '-+]
[(identifier? g) '_] [(identifier? g) '_]
[(syntax? g) (simplify-guide (syntax-e g))] [(syntax? g) (simplify-guide (syntax-e g))]
[(pair? g) (cons (simplify-guide (car g)) [(pair? g) (cons (simplify-guide (car g))
@ -116,7 +118,10 @@
[(/) "HyperLiterateDim"] [(/) "HyperLiterateDim"]
[(=) "HyperLiterateNormal"] [(=) "HyperLiterateNormal"]
[(-) "HyperLiterateRemove"] [(-) "HyperLiterateRemove"]
[(+) "HyperLiterateAdd"])) [(+) "HyperLiterateAdd"]
[(-/) "HyperLiterateDim"]
[(-=) "HyperLiterateNormal"]
[(-+) "HyperLiterateAdd"]))
(define simplified-guide (simplify-guide #'guide1)) (define simplified-guide (simplify-guide #'guide1))
(define (syntax-e? v) (define (syntax-e? v)
(if (syntax? v) (syntax-e v) v)) (if (syntax? v) (syntax-e v) v))
@ -125,7 +130,7 @@
[guide simplified-guide] [guide simplified-guide]
[body #'body]) [body #'body])
(match guide (match guide
[(cons (and new-mode (or '/ '= '- '+)) rest-guide) [(cons (and new-mode (or '/ '= '- '+ '-/ '-= '-+)) rest-guide)
(loop new-mode rest-guide body)] (loop new-mode rest-guide body)]
[(list car-guide rest-guide) [(list car-guide rest-guide)
#:when (and (pair? (syntax-e? body)) #:when (and (pair? (syntax-e? body))
@ -168,7 +173,7 @@
[acc '()]) [acc '()])
(cond (cond
[(and (pair? guide) [(and (pair? guide)
(memq (car guide) '(/ = - +))) (memq (car guide) '(/ = - + -/ -= -+)))
(if first-iteration? (if first-iteration?
(loop (car guide) (cdr guide) body) (loop (car guide) (cdr guide) body)
;; produce: ;; produce:
@ -224,7 +229,7 @@
(raise-syntax-error (raise-syntax-error
'hlite 'hlite
;; TODO: thread the syntax version of body, so that ;; TODO: thread the syntax version of body, so that
;; we can highligh the error. ;; we can highlight the error.
"Expected non-null body, but found null" "Expected non-null body, but found null"
stx)) stx))
;; produce: ;; produce:
@ -261,13 +266,21 @@
(build-source-location-list (build-source-location-list
(update-source-location body #:span 0)))] (update-source-location body #:span 0)))]
['() ['()
(unless (stx-null? body)
(raise-syntax-error
'hlite
;; TODO: thread the syntax version of body, so that
;; we can highlight the error.
(format "Expected null body, but found non-null ~a"
(syntax->datum body))
stx))
body]))) body])))
(define new-executable-code (define new-executable-code
(let loop ([mode '=] (let loop ([mode '=]
[guide simplified-guide] [guide simplified-guide]
[body #'body]) [body #'body])
(match guide (match guide
[(cons (and new-mode (or '/ '= '- '+)) rest-guide) [(cons (and new-mode (or '/ '= '- '+ '-/ '-= '-+)) rest-guide)
(loop new-mode rest-guide body)] (loop new-mode rest-guide body)]
[(cons car-guide rest-guide) [(cons car-guide rest-guide)
(define (do-append-last-acc last-acc acc) (define (do-append-last-acc last-acc acc)
@ -296,7 +309,7 @@
[last-acc '()]) [last-acc '()])
(cond (cond
[(and (pair? guide) [(and (pair? guide)
(memq (car guide) '(/ = - +))) (memq (car guide) '(/ = - + -/ -= -+)))
(if (or first-iteration? (if (or first-iteration?
(eq? (car guide) mode)) (eq? (car guide) mode))
(loop (car guide) (cdr guide) body) (loop (car guide) (cdr guide) body)
@ -313,7 +326,7 @@
;; accumulate the first element of body, if mode is not '- ;; accumulate the first element of body, if mode is not '-
;; which means that the element should be removed. ;; which means that the element should be removed.
(cond (cond
[(and (eq? mode '-) [(and (memq mode '(- -/ -= -+))
(or (pair? (car body)) (or (pair? (car body))
(and (syntax? (car body)) (and (syntax? (car body))
(pair? (syntax-e (car body)))))) (pair? (syntax-e (car body))))))
@ -323,7 +336,7 @@
(cdr body) (cdr body)
(do-append-last-acc last-acc acc) (do-append-last-acc last-acc acc)
r))] r))]
[(eq? mode '-) [(memq mode '(- -/ -= -+))
(loop2 #f (loop2 #f
(cdr guide) (cdr guide)
(cdr body) (cdr body)
@ -361,6 +374,7 @@
;(displayln new-body) ;(displayln new-body)
;(show-stx new-body) ;(show-stx new-body)
#`(begin #`(begin
(init)
#,(datum->syntax #,(datum->syntax
stx stx
`(,(datum->syntax #'here 'chunk #'self) `(,(datum->syntax #'here 'chunk #'self)

13
scribblings/diff1-example.hl.rkt
View File

@ -7,17 +7,6 @@
Highly experimental. Contains bugs, API may change in the future. Highly experimental. Contains bugs, API may change in the future.
♦defproc[(init) any/c]{
For now, the ♦racket[init] function must be called somewhere in documents
which use ♦racketmodname[hyper-literate/diff1]. It produces helper values
which must be inserted in the scribble document. Simply adding this to the
document should be enough:
♦codeblock|{
#lang hyper-literate #:♦ racket/base
♦(init)}|}
♦defform[(hlite name pat . body)]{ ♦defform[(hlite name pat . body)]{
Like ♦racket[chunk], but highlights parts of the ♦racket[body] according to Like ♦racket[chunk], but highlights parts of the ♦racket[body] according to
@ -53,7 +42,6 @@ Highly experimental. Contains bugs, API may change in the future.
It produces the result shown below:} It produces the result shown below:}
♦require[hyper-literate/diff1] ♦require[hyper-literate/diff1]
♦(init)
♦hlite[<my-code> {/ (def args (_ - _ + _ / . _))} ♦hlite[<my-code> {/ (def args (_ - _ + _ / . _))}
(define (foo v) (define (foo v)
@ -65,7 +53,6 @@ You can look at the source code of this document to see how this example is
done. done.
♦require[hyper-literate/diff1] ♦require[hyper-literate/diff1]
♦(init)
We define the function foo as follows: We define the function foo as follows: