;; ==========================================================================
;; types.sx — Gradual type system for SX
;;
;; Registration-time type checking: zero runtime cost.
;; Annotations are optional — unannotated code defaults to `any`.
;;
;; This is an optional spec module — NOT part of the core evaluator.
;; It registers deftype and defeffect via register-special-form! at load time.
;;
;; Depends on: evaluator.sx (type-of, component accessors, env ops)
;;             primitives.sx, boundary.sx (return type declarations)
;;
;; Platform interface (from evaluator.sx, already provided):
;;   (type-of x)            → type string
;;   (symbol-name s)        → string
;;   (keyword-name k)       → string
;;   (component-body c)     → AST
;;   (component-params c)   → list of param name strings
;;   (component-has-children c) → boolean
;;   (env-get env k)        → value or nil
;;
;; New platform functions for types.sx:
;;   (component-param-types c)  → dict {param-name → type} or nil
;;   (component-set-param-types! c d) → store param types on component
;; ==========================================================================


;; --------------------------------------------------------------------------
;; NOTE: deftype and defeffect definition forms have moved to web/web-forms.sx
;; (alongside defhandler, defpage, etc.) — they are domain forms, not core.
;; The type system below uses them but does not define them.
;; --------------------------------------------------------------------------


;; --------------------------------------------------------------------------
;; 1. Type representation
;; --------------------------------------------------------------------------
;; Types are plain SX values:
;;   - Strings for base types: "number", "string", "boolean", "nil",
;;     "symbol", "keyword", "element", "any", "never"
;;   - Nullable shorthand: "string?", "number?", "dict?", "boolean?"
;;     → equivalent to (or string nil) etc.
;;   - Lists for compound types:
;;     (or t1 t2 ...)         — union
;;     (list-of t)            — homogeneous list
;;     (dict-of tk tv)        — typed dict
;;     (-> t1 t2 ... treturn) — function type (last is return)

;; Base type names
(define
  base-types
  (list
    "number"
    "string"
    "boolean"
    "nil"
    "symbol"
    "keyword"
    "element"
    "any"
    "never"
    "list"
    "dict"
    "lambda"
    "component"
    "island"
    "macro"
    "signal"))


;; --------------------------------------------------------------------------
;; 2. Type predicates
;; --------------------------------------------------------------------------

(define type-any? (fn (t) (= t "any")))

(define type-never? (fn (t) (= t "never")))

(define
  type-nullable?
  (fn
    (t)
    (if
      (= t "any")
      true
      (if
        (= t "nil")
        true
        (if
          (and (= (type-of t) "string") (ends-with? t "?"))
          true
          (if
            (and
              (= (type-of t) "list")
              (not (empty? t))
              (= (first t) "or"))
            (contains? (rest t) "nil")
            false))))))

(define
  nullable-base
  (fn
    (t)
    (if
      (and (= (type-of t) "string") (ends-with? t "?") (not (= t "?")))
      (slice t 0 (- (string-length t) 1))
      t)))


;; --------------------------------------------------------------------------
;; 3. Subtype checking
;; --------------------------------------------------------------------------
;; subtype?(a, b) — is type `a` assignable to type `b`?

(define
  subtype?
  (fn
    (a b)
    (if
      (type-any? b)
      true
      (if
        (type-never? a)
        true
        (if
          (type-any? a)
          false
          (if
            (= a b)
            true
            (if
              (= a "nil")
              (type-nullable? b)
              (if
                (and (= (type-of b) "string") (ends-with? b "?"))
                (let
                  ((base (nullable-base b)))
                  (or (= a base) (= a "nil")))
                (if
                  (and
                    (= (type-of a) "list")
                    (not (empty? a))
                    (= (first a) "or"))
                  (every? (fn (member) (subtype? member b)) (rest a))
                  (if
                    (and
                      (= (type-of b) "list")
                      (not (empty? b))
                      (= (first b) "or"))
                    (some (fn (member) (subtype? a member)) (rest b))
                    (if
                      (and
                        (= (type-of a) "list")
                        (= (type-of b) "list")
                        (= (len a) 2)
                        (= (len b) 2)
                        (= (first a) "list-of")
                        (= (first b) "list-of"))
                      (subtype? (nth a 1) (nth b 1))
                      (if
                        (and
                          (= a "list")
                          (= (type-of b) "list")
                          (= (len b) 2)
                          (= (first b) "list-of"))
                        (type-any? (nth b 1))
                        (if
                          (and
                            (= (type-of a) "list")
                            (= (len a) 2)
                            (= (first a) "list-of")
                            (= b "list"))
                          true
                          false)))))))))))))


