C addPrototype: #Writer derivedFrom: {Writer}.


"Writes out C code."
w@(C Writer traits) printPrototype: n on: s
[overrideThis].

w@(C Writer traits) printDeclaration: f@(C Syntax FunctionDef traits) on: s
"Print the function's prototype."
[
  w printDeclaration: f type on: s.
  s ; ' '.
  w print: f name on: s.
  s ; '('.
  f args
    do:
      [| :var |
        w print: var on: s
      ]
    separatedBy: [s ; ', '].
  s ; ')'
].

w@(C Writer traits) printPrototype: f@(C Syntax FunctionDef traits) on: s
[
  f isInline
    ifTrue: 
      [s ; 'static ']
    ifFalse:
      [f isExported 
        ifTrue: [s ; 'extern ']].
  w printDeclaration: f on: s.  
  s ; ';\n'
].

w@(C Writer traits) printDefinition: f@(C Syntax FunctionDef traits) on: s
"Print the function's prototype and body."
[
  s ; '\n'.
  f isInline 
    ifTrue: 
      [s ; 'static INLINE ']
    ifFalse:
      [f isStatic 
        ifTrue: [s ; 'static ']].
  w printDeclaration: f on: s.
  s ; '\n'.
  w print: f body asBodyOn: s
].

g@(C Writer traits) print: obj on: s
[overrideThis].

g@(C Writer traits) print: sym@(Symbol traits) on: s
"The case for l-values just being symbols."
[s ; sym name].

g@(C Writer traits) print: _@True on: s
[s ; 'True'].

g@(C Writer traits) print: _@False on: s
[s ; 'False'].

g@(C Writer traits) print: _@Nil on: s
[s ; 'Nil'].

g@(C Writer traits) print: i@(Integer traits) on: s
[
  s ; i print.
  (i between: (-1 bitShift: 31) and: (1 bitShift: 31) - 1)
    ifFalse: [s nextPut: (i >= (1 bitShift: 31)
		ifTrue: [$U] ifFalse: [$L])]
].

g@(C Writer traits) print: f@(Float traits) on: s
[s ; f print].

g@(C Writer traits) print: a@(Array traits) on: s
[
  s nextPut: ${.
  a doWithIndex:
    [| :each :index |
     g print: each on: s.
     index \\ 16 = 1 ifTrue: [s nextPut: $\n].
     s ; ', '].
  s nextPut: $}
].

w@(C Writer traits) printEscapedCharacter: c on: s
[
  c caseOf:
      {
        $\n -> [s ; '\\n'].
        $\t -> [s ; '\\t'].
        $\r -> [s ; '\\r'].
        $\b -> [s ; '\\b'].
        $\a -> [s ; '\\t'].
        $\v -> [s ; '\\v'].
        $\f -> [s ; '\\f'].
        $\0 -> [s ; '\\0'].
        $" -> [s ; '\\"'].
        $' -> [s ; '\\\'']
      }
    otherwise: [s nextPut: c]
].

w@(C Writer traits) print: str@(String traits) on: s
[
  s nextPut: $".
  str do: 
    [| :c | 
      w printEscapedCharacter: c on: s
    ].
  s nextPut: $"
].

w@(C Writer traits) print: char@(Character traits) on: s
[
  s nextPut: $'.
  w printEscapedCharacter: char on: s.
  s nextPut: $'
].

w@(C Writer traits) print: child asChildOf: parent on: s
"This is a wrapper method using the precedence system to determine whether
to conservatively print enclosing parentheses around arguments."
"NOTE: The conservatism is that equal precedence results in disambiguation."
[
  child precedence <= parent precedence
    ifTrue:
      [s nextPut: $(.
       w print: child on: s.
       s nextPut: $)]
    ifFalse:
      [w print: child on: s].
].

w@(C Writer traits) print: node asStatementOn: s
[
  w indent.
  w printWithIndent: node on: s.
  w unindent.
  s ; ';\n'.
].

w@(C Writer traits) print: node@(C Syntax ControlStatement traits) asStatementOn: s
[
  w indent.
  w printWithIndent: node on: s.
  w unindent.
].

