Skip to content

Instantly share code, notes, and snippets.

@lexi-lambda
Created December 24, 2015 19:50
Show Gist options
  • Star 10 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save lexi-lambda/18cf7a9156f743a1317e to your computer and use it in GitHub Desktop.
Save lexi-lambda/18cf7a9156f743a1317e to your computer and use it in GitHub Desktop.
#lang typed/racket/base
(require (for-syntax racket/base
racket/sequence
racket/syntax
syntax/parse
syntax/stx)
racket/match)
(begin-for-syntax
(define-syntax-class type
#:attributes [name [field-id 1] [param 1]]
(pattern name:id
#:attr [param 1] '()
#:attr [field-id 1] '())
(pattern (name:id param ...+)
#:attr [field-id 1] (generate-temporaries #'(param ...)))))
(define-syntax define-datatype
(syntax-parser
[(_ type-name:type data-constructor:type ...)
(define/with-syntax [data-type ...]
(for/list ([name (in-syntax #'(data-constructor.name ...))])
(if (stx-null? #'(type-name.param ...))
name
#`(#,name type-name.param ...))))
#'(begin
(struct (type-name.param ...) data-constructor.name
([data-constructor.field-id : data-constructor.param] ...)) ...
(define-type type-name (U data-type ...)))]))
(define-datatype (Maybe a)
(Just a)
Nothing)
(: maybe-default (All [a] (Maybe a) a -> a))
(define (maybe-default m v)
(match m
[(Just a) a]
[(Nothing) v]))
(: maybe-then (All [a] (Maybe a) (a -> (Maybe a)) -> (Maybe a)))
(define (maybe-then m f)
(match m
[(Just a) (f a)]
[(Nothing) (Nothing)]))
(define-datatype (Tree a)
Empty
(Leaf a)
(Node (Tree a) (Tree a)))
(define-datatype Expr
(Value Number)
(Add Expr Expr)
(Subtract Expr Expr)
(Multiply Expr Expr)
(Divide Expr Expr))
(: evaluate (Expr -> Number))
(define (evaluate e)
(match e
[(Value x) x ]
[(Add a b) (+ (evaluate a) (evaluate b))]
[(Subtract a b) (- (evaluate a) (evaluate b))]
[(Multiply a b) (* (evaluate a) (evaluate b))]
[(Divide a b) (/ (evaluate a) (evaluate b))]))
(evaluate (Add (Value 1)
(Multiply (Divide (Value 1) (Value 2))
(Value 7))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment