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

Removed Var "abstractions"

Browse Source 
Olly uses De Bruijn, but was attempting to use abstractions to allow
changing that. Unfortunately, these were not really abstractions. So
they're now gone.
This commit is contained in:
William J. Bowman 2016-01-14 15:16:58 -05:00
parent fd52c764da
commit c7aefdb032
No known key found for this signature in database
GPG Key ID: DDD48D26958F0D1A
4 changed files with 72 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
cur-doc/cur/scribblings/olly.scrbl
View File

@ -14,11 +14,11 @@ the language.
maybe-vars maybe-vars
maybe-output-coq maybe-output-coq
maybe-output-latex maybe-output-latex
(nt-name (nt-metavars) maybe-bnfdef constructors ...) ...) (nt-name (nt-metavar ...) maybe-bnfdef non-terminal-def ...) ...)
#:grammar #:grammar
[(maybe-vars [(maybe-vars
(code:line) (code:line)
(code:line #:vars (nt-metavars ...))) (code:line #:vars (nt-metavar ...)))
(maybe-output-coq (maybe-output-coq
(code:line) (code:line)
(code:line #:output-coq coq-filename)) (code:line #:output-coq coq-filename))
@ -27,26 +27,51 @@ the language.
(code:line #:output-latex latex-filename)) (code:line #:output-latex latex-filename))
(maybe-bnfdef (maybe-bnfdef
(code:line) (code:line)
(code:line ::=))]]{ (code:line ::=))
(non-terminal-def
nt-metavar
(code:line terminal)
(code:line (terminal terminal-args ...)))
(terminal-args
nt-metavar
(code:line literal)
(code:line ())
(code:line (#:bind nt-metavar . terminal-args))
(code:line (terminal-args terminal-args ...)))]]{
Defines a new language by generating inductive definitions for each Defines a new language by generating inductive definitions for each
nonterminal @racket[nt-name], whose constructors are generated by non-terminal @racket[nt-name], whose syntax is generated by
@racket[constructors]. The constructors must either with a tag that can @racket[non-terminal-def].
be used to name the constructor, or be another meta-variable. Each @racket[non-terminal-def] must either be a reference to a
The meta-variables @racket[nt-metavars] are replaced by the corresponding previously defined non-terminal using a @racket[nt-metavar], a
inductive types in @racket[constructors]. @racket[terminal] (an identifier), or a @racket[terminal] applied to
The name of each inductive datatype is generated by some @racket[terminal-args].
@racket[(format-id "~a-~a" name nt-name)]. The @racket[terminal-args] are a limited grammar of s-expressions,
which can reference previously defined @racket[nt-metavar]s to be
treated as arguments, literal symbols to be treated as syntax, binding
declarations, or a nested @racket[terminal-arg].
Later nonterminals can refer to prior nonterminals, but they cannot be The inductive definitions are generated by generating a type for each
mutually inductive due to limitations in Cur. When nonterminals appear @racket[nt-name] whose name @racket[nt-type] is generated by
in @racket[constructors], a constructor is defined that coerces one @racket[(format-id name "~a-~a" name nt-name)] and whose constructors
nonterminal to another. are generated by each @racket[non-terminal-def].
For @racket[terminal]s, the constructor is a base constructor whose
name is generated by @racket[(format-id name "~a-~a" name terminal)].
For @racket[nt-metavar]s, the constructor is a conversion constructor
whose name is generated by @racket[(format-id name "~a->~a" nt-type
nt-metavar-type)] where @racket[nt-metavar-type] is the name of the
type generated for the nonterminal to which @racket[nt-metavars] refers.
For @racket[(terminal terminal-args ...)], the constructor is a
function that expects term of of the types generated by
@racket[terminal-args ...].
If @racket[#:vars] is given, it should be a list of meta-variables that If @racket[#:vars] is given, it should be a list of meta-variables that
representing variables in the language. These meta-variables should only representing variables in the language.
appear in binding positions in @racket[constructors]. These variables These variables are represented as De Bruijn indices, and uses of
are represented as De Bruijn indexes, and Olly provides some functions variables in the syntax are treated as type @racket[Nat].
for working with De Bruijn indexes. Binding positions in the syntax, represented by @racket[#:bind
nt-metavar], are erased in converting to De Bruijn indices, although
this may change if the representation of variables used by
@racket[define-language] changes.
If @racket[#:output-coq] is given, it should be a string representing a If @racket[#:output-coq] is given, it should be a string representing a
filename. The form @racket[define-language] will output Coq versions of filename. The form @racket[define-language] will output Coq versions of
@ -66,8 +91,8 @@ Example:
#:output-latex "stlc.tex" #:output-latex "stlc.tex"
(val (v) ::= true false unit) (val (v) ::= true false unit)
(type (A B) ::= boolty unitty (-> A B) (* A A)) (type (A B) ::= boolty unitty (-> A B) (* A A))
(term (e) ::= x v (app e e) (lambda (x : A) e) (cons e e) (term (e) ::= x v (app e e) (lambda (#:bind x : A) e) (cons e e)
(let (x x) = e in e))) (let (#:bind x #:bind x) = e in e)))
] ]
This example is equivalent to This example is equivalent to
@ -85,20 +110,17 @@ This example is equivalent to
(stlc-* : (forall (x : stlc-type) (forall (y : stlc-type) stlc-type)))) (stlc-* : (forall (x : stlc-type) (forall (y : stlc-type) stlc-type))))
(data stlc-term : Type (data stlc-term : Type
(stlc-var-->-stlc-term : (forall (x : Var) stlc-term)) (Var->-stlc-term : (forall (x : Nat) stlc-term))
(stlc-val-->-stlc-term : (forall (x : stlc-val) stlc-term)) (stlc-val->-stlc-term : (forall (x : stlc-val) stlc-term))
(stlc-term-lambda : (forall (x : Var) (stlc-term-lambda : (forall (y : stlc-type)
(forall (y : stlc-type)
(forall (z : stlc-term) (forall (z : stlc-term)
stlc-term)))) stlc-term)))
(stlc-term-cons : (forall (x : stlc-term) (forall (y : stlc-term) stlc-term))) (stlc-term-cons : (forall (x : stlc-term) (forall (y : stlc-term) stlc-term)))
(stlc-term-let : (forall (x : Var) (stlc-term-let : (forall (e1 : stlc-term)
(forall (y : Var) (forall (e2 : stlc-term)
(forall (e1 : stlc-term) stlc-term))))]
(forall (e2 : stlc-term)
stlc-term))))))]
@margin-note{This example is taken from @racketmodname[cur/examples/stlc]} @margin-note{This example is taken from @racketmodname[cur/tests/stlc]}
} }
@defform[(define-relation (name args ...) @defform[(define-relation (name args ...)
@ -126,20 +148,20 @@ explain the syntax in detail, here is an example:
#:output-latex "stlc.tex" #:output-latex "stlc.tex"
[(g : Gamma) [(g : Gamma)
------------------------ T-Unit ------------------------ T-Unit
(has-type g (stlc-val-->-stlc-term stlc-unit) stlc-unitty)] (has-type g (stlc-val->stlc-term stlc-unit) stlc-unitty)]
[(g : Gamma) [(g : Gamma)
------------------------ T-True ------------------------ T-True
(has-type g (stlc-val-->-stlc-term stlc-true) stlc-boolty)] (has-type g (stlc-val->stlc-term stlc-true) stlc-boolty)]
[(g : Gamma) [(g : Gamma)
------------------------ 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 : stlc-type) [(g : Gamma) (x : Nat) (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)]
[(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)
@ -151,16 +173,15 @@ explain the syntax in detail, here is an example:
[(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) (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) y t2) e2 t) (has-type (extend-gamma (extend-gamma g t1) t2) e2 t)
---------------------- T-Let ---------------------- T-Let
(has-type g (stlc-let x y e1 e2) t)] (has-type g (stlc-let 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)
(has-type (extend-gamma g x t1) e1 t2) (has-type (extend-gamma g t1) e1 t2)
---------------------- T-Fun ---------------------- T-Fun
(has-type g (stlc-lambda x t1 e1) (stlc--> t1 t2))] (has-type g (stlc-lambda t1 e1) (stlc--> t1 t2))]
[(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)
@ -179,22 +200,11 @@ This example is equivalent to:
(T-Unit : (forall (g : Gamma) (T-Unit : (forall (g : Gamma)
(has-type (has-type
g g
(stlc-val-->-stlc-term stlc-unit) (stlc-val->stlc-term stlc-unit)
stlc-unitty))) stlc-unitty)))
....)] ....)]
} }
@deftogether[(@defthing[Var Type]
@defthing[avar (forall (x : Nat) Var)])]{
The type of a De Bruijn variable.
}
@defproc[(var-equal? [v1 Var] [v2 Var])
Bool]{
A Cur procedure; returns @racket[true] if @racket[v1] and @racket[v2]
represent the same variable.
}
@todo{Need a Scribble library for defining Cur/Racket things in the same @todo{Need a Scribble library for defining Cur/Racket things in the same
library in a nice way.} library in a nice way.}

14
cur-lib/cur/olly.rkt
View File

@ -10,9 +10,6 @@
(provide (provide
define-relation define-relation
define-language define-language
Var
avar
var-equal?
generate-coq generate-coq
;; private; exported for testing only ;; private; exported for testing only
@ -252,7 +249,7 @@
[(attribute x) => [(attribute x) =>
(lambda (xls) (lambda (xls)
(for ([x xls]) (for ([x xls])
(dict-set! (mv-map) (syntax-e x) #'Var)))]) (dict-set! (mv-map) (syntax-e x) #'Nat)))])
(syntax-parse #'non-terminal-defs (syntax-parse #'non-terminal-defs
[((~var defs non-terminal-def) ...) [((~var defs non-terminal-def) ...)
(let ([output #`(begin defs.def ...)]) (let ([output #`(begin defs.def ...)])
@ -266,15 +263,6 @@
#'()) #'())
#,output))]))) #,output))])))
(data Var : Type (avar : (-> Nat Var)))
(define (var-equal? (v1 : Var) (v2 : Var))
(match v1
[(avar (n1 : Nat))
(match v2
[(avar (n2 : Nat))
(nat-equal? n1 n2)])]))
;; See stlc.rkt for examples ;; See stlc.rkt for examples
;; Generate Coq from Cur: ;; Generate Coq from Cur:

7
cur-test/cur/tests/olly.rkt
View File

@ -21,13 +21,6 @@
(format "\\mbox{\\textit{type}} & A,B,C & \\bnfdef & unit \\bnfalt (* A B) \\bnfalt (+ A C)\\\\~n")) (format "\\mbox{\\textit{type}} & A,B,C & \\bnfdef & unit \\bnfalt (* A B) \\bnfalt (+ A C)\\\\~n"))
(output-latex-bnf #'((type (A B C) ::= unit (* A B) (+ A C)))))) (output-latex-bnf #'((type (A B C) ::= unit (* A B) (+ A C))))))
(check-equal?
(var-equal? (avar z) (avar z))
true)
(check-equal?
(var-equal? (avar z) (avar (s z)))
false)
(begin-for-syntax (begin-for-syntax
(check-equal? (check-equal?
(parameterize ([coq-defns ""]) (output-coq #'(data nat : Type (z : nat))) (coq-defns)) (parameterize ([coq-defns ""]) (output-coq #'(data nat : Type (z : nat))) (coq-defns))

17
cur-test/cur/tests/stlc.rkt
View File

@ -19,10 +19,7 @@
(term (e) ::= x v (app e e) (lambda (#:bind x : A) e) (cons e e) (term (e) ::= x v (app e e) (lambda (#:bind x : A) e) (cons e e)
(let (#:bind x #:bind x) = e in e))) (let (#:bind x #:bind x) = e in e)))
(define (lookup-env (g : (List stlc-type))) (define lookup-env (list-ref stlc-type))
;; TODO: Can't use match due to limitation in type inference
(elim Var Type (lambda (x : Var) (Maybe stlc-type))
(list-ref stlc-type g)))
(define (extend-env (g : (List stlc-type)) (t : stlc-type)) (define (extend-env (g : (List stlc-type)) (t : stlc-type))
(cons stlc-type t g)) (cons stlc-type t g))
@ -42,10 +39,10 @@
------------------------ 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 : (List stlc-type)) (x : Var) (t : stlc-type) [(g : (List stlc-type)) (x : Nat) (t : stlc-type)
(== (Maybe stlc-type) (lookup-env g x) (some stlc-type t)) (== (Maybe stlc-type) (lookup-env g x) (some stlc-type t))
------------------------ T-Var ------------------------ T-Var
(has-type g (Var->stlc-term x) t)] (has-type g (Nat->stlc-term x) t)]
[(g : (List stlc-type)) (e1 : stlc-term) (e2 : stlc-term) [(g : (List stlc-type)) (e1 : stlc-term) (e2 : stlc-term)
(t1 : stlc-type) (t2 : stlc-type) (t1 : stlc-type) (t2 : stlc-type)
@ -113,19 +110,19 @@
#'stlc-unitty] #'stlc-unitty]
[(dict-ref d (syntax->datum #'e) #f) => [(dict-ref d (syntax->datum #'e) #f) =>
(lambda (x) (lambda (x)
#`(Var->stlc-term (avar #,x)))] #`(Nat->stlc-term #,x))]
[else #'e])]))) [else #'e])])))
(check-equal? (check-equal?
(begin-stlc (lambda (x : 1) x)) (begin-stlc (lambda (x : 1) x))
(stlc-lambda stlc-unitty (Var->stlc-term (avar z)))) (stlc-lambda stlc-unitty (Nat->stlc-term z)))
(check-equal? (check-equal?
(begin-stlc ((lambda (x : 1) x) ())) (begin-stlc ((lambda (x : 1) x) ()))
(stlc-app (stlc-lambda stlc-unitty (Var->stlc-term (avar z))) (stlc-app (stlc-lambda stlc-unitty (Nat->stlc-term z))
(stlc-val->stlc-term stlc-unit))) (stlc-val->stlc-term stlc-unit)))
(check-equal? (check-equal?
(begin-stlc (lambda (x : 1) (lambda (y : 1) x))) (begin-stlc (lambda (x : 1) (lambda (y : 1) x)))
(stlc-lambda stlc-unitty (stlc-lambda stlc-unitty (Var->stlc-term (avar (s z)))))) (stlc-lambda stlc-unitty (stlc-lambda stlc-unitty (Nat->stlc-term (s z)))))
(check-equal? (check-equal?
(begin-stlc '(() ())) (begin-stlc '(() ()))
(stlc-cons (stlc-val->stlc-term stlc-unit) (stlc-cons (stlc-val->stlc-term stlc-unit)