(define
  ml-reserved
  (list
    "and"
    "as"
    "assert"
    "asr"
    "begin"
    "class"
    "constraint"
    "do"
    "done"
    "downto"
    "else"
    "end"
    "exception"
    "external"
    "false"
    "for"
    "fun"
    "function"
    "functor"
    "if"
    "in"
    "include"
    "inherit"
    "initializer"
    "land"
    "lazy"
    "let"
    "lor"
    "lsl"
    "lsr"
    "lxor"
    "match"
    "method"
    "mod"
    "module"
    "mutable"
    "new"
    "nonrec"
    "object"
    "of"
    "open"
    "or"
    "private"
    "rec"
    "sig"
    "struct"
    "then"
    "to"
    "true"
    "try"
    "type"
    "val"
    "virtual"
    "when"
    "while"
    "with"
    "ref"
    "not"
    "ignore"
    "print"
    "list"
    "string"
    "int"
    "float"
    "option"
    "result"))

(define ml-renames {:eval-expr "eval_expr" :macro-closure "macro_closure" :*render-fn* "render_fn" :thunk-env "thunk_env" :dict-has? "dict_has" :escape-attr "escape_attr" :thunk-expr "thunk_expr" :get-primitive "get_primitive" :*custom-special-forms* "custom_special_forms" :sx-serialize "sx_serialize" :component-closure "component_closure" :lambda-params "lambda_params" :callable? "is_callable" :island? "is_island" :symbol-name "symbol_name" :string-contains? "string_contains_p" :set-lambda-name! "set_lambda_name" :macro? "is_macro" :true "(Bool true)" :keyword-name "keyword_name" :env-bind! "env_bind" :scope-pop! "scope_pop" :BOOLEAN_ATTRS "boolean_attrs" :expand-macro "expand_macro" :contains? "contains_p" :map-dict "map_dict" :*render-check* "render_check" :macro-body "macro_body" :for-each-indexed "for_each_indexed" :emit! "sx_emit" :context "sx_context" :env-extend "env_extend" :spread? "is_spread" :is-else-clause? "is_else_clause" :component-params "component_params" :dict-delete! "dict_delete" :every? "every_p" :make-component "make_component" :lambda-name "lambda_name" :char-from-code "char_from_code" :spread-attrs "spread_attrs" :component-affinity "component_affinity" :component? "is_component" :call-lambda "call_lambda" :make-thunk "make_thunk" :make-symbol "make_symbol" :dict-get "dict_get" :provide-pop! "provide_pop" :component-body "component_body" :make-spread "make_spread" :emitted "sx_emitted" :provide-push! "provide_push" :make-keyword "make_keyword" :scope-emit! "scope_emit" :register-special-form! "register_special_form" :lambda-body "lambda_body" :escape-string "escape_string" :for-each "for_each" :scope-peek "scope_peek" :make-island "make_island" :string-length "string_length" :nil "Nil" :has-key? "has_key_p" :HTML_TAGS "html_tags" :macro-rest-param "macro_rest_param" :env-has? "env_has" :make-raw-html "make_raw_html" :type-of "type_of" :component-name "component_name" :map-indexed "map_indexed" :render-to-html "render_to_html" :env-set! "env_set" :dict-set! "dict_set" :collected "sx_collected" :clear-collected! "sx_clear_collected" :make-macro "make_macro" :identical? "is_identical" :escape-html "escape_html" :starts-with? "starts_with_p" :make-lambda "make_lambda" :empty? "empty_p" :lambda-closure "lambda_closure" :thunk? "is_thunk" :ends-with? "ends_with_p" :component-has-children? "component_has_children" :VOID_ELEMENTS "void_elements" :env-merge "env_merge" :raw-html-content "raw_html_content" :lambda? "is_lambda" :false "(Bool false)" :parse-float "parse_float" :collect! "sx_collect" :nil? "is_nil" :env-get "env_get" :index-of "index_of" :scope-push! "scope_push" :signal? "is_signal" :macro-params "macro_params" :primitive? "is_primitive" :parse-int "parse_int"})

(define
  ml-mangle
  (fn
    ((name :as string))
    (let
      ((renamed (get ml-renames name)))
      (if
        (not (nil? renamed))
        renamed
        (let
          ((result name))
          (let
            ((result (cond (ends-with? result "?") (str (slice result 0 (- (string-length result) 1)) "_p") (ends-with? result "!") (str (slice result 0 (- (string-length result) 1)) "_b") :else result)))
            (let
              ((result (replace result "-" "_")))
              (let
                ((result (replace result "*" "_")))
                (if
                  (some (fn (r) (= r result)) ml-reserved)
                  (str result "'")
                  result)))))))))

(define
  ml-runtime-names
  (list
    "env-bind!"
    "env-set!"
    "env-get"
    "env-has?"
    "env-extend"
    "env-merge"
    "make-env"
    "make-lambda"
    "make-component"
    "make-island"
    "make-macro"
    "make-thunk"
    "make-symbol"
    "make-keyword"
    "set-lambda-name!"
    "type-of"
    "symbol-name"
    "keyword-name"
    "inspect"
    "lambda-params"
    "lambda-body"
    "lambda-closure"
    "lambda-name"
    "component-params"
    "component-body"
    "component-closure"
    "component-has-children?"
    "component-name"
    "component-affinity"
    "macro-params"
    "macro-rest-param"
    "macro-body"
    "macro-closure"
    "thunk-expr"
    "thunk-env"
    "thunk?"
    "callable?"
    "lambda?"
    "component?"
    "island?"
    "macro?"
    "signal?"
    "primitive?"
    "nil?"
    "identical?"
    "get-primitive"
    "trampoline"
    "sx-serialize"
    "prim-call"
    "first"
    "rest"
    "last"
    "nth"
    "cons"
    "append"
    "reverse"
    "flatten"
    "concat"
    "len"
    "get"
    "empty?"
    "list?"
    "dict?"
    "number?"
    "string?"
    "boolean?"
    "symbol?"
    "keyword?"
    "contains?"
    "has-key?"
    "starts-with?"
    "ends-with?"
    "string-contains?"
    "odd?"
    "even?"
    "zero?"
    "upper"
    "upcase"
    "lower"
    "downcase"
    "trim"
    "split"
    "join"
    "replace"
    "index-of"
    "substring"
    "string-length"
    "char-from-code"
    "keys"
    "vals"
    "assoc"
    "dissoc"
    "merge"
    "dict-set!"
    "dict-get"
    "dict-has?"
    "dict-delete!"
    "abs"
    "sqrt"
    "pow"
    "floor"
    "ceil"
    "round"
    "min"
    "max"
    "clamp"
    "parse-int"
    "parse-float"
    "error"
    "host-error"
    "apply"
    "make-spread"
    "spread?"
    "spread-attrs"
    "map-indexed"
    "map-dict"
    "for-each"
    "for-each-indexed"
    "cek-call"
    "cek-run"
    "cek-step-loop"
    "cek-resume"
    "cek-suspended?"
    "cek-io-request"
    "make-cek-suspended"
    "library-name-key"
    "library-loaded?"
    "library-exports"
    "register-library"
    "sx-call"
    "sx-apply"
    "apply-cek"
    "eval-error?"
    "collect!"
    "collected"
    "clear-collected!"
    "context"
    "emit!"
    "emitted"
    "scope-push!"
    "scope-pop!"
    "provide-push!"
    "provide-pop!"
    "with-island-scope"
    "register-in-scope"
    "signal-value"
    "signal-set-value"
    "signal-subscribers"
    "signal-add-sub!"
    "signal-remove-sub!"
    "signal-deps"
    "signal-set-deps"
    "notify-subscribers"
    "flush-subscribers"
    "dispose-computed"
    "continuation?"
    "continuation-data"
    "make-cek-continuation"
    "callcc-continuation?"
    "callcc-continuation-data"
    "make-callcc-continuation"
    "callcc-continuation-winders-len"
    "dynamic-wind-call"
    "strip-prefix"
    "component-set-param-types!"
    "component-file"
    "component-set-file!"
    "parse-comp-params"
    "parse-macro-params"
    "parse-keyword-args"
    "eval-expr"
    "expand-macro"
    "try-catch"
    "set-render-active!"
    "scope-emitted"
    "jit-try-call"
    "jit-skip?"))

