erlang: core BIFs + funs, Phase 2 complete (+35 tests)

lib/erlang/transpile.sx

@@ -97,6 +97,7 @@
         (= ty "if") (er-eval-if node env)
         (= ty "case") (er-eval-case node env)
         (= ty "call") (er-eval-call node env)
+        (= ty "fun") (er-eval-fun node env)
         (= ty "match") (er-eval-match node env)
         :else (error (str "Erlang eval: unsupported node type '" ty "'"))))))
 
@@ -447,17 +448,22 @@
   (fn
     (node env)
     (let
-      ((fun (get node :fun)) (args (get node :args)))
+      ((fun-node (get node :fun)) (args (get node :args)))
       (cond
-        (= (get fun :type) "atom")
-        (er-eval-local-call (get fun :value) args env)
-        (= (get fun :type) "remote")
-        (er-eval-remote-call
-          (get (get fun :mod) :value)
-          (get (get fun :fun) :value)
-          args
-          env)
-        :else (error "Erlang: unsupported call target")))))
+        (= (get fun-node :type) "atom")
+        (er-apply-bif (get fun-node :value) (er-eval-args args env))
+        (= (get fun-node :type) "remote")
+        (er-apply-remote-bif
+          (get (get fun-node :mod) :value)
+          (get (get fun-node :fun) :value)
+          (er-eval-args args env))
+        :else
+        (let
+          ((fv (er-eval-expr fun-node env)))
+          (if
+            (er-fun? fv)
+            (er-apply-fun fv (er-eval-args args env))
+            (error "Erlang: not a function")))))))
 
 (define
   er-eval-args
@@ -470,22 +476,46 @@
         (range 0 (len args)))
       out)))
 
+;; ── fun values ───────────────────────────────────────────────────
 (define
-  er-eval-local-call
-  (fn
-    (name args env)
-    (let
-      ((vs (er-eval-args args env)))
-      (er-apply-bif name vs))))
+  er-mk-fun
+  (fn (clauses env) {:env env :clauses clauses :tag "fun"}))
+(define er-fun? (fn (v) (er-is-tagged? v "fun")))
 
 (define
-  er-eval-remote-call
+  er-eval-fun
+  (fn (node env) (er-mk-fun (get node :clauses) env)))
+
+(define
+  er-apply-fun
   (fn
-    (mod name args env)
-    (error
-      (str "Erlang: undefined function '" mod ":" name "/" (len args) "'"))))
+    (fv vs)
+    (er-apply-fun-clauses (get fv :clauses) vs (get fv :env) 0)))
+
+(define
+  er-apply-fun-clauses
+  (fn
+    (clauses vs closure-env i)
+    (if
+      (>= i (len clauses))
+      (error "Erlang: function_clause: no matching fun clause")
+      (let
+        ((c (nth clauses i))
+          (ps (get c :patterns))
+          (call-env (er-env-copy closure-env)))
+        (if
+          (not (= (len ps) (len vs)))
+          (er-apply-fun-clauses clauses vs closure-env (+ i 1))
+          (if
+            (and
+              (er-match-all ps vs 0 call-env)
+              (er-eval-guards (get c :guards) call-env))
+            (er-eval-body (get c :body) call-env)
+            (er-apply-fun-clauses clauses vs closure-env (+ i 1))))))))
 
 ;; ── BIFs ─────────────────────────────────────────────────────────
+(define er-atom-ok (er-mk-atom "ok"))
+
 (define
   er-apply-bif
   (fn
@@ -498,9 +528,47 @@
       (= name "is_number") (er-bif-is-number vs)
       (= name "is_float") (er-bif-is-float vs)
       (= name "is_boolean") (er-bif-is-boolean vs)
+      (= name "length") (er-bif-length vs)
+      (= name "hd") (er-bif-hd vs)
+      (= name "tl") (er-bif-tl vs)
+      (= name "element") (er-bif-element vs)
+      (= name "tuple_size") (er-bif-tuple-size vs)
+      (= name "atom_to_list") (er-bif-atom-to-list vs)
+      (= name "list_to_atom") (er-bif-list-to-atom vs)
       :else (error
         (str "Erlang: undefined function '" name "/" (len vs) "'")))))
 
