! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays assocs biassocs
combinators fry kernel lexer locals math parser sequences
words.constant words.symbol ;
IN: alien.enums

TUPLE: enum { assoc assoc read-only } ;

TUPLE: enum-c-type < c-type ;
: <enum-c-type> ( -- enum-c-type )
    enum-c-type new ; inline

:: define-enum-type ( word enum -- )
    <enum-c-type>
        integer >>class
        symbol >>boxed-class
        enum assoc>> to>> '[ _ at ] >>boxer-quot
        enum assoc>> from>> '[ _ at ] >>unboxer-quot
        4 >>align
        4 >>size
        "box_signed_4" >>boxer
        "to_fixnum" >>unboxer
    word [ define-symbol ] [ typedef ] bi ;

: enum-step ( vector -- more? )
    scan {
        { ";" [ drop f ] }
        { "{" [ [ scan scan-word 2array ] dip push "}" expect t ] }
    } case ;

: define-enum ( word assoc -- )
    [ [ create-in dup define-symbol ] dip ] assoc-map >biassoc
    enum boa [ define-constant ] [ define-enum-type ] 2bi ;

SYNTAX: ENUM:
    CREATE-WORD V{ } clone dup
    '[ _ enum-step ] [ ] while define-enum ;