Add write-string to stdlib.

Author: dvanhorn

langs/outlaw/a86/printer.rkt

@@ -1,5 +1,5 @@
 #lang racket
-(provide asm-string current-shared?)
+(provide asm-string current-shared? asm-display)
 (require "ast.rkt")
 
 (define current-shared?
@@ -216,3 +216,27 @@
        (instrs->string a)
        #;
        (error "program does not have an initial label")])))
+
+(define (asm-display a)
+  (begin
+    (set-box! external-labels '())
+    ;; entry point will be first label
+    (match (findf Label? a)
+      [(Label g)
+       (begin
+         (write-string
+          (string-append
+           tab "global " (label-symbol->string g) "\n"
+           tab "default rel\n"
+           tab "section .text\n"))
+         (asm-display-instrs a))]
+      [_
+       (asm-display-instrs a)])))
+
+(define (asm-display-instrs a)
+  (match a
+    ['() (void)]
+    [(cons i a)
+     (begin (write-string (instr->string i))
+            (write-string "\n")
+            (asm-display-instrs a))]))

langs/outlaw/compile-library.rkt

@@ -8,4 +8,4 @@
   (begin
     (read-line) ; ignore #lang racket line
     (current-shared? #t)
-    (displayln (asm-string (compile-library (parse-library (read-all)))))))
+    (asm-display (compile-library (parse-library (read-all))))))

langs/outlaw/compile-stdin.rkt

@@ -9,4 +9,4 @@
   (begin
     (read-line) ; ignore #lang racket line
     (current-shared? #t)
-    (displayln (asm-string (compile (parse (read-all)))))))
+    (asm-display (compile (parse (read-all))))))

langs/outlaw/compile.rkt

@@ -81,7 +81,7 @@
          string->uninterned-symbol
          open-input-file
          write-char error integer?
-         eq-hash-code char-alphabetic? char-whitespace? displayln
+         eq-hash-code char-alphabetic? char-whitespace? displayln write-string
          ;; Op2
          + - < = cons eq? make-vector vector-ref
          make-string string-ref string-append

langs/outlaw/stdlib.rkt

@@ -15,6 +15,7 @@
          read-line
          char-alphabetic? char-whitespace?
          displayln ; only works for strings
+         write-string
          ; unimplemented
          exact->inexact / expt string->keyword
          ;; Op0
@@ -559,10 +560,14 @@
 
 (define (displayln s)
   (if (string? s)
-      (begin (map write-char (string->list s))
+      (begin (write-string s)
              (write-char #\newline))
       (error "unimplemented displayln for non-strings")))
 
+(define (write-string s)
+  (begin (map write-char (string->list s))
+         (string-length s)))
+
 (define (exact->inexact x)
   (error "exact->inexact not implemented"))
 

langs/outlaw/test/test-runner.rkt

@@ -725,6 +725,8 @@
                 (cons (void) "a"))
   (check-equal? (run "" '(write-char #\newline))
                 (cons (void) "\n"))
+  (check-equal? (run "" '(write-string "hello world"))
+                (cons (void) "hello world"))
   (check-equal? (run "" '(displayln "hello world"))
                 (cons (void) "hello world\n"))
   )