+(define
+  er-apply-remote-bif
+  (fn
+    (mod name vs)
+    (cond
+      (= mod "lists") (er-apply-lists-bif name vs)
+      (= mod "io") (er-apply-io-bif name vs)
+      (= mod "erlang") (er-apply-bif name vs)
+      :else (error
+        (str "Erlang: undefined module '" mod "'")))))
+
+(define
+  er-apply-lists-bif
+  (fn
+    (name vs)
+    (cond
+      (= name "reverse") (er-bif-lists-reverse vs)
+      (= name "map") (er-bif-lists-map vs)
+      (= name "foldl") (er-bif-lists-foldl vs)
+      :else (error
+        (str "Erlang: undefined 'lists:" name "/" (len vs) "'")))))
+
+(define
+  er-apply-io-bif
+  (fn
+    (name vs)
+    (cond
+      (= name "format") (er-bif-io-format vs)
+      :else (error
+        (str "Erlang: undefined 'io:" name "/" (len vs) "'")))))
+
 (define
   er-bif-arg1
   (fn
@@ -556,3 +624,275 @@
       ((v (er-bif-arg1 vs "is_boolean")))
       (er-bool
         (or (er-is-atom-named? v "true") (er-is-atom-named? v "false"))))))
+
+;; ── list / tuple BIFs ────────────────────────────────────────────
+(define er-bif-length (fn (vs) (er-list-length (er-bif-arg1 vs "length"))))
+
+(define
+  er-list-length
+  (fn
+    (v)
+    (cond
+      (er-nil? v) 0
+      (er-cons? v) (+ 1 (er-list-length (get v :tail)))
+      :else (error "Erlang: length: not a proper list"))))
+
+(define
+  er-bif-hd
+  (fn
+    (vs)
+    (let
+      ((v (er-bif-arg1 vs "hd")))
+      (if
+        (er-cons? v)
+        (get v :head)
+        (error "Erlang: hd: empty list or non-list")))))
+
+(define
+  er-bif-tl
+  (fn
+    (vs)
+    (let
+      ((v (er-bif-arg1 vs "tl")))
+      (if
+        (er-cons? v)
+        (get v :tail)
+        (error "Erlang: tl: empty list or non-list")))))
+
+(define
+  er-bif-element
+  (fn
+    (vs)
+    (if
+      (not (= (len vs) 2))
+      (error "Erlang: element: arity")
+      (let
+        ((i (nth vs 0)) (t (nth vs 1)))
+        (if
+          (and (= (type-of i) "number") (er-tuple? t))
+          (let
+            ((elems (get t :elements)))
+            (if
+              (and (>= i 1) (<= i (len elems)))
+              (nth elems (- i 1))
+              (error "Erlang: element: badarg (index out of range)")))
+          (error "Erlang: element: badarg"))))))
+
+(define
+  er-bif-tuple-size
+  (fn
+    (vs)
+    (let
+      ((v (er-bif-arg1 vs "tuple_size")))
+      (if
+        (er-tuple? v)
+        (len (get v :elements))
+        (error "Erlang: tuple_size: not a tuple")))))
+
+(define
+  er-bif-atom-to-list
+  (fn
+    (vs)
+    (let
+      ((v (er-bif-arg1 vs "atom_to_list")))
+      (if
+        (er-atom? v)
+        (get v :name)
+        (error "Erlang: atom_to_list: not an atom")))))
+
+(define
+  er-bif-list-to-atom
+  (fn
+    (vs)
+    (let
+      ((v (er-bif-arg1 vs "list_to_atom")))
+      (if
+        (= (type-of v) "string")
+        (er-mk-atom v)
+        (error "Erlang: list_to_atom: not a string")))))
+
+;; ── lists module ─────────────────────────────────────────────────
+(define
+  er-bif-lists-reverse
+  (fn
+    (vs)
+    (er-list-reverse-iter (er-bif-arg1 vs "lists:reverse") (er-mk-nil))))
+
+(define
+  er-list-reverse-iter
+  (fn
+    (v acc)
+    (cond
+      (er-nil? v) acc
+      (er-cons? v)
+      (er-list-reverse-iter (get v :tail) (er-mk-cons (get v :head) acc))
+      :else (error "Erlang: lists:reverse: not a list"))))
+
+(define
+  er-bif-lists-map
+  (fn
+    (vs)
+    (if
+      (not (= (len vs) 2))
+      (error "Erlang: lists:map: arity")
+      (er-list-reverse-iter
+        (er-map-iter (nth vs 0) (nth vs 1) (er-mk-nil))
+        (er-mk-nil)))))
+
+(define
+  er-map-iter
+  (fn
+    (f lst acc)
+    (cond
+      (er-nil? lst) acc
+      (er-cons? lst)
+      (er-map-iter
+        f
+        (get lst :tail)
+        (er-mk-cons (er-apply-fun f (list (get lst :head))) acc))
+      :else (error "Erlang: lists:map: not a list"))))
+
+(define
+  er-bif-lists-foldl
+  (fn
+    (vs)
+    (if
+      (not (= (len vs) 3))
+      (error "Erlang: lists:foldl: arity")
+      (er-foldl-iter (nth vs 0) (nth vs 1) (nth vs 2)))))
+
+(define
+  er-foldl-iter
+  (fn
+    (f acc lst)
+    (cond
+      (er-nil? lst) acc
+      (er-cons? lst)
+      (er-foldl-iter
+        f
+        (er-apply-fun f (list (get lst :head) acc))
+        (get lst :tail))
+      :else (error "Erlang: lists:foldl: not a list"))))
+
+;; ── io module ────────────────────────────────────────────────────
+(define er-io-buffer (list ""))
+(define er-io-flush! (fn () (set-nth! er-io-buffer 0 "")))
+(define er-io-buffer-content (fn () (nth er-io-buffer 0)))
+
+(define
+  er-bif-io-format
+  (fn
+    (vs)
+    (let
+      ((s
+        (cond
+          (= (len vs) 1) (er-format-string (nth vs 0) (list))
+          (= (len vs) 2)
+          (er-format-string (nth vs 0) (er-list-to-sx-list (nth vs 1)))
+          :else (error "Erlang: io:format: arity"))))
+      (set-nth! er-io-buffer 0 (str (nth er-io-buffer 0) s))
+      er-atom-ok)))
+
+(define
+  er-list-to-sx-list
+  (fn
+    (lst)
+    (let
+      ((out (list)))
+      (er-list-to-sx-collect lst out)
+      out)))
+
+(define
+  er-list-to-sx-collect
+  (fn
+    (lst out)
+    (cond
+      (er-nil? lst) nil
+      (er-cons? lst)
+      (do
+        (append! out (get lst :head))
+        (er-list-to-sx-collect (get lst :tail) out))
+      :else (error "Erlang: expected proper list"))))
+
+;; ── format string rendering (~n, ~~, ~p, ~w, ~s) ────────────────
+(define
+  er-format-string
+  (fn (fmt args) (er-format-walk fmt 0 args 0 "")))
+
+(define
+  er-format-walk
+  (fn
+    (fmt i args ai out)
+    (if
+      (>= i (len fmt))
+      out
+      (let
+        ((c (char-at fmt i)))
+        (cond
+          (and (= c "~") (< (+ i 1) (len fmt)))
+          (let
+            ((d (char-at fmt (+ i 1))))
+            (cond
+              (= d "n")
+              (er-format-walk fmt (+ i 2) args ai (str out "\n"))
+              (= d "~") (er-format-walk fmt (+ i 2) args ai (str out "~"))
+              (or (= d "p") (= d "w") (= d "s"))
+              (er-format-walk
+                fmt
+                (+ i 2)
+                args
+                (+ ai 1)
+                (str out (er-format-value (nth args ai))))
+              :else (er-format-walk
+                fmt
+                (+ i 2)
+                args
+                ai
+                (str out "~" d))))
+          :else (er-format-walk fmt (+ i 1) args ai (str out c)))))))
+
+(define
+  er-format-value
+  (fn
+    (v)
+    (cond
+      (= (type-of v) "number") (str v)
+      (= (type-of v) "string") (str "\"" v "\"")
+      (er-atom? v) (get v :name)
+      (er-nil? v) "[]"
+      (er-cons? v) (str "[" (er-format-list-elems v) "]")
+      (er-tuple? v) (str "{" (er-format-tuple-elems (get v :elements)) "}")
+      (er-fun? v) "#Fun"
+      :else (str v))))
+
+(define
+  er-format-list-elems
+  (fn
+    (v)
+    (cond
+      (er-nil? v) ""
+      (and (er-cons? v) (er-nil? (get v :tail)))
+      (er-format-value (get v :head))
+      (er-cons? v)
+      (str
+        (er-format-value (get v :head))
+        ","
+        (er-format-list-elems (get v :tail)))
+      :else (str "|" (er-format-value v)))))
+
+(define
+  er-format-tuple-elems
+  (fn
+    (elems)
+    (if
+      (= (len elems) 0)
+      ""
+      (let
+        ((out (list (er-format-value (nth elems 0)))))
+        (for-each
+          (fn
+            (i)
+            (append! out ",")
+            (append! out (er-format-value (nth elems i))))
+          (range 1 (len elems)))
+        (reduce str "" out)))))