Skip to content

Instantly share code, notes, and snippets.

@lexi-lambda lexi-lambda/adts.rkt
Created Dec 24, 2015

Embed
What would you like to do?
#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
You can’t perform that action at this time.