diff options
Diffstat (limited to 'nim/rnimsyn.pas')
| -rwxr-xr-x | nim/rnimsyn.pas | 1458 |
1 files changed, 0 insertions, 1458 deletions
diff --git a/nim/rnimsyn.pas b/nim/rnimsyn.pas deleted file mode 100755 index ec1e9571e..000000000 --- a/nim/rnimsyn.pas +++ /dev/null @@ -1,1458 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit rnimsyn; - -// This module implements the renderer of the standard Nimrod representation. - -{$include config.inc} - -interface - -uses - nsystem, charsets, scanner, options, idents, strutils, ast, msgs, - lists; - -type - TRenderFlag = (renderNone, renderNoBody, renderNoComments, - renderDocComments, renderNoPragmas, renderIds); - TRenderFlags = set of TRenderFlag; - - TRenderTok = record - kind: TTokType; - len: int16; - end; - TRenderTokSeq = array of TRenderTok; - - TSrcGen = record - indent: int; - lineLen: int; - pos: int; // current position for iteration over the buffer - idx: int; // current token index for iteration over the buffer - tokens: TRenderTokSeq; - buf: string; - pendingNL: int; // negative if not active; else contains the - // indentation value - comStack: array of PNode; // comment stack - flags: TRenderFlags; - end; - -procedure renderModule(n: PNode; const filename: string; - renderFlags: TRenderFlags = {@set}[]); - -function renderTree(n: PNode; renderFlags: TRenderFlags = {@set}[]): string; - -procedure initTokRender(var r: TSrcGen; n: PNode; - renderFlags: TRenderFlags = {@set}[]); -procedure getNextTok(var r: TSrcGen; var kind: TTokType; var literal: string); - -implementation - -// We render the source code in a two phases: The first -// determines how long the subtree will likely be, the second -// phase appends to a buffer that will be the output. - -const - IndentWidth = 2; - longIndentWid = 4; - MaxLineLen = 80; - LineCommentColumn = 30; - -procedure InitSrcGen(out g: TSrcGen; renderFlags: TRenderFlags); -begin -{@ignore} - fillChar(g, sizeof(g), 0); - g.comStack := nil; - g.tokens := nil; -{@emit - g.comStack := @[];} -{@emit - g.tokens := @[];} - g.indent := 0; - g.lineLen := 0; - g.pos := 0; - g.idx := 0; - g.buf := ''; - g.flags := renderFlags; - g.pendingNL := -1; -end; - -{@ignore} -procedure add(var dest: string; const src: string); -begin - dest := dest +{&} src; -end; -{@emit} - -procedure addTok(var g: TSrcGen; kind: TTokType; const s: string); -var - len: int; -begin - len := length(g.tokens); - setLength(g.tokens, len+1); - g.tokens[len].kind := kind; - g.tokens[len].len := int16(length(s)); - add(g.buf, s); -end; - -procedure addPendingNL(var g: TSrcGen); -begin - if g.pendingNL >= 0 then begin - addTok(g, tkInd, NL+{&}repeatChar(g.pendingNL)); - g.lineLen := g.pendingNL; - g.pendingNL := -1; - end -end; - -procedure putNL(var g: TSrcGen; indent: int); overload; -begin - if g.pendingNL >= 0 then - addPendingNL(g) - else - addTok(g, tkInd, NL); - g.pendingNL := indent; - g.lineLen := indent; -end; - -procedure putNL(var g: TSrcGen); overload; -begin - putNL(g, g.indent); -end; - -procedure optNL(var g: TSrcGen; indent: int); overload; -begin - g.pendingNL := indent; - g.lineLen := indent; // BUGFIX -end; - -procedure optNL(var g: TSrcGen); overload; -begin - optNL(g, g.indent) -end; - -procedure indentNL(var g: TSrcGen); -begin - inc(g.indent, indentWidth); - g.pendingNL := g.indent; - g.lineLen := g.indent; -end; - -procedure Dedent(var g: TSrcGen); -begin - dec(g.indent, indentWidth); - assert(g.indent >= 0); - if g.pendingNL > indentWidth then begin - Dec(g.pendingNL, indentWidth); - Dec(g.lineLen, indentWidth) - end -end; - -procedure put(var g: TSrcGen; const kind: TTokType; const s: string); -begin - addPendingNL(g); - if length(s) > 0 then begin - addTok(g, kind, s); - inc(g.lineLen, length(s)); - end -end; - -procedure putLong(var g: TSrcGen; const kind: TTokType; const s: string; - lineLen: int); -// use this for tokens over multiple lines. -begin - addPendingNL(g); - addTok(g, kind, s); - g.lineLen := lineLen; -end; - -// ----------------------- helpers -------------------------------------------- - -function toNimChar(c: Char): string; -begin - case c of - #0: result := '\0'; - #1..#31, #128..#255: result := '\x' + strutils.toHex(ord(c), 2); - '''', '"', '\': result := '\' + c; - else result := c + '' - end; -end; - -function makeNimString(const s: string): string; -var - i: int; -begin - result := '"' + ''; - for i := strStart to length(s)+strStart-1 do add(result, toNimChar(s[i])); - addChar(result, '"'); -end; - -procedure putComment(var g: TSrcGen; s: string); -var - i, j, ind, comIndent: int; - isCode: bool; - com: string; -begin - {@ignore} s := s + #0; {@emit} - i := strStart; - comIndent := 1; - isCode := (length(s) >= 2) and (s[strStart+1] <> ' '); - ind := g.lineLen; - com := ''; - while true do begin - case s[i] of - #0: break; - #13: begin - put(g, tkComment, com); - com := ''; - inc(i); - if s[i] = #10 then inc(i); - optNL(g, ind); - end; - #10: begin - put(g, tkComment, com); - com := ''; - inc(i); - optNL(g, ind); - end; - '#': begin - addChar(com, s[i]); - inc(i); - comIndent := 0; - while s[i] = ' ' do begin - addChar(com, s[i]); - inc(i); inc(comIndent); - end - end; - ' ', #9: begin - addChar(com, s[i]); - inc(i); - end - else begin - // we may break the comment into a multi-line comment if the line - // gets too long: - - // compute length of the following word: - j := i; - while s[j] > ' ' do inc(j); - if not isCode and (g.lineLen + (j-i) > MaxLineLen) then begin - put(g, tkComment, com); - com := ''; - optNL(g, ind); - com := com +{&} '#' +{&} repeatChar(comIndent); - end; - while s[i] > ' ' do begin - addChar(com, s[i]); - inc(i); - end - end - end - end; - put(g, tkComment, com); - optNL(g); -end; - -function maxLineLength(s: string): int; -var - i, linelen: int; -begin - {@ignore} s := s + #0; {@emit} - result := 0; - i := strStart; - lineLen := 0; - while true do begin - case s[i] of - #0: break; - #13: begin - inc(i); - if s[i] = #10 then inc(i); - result := max(result, lineLen); - lineLen := 0; - end; - #10: begin - inc(i); - result := max(result, lineLen); - lineLen := 0; - end; - else begin - inc(lineLen); inc(i); - end - end - end -end; - -procedure putRawStr(var g: TSrcGen; kind: TTokType; const s: string); -var - i, hi: int; - str: string; -begin - i := strStart; - hi := length(s)+strStart-1; - str := ''; - while i <= hi do begin - case s[i] of - #13: begin - put(g, kind, str); - str := ''; - inc(i); - if (i <= hi) and (s[i] = #10) then inc(i); - optNL(g, 0); - end; - #10: begin - put(g, kind, str); - str := ''; - inc(i); - optNL(g, 0); - end; - else begin - addChar(str, s[i]); - inc(i) - end - end - end; - put(g, kind, str); -end; - -function containsNL(const s: string): bool; -var - i: int; -begin - for i := strStart to length(s)+strStart-1 do - case s[i] of - #13, #10: begin result := true; exit end; - else begin end - end; - result := false -end; - -procedure pushCom(var g: TSrcGen; n: PNode); -var - len: int; -begin - len := length(g.comStack); - setLength(g.comStack, len+1); - g.comStack[len] := n; -end; - -procedure popAllComs(var g: TSrcGen); -begin - setLength(g.comStack, 0); -end; - -procedure popCom(var g: TSrcGen); -begin - setLength(g.comStack, length(g.comStack)-1); -end; - -const - Space = ' '+''; - -function shouldRenderComment(var g: TSrcGen; n: PNode): bool; -begin - result := false; - if n.comment <> snil then - result := not (renderNoComments in g.flags) or - (renderDocComments in g.flags) and startsWith(n.comment, '##'); -end; - -procedure gcom(var g: TSrcGen; n: PNode); -var - ml: int; -begin - assert(n <> nil); - if shouldRenderComment(g, n) then begin - if (g.pendingNL < 0) and (length(g.buf) > 0) - and (g.buf[length(g.buf)] <> ' ') then - put(g, tkSpaces, Space); - // Before long comments we cannot make sure that a newline is generated, - // because this might be wrong. But it is no problem in practice. - if (g.pendingNL < 0) and (length(g.buf) > 0) - and (g.lineLen < LineCommentColumn) then begin - ml := maxLineLength(n.comment); - if ml+LineCommentColumn <= maxLineLen then - put(g, tkSpaces, repeatChar(LineCommentColumn - g.lineLen)); - end; - putComment(g, n.comment); - //assert(g.comStack[high(g.comStack)] = n); - end -end; - -procedure gcoms(var g: TSrcGen); -var - i: int; -begin - for i := 0 to high(g.comStack) do gcom(g, g.comStack[i]); - popAllComs(g); -end; - -// ---------------------------------------------------------------------------- - -function lsub(n: PNode): int; forward; - -function litAux(n: PNode; x: biggestInt; size: int): string; -begin - if nfBase2 in n.flags then result := '0b' + toBin(x, size*8) - else if nfBase8 in n.flags then result := '0o' + toOct(x, size*3) - else if nfBase16 in n.flags then result := '0x' + toHex(x, size*2) - else result := toString(x) -end; - -function atom(n: PNode): string; -var - f: float32; -begin - case n.kind of - nkEmpty: result := ''; - nkIdent: result := n.ident.s; - nkSym: result := n.sym.name.s; - nkStrLit: result := makeNimString(n.strVal); - nkRStrLit: result := 'r"' + n.strVal + '"'; - nkTripleStrLit: result := '"""' + n.strVal + '"""'; - nkCharLit: result := '''' + toNimChar(chr(int(n.intVal))) + ''''; - nkIntLit: result := litAux(n, n.intVal, 4); - nkInt8Lit: result := litAux(n, n.intVal, 1) + '''i8'; - nkInt16Lit: result := litAux(n, n.intVal, 2) + '''i16'; - nkInt32Lit: result := litAux(n, n.intVal, 4) + '''i32'; - nkInt64Lit: result := litAux(n, n.intVal, 8) + '''i64'; - nkFloatLit: begin - if n.flags * [nfBase2, nfBase8, nfBase16] = [] then - result := toStringF(n.floatVal) - else - result := litAux(n, ({@cast}PInt64(addr(n.floatVal)))^, 8); - end; - nkFloat32Lit: begin - if n.flags * [nfBase2, nfBase8, nfBase16] = [] then - result := toStringF(n.floatVal) + '''f32' - else begin - f := n.floatVal; - result := litAux(n, ({@cast}PInt32(addr(f)))^, 4) + '''f32' - end; - end; - nkFloat64Lit: begin - if n.flags * [nfBase2, nfBase8, nfBase16] = [] then - result := toStringF(n.floatVal) + '''f64' - else - result := litAux(n, ({@cast}PInt64(addr(n.floatVal)))^, 8) + '''f64'; - end; - nkNilLit: result := 'nil'; - nkType: begin - if (n.typ <> nil) and (n.typ.sym <> nil) then result := n.typ.sym.name.s - else result := '[type node]'; - end; - else InternalError('rnimsyn.atom ' + nodeKindToStr[n.kind]); - end -end; - -// --------------------------------------------------------------------------- - -function lcomma(n: PNode; start: int = 0; theEnd: int = -1): int; -var - i: int; -begin - assert(theEnd < 0); - result := 0; - for i := start to sonsLen(n)+theEnd do begin - inc(result, lsub(n.sons[i])); - inc(result, 2); // for ``, `` - end; - if result > 0 then dec(result, 2); // last does not get a comma! -end; - -function lsons(n: PNode; start: int = 0; theEnd: int = -1): int; -var - i: int; -begin - assert(theEnd < 0); - result := 0; - for i := start to sonsLen(n)+theEnd do inc(result, lsub(n.sons[i])); -end; - -function lsub(n: PNode): int; -// computes the length of a tree -var - L: int; -begin - if n = nil then begin result := 0; exit end; - if n.comment <> snil then begin result := maxLineLen+1; exit end; - case n.kind of - nkTripleStrLit: begin - if containsNL(n.strVal) then result := maxLineLen+1 - else result := length(atom(n)); - end; - nkEmpty..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: - result := length(atom(n)); - nkCall, nkBracketExpr, nkConv: result := lsub(n.sons[0])+lcomma(n, 1)+2; - nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: begin - result := lsub(n.sons[1]); - end; - nkCast: result := lsub(n.sons[0])+lsub(n.sons[1])+length('cast[]()'); - nkAddr: result := lsub(n.sons[0])+length('addr()'); - nkHiddenAddr, nkHiddenDeref: result := lsub(n.sons[0]); - nkCommand: result := lsub(n.sons[0])+lcomma(n, 1)+1; - nkExprEqExpr, nkAsgn, nkFastAsgn: result := lsons(n)+3; - nkPar, nkCurly, nkBracket: result := lcomma(n)+2; - nkSymChoice: result := lsons(n) + length('()') + sonsLen(n)-1; - nkTupleTy: result := lcomma(n)+length('tuple[]'); - nkDotExpr: result := lsons(n)+1; - nkBind: result := lsons(n)+length('bind_'); - nkCheckedFieldExpr: result := lsub(n.sons[0]); - nkLambda: result := lsons(n)+length('lambda__=_'); - nkConstDef, nkIdentDefs: begin - result := lcomma(n, 0, -3); - L := sonsLen(n); - if n.sons[L-2] <> nil then - result := result + lsub(n.sons[L-2]) + 2; - if n.sons[L-1] <> nil then - result := result + lsub(n.sons[L-1]) + 3; - end; - nkVarTuple: result := lcomma(n, 0, -3) + length('() = ') + lsub(lastSon(n)); - nkChckRangeF: result := length('chckRangeF') + 2 + lcomma(n); - nkChckRange64: result := length('chckRange64') + 2 + lcomma(n); - nkChckRange: result := length('chckRange') + 2 + lcomma(n); - - nkObjDownConv, nkObjUpConv, - nkStringToCString, nkCStringToString, nkPassAsOpenArray: begin - result := 2; - if sonsLen(n) >= 1 then - result := result + lsub(n.sons[0]); - result := result + lcomma(n, 1); - end; - nkExprColonExpr: result := lsons(n) + 2; - nkInfix: result := lsons(n) + 2; - nkPrefix: result := lsons(n) + 1; - nkPostfix: result := lsons(n); - nkCallStrLit: result := lsons(n); - nkPragmaExpr: result := lsub(n.sons[0])+lcomma(n, 1); - nkRange: result := lsons(n) + 2; - nkDerefExpr: result := lsub(n.sons[0])+2; - nkAccQuoted: result := lsub(n.sons[0]) + 2; - - nkIfExpr: result := lsub(n.sons[0].sons[0])+lsub(n.sons[0].sons[1]) - + lsons(n, 1) + length('if_:_'); - nkElifExpr: result := lsons(n) + length('_elif_:_'); - nkElseExpr: result := lsub(n.sons[0])+ length('_else:_'); - - // type descriptions - nkTypeOfExpr: result := lsub(n.sons[0])+length('type_'); - nkRefTy: result := lsub(n.sons[0])+length('ref_'); - nkPtrTy: result := lsub(n.sons[0])+length('ptr_'); - nkVarTy: result := lsub(n.sons[0])+length('var_'); - nkDistinctTy: result := lsub(n.sons[0])+length('Distinct_'); - nkTypeDef: result := lsons(n)+3; - nkOfInherit: result := lsub(n.sons[0])+length('of_'); - nkProcTy: result := lsons(n)+length('proc_'); - nkEnumTy: result := lsub(n.sons[0])+lcomma(n,1)+length('enum_'); - nkEnumFieldDef: result := lsons(n)+3; - - nkVarSection: if sonsLen(n) > 1 then result := maxLineLen+1 - else result := lsons(n) + length('var_'); - nkReturnStmt: result := lsub(n.sons[0])+length('return_'); - nkRaiseStmt: result := lsub(n.sons[0])+length('raise_'); - nkYieldStmt: result := lsub(n.sons[0])+length('yield_'); - nkDiscardStmt: result := lsub(n.sons[0])+length('discard_'); - nkBreakStmt: result := lsub(n.sons[0])+length('break_'); - nkContinueStmt: result := lsub(n.sons[0])+length('continue_'); - nkPragma: result := lcomma(n) + 4; - nkCommentStmt: result := length(n.comment); - - nkOfBranch: result := lcomma(n, 0, -2) + lsub(lastSon(n)) - + length('of_:_'); - nkElifBranch: result := lsons(n)+length('elif_:_'); - nkElse: result := lsub(n.sons[0]) + length('else:_'); - nkFinally: result := lsub(n.sons[0]) + length('finally:_'); - nkGenericParams: result := lcomma(n) + 2; - nkFormalParams: begin - result := lcomma(n, 1) + 2; - if n.sons[0] <> nil then result := result + lsub(n.sons[0]) + 2 - end; - nkExceptBranch: result := lcomma(n, 0, -2) + lsub(lastSon(n)) - + length('except_:_'); - else result := maxLineLen+1 - end -end; - -function fits(const g: TSrcGen; x: int): bool; -begin - result := x + g.lineLen <= maxLineLen -end; - -// ------------------------- render part -------------------------------------- - -type - TSubFlag = (rfLongMode, rfNoIndent, rfInConstExpr); - TSubFlags = set of TSubFlag; - TContext = record{@tuple} - spacing: int; - flags: TSubFlags; - end; - -const - emptyContext: TContext = (spacing: 0; flags: {@set}[]); - -procedure initContext(out c: TContext); -begin - c.spacing := 0; - c.flags := {@set}[]; -end; - -procedure gsub(var g: TSrcGen; n: PNode; const c: TContext); overload; forward; - -procedure gsub(var g: TSrcGen; n: PNode); overload; -var - c: TContext; -begin - initContext(c); - gsub(g, n, c); -end; - -function hasCom(n: PNode): bool; -var - i: int; -begin - result := false; - if n = nil then exit; - if n.comment <> snil then begin result := true; exit end; - case n.kind of - nkEmpty..nkNilLit: begin end; - else begin - for i := 0 to sonsLen(n)-1 do - if hasCom(n.sons[i]) then begin - result := true; exit - end - end - end -end; - -procedure putWithSpace(var g: TSrcGen; kind: TTokType; const s: string); -begin - put(g, kind, s); - put(g, tkSpaces, Space); -end; - -procedure gcommaAux(var g: TSrcGen; n: PNode; ind: int; - start: int = 0; theEnd: int = -1); -var - i, sublen: int; - c: bool; -begin - for i := start to sonsLen(n)+theEnd do begin - c := i < sonsLen(n)+theEnd; - sublen := lsub(n.sons[i])+ord(c); - if not fits(g, sublen) and (ind+sublen < maxLineLen) then optNL(g, ind); - gsub(g, n.sons[i]); - if c then begin - putWithSpace(g, tkComma, ','+''); - if hasCom(n.sons[i]) then begin - gcoms(g); - optNL(g, ind); - end - end - end -end; - -procedure gcomma(var g: TSrcGen; n: PNode; const c: TContext; - start: int = 0; theEnd: int = -1); overload; -var - ind: int; -begin - if rfInConstExpr in c.flags then - ind := g.indent + indentWidth - else begin - ind := g.lineLen; - if ind > maxLineLen div 2 then ind := g.indent + longIndentWid - end; - gcommaAux(g, n, ind, start, theEnd); -end; - -procedure gcomma(var g: TSrcGen; n: PNode; - start: int = 0; theEnd: int = -1); overload; -var - ind: int; -begin - ind := g.lineLen; - if ind > maxLineLen div 2 then ind := g.indent + longIndentWid; - gcommaAux(g, n, ind, start, theEnd); -end; - -procedure gsons(var g: TSrcGen; n: PNode; const c: TContext; - start: int = 0; theEnd: int = -1); -var - i: int; -begin - for i := start to sonsLen(n)+theEnd do begin - gsub(g, n.sons[i], c); - end -end; - -procedure gsection(var g: TSrcGen; n: PNode; const c: TContext; kind: TTokType; - const k: string); -var - i: int; -begin - if sonsLen(n) = 0 then exit; // empty var sections are possible - putWithSpace(g, kind, k); - gcoms(g); - indentNL(g); - for i := 0 to sonsLen(n)-1 do begin - optNL(g); - gsub(g, n.sons[i], c); - gcoms(g); - end; - dedent(g); -end; - - -function longMode(n: PNode; start: int = 0; theEnd: int = -1): bool; -var - i: int; -begin - result := n.comment <> snil; - if not result then begin - // check further - for i := start to sonsLen(n)+theEnd do begin - if (lsub(n.sons[i]) > maxLineLen) then begin - result := true; break end; - end - end -end; - -procedure gstmts(var g: TSrcGen; n: PNode; const c: TContext); -var - i: int; -begin - if n = nil then exit; - if (n.kind = nkStmtList) or (n.kind = nkStmtListExpr) then begin - indentNL(g); - for i := 0 to sonsLen(n)-1 do begin - optNL(g); - gsub(g, n.sons[i]); - gcoms(g); - end; - dedent(g); - end - else begin - if rfLongMode in c.flags then indentNL(g); - gsub(g, n); - gcoms(g); - optNL(g); - if rfLongMode in c.flags then dedent(g); - end -end; - -procedure gif(var g: TSrcGen; n: PNode); -var - c: TContext; - i, len: int; -begin - gsub(g, n.sons[0].sons[0]); - initContext(c); - putWithSpace(g, tkColon, ':'+''); - if longMode(n) or (lsub(n.sons[0].sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); // a good place for comments - gstmts(g, n.sons[0].sons[1], c); - len := sonsLen(n); - for i := 1 to len-1 do begin - optNL(g); - gsub(g, n.sons[i], c) - end; -end; - -procedure gwhile(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - putWithSpace(g, tkWhile, 'while'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - initContext(c); - if longMode(n) or (lsub(n.sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); // a good place for comments - gstmts(g, n.sons[1], c); -end; - -procedure gtry(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - put(g, tkTry, 'try'); - putWithSpace(g, tkColon, ':'+''); - initContext(c); - if longMode(n) or (lsub(n.sons[0])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); // a good place for comments - gstmts(g, n.sons[0], c); - gsons(g, n, c, 1); -end; - -procedure gfor(var g: TSrcGen; n: PNode); -var - c: TContext; - len: int; -begin - len := sonsLen(n); - putWithSpace(g, tkFor, 'for'); - initContext(c); - if longMode(n) - or (lsub(n.sons[len-1]) - + lsub(n.sons[len-2]) + 6 + g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcomma(g, n, c, 0, -3); - put(g, tkSpaces, Space); - putWithSpace(g, tkIn, 'in'); - gsub(g, n.sons[len-2], c); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[len-1], c); -end; - -procedure gmacro(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - initContext(c); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - if longMode(n) or (lsub(n.sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); - gsons(g, n, c, 1); -end; - -procedure gcase(var g: TSrcGen; n: PNode); -var - c: TContext; - len, last: int; -begin - initContext(c); - len := sonsLen(n); - if n.sons[len-1].kind = nkElse then last := -2 - else last := -1; - if longMode(n, 0, last) then include(c.flags, rfLongMode); - putWithSpace(g, tkCase, 'case'); - gsub(g, n.sons[0]); - gcoms(g); - optNL(g); - gsons(g, n, c, 1, last); - if last = -2 then begin - initContext(c); - if longMode(n.sons[len-1]) then include(c.flags, rfLongMode); - gsub(g, n.sons[len-1], c); - end -end; - -procedure gproc(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - gsub(g, n.sons[2]); - gsub(g, n.sons[3]); - if not (renderNoBody in g.flags) then begin - if n.sons[4] <> nil then begin - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - indentNL(g); - gcoms(g); - dedent(g); - initContext(c); - gstmts(g, n.sons[4], c); - putNL(g); - end - else begin - indentNL(g); - gcoms(g); - dedent(g); - end - end; -end; - -procedure gblock(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - initContext(c); - putWithSpace(g, tkBlock, 'block'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - if longMode(n) or (lsub(n.sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); - gstmts(g, n.sons[1], c); -end; - -procedure gasm(var g: TSrcGen; n: PNode); -begin - putWithSpace(g, tkAsm, 'asm'); - gsub(g, n.sons[0]); - gcoms(g); - gsub(g, n.sons[1]); -end; - -procedure gident(var g: TSrcGen; n: PNode); -var - s: string; - t: TTokType; -begin - s := atom(n); - if (s[strStart] in scanner.SymChars) then begin - if (n.kind = nkIdent) then begin - if (n.ident.id < ord(tokKeywordLow)-ord(tkSymbol)) or - (n.ident.id > ord(tokKeywordHigh)-ord(tkSymbol)) then - t := tkSymbol - else - t := TTokType(n.ident.id+ord(tkSymbol)) - end - else - t := tkSymbol; - end - else - t := tkOpr; - put(g, t, s); - if (n.kind = nkSym) and (renderIds in g.flags) then - put(g, tkIntLit, toString(n.sym.id)); -end; - -procedure gsub(var g: TSrcGen; n: PNode; const c: TContext); -var - L, i: int; - a: TContext; -begin - if n = nil then exit; - if n.comment <> snil then pushCom(g, n); - case n.kind of - // atoms: - nkTripleStrLit: putRawStr(g, tkTripleStrLit, n.strVal); - nkEmpty, nkType: put(g, tkInvalid, atom(n)); - nkSym, nkIdent: gident(g, n); - nkIntLit: put(g, tkIntLit, atom(n)); - nkInt8Lit: put(g, tkInt8Lit, atom(n)); - nkInt16Lit: put(g, tkInt16Lit, atom(n)); - nkInt32Lit: put(g, tkInt32Lit, atom(n)); - nkInt64Lit: put(g, tkInt64Lit, atom(n)); - nkFloatLit: put(g, tkFloatLit, atom(n)); - nkFloat32Lit: put(g, tkFloat32Lit, atom(n)); - nkFloat64Lit: put(g, tkFloat64Lit, atom(n)); - nkStrLit: put(g, tkStrLit, atom(n)); - nkRStrLit: put(g, tkRStrLit, atom(n)); - nkCharLit: put(g, tkCharLit, atom(n)); - nkNilLit: put(g, tkNil, atom(n)); - // complex expressions - nkCall, nkConv, nkDotCall: begin - if sonsLen(n) >= 1 then - gsub(g, n.sons[0]); - put(g, tkParLe, '('+''); - gcomma(g, n, 1); - put(g, tkParRi, ')'+''); - end; - nkCallStrLit: begin - gsub(g, n.sons[0]); - if n.sons[1].kind = nkRStrLit then - put(g, tkRStrLit, '"' + n.sons[1].strVal + '"') - else - gsub(g, n.sons[0]); - end; - nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: begin - gsub(g, n.sons[0]); - end; - nkCast: begin - put(g, tkCast, 'cast'); - put(g, tkBracketLe, '['+''); - gsub(g, n.sons[0]); - put(g, tkBracketRi, ']'+''); - put(g, tkParLe, '('+''); - gsub(g, n.sons[1]); - put(g, tkParRi, ')'+''); - end; - nkAddr: begin - put(g, tkAddr, 'addr'); - put(g, tkParLe, '('+''); - gsub(g, n.sons[0]); - put(g, tkParRi, ')'+''); - end; - nkBracketExpr: begin - gsub(g, n.sons[0]); - put(g, tkBracketLe, '['+''); - gcomma(g, n, 1); - put(g, tkBracketRi, ']'+''); - end; - nkPragmaExpr: begin - gsub(g, n.sons[0]); - gcomma(g, n, 1); - end; - nkCommand: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, space); - gcomma(g, n, 1); - end; - nkExprEqExpr, nkAsgn, nkFastAsgn: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[1]); - end; - nkChckRangeF: begin - put(g, tkSymbol, 'chckRangeF'); - put(g, tkParLe, '('+''); - gcomma(g, n); - put(g, tkParRi, ')'+''); - end; - nkChckRange64: begin - put(g, tkSymbol, 'chckRange64'); - put(g, tkParLe, '('+''); - gcomma(g, n); - put(g, tkParRi, ')'+''); - end; - nkChckRange: begin - put(g, tkSymbol, 'chckRange'); - put(g, tkParLe, '('+''); - gcomma(g, n); - put(g, tkParRi, ')'+''); - end; - nkObjDownConv, nkObjUpConv, - nkStringToCString, nkCStringToString, nkPassAsOpenArray: begin - if sonsLen(n) >= 1 then - gsub(g, n.sons[0]); - put(g, tkParLe, '('+''); - gcomma(g, n, 1); - put(g, tkParRi, ')'+''); - end; - nkSymChoice: begin - put(g, tkParLe, '('+''); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then put(g, tkOpr, '|'+''); - gsub(g, n.sons[i], c); - end; - put(g, tkParRi, ')'+''); - end; - nkPar: begin - put(g, tkParLe, '('+''); - gcomma(g, n, c); - put(g, tkParRi, ')'+''); - end; - nkCurly: begin - put(g, tkCurlyLe, '{'+''); - gcomma(g, n, c); - put(g, tkCurlyRi, '}'+''); - end; - nkBracket: begin - put(g, tkBracketLe, '['+''); - gcomma(g, n, c); - put(g, tkBracketRi, ']'+''); - end; - nkDotExpr: begin - gsub(g, n.sons[0]); - put(g, tkDot, '.'+''); - gsub(g, n.sons[1]); - end; - nkBind: begin - putWithSpace(g, tkBind, 'bind'); - gsub(g, n.sons[0]); - end; - nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref: gsub(g, n.sons[0]); - nkLambda: begin - assert(n.sons[genericParamsPos] = nil); - putWithSpace(g, tkLambda, 'lambda'); - gsub(g, n.sons[paramsPos]); - gsub(g, n.sons[pragmasPos]); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[codePos]); - end; - nkConstDef, nkIdentDefs: begin - gcomma(g, n, 0, -3); - L := sonsLen(n); - if n.sons[L-2] <> nil then begin - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[L-2]) - end; - if n.sons[L-1] <> nil then begin - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[L-1], c) - end; - end; - nkVarTuple: begin - put(g, tkParLe, '('+''); - gcomma(g, n, 0, -3); - put(g, tkParRi, ')'+''); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, lastSon(n), c); - end; - nkExprColonExpr: begin - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[1]); - end; - nkInfix: begin - gsub(g, n.sons[1]); - put(g, tkSpaces, Space); - gsub(g, n.sons[0]); // binary operator - if not fits(g, lsub(n.sons[2])+ lsub(n.sons[0]) + 1) then - optNL(g, g.indent+longIndentWid) - else put(g, tkSpaces, Space); - gsub(g, n.sons[2]); - end; - nkPrefix: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, space); - gsub(g, n.sons[1]); - end; - nkPostfix: begin - gsub(g, n.sons[1]); - gsub(g, n.sons[0]); - end; - nkRange: begin - gsub(g, n.sons[0]); - put(g, tkDotDot, '..'); - gsub(g, n.sons[1]); - end; - nkDerefExpr: begin - gsub(g, n.sons[0]); - putWithSpace(g, tkHat, '^'+''); - // unfortunately this requires a space, because ^. would be - // only one operator - end; - nkAccQuoted: begin - put(g, tkAccent, '`'+''); - gsub(g, n.sons[0]); - put(g, tkAccent, '`'+''); - end; - nkIfExpr: begin - putWithSpace(g, tkIf, 'if'); - gsub(g, n.sons[0].sons[0]); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[0].sons[1]); - gsons(g, n, emptyContext, 1); - end; - nkElifExpr: begin - putWithSpace(g, tkElif, ' elif'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[1]); - end; - nkElseExpr: begin - put(g, tkElse, ' else'); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[0]); - end; - - nkTypeOfExpr: begin - putWithSpace(g, tkType, 'type'); - gsub(g, n.sons[0]); - end; - nkRefTy: begin - putWithSpace(g, tkRef, 'ref'); - gsub(g, n.sons[0]); - end; - nkPtrTy: begin - putWithSpace(g, tkPtr, 'ptr'); - gsub(g, n.sons[0]); - end; - nkVarTy: begin - putWithSpace(g, tkVar, 'var'); - gsub(g, n.sons[0]); - end; - nkDistinctTy: begin - putWithSpace(g, tkDistinct, 'distinct'); - gsub(g, n.sons[0]); - end; - nkTypeDef: begin - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - put(g, tkSpaces, Space); - if n.sons[2] <> nil then begin - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[2]); - end - end; - nkObjectTy: begin - putWithSpace(g, tkObject, 'object'); - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - gcoms(g); - gsub(g, n.sons[2]); - end; - nkRecList: begin - indentNL(g); - for i := 0 to sonsLen(n)-1 do begin - optNL(g); - gsub(g, n.sons[i], c); - gcoms(g); - end; - dedent(g); - putNL(g); - end; - nkOfInherit: begin - putWithSpace(g, tkOf, 'of'); - gsub(g, n.sons[0]); - end; - nkProcTy: begin - putWithSpace(g, tkProc, 'proc'); - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - end; - nkEnumTy: begin - putWithSpace(g, tkEnum, 'enum'); - gsub(g, n.sons[0]); - gcoms(g); - indentNL(g); - gcommaAux(g, n, g.indent, 1); - gcoms(g); // BUGFIX: comment for the last enum field - dedent(g); - end; - nkEnumFieldDef: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[1]); - end; - nkStmtList, nkStmtListExpr: gstmts(g, n, emptyContext); - nkIfStmt: begin - putWithSpace(g, tkIf, 'if'); - gif(g, n); - end; - nkWhenStmt, nkRecWhen: begin - putWithSpace(g, tkWhen, 'when'); - gif(g, n); - end; - nkWhileStmt: gwhile(g, n); - nkCaseStmt, nkRecCase: gcase(g, n); - nkMacroStmt: gmacro(g, n); - nkTryStmt: gtry(g, n); - nkForStmt: gfor(g, n); - nkBlockStmt, nkBlockExpr: gblock(g, n); - nkAsmStmt: gasm(g, n); - nkProcDef: begin - putWithSpace(g, tkProc, 'proc'); - gproc(g, n); - end; - nkMethodDef: begin - putWithSpace(g, tkMethod, 'method'); - gproc(g, n); - end; - nkIteratorDef: begin - putWithSpace(g, tkIterator, 'iterator'); - gproc(g, n); - end; - nkMacroDef: begin - putWithSpace(g, tkMacro, 'macro'); - gproc(g, n); - end; - nkTemplateDef: begin - putWithSpace(g, tkTemplate, 'template'); - gproc(g, n); - end; - nkTypeSection: gsection(g, n, emptyContext, tkType, 'type'); - nkConstSection: begin - initContext(a); - include(a.flags, rfInConstExpr); - gsection(g, n, a, tkConst, 'const') - end; - nkVarSection: begin - L := sonsLen(n); - if L = 0 then exit; - putWithSpace(g, tkVar, 'var'); - if L > 1 then begin - gcoms(g); - indentNL(g); - for i := 0 to L-1 do begin - optNL(g); - gsub(g, n.sons[i]); - gcoms(g); - end; - dedent(g); - end - else - gsub(g, n.sons[0]); - end; - nkReturnStmt: begin - putWithSpace(g, tkReturn, 'return'); - gsub(g, n.sons[0]); - end; - nkRaiseStmt: begin - putWithSpace(g, tkRaise, 'raise'); - gsub(g, n.sons[0]); - end; - nkYieldStmt: begin - putWithSpace(g, tkYield, 'yield'); - gsub(g, n.sons[0]); - end; - nkDiscardStmt: begin - putWithSpace(g, tkDiscard, 'discard'); - gsub(g, n.sons[0]); - end; - nkBreakStmt: begin - putWithSpace(g, tkBreak, 'break'); - gsub(g, n.sons[0]); - end; - nkContinueStmt: begin - putWithSpace(g, tkContinue, 'continue'); - gsub(g, n.sons[0]); - end; - nkPragma: begin - if not (renderNoPragmas in g.flags) then begin - put(g, tkCurlyDotLe, '{.'); - gcomma(g, n, emptyContext); - put(g, tkCurlyDotRi, '.}') - end; - end; - nkImportStmt: begin - putWithSpace(g, tkImport, 'import'); - gcoms(g); - indentNL(g); - gcommaAux(g, n, g.indent); - dedent(g); - putNL(g); - end; - nkFromStmt: begin - putWithSpace(g, tkFrom, 'from'); - gsub(g, n.sons[0]); - put(g, tkSpaces, Space); - putWithSpace(g, tkImport, 'import'); - gcomma(g, n, emptyContext, 1); - putNL(g); - end; - nkIncludeStmt: begin - putWithSpace(g, tkInclude, 'include'); - gcoms(g); - indentNL(g); - gcommaAux(g, n, g.indent); - dedent(g); - putNL(g); - end; - nkCommentStmt: begin - gcoms(g); - optNL(g); - end; - nkOfBranch: begin - optNL(g); - putWithSpace(g, tkOf, 'of'); - gcomma(g, n, c, 0, -2); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, lastSon(n), c); - end; - nkElifBranch: begin - optNL(g); - putWithSpace(g, tkElif, 'elif'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[1], c) - end; - nkElse: begin - optNL(g); - put(g, tkElse, 'else'); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[0], c) - end; - nkFinally: begin - optNL(g); - put(g, tkFinally, 'finally'); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[0], c) - end; - nkExceptBranch: begin - optNL(g); - putWithSpace(g, tkExcept, 'except'); - gcomma(g, n, 0, -2); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, lastSon(n), c) - end; - nkGenericParams: begin - put(g, tkBracketLe, '['+''); - gcomma(g, n); - put(g, tkBracketRi, ']'+''); - end; - nkFormalParams: begin - put(g, tkParLe, '('+''); - gcomma(g, n, 1); - put(g, tkParRi, ')'+''); - if n.sons[0] <> nil then begin - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[0]); - end; - // XXX: gcomma(g, n, 1, -2); - end; - nkTupleTy: begin - put(g, tkTuple, 'tuple'); - put(g, tkBracketLe, '['+''); - gcomma(g, n); - put(g, tkBracketRi, ']'+''); - end; - else begin - //nkNone, nkMetaNode, nkTableConstr, nkExplicitTypeListCall: begin - InternalError(n.info, 'rnimsyn.gsub(' +{&} nodeKindToStr[n.kind] +{&} ')') - end - end -end; - -function renderTree(n: PNode; renderFlags: TRenderFlags = {@set}[]): string; -var - g: TSrcGen; -begin - initSrcGen(g, renderFlags); - gsub(g, n); - result := g.buf -end; - -procedure renderModule(n: PNode; const filename: string; - renderFlags: TRenderFlags = {@set}[]); -var - i: int; - f: tTextFile; - g: TSrcGen; -begin - initSrcGen(g, renderFlags); - for i := 0 to sonsLen(n)-1 do begin - gsub(g, n.sons[i]); - optNL(g); - if n.sons[i] <> nil then - case n.sons[i].kind of - nkTypeSection, nkConstSection, nkVarSection, nkCommentStmt: - putNL(g); - else begin end - end - end; - gcoms(g); - if OpenFile(f, filename, fmWrite) then begin - nimWrite(f, g.buf); - nimCloseFile(f); - end; -end; - -procedure initTokRender(var r: TSrcGen; n: PNode; - renderFlags: TRenderFlags = {@set}[]); -begin - initSrcGen(r, renderFlags); - gsub(r, n); -end; - -procedure getNextTok(var r: TSrcGen; var kind: TTokType; var literal: string); -var - len: int; -begin - if r.idx < length(r.tokens) then begin - kind := r.tokens[r.idx].kind; - len := r.tokens[r.idx].len; - literal := ncopy(r.buf, r.pos+strStart, r.pos+strStart+len-1); - inc(r.pos, len); - inc(r.idx); - end - else - kind := tkEof; -end; - -end. |