;; --------------------------------------------------------------------------
;; 4. Type union
;; --------------------------------------------------------------------------

(define
  type-union
  (fn
    (a b)
    (if
      (= a b)
      a
      (if
        (type-any? a)
        "any"
        (if
          (type-any? b)
          "any"
          (if
            (type-never? a)
            b
            (if
              (type-never? b)
              a
              (if
                (subtype? a b)
                b
                (if
                  (subtype? b a)
                  a
                  (if
                    (= a "nil")
                    (if
                      (and
                        (= (type-of b) "string")
                        (not (ends-with? b "?")))
                      (str b "?")
                      (list "or" a b))
                    (if
                      (= b "nil")
                      (if
                        (and
                          (= (type-of a) "string")
                          (not (ends-with? a "?")))
                        (str a "?")
                        (list "or" a b))
                      (list "or" a b))))))))))))


;; --------------------------------------------------------------------------
;; 5. Type narrowing
;; --------------------------------------------------------------------------

(define
  narrow-type
  (fn
    (t (predicate-name :as string))
    (match
      predicate-name
      ("nil?" (list "nil" (narrow-exclude-nil t)))
      ("string?" (list "string" (narrow-exclude t "string")))
      ("number?" (list "number" (narrow-exclude t "number")))
      ("list?" (list "list" (narrow-exclude t "list")))
      ("dict?" (list "dict" (narrow-exclude t "dict")))
      ("boolean?" (list "boolean" (narrow-exclude t "boolean")))
      (_ (list t t)))))


(define
  narrow-exclude-nil
  (fn
    (t)
    (if
      (= t "nil")
      "never"
      (if
        (= t "any")
        "any"
        (if
          (and (= (type-of t) "string") (ends-with? t "?"))
          (nullable-base t)
          (if
            (and
              (= (type-of t) "list")
              (not (empty? t))
              (= (first t) "or"))
            (let
              ((members (filter (fn (m) (not (= m "nil"))) (rest t))))
              (if
                (= (len members) 1)
                (first members)
                (if (empty? members) "never" (cons "or" members))))
            t))))))


(define
  narrow-exclude
  (fn
    (t excluded)
    (if
      (= t excluded)
      "never"
      (if
        (= t "any")
        "any"
        (if
          (and
            (= (type-of t) "list")
            (not (empty? t))
            (= (first t) "or"))
          (let
            ((members (filter (fn (m) (not (= m excluded))) (rest t))))
            (if
              (= (len members) 1)
              (first members)
              (if (empty? members) "never" (cons "or" members))))
          t)))))


;; --------------------------------------------------------------------------
;; 6. Type inference
;; --------------------------------------------------------------------------
;; infer-type walks an AST node and returns its inferred type.
;; type-env is a dict mapping variable names → types.

(define
  infer-type
  (fn
    (node (type-env :as dict) (prim-types :as dict) type-registry)
    (let
      ((kind (type-of node)))
      (match
        kind
        ("number" "number")
        ("string" "string")
        ("boolean" "boolean")
        ("keyword" "keyword")
        ("symbol"
          (let
            ((name (symbol-name node)))
            (if
              (has-key? type-env name)
              (get type-env name)
              (if
                (= name "true")
                "boolean"
                (if
                  (= name "false")
                  "boolean"
                  (if
                    (= name "nil")
                    "nil"
                    (if
                      (has-key? prim-types name)
                      (get prim-types name)
                      "any")))))))
        ("dict" "dict")
        ("list" (infer-list-type node type-env prim-types type-registry))
        (_ (if (nil? node) "nil" "any"))))))