w@(C Writer traits) print: node@(C Syntax Empty traits) asStatementOn: s
[
].

w@(C Writer traits) print: node@(C Syntax Block traits) asStatementOn: s
[
  w indent.
  w print: node on: s.
  w unindent.
].

w@(C Writer traits) print: n@(C Syntax Block traits) on: s
[
  w indentOn: s.
  s ; '{\n'.
  n declarations do: 
    [| :decl |
      w print: decl asStatementOn: s.
    ].
  n declarations isEmpty ifFalse: [s ; '\n'].
  n statements do:
    [| :statement |
      w print: statement asStatementOn: s
    ].
  w indentOn: s.
  s ; '}\n'.
].

w@(C Writer traits) print: node asBodyOn: s
[
  w indent.
  w printWithIndent: node on: s.
  w unindent.
  s ; ';\n'.
].

w@(C Writer traits) print: node@(C Syntax ControlStatement traits) asBodyOn: s
[
  w indent.
  w printWithIndent: node on: s.
  w unindent.
].

w@(C Writer traits) print: node@(C Syntax Empty traits) asBodyOn: s
[
  s ; ';\n'.
].

w@(C Writer traits) print: node@(C Syntax Block traits) asBodyOn: s
[
  w print: node on: s.
].

w@(C Writer traits) print: n@(C Syntax Literal traits) on: s
[
  w print: n value on: s.
].

_@(C Writer traits) print: _@(C Syntax Empty traits) on: s
[
].

_@(C Writer traits) print: n@(C Syntax Direct traits) on: s
[
  s ; n contents.
].

w@(C Writer traits) print: n@(C Syntax Break traits) on: s
[
  s ; 'break'.
].

w@(C Writer traits) print: n@(C Syntax Continue traits) on: s
[
  s ; 'continue'.
].

w@(C Writer traits) print: n@(C Syntax FunctionCall traits) on: s
[
  (n function isSameAs: C Syntax FunctionDef)
    ifTrue: 
      [w print: n function name on: s]
    ifFalse: 
      [(n function isSameAs: Symbol)
        ifTrue: [w print: n function on: s]
        ifFalse: [w print: n function asChildOf: n on: s]].
  s ; '('.
  n arguments
    do: [| :arg | w print: arg on: s]
    separatedBy: [s ; ', '].
  s ; ')'
].

w@(C Writer traits) print: n@(C Syntax Return traits) on: s
[
  s ; 'return'.
  n result ifNotNil: [s ; ' '. w print: n result on: s]
].

w@(C Writer traits) print: n@(C Syntax Conditional traits) on: s
[
  w print: n condition asChildOf: n on: s.
  s ; '?'.
  n trueBody
    ifNil: [error: 'True body of C conditional must be defined.'].
  w print: n trueBody asChildOf: n on: s.
  s ; ':'.
  n falseBody
    ifNil: [error: 'False body of C conditional must be defined.'].
  w print: n falseBody asChildOf: n on: s
].

w@(C Writer traits) print: n@(C Syntax IfThenElse traits) on: s
[
  s ; 'if ('.
  n trueBody
    ifNil:
      [
        s ; '!('.
        w print: n condition on: s.
        s ; '))\n'.
        w print: n falseBody asBodyOn: s
      ]
    ifNotNil:
      [
        w print: n condition on: s.
        s ; ')\n'.
        w print: n trueBody asBodyOn: s.
        n falseBody ifNotNil:
          [w indentOn: s.
            s ; 'else\n'.
            w print: n falseBody asBodyOn: s]
      ]
].

w@(C Writer traits) print: n@(C Syntax ForLoop traits) on: s
[
  s ; 'for('.
  w print: n init on: s.
  s ; '; '.
  w print: n stopTest on: s.
  s ; '; '.
  w print: n step on: s.
  s ; ')\n'.
  w print: n body asBodyOn: s.
].

w@(C Writer traits) print: n@(C Syntax WhileLoop traits) on: s
[
  s ; 'while ('.
  w print: n test on: s.
  s ; ')\n'.
  w print: n body asBodyOn: s.
].

