blob: 0f45fc5da41e46e22b7f7f30e33ac024add494c4 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
#lang racket
;; Requires Algebraic Racket https://docs.racket-lang.org/algebraic/index.html
;; When I learned how to program, we kind of had to learn by osmosis.
;; They would show us good code, and bad code, and say
;; "write a fibonacci function which relies on how bad your code is"
;; Generates a syntax object which comutes the nth fibonacci
;; number with fib(n) linter warnings
(define (generate-fib n)
(cond
[(zero? n) (syntax 0)]
[(equal? n 1) (datum->syntax #'lex (quote ((lambda (x) 1) "gregor")))]
[else (datum->syntax #'lex
(quasiquote (+ (unquote (generate-fib (- n 1)))
(unquote (generate-fib (- n 2))))))]))
(eval (generate-fib 0))
(eval (generate-fib 1))
(eval (generate-fib 2))
(eval (generate-fib 3))
(eval (generate-fib 4))
;; Compiles a racket program that computes the fibonacci numbers
;; Reports the number of linter warnings
;; Leaves the compiled fibonacci-n binary, which computes fib(n)
(define (fibonacci n)
(begin
(define outfile (string-append "fibonacci-" (number->string n) ".rkt"))
(define out (open-output-file outfile #:exists 'replace))
(displayln "#lang algebraic/racket/base/linted" out)
(writeln (syntax->datum (generate-fib n)) out)
(close-output-port out)
(define err-out (let ([str-port (open-output-string)])
(parameterize ([current-error-port str-port])
(system (string-append "raco exe " outfile))
)
(get-output-string str-port)))
(delete-file outfile)
(println (/ (length (string-split err-out "\n")) 4))))
(fibonacci 0)
(fibonacci 1)
(fibonacci 2)
(fibonacci 3)
(fibonacci 4)
|