suzanne.soy/cur
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Redex 1.6 enables caching of judgment forms!

Browse Source 
* Judgment form caching enables running test suite in seconds instead of
  days.
* Fixed numerous bugs after properly exercising the oll/stlc examples.
This commit is contained in:
William J. Bowman 2015-02-20 18:22:04 -05:00
parent b3388c5413
commit 6b0d09c7d9
4 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@ -16,7 +16,8 @@ cur (plural curs)
Getting started Getting started
=============== ===============
Don't actually try to run anything. The type-checker may be exponential, Requires redex-lib version 1.6 if you want answer in a reasonable amount
of time. Otherwise, the type-checker may require exponential time
or worse. or worse.
Open up `stlc.rkt` to see an example of what advanced meta-programming can let you do. Open up `stlc.rkt` to see an example of what advanced meta-programming can let you do.

7
oll.rkt
View File

@ -54,10 +54,11 @@
(with-output-to-file (syntax->datum #'latex-file) (with-output-to-file (syntax->datum #'latex-file)
(thunk (thunk
(format "\\fbox{$~a$}$~n$\\begin{mathpar}~n~a~n\end{mathpar}$$" (format "\\fbox{$~a$}$~n$\\begin{mathpar}~n~a~n\end{mathpar}$$"
(syntax->datum #'(n types* ...))
(string-trim (string-trim
(for/fold ([str ""]) (for/fold ([str ""])
([rule (syntax->datum #'(rules.latex ...))]) ([rule (attribute rules.latex)])
(format "~a~a\\and~n" rule)) (format "~a~a\\and~n" str rule))
"\\and" "\\and"
#:left? #f))) #:left? #f)))
#:exists 'append)) #:exists 'append))
@ -311,7 +312,7 @@
(begin (begin
(coq-lift-top-level (coq-lift-top-level
(format "Inductive ~a : ~a :=~a." (format "Inductive ~a : ~a :=~a."
(syntax-e #'n) (sanitize-id (format "~a" (syntax-e #'n)))
(output-coq #'t) (output-coq #'t)
(for/fold ([strs ""]) (for/fold ([strs ""])
([clause (syntax->list #'((x* : t*) ...))]) ([clause (syntax->list #'((x* : t*) ...))])

2
redex-curnel.rkt
View File

@ -47,7 +47,7 @@
(check-true (t? (term (λ (x_0 : (Unv 0)) x_0))))) (check-true (t? (term (λ (x_0 : (Unv 0)) x_0)))))
;; 'A' ;; 'A'
;; Universes ;; (Unv 0)s of Universes
;; Replace with sub-typing ;; Replace with sub-typing
(define-judgment-form cicL (define-judgment-form cicL
#:mode (unv-ok I O) #:mode (unv-ok I O)

13
stlc.rkt
View File

@ -15,17 +15,16 @@
;; TODO: Abstract this over stlc-type, and provide from in OLL ;; TODO: Abstract this over stlc-type, and provide from in OLL
(data gamma : Type (data gamma : Type
(emp-gamma : gamma) (emp-gamma : gamma)
(ext-gamma : (->* gamma var stlc-type gamma))) (extend-gamma : (->* gamma var stlc-type gamma)))
(define-rec (lookup-gamma (g : gamma) (x : var) : (maybe stlc-type)) (define-rec (lookup-gamma (g : gamma) (x : var) : (maybe stlc-type))
(case* g (case* g
[emp-gamma (none stlc-type)] [emp-gamma (none stlc-type)]
[(ext-gamma (g1 : gamma) (v1 : var) (t1 : stlc-type)) [(extend-gamma (g1 : gamma) (v1 : var) (t1 : stlc-type))
(if (var-equal? v1 x) (if (var-equal? v1 x)
(some stlc-type t1) (some stlc-type t1)
(lookup-gamma g1 x))])) (lookup-gamma g1 x))]))
(define-relation (has-type gamma stlc-term stlc-type) (define-relation (has-type gamma stlc-term stlc-type)
#:output-coq "stlc.v" #:output-coq "stlc.v"
#:output-latex "stlc.tex" #:output-latex "stlc.tex"
@ -41,7 +40,7 @@
------------------------ T-False ------------------------ T-False
(has-type g (stlc-val-->-stlc-term stlc-false) stlc-boolty)] (has-type g (stlc-val-->-stlc-term stlc-false) stlc-boolty)]
[(g : gamma) (x : var) (t : style-type) [(g : gamma) (x : var) (t : stlc-type)
(== (maybe stlc-type) (lookup-gamma g x) (some stlc-type t)) (== (maybe stlc-type) (lookup-gamma g x) (some stlc-type t))
------------------------ T-Var ------------------------ T-Var
(has-type g (var-->-stlc-term x) t)] (has-type g (var-->-stlc-term x) t)]
@ -55,9 +54,11 @@
[(g : gamma) (e1 : stlc-term) (e2 : stlc-term) [(g : gamma) (e1 : stlc-term) (e2 : stlc-term)
(t1 : stlc-type) (t2 : stlc-type) (t1 : stlc-type) (t2 : stlc-type)
(t : stlc-type)
(x : var) (y : var)
(has-type g e1 (stlc-* t1 t2)) (has-type g e1 (stlc-* t1 t2))
(has-type (extend-gamma (extend-gamma g x t1) t y2) e2 t) (has-type (extend-gamma (extend-gamma g x t1) y t2) e2 t)
---------------------- T-Pair ---------------------- T-Let
(has-type g (stlc-let x y e1 e2) t)] (has-type g (stlc-let x y e1 e2) t)]
[(g : gamma) (e1 : stlc-term) (t1 : stlc-type) (t2 : stlc-type) (x : var) [(g : gamma) (e1 : stlc-term) (t1 : stlc-type) (t2 : stlc-type) (x : var)