application/octet-stream
•
8.07 KB
•
161 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains the printer, which is used pretty much everywhere a Nujel value needs
;;; a text representation.
(defn int->string/binary (α)
"Turn α into a its **binary** string representation"
(def ret "")
(when (or (not α) (zero? α))
(return "0"))
(while (not-zero? α)
(set! ret (cat (from-char-code (+ #\0 (bit-and α #b1))) ret))
(set! α (bit-shift-right α 1)))
ret)
(defn int->string/octal (α)
"Turn α into a its **octal** string representation"
(def ret "")
(when (or (not α) (zero? α))
(return "0"))
(while (not-zero? α)
(set! ret (cat (from-char-code (+ #\0 (bit-and α #b111))) ret))
(set! α (bit-shift-right α 3)))
ret)
(def int->string/hex/conversion-arr ##("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))
(defn int->string/HEX (α)
"Turn α into a its **hexadecimal** string representation"
(def ret "")
(when (or (not α) (zero? α))
(return "0"))
(when (< α 0) (exception :type-error "Can't print negative numbers in hex for now" α ))
(while (not-zero? α)
(set! ret (cat (ref int->string/hex/conversion-arr (bit-and α #b1111)) ret))
(set! α (bit-shift-right α 4)))
ret)
(defn int->string/hex (α)
"Turn α into a its **hexadecimal** string representation"
(lower-case (int->string/HEX α)))
(defn int->string/decimal (α)
"Turn α into a its **decimal** string representation"
(:string α))
(def int->string int->string/decimal)
(def write/raw (let*
(defn write/raw/array (v port hr?)
(:block-write port "##(")
(dotimes (i (:length v))
(write/raw (ref v i) port hr?)
(when (< i (- (:length v) 1))
(:block-write port " ")))
(:block-write port ")"))
(defn write/raw/buffer (v port hr?)
(if hr?
(:write port "#<buffer :id " (int->string/decimal (val->id v))
" :size " (int->string/hex (:length v)) ">")
(do (:block-write port "#m")
(def view (:u8 v))
(dotimes (i (:length v))
(:block-write port (pad-start (int->string/HEX (ref view i)) 2 "0"))))))
(defn write/raw/bytecode-array (v port hr?)
(:block-write port "#{")
(write/raw/array (:literals v) port #f)
(dotimes (i (:length v))
(when (zero? (bit-and i #x1F))
(:block-write port "\n"))
(:block-write port (pad-start (int->string/HEX (ref v i)) 2 "0")))
(:block-write port "\n}"))
(defn write/raw/tree/rec (v port hr? always-space?)
(when (or (not v)
(not (:key* v)))
(return always-space?))
(when (write/raw/tree/rec (:left* v) port hr? always-space?)
(:block-write port " "))
(:block-write port (:string (:key* v)))
(:block-write port ": ")
(write/raw (:value* v) port hr?)
(write/raw/tree/rec (:right* v) port hr? #t))
(defn write/raw/tree (v port hr?)
(:block-write port "#@(")
(write/raw/tree/rec v port hr? #f)
(:block-write port ")"))
(defn write/raw/map (v port hr?)
(:block-write port "(map/new")
(dotimes (i (:size* v))
(def k (:key* v i))
(when-not (nil? k)
(:block-write port " ")
(write/raw k port hr?)
(:block-write port " ")
(write/raw (:value* v i) port hr?)))
(:block-write port ")"))
(defn write/raw/pair (v port hr?)
(when (and (= 'quote (car v))
(nil? (cddr v))
(pair? (cdr v)))
(:block-write port "'")
(return (write/raw (cadr v) port hr?)))
(:block-write port "(")
(def first? #f)
(while v
(if first?
(:block-write port " ")
(set! first? #t))
(if (pair? v)
(write/raw (car v) port hr?)
(do (:block-write port ". ")
(write/raw v port hr?)))
(cdr! v))
(:block-write port ")"))
(defn write/raw/string (v port hr?)
(when hr? (return (:block-write port v)))
(:block-write port "\"")
(dotimes (i (:length v))
(def c (ref v i))
(case c
(0 (return (:block-write port "\"")))
(#x07 (:block-write port "\\a"))
(#x08 (:block-write port "\\b"))
(#x09 (:block-write port "\\t"))
(#x0A (:block-write port "\\n"))
(#x0B (:block-write port "\\v"))
(#x0C (:block-write port "\\f"))
(#x0D (:block-write port "\\r"))
(#x1B (:block-write port "\\e"))
(#x22 (:block-write port "\\\""))
(#x5C (:block-write port "\\\\"))
(otherwise (:char-write port c))))
(:block-write port "\""))
(defn write/raw (v port hr?)
(case (:type-name v)
(:nil (when-not hr? (:block-write port "#nil")))
(:bool (:block-write port (if v "#t" "#f")))
(:environment (:write port "#<environment " (int->string/hex (val->id v)) ">"))
(:file-handle (:write port "#<file-handle " (int->string/hex (val->id v)) ">"))
(:buffer-view (:write port "#<buffer-view " (int->string/hex (val->id v)) ">"))
((:lambda :macro :native-function) (:block-write port (:string (or (closure/name v) 'anonymous))))
(:int (:block-write port (int->string/decimal v)))
(:float (:block-write port (:string v))) ;; This one is kinda cheating
(:keyword (:write port ":" (:string v)))
(:symbol (:block-write port (:string v)))
(:array (write/raw/array v port hr?))
(:buffer (write/raw/buffer v port hr?))
(:bytecode-array (write/raw/bytecode-array v port hr?))
(:string (write/raw/string v port hr?))
(:tree (write/raw/tree v port hr?))
(:map (write/raw/map v port hr?))
(:pair (write/raw/pair v port hr?))
(:type (:write port (capitalize (:string (:name v)))))
(otherwise (:block-write port "#<unprintable>"))))))
