giles
b4944aa2b6
py.sx is an SX-to-Python translator written in SX. Running it on the Python evaluator against the spec files produces byte-for-byte identical output to the hand-written bootstrap_py.py (128/128 defines match, 1490 lines, 88955 bytes). The bootstrapper bootstraps itself: G0 (Python) == G1 (SX). Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
1183 lines
45 KiB
Plaintext
1183 lines
45 KiB
Plaintext
;; ==========================================================================
|
|
;; py.sx — SX-to-Python translator, written in SX
|
|
;;
|
|
;; Translates (define ...) forms from .sx spec files into Python source.
|
|
;; This is the self-hosting bootstrapper: the Python evaluator executes
|
|
;; this file against the spec to produce sx_ref.py — identical output to
|
|
;; the hand-written bootstrap_py.py.
|
|
;;
|
|
;; Usage (from SX):
|
|
;; (py-expr expr) — translate one expression to Python
|
|
;; (py-statement expr indent) — translate to Python statement
|
|
;; (py-translate-file defines) — translate a list of (name . define-expr) pairs
|
|
;;
|
|
;; Usage (as reader macro):
|
|
;; #py(define foo (fn (x) (+ x 1)))
|
|
;; → "foo = lambda x: (x + 1)"
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Python reserved words — names that get _ suffix
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-reserved
|
|
(list "False" "None" "True" "and" "as" "assert" "async" "await"
|
|
"break" "class" "continue" "def" "del" "elif" "else" "except"
|
|
"finally" "for" "from" "global" "if" "import" "in" "is"
|
|
"lambda" "nonlocal" "not" "or" "pass" "raise" "return" "try"
|
|
"while" "with" "yield"
|
|
"default" "type" "id" "input" "open" "print" "set" "super"))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; RENAMES table — explicit SX name → Python name mappings
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-renames {
|
|
:nil "NIL"
|
|
:true "True"
|
|
:false "False"
|
|
"nil?" "is_nil"
|
|
"type-of" "type_of"
|
|
"symbol-name" "symbol_name"
|
|
"keyword-name" "keyword_name"
|
|
"make-lambda" "make_lambda"
|
|
"make-component" "make_component"
|
|
"make-macro" "make_macro"
|
|
"make-thunk" "make_thunk"
|
|
"make-handler-def" "make_handler_def"
|
|
"make-query-def" "make_query_def"
|
|
"make-action-def" "make_action_def"
|
|
"make-page-def" "make_page_def"
|
|
"make-symbol" "make_symbol"
|
|
"make-keyword" "make_keyword"
|
|
"lambda-params" "lambda_params"
|
|
"lambda-body" "lambda_body"
|
|
"lambda-closure" "lambda_closure"
|
|
"lambda-name" "lambda_name"
|
|
"set-lambda-name!" "set_lambda_name"
|
|
"component-params" "component_params"
|
|
"component-body" "component_body"
|
|
"component-closure" "component_closure"
|
|
"component-has-children?" "component_has_children"
|
|
"component-name" "component_name"
|
|
"component-affinity" "component_affinity"
|
|
"macro-params" "macro_params"
|
|
"macro-rest-param" "macro_rest_param"
|
|
"macro-body" "macro_body"
|
|
"macro-closure" "macro_closure"
|
|
"thunk?" "is_thunk"
|
|
"thunk-expr" "thunk_expr"
|
|
"thunk-env" "thunk_env"
|
|
"callable?" "is_callable"
|
|
"lambda?" "is_lambda"
|
|
"component?" "is_component"
|
|
"island?" "is_island"
|
|
"make-island" "make_island"
|
|
"make-signal" "make_signal"
|
|
"signal?" "is_signal"
|
|
"signal-value" "signal_value"
|
|
"signal-set-value!" "signal_set_value"
|
|
"signal-subscribers" "signal_subscribers"
|
|
"signal-add-sub!" "signal_add_sub"
|
|
"signal-remove-sub!" "signal_remove_sub"
|
|
"signal-deps" "signal_deps"
|
|
"signal-set-deps!" "signal_set_deps"
|
|
"set-tracking-context!" "set_tracking_context"
|
|
"get-tracking-context" "get_tracking_context"
|
|
"make-tracking-context" "make_tracking_context"
|
|
"tracking-context-deps" "tracking_context_deps"
|
|
"tracking-context-add-dep!" "tracking_context_add_dep"
|
|
"tracking-context-notify-fn" "tracking_context_notify_fn"
|
|
"identical?" "is_identical"
|
|
"notify-subscribers" "notify_subscribers"
|
|
"flush-subscribers" "flush_subscribers"
|
|
"dispose-computed" "dispose_computed"
|
|
"with-island-scope" "with_island_scope"
|
|
"register-in-scope" "register_in_scope"
|
|
"*batch-depth*" "_batch_depth"
|
|
"*batch-queue*" "_batch_queue"
|
|
"*island-scope*" "_island_scope"
|
|
"*store-registry*" "_store_registry"
|
|
"def-store" "def_store"
|
|
"use-store" "use_store"
|
|
"clear-stores" "clear_stores"
|
|
"emit-event" "emit_event"
|
|
"on-event" "on_event"
|
|
"bridge-event" "bridge_event"
|
|
"dom-listen" "dom_listen"
|
|
"dom-dispatch" "dom_dispatch"
|
|
"event-detail" "event_detail"
|
|
"macro?" "is_macro"
|
|
"primitive?" "is_primitive"
|
|
"get-primitive" "get_primitive"
|
|
"env-has?" "env_has"
|
|
"env-get" "env_get"
|
|
"env-set!" "env_set"
|
|
"env-extend" "env_extend"
|
|
"env-merge" "env_merge"
|
|
"dict-set!" "dict_set"
|
|
"dict-get" "dict_get"
|
|
"dict-has?" "dict_has"
|
|
"dict-delete!" "dict_delete"
|
|
"eval-expr" "eval_expr"
|
|
"eval-list" "eval_list"
|
|
"eval-call" "eval_call"
|
|
"is-render-expr?" "is_render_expr"
|
|
"render-expr" "render_expr"
|
|
"call-lambda" "call_lambda"
|
|
"call-component" "call_component"
|
|
"parse-keyword-args" "parse_keyword_args"
|
|
"parse-comp-params" "parse_comp_params"
|
|
"parse-macro-params" "parse_macro_params"
|
|
"expand-macro" "expand_macro"
|
|
"render-to-html" "render_to_html"
|
|
"render-to-sx" "render_to_sx"
|
|
"render-value-to-html" "render_value_to_html"
|
|
"render-list-to-html" "render_list_to_html"
|
|
"render-html-element" "render_html_element"
|
|
"render-html-component" "render_html_component"
|
|
"parse-element-args" "parse_element_args"
|
|
"render-attrs" "render_attrs"
|
|
"aser-list" "aser_list"
|
|
"aser-fragment" "aser_fragment"
|
|
"aser-call" "aser_call"
|
|
"aser-special" "aser_special"
|
|
"sf-if" "sf_if"
|
|
"sf-when" "sf_when"
|
|
"sf-cond" "sf_cond"
|
|
"sf-cond-scheme" "sf_cond_scheme"
|
|
"sf-cond-clojure" "sf_cond_clojure"
|
|
"sf-case" "sf_case"
|
|
"sf-case-loop" "sf_case_loop"
|
|
"sf-and" "sf_and"
|
|
"sf-or" "sf_or"
|
|
"sf-let" "sf_let"
|
|
"sf-lambda" "sf_lambda"
|
|
"sf-define" "sf_define"
|
|
"sf-defcomp" "sf_defcomp"
|
|
"defcomp-kwarg" "defcomp_kwarg"
|
|
"sf-defmacro" "sf_defmacro"
|
|
"sf-begin" "sf_begin"
|
|
"sf-quote" "sf_quote"
|
|
"sf-quasiquote" "sf_quasiquote"
|
|
"sf-thread-first" "sf_thread_first"
|
|
"sf-set!" "sf_set_bang"
|
|
"sf-reset" "sf_reset"
|
|
"sf-shift" "sf_shift"
|
|
"qq-expand" "qq_expand"
|
|
"ho-map" "ho_map"
|
|
"ho-map-indexed" "ho_map_indexed"
|
|
"ho-filter" "ho_filter"
|
|
"ho-reduce" "ho_reduce"
|
|
"ho-some" "ho_some"
|
|
"ho-every" "ho_every"
|
|
"ho-for-each" "ho_for_each"
|
|
"sf-defstyle" "sf_defstyle"
|
|
"special-form?" "is_special_form"
|
|
"ho-form?" "is_ho_form"
|
|
"strip-prefix" "strip_prefix"
|
|
"escape-html" "escape_html"
|
|
"escape-attr" "escape_attr"
|
|
"escape-string" "escape_string"
|
|
"raw-html-content" "raw_html_content"
|
|
"HTML_TAGS" "HTML_TAGS"
|
|
"VOID_ELEMENTS" "VOID_ELEMENTS"
|
|
"BOOLEAN_ATTRS" "BOOLEAN_ATTRS"
|
|
"definition-form?" "is_definition_form"
|
|
"RENDER_HTML_FORMS" "RENDER_HTML_FORMS"
|
|
"render-html-form?" "is_render_html_form"
|
|
"dispatch-html-form" "dispatch_html_form"
|
|
"render-lambda-html" "render_lambda_html"
|
|
"make-raw-html" "make_raw_html"
|
|
"render-html-island" "render_html_island"
|
|
"serialize-island-state" "serialize_island_state"
|
|
"json-serialize" "json_serialize"
|
|
"empty-dict?" "is_empty_dict"
|
|
"sf-defisland" "sf_defisland"
|
|
"render-to-sx" "render_to_sx"
|
|
"aser" "aser"
|
|
"eval-case-aser" "eval_case_aser"
|
|
"sx-serialize" "sx_serialize"
|
|
"sx-serialize-dict" "sx_serialize_dict"
|
|
"sx-expr-source" "sx_expr_source"
|
|
"contains?" "contains_p"
|
|
"starts-with?" "starts_with_p"
|
|
"ends-with?" "ends_with_p"
|
|
"empty?" "empty_p"
|
|
"every?" "every_p"
|
|
"for-each" "for_each"
|
|
"for-each-indexed" "for_each_indexed"
|
|
"map-indexed" "map_indexed"
|
|
"map-dict" "map_dict"
|
|
"eval-cond" "eval_cond"
|
|
"eval-cond-scheme" "eval_cond_scheme"
|
|
"eval-cond-clojure" "eval_cond_clojure"
|
|
"process-bindings" "process_bindings"
|
|
"scan-refs" "scan_refs"
|
|
"scan-refs-walk" "scan_refs_walk"
|
|
"transitive-deps" "transitive_deps"
|
|
"compute-all-deps" "compute_all_deps"
|
|
"scan-components-from-source" "scan_components_from_source"
|
|
"components-needed" "components_needed"
|
|
"page-component-bundle" "page_component_bundle"
|
|
"page-css-classes" "page_css_classes"
|
|
"component-deps" "component_deps"
|
|
"component-set-deps!" "component_set_deps"
|
|
"component-css-classes" "component_css_classes"
|
|
"component-io-refs" "component_io_refs"
|
|
"component-set-io-refs!" "component_set_io_refs"
|
|
"env-components" "env_components"
|
|
"regex-find-all" "regex_find_all"
|
|
"scan-css-classes" "scan_css_classes"
|
|
"scan-io-refs" "scan_io_refs"
|
|
"scan-io-refs-walk" "scan_io_refs_walk"
|
|
"transitive-io-refs" "transitive_io_refs"
|
|
"compute-all-io-refs" "compute_all_io_refs"
|
|
"component-pure?" "component_pure_p"
|
|
"render-target" "render_target"
|
|
"page-render-plan" "page_render_plan"
|
|
"split-path-segments" "split_path_segments"
|
|
"make-route-segment" "make_route_segment"
|
|
"parse-route-pattern" "parse_route_pattern"
|
|
"match-route-segments" "match_route_segments"
|
|
"match-route" "match_route"
|
|
"find-matching-route" "find_matching_route"
|
|
})
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Name mangling: SX identifier → valid Python identifier
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-mangle
|
|
(fn (name)
|
|
(let ((renamed (get py-renames name)))
|
|
(if (not (nil? renamed))
|
|
renamed
|
|
;; General mangling rules
|
|
(let ((result name))
|
|
;; Handle trailing ? and !
|
|
(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)))
|
|
;; Kebab to snake_case
|
|
(let ((result (replace result "-" "_")))
|
|
;; Escape Python reserved words
|
|
(if (some (fn (r) (= r result)) py-reserved)
|
|
(str result "_")
|
|
result))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; String quoting for Python
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-quote-string
|
|
(fn (s)
|
|
;; Produce a Python repr-style string literal
|
|
(str "'" (replace (replace (replace (replace s "\\" "\\\\") "'" "\\'") "\n" "\\n") "\t" "\\t") "'")))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Infix operators
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-infix-ops
|
|
(list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod"))
|
|
|
|
(define py-infix?
|
|
(fn (op)
|
|
(some (fn (x) (= x op)) py-infix-ops)))
|
|
|
|
(define py-op-symbol
|
|
(fn (op)
|
|
(case op
|
|
"=" "=="
|
|
"!=" "!="
|
|
"mod" "%"
|
|
:else op)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Cell variable detection: find set! targets crossing lambda boundaries
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-find-nested-set-vars
|
|
(fn (body)
|
|
;; Returns a list of mangled variable names that are set! from within
|
|
;; nested fn/lambda bodies
|
|
(let ((result (list)))
|
|
(begin
|
|
(for-each (fn (b) (py-scan-set-vars b false result)) body)
|
|
result))))
|
|
|
|
(define py-scan-set-vars
|
|
(fn (node in-nested result)
|
|
(when (and (list? node) (not (empty? node)))
|
|
(let ((head (first node)))
|
|
(cond
|
|
;; fn/lambda — mark as nested and scan body
|
|
(and (= (type-of head) "symbol")
|
|
(or (= (symbol-name head) "fn")
|
|
(= (symbol-name head) "lambda")))
|
|
(for-each (fn (child) (py-scan-set-vars child true result))
|
|
(rest (rest node)))
|
|
;; set! inside nested fn — record the variable
|
|
(and (= (type-of head) "symbol")
|
|
(= (symbol-name head) "set!")
|
|
in-nested
|
|
(>= (len node) 2))
|
|
(let ((var-name (if (= (type-of (nth node 1)) "symbol")
|
|
(symbol-name (nth node 1))
|
|
(str (nth node 1)))))
|
|
(let ((mangled (py-mangle var-name)))
|
|
(when (not (some (fn (x) (= x mangled)) result))
|
|
(append! result mangled))))
|
|
;; Otherwise scan children
|
|
:else
|
|
(for-each (fn (child)
|
|
(when (list? child)
|
|
(py-scan-set-vars child in-nested result)))
|
|
node))))))
|
|
|
|
;; Check if a fn expression's body uses set! anywhere
|
|
(define py-body-uses-set?
|
|
(fn (fn-expr)
|
|
(let ((body (rest (rest fn-expr))))
|
|
(py-has-set? body))))
|
|
|
|
(define py-has-set?
|
|
(fn (nodes)
|
|
(some (fn (node)
|
|
(and (list? node)
|
|
(not (empty? node))
|
|
(or (and (= (type-of (first node)) "symbol")
|
|
(= (symbol-name (first node)) "set!"))
|
|
(py-has-set? (filter (fn (x) (list? x)) node)))))
|
|
nodes)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Expression translator: SX AST → Python expression string
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-expr
|
|
(fn (expr)
|
|
(py-expr-with-cells expr (list))))
|
|
|
|
(define py-expr-with-cells
|
|
(fn (expr cell-vars)
|
|
(cond
|
|
;; Bool MUST come before number check (Python: bool is subclass of int)
|
|
(= (type-of expr) "boolean")
|
|
(if expr "True" "False")
|
|
|
|
;; Nil
|
|
(nil? expr) "NIL"
|
|
|
|
;; Numbers
|
|
(number? expr) (str expr)
|
|
|
|
;; Strings
|
|
(string? expr) (py-quote-string expr)
|
|
|
|
;; Symbols
|
|
(= (type-of expr) "symbol")
|
|
(let ((mangled (py-mangle (symbol-name expr))))
|
|
(if (some (fn (c) (= c mangled)) cell-vars)
|
|
(str "_cells[" (py-quote-string mangled) "]")
|
|
mangled))
|
|
|
|
;; Keywords → string
|
|
(= (type-of expr) "keyword")
|
|
(py-quote-string (keyword-name expr))
|
|
|
|
;; Dicts (native {:key val} syntax)
|
|
(= (type-of expr) "dict")
|
|
(py-emit-native-dict expr cell-vars)
|
|
|
|
;; Lists (function calls / special forms)
|
|
(list? expr)
|
|
(if (empty? expr)
|
|
"[]"
|
|
(py-emit-list expr cell-vars))
|
|
|
|
;; Fallback
|
|
:else (str expr))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Dict emission
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-native-dict
|
|
(fn (d cell-vars)
|
|
(let ((items (keys d)))
|
|
(str "{" (join ", " (map (fn (k)
|
|
(str (py-quote-string k) ": " (py-expr-with-cells (get d k) cell-vars)))
|
|
items)) "}"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; List/call emission — the main dispatch
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-list
|
|
(fn (expr cell-vars)
|
|
(let ((head (first expr))
|
|
(args (rest expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
;; Data list — not a function call
|
|
(str "[" (join ", " (map (fn (x) (py-expr-with-cells x cell-vars)) expr)) "]")
|
|
(let ((op (symbol-name head)))
|
|
(cond
|
|
;; fn/lambda
|
|
(or (= op "fn") (= op "lambda"))
|
|
(py-emit-fn expr cell-vars)
|
|
|
|
;; let/let*
|
|
(or (= op "let") (= op "let*"))
|
|
(py-emit-let expr cell-vars)
|
|
|
|
;; if
|
|
(= op "if")
|
|
(let ((cond-e (py-expr-with-cells (nth args 0) cell-vars))
|
|
(then-e (py-expr-with-cells (nth args 1) cell-vars))
|
|
(else-e (if (>= (len args) 3)
|
|
(py-expr-with-cells (nth args 2) cell-vars)
|
|
"NIL")))
|
|
(str "(" then-e " if sx_truthy(" cond-e ") else " else-e ")"))
|
|
|
|
;; when
|
|
(= op "when")
|
|
(py-emit-when expr cell-vars)
|
|
|
|
;; cond
|
|
(= op "cond")
|
|
(py-emit-cond args cell-vars)
|
|
|
|
;; case
|
|
(= op "case")
|
|
(py-emit-case args cell-vars)
|
|
|
|
;; and
|
|
(= op "and")
|
|
(py-emit-and args cell-vars)
|
|
|
|
;; or
|
|
(= op "or")
|
|
(py-emit-or args cell-vars)
|
|
|
|
;; not
|
|
(= op "not")
|
|
(str "(not sx_truthy(" (py-expr-with-cells (first args) cell-vars) "))")
|
|
|
|
;; do/begin
|
|
(or (= op "do") (= op "begin"))
|
|
(py-emit-do args cell-vars)
|
|
|
|
;; list literal
|
|
(= op "list")
|
|
(str "[" (join ", " (map (fn (x) (py-expr-with-cells x cell-vars)) args)) "]")
|
|
|
|
;; dict literal
|
|
(= op "dict")
|
|
(py-emit-dict-literal args cell-vars)
|
|
|
|
;; quote
|
|
(= op "quote")
|
|
(py-emit-quote (first args))
|
|
|
|
;; set!
|
|
(= op "set!")
|
|
(let ((var-name (if (= (type-of (first args)) "symbol")
|
|
(symbol-name (first args))
|
|
(str (first args)))))
|
|
(let ((mangled (py-mangle var-name)))
|
|
(str "_sx_cell_set(_cells, " (py-quote-string mangled)
|
|
", " (py-expr-with-cells (nth args 1) cell-vars) ")")))
|
|
|
|
;; str
|
|
(= op "str")
|
|
(str "sx_str(" (join ", " (map (fn (x) (py-expr-with-cells x cell-vars)) args)) ")")
|
|
|
|
;; Mutation forms in expression context
|
|
(= op "append!")
|
|
(str "_sx_append(" (py-expr-with-cells (nth args 0) cell-vars)
|
|
", " (py-expr-with-cells (nth args 1) cell-vars) ")")
|
|
|
|
(= op "dict-set!")
|
|
(str "_sx_dict_set(" (py-expr-with-cells (nth args 0) cell-vars)
|
|
", " (py-expr-with-cells (nth args 1) cell-vars)
|
|
", " (py-expr-with-cells (nth args 2) cell-vars) ")")
|
|
|
|
(= op "env-set!")
|
|
(str "_sx_dict_set(" (py-expr-with-cells (nth args 0) cell-vars)
|
|
", " (py-expr-with-cells (nth args 1) cell-vars)
|
|
", " (py-expr-with-cells (nth args 2) cell-vars) ")")
|
|
|
|
(= op "set-lambda-name!")
|
|
(str "_sx_set_attr(" (py-expr-with-cells (nth args 0) cell-vars)
|
|
", 'name', " (py-expr-with-cells (nth args 1) cell-vars) ")")
|
|
|
|
;; Infix operators
|
|
(py-infix? op)
|
|
(py-emit-infix op args cell-vars)
|
|
|
|
;; inc/dec
|
|
(= op "inc")
|
|
(str "(" (py-expr-with-cells (first args) cell-vars) " + 1)")
|
|
(= op "dec")
|
|
(str "(" (py-expr-with-cells (first args) cell-vars) " - 1)")
|
|
|
|
;; Regular function call
|
|
:else
|
|
(str (py-mangle op) "("
|
|
(join ", " (map (fn (x) (py-expr-with-cells x cell-vars)) args))
|
|
")")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; fn/lambda → Python lambda
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-fn
|
|
(fn (expr cell-vars)
|
|
(let ((params (nth expr 1))
|
|
(body (rest (rest expr)))
|
|
(param-strs (py-collect-params params)))
|
|
(let ((params-str (join ", " param-strs)))
|
|
(if (= (len body) 1)
|
|
(str "lambda " params-str ": " (py-expr-with-cells (first body) cell-vars))
|
|
;; Multi-expression body
|
|
(str "_sx_fn(lambda " params-str ": (\n"
|
|
(join ",\n" (map (fn (b) (str " " (py-expr-with-cells b cell-vars))) (slice body 0 (- (len body) 1))))
|
|
",\n " (py-expr-with-cells (last body) cell-vars)
|
|
"\n)[-1])"))))))
|
|
|
|
(define py-collect-params
|
|
(fn (params)
|
|
(py-collect-params-loop params 0 (list))))
|
|
|
|
(define py-collect-params-loop
|
|
(fn (params i result)
|
|
(if (>= i (len params))
|
|
result
|
|
(let ((p (nth params i)))
|
|
(cond
|
|
;; &rest marker
|
|
(and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
|
|
(if (< (+ i 1) (len params))
|
|
(py-collect-params-loop params (+ i 2)
|
|
(append result (str "*" (py-mangle (symbol-name (nth params (+ i 1)))))))
|
|
(py-collect-params-loop params (+ i 1) result))
|
|
;; Normal param
|
|
(= (type-of p) "symbol")
|
|
(py-collect-params-loop params (+ i 1)
|
|
(append result (py-mangle (symbol-name p))))
|
|
;; Something else
|
|
:else
|
|
(py-collect-params-loop params (+ i 1)
|
|
(append result (str p))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; let → nested IIFE lambdas
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-let
|
|
(fn (expr cell-vars)
|
|
(let ((bindings (nth expr 1))
|
|
(body (rest (rest expr))))
|
|
(let ((assignments (py-parse-bindings bindings cell-vars)))
|
|
(let ((body-str (if (= (len body) 1)
|
|
(py-expr-with-cells (first body) cell-vars)
|
|
(str "_sx_begin(" (join ", " (map (fn (b) (py-expr-with-cells b cell-vars)) body)) ")"))))
|
|
;; Build from inside out
|
|
(py-wrap-let-bindings assignments body-str cell-vars))))))
|
|
|
|
(define py-parse-bindings
|
|
(fn (bindings cell-vars)
|
|
(if (and (list? bindings) (not (empty? bindings)))
|
|
(if (list? (first bindings))
|
|
;; Scheme-style: ((name val) ...)
|
|
(map (fn (b)
|
|
(let ((vname (if (= (type-of (first b)) "symbol")
|
|
(symbol-name (first b))
|
|
(str (first b)))))
|
|
(list (py-mangle vname) (py-expr-with-cells (nth b 1) cell-vars))))
|
|
bindings)
|
|
;; Clojure-style: (name val name val ...)
|
|
(py-parse-clojure-bindings bindings 0 (list) cell-vars))
|
|
(list))))
|
|
|
|
(define py-parse-clojure-bindings
|
|
(fn (bindings i result cell-vars)
|
|
(if (>= i (- (len bindings) 1))
|
|
result
|
|
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
|
(symbol-name (nth bindings i))
|
|
(str (nth bindings i)))))
|
|
(py-parse-clojure-bindings bindings (+ i 2)
|
|
(append result (list (py-mangle vname) (py-expr-with-cells (nth bindings (+ i 1)) cell-vars)))
|
|
cell-vars)))))
|
|
|
|
(define py-wrap-let-bindings
|
|
(fn (assignments body-str cell-vars)
|
|
(if (empty? assignments)
|
|
body-str
|
|
(let ((binding (last assignments))
|
|
(rest-bindings (slice assignments 0 (- (len assignments) 1)))
|
|
(name (first binding))
|
|
(val (nth binding 1)))
|
|
(let ((inner (if (some (fn (c) (= c name)) cell-vars)
|
|
;; Cell var: initialize in _cells dict
|
|
(str "_sx_begin(_sx_cell_set(_cells, " (py-quote-string name) ", " val "), " body-str ")")
|
|
;; Normal: lambda wrapper
|
|
(str "(lambda " name ": " body-str ")(" val ")"))))
|
|
(py-wrap-let-bindings rest-bindings inner cell-vars))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; when → ternary
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-when
|
|
(fn (expr cell-vars)
|
|
(let ((cond-e (py-expr-with-cells (nth expr 1) cell-vars))
|
|
(body-parts (rest (rest expr))))
|
|
(if (= (len body-parts) 1)
|
|
(str "(" (py-expr-with-cells (first body-parts) cell-vars) " if sx_truthy(" cond-e ") else NIL)")
|
|
(str "(_sx_begin(" (join ", " (map (fn (b) (py-expr-with-cells b cell-vars)) body-parts))
|
|
") if sx_truthy(" cond-e ") else NIL)")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; cond → chained ternaries
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-cond
|
|
(fn (clauses cell-vars)
|
|
(if (empty? clauses)
|
|
"NIL"
|
|
;; Detect scheme vs clojure style
|
|
(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
|
|
(py-cond-scheme clauses cell-vars)
|
|
(py-cond-clojure clauses cell-vars))))))
|
|
|
|
(define py-is-else?
|
|
(fn (test)
|
|
(or (and (= (type-of test) "symbol")
|
|
(or (= (symbol-name test) "else") (= (symbol-name test) ":else")))
|
|
(and (= (type-of test) "keyword") (= (keyword-name test) "else")))))
|
|
|
|
(define py-cond-scheme
|
|
(fn (clauses cell-vars)
|
|
(if (empty? clauses)
|
|
"NIL"
|
|
(let ((clause (first clauses))
|
|
(test (first clause))
|
|
(body (nth clause 1)))
|
|
(if (py-is-else? test)
|
|
(py-expr-with-cells body cell-vars)
|
|
(str "(" (py-expr-with-cells body cell-vars)
|
|
" if sx_truthy(" (py-expr-with-cells test cell-vars)
|
|
") else " (py-cond-scheme (rest clauses) cell-vars) ")"))))))
|
|
|
|
(define py-cond-clojure
|
|
(fn (clauses cell-vars)
|
|
(if (< (len clauses) 2)
|
|
"NIL"
|
|
(let ((test (first clauses))
|
|
(body (nth clauses 1)))
|
|
(if (py-is-else? test)
|
|
(py-expr-with-cells body cell-vars)
|
|
(str "(" (py-expr-with-cells body cell-vars)
|
|
" if sx_truthy(" (py-expr-with-cells test cell-vars)
|
|
") else " (py-cond-clojure (rest (rest clauses)) cell-vars) ")"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; case → _sx_case
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-case
|
|
(fn (args cell-vars)
|
|
(let ((match-expr (py-expr-with-cells (first args) cell-vars))
|
|
(clauses (rest args)))
|
|
(str "_sx_case(" match-expr ", [" (py-case-pairs clauses cell-vars) "])"))))
|
|
|
|
(define py-case-pairs
|
|
(fn (clauses cell-vars)
|
|
(py-case-pairs-loop clauses 0 (list) cell-vars)))
|
|
|
|
(define py-case-pairs-loop
|
|
(fn (clauses i result cell-vars)
|
|
(if (>= i (- (len clauses) 1))
|
|
(join ", " result)
|
|
(let ((test (nth clauses i))
|
|
(body (nth clauses (+ i 1))))
|
|
(let ((pair (if (py-is-else? test)
|
|
(str "(None, lambda: " (py-expr-with-cells body cell-vars) ")")
|
|
(str "(" (py-expr-with-cells test cell-vars)
|
|
", lambda: " (py-expr-with-cells body cell-vars) ")"))))
|
|
(py-case-pairs-loop clauses (+ i 2) (append result pair) cell-vars))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; and/or → short-circuit ternaries
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-and
|
|
(fn (args cell-vars)
|
|
(let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args)))
|
|
(if (= (len parts) 1)
|
|
(first parts)
|
|
(py-and-chain parts)))))
|
|
|
|
(define py-and-chain
|
|
(fn (parts)
|
|
(if (= (len parts) 1)
|
|
(first parts)
|
|
(let ((p (first parts)))
|
|
(str "(" p " if not sx_truthy(" p ") else " (py-and-chain (rest parts)) ")")))))
|
|
|
|
(define py-emit-or
|
|
(fn (args cell-vars)
|
|
(if (= (len args) 1)
|
|
(py-expr-with-cells (first args) cell-vars)
|
|
(let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args)))
|
|
(py-or-chain parts)))))
|
|
|
|
(define py-or-chain
|
|
(fn (parts)
|
|
(if (= (len parts) 1)
|
|
(first parts)
|
|
(let ((p (first parts)))
|
|
(str "(" p " if sx_truthy(" p ") else " (py-or-chain (rest parts)) ")")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; do/begin → _sx_begin
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-do
|
|
(fn (args cell-vars)
|
|
(if (= (len args) 1)
|
|
(py-expr-with-cells (first args) cell-vars)
|
|
(str "_sx_begin(" (join ", " (map (fn (e) (py-expr-with-cells e cell-vars)) args)) ")"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; dict literal → Python dict
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-dict-literal
|
|
(fn (pairs cell-vars)
|
|
(str "{" (py-dict-pairs-str pairs 0 (list) cell-vars) "}")))
|
|
|
|
(define py-dict-pairs-str
|
|
(fn (pairs i result cell-vars)
|
|
(if (>= i (- (len pairs) 1))
|
|
(join ", " result)
|
|
(let ((key (nth pairs i))
|
|
(val (nth pairs (+ i 1))))
|
|
(let ((key-str (if (= (type-of key) "keyword")
|
|
(py-quote-string (keyword-name key))
|
|
(py-expr-with-cells key cell-vars)))
|
|
(val-str (py-expr-with-cells val cell-vars)))
|
|
(py-dict-pairs-str pairs (+ i 2)
|
|
(append result (str key-str ": " val-str))
|
|
cell-vars))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Infix operators
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-infix
|
|
(fn (op args cell-vars)
|
|
(let ((py-op (py-op-symbol op)))
|
|
(if (and (= (len args) 1) (= op "-"))
|
|
(str "(-" (py-expr-with-cells (first args) cell-vars) ")")
|
|
(str "(" (py-expr-with-cells (first args) cell-vars)
|
|
" " py-op " " (py-expr-with-cells (nth args 1) cell-vars) ")")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; quote → Python AST literals
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-quote
|
|
(fn (expr)
|
|
(cond
|
|
(= (type-of expr) "boolean")
|
|
(if expr "True" "False")
|
|
(number? expr) (str expr)
|
|
(string? expr) (py-quote-string expr)
|
|
(nil? expr) "NIL"
|
|
(= (type-of expr) "symbol")
|
|
(str "Symbol(" (py-quote-string (symbol-name expr)) ")")
|
|
(= (type-of expr) "keyword")
|
|
(str "Keyword(" (py-quote-string (keyword-name expr)) ")")
|
|
(list? expr)
|
|
(str "[" (join ", " (map py-emit-quote expr)) "]")
|
|
:else (str expr))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Statement translator: SX AST → Python statement string
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-pad
|
|
(fn (indent)
|
|
(join "" (map (fn (i) " ") (range 0 indent)))))
|
|
|
|
(define py-statement
|
|
(fn (expr indent)
|
|
(py-statement-with-cells expr indent (list))))
|
|
|
|
(define py-statement-with-cells
|
|
(fn (expr indent cell-vars)
|
|
(let ((pad (py-pad indent)))
|
|
(if (and (list? expr) (not (empty? expr))
|
|
(= (type-of (first expr)) "symbol"))
|
|
(let ((name (symbol-name (first expr))))
|
|
(cond
|
|
(= name "define")
|
|
(py-emit-define expr indent cell-vars)
|
|
(= name "set!")
|
|
(str pad (py-mangle (symbol-name (nth expr 1))) " = "
|
|
(py-expr-with-cells (nth expr 2) cell-vars))
|
|
(= name "when")
|
|
(py-emit-when-stmt expr indent cell-vars)
|
|
(or (= name "do") (= name "begin"))
|
|
(join "\n" (map (fn (e) (py-statement-with-cells e indent cell-vars))
|
|
(rest expr)))
|
|
(= name "for-each")
|
|
(py-emit-for-each-stmt expr indent cell-vars)
|
|
(= name "dict-set!")
|
|
(str pad (py-expr-with-cells (nth expr 1) cell-vars)
|
|
"[" (py-expr-with-cells (nth expr 2) cell-vars)
|
|
"] = " (py-expr-with-cells (nth expr 3) cell-vars))
|
|
(= name "append!")
|
|
(str pad (py-expr-with-cells (nth expr 1) cell-vars)
|
|
".append(" (py-expr-with-cells (nth expr 2) cell-vars) ")")
|
|
(= name "env-set!")
|
|
(str pad (py-expr-with-cells (nth expr 1) cell-vars)
|
|
"[" (py-expr-with-cells (nth expr 2) cell-vars)
|
|
"] = " (py-expr-with-cells (nth expr 3) cell-vars))
|
|
(= name "set-lambda-name!")
|
|
(str pad (py-expr-with-cells (nth expr 1) cell-vars)
|
|
".name = " (py-expr-with-cells (nth expr 2) cell-vars))
|
|
:else
|
|
(str pad (py-expr-with-cells expr cell-vars))))
|
|
(str pad (py-expr-with-cells expr cell-vars))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; define → assignment or def statement
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-define
|
|
(fn (expr indent cell-vars)
|
|
(let ((pad (py-pad indent))
|
|
(name (if (= (type-of (nth expr 1)) "symbol")
|
|
(symbol-name (nth expr 1))
|
|
(str (nth expr 1))))
|
|
(val-expr (nth expr 2)))
|
|
;; If value is fn/lambda with set! in body, emit as def
|
|
(if (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"))
|
|
(py-body-uses-set? val-expr))
|
|
(py-emit-define-as-def name val-expr indent)
|
|
(str pad (py-mangle name) " = " (py-expr-with-cells val-expr cell-vars))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; define-as-def: function with set! → proper def + _cells
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-define-as-def
|
|
(fn (name fn-expr indent)
|
|
(let ((pad (py-pad indent))
|
|
(params (nth fn-expr 1))
|
|
(body (rest (rest fn-expr)))
|
|
(param-strs (py-collect-params params))
|
|
(params-str (join ", " param-strs))
|
|
(py-name (py-mangle name))
|
|
(nested-set-vars (py-find-nested-set-vars body)))
|
|
(let ((lines (list (str pad "def " py-name "(" params-str "):"))))
|
|
(begin
|
|
(when (not (empty? nested-set-vars))
|
|
(append! lines (str pad " _cells = {}")))
|
|
(py-emit-body-stmts body lines (+ indent 1) nested-set-vars)
|
|
(join "\n" lines))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Body statement emission (for def bodies)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-body-stmts
|
|
(fn (body lines indent cell-vars)
|
|
(let ((pad (py-pad indent))
|
|
(total (len body)))
|
|
(py-emit-body-stmts-loop body lines indent cell-vars 0 total pad))))
|
|
|
|
(define py-emit-body-stmts-loop
|
|
(fn (body lines indent cell-vars i total pad)
|
|
(when (< i total)
|
|
(let ((expr (nth body i))
|
|
(is-last (= i (- total 1))))
|
|
(begin
|
|
(if (and (list? expr) (not (empty? expr)) (= (type-of (first expr)) "symbol"))
|
|
(let ((name (symbol-name (first expr))))
|
|
(cond
|
|
(or (= name "let") (= name "let*"))
|
|
(py-emit-let-as-stmts expr lines indent is-last cell-vars)
|
|
(or (= name "do") (= name "begin"))
|
|
(if is-last
|
|
(py-emit-body-stmts (rest expr) lines indent cell-vars)
|
|
(for-each (fn (sub) (py-emit-stmt-recursive sub lines indent cell-vars))
|
|
(rest expr)))
|
|
:else
|
|
(if is-last
|
|
(append! lines (str pad "return " (py-expr-with-cells expr cell-vars)))
|
|
(append! lines (py-statement-with-cells expr indent cell-vars)))))
|
|
(if is-last
|
|
(append! lines (str pad "return " (py-expr-with-cells expr cell-vars)))
|
|
(append! lines (py-statement-with-cells expr indent cell-vars))))
|
|
(py-emit-body-stmts-loop body lines indent cell-vars (+ i 1) total pad))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; let as statements (inside def bodies)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-let-as-stmts
|
|
(fn (expr lines indent is-last cell-vars)
|
|
(let ((pad (py-pad indent))
|
|
(bindings (nth expr 1))
|
|
(body (rest (rest expr))))
|
|
(begin
|
|
;; Emit bindings as assignments
|
|
(py-emit-binding-assignments bindings lines indent cell-vars)
|
|
;; Emit body
|
|
(if is-last
|
|
(py-emit-body-stmts body lines indent cell-vars)
|
|
(for-each (fn (b) (py-emit-stmt-recursive b lines indent cell-vars)) body))))))
|
|
|
|
(define py-emit-binding-assignments
|
|
(fn (bindings lines indent cell-vars)
|
|
(let ((pad (py-pad indent)))
|
|
(when (and (list? bindings) (not (empty? bindings)))
|
|
(if (list? (first bindings))
|
|
;; Scheme-style
|
|
(for-each (fn (b)
|
|
(let ((vname (if (= (type-of (first b)) "symbol")
|
|
(symbol-name (first b))
|
|
(str (first b))))
|
|
(mangled (py-mangle (if (= (type-of (first b)) "symbol")
|
|
(symbol-name (first b))
|
|
(str (first b))))))
|
|
(if (some (fn (c) (= c mangled)) cell-vars)
|
|
(append! lines (str pad "_cells[" (py-quote-string mangled) "] = "
|
|
(py-expr-with-cells (nth b 1) cell-vars)))
|
|
(append! lines (str pad mangled " = " (py-expr-with-cells (nth b 1) cell-vars))))))
|
|
bindings)
|
|
;; Clojure-style
|
|
(py-emit-clojure-binding-assignments bindings lines indent 0 cell-vars))))))
|
|
|
|
(define py-emit-clojure-binding-assignments
|
|
(fn (bindings lines indent i cell-vars)
|
|
(let ((pad (py-pad indent)))
|
|
(when (< i (- (len bindings) 1))
|
|
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
|
(symbol-name (nth bindings i))
|
|
(str (nth bindings i))))
|
|
(mangled (py-mangle (if (= (type-of (nth bindings i)) "symbol")
|
|
(symbol-name (nth bindings i))
|
|
(str (nth bindings i))))))
|
|
(begin
|
|
(if (some (fn (c) (= c mangled)) cell-vars)
|
|
(append! lines (str pad "_cells[" (py-quote-string mangled) "] = "
|
|
(py-expr-with-cells (nth bindings (+ i 1)) cell-vars)))
|
|
(append! lines (str pad mangled " = " (py-expr-with-cells (nth bindings (+ i 1)) cell-vars))))
|
|
(py-emit-clojure-binding-assignments bindings lines indent (+ i 2) cell-vars)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Recursive statement emission (for loop/control flow bodies)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-stmt-recursive
|
|
(fn (expr lines indent cell-vars)
|
|
(let ((pad (py-pad indent)))
|
|
(if (not (and (list? expr) (not (empty? expr))))
|
|
(append! lines (py-statement-with-cells expr indent cell-vars))
|
|
(if (not (= (type-of (first expr)) "symbol"))
|
|
(append! lines (py-statement-with-cells expr indent cell-vars))
|
|
(let ((name (symbol-name (first expr))))
|
|
(cond
|
|
(= name "set!")
|
|
(let ((var-name (if (= (type-of (nth expr 1)) "symbol")
|
|
(symbol-name (nth expr 1))
|
|
(str (nth expr 1))))
|
|
(mangled (py-mangle (if (= (type-of (nth expr 1)) "symbol")
|
|
(symbol-name (nth expr 1))
|
|
(str (nth expr 1))))))
|
|
(if (some (fn (c) (= c mangled)) cell-vars)
|
|
(append! lines (str pad "_cells[" (py-quote-string mangled) "] = "
|
|
(py-expr-with-cells (nth expr 2) cell-vars)))
|
|
(append! lines (str pad mangled " = " (py-expr-with-cells (nth expr 2) cell-vars)))))
|
|
(or (= name "let") (= name "let*"))
|
|
(py-emit-let-as-stmts expr lines indent false cell-vars)
|
|
(= name "when")
|
|
(begin
|
|
(append! lines (str pad "if sx_truthy(" (py-expr-with-cells (nth expr 1) cell-vars) "):"))
|
|
(for-each (fn (b) (py-emit-stmt-recursive b lines (+ indent 1) cell-vars))
|
|
(rest (rest expr))))
|
|
(= name "cond")
|
|
(py-emit-cond-stmt expr lines indent cell-vars)
|
|
(or (= name "do") (= name "begin"))
|
|
(for-each (fn (b) (py-emit-stmt-recursive b lines indent cell-vars))
|
|
(rest expr))
|
|
(= name "if")
|
|
(begin
|
|
(append! lines (str pad "if sx_truthy(" (py-expr-with-cells (nth expr 1) cell-vars) "):"))
|
|
(py-emit-stmt-recursive (nth expr 2) lines (+ indent 1) cell-vars)
|
|
(when (>= (len expr) 4)
|
|
(append! lines (str pad "else:"))
|
|
(py-emit-stmt-recursive (nth expr 3) lines (+ indent 1) cell-vars)))
|
|
(= name "append!")
|
|
(append! lines (str pad (py-expr-with-cells (nth expr 1) cell-vars)
|
|
".append(" (py-expr-with-cells (nth expr 2) cell-vars) ")"))
|
|
(= name "dict-set!")
|
|
(append! lines (str pad (py-expr-with-cells (nth expr 1) cell-vars)
|
|
"[" (py-expr-with-cells (nth expr 2) cell-vars)
|
|
"] = " (py-expr-with-cells (nth expr 3) cell-vars)))
|
|
(= name "env-set!")
|
|
(append! lines (str pad (py-expr-with-cells (nth expr 1) cell-vars)
|
|
"[" (py-expr-with-cells (nth expr 2) cell-vars)
|
|
"] = " (py-expr-with-cells (nth expr 3) cell-vars)))
|
|
:else
|
|
(append! lines (py-statement-with-cells expr indent cell-vars)))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; cond as statement (if/elif/else chain)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-cond-stmt
|
|
(fn (expr lines indent cell-vars)
|
|
(let ((pad (py-pad indent))
|
|
(clauses (rest expr)))
|
|
;; Detect scheme vs clojure
|
|
(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
|
|
(py-cond-stmt-scheme clauses lines indent true cell-vars)
|
|
(py-cond-stmt-clojure clauses lines indent 0 true cell-vars))))))
|
|
|
|
(define py-cond-stmt-scheme
|
|
(fn (clauses lines indent first-clause cell-vars)
|
|
(let ((pad (py-pad indent)))
|
|
(when (not (empty? clauses))
|
|
(let ((clause (first clauses))
|
|
(test (first clause))
|
|
(body (nth clause 1)))
|
|
(begin
|
|
(if (py-is-else? test)
|
|
(append! lines (str pad "else:"))
|
|
(begin
|
|
(append! lines (str pad (if first-clause "if" "elif")
|
|
" sx_truthy(" (py-expr-with-cells test cell-vars) "):"))
|
|
nil))
|
|
(py-emit-stmt-recursive body lines (+ indent 1) cell-vars)
|
|
(py-cond-stmt-scheme (rest clauses) lines indent false cell-vars)))))))
|
|
|
|
(define py-cond-stmt-clojure
|
|
(fn (clauses lines indent i first-clause cell-vars)
|
|
(let ((pad (py-pad indent)))
|
|
(when (< i (- (len clauses) 1))
|
|
(let ((test (nth clauses i))
|
|
(body (nth clauses (+ i 1))))
|
|
(begin
|
|
(if (py-is-else? test)
|
|
(append! lines (str pad "else:"))
|
|
(begin
|
|
(append! lines (str pad (if first-clause "if" "elif")
|
|
" sx_truthy(" (py-expr-with-cells test cell-vars) "):"))
|
|
nil))
|
|
(py-emit-stmt-recursive body lines (+ indent 1) cell-vars)
|
|
(py-cond-stmt-clojure clauses lines indent (+ i 2) false cell-vars)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; when as statement
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-when-stmt
|
|
(fn (expr indent cell-vars)
|
|
(let ((pad (py-pad indent))
|
|
(cond-e (py-expr-with-cells (nth expr 1) cell-vars))
|
|
(body-parts (rest (rest expr))))
|
|
(str pad "if sx_truthy(" cond-e "):\n"
|
|
(join "\n" (map (fn (b) (py-statement-with-cells b (+ indent 1) cell-vars))
|
|
body-parts))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; for-each as statement
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-emit-for-each-stmt
|
|
(fn (expr indent cell-vars)
|
|
(let ((pad (py-pad indent))
|
|
(fn-expr (nth expr 1))
|
|
(coll-expr (nth expr 2))
|
|
(coll (py-expr-with-cells coll-expr cell-vars)))
|
|
(if (and (list? fn-expr)
|
|
(= (type-of (first fn-expr)) "symbol")
|
|
(= (symbol-name (first fn-expr)) "fn"))
|
|
;; Inline lambda → for loop
|
|
(let ((params (nth fn-expr 1))
|
|
(body (rest (rest fn-expr)))
|
|
(p (if (= (type-of (first params)) "symbol")
|
|
(symbol-name (first params))
|
|
(str (first params))))
|
|
(p-py (py-mangle p)))
|
|
(let ((lines (list (str pad "for " p-py " in " coll ":"))))
|
|
(begin
|
|
(for-each (fn (b) (py-emit-stmt-recursive b lines (+ indent 1) cell-vars)) body)
|
|
(join "\n" lines))))
|
|
;; Non-inline → for _item
|
|
(str pad "for _item in " coll ":\n"
|
|
pad " " (py-expr-with-cells fn-expr cell-vars) "(_item)")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; File translation: process a list of (name, define-expr) pairs
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define py-translate-file
|
|
(fn (defines)
|
|
(join "\n" (map (fn (pair)
|
|
(let ((name (first pair))
|
|
(expr (nth pair 1)))
|
|
(str "# " name "\n" (py-statement expr 0) "\n")))
|
|
defines))))
|