├── .gitignore ├── Forall.shen ├── Hlist-utils.shen ├── Hlist.shen ├── Json-Lenses.shen ├── Json-Parser.shen ├── Json.shen ├── Prolog-test.shen ├── Talk.org ├── Talk.pdf ├── Type-Tetris-Test.shen ├── Type-Tetris.shen ├── Typed-Coins.shen ├── Untyped-Coins.shen ├── json-notation.png └── signature.shen /.gitignore: -------------------------------------------------------------------------------- 1 | /Talk.tex 2 | /Talk.htlm 3 | /Talk.html 4 | -------------------------------------------------------------------------------- /Forall.shen: -------------------------------------------------------------------------------- 1 | (datatype forall 2 | 3 | let C (subst (gensym &&) A B) 4 | X : C; 5 | ____________________________ 6 | X : (mode (forall A B) -); 7 | 8 | 9 | (scheme A B S V); 10 | X : S >> P; 11 | _______________________________ 12 | X : (mode (forall A B) -) >> P; 13 | 14 | !; 15 | _________________ 16 | (scheme A A V V); 17 | 18 | !; 19 | (scheme A B D F); 20 | (scheme A C E F); 21 | _____________________________ 22 | (scheme A (B | C) (D | E) F); 23 | 24 | _________________ 25 | (scheme A B B _); 26 | ) 27 | 28 | (define foo 29 | {(forall A (A --> A)) --> (number * symbol)} 30 | F -> (@p (F 1) (F a))) -------------------------------------------------------------------------------- /Hlist-utils.shen: -------------------------------------------------------------------------------- 1 | (define separate 2 | [] -> [] 3 | [X] -> [end X] 4 | [X | XS] -> [X , | (separate XS)] 5 | ) 6 | 7 | 8 | (define index 9 | Index [] -> [] 10 | Index [X] -> [end Index X] 11 | Index [X | XS] -> [Index X , | (index (+ Index 1) XS)]) 12 | -------------------------------------------------------------------------------- /Hlist.shen: -------------------------------------------------------------------------------- 1 | (datatype hlist 2 | let Separated (shen.cons_form (separate (shen.decons Xs))) 3 | Separated : HList; 4 | _____________________________ 5 | [hlist | Xs] : (hlist HList); 6 | 7 | X : Type; 8 | XS : Types; 9 | ______________________ 10 | [X , | XS] : (Type Types); 11 | 12 | X : Type; 13 | ______________________ 14 | [end X | []] : (Type hnil); 15 | ) 16 | 17 | (datatype indexed-hlist 18 | let Separated (shen.cons_form (index 0 (shen.decons Xs))) 19 | Separated : HList; 20 | _____________________________ 21 | [indexed-hlist | Xs] : (indexed-hlist HList); 22 | 23 | X : Type; 24 | XS : Types; 25 | ______________________ 26 | [Index X , | XS] : (Index Type Types); 27 | 28 | X : Type; 29 | ______________________ 30 | [end Index X | []] : (Index Type hnil); 31 | 32 | 33 | H1 : (hlist X1); 34 | H2 : (hlist X2); 35 | ________________________________ 36 | (hlist-append H1 H2) : (hlist X1); 37 | ) 38 | -------------------------------------------------------------------------------- /Json-Lenses.shen: -------------------------------------------------------------------------------- 1 | (define with-value 2 | Key _ [] F -> (error (make-string "Key ~A not found" Key)) 3 | Key LeftKVs [(@p Key Value) | KVs] F -> (F LeftKVs Value KVs) 4 | Key LeftKVs [KV | KVs] F -> (with-value Key (append LeftKVs [KV]) KVs F)) 5 | 6 | (define get-key 7 | Key KVs -> (with-value Key [] KVs (/. _ Value _ Value))) 8 | 9 | (define set-key 10 | Key KVs Value -> 11 | (with-value Key [] KVs 12 | (/. LeftKVs _ KVs 13 | [object (append LeftKVs (append [(@p Key Value)] KVs))]))) 14 | 15 | (define object-lens 16 | Key [object | KVs] -> 17 | (@p (get-key Key KVs) 18 | (set-key Key KVs))) 19 | 20 | (define set-index 21 | Index Array Value -> (set-index-helper Index [] Array Value)) 22 | 23 | (define set-index-helper 24 | 0 Left [_ | Rs] Value -> (append (append Left [Value]) Rs) 25 | Index Left [R | Rs] Value -> 26 | (set-index-helper (- Index 1) (append Left [R]) Rs Value)) 27 | 28 | (define get-index 29 | 0 [X | _] -> X 30 | N [_ | Y] -> (get-index (- N 1) Y)) 31 | 32 | (define array-lens 33 | Index Array -> 34 | (@p (get-index Index Array) 35 | (set-index Index Array))) 36 | 37 | (define starter-lens 38 | X -> (@p X (/. V V))) 39 | 40 | (define modify 41 | LensF Json G -> 42 | (let Lens (LensF Json) 43 | ((snd Lens) (G (fst Lens))))) 44 | 45 | (define access 46 | LensF Json -> (fst (LensF Json))) 47 | 48 | (define compose 49 | Lens1F Lens2F Json -> 50 | (let Lens1 (Lens1F Json) 51 | Lens2 (Lens2F (fst Lens1)) 52 | (@p (fst Lens2) (/. V ((snd Lens1) ((snd Lens2) V)))))) 53 | 54 | (define fold-lenses-helper 55 | AccumLens [] -> AccumLens 56 | AccumLens [Lens | Lenses] -> 57 | (fold-lenses-helper (compose AccumLens Lens) 58 | Lenses)) 59 | (define fold-lenses 60 | [] -> starter-lens 61 | [Lens | Lenses] -> 62 | (fold-lenses-helper 63 | (compose starter-lens Lens) 64 | Lenses)) 65 | 66 | (define get-action 67 | set -> (function modify) 68 | get -> (function access)) 69 | 70 | (define from-json 71 | Path JsonString -> 72 | ((compile Path) 73 | (compile 74 | (compile (read-from-string JsonString))))) -------------------------------------------------------------------------------- /Json-Parser.shen: -------------------------------------------------------------------------------- 1 | (defcc shen. 2 | Escaped Byte := (n->string Byte) where (= Escaped 92); 3 | Byte := (n->string Byte) where (not (= Byte 34));) 4 | 5 | (defcc 6 | set := ((function modify) (fold-lenses )); 7 | get := ((function access) (fold-lenses ));) 8 | 9 | (defcc 10 | := [ | ]; 11 | := [];) 12 | 13 | (defcc 14 | X := (array-lens X) where (number? X); 15 | X := (object-lens X) where (symbol? X);) 16 | 17 | (defcc 18 | { } := [object | ]; 19 | {} := [object]; 20 | { } := [object];) 21 | 22 | (defcc 23 | , := [ | ]; 24 | := [];) 25 | 26 | (defcc 27 | String : := (@p (intern String) );) 28 | 29 | (defcc 30 | [ ] := ; 31 | [] := []; 32 | [ ] := [];) 33 | 34 | (defcc 35 | , := [ | ]; 36 | := []) 37 | 38 | (defcc 39 | [cons X Xs] := [(eval [cons X Xs]) | ] ; 40 | X := [X | ]; 41 | X := [X]) 42 | 43 | (defcc 44 | := ; 45 | := ; 46 | X := X;) -------------------------------------------------------------------------------- /Json.shen: -------------------------------------------------------------------------------- 1 | \* 2 | Usage: 3 | (from-json [get hello 0] "{ \"hello\" : [1,2,3,4] }") => 1 4 | ((from-json [set hello 0] "{ \"hello\" : [1,2,3,4] }") (+ 1)) => [object [(@p hello [2 2 3 4])]] 5 | *\ 6 | 7 | (load "Json-Lenses.shen") 8 | (load "Json-Parser.shen") -------------------------------------------------------------------------------- /Prolog-test.shen: -------------------------------------------------------------------------------- 1 | (defprolog mem 2 | X [X | _] [FOUND | _] <--; 3 | X [_ | Y] [X | Y] <-- (mem X Y);) -------------------------------------------------------------------------------- /Talk.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Shen Trick Shots 2 | #+AUTHOR: Aditya Siram 3 | #+OPTIONS: H:1 toc:f 4 | #+LATEX_CLASS: beamer 5 | #+LATEX_listingsCLASS_OPTIONS: [presentation] 6 | #+BEAMER_THEME: Madrid 7 | #+EPRESENT_FRAME_LEVEL: 1 8 | * Overview 9 | - A Lisp 10 | - Pattern matching 11 | - Optional Types 12 | - Built in YACC 13 | * Lenses 14 | - Feature the YACC parser 15 | - Functional updates of a JSON structure 16 | - Yak shave some lenses 17 | * Lenses 18 | - Getting 19 | #+BEGIN_EXAMPLE 20 | (from-json [get a-key 0] "{ \"a-key\" : [1,2,3,4] }") 21 | ^^^^^^^^^^^^^ 22 | => 1 23 | #+END_EXAMPLE 24 | - Setting 25 | #+BEGIN_EXAMPLE 26 | ((from-json [set a-key 0] "{ \"a-key\" : [1,2,3,4] }") 27 | ^^^^^^^^^^^^^ 28 | (+ 1)) 29 | => [json.object [(@p a-key [2 2 3 4])]] 30 | #+END_EXAMPLE 31 | * Lenses 32 | - Tokenized by Shen's own reader! 33 | #+BEGIN_EXAMPLE 34 | (read-from-string "{ \"a-key\" : [1,2,3,4] }") 35 | => [{ "a-key" : [cons 1 [cons , [cons 2 36 | [cons , [cons 3 [cons , 37 | [cons 4 []]]]]]]] }] 38 | #+END_EXAMPLE 39 | - Then built-in parser takes over 40 | #+BEGIN_EXAMPLE 41 | (compile 42 | (compile 43 | (...))) 44 | => [object (@p a-key [1 2 3 4])] 45 | #+END_EXAMPLE 46 | * Lenses 47 | #+BEGIN_EXAMPLE 48 | (defcc 49 | [cons X Xs] := [(eval [cons X Xs]) | ] ; 50 | X := [X | ]; 51 | X := [X]) 52 | #+END_EXAMPLE 53 | * Lenses 54 | - Notice how much this ... 55 | #+BEGIN_EXAMPLE 56 | (defcc 57 | { } := [object | ]; 58 | {} := [object]; 59 | { } := [object];) 60 | 61 | (defcc 62 | , := [ | ]; 63 | := [];) 64 | 65 | (defcc 66 | String : := (@p (intern String) );) 67 | 68 | (defcc 69 | [ ] := ; 70 | ... 71 | #+END_EXAMPLE 72 | * Lenses 73 | - Looks like ... 74 | 75 | #+ATTR_LATEX: :width 0.6\linewidth 76 | [[file:json-notation.png]] 77 | 78 | * Lenses 79 | - A lens for objects 80 | #+BEGIN_EXAMPLE 81 | (define object-lens 82 | Key [object | KVs] -> 83 | (@p (get-key Key KVs) 84 | (set-key Key KVs))) 85 | #+END_EXAMPLE 86 | - ~(set-key ...)~ is curried! 87 | #+BEGIN_EXAMPLE 88 | (set-key Key KVs) 89 | == (/. Object V (set-key Key KVs Object V)) 90 | #+END_EXAMPLE 91 | - A lens to the 'a-key' key 92 | #+BEGIN_EXAMPLE 93 | (object-lens a-key) 94 | #+END_EXAMPLE 95 | * Lenses 96 | - A lens for arrays 97 | #+BEGIN_EXAMPLE 98 | (define array-lens 99 | Index Array -> 100 | (@p (get-index Index Array) 101 | (set-index Index Array))) 102 | #+END_EXAMPLE 103 | - A lens to the 3rd element 104 | #+BEGIN_EXAMPLE 105 | (array-lens 2) 106 | #+END_EXAMPLE 107 | * Lenses 108 | - Combine two lenses 109 | #+BEGIN_EXAMPLE 110 | (define compose 111 | Lens1F Lens2F Json -> 112 | (let Lens1 (Lens1F Json) 113 | Lens2 (Lens2F (fst Lens1)) 114 | (@p (fst Lens2) 115 | (/. V ((snd Lens1) ((snd Lens2) V)))))) 116 | 117 | #+END_EXAMPLE 118 | * Lenses 119 | - Combine many lenses 120 | #+BEGIN_EXAMPLE 121 | (define starter-lens 122 | X -> (@p X (/. V V))) 123 | 124 | (define fold-lenses 125 | [] -> starter-lens 126 | [Lens | Lenses] -> 127 | (fold-lenses-helper 128 | (compose starter-lens Lens) 129 | Lenses)) 130 | #+END_EXAMPLE 131 | 132 | * Lenses 133 | - Run a lens 134 | #+BEGIN_EXAMPLE 135 | (define modify 136 | LensF Json G -> 137 | (let Lens (LensF Json) 138 | ((snd Lens) (G (fst Lens))))) 139 | 140 | (define access 141 | LensF Json -> (fst (LensF Json))) 142 | #+END_EXAMPLE 143 | 144 | * Lenses 145 | - Adding 1 to the first element 146 | #+BEGIN_EXAMPLE 147 | { "a-key" : [ 1 ,2,3,4]} 148 | ^^^^^ 149 | (modify (fold-lenses [(object-lens a-key) 150 | (array-lens 0 )]) 151 | (+ 1)) 152 | #+END_EXAMPLE 153 | * Lenses 154 | - Add 1 to a deeply-nested element 155 | #+BEGIN_EXAMPLE 156 | { "a-key" : [1,2, { "another-key" : [3, 4 ,5,6]},7]} 157 | ^^^^^ 158 | (modify (fold-lenses [(object-lens a-key ) 159 | (array-lens 2 ) 160 | (object-lens another-key) 161 | (array-lens 1 )]) 162 | (+ 1)) 163 | #+END_EXAMPLE 164 | * Lenses 165 | - The UI is messy, what I want is: 166 | #+BEGIN_EXAMPLE 167 | [set a-key 2 another-key 1] 168 | => (modify (fold-lenses [(object-lens a-key ) 169 | (array-lens 2 ) 170 | (object-lens another-key) 171 | (array-lens 1 )]) 172 | ...) 173 | #+END_EXAMPLE 174 | * Lenses 175 | - Describe the composition as a grammar! 176 | #+BEGIN_EXAMPLE 177 | (defcc 178 | set := 179 | ((function modify) (fold-lenses )); 180 | get := 181 | ((function access) (fold-lenses ));) 182 | 183 | (defcc 184 | := [ | ]; 185 | := [];) 186 | 187 | (defcc 188 | X := (array-lens X) where (number? X); 189 | X := (object-lens X) where (symbol? X);) 190 | #+END_EXAMPLE 191 | 192 | * Lenses 193 | - Putting it all together: 194 | #+BEGIN_EXAMPLE 195 | (define from-json 196 | Path JsonString -> 197 | ((compile Path) 198 | (compile 199 | (compile (read-from-string JsonString))))) 200 | 201 | #+END_EXAMPLE 202 | 203 | * Lenses 204 | - Given the JSON 205 | #+BEGIN_EXAMPLE 206 | { "a-key" : [1,2,{ "another-key" : [3,4, 5 ,6] },7]} 207 | ^^^^^ 208 | #+END_EXAMPLE 209 | - Add 1 to 5 210 | #+BEGIN_EXAMPLE 211 | ((from-json 212 | [set a-key 2 another-key 2] 213 | "{\"a-key\":[1,2,{\"another-key\":[3,4,5,6]},7]}") 214 | (+ 1)) 215 | #+END_EXAMPLE 216 | - Results in ... 217 | #+BEGIN_EXAMPLE 218 | [object [ 219 | (@p a-key [1 2 [object [ 220 | (@p another-key [3 4 6 6])] 221 | ^^^^^ 222 | ] 7])]] 223 | #+END_EXAMPLE 224 | * Coins - Typed 225 | - Initial glance at the type system 226 | - Debugging at the type level 227 | - Inserting coins into a coin store 228 | * Coins - Typed 229 | - Typed coin store example 230 | #+BEGIN_EXAMPLE 231 | (insert-coin penny) 232 | => [penny] : (list coin) 233 | 234 | (insert-coin dime) 235 | => [penny dime] : (list coin) 236 | #+END_EXAMPLE 237 | 238 | * Coins - Typed 239 | - Structure of a Shen datatype 240 | #+BEGIN_EXAMPLE 241 | (datatype .... 242 | things-that-need-to-be-true; 243 | ____________________________ 244 | want-to-prove; 245 | 246 | things-that-need-to-be-true; 247 | ____________________________ 248 | want-to-prove; 249 | ... 250 | ) 251 | #+END_EXAMPLE 252 | * Coins - Typed 253 | - Coin type 254 | #+BEGIN_EXAMPLE 255 | (datatype coin 256 | ___________ 257 | penny : coin; 258 | ___________ 259 | nickel: coin; 260 | ___________ 261 | dime : coin; 262 | ___________ 263 | quarter: coin; 264 | ... ) 265 | #+END_EXAMPLE 266 | - Roughly the same as 267 | #+BEGIN_EXAMPLE 268 | data Coin = Penny | Nickel | Dime | Quarter 269 | #+END_EXAMPLE 270 | * Coins - Typed 271 | - Types for storing 272 | #+BEGIN_EXAMPLE 273 | ____________________ 274 | *store*: (list coin); 275 | 276 | X : A; 277 | ______________ 278 | (value X): A; 279 | 280 | Y : A; 281 | _____________ 282 | (set X Y) : A;) 283 | #+END_EXAMPLE 284 | * Coins - Typed 285 | - Inserting into global store 286 | #+BEGIN_EXAMPLE 287 | (define insert-coin 288 | { coin --> (list coin) } 289 | Coin -> (set *store* (append (value *store*) Coin))) 290 | #+END_EXAMPLE 291 | * Coins - Typed 292 | - Running 293 | #+BEGIN_EXAMPLE 294 | (set *store* []) 295 | => [] 296 | (insert-coin penny) 297 | => type error 298 | #+END_EXAMPLE 299 | * Coins - Typed 300 | - Step through the typechecker 301 | #+BEGIN_EXAMPLE 302 | (spy +) 303 | #+END_EXAMPLE 304 | - Stepping session 305 | #+BEGIN_EXAMPLE 306 | ______________________________________ 3 inferences 307 | ?- (define insert-coin ... ) : Var2 308 | > 309 | _______________________________________ 23 inferences 310 | ?- &&Coin : coin 311 | 312 | 1. &&Coin : Var10 313 | 2. insert-coin : (coin --> (list coin)) 314 | 315 | ... 316 | #+END_EXAMPLE 317 | * Coins - Typed 318 | - Current expression 319 | #+BEGIN_EXAMPLE 320 | (set *store* (append (value *store*) Coin)) 321 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^ 322 | #+END_EXAMPLE 323 | 324 | - Step session 325 | #+BEGIN_EXAMPLE 326 | __________________________________________ 90 inferences 327 | ?- ((append ...) &&Coin) : (list coin) 328 | 329 | 1. &&Coin : coin 330 | 2. insert-coin : (coin --> (list coin)) 331 | ... 332 | #+END_EXAMPLE 333 | * Coins - Typed 334 | - Current expression 335 | #+BEGIN_EXAMPLE 336 | (set *store* (append (value *store*) Coin)) 337 | ^^^^ 338 | #+END_EXAMPLE 339 | 340 | - Step session - contradiction! ~(list coin) !== coin~ 341 | #+BEGIN_EXAMPLE 342 | _________________________________________ 156 inferences 343 | ?- &&Coin : (list coin) 344 | 345 | 1. &&Coin : coin 346 | 2. insert-coin : (coin --> (list coin)) 347 | 348 | > 349 | type error in rule 1 of insert-coin 350 | #+END_EXAMPLE 351 | 352 | * Coins - Typed 353 | #+BEGIN_EXAMPLE 354 | (define insert-coin 355 | { coin --> (list coin) } 356 | Coin -> (set *store* (append (value *store*) [Coin]))) 357 | ^^^^^^ 358 | #+END_EXAMPLE 359 | * Coins - Typed 360 | - Datatypes also take side-conditions 361 | #+BEGIN_EXAMPLE 362 | (datatype coins 363 | if (= 1 1) 364 | ___________ 365 | penny : coin; 366 | ...) 367 | #+END_EXAMPLE 368 | * Coins - Typed 369 | - Which run arbitrary code! 370 | #+BEGIN_EXAMPLE 371 | (datatype coins 372 | if (do (output "Hurr-durr, I'm a penny!~%") true) 373 | ___________ 374 | penny : coin; 375 | ...) 376 | #+END_EXAMPLE 377 | - Type level println! 378 | #+BEGIN_EXAMPLE 379 | (insert-coin penny) 380 | => "Hurr-durr, I'm a penny!" 381 | [penny] : (list coin) 382 | #+END_EXAMPLE 383 | * Coins - Typed 384 | - Ad hoc hole driven development! 385 | #+BEGIN_EXAMPLE 386 | (datatype <> 387 | 388 | if (do (output (make-string "<> : ~A~%" X)) true) 389 | ______________ 390 | <> : X;) 391 | #+END_EXAMPLE 392 | * Coins - Typed 393 | 394 | - Load with typechecking 395 | #+BEGIN_EXAMPLE 396 | (define insert-coin 397 | { coin --> (list coin) } 398 | Coin -> (set *store* <>)) 399 | => <> : [list coin] 400 | insert-coin : (coin --> (list coin)) 401 | #+END_EXAMPLE 402 | - Don't run this or you'll get: 403 | #+BEGIN_EXAMPLE 404 | (insert-coin penny) 405 | => [<>] 406 | #+END_EXAMPLE 407 | * Coins - Untyped 408 | - Use the typechecker for runtime reflection 409 | - Grow a datatype at runtime! 410 | * Coins - Untyped 411 | - Add and make coins. 412 | #+BEGIN_EXAMPLE 413 | (with-store penny) 414 | => "penny is not a coin." 415 | (with-store [make penny]) 416 | => type#coin 417 | (with-store penny) 418 | => [penny] 419 | (with-store [remove penny]) 420 | => type#coin 421 | (with-store penny) 422 | => "penny is not a coin" 423 | #+END_EXAMPLE 424 | * Coins - Untyped 425 | - Use the typechecker for runtime reflection! 426 | #+BEGIN_EXAMPLE 427 | (define with-store 428 | ... 429 | Coin -> 430 | (if (= (shen.typecheck Coin coin) coin) 431 | ^^^^^^^^^^^^^^^^^^^^^^^^ 432 | ( ... ) 433 | (make-string "~A is not a coin." Coin))) 434 | #+END_EXAMPLE 435 | - A simple example 436 | #+BEGIN_EXAMPLE 437 | (shen.typecheck "hello world" string) 438 | => string 439 | (shen.typecheck "hello world" number) 440 | => false 441 | #+END_EXAMPLE 442 | * Coins - Untyped 443 | - Add or remove from the global list of coin types 444 | #+BEGIN_EXAMPLE 445 | (define to-coin 446 | make Coin -> (append (value *coins*) [Coin]) 447 | remove Coin -> (remove Coin (value *coins*))) 448 | #+END_EXAMPLE 449 | - Eval a fresh datatype with only those types! 450 | #+BEGIN_EXAMPLE 451 | (define with-store 452 | [Action Coin] -> 453 | ... 454 | (do 455 | ... 456 | (set *current-datatype* (create-datatype NewCoins)) 457 | (eval (value *current-datatype*))))) 458 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 459 | Coin -> ...) 460 | #+END_EXAMPLE 461 | * Coins - Untyped 462 | - Creating the datatype 463 | #+BEGIN_EXAMPLE 464 | (define create-datatype 465 | Coins -> 466 | (append 467 | [datatype coin] 468 | (mapcan (/. Coin [ 469 | ___________ 470 | Coin : coin; 471 | ]) 472 | Coins))) 473 | #+END_EXAMPLE 474 | * Coins - Untyped 475 | - Example Run 476 | #+BEGIN_EXAMPLE 477 | (create-datatype [penny dime]) 478 | => [datatype coin 479 | __________ 480 | penny : coin; 481 | __________ 482 | dime : coin;] 483 | #+END_EXAMPLE 484 | * Coins - Untyped 485 | - Examine datatype at runtime! 486 | #+BEGIN_EXAMPLE 487 | (value *current-datatype*) 488 | => [datatype coin 489 | __________ 490 | penny : coin; 491 | __________ 492 | dime : coin;] 493 | #+END_EXAMPLE 494 | * API - Dump 495 | - Use built-in functions to inspect source code. 496 | - DIY Hoogle. 497 | * API - Dump 498 | - Don't need to give typecheck a concrete type! 499 | #+BEGIN_EXAMPLE 500 | (shen.typecheck 1 A) 501 | => number 502 | #+END_EXAMPLE 503 | - ~A~ is unified with the type 504 | * API - Dump 505 | - An 'undefined' type 506 | #+BEGIN_EXAMPLE 507 | (datatype undefined 508 | ______________ 509 | ??? : X; 510 | ) 511 | #+END_EXAMPLE 512 | * API - Dump 513 | - Some sample functions with fake datatypes 514 | #+BEGIN_EXAMPLE 515 | (define a-b-c 516 | { a --> b --> c } 517 | _ _ -> ??? ) 518 | 519 | (define b-c-d 520 | { b --> c --> d } 521 | _ _ -> ??? ) 522 | 523 | (define c-d 524 | { c --> d } 525 | _ -> ??? ) 526 | 527 | (define a-e 528 | { a --> e } 529 | _ -> ??? ) 530 | #+END_EXAMPLE 531 | 532 | * API - Dump 533 | - Extract the type signatures! 534 | #+BEGIN_EXAMPLE 535 | (dump "test.shen") 536 | => [[a-b-c [a --> [b --> c]]] 537 | [b-c-d [b --> [c --> d]]] 538 | [c-d [c --> d]] 539 | [a-e [a --> e]] 540 | [b-f [b --> f]]] 541 | #+END_EXAMPLE 542 | - Roll you own semver! 543 | * API - Dump 544 | - Extraction code - by Shen's author, adapted from mailing list post. 545 | #+BEGIN_EXAMPLE 546 | (define dump 547 | Shen -> 548 | (let Defs (mapcan (function def) (read-file Shen)) 549 | Types (map get-sig Defs) 550 | Types)) 551 | 552 | (define def 553 | [define F | _] -> [F] 554 | _ -> []) 555 | 556 | (define get-sig 557 | Def -> [Def (shen.typecheck Def (protect A))]) 558 | #+END_EXAMPLE 559 | 560 | * API - Dump 561 | - Hoogle style search! 562 | #+BEGIN_EXAMPLE 563 | (find-signature [a --> b --> X] 564 | (dump "Type-Tetris-Test.shen")) 565 | => [[a-b-c [a --> b --> c]]] 566 | #+END_EXAMPLE 567 | * API - Dump 568 | - Generate a grammar at runtime. 569 | #+BEGIN_EXAMPLE 570 | (define find-signature 571 | Signature ... -> 572 | (let ... 573 | SigParserAST (append 574 | [defcc SigParserName] 575 | Signature [:= true;] 576 | [_ := false;]) 577 | _ (eval SigParserAST) 578 | (...))) 579 | #+END_EXAMPLE 580 | - Generated grammar 581 | #+BEGIN_EXAMPLE 582 | (defcc Parser12345 583 | a --> b --> X := true; 584 | _ := false;) 585 | #+END_EXAMPLE 586 | * Rank N Types 587 | - Emulate Rank N Types in Shen! 588 | - This fails to typecheck 589 | #+BEGIN_EXAMPLE 590 | (define foo 591 | { (A --> A) --> (number * symbol) } 592 | F -> (@p (F 1) (F a))) 593 | #+END_EXAMPLE 594 | - The type variable ~A~ needs to be determined by application. 595 | 596 | * Rank N Types 597 | - Neat hack by Shen author, Mark Tarver. 598 | - This works! 599 | #+BEGIN_EXAMPLE 600 | (define rank-n-stein 601 | {(forall A (A --> A)) --> (number * symbol)} 602 | F -> (@p (F 1) (F a))) 603 | #+END_EXAMPLE 604 | * Rank N Types 605 | - Substitute out free variable in forall 606 | #+BEGIN_EXAMPLE 607 | let C (subst (gensym &&) A B) 608 | X : C; 609 | ____________________________ 610 | X : (mode (forall A B) -); 611 | #+END_EXAMPLE 612 | - Mode declaration disallows two way binding (unification) 613 | #+BEGIN_EXAMPLE 614 | C => (&&12345 --> &&12345) 615 | #+END_EXAMPLE 616 | * Rank N Types 617 | + Typechecking ~(F 1)~ 618 | + ~(forall A (A --> A))~ -> ~(free-var --> free-var)~ 619 | + Type system can now unify ~free-var~ with ~number~ 620 | + ~(forall A (A --> B))~ -> ~(free-var --> B)~ 621 | * Rank N Types 622 | - When ~forall ...~ is in the environment ... 623 | - Replace with ~S~. 624 | #+BEGIN_EXAMPLE 625 | (scheme A B S V); 626 | X : S >> P; 627 | _______________________________ 628 | X : (mode (forall A B) -) >> P; 629 | #+END_EXAMPLE 630 | * Rank N Types 631 | - Recurse over ~(A --> A)~ 632 | - Build up ~(D | E)~. 633 | #+BEGIN_EXAMPLE 634 | !; 635 | (scheme A B D F); 636 | (scheme A C E F); 637 | _____________________________ 638 | (scheme A (B | C) (D | E) F); 639 | #+END_EXAMPLE 640 | * Rank N Types 641 | - If ~A~ is found substitute with ~V~ 642 | #+BEGIN_EXAMPLE 643 | !; 644 | _________________ 645 | (scheme A A V V); 646 | #+END_EXAMPLE 647 | - The ! is a cut. No backtracking. 648 | - In the end, just return: 649 | #+BEGIN_EXAMPLE 650 | _________________ 651 | (scheme A B B _); 652 | #+END_EXAMPLE 653 | * Rank N Types 654 | - (Very) roughly like: 655 | #+BEGIN_EXAMPLE 656 | scheme(A [B | C] [D | E] F) :- 657 | scheme(A B D F); 658 | scheme(A C E F). 659 | scheme (A B B _). 660 | scheme (A A V V). 661 | #+END_EXAMPLE 662 | * Rank N Types 663 | - The Book Of Shen (1st & 2nd edition) 664 | - The Shen mailing list 665 | - Questions? 666 | -------------------------------------------------------------------------------- /Talk.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/deech/lambdaconf-shen-talk/39978fcd9164662a9352c8ab4b60e4fd78e0e38f/Talk.pdf -------------------------------------------------------------------------------- /Type-Tetris-Test.shen: -------------------------------------------------------------------------------- 1 | (datatype undefined 2 | ______________ 3 | ??? : X;) 4 | 5 | (datatype a 6 | _______ 7 | a : a;) 8 | 9 | (datatype b 10 | _______ 11 | b : b;) 12 | 13 | (datatype c 14 | _______ 15 | c : c;) 16 | 17 | (datatype d 18 | _______ 19 | d : d;) 20 | 21 | (datatype e 22 | _______ 23 | e : e;) 24 | 25 | (datatype f 26 | _______ 27 | f : f;) 28 | 29 | (datatype g 30 | _______ 31 | g : g;) 32 | 33 | (datatype h 34 | _______ 35 | h : h;) 36 | 37 | (define a-b-c 38 | { a --> b --> c } 39 | _ _ -> ??? ) 40 | 41 | (define b-c-d 42 | { b --> c --> d } 43 | _ _ -> ??? ) 44 | 45 | (define c-d 46 | { c --> d } 47 | _ -> ??? ) 48 | 49 | (define a-e 50 | { a --> e } 51 | _ -> ??? ) 52 | 53 | (define b-f 54 | { b --> f} 55 | _ -> ???) -------------------------------------------------------------------------------- /Type-Tetris.shen: -------------------------------------------------------------------------------- 1 | (datatype <> 2 | 3 | if (do (output (make-string "<> : ~A~%" X)) true) 4 | ______________ 5 | <> : X;) 6 | 7 | (define dump 8 | Shen -> 9 | (let Defs (mapcan (function def) (read-file Shen)) 10 | Types (map get-sig Defs) 11 | Types)) 12 | 13 | (define def 14 | [define F | _] -> [F] 15 | _ -> []) 16 | 17 | (define get-sig 18 | Def -> [Def (shen.typecheck Def (protect A))]) -------------------------------------------------------------------------------- /Typed-Coins.shen: -------------------------------------------------------------------------------- 1 | (datatype coin 2 | ___________ 3 | penny : coin; 4 | ___________ 5 | nickel: coin; 6 | ___________ 7 | dime : coin; 8 | ___________ 9 | quarter: coin; 10 | 11 | ____________________ 12 | *store*: (list coin); 13 | 14 | X : A; 15 | ______________ 16 | (value X): A; 17 | 18 | Y : A; 19 | _____________ 20 | (set X Y) : A;) 21 | 22 | (define insert-coin 23 | { coin --> (list coin) } 24 | Coin -> (set *store* (append (value *store*) [Coin]))) -------------------------------------------------------------------------------- /Untyped-Coins.shen: -------------------------------------------------------------------------------- 1 | (set *coins* []) 2 | (set *store* []) 3 | (set *current-datatype* []) 4 | (define create-datatype 5 | Coins -> 6 | (append 7 | [datatype coin] 8 | (mapcan (/. Coin [ 9 | ___________ 10 | Coin : coin; 11 | ]) 12 | Coins))) 13 | 14 | (define to-coin 15 | make Coin -> (append (value *coins*) [Coin]) 16 | remove Coin -> (remove Coin (value *coins*))) 17 | 18 | (define with-store 19 | [Action Coin] -> 20 | (let NewCoins (to-coin Action Coin) 21 | (if (not (empty? NewCoins)) 22 | (do 23 | (set *coins* NewCoins) 24 | (set *current-datatype* (create-datatype NewCoins)) 25 | (eval (value *current-datatype*))))) 26 | Coin -> 27 | (if (= (shen.typecheck Coin coin) coin) 28 | (set *store* (append (value *store*) [Coin])) 29 | (make-string "~A is not a coin." Coin))) 30 | -------------------------------------------------------------------------------- /json-notation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/deech/lambdaconf-shen-talk/39978fcd9164662a9352c8ab4b60e4fd78e0e38f/json-notation.png -------------------------------------------------------------------------------- /signature.shen: -------------------------------------------------------------------------------- 1 | (define signature 2 | F -> (prolog? (receive F) (shen.t* [F : A] []) (return [F A]))) 3 | 4 | (define signatures 5 | F -> (prolog? (receive F) (findall A [look [F A]] B) (return [F B]))) 6 | 7 | (defprolog look 8 | [F A] <-- (shen.t* [F : A] []);) 9 | 10 | (define dump 11 | Shen -> (let Defs (mapcan (function def) (read-file Shen)) 12 | KL (map (function ps) Defs) 13 | Types (map (function signature) Defs) 14 | Types)) 15 | 16 | (define def 17 | [define F | _] -> [F] 18 | _ -> []) 19 | 20 | (defcc 21 | X --> [ ] := [X --> | ]; 22 | X --> Y := [X --> Y]; 23 | X := [X];) 24 | 25 | (define compiles? 26 | Grammar [F Sig] -> (not (= (compile Grammar Sig (/. _ false)) false))) 27 | 28 | (define find-signature 29 | Signature Signatures -> 30 | (let SigParserName (gensym (protect Parser)) 31 | SigParserAST (append 32 | [defcc SigParserName] 33 | Signature [:= true;] 34 | [_ := false;]) 35 | _ (eval SigParserAST) 36 | (shen.collect (compiles? SigParserName) 37 | (map (/. S [(nth 1 S) (compile (nth 2 S))]) 38 | Signatures)))) --------------------------------------------------------------------------------