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

Cleaned up tests. make clean && make works.

Browse Source
This commit is contained in:
Georges Dupéron 2015-11-12 12:47:43 +01:00
parent fbc2411603
commit efd556eb66
4 changed files with 68 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
graph/graph/_examples_cond-abort.rkt
View File

@ -2,20 +2,25 @@
(require "cond-abort.rkt")
(require "variant.lp2.rkt")
(require typed/rackunit)
(match-abort '(1 (a b) 3)
[(list x y z)
(let-abort ([new-x x]
[new-y (match-abort y
[(list n p) (list 'A n p)]
[(list q r s) (list 'B q r s)])]
[new-z z])
(list new-x new-y new-z))])
(check-equal?
(match-abort '(1 (a b) 3)
[(list x y z)
(let-abort ([new-x x]
[new-y (match-abort y
[(list n p) (list 'A n p)]
[(list q r s) (list 'B q r s)])]
[new-z z])
(list new-x new-y new-z))])
'(1 (A a b) 3))
(λ ([x : (U (Vector Number) (Vector String String))])
(if (= (vector-length x) 1)
x
x))
(let ()
(λ ([x : (U (Vector Number) (Vector String String))])
(if (= (vector-length x) 1)
x ;; Occurrence typing didn't narrow the type of x to (Vector Number).
x))
(void))
#|
@ -48,16 +53,17 @@
(foldl
(λ (x acc)
(if (null? x)
acc;(reverse acc)
(if (eq? x 'boo)
'continue
(cons x acc))))
'()
'(a b c))
(check-equal?
(foldl
(λ (x acc)
(if (null? x)
acc;(reverse acc)
(if (eq? x 'boo)
'continue
(cons x acc))))
'()
'(a b c))
'(c b a))
(begin
@ -100,24 +106,24 @@
(cons
(let ((val-cache4 (car val-cache3)))
(cond
((and (list? val-cache4) (eq? 'tag1 (car val-cache4)))
(let-values (((temp6 temp7) (apply values val-cache4)))
(list
temp6
(let-values (((temp10 temp11) (apply values temp7)))
(list
(let ((val-cache12 temp10))
(let ((Symbol13 (vector-ref val-cache12 0))) (vector Symbol13)))
(map (λ ((String16 : String)) (string-length String16)) temp11))))))
((and (list? val-cache4) (eq? 'tag2 (car val-cache4)))
(let-values (((temp20 temp21) (apply values val-cache4)))
(list
temp20
(let-values (((temp24 temp25) (apply values temp21)))
(list
(let ((val-cache26 temp24))
(let ((Symbol27 (vector-ref val-cache26 0))) (vector Symbol27)))
(map (λ ((String30 : String)) (string-length String30)) temp25))))))))
((and (list? val-cache4) (eq? 'tag1 (car val-cache4)))
(let-values (((temp6 temp7) (apply values val-cache4)))
(list
temp6
(let-values (((temp10 temp11) (apply values temp7)))
(list
(let ((val-cache12 temp10))
(let ((Symbol13 (vector-ref val-cache12 0))) (vector Symbol13)))
(map (λ ((String16 : String)) (string-length String16)) temp11))))))
((and (list? val-cache4) (eq? 'tag2 (car val-cache4)))
(let-values (((temp20 temp21) (apply values val-cache4)))
(list
temp20
(let-values (((temp24 temp25) (apply values temp21)))
(list
(let ((val-cache26 temp24))
(let ((Symbol27 (vector-ref val-cache26 0))) (vector Symbol27)))
(map (λ ((String30 : String)) (string-length String30)) temp25))))))))
(string-length (cdr val-cache3))))))))
#|

22
graph/graph/_examples_differentiate_unions.rkt
View File

@ -4,13 +4,15 @@
#;(λ ([x : (U (Vector Number) (Vector String String))])
(ann (vector-ref x 0) (U Number String)))
(ann (λ ([x : (U (Vector Number) (Vector String String) Symbol)])
(if (vector? x)
x
#f))
(→ (U (Vector Number) (Vector String String) Symbol)
(U False (Vector Number) (Vector String String))))
(λ ([x : (U (→ Number Number Number) (→ Number Number))])
(procedure-arity x))
(let ()
(ann (λ ([x : (U (Vector Number) (Vector String String) Symbol)])
(if (vector? x)
x
#f))
(→ (U (Vector Number) (Vector String String) Symbol)
(U False (Vector Number) (Vector String String))))
(λ ([x : (U (→ Number Number Number) (→ Number Number))])
(procedure-arity x))
(void))

11
graph/lib/lib.rkt
View File

@ -1,19 +1,18 @@
#lang typed/racket
(require "low.rkt")
(provide (all-from-out "low.rkt"))
(require "eval-get-values.rkt")
(provide (all-from-out "low.rkt")
(all-from-out "eval-get-values.rkt"))
;; Types
(provide AnyImmutable)
;; Functions
(provide ∘ eval-get-values)
(provide (rename-out [∘ compose]))
;; Macros
(provide mapp comment)
(require "eval-get-values.rkt")
(define ∘ compose)
(require (for-syntax syntax/parse
racket/syntax))

10
graph/main.rkt
View File

@ -84,7 +84,7 @@
(syntax->datum #'n))
#'n)
;; Just for testing:
#''error]))
#''test]))
(define-type C Boolean)
@ -116,18 +116,18 @@
(define-type TA A)
(define-type TAI (incomplete A))
(displayln (ann '(A . 1) TAI))
(ann '(A . 1) TAI)
(define-type TC C)
(define-type TCI (incomplete C))
(displayln (ann #t TC))
(displayln (ann '(C . #t) TCI))
(ann #t TC)
(ann '(C . #t) TCI)
(let ()
(define-type A Boolean)
(define-type TA A)
(define-type TAI (incomplete A))
(displayln (ann 'error TAI))
(ann 'test TAI)
(void))))
(require (prefix-in tr: typed/racket))