(define
  infer-list-type
  (fn
    (node (type-env :as dict) (prim-types :as dict) type-registry)
    (if
      (empty? node)
      "list"
      (let
        ((head (first node)) (args (rest node)))
        (if
          (not (= (type-of head) "symbol"))
          "any"
          (let
            ((name (symbol-name head)))
            (match
              name
              ("if" (infer-if-type args type-env prim-types type-registry))
              ("when"
                (if
                  (>= (len args) 2)
                  (type-union
                    (infer-type (last args) type-env prim-types type-registry)
                    "nil")
                  "nil"))
              ("cond" "any")
              ("case" "any")
              ("let" (infer-let-type args type-env prim-types type-registry))
              ("do"
                (if
                  (empty? args)
                  "nil"
                  (infer-type (last args) type-env prim-types type-registry)))
              ("begin"
                (if
                  (empty? args)
                  "nil"
                  (infer-type (last args) type-env prim-types type-registry)))
              ("lambda" "lambda")
              ("fn" "lambda")
              ("and"
                (if
                  (empty? args)
                  "boolean"
                  (infer-type (last args) type-env prim-types type-registry)))
              ("or"
                (if
                  (empty? args)
                  "boolean"
                  (reduce
                    type-union
                    "never"
                    (map
                      (fn
                        (a)
                        (infer-type a type-env prim-types type-registry))
                      args))))
              ("map"
                (if
                  (>= (len args) 2)
                  (let
                    ((fn-type (infer-type (first args) type-env prim-types type-registry)))
                    (if
                      (and
                        (= (type-of fn-type) "list")
                        (= (first fn-type) "->"))
                      (list "list-of" (last fn-type))
                      "list"))
                  "list"))
              ("filter"
                (if
                  (>= (len args) 2)
                  (infer-type (nth args 1) type-env prim-types type-registry)
                  "list"))
              ("reduce" "any")
              ("list" "list")
              ("dict" "dict")
              ("quote" "any")
              ("str" "string")
              ("not" "boolean")
              ("get"
                (if
                  (and (>= (len args) 2) (not (nil? type-registry)))
                  (let
                    ((dict-type (infer-type (first args) type-env prim-types type-registry))
                      (key-arg (nth args 1))
                      (key-name
                        (cond
                          (= (type-of key-arg) "keyword")
                          (keyword-name key-arg)
                          (= (type-of key-arg) "string")
                          key-arg
                          :else nil)))
                    (if
                      (and
                        key-name
                        (= (type-of dict-type) "string")
                        (has-key? type-registry dict-type))
                      (let
                        ((resolved (resolve-type dict-type type-registry)))
                        (if
                          (and
                            (= (type-of resolved) "dict")
                            (has-key? resolved key-name))
                          (get resolved key-name)
                          "any"))
                      "any"))
                  "any"))
              (_
                (if
                  (starts-with? name "~")
                  "element"
                  (if (has-key? prim-types name) (get prim-types name) "any"))))))))))


(define
  infer-if-type
  (fn
    ((args :as list)
      (type-env :as dict)
      (prim-types :as dict)
      type-registry)
    (if
      (< (len args) 2)
      "nil"
      (let
        ((then-type (infer-type (nth args 1) type-env prim-types type-registry)))
        (if
          (>= (len args) 3)
          (type-union
            then-type
            (infer-type (nth args 2) type-env prim-types type-registry))
          (type-union then-type "nil"))))))


(define
  infer-let-type
  (fn
    ((args :as list)
      (type-env :as dict)
      (prim-types :as dict)
      type-registry)
    (if
      (< (len args) 2)
      "nil"
      (let
        ((bindings (first args))
          (body (last args))
          (extended (merge type-env (dict))))
        (for-each
          (fn
            (binding)
            (when
              (and (= (type-of binding) "list") (>= (len binding) 2))
              (let
                ((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (str (first binding))))
                  (val-type
                    (infer-type
                      (nth binding 1)
                      extended
                      prim-types
                      type-registry)))
                (dict-set! extended name val-type))))
          bindings)
        (infer-type body extended prim-types type-registry)))))


;; --------------------------------------------------------------------------
;; 7. Diagnostic types
;; --------------------------------------------------------------------------
;; Diagnostics are dicts:
;;   {:level "error"|"warning"|"info"
;;    :message "human-readable explanation"
;;    :component "~name" (or nil for top-level)
;;    :expr <the offending AST node>}

(define
  make-diagnostic
  (fn ((level :as string) (message :as string) component expr) {:level level :component component :expr expr :message message}))


;; --------------------------------------------------------------------------
;; 8. Call-site checking
;; --------------------------------------------------------------------------

