;;; etaf-view.el --- Unified ETAF View grammar -*- lexical-binding: t; -*-

;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:

;; This file owns the small structural language shared by Hosts and
;; Components.  It deliberately does not render, mutate buffers, or implement
;; lifecycle.  `etaf-view' compiles one structural form into a short-lived
;; View value; the renderer lowers that value to Ebox later.

;;; Code:

(require 'cl-lib)
(require 'ebox-style)

(define-error 'etaf-view-error "Invalid ETAF View")
(define-error 'etaf-view-syntax-error "Invalid ETAF View syntax"
  'etaf-view-error)
(define-error 'etaf-component-call-error "Invalid ETAF Component call"
  'etaf-view-error)

(cl-defstruct (etaf--view-node
               (:constructor etaf--view-node-create))
  "Internal normalized description of one Host View."
  name
  token
  props
  children)

(cl-defstruct (etaf--expr
               (:constructor etaf--expr-create))
  "Internal executable interpolation or compiler-owned structural program."
  (kind 'interpolation)
  token
  thunk
  range-snapshot
  range-key
  range-item)

(cl-defstruct (etaf--component-spec
               (:constructor etaf--component-spec-create))
  "Internal definition of one ETAF Component."
  name
  props
  render
  setup
  styles)

(cl-defstruct (etaf--component-call
               (:constructor etaf--component-call-create))
  "Internal Component invocation retained until rendering."
  spec
  props
  attrs
  slots)

(cl-defstruct (etaf--slot-input
               (:constructor etaf--slot-input-create))
  "Call-site contribution to a named Component slot."
  name
  children)

(cl-defstruct (etaf--slot-projection
               (:constructor etaf--slot-projection-create))
  "A Component View request for one slot and its fallback children."
  name
  token
  fallback)

(defconst etaf--host-names
  '(text box fragment row column flex grid)
  "Minimal unstyled Hosts implemented by ETAF core.

Product Components such as Button belong to `etaf-ui'; they are not added to
this list merely to make a demo convenient.")

(defconst etaf--host-marker 'etaf--host
  "Value stored in the View registry for a built-in Host.")

(defconst etaf--directive-properties '(:if :else-if :else :for)
  "Compiler-owned DSL properties rejected by ordinary node construction.")

(defconst etaf--semantic-props
  '(:class :id :role :disabled :tab-index :ref :use)
  "ETAF Host metadata outside the Ebox style schema.")

(defun etaf--aria-property-p (property)
  "Return non-nil when PROPERTY is in the ETAF aria namespace."
  (and (keywordp property)
       (string-prefix-p ":aria-" (symbol-name property))))

(defun etaf--event-property-p (property)
  "Return non-nil when PROPERTY is an ETAF event callback property."
  (and (keywordp property)
       (string-prefix-p ":on-" (symbol-name property))))

(defun etaf--semantic-property-p (property)
  "Return non-nil when PROPERTY belongs to ETAF Runtime metadata."
  (or (memq property etaf--semantic-props)
      (etaf--aria-property-p property)
      (etaf--event-property-p property)))

(defun etaf--host-attribute-p (property)
  "Return non-nil when PROPERTY belongs to the shared Host attribute domain."
  (or (ebox-style-schema-id property)
      (etaf--semantic-property-p property)))

(defconst etaf--ordinary-elisp-heads
  '(and or not if when unless cond case pcase
    let let* letrec letrec* prog prog1 prog2 progn
    while dolist dotimes cl-loop mapcar mapc mapcan
    save-excursion save-restriction save-window-excursion
    condition-case condition-case-unless-debug unwind-protect
    catch throw signal error user-error quote function lambda
    setq setq-default setf psetf psetq incf decf push pop
    funcall apply apply-partially progn eval macroexpand)
  "Elisp heads that must appear inside `expr', not as View children.")

