From a2ca7879403145497d8fb1bf1789f1b53c4a828b Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Wed, 22 Jun 2016 13:35:59 -0400 Subject: [PATCH] convert more mlish tests to typed-lang-builder/mlish-core --- tapl/tests/mlish/ack.mlish | 2 +- tapl/tests/mlish/alex.mlish | 2 +- tapl/tests/mlish/ary.mlish | 2 +- tapl/tests/mlish/chameneos.mlish | 4 ++-- tapl/tests/mlish/fannkuch.mlish | 2 +- tapl/tests/mlish/fasta.mlish | 2 +- tapl/tests/mlish/fibo.mlish | 2 +- tapl/tests/mlish/find.mlish | 2 +- tapl/tests/mlish/hash.mlish | 2 +- tapl/tests/mlish/inst.mlish | 2 +- tapl/tests/mlish/knuc.mlish | 2 +- tapl/tests/mlish/matrix.mlish | 2 +- tapl/tests/mlish/nbody.mlish | 2 +- tapl/tests/mlish/result.mlish | 16 +++++-------- tapl/tests/mlish/term.mlish | 2 +- tapl/tests/mlish/trees-tests.mlish | 2 +- tapl/tests/mlish/trees.mlish | 2 +- tapl/typed-lang-builder/mlish-core.rkt | 6 ++--- tapl/typed-lang-builder/mlish-do.rkt | 31 ++++++++++++++++++++++++++ 19 files changed, 57 insertions(+), 30 deletions(-) create mode 100644 tapl/typed-lang-builder/mlish-do.rkt diff --git a/tapl/tests/mlish/ack.mlish b/tapl/tests/mlish/ack.mlish index b29225b..edadc19 100644 --- a/tapl/tests/mlish/ack.mlish +++ b/tapl/tests/mlish/ack.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") ;; tests cond with else diff --git a/tapl/tests/mlish/alex.mlish b/tapl/tests/mlish/alex.mlish index 9e80c23..d316a5d 100644 --- a/tapl/tests/mlish/alex.mlish +++ b/tapl/tests/mlish/alex.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") ;; the following function def produces error: diff --git a/tapl/tests/mlish/ary.mlish b/tapl/tests/mlish/ary.mlish index 16280c2..bc31d71 100644 --- a/tapl/tests/mlish/ary.mlish +++ b/tapl/tests/mlish/ary.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") ;; test vectors and for loops diff --git a/tapl/tests/mlish/chameneos.mlish b/tapl/tests/mlish/chameneos.mlish index 94a84df..91dc20c 100644 --- a/tapl/tests/mlish/chameneos.mlish +++ b/tapl/tests/mlish/chameneos.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define-type Color Red Yellow Blue) @@ -15,7 +15,7 @@ (define-type-alias ResultChan (Channel Result)) (typecheck-fail (channel-put (make-channel {Bool}) 1) - #:with-msg "Cannot send Int value on Bool channel") + #:with-msg "channel-put: type mismatch: expected Bool, given Int\n *expression: 1") (define (change [c1 : Color] [c2 : Color] -> Color) (match c1 with diff --git a/tapl/tests/mlish/fannkuch.mlish b/tapl/tests/mlish/fannkuch.mlish index 27ec3ea..1dd420f 100644 --- a/tapl/tests/mlish/fannkuch.mlish +++ b/tapl/tests/mlish/fannkuch.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define (fannkuch [n : Int] -> Int) diff --git a/tapl/tests/mlish/fasta.mlish b/tapl/tests/mlish/fasta.mlish index fe754be..e25b424 100644 --- a/tapl/tests/mlish/fasta.mlish +++ b/tapl/tests/mlish/fasta.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define +alu+ diff --git a/tapl/tests/mlish/fibo.mlish b/tapl/tests/mlish/fibo.mlish index 7857ce2..2c21d83 100644 --- a/tapl/tests/mlish/fibo.mlish +++ b/tapl/tests/mlish/fibo.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define (fib [n : Int] -> Int) diff --git a/tapl/tests/mlish/find.mlish b/tapl/tests/mlish/find.mlish index df8b335..802bb45 100644 --- a/tapl/tests/mlish/find.mlish +++ b/tapl/tests/mlish/find.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define-type (List X) diff --git a/tapl/tests/mlish/hash.mlish b/tapl/tests/mlish/hash.mlish index 87e2d3e..fb230f4 100644 --- a/tapl/tests/mlish/hash.mlish +++ b/tapl/tests/mlish/hash.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define (main [argv : (Vector String)] -> Int) diff --git a/tapl/tests/mlish/inst.mlish b/tapl/tests/mlish/inst.mlish index 8a9605b..b44e049 100644 --- a/tapl/tests/mlish/inst.mlish +++ b/tapl/tests/mlish/inst.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") ;; tests for instantiation of polymorphic functions and constructors diff --git a/tapl/tests/mlish/knuc.mlish b/tapl/tests/mlish/knuc.mlish index a334274..6d1c3cd 100644 --- a/tapl/tests/mlish/knuc.mlish +++ b/tapl/tests/mlish/knuc.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (require-typed mk-fasta #:from "fasta.mlish") diff --git a/tapl/tests/mlish/matrix.mlish b/tapl/tests/mlish/matrix.mlish index 8bd6871..5c50bb5 100644 --- a/tapl/tests/mlish/matrix.mlish +++ b/tapl/tests/mlish/matrix.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define-type-alias Matrix (Vector (Vector Int))) diff --git a/tapl/tests/mlish/nbody.mlish b/tapl/tests/mlish/nbody.mlish index d5dcdc9..3a8cca1 100644 --- a/tapl/tests/mlish/nbody.mlish +++ b/tapl/tests/mlish/nbody.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define +pi+ 3.141592653589793) diff --git a/tapl/tests/mlish/result.mlish b/tapl/tests/mlish/result.mlish index 109f5aa..909c8ef 100644 --- a/tapl/tests/mlish/result.mlish +++ b/tapl/tests/mlish/result.mlish @@ -1,5 +1,5 @@ -#lang s-exp "../../mlish.rkt" -(require "../rackunit-typechecking.rkt" "../../mlish-do.rkt") +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" +(require "../rackunit-typechecking.rkt" "../../typed-lang-builder/mlish-do.rkt") (define-type (Result A B) (Ok A) @@ -82,18 +82,15 @@ (let ([do-ok (inst ok Unit String)] [do-error (inst error String Unit)]) (do result-bind - [tree1+str : (× (Tree Int) (List Char)) - <- (read-tree (tail str))] + [tree1+str <- (read-tree (tail str))] [(cond [(equal? (head (proj tree1+str 1)) #\space) (do-ok (void))] [else (do-error "expected a space")])] - [int+str : (× Int (List Char)) - <- (read-int (tail (proj tree1+str 1)) nil)] + [int+str <- (read-int (tail (proj tree1+str 1)) nil)] [(cond [(equal? (head (proj int+str 1)) #\space) (do-ok (void))] [else (do-error "expected a space")])] - [tree2+str : (× (Tree Int) (List Char)) - <- (read-tree (tail (proj int+str 1)))] + [tree2+str <- (read-tree (tail (proj int+str 1)))] [(cond [(equal? (head (proj tree2+str 1)) #\) ) (do-ok (void))] [else (do-error "expected a `)`")])] @@ -104,8 +101,7 @@ (tail (proj tree2+str 1))))))] [(digit? (head str)) (do result-bind - [int+str : (× Int (List Char)) - <- (read-int str nil)] + [int+str <- (read-int str nil)] (ok (tup (Leaf (proj int+str 0)) (proj int+str 1))))] diff --git a/tapl/tests/mlish/term.mlish b/tapl/tests/mlish/term.mlish index 7c86e3d..fa128f8 100644 --- a/tapl/tests/mlish/term.mlish +++ b/tapl/tests/mlish/term.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") ;; from chap 6 of RW OCaml diff --git a/tapl/tests/mlish/trees-tests.mlish b/tapl/tests/mlish/trees-tests.mlish index b369e49..185a970 100644 --- a/tapl/tests/mlish/trees-tests.mlish +++ b/tapl/tests/mlish/trees-tests.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (require "trees.mlish") diff --git a/tapl/tests/mlish/trees.mlish b/tapl/tests/mlish/trees.mlish index 893dee0..9fbba4c 100644 --- a/tapl/tests/mlish/trees.mlish +++ b/tapl/tests/mlish/trees.mlish @@ -1,4 +1,4 @@ -#lang s-exp "../../mlish.rkt" +#lang s-exp "../../typed-lang-builder/mlish-core.rkt" (require "../rackunit-typechecking.rkt") (define-type (Tree X) diff --git a/tapl/typed-lang-builder/mlish-core.rkt b/tapl/typed-lang-builder/mlish-core.rkt index 8fc67ed..e6efd6c 100644 --- a/tapl/typed-lang-builder/mlish-core.rkt +++ b/tapl/typed-lang-builder/mlish-core.rkt @@ -1200,9 +1200,9 @@ [() ([name : (→ ty_e ... ty.norm) ≫ name-] [x : ty_e ≫ x-] ...) ⊢ [[b ≫ b-] ⇒ : _] ... [[body ≫ body-] ⇐ : ty.norm]] -------- - [⊢ [[_ ≫ (letrec- ([name- (λ- xs- b- ... body-)]) + [⊢ [[_ ≫ (letrec- ([name- (λ- (x- ...) b- ... body-)]) (name- e- ...))] - ⇒ : ty_body]]] + ⇒ : ty.norm]]] [(let ([x:id e] ...) body ...) ▶ -------- [_ ≻ (ext-stlc:let ([x e] ...) (begin body ...))]]) @@ -1288,7 +1288,7 @@ (define-typed-syntax write-string [(write-string str out) ▶ -------- - [_ ≻ (write-string str out (ext-stlc:#%datum . 0) (string-length/tc str))]] + [_ ≻ (write-string str out (ext-stlc:#%datum . 0) (string-length str))]] [(write-string str out start end) ▶ [⊢ [[str ≫ str-] ⇐ : String]] [⊢ [[out ≫ out-] ⇐ : String-Port]] diff --git a/tapl/typed-lang-builder/mlish-do.rkt b/tapl/typed-lang-builder/mlish-do.rkt new file mode 100644 index 0000000..994dab7 --- /dev/null +++ b/tapl/typed-lang-builder/mlish-do.rkt @@ -0,0 +1,31 @@ +#lang racket/base + +(provide do) + +(require (only-in "mlish-core.rkt" #%app λ Unit) + (for-syntax racket/base + syntax/parse)) + +(define-syntax do + (syntax-parser + #:datum-literals (<- :) + [(do bind:id body:expr) + #'body] + [(do bind:id + [x1:id <- m1:expr] + rst ... + body:expr) + #'(bind + m1 + (λ (x1) + (do bind rst ... body)))] + [(do bind:id + [m1:expr] + rst ... + body:expr) + #'(bind + m1 + (λ (dummy) + (do bind rst ... body)))] + )) +