(define
  check-primitive-call
  (fn
    ((name :as string)
      (args :as list)
      (type-env :as dict)
      (prim-types :as dict)
      prim-param-types
      (comp-name :as string)
      type-registry)
    (let
      ((diagnostics (list)))
      (when
        (and (not (nil? prim-param-types)) (has-key? prim-param-types name))
        (let
          ((sig (get prim-param-types name))
            (positional (get sig "positional"))
            (rest-type (get sig "rest-type")))
          (for-each
            (fn
              (idx)
              (when
                (< idx (len args))
                (if
                  (< idx (len positional))
                  (let
                    ((param-info (nth positional idx))
                      (arg-expr (nth args idx)))
                    (let
                      ((expected-type (nth param-info 1)))
                      (when
                        (not (nil? expected-type))
                        (let
                          ((actual (infer-type arg-expr type-env prim-types type-registry)))
                          (when
                            (and
                              (not (type-any? expected-type))
                              (not (type-any? actual))
                              (not
                                (subtype-resolved?
                                  actual
                                  expected-type
                                  type-registry)))
                            (append!
                              diagnostics
                              (make-diagnostic
                                "error"
                                (str
                                  "Argument "
                                  (+ idx 1)
                                  " of `"
                                  name
                                  "` expects "
                                  expected-type
                                  ", got "
                                  actual)
                                comp-name
                                arg-expr)))))))
                  (when
                    (not (nil? rest-type))
                    (let
                      ((arg-expr (nth args idx))
                        (actual
                          (infer-type
                            arg-expr
                            type-env
                            prim-types
                            type-registry)))
                      (when
                        (and
                          (not (type-any? rest-type))
                          (not (type-any? actual))
                          (not
                            (subtype-resolved? actual rest-type type-registry)))
                        (append!
                          diagnostics
                          (make-diagnostic
                            "error"
                            (str
                              "Argument "
                              (+ idx 1)
                              " of `"
                              name
                              "` expects "
                              rest-type
                              ", got "
                              actual)
                            comp-name
                            arg-expr))))))))
            (range 0 (len args) 1))))
      diagnostics)))


(define
  check-component-call
  (fn
    ((comp-name :as string)
      (comp :as component)
      (call-args :as list)
      (type-env :as dict)
      (prim-types :as dict)
      type-registry)
    (let
      ((diagnostics (list))
        (param-types (component-param-types comp))
        (params (component-params comp)))
      (when
        (and (not (nil? param-types)) (not (empty? (keys param-types))))
        (let
          ((i 0) (provided-keys (list)))
          (for-each
            (fn
              (idx)
              (when
                (< idx (len call-args))
                (let
                  ((arg (nth call-args idx)))
                  (when
                    (= (type-of arg) "keyword")
                    (let
                      ((key-name (keyword-name arg)))
                      (append! provided-keys key-name)
                      (when
                        (< (+ idx 1) (len call-args))
                        (let
                          ((val-expr (nth call-args (+ idx 1))))
                          (when
                            (has-key? param-types key-name)
                            (let
                              ((expected (get param-types key-name))
                                (actual
                                  (infer-type
                                    val-expr
                                    type-env
                                    prim-types
                                    type-registry)))
                              (when
                                (and
                                  (not (type-any? expected))
                                  (not (type-any? actual))
                                  (not
                                    (subtype-resolved?
                                      actual
                                      expected
                                      type-registry)))
                                (append!
                                  diagnostics
                                  (make-diagnostic
                                    "error"
                                    (str
                                      "Keyword :"
                                      key-name
                                      " of "
                                      comp-name
                                      " expects "
                                      expected
                                      ", got "
                                      actual)
                                    comp-name
                                    val-expr))))))))))))
            (range 0 (len call-args) 1))
          (for-each
            (fn
              (param-name)
              (when
                (and
                  (has-key? param-types param-name)
                  (not (contains? provided-keys param-name))
                  (not (type-nullable? (get param-types param-name))))
                (append!
                  diagnostics
                  (make-diagnostic
                    "warning"
                    (str
                      "Required param :"
                      param-name
                      " of "
                      comp-name
                      " not provided")
                    comp-name
                    nil))))
            params)
          (for-each
            (fn
              (key)
              (when
                (not (contains? params key))
                (append!
                  diagnostics
                  (make-diagnostic
                    "warning"
                    (str "Unknown keyword :" key " passed to " comp-name)
                    comp-name
                    nil))))
            provided-keys)))
      diagnostics)))


;; --------------------------------------------------------------------------
;; 9. AST walker — check a component body
;; --------------------------------------------------------------------------

(define
  check-body-walk
  (fn
    (node
      (comp-name :as string)
      (type-env :as dict)
      (prim-types :as dict)
      prim-param-types
      env
      (diagnostics :as list)
      type-registry
      effect-annotations)
    (let
      ((kind (type-of node)))
      (when
        (= kind "list")
        (when
          (not (empty? node))
          (let
            ((head (first node)) (args (rest node)))
            (when
              (= (type-of head) "symbol")
              (let
                ((name (symbol-name head)))
                (when
                  (starts-with? name "~")
                  (let
                    ((comp-val (env-get env name)))
                    (when
                      (= (type-of comp-val) "component")
                      (for-each
                        (fn (d) (append! diagnostics d))
                        (check-component-call
                          name
                          comp-val
                          args
                          type-env
                          prim-types
                          type-registry))))
                  (when
                    (not (nil? effect-annotations))
                    (let
                      ((caller-effects (get-effects comp-name effect-annotations)))
                      (for-each
                        (fn (d) (append! diagnostics d))
                        (check-effect-call
                          name
                          caller-effects
                          effect-annotations
                          comp-name)))))
                (when
                  (and
                    (not (starts-with? name "~"))
                    (not (nil? prim-param-types))
                    (has-key? prim-param-types name))
                  (for-each
                    (fn (d) (append! diagnostics d))
                    (check-primitive-call
                      name
                      args
                      type-env
                      prim-types
                      prim-param-types
                      comp-name
                      type-registry)))
                (when
                  (and
                    (not (starts-with? name "~"))
                    (not (nil? effect-annotations)))
                  (let
                    ((caller-effects (get-effects comp-name effect-annotations)))
                    (for-each
                      (fn (d) (append! diagnostics d))
                      (check-effect-call
                        name
                        caller-effects
                        effect-annotations
                        comp-name))))
                (when
                  (or (= name "let") (= name "let*"))
                  (when
                    (>= (len args) 2)
                    (let
                      ((bindings (first args))
                        (body-exprs (rest args))
                        (extended (merge type-env (dict))))
                      (for-each
                        (fn
                          (binding)
                          (when
                            (and
                              (= (type-of binding) "list")
                              (>= (len binding) 2))
                            (let
                              ((bname (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (str (first binding))))
                                (val-type
                                  (infer-type
                                    (nth binding 1)
                                    extended
                                    prim-types
                                    type-registry)))
                              (dict-set! extended bname val-type))))
                        bindings)
                      (for-each
                        (fn
                          (body)
                          (check-body-walk
                            body
                            comp-name
                            extended
                            prim-types
                            prim-param-types
                            env
                            diagnostics
                            type-registry
                            effect-annotations))
                        body-exprs))))
                (when
                  (= name "define")
                  (when
                    (>= (len args) 2)
                    (let
                      ((def-name (if (= (type-of (first args)) "symbol") (symbol-name (first args)) nil))
                        (def-val (nth args 1)))
                      (when
                        def-name
                        (dict-set!
                          type-env
                          def-name
                          (infer-type
                            def-val
                            type-env
                            prim-types
                            type-registry)))
                      (check-body-walk
                        def-val
                        comp-name
                        type-env
                        prim-types
                        prim-param-types
                        env
                        diagnostics
                        type-registry
                        effect-annotations))))))
            (for-each
              (fn
                (child)
                (check-body-walk
                  child
                  comp-name
                  type-env
                  prim-types
                  prim-param-types
                  env
                  diagnostics
                  type-registry
                  effect-annotations))
              args)))))))


;; --------------------------------------------------------------------------
;; 10. Check a single component
;; --------------------------------------------------------------------------

(define
  check-component
  (fn
    ((comp-name :as string)
      env
      (prim-types :as dict)
      prim-param-types
      type-registry
      effect-annotations)
    (let
      ((comp (env-get env comp-name)) (diagnostics (list)))
      (when
        (= (type-of comp) "component")
        (let
          ((body (component-body comp))
            (params (component-params comp))
            (param-types (component-param-types comp))
            (type-env (dict)))
          (for-each
            (fn
              (p)
              (dict-set!
                type-env
                p
                (if
                  (and (not (nil? param-types)) (has-key? param-types p))
                  (get param-types p)
                  "any")))
            params)
          (when
            (component-has-children comp)
            (dict-set! type-env "children" (list "list-of" "element")))
          (check-body-walk
            body
            comp-name
            type-env
            prim-types
            prim-param-types
            env
            diagnostics
            type-registry
            effect-annotations)))
      diagnostics)))