(define
  ml-is-known-name?
  (fn
    ((name :as string))
    (if
      (not (nil? (get ml-renames name)))
      true
      (if
        (some (fn (r) (= r name)) ml-runtime-names)
        true
        (some (fn (d) (= d name)) _known_defines)))))

(define ml-dynamic-globals (list "*render-check*" "*render-fn*"))

(define
  ml-mutable-globals
  (list
    "*strict*"
    "*prim-param-types*"
    "*last-error-kont*"
    "*bind-tracking*"
    "*provide-batch-depth*"
    "*provide-batch-queue*"
    "*provide-subscribers*"
    "*winders*"))

(define
  ml-is-mutable-global?
  (fn (name) (some (fn (g) (= g name)) ml-mutable-globals)))

(define
  ml-is-dyn-global?
  (fn ((name :as string)) (some (fn (g) (= g name)) ml-dynamic-globals)))

(define
  ml-is-dyn-var?
  (fn
    ((name :as string) (set-vars :as list))
    (some (fn (v) (= v (str "dyn:" name))) set-vars)))

(define
  ml-quote-string
  (fn
    ((s :as string))
    (str
      "\""
      (replace
        (replace (replace (replace s "\\" "\\\\") "\"" "\\\"") "\n" "\\n")
        "\t"
        "\\t")
      "\"")))

(define
  ml-is-self-recursive?
  (fn ((name :as string) body) (ml-scan-for-name name body)))

(define
  ml-scan-for-name
  (fn
    ((name :as string) node)
    (cond
      (and (= (type-of node) "symbol") (= (symbol-name node) name))
      true
      (list? node)
      (some (fn (child) (ml-scan-for-name name child)) node)
      :else false)))

(define
  ml-find-let-bound-names
  (fn
    ((body :as list))
    (let
      ((result (list)))
      (begin (for-each (fn (b) (ml-scan-let-names b result)) body) result))))

(define
  ml-scan-let-names
  (fn
    (node (result :as list))
    (when
      (and (list? node) (not (empty? node)))
      (let
        ((head (first node)))
        (cond
          (and
            (= (type-of head) "symbol")
            (or (= (symbol-name head) "let") (= (symbol-name head) "let*"))
            (>= (len node) 2)
            (list? (nth node 1)))
          (let
            ((bindings (nth node 1)))
            (begin
              (if
                (and (not (empty? bindings)) (list? (first bindings)))
                (for-each
                  (fn
                    (b)
                    (when
                      (and (list? b) (>= (len b) 1))
                      (let
                        ((vname (if (= (type-of (first b)) "symbol") (ml-mangle (symbol-name (first b))) (str (first b)))))
                        (when
                          (not (some (fn (x) (= x vname)) result))
                          (append! result vname)))))
                  bindings)
                (let
                  ((i 0))
                  (for-each
                    (fn
                      (item)
                      (when
                        (= (mod i 2) 0)
                        (let
                          ((vname (if (= (type-of item) "symbol") (ml-mangle (symbol-name item)) (str item))))
                          (when
                            (not (some (fn (x) (= x vname)) result))
                            (append! result vname)))))
                    bindings)))
              (for-each
                (fn (child) (ml-scan-let-names child result))
                (rest (rest node)))))
          :else (for-each
            (fn
              (child)
              (when (list? child) (ml-scan-let-names child result)))
            node))))))

(define
  ml-find-set-targets
  (fn
    ((body :as list))
    (let
      ((result (list)))
      (begin (for-each (fn (b) (ml-scan-set b result)) body) result))))

(define
  ml-scan-set
  (fn
    (node (result :as list))
    (when
      (and (list? node) (not (empty? node)))
      (let
        ((head (first node)))
        (cond
          (and
            (= (type-of head) "symbol")
            (= (symbol-name head) "set!")
            (>= (len node) 2))
          (let
            ((var-name (symbol-name (nth node 1))))
            (let
              ((mangled (ml-mangle var-name)))
              (when
                (and
                  (not (ml-is-mutable-global? var-name))
                  (not (some (fn (x) (= x mangled)) result)))
                (append! result mangled))))
          (and
            (= (type-of head) "symbol")
            (= (symbol-name head) "append!")
            (>= (len node) 2)
            (= (type-of (nth node 1)) "symbol"))
          (let
            ((var-name (symbol-name (nth node 1))))
            (let
              ((mangled (ml-mangle var-name)))
              (when
                (and
                  (not (ml-is-mutable-global? var-name))
                  (not (some (fn (x) (= x mangled)) result)))
                (append! result mangled))))
          :else (for-each
            (fn (child) (when (list? child) (ml-scan-set child result)))
            node))))))

(define ml-expr (fn (expr) (ml-expr-inner expr (list))))

(define
  ml-expr-inner
  (fn
    (expr (set-vars :as list))
    (cond
      (= (type-of expr) "boolean")
      (if expr "(Bool true)" "(Bool false)")
      (nil? expr)
      "Nil"
      (number? expr)
      (if
        (string-contains? (str expr) ".")
        (str "(Number " (str expr) ")")
        (str "(Number " (str expr) ".0)"))
      (string? expr)
      (str "(String " (ml-quote-string expr) ")")
      (= (type-of expr) "symbol")
      (let
        ((mangled (ml-mangle (symbol-name expr))))
        (if
          (ml-is-mutable-global? (symbol-name expr))
          (str "!" mangled "ref")
          (if
            (some (fn (c) (= c mangled)) set-vars)
            (str "!" mangled)
            mangled)))
      (= (type-of expr) "keyword")
      (str "(String " (ml-quote-string (keyword-name expr)) ")")
      (= (type-of expr) "dict")
      (ml-emit-dict-native expr set-vars)
      (list? expr)
      (if (empty? expr) "[]" (ml-emit-list expr set-vars))
      :else (str "(* ??? *) " (str expr)))))

