Create a gist now

Instantly share code, notes, and snippets.

Programs by Jay and Matthew at Lambda Lounge Utah, 14 Jan 2014: * "functional.rkt" is from Jay's introduction to functional programming * "web.rkt" and "page.rkt" are from Matthew's explanation of Racket macros & modules
#lang racket
(require rackunit)
;; A singly linked list is either
;; - NULL
;; - pointer to data and a pointer a sll
(struct node (data-ptr next-ptr))
(define n4 (node 4 null))
;; n4->data-ptr
(check-equal? (node-data-ptr n4) 4)
(define n54 (node 5 n4))
;; n54->next-ptr->data-ptr
(check-equal? (node-data-ptr (node-next-ptr n54)) 4)
;; A list is either
;; - null
;; - (cons data list)
(define c4 (cons 4 null))
(define c54 (cons 5 c4))
(check-equal? (car (cdr c54)) 4)
;; c[ad]+r
(check-equal? (cadr c54) 4)
(check-equal? (first (rest c54)) 4)
(check-equal? (second c54) 4)
;; length : list(a) -> num
;; (length l) = 42
(define (length l)
(if (cons? l)
(+ 1 (length (rest l)))
0))
;; f(x) = x + 4
;; f(5) = 5 + 4
(check-equal? (length c54) 2)
(check-equal? (length null) 0)
(check-equal? (length c4) 1)
;; expression problem
;; fun = easy to add functions
;; oo = easy to add kinds
;; all-even? : list num -> bool
(define (all-even? l)
(if (empty? l)
true
(and (even? (first l))
(all-even? (rest l)))))
(check-equal? (all-even? null) true)
(check-equal? (all-even? (list 1 2 3)) false)
(check-equal? (all-even? (list 2 4 6)) true)
;; higher-order function
(check-equal? (all-even? (list 2 4 6))
(all-even? (cons 2 (list 4 6))))
(check-equal? (all-even? (cons 2 (list 4 6)))
(and (even? (first (cons 2 (list 4 6))))
(all-even? (rest (cons 2 (list 4 6))))))
(check-equal? (all-even? (cons 2 (list 4 6)))
(and (even? 2)
(all-even? (list 4 6))))
(check-equal? (all-even?
(cons 2
(cons 4
(cons 6
empty))))
(and (even? 2)
(and (even? 4)
(and (even? 6)
true))))
;; all-even?s job is to...
;; turn empty into true
;; turn (cons a r) into (and (even? a) r)
;; greek name for this: catamorphism
(define (all-even?/awesome l)
(foldr (lambda (a d)
(and (even? a) d))
true
l))
(check-equal? (all-even?/awesome null) true)
(check-equal? (all-even?/awesome (list 1 2 3)) false)
(check-equal? (all-even?/awesome (list 2 4 6)) true)
;; foldr : (A B -> B) B (list A) -> B
;; int f ( int x, int y ) { ... }
;; int int -> int
(define (sum l)
;; + : (A B -> B) : (nat nat -> nat)
;; 0 : B : nat
;; l : (list A) : (list nat)
(foldr + 0 l))
(define arithmetic (list + - * /))
(check-equal? (sum (list 1 2 3 4)) 10)
;; map : (A -> B) (list A) -> (list B)
(define (evenify l)
(map even? l))
(check-equal? (evenify (list 1 2 3 4))
(list false true false true))
;; A bt is either a
(struct bt-leaf () #:transparent)
(struct bt-node (left val right) #:transparent)
;; these are all (bt num)
(define b5 (bt-node (bt-leaf) 5 (bt-leaf)))
(define b6 (bt-node b5 6 (bt-leaf)))
(define bb (bt-node (bt-node (bt-leaf) 3 (bt-leaf))
4
b6))
;; lookup : (bt A) A -> bool
(define (lookup bt v)
(cond
[(bt-leaf? bt)
false]
[else
(cond
[(= v (bt-node-val bt))
true]
[(< v (bt-node-val bt))
(lookup (bt-node-left bt) v)]
[else
(lookup (bt-node-right bt) v)])]))
(check-equal? (lookup bb 5) true)
(check-equal? (lookup bb 2) false)
;; insert : (bt A) A -> (bt A)
(define (insert bt v)
(cond
[(bt-leaf? bt)
(bt-node (bt-leaf) v (bt-leaf))]
[else
(cond
[(= v (bt-node-val bt))
bt]
[(< v (bt-node-val bt))
(bt-node (insert (bt-node-left bt) v)
(bt-node-val bt)
(bt-node-right bt))]
[else
(bt-node
(bt-node-left bt)
(bt-node-val bt)
(insert (bt-node-right bt) v))])]))
;; lg n in time
;; lg n in space
(check-equal? (lookup bb 2) false)
(check-equal? (lookup (insert bb 2) 2) true)
(check-equal? (lookup bb 2) false)
(struct zipper (path focus))
(struct path-tree-left (val right))
(struct path-tree-right (left val))
(define bbz (zipper empty bb))
(define (move-left z)
(match-define (zipper path focus) z)
(match focus
[(bt-leaf)
(error 'move-left "Can't")]
[(bt-node left val right)
(zipper (cons (path-tree-left val right)
path)
left)]))
(define (move-right z)
(match-define (zipper path focus) z)
(match focus
[(bt-leaf)
(error 'move-left "Can't")]
[(bt-node left val right)
(zipper (cons (path-tree-right left val)
path)
right)]))
(define (move-up z)
(match-define (zipper path focus) z)
(match path
[(list)
(error 'move-up "Can't")]
[(cons (path-tree-left val right) old-path)
(zipper old-path (bt-node focus val right))]
[(cons (path-tree-right left val) old-path)
(zipper old-path (bt-node left val focus))]))
(define (replace z v)
(match-define (zipper path focus) z)
(zipper path v))
(zipper-focus
(move-up
(move-up
(replace (move-right (move-left bbz))
(bt-node (bt-leaf) 3.5 (bt-leaf))))))
#lang s-exp "web.rkt"
(div ([style "color: blue"])
(a ([href "http://racket-lang.org"]
[style "font-weight: bold"])
"Hello "
"world")
" bye")
#lang racket
(require web-server/servlet-env
web-server/http/xexpr
(for-syntax syntax/parse))
(provide (except-out (all-from-out racket)
#%module-begin)
(rename-out [module-begin #%module-begin]))
(define-syntax-rule (module-begin expr)
(#%module-begin (page expr)))
(define (show v)
(print v)
(newline)
v)
(define-syntax define-tag
(lambda (stx)
(syntax-parse stx
[(define-tag tag ok-attrib ...)
#'(begin
(define-syntax tag
(lambda (stx)
(syntax-parse stx
[(tag ([attrib s-expr] (... ...)) content-expr (... ...))
(unless (ormap (lambda (a) (member (syntax-e a)
'(ok-attrib ...)))
(syntax-e #'(attrib (... ...))))
(raise-syntax-error #f "bad attribute" stx))
#'(show
`(tag ([attrib ,s-expr] (... ...))
,content-expr (... ...)))])))
(provide tag))])))
(define-tag div style)
(define-tag a href style)
(define (page content)
(serve/servlet
(lambda (req)
(response/xexpr
content))))
(provide page)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment