"requires: syntax"

"This file only defines methods on SyntaxNodes for the purpose of generating
static source output which can be used as valid input. These methods make a
general attempt at comprehensible output. All of them assume that the
previously-called method responsibly adds a line-ending when possible."

Compiler addSlot: #SourceWriter valued: Cloneable derive.
"This visitor is a dispatch point for these methods and may be overridden."

Compiler SourceWriter addSlot: #printsPrettily valued: True.
"Whether comments are added to the source. The default is not to."

Compiler SourceWriter addSlot: #surroundingArity valued: 3.
"The arity of a message-send context. This is significant if > 0, and should
be set to 0 otherwise. Comparisons are made with a current arity, and if the
current is greater, the message is surrounded with precedence-preserving
parentheses."

w@(Compiler SourceWriter traits) print: node@(Compiler SyntaxNode traits) on: s
"All printable nodes need to override this method."
[
  shouldOverrideThis
].

w@(Compiler SourceWriter traits) print: node@(Compiler ImplicitArgumentNode traits) on: s
"The target of implicit message sends to the context. Prints nothing."
[
].

w@(Compiler SourceWriter traits) print: node@(Compiler CommentNode traits)
  on: s
"(Optionally) print out the comment on the following line."
[
  w print: node value on: s.
  w printsPrettily
    ifTrue: [s nextPut: $".
	     s ; node comment.
	     s nextPut: $"].
  s nextPut: $\n.
  w
].

w@(Compiler SourceWriter traits) print: node inParenthesesOn: s
[
  s nextPut: $(.
  w print: node on: s.
  s nextPut: $).
  w
].

_@(Compiler SourceWriter traits) print: node@(Compiler LiteralNode traits) on: s
[
  node value printOn: s
].

w@(Compiler SourceWriter traits) printSendOf: selector with: args on: s
"Accepts a method name and array of arguments, and print the appropriate
source on the stream."
[| previousArity |
  previousArity: w surroundingArity.
  (selector isUnarySelector and: [args size = 1])
    ifTrue: [w surroundingArity: 1.
	     w print: args first on: s.
	     s nextPut: $\s.
	     s ; (selector as: String)].
  (selector isBinarySelector and: [args size = 2])
    ifTrue: [w surroundingArity: 2.
	     previousArity <= 2 ifTrue: [s nextPut: $(].
	     w print: args first on: s.
	     s nextPut: $\s.
	     s ; (selector as: String).
	     s nextPut: $\s.
	     w print: args second on: s.
	     previousArity <= 2 ifTrue: [s nextPut: $)]].
  "For keyword sends, print the first argument, partition the selector by
    the colons, (at an offset of 1 to synchronize indices for looping),
    and then loop from one to the end, printing the keywords and arguments
    alternately."
  selector isKeywordSelector
    ifTrue: [| name names position |
	       name: (selector as: String).
	       names: (name splitWith: ':').
	       w surroundingArity: 3.
	       previousArity > 0 ifTrue: [s nextPut: $(].
	       w print: args first on: s.
	       1 below: args size
		 do: [| :index |
			s nextPut: $\s.
			s ; ((names at: index - 1) as: String).
			s nextPut: $:.
			s nextPut: $\s.
			w print: (args at: index) on: s].
	       previousArity > 0 ifTrue: [s nextPut: $)]].
  w surroundingArity: previousArity.
  w
].

w@(Compiler SourceWriter traits) print: node@(Compiler MacroNode traits)
  on: s
"This should not be called yet anyway."
[
  s nextPut: $`.
  w printSendOf: node selector with: node args on: s
].

w@(Compiler SourceWriter traits) print: node@(Compiler MessageNode traits)
  on: s
[
  w printsPrettily
    ifTrue: [w printSendOf: node selector with: node arguments on: s]
    ifFalse: [s nextPut: $(.
	      node selector printOn: s.
	      s ; ' sendTo: '.
	      node arguments printOn: s.
	      s nextPut: $)].
  w
].

w@(Compiler SourceWriter traits)
  print: node@(Compiler CompoundStatementNode traits) on: s
[
  w surroundingArity: 0.
  node statements
       do: [| :statement | w print: statement on: s]
       separatedBy: [s ; '.\n'].
  w
].

w@(Compiler SourceWriter traits) print: node@(Compiler ArrayNode traits)
  on: s
[
  s nextPut: ${.
  resend.
  s nextPut: $}.
  w
].

w@(Compiler SourceWriter traits) print: node@(Compiler ParenthesisNode traits)
  on: s
[
  s nextPut: $(.
  resend.
  s nextPut: $).
  w
].

w@(Compiler SourceWriter traits) print: node@(Compiler BlockNode traits)
  on: s
[
  s nextPut: $[.
  (node inputVariables size + node localVariables size) = 0
    ifFalse: ["Print the method header."
      s ; ' | '.
      0 below: node inputVariables size
	do: [| :inputVarIndex |
	       s nextPut: $\s.
	       s ; ':' ; ((node inputVariables at: inputVarIndex) name as: String)].
      node localVariables keysDo:
	[| :localVar |
	       s nextPut: $\s.
	       s ; (localVar as: String)].
      s ; ' | '].
  resend.
  s ; ']'.
].

w@(Compiler SourceWriter traits) printArg: arg withRole: role on: s
[
  s ; (arg name as: String).
  ((role is: Compiler LiteralNode) and: [role value == NoRole]) ifFalse:
    [
    s nextPut: $@.
    w print: role on: s. "This sometimes add an unwanted space!"
    ]
].
  
w@(Compiler SourceWriter traits) printMethodHeader: node@(Compiler MethodNode traits) on: s
[
"Accepts a method name and array of arguments, and print the appropriate
source on the stream."
 | args selector |
  selector: node selector.
  args: node inputVariables.
  (selector isUnarySelector and: [args size = 1])
    ifTrue: [ | role |
             role: (node roles first).
	     w printArg: args first withRole: role on: s.
	     s nextPut: $\s.
	     s ; (selector as: String)
            ].
  (selector isBinarySelector and: [args size = 2])
    ifTrue: [ | role0 role1 |
	     role0: (node roles first).
             role1: (node roles second).
	     w printArg: args first withRole: role0 on: s.
	     s nextPut: $\s.
	     s ; (selector as: String).
	     s nextPut: $\s.
	     w printArg: args second withRole: roles1 on: s
            ].
  "For keyword sends, print the first argument, partition the selector by
    the colons, (at an offset of 1 to synchronize indices for looping),
    and then loop from one to the end, printing the keywords and arguments
    alternately."
  selector isKeywordSelector
    ifTrue: [| name names position |
	       name: (selector as: String).
	       names: (name splitWith: ':').
	       w printArg: args first withRole: node roles first on: s.
	       1 below: args size
		 do: [| :index |
			s nextPut: $\s.
			s ; ((names at: index - 1) as: String).
			s nextPut: $:.
			s nextPut: $\s.
			w printArg: (args at: index) withRole: (node roles at: index) on: s
                     ]
             ].
  w
].

w@(Compiler SourceWriter traits) print: node@(Compiler MethodNode traits)
  on: s
[
  s nextPut: $\n.
  w printMethodHeader: node on: s.
  s nextPut: $\s.
  resend.
  w
].

w@(Compiler SourceWriter traits) print: node@(Compiler ReturnNode traits)
  on: s
[
  s ; '^ '.
  w surroundingArity: 2.
  w print: node value on: s.
  w
].

w@(Compiler SourceWriter traits) print: node@(Compiler ResendNode traits)
  on: s
[
  s ; 'resend'.
].