diff --git a/graph/Makefile b/graph/Makefile index 2e50b1c5..d709299e 100644 --- a/graph/Makefile +++ b/graph/Makefile @@ -12,4 +12,4 @@ clean: .PHONY: build-dep build-dep: - raco pkg install --deps search-auto --update-deps --skip-installed alexis-util cover + raco pkg install --deps search-auto --update-deps --skip-installed alexis-util cover debug diff --git a/graph/graph/rewrite-type.lp2.rkt b/graph/graph/rewrite-type.lp2.rkt index 48d7981e..fc81d25f 100644 --- a/graph/graph/rewrite-type.lp2.rkt +++ b/graph/graph/rewrite-type.lp2.rkt @@ -514,6 +514,9 @@ implementation. @section{Conclusion} +TODO: to test the two versions of replace-in-instance, just use the chunk twice, +with a let. + @chunk[<*> (begin (module main typed/racket diff --git a/graph/graph/variant.lp2.rkt b/graph/graph/variant.lp2.rkt index 978cd6cc..9661a6cf 100644 --- a/graph/graph/variant.lp2.rkt +++ b/graph/graph/variant.lp2.rkt @@ -105,7 +105,7 @@ don't really know how to solve that. It should be noted that constructors are likely to have names starting with a capital letter, so maybe this reduces the number of name collisions. -@section{@racket{tagged}} +@section{@racket[tagged]} @CHUNK[ (define-multi-id tagged @@ -131,7 +131,7 @@ number of name collisions. [(tagged foo z x y) (list z y x)]) '(z 3 "o"))] -@section{@racket{define-tagged}} +@section{@racket[define-tagged]} @chunk[ (define-syntax/parse (define-tagged tag:id [field type] ... diff --git a/graph/lib/doc/math.rkt b/graph/lib/doc/math.rkt index f1a2bd8d..31883eaf 100644 --- a/graph/lib/doc/math.rkt +++ b/graph/lib/doc/math.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang at-exp racket ;; This file is derived from the one which can be found at: ;; https://github.com/soegaard/bracket/blob/master/docs/pr-math.rkt @@ -9,15 +9,17 @@ (all-from-out "math-scribble/math-scribble.rkt")) (require scribble/html-properties + scribble/latex-properties scribble/base scribble/core) -(define mathjax-source - "MathJax/MathJax.js?config=default" - ;"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" - ; "http://c328740.r40.cf1.rackcdn.com/mathjax/latest/MathJax.js?config=default" - ;"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-HTML" - ) +;; Other possible sources: +;"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" +;"http://c328740.r40.cf1.rackcdn.com/mathjax/latest/MathJax.js?config=default" +;"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-HTML" +(define mathjax-source "MathJax/MathJax.js?config=default") + +(require scriblib/render-cond) (define setup-math (compound-paragraph @@ -29,8 +31,30 @@ (attributes `((type . "text/javascript") (src . ,mathjax-source ))))) '()) - (paragraph - (style - #f (list (alt-tag "script") - (attributes '((type . "text/x-mathjax-config"))))) - "MathJax.Hub.Config({ tex2jax: {inlineMath: [['$','$']]} });")))) + (cond-block + [(and (or html)) + (paragraph + (style + #f (list (alt-tag "script") + (attributes '((type . "text/x-mathjax-config"))))) + "MathJax.Hub.Config({ tex2jax: {inlineMath: [['$','$']]} });")] + [latex + (paragraph + (style + #f (list (tex-addition (string->bytes/utf-8 @string-append{ + %\overfullrule=2cm + \usepackage[scaled=0.7]{beramono} + \usepackage{newunicodechar} + \newunicodechar{ᵢ}{\ensuremath{_1}} + + \usepackage{xcolor} + \hypersetup{ + unicode=true, + colorlinks=true, + linkcolor={red!50!white!50!black}, + citecolor={blue!50!black}, + urlcolor={blue!80!black}, + } + })))) + "")] + [else (paragraph (style #f (list)) "")])))) diff --git a/graph/lib/lib.rkt b/graph/lib/lib.rkt index 7fb53d3a..7142ffca 100644 --- a/graph/lib/lib.rkt +++ b/graph/lib/lib.rkt @@ -11,7 +11,8 @@ ;; Functions (provide (rename-out [∘ compose])) ;; Macros -(provide mapp comment) +;(provide mapp) +(provide comment) (require (for-syntax syntax/parse racket/syntax)) @@ -95,6 +96,7 @@ ; maybe Prefab? Or are they mutable? )) +#| (define-syntax (mapp stx) (syntax-parse stx [(_ var:id lst:expr body ...) @@ -114,6 +116,8 @@ body ...) result)) (set! l (cdr l))))))))])) +|# + ;; TODO: this does not work, because Null is (Listof Any) ; (mapp x (cdr '(1)) (* x x)) diff --git a/graph/lib/low.rkt b/graph/lib/low.rkt index 178c8959..e34a2a6c 100644 --- a/graph/lib/low.rkt +++ b/graph/lib/low.rkt @@ -161,7 +161,11 @@ (check-equal? (fxxor 13206 23715 314576) 304101)) ;; ==== Rest ==== -(provide nameof +(provide hash-set** + map+fold + cons→values + (rename-out [cons→values cons->values]) + nameof first-value second-value third-value fourth-value fifth-value sixth-value seventh-value eighth-value ninth-value tenth-value (rename-out [compose ∘]) stx-list @@ -179,10 +183,32 @@ my-in-syntax indexof Syntax-Listof - check-duplicate-identifiers) + check-duplicate-identifiers + generate-temporary) (require (for-syntax syntax/parse syntax/parse/experimental/template)) +(: hash-set** (∀ (K V) + (→ (HashTable K V) (Listof (Pairof K V)) (HashTable K V)))) +(define (hash-set** h l) + (if (null? l) + h + (hash-set** (hash-set h (caar l) (cdar l)) (cdr l)))) + + +(define #:∀ (A B) (cons→values [x : (Pairof A B)]) (values (car x) (cdr x))) + +(: map+fold (∀ (E R A) (→ (→ E A (values R A)) A (Listof E) + (Values (Listof R) A)))) +(define (map+fold f init-acc lst) + (let ([result (foldl (λ ([item : E] [acc : (Pairof (Listof R) A)]) + (let-values ([(item new-acc) (f item (cdr acc))]) + (cons (cons item (car acc)) + new-acc))) + (cons '() init-acc) + lst)]) + (values (car result) (cdr result)))) + (define-syntax-rule (nameof x) (begin x 'x)) (module+ test @@ -405,6 +431,8 @@ (define (check-duplicate-identifiers ids) (if (check-duplicate-identifier (my-in-syntax ids)) #t #f)) +(require/typed racket/syntax [generate-temporary (→ Syntax Identifier)]) + (require syntax/parse/define) (provide define-simple-macro) @@ -626,4 +654,87 @@ [i : Nonnegative-Integer (ann (in-naturals) (Sequenceof Nonnegative-Integer))]) i)])) +;; ==== set.rkt ==== + +(provide set-map→set) +(: set-map→set (∀ (e b) (→ (Setof e) (→ e b) (Setof b)))) +(define (set-map→set s f) (list->set (set-map s f))) + +;; ==== type-inference-helpers.rkt ==== + +#| +;; This does not work, in the end. +(provide imap) +(define-syntax (imap stx) + (syntax-parse stx + [(_ lst:expr var:id (~optional (~literal →)) . body) + #'(let () + (define #:∀ (T) (inlined-map [l : (Listof T)]) + (if (null? l) + '() + (cons (let ([var (car l)]) . body) + (inlined-map (cdr l))))) + (inlined-map lst))])) +|# + +;; ==== percent.rkt ==== + +(provide % define%) +#|(define-syntax (% stx) + (syntax-parse stx #:literals (= → :) + [(_ (~seq (~or ((~and var (~not :)) ...) + (~seq (~and var (~not (~or = → :))) ...)) = expr) + ... + (~optional (~literal →)) . body) + #'(let-values ([(var ...) expr] ...) . body)]))|# + +(begin-for-syntax + (define-syntax-class %pat + (pattern v:id + #:with expanded #'v) + (pattern () + #:with expanded #'(list)) + (pattern (x:%pat . rest:%pat) + #:with expanded #'(cons x.expanded rest.expanded))) + (define-splicing-syntax-class %assignment + #:attributes ([pat.expanded 1] [expr 0]) + #:literals (= →) + (pattern (~seq (~and maybe-pat (~not (~or = →))) ... (~datum =) expr:expr) + #:with [pat:%pat ...] #'(maybe-pat ...)))) + +(define-syntax (% stx) + (syntax-parse stx #:literals (= →) + [(_ :%assignment ... (~optional (~literal →)) . body) + #'(match-let*-values ([(pat.expanded ...) expr] ...) . body)])) + +(begin-for-syntax + (define-syntax-class typed-pat + (pattern [x:%pat (~literal :) type:expr] + #:with (tmp) (generate-temporaries #'(x)) + #:with var-type #`[tmp : type] + #:with (expanded ...) #'([x.expanded tmp])) + (pattern x:%pat + #:with var-type #'x + #:with (expanded ...) #'()))) + +(define-syntax (define% stx) + (syntax-parse stx + [(_ (name param:typed-pat ...) + (~and (~seq ret ...) (~optional (~seq (~literal :) ret-type))) + . body) + #'(define (name param.var-type ...) + (match-let (param.expanded ... ...) ret ... . body))])) + +#| +(begin-for-syntax + (define-syntax-class λ%expr + (pattern e:id #:where (symbol->string e)) + (pattern e) + (pattern (e . rest:λ%expr)))) + +(define-syntax (λ% stx) + (syntax-parse stx + [(_ expr )])) +|# + ;; ==== end ==== \ No newline at end of file diff --git a/graph/make/make.rkt b/graph/make/make.rkt index c532eb22..d824a19e 100644 --- a/graph/make/make.rkt +++ b/graph/make/make.rkt @@ -23,15 +23,21 @@ (define scrbl-files (exclude-dirs (find-files-by-extension ".scrbl"))) (define lp2-files (exclude-dirs (find-files-by-extension ".lp2.rkt"))) (define rkt-files (exclude-dirs (find-files-by-extension ".rkt"))) -(define html-sources (append scrbl-files lp2-files)) +(define doc-sources (append scrbl-files lp2-files)) (define html-files (map (λ ([scrbl-or-lp2 : Path]) (build-path "docs/" (regexp-case (path->string scrbl-or-lp2) [#rx"\\.scrbl" ".html"] [#rx"\\.lp2\\.rkt" ".lp2.html"]))) - html-sources)) + doc-sources)) +(define pdf-files (map (λ ([scrbl-or-lp2 : Path]) (build-path "docs/" (regexp-case (path->string scrbl-or-lp2) [#rx"\\.scrbl" ".pdf"] [#rx"\\.lp2\\.rkt" ".lp2.pdf"]))) + doc-sources)) (define mathjax-links (map (λ ([d : Path]) (build-path d "MathJax")) (remove-duplicates (map dirname html-files)))) -(: scribble (→ Path (Listof Path) Any)) -(define (scribble file all-files) +(define-type ScribbleRenderers + ; TODO: add --html-tree and '(other . "…") to be future-proof. + (U "--html" "--htmls" "--latex" "--pdf" "--dvipdf" "--latex-section" + "--text" "--markdown")) +(: scribble (→ Path (Listof Path) ScribbleRenderers Any)) +(define (scribble file all-files renderer) (run `(,(or (find-executable-path "scribble") (error "Can't find executable 'scribble'")) - "--html" + ,renderer "--dest" ,(build-path "docs/" (dirname file)) "+m" "--redirect-main" "http://docs.racket-lang.org/" @@ -59,24 +65,30 @@ ; (managed-compile-zo (build-path (current-directory) rkt))) (run! `(,(or (find-executable-path "raco") (error "Can't find executable 'raco'")) - "make" - ,@rkt-files)) + "make" + ,@rkt-files)) (make/proc (rules (list "zo" (append html-files + pdf-files mathjax-links)) - (for/rules ([scrbl-or-lp2 html-sources] + (for/rules ([scrbl-or-lp2 doc-sources] [html html-files]) - (html) - (scrbl-or-lp2) - (scribble scrbl-or-lp2 html-sources)) + (html) + (scrbl-or-lp2) + (scribble scrbl-or-lp2 doc-sources "--html")) + (for/rules ([scrbl-or-lp2 doc-sources] + [pdf pdf-files]) + (pdf) + (scrbl-or-lp2) + (scribble scrbl-or-lp2 doc-sources "--pdf")) (for/rules ([mathjax-link mathjax-links]) - (mathjax-link) - () - (make-file-or-directory-link (simplify-path (apply build-path `(same ,@(map (λ (x) 'up) (explode-path (dirname mathjax-link))) "lib" "doc" "MathJax")) #f) - mathjax-link))) + (mathjax-link) + () + (make-file-or-directory-link (simplify-path (apply build-path `(same ,@(map (λ (x) 'up) (explode-path (dirname mathjax-link))) "lib" "doc" "MathJax")) #f) + mathjax-link))) (argv)) (run! `(,(or (find-executable-path "raco") (error "Can't find executable 'raco'")) - "cover" - ,@(exclude-dirs rkt-files (list "make/")))) + "cover" + ,@(exclude-dirs rkt-files (list "make/"))))