"{ Package: 'cvut:fel/cface' }"

"{ NameSpace: Cface }"

Generator subclass:#SmalltalkXGenerator

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Cface-Generators'

!

!SmalltalkXGenerator class methodsFor:'instance creation'!

generate:aStringOrFilename class:aClass namespace:aNameSpace 

    |temp|

    temp := Generator onFile:aStringOrFilename.

    temp 

        startGeneration:aClass

        nameSpace:aNameSpace

        toFile:aStringOrFilename , '.st'.

    ^ temp.

    "Created: / 08-02-2008 / 08:55:08 / janfrog"

!

new

    ^ self basicNew initialize.

    "Created: / 08-02-2008 / 08:55:08 / janfrog"

!

on: aStream

    |gen|

    gen := self new.

    gen inputStream: aStream;

        parseDef;

        analyse.

    ^gen

    "Modified: / 24-11-2007 / 12:20:27 / haja"

    "Created: / 08-02-2008 / 08:55:08 / janfrog"

!

onFile: aStringOrFilename

    ^self on: aStringOrFilename asFilename readStream

    "Created: / 08-02-2008 / 08:55:08 / janfrog"

! !

!SmalltalkXGenerator methodsFor:'processing'!

process: node

    super process: node.

    ^changeset

    "Created: / 03-07-2008 / 21:01:19 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!SmalltalkXGenerator methodsFor:'sources'!

sourceForLibraryName

    ^String streamContents:

        [:s|

        s 

            nextPutAll: 'libraryName'; cr; cr;

            tab; 

                nextPutAll: 'OperatingSystem isUNIXlike ifTrue:[^';

                nextPutAll: unixLibraryName storeString;

                nextPutAll: '].';

                cr; cr;

            tab; 

                nextPutAll: 'OperatingSystem isMSWINDOWSlike ifTrue:[^';

                nextPutAll: win32LibraryName storeString;

                nextPutAll: '].';

                cr; cr;

            tab;

                nextPutAll:'self error:''Library name for host OS is not known'''.

        ]

    "Created: / 10-07-2008 / 09:04:56 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

sourceForPrimitive:functionNode 

    ^ (String 

        streamContents:[:s | 

            s nextPutAll:functionNode 

                        smalltalkPrimitiveSelectorIterlacedWithArgumentNames.

            s

                cr;

                cr;

                tab;

                nextPutAll:'<cdecl:';

                space;

                nextPutAll:functionNode return ffiTypeSymbol;

                space;

                nextPut:$";

                nextPutAll:functionNode cName;

                nextPut:$";

                space;

                nextPut:$(;

                space.

            functionNode arguments do:[:argument | 

                s

                    nextPutAll:argument type ffiTypeSymbol;

                    space

            ].

            s

                nextPut:$);

                space.

            s nextPut:$>.

            s

                cr;

                tab.

            s nextPutAll:'self primitiveFailed'.

        ])

    "Created: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!SmalltalkXGenerator methodsFor:'visiting'!

visitCEnumNode: cEnumNode

    cEnumNode isForeign ifTrue:[^self].

    (changeset add: ClassDefinitionChange new)

        superClassName: 

            SharedPool fullName;

        className: 

            cEnumNode smalltalkClassNameWithNamespace;

        classVariableNames:

            (String streamContents:

                [:s|

                cEnumNode values do:

                    [:cEnumValueNode|

                    s nextPutAll: cEnumValueNode smalltalkName; space]]);

        category:

            cEnumNode smalltalkCategory;

        package:

            cEnumNode smalltalkPackage.

    (changeset add: MethodDefinitionChange new)

        className:

            cEnumNode smalltalkClassNameWithNamespace, ' class';

        selector:

            #initialize;

        category:

            #initialization;

        source:

            (String streamContents:

                [:s|

                s nextPutAll:'initialize' ; cr; cr.

                cEnumNode values do:

                    [:cEnumValueNode|

                    s 

                        tab; 

                        nextPutAll: cEnumValueNode smalltalkName;

                        nextPutAll: ' := ';

                        nextPutAll: cEnumValueNode intValue;

                        nextPut:$.; cr]]).

    cEnumNode values do:

        [:cEnumValueNode|

        (changeset add: MethodDefinitionChange new)

            className:

                cEnumNode smalltalkClassNameWithNamespace, ' class';

            selector:

                cEnumValueNode cName asSymbol;

            category:

                #constants;

            source:

                (String streamContents:

                    [:s|

                    s nextPutAll: cEnumValueNode smalltalkName; cr; cr.

                    s tab; nextPut:$^; nextPutAll: cEnumValueNode smalltalkName])]

    "Created: / 03-07-2008 / 20:10:34 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 04-07-2008 / 11:58:27 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

visitCFunctionNode:functionNode 

    (changeset add:MethodDefinitionChange new)

        className:(functionNode smalltalkClassNameWithNamespace , ' class') 

                    asSymbol;

        category:'primitives';

        selector:functionNode smalltalkPrimitiveSelector;

        source:(self sourceForPrimitive:functionNode).

    "Created: / 03-07-2008 / 21:26:42 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

!

visitCStructNode: cStructNode

    self visitCStructuredNode: cStructNode

    "Created: / 03-07-2008 / 21:31:31 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 10-07-2008 / 08:46:29 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

visitCStructuredNode: cStructNode

    cStructNode foreign ifTrue:[^self].

    cStructNode isAnonymous ifTrue:[^self].

    (changeset add:MethodDefinitionChange new)

        className:(cStructNode smalltalkClassNameWithNamespace , ' class') 

                    asSymbol;

        category:'accessing';

        selector:#libraryName;

        source:(self sourceForLibraryName).

    cStructNode fields do:

            [:fieldNode|self visit: fieldNode]

    "Created: / 10-07-2008 / 08:46:12 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

visitCTypedefNode: typedefNode

    "Created: / 03-07-2008 / 22:00:49 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

visitCUnionNode: cStructNode

    self visitCStructuredNode: cStructNode

    "Created: / 09-07-2008 / 22:30:14 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 10-07-2008 / 08:46:43 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!SmalltalkXGenerator class methodsFor:'documentation'!

version

    ^ '$Header: /opt/data/cvs/cvut-fel/cface/Cface__SmalltalkXGenerator.st,v 1.1 2008/02/26 18:25:12 vranyj1 Exp $'

! !