"This defines the C machine representation."

C addPrototype: #Module derivedFrom: {Types C Module}.
C Module addSlot: #namespace valued: Namespace clone.
C Module namespace addImmutableDelegate: #allTypes valued: Types.
C Module namespace addImmutableDelegate: #cTypes valued: Types C.
C Module namespace addImmutableDelegate: #module valued: Nil.
C Module addSlot: #headers valued: ExtensibleArray newEmpty.
C Module addSlot: #types valued: Dictionary newEmpty.
C Module addSlot: #methods valued: Dictionary newEmpty.
C Module addSlot: #inlines valued: {}.
C Module addSlot: #constants valued: Dictionary newEmpty.
C Module addSlot: #globals valued: Dictionary newEmpty.
C Module addSlot: #variableDeclarations valued: Dictionary newEmpty.
C Module addSlot: #variablesSetCache valued: {}. "TODO: default value type"
C Module addSlot: #globalVarUsage valued: Dictionary newEmpty.

m@(C Module traits) newEmpty
[| newM |
  newM: m clone.
  newM namespace: m namespace clone.
  newM namespace atSlotNamed: #module put: newM.
  newM headers: m headers newEmpty.
  newM types: m types newEmpty.
  newM methods: m methods newEmpty.
  newM inlines: m inlines newEmpty.
  newM constants: m constants newEmpty.
  newM globals: m globals newEmpty.
  newM variableDeclarations: m variableDeclarations newEmpty.
  newM variablesSetCache: m variablesSetCache newEmpty.
  newM globalVarUsage: m globalVarUsage newEmpty.
  newM
].

m@(C Module traits) sortedVariables
"Answer a SortedArray of the resulting C variables based on static usage."
[| globalNames |
  globalNames: (Bag newSizeOf: m globalVarUsage).
  m globalVarUsage keysAndValuesDo:
    [| :key :value | (variableDeclarations includesKey: key)
	    ifFalse: [globalNames add: key withOccurrences: value size]].
  m variableDeclarations
    keysDo: [| :e | globalNames add: e withOccurrences: 0].
  m variables sortBy: [| :x :y | (globalNames occurrencesOf: x) >
			 (globalNames occurrencesOf: y)]
].

m@(C Module traits) globalsSet
[
  (m variablesSetCache isNil
      or: [m variablesSetCache size ~= m variables size])
    ifTrue: [m variablesSetCache: (m variables as: Set)].
  m variablesSetCache
].

m@(C Module traits) handleGlobalUsageOf: vars in: method
[| item |
  vars do:
    [| :var |
     (m globalsSet includes: var) ifTrue:
       ["Find the Set of method names using this global var."
        item: (m globalVarUsage at: var
		 ifAbsent: [m globalVarUsage at: var put: Set newEmpty]).
	"Add this method name to that set."
	item include: method selector]].
].

m@(C Module traits) methodNamed: selector
[
  m methods at: selector ifAbsent: []
].

m@(C Module traits) localizeGlobals
"Find all globals used in only one method."
[| candidates procedure |
  candidates: (m globalVarUsage select: [| :e | e size = 1]).
  m variables removeAllFoundIn: candidates keySet.
  candidates keysAndValuesDo:
    [| :key :targets |
     targets do:
       [| :name |
	procedure: (m methodNamed: name).
	procedure locals add: key. "TODO: correct the locals accessor."
	m variableDeclarations at: key ifPresent:
	  [| :var | procedure at: key put: var.
	   m variableDeclarations removeKey: key]]].
  m globalVarUsage: (m globalVarUsage select: [| :e | e size > 1]).
].

m@(C Module traits) addHeaderNamed: headerName
"Add a header file. The argument has to be the literal String that should
appear in the C output, ie it should include <> or double-quotes as necessary."
[
  m headers include: headerName
].

m@(C Module traits) addConstantNamed: name valued: value type: type
[| const |
  m constants
    at: name
    ifPresent:
      [| :_ | error: 'Redefinition of constant: ' ; (name as: String)].
  (value isNil or: [value is: C Syntax Node])
    ifFalse: [value: (value as: C Syntax Literal)].
  const: (C Syntax ConstantDef of: name init: value type: type).
  m constants at: name put: const.
  m namespace addImmutableSlot: name valued: const.
  [| :_ | type] asMethod: name on: {m rules}.
  const
].

m@(C Module traits) addConstantNamed: name type: type
[
  m addConstantNamed: name valued: Nil type: type
].

m@(C Module traits) addConstantNamed: name valued: value
[
  m addConstantNamed: name valued: value type: Types C UnsignedLongInt
].

m@(C Module traits) addGlobalNamed: name valued: value type: type
[| global |
  m globals
    at: name
    ifPresent:
      [| :_ | warn: 'Redefinition of global: ' ; (name as: String)].
  (value isNil or: [value is: C Syntax Node])
    ifFalse: [value: (value as: C Syntax Literal)].
  global: (C Syntax GlobalDef of: name init: value type: type).
  m globals at: name put: global.
  m namespace addImmutableSlot: name valued: global.
  [| :_ | type] asMethod: name on: {m rules}.
  global
].

m@(C Module traits) addGlobalNamed: name type: type
[
  m addGlobalNamed: name valued: Nil type: type
].

m@(C Module traits) addGlobalNamed: name valued: value
[
  m addGlobalNamed: name valued: value type: Types C UnsignedLongInt
].

m@(C Module traits) addType: type named: name
[
  Console ; 'adding type ' ; (name as: String) ; '.\n'.
  m types
    at: name
    ifPresent:
      [| :_ | warn: 'Redefinition of type: ' ; (name as: String)].
  m types at: name put: type.
  m namespace addImmutableSlot: name valued: type.
  type
].

m@(C Module traits) addStructureNamed: name basedOn: basis
[m addType: (Types C Structure newNamed: name basedOn: basis) named: name].

m@(C Module traits) addStructureNamed: name
[m addType: (Types C Structure newNamed: name) named: name].

m@(C Module traits) addSynonymNamed: name of: type
[m addType: (Types C Synonym newNamed: name type: type) named: name].

m@(C Module traits) addEnumerationNamed: name over: values
[| enum |
  enum: (m addSynonymNamed: name of: Types C UnsignedLongInt).
  values
    doWithIndex:
      [| :value :index |
        m addConstantNamed: value valued: index type: enum
      ].
  enum
].

C addSlot: #currentModule valued: Nil.
C addSlot: #modules valued: ExtensibleArray newEmpty.

m@(C Module traits) enter
[
  C currentModule: m.
  (C modules includes: m)
    ifFalse: [C modules addLast: m]
].

m@(C Module traits) exit
[
  C currentModule: Nil
].