From d93ab7e848bf0f4bc1087504eecd7c959d19bf6c Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Fri, 13 Sep 2024 13:52:38 -0400 Subject: Update :3 --- src/gizmo/wasp-curse.el | 168 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 168 insertions(+) create mode 100644 src/gizmo/wasp-curse.el (limited to 'src/gizmo/wasp-curse.el') 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 -- cgit v1.2.3