(defvar etaf--view-registry (make-hash-table :test #'eq)
  "Registry of Hosts and Components used by structural View calls.")

(defvar etaf--allow-component-redefinition nil
  "When non-nil, permit an explicit authoring tool to replace Components.

Normal ETAF loading keeps duplicate definitions as errors.  Tools such as a
source playground may bind this variable around an intentional reload after
disposing the old Runtime.")

(defvar etaf--current-component-props nil
  "Dynamic props of the Component currently being evaluated.")

(defvar etaf--current-component-slots nil
  "Dynamic slots of the Component currently being evaluated.")

(defvar etaf--current-component-instance nil
  "Dynamic Component instance currently being evaluated.")

(defvar etaf--compiling-component-props nil
  "Component prop names visible to the current DSL macro expansion.")

(defun etaf--syntax-error (format-string &rest arguments)
  "Signal a View syntax error formatted from FORMAT-STRING and ARGUMENTS."
  (signal 'etaf-view-syntax-error
          (list (apply #'format format-string arguments))))

(defun etaf--component-error (format-string &rest arguments)
  "Signal a Component call error formatted from FORMAT-STRING and ARGUMENTS."
  (signal 'etaf-component-call-error
          (list (apply #'format format-string arguments))))

(defun etaf--keyword-for-name (name)
  "Return the property keyword corresponding to symbol NAME."
  (intern (concat ":" (symbol-name name))))

(defun etaf--register-component (name spec)
  "Register Component SPEC under exact registry NAME."
  (unless (and (symbolp name) (etaf--component-spec-p spec))
    (signal 'wrong-type-argument (list 'etaf--component-spec-p spec)))
  (let ((existing (gethash name etaf--view-registry)))
    (when (eq existing etaf--host-marker)
      (etaf--component-error
       "Component %S conflicts with a core Host" name))
    (when (and existing (not (eq existing etaf--host-marker))
               (not (eq existing spec))
               (not etaf--allow-component-redefinition))
      (etaf--component-error
       "Component %S is already registered" name)))
  (puthash name spec etaf--view-registry)
  (when (fboundp 'etaf-compiler-note-registry-change)
    (etaf-compiler-note-registry-change))
  spec)

(defun etaf--register-core-hosts ()
  "Register the exact core Host names."
  (dolist (name etaf--host-names)
    (puthash name etaf--host-marker etaf--view-registry)))

(etaf--register-core-hosts)

(defun etaf--validate-property-plist (props)
  "Validate evaluated View PROPS and return a defensive copy."
  (unless (and (proper-list-p props) (zerop (% (length props) 2)))
    (etaf--component-error "View properties must be keyword/value pairs: %S"
                           props))
  (let ((copy nil)
        (seen nil)
        (tail props))
    (while tail
      (let ((key (pop tail))
            (value (pop tail)))
        (unless (keywordp key)
          (etaf--component-error "View property name must be a keyword: %S"
                                 key))
        (when (memq key seen)
          (etaf--component-error "Duplicate View property: %S" key))
        (push key seen)
        (push key copy)
        (push value copy)))
    (nreverse copy)))

(defun etaf--resolve-property-value (value)
  "Resolve one lazily compiled property VALUE."
  (if (etaf--expr-p value)
      (etaf--resolve-property-value (funcall (etaf--expr-thunk value)))
    value))

(defun etaf--resolve-property-plist (props)
  "Resolve all lazy values in PROPS while preserving its keys."
  (let ((copy nil)
        (tail props))
    (while tail
      (push (pop tail) copy)
      (push (etaf--resolve-property-value (pop tail)) copy))
    (nreverse copy)))

(defun etaf--property-domain-key (property)
  "Return PROPERTY's canonical Host-domain key."
  (or (ebox-style-canonical-name property) property))

(defun etaf--plist-set (props key value)
  "Return PROPS with KEY set to VALUE while preserving source order."
  (if (plist-member props key)
      (let ((copy (copy-sequence props)))
        (plist-put copy key value)
        copy)
    (append props (list key value))))

(defun etaf--plist-remove-domain (props property)
  "Return PROPS without any alias in PROPERTY's canonical domain."
  (let ((domain (etaf--property-domain-key property)))
    (cl-loop for (key value) on props by #'cddr
             unless (eq (etaf--property-domain-key key) domain)
             append (list key value))))

(defun etaf--class-tokens (value)
  "Return normalized class tokens from resolved VALUE."
  (cond
   ((null value) nil)
   ((stringp value) (split-string value "[[:space:]]+" t))
   ((symbolp value) (list (symbol-name value)))
   ((proper-list-p value)
    (cl-mapcan #'etaf--class-tokens value))
   (t
    (etaf--component-error "Invalid class value: %S" value))))

(defun etaf--merge-class-values (root-value caller-value)
  "Return stable union of ROOT-VALUE and CALLER-VALUE class tokens."
  (let (seen result)
    (dolist (token (append (etaf--class-tokens root-value)
                           (etaf--class-tokens caller-value)))
      (unless (member token seen)
        (push token seen)
        (push token result)))
    (nreverse result)))

(defun etaf--merge-class-input (root-value caller-value)
  "Return a class value merging possibly lazy ROOT-VALUE and CALLER-VALUE."
  (etaf--merge-class-values
   (etaf--resolve-property-value root-value)
   (etaf--resolve-property-value caller-value)))

(defun etaf--merge-host-attrs (props attrs &optional tag component-name)
  "Merge caller ATTRS into root Host PROPS for TAG.
Visual Ebox attributes override Component defaults.  Class tokens merge.
Forwarded Runtime metadata overrides same-key Component root metadata so Host
attrs can reach the retained root.  COMPONENT-NAME labels diagnostics."
  (let ((result (copy-sequence props))
        (tail attrs))
    (while tail
      (let* ((key (pop tail))
             (value (pop tail))
             (style-p (not (null (ebox-style-schema-id key)))))
        (when (and tag style-p
                   (not (ebox-style-property-accepted-p tag key)))
          (etaf--component-error
           "Component %S root Host %S rejects attribute %S"
           component-name tag key))
        (cond
         ((eq key :class)
          (setq result
                (etaf--plist-set
                 result :class
                 (etaf--merge-class-input (plist-get result :class) value))))
         (style-p
          (setq result
                (append (etaf--plist-remove-domain result key)
                        (list key value))))
         ((plist-member result key)
          (setq result (etaf--plist-set result key value)))
         (t
          (setq result (append result (list key value)))))))
    result))

(defun etaf--forward-component-attrs (call attrs component-name)
  "Return copied root Component CALL receiving caller ATTRS.
COMPONENT-NAME identifies the forwarding owner for diagnostics."
  (let* ((copy (copy-sequence call))
         (spec (etaf--component-call-spec call))
         (declared (mapcar #'etaf--component-prop-key
                           (etaf--component-spec-props spec)))
         (props (copy-sequence (etaf--component-call-props call)))
         (forwarded (copy-sequence (etaf--component-call-attrs call)))
         (tail attrs))
    (while tail
      (let ((key (pop tail))
            (value (pop tail)))
        (if (memq key declared)
            (setq props (etaf--plist-set props key value))
          (setq forwarded
                (etaf--merge-host-attrs
                 forwarded (list key value) nil component-name)))))
    (setf (etaf--component-call-props copy) props
          (etaf--component-call-attrs copy) forwarded)
    copy))

(defun etaf--apply-component-attrs (value attrs component-name)
  "Apply resolved fallthrough ATTRS to COMPONENT-NAME root VALUE."
  (if (null attrs)
      value
    (cond
     ((stringp value)
      (etaf--view-node-create
       :name 'text :props (copy-sequence attrs) :children (list value)))
     ((etaf--view-node-p value)
      (when (eq (etaf--view-node-name value) 'fragment)
        (etaf--component-error
         "Component %S has multiple roots; Host attrs have no target"
         component-name))
      (let ((copy (copy-sequence value)))
        (setf (etaf--view-node-props copy)
              (etaf--merge-host-attrs
               (etaf--view-node-props value) attrs
               (etaf--view-node-name value) component-name))
        copy))
     ((etaf--component-call-p value)
      (etaf--forward-component-attrs value attrs component-name))
     (t
      (etaf--component-error
       "Component %S cannot apply Host attrs to %S" component-name value)))))

(defun etaf--compile-property-value (form)
  "Compile property FORM as a constant or a render-time thunk."
  (if (or (null form) (numberp form) (stringp form) (characterp form)
          (keywordp form) (eq form t)
          (and (consp form) (memq (car form) '(quote function))))
      form
    `(etaf--expr-create :thunk (lambda () ,form))))

(defun etaf--compile-property-plist (props)
  "Compile alternating property FORMS in PROPS into a generated property list."
  (let (compiled)
    (while props
      (let ((key (pop props))
            (value (pop props)))
        (setq compiled
              (append compiled
                      (list key (etaf--compile-property-value value))))))
    compiled))

(defun etaf--validate-key (key)
  "Validate identity KEY and return its immutable boundary value."
  (unless (and key (or (symbolp key) (stringp key) (integerp key)))
    (etaf--component-error
     "View keys must be non-nil symbols, integers, or strings: %S" key))
  (if (stringp key) (copy-sequence key) key))

(defun etaf--parse-attributes-and-children (items)
  "Split structural ITEMS into `(PROPS . CHILDREN)'.

All keyword attributes must precede the first non-keyword child.  Values are
returned as unevaluated forms because they are ordinary Elisp expressions in
the generated code."
  (let (props children seen children-started)
    (while items
      (let ((item (pop items)))
        (if (keywordp item)
            (progn
              (when children-started
                (etaf--syntax-error
                 "Attributes must precede children; found %S after a child"
                 item))
              (unless items
                (etaf--syntax-error "Missing value for View property %S"
                                    item))
              (when (memq item seen)
                (etaf--syntax-error "Duplicate View property %S" item))
              (push item seen)
              (let ((value (pop items)))
                (push item props)
                (push value props)))
          (setq children-started t)
          (push item children))))
    (cons (nreverse props) (nreverse children))))

(defun etaf--parse-expr-form (items)
  "Return the sole ordinary Elisp form from interpolation ITEMS."
  (unless (= (length items) 1)
    (etaf--syntax-error "Expr accepts exactly one form: (expr FORM)"))
  (car items))

(defun etaf--constant-slot-name (form)
  "Return the static slot symbol represented by FORM, or signal an error."
  (unless (and (consp form)
               (eq (car form) 'quote)
               (null (cddr form)))
    (etaf--syntax-error
     "Slot names must be quoted stable symbols: %S" form))
  (let ((name (cadr form)))
    (unless (and (symbolp name) (not (keywordp name))
                 (not (memq name '(nil t))))
      (etaf--syntax-error
       "Slot names must be stable non-keyword symbols: %S" form))
    name))

(defun etaf--compile-slot-form (items slot-mode)
  "Compile a slot form with ITEMS according to SLOT-MODE.

SLOT-MODE is `:projection' while compiling a Component's own View and
`:input' while compiling the children supplied to a Component call.  An
input slot must have an explicit `:name'; ordinary trailing children already
belong to the anonymous `default' slot."
  (let* ((parts (etaf--parse-attributes-and-children items))
         (props (car parts))
         (children (cdr parts))
         (name-supplied-p (plist-member props :name))
         (name (if name-supplied-p
                   (etaf--constant-slot-name (plist-get props :name))
                 'default)))
    (unless (or (null props)
                (and (= (length props) 2) (eq (car props) :name)))
      (etaf--syntax-error "Slot accepts only the optional :name attribute"))
    (when (and (eq slot-mode :input) (not name-supplied-p))
      (etaf--syntax-error
       "A named slot input requires :name; ordinary children fill default"))
    (let ((compiled (mapcar (lambda (child)
                              (etaf--compile-child-form child slot-mode))
                            children)))
      (if (eq slot-mode :projection)
          (let ((token (gensym "etaf-slot-site-")))
            `(etaf--slot-projection-create
              :name ',name
              :token ',token
              :fallback (list ,@compiled)))
        `(etaf--slot-input-create
          :name ',name
          :children (list ,@compiled))))))

(defun etaf--ordinary-expression-head-p (head)
  "Return non-nil when HEAD denotes ordinary Elisp computation."
  (or (memq head etaf--ordinary-elisp-heads)
      (special-form-p head)
      (and (symbolp head) (fboundp head))))

(defun etaf--compile-expr-form (items)
  "Compile an `expr' form with ITEMS into an executable View value."
  (let ((token (gensym "etaf-expr-site-")))
    `(etaf--expr-create
    :kind 'interpolation
    :token ',token
    :thunk (lambda () ,(etaf--parse-expr-form items)))))

(defun etaf--structural-program-p (value)
  "Return non-nil when VALUE is a compiler-owned structural program."
  (and (etaf--expr-p value)
       (memq (etaf--expr-kind value) '(branch keyed-list))))

(defun etaf--keyed-program-snapshot (program)
  "Evaluate and validate one compiler-owned keyed-list PROGRAM snapshot."
  (unless (and (etaf--expr-p program)
               (eq (etaf--expr-kind program) 'keyed-list)
               (functionp (etaf--expr-range-snapshot program))
               (functionp (etaf--expr-range-item program)))
    (etaf--component-error "Invalid keyed-list program: %S" program))
  (let* ((snapshot (funcall (etaf--expr-range-snapshot program)))
         (items (and (proper-list-p snapshot) (plist-get snapshot :items)))
         (keys (and (proper-list-p snapshot) (plist-get snapshot :keys))))
    (unless (and (proper-list-p items) (proper-list-p keys)
                 (= (length items) (length keys)))
      (etaf--component-error "Invalid keyed-list snapshot: %S" snapshot))
    (let ((seen (make-hash-table :test #'equal))
          validated)
      (dolist (key keys)
        (setq key (etaf--validate-key key))
        (when (gethash key seen)
          (etaf--component-error "Duplicate keyed-list key: %S" key))
        (puthash key t seen)
        (push key validated))
      (let ((copy (copy-sequence snapshot)))
        (plist-put copy :items (copy-sequence items))
        (plist-put copy :keys (nreverse validated))
        copy))))

(defun etaf--keyed-program-outputs (program snapshot)
  "Return PROGRAM outputs for already validated keyed SNAPSHOT."
  (let ((renderer (etaf--expr-range-item program))
        (context (plist-get snapshot :context)))
    (mapcar (lambda (item) (funcall renderer item context))
            (plist-get snapshot :items))))

(defun etaf--view-form-parts (form)
  "Return parsed `(TAG PROPS CHILDREN)' for directive-capable FORM."
  (unless (and (consp form) (symbolp (car form))
               (not (memq (car form) '(expr slot))))
    (etaf--syntax-error "Directive requires a View node: %S" form))
  (let ((parts (etaf--parse-attributes-and-children (cdr form))))
    (list (car form) (car parts) (cdr parts))))

(defun etaf--view-directive-properties (props)
  "Return directive entries present in raw PROPS."
  (cl-loop for (key value) on props by #'cddr
           when (memq key etaf--directive-properties)
           append (list key value)))

(defun etaf--validate-directive-set (directives)
  "Validate one node's raw DIRECTIVES and return them."
  (let ((branch-count
         (cl-count-if (lambda (key) (plist-member directives key))
                      '(:if :else-if :else))))
    (when (> branch-count 1)
      (etaf--syntax-error "A View node accepts one branch directive"))
    (when (and (> branch-count 0) (plist-member directives :for))
      (etaf--syntax-error "Branch directives cannot share a node with :for"))
    (when (and (plist-member directives :else)
               (not (eq (plist-get directives :else) t)))
      (etaf--syntax-error ":else requires literal t")))
  directives)

(defun etaf--view-without-directives (form)
  "Return raw View FORM without compiler directive properties."
  (pcase-let ((`(,tag ,props ,children) (etaf--view-form-parts form)))
    (cons tag
          (append
           (cl-loop for (key value) on props by #'cddr
                    unless (memq key etaf--directive-properties)
                    append (list key value))
           children))))

(defun etaf--compile-branch-children (first rest slot-mode)
  "Compile branch FIRST and adjacent arms from REST under SLOT-MODE.
Return `(COMPILED . REMAINING)' for one compiler-owned Range program."
  (let ((arms nil)
        (remaining rest)
        (saw-else nil)
        done)
    (cl-labels
        ((add-arm
          (form kind condition)
          (let ((parts (etaf--view-form-parts form)))
            (etaf--validate-directive-set
             (etaf--view-directive-properties (nth 1 parts)))
            (push (list kind condition
                        (etaf--compile-view-form
                         (etaf--view-without-directives form) slot-mode))
                  arms))))
      (let* ((directives
              (etaf--view-directive-properties
               (nth 1 (etaf--view-form-parts first)))))
        (add-arm first :if (plist-get directives :if)))
      (while (and remaining (not done))
        (let* ((candidate (car remaining))
               (parts (and (consp candidate) (symbolp (car candidate))
                           (not (memq (car candidate) '(expr slot)))
                           (etaf--view-form-parts candidate)))
               (directives (and parts
                                (etaf--view-directive-properties
                                 (nth 1 parts)))))
          (cond
           ((and directives (plist-member directives :else-if))
            (when saw-else
              (etaf--syntax-error ":else-if cannot follow :else"))
            (add-arm candidate :else-if (plist-get directives :else-if))
            (setq remaining (cdr remaining)))
           ((and directives (plist-member directives :else))
            (when saw-else
              (etaf--syntax-error "A branch chain accepts one :else"))
            (setq saw-else t)
            (add-arm candidate :else (plist-get directives :else))
            (setq remaining (cdr remaining)))
           (t (setq done t))))))
    (let ((token (gensym "etaf-branch-site-"))
          (ordered (nreverse arms)))
      (cons
       `(etaf--expr-create
         :kind 'branch
         :token ',token
         :thunk
         (lambda ()
           (cond
            ,@(mapcar
               (lambda (arm)
                 (pcase (car arm)
                   (:else `(t ,(nth 2 arm)))
                   (_ `(,(nth 1 arm) ,(nth 2 arm)))))
               ordered))))
       remaining))))

(defun etaf--compile-for-child (form slot-mode)
  "Compile one keyed `:for' View FORM for SLOT-MODE."
  (pcase-let* ((`(,_tag ,props ,_children) (etaf--view-form-parts form))
               (directives
                (etaf--validate-directive-set
                 (etaf--view-directive-properties props)))
               (for-form (plist-get directives :for)))
    (when (cl-some (lambda (key) (plist-member directives key))
                   '(:if :else-if :else))
      (etaf--syntax-error "Branch directives cannot share a node with :for"))
    (unless (and (proper-list-p for-form) (= (length for-form) 2)
                 (symbolp (car for-form))
                 (not (keywordp (car for-form)))
                 (not (memq (car for-form) '(nil t))))
      (etaf--syntax-error ":for must be (ITEM ITEMS): %S" for-form))
    (when (memq (car for-form) etaf--compiling-component-props)
      (etaf--syntax-error ":for item %S conflicts with a Component prop"
                          (car for-form)))
    (unless (plist-member props :key)
      (etaf--syntax-error ":for requires an explicit :key"))
    (let* ((item (car for-form))
           (items-form (cadr for-form))
           (key-form (plist-get props :key))
           (compiled (etaf--compile-view-form
                      (etaf--view-without-directives form) slot-mode))
           (token (gensym "etaf-keyed-list-site-"))
           (snapshot (gensym "etaf-keyed-snapshot-"))
           (item-renderer (gensym "etaf-keyed-item-")))
      `(let ((,snapshot
              (lambda ()
                (let ((items ,items-form))
                  (unless (proper-list-p items)
                    (etaf--component-error
                     ":for collection must be a proper list: %S" items))
                  (list :items (copy-sequence items)
                        :keys
                        (mapcar
                         (lambda (,item) (etaf--validate-key ,key-form))
                         items)
                        :context nil))))
             (,item-renderer
              (lambda (,item _etaf-keyed-context) ,compiled)))
         (etaf--expr-create
          :kind 'keyed-list
          :token ',token
          :thunk
          (lambda ()
            (let* ((program (funcall ,snapshot))
                   (items (plist-get program :items)))
              (mapcar (lambda (,item)
                        (funcall ,item-renderer ,item nil))
                      items)))
          :range-snapshot ,snapshot
          :range-item ,item-renderer)))))

(defun etaf--compile-child-sequence (children slot-mode)
  "Compile sibling CHILDREN with branch and keyed-list SLOT-MODE structure."
  (let (compiled)
    (while children
      (let* ((form (car children))
             (parts (and (consp form) (symbolp (car form))
                         (not (memq (car form) '(expr slot)))
                         (etaf--view-form-parts form)))
             (directives
              (and parts
                   (etaf--validate-directive-set
                    (etaf--view-directive-properties (nth 1 parts))))))
        (cond
         ((and directives (plist-member directives :if))
          (pcase-let ((`(,value . ,remaining)
                       (etaf--compile-branch-children
                        form (cdr children) slot-mode)))
            (push value compiled)
            (setq children remaining)))
         ((and directives (plist-member directives :for))
          (push (etaf--compile-for-child form slot-mode) compiled)
          (setq children (cdr children)))
         ((and directives
               (or (plist-member directives :else-if)
                   (plist-member directives :else)))
          (etaf--syntax-error "Orphan branch arm: %S" form))
         (t
          (push (etaf--compile-child-form form slot-mode) compiled)
          (setq children (cdr children))))))
    (nreverse compiled)))

(defun etaf--compile-child-form (form &optional slot-mode)
  "Compile structural child FORM into code returning a View value.

SLOT-MODE distinguishes Component-owned projections from call-site inputs."
  (cond
   ((null form) nil)
   ((stringp form) `(quote ,form))
   ((and (consp form) (eq (car form) 'expr))
    (etaf--compile-expr-form (cdr form)))
   ((and (consp form) (eq (car form) 'slot))
    (etaf--compile-slot-form (cdr form) slot-mode))
   ((and (consp form) (symbolp (car form)))
    (when (and (null (gethash (car form) etaf--view-registry))
               (etaf--ordinary-expression-head-p (car form)))
      (etaf--syntax-error
       "Elisp expression %S must be inside (expr FORM)" (car form)))
    (etaf--compile-view-form form slot-mode))
   ((consp form)
    (etaf--syntax-error "Invalid View child form: %S" form))
   (t
    (etaf--syntax-error
     "View children must be strings, nil, View forms, or expr results: %S"
     form))))

(defun etaf--compile-view-form (form &optional slot-mode)
  "Compile one structural View FORM into runtime construction code.

SLOT-MODE distinguishes Component-owned projections from call-site inputs."
  (cond
   ((null form) nil)
   ((stringp form) `(etaf--text-view-from-string ,form))
   ((not (and (consp form) (symbolp (car form))))
    (etaf--syntax-error "View form must start with a symbol: %S" form))
   ((eq (car form) 'expr)
    (etaf--compile-expr-form (cdr form)))
   ((eq (car form) 'slot)
    ;; A render closure returned from `:setup' invokes `etaf-view' later than
    ;; the Component definition macro, so the public macro defaults to
    ;; projection mode.  An unowned projection simply uses its fallback.
    (etaf--compile-slot-form (cdr form) slot-mode))
   (t
    (let* ((parts (etaf--parse-attributes-and-children (cdr form)))
           (props (car parts))
           (children (cdr parts))
           (host-view-p (eq (gethash (car form) etaf--view-registry)
                            etaf--host-marker))
           (child-slot-mode (if host-view-p slot-mode :input)))
      (let ((token (and (memq (car form) '(fragment etaf-fragment))
                        (gensym "etaf-fragment-site-"))))
        `(etaf--view-call ',(car form)
                          (list ,@(etaf--compile-property-plist props))
                          (list ,@(etaf--compile-child-sequence
                                   children child-slot-mode))
                          ,(and token `',token)))))))

;;;###autoload
(defmacro etaf-view (form)
  "Construct a normalized ETAF View from structural FORM.

FORM uses one grammar for Hosts and Component calls:

  (NAME :PROPERTY VALUE ... CHILD ...)

Properties must come first and children must come last.  Property values are
ordinary Elisp expressions.  `(expr FORM)' is text interpolation only."
  (declare (indent 1) (debug (form)))
  (if (fboundp 'etaf-compiler-expand-view)
      (etaf-compiler-expand-view form :projection)
    (etaf--compile-view-form form :projection)))

(defun etaf--component-prop-key (name)
  "Return the keyword used to pass Component prop NAME."
  (if (keywordp name)
      name
    (etaf--keyword-for-name name)))

(defun etaf--partition-component-input (spec props)
  "Partition SPEC input PROPS into business props and Host attrs.
Return `(BUSINESS ATTRS)'.  `:key' remains framework-owned input metadata."
  (let ((declared (mapcar #'etaf--component-prop-key
                          (etaf--component-spec-props spec)))
        (tail (etaf--validate-property-plist props))
        (attr-domains (make-hash-table :test #'eq))
        business
        attrs)
    (while tail
      (let ((key (pop tail))
            (value (pop tail)))
        (cond
         ((or (eq key :key) (memq key declared))
          (setq business (append business (list key value))))
         ((etaf--host-attribute-p key)
          (let ((domain (etaf--property-domain-key key)))
            (when (gethash domain attr-domains)
              (etaf--component-error
               "Duplicate Component Host attribute domain: %S" key))
            (puthash domain t attr-domains)
            (setq attrs (append attrs (list domain value)))))
         (t
          (etaf--component-error
           "Unknown prop or Host attribute %S for Component %S"
           key (etaf--component-spec-name spec))))))
    (list business attrs)))

(defun etaf--component-business-props (call)
  "Return CALL's declared business props without framework `:key'."
  (cl-loop for (key value) on (etaf--component-call-props call) by #'cddr
           unless (eq key :key)
           append (list key value)))

(defun etaf--typed-view-child-p (value)
  "Return non-nil when VALUE is one already validated View child."
  (or (null value)
      (stringp value)
      ;; Code-mode setup may retain a structural program (for example, a
      ;; direct Range expression) and pass that opaque value to `etaf-node'.
      ;; It is still validated and interpreted only at the renderer boundary;
      ;; arbitrary lists remain rejected here.
      (etaf--expr-p value)
      (etaf--view-node-p value)
      (etaf--component-call-p value)
      (etaf--slot-projection-p value)))

(defun etaf--validate-component-render-result (value component-name)
  "Return typed VALUE or reject COMPONENT-NAME's ambiguous render result."
  (unless (etaf--typed-view-child-p value)
    (etaf--component-error
     "Component %S must render nil, a string, or one typed View; got %S"
     component-name value))
  value)

(defun etaf--validate-code-children (children context)
  "Return a detached CHILDREN spine after typed validation for CONTEXT."
  (unless (proper-list-p children)
    (etaf--component-error "%s children must be a proper list: %S"
                           context children))
  (dolist (child children)
    (unless (etaf--typed-view-child-p child)
      (etaf--component-error
       "%s child must be nil, string, or typed View: %S" context child)))
  (copy-sequence children))

(defun etaf--validate-code-slots (slots)
  "Return typed named SLOTS as internal slot inputs."
  (unless (proper-list-p slots)
    (etaf--component-error "Named slots must be a proper alist: %S" slots))
  (let (seen result)
    (dolist (entry slots (nreverse result))
      (unless (and (consp entry)
                   (symbolp (car entry))
                   (not (keywordp (car entry)))
                   (not (memq (car entry) '(nil t))))
        (etaf--component-error "Invalid named slot entry: %S" entry))
      (when (memq (car entry) seen)
        (etaf--component-error "Duplicate Component slot %S" (car entry)))
      (push (car entry) seen)
      (push (etaf--slot-input-create
             :name (car entry)
             :children (etaf--validate-code-children
                        (cdr entry) (format "Slot %S" (car entry))))
            result))))

;;;###autoload
(defun etaf-node (tag props children &optional named-slots)
  "Construct one typed View node from evaluated ordinary Elisp values.
TAG is an exact Host or Component registry symbol.  PROPS is a keyword plist,
CHILDREN is a list of typed View children, and NAMED-SLOTS is a Component-only
alist from stable slot symbols to typed child lists."
  (unless (symbolp tag)
    (etaf--component-error "Node tag must be a symbol: %S" tag))
  (setq props (etaf--validate-property-plist props))
  (dolist (directive etaf--directive-properties)
    (when (plist-member props directive)
      (etaf--component-error
       "Code node %S rejects DSL directive %S" tag directive)))
  (when (plist-member props :key)
    (setq props
          (plist-put props :key
                     (etaf--validate-key (plist-get props :key)))))
  (let* ((entry (gethash tag etaf--view-registry))
         (children (etaf--validate-code-children children
                                                (format "Node %S" tag)))
         (slot-inputs (etaf--validate-code-slots named-slots)))
    (when (and slot-inputs (eq entry etaf--host-marker))
      (etaf--component-error "Host %S does not accept named slots" tag))
    (etaf--view-call tag props (append children slot-inputs))))

(defun etaf--text-view-from-string (value)
  "Return one normalized Text View containing string VALUE."
  (etaf--view-node-create :name 'text :props nil :children (list value)))

(defun etaf--normalize-structural-child (child)
  "Normalize static structural CHILD without evaluating expressions."
  (cond
   ((stringp child) (etaf--text-view-from-string child))
   ((etaf--slot-input-p child)
    (let ((copy (copy-sequence child)))
      (setf (etaf--slot-input-children copy)
            (mapcar #'etaf--normalize-structural-child
                    (etaf--slot-input-children child)))
      copy))
   (t child)))

(defun etaf--view-call (name props children &optional token)
  "Construct NAME from PROPS and CHILDREN, retaining optional site TOKEN."
  (unless (symbolp name)
    (etaf--syntax-error "View name must be a symbol: %S" name))
  (setq props (etaf--validate-property-plist props))
  (let* ((entry (gethash name etaf--view-registry))
         (host-name (and (eq entry etaf--host-marker)
                         name))
         (children
          (if (eq host-name 'text)
              children
            (mapcar #'etaf--normalize-structural-child children))))
    (cond
     ((eq entry etaf--host-marker)
      (when (and (eq host-name 'text) (/= (length children) 1))
        (etaf--syntax-error
         "Text requires exactly one string or expr payload"))
      (when (plist-member props :key)
        (etaf--validate-key
         (etaf--resolve-property-value (plist-get props :key))))
     (etaf--view-node-create
       :name host-name
       :token token
       :props props
       :children children))
     ((etaf--component-spec-p entry)
      (pcase-let* ((`(,business-props ,attrs)
                    (etaf--partition-component-input entry props)))
        (let (default-children named-slots)
        (dolist (child children)
          (if (etaf--slot-input-p child)
              (progn
                (when (assq (etaf--slot-input-name child) named-slots)
                  (etaf--component-error
                   "Duplicate Component slot %S" (etaf--slot-input-name child)))
                (push (cons (etaf--slot-input-name child)
                            (etaf--slot-input-children child))
                      named-slots))
            (push child default-children)))
        (setq default-children (nreverse default-children)
              named-slots (nreverse named-slots))
        (when (and default-children (assq 'default named-slots))
          (etaf--component-error
           "Component default slot has both children and an explicit input"))
        (etaf--component-call-create
         :spec entry
         :props business-props
         :attrs attrs
         :slots (if default-children
                    (cons (cons 'default default-children) named-slots)
                  named-slots)))))
     (t
      (etaf--component-error "Unknown ETAF Host or Component: %S" name)))))

(provide 'etaf-view)

;;; etaf-view.el ends here