1 files changed, 168 insertions, 0 deletions
diff --git a/src/gizmo/wasp-curse.el b/src/gizmo/wasp-curse.el
new file mode 100644
index 00000000..95149fef
--- /dev/null
+++ b/src/gizmo/wasp-curse.el
@@ -0,0 +1,168 @@
+;;; wasp-curse --- A curse -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'f)
+(require 'ht)
+(require 'cl-lib)
+
+(defun w/curse-run (prog)
+  "Run PROG and return the output."
+  (let ((tmpfile (make-temp-file "curse.js")))
+    (with-temp-file tmpfile (insert prog))
+    (shell-command-to-string (format "node '%s'" tmpfile))))
+
+(defun w/curse-name (name)
+  "Convert NAME to a cursed name."
+  (replace-regexp-in-string "[-]" "_" (format "%s" name)))
+
+(defconst w/binary-ops
+  '((or . "||")
+    (and . "&&")
+    (> . ">")
+    (>= . ">=")
+    (< . "<")
+    (<= . "<=")
+    (= . "===")
+    (% . "%")
+    (/ . "/")
+    (bit-or . "|")
+    (bit-and . "&")
+    (bit-xor . "^")))
+
+(defun w/curse-expr (expr)
+  "Translate EXPR according to the nature of the curse."
+  (cond
+   ((null expr) "(null)")
+   ((listp expr)
+    (pcase (car expr)
+      ((or '+ '- '*)
+       (format
+        "(%s)"
+        (s-join (format "%s" (car expr)) (-map #'w/curse-expr (cdr expr)))))
+      ((pred (lambda (x) (alist-get x w/binary-ops)))
+       (format
+        "(%s)"
+        (s-join (alist-get (car expr) w/binary-ops) (-map #'w/curse-expr (cdr expr)))))
+      ((or '<< '>>)
+       (format
+        "(%s%s%s)"
+        (w/curse-expr (cadr expr))
+        (format "%s" (car expr))
+        (w/curse-expr (caddr expr))))
+      ('comment "(null)")
+      ('lambda
+        (format
+         "((%s)=>(%s))"
+         (s-join "," (-map #'w/curse-name (cadr expr)))
+         (s-join "," (-map #'w/curse-expr (cddr expr)))))
+      ('async-lambda
+        (format
+         "(async(%s)=>(%s))"
+         (s-join "," (-map #'w/curse-name (cadr expr)))
+         (s-join "," (-map #'w/curse-expr (cddr expr)))))
+      ('if
+        (format
+         "(%s?%s:%s)"
+         (w/curse-expr (cadr expr))
+         (w/curse-expr (caddr expr))
+         (w/curse-expr (cadddr expr))))
+      ('define
+        (format
+         "(globalThis.%s=%s)"
+         (w/curse-name (cadr expr))
+         (w/curse-expr (caddr expr))))
+      ('set
+        (format
+         "(%s=%s)"
+         (w/curse-name (cadr expr))
+         (w/curse-expr (caddr expr))))
+      ('aset
+        (format
+         "(%s[%s]=%s)"
+         (w/curse-name (cadr expr))
+         (w/curse-expr (caddr expr))
+         (w/curse-expr (cadddr expr))))
+      ('new
+        (format
+         "(new %s(%s))"
+         (w/curse-expr (cadr expr))
+         (s-join "," (-map #'w/curse-expr (cddr expr)))))
+      ('await
+        (format
+         "(await %s)"
+         (w/curse-expr (cadr expr))))
+      ('not
+        (format
+         "(!%s)"
+         (w/curse-expr (cadr expr))))
+      ('let
+        (format
+         "(((%s)=>(%s))(%s))"
+         (s-join "," (--map (w/curse-name (car it)) (cadr expr)))
+         (s-join "," (-map #'w/curse-expr (cddr expr)))
+         (s-join "," (--map (w/curse-expr (cadr it)) (cadr expr)))))
+      ('async-let
+        (format
+         "((async(%s)=>(%s))(%s))"
+         (s-join "," (--map (w/curse-name (car it)) (cadr expr)))
+         (s-join "," (-map #'w/curse-expr (cddr expr)))
+         (s-join "," (--map (w/curse-expr (cadr it)) (cadr expr)))))
+      ('do
+        (format
+         "((()=>(%s))())"
+         (s-join "," (-map #'w/curse-expr (cdr expr)))))
+      ('iota
+        (format
+         "[...Array(%s).keys()]"
+         (w/curse-expr (cadr expr))))
+      ('array
+       (format
+         "[%s]"
+         (s-join "," (-map #'w/curse-expr (cdr expr)))))
+      ('object
+       (format
+        "{%s}"
+        (s-join
+         ","
+         (--map (format "%s:%s" (w/curse-name (car it)) (w/curse-expr (cadr it))) (cdr expr)))))
+      ('@
+       (format
+        "((%s)[%s])"
+        (w/curse-expr (cadr expr))
+        (w/curse-expr (caddr expr))))
+      (_
+       (format
+        "((%s)(%s))"
+        (w/curse-expr (car expr))
+        (s-join "," (-map #'w/curse-expr (cdr expr)))))
+      ))
+   ((symbolp expr) (w/curse-name expr))
+   ((numberp expr) (format "%s" expr))
+   ((stringp expr) (format "\"%s\"" expr))
+   (t "(null)")))
+
+(defun w/curse-current-buffer ()
+  "Transmute the current buffer according to the curse."
+  (interactive)
+  (let* ((srcfile (buffer-file-name))
+         (jspath (s-concat (f-base srcfile) ".js"))
+         (src (buffer-string)))
+    (with-temp-buffer
+      (insert src)
+      (goto-char (point-min))
+      (let ((acc "")
+            (line (read (current-buffer))))
+        (while (and line (not (eobp)))
+          (setf acc (s-concat acc (w/curse-expr line) ";"))
+          (setf
+           line
+           (condition-case nil
+               (read (current-buffer))
+             (error nil))))
+        (write-region acc nil jspath)))))
+
+(provide 'wasp-curse)
+;;; wasp-curse.el ends here