;; --------------------------------------------------------------------------
;; 11. Check all components in an environment
;; --------------------------------------------------------------------------

(define
  check-all
  (fn
    (env
      (prim-types :as dict)
      prim-param-types
      type-registry
      effect-annotations)
    (let
      ((all-diagnostics (list)))
      (for-each
        (fn
          (name)
          (let
            ((val (env-get env name)))
            (when
              (= (type-of val) "component")
              (for-each
                (fn (d) (append! all-diagnostics d))
                (check-component
                  name
                  env
                  prim-types
                  prim-param-types
                  type-registry
                  effect-annotations)))))
        (keys env))
      all-diagnostics)))


;; --------------------------------------------------------------------------
;; 12. Build primitive type registry
;; --------------------------------------------------------------------------
;; Builds a dict mapping primitive-name → return-type from
;; the declarations parsed by boundary_parser.py.
;; This is called by the host at startup with the parsed declarations.

(define
  build-type-registry
  (fn
    ((prim-declarations :as list) (io-declarations :as list))
    (let
      ((registry (dict)))
      (for-each
        (fn
          (decl)
          (let
            ((name (get decl "name")) (returns (get decl "returns")))
            (when
              (and (not (nil? name)) (not (nil? returns)))
              (dict-set! registry name returns))))
        prim-declarations)
      (for-each
        (fn
          (decl)
          (let
            ((name (get decl "name")) (returns (get decl "returns")))
            (when
              (and (not (nil? name)) (not (nil? returns)))
              (dict-set! registry name returns))))
        io-declarations)
      registry)))


;; --------------------------------------------------------------------------
;; 13. User-defined types (deftype)
;; --------------------------------------------------------------------------
;; Type definitions are plain dicts: {:name "price" :params [] :body "number"}
;; Stored in env under "*type-registry*" mapping type names to defs.

;; make-type-def and normalize-type-body are defined in eval.sx
;; (always compiled). They're available when types.sx is compiled as a spec module.

;; -- Standard type definitions --
;; These define the record types used throughout the type system itself.

;; Universal: nullable shorthand
(deftype (maybe a) (union a nil))

;; A type definition entry in the registry
(deftype type-def {:body any :params list :name string})

;; A diagnostic produced by the type checker
(deftype diagnostic {:level string :component string? :expr any :message string})

;; Primitive parameter type signature
(deftype prim-param-sig {:rest-type string? :positional list})

;; Effect declarations
(defeffect io)
(defeffect mutation)
(defeffect render)

(define type-def-name (fn (td) (get td "name")))

(define type-def-params (fn (td) (get td "params")))

(define type-def-body (fn (td) (get td "body")))

(define
  resolve-type
  (fn
    (t registry)
    (if
      (nil? registry)
      t
      (match
        (type-of t)
        ("string"
          (if
            (has-key? registry t)
            (let
              ((td (get registry t)))
              (let
                ((params (type-def-params td)) (body (type-def-body td)))
                (if (empty? params) (resolve-type body registry) t)))
            t))
        ("list"
          (if
            (empty? t)
            t
            (let
              ((head (first t)))
              (cond
                (or
                  (= head "or")
                  (= head "list-of")
                  (= head "->")
                  (= head "dict-of"))
                (cons
                  head
                  (map (fn (m) (resolve-type m registry)) (rest t)))
                (and (= (type-of head) "string") (has-key? registry head))
                (let
                  ((td (get registry head))
                    (params (type-def-params td))
                    (body (type-def-body td))
                    (args (rest t)))
                  (if
                    (= (len params) (len args))
                    (resolve-type
                      (substitute-type-vars body params args)
                      registry)
                    t))
                :else t))))
        ("dict" (map-dict (fn (k v) (resolve-type v registry)) t))
        (_ t)))))

(define
  substitute-type-vars
  (fn
    (body (params :as list) (args :as list))
    (let
      ((subst (dict)))
      (for-each
        (fn (i) (dict-set! subst (nth params i) (nth args i)))
        (range 0 (len params) 1))
      (substitute-in-type body subst))))

(define
  substitute-in-type
  (fn
    (t (subst :as dict))
    (match
      (type-of t)
      ("string" (if (has-key? subst t) (get subst t) t))
      ("list" (map (fn (m) (substitute-in-type m subst)) t))
      ("dict" (map-dict (fn (k v) (substitute-in-type v subst)) t))
      (_ t))))

