Skip to content

Commit 874bdb0

Browse files
dvanhorndvanhorn
committed
Start of Knock.
1 parent ac318fc commit 874bdb0

4 files changed

Lines changed: 204 additions & 38 deletions

File tree

‎www/notes/knock.scrbl‎

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
#lang scribble/manual
2+
3+
@(require (for-label (except-in racket ...)))
4+
@(require redex/pict
5+
racket/runtime-path
6+
scribble/examples
7+
"hustle/semantics.rkt"
8+
"utils.rkt"
9+
"ev.rkt"
10+
"../utils.rkt")
11+
12+
@(define codeblock-include (make-codeblock-include #'h))
13+
14+
@(for-each (λ (f) (ev `(require (file ,(path->string (build-path notes "knock" f))))))
15+
'("interp.rkt" "compile.rkt" "asm/interp.rkt" "asm/printer.rkt"))
16+
17+
@title[#:tag "Knock"]{Knock: first-class function (pointers)}
18+
19+
@table-of-contents[]
20+
21+
@section[#:tag-prefix "knock"]{First-class function (pointers)}
22+
23+
With Iniquity and Jig, we have introduced functions and function
24+
calls, but functions are second-class language mechanisms: functions
25+
are not values. They cannot be computed. They cannot be stored in a
26+
list or box. They cannot be passed as arguments are returned as
27+
results of other functions.
28+
29+
This is too bad since so many program designs depend on the idea of
30+
computation-as-a-value at the heart of functional and object-oriented
31+
programming.
32+
33+
Let's now remedy this problem by making functions first-class values
34+
in our language. We'll call it @bold{Knock}.
35+
36+
37+
We add to the syntax two new forms, one for reference functions and
38+
one for calling a function where the function position is an arbitrary
39+
expression (that should evaluate to a function):
40+
41+
@verbatim|{
42+
;; type Expr =
43+
;; | ....
44+
;; | `(fun ,Variable)
45+
;; | `(call ,Expr ,@(Listof Expr))
46+
}|
47+
48+
These new syntactic forms are temporary forms that don't correspond
49+
anything in Racket but make it a bit easier to present how first-class
50+
functions work. The @racket[(fun _f)] form is a reference to a
51+
function @racket[_f], which is defined in the program. The
52+
@racket[(call _e0 _es ...)] form is a function call where the function
53+
position, @racket[_e0] is an arbitrary expression that should produce
54+
a function value.
55+
56+
We will end up eliminating them in future versions of the compiler;
57+
they are simply a crutch for now.
58+
59+
60+
@section[#:tag-prefix "knock"]{A Compiler with Function pointers}
61+
62+
@codeblock-include["knock/compile.rkt"]
63+
64+
@ex[
65+
(asm-interp
66+
(compile '(begin (define (f x)
67+
(if (zero? x)
68+
0
69+
(add1 (call (fun f) (sub1 x)))))
70+
(call (fun f) 10))))
71+
]
72+
73+
@ex[
74+
(asm-interp
75+
(compile '(begin (define (f x) (fun h))
76+
(define (h y) y)
77+
(call (call (fun f) 5) 9))))
78+
79+
]

‎www/notes/knock/asm/printer.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@
3131
[`(neg ,a1)
3232
(string-append "\tneg " (arg->string a1) "\n")]
3333
[`(call ,l)
34-
(string-append "\tcall " (label->string l) "\n")]
34+
(string-append "\tcall " (arg->string l) "\n")]
3535
[`(push ,r)
3636
(string-append "\tpush " (reg->string r) "\n")]
3737
[l (string-append (label->string l) ":\n")]))

‎www/notes/knock/compile.rkt‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -10,19 +10,17 @@
1010
(define type-box #b001)
1111
(define type-pair #b010)
1212
(define type-string #b011)
13-
(define type-proc #b100)
13+
(define type-proc #b100) ;; <-- NEW: procedure value: points to function label in memory
1414

1515
(define imm-shift (+ 2 result-shift))
1616
(define imm-type-mask (sub1 (arithmetic-shift 1 imm-shift)))
1717
(define imm-type-int (arithmetic-shift #b00 result-shift))
1818
(define imm-type-bool (arithmetic-shift #b01 result-shift))
1919
(define imm-type-char (arithmetic-shift #b10 result-shift))
2020
(define imm-type-empty (arithmetic-shift #b11 result-shift))
21-
22-
23-
2421
(define imm-val-false imm-type-bool)
25-
(define imm-val-true (bitwise-ior (arithmetic-shift 1 (add1 imm-shift)) imm-type-bool))
22+
(define imm-val-true
23+
(bitwise-ior (arithmetic-shift 1 (add1 imm-shift)) imm-type-bool))
2624

2725
;; Allocate in 64-bit (8-byte) increments, so pointers
2826
;; end in #b000 and we tag with #b001 for boxes, etc.

‎www/notes/knock/interp.rkt‎

Lines changed: 121 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,67 +1,159 @@
11
#lang racket
22
(provide (all-defined-out))
33

4+
5+
;; type Expr =
6+
;; ...
7+
;; | `(λ ,(Listof Variable) ,Expr)
8+
9+
;; type Value =
10+
;; ...
11+
;; | ((Listof Value) -> Answer)
12+
13+
;; Expr REnv -> Answer
14+
(define (interp-env e r)
15+
(match e
16+
[''() '()]
17+
[(? syntactic-value? v) v]
18+
[(list (? prim? p) es ...)
19+
(match (interp-env* es r)
20+
[(list vs ...) (interp-prim p vs)]
21+
[_ 'err])]
22+
[`(if ,e0 ,e1 ,e2)
23+
(match (interp-env e0 r)
24+
['err 'err]
25+
[v
26+
(if v
27+
(interp-env e1 r)
28+
(interp-env e2 r))])]
29+
[(? symbol? x)
30+
(lookup r x)]
31+
[`(let ((,x ,e0)) ,e1)
32+
(match (interp-env e0 r)
33+
['err 'err]
34+
[v
35+
(interp-env e1 (ext r x v))])]
36+
37+
[`(λ (,xs ...) ,e)
38+
39+
(λ (vs) (interp-env e (append (zip xs vs) r)))]
40+
41+
[`(,e . ,es)
42+
(match (interp-env* (cons e es) r)
43+
[(list f vs ...) (f vs)]
44+
[_ 'err])]))
45+
46+
47+
;; (Listof Expr) REnv -> (Listof Value) | 'err
48+
(define (interp-env* es r)
49+
(match es
50+
['() '()]
51+
[(cons e es)
52+
(match (interp-env e r)
53+
['err 'err]
54+
[v (cons v (interp-env* es r))])]))
55+
56+
57+
(define Y '(λ (t) ((λ (f) (t (λ (z) ((f f) z))))
58+
(λ (f) (t (λ (z) ((f f) z)))))))
59+
60+
(define Tri `(,Y
61+
(λ (tri)
62+
(λ (n)
63+
(if (zero? n)
64+
1
65+
(+ n (tri (sub1 n))))))))
66+
467
;; type Prog =
568
;; | `(begin ,@(Listof Defn) ,Expr)
669
;; | Expr
770

871
;; type Defn = `(define (,Variable ,@(Listof Variable)) ,Expr)
972

73+
1074
;; Prog -> Answer
1175
(define (interp p)
1276
(match p
1377
[(list 'begin ds ... e)
14-
(interp-env e '() ds)]
15-
[e (interp-env e '() '())]))
78+
(interp-env e (interp-defns ds))]
79+
[e (interp-env e '())]))
80+
81+
;; (Listof Defn) -> REnv
82+
(define (interp-defns ds)
83+
(map (lambda (d)
84+
(match d
85+
[`(define (,f . ,xs) ,e)
86+
(list f (interp-defn d ds))]))
87+
ds))
88+
89+
;; Defn (Listof Defn) -> ((Listof Value) -> Answer)
90+
(define (interp-defn d ds)
91+
(match d
92+
[`(define (,f . ,xs) ,e)
93+
(lambda (vs)
94+
(if (= (length vs) (length xs))
95+
(interp-env e (append (interp-defns ds) (zip xs vs)))
96+
'err))]))
1697

17-
;; Expr REnv (Listof Defn) -> Answer
18-
(define (interp-env e r ds)
98+
99+
100+
;; type Value =
101+
;; ...
102+
;; | `(closure ,(Listof Variable) ,Expr ,Env)
103+
104+
(define (interp-closure e)
105+
(interp-env-closure e '()))
106+
107+
;; Expr REnv -> Answer
108+
(define (interp-env-closure e r)
19109
(match e
20110
[''() '()]
21-
[(? value? v) v]
111+
[(? syntactic-value? v) v]
22112
[(list (? prim? p) es ...)
23-
(match (interp-env* es r ds)
113+
(match (interp-env-closure* es r)
24114
[(list vs ...) (interp-prim p vs)]
25115
[_ 'err])]
26116
[`(if ,e0 ,e1 ,e2)
27-
(match (interp-env e0 r ds)
117+
(match (interp-env-closure e0 r)
28118
['err 'err]
29119
[v
30120
(if v
31-
(interp-env e1 r ds)
32-
(interp-env e2 r ds))])]
121+
(interp-env-closure e1 r)
122+
(interp-env-closure e2 r))])]
33123
[(? symbol? x)
34124
(lookup r x)]
35125
[`(let ((,x ,e0)) ,e1)
36-
(match (interp-env e0 r ds)
126+
(match (interp-env-closure e0 r)
37127
['err 'err]
38128
[v
39-
(interp-env e1 (ext r x v) ds)])]
129+
(interp-env-closure e1 (ext r x v))])]
130+
131+
[`(λ (,xs ...) ,e)
132+
`(closure ,xs ,e ,r)]
40133

41-
[`(,f . ,es)
42-
(match (interp-env* es r ds)
43-
[(list vs ...)
44-
(match (defns-lookup ds f)
45-
[`(define (,f ,xs ...) ,e)
46-
; check arity matches
47-
(if (= (length xs) (length vs))
48-
(interp-env e (zip xs vs) ds)
49-
'err)])]
134+
[`(,e . ,es)
135+
(match (interp-env-closure* (cons e es) r)
136+
[(list `(closure ,xs ,e ,r) vs ...)
137+
(if (= (length vs) (length xs))
138+
(interp-env-closure e (append (zip xs vs) r))
139+
'err)]
50140
[_ 'err])]))
51141

52-
;; (Listof Defn) Symbol -> Defn
53-
(define (defns-lookup ds f)
54-
(findf (match-lambda [`(define (,g . ,_) ,_) (eq? f g)])
55-
ds))
142+
56143

57144
;; (Listof Expr) REnv -> (Listof Value) | 'err
58-
(define (interp-env* es r ds)
145+
(define (interp-env-closure* es r)
59146
(match es
60147
['() '()]
61148
[(cons e es)
62-
(match (interp-env e r ds)
149+
(match (interp-env-closure e r)
63150
['err 'err]
64-
[v (cons v (interp-env* es r ds))])]))
151+
[v (cons v (interp-env-closure* es r))])]))
152+
153+
154+
155+
156+
65157

66158
;; Any -> Boolean
67159
(define (prim? x)
@@ -70,13 +162,10 @@
70162
box unbox empty? cons car cdr))))
71163

72164
;; Any -> Boolean
73-
(define (value? x)
165+
(define (syntactic-value? x)
74166
(or (integer? x)
75167
(boolean? x)
76-
(null? x)
77-
(and (pair? x)
78-
(value? (car x))
79-
(value? (cdr x)))))
168+
(null? x)))
80169

81170
;; Prim (Listof Value) -> Answer
82171
(define (interp-prim p vs)

0 commit comments

Comments
 (0)