Initial revision of low-level representation and compiler design.
This commit is contained in:
parent
0867f66767
commit
d8d11f2da2
|
|
@ -0,0 +1,201 @@
|
||||||
|
top:
|
||||||
|
00xxxxxx out in in: expression
|
||||||
|
01xxxxxx in in in: statement
|
||||||
|
1xxxxxxx out in in: conditional
|
||||||
|
expression: up to 64, 1 out, 2 in
|
||||||
|
00000000 out sub in: unary-expr
|
||||||
|
00000001 out sub in: unary-float-expr
|
||||||
|
00xxxxxx out in in: binary-expr, x > 1
|
||||||
|
unary-expr: up to 255, 1 out, 1 in
|
||||||
|
(set! out in)
|
||||||
|
(set! out (car in))
|
||||||
|
(set! out (cdr in))
|
||||||
|
(set! out (unbox in))
|
||||||
|
(set! out (not in)) ; if in == #f then #t else #f
|
||||||
|
(set! out (nil? in)) ; value => bool
|
||||||
|
(set! out (pair? in)) ; value => bool
|
||||||
|
(set! out (box? in)) ; value => bool
|
||||||
|
(set! out (vector? in)) ; value => bool
|
||||||
|
(set! out (byte-string? in)) ; value => bool
|
||||||
|
(set! out (struct? in)) ; value => bool
|
||||||
|
(set! out (fixnum? in)) ; value => bool
|
||||||
|
(set! out (float? in)) ; value => bool
|
||||||
|
(set! out (make-box in)) ; value => box
|
||||||
|
(set! out (make-struct in)) ; metastruct => struct
|
||||||
|
(set! out (make-float in)) ; fixnum => float
|
||||||
|
(set! out (lambda in)) ; template-or-lambda => lambda
|
||||||
|
(set! out (fix- in)) ; two's complement / arithmetic negation
|
||||||
|
(set! out (bit-not in)) ; one's complement / bitwise negation
|
||||||
|
unary-float-expr: up to 255, 1 out, 1 in
|
||||||
|
(set! out (float- in))
|
||||||
|
|
||||||
|
; ISO C
|
||||||
|
(set! out (acos in))
|
||||||
|
(set! out (asin in))
|
||||||
|
(set! out (atan in))
|
||||||
|
(set! out (cos in))
|
||||||
|
(set! out (sin in))
|
||||||
|
(set! out (tan in))
|
||||||
|
(set! out (cosh in))
|
||||||
|
(set! out (sinh in))
|
||||||
|
(set! out (tanh in))
|
||||||
|
(set! out (exp in))
|
||||||
|
(set! out (frexp in)) ; float => (float . fixnum)
|
||||||
|
(set! out (log in)) ; base e
|
||||||
|
(set! out (log10 in))
|
||||||
|
(set! out (modf in)) ; float => (float . float)
|
||||||
|
(set! out (sqrt in))
|
||||||
|
(set! out (ceil in))
|
||||||
|
(set! out (fabs in))
|
||||||
|
(set! out (floor in))
|
||||||
|
|
||||||
|
; SVID & X/Open
|
||||||
|
(set! out (erf in))
|
||||||
|
(set! out (erfc in))
|
||||||
|
;(set! out (gamma in)) ; obsolete
|
||||||
|
(set! out (j0 in))
|
||||||
|
(set! out (j1 in))
|
||||||
|
(set! out (lgamma in)) ; float => (float . fixnum), actually lgamma_r
|
||||||
|
(set! out (y0 in))
|
||||||
|
(set! out (y1 in))
|
||||||
|
|
||||||
|
; SVID & XPG 4.2/5
|
||||||
|
(set! out (asinh in))
|
||||||
|
(set! out (acosh in))
|
||||||
|
(set! out (atanh in))
|
||||||
|
(set! out (cbrt in))
|
||||||
|
(set! out (logb in))
|
||||||
|
|
||||||
|
; XPG 4.2/5
|
||||||
|
(set! out (expm1 in))
|
||||||
|
(set! out (ilogb in))
|
||||||
|
(set! out (log1p in))
|
||||||
|
;(set! out (rint in)) ; implies changing rounding mode; use floor or ceil
|
||||||
|
binary-expr: up to 64, 1 out, 2 in
|
||||||
|
(set! out (cons in1 in2)) ; car cdr
|
||||||
|
(set! out (make-vector in1 in2)) ; nelem iv, nelem >= 0
|
||||||
|
(set! out (make-byte-string in1 in2)) ; nbytes iv, nbytes >= 0
|
||||||
|
(set! out (vector-ref in1 in2)) ; vector n, 0 <= n < nelem
|
||||||
|
(set! out (byte-string-ref in1 in2)) ; string n, 0 <= n < nbytes
|
||||||
|
(set! out (struct-ref in1 in2)) ; struct n, 0 <= n < nslots
|
||||||
|
(set! out (eq? in1 in2)) ; any values; superset of (fix= in2 in1)
|
||||||
|
(set! out (fix+ in1 in2))
|
||||||
|
(set! out (fix- in1 in2))
|
||||||
|
(set! out (fix* in1 in2))
|
||||||
|
(set! out (fix/ in1 in2))
|
||||||
|
(set! out (fix% in1 in2))
|
||||||
|
(set! out (fix< in1 in2)) ; == (fix> in2 in1)
|
||||||
|
(set! out (fix>= in1 in2)) ; == (fix<= in2 in1)
|
||||||
|
(set! out (bit-and in1 in2))
|
||||||
|
(set! out (bit-or in1 in2))
|
||||||
|
(set! out (bit-xor in1 in2))
|
||||||
|
(set! out (fix<< in1 in2)) ; arithmetic left-shift (2*x) w/ overflow into sign
|
||||||
|
(set! out (fix>> in1 in2)) ; arithmetic right-shift (x/2)
|
||||||
|
(set! out (fix>>> in1 in2)) ; logical right-shift; sign becomes zero (+)
|
||||||
|
(set! out (float+ in1 in2))
|
||||||
|
(set! out (float- in1 in2))
|
||||||
|
(set! out (float* in1 in2))
|
||||||
|
(set! out (float/ in1 in2))
|
||||||
|
(set! out (float< in1 in2)) ; == (float> in2 in1)
|
||||||
|
(set! out (float>= in1 in2)) ; == (float<= in2 in1)
|
||||||
|
(set! out (atan2 in1 in2)) ; float float
|
||||||
|
(set! out (pow in1 in2)) ; float float
|
||||||
|
(set! out (ldexp in1 in2)) ; float fixnum
|
||||||
|
(set! out (fmod in1 in2)) ; float float
|
||||||
|
(set! out (hypot in1 in2)) ; float float
|
||||||
|
(set! out (jn in1 in2)) ; fixnum float
|
||||||
|
(set! out (yn in1 in2)) ; fixnum float
|
||||||
|
(set! out (nextafter in1 in2)) ; float float
|
||||||
|
(set! out (remainder in1 in2)) ; float float
|
||||||
|
(set! out (scalb in1 in2)) ; float float
|
||||||
|
conditional: 1AAAAAAA; 1 out, 2 in + fA
|
||||||
|
(set! out (if fA in1 in2)) ; in2 if fA == #f, in1 otherwise
|
||||||
|
statement: up to 64, 3 in
|
||||||
|
(set-box! in in) ; box value
|
||||||
|
(set-car! in in) ; pair value
|
||||||
|
(set-cdr! in in) ; pair value
|
||||||
|
(vector-set! in in in) ; vector n value, 0 <= n < nelem
|
||||||
|
(byte-string-set! in in in) ; string n value, 0 <= n < nbytes
|
||||||
|
(struct-set! in in in) ; struct n value, 1 <= n < nslots
|
||||||
|
|
||||||
|
in:
|
||||||
|
nil (00000000) [g0, always NIL]
|
||||||
|
gN (00NNNNNN) [global, N < 64]
|
||||||
|
iN (01NNNNNN) [instance, N < 64]
|
||||||
|
fN (1NNNNNNN) [frame, N < 120]
|
||||||
|
-- (11111NNN) [reserved, N < 5]
|
||||||
|
argv (11111101) [argument list]
|
||||||
|
ctx (11111110) [dynamic context]
|
||||||
|
k (11111111) [continuation]
|
||||||
|
|
||||||
|
out:
|
||||||
|
fN (1NNNNNNN) [0 <= N < 120]
|
||||||
|
|
||||||
|
lambda:[
|
||||||
|
global: vector of immutable values (g1..gN); shared between instances (lambdas)
|
||||||
|
instance: vector of immutable values (i0..iN); shared between frames (calls)
|
||||||
|
frame: number of frame variables; initially NIL
|
||||||
|
code: byte-string containing sequence of 4-byte instruction words
|
||||||
|
tail-call: in-ref of lambda to tail-call
|
||||||
|
arguments: in-ref of argument list to pass to tail-call
|
||||||
|
context: in-ref of dynamic context to pass to tail-call
|
||||||
|
continuation: in-ref of continuation to pass to tail-call
|
||||||
|
]
|
||||||
|
|
||||||
|
template:[
|
||||||
|
global: linked
|
||||||
|
instance: byte-string of in-refs. to parent instance/frame slots
|
||||||
|
frame: copied verbatim
|
||||||
|
code: linked
|
||||||
|
tail-call: copied verbatim
|
||||||
|
arguments: copied verbatim
|
||||||
|
context: copied verbatim
|
||||||
|
continuation: copied verbatim
|
||||||
|
]
|
||||||
|
|
||||||
|
Protocol:
|
||||||
|
|
||||||
|
Normal function calls (return to caller, or caller's continuation if tail-call):
|
||||||
|
Call: Tail-call function with valid 'k' and original 'ctx'.
|
||||||
|
Return: Tail-call 'k' with 'nil' continuation and context (ignored).
|
||||||
|
|
||||||
|
Coroutines (cooperating, interleaved tail-call chains in CPS):
|
||||||
|
Call: Tail-call function with valid 'k' and original 'ctx'.
|
||||||
|
Return: Tail-call 'k' with valid 'k' and original 'ctx'.
|
||||||
|
|
||||||
|
call-with-current-continuation:
|
||||||
|
Look up abort handler by prompt tag in incoming 'ctx'.
|
||||||
|
call provided lambda with lambda parameter as follows:
|
||||||
|
Tail-call abort handler with same parameters and 'k' & 'ctx' from call/cc.
|
||||||
|
|
||||||
|
call-with-composable-continuation:
|
||||||
|
(define (call-with-composable-continuation proc [prompt-tag (current-prompt-tag)])
|
||||||
|
(let [(meta-continuation (prompt-tag-meta-continuation prompt-tag))]
|
||||||
|
(call-with-current-continuation
|
||||||
|
(lambda (k)
|
||||||
|
(let [(result (let [(var (lambda values
|
||||||
|
(call-with-continuation-prompt
|
||||||
|
(lambda () (apply k values))
|
||||||
|
prompt-tag)))]
|
||||||
|
(proc var)))]
|
||||||
|
((meta-continuation) result))))]))
|
||||||
|
|
||||||
|
call-with-continuation-prompt:
|
||||||
|
(define (call-with-continuation-prompt body-thunk
|
||||||
|
[prompt-tag (current-prompt-tag)]
|
||||||
|
[abort-proc (lambda (fn . args)
|
||||||
|
(apply fn args))])
|
||||||
|
(let [(meta-continuation (prompt-tag-meta-continuation prompt-tag))
|
||||||
|
(abort-handler (prompt-tag-abort-handler prompt-tag))]
|
||||||
|
(call-with-current-continuation
|
||||||
|
(lambda (k)
|
||||||
|
(parameterize [(meta-continuation k)
|
||||||
|
(abort-handler abort-proc)]
|
||||||
|
(let [(result (body-thunk))]
|
||||||
|
((meta-continuation) result))))))]))
|
||||||
|
|
||||||
|
parameterize:
|
||||||
|
Call thunk with 'k' and updated context.
|
||||||
|
New context includes (parameter => value) association.
|
||||||
|
|
||||||
|
# vim:set sw=2 expandtab tw=0:
|
||||||
|
|
@ -0,0 +1,226 @@
|
||||||
|
; Function of multiple moderately-complex arguments:
|
||||||
|
(define (g x y z) ...)
|
||||||
|
(lambda (x f y h z) (g x (f y) (h z)))
|
||||||
|
|
||||||
|
; Same thing in functional continuation-passing form:
|
||||||
|
(define (g x y z) ...)
|
||||||
|
(lambda (k x f y h z)
|
||||||
|
(let [(g1 (lambda (_ fy)
|
||||||
|
(let [(g2 (lambda (_ hz)
|
||||||
|
(g k x fy hz)))]
|
||||||
|
(h g2 z))]
|
||||||
|
(f g1 y)))
|
||||||
|
|
||||||
|
; Internal form:
|
||||||
|
#S(lambda
|
||||||
|
; globals
|
||||||
|
#(
|
||||||
|
#S(template ; g1
|
||||||
|
; globals
|
||||||
|
#(
|
||||||
|
#S(template ; g1
|
||||||
|
#(#S(lambda ...)) ; globals (g1=g)
|
||||||
|
#B(i0 i1 f0) ; instance vars (i0-i2)
|
||||||
|
1 ; frame vars (f0)
|
||||||
|
#B( ; code
|
||||||
|
(set! f0 (car argv))
|
||||||
|
(set! f0 (cons f0 nil))
|
||||||
|
(set! f0 (cons i2 f0))
|
||||||
|
(set! f0 (cons i1 f0)) ; (list x fy hz)
|
||||||
|
)
|
||||||
|
g1 ; tail-call
|
||||||
|
f0 ; arguments
|
||||||
|
ctx ; dynamic context
|
||||||
|
i0 ; continuation
|
||||||
|
)
|
||||||
|
)
|
||||||
|
#(k f0 f3 f4) ; instance vars (i0-i3)
|
||||||
|
3 ; frame vars (f0-f2)
|
||||||
|
#B( ; code
|
||||||
|
(set! f0 (car argv))
|
||||||
|
(set! f1 (cons i3 nil)) ; (list z)
|
||||||
|
(set! f2 (lambda g1))
|
||||||
|
)
|
||||||
|
i2 ; tail-call
|
||||||
|
f1 ; arguments
|
||||||
|
ctx ; dynamic context
|
||||||
|
f2 ; continuation
|
||||||
|
)
|
||||||
|
)
|
||||||
|
#() ; instance vars
|
||||||
|
7 ; frame vars (f0-f6)
|
||||||
|
#B( ; code
|
||||||
|
(set! f0 (car argv)) ; x
|
||||||
|
(set! f5 (cdr argv))
|
||||||
|
(set! f1 (car f5)) ; f
|
||||||
|
(set! f5 (cdr f5))
|
||||||
|
(set! f2 (car f5)) ; y
|
||||||
|
(set! f5 (cdr f5))
|
||||||
|
(set! f3 (car f5)) ; h
|
||||||
|
(set! f5 (cdr f5))
|
||||||
|
(set! f4 (car f5)) ; z
|
||||||
|
(set! f5 (cons f2 nil)) ; (list y)
|
||||||
|
(set! f6 (lambda g1))
|
||||||
|
)
|
||||||
|
f1 ; tail-call
|
||||||
|
f5 ; arguments
|
||||||
|
ctx ; dynamic context
|
||||||
|
f6 ; continuation
|
||||||
|
)
|
||||||
|
|
||||||
|
=================================================
|
||||||
|
|
||||||
|
; Function w/ conditional behavior
|
||||||
|
(let [(add1 (lambda (x) (+ 1 x)))]
|
||||||
|
(lambda (x y)
|
||||||
|
(if x
|
||||||
|
(add1 x)
|
||||||
|
y))
|
||||||
|
|
||||||
|
; CPS
|
||||||
|
(let [(add1 (lambda (k x) (k (+ 1 x))))]
|
||||||
|
(lambda (k x y)
|
||||||
|
(let [(f0 (if' x
|
||||||
|
(lambda (k') (add1 k' x))
|
||||||
|
(lambda (k') (k' y))))]
|
||||||
|
(f0 k))))
|
||||||
|
|
||||||
|
; Internal form
|
||||||
|
#S(lambda
|
||||||
|
#(
|
||||||
|
#S(template ; g1
|
||||||
|
#(
|
||||||
|
#S(lambda ; g1 = add1
|
||||||
|
#(1)
|
||||||
|
#()
|
||||||
|
1
|
||||||
|
#B(
|
||||||
|
(set! f0 (car argv))
|
||||||
|
(set! f0 (fix+ f0 g1))
|
||||||
|
(set! f0 (cons f0 nil))
|
||||||
|
)
|
||||||
|
k
|
||||||
|
f0
|
||||||
|
ctx
|
||||||
|
nil
|
||||||
|
)
|
||||||
|
)
|
||||||
|
#B(f0)
|
||||||
|
1 ; f0
|
||||||
|
#B(
|
||||||
|
(set! f0 (cons i0 nil))
|
||||||
|
)
|
||||||
|
g1
|
||||||
|
f0
|
||||||
|
ctx
|
||||||
|
k
|
||||||
|
)
|
||||||
|
#S(template ; g2
|
||||||
|
#()
|
||||||
|
#B(f0)
|
||||||
|
1 ; f0
|
||||||
|
#B(
|
||||||
|
(set! f0 (cons i0 nil))
|
||||||
|
)
|
||||||
|
k
|
||||||
|
f0
|
||||||
|
ctx
|
||||||
|
nil
|
||||||
|
)
|
||||||
|
)
|
||||||
|
#()
|
||||||
|
3 ; f0-f2
|
||||||
|
#B(
|
||||||
|
(set! f0 (car argv))
|
||||||
|
(set! f1 (cdr argv))
|
||||||
|
(set! f1 (car f1))
|
||||||
|
(set! f2 (if f0 g1 g2))
|
||||||
|
(set! f2 (lambda f2))
|
||||||
|
)
|
||||||
|
f2
|
||||||
|
nil
|
||||||
|
ctx
|
||||||
|
k
|
||||||
|
)
|
||||||
|
|
||||||
|
=================================================
|
||||||
|
|
||||||
|
; Recursive function
|
||||||
|
(define fact
|
||||||
|
(lambda (n)
|
||||||
|
(if (< n 1)
|
||||||
|
1
|
||||||
|
(* n (fact (- n 1))))))
|
||||||
|
|
||||||
|
; CPS
|
||||||
|
(letrec [(fact (lambda (k n)
|
||||||
|
((if' (< n 1)
|
||||||
|
(lambda (k') (k' 1))
|
||||||
|
(lambda (k')
|
||||||
|
(let (k'' (lambda (_ m)
|
||||||
|
(k' (* n m))))
|
||||||
|
(fact k'' (- n 1)))))
|
||||||
|
k)))])
|
||||||
|
|
||||||
|
; Internal
|
||||||
|
#0=#S(lambda
|
||||||
|
#(
|
||||||
|
#S(lambda ; g1 = (lambda (k) (k 1))
|
||||||
|
#(1) ; g1 = 1
|
||||||
|
#() ; instance
|
||||||
|
1 ; frame (f0)
|
||||||
|
#B(
|
||||||
|
(set! f0 (cons g1 nil))
|
||||||
|
)
|
||||||
|
k ; tail-call
|
||||||
|
f0 ; arguments
|
||||||
|
ctx ; dynamic context
|
||||||
|
nil ; continuation
|
||||||
|
)
|
||||||
|
#S(template ; g2 = (lambda (k) ...)
|
||||||
|
#(
|
||||||
|
#=0 ; g1 = fact
|
||||||
|
#S(template ; g2 = (lambda (_ m) (k (* n m)))
|
||||||
|
#() ; globals
|
||||||
|
#B(i0 ctx k) ; instance (i0=n, i1=ctx, i2=k)
|
||||||
|
1 ; frame (f0)
|
||||||
|
#B(
|
||||||
|
(set! f0 (car argv))
|
||||||
|
(set! f0 (fix* i0 f0))
|
||||||
|
(set! f0 (cons f0 nil))
|
||||||
|
)
|
||||||
|
i2
|
||||||
|
f0
|
||||||
|
i1
|
||||||
|
nil
|
||||||
|
)
|
||||||
|
1 ; g3 = 1
|
||||||
|
)
|
||||||
|
#B(f0) ; instance (i0 = parent->f0 = n)
|
||||||
|
1 ; frame (f0)
|
||||||
|
#B(
|
||||||
|
(set! f0 (fix- i0 g3))
|
||||||
|
(set! f0 (cons f0 nil))
|
||||||
|
)
|
||||||
|
g1
|
||||||
|
f0
|
||||||
|
ctx
|
||||||
|
g2
|
||||||
|
)
|
||||||
|
1 ; g3 = 1
|
||||||
|
)
|
||||||
|
#() ; instance
|
||||||
|
2 ; frame (f0-f1)
|
||||||
|
#B(
|
||||||
|
(set! f0 (car argv))
|
||||||
|
(set! f1 (fix< f0 g3))
|
||||||
|
(set! f1 (if f1 g1 g2))
|
||||||
|
(set! f1 (lambda f1))
|
||||||
|
)
|
||||||
|
f1
|
||||||
|
nil
|
||||||
|
ctx
|
||||||
|
k
|
||||||
|
)
|
||||||
|
|
||||||
|
# vim:set sw=2 expandtab:
|
||||||
Loading…
Reference in New Issue