"{ 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>"
!

visitCStructFieldNode:field

     (changeset add: MethodDefinitionChange new)
        className: (field owner smalltalkClassNameWithNamespace) asSymbol;
        category: 'accessing - primitives';
        selector: ('prim' , field smalltalkName capitalized);
        source:
            (String streamContents:
                [:s|
                s 
                    nextPutAll:('prim' , field smalltalkName capitalized); cr; cr;
                    tab; nextPutAll: 'self'; space;
                        nextPutAll: field smalltalkxValueExtractionSelector;
                        nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString]).

    (changeset add: MethodDefinitionChange new)
        className: (field owner smalltalkClassNameWithNamespace) asSymbol;
        category: 'accessing - primitives';
        selector: ('prim' , field smalltalkName capitalized, ':') asSymbol;
        source:
            (String streamContents:
                [:s|
                s 
                    nextPutAll:('prim' , field smalltalkName capitalized, ':') asSymbol;
                        space; nextPutAll: 'value'; cr; cr;
                    tab; nextPutAll: 'self'; space;
                        nextPutAll: field smalltalkxValueSettingSelector keywords first;
                        nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString; space;
                        nextPutAll: field smalltalkxValueSettingSelector keywords second;
                        nextPutAll: 'value'])

    "Created: / 09-07-2008 / 21:32:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 10-07-2008 / 07:43:54 / 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: ClassDefinitionChange new)
        superClassName: 
            ExternalStructure fullName;
        className: 
            cStructNode smalltalkClassNameWithNamespace;
        category:
            cStructNode smalltalkCategory;
        package:
            cStructNode smalltalkPackage.

    (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 $'
! !