effects kernel windows.ole32 parser lexer splitting grouping
sequences namespaces assocs quotations generalizations
accessors words macros alien.syntax fry arrays layouts math
-classes.struct windows.kernel32 ;
-FROM: alien.parser.private => return-type-name ;
+classes.struct windows.kernel32 locals ;
+FROM: alien.parser.private => parse-pointers return-type-name ;
IN: windows.com.syntax
<PRIVATE
TUPLE: com-interface-definition word parent iid functions ;
C: <com-interface-definition> com-interface-definition
-TUPLE: com-function-definition name return parameters ;
+TUPLE: com-function-definition return name parameter-types parameter-names ;
C: <com-function-definition> com-function-definition
SYMBOL: +com-interface-definitions+
: save-com-interface-definition ( definition -- )
dup word>> +com-interface-definitions+ get-global set-at ;
-: (parse-com-function) ( tokens -- definition )
- [ second ]
- [ first parse-c-type ]
- [
- 3 tail [ CHAR: , swap remove ] map
- 2 group [ first2 normalize-c-arg 2array ] map
- { void* "this" } prefix
- ] tri
+: (parse-com-function) ( return name -- definition )
+ ")" scan-c-args
+ [ pointer: void prefix ] [ "this" prefix ] bi*
<com-function-definition> ;
+:: (parse-com-functions) ( functions -- )
+ scan dup ";" = [ drop ] [
+ parse-c-type scan parse-pointers
+ (parse-com-function) functions push
+ functions (parse-com-functions)
+ ] if ;
+
: parse-com-functions ( -- functions )
- ";" parse-tokens { ")" } split harvest
- [ (parse-com-function) ] map ;
+ V{ } clone [ (parse-com-functions) ] keep >array ;
: (iid-word) ( definition -- word )
word>> name>> "-iid" append create-in ;
dup parent>> [ family-tree-functions ] [ { } ] if*
swap functions>> append ;
-: (invocation-quot) ( function return parameters -- quot )
- [ first ] map [ com-invoke ] 3curry ;
-
-: (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
- swap
- [ [ second ] map ]
- [ dup void? [ drop { } ] [ return-type-name 1array ] if ] bi*
- <effect> ;
-
-: (define-word-for-function) ( function interface n -- )
- -rot [ (function-word) swap ] 2keep drop
- [ return>> ] [ parameters>> ] bi
- [ (invocation-quot) ] 2keep
- (stack-effect-from-return-and-parameters)
+:: (define-word-for-function) ( function interface n -- )
+ function interface (function-word)
+ n function [ return>> ] [ parameter-types>> ] bi '[ _ _ _ com-invoke ]
+ function [ parameter-names>> ] [ return>> ] bi function-effect
define-declared ;
: define-words-for-com-interface ( definition -- )