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

Fixed well-formedness checking for contexts

Browse Source
This commit is contained in:
William J. Bowman 2015-03-24 20:36:09 -04:00
parent f5d387b689
commit f7ddeae5bc
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
redex-curnel.rkt
View File

@ -153,11 +153,11 @@
(define-extended-language cic-typingL cicL (define-extended-language cic-typingL cicL
;; NB: There may be a bijection between Γ and Ξ. That's ;; NB: There may be a bijection between Γ and Ξ. That's
;; NB: interesting. ;; NB: interesting.
(Γ ::= ∅ (Γ x : t)) (Γ ::= ∅ (Γ x : t)) ;; Contexts
;; Σ is a signature (list) of inductively defined data with it's ;; Σ signature. (inductive-name : type ((constructor : tye) ...))
;; constructors (Σ ::= ∅ (Σ (x : t ((x : t) ...))))
;; (inductive-name : type ((constr : t) ...)) (Ξ Φ ::= hole (Π (x : t) Ξ)) ;;(Telescope)
(Σ ::= ∅ (Σ (x : t ((x : t) ...))))) (Θ ::= hole (Θ e)) #|(Apply context)|#)
(define Σ? (redex-match? cic-typingL Σ)) (define Σ? (redex-match? cic-typingL Σ))
(define Γ? (redex-match? cic-typingL Γ)) (define Γ? (redex-match? cic-typingL Γ))
@ -255,7 +255,6 @@
;; TODO: Add positivity checking. ;; TODO: Add positivity checking.
(define-metafunction cicL (define-metafunction cicL
positive : t any -> #t or #f positive : t any -> #t or #f
;; (Unv 0); not a inductive constructor
[(positive any_1 any_2) #t]) [(positive any_1 any_2) #t])
(module+ test (module+ test
@ -287,10 +286,11 @@
(wf Σ (Γ x : t))] (wf Σ (Γ x : t))]
[(types Σ ∅ t t_0) [(types Σ ∅ t t_0)
(types Σ (∅ x : t) t_c t_tc) ...
(wf Σ ∅) (wf Σ ∅)
(side-condition (positive t (t_c ...))) (side-condition (positive t (t_c ...)))
----------------- -----------------
(wf (Σ (x : t ((c : t_c) ...))) ∅)]) (wf (Σ (x : t ((x_1 : t_c) ...))) ∅)])
(module+ test (module+ test
(check-true (judgment-holds (wf ,Σ0 ∅))) (check-true (judgment-holds (wf ,Σ0 ∅)))
(check-true (judgment-holds (wf (∅ (truth : (Unv 0) ())) ∅))) (check-true (judgment-holds (wf (∅ (truth : (Unv 0) ())) ∅)))