(define
  ml-emit-dict-native
  (fn
    ((d :as dict) (set-vars :as list))
    (let
      ((items (keys d)))
      (if
        (and
          (= (len items) 5)
          (some (fn (k) (= k "control")) items)
          (some (fn (k) (= k "phase")) items)
          (some (fn (k) (= k "kont")) items))
        (str
          "(CekState { cs_control = "
          (ml-expr-inner (get d "control") set-vars)
          "; cs_env = "
          (ml-expr-inner (get d "env") set-vars)
          "; cs_kont = "
          (ml-expr-inner (get d "kont") set-vars)
          "; cs_phase = "
          (let
            ((p (get d "phase")))
            (if
              (= (type-of p) "string")
              (ml-quote-string p)
              (str
                "(match "
                (ml-expr-inner p set-vars)
                " with String s -> s | _ -> \"\")")))
          "; cs_value = "
          (ml-expr-inner (get d "value") set-vars)
          " })")
        (if
          (and
            (some (fn (k) (= k "type")) items)
            (= (type-of (get d "type")) "string"))
          (let
            ((frame-type (get d "type"))
              (ef
                (fn
                  (field)
                  (if
                    (some (fn (k) (= k field)) items)
                    (ml-expr-inner (get d field) set-vars)
                    "Nil"))))
            (str
              "(CekFrame { cf_type = "
              (ml-quote-string frame-type)
              "; cf_env = "
              (ef "env")
              "; cf_name = "
              (if (= frame-type "if") (ef "else") (cond (some (fn (k) (= k "body-result")) items) (ef "body-result") :else (ef "name")))
              "; cf_body = "
              (if (= frame-type "if") (ef "then") (ef "body"))
              "; cf_remaining = "
              (ef "remaining")
              "; cf_f = "
              (cond (some (fn (k) (= k "after-thunk")) items) (ef "after-thunk") (some (fn (k) (= k "f")) items) (ef "f") :else "Nil")
              "; cf_args = "
              (cond
                (some (fn (k) (= k "evaled")) items)
                (ef "evaled")
                (some (fn (k) (= k "args")) items)
                (ef "args")
                :else "Nil")
              "; cf_results = "
              (cond
                (some (fn (k) (= k "results")) items)
                (ef "results")
                (some (fn (k) (= k "raw-args")) items)
                (ef "raw-args")
                (some (fn (k) (= k "subscribers")) items)
                (ef "subscribers")
                :else "Nil")
              "; cf_extra = "
              (cond
                (some (fn (k) (= k "ho-type")) items)
                (ef "ho-type")
                (some (fn (k) (= k "scheme")) items)
                (ef "scheme")
                (some (fn (k) (= k "indexed")) items)
                (ef "indexed")
                (some (fn (k) (= k "value")) items)
                (ef "value")
                (some (fn (k) (= k "phase")) items)
                (ef "phase")
                (some (fn (k) (= k "has-effects")) items)
                (ef "has-effects")
                (some (fn (k) (= k "match-val")) items)
                (ef "match-val")
                (some (fn (k) (= k "current-item")) items)
                (ef "current-item")
                (some (fn (k) (= k "update-fn")) items)
                (ef "update-fn")
                (some (fn (k) (= k "head-name")) items)
                (ef "head-name")
                (some (fn (k) (= k "prev-tracking")) items)
                (ef "prev-tracking")
                (some (fn (k) (= k "extra")) items)
                (ef "extra")
                (some (fn (k) (= k "winders-len")) items)
                (ef "winders-len")
                :else "Nil")
              "; cf_extra2 = "
              (cond
                (some (fn (k) (= k "emitted")) items)
                (ef "emitted")
                (some (fn (k) (= k "effect-list")) items)
                (ef "effect-list")
                (some (fn (k) (= k "first-render")) items)
                (ef "first-render")
                :else "Nil")
              " })"))
          (if
            (and
              (some (fn (k) (= k "ip")) items)
              (some (fn (k) (= k "closure")) items)
              (some (fn (k) (= k "base")) items))
            (str
              "(VmFrame { vf_closure = (match "
              (ml-expr-inner (get d "closure") set-vars)
              " with VmClosure c -> c | _ -> failwith \"vf_closure\")"
              "; vf_ip = val_to_int "
              (ml-expr-inner (get d "ip") set-vars)
              "; vf_base = val_to_int "
              (ml-expr-inner (get d "base") set-vars)
              "; vf_local_cells = Hashtbl.create 4 })")
            (if
              (and
                (some (fn (k) (= k "sp")) items)
                (some (fn (k) (= k "stack")) items)
                (some (fn (k) (= k "globals")) items))
              (str
                "(VmMachine { vm_stack = (match "
                (ml-expr-inner (get d "stack") set-vars)
                " with List _ -> Array.make 4096 Nil | _ -> Array.make 4096 Nil)"
                "; vm_sp = val_to_int "
                (ml-expr-inner (get d "sp") set-vars)
                "; vm_frames = []"
                "; vm_globals = (match "
                (ml-expr-inner (get d "globals") set-vars)
                " with Dict d -> d | _ -> Hashtbl.create 0)"
                "; vm_pending_cek = None })")
              (str
                "(let _d = Hashtbl.create "
                (str (round (len items)))
                " in "
                (join
                  "; "
                  (map
                    (fn
                      (k)
                      (str
                        "Hashtbl.replace _d "
                        (ml-quote-string k)
                        " "
                        (ml-expr-inner (get d k) set-vars)))
                    items))
                "; Dict _d)"))))))))

