refactor mlish tests; parallize run-all-mlish-tests somewhat
This commit is contained in:
Stephen Chang
parent
05969628ff
commit
2da260d1f9
|
|
@ -858,23 +858,24 @@
|
|||
#:when (typecheck? #'ty_e #'ty_x)
|
||||
(⊢ (set! x e-) : Unit)])
|
||||
|
||||
(define-typed-syntax provide-type [(_ ty) #'(provide ty)])
|
||||
(define-typed-syntax provide-type [(_ ty ...) #'(provide ty ...)])
|
||||
|
||||
(define-typed-syntax provide
|
||||
[(_ x:id)
|
||||
#:with [x- ty_x] (infer+erase #'x)
|
||||
#:with x-ty (format-id #'x "~a-ty" #'x) ; TODO: use hash-code to generate this tmp
|
||||
[(_ x:id ...)
|
||||
#:with ([x- ty_x] ...) (infers+erase #'(x ...))
|
||||
; TODO: use hash-code to generate this tmp
|
||||
#:with (x-ty ...) (stx-map (lambda (y) (format-id y "~a-ty" y)) #'(x ...))
|
||||
#'(begin
|
||||
(provide x)
|
||||
(stlc+rec-iso:define-type-alias x-ty ty_x)
|
||||
(provide x-ty))])
|
||||
(provide x ...)
|
||||
(stlc+rec-iso:define-type-alias x-ty ty_x) ...
|
||||
(provide x-ty ...))])
|
||||
(define-typed-syntax require-typed
|
||||
[(_ x:id #:from mod)
|
||||
#:with x-ty (format-id #'x "~a-ty" #'x)
|
||||
#:with y (generate-temporary #'x)
|
||||
[(_ x:id ... #:from mod)
|
||||
#:with (x-ty ...) (stx-map (lambda (y) (format-id y "~a-ty" y)) #'(x ...))
|
||||
#:with (y ...) (generate-temporaries #'(x ...))
|
||||
#'(begin
|
||||
(require (rename-in (only-in mod x x-ty) [x y]))
|
||||
(define-syntax x (make-rename-transformer (assign-type #'y #'x-ty))))])
|
||||
(require (rename-in (only-in mod x ... x-ty ...) [x y] ...))
|
||||
(define-syntax x (make-rename-transformer (assign-type #'y #'x-ty))) ...)])
|
||||
|
||||
(define-base-type Regexp)
|
||||
(define-primop regexp-match : (→ Regexp String (List String)))
|
||||
|
|
|
|||
59
tapl/tests/mlish/bg/basics-general.rkt
Normal file
59
tapl/tests/mlish/bg/basics-general.rkt
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
#lang s-exp "../../../mlish.rkt"
|
||||
|
||||
(define-type (List X)
|
||||
Nil
|
||||
(Cons X (List X)))
|
||||
(define-type (** X Y)
|
||||
(Pair X Y))
|
||||
(define-type Bool
|
||||
True
|
||||
False)
|
||||
|
||||
(define (map [f : (→ A B)] [x* : (List A)] → (List B))
|
||||
(match x* with
|
||||
[Nil -> Nil]
|
||||
[Cons x x* -> (Cons (f x) (map f x*))]))
|
||||
|
||||
(define (append [x* : (List A)] [y* : (List A)] → (List A))
|
||||
(match x* with
|
||||
[Nil -> y*]
|
||||
[Cons x x* -> (Cons x (append x* y*))]))
|
||||
|
||||
(define (fst [xy : (** A B)] → A)
|
||||
(match xy with
|
||||
[Pair x y -> x]))
|
||||
|
||||
(define (snd [xy : (** A B)] → B)
|
||||
(match xy with
|
||||
[Pair x y -> y]))
|
||||
|
||||
(define (member [x* : (List A)] [y : A] → Bool)
|
||||
(match x* with
|
||||
[Nil -> False]
|
||||
[Cons x x* ->
|
||||
(if (equal? x y) True (member x* y))]))
|
||||
|
||||
(define (foldl [f : (→ A B A)] [acc : A] [x* : (List B)] → A)
|
||||
(match x* with
|
||||
[Nil -> acc]
|
||||
[Cons x x* -> (foldl f (f acc x) x*)]))
|
||||
|
||||
(define (foldr [f : (→ A B B)] [x* : (List A)] [acc : B] → B)
|
||||
(match x* with
|
||||
[Nil -> acc]
|
||||
[Cons x x* -> (f x (foldr f x* acc))]))
|
||||
|
||||
(define (filter [f : (→ A Bool)] [x* : (List A)] → (List A))
|
||||
(foldr (λ ([x : A] [acc : (List A)]) (match (f x) with [True -> (Cons x acc)] [False -> acc]))
|
||||
x*
|
||||
Nil))
|
||||
|
||||
(define (sum [x* : (List Float)] → Float)
|
||||
(foldl fl+ (exact->inexact 0) x*))
|
||||
|
||||
(define (reverse [x* : (List A)] → (List A))
|
||||
(foldl (λ ([x* : (List A)] [x : A]) (Cons x x*)) Nil x*))
|
||||
|
||||
(provide-type List Nil Cons ** Pair Bool True False)
|
||||
|
||||
(provide map append fst snd member foldl foldr filter sum reverse)
|
||||
|
|
@ -1,11 +1,8 @@
|
|||
#lang s-exp "../../../mlish.rkt"
|
||||
(require "../../rackunit-typechecking.rkt")
|
||||
|
||||
;; =============================================================================
|
||||
|
||||
(define-type (List X)
|
||||
Nil
|
||||
(Cons X (List X)))
|
||||
(require "basics-general.rkt")
|
||||
(require-typed map append fst snd member foldl foldr filter sum reverse
|
||||
#:from "basics-general.rkt")
|
||||
|
||||
;; =============================================================================
|
||||
;; http://www.cs.cornell.edu/courses/cs3110/2011fa/hw/ps1/ps1.html
|
||||
|
|
@ -41,16 +38,6 @@
|
|||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(define (map [f : (→ A B)] [x* : (List A)] → (List B))
|
||||
(match x* with
|
||||
[Nil -> Nil]
|
||||
[Cons x x* -> (Cons (f x) (map f x*))]))
|
||||
|
||||
(define (append [x* : (List A)] [y* : (List A)] → (List A))
|
||||
(match x* with
|
||||
[Nil -> y*]
|
||||
[Cons x x* -> (Cons x (append x* y*))]))
|
||||
|
||||
(define (flatten [x** : (List (List A))] → (List A))
|
||||
(match x** with
|
||||
[Nil -> Nil]
|
||||
|
|
@ -98,9 +85,6 @@
|
|||
;; =============================================================================
|
||||
;; http://www.cs.cornell.edu/courses/cs3110/2011sp/hw/ps1/ps1.htm
|
||||
|
||||
(define-type (** X Y)
|
||||
(Pair X Y))
|
||||
|
||||
(define (split [ab* : (List (** A B))] → (** (List A) (List B)))
|
||||
(match ab* with
|
||||
[Nil -> (Pair Nil Nil)]
|
||||
|
|
@ -165,45 +149,6 @@
|
|||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(define-type Bool
|
||||
True
|
||||
False)
|
||||
|
||||
(define (fst [xy : (** A B)] → A)
|
||||
(match xy with
|
||||
[Pair x y -> x]))
|
||||
|
||||
(define (snd [xy : (** A B)] → B)
|
||||
(match xy with
|
||||
[Pair x y -> y]))
|
||||
|
||||
(define (member [x* : (List A)] [y : A] → Bool)
|
||||
(match x* with
|
||||
[Nil -> False]
|
||||
[Cons x x* ->
|
||||
(if (equal? x y) True (member x* y))]))
|
||||
|
||||
(define (foldl [f : (→ A B A)] [acc : A] [x* : (List B)] → A)
|
||||
(match x* with
|
||||
[Nil -> acc]
|
||||
[Cons x x* -> (foldl f (f acc x) x*)]))
|
||||
|
||||
(define (foldr [f : (→ A B B)] [x* : (List A)] [acc : B] → B)
|
||||
(match x* with
|
||||
[Nil -> acc]
|
||||
[Cons x x* -> (f x (foldr f x* acc))]))
|
||||
|
||||
(define (filter [f : (→ A Bool)] [x* : (List A)] → (List A))
|
||||
(foldr (λ ([x : A] [acc : (List A)]) (match (f x) with [True -> (Cons x acc)] [False -> acc]))
|
||||
x*
|
||||
Nil))
|
||||
|
||||
(define (sum [x* : (List Float)] → Float)
|
||||
(foldl fl+ (exact->inexact 0) x*))
|
||||
|
||||
(define (reverse [x* : (List A)] → (List A))
|
||||
(foldl (λ ([x* : (List A)] [x : A]) (Cons x x*)) Nil x*))
|
||||
|
||||
(define (convolve [x* : (List Float)] [y* : (List Float)] → Float)
|
||||
(sum
|
||||
(map (λ ([xy : (** Float Float)]) (fl* (fst xy) (snd xy)))
|
||||
|
|
@ -267,132 +212,6 @@
|
|||
|
||||
;; # (mc 3 successor) (mc 0) square 2;;
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(define (map-index [is* : (List (** Int (List String)))] → (List (** String Int)))
|
||||
(match is* with
|
||||
[Nil -> Nil]
|
||||
[Cons hd tl ->
|
||||
(match hd with
|
||||
[Pair i s* ->
|
||||
(append (foldr (λ ([s : String] [acc : (List (** String Int))]) (Cons (Pair s i) acc))
|
||||
s*
|
||||
Nil)
|
||||
(map-index tl))])]))
|
||||
|
||||
(check-type
|
||||
(map-index Nil)
|
||||
: (List (** String Int))
|
||||
⇒ (Nil {(List (** String Int))}))
|
||||
|
||||
(check-type
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil)))) Nil))
|
||||
: (List (** String Int))
|
||||
⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) Nil))))
|
||||
|
||||
(check-type
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
|
||||
(Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
|
||||
Nil)))
|
||||
: (List (** String Int))
|
||||
⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) (Cons (Pair "d" 1) (Cons (Pair "e" 1) Nil))))))
|
||||
|
||||
(define (reduce-index [si* : (List (** String Int))] → (List (** String (List Int))))
|
||||
(snd (foldr
|
||||
(λ ([si : (** String Int)] [acc : (** (List String) (List (** String (List Int))))])
|
||||
(match si with
|
||||
[Pair s i ->
|
||||
(match acc with
|
||||
[Pair seen out ->
|
||||
(match (member seen s) with
|
||||
[True ->
|
||||
(Pair
|
||||
seen
|
||||
(foldr
|
||||
(λ ([si* : (** String (List Int))] [acc : (List (** String (List Int)))])
|
||||
(match si* with
|
||||
[Pair s2 i* ->
|
||||
(if (equal? s s2)
|
||||
(match (member i* i) with
|
||||
[True -> (Cons si* acc)]
|
||||
[False -> (Cons (Pair s2 (Cons i i*)) acc)])
|
||||
(Cons si* acc))]))
|
||||
out
|
||||
Nil))]
|
||||
[False ->
|
||||
(Pair
|
||||
(Cons s seen)
|
||||
(Cons (Pair s (Cons i Nil)) out))])])]))
|
||||
si*
|
||||
(Pair Nil Nil))))
|
||||
|
||||
|
||||
(check-type
|
||||
(reduce-index Nil)
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Nil {(List (** String (List Int)))}))
|
||||
|
||||
(check-type
|
||||
(reduce-index
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
|
||||
(Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
|
||||
Nil))))
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Cons (Pair "a" (Cons 0 Nil))
|
||||
(Cons (Pair "b" (Cons 0 Nil))
|
||||
(Cons (Pair "c" (Cons 0 Nil))
|
||||
(Cons (Pair "d" (Cons 1 Nil))
|
||||
(Cons (Pair "e" (Cons 1 Nil))
|
||||
Nil))))))
|
||||
|
||||
(check-type
|
||||
(reduce-index
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
|
||||
(Cons (Pair 1 (Cons "a" (Cons "b" Nil)))
|
||||
Nil))))
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Cons (Pair "c" (Cons 0 Nil))
|
||||
(Cons (Pair "a" (Cons 0 (Cons 1 Nil)))
|
||||
(Cons (Pair "b" (Cons 0 (Cons 1 Nil)))
|
||||
Nil))))
|
||||
|
||||
;; For every string, get all integers that refer to the string
|
||||
(define (make-index [is* : (List (** Int (List String)))] → (List (** String (List Int))))
|
||||
(reduce-index (map-index is*)))
|
||||
|
||||
(check-type
|
||||
(make-index Nil)
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Nil {(List (** String (List Int)))}))
|
||||
|
||||
(check-type
|
||||
(make-index (Cons (Pair 1 (Cons "ocaml" (Cons "is" (Cons "fun" (Cons "because" (Cons "fun" (Cons "is" (Cons "a" (Cons "keyword" Nil)))))))))
|
||||
(Cons (Pair 2 (Cons "page" (Cons "2" (Cons "intentionally" (Cons "left" (Cons "blank" Nil))))))
|
||||
(Cons (Pair 3 (Cons "the" (Cons "quick" (Cons "brown" (Cons "fox" (Cons "jumped" (Cons "over" (Cons "the" (Cons "lazy" (Cons "dog" Nil))))))))))
|
||||
(Cons (Pair 4 (Cons "is" (Cons "this" (Cons "the" (Cons "end" Nil))))) Nil)))))
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Cons (Pair "ocaml" (Cons 1 Nil))
|
||||
(Cons (Pair "because" (Cons 1 Nil))
|
||||
(Cons (Pair "fun" (Cons 1 Nil))
|
||||
(Cons (Pair "a" (Cons 1 Nil))
|
||||
(Cons (Pair "keyword" (Cons 1 Nil))
|
||||
(Cons (Pair "page" (Cons 2 Nil))
|
||||
(Cons (Pair "2" (Cons 2 Nil))
|
||||
(Cons (Pair "intentionally" (Cons 2 Nil))
|
||||
(Cons (Pair "left" (Cons 2 Nil))
|
||||
(Cons (Pair "blank" (Cons 2 Nil))
|
||||
(Cons (Pair "quick" (Cons 3 Nil))
|
||||
(Cons (Pair "brown" (Cons 3 Nil))
|
||||
(Cons (Pair "fox" (Cons 3 Nil))
|
||||
(Cons (Pair "jumped" (Cons 3 Nil))
|
||||
(Cons (Pair "over" (Cons 3 Nil))
|
||||
(Cons (Pair "lazy" (Cons 3 Nil))
|
||||
(Cons (Pair "dog" (Cons 3 Nil))
|
||||
(Cons (Pair "is" (Cons 1 (Cons 4 Nil)))
|
||||
(Cons (Pair "this" (Cons 4 Nil))
|
||||
(Cons (Pair "the" (Cons 3 (Cons 4 Nil)))
|
||||
(Cons (Pair "end" (Cons 4 Nil)) Nil))))))))))))))))))))))
|
||||
|
||||
;; =============================================================================
|
||||
;; === sorting
|
||||
|
||||
|
|
|
|||
138
tapl/tests/mlish/bg/basics2.mlish
Normal file
138
tapl/tests/mlish/bg/basics2.mlish
Normal file
|
|
@ -0,0 +1,138 @@
|
|||
#lang s-exp "../../../mlish.rkt"
|
||||
(require "../../rackunit-typechecking.rkt")
|
||||
(require "basics-general.rkt")
|
||||
(require-typed append filter foldr foldl reverse snd member
|
||||
#:from "basics-general.rkt")
|
||||
|
||||
|
||||
;; =============================================================================
|
||||
;; http://www.cs.cornell.edu/courses/cs3110/2011fa/hw/ps1/ps1.html
|
||||
;; continued
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(define (map-index [is* : (List (** Int (List String)))] → (List (** String Int)))
|
||||
(match is* with
|
||||
[Nil -> Nil]
|
||||
[Cons hd tl ->
|
||||
(match hd with
|
||||
[Pair i s* ->
|
||||
(append (foldr (λ ([s : String] [acc : (List (** String Int))]) (Cons (Pair s i) acc))
|
||||
s*
|
||||
Nil)
|
||||
(map-index tl))])]))
|
||||
|
||||
(check-type
|
||||
(map-index Nil)
|
||||
: (List (** String Int))
|
||||
⇒ (Nil {(List (** String Int))}))
|
||||
|
||||
(check-type
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil)))) Nil))
|
||||
: (List (** String Int))
|
||||
⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) Nil))))
|
||||
|
||||
(check-type
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
|
||||
(Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
|
||||
Nil)))
|
||||
: (List (** String Int))
|
||||
⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) (Cons (Pair "d" 1) (Cons (Pair "e" 1) Nil))))))
|
||||
|
||||
(define (reduce-index [si* : (List (** String Int))] → (List (** String (List Int))))
|
||||
(snd (foldr
|
||||
(λ ([si : (** String Int)] [acc : (** (List String) (List (** String (List Int))))])
|
||||
(match si with
|
||||
[Pair s i ->
|
||||
(match acc with
|
||||
[Pair seen out ->
|
||||
(match (member seen s) with
|
||||
[True ->
|
||||
(Pair
|
||||
seen
|
||||
(foldr
|
||||
(λ ([si* : (** String (List Int))] [acc : (List (** String (List Int)))])
|
||||
(match si* with
|
||||
[Pair s2 i* ->
|
||||
(if (equal? s s2)
|
||||
(match (member i* i) with
|
||||
[True -> (Cons si* acc)]
|
||||
[False -> (Cons (Pair s2 (Cons i i*)) acc)])
|
||||
(Cons si* acc))]))
|
||||
out
|
||||
Nil))]
|
||||
[False ->
|
||||
(Pair
|
||||
(Cons s seen)
|
||||
(Cons (Pair s (Cons i Nil)) out))])])]))
|
||||
si*
|
||||
(Pair Nil Nil))))
|
||||
|
||||
|
||||
(check-type
|
||||
(reduce-index Nil)
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Nil {(List (** String (List Int)))}))
|
||||
|
||||
(check-type
|
||||
(reduce-index
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
|
||||
(Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
|
||||
Nil))))
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Cons (Pair "a" (Cons 0 Nil))
|
||||
(Cons (Pair "b" (Cons 0 Nil))
|
||||
(Cons (Pair "c" (Cons 0 Nil))
|
||||
(Cons (Pair "d" (Cons 1 Nil))
|
||||
(Cons (Pair "e" (Cons 1 Nil))
|
||||
Nil))))))
|
||||
|
||||
(check-type
|
||||
(reduce-index
|
||||
(map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
|
||||
(Cons (Pair 1 (Cons "a" (Cons "b" Nil)))
|
||||
Nil))))
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Cons (Pair "c" (Cons 0 Nil))
|
||||
(Cons (Pair "a" (Cons 0 (Cons 1 Nil)))
|
||||
(Cons (Pair "b" (Cons 0 (Cons 1 Nil)))
|
||||
Nil))))
|
||||
|
||||
;; For every string, get all integers that refer to the string
|
||||
(define (make-index [is* : (List (** Int (List String)))]
|
||||
→ (List (** String (List Int))))
|
||||
(reduce-index (map-index is*)))
|
||||
|
||||
(check-type
|
||||
(make-index Nil)
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Nil {(List (** String (List Int)))}))
|
||||
|
||||
(check-type
|
||||
(make-index (Cons (Pair 1 (Cons "ocaml" (Cons "is" (Cons "fun" (Cons "because" (Cons "fun" (Cons "is" (Cons "a" (Cons "keyword" Nil)))))))))
|
||||
(Cons (Pair 2 (Cons "page" (Cons "2" (Cons "intentionally" (Cons "left" (Cons "blank" Nil))))))
|
||||
(Cons (Pair 3 (Cons "the" (Cons "quick" (Cons "brown" (Cons "fox" (Cons "jumped" (Cons "over" (Cons "the" (Cons "lazy" (Cons "dog" Nil))))))))))
|
||||
(Cons (Pair 4 (Cons "is" (Cons "this" (Cons "the" (Cons "end" Nil))))) Nil)))))
|
||||
: (List (** String (List Int)))
|
||||
⇒ (Cons (Pair "ocaml" (Cons 1 Nil))
|
||||
(Cons (Pair "because" (Cons 1 Nil))
|
||||
(Cons (Pair "fun" (Cons 1 Nil))
|
||||
(Cons (Pair "a" (Cons 1 Nil))
|
||||
(Cons (Pair "keyword" (Cons 1 Nil))
|
||||
(Cons (Pair "page" (Cons 2 Nil))
|
||||
(Cons (Pair "2" (Cons 2 Nil))
|
||||
(Cons (Pair "intentionally" (Cons 2 Nil))
|
||||
(Cons (Pair "left" (Cons 2 Nil))
|
||||
(Cons (Pair "blank" (Cons 2 Nil))
|
||||
(Cons (Pair "quick" (Cons 3 Nil))
|
||||
(Cons (Pair "brown" (Cons 3 Nil))
|
||||
(Cons (Pair "fox" (Cons 3 Nil))
|
||||
(Cons (Pair "jumped" (Cons 3 Nil))
|
||||
(Cons (Pair "over" (Cons 3 Nil))
|
||||
(Cons (Pair "lazy" (Cons 3 Nil))
|
||||
(Cons (Pair "dog" (Cons 3 Nil))
|
||||
(Cons (Pair "is" (Cons 1 (Cons 4 Nil)))
|
||||
(Cons (Pair "this" (Cons 4 Nil))
|
||||
(Cons (Pair "the" (Cons 3 (Cons 4 Nil)))
|
||||
(Cons (Pair "end" (Cons 4 Nil)) Nil))))))))))))))))))))))
|
||||
|
||||
|
|
@ -118,11 +118,12 @@
|
|||
;; (list 66 0)
|
||||
;; (list 67 0)))
|
||||
|
||||
(check-type (go 1000 (list Blue Red Yellow Red Yellow Blue))
|
||||
: (List Result)
|
||||
-> (list (list 333 0)
|
||||
(list 333 0)
|
||||
(list 333 0)
|
||||
(list 333 0)
|
||||
(list 334 0)
|
||||
(list 334 0)))
|
||||
(check-type (map (λ ([x : Result]) (proj x 0))
|
||||
(go 1000 (list Blue Red Yellow Red Yellow Blue)))
|
||||
: (List Int) -> (list 333 333 333 333 334 334))
|
||||
;; -> (list (list 333 0)
|
||||
;; (list 333 0)
|
||||
;; (list 333 0)
|
||||
;; (list 333 0)
|
||||
;; (list 334 0)
|
||||
;; (list 334 0)))
|
||||
|
|
|
|||
|
|
@ -5,54 +5,4 @@
|
|||
(Leaf X)
|
||||
(Node (Tree X) X (Tree X)))
|
||||
|
||||
(provide-type Tree)
|
||||
(provide-type Leaf)
|
||||
(provide-type Node)
|
||||
|
||||
(define (make [item : Int] [depth : Int] -> (Tree Int))
|
||||
(if (zero? depth)
|
||||
(Leaf item)
|
||||
(let ([item2 (* item 2)]
|
||||
[depth2 (sub1 depth)])
|
||||
(Node (make (sub1 item2) depth2)
|
||||
item
|
||||
(make item2 depth2)))))
|
||||
|
||||
(define tree1 (make 4 1))
|
||||
(define tree2 (make 3 2))
|
||||
|
||||
(check-type tree1
|
||||
: (Tree Int) -> (Node (Leaf 7) 4 (Leaf 8)))
|
||||
|
||||
(check-type tree2
|
||||
: (Tree Int)
|
||||
-> (Node
|
||||
(Node (Leaf 9) 5 (Leaf 10))
|
||||
3
|
||||
(Node (Leaf 11) 6 (Leaf 12))))
|
||||
|
||||
(define (sum [t : (Tree Int)] -> Int)
|
||||
(match t with
|
||||
[Leaf v -> v]
|
||||
[Node l v r -> (+ (+ (sum l) v) (sum r))]))
|
||||
|
||||
(check-type (sum tree1) : Int -> 19)
|
||||
(check-type (sum tree2) : Int -> 56)
|
||||
|
||||
(define (check/acc [t : (Tree Int)] [acc : Int] -> Int)
|
||||
(match t with
|
||||
[Leaf v ->
|
||||
(+ acc v)]
|
||||
[Node l v r ->
|
||||
(check/acc l (- acc (check/acc r 0)))]))
|
||||
(define (check [t : (Tree Int)] -> Int)
|
||||
(check/acc t 0))
|
||||
|
||||
(define min-depth 4)
|
||||
|
||||
(define (main [n : Int] -> Int)
|
||||
(let* ([max-depth (max (+ min-depth 2) n)]
|
||||
[stretch-depth (add1 max-depth)])
|
||||
(check (make 0 stretch-depth))))
|
||||
|
||||
(check-type (main 17) : Int -> 0)
|
||||
(provide-type Tree Leaf Node)
|
||||
|
|
|
|||
|
|
@ -1,30 +1,81 @@
|
|||
#lang racket
|
||||
(require "mlish-tests.rkt")
|
||||
(require "mlish/queens.mlish")
|
||||
(require "mlish/trees.mlish")
|
||||
(require "mlish/chameneos.mlish")
|
||||
(require "mlish/ack.mlish")
|
||||
(require "mlish/ary.mlish")
|
||||
(require "mlish/fannkuch.mlish")
|
||||
(require "mlish/fasta.mlish")
|
||||
(require "mlish/fibo.mlish")
|
||||
(require "mlish/hash.mlish")
|
||||
;(require "mlish/heapsort.mlish")
|
||||
(require "mlish/knuc.mlish")
|
||||
(require "mlish/matrix.mlish")
|
||||
(require "mlish/nbody.mlish")
|
||||
|
||||
;; from rw ocaml
|
||||
(require "mlish/term.mlish")
|
||||
(require "mlish/find.mlish")
|
||||
(require "mlish/alex.mlish")
|
||||
(require "mlish/inst.mlish")
|
||||
(require "mlish/result.mlish")
|
||||
(match-define (list i1 o1 id1 err1 f1)
|
||||
(process "time racket run-mlish-tests1.rkt"))
|
||||
(match-define (list i1b o1b id1b err1b f1b)
|
||||
(process "time racket run-mlish-tests1b.rkt"))
|
||||
(match-define (list i2 o2 id2 err2 f2)
|
||||
(process "time racket run-mlish-tests2.rkt"))
|
||||
(match-define (list i3 o3 id3 err3 f3)
|
||||
(process "time racket mlish/bg/basics.mlish"))
|
||||
(match-define (list i3b o3b id3b err3b f3b)
|
||||
(process "time racket mlish/bg/basics2.mlish"))
|
||||
(match-define (list i3c o3c id3c err3c f3c)
|
||||
(process "time racket run-mlish-tests3.rkt"))
|
||||
(match-define (list i4 o4 id4 err4 f4)
|
||||
(process "time racket mlish/polyrecur.mlish"))
|
||||
|
||||
;; bg
|
||||
(require "mlish/bg/basics.mlish")
|
||||
(require "mlish/bg/huffman.mlish")
|
||||
(require "mlish/bg/lambda.rkt")
|
||||
(displayln "----- General tests and queens: ---------------------------------")
|
||||
(write-string (port->string err1))
|
||||
(displayln "----- Shootout tests: -------------------------------------------")
|
||||
(write-string (port->string err1b))
|
||||
(displayln "----- RW OCaml tests: -------------------------------------------")
|
||||
(write-string (port->string err2))
|
||||
(displayln "----- Ben's tests: ----------------------------------------------")
|
||||
(write-string (port->string err3))
|
||||
(write-string (port->string err3b))
|
||||
(write-string (port->string err3c))
|
||||
(displayln "----- Okasaki / polymorphic recursion tests: --------------------")
|
||||
(write-string (port->string err4))
|
||||
|
||||
;; okasaki, polymorphic recursion
|
||||
(require "mlish/polyrecur.mlish")
|
||||
(close-input-port i1)
|
||||
(close-output-port o1)
|
||||
(close-input-port err1)
|
||||
(close-input-port i1b)
|
||||
(close-output-port o1b)
|
||||
(close-input-port err1b)
|
||||
(close-input-port i2)
|
||||
(close-output-port o2)
|
||||
(close-input-port err2)
|
||||
(close-input-port i3)
|
||||
(close-output-port o3)
|
||||
(close-input-port err3)
|
||||
(close-input-port i3b)
|
||||
(close-output-port o3b)
|
||||
(close-input-port err3b)
|
||||
(close-input-port i3c)
|
||||
(close-output-port o3c)
|
||||
(close-input-port err3c)
|
||||
(close-input-port i4)
|
||||
(close-output-port o4)
|
||||
(close-input-port err4)
|
||||
|
||||
;; (require "mlish-tests.rkt")
|
||||
;; (require "mlish/queens.mlish")
|
||||
;; (require "mlish/trees.mlish")
|
||||
;; (require "mlish/chameneos.mlish")
|
||||
;; (require "mlish/ack.mlish")
|
||||
;; (require "mlish/ary.mlish")
|
||||
;; (require "mlish/fannkuch.mlish")
|
||||
;; (require "mlish/fasta.mlish")
|
||||
;; (require "mlish/fibo.mlish")
|
||||
;; (require "mlish/hash.mlish")
|
||||
;; ;(require "mlish/heapsort.mlish")
|
||||
;; (require "mlish/knuc.mlish")
|
||||
;; (require "mlish/matrix.mlish")
|
||||
;; (require "mlish/nbody.mlish")
|
||||
|
||||
;; ;; from rw ocaml
|
||||
;; (require "mlish/term.mlish")
|
||||
;; (require "mlish/find.mlish")
|
||||
;; (require "mlish/alex.mlish")
|
||||
;; (require "mlish/inst.mlish")
|
||||
;; (require "mlish/result.mlish")
|
||||
|
||||
;; ;; bg
|
||||
;; (require "mlish/bg/basics.mlish")
|
||||
;; (require "mlish/bg/huffman.mlish")
|
||||
;; (require "mlish/bg/lambda.rkt")
|
||||
|
||||
;; ;; okasaki, polymorphic recursion
|
||||
;; (require "mlish/polyrecur.mlish")
|
||||
|
|
|
|||
15
tapl/tests/run-mlish-tests1.rkt
Normal file
15
tapl/tests/run-mlish-tests1.rkt
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
#lang racket
|
||||
(require "mlish-tests.rkt")
|
||||
(require "mlish/queens.mlish")
|
||||
;; (require "mlish/trees.mlish")
|
||||
;; (require "mlish/chameneos.mlish")
|
||||
;; (require "mlish/ack.mlish")
|
||||
;; (require "mlish/ary.mlish")
|
||||
;; (require "mlish/fannkuch.mlish")
|
||||
;; (require "mlish/fasta.mlish")
|
||||
;; (require "mlish/fibo.mlish")
|
||||
;; (require "mlish/hash.mlish")
|
||||
;; ;(require "mlish/heapsort.mlish")
|
||||
;; (require "mlish/knuc.mlish")
|
||||
;; (require "mlish/matrix.mlish")
|
||||
;; (require "mlish/nbody.mlish")
|
||||
15
tapl/tests/run-mlish-tests1b.rkt
Normal file
15
tapl/tests/run-mlish-tests1b.rkt
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
#lang racket
|
||||
;; (require "mlish-tests.rkt")
|
||||
;; (require "mlish/queens.mlish")
|
||||
(require "mlish/trees-tests.mlish")
|
||||
(require "mlish/chameneos.mlish")
|
||||
(require "mlish/ack.mlish")
|
||||
(require "mlish/ary.mlish")
|
||||
(require "mlish/fannkuch.mlish")
|
||||
(require "mlish/fasta.mlish")
|
||||
(require "mlish/fibo.mlish")
|
||||
(require "mlish/hash.mlish")
|
||||
;(require "mlish/heapsort.mlish")
|
||||
(require "mlish/knuc.mlish")
|
||||
(require "mlish/matrix.mlish")
|
||||
(require "mlish/nbody.mlish")
|
||||
7
tapl/tests/run-mlish-tests2.rkt
Normal file
7
tapl/tests/run-mlish-tests2.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#lang racket
|
||||
;; from rw ocaml
|
||||
(require "mlish/term.mlish")
|
||||
(require "mlish/find.mlish")
|
||||
(require "mlish/alex.mlish")
|
||||
(require "mlish/inst.mlish")
|
||||
(require "mlish/result.mlish")
|
||||
4
tapl/tests/run-mlish-tests3.rkt
Normal file
4
tapl/tests/run-mlish-tests3.rkt
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
#lang racket
|
||||
;; bg
|
||||
(require "mlish/bg/huffman.mlish")
|
||||
(require "mlish/bg/lambda.rkt")
|
||||
Loading…
Reference in New Issue
Block a user