ptype.fs (4128B) - raw
1 \ Type parsing 2 ?f<< /comp/c/tok.fs 3 ?f<< /comp/c/glob.fs 4 ?f<< /comp/c/expr.fs 5 ?f<< /comp/c/type.fs 6 7 : _err ( -- ) tokdbg abort" ptype error" ; 8 : _assert ( f -- ) not if _err then ; 9 10 alias _err parseType ( tok -- type? f ) \ forward declaration 11 alias _err parseDeclarator ( type -- cdecl ) \ forward declaration 12 13 \ Parsing strategy: we dig down recursively through nextt until we get to our 14 \ identifier. Before that identifier, we can hit chars like ( and *. 15 \ For *, it's easy, we inc our current indirection level. For (, we enter a 16 \ recursion. 17 \ After we hit the identifier, we continue parsing forward, where 18 \ we can hit chars like [, an array specifier and (, a function specifier. We 19 \ process them, amending our cdecl structure as we go. If we hit a ), we go up 20 \ one level in recursion and apply previously recorded indirection levels to the 21 \ returned type. 22 23 : _arg ( parent-cdecl tok -- offset ) 24 parseType _assert parseDeclarator ( cdecl newtype ) 25 tuck swap to CDecl nexttype ( newtype ) 26 ')' readChar? if 0 swap CDecl :offset! else 27 ',' expectChar dup nextt _arg ( cdecl offset ) 28 swap CDecl :offset! then ( offset ) ; 29 30 \ parsing after the identifier 31 : _post ( cdecl -- cdecl ) 32 begin ( cdecl ) nextt case 33 '[' isChar? of 34 nextt parseExpression ExprOp :const# 35 nextt ']' expectChar ( cdecl nbelem ) over to CDecl nbelem endof 36 '(' isChar? of 37 dup CDecl :funcsig! STORAGE_PS to@! curstorage >r 38 ')' readChar? not if ( cdecl tok ) 39 over swap _arg ( cdecl offset ) drop 40 \ args in nexttype, we want them in args 41 0 over to@! CDecl nexttype over to CDecl args then 42 r> to curstorage endof 43 to nexttputback rdrop exit 44 endcase again ; 45 46 :realias parseDeclarator ( type -- cdecl ) 47 0 over cdecl? if over CDecl :funcptr? if 48 dip bi CDecl type | CDecl lvl | + then then ( type lvl ) 49 begin ( type lvl ) 50 '*' readChar? while ( type lvl tok ) 1+ repeat ( type lvl tok ) 51 dup '(' isChar? if ( type lvl tok ) 52 \ Complex type parsing is messed up. Example "int (*foo)[42]", a pointer to 53 \ an array of int (an array of int* is "int *foo[42]"). Right now, "type" is 54 \ "int" and we're about to parse the "(*foo)" part. This will give us a 55 \ CDecl {type=int,lvl=1,name=foo}. Now, for the _post part, we want a brand 56 \ new CDecl {type=int,lvl=0,nbelem=42,name=null}. Then, we set the first 57 \ CDecl's type to the newly parsed type. We have our "int (*foo)[42]". 58 \ The "lvl" we've just parsed above goes to the *inner* type. 59 drop over parseDeclarator read) ( type inner-lvl outer-type ) 60 rot NULLSTR swap CDecl :new _post ( il ot inner-type ) 61 rot over to CDecl lvl over to CDecl type ( cdecl ) 62 else ( type lvl tok ) 63 dup isIdent? not if to nexttputback NULLSTR then ( type lvl name ) 64 rot CDecl :new ( lvl cdecl ) tuck to CDecl lvl then _post ; 65 66 : _parseStruct ( -- cdecl ) 67 nextt dup isIdent? if nextt else NULLSTR swap then 68 '{' expectChar ( name ) TYPE_VOID CDecl :new ( eop ) 69 dup CDecl :struct! dup addTypedef 70 STORAGE_NONE to@! curstorage >r \ V1=curstorage 71 0 >r dup begin ( eop prev ) \ V2=offset 72 '}' readChar? not while ( eop prev tok ) 73 parseType _assert parseDeclarator begin ( eop prev new ) 74 tuck swap to CDecl nexttype ( eop new ) 75 V2 over CDecl :offset! to V2 76 ';' readChar? not while ( eop prev tok ) 77 ',' expectChar dup CDecl type parseDeclarator repeat ( eop prev ) 78 repeat ( eop prev ) rdrop drop r> to curstorage ; 79 80 \ parse a type from stream, starting with "tok". This only parses the "type" 81 \ part without the "*" part or the name part. The result can be a "base" type 82 \ (type < $100) or a CDecl if the type is a struct, union or enum. 83 create _ubuf $10 allot 84 :realias parseType ( tok -- type? f ) 85 dup S" typedef" s= if 86 drop nextt parseType _assert parseDeclarator ( cdecl ) 87 dup addTypedef 1 exit then 88 dup S" struct" s= if drop _parseStruct 1 else 89 dup S" unsigned" s= if drop 8 nextt else 0 swap then ( type tok ) 90 dup typenames sfind dup 0>= if ( type tok idx ) nip or 1 91 else drop nip findTypedef ( type-or-0 ) ?dup bool then then ;