#lang typed/racket/no-check ;; in this file I translate (most of) the code presented in the ;; given chapter of PLAI from the plai-typed language to the ;; typed/racket/no-check language. ;; in many cases, shriram redefines the same function multiple ;; times; putting all of these definitions in the same file would ;; prevent it from compiling. In these cases, I've commented out ;; the later redefinitions using the s-exp-comment-block #; sequence. ;; in other cases, I've moved test cases downward to allow code to ;; run. ;; also, in order to get them all into one file, I've used DrRacket's ;; explicit `module' feature. You could also take all of these module ;; forms and put each one in its own file. So, for instance, if you ;; take the code in the 'chapter1' module and put in in its own file ;; (with or without the 'module' wrapper, actually) it should run ;; the same way it does here (and without needing the 'require' at ;; the bottom). ;; this module is just a wrapper for the tstruct macro: (module ts typed/racket/no-check ;; this macro defines a "tstruct" form that's just ;; like "struct" but automatically inserts the #:transparent ;; tag. The examples below use this form instead of struct. ;; If you want to cut and paste the code below into your own ;; code, you can either ;; a) copy and paste this macro into your code, or ;; b) change "tstruct" into "struct" and add the "#:transparent" ;; tag to each one. (define-syntax tstruct (syntax-rules () [(_ name fields) (struct name fields #:transparent)])) (provide tstruct)) ;; CHAPTER 1: (module chapter1 typed/racket/no-check (require typed/rackunit (submod ".." ts)) (define-type MisspelledAnimal (U caml yacc)) (tstruct caml ([humps : Real])) (tstruct yacc ([height : Real])) (caml 2) (yacc 1.9) (define ma1 (caml 2)) (define ma2 (yacc 1.9)) (define (good? [ma : MisspelledAnimal]) : Boolean (match ma [(caml humps) (>= humps 2)] [(yacc height) (> height 2.1)])) ;; redefinition 1: #;(define (good? [ma : MisspelledAnimal]) : Boolean (match ma [(caml h) (>= h 2)] [(yacc h) (> h 2.1)])) ;; redefinition 2: #;(define (good? [ma : MisspelledAnimal]) : Boolean (cond [(caml? ma) (>= (caml-humps ma) 2)] [(yacc? ma) (> (yacc-height ma) 2.1)])) (check-equal? (good? ma1) #t) (check-equal? (good? ma2) #f) ) ;; CHAPTER 2: (module chapter2 typed/racket/no-check (require typed/rackunit (submod ".." ts)) (define-type ArithC (U numC plusC multC)) (tstruct numC ([n : Real])) (tstruct plusC ([l : ArithC] [r : ArithC])) (tstruct multC ([l : ArithC] [r : ArithC])) (define (parse [s : Sexp]) : ArithC (cond [(real? s) (numC s)] [(list? s) (case (first s) [(+) (plusC (parse (second s)) (parse (third s)))] [(*) (multC (parse (second s)) (parse (third s)))] [else (error 'parse "invalid list input")])] [else (error 'parse "invalid input")])) (check-equal? (parse '(+ (* 1 2) (+ 2 3))) (plusC (multC (numC 1) (numC 2)) (plusC (numC 2) (numC 3))))) ;; CHAPTER 3: (module chapter3 typed/racket/no-check (require (submod ".." ts)) (define-type ArithC (U numC plusC multC)) (tstruct numC ([n : Real])) (tstruct plusC ([l : ArithC] [r : ArithC])) (tstruct multC ([l : ArithC] [r : ArithC])) #;(define (interp [a : ArithC]) : Real (match a [(numC n) n] [(plusC l r) ...] [(multC l r) ...])) ;; in Typed Racket, this produces type errors...: #;(define (interp [a : ArithC]) : Real (match a [(numC n) n] [(plusC l r) (+ l r)] [(multC l r) (+ l r)])) (define (interp [a : ArithC]) : Real (match a [(numC n) n] [(plusC l r) (+ (interp l) (interp r))] [(multC l r) (* (interp l) (interp r))])) (display 13)) (module chapter4 typed/racket/no-check (require (submod ".." ts)) (define-type ArithC (U NumC PlusC MultC)) (tstruct NumC ([n : Real])) (tstruct PlusC ([l : ArithC] [r : ArithC])) (tstruct MultC ([l : ArithC] [r : ArithC])) (define-type ArithS (U NumS PlusS BMinusS MultS)) (struct NumS ([n : Real])) (struct PlusS ([l : ArithS] [r : ArithS])) (struct BMinusS ([l : ArithS] [r : ArithS])) (struct MultS ([l : ArithS] [r : ArithS])) ;; ::= (define (desugar [as : ArithS]) : ArithC (match as [(NumS n) (NumC n)] [(PlusS l r) (PlusC (desugar l) (desugar r))] [(MultS l r) (MultC (desugar l) (desugar r))] #;())) ;; := #;[(BMinusS l r) (PlusC (desugar l) (MultC (NumC -1) (desugar r)))] ) (module chapter5 typed/racket/no-check ;; SECTION 5.1 (require (submod ".." ts)) (tstruct FunDefC ([name : Symbol] [arg : Symbol] [body : ExprC])) ;; ::= (define-type ExprC (U NumC IdC AppC PlusC MultC)) (tstruct NumC ([n : Real])) ;; ;; (tstruct PlusC ([l : ExprC] [r : ExprC])) (tstruct MultC ([l : ExprC] [r : ExprC])) ;; ::= (tstruct IdC ([s : Symbol])) ;; ::= (tstruct AppC ([fun : Symbol] [arg : ExprC])) (FunDefC 'double 'x (PlusC (IdC 'x) (IdC 'x))) (FunDefC 'quadruple 'x (AppC 'double (AppC 'double (IdC 'x)))) (FunDefC 'const5 '_ (NumC 5)) ;; SECTION 5.2 ;; ::= (define (interp [e : ExprC] [fds : (Listof FunDefC)]) : Real ;; #xfeedface ) ;; ::= #;(match e [(NumC n) n] ; ; [(PlusC l r) (+ (interp l fds) (interp r fds))] [(MultC l r) (* (interp l fds) (interp r fds))]) ;; SECTION 5.3 ;; ::= (define (subst [what : ExprC] [for : Symbol] [in : ExprC]) : ExprC ;; (NumC #xfeedface) ) ;; ::= #;(match in [(NumC n) in] [(IdC s) (cond [(symbol=? s for) what] [else in])] [(AppC f a) (AppC f (subst what for a))] [(PlusC l r) (PlusC (subst what for l) (subst what for r))] [(MultC l r) (MultC (subst what for l) (subst what for r))]) ;; SECTION 5.4 ;; ::= #;[(AppC f a) (define fd (get-fundef f fds)) (subst a (FunDefC-arg fd) (FunDefC-body fd))] ;; ::= #;[(AppC f a) (define fd (get-fundef f fds)) (interp (subst a (FunDefC-arg fd) (FunDefC-body fd)) fds)] ;; ::= #;[(IdC _) (error 'interp "shouldn't get here")] (define (get-fundef [n : Symbol] [fds : (Listof FunDefC)]) : FunDefC (cond [(empty? fds) (error 'get-fundef "reference to undefined function")] [(cons? fds) (cond [(equal? n (FunDefC-name (first fds))) (first fds)] [else (get-fundef n (rest fds))])])) ) (module chapter6 typed/racket/no-check ;; copied from chapter 5: (require (submod ".." ts)) (tstruct FunDefC ([name : Symbol] [arg : Symbol] [body : ExprC])) ;; ::= (define-type ExprC (U NumC IdC AppC PlusC MultC)) (tstruct NumC ([n : Real])) ;; ;; (tstruct PlusC ([l : ExprC] [r : ExprC])) (tstruct MultC ([l : ExprC] [r : ExprC])) ;; ::= (tstruct IdC ([s : Symbol])) ;; ::= (tstruct AppC ([fun : Symbol] [arg : ExprC])) ;; chapter 6 starts here: (tstruct Binding ((name : Symbol) (val : Real))) (define-type Env (Listof Binding)) (define mt-env '()) (define extend-env cons) (define (interp [expr : ExprC] [env : Env] [fds : (Listof FunDefC)]) : Real (match expr [(NumC n) n] ; ; ; )) ;; ooh, chapter 6 is unfinished. 1234) ;; to run a particular chapter's code: (require 'chapter1) (require 'chapter2) (require 'chapter3) (require 'chapter4) (require 'chapter5) (require 'chapter6)