aboutsummaryrefslogtreecommitdiffstats
path: root/lib/csc/linker.csc
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2023-05-01 07:56:42 -0700
committerRose Hogenson <rhogenson@posteo.net>2023-05-01 07:56:42 -0700
commita89d6c82e981fec7d6e4c975e083d2b9e04467ad (patch)
treed5445ceb797473dd45ac006c337d990e5dd6f0d4 /lib/csc/linker.csc
parentFix bugs with recursive macros and empty template. (diff)
downloadchromatopelma-a89d6c82e981fec7d6e4c975e083d2b9e04467ad.tar.zst
Rewrite most of the compiler.
This represents a major step back in terms of functionality, and amount of code. The latter I think constitutes a major win. Next steps are to reimplement syntax-rules, call/cc, and call-with-values.
Diffstat (limited to 'lib/csc/linker.csc')
-rw-r--r--lib/csc/linker.csc119
1 files changed, 0 insertions, 119 deletions
diff --git a/lib/csc/linker.csc b/lib/csc/linker.csc
deleted file mode 100644
index 5e4e678..0000000
--- a/lib/csc/linker.csc
+++ /dev/null
@@ -1,119 +0,0 @@
-(define-library (csc linker)
- (export
- add-to-environment
- compare-globals
- link)
- (import (scheme base)
- (only (csc format)
- sprintf)
- (only (csc hash-map)
- compare-numbers
- hash-bytevector
- insert
- lookup
- make-comparer
- make-map
- map-for-each)
- (only (csc loop)
- loop
- return)
- (only (csc match) match)
- (only (scheme case-lambda)
- case-lambda))
- (begin
- ; A CSC bytecode program is a list of opcodes and labels. An opcode is a
- ; list of an opcode and arguments. Arguments can be any of:
- ; - (local x),
- ; - (global x lib),
- ; - (const x),
- ; - or (label x).
- ; The full list of opcodes can be found in encoding.csc.
-
-
- ; Rewrites each (label x) form into a integer constant.
- (define (translate-labels program label-map)
- (loop for opcode in program
- for op = (car opcode)
- for args = (cdr opcode)
- unless (symbol=? op 'label)
- collect (cons op (loop for arg in args
- collect (match arg
- (('label x)
- (list 'const (lookup label-map x)))
- (_ arg))))))
-
-
- (define (make-label-map offset program)
- (loop for op in program
- for i from offset
- with m = (make-map compare-numbers)
- do (match op
- (('label id)
- (set! m (insert m id i))
- (set! i (- i 1)))) ; Labels will be removed later.
- finally (return m)))
-
-
- (define (add-to-environment environment programs)
- (define next-global-id 0)
- (map-for-each (lambda (k v)
- (when (>= v next-global-id)
- (set! next-global-id (+ 1 v))))
- environment)
- (loop for opcode in (apply append programs)
- do (loop for arg in (cdr opcode)
- do (match arg
- (('global name lib)
- (define id next-global-id)
- (set! next-global-id (+ 1 next-global-id))
- (set! environment (insert environment arg id))))))
- environment)
-
-
- (define compare-globals
- (make-comparer
- (lambda (x)
- (hash-bytevector (string->utf8 (sprintf "{}" x))))
- (lambda (x y)
- (cond
- ((equal? x y) 0)
- ((string<? (sprintf "{}" x) (sprintf "{}" y)) -1)
- (else 1)))))
-
-
- (define (translate-globals program environment)
- (loop for opcode in program
- for op = (car opcode)
- for args = (cdr opcode)
- collect (cons op (loop for arg in args
- collect (match arg
- (('global x lib)
- (list 'const (lookup environment arg)))
- (_ arg))))))
-
-
- (define (num-globals environment)
- (define n 0)
- (map-for-each (lambda (k v)
- (when (<= n v)
- (set! n (+ 1 v))))
- environment)
- n)
-
-
- (define link
- (case-lambda
- ((programs environment)
- (append
- (list
- (list 'alloc (list 'local 0) (list 'const (num-globals environment))))
- (translate-globals
- (loop for prog in programs
- for off = 1 then (+ off (length converted-prog))
- for converted-prog = (translate-labels
- prog
- (make-label-map off prog))
- append converted-prog)
- environment)))
- ((programs)
- (link programs (add-to-environment (make-map compare-globals) programs)))))))