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 "cond-abort.rkt")
(require "variant.lp2.rkt") (require "variant.lp2.rkt")
(require typed/rackunit)
(match-abort '(1 (a b) 3) (check-equal?
[(list x y z) (match-abort '(1 (a b) 3)
(let-abort ([new-x x] [(list x y z)
[new-y (match-abort y (let-abort ([new-x x]
[(list n p) (list 'A n p)] [new-y (match-abort y
[(list q r s) (list 'B q r s)])] [(list n p) (list 'A n p)]
[new-z z]) [(list q r s) (list 'B q r s)])]
(list new-x new-y new-z))]) [new-z z])
(list new-x new-y new-z))])
'(1 (A a b) 3))
(λ ([x : (U (Vector Number) (Vector String String))]) (let ()
(if (= (vector-length x) 1) (λ ([x : (U (Vector Number) (Vector String String))])
x (if (= (vector-length x) 1)
x)) x ;; Occurrence typing didn't narrow the type of x to (Vector Number).
x))
(void))
#| #|
@ -48,16 +53,17 @@
(check-equal?
(foldl (foldl
(λ (x acc) (λ (x acc)
(if (null? x) (if (null? x)
acc;(reverse acc) acc;(reverse acc)
(if (eq? x 'boo) (if (eq? x 'boo)
'continue 'continue
(cons x acc)))) (cons x acc))))
'() '()
'(a b c)) '(a b c))
'(c b a))
(begin (begin
@ -100,24 +106,24 @@
(cons (cons
(let ((val-cache4 (car val-cache3))) (let ((val-cache4 (car val-cache3)))
(cond (cond
((and (list? val-cache4) (eq? 'tag1 (car val-cache4))) ((and (list? val-cache4) (eq? 'tag1 (car val-cache4)))
(let-values (((temp6 temp7) (apply values val-cache4))) (let-values (((temp6 temp7) (apply values val-cache4)))
(list (list
temp6 temp6
(let-values (((temp10 temp11) (apply values temp7))) (let-values (((temp10 temp11) (apply values temp7)))
(list (list
(let ((val-cache12 temp10)) (let ((val-cache12 temp10))
(let ((Symbol13 (vector-ref val-cache12 0))) (vector Symbol13))) (let ((Symbol13 (vector-ref val-cache12 0))) (vector Symbol13)))
(map (λ ((String16 : String)) (string-length String16)) temp11)))))) (map (λ ((String16 : String)) (string-length String16)) temp11))))))
((and (list? val-cache4) (eq? 'tag2 (car val-cache4))) ((and (list? val-cache4) (eq? 'tag2 (car val-cache4)))
(let-values (((temp20 temp21) (apply values val-cache4))) (let-values (((temp20 temp21) (apply values val-cache4)))
(list (list
temp20 temp20
(let-values (((temp24 temp25) (apply values temp21))) (let-values (((temp24 temp25) (apply values temp21)))
(list (list
(let ((val-cache26 temp24)) (let ((val-cache26 temp24))
(let ((Symbol27 (vector-ref val-cache26 0))) (vector Symbol27))) (let ((Symbol27 (vector-ref val-cache26 0))) (vector Symbol27)))
(map (λ ((String30 : String)) (string-length String30)) temp25)))))))) (map (λ ((String30 : String)) (string-length String30)) temp25))))))))
(string-length (cdr val-cache3)))))))) (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))]) #;(λ ([x : (U (Vector Number) (Vector String String))])
(ann (vector-ref x 0) (U Number String))) (ann (vector-ref x 0) (U Number String)))
(ann (λ ([x : (U (Vector Number) (Vector String String) Symbol)]) (let ()
(if (vector? x) (ann (λ ([x : (U (Vector Number) (Vector String String) Symbol)])
x (if (vector? x)
#f)) x
(→ (U (Vector Number) (Vector String String) Symbol) #f))
(U False (Vector Number) (Vector String String)))) (→ (U (Vector Number) (Vector String String) Symbol)
(U False (Vector Number) (Vector String String))))
(λ ([x : (U (→ Number Number Number) (→ Number Number))])
(procedure-arity x)) (λ ([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 #lang typed/racket
(require "low.rkt") (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 ;; Types
(provide AnyImmutable) (provide AnyImmutable)
;; Functions ;; Functions
(provide ∘ eval-get-values) (provide (rename-out [∘ compose]))
;; Macros ;; Macros
(provide mapp comment) (provide mapp comment)
(require "eval-get-values.rkt")
(define ∘ compose)
(require (for-syntax syntax/parse (require (for-syntax syntax/parse
racket/syntax)) racket/syntax))

10
graph/main.rkt
View File

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