Add write-char and displayln (for strings).

Author: dvanhorn

langs/outlaw/compile-ops.rkt

@@ -153,6 +153,12 @@
           (pad-stack)
           (Call 'is_char_whitespace)
           (unpad-stack))]
+    ['write-char
+     (seq (assert-char rax)
+          (Mov rdi rax)
+          (pad-stack)
+          (Call 'print_codepoint_out)
+          (unpad-stack))]
 
     ;; Op2
     ['+

langs/outlaw/compile.rkt

@@ -80,7 +80,7 @@
          string->uninterned-symbol
          open-input-file
          write-char error integer?
-         eq-hash-code char-alphabetic? char-whitespace?
+         eq-hash-code char-alphabetic? char-whitespace? displayln
          ;; Op2
          + - < = cons eq? make-vector vector-ref
          make-string string-ref string-append
@@ -104,6 +104,7 @@
          peek_byte_port
          is_char_alphabetic
          is_char_whitespace
+         print_codepoint_out
          system_type)))
 
 (define cons-function

langs/outlaw/io.c

@@ -9,6 +9,7 @@
 #define port_buffer_bytes 8
 
 void utf8_encode_string(val_str_t *, char *);
+int utf8_encode_char(val_char_t, char *);
 
 val_t read_byte(void)
 {
@@ -30,6 +31,14 @@ val_t write_byte(val_t c)
   return val_wrap_void();
 }
 
+val_t print_codepoint_out(val_t c)
+{
+  char buffer[5] = {0};
+  utf8_encode_char(val_unwrap_char(c), buffer);
+  fprintf(out, "%s", buffer);
+  return val_wrap_void();
+}
+
 val_t open_input_file(val_t in) {
   FILE *f;
   char *buf;

langs/outlaw/stdlib.rkt

@@ -14,6 +14,7 @@
          findf
          read-line
          char-alphabetic? char-whitespace?
+         displayln ; only works for strings
          ; unimplemented
          exact->inexact / expt string->keyword
          ;; Op0
@@ -65,6 +66,7 @@
 (define (zero? n) (%zero? n))
 (define (char? n) (%char? n))
 (define (write-byte b) (%write-byte b)) ; IMPROVE: add port
+(define (write-char c) (%write-char c))
 (define (eof-object? x) (%eof-object? x))
 (define (integer->char i) (%integer->char i))
 (define (char->integer c) (%char->integer c))
@@ -555,6 +557,12 @@
 (define (char-alphabetic? x) (%char-alphabetic? x))
 (define (char-whitespace? x) (%char-whitespace? x))
 
+(define (displayln s)
+  (if (string? s)
+      (begin (map write-char (string->list s))
+             (write-char #\newline))
+      (error "unimplemented displayln for non-strings")))
+
 (define (exact->inexact x)
   (error "exact->inexact not implemented"))
 

langs/outlaw/test/test-runner.rkt

@@ -674,4 +674,10 @@
                 (cons #\a ""))
   (check-equal? (run "ab" '(cons (read-char) (read-char)))
                 (cons '(#\a . #\b) ""))
+  (check-equal? (run "" '(write-char #\a))
+                (cons (void) "a"))
+  (check-equal? (run "" '(write-char #\newline))
+                (cons (void) "\n"))
+  (check-equal? (run "" '(displayln "hello world"))
+                (cons (void) "hello world\n"))
   )