Kapow! pasted by wasamasa on Mon May 30 20:00:33 2016

(define KW_GetWidgetChildren (foreign-lambda* scheme-object ((KW_Widget* widget))
                               "C_word lst = C_SCHEME_END_OF_LIST;\n"
                               "C_word *p;\n"
                               "unsigned int count;\n"
                               "KW_Widget * const * children = KW_GetWidgetChildren(widget, &count);\n"
                               "if (!count) {\n"
                               "  C_return(lst);\n"
                               "}\n"
                               "for (int i = 0; i < count; i++) {\n"
                               "  C_word *a = C_alloc(C_SIZEOF_POINTER);\n"
                               "  KW_Widget *child = children[i];\n"
                               "  C_a_i_address_to_pointer(&p, 0, (C_word) child);\n"
                               "  lst = C_a_pair(&a, *p, lst);\n"
                               "}\n"
                               "C_return(lst);"))

(define (widget-children widget)
  (and-let* ((widget* (widget-pointer widget)))
    (let ((children* (KW_GetWidgetChildren widget*)))
      (map (cut hash-table-ref <> widget-table) children*))))

Less wrong pasted by wasamasa on Mon May 30 20:23:21 2016

(define KW_GetWidgetChildren (foreign-safe-lambda* scheme-object ((KW_Widget* widget))
                               "C_word lst = C_SCHEME_END_OF_LIST;\n"
                               "C_word *p = C_alloc(C_SIZEOF_POINTER);\n"
                               "unsigned int count;\n"
                               "KW_Widget * const * children = KW_GetWidgetChildren(widget, &count);\n"
                               "if (!count) {\n"
                               "  C_return(lst);\n"
                               "}\n"
                               "for (int i = 0; i < count; i++) {\n"
                               "  C_word *a = C_alloc(C_SIZEOF_PAIR);\n"
                               "  KW_Widget *child = children[i];\n"
                               "  C_a_i_address_to_pointer(&p, 0, (C_word) child);\n"
                               "  lst = C_a_pair(&a, *p, lst);\n"
                               "}\n"
                               "C_return(lst);"))

(define (widget-children widget)
  (and-let* ((widget* (widget-pointer widget)))
    (let ((children* (KW_GetWidgetChildren widget*)))
      (map (cut hash-table-ref widget-table <>) children*))))

Try this pasted by sjamaan on Mon May 30 20:38:04 2016

(define KW_GetWidgetChildren
  (foreign-primitive ((KW_Widget* widget))
    "unsigned int count;\n"
    "C_word av[4] = { C_SCHEME_UNDEFINED, C_k, C_SCHEME_FALSE, C_SCHEME_FALSE} ;"
    "C_word ab[C_SIZEOF_POINTER], *a = ab;"
    "KW_Widget * const * children = KW_GetWidgetChildren(widget, &count);\n"
    "av[1] = C_fix(count);"
    "av[2] = C_a_i_address_to_pointer(&a, 0, (C_word)children);"
    "C_values(4, av);"))

(define (get-children)
  (define extract-child
    (foreign-lambda* ((KW_Widget* children) (int i))
        "C_return(children[i]);"))
  (receive (count child-ptr)
      (let lp ((i 0)
               (children '()))
        (if (= i count)
            children
            (lp (add1 i) (cons (extract-child child-ptr i) children))))))

Obvious mistake fixed pasted by sjamaan on Mon May 30 20:39:33 2016

(define KW_GetWidgetChildren
  (foreign-primitive ((KW_Widget* widget))
    "unsigned int count;\n"
    "C_word av[4] = { C_SCHEME_UNDEFINED, C_k, C_SCHEME_FALSE, C_SCHEME_FALSE} ;"
    "C_word ab[C_SIZEOF_POINTER], *a = ab;"
    "KW_Widget * const * children = KW_GetWidgetChildren(widget, &count);\n"
    "av[2] = C_fix(count);"
    "av[3] = C_a_i_address_to_pointer(&a, 0, (C_word)children);"
    "C_values(4, av);"))

(define (get-children)
  (define extract-child
    (foreign-lambda* ((KW_Widget* children) (int i))
        "C_return(children[i]);"))
  (receive (count child-ptr)
      (let lp ((i 0)
               (children '()))
        (if (= i count)
            children
            (lp (add1 i) (cons (extract-child child-ptr i) children))))))

Of course, this needs to call KW_GetWidgetChildren too... pasted by sjamaan on Mon May 30 20:41:45 2016

(define KW_GetWidgetChildren
  (foreign-primitive ((KW_Widget* widget))
    "unsigned int count;\n"
    "C_word av[4] = { C_SCHEME_UNDEFINED, C_k, C_SCHEME_FALSE, C_SCHEME_FALSE} ;"
    "C_word ab[C_SIZEOF_POINTER], *a = ab;"
    "KW_Widget * const * children = KW_GetWidgetChildren(widget, &count);\n"
    "av[2] = C_fix(count);"
    "av[3] = C_a_i_address_to_pointer(&a, 0, (C_word)children);"
    "C_values(4, av);"))

(define (get-children widget)
  (define extract-child
    (foreign-lambda* ((KW_Widget* children) (int i))
        "C_return(children[i]);"))
  (receive (count child-ptr)
     (KW_GetWidgetChildren widget)
      (let lp ((i 0)
               (children '()))
        (if (= i count)
            children
            (lp (add1 i) (cons (extract-child child-ptr i) children))))))

Finally something working added by wasamasa on Mon May 30 21:13:04 2016

(define KW_GetWidgetChildren (foreign-lambda c-pointer "KW_GetWidgetChildren" KW_Widget* int*))

(define (widget-children widget)
  (and-let* ((widget* (widget-pointer widget)))
    (let-location ((count int 0))
      (let ((children* (KW_GetWidgetChildren widget* (location count))))
        (if (zero? count)
            '()
            (let loop ((i 0)
                       (children '()))
              (if (< i count)
                (let* ((child* ((foreign-lambda* KW_Widget* ((c-pointer p) (int i))
                                  "KW_Widget * const * ps = p; C_return((ps)[i]);") children* i))
                       (child (hash-table-ref widget-table child*)))
                  (loop (add1 i) (cons child children)))
                children)))))))