Welcome to the CHICKEN Scheme pasting service
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)))))))