w@(C Writer traits) print: n@(C Syntax DoWhileLoop traits) on: s
[
  s ; 'do\n'.
  w print: n body asBodyOn: s.
  w indentOn: s.
  s ; 'while ('.
  w print: n test on: s.
  s ; ');\n'
].

w@(C Writer traits) print: n@(C Syntax Assignment traits) on: s
[
  w print: n name on: s.
  s ; ' = '.
  w print: n value asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax Prefix traits) on: s
[
  s ; n op name.
  w print: n argument asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax Postfix traits) on: s
[
  w print: n argument asChildOf: n on: s.
  s ; n op name.
].

w@(C Writer traits) print: n@(C Syntax Infix traits) on: s
[
  w print: n args first asChildOf: n on: s.
  s ; ' ' ; n op name ; ' '.
  w print: n args second asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax OpAssignment traits) on: s
[
  w print: n name on: s.
  s ; n operation name.
  w print: n value asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax SizeOf traits) on: s
[
  s ; 'sizeof '.
  w print: n argument asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax Cast traits) on: s
[
  s ; '('.
  w printDeclaration: n targetType on: s.
  s ; ') '.
  w print: n argument asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax Subscript traits) on: s
[
  w print: n array asChildOf: n on: s.
  n subscripts
    do: [| :sub |
	 s nextPut: $[.
	 w print: sub on: s.
	 s nextPut: $]].
].

w@(C Writer traits) print: n@(C Syntax Select traits) on: s
[
  w print: n struct asChildOf: n on: s.
  s ; '.'.
  w print: n member on: s.
].

w@(C Writer traits) print: n@(C Syntax PointAt traits) on: s
[
  w print: n struct asChildOf: n on: s.
  s ; '->'.
  w print: n member on: s.
].

w@(C Writer traits) print: n@(C Syntax VariableRef traits) on: s
[
  w print: n name on: s.
].

w@(C Writer traits) print: n@(C Syntax Definition traits) on: s
[
  w printDeclaration: n type on: s.
  s ; ' '.
  w printName: n name typed: n type on: s.
].

w@(C Writer traits) print: n@(C Syntax VariableDef traits) on: s
[
  resend.
  n init ifNotNil: [s ; ' = '. w print: n init on: s].
].

w@(C Writer traits) printDefinition: n@(C Syntax ConstantDef traits) on: s
[
  n isStatic ifTrue: [s ; 'static '].
  (n type is: Types C Pointer)
    ifFalse: [s ; 'const '].
  w printDeclaration: n type on: s.
  s ; ' '.
  (n type is: Types C Pointer)
    ifTrue: [s ; 'const '].
  w printName: n name typed: n type on: s.
  n init ifNotNil: [s ; ' = '. w print: n init on: s].
  s ; ';\n'
].

w@(C Writer traits) printPrototype: n@(C Syntax ConstantDef traits) on: s
[
  n isExported ifTrue: [s ; 'extern '].
  (n type is: Types C Pointer)
    ifFalse: [s ; 'const '].
  w printDeclaration: n type on: s.
  s ; ' '.
  (n type is: Types C Pointer)
    ifTrue: [s ; 'const '].
  w printName: n name typed: n type on: s.
  s ; ';\n'
].

w@(C Writer traits) printPrototype: n@(C Syntax GlobalDef traits) on: s
[
  n isExported ifTrue: [s ; 'extern '].
  w printDeclaration: n type on: s.
  s ; ' '.
  w printName: n name typed: n type on: s.
  s ; ';\n'
].

w@(C Writer traits) printDefinition: n@(C Syntax GlobalDef traits) on: s
[
  n isStatic ifTrue: [s ; 'static '].
  w print: n on: s.
  s ; ';\n'
].

w@(C Writer traits) print: n@(C Syntax ArrayLiteral traits) on: s
[
  w print: n elements on: s 
].