(define
  ml-emit-list
  (fn
    (expr (set-vars :as list))
    (let
      ((head (first expr)) (args (rest expr)))
      (if
        (not (= (type-of head) "symbol"))
        (if
          (list? head)
          (str
            "(cek_call ("
            (ml-expr-inner head set-vars)
            ") (List ["
            (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
            "]))")
          (str
            "["
            (join "; " (map (fn (x) (ml-expr-inner x set-vars)) expr))
            "]"))
        (let
          ((op (symbol-name head)))
          (cond
            (or (= op "fn") (= op "lambda"))
            (ml-emit-fn expr set-vars)
            (or (= op "let") (= op "let*"))
            (ml-emit-let expr set-vars)
            (= op "if")
            (let
              ((cond-e (ml-expr-inner (nth args 0) set-vars))
                (then-e (ml-expr-inner (nth args 1) set-vars))
                (else-e
                  (if
                    (>= (len args) 3)
                    (ml-expr-inner (nth args 2) set-vars)
                    "Nil")))
              (str
                "(if sx_truthy ("
                cond-e
                ") then "
                then-e
                " else "
                else-e
                ")"))
            (= op "when")
            (ml-emit-when expr set-vars)
            (= op "cond")
            (ml-emit-cond args set-vars)
            (or (= op "case") (= op "match"))
            (ml-emit-case args set-vars)
            (= op "and")
            (ml-emit-and args set-vars)
            (= op "or")
            (ml-emit-or args set-vars)
            (= op "not")
            (str
              "(Bool (not (sx_truthy ("
              (ml-expr-inner (first args) set-vars)
              "))))")
            (or (= op "do") (= op "begin"))
            (ml-emit-do args set-vars)
            (= op "list")
            (str
              "(List ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "dict")
            (ml-emit-dict-call args set-vars)
            (= op "quote")
            (ml-emit-quote (first args))
            (= op "set!")
            (let
              ((var-name (symbol-name (first args))))
              (if
                (ml-is-mutable-global? var-name)
                (str
                  "("
                  (ml-mangle var-name)
                  "ref := "
                  (ml-expr-inner (nth args 1) set-vars)
                  "; Nil)")
                (let
                  ((mangled (ml-mangle var-name)))
                  (str
                    "("
                    mangled
                    " := "
                    (ml-expr-inner (nth args 1) set-vars)
                    "; Nil)"))))
            (= op "str")
            (str
              "(String (sx_str ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "]))")
            (= op "error")
            (str
              "(raise (Eval_error (value_to_str "
              (ml-expr-inner (first args) set-vars)
              ")))")
            (= op "+")
            (str
              "(prim_call \"+\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "-")
            (str
              "(prim_call \"-\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "*")
            (str
              "(prim_call \"*\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "/")
            (str
              "(prim_call \"/\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "mod")
            (str
              "(prim_call \"mod\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "=")
            (str
              "(prim_call \"=\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "!=")
            (str
              "(prim_call \"!=\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "<")
            (str
              "(prim_call \"<\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op ">")
            (str
              "(prim_call \">\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "<=")
            (str
              "(prim_call \"<=\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op ">=")
            (str
              "(prim_call \">=\" ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "apply")
            (str
              "(sx_apply "
              (ml-expr-inner (first args) set-vars)
              " "
              (ml-expr-inner (nth args 1) set-vars)
              ")")
            (= op "apply-cek")
            (str
              "(sx_apply_cek "
              (ml-expr-inner (first args) set-vars)
              " "
              (ml-expr-inner (nth args 1) set-vars)
              ")")
            (= op "eval-error?")
            (str
              "(Bool (is_eval_error "
              (ml-expr-inner (first args) set-vars)
              "))")
            (= op "for-each")
            (ml-emit-for-each args set-vars)
            (= op "map")
            (ml-emit-ho-form "List.map" "(fun _x -> " ")" "List" args set-vars)
            (= op "map-indexed")
            (ml-emit-ho-indexed args set-vars)
            (= op "filter")
            (ml-emit-ho-form
              "List.filter"
              "(fun _x -> sx_truthy ("
              "))"
              "List"
              args
              set-vars)
            (= op "reduce")
            (ml-emit-reduce args set-vars)
            (= op "some")
            (ml-emit-ho-form
              "List.exists"
              "(fun _x -> sx_truthy ("
              "))"
              "Bool"
              args
              set-vars)
            (= op "every?")
            (ml-emit-ho-form
              "List.for_all"
              "(fun _x -> sx_truthy ("
              "))"
              "Bool"
              args
              set-vars)
            (= op "map-dict")
            (ml-emit-map-dict args set-vars)
            (= op "append!")
            (let
              ((target (symbol-name (nth expr 1)))
                (item-expr (ml-expr-inner (nth args 1) set-vars)))
              (if
                (ml-is-mutable-global? target)
                (let
                  ((mangled (ml-mangle target)))
                  (str
                    "("
                    mangled
                    "ref := sx_append_b !"
                    mangled
                    "ref "
                    item-expr
                    "; Nil)"))
                (if
                  (and
                    (= (type-of (nth expr 1)) "symbol")
                    (some (fn (v) (= v (ml-mangle target))) set-vars))
                  (let
                    ((mangled (ml-mangle target)))
                    (str
                      "("
                      mangled
                      " := sx_append_b !"
                      mangled
                      " "
                      item-expr
                      "; Nil)"))
                  (str
                    "(sx_append_b "
                    (ml-expr-inner (nth expr 1) set-vars)
                    " "
                    item-expr
                    ")"))))
            (= op "dict-set!")
            (str
              "(sx_dict_set_b "
              (ml-expr-inner (nth args 0) set-vars)
              " "
              (ml-expr-inner (nth args 1) set-vars)
              " "
              (ml-expr-inner (nth args 2) set-vars)
              ")")
            (= op "env-bind!")
            (str
              "(env_bind "
              (ml-expr-inner (nth args 0) set-vars)
              " (sx_to_string "
              (ml-expr-inner (nth args 1) set-vars)
              ")"
              " "
              (ml-expr-inner (nth args 2) set-vars)
              ")")
            (= op "env-set!")
            (str
              "(env_set "
              (ml-expr-inner (nth args 0) set-vars)
              " (sx_to_string "
              (ml-expr-inner (nth args 1) set-vars)
              ")"
              " "
              (ml-expr-inner (nth args 2) set-vars)
              ")")
            (= op "set-lambda-name!")
            (str
              "(set_lambda_name "
              (ml-expr-inner (nth args 0) set-vars)
              " (sx_to_string "
              (ml-expr-inner (nth args 1) set-vars)
              "))")
            (or
              (= op "slice")
              (= op "concat")
              (= op "range")
              (= op "sort")
              (= op "merge")
              (= op "round")
              (= op "min")
              (= op "max")
              (= op "substring")
              (= op "assoc")
              (= op "dissoc")
              (= op "append")
              (= op "flatten")
              (= op "unique")
              (= op "zip")
              (= op "take")
              (= op "drop")
              (= op "chunk-every")
              (= op "zip-pairs")
              (= op "format")
              (= op "replace")
              (= op "split")
              (= op "join")
              (= op "index-of")
              (= op "dict")
              (= op "keys")
              (= op "vals")
              (= op "has-key?")
              (= op "contains?")
              (= op "starts-with?")
              (= op "ends-with?")
              (= op "string-contains?")
              (= op "string-length"))
            (str
              "(prim_call "
              (ml-quote-string op)
              " ["
              (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args))
              "])")
            (= op "inc")
            (str
              "(prim_call \"inc\" ["
              (ml-expr-inner (first args) set-vars)
              "])")
            (= op "dec")
            (str
              "(prim_call \"dec\" ["
              (ml-expr-inner (first args) set-vars)
              "])")
            :else (let
              ((callee (ml-mangle op)))
              (if
                (or (ml-is-dyn-var? op set-vars) (ml-is-dyn-global? op))
                (str
                  "(cek_call ("
                  callee
                  ") (List ["
                  (join
                    "; "
                    (map (fn (x) (ml-expr-inner x set-vars)) args))
                  "]))")
                (if
                  (empty? args)
                  (str "(" callee " ())")
                  (str
                    "("
                    callee
                    " "
                    (join
                      " "
                      (map
                        (fn (x) (str "(" (ml-expr-inner x set-vars) ")"))
                        args))
                    ")"))))))))))

(define
  ml-emit-fn-bare
  (fn
    (expr (set-vars :as list))
    (let
      ((params (nth expr 1))
        (body (rest (rest expr)))
        (param-strs (ml-collect-params params))
        (body-set-vars (ml-find-set-targets body))
        (let-bound (ml-find-let-bound-names body)))
      (let
        ((params-str (if (empty? param-strs) "()" (join " " param-strs)))
          (all-set-vars (append set-vars body-set-vars))
          (needs-ref
            (filter
              (fn (v) (not (some (fn (lb) (= lb v)) let-bound)))
              body-set-vars)))
        (if
          (empty? body-set-vars)
          (if
            (= (len body) 1)
            (str
              "(fun "
              params-str
              " -> "
              (ml-expr-inner (first body) all-set-vars)
              ")")
            (str "(fun " params-str " -> " (ml-emit-do body all-set-vars) ")"))
          (let
            ((ref-decls (if (empty? needs-ref) "" (str (join " " (map (fn (v) (str "let " v " = ref Nil in")) needs-ref)) " ")))
              (body-str
                (if
                  (= (len body) 1)
                  (ml-expr-inner (first body) all-set-vars)
                  (ml-emit-do body all-set-vars))))
            (str "(fun " params-str " -> " ref-decls body-str ")")))))))

(define
  ml-emit-fn
  (fn
    (expr (set-vars :as list))
    (let
      ((params (nth expr 1))
        (param-strs (ml-collect-params params))
        (n (len param-strs))
        (bare (ml-emit-fn-bare expr set-vars)))
      (if
        (= n 0)
        (str "(NativeFn (\"\\206\\187\", fun _args -> " bare " ()))")
        (let
          ((match-pat (str "[" (join "; " param-strs) "]"))
            (call-args (join " " param-strs)))
          (str
            "(NativeFn (\"\\206\\187\", fun _args -> match _args with "
            match-pat
            " -> "
            bare
            " "
            call-args
            " | _ -> Nil))"))))))

(define
  ml-collect-params
  (fn ((params :as list)) (ml-collect-params-loop params 0 (list))))

(define
  ml-collect-params-loop
  (fn
    ((params :as list) (i :as number) (result :as list))
    (if
      (>= i (len params))
      result
      (let
        ((p (nth params i)))
        (cond
          (and (= (type-of p) "symbol") (= (symbol-name p) "&key"))
          (ml-collect-params-loop params (+ i 1) result)
          (and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
          (ml-collect-params-loop params (+ i 2) result)
          (and
            (= (type-of p) "list")
            (= (len p) 3)
            (= (type-of (nth p 1)) "keyword")
            (= (keyword-name (nth p 1)) "as"))
          (ml-collect-params-loop
            params
            (+ i 1)
            (append result (ml-mangle (symbol-name (first p)))))
          (= (type-of p) "symbol")
          (ml-collect-params-loop
            params
            (+ i 1)
            (append result (ml-mangle (symbol-name p))))
          :else (ml-collect-params-loop params (+ i 1) (append result (str p))))))))

(define
  ml-emit-let
  (fn
    (expr (set-vars :as list))
    (let
      ((bindings (nth expr 1)) (body (rest (rest expr))))
      (let
        ((parsed (ml-parse-bindings-full bindings set-vars)))
        (let
          ((dyn-additions (reduce (fn (acc b) (let ((vname (first b)) (is-fn (nth b 2))) (if is-fn acc (append acc (str "dyn:" vname))))) (list) parsed)))
          (let
            ((body-set-vars (append set-vars dyn-additions)))
            (let
              ((binding-strs (map (fn (b) (let ((vname (first b)) (vval (nth b 1))) (if (some (fn (sv) (= sv vname)) set-vars) (str "let " vname " = ref (" vval ") in") (str "let " vname " = " vval " in")))) parsed))
                (body-str
                  (if
                    (= (len body) 1)
                    (ml-expr-inner (first body) body-set-vars)
                    (ml-emit-do body body-set-vars))))
              (str "(" (join " " binding-strs) " " body-str ")"))))))))

(define
  ml-is-fn-expr?
  (fn
    (expr)
    (and
      (list? expr)
      (not (empty? expr))
      (= (type-of (first expr)) "symbol")
      (or
        (= (symbol-name (first expr)) "fn")
        (= (symbol-name (first expr)) "lambda")))))

(define
  ml-parse-bindings-full
  (fn
    (bindings (set-vars :as list))
    (if
      (and (list? bindings) (not (empty? bindings)))
      (if
        (list? (first bindings))
        (map
          (fn
            (b)
            (let
              ((vname (if (= (type-of (first b)) "symbol") (symbol-name (first b)) (str (first b)))))
              (list
                (ml-mangle vname)
                (ml-expr-inner (nth b 1) set-vars)
                (ml-is-fn-expr? (nth b 1)))))
          bindings)
        (ml-parse-clojure-bindings-full bindings 0 (list) set-vars))
      (list))))

(define
  ml-parse-clojure-bindings-full
  (fn
    (bindings (i :as number) (result :as list) (set-vars :as list))
    (if
      (>= i (- (len bindings) 1))
      result
      (let
        ((vname (if (= (type-of (nth bindings i)) "symbol") (symbol-name (nth bindings i)) (str (nth bindings i))))
          (val-expr (nth bindings (+ i 1))))
        (ml-parse-clojure-bindings-full
          bindings
          (+ i 2)
          (append
            result
            (list
              (ml-mangle vname)
              (ml-expr-inner val-expr set-vars)
              (ml-is-fn-expr? val-expr)))
          set-vars)))))

(define
  ml-parse-bindings
  (fn
    (bindings (set-vars :as list))
    (if
      (and (list? bindings) (not (empty? bindings)))
      (if
        (list? (first bindings))
        (map
          (fn
            (b)
            (let
              ((vname (if (= (type-of (first b)) "symbol") (symbol-name (first b)) (str (first b)))))
              (list (ml-mangle vname) (ml-expr-inner (nth b 1) set-vars))))
          bindings)
        (ml-parse-clojure-bindings bindings 0 (list) set-vars))
      (list))))

(define
  ml-parse-clojure-bindings
  (fn
    (bindings (i :as number) (result :as list) (set-vars :as list))
    (if
      (>= i (- (len bindings) 1))
      result
      (let
        ((vname (if (= (type-of (nth bindings i)) "symbol") (symbol-name (nth bindings i)) (str (nth bindings i)))))
        (ml-parse-clojure-bindings
          bindings
          (+ i 2)
          (append
            result
            (list
              (ml-mangle vname)
              (ml-expr-inner (nth bindings (+ i 1)) set-vars)))
          set-vars)))))

(define
  ml-emit-when
  (fn
    (expr (set-vars :as list))
    (let
      ((cond-e (ml-expr-inner (nth expr 1) set-vars))
        (body-parts (rest (rest expr))))
      (if
        (= (len body-parts) 1)
        (str
          "(if sx_truthy ("
          cond-e
          ") then "
          (ml-expr-inner (first body-parts) set-vars)
          " else Nil)")
        (str
          "(if sx_truthy ("
          cond-e
          ") then "
          (ml-emit-do body-parts set-vars)
          " else Nil)")))))

(define
  ml-emit-cond
  (fn
    ((clauses :as list) (set-vars :as list))
    (if
      (empty? clauses)
      "Nil"
      (let
        ((is-scheme (and (every? (fn (c) (and (list? c) (= (len c) 2))) clauses) (not (some (fn (c) (= (type-of c) "keyword")) clauses)))))
        (if
          is-scheme
          (ml-cond-scheme clauses set-vars)
          (ml-cond-clojure clauses set-vars))))))

(define
  ml-is-else?
  (fn
    (test)
    (or
      (and
        (= (type-of test) "symbol")
        (or
          (= (symbol-name test) "else")
          (= (symbol-name test) ":else")
          (= (symbol-name test) "_")))
      (and (= (type-of test) "keyword") (= (keyword-name test) "else")))))

(define
  ml-cond-scheme
  (fn
    ((clauses :as list) (set-vars :as list))
    (if
      (empty? clauses)
      "Nil"
      (let
        ((clause (first clauses))
          (test (first clause))
          (body (nth clause 1)))
        (if
          (ml-is-else? test)
          (ml-expr-inner body set-vars)
          (str
            "(if sx_truthy ("
            (ml-expr-inner test set-vars)
            ") then "
            (ml-expr-inner body set-vars)
            " else "
            (ml-cond-scheme (rest clauses) set-vars)
            ")"))))))

(define
  ml-cond-clojure
  (fn
    ((clauses :as list) (set-vars :as list))
    (if
      (< (len clauses) 2)
      "Nil"
      (let
        ((test (first clauses)) (body (nth clauses 1)))
        (if
          (ml-is-else? test)
          (ml-expr-inner body set-vars)
          (str
            "(if sx_truthy ("
            (ml-expr-inner test set-vars)
            ") then "
            (ml-expr-inner body set-vars)
            " else "
            (ml-cond-clojure (rest (rest clauses)) set-vars)
            ")"))))))

(define
  ml-emit-case
  (fn
    ((args :as list) (set-vars :as list))
    (let
      ((match-expr (ml-expr-inner (first args) set-vars))
        (clauses (rest args)))
      (str
        "(let _match_val = "
        match-expr
        " in "
        (ml-case-chain clauses set-vars)
        ")"))))

(define
  ml-case-chain
  (fn
    ((clauses :as list) (set-vars :as list))
    (if
      (empty? clauses)
      "Nil"
      (let
        ((clause (first clauses)))
        (if
          (list? clause)
          (let
            ((test (first clause)) (body (nth clause 1)))
            (if
              (ml-is-else? test)
              (ml-expr-inner body set-vars)
              (str
                "(if sx_truthy ((prim_call \"=\" [_match_val; "
                (ml-expr-inner test set-vars)
                "])) then "
                (ml-expr-inner body set-vars)
                " else "
                (ml-case-chain (rest clauses) set-vars)
                ")")))
          (if
            (< (len clauses) 2)
            "Nil"
            (let
              ((test (first clauses)) (body (nth clauses 1)))
              (if
                (ml-is-else? test)
                (ml-expr-inner body set-vars)
                (str
                  "(if _match_val = "
                  (ml-expr-inner test set-vars)
                  " then "
                  (ml-expr-inner body set-vars)
                  " else "
                  (ml-case-chain (rest (rest clauses)) set-vars)
                  ")")))))))))

(define
  ml-emit-and
  (fn
    ((args :as list) (set-vars :as list))
    (if
      (= (len args) 1)
      (ml-expr-inner (first args) set-vars)
      (let
        ((parts (map (fn (x) (ml-expr-inner x set-vars)) args)))
        (ml-and-chain parts)))))

(define
  ml-and-chain
  (fn
    ((parts :as list))
    (if
      (= (len parts) 1)
      (first parts)
      (str
        "(let _and = "
        (first parts)
        " in if not (sx_truthy _and) then _and else "
        (ml-and-chain (rest parts))
        ")"))))

(define
  ml-emit-or
  (fn
    ((args :as list) (set-vars :as list))
    (if
      (= (len args) 1)
      (ml-expr-inner (first args) set-vars)
      (let
        ((parts (map (fn (x) (ml-expr-inner x set-vars)) args)))
        (ml-or-chain parts)))))

(define
  ml-or-chain
  (fn
    ((parts :as list))
    (if
      (= (len parts) 1)
      (first parts)
      (str
        "(let _or = "
        (first parts)
        " in if sx_truthy _or then _or else "
        (ml-or-chain (rest parts))
        ")"))))

(define
  ml-emit-do
  (fn
    ((args :as list) (set-vars :as list))
    (if
      (= (len args) 1)
      (ml-expr-inner (first args) set-vars)
      (ml-emit-do-chain args 0 set-vars))))

(define
  ml-is-define?
  (fn
    (expr)
    (and
      (list? expr)
      (not (empty? expr))
      (= (type-of (first expr)) "symbol")
      (= (symbol-name (first expr)) "define"))))

(define
  ml-emit-do-chain
  (fn
    ((args :as list) (i :as number) (set-vars :as list))
    (if
      (>= i (len args))
      "Nil"
      (let
        ((expr (nth args i)) (is-last (= i (- (len args) 1))))
        (if
          (ml-is-define? expr)
          (let
            ((name (if (= (type-of (nth expr 1)) "symbol") (symbol-name (nth expr 1)) (str (nth expr 1))))
              (val-expr (nth expr 2)))
            (let
              ((ml-name (ml-mangle name))
                (is-fn
                  (and
                    (list? val-expr)
                    (not (empty? val-expr))
                    (= (type-of (first val-expr)) "symbol")
                    (or
                      (= (symbol-name (first val-expr)) "fn")
                      (= (symbol-name (first val-expr)) "lambda"))))
                (is-recursive (ml-is-self-recursive? name val-expr)))
              (let
                ((rec-kw (if is-recursive "rec " ""))
                  (val-str
                    (if
                      (and is-fn is-recursive)
                      (ml-emit-fn-bare val-expr set-vars)
                      (ml-expr-inner val-expr set-vars)))
                  (rest-str (ml-emit-do-chain args (+ i 1) set-vars)))
                (str "(let " rec-kw ml-name " = " val-str " in " rest-str ")"))))
          (if
            is-last
            (ml-expr-inner expr set-vars)
            (str
              "(let () = ignore ("
              (ml-expr-inner expr set-vars)
              ") in "
              (ml-emit-do-chain args (+ i 1) set-vars)
              ")")))))))

(define
  ml-is-inline-fn?
  (fn
    (expr)
    (and
      (list? expr)
      (not (empty? expr))
      (= (type-of (first expr)) "symbol")
      (or
        (= (symbol-name (first expr)) "fn")
        (= (symbol-name (first expr)) "lambda")))))

(define
  ml-emit-ho-form
  (fn
    ((ocaml-fn :as string)
      (wrap-pre :as string)
      (wrap-post :as string)
      (result-wrap :as string)
      (args :as list)
      (set-vars :as list))
    (let
      ((fn-arg (first args))
        (coll-arg (nth args 1))
        (needs-bool
          (or
            (= ocaml-fn "List.filter")
            (= ocaml-fn "List.exists")
            (= ocaml-fn "List.for_all"))))
      (if
        (ml-is-inline-fn? fn-arg)
        (let
          ((params (nth fn-arg 1))
            (body (rest (rest fn-arg)))
            (param-strs (ml-collect-params params)))
          (let
            ((param-str (if (empty? param-strs) "_" (first param-strs)))
              (body-str
                (if
                  (= (len body) 1)
                  (ml-expr-inner (first body) set-vars)
                  (ml-emit-do body set-vars))))
            (let
              ((wrapped-body (if needs-bool (str "sx_truthy (" body-str ")") body-str)))
              (str
                "("
                result-wrap
                " ("
                ocaml-fn
                " (fun "
                param-str
                " -> "
                wrapped-body
                ") (sx_to_list "
                (ml-expr-inner coll-arg set-vars)
                ")))"))))
        (let
          ((fn-str (ml-expr-inner fn-arg set-vars)))
          (if
            needs-bool
            (str
              "("
              result-wrap
              " ("
              ocaml-fn
              " (fun _x -> sx_truthy (cek_call "
              fn-str
              " (List [_x])))"
              " (sx_to_list "
              (ml-expr-inner coll-arg set-vars)
              ")))")
            (str
              "("
              result-wrap
              " ("
              ocaml-fn
              " (fun _x -> cek_call "
              fn-str
              " (List [_x]))"
              " (sx_to_list "
              (ml-expr-inner coll-arg set-vars)
              ")))")))))))

(define
  ml-emit-ho-indexed
  (fn
    ((args :as list) (set-vars :as list))
    (let
      ((fn-arg (first args)) (coll-arg (nth args 1)))
      (if
        (ml-is-inline-fn? fn-arg)
        (let
          ((params (nth fn-arg 1))
            (body (rest (rest fn-arg)))
            (param-strs (ml-collect-params params)))
          (let
            ((i-param (if (>= (len param-strs) 1) (first param-strs) "_i"))
              (v-param
                (if (>= (len param-strs) 2) (nth param-strs 1) "_v"))
              (body-str
                (if
                  (= (len body) 1)
                  (ml-expr-inner (first body) set-vars)
                  (ml-emit-do body set-vars))))
            (str
              "(List (List.mapi (fun "
              i-param
              " "
              v-param
              " -> let "
              i-param
              " = Number (float_of_int "
              i-param
              ") in "
              body-str
              ") (sx_to_list "
              (ml-expr-inner coll-arg set-vars)
              ")))")))
        (str
          "(List (List.mapi (fun _i _x -> cek_call "
          (ml-expr-inner fn-arg set-vars)
          " (List [Number (float_of_int _i); _x])) (sx_to_list "
          (ml-expr-inner coll-arg set-vars)
          ")))")))))

(define
  ml-emit-reduce
  (fn
    ((args :as list) (set-vars :as list))
    (let
      ((fn-arg (first args))
        (init-arg (nth args 1))
        (coll-arg (nth args 2)))
      (if
        (ml-is-inline-fn? fn-arg)
        (let
          ((params (nth fn-arg 1))
            (body (rest (rest fn-arg)))
            (param-strs (ml-collect-params params)))
          (let
            ((raw-acc (if (>= (len param-strs) 1) (first param-strs) "_acc"))
              (x-param
                (if (>= (len param-strs) 2) (nth param-strs 1) "_x"))
              (body-str
                (if
                  (= (len body) 1)
                  (ml-expr-inner (first body) set-vars)
                  (ml-emit-do body set-vars)))
              (acc-param
                (if
                  (string-contains? body-str raw-acc)
                  raw-acc
                  (if (starts-with? raw-acc "_") raw-acc (str "_" raw-acc)))))
            (str
              "(List.fold_left (fun "
              acc-param
              " "
              x-param
              " -> "
              body-str
              ") "
              (ml-expr-inner init-arg set-vars)
              " (sx_to_list "
              (ml-expr-inner coll-arg set-vars)
              "))")))
        (str
          "(List.fold_left (fun _acc _x -> cek_call "
          (ml-expr-inner fn-arg set-vars)
          " (List [_acc; _x])) "
          (ml-expr-inner init-arg set-vars)
          " (sx_to_list "
          (ml-expr-inner coll-arg set-vars)
          "))")))))

(define
  ml-emit-for-each
  (fn
    ((args :as list) (set-vars :as list))
    (let
      ((fn-arg (first args)) (coll-arg (nth args 1)))
      (if
        (ml-is-inline-fn? fn-arg)
        (let
          ((params (nth fn-arg 1))
            (body (rest (rest fn-arg)))
            (param-strs (ml-collect-params params)))
          (let
            ((param-str (if (empty? param-strs) "_" (first param-strs)))
              (body-str
                (if
                  (= (len body) 1)
                  (ml-expr-inner (first body) set-vars)
                  (ml-emit-do body set-vars))))
            (str
              "(List.iter (fun "
              param-str
              " -> ignore ("
              body-str
              ")) (sx_to_list "
              (ml-expr-inner coll-arg set-vars)
              "); Nil)")))
        (str
          "(List.iter (fun _x -> ignore (cek_call "
          (ml-expr-inner fn-arg set-vars)
          " (List [_x]))) (sx_to_list "
          (ml-expr-inner coll-arg set-vars)
          "); Nil)")))))

(define
  ml-emit-map-dict
  (fn
    ((args :as list) (set-vars :as list))
    (let
      ((fn-arg (first args)) (dict-arg (nth args 1)))
      (if
        (ml-is-inline-fn? fn-arg)
        (let
          ((params (nth fn-arg 1))
            (body (rest (rest fn-arg)))
            (param-strs (ml-collect-params params)))
          (let
            ((k-param (if (>= (len param-strs) 1) (first param-strs) "_k"))
              (v-param
                (if (>= (len param-strs) 2) (nth param-strs 1) "_v"))
              (body-str
                (if
                  (= (len body) 1)
                  (ml-expr-inner (first body) set-vars)
                  (ml-emit-do body set-vars))))
            (str
              "(match "
              (ml-expr-inner dict-arg set-vars)
              " with Dict _tbl -> "
              "let _r = Hashtbl.create (Hashtbl.length _tbl) in "
              "Hashtbl.iter (fun "
              k-param
              " "
              v-param
              " -> "
              "let "
              k-param
              " = String "
              k-param
              " in "
              "Hashtbl.replace _r (value_to_str "
              k-param
              ") ("
              body-str
              ")) _tbl; "
              "Dict _r | _ -> raise (Eval_error \"map-dict: expected dict\"))")))
        (let
          ((fn-str (ml-expr-inner fn-arg set-vars)))
          (str
            "(match "
            (ml-expr-inner dict-arg set-vars)
            " with Dict _tbl -> "
            "let _r = Hashtbl.create (Hashtbl.length _tbl) in "
            "Hashtbl.iter (fun _k _v -> "
            "Hashtbl.replace _r _k (cek_call "
            fn-str
            " (List [String _k; _v]))) _tbl; "
            "Dict _r | _ -> raise (Eval_error \"map-dict: expected dict\"))"))))))

(define
  ml-emit-dict-call
  (fn
    ((pairs :as list) (set-vars :as list))
    (let
      ((n (len pairs)))
      (if
        (= n 0)
        "(Dict (Hashtbl.create 0))"
        (str
          "(let _d = Hashtbl.create "
          (str (round (/ n 2)))
          " in "
          (ml-dict-pairs pairs 0 set-vars)
          " Dict _d)")))))

(define
  ml-dict-pairs
  (fn
    ((pairs :as list) (i :as number) (set-vars :as list))
    (if
      (>= i (- (len pairs) 1))
      ""
      (let
        ((key (nth pairs i)) (val (nth pairs (+ i 1))))
        (let
          ((key-str (if (= (type-of key) "keyword") (ml-quote-string (keyword-name key)) (str "(value_to_str " (ml-expr-inner key set-vars) ")")))
            (val-str (ml-expr-inner val set-vars)))
          (str
            "Hashtbl.replace _d "
            key-str
            " "
            val-str
            "; "
            (ml-dict-pairs pairs (+ i 2) set-vars)))))))

(define
  ml-emit-quote
  (fn
    (expr)
    (cond
      (= (type-of expr) "boolean")
      (if expr "(Bool true)" "(Bool false)")
      (number? expr)
      (str "(Number " (str expr) ")")
      (string? expr)
      (str "(String " (ml-quote-string expr) ")")
      (nil? expr)
      "Nil"
      (= (type-of expr) "symbol")
      (str "(Symbol " (ml-quote-string (symbol-name expr)) ")")
      (= (type-of expr) "keyword")
      (str "(Keyword " (ml-quote-string (keyword-name expr)) ")")
      (list? expr)
      (str "(List [" (join "; " (map ml-emit-quote expr)) "])")
      :else (str "(* quote fallback *) " (str expr)))))

(define
  ml-emit-define
  (fn
    (expr)
    (let
      ((name (if (= (type-of (nth expr 1)) "symbol") (symbol-name (nth expr 1)) (str (nth expr 1))))
        (val-expr
          (let ((raw (nth expr 2))) (if (keyword? raw) (last expr) raw))))
      (let
        ((ml-name (ml-mangle name))
          (is-fn
            (and
              (list? val-expr)
              (not (empty? val-expr))
              (= (type-of (first val-expr)) "symbol")
              (or
                (= (symbol-name (first val-expr)) "fn")
                (= (symbol-name (first val-expr)) "lambda"))))
          (is-recursive (ml-is-self-recursive? name val-expr)))
        (let
          ((rec-kw (if is-recursive "rec " "")))
          (if
            is-fn
            (let
              ((params (nth val-expr 1))
                (body (rest (rest val-expr)))
                (param-strs (ml-collect-params params))
                (set-targets (ml-find-set-targets body))
                (let-bound (ml-find-let-bound-names body)))
              (let
                ((params-str (if (empty? param-strs) "()" (join " " param-strs)))
                  (all-set-vars set-targets)
                  (needs-ref
                    (filter
                      (fn (v) (not (some (fn (lb) (= lb v)) let-bound)))
                      set-targets)))
                (if
                  (empty? set-targets)
                  (if
                    (= (len body) 1)
                    (str
                      "let "
                      rec-kw
                      ml-name
                      " "
                      params-str
                      " =\n  "
                      (ml-expr-inner (first body) all-set-vars)
                      "\n")
                    (str
                      "let "
                      rec-kw
                      ml-name
                      " "
                      params-str
                      " =\n  "
                      (ml-emit-do body all-set-vars)
                      "\n"))
                  (let
                    ((ref-decls (if (empty? needs-ref) "" (str (join " " (map (fn (v) (str "let " v " = ref Nil in")) needs-ref)) " ")))
                      (body-str
                        (if
                          (= (len body) 1)
                          (ml-expr-inner (first body) all-set-vars)
                          (ml-emit-do body all-set-vars))))
                    (str
                      "let "
                      rec-kw
                      ml-name
                      " "
                      params-str
                      " =\n  "
                      ref-decls
                      body-str
                      "\n")))))
            (if
              (ml-is-mutable-global? name)
              (str
                "let "
                ml-name
                "ref = ref "
                (ml-expr val-expr)
                "\nand "
                ml-name
                " =\n  "
                (ml-expr val-expr)
                "\n")
              (str "let " ml-name " =\n  " (ml-expr val-expr) "\n"))))))))

(define
  ml-translate-file
  (fn
    ((defines :as list))
    (let
      ((parts (map (fn (pair) (let ((name (first pair)) (expr (nth pair 1))) (str "(* " name " *)\n" (ml-emit-define-body expr)))) defines)))
      (if
        (empty? parts)
        ""
        (str
          (first parts)
          "\n"
          (join
            "\n"
            (map
              (fn
                (p)
                (let
                  ((nl-idx (index-of p "\n")))
                  (if
                    (and (number? nl-idx) (>= nl-idx 0))
                    (let
                      ((before (slice p 0 nl-idx))
                        (after (slice p (+ nl-idx 1))))
                      (cond
                        (starts-with? after "let rec ")
                        (str before "\nand " (slice after 8))
                        (starts-with? after "let ")
                        (str before "\nand " (slice after 4))
                        :else p))
                    (cond
                      (starts-with? p "let rec ")
                      (str "and " (slice p 8))
                      (starts-with? p "let ")
                      (str "and " (slice p 4))
                      :else p))))
              (rest parts))))))))

(define
  ml-emit-define-body
  (fn
    (expr)
    (let
      ((name (if (= (type-of (nth expr 1)) "symbol") (symbol-name (nth expr 1)) (str (nth expr 1))))
        (val-expr
          (let ((raw (nth expr 2))) (if (keyword? raw) (last expr) raw))))
      (let
        ((ml-name (ml-mangle name))
          (is-fn
            (and
              (list? val-expr)
              (not (empty? val-expr))
              (= (type-of (first val-expr)) "symbol")
              (or
                (= (symbol-name (first val-expr)) "fn")
                (= (symbol-name (first val-expr)) "lambda")))))
        (if
          is-fn
          (let
            ((params (nth val-expr 1))
              (body (rest (rest val-expr)))
              (param-strs (ml-collect-params params))
              (set-targets (ml-find-set-targets body))
              (let-bound (ml-find-let-bound-names body)))
            (let
              ((params-str (if (empty? param-strs) "()" (join " " param-strs)))
                (needs-ref
                  (filter
                    (fn (v) (not (some (fn (lb) (= lb v)) let-bound)))
                    set-targets)))
              (if
                (empty? set-targets)
                (if
                  (= (len body) 1)
                  (str
                    "let rec "
                    ml-name
                    " "
                    params-str
                    " =\n  "
                    (ml-expr-inner (first body) set-targets)
                    "\n")
                  (str
                    "let rec "
                    ml-name
                    " "
                    params-str
                    " =\n  "
                    (ml-emit-do body set-targets)
                    "\n"))
                (let
                  ((ref-decls (if (empty? needs-ref) "" (str (join " " (map (fn (v) (str "let " v " = ref Nil in")) needs-ref)) " ")))
                    (body-str
                      (if
                        (= (len body) 1)
                        (ml-expr-inner (first body) set-targets)
                        (ml-emit-do body set-targets))))
                  (str
                    "let rec "
                    ml-name
                    " "
                    params-str
                    " =\n  "
                    ref-decls
                    body-str
                    "\n")))))
          (if
            (ml-is-mutable-global? name)
            (str
              "let rec "
              ml-name
              "ref = ref "
              (ml-expr val-expr)
              "\nand "
              ml-name
              " =\n  "
              (ml-expr val-expr)
              "\n")
            (str "let rec " ml-name " =\n  " (ml-expr val-expr) "\n")))))))
