From 68986fe0410584c6934c835bb0ee784655f5f8c5 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Tue, 11 Jan 2022 22:01:23 -0800
Subject: Move scheme compiler into a separate directory.

---
 csc/linker.csc | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 csc/linker.csc

(limited to 'csc/linker.csc')

diff --git a/csc/linker.csc b/csc/linker.csc
new file mode 100644
index 0000000..852ee13
--- /dev/null
+++ b/csc/linker.csc
@@ -0,0 +1,67 @@
+(define-library (csc linker)
+  (export link remove-labels make-label-map translate-labels)
+  (import (scheme base)
+          (only (csc encoding) encode)
+          (only (csc format) sprintf)
+          (only (csc hash-map)
+            hash-bytevector
+            insert
+            lookup
+            make-map)
+          (only (csc list)
+            enumerate
+            filter)
+          (only (csc match) match))
+  (begin
+    ; A CSC bytecode program is a list of opcodes. An opcode is a symbol, or a 2
+    ; item list of a symbol and an argument. The full list of opcodes can be
+    ; found in encoding.csc.
+
+
+    (define (translate-labels program label-map)
+      (map
+        (lambda (x)
+          (match x
+            ((i . ((! 'if) label))
+             ; Compute offset from the current position. Subtract 1
+             ; because the instruction pointer is incremented each
+             ; time already.
+             (list 'if (- (lookup label-map label) i 1)))
+            ((_ . ((! 'call) label))
+             (list 'call (lookup label-map label)))
+            ((_ . opcode) opcode)))
+        (enumerate program)))
+    (lambda (i . opcode)
+          (match opcode
+            (((! 'if) label) #t)
+            (_ #f)))
+
+
+    (define (hash-string s)
+      (hash-bytevector (string->utf8 s)))
+
+
+    (define (make-label-map program)
+      (let loop ((m (make-map hash-string string<?))
+                 (program program)
+                 (i 0))
+        (match program
+          ('() m)
+          ((((! 'label) name) . tail)
+           (loop (insert m name i) tail i))  ; N.b.: i instead of (+ 1 i) because we're going to remove the labels later.
+          ((_ . tail) (loop m tail (+ 1 i))))))
+
+
+    (define (remove-labels program)
+      (filter
+        (lambda (opcode)
+          (match opcode
+            (((! 'label) _) #f)
+            (_ #t)))
+        program))
+
+
+    (define (link . programs)
+      (let* ((program (apply append programs))
+             (label-map (make-label-map program)))
+        (encode (translate-labels (remove-labels program) label-map))))))
-- 
cgit v1.3.1