Skip to content

Instantly share code, notes, and snippets.

@takikawa

takikawa/Both mand & opt

Last active June 17, 2016 19:34
Show Gist options
  • Save takikawa/2c910405033a60c1ac5c5f1e15528186 to your computer and use it in GitHub Desktop.
Save takikawa/2c910405033a60c1ac5c5f1e15528186 to your computer and use it in GitHub Desktop.
Download ZIP
Racket expansion of contract
Raw
Both mand & opt
(module anonymous-module racket
(#%module-begin
(module configure-runtime '#%kernel
(#%module-begin (#%require racket/runtime-config) (#%app configure '#f)))
(#%provide (rename provide/contract-id-f f))
(define-syntaxes (f)
(#%app
make-keyword-syntax
(lambda () (#%app values (quote-syntax f5) (quote-syntax f7)))
'1
'0
'#f
'()
'(#:opt)))
(define-values (f5)
(lambda (opt2 opt3 x4)
(let-values (((x) x4))
(let-values (((y) (if opt3 opt2 (quote 3)))) (let-values () x)))))
(define-values:18 (unpack6:19)
(lambda (given-kws given-args x4)
(let-values:20 (((opt3) (#%app:21 pair?:21 given-kws)))
(let-values:22 (((opt2) (if:21 opt3 (#%app:21 car:21 given-args) (#%app:21 void:21))))
(#%app f5 opt2 opt3 x4)))))
(define-values:23 (f7)
(#%app
make-optional-keyword-procedure
(lambda (given-kws given-argc)
(if:24 (#%app:25 =:25 given-argc '3)
(let-values:26 (((l1:27) given-kws))
(let-values:28 (((l1:27)
(if:27 (#%app:27 null?:27 l1:27)
l1:27
(if:27 (#%app:27 eq?:27 (#%app:27 car:27 l1:27) '#:opt)
(#%app:27 cdr:27 l1:27)
l1:27))))
(#%app:29 null?:29 l1:27)))
'#f))
(case-lambda:30 [(given-kws given-args x) (#%app:30 unpack6:19 given-kws given-args x)])
null
'(#:opt)
(let-values:31 (((f) (case-lambda:32 [(x) (#%app:32 unpack6:19 null null x)]))) f)))
(define-values:33 (pos-module-source:34)
(#%app:35
module-name-fixup:36
(#%app:37 variable-reference->module-source/submod:38 (#%variable-reference:38))
(#%app:39 list:36)))
(define-values (lifted.0:40)
(#%app:41
make-required:41
'...row-higher-order.rkt:352:44:41
(case-lambda:42 [(self:41) (#%app:42 apply:42 missing-kw:41 self:41 null:41)])
'#f
'#f))
(define-values:43 (idZ12:44)
(let-values:45 (((f)
(#%app:46
coerce-contract:34
'provide/contract:34
(let-values:47 (((mand14:48) integer?) ((opt15:49) integer?))
(#%app:50
build-->:51
'->*:51
(#%app:52 list:51)
(#%app:53 list:51)
'(#:mand)
(#%app:54 list:51 mand14:48)
'(#:opt)
(#%app:55 list:51 opt15:49)
'#f
'#f
(#%app:56 list:51 integer?)
'#f
(lambda:57 (blame:51 f:51 mand18:58 opt19:59 integer?20:60)
(#%app:61
values:51
(#%app:62
procedure-specialize:51
(#%app:63
make-checking-proc:51
f:51
blame:51
'#f
'(#:mand)
(#%app:64 list:51 mand18:58)
'(#:opt)
(#%app:65 list:51 opt19:59)
'0
(#%app:66 list:51)
'#f
'#f
(#%app:67 list:51 integer?20:60)
'#f))
(#%app:68
procedure-specialize:51
(#%app:69
make-checking-proc:51
f:51
blame:51
'#f
'(#:mand)
(#%app:70 list:51 mand18:58)
'(#:opt)
(#%app:71 list:51 opt19:59)
'0
(#%app:72 list:51)
'#f
'#f
(#%app:73 list:51 integer?20:60)
'#f))
'1))
(lambda:74 (blame:51
f:51
neg-party:51
blame-party-info:51
rng-ctcs:51
mandatory-dom-proj26:75
optional-dom-proj27:76
integer?28:77)
(let-values (((blame+neg-party:51)
(#%app:78 cons:51 blame:51 neg-party:51)))
(#%app:79
arity-checking-wrapper:51
f:51
blame:51
neg-party:51
blame+neg-party:51
void:51
'#t
'#f
'#f
'#f
(let-values:80 (((core38:81)
(lambda:41 (mand34:82 opt35:83 opt37:84)
(let-values:85 (((mand30:86) mand34:82))
(let-values:87 (((opt31:88)
(if:89 opt37:84
opt35:83
arrow:unspecified-dom:51)))
(let-values:90 ()
(with-continuation-mark:91
contract-continuation-mark-key:91
blame+neg-party:51
(let-values:92 ()
(let-values:93 ()
(let-values:95 (((kwd-results:51)
(#%app:96
cons:51
(#%app:97
mandatory-dom-proj26:75
mand30:86
neg-party:51)
(#%app:98
maybe-cons-kwd:51
optional-dom-proj27:76
opt31:88
null:51
neg-party:51))))
(#%app:99
call-with-immediate-continuation-mark:51
tail-contract-key:51
(lambda:100 (m:51)
(if:51 (#%app:101
tail-marks-match?:51
m:51
rng-ctcs:51
blame-party-info:51
neg-party:51
(#%app:102
cons:51
blame:51
neg-party:51))
(#%app:103
values:51
kwd-results:51)
(#%app:104
values:51
(case-lambda:51
[(integer?2832:105)
(with-continuation-mark:106
contract-continuation-mark-key:106
blame+neg-party:51
(let-values:107 ()
(let-values:108 ()
(#%app:110
values:51
(#%app:111
integer?28:77
integer?2832:105
neg-party:51)))))]
[args:51
(let-values:112 (((...row-higher-order.rkt:152:22:113)
bad-number-of-results19:114)
((blame40:115)
blame:51)
((f41:116)
f:51)
((temp42:117)
'1)
((args43:118)
args:51)
((neg-party44:119)
neg-party:51))
(if:113 (#%app:113
variable-reference-constant?:113
(#%variable-reference:113
bad-number-of-results19:120))
(#%app:113
bad-number-of-results17:121
neg-party44:119
'#t
blame40:115
f41:116
temp42:117
args43:118
'#f
'#f)
(#%app:113
(#%app:113
checked-procedure-check-and-extract:113
struct:keyword-procedure:113
...row-higher-order.rkt:152:22:113
keyword-procedure-extract:113
'(#:missing-party)
'6)
'(#:missing-party)
(#%app:113
list:113
neg-party44:119)
blame40:115
f41:116
temp42:117
args43:118)))])
kwd-results:51))))))))))))))
(let-values:122 (((unpack39:123)
(lambda:41 (given-kws:41 given-args:41)
(let-values:124 (((mand34:82)
(#%app:125
car:125
given-args:41))
((given-kws:41)
(#%app:125
cdr:125
given-kws:41))
((given-args:41)
(#%app:125
cdr:125
given-args:41)))
(let-values:126 (((opt37:84)
(#%app:127
pair?:127
given-kws:41)))
(let-values:128 (((opt35:83)
(if:127 opt37:84
(#%app:127
car:127
given-args:41)
(#%app:127
void:127))))
(#%app:41
core38:81
mand34:82
opt35:83
opt37:84)))))))
(#%app:41
lifted.0:40
(lambda:41 (given-kws:41 given-argc:41)
(if:129 (#%app:130 =:130 given-argc:41 '2)
(#%app:131
subsets?:131
'(#:mand)
given-kws:41
'(#:mand #:opt))
'#f))
(case-lambda:132
[(given-kws:41 given-args:41)
(#%app:132 unpack39:123 given-kws:41 given-args:41)])
'(#:mand)
'(#:mand #:opt))))
'0
'0
'(#:mand)
'(#:opt)
'#f)))
'#f)))))
f))
(define-syntaxes:133 (provide/contract-id-f:34)
(#%app:134
make-provide/contract-arrow-transformer:34
(quote-syntax:34 provide/contract-id-f:34)
(quote-syntax:34 idZ12:44)
(quote-syntax:34 f)
(quote-syntax:34 idX10:135)
(quote-syntax:34 idY11:136)
'#s(valid-app-shapes (0) (#:mand) (#:opt))))
(define-syntaxes:137 (contracted-vars-info1:138)
(quote-syntax:34 ((rename-out:34 [provide/contract-id-f:34 f]))))
(define-values:34 (idX10:135 idB13:139)
(#%app:140
do-partial-app:34
idZ12:44
f7:141
'f
pos-module-source:34
(#%app:142
kernel:srcloc:144
(#%app:145 source-location-source:143 (quote-syntax:143 here:143))
(quote:143 3)
(quote:143 24)
(quote:143 39)
(quote:143 1))))
(define-values:146 (idY11:136)
(#%app:147 wrapped-extra-arg-arrow-extra-neg-party-argument:34 idX10:135))))
Raw
Just mand arg
(module anonymous-module racket
(#%module-begin
(module configure-runtime '#%kernel
(#%module-begin (#%require racket/runtime-config) (#%app configure '#f)))
(#%provide (rename provide/contract-id-f f))
(define-syntaxes (f)
(#%app
make-keyword-syntax
(lambda () (#%app values (quote-syntax f5) (quote-syntax f7)))
'1
'0
'#f
'()
'(#:opt)))
(define-values (f5)
(lambda (opt2 opt3 x4)
(let-values (((x) x4))
(let-values (((y) (if opt3 opt2 (quote 3)))) (let-values () x)))))
(define-values:18 (unpack6:19)
(lambda (given-kws given-args x4)
(let-values:20 (((opt3) (#%app:21 pair?:21 given-kws)))
(let-values:22 (((opt2) (if:21 opt3 (#%app:21 car:21 given-args) (#%app:21 void:21))))
(#%app f5 opt2 opt3 x4)))))
(define-values:23 (f7)
(#%app
make-optional-keyword-procedure
(lambda (given-kws given-argc)
(if:24 (#%app:25 =:25 given-argc '3)
(let-values:26 (((l1:27) given-kws))
(let-values:28 (((l1:27)
(if:27 (#%app:27 null?:27 l1:27)
l1:27
(if:27 (#%app:27 eq?:27 (#%app:27 car:27 l1:27) '#:opt)
(#%app:27 cdr:27 l1:27)
l1:27))))
(#%app:29 null?:29 l1:27)))
'#f))
(case-lambda:30 [(given-kws given-args x) (#%app:30 unpack6:19 given-kws given-args x)])
null
'(#:opt)
(let-values:31 (((f) (case-lambda:32 [(x) (#%app:32 unpack6:19 null null x)]))) f)))
(define-values:33 (pos-module-source:34)
(#%app:35
module-name-fixup:36
(#%app:37 variable-reference->module-source/submod:38 (#%variable-reference:38))
(#%app:39 list:36)))
(define-values (lifted.0:40)
(#%app:41
make-required:41
'.../arrow-val-first.rkt:357:18:41
(case-lambda:42
[(self:41 neg-party:43) (#%app:42 apply:42 missing-kw:41 self:41 neg-party:43 null:41)])
'#f
'#f))
(define-values (lifted.1:44)
(#%app:45
make-required:45
'.../arrow-val-first.rkt:357:18:45
(case-lambda:46
[(self:45 neg-party:43) (#%app:46 apply:46 missing-kw:45 self:45 neg-party:43 null:45)])
'#f
'#f))
(define-values (lifted.2:47)
(#%app:48
make-required:48
'...row-higher-order.rkt:352:44:48
(case-lambda:49 [(self:48) (#%app:49 apply:49 missing-kw:48 self:48 null:48)])
'#f
'#f))
(define-values:50 (idZ12:51)
(let-values:52 (((f)
(#%app:53
coerce-contract:34
'provide/contract:34
(let-values:54 (((mand14:55) integer?))
(#%app:56
build-simple-->:43
(#%app:57 list:43)
'(#:mand)
(#%app:58 list:43 mand14:55)
(#%app:59 list:43 integer?)
(lambda:60 (blame:43 f:43 mand15:61 integer?16:62)
(#%app:63
values:43
(#%app:64
procedure-specialize:43
(let-values:65 (((core31:66)
(lambda:41 (mand28:67 neg-party30:68)
(let-values:69 (((neg-party:43)
neg-party30:68))
(let-values:70 (((mand18:71) mand28:67))
(let-values:72 ()
(let-values:73 (((blame+neg-party:43)
(#%app:74
cons:43
blame:43
neg-party:43)))
(let-values:76 ()
(let-values (((args:43
integer?17:78)
(#%app:79
call-with-values:77
(lambda:80 ()
(let-values:43 ([(mand1819:81)
(begin:82
(with-continuation-mark:82
contract-continuation-mark-key:82
blame+neg-party:43
(let-values:83 ()
(#%app:84
values:43
(#%app:85
mand15:61
mand18:71
neg-party:43)))))])
(let-values:86 (((.../arrow-val-first.rkt:274:21:87)
f:43)
((mand181933:88)
mand1819:81))
(#%app:87
(#%app:87
checked-procedure-check-and-extract:87
struct:keyword-procedure:87
.../arrow-val-first.rkt:274:21:87
keyword-procedure-extract:87
'(#:mand)
'2)
'(#:mand)
(#%app:87
list:87
mand181933:88)))))
(case-lambda:77
[(integer?17:78)
(#%app:89
values:77
'#f
integer?17:78)]
[args:43
(#%app:90
values:77
args:43
'#f)]))))
(if:91 args:43
(let-values:91 ()
(with-continuation-mark:92
contract-continuation-mark-key:92
blame+neg-party:43
(let-values:93 ()
(#%app:94
wrong-number-of-results-blame:43
blame:43
neg-party:43
f:43
args:43
'1))))
(let-values:91 ()
(with-continuation-mark:95
contract-continuation-mark-key:95
blame+neg-party:43
(let-values:96 ()
(#%app:97
values:43
(#%app:98
integer?16:62
integer?17:78
neg-party:43)))))))))))))))
(let-values:99 (((unpack32:100)
(lambda:41 (given-kws:41
given-args:41
neg-party30:68)
(let-values:101 (((mand28:67)
(#%app:102
car:102
given-args:41)))
(#%app:41
core31:66
mand28:67
neg-party30:68)))))
(#%app:41
lifted.0:40
(lambda:41 (given-kws:41 given-argc:41)
(if:103 (#%app:104 =:104 given-argc:41 '3)
(let-values:105 (((l2:106) given-kws:41))
(if:107 (#%app:106 pair?:106 l2:106)
(if:108 (#%app:106
eq?:106
(#%app:106 car:106 l2:106)
'#:mand)
(#%app:109 null?:109 (#%app:106 cdr:106 l2:106))
'#f)
'#f))
'#f))
(case-lambda:110
[(given-kws:41 given-args:41 neg-party:43)
(#%app:110
unpack32:100
given-kws:41
given-args:41
neg-party:43)])
'(#:mand)
'(#:mand)))))
(#%app:111
procedure-specialize:43
(let-values:112 (((core37:113)
(lambda:45 (mand34:114 neg-party36:115)
(let-values:116 (((neg-party:43)
neg-party36:115))
(let-values:117 (((mand18:71) mand34:114))
(let-values:118 ()
(let-values:119 (((blame+neg-party:43)
(#%app:120
cons:43
blame:43
neg-party:43)))
(let-values (((integer?17:78)
(let-values:43 ([(mand1819:81)
(begin:121
(with-continuation-mark:121
contract-continuation-mark-key:121
blame+neg-party:43
(let-values:122 ()
(#%app:123
values:43
(#%app:124
mand15:61
mand18:71
neg-party:43)))))])
(let-values:125 (((.../arrow-val-first.rkt:274:21:126)
f:43)
((mand181939:127)
mand1819:81))
(#%app:126
(#%app:126
checked-procedure-check-and-extract:126
struct:keyword-procedure:126
.../arrow-val-first.rkt:274:21:126
keyword-procedure-extract:126
'(#:mand)
'2)
'(#:mand)
(#%app:126
list:126
mand181939:127))))))
(with-continuation-mark:128
contract-continuation-mark-key:128
blame+neg-party:43
(let-values:129 ()
(#%app:130
values:43
(#%app:131
integer?16:62
integer?17:78
neg-party:43))))))))))))
(let-values:132 (((unpack38:133)
(lambda:45 (given-kws:45
given-args:45
neg-party36:115)
(let-values:134 (((mand34:114)
(#%app:135
car:135
given-args:45)))
(#%app:45
core37:113
mand34:114
neg-party36:115)))))
(#%app:45
lifted.1:44
(lambda:45 (given-kws:45 given-argc:45)
(if:136 (#%app:137 =:137 given-argc:45 '3)
(let-values:138 (((l2:139) given-kws:45))
(if:140 (#%app:139 pair?:139 l2:139)
(if:141 (#%app:139
eq?:139
(#%app:139 car:139 l2:139)
'#:mand)
(#%app:142 null?:142 (#%app:139 cdr:139 l2:139))
'#f)
'#f))
'#f))
(case-lambda:143
[(given-kws:45 given-args:45 neg-party:43)
(#%app:143
unpack38:133
given-kws:45
given-args:45
neg-party:43)])
'(#:mand)
'(#:mand)))))
'1))
(lambda:144 (blame:43
f:43
neg-party:43
blame-party-info:43
rng-ctcs:43
mandatory-dom-proj22:145
integer?23:146)
(let-values (((blame+neg-party:43)
(#%app:147 cons:43 blame:43 neg-party:43)))
(#%app:148
arity-checking-wrapper:43
f:43
blame:43
neg-party:43
blame+neg-party:43
void:43
'#t
'#f
'#f
'#f
(let-values:149 (((core42:150)
(lambda:48 (mand40:151)
(let-values:152 (((mand25:153) mand40:151))
(let-values:154 ()
(with-continuation-mark:155
contract-continuation-mark-key:155
blame+neg-party:43
(let-values:156 ()
(let-values:157 ()
(let-values:159 (((kwd-results:43)
(#%app:160
cons:43
(#%app:161
mandatory-dom-proj22:145
mand25:153
neg-party:43)
null:43)))
(#%app:162
call-with-immediate-continuation-mark:43
tail-contract-key:43
(lambda:163 (m:43)
(if:43 (#%app:164
tail-marks-match?:43
m:43
rng-ctcs:43
blame-party-info:43
neg-party:43
(#%app:165
cons:43
blame:43
neg-party:43))
(#%app:166
values:43
kwd-results:43)
(#%app:167
values:43
(case-lambda:43
[(integer?2326:168)
(with-continuation-mark:169
contract-continuation-mark-key:169
blame+neg-party:43
(let-values:170 ()
(let-values:171 ()
(#%app:173
values:43
(#%app:174
integer?23:146
integer?2326:168
neg-party:43)))))]
[args:43
(let-values:175 (((...row-higher-order.rkt:152:22:176)
bad-number-of-results19:177)
((blame44:178)
blame:43)
((f45:179)
f:43)
((temp46:180)
'1)
((args47:181)
args:43)
((neg-party48:182)
neg-party:43))
(if:176 (#%app:176
variable-reference-constant?:176
(#%variable-reference:176
bad-number-of-results19:183))
(#%app:176
bad-number-of-results17:184
neg-party48:182
'#t
blame44:178
f45:179
temp46:180
args47:181
'#f
'#f)
(#%app:176
(#%app:176
checked-procedure-check-and-extract:176
struct:keyword-procedure:176
...row-higher-order.rkt:152:22:176
keyword-procedure-extract:176
'(#:missing-party)
'6)
'(#:missing-party)
(#%app:176
list:176
neg-party48:182)
blame44:178
f45:179
temp46:180
args47:181)))])
kwd-results:43)))))))))))))
(let-values:185 (((unpack43:186)
(lambda:48 (given-kws:48 given-args:48)
(let-values:187 (((mand40:151)
(#%app:188
car:188
given-args:48)))
(#%app:48 core42:150 mand40:151)))))
(#%app:48
lifted.2:47
(lambda:48 (given-kws:48 given-argc:48)
(if:189 (#%app:190 =:190 given-argc:48 '2)
(let-values:191 (((l2:192) given-kws:48))
(if:193 (#%app:192 pair?:192 l2:192)
(if:194 (#%app:192
eq?:192
(#%app:192 car:192 l2:192)
'#:mand)
(#%app:195 null?:195 (#%app:192 cdr:192 l2:192))
'#f)
'#f))
'#f))
(case-lambda:196
[(given-kws:48 given-args:48)
(#%app:196 unpack43:186 given-kws:48 given-args:48)])
'(#:mand)
'(#:mand))))
'0
'0
'(#:mand)
'()
'#f)))
'#f
'#f)))))
f))
(define-syntaxes:197 (provide/contract-id-f:34)
(#%app:198
make-provide/contract-arrow-transformer:34
(quote-syntax:34 provide/contract-id-f:34)
(quote-syntax:34 idZ12:51)
(quote-syntax:34 f)
(quote-syntax:34 idX10:199)
(quote-syntax:34 idY11:200)
'#s(valid-app-shapes (0) (#:mand) ())))
(define-syntaxes:201 (contracted-vars-info1:202)
(quote-syntax:34 ((rename-out:34 [provide/contract-id-f:34 f]))))
(define-values:34 (idX10:199 idB13:203)
(#%app:204
do-partial-app:34
idZ12:51
f7:205
'f
pos-module-source:34
(#%app:206
kernel:srcloc:208
(#%app:209 source-location-source:207 (quote-syntax:207 here:207))
(quote:207 3)
(quote:207 24)
(quote:207 39)
(quote:207 1))))
(define-values:210 (idY11:200)
(#%app:211 wrapped-extra-arg-arrow-extra-neg-party-argument:34 idX10:199))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment