core: Support --native for compiling YS to machine code

Author: ingydotnet

.vscode/settings.json

@@ -1,8 +1,11 @@
 {
   "calva.fmt.configPath": ".cljfmt.edn",
   "cSpell.words": [
+    "concat",
     "cond",
+    "defmacro",
     "defn",
+    "doall",
     "fizzbuzz",
     "mapv",
     "yamlscript"

Changes

@@ -1,4 +1,9 @@
 
+- version: 0.1.29
+  date:    Wed Dec 20 10:12:44 AM PST 2023
+  changes:
+  - core: Support --native for compiling YS to machine code
+
 - version: 0.1.28
   date:    Mon Dec 18 08:57:06 AM PST 2023
   changes:

common/clojure.mk

@@ -8,8 +8,8 @@ export PATH := $(GRAALVM_HOME)/bin:$(PATH)
 YAMLSCRIPT_LANG_INSTALLED := \
   $(HOME)/.m2/repository/yamlscript/core/maven-metadata-local.xml
 YAMLSCRIPT_CORE_SRC := \
-  ../core/src/yamlscript/* \
-  ../core/src/ys/* \
+  ../core/src/yamlscript/*.clj \
+  ../core/src/ys/*.clj \
 
 ifdef w
   export WARN_ON_REFLECTION := 1

core/src/yamlscript/ast.clj

@@ -33,6 +33,8 @@
 
 (defn Key [s] {:Key (keyword s)})
 
+(defn Tok [s] {:Tok (str s)})
+
 (defn Bln [b]
   (if (re-matches #"(true|True|TRUE)" b)
     {:Bln true}

core/src/yamlscript/constructor.clj

@@ -127,8 +127,11 @@
                    (keys (get-declares node defn-names)))
         form (Lst (cons (Sym 'declare) declares))]
     (if (seq declares)
-      (update-in node [:Top]
-        #(vec (concat [form] %)))
+      (if (= 'ns (get-in node [:Top 0 :Lst 0 :Sym]))
+        (update-in node [:Top]
+          #(vec (concat [(first %)] [form] (rest %))))
+        (update-in node [:Top]
+          #(vec (concat [form] %))))
       node)))
 
 (def call-main

core/src/yamlscript/printer.clj

@@ -7,11 +7,8 @@
 (ns yamlscript.printer
   (:use yamlscript.debug)
   (:require
-   [clojure.edn :as edn]
    [clojure.string :as str]
-   [clojure.pprint :as pp]
-   [yamlscript.builder :as builder]
-   [clj-yaml.core :as yaml])
+   [clojure.pprint :as pp])
   (:refer-clojure :exclude [print]))
 
 (def string-escape
@@ -51,6 +48,7 @@
       :Chr (str "\\" val)
       :Spc (str/replace val #"::" ".")
       :Sym (str val)
+      :Tok (str val)
       :Key (str val)
       :Int (str val)
       :Flt (str val)
@@ -60,10 +58,16 @@
               (Exception. (str "Unknown AST node type:"
                             node))))))
 
-(defn pretty-format [s]
-  (str
-    (with-out-str (pp/write s))
-    "\n"))
+(defn pretty-format [code]
+  (->> code
+    (#(str "(do " % "\n)\n"))
+    read-string
+    rest
+    (map #(str
+            (with-out-str (pp/write %))
+            "\n"))
+    (str/join "")))
+
 
 (defn print
   "Render a YAMLScript AST as Clojure code."
@@ -72,15 +76,16 @@
         code (->> list
                (map print-node)
                (str/join "\n")
-               (#(str "(do " % "\n)\n"))
-               edn/read-string
-               rest
-               (map pretty-format)
-               (str/join ""))]
+               pretty-format)]
     code))
 
 (comment
   (print :Empty)
+  (read-string "
+(defmacro each [bindings & body]
+  `(do
+     (doall (for [~@bindings] (do ~@body)))
+     nil)))")
   (print
     {:Lst [{:Sym 'a} {:Sym 'b} {:Sym 'c}]})
   (print {:Map [{:Str "foo"} {:Str "\\a"}]})

core/src/yamlscript/re.clj

@@ -64,7 +64,7 @@
 (def pkey (re #"(?:$symw|$pnum|$strg)"))   ; Path key
 (def path (re #"(?:$symw(?:\.$pkey)+)"))   ; Lookup path
 (def keyw (re #"(?:\:$symw)"))             ; Keyword token
-(def symb (re #"(?:$symw[?!]?)"))          ; Symbol token
+(def symb (re #"(?:_[*+.]|$symw[?!]?)"))   ; Symbol token
 (def nspc (re #"(?:$symw(?:\:\:$symw)+)")) ; Namespace symbol
 (def fqsm (re #"(?:$nspc\.$symb)"))        ; Fully qualified symbol
                                            ; Symbol followed by paren

core/src/yamlscript/runtime.clj

@@ -29,8 +29,6 @@
 (def ys-ys (sci/create-ns 'ys))
 (def ys-ys-vars (sci/copy-ns ys.ys ys-ys))
 
- cast unquote-splicing update-keys update-vals
-
 (def argv (sci/new-dynamic-var 'ARGV nil))
 (def env (sci/new-dynamic-var 'ENV nil))
 

core/src/yamlscript/ysreader.clj

@@ -40,6 +40,12 @@
 (defn is-quote? [token]
   (and token (= "'" (str token))))
 
+(defn is-syntax-quote? [token]
+  (and token (= "`" (str token))))
+
+(defn is-unquote-splice? [token]
+  (and token (= "~@" (str token))))
+
 (defn is-string? [token]
   (and token (re-matches re/strg (str token))))
 
@@ -69,6 +75,7 @@
       $fqsm |                   # Fully qualified symbol
       $nspc |                   # Namespace symbol
       $path |                   # Lookup path
+      $lnum |                   # Number token
       $symb |                   # Symbol token
       $oper |                   # Operator token
       $char |                   # Character token
@@ -195,7 +202,7 @@
               (is-string? %) (Str (normalize-string %))
               :else (throw (Exception. (str "Invalid path token: " %))))
            keys)
-    form (cons (Sym '_.) (cons (Sym value) form))]
+    form (cons (Sym '__) (cons (Sym value) form))]
     (Lst form)))
 
 (defn read-scalar [[token & tokens]]
@@ -214,6 +221,8 @@
                        [(Sym n) tokens])
     (is-number? token) [(Int token) tokens]
     (is-operator? token) [(Sym token) tokens]
+    (is-unquote-splice? token) [(Tok token) tokens]
+    (is-syntax-quote? token) [(Tok token) tokens]
     (is-string? token) [(Str (normalize-string token)) tokens]
     (is-keyword? token) [(Key (subs token 1)) tokens]
     (is-character? token) [(Chr (subs token 1)) tokens]

core/src/ys/std.clj

@@ -22,20 +22,18 @@
 (defn zzz [& xs]
   (apply yamlscript.debug/zzz xs))
 
-(defn toB [x] boolean x)
+(defn toBoo [x] boolean x)
 
-(defn toF [x] (parse-double x))
+(defn toFlt [x] (parse-double x))
 
-(defn toI [x] (parse-long x))
+(defn toInt [x] (parse-long x))
 
-(defn toM
+(defn toMap
   ([] {})
   ([x] (apply hash-map x))
   ([k v & xs] (apply hash-map k v xs)))
 
-(defn toS [& xs] (apply str xs))
-
-(defn => [this] this)
+(defn toStr [& xs] (apply str xs))
 
 (defn _get [coll key]
   (if (string? key)
@@ -44,7 +42,7 @@
     (get coll key))
   )
 
-(defn _. [x & xs]
+(defn __ [x & xs]
   (reduce _get x xs))
 
 (defn _+ [x & xs]