w@(C Writer traits) print: n@(C Syntax CaseSwitch traits) on: s
[
  s ; 'switch ('.
  w print: n value on: s.
  s ; ') {\n'.
  n cases do:
    [| :case |
     w indentOn: s.
     s ; 'case '.
     w print: case key on: s.
     s ; ':\n'.
     w print: case value asStatementOn: s.
     w print: C Syntax Break asStatementOn: s].
  n otherwise
    ifNotNil:
      [
        w indentOn: s.
        s ; 'default:\n'.
        w print: n otherwise asStatementOn: s.
        w print: C Syntax Break asStatementOn: s]. 
  w indentOn: s.
  s ; '}\n'.
].

w@(C Writer traits) print: n@(C Syntax Comment traits) on: s
[
  s ; '/* ' ; n comment ; ' */'
].

w@(C Writer traits) print: n@(C Syntax AddressOf traits) on: s
[
  s nextPut: $&.
  w print: n expression asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax Dereference traits) on: s
[
  s nextPut: $*.
  w print: n pointer asChildOf: n on: s.
].

w@(C Writer traits) print: n@(C Syntax Label traits) asStatementOn: s
[
  s ; n name ; ': '.
  w print: n statement asStatementOn: s.
].

w@(C Writer traits) print: n@(C Syntax Goto traits) on: s
[
  s ; 'goto ' ; n label name.
].

"Type declarations."

w@(C Writer traits) printName: name typed: _@(Types C Type traits) on: s
[
  w print: name on: s
].

w@(C Writer traits) printName: name typed: arr@(Types C Array traits) on: s
[| arrName |
  arrName: '' writer.
  w print: name on: arrName.
  arrName ; '['.
  arr size
    ifNotNil: [w print: arr size on: arrName].
  arrName ; ']'.
  w printName: arrName contents intern typed: arr elementType on: s
].

w@(C Writer traits) printName: name typed: fp@(Types C FunctionPointer traits) on: s
[ 
  s ; '(* '.
  w print: name on: s.
  s ; ') ('.
  fp targetType argumentTypes
    do: [| :argType |
          w printDeclaration: argType on: s.
          w printName: #'' typed: argType on: s]
    separatedBy: [s ; ', '].
  s ; ')'
].

w@(C Writer traits) printDeclaration: elem@(Types C Type traits) on: s
[
  s ; (elem cName as: String)
].

w@(C Writer traits) printDeclaration: arr@(Types C Array traits) on: s
[
  w printDeclaration: arr elementType on: s
].

w@(C Writer traits) printDeclaration: p@(Types C FunctionPointer traits) on: s
[
  w printDeclaration: p targetType resultType on: s
].

w@(C Writer traits) printDeclaration: p@(Types C Pointer traits) on: s
[
  w printDeclaration: p targetType on: s.
  s ; ' *'
].

w@(C Writer traits) printDeclaration: type@(Types C Structure traits) on: s
[
  s ; 'struct ' ; (type cName as: String)
].

w@(C Writer traits) printDefinition: _@(Types Type traits) on: s
[overrideThis].

w@(C Writer traits) print: elem@(Types C StructureElement traits) on: s
[
  w printDeclaration: elem type on: s.
  s ; ' '.
  w printName: elem cName typed: elem type on: s.
].

w@(C Writer traits) print: elem@(Types C PackedStructureElement traits) on: s
[
  resend.
  s nextPut: $:.
  w print: elem bitSize on: s.
].

w@(C Writer traits) printPrototype: type@(Types C Synonym traits) on: s
[
].

w@(C Writer traits) printDeclaration: type@(Types C Synonym traits) on: s
[
  s ; (type cName as: String)
].

w@(C Writer traits) printDefinition: type@(Types C Synonym traits) on: s
[
  s ; 'typedef '.
  w printDeclaration: type targetType on: s.
  s ; ' '.
  w printName: type cName typed: type targetType on: s.
  s ; ';\n'
].

w@(C Writer traits) printPrototype: type@(Types C Structure traits) on: s
[
  w printDeclaration: type on: s.
  s ; ';\n'
].

w@(C Writer traits) printDefinition: type@(Types C Structure traits) on: s
[
  s ; '\n'.
  w printDeclaration: type on: s.
  s ; ' {\n'.
  type elementSpecs do:
    [| :each |
    
     w print: each asStatementOn: s].
  s ; '};\n'
].