diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2023-05-01 07:56:42 -0700 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2023-05-01 07:56:42 -0700 |
| commit | a89d6c82e981fec7d6e4c975e083d2b9e04467ad (patch) | |
| tree | d5445ceb797473dd45ac006c337d990e5dd6f0d4 /lib/csc/linker.csc | |
| parent | Fix bugs with recursive macros and empty template. (diff) | |
| download | chromatopelma-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.csc | 119 |
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))))))) |