(define
  subtype-resolved?
  (fn
    (a b registry)
    (if
      (nil? registry)
      (subtype? a b)
      (let
        ((ra (resolve-type a registry)) (rb (resolve-type b registry)))
        (if
          (and (= (type-of ra) "dict") (= (type-of rb) "dict"))
          (every?
            (fn
              (key)
              (and
                (has-key? ra key)
                (subtype-resolved? (get ra key) (get rb key) registry)))
            (keys rb))
          (subtype? ra rb))))))


;; --------------------------------------------------------------------------
;; 14. Effect checking (defeffect)
;; --------------------------------------------------------------------------
;; Effects are annotations on functions/components describing their
;; side effects. A pure function cannot call IO functions.

(define
  get-effects
  (fn
    ((name :as string) effect-annotations)
    (if
      (nil? effect-annotations)
      nil
      (if
        (has-key? effect-annotations name)
        (get effect-annotations name)
        nil))))

(define
  effects-subset?
  (fn
    (callee-effects caller-effects)
    (if
      (nil? caller-effects)
      true
      (if
        (nil? callee-effects)
        true
        (every? (fn (e) (contains? caller-effects e)) callee-effects)))))

(define
  check-effect-call
  (fn
    ((callee-name :as string)
      caller-effects
      effect-annotations
      (comp-name :as string))
    (let
      ((diagnostics (list))
        (callee-effects (get-effects callee-name effect-annotations)))
      (when
        (and
          (not (nil? caller-effects))
          (not (nil? callee-effects))
          (not (effects-subset? callee-effects caller-effects)))
        (append!
          diagnostics
          (make-diagnostic
            "error"
            (str
              "`"
              callee-name
              "` has effects "
              (join ", " callee-effects)
              " but `"
              comp-name
              "` only allows "
              (if
                (empty? caller-effects)
                "[pure]"
                (join ", " caller-effects)))
            comp-name
            nil)))
      diagnostics)))

(define
  build-effect-annotations
  (fn
    ((io-declarations :as list))
    (let
      ((annotations (dict)))
      (for-each
        (fn
          (decl)
          (let
            ((name (get decl "name")))
            (when
              (not (nil? name))
              (dict-set! annotations name (list "io")))))
        io-declarations)
      annotations)))


;; --------------------------------------------------------------------------
;; 15. Check component effects — convenience wrapper
;; --------------------------------------------------------------------------
;; Validates that components respect their declared effect annotations.
;; Delegates to check-body-walk with nil type checking (effects only).

(define
  check-component-effects
  (fn
    ((comp-name :as string) env effect-annotations)
    (let
      ((comp (env-get env comp-name)) (diagnostics (list)))
      (when
        (= (type-of comp) "component")
        (let
          ((body (component-body comp)))
          (check-body-walk
            body
            comp-name
            (dict)
            (dict)
            nil
            env
            diagnostics
            nil
            effect-annotations)))
      diagnostics)))

(define
  check-all-effects
  (fn
    (env effect-annotations)
    (let
      ((all-diagnostics (list)))
      (for-each
        (fn
          (name)
          (let
            ((val (env-get env name)))
            (when
              (= (type-of val) "component")
              (for-each
                (fn (d) (append! all-diagnostics d))
                (check-component-effects name env effect-annotations)))))
        (keys env))
      all-diagnostics)))


;; --------------------------------------------------------------------------
;; Platform interface summary
;; --------------------------------------------------------------------------
;;
;; From eval.sx (already provided):
;;   (type-of x), (symbol-name s), (keyword-name k), (env-get env k)
;;   (component-body c), (component-params c), (component-has-children c)
;;
;; New for types.sx (each host implements):
;;   (component-param-types c)        → dict {param-name → type} or nil
;;   (component-set-param-types! c d) → store param types on component
;;   (merge d1 d2)               → new dict merging d1 and d2
;;
;; Primitive param types:
;;   The host provides prim-param-types as a dict mapping primitive names
;;   to param type descriptors. Each descriptor is a dict:
;;     {"positional" [["name" "type-or-nil"] ...] "rest-type" "type-or-nil"}
;;   Built by boundary_parser.parse_primitive_param_types() in Python.
;;   Passed to check-component/check-all as an optional extra argument.
;;
;; --------------------------------------------------------------------------
