From a89d6c82e981fec7d6e4c975e083d2b9e04467ad Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Mon, 1 May 2023 07:56:42 -0700
Subject: 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.
---
 lib/csc/linker.csc | 119 -----------------------------------------------------
 1 file changed, 119 deletions(-)
 delete mode 100644 lib/csc/linker.csc

(limited to 'lib/csc/linker.csc')

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)))))))
-- 
cgit v1.3.1