diff options
Diffstat (limited to 'rod')
95 files changed, 0 insertions, 39994 deletions
diff --git a/rod/ast.nim b/rod/ast.nim deleted file mode 100755 index fb610f565..000000000 --- a/rod/ast.nim +++ /dev/null @@ -1,1137 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# abstract syntax tree + symbol table - -import - msgs, nhashes, nversion, options, strutils, crc, ropes, idents, lists - -const - ImportTablePos* = 0 - ModuleTablePos* = 1 - -type - TCallingConvention* = enum - ccDefault, # proc has no explicit calling convention - ccStdCall, # procedure is stdcall - ccCDecl, # cdecl - ccSafeCall, # safecall - ccSysCall, # system call - ccInline, # proc should be inlined - ccNoInline, # proc should not be inlined - ccFastCall, # fastcall (pass parameters in registers) - ccClosure, # proc has a closure - ccNoConvention # needed for generating proper C procs sometimes - -const - CallingConvToStr*: array[TCallingConvention, string] = ["", "stdcall", - "cdecl", "safecall", "syscall", "inline", "noinline", "fastcall", - "closure", "noconv"] - -type - TNodeKind* = enum # order is extremely important, because ranges are used - # to check whether a node belongs to a certain class - nkNone, # unknown node kind: indicates an error - # Expressions: - # Atoms: - nkEmpty, # the node is empty - nkIdent, # node is an identifier - nkSym, # node is a symbol - nkType, # node is used for its typ field - - nkCharLit, # a character literal '' - nkIntLit, # an integer literal - nkInt8Lit, - nkInt16Lit, - nkInt32Lit, - nkInt64Lit, - nkFloatLit, # a floating point literal - nkFloat32Lit, - nkFloat64Lit, - nkStrLit, # a string literal "" - nkRStrLit, # a raw string literal r"" - nkTripleStrLit, # a triple string literal """ - nkMetaNode, # difficult to explan; represents itself - # (used for macros) - nkNilLit, # the nil literal - # end of atoms - nkDotCall, # used to temporarily flag a nkCall node; - # this is used - # for transforming ``s.len`` to ``len(s)`` - nkCommand, # a call like ``p 2, 4`` without parenthesis - nkCall, # a call like p(x, y) or an operation like +(a, b) - nkCallStrLit, # a call with a string literal - # x"abc" has two sons: nkIdent, nkRStrLit - # x"""abc""" has two sons: nkIdent, nkTripleStrLit - nkExprEqExpr, # a named parameter with equals: ''expr = expr'' - nkExprColonExpr, # a named parameter with colon: ''expr: expr'' - nkIdentDefs, # a definition like `a, b: typeDesc = expr` - # either typeDesc or expr may be nil; used in - # formal parameters, var statements, etc. - nkVarTuple, # a ``var (a, b) = expr`` construct - nkInfix, # a call like (a + b) - nkPrefix, # a call like !a - nkPostfix, # something like a! (also used for visibility) - nkPar, # syntactic (); may be a tuple constructor - nkCurly, # syntactic {} - nkBracket, # syntactic [] - nkBracketExpr, # an expression like a[i..j, k] - nkPragmaExpr, # an expression like a{.pragmas.} - nkRange, # an expression like i..j - nkDotExpr, # a.b - nkCheckedFieldExpr, # a.b, but b is a field that needs to be checked - nkDerefExpr, # a^ - nkIfExpr, # if as an expression - nkElifExpr, - nkElseExpr, - nkLambda, # lambda expression - nkAccQuoted, # `a` as a node - - nkTableConstr, # a table constructor {expr: expr} - nkBind, # ``bind expr`` node - nkSymChoice, # symbol choice node - nkHiddenStdConv, # an implicit standard type conversion - nkHiddenSubConv, # an implicit type conversion from a subtype - # to a supertype - nkHiddenCallConv, # an implicit type conversion via a type converter - nkConv, # a type conversion - nkCast, # a type cast - nkAddr, # a addr expression - nkHiddenAddr, # implicit address operator - nkHiddenDeref, # implicit ^ operator - nkObjDownConv, # down conversion between object types - nkObjUpConv, # up conversion between object types - nkChckRangeF, # range check for floats - nkChckRange64, # range check for 64 bit ints - nkChckRange, # range check for ints - nkStringToCString, # string to cstring - nkCStringToString, # cstring to string - nkPassAsOpenArray, # thing is passed as an open array - # end of expressions - - nkAsgn, # a = b - nkFastAsgn, # internal node for a fast ``a = b`` - # (no string copy) - nkGenericParams, # generic parameters - nkFormalParams, # formal parameters - nkOfInherit, # inherited from symbol - - nkModule, # the syntax tree of a module - nkProcDef, # a proc - nkMethodDef, # a method - nkConverterDef, # a converter - nkMacroDef, # a macro - nkTemplateDef, # a template - nkIteratorDef, # an iterator - - nkOfBranch, # used inside case statements - # for (cond, action)-pairs - nkElifBranch, # used in if statements - nkExceptBranch, # an except section - nkElse, # an else part - nkMacroStmt, # a macro statement - nkAsmStmt, # an assembler block - nkPragma, # a pragma statement - nkIfStmt, # an if statement - nkWhenStmt, # a when statement - nkForStmt, # a for statement - nkWhileStmt, # a while statement - nkCaseStmt, # a case statement - nkVarSection, # a var section - nkConstSection, # a const section - nkConstDef, # a const definition - nkTypeSection, # a type section (consists of type definitions) - nkTypeDef, # a type definition - nkYieldStmt, # the yield statement as a tree - nkTryStmt, # a try statement - nkFinally, # a finally section - nkRaiseStmt, # a raise statement - nkReturnStmt, # a return statement - nkBreakStmt, # a break statement - nkContinueStmt, # a continue statement - nkBlockStmt, # a block statement - nkDiscardStmt, # a discard statement - nkStmtList, # a list of statements - nkImportStmt, # an import statement - nkFromStmt, # a from * import statement - nkIncludeStmt, # an include statement - nkCommentStmt, # a comment statement - nkStmtListExpr, # a statement list followed by an expr; this is used - # to allow powerful multi-line templates - nkBlockExpr, # a statement block ending in an expr; this is used - # to allowe powerful multi-line templates that open a - # temporary scope - nkStmtListType, # a statement list ending in a type; for macros - nkBlockType, # a statement block ending in a type; for macros - # types as syntactic trees: - nkTypeOfExpr, - nkObjectTy, - nkTupleTy, - nkRecList, # list of object parts - nkRecCase, # case section of object - nkRecWhen, # when section of object - nkRefTy, - nkPtrTy, - nkVarTy, - nkDistinctTy, # distinct type - nkProcTy, - nkEnumTy, - nkEnumFieldDef, # `ident = expr` in an enumeration - nkReturnToken # token used for interpretation - TNodeKinds* = set[TNodeKind] - -type - TSymFlag* = enum # already 30 flags! - sfUsed, # read access of sym (for warnings) or simply used - sfStar, # symbol has * visibility - sfMinus, # symbol has - visibility - sfInInterface, # symbol is in interface section declared - sfFromGeneric, # symbol is instantiation of a generic; this is needed - # for symbol file generation; such symbols should always - # be written into the ROD file - sfGlobal, # symbol is at global scope - - sfForward, # symbol is forward directed - sfImportc, # symbol is external; imported - sfExportc, # symbol is exported (under a specified name) - sfVolatile, # variable is volatile - sfRegister, # variable should be placed in a register - sfPure, # object is "pure" that means it has no type-information - - sfResult, # variable is 'result' in proc - sfNoSideEffect, # proc has no side effects - sfSideEffect, # proc may have side effects; cannot prove it has none - sfMainModule, # module is the main module - sfSystemModule, # module is the system module - sfNoReturn, # proc never returns (an exit proc) - sfAddrTaken, # the variable's address is taken (ex- or implicitely) - sfCompilerProc, # proc is a compiler proc, that is a C proc that is - # needed for the code generator - sfProcvar, # proc can be passed to a proc var - sfDiscriminant, # field is a discriminant in a record/object - sfDeprecated, # symbol is deprecated - sfInClosure, # variable is accessed by a closure - sfTypeCheck, # wether macro parameters should be type checked - sfCompileTime, # proc can be evaluated at compile time - sfThreadVar, # variable is a thread variable - sfMerge, # proc can be merged with itself - sfDeadCodeElim, # dead code elimination for the module is turned on - sfBorrow # proc is borrowed - - TSymFlags* = set[TSymFlag] - - TTypeKind* = enum # order is important! - # Don't forget to change hti.nim if you make a change here - # XXX put this into an include file to avoid this issue! - tyNone, tyBool, tyChar, - tyEmpty, tyArrayConstr, tyNil, tyExpr, tyStmt, tyTypeDesc, - tyGenericInvokation, # ``T[a, b]`` for types to invoke - tyGenericBody, # ``T[a, b, body]`` last parameter is the body - tyGenericInst, # ``T[a, b, realInstance]`` instantiated generic type - tyGenericParam, # ``a`` in the example - tyDistinct, - tyEnum, - tyOrdinal, # misnamed: should become 'tyConstraint' - tyArray, - tyObject, - tyTuple, - tySet, - tyRange, - tyPtr, tyRef, - tyVar, - tySequence, - tyProc, - tyPointer, tyOpenArray, - tyString, tyCString, tyForward, - tyInt, tyInt8, tyInt16, tyInt32, tyInt64, # signed integers - tyFloat, tyFloat32, tyFloat64, tyFloat128 - - TTypeKinds* = set[TTypeKind] - - TNodeFlag* = enum - nfNone, - nfBase2, # nfBase10 is default, so not needed - nfBase8, - nfBase16, - nfAllConst, # used to mark complex expressions constant - nfTransf, # node has been transformed - nfSem # node has been checked for semantics - - TNodeFlags* = set[TNodeFlag] - TTypeFlag* = enum - tfVarargs, # procedure has C styled varargs - tfNoSideEffect, # procedure type does not allow side effects - tfFinal, # is the object final? - tfAcyclic, # type is acyclic (for GC optimization) - tfEnumHasWholes, # enum cannot be mapped into a range - tfShallow # type can be shallow copied on assignment - - TTypeFlags* = set[TTypeFlag] - - TSymKind* = enum # the different symbols (start with the prefix sk); - # order is important for the documentation generator! - skUnknown, # unknown symbol: used for parsing assembler blocks - # and first phase symbol lookup in generics - skConditional, # symbol for the preprocessor (may become obsolete) - skDynLib, # symbol represents a dynamic library; this is used - # internally; it does not exist in Nimrod code - skParam, # a parameter - skGenericParam, # a generic parameter; eq in ``proc x[eq=`==`]()`` - skTemp, # a temporary variable (introduced by compiler) - skModule, # module identifier - skType, # a type - skConst, # a constant - skVar, # a variable - skProc, # a proc - skMethod, # a method - skIterator, # an iterator - skConverter, # a type converter - skMacro, # a macro - skTemplate, # a template; currently also misused for user-defined - # pragmas - skField, # a field in a record or object - skEnumField, # an identifier in an enum - skForVar, # a for loop variable - skLabel, # a label (for block statement) - skStub # symbol is a stub and not yet loaded from the ROD - # file (it is loaded on demand, which may - # mean: never) - TSymKinds* = set[TSymKind] - - TMagic* = enum # symbols that require compiler magic: - mNone, mDefined, mDefinedInScope, mLow, mHigh, mSizeOf, mIs, mEcho, - mUnaryLt, mSucc, - mPred, mInc, mDec, mOrd, mNew, mNewFinalize, mNewSeq, mLengthOpenArray, - mLengthStr, mLengthArray, mLengthSeq, mIncl, mExcl, mCard, mChr, mGCref, - mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, mAddI64, mSubI64, mMulI64, - mDivI64, mModI64, - mAddF64, mSubF64, mMulF64, mDivF64, - mShrI, mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, mMaxI64, - mMinF64, mMaxF64, mAddU, mSubU, mMulU, - mDivU, mModU, mAddU64, mSubU64, mMulU64, mDivU64, mModU64, mEqI, mLeI, - mLtI, - mEqI64, mLeI64, mLtI64, mEqF64, mLeF64, mLtF64, - mLeU, mLtU, mLeU64, mLtU64, - mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, mEqB, mLeB, mLtB, mEqRef, - mEqProc, mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, - mUnaryMinusI64, mAbsI, mAbsI64, mNot, - mUnaryPlusI, mBitnotI, mUnaryPlusI64, - mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, - mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, mToU32, - mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, mBoolToStr, - mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr, - mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, - mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, - mConTArr, mConTT, mSlice, - mFields, mFieldPairs, - mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInRange, mInSet, mRepr, mExit, mSetLengthStr, mSetLengthSeq, mAssert, - mSwap, mIsNil, mArrToSeq, mCopyStr, mCopyStrLast, mNewString, mReset, - mArray, mOpenArray, mRange, mSet, mSeq, - mOrdinal, mInt, mInt8, mInt16, mInt32, - mInt64, mFloat, mFloat32, mFloat64, mBool, mChar, mString, mCstring, - mPointer, mEmptySet, mIntSetBaseType, mNil, mExpr, mStmt, mTypeDesc, - mIsMainModule, mCompileDate, mCompileTime, mNimrodVersion, mNimrodMajor, - mNimrodMinor, mNimrodPatch, mCpuEndian, mHostOS, mHostCPU, mAppType, - mNaN, mInf, mNegInf, - mCompileOption, mCompileOptionArg, - mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, mNKind, - mNIntVal, mNFloatVal, mNSymbol, mNIdent, mNGetType, mNStrVal, mNSetIntVal, - mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetType, mNSetStrVal, - mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mIdentToStr, - mEqIdent, mEqNimrodNode, mNHint, mNWarning, mNError - -type - PNode* = ref TNode - PNodePtr* = ptr PNode - TNodeSeq* = seq[PNode] - PType* = ref TType - PSym* = ref TSym - TNode*{.acyclic, final.} = object # on a 32bit machine, this takes 32 bytes - typ*: PType - comment*: string - info*: TLineInfo - flags*: TNodeFlags - case Kind*: TNodeKind - of nkCharLit..nkInt64Lit: - intVal*: biggestInt - of nkFloatLit..nkFloat64Lit: - floatVal*: biggestFloat - of nkStrLit..nkTripleStrLit: - strVal*: string - of nkSym: - sym*: PSym - of nkIdent: - ident*: PIdent - else: - sons*: TNodeSeq - - TSymSeq* = seq[PSym] - TStrTable* = object # a table[PIdent] of PSym - counter*: int - data*: TSymSeq - - # -------------- backend information ------------------------------- - TLocKind* = enum - locNone, # no location - locTemp, # temporary location - locLocalVar, # location is a local variable - locGlobalVar, # location is a global variable - locParam, # location is a parameter - locField, # location is a record field - locArrayElem, # location is an array element - locExpr, # "location" is really an expression - locProc, # location is a proc (an address of a procedure) - locData, # location is a constant - locCall, # location is a call expression - locOther # location is something other - TLocFlag* = enum - lfIndirect, # backend introduced a pointer - lfParamCopy, # backend introduced a parameter copy (LLVM) - lfNoDeepCopy, # no need for a deep copy - lfNoDecl, # do not declare it in C - lfDynamicLib, # link symbol to dynamic library - lfExportLib, # export symbol for dynamic library generation - lfHeader # include header file for symbol - TStorageLoc* = enum - OnUnknown, # location is unknown (stack, heap or static) - OnStack, # location is on hardware stack - OnHeap # location is on heap or global - # (reference counting needed) - TLocFlags* = set[TLocFlag] - TLoc*{.final.} = object - k*: TLocKind # kind of location - s*: TStorageLoc - flags*: TLocFlags # location's flags - t*: PType # type of location - r*: PRope # rope value of location (code generators) - a*: int # location's "address", i.e. slot for temporaries - - # ---------------- end of backend information ------------------------------ - - TLibKind* = enum - libHeader, libDynamic - TLib* = object of lists.TListEntry # also misused for headers! - kind*: TLibKind - generated*: bool # needed for the backends: - name*: PRope - path*: PNode # can be a string literal! - - - PLib* = ref TLib - TSym* = object of TIdObj - kind*: TSymKind - magic*: TMagic - typ*: PType - name*: PIdent - info*: TLineInfo - owner*: PSym - flags*: TSymFlags - tab*: TStrTable # interface table for modules - ast*: PNode # syntax tree of proc, iterator, etc.: - # the whole proc including header; this is used - # for easy generation of proper error messages - # for variant record fields the discriminant - # expression - options*: TOptions - position*: int # used for many different things: - # for enum fields its position; - # for fields its offset - # for parameters its position - # for a conditional: - # 1 iff the symbol is defined, else 0 - # (or not in symbol table) - offset*: int # offset of record field - loc*: TLoc - annex*: PLib # additional fields (seldom used, so we use a - # reference to another object to safe space) - - TTypeSeq* = seq[PType] - TType* = object of TIdObj # types are identical iff they have the - # same id; there may be multiple copies of a type - # in memory! - kind*: TTypeKind # kind of type - sons*: TTypeSeq # base types, etc. - n*: PNode # node for types: - # for range types a nkRange node - # for record types a nkRecord node - # for enum types a list of symbols - # else: unused - flags*: TTypeFlags # flags of the type - callConv*: TCallingConvention # for procs - owner*: PSym # the 'owner' of the type - sym*: PSym # types have the sym associated with them - # it is used for converting types to strings - size*: BiggestInt # the size of the type in bytes - # -1 means that the size is unkwown - align*: int # the type's alignment requirements - containerID*: int # used for type checking of generics - loc*: TLoc - - TPair*{.final.} = object - key*, val*: PObject - - TPairSeq* = seq[TPair] - TTable*{.final.} = object # the same as table[PObject] of PObject - counter*: int - data*: TPairSeq - - TIdPair*{.final.} = object - key*: PIdObj - val*: PObject - - TIdPairSeq* = seq[TIdPair] - TIdTable*{.final.} = object # the same as table[PIdent] of PObject - counter*: int - data*: TIdPairSeq - - TIdNodePair*{.final.} = object - key*: PIdObj - val*: PNode - - TIdNodePairSeq* = seq[TIdNodePair] - TIdNodeTable*{.final.} = object # the same as table[PIdObj] of PNode - counter*: int - data*: TIdNodePairSeq - - TNodePair*{.final.} = object - h*: THash # because it is expensive to compute! - key*: PNode - val*: int - - TNodePairSeq* = seq[TNodePair] - TNodeTable*{.final.} = object # the same as table[PNode] of int; - # nodes are compared by structure! - counter*: int - data*: TNodePairSeq - - TObjectSeq* = seq[PObject] - TObjectSet*{.final.} = object - counter*: int - data*: TObjectSeq - -# BUGFIX: a module is overloadable so that a proc can have the -# same name as an imported module. This is necessary because of -# the poor naming choices in the standard library. - -const - OverloadableSyms* = {skProc, skMethod, skIterator, skConverter, skModule} - - GenericTypes*: TTypeKinds = {tyGenericInvokation, tyGenericBody, - tyGenericParam} - StructuralEquivTypes*: TTypeKinds = {tyArrayConstr, tyNil, tyTuple, tyArray, - tySet, tyRange, tyPtr, tyRef, tyVar, tySequence, tyProc, tyOpenArray} - ConcreteTypes*: TTypeKinds = { # types of the expr that may occur in:: - # var x = expr - tyBool, tyChar, tyEnum, tyArray, tyObject, - tySet, tyTuple, tyRange, tyPtr, tyRef, tyVar, tySequence, tyProc, - tyPointer, - tyOpenArray, tyString, tyCString, tyInt..tyInt64, tyFloat..tyFloat128} - - ConstantDataTypes*: TTypeKinds = {tyArray, tySet, tyTuple} - ExportableSymKinds* = {skVar, skConst, skProc, skMethod, skType, skIterator, - skMacro, skTemplate, skConverter, skStub} - PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, nfAllConst} - namePos* = 0 - genericParamsPos* = 1 - paramsPos* = 2 - pragmasPos* = 3 - codePos* = 4 - resultPos* = 5 - dispatcherPos* = 6 - -var gId*: int - -proc getID*(): int {.inline.} -proc setID*(id: int) {.inline.} -proc IDsynchronizationPoint*(idRange: int) - -# creator procs: -proc NewSym*(symKind: TSymKind, Name: PIdent, owner: PSym): PSym -proc NewType*(kind: TTypeKind, owner: PSym): PType -proc newNode*(kind: TNodeKind): PNode -proc newIntNode*(kind: TNodeKind, intVal: BiggestInt): PNode -proc newIntTypeNode*(kind: TNodeKind, intVal: BiggestInt, typ: PType): PNode -proc newFloatNode*(kind: TNodeKind, floatVal: BiggestFloat): PNode -proc newStrNode*(kind: TNodeKind, strVal: string): PNode -proc newIdentNode*(ident: PIdent, info: TLineInfo): PNode -proc newSymNode*(sym: PSym): PNode -proc newNodeI*(kind: TNodeKind, info: TLineInfo): PNode -proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode -proc initStrTable*(x: var TStrTable) -proc initTable*(x: var TTable) -proc initIdTable*(x: var TIdTable) -proc initObjectSet*(x: var TObjectSet) -proc initIdNodeTable*(x: var TIdNodeTable) -proc initNodeTable*(x: var TNodeTable) - -# copy procs: -proc copyType*(t: PType, owner: PSym, keepId: bool): PType -proc copySym*(s: PSym, keepId: bool = false): PSym -proc assignType*(dest, src: PType) -proc copyStrTable*(dest: var TStrTable, src: TStrTable) -proc copyTable*(dest: var TTable, src: TTable) -proc copyObjectSet*(dest: var TObjectSet, src: TObjectSet) -proc copyIdTable*(dest: var TIdTable, src: TIdTable) -proc sonsLen*(n: PNode): int {.inline.} -proc sonsLen*(n: PType): int {.inline.} -proc lastSon*(n: PNode): PNode {.inline.} -proc lastSon*(n: PType): PType {.inline.} -proc newSons*(father: PNode, length: int) -proc newSons*(father: PType, length: int) -proc addSon*(father, son: PNode) -proc addSon*(father, son: PType) -proc delSon*(father: PNode, idx: int) -proc hasSonWith*(n: PNode, kind: TNodeKind): bool -proc hasSubnodeWith*(n: PNode, kind: TNodeKind): bool -proc replaceSons*(n: PNode, oldKind, newKind: TNodeKind) -proc copyNode*(src: PNode): PNode - # does not copy its sons! -proc copyTree*(src: PNode): PNode - # does copy its sons! - -proc discardSons*(father: PNode) - -var emptyNode* = newNode(nkEmpty) -# There is a single empty node that is shared! Do not overwrite it! - - -const # for all kind of hash tables: - GrowthFactor* = 2 # must be power of 2, > 0 - StartSize* = 8 # must be power of 2, > 0 - -proc SameValue*(a, b: PNode): bool - # a, b are literals -proc leValue*(a, b: PNode): bool - # a <= b? a, b are literals -proc ValueToString*(a: PNode): string - -# ------------- efficient integer sets ------------------------------------- -type - TBitScalar* = int - -const - InitIntSetSize* = 8 # must be a power of two! - TrunkShift* = 9 - BitsPerTrunk* = 1 shl TrunkShift # needs to be a power of 2 and - # divisible by 64 - TrunkMask* = BitsPerTrunk - 1 - IntsPerTrunk* = BitsPerTrunk div (sizeof(TBitScalar) * 8) - IntShift* = 5 + ord(sizeof(TBitScalar) == 8) # 5 or 6, depending on int width - IntMask* = 1 shl IntShift - 1 - -type - PTrunk* = ref TTrunk - TTrunk*{.final.} = object - next*: PTrunk # all nodes are connected with this pointer - key*: int # start address at bit 0 - bits*: array[0..IntsPerTrunk - 1, TBitScalar] # a bit vector - - TTrunkSeq* = seq[PTrunk] - TIntSet*{.final.} = object - counter*, max*: int - head*: PTrunk - data*: TTrunkSeq - - -proc IntSetContains*(s: TIntSet, key: int): bool -proc IntSetIncl*(s: var TIntSet, key: int) -proc IntSetExcl*(s: var TIntSet, key: int) -proc IntSetInit*(s: var TIntSet) -proc IntSetContainsOrIncl*(s: var TIntSet, key: int): bool -const - debugIds* = false - -proc registerID*(id: PIdObj) -# implementation - -var usedIds: TIntSet - -proc registerID(id: PIdObj) = - if debugIDs: - if (id.id == - 1) or IntSetContainsOrIncl(usedIds, id.id): - InternalError("ID already used: " & $(id.id)) - -proc getID(): int = - result = gId - inc(gId) - -proc setId(id: int) = - gId = max(gId, id + 1) - -proc IDsynchronizationPoint(idRange: int) = - gId = (gId div IdRange + 1) * IdRange + 1 - -proc leValue(a, b: PNode): bool = - # a <= b? - result = false - case a.kind - of nkCharLit..nkInt64Lit: - if b.kind in {nkCharLit..nkInt64Lit}: result = a.intVal <= b.intVal - of nkFloatLit..nkFloat64Lit: - if b.kind in {nkFloatLit..nkFloat64Lit}: result = a.floatVal <= b.floatVal - of nkStrLit..nkTripleStrLit: - if b.kind in {nkStrLit..nkTripleStrLit}: result = a.strVal <= b.strVal - else: InternalError(a.info, "leValue") - -proc SameValue(a, b: PNode): bool = - result = false - case a.kind - of nkCharLit..nkInt64Lit: - if b.kind in {nkCharLit..nkInt64Lit}: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: - if b.kind in {nkFloatLit..nkFloat64Lit}: result = a.floatVal == b.floatVal - of nkStrLit..nkTripleStrLit: - if b.kind in {nkStrLit..nkTripleStrLit}: result = a.strVal == b.strVal - else: InternalError(a.info, "SameValue") - -proc ValueToString(a: PNode): string = - case a.kind - of nkCharLit..nkInt64Lit: result = $(a.intVal) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: result = $(a.floatVal) - of nkStrLit..nkTripleStrLit: result = a.strVal - else: - InternalError(a.info, "valueToString") - result = "" - -proc copyStrTable(dest: var TStrTable, src: TStrTable) = - dest.counter = src.counter - if isNil(src.data): return - setlen(dest.data, len(src.data)) - for i in countup(0, high(src.data)): dest.data[i] = src.data[i] - -proc copyIdTable(dest: var TIdTable, src: TIdTable) = - dest.counter = src.counter - if isNil(src.data): return - newSeq(dest.data, len(src.data)) - for i in countup(0, high(src.data)): dest.data[i] = src.data[i] - -proc copyTable(dest: var TTable, src: TTable) = - dest.counter = src.counter - if isNil(src.data): return - setlen(dest.data, len(src.data)) - for i in countup(0, high(src.data)): dest.data[i] = src.data[i] - -proc copyObjectSet(dest: var TObjectSet, src: TObjectSet) = - dest.counter = src.counter - if isNil(src.data): return - setlen(dest.data, len(src.data)) - for i in countup(0, high(src.data)): dest.data[i] = src.data[i] - -proc discardSons(father: PNode) = - father.sons = nil - -proc newNode(kind: TNodeKind): PNode = - new(result) - result.kind = kind - #result.info = UnknownLineInfo() inlined: - result.info.fileIndex = int32(- 1) - result.info.col = int16(- 1) - result.info.line = int16(- 1) - -proc newIntNode(kind: TNodeKind, intVal: BiggestInt): PNode = - result = newNode(kind) - result.intVal = intVal - -proc newIntTypeNode(kind: TNodeKind, intVal: BiggestInt, typ: PType): PNode = - result = newIntNode(kind, intVal) - result.typ = typ - -proc newFloatNode(kind: TNodeKind, floatVal: BiggestFloat): PNode = - result = newNode(kind) - result.floatVal = floatVal - -proc newStrNode(kind: TNodeKind, strVal: string): PNode = - result = newNode(kind) - result.strVal = strVal - -proc newIdentNode(ident: PIdent, info: TLineInfo): PNode = - result = newNode(nkIdent) - result.ident = ident - result.info = info - -proc newSymNode(sym: PSym): PNode = - result = newNode(nkSym) - result.sym = sym - result.typ = sym.typ - result.info = sym.info - -proc newSymNode*(sym: PSym, info: TLineInfo): PNode = - result = newNode(nkSym) - result.sym = sym - result.typ = sym.typ - result.info = info - -proc newNodeI(kind: TNodeKind, info: TLineInfo): PNode = - result = newNode(kind) - result.info = info - -proc newNodeIT(kind: TNodeKind, info: TLineInfo, typ: PType): PNode = - result = newNode(kind) - result.info = info - result.typ = typ - -proc NewType(kind: TTypeKind, owner: PSym): PType = - new(result) - result.kind = kind - result.owner = owner - result.size = - 1 - result.align = 2 # default alignment - result.id = getID() - if debugIds: - RegisterId(result) - #if result.id < 2000 then - # MessageOut(typeKindToStr[kind] & ' has id: ' & toString(result.id)) - -proc assignType(dest, src: PType) = - dest.kind = src.kind - dest.flags = src.flags - dest.callConv = src.callConv - dest.n = src.n - dest.size = src.size - dest.align = src.align - dest.containerID = src.containerID - newSons(dest, sonsLen(src)) - for i in countup(0, sonsLen(src) - 1): dest.sons[i] = src.sons[i] - -proc copyType(t: PType, owner: PSym, keepId: bool): PType = - result = newType(t.Kind, owner) - assignType(result, t) - if keepId: - result.id = t.id - else: - result.id = getID() - if debugIds: RegisterId(result) - result.sym = t.sym # backend-info should not be copied - -proc copySym(s: PSym, keepId: bool = false): PSym = - result = newSym(s.kind, s.name, s.owner) - result.ast = nil # BUGFIX; was: s.ast which made problems - result.info = s.info - result.typ = s.typ - if keepId: - result.id = s.id - else: - result.id = getID() - if debugIds: RegisterId(result) - result.flags = s.flags - result.magic = s.magic - copyStrTable(result.tab, s.tab) - result.options = s.options - result.position = s.position - result.loc = s.loc - result.annex = s.annex # BUGFIX - -proc NewSym(symKind: TSymKind, Name: PIdent, owner: PSym): PSym = - # generates a symbol and initializes the hash field too - new(result) - result.Name = Name - result.Kind = symKind - result.flags = {} - result.info = UnknownLineInfo() - result.options = gOptions - result.owner = owner - result.offset = - 1 - result.id = getID() - if debugIds: - RegisterId(result) - #if result.id < 2000: - # MessageOut(name.s & " has id: " & toString(result.id)) - -proc initStrTable(x: var TStrTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initTable(x: var TTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initIdTable(x: var TIdTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initObjectSet(x: var TObjectSet) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initIdNodeTable(x: var TIdNodeTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initNodeTable(x: var TNodeTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc sonsLen(n: PType): int = - if isNil(n.sons): result = 0 - else: result = len(n.sons) - -proc newSons(father: PType, length: int) = - if isNil(father.sons): father.sons = @[] - setlen(father.sons, len(father.sons) + length) - -proc addSon(father, son: PType) = - if isNil(father.sons): father.sons = @[] - add(father.sons, son) - #assert((father.kind != tyGenericInvokation) or (son.kind != tyGenericInst)) - -proc sonsLen(n: PNode): int = - if isNil(n.sons): result = 0 - else: result = len(n.sons) - -proc len*(n: PNode): int {.inline.} = - if isNil(n.sons): result = 0 - else: result = len(n.sons) - -proc safeLen*(n: PNode): int {.inline.} = - ## works even for leaves. - if n.kind in {nkNone..nkNilLit} or isNil(n.sons): result = 0 - else: result = len(n.sons) - -proc add*(father, son: PNode) = - assert son != nil - if isNil(father.sons): father.sons = @[] - add(father.sons, son) - -proc `[]`*(n: PNode, i: int): PNode {.inline.} = - result = n.sons[i] - -proc newSons(father: PNode, length: int) = - if isNil(father.sons): father.sons = @[] - setlen(father.sons, len(father.sons) + length) - -proc addSon(father, son: PNode) = - assert son != nil - if isNil(father.sons): father.sons = @[] - add(father.sons, son) - -proc delSon(father: PNode, idx: int) = - if isNil(father.sons): return - var length = sonsLen(father) - for i in countup(idx, length - 2): father.sons[i] = father.sons[i + 1] - setlen(father.sons, length - 1) - -proc copyNode(src: PNode): PNode = - # does not copy its sons! - if src == nil: - return nil - result = newNode(src.kind) - result.info = src.info - result.typ = src.typ - result.flags = src.flags * PersistentNodeFlags - case src.Kind - of nkCharLit..nkInt64Lit: result.intVal = src.intVal - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: result.floatVal = src.floatVal - of nkSym: result.sym = src.sym - of nkIdent: result.ident = src.ident - of nkStrLit..nkTripleStrLit: result.strVal = src.strVal - else: nil - -proc shallowCopy*(src: PNode): PNode = - # does not copy its sons, but provides space for them: - if src == nil: return nil - result = newNode(src.kind) - result.info = src.info - result.typ = src.typ - result.flags = src.flags * PersistentNodeFlags - case src.Kind - of nkCharLit..nkInt64Lit: result.intVal = src.intVal - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: result.floatVal = src.floatVal - of nkSym: result.sym = src.sym - of nkIdent: result.ident = src.ident - of nkStrLit..nkTripleStrLit: result.strVal = src.strVal - else: newSons(result, sonsLen(src)) - -proc copyTree(src: PNode): PNode = - # copy a whole syntax tree; performs deep copying - if src == nil: - return nil - result = newNode(src.kind) - result.info = src.info - result.typ = src.typ - result.flags = src.flags * PersistentNodeFlags - case src.Kind - of nkCharLit..nkInt64Lit: result.intVal = src.intVal - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: result.floatVal = src.floatVal - of nkSym: result.sym = src.sym - of nkIdent: result.ident = src.ident - of nkStrLit..nkTripleStrLit: result.strVal = src.strVal - else: - result.sons = nil - newSons(result, sonsLen(src)) - for i in countup(0, sonsLen(src) - 1): - result.sons[i] = copyTree(src.sons[i]) - -proc lastSon(n: PNode): PNode = - result = n.sons[sonsLen(n) - 1] - -proc lastSon(n: PType): PType = - result = n.sons[sonsLen(n) - 1] - -proc hasSonWith(n: PNode, kind: TNodeKind): bool = - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind == kind: - return true - result = false - -proc hasSubnodeWith(n: PNode, kind: TNodeKind): bool = - case n.kind - of nkEmpty..nkNilLit: result = n.kind == kind - else: - for i in countup(0, sonsLen(n) - 1): - if (n.sons[i].kind == kind) or hasSubnodeWith(n.sons[i], kind): - return true - result = false - -proc replaceSons(n: PNode, oldKind, newKind: TNodeKind) = - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind == oldKind: n.sons[i].kind = newKind - -proc sonsNotNil(n: PNode): bool = - for i in countup(0, sonsLen(n) - 1): - if n.sons[i] == nil: - return false - result = true - -proc getInt*(a: PNode): biggestInt = - case a.kind - of nkIntLit..nkInt64Lit: result = a.intVal - else: - internalError(a.info, "getInt") - result = 0 - -proc getFloat*(a: PNode): biggestFloat = - case a.kind - of nkFloatLit..nkFloat64Lit: result = a.floatVal - else: - internalError(a.info, "getFloat") - result = 0.0 - -proc getStr*(a: PNode): string = - case a.kind - of nkStrLit..nkTripleStrLit: result = a.strVal - else: - internalError(a.info, "getStr") - result = "" - -proc getStrOrChar*(a: PNode): string = - case a.kind - of nkStrLit..nkTripleStrLit: result = a.strVal - of nkCharLit: result = chr(int(a.intVal)) & "" - else: - internalError(a.info, "getStrOrChar") - result = "" - -proc mustRehash(length, counter: int): bool {.inline.} = - assert(length > counter) - result = (length * 2 < counter * 3) or (length - counter < 4) - -proc nextTry(h, maxHash: THash): THash {.inline.} = - result = ((5 * h) + 1) and maxHash - # For any initial h in range(maxHash), repeating that maxHash times - # generates each int in range(maxHash) exactly once (see any text on - # random-number generation for proof). - -proc IntSetInit(s: var TIntSet) = - newSeq(s.data, InitIntSetSize) - s.max = InitIntSetSize - 1 - s.counter = 0 - s.head = nil - -proc IntSetGet(t: TIntSet, key: int): PTrunk = - var h = key and t.max - while t.data[h] != nil: - if t.data[h].key == key: - return t.data[h] - h = nextTry(h, t.max) - result = nil - -proc IntSetRawInsert(t: TIntSet, data: var TTrunkSeq, desc: PTrunk) = - var h = desc.key and t.max - while data[h] != nil: - assert(data[h] != desc) - h = nextTry(h, t.max) - assert(data[h] == nil) - data[h] = desc - -proc IntSetEnlarge(t: var TIntSet) = - var - n: TTrunkSeq - oldMax: int - oldMax = t.max - t.max = ((t.max + 1) * 2) - 1 - newSeq(n, t.max + 1) - for i in countup(0, oldmax): - if t.data[i] != nil: IntSetRawInsert(t, n, t.data[i]) - swap(t.data, n) - -proc IntSetPut(t: var TIntSet, key: int): PTrunk = - var h = key and t.max - while t.data[h] != nil: - if t.data[h].key == key: - return t.data[h] - h = nextTry(h, t.max) - if mustRehash(t.max + 1, t.counter): IntSetEnlarge(t) - inc(t.counter) - h = key and t.max - while t.data[h] != nil: h = nextTry(h, t.max) - assert(t.data[h] == nil) - new(result) - result.next = t.head - result.key = key - t.head = result - t.data[h] = result - -proc IntSetContains(s: TIntSet, key: int): bool = - var - u: TBitScalar - t: PTrunk - t = IntSetGet(s, `shr`(key, TrunkShift)) - if t != nil: - u = key and TrunkMask - result = (t.bits[`shr`(u, IntShift)] and `shl`(1, u and IntMask)) != 0 - else: - result = false - -proc IntSetIncl(s: var TIntSet, key: int) = - var - u: TBitScalar - t: PTrunk - t = IntSetPut(s, `shr`(key, TrunkShift)) - u = key and TrunkMask - t.bits[`shr`(u, IntShift)] = t.bits[`shr`(u, IntShift)] or - `shl`(1, u and IntMask) - -proc IntSetExcl(s: var TIntSet, key: int) = - var - u: TBitScalar - t: PTrunk - t = IntSetGet(s, `shr`(key, TrunkShift)) - if t != nil: - u = key and TrunkMask - t.bits[`shr`(u, IntShift)] = t.bits[`shr`(u, IntShift)] and - not `shl`(1, u and IntMask) - -proc IntSetContainsOrIncl(s: var TIntSet, key: int): bool = - var - u: TBitScalar - t: PTrunk - t = IntSetGet(s, `shr`(key, TrunkShift)) - if t != nil: - u = key and TrunkMask - result = (t.bits[`shr`(u, IntShift)] and `shl`(1, u and IntMask)) != 0 - if not result: - t.bits[`shr`(u, IntShift)] = t.bits[`shr`(u, IntShift)] or - `shl`(1, u and IntMask) - else: - IntSetIncl(s, key) - result = false - -if debugIDs: IntSetInit(usedIds) diff --git a/rod/astalgo.nim b/rod/astalgo.nim deleted file mode 100755 index 2bd04618d..000000000 --- a/rod/astalgo.nim +++ /dev/null @@ -1,843 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Algorithms for the abstract syntax tree: hash tables, lists -# and sets of nodes are supported. Efficiency is important as -# the data structures here are used in various places of the compiler. - -import - ast, nhashes, strutils, options, msgs, ropes, idents, rodutils - -proc hashNode*(p: PObject): THash -proc treeToYaml*(n: PNode, indent: int = 0, maxRecDepth: int = - 1): PRope - # Convert a tree into its YAML representation; this is used by the - # YAML code generator and it is invaluable for debugging purposes. - # If maxRecDepht <> -1 then it won't print the whole graph. -proc typeToYaml*(n: PType, indent: int = 0, maxRecDepth: int = - 1): PRope -proc symToYaml*(n: PSym, indent: int = 0, maxRecDepth: int = - 1): PRope -proc lineInfoToStr*(info: TLineInfo): PRope - -# ----------------------- node sets: --------------------------------------- -proc ObjectSetContains*(t: TObjectSet, obj: PObject): bool - # returns true whether n is in t -proc ObjectSetIncl*(t: var TObjectSet, obj: PObject) - # include an element n in the table t -proc ObjectSetContainsOrIncl*(t: var TObjectSet, obj: PObject): bool - # more are not needed ... - -# ----------------------- (key, val)-Hashtables ---------------------------- -proc TablePut*(t: var TTable, key, val: PObject) -proc TableGet*(t: TTable, key: PObject): PObject -type - TCmpProc* = proc (key, closure: PObject): bool # should return true if found - -proc TableSearch*(t: TTable, key, closure: PObject, comparator: TCmpProc): PObject - # return val as soon as comparator returns true; if this never happens, - # nil is returned - -# ----------------------- str table ----------------------------------------- -proc StrTableContains*(t: TStrTable, n: PSym): bool -proc StrTableAdd*(t: var TStrTable, n: PSym) -proc StrTableGet*(t: TStrTable, name: PIdent): PSym - - # the iterator scheme: -type - TTabIter*{.final.} = object # consider all fields here private - h*: THash # current hash - -proc InitTabIter*(ti: var TTabIter, tab: TStrTable): PSym -proc NextIter*(ti: var TTabIter, tab: TStrTable): PSym - # usage: - # var - # i: TTabIter - # s: PSym - # s = InitTabIter(i, table) - # while s != nil: - # ... - # s = NextIter(i, table) - # - -type - TIdentIter*{.final.} = object # iterator over all syms with same identifier - h*: THash # current hash - name*: PIdent - - -proc InitIdentIter*(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym -proc NextIdentIter*(ti: var TIdentIter, tab: TStrTable): PSym - -# -------------- symbol table ---------------------------------------------- -# Each TParser object (which represents a module being compiled) has its own -# symbol table. A symbol table is organized as a stack of str tables. The -# stack represents the different scopes. -# Stack pointer: -# 0 imported symbols from other modules -# 1 module level -# 2 proc level -# 3 nested statements -# ... -# -type - TSymTab*{.final.} = object - tos*: Natural # top of stack - stack*: seq[TStrTable] - - -proc InitSymTab*(tab: var TSymTab) -proc DeinitSymTab*(tab: var TSymTab) -proc SymTabGet*(tab: TSymTab, s: PIdent): PSym -proc SymTabLocalGet*(tab: TSymTab, s: PIdent): PSym -proc SymTabAdd*(tab: var TSymTab, e: PSym) -proc SymTabAddAt*(tab: var TSymTab, e: PSym, at: Natural) -proc SymTabAddUnique*(tab: var TSymTab, e: PSym): TResult -proc SymTabAddUniqueAt*(tab: var TSymTab, e: PSym, at: Natural): TResult -proc OpenScope*(tab: var TSymTab) -proc RawCloseScope*(tab: var TSymTab) - # the real "closeScope" adds some - # checks in parsobj - # these are for debugging only: -proc debug*(n: PSym) -proc debug*(n: PType) -proc debug*(n: PNode) - -# --------------------------- ident tables ---------------------------------- -proc IdTableGet*(t: TIdTable, key: PIdObj): PObject -proc IdTableGet*(t: TIdTable, key: int): PObject -proc IdTablePut*(t: var TIdTable, key: PIdObj, val: PObject) -proc IdTableHasObjectAsKey*(t: TIdTable, key: PIdObj): bool - # checks if `t` contains the `key` (compared by the pointer value, not only - # `key`'s id) -proc IdNodeTableGet*(t: TIdNodeTable, key: PIdObj): PNode -proc IdNodeTablePut*(t: var TIdNodeTable, key: PIdObj, val: PNode) -proc writeIdNodeTable*(t: TIdNodeTable) - -# --------------------------------------------------------------------------- - -proc getSymFromList*(list: PNode, ident: PIdent, start: int = 0): PSym -proc lookupInRecord*(n: PNode, field: PIdent): PSym -proc getModule*(s: PSym): PSym -proc mustRehash*(length, counter: int): bool -proc nextTry*(h, maxHash: THash): THash {.inline.} - -# ------------- table[int, int] --------------------------------------------- -const - InvalidKey* = low(int) - -type - TIIPair*{.final.} = object - key*, val*: int - - TIIPairSeq* = seq[TIIPair] - TIITable*{.final.} = object # table[int, int] - counter*: int - data*: TIIPairSeq - - -proc initIITable*(x: var TIITable) -proc IITableGet*(t: TIITable, key: int): int -proc IITablePut*(t: var TIITable, key, val: int) - -# implementation - -proc lookupInRecord(n: PNode, field: PIdent): PSym = - result = nil - case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = lookupInRecord(n.sons[i], field) - if result != nil: return - of nkRecCase: - if (n.sons[0].kind != nkSym): InternalError(n.info, "lookupInRecord") - result = lookupInRecord(n.sons[0], field) - if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - result = lookupInRecord(lastSon(n.sons[i]), field) - if result != nil: return - else: internalError(n.info, "lookupInRecord(record case branch)") - of nkSym: - if n.sym.name.id == field.id: result = n.sym - else: internalError(n.info, "lookupInRecord()") - -proc getModule(s: PSym): PSym = - result = s - assert((result.kind == skModule) or (result.owner != result)) - while (result != nil) and (result.kind != skModule): result = result.owner - -proc getSymFromList(list: PNode, ident: PIdent, start: int = 0): PSym = - for i in countup(start, sonsLen(list) - 1): - if list.sons[i].kind != nkSym: InternalError(list.info, "getSymFromList") - result = list.sons[i].sym - if result.name.id == ident.id: return - result = nil - -proc hashNode(p: PObject): THash = - result = hashPtr(cast[pointer](p)) - -proc mustRehash(length, counter: int): bool = - assert(length > counter) - result = (length * 2 < counter * 3) or (length - counter < 4) - -proc spaces(x: int): PRope = - # returns x spaces - result = toRope(repeatChar(x)) - -proc toYamlChar(c: Char): string = - case c - of '\0'..'\x1F', '\x80'..'\xFF': result = "\\u" & strutils.toHex(ord(c), 4) - of '\'', '\"', '\\': result = '\\' & c - else: result = $c - -proc makeYamlString*(s: string): PRope = - # We have to split long strings into many ropes. Otherwise - # this could trigger InternalError(111). See the ropes module for - # further information. - const MaxLineLength = 64 - result = nil - var res = "\"" - for i in countup(0, len(s) - 1): - if (i + 1) mod MaxLineLength == 0: - add(res, '\"') - add(res, "\n") - app(result, toRope(res)) - res = "\"" # reset - add(res, toYamlChar(s[i])) - add(res, '\"') - app(result, toRope(res)) - -proc flagsToStr[T](flags: set[T]): PRope = - if flags == {}: - result = toRope("[]") - else: - result = nil - for x in items(flags): - if result != nil: app(result, ", ") - app(result, makeYamlString($x)) - result = con("[", con(result, "]")) - -proc lineInfoToStr(info: TLineInfo): PRope = - result = ropef("[$1, $2, $3]", [makeYamlString(toFilename(info)), - toRope(toLinenumber(info)), - toRope(toColumn(info))]) - -proc treeToYamlAux(n: PNode, marker: var TIntSet, - indent, maxRecDepth: int): PRope -proc symToYamlAux(n: PSym, marker: var TIntSet, - indent, maxRecDepth: int): PRope -proc typeToYamlAux(n: PType, marker: var TIntSet, - indent, maxRecDepth: int): PRope -proc strTableToYaml(n: TStrTable, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - var istr = spaces(indent + 2) - result = toRope("[") - var mycount = 0 - for i in countup(0, high(n.data)): - if n.data[i] != nil: - if mycount > 0: app(result, ",") - appf(result, "$n$1$2", - [istr, symToYamlAux(n.data[i], marker, indent + 2, maxRecDepth - 1)]) - inc(mycount) - if mycount > 0: appf(result, "$n$1", [spaces(indent)]) - app(result, "]") - assert(mycount == n.counter) - -proc ropeConstr(indent: int, c: openarray[PRope]): PRope = - # array of (name, value) pairs - var istr = spaces(indent + 2) - result = toRope("{") - var i = 0 - while i <= high(c): - if i > 0: app(result, ",") - appf(result, "$n$1\"$2\": $3", [istr, c[i], c[i + 1]]) - inc(i, 2) - appf(result, "$n$1}", [spaces(indent)]) - -proc symToYamlAux(n: PSym, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - elif IntSetContainsOrIncl(marker, n.id): - result = ropef("\"$1 @$2\"", [toRope(n.name.s), toRope( - strutils.toHex(cast[TAddress](n), sizeof(n) * 2))]) - else: - var ast = treeToYamlAux(n.ast, marker, indent + 2, maxRecDepth - 1) - result = ropeConstr(indent, [toRope("kind"), - makeYamlString($n.kind), - toRope("name"), makeYamlString(n.name.s), - toRope("typ"), typeToYamlAux(n.typ, marker, - indent + 2, maxRecDepth - 1), - toRope("info"), lineInfoToStr(n.info), - toRope("flags"), flagsToStr(n.flags), - toRope("magic"), makeYamlString($n.magic), - toRope("ast"), ast, toRope("options"), - flagsToStr(n.options), toRope("position"), - toRope(n.position)]) - -proc typeToYamlAux(n: PType, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - elif intSetContainsOrIncl(marker, n.id): - result = ropef("\"$1 @$2\"", [toRope($n.kind), toRope( - strutils.toHex(cast[TAddress](n), sizeof(n) * 2))]) - else: - if sonsLen(n) > 0: - result = toRope("[") - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$n$1$2", [spaces(indent + 4), typeToYamlAux(n.sons[i], - marker, indent + 4, maxRecDepth - 1)]) - appf(result, "$n$1]", [spaces(indent + 2)]) - else: - result = toRope("null") - result = ropeConstr(indent, [toRope("kind"), - makeYamlString($n.kind), - toRope("sym"), symToYamlAux(n.sym, marker, - indent + 2, maxRecDepth - 1), toRope("n"), treeToYamlAux(n.n, marker, - indent + 2, maxRecDepth - 1), toRope("flags"), FlagsToStr(n.flags), - toRope("callconv"), - makeYamlString(CallingConvToStr[n.callConv]), - toRope("size"), toRope(n.size), - toRope("align"), toRope(n.align), - toRope("sons"), result]) - -proc treeToYamlAux(n: PNode, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - else: - var istr = spaces(indent + 2) - result = ropef("{$n$1\"kind\": $2", [istr, makeYamlString($n.kind)]) - if maxRecDepth != 0: - appf(result, ",$n$1\"info\": $2", [istr, lineInfoToStr(n.info)]) - case n.kind - of nkCharLit..nkInt64Lit: - appf(result, ",$n$1\"intVal\": $2", [istr, toRope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ",$n$1\"floatVal\": $2", - [istr, toRope(n.floatVal.ToStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - appf(result, ",$n$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - appf(result, ",$n$1\"sym\": $2", - [istr, symToYamlAux(n.sym, marker, indent + 2, maxRecDepth)]) - of nkIdent: - if n.ident != nil: - appf(result, ",$n$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - appf(result, ",$n$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - appf(result, ",$n$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$n$1$2", [spaces(indent + 4), treeToYamlAux(n.sons[i], - marker, indent + 4, maxRecDepth - 1)]) - appf(result, "$n$1]", [istr]) - appf(result, ",$n$1\"typ\": $2", - [istr, typeToYamlAux(n.typ, marker, indent + 2, maxRecDepth)]) - appf(result, "$n$1}", [spaces(indent)]) - -proc treeToYaml(n: PNode, indent: int = 0, maxRecDepth: int = - 1): PRope = - var marker: TIntSet - IntSetInit(marker) - result = treeToYamlAux(n, marker, indent, maxRecDepth) - -proc typeToYaml(n: PType, indent: int = 0, maxRecDepth: int = - 1): PRope = - var marker: TIntSet - IntSetInit(marker) - result = typeToYamlAux(n, marker, indent, maxRecDepth) - -proc symToYaml(n: PSym, indent: int = 0, maxRecDepth: int = - 1): PRope = - var marker: TIntSet - IntSetInit(marker) - result = symToYamlAux(n, marker, indent, maxRecDepth) - -proc debugType(n: PType): PRope = - if n == nil: - result = toRope("null") - else: - result = toRope($n.kind) - if n.sym != nil: - app(result, " ") - app(result, n.sym.name.s) - if (n.kind != tyString) and (sonsLen(n) > 0): - app(result, "(") - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ", ") - if n.sons[i] == nil: - app(result, "null") - else: - app(result, debugType(n.sons[i])) - app(result, ")") - -proc debugTree(n: PNode, indent: int, maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - else: - var istr = spaces(indent + 2) - result = ropef("{$n$1\"kind\": $2", - [istr, makeYamlString($n.kind)]) - if maxRecDepth != 0: - case n.kind - of nkCharLit..nkInt64Lit: - appf(result, ",$n$1\"intVal\": $2", [istr, toRope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ",$n$1\"floatVal\": $2", - [istr, toRope(n.floatVal.ToStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - appf(result, ",$n$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - appf(result, ",$n$1\"sym\": $2_$3", - [istr, toRope(n.sym.name.s), toRope(n.sym.id)]) - of nkIdent: - if n.ident != nil: - appf(result, ",$n$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - appf(result, ",$n$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - appf(result, ",$n$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$n$1$2", [spaces(indent + 4), debugTree(n.sons[i], - indent + 4, maxRecDepth - 1)]) - appf(result, "$n$1]", [istr]) - appf(result, "$n$1}", [spaces(indent)]) - -proc debug(n: PSym) = - #writeln(stdout, ropeToStr(symToYaml(n, 0, 1))) - writeln(stdout, ropeToStr(ropef("$1_$2: $3, $4", [ - toRope(n.name.s), toRope(n.id), flagsToStr(n.flags), - flagsToStr(n.loc.flags)]))) - -proc debug(n: PType) = - writeln(stdout, ropeToStr(debugType(n))) - -proc debug(n: PNode) = - writeln(stdout, ropeToStr(debugTree(n, 0, 100))) - -const - EmptySeq = @[] - -proc nextTry(h, maxHash: THash): THash = - result = ((5 * h) + 1) and maxHash - # For any initial h in range(maxHash), repeating that maxHash times - # generates each int in range(maxHash) exactly once (see any text on - # random-number generation for proof). - -proc objectSetContains(t: TObjectSet, obj: PObject): bool = - # returns true whether n is in t - var h: THash = hashNode(obj) and high(t.data) # start with real hash value - while t.data[h] != nil: - if (t.data[h] == obj): - return true - h = nextTry(h, high(t.data)) - result = false - -proc objectSetRawInsert(data: var TObjectSeq, obj: PObject) = - var h: THash = HashNode(obj) and high(data) - while data[h] != nil: - assert(data[h] != obj) - h = nextTry(h, high(data)) - assert(data[h] == nil) - data[h] = obj - -proc objectSetEnlarge(t: var TObjectSet) = - var n: TObjectSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i] != nil: objectSetRawInsert(n, t.data[i]) - swap(t.data, n) - -proc objectSetIncl(t: var TObjectSet, obj: PObject) = - if mustRehash(len(t.data), t.counter): objectSetEnlarge(t) - objectSetRawInsert(t.data, obj) - inc(t.counter) - -proc objectSetContainsOrIncl(t: var TObjectSet, obj: PObject): bool = - # returns true if obj is already in the string table: - var h: THash = HashNode(obj) and high(t.data) - while true: - var it = t.data[h] - if it == nil: break - if it == obj: - return true # found it - h = nextTry(h, high(t.data)) - if mustRehash(len(t.data), t.counter): - objectSetEnlarge(t) - objectSetRawInsert(t.data, obj) - else: - assert(t.data[h] == nil) - t.data[h] = obj - inc(t.counter) - result = false - -proc TableRawGet(t: TTable, key: PObject): int = - var h: THash = hashNode(key) and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key == key: - return h - h = nextTry(h, high(t.data)) - result = -1 - -proc TableSearch(t: TTable, key, closure: PObject, - comparator: TCmpProc): PObject = - var h: THash = hashNode(key) and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key == key: - if comparator(t.data[h].val, closure): - # BUGFIX 1 - return t.data[h].val - h = nextTry(h, high(t.data)) - result = nil - -proc TableGet(t: TTable, key: PObject): PObject = - var index = TableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -proc TableRawInsert(data: var TPairSeq, key, val: PObject) = - var h: THash = HashNode(key) and high(data) - while data[h].key != nil: - assert(data[h].key != key) - h = nextTry(h, high(data)) - assert(data[h].key == nil) - data[h].key = key - data[h].val = val - -proc TableEnlarge(t: var TTable) = - var n: TPairSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: TableRawInsert(n, t.data[i].key, t.data[i].val) - swap(t.data, n) - -proc TablePut(t: var TTable, key, val: PObject) = - var index = TableRawGet(t, key) - if index >= 0: - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): TableEnlarge(t) - TableRawInsert(t.data, key, val) - inc(t.counter) - -proc StrTableContains(t: TStrTable, n: PSym): bool = - var h: THash = n.name.h and high(t.data) # start with real hash value - while t.data[h] != nil: - if (t.data[h] == n): - return true - h = nextTry(h, high(t.data)) - result = false - -proc StrTableRawInsert(data: var TSymSeq, n: PSym) = - var h: THash = n.name.h and high(data) - while data[h] != nil: - if data[h] == n: InternalError(n.info, "StrTableRawInsert: " & n.name.s) - h = nextTry(h, high(data)) - assert(data[h] == nil) - data[h] = n - -proc StrTableEnlarge(t: var TStrTable) = - var n: TSymSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i] != nil: StrTableRawInsert(n, t.data[i]) - swap(t.data, n) - -proc StrTableAdd(t: var TStrTable, n: PSym) = - if mustRehash(len(t.data), t.counter): StrTableEnlarge(t) - StrTableRawInsert(t.data, n) - inc(t.counter) - -proc StrTableIncl*(t: var TStrTable, n: PSym): bool = - # returns true if n is already in the string table: - # It is essential that `n` is written nevertheless! - # This way the newest redefinition is picked by the semantic analyses! - var h: THash = n.name.h and high(t.data) - while true: - var it = t.data[h] - if it == nil: break - if it.name.id == n.name.id: - t.data[h] = n # overwrite it with newer definition! - return true # found it - h = nextTry(h, high(t.data)) - if mustRehash(len(t.data), t.counter): - StrTableEnlarge(t) - StrTableRawInsert(t.data, n) - else: - assert(t.data[h] == nil) - t.data[h] = n - inc(t.counter) - result = false - -proc StrTableGet(t: TStrTable, name: PIdent): PSym = - var h: THash = name.h and high(t.data) - while true: - result = t.data[h] - if result == nil: break - if result.name.id == name.id: break - h = nextTry(h, high(t.data)) - -proc InitIdentIter(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym = - ti.h = s.h - ti.name = s - if tab.Counter == 0: result = nil - else: result = NextIdentIter(ti, tab) - -proc NextIdentIter(ti: var TIdentIter, tab: TStrTable): PSym = - var h, start: THash - h = ti.h and high(tab.data) - start = h - result = tab.data[h] - while result != nil: - if result.Name.id == ti.name.id: break - h = nextTry(h, high(tab.data)) - if h == start: - result = nil - break - result = tab.data[h] - ti.h = nextTry(h, high(tab.data)) - -proc NextIdentExcluding*(ti: var TIdentIter, tab: TStrTable, - excluding: TIntSet): PSym = - var h: THash = ti.h and high(tab.data) - var start = h - result = tab.data[h] - while result != nil: - if result.Name.id == ti.name.id and - not IntSetContains(excluding, result.id): break - h = nextTry(h, high(tab.data)) - if h == start: - result = nil - break - result = tab.data[h] - ti.h = nextTry(h, high(tab.data)) - if result != nil and IntSetContains(excluding, result.id): result = nil - -proc FirstIdentExcluding*(ti: var TIdentIter, tab: TStrTable, s: PIdent, - excluding: TIntSet): PSym = - ti.h = s.h - ti.name = s - if tab.Counter == 0: result = nil - else: result = NextIdentExcluding(ti, tab, excluding) - -proc InitTabIter(ti: var TTabIter, tab: TStrTable): PSym = - ti.h = 0 # we start by zero ... - if tab.counter == 0: - result = nil # FIX 1: removed endless loop - else: - result = NextIter(ti, tab) - -proc NextIter(ti: var TTabIter, tab: TStrTable): PSym = - result = nil - while (ti.h <= high(tab.data)): - result = tab.data[ti.h] - Inc(ti.h) # ... and increment by one always - if result != nil: break - -proc InitSymTab(tab: var TSymTab) = - tab.tos = 0 - tab.stack = EmptySeq - -proc DeinitSymTab(tab: var TSymTab) = - tab.stack = nil - -proc SymTabLocalGet(tab: TSymTab, s: PIdent): PSym = - result = StrTableGet(tab.stack[tab.tos - 1], s) - -proc SymTabGet(tab: TSymTab, s: PIdent): PSym = - for i in countdown(tab.tos - 1, 0): - result = StrTableGet(tab.stack[i], s) - if result != nil: return - result = nil - -proc SymTabAddAt(tab: var TSymTab, e: PSym, at: Natural) = - StrTableAdd(tab.stack[at], e) - -proc SymTabAdd(tab: var TSymTab, e: PSym) = - StrTableAdd(tab.stack[tab.tos - 1], e) - -proc SymTabAddUniqueAt(tab: var TSymTab, e: PSym, at: Natural): TResult = - if StrTableIncl(tab.stack[at], e): - result = Failure - else: - result = Success - -proc SymTabAddUnique(tab: var TSymTab, e: PSym): TResult = - result = SymTabAddUniqueAt(tab, e, tab.tos - 1) - -proc OpenScope(tab: var TSymTab) = - if tab.tos >= len(tab.stack): setlen(tab.stack, tab.tos + 1) - initStrTable(tab.stack[tab.tos]) - Inc(tab.tos) - -proc RawCloseScope(tab: var TSymTab) = - Dec(tab.tos) - -iterator items*(tab: TStrTable): PSym = - var it: TTabIter - var s = InitTabIter(it, tab) - while s != nil: - yield s - s = NextIter(it, tab) - -iterator items*(tab: TSymTab): PSym = - for i in countdown(tab.tos-1, 0): - for it in items(tab.stack[i]): yield it - -proc hasEmptySlot(data: TIdPairSeq): bool = - for h in countup(0, high(data)): - if data[h].key == nil: - return true - result = false - -proc IdTableRawGet(t: TIdTable, key: int): int = - var h: THash - h = key and high(t.data) # start with real hash value - while t.data[h].key != nil: - if (t.data[h].key.id == key): - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc IdTableHasObjectAsKey(t: TIdTable, key: PIdObj): bool = - var index = IdTableRawGet(t, key.id) - if index >= 0: result = t.data[index].key == key - else: result = false - -proc IdTableGet(t: TIdTable, key: PIdObj): PObject = - var index = IdTableRawGet(t, key.id) - if index >= 0: result = t.data[index].val - else: result = nil - -proc IdTableGet(t: TIdTable, key: int): PObject = - var index = IdTableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -proc IdTableRawInsert(data: var TIdPairSeq, key: PIdObj, val: PObject) = - var h: THash - h = key.id and high(data) - while data[h].key != nil: - assert(data[h].key.id != key.id) - h = nextTry(h, high(data)) - assert(data[h].key == nil) - data[h].key = key - data[h].val = val - -proc IdTablePut(t: var TIdTable, key: PIdObj, val: PObject) = - var - index: int - n: TIdPairSeq - index = IdTableRawGet(t, key.id) - if index >= 0: - assert(t.data[index].key != nil) - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: - IdTableRawInsert(n, t.data[i].key, t.data[i].val) - assert(hasEmptySlot(n)) - swap(t.data, n) - IdTableRawInsert(t.data, key, val) - inc(t.counter) - -proc writeIdNodeTable(t: TIdNodeTable) = - nil - -proc IdNodeTableRawGet(t: TIdNodeTable, key: PIdObj): int = - var h: THash - h = key.id and high(t.data) # start with real hash value - while t.data[h].key != nil: - if (t.data[h].key.id == key.id): - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc IdNodeTableGet(t: TIdNodeTable, key: PIdObj): PNode = - var index: int - index = IdNodeTableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -proc IdNodeTableRawInsert(data: var TIdNodePairSeq, key: PIdObj, val: PNode) = - var h: THash - h = key.id and high(data) - while data[h].key != nil: - assert(data[h].key.id != key.id) - h = nextTry(h, high(data)) - assert(data[h].key == nil) - data[h].key = key - data[h].val = val - -proc IdNodeTablePut(t: var TIdNodeTable, key: PIdObj, val: PNode) = - var index = IdNodeTableRawGet(t, key) - if index >= 0: - assert(t.data[index].key != nil) - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): - var n: TIdNodePairSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: - IdNodeTableRawInsert(n, t.data[i].key, t.data[i].val) - swap(t.data, n) - IdNodeTableRawInsert(t.data, key, val) - inc(t.counter) - -proc initIITable(x: var TIITable) = - x.counter = 0 - newSeq(x.data, startSize) - for i in countup(0, startSize - 1): x.data[i].key = InvalidKey - -proc IITableRawGet(t: TIITable, key: int): int = - var h: THash - h = key and high(t.data) # start with real hash value - while t.data[h].key != InvalidKey: - if (t.data[h].key == key): - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc IITableGet(t: TIITable, key: int): int = - var index = IITableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = InvalidKey - -proc IITableRawInsert(data: var TIIPairSeq, key, val: int) = - var h: THash - h = key and high(data) - while data[h].key != InvalidKey: - assert(data[h].key != key) - h = nextTry(h, high(data)) - assert(data[h].key == InvalidKey) - data[h].key = key - data[h].val = val - -proc IITablePut(t: var TIITable, key, val: int) = - var index = IITableRawGet(t, key) - if index >= 0: - assert(t.data[index].key != InvalidKey) - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): - var n: TIIPairSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(n)): n[i].key = InvalidKey - for i in countup(0, high(t.data)): - if t.data[i].key != InvalidKey: - IITableRawInsert(n, t.data[i].key, t.data[i].val) - swap(t.data, n) - IITableRawInsert(t.data, key, val) - inc(t.counter) diff --git a/rod/bitsets.nim b/rod/bitsets.nim deleted file mode 100755 index 937e8237c..000000000 --- a/rod/bitsets.nim +++ /dev/null @@ -1,71 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# this unit handles Nimrod sets; it implements bit sets -# the code here should be reused in the Nimrod standard library - -type - TBitSet* = seq[int8] # we use byte here to avoid issues with - # cross-compiling; uint would be more efficient - # however - -const - ElemSize* = sizeof(int8) * 8 - -proc BitSetInit*(b: var TBitSet, length: int) -proc BitSetUnion*(x: var TBitSet, y: TBitSet) -proc BitSetDiff*(x: var TBitSet, y: TBitSet) -proc BitSetSymDiff*(x: var TBitSet, y: TBitSet) -proc BitSetIntersect*(x: var TBitSet, y: TBitSet) -proc BitSetIncl*(x: var TBitSet, elem: BiggestInt) -proc BitSetExcl*(x: var TBitSet, elem: BiggestInt) -proc BitSetIn*(x: TBitSet, e: BiggestInt): bool -proc BitSetEquals*(x, y: TBitSet): bool -proc BitSetContains*(x, y: TBitSet): bool -# implementation - -proc BitSetIn(x: TBitSet, e: BiggestInt): bool = - result = (x[int(e div ElemSize)] and toU8(int(1 shl (e mod ElemSize)))) != - toU8(0) - -proc BitSetIncl(x: var TBitSet, elem: BiggestInt) = - assert(elem >= 0) - x[int(elem div ElemSize)] = x[int(elem div ElemSize)] or - toU8(int(1 shl (elem mod ElemSize))) - -proc BitSetExcl(x: var TBitSet, elem: BiggestInt) = - x[int(elem div ElemSize)] = x[int(elem div ElemSize)] and - not toU8(int(1 shl (elem mod ElemSize))) - -proc BitSetInit(b: var TBitSet, length: int) = - newSeq(b, length) - -proc BitSetUnion(x: var TBitSet, y: TBitSet) = - for i in countup(0, high(x)): x[i] = x[i] or y[i] - -proc BitSetDiff(x: var TBitSet, y: TBitSet) = - for i in countup(0, high(x)): x[i] = x[i] and not y[i] - -proc BitSetSymDiff(x: var TBitSet, y: TBitSet) = - for i in countup(0, high(x)): x[i] = x[i] xor y[i] - -proc BitSetIntersect(x: var TBitSet, y: TBitSet) = - for i in countup(0, high(x)): x[i] = x[i] and y[i] - -proc BitSetEquals(x, y: TBitSet): bool = - for i in countup(0, high(x)): - if x[i] != y[i]: - return false - result = true - -proc BitSetContains(x, y: TBitSet): bool = - for i in countup(0, high(x)): - if (x[i] and not y[i]) != int8(0): - return false - result = true diff --git a/rod/c2nim/c2nim.cfg b/rod/c2nim/c2nim.cfg deleted file mode 100755 index 789e6ec7f..000000000 --- a/rod/c2nim/c2nim.cfg +++ /dev/null @@ -1,4 +0,0 @@ -# Use the modules of the compiler - -path: "$nimrod/rod" - diff --git a/rod/c2nim/c2nim.nim b/rod/c2nim/c2nim.nim deleted file mode 100755 index f4e185445..000000000 --- a/rod/c2nim/c2nim.nim +++ /dev/null @@ -1,76 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - strutils, os, times, parseopt, llstream, ast, rnimsyn, options, msgs, - clex, cparse - -const - Version = NimrodVersion - Usage = """ -c2nim - C to Nimrod source converter - (c) 2011 Andreas Rumpf -Usage: c2nim [options] inputfile [options] -Options: - -o, --out:FILE set output filename - --dynlib:SYMBOL import from dynlib: SYMBOL will be used for the import - --header:HEADER_FILE import from a HEADER_FILE (discouraged!) - --cdecl annotate procs with ``{.cdecl.}`` - --stdcall annotate procs with ``{.stdcall.}`` - --ref convert typ* to ref typ (default: ptr typ) - --prefix:PREFIX strip prefix for the generated Nimrod identifiers - (multiple --prefix options are supported) - --suffix:SUFFIX strip suffix for the generated Nimrod identifiers - (multiple --suffix options are supported) - --skipinclude do not convert ``#include`` to ``import`` - --typeprefixes generate ``T`` and ``P`` type prefixes - --skipcomments do not copy comments - -v, --version write c2nim's version - -h, --help show this help -""" - -proc main(infile, outfile: string, options: PParserOptions) = - var start = getTime() - var stream = LLStreamOpen(infile, fmRead) - if stream == nil: rawMessage(errCannotOpenFile, infile) - var p: TParser - openParser(p, infile, stream, options) - var module = parseUnit(p) - closeParser(p) - renderModule(module, outfile) - rawMessage(hintSuccessX, [$gLinesCompiled, $(getTime() - start)]) - -var - infile = "" - outfile = "" - parserOptions = newParserOptions() -for kind, key, val in getopt(): - case kind - of cmdArgument: infile = key - of cmdLongOption, cmdShortOption: - case key.toLower - of "help", "h": - stdout.write(Usage) - quit(0) - of "version", "v": - stdout.write(Version & "\n") - quit(0) - of "o", "out": outfile = key - else: - if not parserOptions.setOption(key, val): - stdout.write("[Error] unknown option: " & key) - of cmdEnd: assert(false) -if infile.len == 0: - # no filename has been given, so we show the help: - stdout.write(Usage) -else: - if outfile.len == 0: - outfile = changeFileExt(infile, "nim") - infile = addFileExt(infile, "h") - main(infile, outfile, parserOptions) diff --git a/rod/c2nim/clex.nim b/rod/c2nim/clex.nim deleted file mode 100755 index 5a67f9475..000000000 --- a/rod/c2nim/clex.nim +++ /dev/null @@ -1,752 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements an Ansi C scanner. This is an adaption from -# the scanner module. Keywords are not handled here, but in the parser to make -# it more flexible. - - -import - options, msgs, strutils, platform, lexbase, llstream - -const - MaxLineLength* = 80 # lines longer than this lead to a warning - numChars*: TCharSet = {'0'..'9', 'a'..'z', 'A'..'Z'} - SymChars*: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '_', '\x80'..'\xFF'} - SymStartChars*: TCharSet = {'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF'} - -type - TTokKind* = enum - pxInvalid, pxEof, - pxMacroParam, # fake token: macro parameter (with its index) - pxStarComment, # /* */ comment - pxLineComment, # // comment - pxDirective, # #define, etc. - pxDirectiveParLe, # #define m( with parle (yes, C is that ugly!) - pxDirConc, # ## - pxNewLine, # newline: end of directive - pxAmp, # & - pxAmpAmp, # && - pxAmpAsgn, # &= - pxAmpAmpAsgn, # &&= - pxBar, # | - pxBarBar, # || - pxBarAsgn, # |= - pxBarBarAsgn, # ||= - pxNot, # ! - pxPlusPlus, # ++ - pxMinusMinus, # -- - pxPlus, # + - pxPlusAsgn, # += - pxMinus, # - - pxMinusAsgn, # -= - pxMod, # % - pxModAsgn, # %= - pxSlash, # / - pxSlashAsgn, # /= - pxStar, # * - pxStarAsgn, # *= - pxHat, # ^ - pxHatAsgn, # ^= - pxAsgn, # = - pxEquals, # == - pxDot, # . - pxDotDotDot, # ... - pxLe, # <= - pxLt, # < - pxGe, # >= - pxGt, # > - pxNeq, # != - pxConditional, # ? - pxShl, # << - pxShlAsgn, # <<= - pxShr, # >> - pxShrAsgn, # >>= - pxTilde, # ~ - pxTildeAsgn, # ~= - pxArrow, # -> - pxScope, # :: - - pxStrLit, - pxCharLit, - pxSymbol, # a symbol - pxIntLit, - pxInt64Lit, # long constant like 0x70fffffff or out of int range - pxFloatLit, - pxParLe, pxBracketLe, pxCurlyLe, # this order is important - pxParRi, pxBracketRi, pxCurlyRi, # for macro argument parsing! - pxComma, pxSemiColon, pxColon, - TTokKinds* = set[TTokKind] - -type - TNumericalBase* = enum base10, base2, base8, base16 - TToken* = object - xkind*: TTokKind # the type of the token - s*: string # parsed symbol, char or string literal - iNumber*: BiggestInt # the parsed integer literal; - # if xkind == pxMacroParam: parameter's position - fNumber*: BiggestFloat # the parsed floating point literal - base*: TNumericalBase # the numerical base; only valid for int - # or float literals - next*: ref TToken # for C we need arbitrary look-ahead :-( - - TLexer* = object of TBaseLexer - filename*: string - inDirective: bool - -proc getTok*(L: var TLexer, tok: var TToken) -proc PrintTok*(tok: TToken) -proc `$`*(tok: TToken): string -# implementation - -var - gLinesCompiled*: int - -proc fillToken(L: var TToken) = - L.xkind = pxInvalid - L.iNumber = 0 - L.s = "" - L.fNumber = 0.0 - L.base = base10 - -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) = - openBaseLexer(lex, inputstream) - lex.filename = filename - -proc closeLexer*(lex: var TLexer) = - inc(gLinesCompiled, lex.LineNumber) - closeBaseLexer(lex) - -proc getColumn*(L: TLexer): int = - result = getColNumber(L, L.bufPos) - -proc getLineInfo*(L: TLexer): TLineInfo = - result = newLineInfo(L.filename, L.linenumber, getColNumber(L, L.bufpos)) - -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") = - msgs.GenericMessage(getLineInfo(L), msg, arg) - -proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = - var info = newLineInfo(L.filename, L.linenumber, pos - L.lineStart) - msgs.GenericMessage(info, msg, arg) - -proc TokKindToStr*(k: TTokKind): string = - case k - of pxEof: result = "[EOF]" - of pxInvalid: result = "[invalid]" - of pxMacroParam: result = "[macro param]" - of pxStarComment, pxLineComment: result = "[comment]" - of pxStrLit: result = "[string literal]" - of pxCharLit: result = "[char literal]" - - of pxDirective, pxDirectiveParLe: result = "#" # #define, etc. - of pxDirConc: result = "##" - of pxNewLine: result = "[NewLine]" - of pxAmp: result = "&" # & - of pxAmpAmp: result = "&&" # && - of pxAmpAsgn: result = "&=" # &= - of pxAmpAmpAsgn: result = "&&=" # &&= - of pxBar: result = "|" # | - of pxBarBar: result = "||" # || - of pxBarAsgn: result = "|=" # |= - of pxBarBarAsgn: result = "||=" # ||= - of pxNot: result = "!" # ! - of pxPlusPlus: result = "++" # ++ - of pxMinusMinus: result = "--" # -- - of pxPlus: result = "+" # + - of pxPlusAsgn: result = "+=" # += - of pxMinus: result = "-" # - - of pxMinusAsgn: result = "-=" # -= - of pxMod: result = "%" # % - of pxModAsgn: result = "%=" # %= - of pxSlash: result = "/" # / - of pxSlashAsgn: result = "/=" # /= - of pxStar: result = "*" # * - of pxStarAsgn: result = "*=" # *= - of pxHat: result = "^" # ^ - of pxHatAsgn: result = "^=" # ^= - of pxAsgn: result = "=" # = - of pxEquals: result = "==" # == - of pxDot: result = "." # . - of pxDotDotDot: result = "..." # ... - of pxLe: result = "<=" # <= - of pxLt: result = "<" # < - of pxGe: result = ">=" # >= - of pxGt: result = ">" # > - of pxNeq: result = "!=" # != - of pxConditional: result = "?" - of pxShl: result = "<<" - of pxShlAsgn: result = "<<=" - of pxShr: result = ">>" - of pxShrAsgn: result = ">>=" - of pxTilde: result = "~" - of pxTildeAsgn: result = "~=" - of pxArrow: result = "->" - of pxScope: result = "::" - - of pxSymbol: result = "[identifier]" - of pxIntLit, pxInt64Lit: result = "[integer literal]" - of pxFloatLit: result = "[floating point literal]" - of pxParLe: result = "(" - of pxParRi: result = ")" - of pxBracketLe: result = "[" - of pxBracketRi: result = "]" - of pxComma: result = "," - of pxSemiColon: result = ";" - of pxColon: result = ":" - of pxCurlyLe: result = "{" - of pxCurlyRi: result = "}" - -proc `$`(tok: TToken): string = - case tok.xkind - of pxSymbol, pxInvalid, pxStarComment, pxLineComment, pxStrLit: result = tok.s - of pxIntLit, pxInt64Lit: result = $tok.iNumber - of pxFloatLit: result = $tok.fNumber - else: result = TokKindToStr(tok.xkind) - -proc PrintTok(tok: TToken) = - writeln(stdout, $tok) - -proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: TCharSet) = - # matches ([chars]_)* - var pos = L.bufpos # use registers for pos, buf - var buf = L.buf - while true: - if buf[pos] in chars: - add(tok.s, buf[pos]) - Inc(pos) - else: - break - if buf[pos] == '_': - add(tok.s, '_') - Inc(pos) - L.bufPos = pos - -proc isFloatLiteral(s: string): bool = - for i in countup(0, len(s)-1): - if s[i] in {'.', 'e', 'E'}: - return true - -proc getNumber2(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 2 # skip 0b - tok.base = base2 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z': - # ignore type suffix: - inc(pos) - of '2'..'9', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': - inc(pos) - of '0', '1': - xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits) - else: break - tok.iNumber = xi - if (bits > 32): tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber8(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 # skip 0 - tok.base = base8 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z': - # ignore type suffix: - inc(pos) - of '8'..'9', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': - inc(pos) - of '0'..'7': - xi = `shl`(xi, 3) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits) - else: break - tok.iNumber = xi - if (bits > 12): tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber16(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 2 # skip 0x - tok.base = base16 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'G'..'Z', 'g'..'z': - # ignore type suffix: - inc(pos) - of '_': inc(pos) - of '0'..'9': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits, 4) - of 'a'..'f': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) - inc(pos) - inc(bits, 4) - of 'A'..'F': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) - inc(pos) - inc(bits, 4) - else: break - tok.iNumber = xi - if bits > 32: tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber(L: var TLexer, tok: var TToken) = - tok.base = base10 - matchUnderscoreChars(L, tok, {'0'..'9'}) - if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): - add(tok.s, '.') - inc(L.bufpos) - matchUnderscoreChars(L, tok, {'e', 'E', '+', '-', '0'..'9'}) - try: - if isFloatLiteral(tok.s): - tok.fnumber = parseFloat(tok.s) - tok.xkind = pxFloatLit - else: - tok.iNumber = ParseInt(tok.s) - if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)): - tok.xkind = pxInt64Lit - else: - tok.xkind = pxIntLit - except EInvalidValue: - lexMessage(L, errInvalidNumber, tok.s) - except EOverflow: - lexMessage(L, errNumberOutOfRange, tok.s) - # ignore type suffix: - while L.buf[L.bufpos] in {'A'..'Z', 'a'..'z'}: inc(L.bufpos) - -proc HandleCRLF(L: var TLexer, pos: int): int = - case L.buf[pos] - of CR: result = lexbase.HandleCR(L, pos) - of LF: result = lexbase.HandleLF(L, pos) - else: result = pos - -proc escape(L: var TLexer, tok: var TToken, allowEmpty=false) = - inc(L.bufpos) # skip \ - case L.buf[L.bufpos] - of 'b', 'B': - add(tok.s, '\b') - inc(L.bufpos) - of 't', 'T': - add(tok.s, '\t') - inc(L.bufpos) - of 'n', 'N': - add(tok.s, '\L') - inc(L.bufpos) - of 'f', 'F': - add(tok.s, '\f') - inc(L.bufpos) - of 'r', 'R': - add(tok.s, '\r') - inc(L.bufpos) - of '\'': - add(tok.s, '\'') - inc(L.bufpos) - of '"': - add(tok.s, '"') - inc(L.bufpos) - of '\\': - add(tok.s, '\b') - inc(L.bufpos) - of '0'..'7': - var xi = ord(L.buf[L.bufpos]) - ord('0') - inc(L.bufpos) - if L.buf[L.bufpos] in {'0'..'7'}: - xi = (xi shl 3) or (ord(L.buf[L.bufpos]) - ord('0')) - inc(L.bufpos) - if L.buf[L.bufpos] in {'0'..'7'}: - xi = (xi shl 3) or (ord(L.buf[L.bufpos]) - ord('0')) - inc(L.bufpos) - add(tok.s, chr(xi)) - elif not allowEmpty: - lexMessage(L, errInvalidCharacterConstant) - -proc getCharLit(L: var TLexer, tok: var TToken) = - inc(L.bufpos) # skip ' - if L.buf[L.bufpos] == '\\': - escape(L, tok) - else: - add(tok.s, L.buf[L.bufpos]) - inc(L.bufpos) - if L.buf[L.bufpos] == '\'': - inc(L.bufpos) - else: - lexMessage(L, errMissingFinalQuote) - tok.xkind = pxCharLit - -proc getString(L: var TLexer, tok: var TToken) = - var pos = L.bufPos + 1 # skip " - var buf = L.buf # put `buf` in a register - var line = L.linenumber # save linenumber for better error message - while true: - case buf[pos] - of '\"': - Inc(pos) - break - of CR: - pos = lexbase.HandleCR(L, pos) - buf = L.buf - of LF: - pos = lexbase.HandleLF(L, pos) - buf = L.buf - of lexbase.EndOfFile: - var line2 = L.linenumber - L.LineNumber = line - lexMessagePos(L, errClosingQuoteExpected, L.lineStart) - L.LineNumber = line2 - break - of '\\': - # we allow an empty \ for line concatenation, but we don't require it - # for line concatenation - L.bufpos = pos - escape(L, tok, allowEmpty=true) - pos = L.bufpos - else: - add(tok.s, buf[pos]) - Inc(pos) - L.bufpos = pos - tok.xkind = pxStrLit - -proc getSymbol(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - while true: - var c = buf[pos] - if c notin SymChars: break - add(tok.s, c) - Inc(pos) - L.bufpos = pos - tok.xkind = pxSymbol - -proc scanLineComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - # a comment ends if the next line does not start with the // on the same - # column after only whitespace - tok.xkind = pxLineComment - var col = getColNumber(L, pos) - while true: - inc(pos, 2) # skip // - add(tok.s, '#') - while not (buf[pos] in {CR, LF, lexbase.EndOfFile}): - add(tok.s, buf[pos]) - inc(pos) - pos = handleCRLF(L, pos) - buf = L.buf - var indent = 0 - while buf[pos] == ' ': - inc(pos) - inc(indent) - if (col == indent) and (buf[pos] == '/') and (buf[pos + 1] == '/'): - add(tok.s, "\n") - else: - break - L.bufpos = pos - -proc scanStarComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - tok.s = "#" - tok.xkind = pxStarComment - while true: - case buf[pos] - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - add(tok.s, "\n#") - # skip annoying stars as line prefix: (eg. - # /* - # * ugly comment <-- this star - # */ - while buf[pos] in {' ', '\t'}: - add(tok.s, ' ') - inc(pos) - if buf[pos] == '*' and buf[pos+1] != '/': inc(pos) - of '*': - inc(pos) - if buf[pos] == '/': - inc(pos) - break - else: - add(tok.s, '*') - of lexbase.EndOfFile: - lexMessage(L, errTokenExpected, "*/") - else: - add(tok.s, buf[pos]) - inc(pos) - L.bufpos = pos - -proc skip(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - while true: - case buf[pos] - of '\\': - # Ignore \ line continuation characters when not inDirective - inc(pos) - if L.inDirective: - while buf[pos] in {' ', '\t'}: inc(pos) - if buf[pos] in {CR, LF}: - pos = HandleCRLF(L, pos) - buf = L.buf - of ' ', Tabulator: - Inc(pos) # newline is special: - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - if L.inDirective: - tok.xkind = pxNewLine - L.inDirective = false - else: - break # EndOfFile also leaves the loop - L.bufpos = pos - -proc getDirective(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 - var buf = L.buf - while buf[pos] in {' ', '\t'}: inc(pos) - while buf[pos] in SymChars: - add(tok.s, buf[pos]) - inc(pos) - # a HACK: we need to distinguish - # #define x (...) - # from: - # #define x(...) - # - L.bufpos = pos - # look ahead: - while buf[pos] in {' ', '\t'}: inc(pos) - while buf[pos] in SymChars: inc(pos) - if buf[pos] == '(': tok.xkind = pxDirectiveParLe - else: tok.xkind = pxDirective - L.inDirective = true - -proc getTok(L: var TLexer, tok: var TToken) = - tok.xkind = pxInvalid - fillToken(tok) - skip(L, tok) - if tok.xkind == pxNewLine: return - var c = L.buf[L.bufpos] - if c in SymStartChars: - getSymbol(L, tok) - elif c == '0': - case L.buf[L.bufpos+1] - of 'x', 'X': getNumber16(L, tok) - of 'b', 'B': getNumber2(L, tok) - of '1'..'7': getNumber8(L, tok) - else: getNumber(L, tok) - elif c in {'1'..'9'}: - getNumber(L, tok) - else: - case c - of ';': - tok.xkind = pxSemicolon - Inc(L.bufpos) - of '/': - if L.buf[L.bufpos + 1] == '/': - scanLineComment(L, tok) - elif L.buf[L.bufpos+1] == '*': - inc(L.bufpos, 2) - scanStarComment(L, tok) - elif L.buf[L.bufpos+1] == '=': - inc(L.bufpos, 2) - tok.xkind = pxSlashAsgn - else: - tok.xkind = pxSlash - inc(L.bufpos) - of ',': - tok.xkind = pxComma - Inc(L.bufpos) - of '(': - Inc(L.bufpos) - tok.xkind = pxParLe - of '*': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxStarAsgn - else: - tok.xkind = pxStar - of ')': - Inc(L.bufpos) - tok.xkind = pxParRi - of '[': - Inc(L.bufpos) - tok.xkind = pxBracketLe - of ']': - Inc(L.bufpos) - tok.xkind = pxBracketRi - of '.': - inc(L.bufpos) - if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] == '.': - tok.xkind = pxDotDotDot - inc(L.bufpos, 2) - else: - tok.xkind = pxDot - of '{': - Inc(L.bufpos) - tok.xkind = pxCurlyLe - of '}': - Inc(L.bufpos) - tok.xkind = pxCurlyRi - of '+': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxPlusAsgn - inc(L.bufpos) - elif L.buf[L.bufpos] == '+': - tok.xkind = pxPlusPlus - inc(L.bufpos) - else: - tok.xkind = pxPlus - of '-': - inc(L.bufpos) - case L.buf[L.bufpos] - of '>': - tok.xkind = pxArrow - inc(L.bufpos) - of '=': - tok.xkind = pxMinusAsgn - inc(L.bufpos) - of '-': - tok.xkind = pxMinusMinus - inc(L.bufpos) - else: - tok.xkind = pxMinus - of '?': - inc(L.bufpos) - tok.xkind = pxConditional - of ':': - inc(L.bufpos) - if L.buf[L.bufpos] == ':': - tok.xkind = pxScope - inc(L.bufpos) - else: - tok.xkind = pxColon - of '!': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxNeq - inc(L.bufpos) - else: - tok.xkind = pxNot - of '<': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxLe - elif L.buf[L.bufpos] == '<': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxShlAsgn - else: - tok.xkind = pxShl - else: - tok.xkind = pxLt - of '>': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxGe - elif L.buf[L.bufpos] == '>': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxShrAsgn - else: - tok.xkind = pxShr - else: - tok.xkind = pxGt - of '=': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxEquals - inc(L.bufpos) - else: - tok.xkind = pxAsgn - of '&': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxAmpAsgn - inc(L.bufpos) - elif L.buf[L.bufpos] == '&': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxAmpAmpAsgn - else: - tok.xkind = pxAmpAmp - else: - tok.xkind = pxAmp - of '|': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxBarAsgn - inc(L.bufpos) - elif L.buf[L.bufpos] == '|': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxBarBarAsgn - else: - tok.xkind = pxBarBar - else: - tok.xkind = pxBar - of '^': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxHatAsgn - inc(L.bufpos) - else: - tok.xkind = pxHat - of '%': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxModAsgn - inc(L.bufpos) - else: - tok.xkind = pxMod - of '~': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxTildeAsgn - inc(L.bufpos) - else: - tok.xkind = pxTilde - of '#': - if L.buf[L.bufpos+1] == '#': - inc(L.bufpos, 2) - tok.xkind = pxDirConc - else: - getDirective(L, tok) - of '"': getString(L, tok) - of '\'': getCharLit(L, tok) - of lexbase.EndOfFile: - tok.xkind = pxEof - else: - tok.s = $c - tok.xkind = pxInvalid - lexMessage(L, errInvalidToken, c & " (\\" & $(ord(c)) & ')') - Inc(L.bufpos) diff --git a/rod/c2nim/cparse.nim b/rod/c2nim/cparse.nim deleted file mode 100755 index ce9caf7f5..000000000 --- a/rod/c2nim/cparse.nim +++ /dev/null @@ -1,1704 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements an Ansi C parser. -## It translates a C source file into a Nimrod AST. Then the renderer can be -## used to convert the AST to its text representation. - -# XXX cleanup of declaration handling. - -import - os, llstream, rnimsyn, clex, idents, strutils, pegs, ast, astalgo, msgs, - options, strtabs - -type - TParserFlag = enum - pfRefs, ## use "ref" instead of "ptr" for C's typ* - pfCDecl, ## annotate procs with cdecl - pfStdCall, ## annotate procs with stdcall - pfSkipInclude, ## skip all ``#include`` - pfTypePrefixes, ## all generated types start with 'T' or 'P' - pfSkipComments ## do not generate comments - - TMacro {.final.} = object - name: string - params: int # number of parameters - body: seq[ref TToken] # can contain pxMacroParam tokens - - TParserOptions {.final.} = object - flags: set[TParserFlag] - prefixes, suffixes: seq[string] - mangleRules: seq[tuple[pattern: TPeg, frmt: string]] - privateRules: seq[TPeg] - dynlibSym, header: string - macros: seq[TMacro] - toMangle: PStringTable - PParserOptions* = ref TParserOptions - - TParser* {.final.} = object - lex: TLexer - tok: ref TToken # current token - options: PParserOptions - backtrack: seq[ref TToken] - inTypeDef: int - scopeCounter: int - hasDeadCodeElimPragma: bool - - TReplaceTuple* = array[0..1, string] - -proc newParserOptions*(): PParserOptions = - new(result) - result.prefixes = @[] - result.suffixes = @[] - result.macros = @[] - result.mangleRules = @[] - result.privateRules = @[] - result.flags = {} - result.dynlibSym = "" - result.header = "" - result.toMangle = newStringTable() - -proc setOption*(parserOptions: PParserOptions, key: string, val=""): bool = - result = true - case key - of "ref": incl(parserOptions.flags, pfRefs) - of "dynlib": parserOptions.dynlibSym = val - of "header": parserOptions.header = val - of "cdecl": incl(parserOptions.flags, pfCdecl) - of "stdcall": incl(parserOptions.flags, pfStdCall) - of "prefix": parserOptions.prefixes.add(val) - of "suffix": parserOptions.suffixes.add(val) - of "skipinclude": incl(parserOptions.flags, pfSkipInclude) - of "typeprefixes": incl(parserOptions.flags, pfTypePrefixes) - of "skipcomments": incl(parserOptions.flags, pfSkipComments) - else: result = false - -proc ParseUnit*(p: var TParser): PNode -proc openParser*(p: var TParser, filename: string, inputStream: PLLStream, - options = newParserOptions()) -proc closeParser*(p: var TParser) - -# implementation - -proc OpenParser(p: var TParser, filename: string, - inputStream: PLLStream, options = newParserOptions()) = - OpenLexer(p.lex, filename, inputStream) - p.options = options - p.backtrack = @[] - new(p.tok) - -proc parMessage(p: TParser, msg: TMsgKind, arg = "") = - #assert false - lexMessage(p.lex, msg, arg) - -proc CloseParser(p: var TParser) = CloseLexer(p.lex) -proc saveContext(p: var TParser) = p.backtrack.add(p.tok) -proc closeContext(p: var TParser) = discard p.backtrack.pop() -proc backtrackContext(p: var TParser) = p.tok = p.backtrack.pop() - -proc rawGetTok(p: var TParser) = - if p.tok.next != nil: - p.tok = p.tok.next - elif p.backtrack.len == 0: - p.tok.next = nil - getTok(p.lex, p.tok[]) - else: - # We need the next token and must be able to backtrack. So we need to - # allocate a new token. - var t: ref TToken - new(t) - getTok(p.lex, t[]) - p.tok.next = t - p.tok = t - -proc findMacro(p: TParser): int = - for i in 0..high(p.options.macros): - if p.tok.s == p.options.macros[i].name: return i - return -1 - -proc rawEat(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: rawGetTok(p) - else: parMessage(p, errTokenExpected, TokKindToStr(xkind)) - -proc parseMacroArguments(p: var TParser): seq[seq[ref TToken]] = - result = @[] - result.add(@[]) - var i: array[pxParLe..pxCurlyLe, int] - var L = 0 - saveContext(p) - while true: - var kind = p.tok.xkind - case kind - of pxEof: rawEat(p, pxParRi) - of pxParLe, pxBracketLe, pxCurlyLe: - inc(i[kind]) - result[L].add(p.tok) - of pxParRi: - # end of arguments? - if i[pxParLe] == 0 and i[pxBracketLe] == 0 and i[pxCurlyLe] == 0: break - if i[pxParLe] > 0: dec(i[pxParLe]) - result[L].add(p.tok) - of pxBracketRi, pxCurlyRi: - kind = pred(kind, 3) - if i[kind] > 0: dec(i[kind]) - result[L].add(p.tok) - of pxComma: - if i[pxParLe] == 0 and i[pxBracketLe] == 0 and i[pxCurlyLe] == 0: - # next argument: comma is not part of the argument - result.add(@[]) - inc(L) - else: - # comma does not separate different arguments: - result[L].add(p.tok) - else: - result[L].add(p.tok) - rawGetTok(p) - closeContext(p) - -proc expandMacro(p: var TParser, m: TMacro) = - rawGetTok(p) # skip macro name - var arguments: seq[seq[ref TToken]] - if m.params > 0: - rawEat(p, pxParLe) - arguments = parseMacroArguments(p) - if arguments.len != m.params: parMessage(p, errWrongNumberOfArguments) - rawEat(p, pxParRi) - # insert into the token list: - if m.body.len > 0: - var newList: ref TToken - new(newList) - var lastTok = newList - for tok in items(m.body): - if tok.xkind == pxMacroParam: - for t in items(arguments[int(tok.iNumber)]): - #echo "t: ", t^ - lastTok.next = t - lastTok = t - else: - #echo "tok: ", tok^ - lastTok.next = tok - lastTok = tok - lastTok.next = p.tok - p.tok = newList.next - -proc getTok(p: var TParser) = - rawGetTok(p) - if p.tok.xkind == pxSymbol: - var idx = findMacro(p) - if idx >= 0: - expandMacro(p, p.options.macros[idx]) - -proc parLineInfo(p: TParser): TLineInfo = - result = getLineInfo(p.lex) - -proc skipComAux(p: var TParser, n: PNode) = - if n != nil and n.kind != nkEmpty: - if pfSkipComments notin p.options.flags: - if n.comment == nil: n.comment = p.tok.s - else: add(n.comment, "\n" & p.tok.s) - else: - parMessage(p, warnCommentXIgnored, p.tok.s) - getTok(p) - -proc skipCom(p: var TParser, n: PNode) = - while p.tok.xkind in {pxLineComment, pxStarComment}: skipcomAux(p, n) - -proc skipStarCom(p: var TParser, n: PNode) = - while p.tok.xkind == pxStarComment: skipComAux(p, n) - -proc getTok(p: var TParser, n: PNode) = - getTok(p) - skipCom(p, n) - -proc ExpectIdent(p: TParser) = - if p.tok.xkind != pxSymbol: parMessage(p, errIdentifierExpected, $(p.tok[])) - -proc Eat(p: var TParser, xkind: TTokKind, n: PNode) = - if p.tok.xkind == xkind: getTok(p, n) - else: parMessage(p, errTokenExpected, TokKindToStr(xkind)) - -proc Eat(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: getTok(p) - else: parMessage(p, errTokenExpected, TokKindToStr(xkind)) - -proc Eat(p: var TParser, tok: string, n: PNode) = - if p.tok.s == tok: getTok(p, n) - else: parMessage(p, errTokenExpected, tok) - -proc Opt(p: var TParser, xkind: TTokKind, n: PNode) = - if p.tok.xkind == xkind: getTok(p, n) - -proc addSon(father, a, b: PNode) = - addSon(father, a) - addSon(father, b) - -proc addSon(father, a, b, c: PNode) = - addSon(father, a) - addSon(father, b) - addSon(father, c) - -proc newNodeP(kind: TNodeKind, p: TParser): PNode = - result = newNodeI(kind, getLineInfo(p.lex)) - -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal - -proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, - p: TParser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal - -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal - -proc newIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident - -proc newIdentNodeP(ident: string, p: TParser): PNode = - result = newIdentNodeP(getIdent(ident), p) - -proc mangleRules(s: string, p: TParser): string = - block mangle: - for pattern, frmt in items(p.options.mangleRules): - if s.match(pattern): - result = s.replace(pattern, frmt) - break mangle - block prefixes: - for prefix in items(p.options.prefixes): - if s.startsWith(prefix): - result = s.copy(prefix.len) - break prefixes - result = s - block suffixes: - for suffix in items(p.options.suffixes): - if result.endsWith(suffix): - setLen(result, result.len - suffix.len) - break suffixes - -proc mangleName(s: string, p: TParser): string = - if p.options.toMangle.hasKey(s): result = p.options.toMangle[s] - else: result = mangleRules(s, p) - -proc isPrivate(s: string, p: TParser): bool = - for pattern in items(p.options.privateRules): - if s.match(pattern): return true - -proc mangledIdent(ident: string, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = getIdent(mangleName(ident, p)) - -proc newIdentPair(a, b: string, p: TParser): PNode = - result = newNodeP(nkExprColonExpr, p) - addSon(result, newIdentNodeP(a, p)) - addSon(result, newIdentNodeP(b, p)) - -proc newIdentStrLitPair(a, b: string, p: TParser): PNode = - result = newNodeP(nkExprColonExpr, p) - addSon(result, newIdentNodeP(a, p)) - addSon(result, newStrNodeP(nkStrLit, b, p)) - -proc addImportToPragma(pragmas: PNode, ident: string, p: TParser) = - addSon(pragmas, newIdentStrLitPair("importc", ident, p)) - if p.options.dynlibSym.len > 0: - addSon(pragmas, newIdentPair("dynlib", p.options.dynlibSym, p)) - else: - addSon(pragmas, newIdentStrLitPair("header", p.options.header, p)) - -proc exportSym(p: TParser, i: PNode, origName: string): PNode = - assert i.kind == nkIdent - if p.scopeCounter == 0 and not isPrivate(origName, p): - result = newNodeI(nkPostfix, i.info) - addSon(result, newIdentNode(getIdent("*"), i.info), i) - else: - result = i - -proc varIdent(ident: string, p: TParser): PNode = - result = exportSym(p, mangledIdent(ident, p), ident) - if p.scopeCounter > 0: return - if p.options.dynlibSym.len > 0 or p.options.header.len > 0: - var a = result - result = newNodeP(nkPragmaExpr, p) - var pragmas = newNodeP(nkPragma, p) - addSon(result, a) - addSon(result, pragmas) - addImportToPragma(pragmas, ident, p) - -proc fieldIdent(ident: string, p: TParser): PNode = - result = exportSym(p, mangledIdent(ident, p), ident) - if p.scopeCounter > 0: return - if p.options.header.len > 0: - var a = result - result = newNodeP(nkPragmaExpr, p) - var pragmas = newNodeP(nkPragma, p) - addSon(result, a) - addSon(result, pragmas) - addSon(pragmas, newIdentStrLitPair("importc", ident, p)) - -proc DoImport(ident: string, pragmas: PNode, p: TParser) = - if p.options.dynlibSym.len > 0 or p.options.header.len > 0: - addImportToPragma(pragmas, ident, p) - -proc newBinary(opr: string, a, b: PNode, p: TParser): PNode = - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP(getIdent(opr), p)) - addSon(result, a) - addSon(result, b) - -proc skipIdent(p: var TParser): PNode = - expectIdent(p) - result = mangledIdent(p.tok.s, p) - getTok(p, result) - -proc skipIdentExport(p: var TParser): PNode = - expectIdent(p) - result = exportSym(p, mangledIdent(p.tok.s, p), p.tok.s) - getTok(p, result) - -proc skipTypeIdentExport(p: var TParser, prefix='T'): PNode = - expectIdent(p) - var n = prefix & mangleName(p.tok.s, p) - p.options.toMangle[p.tok.s] = n - var i = newNodeP(nkIdent, p) - i.ident = getIdent(n) - result = exportSym(p, i, p.tok.s) - getTok(p, result) - -proc markTypeIdent(p: var TParser, typ: PNode) = - if pfTypePrefixes in p.options.flags: - var prefix = "" - if typ == nil or typ.kind == nkEmpty: - prefix = "T" - else: - var t = typ - while t != nil and t.kind in {nkVarTy, nkPtrTy, nkRefTy}: - prefix.add('P') - t = t.sons[0] - if prefix.len == 0: prefix.add('T') - expectIdent(p) - p.options.toMangle[p.tok.s] = prefix & mangleRules(p.tok.s, p) - -# --------------- parser ----------------------------------------------------- -# We use this parsing rule: If it looks like a declaration, it is one. This -# avoids to build a symbol table, which can't be done reliably anyway for our -# purposes. - -proc expression(p: var TParser): PNode -proc constantExpression(p: var TParser): PNode -proc assignmentExpression(p: var TParser): PNode -proc compoundStatement(p: var TParser): PNode -proc statement(p: var TParser): PNode - -proc declKeyword(s: string): bool = - # returns true if it is a keyword that introduces a declaration - case s - of "extern", "static", "auto", "register", "const", "volatile", "restrict", - "inline", "__inline", "__cdecl", "__stdcall", "__syscall", "__fastcall", - "__safecall", "void", "struct", "union", "enum", "typedef", - "short", "int", "long", "float", "double", "signed", "unsigned", "char": - result = true - -proc stmtKeyword(s: string): bool = - case s - of "if", "for", "while", "do", "switch", "break", "continue", "return", - "goto": - result = true - -# ------------------- type desc ----------------------------------------------- - -proc isIntType(s: string): bool = - case s - of "short", "int", "long", "float", "double", "signed", "unsigned": - result = true - -proc skipConst(p: var TParser) = - while p.tok.xkind == pxSymbol and - (p.tok.s == "const" or p.tok.s == "volatile" or p.tok.s == "restrict"): - getTok(p, nil) - -proc typeAtom(p: var TParser): PNode = - skipConst(p) - ExpectIdent(p) - case p.tok.s - of "void": - result = newNodeP(nkNilLit, p) # little hack - getTok(p, nil) - of "struct", "union", "enum": - getTok(p, nil) - result = skipIdent(p) - elif isIntType(p.tok.s): - var x = "c" & p.tok.s - getTok(p, nil) - while p.tok.xkind == pxSymbol and - (isIntType(p.tok.s) or p.tok.s == "char"): - add(x, p.tok.s) - getTok(p, nil) - result = mangledIdent(x, p) - else: - result = mangledIdent(p.tok.s, p) - getTok(p, result) - -proc newPointerTy(p: TParser, typ: PNode): PNode = - if pfRefs in p.options.flags: - result = newNodeP(nkRefTy, p) - else: - result = newNodeP(nkPtrTy, p) - result.addSon(typ) - -proc pointer(p: var TParser, a: PNode): PNode = - result = a - var i = 0 - skipConst(p) - while p.tok.xkind == pxStar: - inc(i) - getTok(p, result) - skipConst(p) - result = newPointerTy(p, result) - if a.kind == nkIdent and a.ident.s == "char": - if i >= 2: - result = newIdentNodeP("cstringArray", p) - for j in 1..i-2: result = newPointerTy(p, result) - elif i == 1: result = newIdentNodeP("cstring", p) - elif a.kind == nkNilLit and i > 0: - result = newIdentNodeP("pointer", p) - for j in 1..i-1: result = newPointerTy(p, result) - -proc newProcPragmas(p: TParser): PNode = - result = newNodeP(nkPragma, p) - if pfCDecl in p.options.flags: - addSon(result, newIdentNodeP("cdecl", p)) - elif pfStdCall in p.options.flags: - addSon(result, newIdentNodeP("stdcall", p)) - -proc addPragmas(father, pragmas: PNode) = - if sonsLen(pragmas) > 0: addSon(father, pragmas) - else: addSon(father, ast.emptyNode) - -proc addReturnType(params, rettyp: PNode) = - if rettyp == nil: addSon(params, ast.emptyNode) - elif rettyp.kind != nkNilLit: addSon(params, rettyp) - else: addson(params, ast.emptyNode) - -proc parseFormalParams(p: var TParser, params, pragmas: PNode) - -proc parseTypeSuffix(p: var TParser, typ: PNode): PNode = - result = typ - while true: - case p.tok.xkind - of pxBracketLe: - getTok(p, result) - skipConst(p) # POSIX contains: ``int [restrict]`` - if p.tok.xkind != pxBracketRi: - var tmp = result - var index = expression(p) - # array type: - result = newNodeP(nkBracketExpr, p) - addSon(result, newIdentNodeP("array", p)) - var r = newNodeP(nkRange, p) - addSon(r, newIntNodeP(nkIntLit, 0, p)) - addSon(r, newBinary("-", index, newIntNodeP(nkIntLit, 1, p), p)) - addSon(result, r) - addSon(result, tmp) - else: - # pointer type: - var tmp = result - if pfRefs in p.options.flags: - result = newNodeP(nkRefTy, p) - else: - result = newNodeP(nkPtrTy, p) - result.addSon(tmp) - eat(p, pxBracketRi, result) - of pxParLe: - # function pointer: - var procType = newNodeP(nkProcTy, p) - var pragmas = newProcPragmas(p) - var params = newNodeP(nkFormalParams, p) - addReturnType(params, result) - parseFormalParams(p, params, pragmas) - addSon(procType, params) - addPragmas(procType, pragmas) - result = procType - else: break - -proc typeDesc(p: var TParser): PNode = - result = pointer(p, typeAtom(p)) - -proc parseField(p: var TParser, kind: TNodeKind): PNode = - if p.tok.xkind == pxParLe: - getTok(p, nil) - while p.tok.xkind == pxStar: getTok(p, nil) - result = parseField(p, kind) - eat(p, pxParRi, result) - else: - expectIdent(p) - if kind == nkRecList: result = fieldIdent(p.tok.s, p) - else: result = mangledIdent(p.tok.s, p) - getTok(p, result) - -proc takeOnlyFirstField(p: TParser, isUnion: bool): bool = - # if we generate an interface to a header file, *all* fields can be - # generated: - result = isUnion and p.options.header.len == 0 - -proc parseStructBody(p: var TParser, isUnion: bool, - kind: TNodeKind = nkRecList): PNode = - result = newNodeP(kind, p) - eat(p, pxCurlyLe, result) - while p.tok.xkind notin {pxEof, pxCurlyRi}: - var baseTyp = typeAtom(p) - while true: - var def = newNodeP(nkIdentDefs, p) - var t = pointer(p, baseTyp) - var i = parseField(p, kind) - t = parseTypeSuffix(p, t) - addSon(def, i, t, ast.emptyNode) - if not takeOnlyFirstField(p, isUnion) or sonsLen(result) < 1: - addSon(result, def) - if p.tok.xkind != pxComma: break - getTok(p, def) - eat(p, pxSemicolon, lastSon(result)) - eat(p, pxCurlyRi, result) - -proc structPragmas(p: TParser, name: PNode, origName: string): PNode = - assert name.kind == nkIdent - result = newNodeP(nkPragmaExpr, p) - addson(result, exportSym(p, name, origName)) - var pragmas = newNodep(nkPragma, p) - addSon(pragmas, newIdentNodeP("pure", p), newIdentNodeP("final", p)) - if p.options.header.len > 0: - addSon(pragmas, newIdentStrLitPair("importc", origName, p), - newIdentStrLitPair("header", p.options.header, p)) - addSon(result, pragmas) - -proc enumPragmas(p: TParser, name: PNode): PNode = - result = newNodeP(nkPragmaExpr, p) - addson(result, name) - var pragmas = newNodep(nkPragma, p) - var e = newNodeP(nkExprColonExpr, p) - # HACK: sizeof(cint) should be constructed as AST - addSon(e, newIdentNodeP("size", p), newIdentNodeP("sizeof(cint)", p)) - addSon(pragmas, e) - addSon(result, pragmas) - -proc parseStruct(p: var TParser, isUnion: bool): PNode = - result = newNodeP(nkObjectTy, p) - addSon(result, ast.emptyNode, ast.emptyNode) # no pragmas, no inheritance - if p.tok.xkind == pxCurlyLe: - addSon(result, parseStructBody(p, isUnion)) - else: - addSon(result, newNodeP(nkRecList, p)) - -proc parseParam(p: var TParser, params: PNode) = - var typ = typeDesc(p) - # support for ``(void)`` parameter list: - if typ.kind == nkNilLit and p.tok.xkind == pxParRi: return - var name: PNode - if p.tok.xkind == pxSymbol: - name = skipIdent(p) - else: - # generate a name for the formal parameter: - var idx = sonsLen(params)+1 - name = newIdentNodeP("a" & $idx, p) - typ = parseTypeSuffix(p, typ) - var x = newNodeP(nkIdentDefs, p) - addSon(x, name, typ) - if p.tok.xkind == pxAsgn: - # we support default parameters for C++: - getTok(p, x) - addSon(x, assignmentExpression(p)) - else: - addSon(x, ast.emptyNode) - addSon(params, x) - -proc parseFormalParams(p: var TParser, params, pragmas: PNode) = - eat(p, pxParLe, params) - while p.tok.xkind notin {pxEof, pxParRi}: - if p.tok.xkind == pxDotDotDot: - addSon(pragmas, newIdentNodeP("varargs", p)) - getTok(p, pragmas) - break - parseParam(p, params) - if p.tok.xkind != pxComma: break - getTok(p, params) - eat(p, pxParRi, params) - -proc parseCallConv(p: var TParser, pragmas: PNode) = - while p.tok.xkind == pxSymbol: - case p.tok.s - of "inline", "__inline": addSon(pragmas, newIdentNodeP("inline", p)) - of "__cdecl": addSon(pragmas, newIdentNodeP("cdecl", p)) - of "__stdcall": addSon(pragmas, newIdentNodeP("stdcall", p)) - of "__syscall": addSon(pragmas, newIdentNodeP("syscall", p)) - of "__fastcall": addSon(pragmas, newIdentNodeP("fastcall", p)) - of "__safecall": addSon(pragmas, newIdentNodeP("safecall", p)) - else: break - getTok(p, nil) - -proc parseFunctionPointerDecl(p: var TParser, rettyp: PNode): PNode = - var procType = newNodeP(nkProcTy, p) - var pragmas = newProcPragmas(p) - var params = newNodeP(nkFormalParams, p) - eat(p, pxParLe, params) - addReturnType(params, rettyp) - parseCallConv(p, pragmas) - if p.tok.xkind == pxStar: getTok(p, params) - else: parMessage(p, errTokenExpected, "*") - if p.inTypeDef > 0: markTypeIdent(p, nil) - var name = skipIdentExport(p) - eat(p, pxParRi, name) - parseFormalParams(p, params, pragmas) - addSon(procType, params) - addPragmas(procType, pragmas) - - if p.inTypeDef == 0: - result = newNodeP(nkVarSection, p) - var def = newNodeP(nkIdentDefs, p) - addSon(def, name, procType, ast.emptyNode) - addSon(result, def) - else: - result = newNodeP(nkTypeDef, p) - addSon(result, name, ast.emptyNode, procType) - assert result != nil - -proc addTypeDef(section, name, t: PNode) = - var def = newNodeI(nkTypeDef, name.info) - addSon(def, name, ast.emptyNode, t) - addSon(section, def) - -proc otherTypeDef(p: var TParser, section, typ: PNode) = - var name, t: PNode - case p.tok.xkind - of pxParLe: - # function pointer: typedef typ (*name)(); - var x = parseFunctionPointerDecl(p, typ) - name = x[0] - t = x[2] - of pxStar: - # typedef typ *b; - t = pointer(p, typ) - markTypeIdent(p, t) - name = skipIdentExport(p) - else: - # typedef typ name; - t = typ - markTypeIdent(p, t) - name = skipIdentExport(p) - t = parseTypeSuffix(p, t) - addTypeDef(section, name, t) - -proc parseTrailingDefinedTypes(p: var TParser, section, typ: PNode) = - while p.tok.xkind == pxComma: - getTok(p, nil) - var newTyp = pointer(p, typ) - markTypeIdent(p, newTyp) - var newName = skipIdentExport(p) - newTyp = parseTypeSuffix(p, newTyp) - addTypeDef(section, newName, newTyp) - -proc enumFields(p: var TParser): PNode = - result = newNodeP(nkEnumTy, p) - addSon(result, ast.emptyNode) # enum does not inherit from anything - while true: - var e = skipIdent(p) - if p.tok.xkind == pxAsgn: - getTok(p, e) - var c = constantExpression(p) - var a = e - e = newNodeP(nkEnumFieldDef, p) - addSon(e, a, c) - skipCom(p, e) - - addSon(result, e) - if p.tok.xkind != pxComma: break - getTok(p, e) - # allow trailing comma: - if p.tok.xkind == pxCurlyRi: break - -proc parseTypedefStruct(p: var TParser, result: PNode, isUnion: bool) = - getTok(p, result) - if p.tok.xkind == pxCurlyLe: - var t = parseStruct(p, isUnion) - var origName = p.tok.s - markTypeIdent(p, nil) - var name = skipIdent(p) - addTypeDef(result, structPragmas(p, name, origName), t) - parseTrailingDefinedTypes(p, result, name) - elif p.tok.xkind == pxSymbol: - # name to be defined or type "struct a", we don't know yet: - markTypeIdent(p, nil) - var origName = p.tok.s - var nameOrType = skipIdent(p) - case p.tok.xkind - of pxCurlyLe: - var t = parseStruct(p, isUnion) - if p.tok.xkind == pxSymbol: - # typedef struct tagABC {} abc, *pabc; - # --> abc is a better type name than tagABC! - markTypeIdent(p, nil) - var origName = p.tok.s - var name = skipIdent(p) - addTypeDef(result, structPragmas(p, name, origName), t) - parseTrailingDefinedTypes(p, result, name) - else: - addTypeDef(result, structPragmas(p, nameOrType, origName), t) - of pxSymbol: - # typedef struct a a? - if mangleName(p.tok.s, p) == nameOrType.ident.s: - # ignore the declaration: - getTok(p, nil) - else: - # typedef struct a b; or typedef struct a b[45]; - otherTypeDef(p, result, nameOrType) - else: - otherTypeDef(p, result, nameOrType) - else: - expectIdent(p) - -proc parseTypedefEnum(p: var TParser, result: PNode) = - getTok(p, result) - if p.tok.xkind == pxCurlyLe: - getTok(p, result) - var t = enumFields(p) - eat(p, pxCurlyRi, t) - var origName = p.tok.s - markTypeIdent(p, nil) - var name = skipIdent(p) - addTypeDef(result, enumPragmas(p, exportSym(p, name, origName)), t) - parseTrailingDefinedTypes(p, result, name) - elif p.tok.xkind == pxSymbol: - # name to be defined or type "enum a", we don't know yet: - markTypeIdent(p, nil) - var origName = p.tok.s - var nameOrType = skipIdent(p) - case p.tok.xkind - of pxCurlyLe: - getTok(p, result) - var t = enumFields(p) - eat(p, pxCurlyRi, t) - if p.tok.xkind == pxSymbol: - # typedef enum tagABC {} abc, *pabc; - # --> abc is a better type name than tagABC! - markTypeIdent(p, nil) - var origName = p.tok.s - var name = skipIdent(p) - addTypeDef(result, enumPragmas(p, exportSym(p, name, origName)), t) - parseTrailingDefinedTypes(p, result, name) - else: - addTypeDef(result, - enumPragmas(p, exportSym(p, nameOrType, origName)), t) - of pxSymbol: - # typedef enum a a? - if mangleName(p.tok.s, p) == nameOrType.ident.s: - # ignore the declaration: - getTok(p, nil) - else: - # typedef enum a b; or typedef enum a b[45]; - otherTypeDef(p, result, nameOrType) - else: - otherTypeDef(p, result, nameOrType) - else: - expectIdent(p) - -proc parseTypeDef(p: var TParser): PNode = - result = newNodeP(nkTypeSection, p) - while p.tok.xkind == pxSymbol and p.tok.s == "typedef": - getTok(p, result) - inc(p.inTypeDef) - expectIdent(p) - case p.tok.s - of "struct": parseTypedefStruct(p, result, isUnion=false) - of "union": parseTypedefStruct(p, result, isUnion=true) - of "enum": parseTypedefEnum(p, result) - else: - var t = typeAtom(p) - otherTypeDef(p, result, t) - eat(p, pxSemicolon) - dec(p.inTypeDef) - -proc skipDeclarationSpecifiers(p: var TParser) = - while p.tok.xkind == pxSymbol: - case p.tok.s - of "extern", "static", "auto", "register", "const", "volatile": - getTok(p, nil) - else: break - -proc parseInitializer(p: var TParser): PNode = - if p.tok.xkind == pxCurlyLe: - result = newNodeP(nkBracket, p) - getTok(p, result) - while p.tok.xkind notin {pxEof, pxCurlyRi}: - addSon(result, parseInitializer(p)) - opt(p, pxComma, nil) - eat(p, pxCurlyRi, result) - else: - result = assignmentExpression(p) - -proc addInitializer(p: var TParser, def: PNode) = - if p.tok.xkind == pxAsgn: - getTok(p, def) - addSon(def, parseInitializer(p)) - else: - addSon(def, ast.emptyNode) - -proc parseVarDecl(p: var TParser, baseTyp, typ: PNode, - origName: string): PNode = - result = newNodeP(nkVarSection, p) - var def = newNodeP(nkIdentDefs, p) - addSon(def, varIdent(origName, p)) - addSon(def, parseTypeSuffix(p, typ)) - addInitializer(p, def) - addSon(result, def) - - while p.tok.xkind == pxComma: - getTok(p, def) - var t = pointer(p, baseTyp) - expectIdent(p) - def = newNodeP(nkIdentDefs, p) - addSon(def, varIdent(p.tok.s, p)) - getTok(p, def) - addSon(def, parseTypeSuffix(p, t)) - addInitializer(p, def) - addSon(result, def) - eat(p, pxSemicolon) - -when false: - proc declaration(p: var TParser, father: PNode) = - # general syntax to parse is:: - # - # baseType ::= typeIdent | ((struct|union|enum) ident ("{" body "}" )? - # | "{" body "}") - # declIdent ::= "(" "*" ident ")" formalParams ("=" exprNoComma)? - # | ident ((formalParams ("{" statements "}")?)|"=" - # exprNoComma|(typeSuffix("=" exprNoComma)? ))? - # declaration ::= baseType (pointers)? declIdent ("," declIdent)* - var pragmas = newNodeP(nkPragma, p) - - skipDeclarationSpecifiers(p) - parseCallConv(p, pragmas) - skipDeclarationSpecifiers(p) - expectIdent(p) - -proc declaration(p: var TParser): PNode = - result = newNodeP(nkProcDef, p) - var pragmas = newNodeP(nkPragma, p) - - skipDeclarationSpecifiers(p) - parseCallConv(p, pragmas) - skipDeclarationSpecifiers(p) - expectIdent(p) - var baseTyp = typeAtom(p) - var rettyp = pointer(p, baseTyp) - skipDeclarationSpecifiers(p) - parseCallConv(p, pragmas) - skipDeclarationSpecifiers(p) - - if p.tok.xkind == pxParLe: - # Function pointer declaration: This is of course only a heuristic, but the - # best we can do here. - result = parseFunctionPointerDecl(p, rettyp) - eat(p, pxSemicolon) - return - ExpectIdent(p) - var origName = p.tok.s - getTok(p) # skip identifier - case p.tok.xkind - of pxParLe: - # really a function! - var name = mangledIdent(origName, p) - var params = newNodeP(nkFormalParams, p) - addReturnType(params, rettyp) - parseFormalParams(p, params, pragmas) - - if pfCDecl in p.options.flags: - addSon(pragmas, newIdentNodeP("cdecl", p)) - elif pfStdcall in p.options.flags: - addSon(pragmas, newIdentNodeP("stdcall", p)) - addSon(result, exportSym(p, name, origName), ast.emptyNode) # no generics - addSon(result, params, pragmas) - case p.tok.xkind - of pxSemicolon: - getTok(p) - addSon(result, ast.emptyNode) # nobody - if p.scopeCounter == 0: DoImport(origName, pragmas, p) - of pxCurlyLe: - addSon(result, compoundStatement(p)) - else: - parMessage(p, errTokenExpected, ";") - if sonsLen(result.sons[pragmasPos]) == 0: - result.sons[pragmasPos] = ast.emptyNode - of pxAsgn, pxSemicolon, pxComma: - result = parseVarDecl(p, baseTyp, rettyp, origName) - else: - parMessage(p, errTokenExpected, ";") - assert result != nil - -proc createConst(name, typ, val: PNode, p: TParser): PNode = - result = newNodeP(nkConstDef, p) - addSon(result, name, typ, val) - -proc enumSpecifier(p: var TParser): PNode = - saveContext(p) - getTok(p, nil) # skip "enum" - case p.tok.xkind - of pxCurlyLe: - closeContext(p) - # make a const section out of it: - result = newNodeP(nkConstSection, p) - getTok(p, result) - var i = 0 - while true: - var name = skipIdentExport(p) - var val: PNode - if p.tok.xkind == pxAsgn: - getTok(p, name) - val = constantExpression(p) - if val.kind == nkIntLit: i = int(val.intVal)+1 - else: parMessage(p, errXExpected, "int literal") - else: - val = newIntNodeP(nkIntLit, i, p) - inc(i) - var c = createConst(name, ast.emptyNode, val, p) - addSon(result, c) - if p.tok.xkind != pxComma: break - getTok(p, c) - # allow trailing comma: - if p.tok.xkind == pxCurlyRi: break - eat(p, pxCurlyRi, result) - eat(p, pxSemicolon) - of pxSymbol: - var origName = p.tok.s - markTypeIdent(p, nil) - result = skipIdent(p) - case p.tok.xkind - of pxCurlyLe: - closeContext(p) - var name = result - # create a type section containing the enum - result = newNodeP(nkTypeSection, p) - var t = newNodeP(nkTypeDef, p) - getTok(p, t) - var e = enumFields(p) - addSon(t, exportSym(p, name, origName), ast.emptyNode, e) - addSon(result, t) - eat(p, pxCurlyRi, result) - eat(p, pxSemicolon) - of pxSemicolon: - # just ignore ``enum X;`` for now. - closeContext(p) - getTok(p, nil) - else: - backtrackContext(p) - result = declaration(p) - else: - closeContext(p) - parMessage(p, errTokenExpected, "{") - result = ast.emptyNode - -# Expressions - -proc setBaseFlags(n: PNode, base: TNumericalBase) = - case base - of base10: nil - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) - -proc unaryExpression(p: var TParser): PNode - -proc isDefinitelyAType(p: var TParser): bool = - var starFound = false - var words = 0 - while true: - case p.tok.xkind - of pxSymbol: - if declKeyword(p.tok.s): return true - elif starFound: return false - else: inc(words) - of pxStar: - starFound = true - of pxParRi: return words == 0 or words > 1 or starFound - else: return false - getTok(p, nil) - -proc castExpression(p: var TParser): PNode = - if p.tok.xkind == pxParLe: - saveContext(p) - result = newNodeP(nkCast, p) - getTok(p, result) - var t = isDefinitelyAType(p) - backtrackContext(p) - if t: - eat(p, pxParLe, result) - var a = typeDesc(p) - eat(p, pxParRi, result) - addSon(result, a) - addSon(result, castExpression(p)) - else: - # else it is just an expression in (): - result = newNodeP(nkPar, p) - eat(p, pxParLe, result) - addSon(result, expression(p)) - if p.tok.xkind != pxParRi: - # ugh, it is a cast, even though it does not look like one: - result.kind = nkCast - addSon(result, castExpression(p)) - eat(p, pxParRi, result) - #result = unaryExpression(p) - else: - result = unaryExpression(p) - -proc primaryExpression(p: var TParser): PNode = - case p.tok.xkind - of pxSymbol: - if p.tok.s == "NULL": - result = newNodeP(nkNilLit, p) - else: - result = mangledIdent(p.tok.s, p) - getTok(p, result) - of pxIntLit: - result = newIntNodeP(nkIntLit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p, result) - of pxInt64Lit: - result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p, result) - of pxFloatLit: - result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p, result) - of pxStrLit: - # Ansi C allows implicit string literal concatenations: - result = newStrNodeP(nkStrLit, p.tok.s, p) - getTok(p, result) - while p.tok.xkind == pxStrLit: - add(result.strVal, p.tok.s) - getTok(p, result) - of pxCharLit: - result = newIntNodeP(nkCharLit, ord(p.tok.s[0]), p) - getTok(p, result) - of pxParLe: - result = castExpression(p) - else: - result = ast.emptyNode - -proc multiplicativeExpression(p: var TParser): PNode = - result = castExpression(p) - while true: - case p.tok.xkind - of pxStar: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("*", p), a) - getTok(p, result) - var b = castExpression(p) - addSon(result, b) - of pxSlash: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("div", p), a) - getTok(p, result) - var b = castExpression(p) - addSon(result, b) - of pxMod: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("mod", p), a) - getTok(p, result) - var b = castExpression(p) - addSon(result, b) - else: break - -proc additiveExpression(p: var TParser): PNode = - result = multiplicativeExpression(p) - while true: - case p.tok.xkind - of pxPlus: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("+", p), a) - getTok(p, result) - var b = multiplicativeExpression(p) - addSon(result, b) - of pxMinus: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("-", p), a) - getTok(p, result) - var b = multiplicativeExpression(p) - addSon(result, b) - else: break - -proc incdec(p: var TParser, opr: string): PNode = - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP(opr, p)) - gettok(p, result) - addSon(result, unaryExpression(p)) - -proc unaryOp(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p, result) - addSon(result, castExpression(p)) - -proc prefixCall(p: var TParser, opr: string): PNode = - result = newNodeP(nkPrefix, p) - addSon(result, newIdentNodeP(opr, p)) - gettok(p, result) - addSon(result, castExpression(p)) - -proc postfixExpression(p: var TParser): PNode = - result = primaryExpression(p) - while true: - case p.tok.xkind - of pxBracketLe: - var a = result - result = newNodeP(nkBracketExpr, p) - addSon(result, a) - getTok(p, result) - var b = expression(p) - addSon(result, b) - eat(p, pxBracketRi, result) - of pxParLe: - var a = result - result = newNodeP(nkCall, p) - addSon(result, a) - getTok(p, result) - if p.tok.xkind != pxParRi: - a = assignmentExpression(p) - addSon(result, a) - while p.tok.xkind == pxComma: - getTok(p, a) - a = assignmentExpression(p) - addSon(result, a) - eat(p, pxParRi, result) - of pxDot, pxArrow: - var a = result - result = newNodeP(nkDotExpr, p) - addSon(result, a) - getTok(p, result) - addSon(result, skipIdent(p)) - of pxPlusPlus: - var a = result - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("inc", p)) - gettok(p, result) - addSon(result, a) - of pxMinusMinus: - var a = result - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("dec", p)) - gettok(p, result) - addSon(result, a) - else: break - -proc unaryExpression(p: var TParser): PNode = - case p.tok.xkind - of pxPlusPlus: result = incdec(p, "inc") - of pxMinusMinus: result = incdec(p, "dec") - of pxAmp: result = unaryOp(p, nkAddr) - of pxStar: result = unaryOp(p, nkBracketExpr) - of pxPlus: result = prefixCall(p, "+") - of pxMinus: result = prefixCall(p, "-") - of pxTilde: result = prefixCall(p, "not") - of pxNot: result = prefixCall(p, "not") - of pxSymbol: - if p.tok.s == "sizeof": - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("sizeof", p)) - getTok(p, result) - if p.tok.xkind == pxParLe: - getTok(p, result) - addson(result, typeDesc(p)) - eat(p, pxParRi, result) - else: - addSon(result, unaryExpression(p)) - else: - result = postfixExpression(p) - else: result = postfixExpression(p) - -proc expression(p: var TParser): PNode = - # we cannot support C's ``,`` operator - result = assignmentExpression(p) - if p.tok.xkind == pxComma: - getTok(p, result) - parMessage(p, errOperatorExpected, ",") - -proc conditionalExpression(p: var TParser): PNode - -proc constantExpression(p: var TParser): PNode = - result = conditionalExpression(p) - -proc lvalue(p: var TParser): PNode = - result = unaryExpression(p) - -proc asgnExpr(p: var TParser, opr: string, a: PNode): PNode = - closeContext(p) - getTok(p, a) - var b = assignmentExpression(p) - result = newNodeP(nkAsgn, p) - addSon(result, a, newBinary(opr, copyTree(a), b, p)) - -proc incdec(p: var TParser, opr: string, a: PNode): PNode = - closeContext(p) - getTok(p, a) - var b = assignmentExpression(p) - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP(getIdent(opr), p), a, b) - -proc assignmentExpression(p: var TParser): PNode = - saveContext(p) - var a = lvalue(p) - case p.tok.xkind - of pxAsgn: - closeContext(p) - getTok(p, a) - var b = assignmentExpression(p) - result = newNodeP(nkAsgn, p) - addSon(result, a, b) - of pxPlusAsgn: result = incDec(p, "inc", a) - of pxMinusAsgn: result = incDec(p, "dec", a) - of pxStarAsgn: result = asgnExpr(p, "*", a) - of pxSlashAsgn: result = asgnExpr(p, "/", a) - of pxModAsgn: result = asgnExpr(p, "mod", a) - of pxShlAsgn: result = asgnExpr(p, "shl", a) - of pxShrAsgn: result = asgnExpr(p, "shr", a) - of pxAmpAsgn: result = asgnExpr(p, "and", a) - of pxHatAsgn: result = asgnExpr(p, "xor", a) - of pxBarAsgn: result = asgnExpr(p, "or", a) - else: - backtrackContext(p) - result = conditionalExpression(p) - -proc shiftExpression(p: var TParser): PNode = - result = additiveExpression(p) - while p.tok.xkind in {pxShl, pxShr}: - var op = if p.tok.xkind == pxShl: "shl" else: "shr" - getTok(p, result) - var a = result - var b = additiveExpression(p) - result = newBinary(op, a, b, p) - -proc relationalExpression(p: var TParser): PNode = - result = shiftExpression(p) - # Nimrod uses ``<`` and ``<=``, etc. too: - while p.tok.xkind in {pxLt, pxLe, pxGt, pxGe}: - var op = TokKindToStr(p.tok.xkind) - getTok(p, result) - var a = result - var b = shiftExpression(p) - result = newBinary(op, a, b, p) - -proc equalityExpression(p: var TParser): PNode = - result = relationalExpression(p) - # Nimrod uses ``==`` and ``!=`` too: - while p.tok.xkind in {pxEquals, pxNeq}: - var op = TokKindToStr(p.tok.xkind) - getTok(p, result) - var a = result - var b = relationalExpression(p) - result = newBinary(op, a, b, p) - -proc andExpression(p: var TParser): PNode = - result = equalityExpression(p) - while p.tok.xkind == pxAmp: - getTok(p, result) - var a = result - var b = equalityExpression(p) - result = newBinary("and", a, b, p) - -proc exclusiveOrExpression(p: var TParser): PNode = - result = andExpression(p) - while p.tok.xkind == pxHat: - getTok(p, result) - var a = result - var b = andExpression(p) - result = newBinary("^", a, b, p) - -proc inclusiveOrExpression(p: var TParser): PNode = - result = exclusiveOrExpression(p) - while p.tok.xkind == pxBar: - getTok(p, result) - var a = result - var b = exclusiveOrExpression(p) - result = newBinary("or", a, b, p) - -proc logicalAndExpression(p: var TParser): PNode = - result = inclusiveOrExpression(p) - while p.tok.xkind == pxAmpAmp: - getTok(p, result) - var a = result - var b = inclusiveOrExpression(p) - result = newBinary("and", a, b, p) - -proc logicalOrExpression(p: var TParser): PNode = - result = logicalAndExpression(p) - while p.tok.xkind == pxBarBar: - getTok(p, result) - var a = result - var b = logicalAndExpression(p) - result = newBinary("or", a, b, p) - -proc conditionalExpression(p: var TParser): PNode = - result = logicalOrExpression(p) - if p.tok.xkind == pxConditional: - getTok(p, result) # skip '?' - var a = result - var b = expression(p) - eat(p, pxColon, b) - var c = conditionalExpression(p) - result = newNodeP(nkIfExpr, p) - var branch = newNodeP(nkElifExpr, p) - addSon(branch, a, b) - addSon(result, branch) - branch = newNodeP(nkElseExpr, p) - addSon(branch, c) - addSon(result, branch) - -# Statements - -proc buildStmtList(a: PNode): PNode = - if a.kind == nkStmtList: result = a - else: - result = newNodeI(nkStmtList, a.info) - addSon(result, a) - -proc nestedStatement(p: var TParser): PNode = - # careful: We need to translate: - # if (x) if (y) stmt; - # into: - # if x: - # if x: - # stmt - # - # Nimrod requires complex statements to be nested in whitespace! - const - complexStmt = {nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, - nkTemplateDef, nkIteratorDef, nkMacroStmt, nkIfStmt, - nkWhenStmt, nkForStmt, nkWhileStmt, nkCaseStmt, nkVarSection, - nkConstSection, nkTypeSection, nkTryStmt, nkBlockStmt, nkStmtList, - nkCommentStmt, nkStmtListExpr, nkBlockExpr, nkStmtListType, nkBlockType} - result = statement(p) - if result.kind in complexStmt: - result = buildStmtList(result) - -proc expressionStatement(p: var TParser): PNode = - # do not skip the comment after a semicolon to make a new nkCommentStmt - if p.tok.xkind == pxSemicolon: - getTok(p) - result = ast.emptyNode - else: - result = expression(p) - if p.tok.xkind == pxSemicolon: getTok(p) - else: parMessage(p, errTokenExpected, ";") - assert result != nil - -proc parseIf(p: var TParser): PNode = - # we parse additional "else if"s too here for better Nimrod code - result = newNodeP(nkIfStmt, p) - while true: - getTok(p) # skip ``if`` - var branch = newNodeP(nkElifBranch, p) - skipCom(p, branch) - eat(p, pxParLe, branch) - addSon(branch, expression(p)) - eat(p, pxParRi, branch) - addSon(branch, nestedStatement(p)) - addSon(result, branch) - if p.tok.s == "else": - getTok(p, result) - if p.tok.s != "if": - # ordinary else part: - branch = newNodeP(nkElse, p) - addSon(branch, nestedStatement(p)) - addSon(result, branch) - break - else: - break - -proc parseWhile(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p, result) - eat(p, pxParLe, result) - addSon(result, expression(p)) - eat(p, pxParRi, result) - addSon(result, nestedStatement(p)) - -proc parseDoWhile(p: var TParser): PNode = - # we only support ``do stmt while (0)`` as an idiom for - # ``block: stmt`` - result = newNodeP(nkBlockStmt, p) - getTok(p, result) # skip "do" - addSon(result, ast.emptyNode, nestedStatement(p)) - eat(p, "while", result) - eat(p, pxParLe, result) - if p.tok.xkind == pxIntLit and p.tok.iNumber == 0: getTok(p, result) - else: parMessage(p, errTokenExpected, "0") - eat(p, pxParRi, result) - if p.tok.xkind == pxSemicolon: getTok(p) - -proc declarationOrStatement(p: var TParser): PNode = - if p.tok.xkind != pxSymbol: - result = expressionStatement(p) - elif declKeyword(p.tok.s): - result = declaration(p) - else: - # ordinary identifier: - saveContext(p) - getTok(p) # skip identifier to look ahead - case p.tok.xkind - of pxSymbol, pxStar: - # we parse - # a b - # a * b - # always as declarations! This is of course not correct, but good - # enough for most real world C code out there. - backtrackContext(p) - result = declaration(p) - of pxColon: - # it is only a label: - closeContext(p) - getTok(p) - result = statement(p) - else: - backtrackContext(p) - result = expressionStatement(p) - assert result != nil - -proc parseTuple(p: var TParser, isUnion: bool): PNode = - result = parseStructBody(p, isUnion, nkTupleTy) - -proc parseTrailingDefinedIdents(p: var TParser, result, baseTyp: PNode) = - var varSection = newNodeP(nkVarSection, p) - while p.tok.xkind notin {pxEof, pxSemicolon}: - var t = pointer(p, baseTyp) - expectIdent(p) - var def = newNodeP(nkIdentDefs, p) - addSon(def, varIdent(p.tok.s, p)) - getTok(p, def) - addSon(def, parseTypeSuffix(p, t)) - addInitializer(p, def) - addSon(varSection, def) - if p.tok.xkind != pxComma: break - getTok(p, def) - eat(p, pxSemicolon) - if sonsLen(varSection) > 0: - addSon(result, varSection) - -proc parseStandaloneStruct(p: var TParser, isUnion: bool): PNode = - result = newNodeP(nkStmtList, p) - saveContext(p) - getTok(p, result) # skip "struct" or "union" - var origName = "" - if p.tok.xkind == pxSymbol: - markTypeIdent(p, nil) - origName = p.tok.s - getTok(p, result) - if p.tok.xkind in {pxCurlyLe, pxSemiColon}: - if origName.len > 0: - var name = mangledIdent(origName, p) - var t = parseStruct(p, isUnion) - var typeSection = newNodeP(nkTypeSection, p) - addTypeDef(typeSection, structPragmas(p, name, origName), t) - addSon(result, typeSection) - parseTrailingDefinedIdents(p, result, name) - else: - var t = parseTuple(p, isUnion) - parseTrailingDefinedIdents(p, result, t) - else: - backtrackContext(p) - result = declaration(p) - -proc parseFor(p: var TParser, result: PNode) = - # 'for' '(' expression_statement expression_statement expression? ')' - # statement - getTok(p, result) - eat(p, pxParLe, result) - var initStmt = declarationOrStatement(p) - if initStmt.kind != nkEmpty: - addSon(result, initStmt) - var w = newNodeP(nkWhileStmt, p) - var condition = expressionStatement(p) - if condition.kind == nkEmpty: condition = newIdentNodeP("true", p) - addSon(w, condition) - var step = if p.tok.xkind != pxParRi: expression(p) else: ast.emptyNode - eat(p, pxParRi, step) - var loopBody = nestedStatement(p) - if step.kind != nkEmpty: - loopBody = buildStmtList(loopBody) - addSon(loopBody, step) - addSon(w, loopBody) - addSon(result, w) - -proc switchStatement(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while true: - if p.tok.xkind in {pxEof, pxCurlyRi}: break - case p.tok.s - of "break": - getTok(p, result) - eat(p, pxSemicolon, result) - break - of "return", "continue", "goto": - addSon(result, statement(p)) - break - of "case", "default": - break - else: nil - addSon(result, statement(p)) - if sonsLen(result) == 0: - # translate empty statement list to Nimrod's ``nil`` statement - result = newNodeP(nkNilLit, p) - -proc rangeExpression(p: var TParser): PNode = - # We support GCC's extension: ``case expr...expr:`` - result = constantExpression(p) - if p.tok.xkind == pxDotDotDot: - getTok(p, result) - var a = result - var b = constantExpression(p) - result = newNodeP(nkRange, p) - addSon(result, a) - addSon(result, b) - -proc parseSwitch(p: var TParser): PNode = - # We cannot support Duff's device or C's crazy switch syntax. We just support - # sane usages of switch. ;-) - result = newNodeP(nkCaseStmt, p) - getTok(p, result) - eat(p, pxParLe, result) - addSon(result, expression(p)) - eat(p, pxParRi, result) - eat(p, pxCurlyLe, result) - var b: PNode - while (p.tok.xkind != pxCurlyRi) and (p.tok.xkind != pxEof): - case p.tok.s - of "default": - b = newNodeP(nkElse, p) - getTok(p, b) - eat(p, pxColon, b) - of "case": - b = newNodeP(nkOfBranch, p) - while p.tok.xkind == pxSymbol and p.tok.s == "case": - getTok(p, b) - addSon(b, rangeExpression(p)) - eat(p, pxColon, b) - else: - parMessage(p, errXExpected, "case") - addSon(b, switchStatement(p)) - addSon(result, b) - if b.kind == nkElse: break - eat(p, pxCurlyRi) - -proc addStmt(sl, a: PNode) = - # merge type sections is possible: - if a.kind != nkTypeSection or sonsLen(sl) == 0 or - lastSon(sl).kind != nkTypeSection: - addSon(sl, a) - else: - var ts = lastSon(sl) - for i in 0..sonsLen(a)-1: addSon(ts, a.sons[i]) - -proc embedStmts(sl, a: PNode) = - if a.kind != nkStmtList: - addStmt(sl, a) - else: - for i in 0..sonsLen(a)-1: - if a[i].kind != nkEmpty: addStmt(sl, a[i]) - -proc compoundStatement(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - eat(p, pxCurlyLe) - inc(p.scopeCounter) - while p.tok.xkind notin {pxEof, pxCurlyRi}: - var a = statement(p) - if a.kind == nkEmpty: break - embedStmts(result, a) - if sonsLen(result) == 0: - # translate ``{}`` to Nimrod's ``nil`` statement - result = newNodeP(nkNilLit, p) - dec(p.scopeCounter) - eat(p, pxCurlyRi) - -include cpp - -proc statement(p: var TParser): PNode = - case p.tok.xkind - of pxSymbol: - case p.tok.s - of "if": result = parseIf(p) - of "switch": result = parseSwitch(p) - of "while": result = parseWhile(p) - of "do": result = parseDoWhile(p) - of "for": - result = newNodeP(nkStmtList, p) - parseFor(p, result) - of "goto": - # we cannot support "goto"; in hand-written C, "goto" is most often used - # to break a block, so we convert it to a break statement with label. - result = newNodeP(nkBreakStmt, p) - getTok(p) - addSon(result, skipIdent(p)) - eat(p, pxSemicolon) - of "continue": - result = newNodeP(nkContinueStmt, p) - getTok(p) - eat(p, pxSemicolon) - addSon(result, ast.emptyNode) - of "break": - result = newNodeP(nkBreakStmt, p) - getTok(p) - eat(p, pxSemicolon) - addSon(result, ast.emptyNode) - of "return": - result = newNodeP(nkReturnStmt, p) - getTok(p) - # special case for ``return (expr)`` because I hate the redundant - # parenthesis ;-) - if p.tok.xkind == pxParLe: - getTok(p, result) - addSon(result, expression(p)) - eat(p, pxParRi, result) - elif p.tok.xkind != pxSemicolon: - addSon(result, expression(p)) - else: - addSon(result, ast.emptyNode) - eat(p, pxSemicolon) - of "enum": result = enumSpecifier(p) - of "typedef": result = parseTypeDef(p) - of "struct": result = parseStandaloneStruct(p, isUnion=false) - of "union": result = parseStandaloneStruct(p, isUnion=true) - else: result = declarationOrStatement(p) - of pxCurlyLe: - result = compoundStatement(p) - of pxDirective, pxDirectiveParLe: - result = parseDir(p) - of pxLineComment, pxStarComment: - result = newNodeP(nkCommentStmt, p) - skipCom(p, result) - of pxSemicolon: - # empty statement: - getTok(p) - if p.tok.xkind in {pxLineComment, pxStarComment}: - result = newNodeP(nkCommentStmt, p) - skipCom(p, result) - else: - result = newNodeP(nkNilLit, p) - else: - result = expressionStatement(p) - assert result != nil - -proc parseUnit(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - getTok(p) # read first token - while p.tok.xkind != pxEof: - var s = statement(p) - if s.kind != nkEmpty: embedStmts(result, s) - diff --git a/rod/c2nim/cpp.nim b/rod/c2nim/cpp.nim deleted file mode 100755 index 61b91e4de..000000000 --- a/rod/c2nim/cpp.nim +++ /dev/null @@ -1,344 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Preprocessor support - -const - c2nimSymbol = "C2NIM" - -proc eatNewLine(p: var TParser, n: PNode) = - if p.tok.xkind == pxLineComment: - skipCom(p, n) - if p.tok.xkind == pxNewLine: getTok(p) - elif p.tok.xkind == pxNewLine: - eat(p, pxNewLine) - -proc skipLine(p: var TParser) = - while p.tok.xkind notin {pxEof, pxNewLine, pxLineComment}: getTok(p) - eatNewLine(p, nil) - -proc parseDefineBody(p: var TParser, tmplDef: PNode): string = - if p.tok.xkind == pxCurlyLe or - (p.tok.xkind == pxSymbol and ( - declKeyword(p.tok.s) or stmtKeyword(p.tok.s))): - addSon(tmplDef, statement(p)) - result = "stmt" - elif p.tok.xkind in {pxLineComment, pxNewLine}: - addSon(tmplDef, buildStmtList(newNodeP(nkNilLit, p))) - result = "stmt" - else: - addSon(tmplDef, buildStmtList(expression(p))) - result = "expr" - -proc parseDefine(p: var TParser): PNode = - if p.tok.xkind == pxDirectiveParLe: - # a macro with parameters: - result = newNodeP(nkTemplateDef, p) - getTok(p) - addSon(result, skipIdentExport(p)) - eat(p, pxParLe) - var params = newNodeP(nkFormalParams, p) - # return type; not known yet: - addSon(params, ast.emptyNode) - var identDefs = newNodeP(nkIdentDefs, p) - while p.tok.xkind != pxParRi: - addSon(identDefs, skipIdent(p)) - skipStarCom(p, nil) - if p.tok.xkind != pxComma: break - getTok(p) - addSon(identDefs, newIdentNodeP("expr", p)) - addSon(identDefs, ast.emptyNode) - addSon(params, identDefs) - eat(p, pxParRi) - - addSon(result, ast.emptyNode) # no generic parameters - addSon(result, params) - addSon(result, ast.emptyNode) # no pragmas - var kind = parseDefineBody(p, result) - params.sons[0] = newIdentNodeP(kind, p) - eatNewLine(p, result) - else: - # a macro without parameters: - result = newNodeP(nkConstSection, p) - while p.tok.xkind == pxDirective and p.tok.s == "define": - getTok(p) # skip #define - var c = newNodeP(nkConstDef, p) - addSon(c, skipIdentExport(p)) - addSon(c, ast.emptyNode) - skipStarCom(p, c) - if p.tok.xkind in {pxLineComment, pxNewLine, pxEof}: - addSon(c, newIdentNodeP("true", p)) - else: - addSon(c, expression(p)) - addSon(result, c) - eatNewLine(p, c) - assert result != nil - -proc parseDefBody(p: var TParser, m: var TMacro, params: seq[string]) = - m.body = @[] - # A little hack: We safe the context, so that every following token will be - # put into a newly allocated TToken object. Thus we can just save a - # reference to the token in the macro's body. - saveContext(p) - while p.tok.xkind notin {pxEof, pxNewLine, pxLineComment}: - case p.tok.xkind - of pxSymbol: - # is it a parameter reference? - var tok = p.tok - for i in 0..high(params): - if params[i] == p.tok.s: - new(tok) - tok.xkind = pxMacroParam - tok.iNumber = i - break - m.body.add(tok) - of pxDirConc: - # just ignore this token: this implements token merging correctly - nil - else: - m.body.add(p.tok) - # we do not want macro expansion here: - rawGetTok(p) - eatNewLine(p, nil) - closeContext(p) - # newline token might be overwritten, but this is not - # part of the macro body, so it is safe. - -proc parseDef(p: var TParser, m: var TMacro) = - var hasParams = p.tok.xkind == pxDirectiveParLe - getTok(p) - expectIdent(p) - m.name = p.tok.s - getTok(p) - var params: seq[string] = @[] - # parse parameters: - if hasParams: - eat(p, pxParLe) - while p.tok.xkind != pxParRi: - expectIdent(p) - params.add(p.tok.s) - getTok(p) - skipStarCom(p, nil) - if p.tok.xkind != pxComma: break - getTok(p) - eat(p, pxParRi) - m.params = params.len - parseDefBody(p, m, params) - -proc isDir(p: TParser, dir: string): bool = - result = p.tok.xkind in {pxDirectiveParLe, pxDirective} and p.tok.s == dir - -proc parseInclude(p: var TParser): PNode = - result = newNodeP(nkImportStmt, p) - while isDir(p, "include"): - getTok(p) # skip "include" - if p.tok.xkind == pxStrLit and pfSkipInclude notin p.options.flags: - var file = newStrNodeP(nkStrLit, changeFileExt(p.tok.s, ""), p) - addSon(result, file) - getTok(p) - skipStarCom(p, file) - eatNewLine(p, nil) - else: - skipLine(p) - if sonsLen(result) == 0: - # we only parsed includes that we chose to ignore: - result = ast.emptyNode - -proc definedExprAux(p: var TParser): PNode = - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("defined", p)) - addSon(result, skipIdent(p)) - -proc parseStmtList(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while true: - case p.tok.xkind - of pxEof: break - of pxDirectiveParLe, pxDirective: - case p.tok.s - of "else", "endif", "elif": break - else: nil - addSon(result, statement(p)) - -proc eatEndif(p: var TParser) = - if isDir(p, "endif"): - skipLine(p) - else: - parMessage(p, errXExpected, "#endif") - -proc parseIfDirAux(p: var TParser, result: PNode) = - addSon(result.sons[0], parseStmtList(p)) - while isDir(p, "elif"): - var b = newNodeP(nkElifBranch, p) - getTok(p) - addSon(b, expression(p)) - eatNewLine(p, nil) - addSon(b, parseStmtList(p)) - addSon(result, b) - if isDir(p, "else"): - var s = newNodeP(nkElse, p) - skipLine(p) - addSon(s, parseStmtList(p)) - addSon(result, s) - eatEndif(p) - -proc skipUntilEndif(p: var TParser) = - var nested = 1 - while p.tok.xkind != pxEof: - if isDir(p, "ifdef") or isDir(p, "ifndef") or isDir(p, "if"): - inc(nested) - elif isDir(p, "endif"): - dec(nested) - if nested <= 0: - skipLine(p) - return - getTok(p) - parMessage(p, errXExpected, "#endif") - -type - TEndifMarker = enum - emElif, emElse, emEndif - -proc skipUntilElifElseEndif(p: var TParser): TEndifMarker = - var nested = 1 - while p.tok.xkind != pxEof: - if isDir(p, "ifdef") or isDir(p, "ifndef") or isDir(p, "if"): - inc(nested) - elif isDir(p, "elif") and nested <= 1: - return emElif - elif isDir(p, "else") and nested <= 1: - return emElse - elif isDir(p, "endif"): - dec(nested) - if nested <= 0: - return emEndif - getTok(p) - parMessage(p, errXExpected, "#endif") - -proc parseIfdef(p: var TParser): PNode = - getTok(p) # skip #ifdef - ExpectIdent(p) - case p.tok.s - of "__cplusplus": - skipUntilEndif(p) - result = ast.emptyNode - of c2nimSymbol: - skipLine(p) - result = parseStmtList(p) - skipUntilEndif(p) - else: - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - addSon(result.sons[0], definedExprAux(p)) - eatNewLine(p, nil) - parseIfDirAux(p, result) - -proc parseIfndef(p: var TParser): PNode = - result = ast.emptyNode - getTok(p) # skip #ifndef - ExpectIdent(p) - if p.tok.s == c2nimSymbol: - skipLine(p) - case skipUntilElifElseEndif(p) - of emElif: - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], expression(p)) - eatNewLine(p, nil) - parseIfDirAux(p, result) - of emElse: - skipLine(p) - result = parseStmtList(p) - eatEndif(p) - of emEndif: skipLine(p) - else: - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - var e = newNodeP(nkCall, p) - addSon(e, newIdentNodeP("not", p)) - addSon(e, definedExprAux(p)) - eatNewLine(p, nil) - addSon(result.sons[0], e) - parseIfDirAux(p, result) - -proc parseIfDir(p: var TParser): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], expression(p)) - eatNewLine(p, nil) - parseIfDirAux(p, result) - -proc parsePegLit(p: var TParser): TPeg = - var col = getColumn(p.lex) + 2 - getTok(p) - if p.tok.xkind != pxStrLit: ExpectIdent(p) - try: - result = parsePeg( - pattern = if p.tok.xkind == pxStrLit: p.tok.s else: escapePeg(p.tok.s), - filename = p.lex.filename, - line = p.lex.linenumber, - col = col) - getTok(p) - except EInvalidPeg: - parMessage(p, errUser, getCurrentExceptionMsg()) - -proc parseMangleDir(p: var TParser) = - var pattern = parsePegLit(p) - if p.tok.xkind != pxStrLit: ExpectIdent(p) - p.options.mangleRules.add((pattern, p.tok.s)) - getTok(p) - eatNewLine(p, nil) - -proc modulePragmas(p: var TParser): PNode = - if p.options.dynlibSym.len > 0 and not p.hasDeadCodeElimPragma: - p.hasDeadCodeElimPragma = true - result = newNodeP(nkPragma, p) - var e = newNodeP(nkExprColonExpr, p) - addSon(e, newIdentNodeP("deadCodeElim", p), newIdentNodeP("on", p)) - addSon(result, e) - else: - result = ast.emptyNode - -proc parseDir(p: var TParser): PNode = - result = ast.emptyNode - assert(p.tok.xkind in {pxDirective, pxDirectiveParLe}) - case p.tok.s - of "define": result = parseDefine(p) - of "include": result = parseInclude(p) - of "ifdef": result = parseIfdef(p) - of "ifndef": result = parseIfndef(p) - of "if": result = parseIfDir(p) - of "cdecl", "stdcall", "ref", "skipinclude", "typeprefixes", "skipcomments": - discard setOption(p.options, p.tok.s) - getTok(p) - eatNewLine(p, nil) - of "dynlib", "header", "prefix", "suffix": - var key = p.tok.s - getTok(p) - if p.tok.xkind != pxStrLit: ExpectIdent(p) - discard setOption(p.options, key, p.tok.s) - getTok(p) - eatNewLine(p, nil) - result = modulePragmas(p) - of "mangle": - parseMangleDir(p) - of "def": - var L = p.options.macros.len - setLen(p.options.macros, L+1) - parseDef(p, p.options.macros[L]) - of "private": - var pattern = parsePegLit(p) - p.options.privateRules.add(pattern) - eatNewLine(p, nil) - else: - # ignore unimportant/unknown directive ("undef", "pragma", "error") - skipLine(p) - diff --git a/rod/c2nim/tests/systest.c b/rod/c2nim/tests/systest.c deleted file mode 100755 index 4ba1d9044..000000000 --- a/rod/c2nim/tests/systest.c +++ /dev/null @@ -1,601 +0,0 @@ -/* This file has been written by Blablub. - * - * Another comment line. - */ - -#ifdef __cplusplus -# ifdef __SOME_OTHER_CRAP -extern "C" { -# endif -#endif - -typedef void (*callback_t) (int rc); - -int aw_callback_set (AW_CALLBACK c, callback_t callback ); -int aw_instance_callback_set (AW_CALLBACK c, callback_t callback); - -#define AW_BUILD 85 // AW 5.0 -// Limits -#define AW_MAX_AVCHANGE_PER_SECOND 10 - -#private expatDll - -#if !defined(expatDll) -# if defined(windows) -# define expatDll "expat.dll" -# elif defined(macosx) -# define expatDll "libexpat.dynlib" -# else -# define expatDll "libexpat.so(.1|)" -# endif -#endif - -#mangle "'XML_'{.*}" "$1" -#private "'XML_ParserStruct'" - -#mangle cunsignedint cint - -unsigned int uiVar; - -#private "@('_'!.)" -unsigned int myPrivateVar__; - - -struct XML_ParserStruct; - -#def XMLCALL __cdecl - -typedef void (XMLCALL *XML_ElementDeclHandler) (void *userData, - const XML_Char *name, - XML_Content *model); - - -void* x; -void* fn(void); -void (*fn)(void); -void* (*fn)(void); -void* (*fn)(void*); - -/* - * Very ugly real world code ahead: - */ - -#def JMETHOD(rettype, name, params) rettype (*name) params - -typedef struct cjpeg_source_struct * cjpeg_source_ptr; - -struct cjpeg_source_struct { - JMETHOD(void, start_input, (j_compress_ptr cinfo, - cjpeg_source_ptr sinfo)); - JMETHOD(JDIMENSION, get_pixel_rows, (j_compress_ptr cinfo, - cjpeg_source_ptr sinfo)); - JMETHOD(void, finish_input, (j_compress_ptr cinfo, - cjpeg_source_ptr sinfo)); - - FILE *input_file; - - JSAMPARRAY buffer; - JDIMENSION buffer_height; -}; - -// Test standalone structs: - -union myunion { - char x, y, *z; - myint a, b; -} u; - -struct mystruct { - char x, y, *z; - myint a, b; -}; - -struct mystruct fn(i32 x, i64 y); - -struct mystruct { - char x, y, *z; - myint a, b; -} *myvar = NULL, **myvar2 = NULL; - -// anonymous struct: - -struct { - char x, y, *z; - myint a, b; -} varX, **varY; - -// empty anonymous struct: - -struct { - -} varX, **varY; - -// Test C2NIM skipping: - -#define MASK(x) ((x) & 0xff) -#define CAST1(x) ((int) &x) -#define CAST2(x) (typ*) &x -#define CAST3(x) ((const unsigned char**) &x) - -#ifndef C2NIM - #if someNestedCond - This is an invalid text that should generate a parser error, if not - #endif - skipped correctly. -#endif - -#ifndef C2NIM - #if someNestedCond - This is an invalid text that should generate a parser error, if not - #endif - skipped correctly. -#else -typedef char gchar; -typedef unsigned int gunsignedint; -typedef unsigned char guchar; -#endif - -#ifdef C2NIM -# mangle "'those'" "these" -int those; -#elif abc - #if someNestedCond - This is an invalid text that should generate a parser error, if not - #else - skipped correctly. - #endif -#else - Another crappy input line. -#endif - -point* newPoint(void) { - for (int i = 0; i < 89; ++i) echo("test" " string " "concatenation"); - for (; j < 54; j++) {} - for (;; j--) ; - for (;;) {} - mytype * x = y * z; - - if (**p == ' ') { - --p; - } else if (**p == '\t') { - p += 3; - } else { - p = 45 + (mytype*)45; - p = 45 + ((mytype*)45); - p = 45 + ((mytype)45); - // BUG: This does not parse: - // p = 45 + (mytype)45; - } - - while (x >= 6 && x <= 20) - --x; - - switch (*p) { - case 'A'...'Z': - case 'a'...'z': - ++p; - break; - case '0': - ++p; - break; - default: - return NULL; - } -} - -enum { - a1, a2 = 4, a3 -}; - -typedef enum crazyTAG { - x1, x2, x3 = 8, x4, x5 -} myEnum, *pMyEnum; - -typedef enum { - x1, x2, x3 = 8, x4, x5 -} myEnum, *pMyEnum; - -// Test multi-line macro: - -#define MUILTILINE "abc" \ - "xyz" \ - "def" - -#define MULTILINE(x, y) do { \ - ++y; ++x; \ -} while (0) - -#ifdef C2NIM -# dynlib iupdll -# cdecl -# mangle "'GTK_'{.*}" "TGtk$1" -# mangle "'PGTK_'{.*}" "PGtk$1" -# if defined(windows) -# define iupdll "iup.dll" -# elif defined(macosx) -# define iupdll "libiup.dynlib" -# else -# define iupdll "libiup.so" -# endif -#endif - -typedef struct stupidTAG { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -typedef struct { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -int IupConvertXYToPos(PIhandle ih, int x, int y); - -#ifdef DEBUG -# define OUT(x) printf("%s\n", x) -#else -# define OUT(x) -#endif - - - #ifdef C2NIM - # def EXTERN(x) static x - # def TWO_ARGS(x, y) x* y - #endif - // parses now! - EXTERN(int) f(void); - EXTERN(int) g(void); - - - #def EXPORT - // does parse now! - EXPORT int f(void); - EXPORT int g(void); - - static TWO_ARGS(int, x) = TWO_ARGS(56, 45); - - -# define abc 34 -# define xyz 42 - -# define wuseldusel "my string\nconstant" - -#undef ignoreThis - -char* x; - -typedef struct { - char x, y, *z; -} point; - -char* __stdcall printf(char* frmt, const char* const** ptrToStrArray, - const int* const dummy, ...); - -inline char* myinlineProc(char* frmt, const char* const* strArray, - const int* const dummy, ...); - -// Test void parameter list: -void myVoidProc(void); - -void emptyReturn(void) { return; } - -// POSIX stuff: - -#ifdef C2NIM -#prefix posix_ -int c2nimBranch; -#elif defined(MACOSX) -int* x, y, z; -#else -int dummy; -#endif - -#ifndef C2NIM -int dontTranslateThis; -#elif defined(Windows) -int WindowsTrue = true; -#endif - -int posix_spawn(pid_t *restrict, const char *restrict, - const posix_spawn_file_actions_t *, - const posix_spawnattr_t *restrict, char *const [restrict], - char *const [restrict]); -int posix_spawn_file_actions_addclose(posix_spawn_file_actions_t *, - int); -int posix_spawn_file_actions_adddup2(posix_spawn_file_actions_t *, - int, int); -int posix_spawn_file_actions_addopen(posix_spawn_file_actions_t *restrict, - int, const char *restrict, int, mode_t); -int posix_spawn_file_actions_destroy(posix_spawn_file_actions_t *); -int posix_spawn_file_actions_init(posix_spawn_file_actions_t *); -int posix_spawnattr_destroy(posix_spawnattr_t *); -int posix_spawnattr_getsigdefault(const posix_spawnattr_t *restrict, - sigset_t *restrict); -int posix_spawnattr_getflags(const posix_spawnattr_t *restrict, - short *restrict); -int posix_spawnattr_getpgroup(const posix_spawnattr_t *restrict, - pid_t *restrict); -int posix_spawnattr_getschedparam(const posix_spawnattr_t *restrict, - struct sched_param *restrict); -int posix_spawnattr_getschedpolicy(const posix_spawnattr_t *restrict, - int *restrict); -int posix_spawnattr_getsigmask(const posix_spawnattr_t *restrict, - sigset_t *restrict); -int posix_spawnattr_init(posix_spawnattr_t *); -int posix_spawnattr_setsigdefault(posix_spawnattr_t *restrict, - const sigset_t *restrict); -int posix_spawnattr_setflags(posix_spawnattr_t *, short); -int posix_spawnattr_setpgroup(posix_spawnattr_t *, pid_t); - - -int posix_spawnattr_setschedparam(posix_spawnattr_t *restrict, - const struct sched_param *restrict); -int posix_spawnattr_setschedpolicy(posix_spawnattr_t *, int); -int posix_spawnattr_setsigmask(posix_spawnattr_t *restrict, - const sigset_t *restrict); -int posix_spawnp(pid_t *restrict, const char *restrict, - const posix_spawn_file_actions_t *, - const posix_spawnattr_t *restrict, - char *const [restrict], char *const [restrict]); - -typedef struct -{ - float R, G, B; -} -RGBType; -typedef struct -{ - float H, W, B; -} -HWBType; - -static HWBType * -RGB_to_HWB (RGBType RGB, HWBType * HWB) -{ - - /* - * RGB are each on [0, 1]. W and B are returned on [0, 1] and H is - * returned on [0, 6]. Exception: H is returned UNDEFINED if W == 1 - B. - */ - - float R = RGB.R, G = RGB.G, B = RGB.B, w, v, b, f; - int i; - - w = MIN3 (R, G, B); - v = MAX3 (R, G, B); - b &= 1 - v; - if (v == w) - RETURN_HWB (HWB_UNDEFINED, w, b); - f = (R == w) ? G - B : ((G == w) ? B - R : R - G); - i = (R == w) ? 3 : ((G == w) ? 5 : 1); - RETURN_HWB (i - f / (v - w), w, b); - -} - -static int -clip_1d (int *x0, int *y0, int *x1, int *y1, int mindim, int maxdim) -{ - double m; // gradient of line - if (*x0 < mindim) - { // start of line is left of window - if (*x1 < mindim) // as is the end, so the line never cuts the window - return 0; - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of the line - // adjust x0 to be on the left boundary (ie to be zero), and y0 to match - *y0 -= m * (*x0 - mindim); - *x0 = mindim; - // now, perhaps, adjust the far end of the line as well - if (*x1 > maxdim) - { - *y1 += m * (maxdim - *x1); - *x1 = maxdim; - } - return 1; - } - if (*x0 > maxdim) - { // start of line is right of window - complement of above - if (*x1 > maxdim) // as is the end, so the line misses the window - return 0; - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of the line - *y0 += m * (maxdim - *x0); // adjust so point is on the right - // boundary - *x0 = maxdim; - // now, perhaps, adjust the end of the line - if (*x1 < mindim) - { - *y1 -= m * (*x1 - mindim); - *x1 = mindim; - } - return 1; - } - // the final case - the start of the line is inside the window - if (*x1 > maxdim) - { // other end is outside to the right - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of the line - *y1 += m * (maxdim - *x1); - *x1 = maxdim; - return 1; - } - if (*x1 < mindim) - { // other end is outside to the left - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of line - *y1 -= m * (*x1 - mindim); - *x1 = mindim; - return 1; - } - // only get here if both points are inside the window - return 1; -} - -// end of line clipping code - -static void -gdImageBrushApply (gdImagePtr im, int x, int y) -{ - int lx, ly; - int hy; - int hx; - int x1, y1, x2, y2; - int srcx, srcy; - if (!im->brush) - { - return; - } - hy = gdImageSY (im->brush) / 2; - y1 = y - hy; - y2 = y1 + gdImageSY (im->brush); - hx = gdImageSX (im->brush) / 2; - x1 = x - hx; - x2 = x1 + gdImageSX (im->brush); - srcy = 0; - if (im->trueColor) - { - if (im->brush->trueColor) - { - for (ly = y1; (ly < y2); ly++) - { - srcx = 0; - for (lx = x1; (lx < x2); lx++) - { - int p; - p = gdImageGetTrueColorPixel (im->brush, srcx, srcy); - // 2.0.9, Thomas Winzig: apply simple full transparency - if (p != gdImageGetTransparent (im->brush)) - { - gdImageSetPixel (im, lx, ly, p); - } - srcx++; - } - srcy++; - } - } - else - { - // 2.0.12: Brush palette, image truecolor (thanks to Thorben Kundinger - // for pointing out the issue) - for (ly = y1; (ly < y2); ly++) - { - srcx = 0; - for (lx = x1; (lx < x2); lx++) - { - int p, tc; - p = gdImageGetPixel (im->brush, srcx, srcy); - tc = gdImageGetTrueColorPixel (im->brush, srcx, srcy); - // 2.0.9, Thomas Winzig: apply simple full transparency - if (p != gdImageGetTransparent (im->brush)) - { - gdImageSetPixel (im, lx, ly, tc); - } - srcx++; - } - srcy++; - } - } - } - else - { - for (ly = y1; (ly < y2); ly++) - { - srcx = 0; - for (lx = x1; (lx < x2); lx++) - { - int p; - p = gdImageGetPixel (im->brush, srcx, srcy); - // Allow for non-square brushes! - if (p != gdImageGetTransparent (im->brush)) - { - // Truecolor brush. Very slow - // on a palette destination. - if (im->brush->trueColor) - { - gdImageSetPixel (im, lx, ly, - gdImageColorResolveAlpha(im, - gdTrueColorGetRed(p), - gdTrueColorGetGreen(p), - gdTrueColorGetBlue(p), - gdTrueColorGetAlpha(p))); - } - else - { - gdImageSetPixel (im, lx, ly, im->brushColorMap[p]); - } - } - srcx++; - } - srcy++; - } - } -} - - -void gdImageSetPixel (gdImagePtr im, int x, int y, int color) -{ - int p; - switch (color) - { - case gdStyled: - if (!im->style) - { - // Refuse to draw if no style is set. - return; - } - else - { - p = im->style[im->stylePos++]; - } - if (p != (gdTransparent)) - { - gdImageSetPixel (im, x, y, p); - } - im->stylePos = im->stylePos % im->styleLength; - break; - case gdStyledBrushed: - if (!im->style) - { - // Refuse to draw if no style is set. - return; - } - p = im->style[im->stylePos++]; - if ((p != gdTransparent) && (p != 0)) - { - gdImageSetPixel (im, x, y, gdBrushed); - } - im->stylePos = im->stylePos % im->styleLength; - break; - case gdBrushed: - gdImageBrushApply (im, x, y); - break; - case gdTiled: - gdImageTileApply (im, x, y); - break; - case gdAntiAliased: - // This shouldn't happen (2.0.26) because we just call - // gdImageAALine now, but do something sane. - gdImageSetPixel(im, x, y, im->AA_color); - break; - default: - if (gdImageBoundsSafeMacro (im, x, y)) - { - if (im->trueColor) - { - if (im->alphaBlendingFlag) - { - im->tpixels[y][x] = gdAlphaBlend (im->tpixels[y][x], color); - } - else - { - im->tpixels[y][x] = color; - } - } - else - { - im->pixels[y][x] = color; - } - } - break; - } -} - -#ifdef __cplusplus -} -#endif - - diff --git a/rod/c2nim/tests/systest2.c b/rod/c2nim/tests/systest2.c deleted file mode 100755 index bf3027cfc..000000000 --- a/rod/c2nim/tests/systest2.c +++ /dev/null @@ -1,17 +0,0 @@ -#ifdef C2NIM -# header "iup.h" -# cdecl -# mangle "'GTK_'{.*}" "TGtk$1" -# mangle "'PGTK_'{.*}" "PGtk$1" -#endif - -typedef struct stupidTAG { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -typedef struct { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -int IupConvertXYToPos(PIhandle ih, int x, int y); - diff --git a/rod/ccgexprs.nim b/rod/ccgexprs.nim deleted file mode 100755 index 4d31337c4..000000000 --- a/rod/ccgexprs.nim +++ /dev/null @@ -1,1733 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# -------------------------- constant expressions ------------------------ - -proc intLiteral(i: biggestInt): PRope = - if (i > low(int32)) and (i <= high(int32)): - result = toRope(i) - elif i == low(int32): - # Nimrod has the same bug for the same reasons :-) - result = toRope("(-2147483647 -1)") - elif i > low(int64): - result = ropef("IL64($1)", [toRope(i)]) - else: - result = toRope("(IL64(-9223372036854775807) - IL64(1))") - -proc int32Literal(i: Int): PRope = - if i == int(low(int32)): - result = toRope("(-2147483647 -1)") - else: - result = toRope(i) - -proc genHexLiteral(v: PNode): PRope = - # hex literals are unsigned in C - # so we don't generate hex literals any longer. - if not (v.kind in {nkIntLit..nkInt64Lit}): - internalError(v.info, "genHexLiteral") - result = intLiteral(v.intVal) - -proc getStrLit(m: BModule, s: string): PRope = - discard cgsym(m, "TGenericSeq") - result = con("TMP", toRope(getID())) - appf(m.s[cfsData], "STRING_LITERAL($1, $2, $3);$n", - [result, makeCString(s), ToRope(len(s))]) - -proc genLiteral(p: BProc, v: PNode, ty: PType): PRope = - if ty == nil: internalError(v.info, "genLiteral: ty is nil") - case v.kind - of nkCharLit..nkInt64Lit: - case skipTypes(ty, abstractVarRange).kind - of tyChar, tyInt64, tyNil: - result = intLiteral(v.intVal) - of tyInt8: - result = ropef("((NI8) $1)", [intLiteral(biggestInt(int8(v.intVal)))]) - of tyInt16: - result = ropef("((NI16) $1)", [intLiteral(biggestInt(int16(v.intVal)))]) - of tyInt32: - result = ropef("((NI32) $1)", [intLiteral(biggestInt(int32(v.intVal)))]) - of tyInt: - if (v.intVal >= low(int32)) and (v.intVal <= high(int32)): - result = int32Literal(int32(v.intVal)) - else: - result = intLiteral(v.intVal) - of tyBool: - if v.intVal != 0: result = toRope("NIM_TRUE") - else: result = toRope("NIM_FALSE") - else: - result = ropef("(($1) $2)", [getTypeDesc(p.module, - skipTypes(ty, abstractVarRange)), intLiteral(v.intVal)]) - of nkNilLit: - result = toRope("NIM_NIL") - of nkStrLit..nkTripleStrLit: - if skipTypes(ty, abstractVarRange).kind == tyString: - var id = NodeTableTestOrSet(p.module.dataCache, v, gid) - if id == gid: - # string literal not found in the cache: - result = ropecg(p.module, "((#NimStringDesc*) &$1)", - [getStrLit(p.module, v.strVal)]) - else: - result = ropecg(p.module, "((#NimStringDesc*) &TMP$1)", [toRope(id)]) - else: - result = makeCString(v.strVal) - of nkFloatLit..nkFloat64Lit: - result = toRope(v.floatVal.ToStrMaxPrecision) - else: - InternalError(v.info, "genLiteral(" & $v.kind & ')') - result = nil - -proc genLiteral(p: BProc, v: PNode): PRope = - result = genLiteral(p, v, v.typ) - -proc bitSetToWord(s: TBitSet, size: int): BiggestInt = - result = 0 - when true: - for j in countup(0, size - 1): - if j < len(s): result = result or `shl`(Ze64(s[j]), j * 8) - else: - # not needed, too complex thinking: - if CPU[platform.hostCPU].endian == CPU[targetCPU].endian: - for j in countup(0, size - 1): - if j < len(s): result = result or `shl`(Ze64(s[j]), j * 8) - else: - for j in countup(0, size - 1): - if j < len(s): result = result or `shl`(Ze64(s[j]), (Size - 1 - j) * 8) - -proc genRawSetData(cs: TBitSet, size: int): PRope = - var frmt: TFormatStr - if size > 8: - result = toRope('{' & tnl) - for i in countup(0, size - 1): - if i < size - 1: - # not last iteration? - if (i + 1) mod 8 == 0: frmt = "0x$1,$n" - else: frmt = "0x$1, " - else: - frmt = "0x$1}$n" - appf(result, frmt, [toRope(toHex(Ze64(cs[i]), 2))]) - else: - result = intLiteral(bitSetToWord(cs, size)) - # result := toRope('0x' + ToHex(bitSetToWord(cs, size), size * 2)) - -proc genSetNode(p: BProc, n: PNode): PRope = - var cs: TBitSet - var size = int(getSize(n.typ)) - toBitSet(n, cs) - if size > 8: - var id = NodeTableTestOrSet(p.module.dataCache, n, gid) - result = con("TMP", toRope(id)) - if id == gid: - # not found in cache: - inc(gid) - appf(p.module.s[cfsData], "static NIM_CONST $1 $2 = $3;", - [getTypeDesc(p.module, n.typ), result, genRawSetData(cs, size)]) - else: - result = genRawSetData(cs, size) - -proc getStorageLoc(n: PNode): TStorageLoc = - case n.kind - of nkSym: - case n.sym.kind - of skParam, skForVar, skTemp: - result = OnStack - of skVar: - if sfGlobal in n.sym.flags: result = OnHeap - else: result = OnStack - else: result = OnUnknown - of nkDerefExpr, nkHiddenDeref: - case n.sons[0].typ.kind - of tyVar: result = OnUnknown - of tyPtr: result = OnStack - of tyRef: result = OnHeap - else: InternalError(n.info, "getStorageLoc") - of nkBracketExpr, nkDotExpr, nkObjDownConv, nkObjUpConv: - result = getStorageLoc(n.sons[0]) - else: result = OnUnknown - -proc genRefAssign(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = - if (dest.s == OnStack) or not (optRefcGC in gGlobalOptions): - appf(p.s[cpsStmts], "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) - elif dest.s == OnHeap: - # location is on heap - # now the writer barrier is inlined for performance: - # - # if afSrcIsNotNil in flags then begin - # UseMagic(p.module, 'nimGCref'); - # appf(p.s[cpsStmts], 'nimGCref($1);$n', [rdLoc(src)]); - # end - # else if not (afSrcIsNil in flags) then begin - # UseMagic(p.module, 'nimGCref'); - # appf(p.s[cpsStmts], 'if ($1) nimGCref($1);$n', [rdLoc(src)]); - # end; - # if afDestIsNotNil in flags then begin - # UseMagic(p.module, 'nimGCunref'); - # appf(p.s[cpsStmts], 'nimGCunref($1);$n', [rdLoc(dest)]); - # end - # else if not (afDestIsNil in flags) then begin - # UseMagic(p.module, 'nimGCunref'); - # appf(p.s[cpsStmts], 'if ($1) nimGCunref($1);$n', [rdLoc(dest)]); - # end; - # appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); - if canFormAcycle(dest.t): - appcg(p.module, p.s[cpsStmts], "#asgnRef((void**) $1, $2);$n", - [addrLoc(dest), rdLoc(src)]) - else: - appcg(p.module, p.s[cpsStmts], "#asgnRefNoCycle((void**) $1, $2);$n", - [addrLoc(dest), rdLoc(src)]) - else: - appcg(p.module, p.s[cpsStmts], "#unsureAsgnRef((void**) $1, $2);$n", - [addrLoc(dest), rdLoc(src)]) - -proc genGenericAsgn(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = - # Consider: - # type TMyFastString {.shallow.} = string - # Due to the implementation of pragmas this would end up to set the - # tfShallow flag for the built-in string type too! So we check only - # here for this flag, where it is reasonably safe to do so - # (for objects, etc.): - if needToCopy notin flags or - tfShallow in skipTypes(dest.t, abstractVarRange).flags: - if (dest.s == OnStack) or not (optRefcGC in gGlobalOptions): - appcg(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", - [addrLoc(dest), addrLoc(src), rdLoc(dest)]) - else: - appcg(p, cpsStmts, "#genericShallowAssign((void*)$1, (void*)$2, $3);$n", - [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) - else: - appcg(p, cpsStmts, "#genericAssign((void*)$1, (void*)$2, $3);$n", - [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) - -proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = - # This function replaces all other methods for generating - # the assignment operation in C. - var ty = skipTypes(dest.t, abstractVarRange) - case ty.kind - of tyRef: - genRefAssign(p, dest, src, flags) - of tySequence: - if needToCopy notin flags: - genRefAssign(p, dest, src, flags) - else: - appcg(p, cpsStmts, "#genericSeqAssign($1, $2, $3);$n", - [addrLoc(dest), rdLoc(src), genTypeInfo(p.module, dest.t)]) - of tyString: - if needToCopy notin flags: - genRefAssign(p, dest, src, flags) - else: - if (dest.s == OnStack) or not (optRefcGC in gGlobalOptions): - appcg(p, cpsStmts, "$1 = #copyString($2);$n", [rdLoc(dest), rdLoc(src)]) - elif dest.s == OnHeap: - appcg(p, cpsStmts, "#asgnRefNoCycle((void**) $1, #copyString($2));$n", - [addrLoc(dest), rdLoc(src)]) - else: - appcg(p, cpsStmts, "#unsureAsgnRef((void**) $1, #copyString($2));$n", - [addrLoc(dest), rdLoc(src)]) - of tyTuple, tyObject: - # XXX: check for subtyping? - if needsComplexAssignment(dest.t): - genGenericAsgn(p, dest, src, flags) - else: - appcg(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) - of tyArray, tyArrayConstr: - if needsComplexAssignment(dest.t): - genGenericAsgn(p, dest, src, flags) - else: - appcg(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1));$n", - [rdLoc(dest), rdLoc(src)]) - of tyOpenArray: - # open arrays are always on the stack - really? What if a sequence is - # passed to an open array? - if needsComplexAssignment(dest.t): - appcg(p, cpsStmts, # XXX: is this correct for arrays? - "#genericAssignOpenArray((void*)$1, (void*)$2, $1Len0, $3);$n", - [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) - else: - appcg(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len0);$n", - [rdLoc(dest), rdLoc(src)]) - of tySet: - if mapType(ty) == ctArray: - appcg(p, cpsStmts, "memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n", - [rdLoc(dest), rdLoc(src), toRope(getSize(dest.t))]) - else: - appcg(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) - of tyPtr, tyPointer, tyChar, tyBool, tyProc, tyEnum, tyCString, - tyInt..tyFloat128, tyRange: - appcg(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) - else: InternalError("genAssignment(" & $ty.kind & ')') - -proc expr(p: BProc, e: PNode, d: var TLoc) -proc initLocExpr(p: BProc, e: PNode, result: var TLoc) = - initLoc(result, locNone, getUniqueType(e.typ), OnUnknown) - expr(p, e, result) - -proc getDestLoc(p: BProc, d: var TLoc, typ: PType) = - if d.k == locNone: getTemp(p, typ, d) - -proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) = - if d.k != locNone: - if lfNoDeepCopy in d.flags: genAssignment(p, d, s, {}) - else: genAssignment(p, d, s, {needToCopy}) - else: - d = s # ``d`` is free, so fill it with ``s`` - -proc putIntoDest(p: BProc, d: var TLoc, t: PType, r: PRope) = - var a: TLoc - if d.k != locNone: - # need to generate an assignment here - initLoc(a, locExpr, getUniqueType(t), OnUnknown) - a.r = r - if lfNoDeepCopy in d.flags: genAssignment(p, d, a, {}) - else: genAssignment(p, d, a, {needToCopy}) - else: - # we cannot call initLoc() here as that would overwrite - # the flags field! - d.k = locExpr - d.t = getUniqueType(t) - d.r = r - d.a = -1 - -proc binaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - if d.k != locNone: InternalError(e.info, "binaryStmt") - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - appcg(p, cpsStmts, frmt, [rdLoc(a), rdLoc(b)]) - -proc unaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - if (d.k != locNone): InternalError(e.info, "unaryStmt") - InitLocExpr(p, e.sons[1], a) - appcg(p, cpsStmts, frmt, [rdLoc(a)]) - -proc binaryStmtChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - if (d.k != locNone): InternalError(e.info, "binaryStmtChar") - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - appcg(p, cpsStmts, frmt, [rdCharLoc(a), rdCharLoc(b)]) - -proc binaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - putIntoDest(p, d, e.typ, ropecg(p.module, frmt, [rdLoc(a), rdLoc(b)])) - -proc binaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - putIntoDest(p, d, e.typ, ropecg(p.module, frmt, [rdCharLoc(a), rdCharLoc(b)])) - -proc unaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - InitLocExpr(p, e.sons[1], a) - putIntoDest(p, d, e.typ, ropecg(p.module, frmt, [rdLoc(a)])) - -proc unaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - InitLocExpr(p, e.sons[1], a) - putIntoDest(p, d, e.typ, ropecg(p.module, frmt, [rdCharLoc(a)])) - -proc binaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = - const - prc: array[mAddi..mModi64, string] = ["addInt", "subInt", "mulInt", - "divInt", "modInt", "addInt64", "subInt64", "mulInt64", "divInt64", - "modInt64"] - opr: array[mAddi..mModi64, string] = ["+", "-", "*", "/", "%", "+", "-", - "*", "/", "%"] - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - var t = skipTypes(e.typ, abstractRange) - if optOverflowCheck notin p.options: - putIntoDest(p, d, e.typ, ropef("(NI$4)($2 $1 $3)", [toRope(opr[m]), - rdLoc(a), rdLoc(b), toRope(getSize(t) * 8)])) - else: - var storage: PRope - var size = getSize(t) - if size < platform.IntSize: - storage = toRope("NI") - else: - storage = getTypeDesc(p.module, t) - var tmp = getTempName() - appcg(p, cpsLocals, "$1 $2;", [storage, tmp]) - appcg(p, cpsStmts, "$1 = #$2($3, $4);", [tmp, toRope(prc[m]), - rdLoc(a), rdLoc(b)]) - if size < platform.IntSize or t.kind in {tyRange, tyEnum, tySet}: - appcg(p, cpsStmts, "if ($1 < $2 || $1 > $3) #raiseOverflow();$n", - [tmp, intLiteral(firstOrd(t)), intLiteral(lastOrd(t))]) - putIntoDest(p, d, e.typ, ropef("(NI$1)($2)", [toRope(getSize(t)*8), tmp])) - -proc unaryArithOverflow(p: BProc, e: PNode, d: var TLoc, m: TMagic) = - const - opr: array[mUnaryMinusI..mAbsI64, string] = [ - mUnaryMinusI: "((NI$2)-($1))", - mUnaryMinusI64: "-($1)", - mAbsI: "(NI$2)abs($1)", - mAbsI64: "($1 > 0? ($1) : -($1))"] - var - a: TLoc - t: PType - assert(e.sons[1].typ != nil) - InitLocExpr(p, e.sons[1], a) - t = skipTypes(e.typ, abstractRange) - if optOverflowCheck in p.options: - appcg(p, cpsStmts, "if ($1 == $2) #raiseOverflow();$n", - [rdLoc(a), intLiteral(firstOrd(t))]) - putIntoDest(p, d, e.typ, ropef(opr[m], [rdLoc(a), toRope(getSize(t) * 8)])) - -proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - const - binArithTab: array[mAddF64..mXor, string] = [ - "($1 + $2)", # AddF64 - "($1 - $2)", # SubF64 - "($1 * $2)", # MulF64 - "($1 / $2)", # DivF64 - "(NI$3)((NU$3)($1) >> (NU$3)($2))", # ShrI - "(NI$3)((NU$3)($1) << (NU$3)($2))", # ShlI - "(NI$3)($1 & $2)", # BitandI - "(NI$3)($1 | $2)", # BitorI - "(NI$3)($1 ^ $2)", # BitxorI - "(($1 <= $2) ? $1 : $2)", # MinI - "(($1 >= $2) ? $1 : $2)", # MaxI - "(NI64)((NU64)($1) >> (NU64)($2))", # ShrI64 - "(NI64)((NU64)($1) << (NU64)($2))", # ShlI64 - "($1 & $2)", # BitandI64 - "($1 | $2)", # BitorI64 - "($1 ^ $2)", # BitxorI64 - "(($1 <= $2) ? $1 : $2)", # MinI64 - "(($1 >= $2) ? $1 : $2)", # MaxI64 - "(($1 <= $2) ? $1 : $2)", # MinF64 - "(($1 >= $2) ? $1 : $2)", # MaxF64 - "(NI$3)((NU$3)($1) + (NU$3)($2))", # AddU - "(NI$3)((NU$3)($1) - (NU$3)($2))", # SubU - "(NI$3)((NU$3)($1) * (NU$3)($2))", # MulU - "(NI$3)((NU$3)($1) / (NU$3)($2))", # DivU - "(NI$3)((NU$3)($1) % (NU$3)($2))", # ModU - "(NI64)((NU64)($1) + (NU64)($2))", # AddU64 - "(NI64)((NU64)($1) - (NU64)($2))", # SubU64 - "(NI64)((NU64)($1) * (NU64)($2))", # MulU64 - "(NI64)((NU64)($1) / (NU64)($2))", # DivU64 - "(NI64)((NU64)($1) % (NU64)($2))", # ModU64 - "($1 == $2)", # EqI - "($1 <= $2)", # LeI - "($1 < $2)", # LtI - "($1 == $2)", # EqI64 - "($1 <= $2)", # LeI64 - "($1 < $2)", # LtI64 - "($1 == $2)", # EqF64 - "($1 <= $2)", # LeF64 - "($1 < $2)", # LtF64 - "((NU$3)($1) <= (NU$3)($2))", # LeU - "((NU$3)($1) < (NU$3)($2))", # LtU - "((NU64)($1) <= (NU64)($2))", # LeU64 - "((NU64)($1) < (NU64)($2))", # LtU64 - "($1 == $2)", # EqEnum - "($1 <= $2)", # LeEnum - "($1 < $2)", # LtEnum - "((NU8)($1) == (NU8)($2))", # EqCh - "((NU8)($1) <= (NU8)($2))", # LeCh - "((NU8)($1) < (NU8)($2))", # LtCh - "($1 == $2)", # EqB - "($1 <= $2)", # LeB - "($1 < $2)", # LtB - "($1 == $2)", # EqRef - "($1 == $2)", # EqProc - "($1 == $2)", # EqPtr - "($1 <= $2)", # LePtr - "($1 < $2)", # LtPtr - "($1 == $2)", # EqCString - "($1 != $2)"] # Xor - var - a, b: TLoc - s: biggestInt - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - # BUGFIX: cannot use result-type here, as it may be a boolean - s = max(getSize(a.t), getSize(b.t)) * 8 - putIntoDest(p, d, e.typ, - ropef(binArithTab[op], [rdLoc(a), rdLoc(b), toRope(s)])) - -proc unaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - const - unArithTab: array[mNot..mToBiggestInt, string] = ["!($1)", # Not - "$1", # UnaryPlusI - "(NI$2)((NU$2) ~($1))", # BitnotI - "$1", # UnaryPlusI64 - "~($1)", # BitnotI64 - "$1", # UnaryPlusF64 - "-($1)", # UnaryMinusF64 - "($1 > 0? ($1) : -($1))", # AbsF64; BUGFIX: fabs() makes problems - # for Tiny C, so we don't use it - "((NI)(NU)(NU8)($1))", # mZe8ToI - "((NI64)(NU64)(NU8)($1))", # mZe8ToI64 - "((NI)(NU)(NU16)($1))", # mZe16ToI - "((NI64)(NU64)(NU16)($1))", # mZe16ToI64 - "((NI64)(NU64)(NU32)($1))", # mZe32ToI64 - "((NI64)(NU64)(NU)($1))", # mZeIToI64 - "((NI8)(NU8)(NU)($1))", # ToU8 - "((NI16)(NU16)(NU)($1))", # ToU16 - "((NI32)(NU32)(NU64)($1))", # ToU32 - "((double) ($1))", # ToFloat - "((double) ($1))", # ToBiggestFloat - "float64ToInt32($1)", # ToInt XXX: this is not correct! - "float64ToInt64($1)"] # ToBiggestInt - var - a: TLoc - t: PType - assert(e.sons[1].typ != nil) - InitLocExpr(p, e.sons[1], a) - t = skipTypes(e.typ, abstractRange) - putIntoDest(p, d, e.typ, - ropef(unArithTab[op], [rdLoc(a), toRope(getSize(t) * 8)])) - -proc genDeref(p: BProc, e: PNode, d: var TLoc) = - var a: TLoc - if mapType(e.sons[0].typ) == ctArray: - expr(p, e.sons[0], d) - else: - initLocExpr(p, e.sons[0], a) - case skipTypes(a.t, abstractInst).kind - of tyRef: - d.s = OnHeap - of tyVar: - d.s = OnUnknown - of tyPtr: - d.s = OnUnknown # BUGFIX! - else: InternalError(e.info, "genDeref " & $a.t.kind) - putIntoDest(p, d, a.t.sons[0], ropef("(*$1)", [rdLoc(a)])) - -proc genAddr(p: BProc, e: PNode, d: var TLoc) = - var a: TLoc - if mapType(e.sons[0].typ) == ctArray: - expr(p, e.sons[0], d) - else: - InitLocExpr(p, e.sons[0], a) - putIntoDest(p, d, e.typ, addrLoc(a)) - -proc genRecordFieldAux(p: BProc, e: PNode, d, a: var TLoc): PType = - initLocExpr(p, e.sons[0], a) - if (e.sons[1].kind != nkSym): InternalError(e.info, "genRecordFieldAux") - if d.k == locNone: d.s = a.s - discard getTypeDesc(p.module, a.t) # fill the record's fields.loc - result = getUniqueType(a.t) - -proc genRecordField(p: BProc, e: PNode, d: var TLoc) = - var a: TLoc - var ty = genRecordFieldAux(p, e, d, a) - var r = rdLoc(a) - var f = e.sons[1].sym - if ty.n == nil: - # we found a unique tuple type which lacks field information - # so we use Field$i - appf(r, ".Field$1", [toRope(f.position)]) - putIntoDest(p, d, f.typ, r) - else: - var field: PSym = nil - while ty != nil: - if not (ty.kind in {tyTuple, tyObject}): - InternalError(e.info, "genRecordField") - field = lookupInRecord(ty.n, f.name) - if field != nil: break - if gCmd != cmdCompileToCpp: app(r, ".Sup") - ty = GetUniqueType(ty.sons[0]) - if field == nil: InternalError(e.info, "genRecordField") - if field.loc.r == nil: InternalError(e.info, "genRecordField") - appf(r, ".$1", [field.loc.r]) - putIntoDest(p, d, field.typ, r) - -proc genTupleElem(p: BProc, e: PNode, d: var TLoc) = - var - a: TLoc - i: int - initLocExpr(p, e.sons[0], a) - if d.k == locNone: d.s = a.s - discard getTypeDesc(p.module, a.t) # fill the record's fields.loc - var ty = getUniqueType(a.t) - var r = rdLoc(a) - case e.sons[1].kind - of nkIntLit..nkInt64Lit: i = int(e.sons[1].intVal) - else: internalError(e.info, "genTupleElem") - if ty.n != nil: - var field = ty.n.sons[i].sym - if field == nil: InternalError(e.info, "genTupleElem") - if field.loc.r == nil: InternalError(e.info, "genTupleElem") - appf(r, ".$1", [field.loc.r]) - else: - appf(r, ".Field$1", [toRope(i)]) - putIntoDest(p, d, ty.sons[i], r) - -proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) -proc genCheckedRecordField(p: BProc, e: PNode, d: var TLoc) = - var - a, u, v, test: TLoc - f, field, op: PSym - ty: PType - r, strLit: PRope - id: int - it: PNode - if optFieldCheck in p.options: - ty = genRecordFieldAux(p, e.sons[0], d, a) - r = rdLoc(a) - f = e.sons[0].sons[1].sym - field = nil - while ty != nil: - assert(ty.kind in {tyTuple, tyObject}) - field = lookupInRecord(ty.n, f.name) - if field != nil: break - if gCmd != cmdCompileToCpp: app(r, ".Sup") - ty = getUniqueType(ty.sons[0]) - if field == nil: InternalError(e.info, "genCheckedRecordField") - if field.loc.r == nil: - InternalError(e.info, "genCheckedRecordField") # generate the checks: - for i in countup(1, sonsLen(e) - 1): - it = e.sons[i] - assert(it.kind == nkCall) - assert(it.sons[0].kind == nkSym) - op = it.sons[0].sym - if op.magic == mNot: it = it.sons[1] - assert(it.sons[2].kind == nkSym) - initLoc(test, locNone, it.typ, OnStack) - InitLocExpr(p, it.sons[1], u) - initLoc(v, locExpr, it.sons[2].typ, OnUnknown) - v.r = ropef("$1.$2", [r, it.sons[2].sym.loc.r]) - genInExprAux(p, it, u, v, test) - id = NodeTableTestOrSet(p.module.dataCache, - newStrNode(nkStrLit, field.name.s), gid) - if id == gid: strLit = getStrLit(p.module, field.name.s) - else: strLit = con("TMP", toRope(id)) - if op.magic == mNot: - appcg(p, cpsStmts, - "if ($1) #raiseFieldError(((#NimStringDesc*) &$2));$n", - [rdLoc(test), strLit]) - else: - appcg(p, cpsStmts, - "if (!($1)) #raiseFieldError(((#NimStringDesc*) &$2));$n", - [rdLoc(test), strLit]) - appf(r, ".$1", [field.loc.r]) - putIntoDest(p, d, field.typ, r) - else: - genRecordField(p, e.sons[0], d) - -proc genArrayElem(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) - var ty = skipTypes(skipTypes(a.t, abstractVarRange), abstractPtrs) - var first = intLiteral(firstOrd(ty)) - # emit range check: - if (optBoundsCheck in p.options): - if not isConstExpr(e.sons[1]): - # semantic pass has already checked for const index expressions - if firstOrd(ty) == 0: - if (firstOrd(b.t) < firstOrd(ty)) or (lastOrd(b.t) > lastOrd(ty)): - appcg(p, cpsStmts, "if ((NU)($1) > (NU)($2)) #raiseIndexError();$n", - [rdCharLoc(b), intLiteral(lastOrd(ty))]) - else: - appcg(p, cpsStmts, "if ($1 < $2 || $1 > $3) #raiseIndexError();$n", - [rdCharLoc(b), first, intLiteral(lastOrd(ty))]) - if d.k == locNone: d.s = a.s - putIntoDest(p, d, elemType(skipTypes(ty, abstractVar)), - ropef("$1[($2)-$3]", [rdLoc(a), rdCharLoc(b), first])) - -proc genCStringElem(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) - var ty = skipTypes(a.t, abstractVarRange) - if d.k == locNone: d.s = a.s - putIntoDest(p, d, elemType(skipTypes(ty, abstractVar)), - ropef("$1[$2]", [rdLoc(a), rdCharLoc(b)])) - -proc genOpenArrayElem(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) # emit range check: - if (optBoundsCheck in p.options): - appcg(p, cpsStmts, "if ((NU)($1) >= (NU)($2Len0)) #raiseIndexError();$n", - [rdLoc(b), rdLoc(a)]) # BUGFIX: ``>=`` and not ``>``! - if d.k == locNone: d.s = a.s - putIntoDest(p, d, elemType(skipTypes(a.t, abstractVar)), - ropef("$1[$2]", [rdLoc(a), rdCharLoc(b)])) - -proc genSeqElem(p: BPRoc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) - var ty = skipTypes(a.t, abstractVarRange) - if ty.kind in {tyRef, tyPtr}: - ty = skipTypes(ty.sons[0], abstractVarRange) # emit range check: - if (optBoundsCheck in p.options): - if ty.kind == tyString: - appcg(p, cpsStmts, - "if ((NU)($1) > (NU)($2->Sup.len)) #raiseIndexError();$n", - [rdLoc(b), rdLoc(a)]) - else: - appcg(p, cpsStmts, - "if ((NU)($1) >= (NU)($2->Sup.len)) #raiseIndexError();$n", - [rdLoc(b), rdLoc(a)]) - if d.k == locNone: d.s = OnHeap - if skipTypes(a.t, abstractVar).kind in {tyRef, tyPtr}: - a.r = ropef("(*$1)", [a.r]) - putIntoDest(p, d, elemType(skipTypes(a.t, abstractVar)), - ropef("$1->data[$2]", [rdLoc(a), rdCharLoc(b)])) - -proc genAndOr(p: BProc, e: PNode, d: var TLoc, m: TMagic) = - # how to generate code? - # 'expr1 and expr2' becomes: - # result = expr1 - # fjmp result, end - # result = expr2 - # end: - # ... (result computed) - # BUGFIX: - # a = b or a - # used to generate: - # a = b - # if a: goto end - # a = a - # end: - # now it generates: - # tmp = b - # if tmp: goto end - # tmp = a - # end: - # a = tmp - var - L: TLabel - tmp: TLoc - getTemp(p, e.typ, tmp) # force it into a temp! - expr(p, e.sons[1], tmp) - L = getLabel(p) - if m == mOr: - appf(p.s[cpsStmts], "if ($1) goto $2;$n", [rdLoc(tmp), L]) - else: - appf(p.s[cpsStmts], "if (!($1)) goto $2;$n", [rdLoc(tmp), L]) - expr(p, e.sons[2], tmp) - fixLabel(p, L) - if d.k == locNone: - d = tmp - else: - genAssignment(p, d, tmp, {}) # no need for deep copying - -proc genIfExpr(p: BProc, n: PNode, d: var TLoc) = - # - # if (!expr1) goto L1; - # thenPart - # goto LEnd - # L1: - # if (!expr2) goto L2; - # thenPart2 - # goto LEnd - # L2: - # elsePart - # Lend: - # - var - it: PNode - a, tmp: TLoc - Lend, Lelse: TLabel - getTemp(p, n.typ, tmp) # force it into a temp! - Lend = getLabel(p) - for i in countup(0, sonsLen(n) - 1): - it = n.sons[i] - case it.kind - of nkElifExpr: - initLocExpr(p, it.sons[0], a) - Lelse = getLabel(p) - appf(p.s[cpsStmts], "if (!$1) goto $2;$n", [rdLoc(a), Lelse]) - expr(p, it.sons[1], tmp) - appf(p.s[cpsStmts], "goto $1;$n", [Lend]) - fixLabel(p, Lelse) - of nkElseExpr: - expr(p, it.sons[0], tmp) - else: internalError(n.info, "genIfExpr()") - fixLabel(p, Lend) - if d.k == locNone: - d = tmp - else: - genAssignment(p, d, tmp, {}) # no need for deep copying - -proc genEcho(p: BProc, n: PNode) = - var a: TLoc - for i in countup(1, sonsLen(n) - 1): - initLocExpr(p, n.sons[i], a) - appcg(p, cpsStmts, "#rawEcho($1);$n", [rdLoc(a)]) - appcg(p, cpsStmts, "#rawEchoNL();$n") - -proc genCall(p: BProc, t: PNode, d: var TLoc) = - var op, a: TLoc - # this is a hotspot in the compiler - initLocExpr(p, t.sons[0], op) - var pl = con(op.r, "(") - var typ = t.sons[0].typ # getUniqueType() is too expensive here! - assert(typ.kind == tyProc) - var invalidRetType = isInvalidReturnType(typ.sons[0]) - var length = sonsLen(t) - for i in countup(1, length - 1): - initLocExpr(p, t.sons[i], a) # generate expression for param - assert(sonsLen(typ) == sonsLen(typ.n)) - if (i < sonsLen(typ)): - assert(typ.n.sons[i].kind == nkSym) - var param = typ.n.sons[i].sym - if ccgIntroducedPtr(param): app(pl, addrLoc(a)) - else: app(pl, rdLoc(a)) - else: - app(pl, rdLoc(a)) - if i < length - 1: app(pl, ", ") - if typ.sons[0] != nil: - if invalidRetType: - if length > 1: app(pl, ", ") - # beware of 'result = p(result)'. We always allocate a temporary: - if d.k in {locTemp, locNone}: - # We already got a temp. Great, special case it: - if d.k == locNone: getTemp(p, typ.sons[0], d) - app(pl, addrLoc(d)) - app(pl, ")") - app(p.s[cpsStmts], pl) - app(p.s[cpsStmts], ';' & tnl) - else: - var tmp: TLoc - getTemp(p, typ.sons[0], tmp) - app(pl, addrLoc(tmp)) - app(pl, ")") - app(p.s[cpsStmts], pl) - app(p.s[cpsStmts], ';' & tnl) - genAssignment(p, d, tmp, {}) # no need for deep copying - else: - app(pl, ")") - if d.k == locNone: getTemp(p, typ.sons[0], d) - assert(d.t != nil) # generate an assignment to d: - var list: TLoc - initLoc(list, locCall, nil, OnUnknown) - list.r = pl - genAssignment(p, d, list, {}) # no need for deep copying - else: - app(pl, ")") - app(p.s[cpsStmts], pl) - app(p.s[cpsStmts], ';' & tnl) - - when false: - app(pl, ")") - if (typ.sons[0] != nil) and not invalidRetType: - if d.k == locNone: getTemp(p, typ.sons[0], d) - assert(d.t != nil) # generate an assignment to d: - initLoc(list, locCall, nil, OnUnknown) - list.r = pl - genAssignment(p, d, list, {}) # no need for deep copying - else: - app(p.s[cpsStmts], pl) - app(p.s[cpsStmts], ';' & tnl) - -proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = - # <Nimrod code> - # s = 'Hello ' & name & ', how do you feel?' & 'z' - # - # <generated C code> - # { - # string tmp0; - # ... - # tmp0 = rawNewString(6 + 17 + 1 + s2->len); - # // we cannot generate s = rawNewString(...) here, because - # // ``s`` may be used on the right side of the expression - # appendString(tmp0, strlit_1); - # appendString(tmp0, name); - # appendString(tmp0, strlit_2); - # appendChar(tmp0, 'z'); - # asgn(s, tmp0); - # } - var a, tmp: TLoc - getTemp(p, e.typ, tmp) - var L = 0 - var appends: PRope = nil - var lens: PRope = nil - for i in countup(0, sonsLen(e) - 2): - # compute the length expression: - initLocExpr(p, e.sons[i + 1], a) - if skipTypes(e.sons[i + 1].Typ, abstractVarRange).kind == tyChar: - Inc(L) - appcg(p.module, appends, "#appendChar($1, $2);$n", [tmp.r, rdLoc(a)]) - else: - if e.sons[i + 1].kind in {nkStrLit..nkTripleStrLit}: - Inc(L, len(e.sons[i + 1].strVal)) - else: - appf(lens, "$1->Sup.len + ", [rdLoc(a)]) - appcg(p.module, appends, "#appendString($1, $2);$n", [tmp.r, rdLoc(a)]) - appcg(p, cpsStmts, "$1 = #rawNewString($2$3);$n", [tmp.r, lens, toRope(L)]) - app(p.s[cpsStmts], appends) - if d.k == locNone: - d = tmp - else: - genAssignment(p, d, tmp, {}) # no need for deep copying - -proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = - # <Nimrod code> - # s &= 'Hello ' & name & ', how do you feel?' & 'z' - # // BUG: what if s is on the left side too? - # <generated C code> - # { - # s = resizeString(s, 6 + 17 + 1 + name->len); - # appendString(s, strlit_1); - # appendString(s, name); - # appendString(s, strlit_2); - # appendChar(s, 'z'); - # } - var - a, dest: TLoc - L: int - appends, lens: PRope - assert(d.k == locNone) - L = 0 - appends = nil - lens = nil - initLocExpr(p, e.sons[1], dest) - for i in countup(0, sonsLen(e) - 3): - # compute the length expression: - initLocExpr(p, e.sons[i + 2], a) - if skipTypes(e.sons[i + 2].Typ, abstractVarRange).kind == tyChar: - Inc(L) - appcg(p.module, appends, "#appendChar($1, $2);$n", - [rdLoc(dest), rdLoc(a)]) - else: - if e.sons[i + 2].kind in {nkStrLit..nkTripleStrLit}: - Inc(L, len(e.sons[i + 2].strVal)) - else: - appf(lens, "$1->Sup.len + ", [rdLoc(a)]) - appcg(p.module, appends, "#appendString($1, $2);$n", - [rdLoc(dest), rdLoc(a)]) - appcg(p, cpsStmts, "$1 = #resizeString($1, $2$3);$n", - [rdLoc(dest), lens, toRope(L)]) - app(p.s[cpsStmts], appends) - -proc genSeqElemAppend(p: BProc, e: PNode, d: var TLoc) = - # seq &= x --> - # seq = (typeof seq) incrSeq(&seq->Sup, sizeof(x)); - # seq->data[seq->len-1] = x; - var a, b, dest: TLoc - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - appcg(p, cpsStmts, "$1 = ($2) #incrSeq(&($1)->Sup, sizeof($3));$n", [ - rdLoc(a), - getTypeDesc(p.module, skipTypes(e.sons[1].typ, abstractVar)), - getTypeDesc(p.module, skipTypes(e.sons[2].Typ, abstractVar))]) - initLoc(dest, locExpr, b.t, OnHeap) - dest.r = ropef("$1->data[$1->Sup.len-1]", [rdLoc(a)]) - genAssignment(p, dest, b, {needToCopy, afDestIsNil}) - -proc genReset(p: BProc, n: PNode) = - var a: TLoc - InitLocExpr(p, n.sons[1], a) - appcg(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - [addrLoc(a), genTypeInfo(p.module, skipTypes(a.t, abstractVarRange))]) - -proc genNew(p: BProc, e: PNode) = - var - a, b: TLoc - reftype, bt: PType - refType = skipTypes(e.sons[1].typ, abstractVarRange) - InitLocExpr(p, e.sons[1], a) - initLoc(b, locExpr, a.t, OnHeap) - b.r = ropecg(p.module, - "($1) #newObj($2, sizeof($3))", [getTypeDesc(p.module, reftype), - genTypeInfo(p.module, refType), - getTypeDesc(p.module, skipTypes(reftype.sons[0], abstractRange))]) - genAssignment(p, a, b, {}) # set the object type: - bt = skipTypes(refType.sons[0], abstractRange) - genObjectInit(p, cpsStmts, bt, a, false) - -proc genNewSeq(p: BProc, e: PNode) = - var - a, b, c: TLoc - seqtype: PType - seqType = skipTypes(e.sons[1].typ, abstractVarRange) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - initLoc(c, locExpr, a.t, OnHeap) - c.r = ropecg(p.module, "($1) #newSeq($2, $3)", [ - getTypeDesc(p.module, seqtype), - genTypeInfo(p.module, seqType), rdLoc(b)]) - genAssignment(p, a, c, {}) - -proc genIs(p: BProc, x: PNode, typ: PType, d: var TLoc) = - var - a: TLoc - dest, t: PType - r, nilcheck: PRope - initLocExpr(p, x, a) - dest = skipTypes(typ, abstractPtrs) - r = rdLoc(a) - nilCheck = nil - t = skipTypes(a.t, abstractInst) - while t.kind in {tyVar, tyPtr, tyRef}: - if t.kind != tyVar: nilCheck = r - r = ropef("(*$1)", [r]) - t = skipTypes(t.sons[0], abstractInst) - if gCmd != cmdCompileToCpp: - while (t.kind == tyObject) and (t.sons[0] != nil): - app(r, ".Sup") - t = skipTypes(t.sons[0], abstractInst) - if nilCheck != nil: - r = ropecg(p.module, "(($1) && #isObj($2.m_type, $3))", - [nilCheck, r, genTypeInfo(p.module, dest)]) - else: - r = ropecg(p.module, "#isObj($1.m_type, $2)", [r, genTypeInfo(p.module, dest)]) - putIntoDest(p, d, getSysType(tyBool), r) - -proc genIs(p: BProc, n: PNode, d: var TLoc) = - genIs(p, n.sons[1], n.sons[2].typ, d) - -proc genNewFinalize(p: BProc, e: PNode) = - var - a, b, f: TLoc - refType, bt: PType - ti: PRope - oldModule: BModule - refType = skipTypes(e.sons[1].typ, abstractVarRange) - InitLocExpr(p, e.sons[1], a) - # This is a little hack: - # XXX this is also a bug, if the finalizer expression produces side-effects - oldModule = p.module - p.module = gNimDat - InitLocExpr(p, e.sons[2], f) - p.module = oldModule - initLoc(b, locExpr, a.t, OnHeap) - ti = genTypeInfo(p.module, refType) - appf(gNimDat.s[cfsTypeInit3], "$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) - b.r = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ - getTypeDesc(p.module, refType), - ti, getTypeDesc(p.module, skipTypes(reftype.sons[0], abstractRange))]) - genAssignment(p, a, b, {}) # set the object type: - bt = skipTypes(refType.sons[0], abstractRange) - genObjectInit(p, cpsStmts, bt, a, false) - -proc genRepr(p: BProc, e: PNode, d: var TLoc) = - var a: TLoc - InitLocExpr(p, e.sons[1], a) - var t = skipTypes(e.sons[1].typ, abstractVarRange) - case t.kind - of tyInt..tyInt64: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprInt($1)", [rdLoc(a)])) - of tyFloat..tyFloat128: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprFloat($1)", [rdLoc(a)])) - of tyBool: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprBool($1)", [rdLoc(a)])) - of tyChar: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprChar($1)", [rdLoc(a)])) - of tyEnum, tyOrdinal: - putIntoDest(p, d, e.typ, - ropecg(p.module, "#reprEnum($1, $2)", [ - rdLoc(a), genTypeInfo(p.module, t)])) - of tyString: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprStr($1)", [rdLoc(a)])) - of tySet: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprSet($1, $2)", [ - addrLoc(a), genTypeInfo(p.module, t)])) - of tyOpenArray: - var b: TLoc - case a.t.kind - of tyOpenArray: putIntoDest(p, b, e.typ, rdLoc(a)) - of tyString, tySequence: - putIntoDest(p, b, e.typ, ropef("$1->data, $1->Sup.len", [rdLoc(a)])) - of tyArray, tyArrayConstr: - putIntoDest(p, b, e.typ, - ropef("$1, $2", [rdLoc(a), toRope(lengthOrd(a.t))])) - else: InternalError(e.sons[0].info, "genRepr()") - putIntoDest(p, d, e.typ, - ropecg(p.module, "#reprOpenArray($1, $2)", [rdLoc(b), - genTypeInfo(p.module, elemType(t))])) - of tyCString, tyArray, tyArrayConstr, tyRef, tyPtr, tyPointer, tyNil, - tySequence: - putIntoDest(p, d, e.typ, - ropecg(p.module, "#reprAny($1, $2)", [ - rdLoc(a), genTypeInfo(p.module, t)])) - else: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprAny($1, $2)", - [addrLoc(a), genTypeInfo(p.module, t)])) - -proc genDollar(p: BProc, n: PNode, d: var TLoc, frmt: string) = - var a: TLoc - InitLocExpr(p, n.sons[1], a) - a.r = ropecg(p.module, frmt, [rdLoc(a)]) - if d.k == locNone: getTemp(p, n.typ, d) - genAssignment(p, d, a, {}) - -proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - var typ = skipTypes(e.sons[1].Typ, abstractPtrs) - case typ.kind - of tyOpenArray: - while e.sons[1].kind == nkPassAsOpenArray: e.sons[1] = e.sons[1].sons[0] - if op == mHigh: unaryExpr(p, e, d, "($1Len0-1)") - else: unaryExpr(p, e, d, "$1Len0") - of tyCstring: - if op == mHigh: unaryExpr(p, e, d, "(strlen($1)-1)") - else: unaryExpr(p, e, d, "strlen($1)") - of tyString, tySequence: - if op == mHigh: unaryExpr(p, e, d, "($1->Sup.len-1)") - else: unaryExpr(p, e, d, "$1->Sup.len") - of tyArray, tyArrayConstr: - # YYY: length(sideeffect) is optimized away incorrectly? - if op == mHigh: putIntoDest(p, d, e.typ, toRope(lastOrd(Typ))) - else: putIntoDest(p, d, e.typ, toRope(lengthOrd(typ))) - else: InternalError(e.info, "genArrayLen()") - -proc genSetLengthSeq(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - assert(d.k == locNone) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - var t = skipTypes(e.sons[1].typ, abstractVar) - appcg(p, cpsStmts, "$1 = ($3) #setLengthSeq(&($1)->Sup, sizeof($4), $2);$n", [ - rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), - getTypeDesc(p.module, t.sons[0])]) - -proc genSetLengthStr(p: BProc, e: PNode, d: var TLoc) = - binaryStmt(p, e, d, "$1 = #setLengthStr($1, $2);$n") - -proc genSwap(p: BProc, e: PNode, d: var TLoc) = - # swap(a, b) --> - # temp = a - # a = b - # b = temp - var a, b, tmp: TLoc - getTemp(p, skipTypes(e.sons[1].typ, abstractVar), tmp) - InitLocExpr(p, e.sons[1], a) # eval a - InitLocExpr(p, e.sons[2], b) # eval b - genAssignment(p, tmp, a, {}) - genAssignment(p, a, b, {}) - genAssignment(p, b, tmp, {}) - -proc rdSetElemLoc(a: TLoc, setType: PType): PRope = - # read a location of an set element; it may need a substraction operation - # before the set operation - result = rdCharLoc(a) - assert(setType.kind == tySet) - if (firstOrd(setType) != 0): - result = ropef("($1-$2)", [result, toRope(firstOrd(setType))]) - -proc fewCmps(s: PNode): bool = - # this function estimates whether it is better to emit code - # for constructing the set or generating a bunch of comparisons directly - if s.kind != nkCurly: InternalError(s.info, "fewCmps") - if (getSize(s.typ) <= platform.intSize) and (nfAllConst in s.flags): - result = false # it is better to emit the set generation code - elif elemType(s.typ).Kind in {tyInt, tyInt16..tyInt64}: - result = true # better not emit the set if int is basetype! - else: - result = sonsLen(s) <= 8 # 8 seems to be a good value - -proc binaryExprIn(p: BProc, e: PNode, a, b, d: var TLoc, frmt: string) = - putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdSetElemLoc(b, a.t)])) - -proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) = - case int(getSize(skipTypes(e.sons[1].typ, abstractVar))) - of 1: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&7)))!=0)") - of 2: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&15)))!=0)") - of 4: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&31)))!=0)") - of 8: binaryExprIn(p, e, a, b, d, "(($1 &(IL64(1)<<(($2)&IL64(63))))!=0)") - else: binaryExprIn(p, e, a, b, d, "(($1[$2/8] &(1<<($2%8)))!=0)") - -proc binaryStmtInExcl(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - assert(d.k == locNone) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - appf(p.s[cpsStmts], frmt, [rdLoc(a), rdSetElemLoc(b, a.t)]) - -proc genInOp(p: BProc, e: PNode, d: var TLoc) = - var a, b, x, y: TLoc - if (e.sons[1].Kind == nkCurly) and fewCmps(e.sons[1]): - # a set constructor but not a constant set: - # do not emit the set, but generate a bunch of comparisons - initLocExpr(p, e.sons[2], a) - initLoc(b, locExpr, e.typ, OnUnknown) - b.r = toRope("(") - var length = sonsLen(e.sons[1]) - for i in countup(0, length - 1): - if e.sons[1].sons[i].Kind == nkRange: - InitLocExpr(p, e.sons[1].sons[i].sons[0], x) - InitLocExpr(p, e.sons[1].sons[i].sons[1], y) - appf(b.r, "$1 >= $2 && $1 <= $3", - [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) - else: - InitLocExpr(p, e.sons[1].sons[i], x) - appf(b.r, "$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) - if i < length - 1: app(b.r, " || ") - app(b.r, ")") - putIntoDest(p, d, e.typ, b.r) - else: - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - genInExprAux(p, e, a, b, d) - -proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - const - lookupOpr: array[mLeSet..mSymDiffSet, string] = [ - "for ($1 = 0; $1 < $2; $1++) { $n" & - " $3 = (($4[$1] & ~ $5[$1]) == 0);$n" & - " if (!$3) break;}$n", "for ($1 = 0; $1 < $2; $1++) { $n" & - " $3 = (($4[$1] & ~ $5[$1]) == 0);$n" & " if (!$3) break;}$n" & - "if ($3) $3 = (memcmp($4, $5, $2) != 0);$n", - "&", "|", "& ~", "^"] - var a, b, i: TLoc - var setType = skipTypes(e.sons[1].Typ, abstractVar) - var size = int(getSize(setType)) - case size - of 1, 2, 4, 8: - case op - of mIncl: - var ts = "NI" & $(size * 8) - binaryStmtInExcl(p, e, d, - "$1 |=(1<<((" & ts & ")($2)%(sizeof(" & ts & ")*8)));$n") - of mExcl: - var ts = "NI" & $(size * 8) - binaryStmtInExcl(p, e, d, "$1 &= ~(1 << ((" & ts & ")($2) % (sizeof(" & - ts & ")*8)));$n") - of mCard: - if size <= 4: unaryExprChar(p, e, d, "#countBits32($1)") - else: unaryExprChar(p, e, d, "#countBits64($1)") - of mLtSet: binaryExprChar(p, e, d, "(($1 & ~ $2 ==0)&&($1 != $2))") - of mLeSet: binaryExprChar(p, e, d, "(($1 & ~ $2)==0)") - of mEqSet: binaryExpr(p, e, d, "($1 == $2)") - of mMulSet: binaryExpr(p, e, d, "($1 & $2)") - of mPlusSet: binaryExpr(p, e, d, "($1 | $2)") - of mMinusSet: binaryExpr(p, e, d, "($1 & ~ $2)") - of mSymDiffSet: binaryExpr(p, e, d, "($1 ^ $2)") - of mInSet: - genInOp(p, e, d) - else: internalError(e.info, "genSetOp()") - else: - case op - of mIncl: binaryStmtInExcl(p, e, d, "$1[$2/8] |=(1<<($2%8));$n") - of mExcl: binaryStmtInExcl(p, e, d, "$1[$2/8] &= ~(1<<($2%8));$n") - of mCard: unaryExprChar(p, e, d, "#cardSet($1, " & $size & ')') - of mLtSet, mLeSet: - getTemp(p, getSysType(tyInt), i) # our counter - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) - if d.k == locNone: getTemp(p, a.t, d) - appf(p.s[cpsStmts], lookupOpr[op], - [rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b)]) - of mEqSet: - binaryExprChar(p, e, d, "(memcmp($1, $2, " & $(size) & ")==0)") - of mMulSet, mPlusSet, mMinusSet, mSymDiffSet: - # we inline the simple for loop for better code generation: - getTemp(p, getSysType(tyInt), i) # our counter - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) - if d.k == locNone: getTemp(p, a.t, d) - appf(p.s[cpsStmts], - "for ($1 = 0; $1 < $2; $1++) $n" & - " $3[$1] = $4[$1] $6 $5[$1];$n", [ - rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b), - toRope(lookupOpr[op])]) - of mInSet: genInOp(p, e, d) - else: internalError(e.info, "genSetOp") - -proc genOrd(p: BProc, e: PNode, d: var TLoc) = - unaryExprChar(p, e, d, "$1") - -proc genCast(p: BProc, e: PNode, d: var TLoc) = - const - ValueTypes = {tyTuple, tyObject, tyArray, tyOpenArray, tyArrayConstr} - # we use whatever C gives us. Except if we have a value-type, we need to go - # through its address: - var a: TLoc - InitLocExpr(p, e.sons[1], a) - if (skipTypes(e.typ, abstractRange).kind in ValueTypes) and - not (lfIndirect in a.flags): - putIntoDest(p, d, e.typ, ropef("(*($1*) ($2))", - [getTypeDesc(p.module, e.typ), addrLoc(a)])) - else: - putIntoDest(p, d, e.typ, ropef("(($1) ($2))", - [getTypeDesc(p.module, e.typ), rdCharLoc(a)])) - -proc genRangeChck(p: BProc, n: PNode, d: var TLoc, magic: string) = - var a: TLoc - var dest = skipTypes(n.typ, abstractVar) - if optRangeCheck notin p.options: - InitLocExpr(p, n.sons[0], a) - putIntoDest(p, d, n.typ, ropef("(($1) ($2))", - [getTypeDesc(p.module, dest), rdCharLoc(a)])) - else: - InitLocExpr(p, n.sons[0], a) - putIntoDest(p, d, dest, ropecg(p.module, "(($1)#$5($2, $3, $4))", [ - getTypeDesc(p.module, dest), rdCharLoc(a), - genLiteral(p, n.sons[1], dest), genLiteral(p, n.sons[2], dest), - toRope(magic)])) - -proc genConv(p: BProc, e: PNode, d: var TLoc) = - genCast(p, e, d) - -proc passToOpenArray(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc - while n.sons[0].kind == nkPassAsOpenArray: - n.sons[0] = n.sons[0].sons[0] # BUGFIX - var dest = skipTypes(n.typ, abstractVar) - case skipTypes(n.sons[0].typ, abstractVar).kind - of tyOpenArray: - initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, dest, ropef("$1, $1Len0", [rdLoc(a)])) - of tyString, tySequence: - initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, dest, ropef("$1->data, $1->Sup.len", [rdLoc(a)])) - of tyArray, tyArrayConstr: - initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, dest, ropef("$1, $2", [rdLoc(a), toRope(lengthOrd(a.t))])) - else: InternalError(n.sons[0].info, "passToOpenArray: " & typeToString(a.t)) - -proc convStrToCStr(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc - initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, skipTypes(n.typ, abstractVar), ropef("$1->data", [rdLoc(a)])) - -proc convCStrToStr(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc - initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, skipTypes(n.typ, abstractVar), - ropecg(p.module, "#cstrToNimstr($1)", [rdLoc(a)])) - -proc genStrEquals(p: BProc, e: PNode, d: var TLoc) = - var x: TLoc - var a = e.sons[1] - var b = e.sons[2] - if (a.kind == nkNilLit) or (b.kind == nkNilLit): - binaryExpr(p, e, d, "($1 == $2)") - elif (a.kind in {nkStrLit..nkTripleStrLit}) and (a.strVal == ""): - initLocExpr(p, e.sons[2], x) - putIntoDest(p, d, e.typ, ropef("(($1) && ($1)->Sup.len == 0)", [rdLoc(x)])) - elif (b.kind in {nkStrLit..nkTripleStrLit}) and (b.strVal == ""): - initLocExpr(p, e.sons[1], x) - putIntoDest(p, d, e.typ, ropef("(($1) && ($1)->Sup.len == 0)", [rdLoc(x)])) - else: - binaryExpr(p, e, d, "#eqStrings($1, $2)") - -proc genSeqConstr(p: BProc, t: PNode, d: var TLoc) = - var newSeq, arr: TLoc - if d.k == locNone: - getTemp(p, t.typ, d) - # generate call to newSeq before adding the elements per hand: - initLoc(newSeq, locExpr, t.typ, OnHeap) - newSeq.r = ropecg(p.module, "($1) #newSeq($2, $3)", - [getTypeDesc(p.module, t.typ), - genTypeInfo(p.module, t.typ), intLiteral(sonsLen(t))]) - genAssignment(p, d, newSeq, {afSrcIsNotNil}) - for i in countup(0, sonsLen(t) - 1): - initLoc(arr, locExpr, elemType(skipTypes(t.typ, abstractInst)), OnHeap) - arr.r = ropef("$1->data[$2]", [rdLoc(d), intLiteral(i)]) - arr.s = OnHeap # we know that sequences are on the heap - expr(p, t.sons[i], arr) - -proc genArrToSeq(p: BProc, t: PNode, d: var TLoc) = - var newSeq, elem, a, arr: TLoc - if t.kind == nkBracket: - t.sons[1].typ = t.typ - genSeqConstr(p, t.sons[1], d) - return - if d.k == locNone: - getTemp(p, t.typ, d) - # generate call to newSeq before adding the elements per hand: - var L = int(lengthOrd(t.sons[1].typ)) - initLoc(newSeq, locExpr, t.typ, OnHeap) - newSeq.r = ropecg(p.module, "($1) #newSeq($2, $3)", - [getTypeDesc(p.module, t.typ), - genTypeInfo(p.module, t.typ), intLiteral(L)]) - genAssignment(p, d, newSeq, {afSrcIsNotNil}) - initLocExpr(p, t.sons[1], a) - for i in countup(0, L - 1): - initLoc(elem, locExpr, elemType(skipTypes(t.typ, abstractInst)), OnHeap) - elem.r = ropef("$1->data[$2]", [rdLoc(d), intLiteral(i)]) - elem.s = OnHeap # we know that sequences are on the heap - initLoc(arr, locExpr, elemType(skipTypes(t.sons[1].typ, abstractInst)), a.s) - arr.r = ropef("$1[$2]", [rdLoc(a), intLiteral(i)]) - genAssignment(p, elem, arr, {afDestIsNil, needToCopy}) - -proc binaryFloatArith(p: BProc, e: PNode, d: var TLoc, m: TMagic) = - if {optNanCheck, optInfCheck} * p.options != {}: - const opr: array[mAddF64..mDivF64, string] = ["+", "-", "*", "/"] - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - putIntoDest(p, d, e.typ, ropef("($2 $1 $3)", [ - toRope(opr[m]), rdLoc(a), rdLoc(b)])) - if optNanCheck in p.options: - appcg(p, cpsStmts, "#nanCheck($1);$n", [rdLoc(d)]) - if optInfCheck in p.options: - appcg(p, cpsStmts, "#infCheck($1);$n", [rdLoc(d)]) - else: - binaryArith(p, e, d, m) - -proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - var line, filen: PRope - case op - of mOr, mAnd: genAndOr(p, e, d, op) - of mNot..mToBiggestInt: unaryArith(p, e, d, op) - of mUnaryMinusI..mAbsI64: unaryArithOverflow(p, e, d, op) - of mAddF64..mDivF64: binaryFloatArith(p, e, d, op) - of mShrI..mXor: binaryArith(p, e, d, op) - of mAddi..mModi64: binaryArithOverflow(p, e, d, op) - of mRepr: genRepr(p, e, d) - of mSwap: genSwap(p, e, d) - of mUnaryLt: - if not (optOverflowCheck in p.Options): unaryExpr(p, e, d, "$1 - 1") - else: unaryExpr(p, e, d, "#subInt($1, 1)") - of mPred: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, e, d, "$1 - $2") - else: binaryExpr(p, e, d, "#subInt($1, $2)") - of mSucc: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, e, d, "$1 + $2") - else: binaryExpr(p, e, d, "#addInt($1, $2)") - of mInc: - if not (optOverflowCheck in p.Options): - binaryStmt(p, e, d, "$1 += $2;$n") - elif skipTypes(e.sons[1].typ, abstractVar).kind == tyInt64: - binaryStmt(p, e, d, "$1 = #addInt64($1, $2);$n") - else: - binaryStmt(p, e, d, "$1 = #addInt($1, $2);$n") - of ast.mDec: - if not (optOverflowCheck in p.Options): - binaryStmt(p, e, d, "$1 -= $2;$n") - elif skipTypes(e.sons[1].typ, abstractVar).kind == tyInt64: - binaryStmt(p, e, d, "$1 = #subInt64($1, $2);$n") - else: - binaryStmt(p, e, d, "$1 = #subInt($1, $2);$n") - of mConStrStr: genStrConcat(p, e, d) - of mAppendStrCh: binaryStmt(p, e, d, "$1 = #addChar($1, $2);$n") - of mAppendStrStr: genStrAppend(p, e, d) - of mAppendSeqElem: genSeqElemAppend(p, e, d) - of mEqStr: genStrEquals(p, e, d) - of mLeStr: binaryExpr(p, e, d, "(#cmpStrings($1, $2) <= 0)") - of mLtStr: binaryExpr(p, e, d, "(#cmpStrings($1, $2) < 0)") - of mIsNil: unaryExpr(p, e, d, "$1 == 0") - of mIntToStr: genDollar(p, e, d, "#nimIntToStr($1)") - of mInt64ToStr: genDollar(p, e, d, "#nimInt64ToStr($1)") - of mBoolToStr: genDollar(p, e, d, "#nimBoolToStr($1)") - of mCharToStr: genDollar(p, e, d, "#nimCharToStr($1)") - of mFloatToStr: genDollar(p, e, d, "#nimFloatToStr($1)") - of mCStrToStr: genDollar(p, e, d, "#cstrToNimstr($1)") - of mStrToStr: expr(p, e.sons[1], d) - of mEnumToStr: genRepr(p, e, d) - of mAssert: - if (optAssert in p.Options): - expr(p, e.sons[1], d) - line = toRope(toLinenumber(e.info)) - filen = makeCString(ToFilename(e.info)) - appcg(p, cpsStmts, "#internalAssert($1, $2, $3);$n", - [filen, line, rdLoc(d)]) - of mIs: genIs(p, e, d) - of mNew: genNew(p, e) - of mNewFinalize: genNewFinalize(p, e) - of mNewSeq: genNewSeq(p, e) - of mSizeOf: - putIntoDest(p, d, e.typ, ropef("((NI)sizeof($1))", - [getTypeDesc(p.module, e.sons[1].typ)])) - of mChr: genCast(p, e, d) - of mOrd: genOrd(p, e, d) - of mLengthArray, mHigh, mLengthStr, mLengthSeq, mLengthOpenArray: - genArrayLen(p, e, d, op) - of mGCref: unaryStmt(p, e, d, "#nimGCref($1);$n") - of mGCunref: unaryStmt(p, e, d, "#nimGCunref($1);$n") - of mSetLengthStr: genSetLengthStr(p, e, d) - of mSetLengthSeq: genSetLengthSeq(p, e, d) - of mIncl, mExcl, mCard, mLtSet, mLeSet, mEqSet, mMulSet, mPlusSet, mMinusSet, - mInSet: - genSetOp(p, e, d, op) - of mNewString, mCopyStr, mCopyStrLast, mExit: genCall(p, e, d) - of mReset: genReset(p, e) - of mEcho: genEcho(p, e) - of mArrToSeq: genArrToSeq(p, e, d) - of mNLen..mNError: - localError(e.info, errCannotGenerateCodeForX, e.sons[0].sym.name.s) - else: internalError(e.info, "genMagicExpr: " & $op) - -proc genConstExpr(p: BProc, n: PNode): PRope -proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = - if (nfAllConst in n.flags) and (d.k == locNone) and (sonsLen(n) > 0): - var t = getUniqueType(n.typ) - discard getTypeDesc(p.module, t) # so that any fields are initialized - var id = NodeTableTestOrSet(p.module.dataCache, n, gid) - fillLoc(d, locData, t, con("TMP", toRope(id)), OnHeap) - if id == gid: - # expression not found in the cache: - inc(gid) - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, t), d.r, genConstExpr(p, n)]) - result = true - else: - result = false - -proc genSetConstr(p: BProc, e: PNode, d: var TLoc) = - # example: { a..b, c, d, e, f..g } - # we have to emit an expression of the form: - # memset(tmp, 0, sizeof(tmp)); inclRange(tmp, a, b); incl(tmp, c); - # incl(tmp, d); incl(tmp, e); inclRange(tmp, f, g); - var - a, b, idx: TLoc - ts: string - if nfAllConst in e.flags: - putIntoDest(p, d, e.typ, genSetNode(p, e)) - else: - if d.k == locNone: getTemp(p, e.typ, d) - if getSize(e.typ) > 8: - # big set: - appf(p.s[cpsStmts], "memset($1, 0, sizeof($1));$n", [rdLoc(d)]) - for i in countup(0, sonsLen(e) - 1): - if e.sons[i].kind == nkRange: - getTemp(p, getSysType(tyInt), idx) # our counter - initLocExpr(p, e.sons[i].sons[0], a) - initLocExpr(p, e.sons[i].sons[1], b) - appf(p.s[cpsStmts], "for ($1 = $3; $1 <= $4; $1++) $n" & - "$2[$1/8] |=(1<<($1%8));$n", [rdLoc(idx), rdLoc(d), - rdSetElemLoc(a, e.typ), rdSetElemLoc(b, e.typ)]) - else: - initLocExpr(p, e.sons[i], a) - appf(p.s[cpsStmts], "$1[$2/8] |=(1<<($2%8));$n", - [rdLoc(d), rdSetElemLoc(a, e.typ)]) - else: - # small set - ts = "NI" & $(getSize(e.typ) * 8) - appf(p.s[cpsStmts], "$1 = 0;$n", [rdLoc(d)]) - for i in countup(0, sonsLen(e) - 1): - if e.sons[i].kind == nkRange: - getTemp(p, getSysType(tyInt), idx) # our counter - initLocExpr(p, e.sons[i].sons[0], a) - initLocExpr(p, e.sons[i].sons[1], b) - appf(p.s[cpsStmts], "for ($1 = $3; $1 <= $4; $1++) $n" & - "$2 |=(1<<((" & ts & ")($1)%(sizeof(" & ts & ")*8)));$n", [ - rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), - rdSetElemLoc(b, e.typ)]) - else: - initLocExpr(p, e.sons[i], a) - appf(p.s[cpsStmts], - "$1 |=(1<<((" & ts & ")($2)%(sizeof(" & ts & ")*8)));$n", - [rdLoc(d), rdSetElemLoc(a, e.typ)]) - -proc genTupleConstr(p: BProc, n: PNode, d: var TLoc) = - var rec: TLoc - if not handleConstExpr(p, n, d): - var t = getUniqueType(n.typ) - discard getTypeDesc(p.module, t) # so that any fields are initialized - if d.k == locNone: getTemp(p, t, d) - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if it.kind == nkExprColonExpr: - initLoc(rec, locExpr, it.sons[1].typ, d.s) - if (t.n.sons[i].kind != nkSym): InternalError(n.info, "genTupleConstr") - rec.r = ropef("$1.$2", - [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]) - expr(p, it.sons[1], rec) - elif t.n == nil: - initLoc(rec, locExpr, it.typ, d.s) - rec.r = ropef("$1.Field$2", [rdLoc(d), toRope(i)]) - expr(p, it, rec) - else: - initLoc(rec, locExpr, it.typ, d.s) - if (t.n.sons[i].kind != nkSym): - InternalError(n.info, "genTupleConstr: 2") - rec.r = ropef("$1.$2", - [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]) - expr(p, it, rec) - -proc genArrayConstr(p: BProc, n: PNode, d: var TLoc) = - var arr: TLoc - if not handleConstExpr(p, n, d): - if d.k == locNone: getTemp(p, n.typ, d) - for i in countup(0, sonsLen(n) - 1): - initLoc(arr, locExpr, elemType(skipTypes(n.typ, abstractInst)), d.s) - arr.r = ropef("$1[$2]", [rdLoc(d), intLiteral(i)]) - expr(p, n.sons[i], arr) - -proc genComplexConst(p: BProc, sym: PSym, d: var TLoc) = - genConstPrototype(p.module, sym) - assert((sym.loc.r != nil) and (sym.loc.t != nil)) - putLocIntoDest(p, d, sym.loc) - -proc genStmtListExpr(p: BProc, n: PNode, d: var TLoc) = - var length = sonsLen(n) - for i in countup(0, length - 2): genStmts(p, n.sons[i]) - if length > 0: expr(p, n.sons[length - 1], d) - -proc upConv(p: BProc, n: PNode, d: var TLoc) = - var - a: TLoc - dest, t: PType - r, nilCheck: PRope - initLocExpr(p, n.sons[0], a) - dest = skipTypes(n.typ, abstractPtrs) - if (optObjCheck in p.options) and not (isPureObject(dest)): - r = rdLoc(a) - nilCheck = nil - t = skipTypes(a.t, abstractInst) - while t.kind in {tyVar, tyPtr, tyRef}: - if t.kind != tyVar: nilCheck = r - r = ropef("(*$1)", [r]) - t = skipTypes(t.sons[0], abstractInst) - if gCmd != cmdCompileToCpp: - while (t.kind == tyObject) and (t.sons[0] != nil): - app(r, ".Sup") - t = skipTypes(t.sons[0], abstractInst) - if nilCheck != nil: - appcg(p, cpsStmts, "if ($1) #chckObj($2.m_type, $3);$n", - [nilCheck, r, genTypeInfo(p.module, dest)]) - else: - appcg(p, cpsStmts, "#chckObj($1.m_type, $2);$n", - [r, genTypeInfo(p.module, dest)]) - if n.sons[0].typ.kind != tyObject: - putIntoDest(p, d, n.typ, - ropef("(($1) ($2))", [getTypeDesc(p.module, n.typ), rdLoc(a)])) - else: - putIntoDest(p, d, n.typ, ropef("(*($1*) ($2))", - [getTypeDesc(p.module, dest), addrLoc(a)])) - -proc downConv(p: BProc, n: PNode, d: var TLoc) = - if gCmd == cmdCompileToCpp: - expr(p, n.sons[0], d) # downcast does C++ for us - else: - var dest = skipTypes(n.typ, abstractPtrs) - var src = skipTypes(n.sons[0].typ, abstractPtrs) - var a: TLoc - initLocExpr(p, n.sons[0], a) - var r = rdLoc(a) - if skipTypes(n.sons[0].typ, abstractInst).kind in {tyRef, tyPtr, tyVar}: - app(r, "->Sup") - for i in countup(2, abs(inheritanceDiff(dest, src))): app(r, ".Sup") - r = con("&", r) - else: - for i in countup(1, abs(inheritanceDiff(dest, src))): app(r, ".Sup") - putIntoDest(p, d, n.typ, r) - -proc genBlock(p: BProc, t: PNode, d: var TLoc) -proc expr(p: BProc, e: PNode, d: var TLoc) = - case e.kind - of nkSym: - var sym = e.sym - case sym.Kind - of skMethod: - if sym.ast.sons[codePos].kind == nkEmpty: - # we cannot produce code for the dispatcher yet: - fillProcLoc(sym) - genProcPrototype(p.module, sym) - else: - genProc(p.module, sym) - putLocIntoDest(p, d, sym.loc) - of skProc, skConverter: - genProc(p.module, sym) - if ((sym.loc.r == nil) or (sym.loc.t == nil)): - InternalError(e.info, "expr: proc not init " & sym.name.s) - putLocIntoDest(p, d, sym.loc) - of skConst: - if isSimpleConst(sym.typ): - putIntoDest(p, d, e.typ, genLiteral(p, sym.ast, sym.typ)) - else: - genComplexConst(p, sym, d) - of skEnumField: - putIntoDest(p, d, e.typ, toRope(sym.position)) - of skVar: - if (sfGlobal in sym.flags): genVarPrototype(p.module, sym) - if ((sym.loc.r == nil) or (sym.loc.t == nil)): - InternalError(e.info, "expr: var not init " & sym.name.s) - putLocIntoDest(p, d, sym.loc) - of skForVar, skTemp: - if ((sym.loc.r == nil) or (sym.loc.t == nil)): - InternalError(e.info, "expr: temp not init " & sym.name.s) - putLocIntoDest(p, d, sym.loc) - of skParam: - if ((sym.loc.r == nil) or (sym.loc.t == nil)): - InternalError(e.info, "expr: param not init " & sym.name.s) - putLocIntoDest(p, d, sym.loc) - else: InternalError(e.info, "expr(" & $sym.kind & "); unknown symbol") - of nkStrLit..nkTripleStrLit, nkIntLit..nkInt64Lit, nkFloatLit..nkFloat64Lit, - nkNilLit, nkCharLit: - putIntoDest(p, d, e.typ, genLiteral(p, e)) - of nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand, - nkCallStrLit: - if (e.sons[0].kind == nkSym) and (e.sons[0].sym.magic != mNone): - genMagicExpr(p, e, d, e.sons[0].sym.magic) - else: - genCall(p, e, d) - of nkCurly: genSetConstr(p, e, d) - of nkBracket: - if (skipTypes(e.typ, abstractVarRange).kind == tySequence): - genSeqConstr(p, e, d) - else: - genArrayConstr(p, e, d) - of nkPar: genTupleConstr(p, e, d) - of nkCast: genCast(p, e, d) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, e, d) - of nkHiddenAddr, nkAddr: genAddr(p, e, d) - of nkBracketExpr: - var ty = skipTypes(e.sons[0].typ, abstractVarRange) - if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.sons[0], abstractVarRange) - case ty.kind - of tyArray, tyArrayConstr: genArrayElem(p, e, d) - of tyOpenArray: genOpenArrayElem(p, e, d) - of tySequence, tyString: genSeqElem(p, e, d) - of tyCString: genCStringElem(p, e, d) - of tyTuple: genTupleElem(p, e, d) - else: InternalError(e.info, "expr(nkBracketExpr, " & $ty.kind & ')') - of nkDerefExpr, nkHiddenDeref: genDeref(p, e, d) - of nkDotExpr: genRecordField(p, e, d) - of nkCheckedFieldExpr: genCheckedRecordField(p, e, d) - of nkBlockExpr: genBlock(p, e, d) - of nkStmtListExpr: genStmtListExpr(p, e, d) - of nkIfExpr: genIfExpr(p, e, d) - of nkObjDownConv: downConv(p, e, d) - of nkObjUpConv: upConv(p, e, d) - of nkChckRangeF: genRangeChck(p, e, d, "chckRangeF") - of nkChckRange64: genRangeChck(p, e, d, "chckRange64") - of nkChckRange: genRangeChck(p, e, d, "chckRange") - of nkStringToCString: convStrToCStr(p, e, d) - of nkCStringToString: convCStrToStr(p, e, d) - of nkPassAsOpenArray: passToOpenArray(p, e, d) - else: InternalError(e.info, "expr(" & $e.kind & "); unknown node kind") - -proc genNamedConstExpr(p: BProc, n: PNode): PRope = - if n.kind == nkExprColonExpr: result = genConstExpr(p, n.sons[1]) - else: result = genConstExpr(p, n) - -proc genConstSimpleList(p: BProc, n: PNode): PRope = - var length = sonsLen(n) - result = toRope("{") - for i in countup(0, length - 2): - appf(result, "$1,$n", [genNamedConstExpr(p, n.sons[i])]) - if length > 0: app(result, genNamedConstExpr(p, n.sons[length - 1])) - app(result, '}' & tnl) - -proc genConstExpr(p: BProc, n: PNode): PRope = - case n.Kind - of nkHiddenStdConv, nkHiddenSubConv: - result = genConstExpr(p, n.sons[1]) - of nkCurly: - var cs: TBitSet - toBitSet(n, cs) - result = genRawSetData(cs, int(getSize(n.typ))) - of nkBracket, nkPar: - # XXX: tySequence! - result = genConstSimpleList(p, n) - else: - # result := genLiteral(p, n) - var d: TLoc - initLocExpr(p, n, d) - result = rdLoc(d) diff --git a/rod/ccgstmts.nim b/rod/ccgstmts.nim deleted file mode 100755 index 81a042f25..000000000 --- a/rod/ccgstmts.nim +++ /dev/null @@ -1,725 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -const - RangeExpandLimit = 256 # do not generate ranges - # over 'RangeExpandLimit' elements - stringCaseThreshold = 8 - # above X strings a hash-switch for strings is generated - # this version sets it too high to avoid hashing, because this has not - # been tested for a long time - -proc genLineDir(p: BProc, t: PNode) = - var line = toLinenumber(t.info) # BUGFIX - if line < 0: - line = 0 # negative numbers are not allowed in #line - if optLineDir in p.Options: - appff(p.s[cpsStmts], "#line $2 \"$1\"$n", "; line $2 \"$1\"$n", - [toRope(toFilename(t.info)), toRope(line)]) - if ({optStackTrace, optEndb} * p.Options == {optStackTrace, optEndb}) and - ((p.prc == nil) or not (sfPure in p.prc.flags)): - appcg(p, cpsStmts, "#endb($1);$n", [toRope(line)]) - elif ({optLineTrace, optStackTrace} * p.Options == - {optLineTrace, optStackTrace}) and - ((p.prc == nil) or not (sfPure in p.prc.flags)): - appf(p.s[cpsStmts], "F.line = $1;F.filename = $2;$n", - [toRope(line), makeCString(toFilename(t.info).extractFilename)]) - -proc genVarTuple(p: BProc, n: PNode) = - var - L: int - v: PSym - tup, field: TLoc - t: PType - if n.kind != nkVarTuple: InternalError(n.info, "genVarTuple") - L = sonsLen(n) - genLineDir(p, n) - initLocExpr(p, n.sons[L - 1], tup) - t = tup.t - for i in countup(0, L - 3): - v = n.sons[i].sym - if sfGlobal in v.flags: - assignGlobalVar(p, v) - genObjectInit(p, cpsInit, v.typ, v.loc, true) - else: - assignLocalVar(p, v) - initVariable(p, v) - initLoc(field, locExpr, t.sons[i], tup.s) - if t.n == nil: - field.r = ropef("$1.Field$2", [rdLoc(tup), toRope(i)]) - else: - if (t.n.sons[i].kind != nkSym): InternalError(n.info, "genVarTuple") - field.r = ropef("$1.$2", - [rdLoc(tup), mangleRecFieldName(t.n.sons[i].sym, t)]) - putLocIntoDest(p, v.loc, field) - -proc genVarStmt(p: BProc, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.kind == nkIdentDefs: - assert(a.sons[0].kind == nkSym) - var v = a.sons[0].sym - if sfGlobal in v.flags: - assignGlobalVar(p, v) - genObjectInit(p, cpsInit, v.typ, v.loc, true) - else: - assignLocalVar(p, v) - initVariable(p, v) - if a.sons[2].kind != nkEmpty: - genLineDir(p, a) - expr(p, a.sons[2], v.loc) - else: - genVarTuple(p, a) - -proc genConstStmt(p: BProc, t: PNode) = - for i in countup(0, sonsLen(t) - 1): - if t.sons[i].kind == nkCommentStmt: continue - if t.sons[i].kind != nkConstDef: InternalError(t.info, "genConstStmt") - var c = t.sons[i].sons[0].sym - assert c != nil - assert c.typ != nil - if c.typ.kind in ConstantDataTypes and not (lfNoDecl in c.loc.flags): - # generate the data: - fillLoc(c.loc, locData, c.typ, mangleName(c), OnUnknown) - if sfImportc in c.flags: - appf(p.module.s[cfsData], "extern NIM_CONST $1 $2;$n", - [getTypeDesc(p.module, c.typ), c.loc.r]) - else: - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, c.typ), c.loc.r, genConstExpr(p, c.ast)]) - -proc genIfStmt(p: BProc, n: PNode) = - # - # if (!expr1) goto L1; - # thenPart - # goto LEnd - # L1: - # if (!expr2) goto L2; - # thenPart2 - # goto LEnd - # L2: - # elsePart - # Lend: - # - var - a: TLoc - Lelse: TLabel - genLineDir(p, n) - var Lend = getLabel(p) - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkElifBranch: - initLocExpr(p, it.sons[0], a) - Lelse = getLabel(p) - inc(p.labels) - appff(p.s[cpsStmts], "if (!$1) goto $2;$n", - "br i1 $1, label %LOC$3, label %$2$n" & "LOC$3: $n", - [rdLoc(a), Lelse, toRope(p.labels)]) - genStmts(p, it.sons[1]) - if sonsLen(n) > 1: - appff(p.s[cpsStmts], "goto $1;$n", "br label %$1$n", [Lend]) - fixLabel(p, Lelse) - of nkElse: - genStmts(p, it.sons[0]) - else: internalError(n.info, "genIfStmt()") - if sonsLen(n) > 1: fixLabel(p, Lend) - -proc popSafePoints(p: BProc, howMany: int) = - var L = p.nestedTryStmts.len - # danger of endless recursion! we workaround this here by a temp stack - var stack: seq[PNode] - newSeq(stack, howMany) - for i in countup(1, howMany): - stack[i-1] = p.nestedTryStmts[L-i] - setLen(p.nestedTryStmts, L-howMany) - - for tryStmt in items(stack): - appcg(p, cpsStmts, "#popSafePoint();$n", []) - var finallyStmt = lastSon(tryStmt) - if finallyStmt.kind == nkFinally: - genStmts(p, finallyStmt.sons[0]) - # push old elements again: - for i in countdown(howMany-1, 0): - p.nestedTryStmts.add(stack[i]) - -proc genReturnStmt(p: BProc, t: PNode) = - p.beforeRetNeeded = true - popSafePoints(p, min(1, p.nestedTryStmts.len)) - genLineDir(p, t) - if (t.sons[0].kind != nkEmpty): genStmts(p, t.sons[0]) - appff(p.s[cpsStmts], "goto BeforeRet;$n", "br label %BeforeRet$n", []) - -proc genWhileStmt(p: BProc, t: PNode) = - # we don't generate labels here as for example GCC would produce - # significantly worse code - var - a: TLoc - Labl: TLabel - length: int - inc(p.withinLoop) - genLineDir(p, t) - assert(sonsLen(t) == 2) - inc(p.labels) - Labl = con("LA", toRope(p.labels)) - length = len(p.blocks) - setlen(p.blocks, length + 1) - p.blocks[length].id = - p.labels # negative because it isn't used yet - p.blocks[length].nestedTryStmts = p.nestedTryStmts.len - app(p.s[cpsStmts], "while (1) {" & tnl) - initLocExpr(p, t.sons[0], a) - if (t.sons[0].kind != nkIntLit) or (t.sons[0].intVal == 0): - p.blocks[length].id = abs(p.blocks[length].id) - appf(p.s[cpsStmts], "if (!$1) goto $2;$n", [rdLoc(a), Labl]) - genStmts(p, t.sons[1]) - if p.blocks[length].id > 0: appf(p.s[cpsStmts], "} $1: ;$n", [Labl]) - else: app(p.s[cpsStmts], '}' & tnl) - setlen(p.blocks, len(p.blocks) - 1) - dec(p.withinLoop) - -proc genBlock(p: BProc, t: PNode, d: var TLoc) = - inc(p.labels) - var idx = len(p.blocks) - if t.sons[0].kind != nkEmpty: - # named block? - assert(t.sons[0].kind == nkSym) - var sym = t.sons[0].sym - sym.loc.k = locOther - sym.loc.a = idx - setlen(p.blocks, idx + 1) - p.blocks[idx].id = -p.labels # negative because it isn't used yet - p.blocks[idx].nestedTryStmts = p.nestedTryStmts.len - if t.kind == nkBlockExpr: genStmtListExpr(p, t.sons[1], d) - else: genStmts(p, t.sons[1]) - if p.blocks[idx].id > 0: - appf(p.s[cpsStmts], "LA$1: ;$n", [toRope(p.blocks[idx].id)]) - setlen(p.blocks, idx) - -proc genBreakStmt(p: BProc, t: PNode) = - var idx = len(p.blocks) - 1 - if t.sons[0].kind != nkEmpty: - # named break? - assert(t.sons[0].kind == nkSym) - var sym = t.sons[0].sym - assert(sym.loc.k == locOther) - idx = sym.loc.a - p.blocks[idx].id = abs(p.blocks[idx].id) # label is used - popSafePoints(p, p.nestedTryStmts.len - p.blocks[idx].nestedTryStmts) - genLineDir(p, t) - appf(p.s[cpsStmts], "goto LA$1;$n", [toRope(p.blocks[idx].id)]) - -proc getRaiseFrmt(p: BProc): string = - if gCmd == cmdCompileToCpp: - result = "throw #nimException($1, $2);$n" - else: - result = "#raiseException((#E_Base*)$1, $2);$n" - -proc genRaiseStmt(p: BProc, t: PNode) = - if t.sons[0].kind != nkEmpty: - var a: TLoc - InitLocExpr(p, t.sons[0], a) - var e = rdLoc(a) - var typ = skipTypes(t.sons[0].typ, abstractPtrs) - genLineDir(p, t) - appcg(p, cpsStmts, getRaiseFrmt(p), [e, makeCString(typ.sym.name.s)]) - else: - genLineDir(p, t) - # reraise the last exception: - if gCmd == cmdCompileToCpp: - appcg(p, cpsStmts, "throw;" & tnl) - else: - appcg(p, cpsStmts, "#reraiseException();" & tnl) - -proc genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, - rangeFormat, eqFormat: TFormatStr, labl: TLabel) = - var - x, y: TLoc - var length = sonsLen(b) - for i in countup(0, length - 2): - if b.sons[i].kind == nkRange: - initLocExpr(p, b.sons[i].sons[0], x) - initLocExpr(p, b.sons[i].sons[1], y) - appcg(p, cpsStmts, rangeFormat, - [rdCharLoc(e), rdCharLoc(x), rdCharLoc(y), labl]) - else: - initLocExpr(p, b.sons[i], x) - appcg(p, cpsStmts, eqFormat, [rdCharLoc(e), rdCharLoc(x), labl]) - -proc genCaseSecondPass(p: BProc, t: PNode, labId, until: int): TLabel = - var Lend = getLabel(p) - for i in 1..until: - appf(p.s[cpsStmts], "LA$1: ;$n", [toRope(labId + i)]) - if t.sons[i].kind == nkOfBranch: - var length = sonsLen(t.sons[i]) - genStmts(p, t.sons[i].sons[length - 1]) - appf(p.s[cpsStmts], "goto $1;$n", [Lend]) - else: - genStmts(p, t.sons[i].sons[0]) - result = Lend - -proc genIfForCaseUntil(p: BProc, t: PNode, rangeFormat, eqFormat: TFormatStr, - until: int, a: TLoc): TLabel = - # generate a C-if statement for a Nimrod case statement - var labId = p.labels - for i in 1..until: - inc(p.labels) - if t.sons[i].kind == nkOfBranch: # else statement - genCaseGenericBranch(p, t.sons[i], a, rangeFormat, eqFormat, - con("LA", toRope(p.labels))) - else: - appf(p.s[cpsStmts], "goto LA$1;$n", [toRope(p.labels)]) - if until < t.len-1: - inc(p.labels) - var gotoTarget = p.labels - appf(p.s[cpsStmts], "goto LA$1;$n", [toRope(gotoTarget)]) - result = genCaseSecondPass(p, t, labId, until) - appf(p.s[cpsStmts], "LA$1: ;$n", [toRope(gotoTarget)]) - else: - result = genCaseSecondPass(p, t, labId, until) - -proc genCaseGeneric(p: BProc, t: PNode, rangeFormat, eqFormat: TFormatStr) = - var a: TLoc - initLocExpr(p, t.sons[0], a) - var Lend = genIfForCaseUntil(p, t, rangeFormat, eqFormat, sonsLen(t)-1, a) - fixLabel(p, Lend) - -proc genCaseStringBranch(p: BProc, b: PNode, e: TLoc, labl: TLabel, - branches: var openArray[PRope]) = - var x: TLoc - var length = sonsLen(b) - for i in countup(0, length - 2): - assert(b.sons[i].kind != nkRange) - initLocExpr(p, b.sons[i], x) - assert(b.sons[i].kind in {nkStrLit..nkTripleStrLit}) - var j = int(hashString(b.sons[i].strVal) and high(branches)) - appcg(p.module, branches[j], "if (#eqStrings($1, $2)) goto $3;$n", - [rdLoc(e), rdLoc(x), labl]) - -proc genStringCase(p: BProc, t: PNode) = - # count how many constant strings there are in the case: - var strings = 0 - for i in countup(1, sonsLen(t) - 1): - if t.sons[i].kind == nkOfBranch: inc(strings, sonsLen(t.sons[i]) - 1) - if strings > stringCaseThreshold: - var bitMask = math.nextPowerOfTwo(strings) - 1 - var branches: seq[PRope] - newSeq(branches, bitMask + 1) - var a: TLoc - initLocExpr(p, t.sons[0], a) # fist pass: gnerate ifs+goto: - var labId = p.labels - for i in countup(1, sonsLen(t) - 1): - inc(p.labels) - if t.sons[i].kind == nkOfBranch: - genCaseStringBranch(p, t.sons[i], a, con("LA", toRope(p.labels)), - branches) - else: - # else statement: nothing to do yet - # but we reserved a label, which we use later - appcg(p, cpsStmts, "switch (#hashString($1) & $2) {$n", - [rdLoc(a), toRope(bitMask)]) - for j in countup(0, high(branches)): - if branches[j] != nil: - appf(p.s[cpsStmts], "case $1: $n$2break;$n", - [intLiteral(j), branches[j]]) - app(p.s[cpsStmts], '}' & tnl) # else statement: - if t.sons[sonsLen(t) - 1].kind != nkOfBranch: - appf(p.s[cpsStmts], "goto LA$1;$n", [toRope(p.labels)]) - # third pass: generate statements - var Lend = genCaseSecondPass(p, t, labId, sonsLen(t)-1) - fixLabel(p, Lend) - else: - genCaseGeneric(p, t, "", "if (#eqStrings($1, $2)) goto $3;$n") - -proc branchHasTooBigRange(b: PNode): bool = - for i in countup(0, sonsLen(b)-2): - # last son is block - if (b.sons[i].Kind == nkRange) and - b.sons[i].sons[1].intVal - b.sons[i].sons[0].intVal > RangeExpandLimit: - return true - -proc IfSwitchSplitPoint(p: BProc, n: PNode): int = - for i in 1..n.len-1: - var branch = n[i] - var stmtBlock = lastSon(branch) - if stmtBlock.stmtsContainPragma(wLinearScanEnd): - result = i - elif hasSwitchRange notin CC[ccompiler].props: - if branch.kind == nkOfBranch and branchHasTooBigRange(branch): - result = i - -proc genOrdinalCase(p: BProc, n: PNode) = - # analyse 'case' statement: - var splitPoint = IfSwitchSplitPoint(p, n) - - # generate if part (might be empty): - var a: TLoc - initLocExpr(p, n.sons[0], a) - var Lend = if splitPoint > 0: genIfForCaseUntil(p, n, - rangeFormat = "if ($1 >= $2 && $1 <= $3) goto $4;$n", - eqFormat = "if ($1 == $2) goto $3;$n", - splitPoint, a) else: nil - - # generate switch part (might be empty): - if splitPoint+1 < n.len: - appf(p.s[cpsStmts], "switch ($1) {$n", [rdCharLoc(a)]) - var hasDefault = false - for i in splitPoint+1 .. < n.len: - var branch = n[i] - if branch.kind == nkOfBranch: - var length = branch.len - for j in 0 .. length-2: - if branch[j].kind == nkRange: - if hasSwitchRange in CC[ccompiler].props: - appf(p.s[cpsStmts], "case $1 ... $2:$n", [ - genLiteral(p, branch[j][0]), - genLiteral(p, branch[j][1])]) - else: - var v = copyNode(branch[j][0]) - while v.intVal <= branch[j][1].intVal: - appf(p.s[cpsStmts], "case $1:$n", [genLiteral(p, v)]) - Inc(v.intVal) - else: - appf(p.s[cpsStmts], "case $1:$n", [genLiteral(p, branch[j])]) - genStmts(p, branch[length-1]) - else: - # else part of case statement: - app(p.s[cpsStmts], "default:" & tnl) - genStmts(p, branch[0]) - hasDefault = true - app(p.s[cpsStmts], "break;" & tnl) - if (hasAssume in CC[ccompiler].props) and not hasDefault: - app(p.s[cpsStmts], "default: __assume(0);" & tnl) - app(p.s[cpsStmts], '}' & tnl) - if Lend != nil: fixLabel(p, Lend) - -proc genCaseStmt(p: BProc, t: PNode) = - genLineDir(p, t) - case skipTypes(t.sons[0].typ, abstractVarRange).kind - of tyString: - genStringCase(p, t) - of tyFloat..tyFloat128: - genCaseGeneric(p, t, "if ($1 >= $2 && $1 <= $3) goto $4;$n", - "if ($1 == $2) goto $3;$n") - else: - genOrdinalCase(p, t) - -proc hasGeneralExceptSection(t: PNode): bool = - var length = sonsLen(t) - var i = 1 - while (i < length) and (t.sons[i].kind == nkExceptBranch): - var blen = sonsLen(t.sons[i]) - if blen == 1: - return true - inc(i) - result = false - -proc genTryStmtCpp(p: BProc, t: PNode) = - # code to generate: - # - # bool tmpRethrow = false; - # try - # { - # myDiv(4, 9); - # } catch (NimException& tmp) { - # tmpRethrow = true; - # switch (tmp.exc) - # { - # case DIVIDE_BY_ZERO: - # tmpRethrow = false; - # printf("Division by Zero\n"); - # break; - # default: // used for general except! - # generalExceptPart(); - # tmpRethrow = false; - # } - # } - # excHandler = excHandler->prev; // we handled the exception - # finallyPart(); - # if (tmpRethrow) throw; - var - rethrowFlag: PRope - exc: PRope - i, length, blen: int - genLineDir(p, t) - rethrowFlag = nil - exc = getTempName() - if not hasGeneralExceptSection(t): - rethrowFlag = getTempName() - appf(p.s[cpsLocals], "volatile NIM_BOOL $1 = NIM_FALSE;$n", [rethrowFlag]) - if optStackTrace in p.Options: - appcg(p, cpsStmts, "#framePtr = (TFrame*)&F;" & tnl) - app(p.s[cpsStmts], "try {" & tnl) - add(p.nestedTryStmts, t) - genStmts(p, t.sons[0]) - length = sonsLen(t) - if t.sons[1].kind == nkExceptBranch: - appf(p.s[cpsStmts], "} catch (NimException& $1) {$n", [exc]) - if rethrowFlag != nil: - appf(p.s[cpsStmts], "$1 = NIM_TRUE;$n", [rethrowFlag]) - appf(p.s[cpsStmts], "if ($1.sp.exc) {$n", [exc]) - i = 1 - while (i < length) and (t.sons[i].kind == nkExceptBranch): - blen = sonsLen(t.sons[i]) - if blen == 1: - # general except section: - app(p.s[cpsStmts], "default: " & tnl) - genStmts(p, t.sons[i].sons[0]) - else: - for j in countup(0, blen - 2): - assert(t.sons[i].sons[j].kind == nkType) - appf(p.s[cpsStmts], "case $1:$n", [toRope(t.sons[i].sons[j].typ.id)]) - genStmts(p, t.sons[i].sons[blen - 1]) - if rethrowFlag != nil: - appf(p.s[cpsStmts], "$1 = NIM_FALSE; ", [rethrowFlag]) - app(p.s[cpsStmts], "break;" & tnl) - inc(i) - if t.sons[1].kind == nkExceptBranch: - app(p.s[cpsStmts], "}}" & tnl) # end of catch-switch statement - appcg(p, cpsStmts, "#popSafePoint();") - discard pop(p.nestedTryStmts) - if (i < length) and (t.sons[i].kind == nkFinally): - genStmts(p, t.sons[i].sons[0]) - if rethrowFlag != nil: - appf(p.s[cpsStmts], "if ($1) { throw; }$n", [rethrowFlag]) - -proc genTryStmt(p: BProc, t: PNode) = - # code to generate: - # - # TSafePoint sp; - # pushSafePoint(&sp); - # sp.status = setjmp(sp.context); - # if (sp.status == 0) { - # myDiv(4, 9); - # popSafePoint(); - # } else { - # popSafePoint(); - # /* except DivisionByZero: */ - # if (sp.status == DivisionByZero) { - # printf('Division by Zero\n'); - # clearException(); - # } else { - # clearException(); - # } - # } - # /* finally: */ - # printf('fin!\n'); - # if (exception not cleared) - # propagateCurrentException(); - genLineDir(p, t) - var safePoint = getTempName() - discard cgsym(p.module, "E_Base") - appcg(p, cpsLocals, "#TSafePoint $1;$n", [safePoint]) - appcg(p, cpsStmts, "#pushSafePoint(&$1);$n" & - "$1.status = setjmp($1.context);$n", [safePoint]) - if optStackTrace in p.Options: - appcg(p, cpsStmts, "#framePtr = (TFrame*)&F;" & tnl) - appf(p.s[cpsStmts], "if ($1.status == 0) {$n", [safePoint]) - var length = sonsLen(t) - add(p.nestedTryStmts, t) - genStmts(p, t.sons[0]) - appcg(p, cpsStmts, "#popSafePoint();$n} else {$n#popSafePoint();$n") - var i = 1 - while (i < length) and (t.sons[i].kind == nkExceptBranch): - var blen = sonsLen(t.sons[i]) - if blen == 1: - # general except section: - if i > 1: app(p.s[cpsStmts], "else {" & tnl) - genStmts(p, t.sons[i].sons[0]) - appcg(p, cpsStmts, "$1.status = 0;#popCurrentException();$n", [safePoint]) - if i > 1: app(p.s[cpsStmts], '}' & tnl) - else: - var orExpr: PRope = nil - for j in countup(0, blen - 2): - assert(t.sons[i].sons[j].kind == nkType) - if orExpr != nil: app(orExpr, "||") - appcg(p.module, orExpr, "#getCurrentException()->Sup.m_type == $1", - [genTypeInfo(p.module, t.sons[i].sons[j].typ)]) - if i > 1: app(p.s[cpsStmts], "else ") - appf(p.s[cpsStmts], "if ($1) {$n", [orExpr]) - genStmts(p, t.sons[i].sons[blen-1]) - # code to clear the exception: - appcg(p, cpsStmts, "$1.status = 0;#popCurrentException();}$n", - [safePoint]) - inc(i) - app(p.s[cpsStmts], '}' & tnl) # end of if statement - discard pop(p.nestedTryStmts) - if i < length and t.sons[i].kind == nkFinally: - genStmts(p, t.sons[i].sons[0]) - appcg(p, cpsStmts, "if ($1.status != 0) #reraiseException();$n", [safePoint]) - -proc genAsmOrEmitStmt(p: BProc, t: PNode): PRope = - for i in countup(0, sonsLen(t) - 1): - case t.sons[i].Kind - of nkStrLit..nkTripleStrLit: - app(result, t.sons[i].strVal) - of nkSym: - var sym = t.sons[i].sym - if sym.kind in {skProc, skMethod}: - var a: TLoc - initLocExpr(p, t.sons[i], a) - app(result, rdLoc(a)) - else: - var r = sym.loc.r - if r == nil: - # if no name has already been given, - # it doesn't matter much: - r = mangleName(sym) - sym.loc.r = r # but be consequent! - app(result, r) - else: InternalError(t.sons[i].info, "genAsmOrEmitStmt()") - -proc genAsmStmt(p: BProc, t: PNode) = - assert(t.kind == nkAsmStmt) - genLineDir(p, t) - var s = genAsmOrEmitStmt(p, t) - appf(p.s[cpsStmts], CC[ccompiler].asmStmtFrmt, [s]) - -proc genEmit(p: BProc, t: PNode) = - genLineDir(p, t) - var s = genAsmOrEmitStmt(p, t.sons[1]) - if p.prc == nil: - # top level emit pragma? - app(p.module.s[cfsProcs], s) - else: - app(p.s[cpsStmts], s) - -var - breakPointId: int = 0 - gBreakpoints: PRope # later the breakpoints are inserted into the main proc - -proc genBreakPoint(p: BProc, t: PNode) = - var name: string - if optEndb in p.Options: - if t.kind == nkExprColonExpr: - assert(t.sons[1].kind in {nkStrLit..nkTripleStrLit}) - name = normalize(t.sons[1].strVal) - else: - inc(breakPointId) - name = "bp" & $breakPointId - genLineDir(p, t) # BUGFIX - appcg(p.module, gBreakpoints, - "#dbgRegisterBreakpoint($1, (NCSTRING)$2, (NCSTRING)$3);$n", [ - toRope(toLinenumber(t.info)), makeCString(toFilename(t.info)), - makeCString(name)]) - -proc genPragma(p: BProc, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - case whichPragma(it) - of wEmit: - genEmit(p, it) - of wBreakpoint: - genBreakPoint(p, it) - of wDeadCodeElim: - if not (optDeadCodeElim in gGlobalOptions): - # we need to keep track of ``deadCodeElim`` pragma - if (sfDeadCodeElim in p.module.module.flags): - addPendingModule(p.module) - else: nil - -proc FieldDiscriminantCheckNeeded(p: BProc, asgn: PNode): bool = - if optFieldCheck in p.options: - var le = asgn.sons[0] - if le.kind == nkCheckedFieldExpr: - var field = le.sons[0].sons[1].sym - result = sfDiscriminant in field.flags - elif le.kind == nkDotExpr: - var field = le.sons[1].sym - result = sfDiscriminant in field.flags - -proc genDiscriminantCheck(p: BProc, a, tmp: TLoc, objtype: PType, - field: PSym) = - var t = skipTypes(objtype, abstractVar) - assert t.kind == tyObject - discard genTypeInfo(p.module, t) - var L = lengthOrd(field.typ) - if not IntSetContainsOrIncl(p.module.declaredThings, field.id): - appcg(p.module, cfsVars, "extern $1", - discriminatorTableDecl(p.module, t, field)) - appcg(p, cpsStmts, - "#FieldDiscriminantCheck((NI)(NU)($1), (NI)(NU)($2), $3, $4);$n", - [rdLoc(a), rdLoc(tmp), discriminatorTableName(p.module, t, field), - intLiteral(L+1)]) - -proc asgnFieldDiscriminant(p: BProc, e: PNode) = - var a, tmp: TLoc - var dotExpr = e.sons[0] - var d: PSym - if dotExpr.kind == nkCheckedFieldExpr: dotExpr = dotExpr.sons[0] - InitLocExpr(p, e.sons[0], a) - getTemp(p, a.t, tmp) - expr(p, e.sons[1], tmp) - genDiscriminantCheck(p, a, tmp, dotExpr.sons[0].typ, dotExpr.sons[1].sym) - genAssignment(p, a, tmp, {}) - -proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = - genLineDir(p, e) - if not FieldDiscriminantCheckNeeded(p, e): - var a: TLoc - InitLocExpr(p, e.sons[0], a) - if fastAsgn: incl(a.flags, lfNoDeepCopy) - assert(a.t != nil) - expr(p, e.sons[1], a) - else: - asgnFieldDiscriminant(p, e) - -proc genStmts(p: BProc, t: PNode) = - var - a: TLoc - prc: PSym - case t.kind - of nkEmpty: - nil - of nkStmtList: - for i in countup(0, sonsLen(t) - 1): genStmts(p, t.sons[i]) - of nkBlockStmt: genBlock(p, t, a) - of nkIfStmt: genIfStmt(p, t) - of nkWhileStmt: genWhileStmt(p, t) - of nkVarSection: genVarStmt(p, t) - of nkConstSection: genConstStmt(p, t) - of nkForStmt: internalError(t.info, "for statement not eliminated") - of nkCaseStmt: genCaseStmt(p, t) - of nkReturnStmt: genReturnStmt(p, t) - of nkBreakStmt: genBreakStmt(p, t) - of nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand, - nkCallStrLit: - genLineDir(p, t) - initLocExpr(p, t, a) - of nkAsgn: genAsgn(p, t, fastAsgn=false) - of nkFastAsgn: genAsgn(p, t, fastAsgn=true) - of nkDiscardStmt: - genLineDir(p, t) - initLocExpr(p, t.sons[0], a) - of nkAsmStmt: genAsmStmt(p, t) - of nkTryStmt: - if gCmd == cmdCompileToCpp: genTryStmtCpp(p, t) - else: genTryStmt(p, t) - of nkRaiseStmt: genRaiseStmt(p, t) - of nkTypeSection: - # we have to emit the type information for object types here to support - # separate compilation: - genTypeSection(p.module, t) - of nkCommentStmt, nkNilLit, nkIteratorDef, nkIncludeStmt, nkImportStmt, - nkFromStmt, nkTemplateDef, nkMacroDef: - nil - of nkPragma: genPragma(p, t) - of nkProcDef, nkMethodDef, nkConverterDef: - if (t.sons[genericParamsPos].kind == nkEmpty): - prc = t.sons[namePos].sym - if (optDeadCodeElim notin gGlobalOptions and - sfDeadCodeElim notin getModule(prc).flags) or - ({sfExportc, sfCompilerProc} * prc.flags == {sfExportc}) or - (sfExportc in prc.flags and lfExportLib in prc.loc.flags) or - (prc.kind == skMethod): - # we have not only the header: - if t.sons[codePos].kind != nkEmpty or lfDynamicLib in prc.loc.flags: - genProc(p.module, prc) - else: internalError(t.info, "genStmts(" & $t.kind & ')') - diff --git a/rod/ccgtypes.nim b/rod/ccgtypes.nim deleted file mode 100755 index 1920da599..000000000 --- a/rod/ccgtypes.nim +++ /dev/null @@ -1,761 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# ------------------------- Name Mangling -------------------------------- - -proc mangle(name: string): string = - case name[0] - of 'a'..'z': - result = "" - add(result, chr(ord(name[0]) - ord('a') + ord('A'))) - of '0'..'9', 'A'..'Z': - result = "" - add(result, name[0]) - else: result = "HEX" & toHex(ord(name[0]), 2) - for i in countup(0 + 1, len(name) + 0 - 1): - case name[i] - of 'A'..'Z': - add(result, chr(ord(name[i]) - ord('A') + ord('a'))) - of '_': - nil - of 'a'..'z', '0'..'9': - add(result, name[i]) - else: - add(result, "HEX") - add(result, toHex(ord(name[i]), 2)) - -proc mangleName(s: PSym): PRope = - result = s.loc.r - if result == nil: - if gCmd == cmdCompileToLLVM: - case s.kind - of skProc, skMethod, skConverter, skConst: - result = toRope("@") - of skVar: - if (sfGlobal in s.flags): result = toRope("@") - else: result = toRope("%") - of skForVar, skTemp, skParam, skType, skEnumField, skModule: - result = toRope("%") - else: InternalError(s.info, "mangleName") - app(result, toRope(mangle(s.name.s))) - app(result, "_") - app(result, toRope(s.id)) - if optGenMapping in gGlobalOptions: - if s.owner != nil: - appf(gMapping, "r\"$1.$2\": $3$n", - [toRope(s.owner.Name.s), toRope(s.name.s), result]) - s.loc.r = result - -proc getTypeName(typ: PType): PRope = - if (typ.sym != nil) and ({sfImportc, sfExportc} * typ.sym.flags != {}) and - (gCmd != cmdCompileToLLVM): - result = typ.sym.loc.r - else: - if typ.loc.r == nil: typ.loc.r = ropeff("TY$1", "%TY$1", [toRope(typ.id)]) - result = typ.loc.r - if result == nil: InternalError("getTypeName: " & $typ.kind) - -proc mapType(typ: PType): TCTypeKind = - case typ.kind - of tyNone: result = ctVoid - of tyBool: result = ctBool - of tyChar: result = ctChar - of tySet: - case int(getSize(typ)) - of 1: result = ctInt8 - of 2: result = ctInt16 - of 4: result = ctInt32 - of 8: result = ctInt64 - else: result = ctArray - of tyOpenArray, tyArrayConstr, tyArray: result = ctArray - of tyObject, tyTuple: result = ctStruct - of tyGenericBody, tyGenericInst, tyGenericParam, tyDistinct, tyOrdinal: - result = mapType(lastSon(typ)) - of tyEnum: - if firstOrd(typ) < 0: - result = ctInt32 - else: - case int(getSize(typ)) - of 1: result = ctUInt8 - of 2: result = ctUInt16 - of 4: result = ctInt32 - of 8: result = ctInt64 - else: internalError("mapType") - of tyRange: result = mapType(typ.sons[0]) - of tyPtr, tyVar, tyRef: - case typ.sons[0].kind - of tyOpenArray, tyArrayConstr, tyArray: result = ctArray - else: result = ctPtr - of tyPointer: result = ctPtr - of tySequence: result = ctNimSeq - of tyProc: result = ctProc - of tyString: result = ctNimStr - of tyCString: result = ctCString - of tyInt..tyFloat128: - result = TCTypeKind(ord(typ.kind) - ord(tyInt) + ord(ctInt)) - else: InternalError("mapType") - -proc mapReturnType(typ: PType): TCTypeKind = - if skipTypes(typ, abstractInst).kind == tyArray: result = ctPtr - else: result = mapType(typ) - -proc getTypeDescAux(m: BModule, typ: PType, check: var TIntSet): PRope -proc needsComplexAssignment(typ: PType): bool = - result = containsGarbageCollectedRef(typ) - -proc isInvalidReturnType(rettype: PType): bool = - # Arrays and sets cannot be returned by a C procedure, because C is - # such a poor programming language. - # We exclude records with refs too. This enhances efficiency and - # is necessary for proper code generation of assignments. - if rettype == nil: result = true - else: - case mapType(rettype) - of ctArray: - result = not (skipTypes(rettype, abstractInst).kind in - {tyVar, tyRef, tyPtr}) - of ctStruct: - result = needsComplexAssignment(skipTypes(rettype, abstractInst)) - else: result = false - -const - CallingConvToStr: array[TCallingConvention, string] = ["N_NIMCALL", - "N_STDCALL", "N_CDECL", "N_SAFECALL", - "N_SYSCALL", # this is probably not correct for all platforms, - # but one can #define it to what one wants - "N_INLINE", "N_NOINLINE", "N_FASTCALL", "N_CLOSURE", "N_NOCONV"] - CallingConvToStrLLVM: array[TCallingConvention, string] = ["fastcc $1", - "stdcall $1", "ccc $1", "safecall $1", "syscall $1", "$1 alwaysinline", - "$1 noinline", "fastcc $1", "ccc $1", "$1"] - -proc CacheGetType(tab: TIdTable, key: PType): PRope = - # returns nil if we need to declare this type - # since types are now unique via the ``GetUniqueType`` mechanism, this slow - # linear search is not necessary anymore: - result = PRope(IdTableGet(tab, key)) - -proc getTempName(): PRope = - result = ropeff("TMP$1", "%TMP$1", [toRope(gId)]) - inc(gId) - -proc getGlobalTempName(): PRope = - result = ropeff("TMP$1", "@TMP$1", [toRope(gId)]) - inc(gId) - -proc ccgIntroducedPtr(s: PSym): bool = - var pt = s.typ - assert(not (sfResult in s.flags)) - case pt.Kind - of tyObject: - # XXX quick hack floatSize*2 for the pegs module under 64bit - if (optByRef in s.options) or (getSize(pt) > platform.floatSize * 2): - result = true # requested anyway - elif (tfFinal in pt.flags) and (pt.sons[0] == nil): - result = false # no need, because no subtyping possible - else: - result = true # ordinary objects are always passed by reference, - # otherwise casting doesn't work - of tyTuple: - result = (getSize(pt) > platform.floatSize) or (optByRef in s.options) - else: result = false - -proc fillResult(param: PSym) = - fillLoc(param.loc, locParam, param.typ, ropeff("Result", "%Result", []), - OnStack) - if (mapReturnType(param.typ) != ctArray) and IsInvalidReturnType(param.typ): - incl(param.loc.flags, lfIndirect) - param.loc.s = OnUnknown - -proc genProcParams(m: BModule, t: PType, rettype, params: var PRope, - check: var TIntSet) = - params = nil - if (t.sons[0] == nil) or isInvalidReturnType(t.sons[0]): - rettype = toRope("void") - else: - rettype = getTypeDescAux(m, t.sons[0], check) - for i in countup(1, sonsLen(t.n) - 1): - if t.n.sons[i].kind != nkSym: InternalError(t.n.info, "genProcParams") - var param = t.n.sons[i].sym - fillLoc(param.loc, locParam, param.typ, mangleName(param), OnStack) - app(params, getTypeDescAux(m, param.typ, check)) - if ccgIntroducedPtr(param): - app(params, "*") - incl(param.loc.flags, lfIndirect) - param.loc.s = OnUnknown - app(params, " ") - app(params, param.loc.r) # declare the len field for open arrays: - var arr = param.typ - if arr.kind == tyVar: arr = arr.sons[0] - var j = 0 - while arr.Kind == tyOpenArray: - # need to pass hidden parameter: - appff(params, ", NI $1Len$2", ", @NI $1Len$2", [param.loc.r, toRope(j)]) - inc(j) - arr = arr.sons[0] - if i < sonsLen(t.n) - 1: app(params, ", ") - if (t.sons[0] != nil) and isInvalidReturnType(t.sons[0]): - if params != nil: app(params, ", ") - var arr = t.sons[0] - app(params, getTypeDescAux(m, arr, check)) - if (mapReturnType(t.sons[0]) != ctArray) or (gCmd == cmdCompileToLLVM): - app(params, "*") - appff(params, " Result", " @Result", []) - if t.callConv == ccClosure: - if params != nil: app(params, ", ") - app(params, "void* ClPart") - if tfVarargs in t.flags: - if params != nil: app(params, ", ") - app(params, "...") - if (params == nil) and (gCmd != cmdCompileToLLVM): app(params, "void)") - else: app(params, ")") - params = con("(", params) - -proc isImportedType(t: PType): bool = - result = (t.sym != nil) and (sfImportc in t.sym.flags) - -proc typeNameOrLiteral(t: PType, literal: string): PRope = - if (t.sym != nil) and (sfImportc in t.sym.flags) and (t.sym.magic == mNone): - result = getTypeName(t) - else: - result = toRope(literal) - -proc getSimpleTypeDesc(m: BModule, typ: PType): PRope = - const - NumericalTypeToStr: array[tyInt..tyFloat128, string] = ["NI", "NI8", "NI16", - "NI32", "NI64", "NF", "NF32", "NF64", "NF128"] - case typ.Kind - of tyPointer: - result = typeNameOrLiteral(typ, "void*") - of tyEnum: - if firstOrd(typ) < 0: - result = typeNameOrLiteral(typ, "NI32") - else: - case int(getSize(typ)) - of 1: result = typeNameOrLiteral(typ, "NU8") - of 2: result = typeNameOrLiteral(typ, "NU16") - of 4: result = typeNameOrLiteral(typ, "NI32") - of 8: result = typeNameOrLiteral(typ, "NI64") - else: - internalError(typ.sym.info, "getSimpleTypeDesc: " & $(getSize(typ))) - result = nil - of tyString: - discard cgsym(m, "NimStringDesc") - result = typeNameOrLiteral(typ, "NimStringDesc*") - of tyCstring: result = typeNameOrLiteral(typ, "NCSTRING") - of tyBool: result = typeNameOrLiteral(typ, "NIM_BOOL") - of tyChar: result = typeNameOrLiteral(typ, "NIM_CHAR") - of tyNil: result = typeNameOrLiteral(typ, "0") - of tyInt..tyFloat128: - result = typeNameOrLiteral(typ, NumericalTypeToStr[typ.Kind]) - of tyRange: result = getSimpleTypeDesc(m, typ.sons[0]) - else: result = nil - -proc getTypePre(m: BModule, typ: PType): PRope = - if typ == nil: result = toRope("void") - else: - result = getSimpleTypeDesc(m, typ) - if result == nil: result = CacheGetType(m.typeCache, typ) - -proc getForwardStructFormat(): string = - if gCmd == cmdCompileToCpp: result = "struct $1;$n" - else: result = "typedef struct $1 $1;$n" - -proc getTypeForward(m: BModule, typ: PType): PRope = - result = CacheGetType(m.forwTypeCache, typ) - if result != nil: return - result = getTypePre(m, typ) - if result != nil: return - case typ.kind - of tySequence, tyTuple, tyObject: - result = getTypeName(typ) - if not isImportedType(typ): - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]) - IdTablePut(m.forwTypeCache, typ, result) - else: InternalError("getTypeForward(" & $typ.kind & ')') - -proc mangleRecFieldName(field: PSym, rectype: PType): PRope = - if (rectype.sym != nil) and - ({sfImportc, sfExportc} * rectype.sym.flags != {}): - result = field.loc.r - else: - result = toRope(mangle(field.name.s)) - if result == nil: InternalError(field.info, "mangleRecFieldName") - -proc genRecordFieldsAux(m: BModule, n: PNode, accessExpr: PRope, rectype: PType, - check: var TIntSet): PRope = - var - ae, uname, sname, a: PRope - k: PNode - field: PSym - result = nil - case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - app(result, genRecordFieldsAux(m, n.sons[i], accessExpr, rectype, check)) - of nkRecCase: - if (n.sons[0].kind != nkSym): InternalError(n.info, "genRecordFieldsAux") - app(result, genRecordFieldsAux(m, n.sons[0], accessExpr, rectype, check)) - uname = toRope(mangle(n.sons[0].sym.name.s) & 'U') - if accessExpr != nil: ae = ropef("$1.$2", [accessExpr, uname]) - else: ae = uname - app(result, "union {" & tnl) - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - k = lastSon(n.sons[i]) - if k.kind != nkSym: - sname = con("S", toRope(i)) - a = genRecordFieldsAux(m, k, ropef("$1.$2", [ae, sname]), rectype, - check) - if a != nil: - app(result, "struct {") - app(result, a) - appf(result, "} $1;$n", [sname]) - else: - app(result, genRecordFieldsAux(m, k, ae, rectype, check)) - else: internalError("genRecordFieldsAux(record case branch)") - appf(result, "} $1;$n", [uname]) - of nkSym: - field = n.sym - assert(field.ast == nil) - sname = mangleRecFieldName(field, rectype) - if accessExpr != nil: ae = ropef("$1.$2", [accessExpr, sname]) - else: ae = sname - fillLoc(field.loc, locField, field.typ, ae, OnUnknown) - appf(result, "$1 $2;$n", [getTypeDescAux(m, field.loc.t, check), sname]) - else: internalError(n.info, "genRecordFieldsAux()") - -proc getRecordFields(m: BModule, typ: PType, check: var TIntSet): PRope = - result = genRecordFieldsAux(m, typ.n, nil, typ, check) - -proc getRecordDesc(m: BModule, typ: PType, name: PRope, - check: var TIntSet): PRope = - # declare the record: - var hasField = false - if typ.kind == tyObject: - if typ.sons[0] == nil: - if typ.sym != nil and sfPure in typ.sym.flags or tfFinal in typ.flags: - result = ropecg(m, "struct $1 {$n", [name]) - else: - result = ropecg(m, "struct $1 {$n#TNimType* m_type;$n", [name]) - hasField = true - elif gCmd == cmdCompileToCpp: - result = ropecg(m, "struct $1 : public $2 {$n", - [name, getTypeDescAux(m, typ.sons[0], check)]) - hasField = true - else: - result = ropecg(m, "struct $1 {$n $2 Sup;$n", - [name, getTypeDescAux(m, typ.sons[0], check)]) - hasField = true - else: - result = ropef("struct $1 {$n", [name]) - var desc = getRecordFields(m, typ, check) - if (desc == nil) and not hasField: - appf(result, "char dummy;$n", []) - else: - app(result, desc) - app(result, "};" & tnl) - -proc getTupleDesc(m: BModule, typ: PType, name: PRope, - check: var TIntSet): PRope = - result = ropef("struct $1 {$n", [name]) - var desc: PRope = nil - for i in countup(0, sonsLen(typ) - 1): - appf(desc, "$1 Field$2;$n", - [getTypeDescAux(m, typ.sons[i], check), toRope(i)]) - if (desc == nil): app(result, "char dummy;" & tnl) - else: app(result, desc) - app(result, "};" & tnl) - -proc pushType(m: BModule, typ: PType) = - add(m.typeStack, typ) - -proc getTypeDescAux(m: BModule, typ: PType, check: var TIntSet): PRope = - # returns only the type's name - var - name, rettype, desc, recdesc: PRope - n: biggestInt - t, et: PType - t = getUniqueType(typ) - if t == nil: InternalError("getTypeDescAux: t == nil") - if t.sym != nil: useHeader(m, t.sym) - result = getTypePre(m, t) - if result != nil: return - if IntSetContainsOrIncl(check, t.id): - InternalError("cannot generate C type for: " & typeToString(typ)) - # XXX: this BUG is hard to fix -> we need to introduce helper structs, - # but determining when this needs to be done is hard. We should split - # C type generation into an analysis and a code generation phase somehow. - case t.Kind - of tyRef, tyPtr, tyVar: - et = getUniqueType(t.sons[0]) - if et.kind in {tyArrayConstr, tyArray, tyOpenArray}: - et = getUniqueType(elemType(et)) - case et.Kind - of tyObject, tyTuple: - # no restriction! We have a forward declaration for structs - name = getTypeForward(m, et) - result = con(name, "*") - IdTablePut(m.typeCache, t, result) - pushType(m, et) - of tySequence: - # no restriction! We have a forward declaration for structs - name = getTypeForward(m, et) - result = con(name, "**") - IdTablePut(m.typeCache, t, result) - pushType(m, et) - else: - # else we have a strong dependency :-( - result = con(getTypeDescAux(m, et, check), "*") - IdTablePut(m.typeCache, t, result) - of tyOpenArray: - et = getUniqueType(t.sons[0]) - result = con(getTypeDescAux(m, et, check), "*") - IdTablePut(m.typeCache, t, result) - of tyProc: - result = getTypeName(t) - IdTablePut(m.typeCache, t, result) - genProcParams(m, t, rettype, desc, check) - if not isImportedType(t): - if t.callConv != ccClosure: # procedure vars may need a closure! - appf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", - [toRope(CallingConvToStr[t.callConv]), rettype, result, desc]) - else: - appf(m.s[cfsTypes], "typedef struct $1 {$n" & - "N_CDECL_PTR($2, PrcPart) $3;$n" & "void* ClPart;$n};$n", - [result, rettype, desc]) - of tySequence: - # we cannot use getTypeForward here because then t would be associated - # with the name of the struct, not with the pointer to the struct: - result = CacheGetType(m.forwTypeCache, t) - if result == nil: - result = getTypeName(t) - if not isImportedType(t): - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]) - IdTablePut(m.forwTypeCache, t, result) - assert(CacheGetType(m.typeCache, t) == nil) - IdTablePut(m.typeCache, t, con(result, "*")) - if not isImportedType(t): - if skipTypes(t.sons[0], abstractInst).kind != tyEmpty: - appcg(m, m.s[cfsSeqTypes], - "struct $2 {$n" & - " #TGenericSeq Sup;$n" & - " $1 data[SEQ_DECL_SIZE];$n" & - "};$n", [getTypeDescAux(m, t.sons[0], check), result]) - else: - result = toRope("TGenericSeq") - app(result, "*") - of tyArrayConstr, tyArray: - n = lengthOrd(t) - if n <= 0: - n = 1 # make an array of at least one element - result = getTypeName(t) - IdTablePut(m.typeCache, t, result) - if not isImportedType(t): - appf(m.s[cfsTypes], "typedef $1 $2[$3];$n", - [getTypeDescAux(m, t.sons[1], check), result, ToRope(n)]) - of tyObject, tyTuple: - result = CacheGetType(m.forwTypeCache, t) - if result == nil: - result = getTypeName(t) - if not isImportedType(t): - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]) - IdTablePut(m.forwTypeCache, t, result) - IdTablePut(m.typeCache, t, result) # always call for sideeffects: - if t.n != nil: recdesc = getRecordDesc(m, t, result, check) - else: recdesc = getTupleDesc(m, t, result, check) - if not isImportedType(t): app(m.s[cfsTypes], recdesc) - of tySet: - case int(getSize(t)) - of 1: result = toRope("NU8") - of 2: result = toRope("NU16") - of 4: result = toRope("NU32") - of 8: result = toRope("NU64") - else: - result = getTypeName(t) - IdTablePut(m.typeCache, t, result) - if not isImportedType(t): - appf(m.s[cfsTypes], "typedef NU8 $1[$2];$n", - [result, toRope(getSize(t))]) - of tyGenericInst, tyDistinct, tyOrdinal: - result = getTypeDescAux(m, lastSon(t), check) - else: - InternalError("getTypeDescAux(" & $t.kind & ')') - result = nil - -proc getTypeDesc(m: BModule, typ: PType): PRope = - var check: TIntSet - IntSetInit(check) - result = getTypeDescAux(m, typ, check) - -proc getTypeDesc(m: BModule, magic: string): PRope = - var sym = magicsys.getCompilerProc(magic) - if sym != nil: - result = getTypeDesc(m, sym.typ) - else: - rawMessage(errSystemNeeds, magic) - result = nil - -proc finishTypeDescriptions(m: BModule) = - var i = 0 - while i < len(m.typeStack): - discard getTypeDesc(m, m.typeStack[i]) - inc(i) - -proc genProcHeader(m: BModule, prc: PSym): PRope = - var - rettype, params: PRope - check: TIntSet - # using static is needed for inline procs - if (prc.typ.callConv == ccInline): result = toRope("static ") - else: result = nil - IntSetInit(check) - fillLoc(prc.loc, locProc, prc.typ, mangleName(prc), OnUnknown) - genProcParams(m, prc.typ, rettype, params, check) - appf(result, "$1($2, $3)$4", - [toRope(CallingConvToStr[prc.typ.callConv]), rettype, prc.loc.r, params]) - -proc genTypeInfo(m: BModule, typ: PType): PRope -proc getNimNode(m: BModule): PRope = - result = ropef("$1[$2]", [m.typeNodesName, toRope(m.typeNodes)]) - inc(m.typeNodes) - -proc getNimType(m: BModule): PRope = - result = ropef("$1[$2]", [m.nimTypesName, toRope(m.nimTypes)]) - inc(m.nimTypes) - -proc allocMemTI(m: BModule, typ: PType, name: PRope) = - var tmp = getNimType(m) - appf(m.s[cfsTypeInit2], "$2 = &$1;$n", [tmp, name]) - -proc genTypeInfoAuxBase(m: BModule, typ: PType, name, base: PRope) = - var nimtypeKind: int - allocMemTI(m, typ, name) - if (typ.kind == tyObject) and (tfFinal in typ.flags) and - (typ.sons[0] == nil): - nimtypeKind = ord(high(TTypeKind)) + 1 # tyPureObject - else: - nimtypeKind = ord(typ.kind) - appf(m.s[cfsTypeInit3], - "$1->size = sizeof($2);$n" & "$1->kind = $3;$n" & "$1->base = $4;$n", - [name, getTypeDesc(m, typ), toRope(nimtypeKind), base]) - # compute type flags for GC optimization - var flags = 0 - if not containsGarbageCollectedRef(typ): flags = flags or 1 - if not canFormAcycle(typ): flags = flags or 2 - #else MessageOut("can contain a cycle: " & typeToString(typ)) - if flags != 0: - appf(m.s[cfsTypeInit3], "$1->flags = $2;$n", [name, toRope(flags)]) - appf(m.s[cfsVars], "TNimType* $1; /* $2 */$n", - [name, toRope(typeToString(typ))]) - -proc genTypeInfoAux(m: BModule, typ: PType, name: PRope) = - var base: PRope - if (sonsLen(typ) > 0) and (typ.sons[0] != nil): - base = genTypeInfo(m, typ.sons[0]) - else: - base = toRope("0") - genTypeInfoAuxBase(m, typ, name, base) - -proc discriminatorTableName(m: BModule, objtype: PType, d: PSym): PRope = - if objType.sym == nil: - InternalError(d.info, "anonymous obj with discriminator") - result = ropef("NimDT_$1_$2", [ - toRope(objType.sym.name.s), toRope(d.name.s)]) - -proc discriminatorTableDecl(m: BModule, objtype: PType, d: PSym): PRope = - discard cgsym(m, "TNimNode") - var tmp = discriminatorTableName(m, objtype, d) - result = ropef("TNimNode* $1[$2];$n", [tmp, toRope(lengthOrd(d.typ)+1)]) - -proc genObjectFields(m: BModule, typ: PType, n: PNode, expr: PRope) = - case n.kind - of nkRecList: - var L = sonsLen(n) - if L == 1: - genObjectFields(m, typ, n.sons[0], expr) - elif L > 0: - var tmp = getTempName() - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, toRope(L)]) - for i in countup(0, L-1): - var tmp2 = getNimNode(m) - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(i), tmp2]) - genObjectFields(m, typ, n.sons[i], tmp2) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, toRope(L), tmp]) - else: - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", [expr, toRope(L)]) - of nkRecCase: - assert(n.sons[0].kind == nkSym) - var field = n.sons[0].sym - var tmp = discriminatorTableName(m, typ, field) - var L = lengthOrd(field.typ) - assert L > 0 - appf(m.s[cfsTypeInit3], "$1.kind = 3;$n" & - "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & - "$1.name = $5;$n" & "$1.sons = &$6[0];$n" & - "$1.len = $7;$n", [expr, getTypeDesc(m, typ), field.loc.r, - genTypeInfo(m, field.typ), - makeCString(field.name.s), - tmp, toRope(L)]) - appf(m.s[cfsData], "TNimNode* $1[$2];$n", [tmp, toRope(L+1)]) - for i in countup(1, sonsLen(n)-1): - var b = n.sons[i] # branch - var tmp2 = getNimNode(m) - genObjectFields(m, typ, lastSon(b), tmp2) - case b.kind - of nkOfBranch: - if sonsLen(b) < 2: - internalError(b.info, "genObjectFields; nkOfBranch broken") - for j in countup(0, sonsLen(b) - 2): - if b.sons[j].kind == nkRange: - var x = int(getOrdValue(b.sons[j].sons[0])) - var y = int(getOrdValue(b.sons[j].sons[1])) - while x <= y: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(x), tmp2]) - inc(x) - else: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", - [tmp, toRope(getOrdValue(b.sons[j])), tmp2]) - of nkElse: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", - [tmp, toRope(L), tmp2]) - else: internalError(n.info, "genObjectFields(nkRecCase)") - of nkSym: - var field = n.sym - appf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & - "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & - "$1.name = $5;$n", [expr, getTypeDesc(m, typ), - field.loc.r, genTypeInfo(m, field.typ), makeCString(field.name.s)]) - else: internalError(n.info, "genObjectFields") - -proc genObjectInfo(m: BModule, typ: PType, name: PRope) = - if typ.kind == tyObject: genTypeInfoAux(m, typ, name) - else: genTypeInfoAuxBase(m, typ, name, toRope("0")) - var tmp = getNimNode(m) - genObjectFields(m, typ, typ.n, tmp) - appf(m.s[cfsTypeInit3], "$1->node = &$2;$n", [name, tmp]) - -proc genTupleInfo(m: BModule, typ: PType, name: PRope) = - var - tmp, expr, tmp2: PRope - length: int - a: PType - genTypeInfoAuxBase(m, typ, name, toRope("0")) - expr = getNimNode(m) - length = sonsLen(typ) - if length > 0: - tmp = getTempName() - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, toRope(length)]) - for i in countup(0, length - 1): - a = typ.sons[i] - tmp2 = getNimNode(m) - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(i), tmp2]) - appf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & - "$1.offset = offsetof($2, Field$3);$n" & "$1.typ = $4;$n" & - "$1.name = \"Field$3\";$n", - [tmp2, getTypeDesc(m, typ), toRope(i), genTypeInfo(m, a)]) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, toRope(length), tmp]) - else: - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", - [expr, toRope(length)]) - appf(m.s[cfsTypeInit3], "$1->node = &$2;$n", [name, tmp]) - -proc genEnumInfo(m: BModule, typ: PType, name: PRope) = - var - nodePtrs, elemNode, enumNames, enumArray, counter, specialCases: PRope - length, firstNimNode: int - field: PSym - # Type information for enumerations is quite heavy, so we do some - # optimizations here: The ``typ`` field is never set, as it is redundant - # anyway. We generate a cstring array and a loop over it. Exceptional - # positions will be reset after the loop. - genTypeInfoAux(m, typ, name) - nodePtrs = getTempName() - length = sonsLen(typ.n) - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", - [nodePtrs, toRope(length)]) - enumNames = nil - specialCases = nil - firstNimNode = m.typeNodes - for i in countup(0, length - 1): - assert(typ.n.sons[i].kind == nkSym) - field = typ.n.sons[i].sym - elemNode = getNimNode(m) - if field.ast == nil: - # no explicit string literal for the enum field, so use field.name: - app(enumNames, makeCString(field.name.s)) - else: - app(enumNames, makeCString(field.ast.strVal)) - if i < length - 1: app(enumNames, ", " & tnl) - if field.position != i: - appf(specialCases, "$1.offset = $2;$n", [elemNode, toRope(field.position)]) - enumArray = getTempName() - counter = getTempName() - appf(m.s[cfsTypeInit1], "NI $1;$n", [counter]) - appf(m.s[cfsTypeInit1], "static char* NIM_CONST $1[$2] = {$n$3};$n", - [enumArray, toRope(length), enumNames]) - appf(m.s[cfsTypeInit3], "for ($1 = 0; $1 < $2; $1++) {$n" & - "$3[$1+$4].kind = 1;$n" & "$3[$1+$4].offset = $1;$n" & - "$3[$1+$4].name = $5[$1];$n" & "$6[$1] = &$3[$1+$4];$n" & "}$n", [counter, - toRope(length), m.typeNodesName, toRope(firstNimNode), enumArray, nodePtrs]) - app(m.s[cfsTypeInit3], specialCases) - appf(m.s[cfsTypeInit3], - "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n$4->node = &$1;$n", - [getNimNode(m), toRope(length), nodePtrs, name]) - -proc genSetInfo(m: BModule, typ: PType, name: PRope) = - assert(typ.sons[0] != nil) - genTypeInfoAux(m, typ, name) - var tmp = getNimNode(m) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 0;$n" & "$3->node = &$1;$n", - [tmp, toRope(firstOrd(typ)), name]) - -proc genArrayInfo(m: BModule, typ: PType, name: PRope) = - genTypeInfoAuxBase(m, typ, name, genTypeInfo(m, typ.sons[1])) - -var - gToTypeInfoId: TIiTable - -proc genTypeInfo(m: BModule, typ: PType): PRope = - var dataGenerated: bool - var t = getUniqueType(typ) - var id = IiTableGet(gToTypeInfoId, t.id) - if id == invalidKey: - dataGenerated = false - id = t.id # getID(); - IiTablePut(gToTypeInfoId, t.id, id) - else: - dataGenerated = true - result = ropef("NTI$1", [toRope(id)]) - if not IntSetContainsOrIncl(m.typeInfoMarker, id): - # declare type information structures: - discard cgsym(m, "TNimType") - discard cgsym(m, "TNimNode") - appf(m.s[cfsVars], "extern TNimType* $1; /* $2 */$n", - [result, toRope(typeToString(t))]) - if dataGenerated: return - case t.kind - of tyEmpty: result = toRope("0") - of tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, tyInt..tyFloat128, - tyVar: - genTypeInfoAuxBase(gNimDat, t, result, toRope("0")) - of tyRef, tyPtr, tySequence, tyRange: genTypeInfoAux(gNimDat, t, result) - of tyArrayConstr, tyArray: genArrayInfo(gNimDat, t, result) - of tySet: genSetInfo(gNimDat, t, result) - of tyEnum: genEnumInfo(gNimDat, t, result) - of tyObject: genObjectInfo(gNimDat, t, result) - of tyTuple: - if t.n != nil: genObjectInfo(gNimDat, t, result) - else: genTupleInfo(gNimDat, t, result) - else: InternalError("genTypeInfo(" & $t.kind & ')') - -proc genTypeSection(m: BModule, n: PNode) = - nil diff --git a/rod/ccgutils.nim b/rod/ccgutils.nim deleted file mode 100755 index f1d66ca94..000000000 --- a/rod/ccgutils.nim +++ /dev/null @@ -1,148 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module declares some helpers for the C code generator. - -import - ast, astalgo, ropes, lists, nhashes, strutils, types, msgs, wordrecg, - platform - -proc whichPragma*(n: PNode): TSpecialWord = - var key = if n.kind == nkExprColonExpr: n.sons[0] else: n - if key.kind == nkIdent: result = whichKeyword(key.ident) - -proc getPragmaStmt*(n: PNode, w: TSpecialWord): PNode = - case n.kind - of nkStmtList: - for i in 0 .. < n.len: - result = getPragmaStmt(n[i], w) - if result != nil: break - of nkPragma: - for i in 0 .. < n.len: - if whichPragma(n[i]) == w: return n[i] - else: nil - -proc stmtsContainPragma*(n: PNode, w: TSpecialWord): bool = - result = getPragmaStmt(n, w) != nil - -proc hashString*(s: string): biggestInt = - # has to be the same algorithm as system.hashString! - if CPU[targetCPU].bit == 64: - # we have to use the same bitwidth - # as the target CPU - var b = 0'i64 - for i in countup(0, len(s) - 1): - b = b +% Ord(s[i]) - b = b +% `shl`(b, 10) - b = b xor `shr`(b, 6) - b = b +% `shl`(b, 3) - b = b xor `shr`(b, 11) - b = b +% `shl`(b, 15) - result = b - else: - var a = 0'i32 - for i in countup(0, len(s) - 1): - a = a +% Ord(s[i]).int32 - a = a +% `shl`(a, 10'i32) - a = a xor `shr`(a, 6'i32) - a = a +% `shl`(a, 3'i32) - a = a xor `shr`(a, 11'i32) - a = a +% `shl`(a, 15'i32) - result = a - -var gTypeTable: array[TTypeKind, TIdTable] - -proc initTypeTables() = - for i in countup(low(TTypeKind), high(TTypeKind)): InitIdTable(gTypeTable[i]) - -proc GetUniqueType*(key: PType): PType = - var - t: PType - k: TTypeKind - # this is a hotspot in the compiler! - result = key - if key == nil: return - k = key.kind - case k - of tyObject, tyEnum: - result = PType(IdTableGet(gTypeTable[k], key)) - if result == nil: - IdTablePut(gTypeTable[k], key, key) - result = key - of tyGenericInst, tyDistinct, tyOrdinal: - result = GetUniqueType(lastSon(key)) - of tyProc: - nil - else: - # we have to do a slow linear search because types may need - # to be compared by their structure: - if IdTableHasObjectAsKey(gTypeTable[k], key): return - for h in countup(0, high(gTypeTable[k].data)): - t = PType(gTypeTable[k].data[h].key) - if (t != nil) and sameType(t, key): - return t - IdTablePut(gTypeTable[k], key, key) - -proc TableGetType*(tab: TIdTable, key: PType): PObject = - var t: PType - # returns nil if we need to declare this type - result = IdTableGet(tab, key) - if (result == nil) and (tab.counter > 0): - # we have to do a slow linear search because types may need - # to be compared by their structure: - for h in countup(0, high(tab.data)): - t = PType(tab.data[h].key) - if t != nil: - if sameType(t, key): - return tab.data[h].val - -proc toCChar*(c: Char): string = - case c - of '\0'..'\x1F', '\x80'..'\xFF': result = '\\' & toOctal(c) - of '\'', '\"', '\\': result = '\\' & c - else: result = $(c) - -proc makeCString*(s: string): PRope = - # BUGFIX: We have to split long strings into many ropes. Otherwise - # this could trigger an InternalError(). See the ropes module for - # further information. - const - MaxLineLength = 64 - var res: string - result = nil - res = "\"" - for i in countup(0, len(s) + 0 - 1): - if (i - 0 + 1) mod MaxLineLength == 0: - add(res, '\"') - add(res, "\n") - app(result, toRope(res)) # reset: - setlen(res, 1) - res[0] = '\"' - add(res, toCChar(s[i])) - add(res, '\"') - app(result, toRope(res)) - -proc makeLLVMString*(s: string): PRope = - const MaxLineLength = 64 - var res: string - result = nil - res = "c\"" - for i in countup(0, len(s) + 0 - 1): - if (i - 0 + 1) mod MaxLineLength == 0: - app(result, toRope(res)) - setlen(res, 0) - case s[i] - of '\0'..'\x1F', '\x80'..'\xFF', '\"', '\\': - add(res, '\\') - add(res, toHex(ord(s[i]), 2)) - else: add(res, s[i]) - add(res, "\\00\"") - app(result, toRope(res)) - -InitTypeTables() diff --git a/rod/cgen.nim b/rod/cgen.nim deleted file mode 100755 index a15c4c4ca..000000000 --- a/rod/cgen.nim +++ /dev/null @@ -1,1032 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This is the new C code generator; much cleaner and faster -# than the old one. It also generates better code. - -import - ast, astalgo, strutils, nhashes, trees, platform, magicsys, extccomp, - options, - nversion, nimsets, msgs, crc, bitsets, idents, lists, types, ccgutils, os, - times, ropes, math, passes, rodread, wordrecg, rnimsyn, treetab, cgmeth, - rodutils - -when options.hasTinyCBackend: - import tccgen - -proc cgenPass*(): TPass -# implementation - -type - TLabel = PRope # for the C generator a label is just a rope - TCFileSection = enum # the sections a generated C file consists of - cfsHeaders, # section for C include file headers - cfsForwardTypes, # section for C forward typedefs - cfsTypes, # section for C typedefs - cfsSeqTypes, # section for sequence types only - # this is needed for strange type generation - # reasons - cfsFieldInfo, # section for field information - cfsTypeInfo, # section for type information - cfsProcHeaders, # section for C procs prototypes - cfsData, # section for C constant data - cfsVars, # section for C variable declarations - cfsProcs, # section for C procs that are not inline - cfsTypeInit1, # section 1 for declarations of type information - cfsTypeInit2, # section 2 for init of type information - cfsTypeInit3, # section 3 for init of type information - cfsDebugInit, # section for init of debug information - cfsDynLibInit, # section for init of dynamic library binding - cfsDynLibDeinit # section for deinitialization of dynamic - # libraries - TCTypeKind = enum # describes the type kind of a C type - ctVoid, ctChar, ctBool, ctUInt, ctUInt8, ctUInt16, ctUInt32, ctUInt64, - ctInt, ctInt8, ctInt16, ctInt32, ctInt64, ctFloat, ctFloat32, ctFloat64, - ctFloat128, ctArray, ctStruct, ctPtr, ctNimStr, ctNimSeq, ctProc, ctCString - TCFileSections = array[TCFileSection, PRope] # represents a generated C file - TCProcSection = enum # the sections a generated C proc consists of - cpsLocals, # section of local variables for C proc - cpsInit, # section for init of variables for C proc - cpsStmts # section of local statements for C proc - TCProcSections = array[TCProcSection, PRope] # represents a generated C proc - BModule = ref TCGen - BProc = ref TCProc - TBlock{.final.} = object - id*: int # the ID of the label; positive means that it - # has been used (i.e. the label should be emitted) - nestedTryStmts*: int # how many try statements is it nested into - - TCProc{.final.} = object # represents C proc that is currently generated - s: TCProcSections # the procs sections; short name for readability - prc: PSym # the Nimrod proc that this C proc belongs to - BeforeRetNeeded: bool # true iff 'BeforeRet' label for proc is needed - nestedTryStmts: seq[PNode] # in how many nested try statements we are - # (the vars must be volatile then) - labels: Natural # for generating unique labels in the C proc - blocks: seq[TBlock] # nested blocks - options: TOptions # options that should be used for code - # generation; this is the same as prc.options - # unless prc == nil - frameLen: int # current length of frame descriptor - sendClosure: PType # closure record type that we pass - receiveClosure: PType # closure record type that we get - module: BModule # used to prevent excessive parameter passing - withinLoop: int # > 0 if we are within a loop - - TTypeSeq = seq[PType] - TCGen = object of TPassContext # represents a C source file - module*: PSym - filename*: string - s*: TCFileSections # sections of the C file - cfilename*: string # filename of the module (including path, - # without extension) - typeCache*: TIdTable # cache the generated types - forwTypeCache*: TIdTable # cache for forward declarations of types - declaredThings*: TIntSet # things we have declared in this .c file - declaredProtos*: TIntSet # prototypes we have declared in this .c file - headerFiles*: TLinkedList # needed headers to include - typeInfoMarker*: TIntSet # needed for generating type information - initProc*: BProc # code for init procedure - typeStack*: TTypeSeq # used for type generation - dataCache*: TNodeTable - forwardedProcs*: TSymSeq # keep forwarded procs here - typeNodes*, nimTypes*: int # used for type info generation - typeNodesName*, nimTypesName*: PRope # used for type info generation - labels*: natural # for generating unique module-scope names - - -var - mainModProcs, mainModInit: PRope # parts of the main module - gMapping: PRope # the generated mapping file (if requested) - gProcProfile: Natural # proc profile counter - gGeneratedSyms: TIntSet # set of ID's of generated symbols - gPendingModules: seq[BModule] = @[] # list of modules that are not - # finished with code generation - gForwardedProcsCounter: int = 0 - gNimDat: BModule # generated global data - -proc ropeff(cformat, llvmformat: string, args: openarray[PRope]): PRope = - if gCmd == cmdCompileToLLVM: result = ropef(llvmformat, args) - else: result = ropef(cformat, args) - -proc appff(dest: var PRope, cformat, llvmformat: string, - args: openarray[PRope]) = - if gCmd == cmdCompileToLLVM: appf(dest, llvmformat, args) - else: appf(dest, cformat, args) - -proc addForwardedProc(m: BModule, prc: PSym) = - m.forwardedProcs.add(prc) - inc(gForwardedProcsCounter) - -proc addPendingModule(m: BModule) = - for i in countup(0, high(gPendingModules)): - if gPendingModules[i] == m: - InternalError("module already pending: " & m.module.name.s) - gPendingModules.add(m) - -proc findPendingModule(m: BModule, s: PSym): BModule = - var ms = getModule(s) - if ms.id == m.module.id: return m - for i in countup(0, high(gPendingModules)): - result = gPendingModules[i] - if result.module.id == ms.id: return - InternalError(s.info, "no pending module found for: " & s.name.s) - -proc initLoc(result: var TLoc, k: TLocKind, typ: PType, s: TStorageLoc) = - result.k = k - result.s = s - result.t = GetUniqueType(typ) - result.r = nil - result.a = - 1 - result.flags = {} - -proc fillLoc(a: var TLoc, k: TLocKind, typ: PType, r: PRope, s: TStorageLoc) = - # fills the loc if it is not already initialized - if a.k == locNone: - a.k = k - a.t = getUniqueType(typ) - a.a = - 1 - a.s = s - if a.r == nil: a.r = r - -proc newProc(prc: PSym, module: BModule): BProc = - new(result) - result.prc = prc - result.module = module - if prc != nil: result.options = prc.options - else: result.options = gOptions - result.blocks = @[] - result.nestedTryStmts = @[] - -proc isSimpleConst(typ: PType): bool = - result = not (skipTypes(typ, abstractVar).kind in - {tyTuple, tyObject, tyArray, tyArrayConstr, tySet, tySequence}) - -proc useHeader(m: BModule, sym: PSym) = - if lfHeader in sym.loc.Flags: - assert(sym.annex != nil) - discard lists.IncludeStr(m.headerFiles, getStr(sym.annex.path)) - -proc cgsym(m: BModule, name: string): PRope - -proc ropecg(m: BModule, frmt: TFormatStr, args: openarray[PRope]): PRope = - var i, j, length, start, num: int - i = 0 - length = len(frmt) - result = nil - num = 0 - while i < length: - if frmt[i] == '$': - inc(i) # skip '$' - case frmt[i] - of '$': - app(result, "$") - inc(i) - of '#': - inc(i) - app(result, args[num]) - inc(num) - of '0'..'9': - j = 0 - while true: - j = (j * 10) + Ord(frmt[i]) - ord('0') - inc(i) - if i >= length or not (frmt[i] in {'0'..'9'}): break - num = j - if j > high(args) + 1: - internalError("ropes: invalid format string $" & $(j)) - app(result, args[j - 1]) - of 'N', 'n': - app(result, tnl) - inc(i) - else: InternalError("ropes: invalid format string $" & frmt[i]) - elif frmt[i] == '#' and frmt[i+1] in IdentStartChars: - inc(i) - var j = i - while frmt[j] in IdentChars: inc(j) - var ident = copy(frmt, i, j-1) - i = j - app(result, cgsym(m, ident)) - elif frmt[i] == '#' and frmt[i+1] == '$': - inc(i, 2) - var j = 0 - while frmt[i] in Digits: - j = (j * 10) + Ord(frmt[i]) - ord('0') - inc(i) - app(result, cgsym(m, args[j-1].ropeToStr)) - start = i - while i < length: - if frmt[i] != '$' and frmt[i] != '#': inc(i) - else: break - if i - 1 >= start: - app(result, copy(frmt, start, i - 1)) - -proc appcg(m: BModule, c: var PRope, frmt: TFormatStr, - args: openarray[PRope]) = - app(c, ropecg(m, frmt, args)) - -proc appcg(m: BModule, s: TCFileSection, frmt: TFormatStr, - args: openarray[PRope]) = - app(m.s[s], ropecg(m, frmt, args)) - -proc appcg(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: openarray[PRope]) = - app(p.s[s], ropecg(p.module, frmt, args)) - - -include "ccgtypes.nim" - -# ------------------------------ Manager of temporaries ------------------ - -proc rdLoc(a: TLoc): PRope = - # 'read' location (deref if indirect) - result = a.r - if lfIndirect in a.flags: result = ropef("(*$1)", [result]) - -proc addrLoc(a: TLoc): PRope = - result = a.r - if lfIndirect notin a.flags: result = con("&", result) - -proc rdCharLoc(a: TLoc): PRope = - # read a location that may need a char-cast: - result = rdLoc(a) - if skipTypes(a.t, abstractRange).kind == tyChar: - result = ropef("((NU8)($1))", [result]) - -proc genObjectInit(p: BProc, section: TCProcSection, t: PType, a: TLoc, - takeAddr: bool) = - case analyseObjectWithTypeField(t) - of frNone: - nil - of frHeader: - var r = rdLoc(a) - if not takeAddr: r = ropef("(*$1)", [r]) - var s = skipTypes(t, abstractInst) - while (s.kind == tyObject) and (s.sons[0] != nil): - app(r, ".Sup") - s = skipTypes(s.sons[0], abstractInst) - appcg(p, section, "$1.m_type = $2;$n", [r, genTypeInfo(p.module, t)]) - of frEmbedded: - # worst case for performance: - var r = if takeAddr: addrLoc(a) else: rdLoc(a) - appcg(p, section, "#objectInit($1, $2);$n", [r, genTypeInfo(p.module, t)]) - -type - TAssignmentFlag = enum - needToCopy, needForSubtypeCheck, afDestIsNil, afDestIsNotNil, afSrcIsNil, - afSrcIsNotNil - TAssignmentFlags = set[TAssignmentFlag] - -proc genRefAssign(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) - -proc zeroVar(p: BProc, loc: TLoc, containsGCref: bool) = - if skipTypes(loc.t, abstractVarRange).Kind notin - {tyArray, tyArrayConstr, tySet, tyTuple, tyObject}: - if containsGcref and p.WithInLoop > 0: - appf(p.s[cpsInit], "$1 = 0;$n", [rdLoc(loc)]) - var nilLoc: TLoc - initLoc(nilLoc, locTemp, loc.t, onStack) - nilLoc.r = toRope("NIM_NIL") - # puts ``unsureAsgnRef`` etc to ``p.s[cpsStmts]``: - genRefAssign(p, loc, nilLoc, {afSrcIsNil}) - else: - appf(p.s[cpsStmts], "$1 = 0;$n", [rdLoc(loc)]) - else: - if containsGcref and p.WithInLoop > 0: - appf(p.s[cpsInit], "memset((void*)$1, 0, sizeof($2));$n", - [addrLoc(loc), rdLoc(loc)]) - appcg(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - [addrLoc(loc), genTypeInfo(p.module, loc.t)]) - else: - appf(p.s[cpsStmts], "memset((void*)$1, 0, sizeof($2));$n", - [addrLoc(loc), rdLoc(loc)]) - genObjectInit(p, cpsInit, loc.t, loc, true) - -proc zeroTemp(p: BProc, loc: TLoc) = - if skipTypes(loc.t, abstractVarRange).Kind notin - {tyArray, tyArrayConstr, tySet, tyTuple, tyObject}: - appf(p.s[cpsStmts], "$1 = 0;$n", [rdLoc(loc)]) - when false: - var nilLoc: TLoc - initLoc(nilLoc, locTemp, loc.t, onStack) - nilLoc.r = toRope("NIM_NIL") - # puts ``unsureAsgnRef`` etc to ``p.s[cpsStmts]``: - genRefAssign(p, loc, nilLoc, {afSrcIsNil}) - else: - appf(p.s[cpsStmts], "memset((void*)$1, 0, sizeof($2));$n", - [addrLoc(loc), rdLoc(loc)]) - when false: - appcg(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - [addrLoc(loc), genTypeInfo(p.module, loc.t)]) - -proc initVariable(p: BProc, v: PSym) = - var b = containsGarbageCollectedRef(v.typ) - if b or v.ast == nil: - zeroVar(p, v.loc, b) - -proc initTemp(p: BProc, tmp: var TLoc) = - if containsGarbageCollectedRef(tmp.t): - zeroTemp(p, tmp) - -proc getTemp(p: BProc, t: PType, result: var TLoc) = - inc(p.labels) - if gCmd == cmdCompileToLLVM: - result.r = con("%LOC", toRope(p.labels)) - else: - result.r = con("LOC", toRope(p.labels)) - appf(p.s[cpsLocals], "$1 $2;$n", [getTypeDesc(p.module, t), result.r]) - result.k = locTemp - result.a = - 1 - result.t = getUniqueType(t) - result.s = OnStack - result.flags = {} - initTemp(p, result) - -proc cstringLit(p: BProc, r: var PRope, s: string): PRope = - if gCmd == cmdCompileToLLVM: - inc(p.module.labels) - inc(p.labels) - result = ropef("%LOC$1", [toRope(p.labels)]) - appf(p.module.s[cfsData], "@C$1 = private constant [$2 x i8] $3$n", - [toRope(p.module.labels), toRope(len(s)), makeLLVMString(s)]) - appf(r, "$1 = getelementptr [$2 x i8]* @C$3, %NI 0, %NI 0$n", - [result, toRope(len(s)), toRope(p.module.labels)]) - else: - result = makeCString(s) - -proc cstringLit(m: BModule, r: var PRope, s: string): PRope = - if gCmd == cmdCompileToLLVM: - inc(m.labels, 2) - result = ropef("%MOC$1", [toRope(m.labels - 1)]) - appf(m.s[cfsData], "@MOC$1 = private constant [$2 x i8] $3$n", - [toRope(m.labels), toRope(len(s)), makeLLVMString(s)]) - appf(r, "$1 = getelementptr [$2 x i8]* @MOC$3, %NI 0, %NI 0$n", - [result, toRope(len(s)), toRope(m.labels)]) - else: - result = makeCString(s) - -proc allocParam(p: BProc, s: PSym) = - assert(s.kind == skParam) - if lfParamCopy notin s.loc.flags: - inc(p.labels) - var tmp = con("%LOC", toRope(p.labels)) - incl(s.loc.flags, lfParamCopy) - incl(s.loc.flags, lfIndirect) - appf(p.s[cpsInit], "$1 = alloca $3$n" & "store $3 $2, $3* $1$n", - [tmp, s.loc.r, getTypeDesc(p.module, s.loc.t)]) - s.loc.r = tmp - -proc localDebugInfo(p: BProc, s: PSym) = - if {optStackTrace, optEndb} * p.options != {optStackTrace, optEndb}: return - # XXX work around a bug: No type information for open arrays possible: - if skipTypes(s.typ, abstractVar).kind == tyOpenArray: return - if gCmd == cmdCompileToLLVM: - # "address" is the 0th field - # "typ" is the 1rst field - # "name" is the 2nd field - var name = cstringLit(p, p.s[cpsInit], normalize(s.name.s)) - if (s.kind == skParam) and not ccgIntroducedPtr(s): allocParam(p, s) - inc(p.labels, 3) - appf(p.s[cpsInit], "%LOC$6 = getelementptr %TF* %F, %NI 0, $1, %NI 0$n" & - "%LOC$7 = getelementptr %TF* %F, %NI 0, $1, %NI 1$n" & - "%LOC$8 = getelementptr %TF* %F, %NI 0, $1, %NI 2$n" & - "store i8* $2, i8** %LOC$6$n" & "store $3* $4, $3** %LOC$7$n" & - "store i8* $5, i8** %LOC$8$n", [toRope(p.frameLen), s.loc.r, - getTypeDesc(p.module, "TNimType"), - genTypeInfo(p.module, s.loc.t), name, - toRope(p.labels), toRope(p.labels - 1), - toRope(p.labels - 2)]) - else: - var a = con("&", s.loc.r) - if (s.kind == skParam) and ccgIntroducedPtr(s): a = s.loc.r - appf(p.s[cpsInit], - "F.s[$1].address = (void*)$3; F.s[$1].typ = $4; F.s[$1].name = $2;$n", - [toRope(p.frameLen), makeCString(normalize(s.name.s)), a, - genTypeInfo(p.module, s.loc.t)]) - inc(p.frameLen) - -proc assignLocalVar(p: BProc, s: PSym) = - #assert(s.loc.k == locNone) // not yet assigned - # this need not be fullfilled for inline procs; they are regenerated - # for each module that uses them! - if s.loc.k == locNone: - fillLoc(s.loc, locLocalVar, s.typ, mangleName(s), OnStack) - if gCmd == cmdCompileToLLVM: - appf(p.s[cpsLocals], "$1 = alloca $2$n", - [s.loc.r, getTypeDesc(p.module, s.loc.t)]) - incl(s.loc.flags, lfIndirect) - else: - app(p.s[cpsLocals], getTypeDesc(p.module, s.loc.t)) - if sfRegister in s.flags: app(p.s[cpsLocals], " register") - if (sfVolatile in s.flags) or (p.nestedTryStmts.len > 0): - app(p.s[cpsLocals], " volatile") - appf(p.s[cpsLocals], " $1;$n", [s.loc.r]) - localDebugInfo(p, s) - -proc declareThreadVar(m: BModule, s: PSym) = - if optThreads in gGlobalOptions: - app(m.s[cfsVars], "NIM_THREADVAR ") - app(m.s[cfsVars], getTypeDesc(m, s.loc.t)) - - -proc assignGlobalVar(p: BProc, s: PSym) = - if s.loc.k == locNone: - fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), OnHeap) - useHeader(p.module, s) - if lfNoDecl in s.loc.flags: return - if sfImportc in s.flags: app(p.module.s[cfsVars], "extern ") - if sfThreadVar in s.flags: declareThreadVar(p.module, s) - else: app(p.module.s[cfsVars], getTypeDesc(p.module, s.loc.t)) - if sfRegister in s.flags: app(p.module.s[cfsVars], " register") - if sfVolatile in s.flags: app(p.module.s[cfsVars], " volatile") - appf(p.module.s[cfsVars], " $1;$n", [s.loc.r]) - if {optStackTrace, optEndb} * p.module.module.options == - {optStackTrace, optEndb}: - appcg(p.module, p.module.s[cfsDebugInit], - "#dbgRegisterGlobal($1, &$2, $3);$n", - [cstringLit(p, p.module.s[cfsDebugInit], - normalize(s.owner.name.s & '.' & s.name.s)), - s.loc.r, genTypeInfo(p.module, s.typ)]) - -proc iff(cond: bool, the, els: PRope): PRope = - if cond: result = the - else: result = els - -proc assignParam(p: BProc, s: PSym) = - assert(s.loc.r != nil) - if sfAddrTaken in s.flags and gCmd == cmdCompileToLLVM: allocParam(p, s) - localDebugInfo(p, s) - -proc fillProcLoc(sym: PSym) = - if sym.loc.k == locNone: - fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), OnStack) - -proc getLabel(p: BProc): TLabel = - inc(p.labels) - result = con("LA", toRope(p.labels)) - -proc fixLabel(p: BProc, labl: TLabel) = - appf(p.s[cpsStmts], "$1: ;$n", [labl]) - -proc genVarPrototype(m: BModule, sym: PSym) -proc genConstPrototype(m: BModule, sym: PSym) -proc genProc(m: BModule, prc: PSym) -proc genStmts(p: BProc, t: PNode) -proc genProcPrototype(m: BModule, sym: PSym) - -include "ccgexprs.nim", "ccgstmts.nim" - -# ----------------------------- dynamic library handling ----------------- -# We don't finalize dynamic libs as this does the OS for us. - -proc libCandidates(s: string, dest: var TStringSeq) = - var le = strutils.find(s, '(') - var ri = strutils.find(s, ')', le+1) - if le >= 0 and ri > le: - var prefix = copy(s, 0, le - 1) - var suffix = copy(s, ri + 1) - for middle in split(copy(s, le + 1, ri - 1), '|'): - libCandidates(prefix & middle & suffix, dest) - else: - add(dest, s) - -proc loadDynamicLib(m: BModule, lib: PLib) = - assert(lib != nil) - if not lib.generated: - lib.generated = true - var tmp = getGlobalTempName() - assert(lib.name == nil) - lib.name = tmp # BUGFIX: cgsym has awful side-effects - appf(m.s[cfsVars], "static void* $1;$n", [tmp]) - if lib.path.kind in {nkStrLit..nkTripleStrLit}: - var s: TStringSeq = @[] - libCandidates(lib.path.strVal, s) - var loadlib: PRope = nil - for i in countup(0, high(s)): - inc(m.labels) - if i > 0: app(loadlib, "||") - appcg(m, loadlib, "($1 = #nimLoadLibrary((#NimStringDesc*) &$2))$n", - [tmp, getStrLit(m, s[i])]) - appcg(m, m.s[cfsDynLibInit], - "if (!($1)) #nimLoadLibraryError((#NimStringDesc*) &$2);$n", - [loadlib, getStrLit(m, lib.path.strVal)]) - else: - var p = newProc(nil, m) - var dest: TLoc - initLocExpr(p, lib.path, dest) - app(m.s[cfsVars], p.s[cpsLocals]) - app(m.s[cfsDynLibInit], p.s[cpsInit]) - app(m.s[cfsDynLibInit], p.s[cpsStmts]) - appcg(m, m.s[cfsDynLibInit], - "if (!($1 = #nimLoadLibrary($2))) #nimLoadLibraryError($2);$n", - [tmp, rdLoc(dest)]) - - if lib.name == nil: InternalError("loadDynamicLib") - -proc mangleDynLibProc(sym: PSym): PRope = - if sfCompilerProc in sym.flags: - # NOTE: sym.loc.r is the external name! - result = toRope(sym.name.s) - else: - result = ropef("Dl_$1", [toRope(sym.id)]) - -proc SymInDynamicLib(m: BModule, sym: PSym) = - var lib = sym.annex - var extname = sym.loc.r - loadDynamicLib(m, lib) - #discard cgsym(m, "nimGetProcAddr") - if gCmd == cmdCompileToLLVM: incl(sym.loc.flags, lfIndirect) - var tmp = mangleDynLibProc(sym) - sym.loc.r = tmp # from now on we only need the internal name - sym.typ.sym = nil # generate a new name - inc(m.labels, 2) - appcg(m, m.s[cfsDynLibInit], - "$1 = ($2) #nimGetProcAddr($3, $4);$n", - [tmp, getTypeDesc(m, sym.typ), - lib.name, cstringLit(m, m.s[cfsDynLibInit], ropeToStr(extname))]) - appff(m.s[cfsVars], "$2 $1;$n", - "$1 = linkonce global $2 zeroinitializer$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t)]) - -proc cgsym(m: BModule, name: string): PRope = - var sym = magicsys.getCompilerProc(name) - if sym != nil: - case sym.kind - of skProc, skMethod, skConverter: genProc(m, sym) - of skVar: genVarPrototype(m, sym) - of skType: discard getTypeDesc(m, sym.typ) - else: InternalError("cgsym: " & name) - else: - # we used to exclude the system module from this check, but for DLL - # generation support this sloppyness leads to hard to detect bugs, so - # we're picky here for the system module too: - rawMessage(errSystemNeeds, name) - result = sym.loc.r - -proc generateHeaders(m: BModule) = - app(m.s[cfsHeaders], "#include \"nimbase.h\"" & tnl & tnl) - var it = PStrEntry(m.headerFiles.head) - while it != nil: - if it.data[0] notin {'\"', '<'}: - appf(m.s[cfsHeaders], "#include \"$1\"$n", [toRope(it.data)]) - else: - appf(m.s[cfsHeaders], "#include $1$n", [toRope(it.data)]) - it = PStrEntry(it.Next) - -proc getFrameDecl(p: BProc) = - var slots: PRope - if p.frameLen > 0: - discard cgsym(p.module, "TVarSlot") - slots = ropeff(" TVarSlot s[$1];$n", ", [$1 x %TVarSlot]", - [toRope(p.frameLen)]) - else: - slots = nil - appff(p.s[cpsLocals], "volatile struct {TFrame* prev;" & - "NCSTRING procname;NI line;NCSTRING filename;" & - "NI len;$n$1} F;$n", - "%TF = type {%TFrame*, i8*, %NI, %NI$1}$n" & - "%F = alloca %TF$n", [slots]) - inc(p.labels) - prepend(p.s[cpsInit], ropeff("F.len = $1;$n", - "%LOC$2 = getelementptr %TF %F, %NI 4$n" & - "store %NI $1, %NI* %LOC$2$n", [toRope(p.frameLen), toRope(p.labels)])) - -proc retIsNotVoid(s: PSym): bool = - result = (s.typ.sons[0] != nil) and not isInvalidReturnType(s.typ.sons[0]) - -proc initFrame(p: BProc, procname, filename: PRope): PRope = - result = ropecg(p.module, - "F.procname = $1;$n" & - "F.prev = #framePtr;$n" & - "F.filename = $2;$n" & - "F.line = 0;$n" & - "framePtr = (TFrame*)&F;$n", [procname, filename]) - -proc deinitFrame(p: BProc): PRope = - inc(p.labels, 3) - result = ropeff("framePtr = framePtr->prev;$n", - "%LOC$1 = load %TFrame* @framePtr$n" & - "%LOC$2 = getelementptr %TFrame* %LOC$1, %NI 0$n" & - "%LOC$3 = load %TFrame** %LOC$2$n" & - "store %TFrame* $LOC$3, %TFrame** @framePtr", [toRope(p.labels), - toRope(p.labels - 1), toRope(p.labels - 2)]) - -proc genProcAux(m: BModule, prc: PSym) = - var - p: BProc - generatedProc, header, returnStmt, procname, filename: PRope - res, param: PSym - p = newProc(prc, m) - header = genProcHeader(m, prc) - if (gCmd != cmdCompileToLLVM) and (lfExportLib in prc.loc.flags): - header = con("N_LIB_EXPORT ", header) - returnStmt = nil - assert(prc.ast != nil) - if not (sfPure in prc.flags) and (prc.typ.sons[0] != nil): - res = prc.ast.sons[resultPos].sym # get result symbol - if not isInvalidReturnType(prc.typ.sons[0]): - # declare the result symbol: - assignLocalVar(p, res) - assert(res.loc.r != nil) - returnStmt = ropeff("return $1;$n", "ret $1$n", [rdLoc(res.loc)]) - initVariable(p, res) - else: - fillResult(res) - assignParam(p, res) - if skipTypes(res.typ, abstractInst).kind == tyArray: - incl(res.loc.flags, lfIndirect) - res.loc.s = OnUnknown - for i in countup(1, sonsLen(prc.typ.n) - 1): - param = prc.typ.n.sons[i].sym - assignParam(p, param) - genStmts(p, prc.ast.sons[codePos]) # modifies p.locals, p.init, etc. - if sfPure in prc.flags: - generatedProc = ropeff("$1 {$n$2$3$4}$n", "define $1 {$n$2$3$4}$n", [header, - p.s[cpsLocals], p.s[cpsInit], p.s[cpsStmts]]) - else: - generatedProc = ropeff("$1 {$n", "define $1 {$n", [header]) - if optStackTrace in prc.options: - getFrameDecl(p) - app(generatedProc, p.s[cpsLocals]) - procname = CStringLit(p, generatedProc, prc.name.s) - filename = CStringLit(p, generatedProc, toFilename(prc.info)) - app(generatedProc, initFrame(p, procname, filename)) - else: - app(generatedProc, p.s[cpsLocals]) - if (optProfiler in prc.options) and (gCmd != cmdCompileToLLVM): - if gProcProfile >= 64 * 1024: - InternalError(prc.info, "too many procedures for profiling") - discard cgsym(m, "profileData") - app(p.s[cpsLocals], "ticks NIM_profilingStart;" & tnl) - if prc.loc.a < 0: - appf(m.s[cfsDebugInit], "profileData[$1].procname = $2;$n", [ - toRope(gProcProfile), - makeCString(prc.name.s)]) - prc.loc.a = gProcProfile - inc(gProcProfile) - prepend(p.s[cpsInit], toRope("NIM_profilingStart = getticks();" & tnl)) - app(generatedProc, p.s[cpsInit]) - app(generatedProc, p.s[cpsStmts]) - if p.beforeRetNeeded: app(generatedProc, "BeforeRet: ;" & tnl) - if optStackTrace in prc.options: app(generatedProc, deinitFrame(p)) - if (optProfiler in prc.options) and (gCmd != cmdCompileToLLVM): - appf(generatedProc, - "profileData[$1].total += elapsed(getticks(), NIM_profilingStart);$n", - [toRope(prc.loc.a)]) - app(generatedProc, returnStmt) - app(generatedProc, '}' & tnl) - app(m.s[cfsProcs], generatedProc) - -proc genProcPrototype(m: BModule, sym: PSym) = - useHeader(m, sym) - if lfNoDecl in sym.loc.Flags: return - if lfDynamicLib in sym.loc.Flags: - if sym.owner.id != m.module.id and - not intSetContainsOrIncl(m.declaredThings, sym.id): - appff(m.s[cfsVars], "extern $1 $2;$n", - "@$2 = linkonce global $1 zeroinitializer$n", - [getTypeDesc(m, sym.loc.t), mangleDynLibProc(sym)]) - if gCmd == cmdCompileToLLVM: incl(sym.loc.flags, lfIndirect) - elif not IntSetContainsOrIncl(m.declaredProtos, sym.id): - appf(m.s[cfsProcHeaders], "$1;$n", [genProcHeader(m, sym)]) - -proc genProcNoForward(m: BModule, prc: PSym) = - fillProcLoc(prc) - useHeader(m, prc) - genProcPrototype(m, prc) - if lfNoDecl in prc.loc.Flags: return - if prc.typ.callConv == ccInline: - # We add inline procs to the calling module to enable C based inlining. - # This also means that a check with ``gGeneratedSyms`` is wrong, we need - # a check for ``m.declaredThings``. - if not intSetContainsOrIncl(m.declaredThings, prc.id): genProcAux(m, prc) - elif lfDynamicLib in prc.loc.flags: - if not IntSetContainsOrIncl(gGeneratedSyms, prc.id): - SymInDynamicLib(findPendingModule(m, prc), prc) - elif not (sfImportc in prc.flags): - if not IntSetContainsOrIncl(gGeneratedSyms, prc.id): - genProcAux(findPendingModule(m, prc), prc) - -proc genProc(m: BModule, prc: PSym) = - if sfBorrow in prc.flags: return - fillProcLoc(prc) - if {sfForward, sfFromGeneric} * prc.flags != {}: addForwardedProc(m, prc) - else: genProcNoForward(m, prc) - -proc genVarPrototype(m: BModule, sym: PSym) = - assert(sfGlobal in sym.flags) - useHeader(m, sym) - fillLoc(sym.loc, locGlobalVar, sym.typ, mangleName(sym), OnHeap) - if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(m.declaredThings, sym.id): - return - if sym.owner.id != m.module.id: - # else we already have the symbol generated! - assert(sym.loc.r != nil) - if gCmd == cmdCompileToLLVM: - incl(sym.loc.flags, lfIndirect) - appf(m.s[cfsVars], "$1 = linkonce global $2 zeroinitializer$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t)]) - else: - app(m.s[cfsVars], "extern ") - if sfThreadVar in sym.flags: declareThreadVar(m, sym) - else: app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)) - if sfRegister in sym.flags: app(m.s[cfsVars], " register") - if sfVolatile in sym.flags: app(m.s[cfsVars], " volatile") - appf(m.s[cfsVars], " $1;$n", [sym.loc.r]) - -proc genConstPrototype(m: BModule, sym: PSym) = - useHeader(m, sym) - if sym.loc.k == locNone: - fillLoc(sym.loc, locData, sym.typ, mangleName(sym), OnUnknown) - if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(m.declaredThings, sym.id): - return - if sym.owner.id != m.module.id: - # else we already have the symbol generated! - assert(sym.loc.r != nil) - appff(m.s[cfsData], "extern NIM_CONST $1 $2;$n", - "$1 = linkonce constant $2 zeroinitializer", - [getTypeDesc(m, sym.loc.t), sym.loc.r]) - -proc getFileHeader(cfilenoext: string): PRope = - if optCompileOnly in gGlobalOptions: - result = ropeff("/* Generated by Nimrod Compiler v$1 */$n" & - "/* (c) 2011 Andreas Rumpf */$n", - "; Generated by Nimrod Compiler v$1$n" & - "; (c) 2011 Andreas Rumpf$n", [toRope(versionAsString)]) - else: - result = ropeff("/* Generated by Nimrod Compiler v$1 */$n" & - "/* (c) 2011 Andreas Rumpf */$n" & "/* Compiled for: $2, $3, $4 */$n" & - "/* Command for C compiler:$n $5 */$n", - "; Generated by Nimrod Compiler v$1$n" & - "; (c) 2011 Andreas Rumpf$n" & "; Compiled for: $2, $3, $4$n" & - "; Command for LLVM compiler:$n $5$n", [toRope(versionAsString), - toRope(platform.OS[targetOS].name), - toRope(platform.CPU[targetCPU].name), - toRope(extccomp.CC[extccomp.ccompiler].name), - toRope(getCompileCFileCmd(cfilenoext))]) - case platform.CPU[targetCPU].intSize - of 16: - appff(result, - "$ntypedef short int NI;$n" & "typedef unsigned short int NU;$n", - "$n%NI = type i16$n", []) - of 32: - appff(result, - "$ntypedef long int NI;$n" & "typedef unsigned long int NU;$n", - "$n%NI = type i32$n", []) - of 64: - appff(result, "$ntypedef long long int NI;$n" & - "typedef unsigned long long int NU;$n", "$n%NI = type i64$n", []) - else: - nil - -proc genMainProc(m: BModule) = - const - CommonMainBody = - " nim__datInit();$n" & - " systemInit();$n" & - "$1" & - "$2" - PosixNimMain = - "int cmdCount;$n" & - "char** cmdLine;$n" & - "char** gEnv;$n" & - "N_CDECL(void, NimMain)(void) {$n" & - CommonMainBody & "}$n" - PosixCMain = "int main(int argc, char** args, char** env) {$n" & - " cmdLine = args;$n" & " cmdCount = argc;$n" & " gEnv = env;$n" & - " NimMain();$n" & " return 0;$n" & "}$n" - WinNimMain = "N_CDECL(void, NimMain)(void) {$n" & - CommonMainBody & "}$n" - WinCMain = "N_STDCALL(int, WinMain)(HINSTANCE hCurInstance, $n" & - " HINSTANCE hPrevInstance, $n" & - " LPSTR lpCmdLine, int nCmdShow) {$n" & - " NimMain();$n" & " return 0;$n" & "}$n" - WinNimDllMain = "N_LIB_EXPORT N_CDECL(void, NimMain)(void) {$n" & - CommonMainBody & "}$n" - WinCDllMain = - "BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fwdreason, $n" & - " LPVOID lpvReserved) {$n" & " NimMain();$n" & - " return 1;$n" & "}$n" - PosixNimDllMain = WinNimDllMain - PosixCDllMain = - "void NIM_POSIX_INIT NimMainInit(void) {$n" & - " NimMain();$n}$n" - var nimMain, otherMain: TFormatStr - if platform.targetOS == osWindows and - gGlobalOptions * {optGenGuiApp, optGenDynLib} != {}: - if optGenGuiApp in gGlobalOptions: - nimMain = WinNimMain - otherMain = WinCMain - else: - nimMain = WinNimDllMain - otherMain = WinCDllMain - discard lists.IncludeStr(m.headerFiles, "<windows.h>") - elif optGenDynLib in gGlobalOptions: - nimMain = posixNimDllMain - otherMain = posixCDllMain - else: - nimMain = PosixNimMain - otherMain = PosixCMain - if gBreakpoints != nil: discard cgsym(m, "dbgRegisterBreakpoint") - inc(m.labels) - appcg(m, m.s[cfsProcs], nimMain, [ - gBreakpoints, mainModInit, toRope(m.labels)]) - if not (optNoMain in gGlobalOptions): - appcg(m, m.s[cfsProcs], otherMain, []) - -proc getInitName(m: PSym): PRope = - result = ropeff("$1Init", "@$1Init", [toRope(m.name.s)]) - -proc registerModuleToMain(m: PSym) = - var initname = getInitName(m) - appff(mainModProcs, "N_NOINLINE(void, $1)(void);$n", - "declare void $1() noinline$n", [initname]) - if not (sfSystemModule in m.flags): - appff(mainModInit, "$1();$n", "call void ()* $1$n", [initname]) - -proc genInitCode(m: BModule) = - var initname, prc, procname, filename: PRope - if optProfiler in m.initProc.options: - # This does not really belong here, but there is no good place for this - # code. I don't want to put this to the proc generation as the - # ``IncludeStr`` call is quite slow. - discard lists.IncludeStr(m.headerFiles, "<cycle.h>") - initname = getInitName(m.module) - prc = ropeff("N_NOINLINE(void, $1)(void) {$n", - "define void $1() noinline {$n", [initname]) - if m.typeNodes > 0: - appcg(m, m.s[cfsTypeInit1], "static #TNimNode $1[$2];$n", - [m.typeNodesName, toRope(m.typeNodes)]) - if m.nimTypes > 0: - appcg(m, m.s[cfsTypeInit1], "static #TNimType $1[$2];$n", - [m.nimTypesName, toRope(m.nimTypes)]) - if optStackTrace in m.initProc.options: - getFrameDecl(m.initProc) - app(prc, m.initProc.s[cpsLocals]) - app(prc, m.s[cfsTypeInit1]) - procname = CStringLit(m.initProc, prc, m.module.name.s) - filename = CStringLit(m.initProc, prc, toFilename(m.module.info)) - app(prc, initFrame(m.initProc, procname, filename)) - else: - app(prc, m.initProc.s[cpsLocals]) - app(prc, m.s[cfsTypeInit1]) - app(prc, m.s[cfsTypeInit2]) - app(prc, m.s[cfsTypeInit3]) - app(prc, m.s[cfsDebugInit]) - app(prc, m.s[cfsDynLibInit]) - app(prc, m.initProc.s[cpsInit]) - app(prc, m.initProc.s[cpsStmts]) - if optStackTrace in m.initProc.options: app(prc, deinitFrame(m.initProc)) - app(prc, '}' & tnl & tnl) - app(m.s[cfsProcs], prc) - -proc genModule(m: BModule, cfilenoext: string): PRope = - result = getFileHeader(cfilenoext) - generateHeaders(m) - for i in countup(low(TCFileSection), cfsProcs): app(result, m.s[i]) - -proc rawNewModule(module: PSym, filename: string): BModule = - new(result) - InitLinkedList(result.headerFiles) - intSetInit(result.declaredThings) - intSetInit(result.declaredProtos) - result.cfilename = filename - result.filename = filename - initIdTable(result.typeCache) - initIdTable(result.forwTypeCache) - result.module = module - intSetInit(result.typeInfoMarker) - result.initProc = newProc(nil, result) - result.initProc.options = gOptions - initNodeTable(result.dataCache) - result.typeStack = @[] - result.forwardedProcs = @[] - result.typeNodesName = getTempName() - result.nimTypesName = getTempName() - -proc newModule(module: PSym, filename: string): BModule = - result = rawNewModule(module, filename) - if (optDeadCodeElim in gGlobalOptions): - if (sfDeadCodeElim in module.flags): - InternalError("added pending module twice: " & filename) - addPendingModule(result) - -proc registerTypeInfoModule() = - const moduleName = "nim__dat" - var s = NewSym(skModule, getIdent(moduleName), nil) - gNimDat = rawNewModule(s, joinPath(options.projectPath, moduleName) & ".nim") - addPendingModule(gNimDat) - appff(mainModProcs, "N_NOINLINE(void, $1)(void);$n", - "declare void $1() noinline$n", [getInitName(s)]) - -proc myOpen(module: PSym, filename: string): PPassContext = - if gNimDat == nil: registerTypeInfoModule() - result = newModule(module, filename) - -proc myOpenCached(module: PSym, filename: string, - rd: PRodReader): PPassContext = - if gNimDat == nil: - registerTypeInfoModule() - #MessageOut('cgen.myOpenCached has been called ' + filename) - var cfile = changeFileExt(completeCFilePath(filename), cExt) - var cfilenoext = changeFileExt(cfile, "") - addFileToLink(cfilenoext) - registerModuleToMain(module) - # XXX: this cannot be right here, initalization has to be appended during - # the ``myClose`` call - result = nil - -proc shouldRecompile(code: PRope, cfile, cfilenoext: string): bool = - result = true - if not (optForceFullMake in gGlobalOptions): - var objFile = toObjFile(cfilenoext) - if writeRopeIfNotEqual(code, cfile): return - if ExistsFile(objFile) and os.FileNewer(objFile, cfile): result = false - else: - writeRope(code, cfile) - -proc myProcess(b: PPassContext, n: PNode): PNode = - result = n - if b == nil or passes.skipCodegen(n): return - var m = BModule(b) - m.initProc.options = gOptions - genStmts(m.initProc, n) - -proc finishModule(m: BModule) = - var i = 0 - while i <= high(m.forwardedProcs): - # Note: ``genProc`` may add to ``m.forwardedProcs``, so we cannot use - # a ``for`` loop here - var prc = m.forwardedProcs[i] - if sfForward in prc.flags: InternalError(prc.info, "still forwarded") - genProcNoForward(m, prc) - inc(i) - assert(gForwardedProcsCounter >= i) - dec(gForwardedProcsCounter, i) - setlen(m.forwardedProcs, 0) - -proc writeModule(m: BModule) = - # generate code for the init statements of the module: - genInitCode(m) - finishTypeDescriptions(m) - var cfile = completeCFilePath(m.cfilename) - var cfilenoext = changeFileExt(cfile, "") - if sfMainModule in m.module.flags: - # generate main file: - app(m.s[cfsProcHeaders], mainModProcs) - var code = genModule(m, cfilenoext) - - when hasTinyCBackend: - if gCmd == cmdRun: - tccgen.compileCCode(ropeToStr(code)) - return - - if shouldRecompile(code, changeFileExt(cfile, cExt), cfilenoext): - addFileToCompile(cfilenoext) - addFileToLink(cfilenoext) - -proc myClose(b: PPassContext, n: PNode): PNode = - result = n - if b == nil or passes.skipCodegen(n): return - var m = BModule(b) - if n != nil: - m.initProc.options = gOptions - genStmts(m.initProc, n) - registerModuleToMain(m.module) - if not (optDeadCodeElim in gGlobalOptions) and - not (sfDeadCodeElim in m.module.flags): - finishModule(m) - if sfMainModule in m.module.flags: - var disp = generateMethodDispatchers() - for i in 0..sonsLen(disp)-1: genProcAux(gNimDat, disp.sons[i].sym) - genMainProc(m) - # we need to process the transitive closure because recursive module - # deps are allowed (and the system module is processed in the wrong - # order anyway) - while gForwardedProcsCounter > 0: - for i in countup(0, high(gPendingModules)): - finishModule(gPendingModules[i]) - for i in countup(0, high(gPendingModules)): writeModule(gPendingModules[i]) - setlen(gPendingModules, 0) - if not (optDeadCodeElim in gGlobalOptions) and - not (sfDeadCodeElim in m.module.flags): - writeModule(m) - if sfMainModule in m.module.flags: writeMapping(gMapping) - -proc cgenPass(): TPass = - initPass(result) - result.open = myOpen - result.openCached = myOpenCached - result.process = myProcess - result.close = myClose - -InitIiTable(gToTypeInfoId) -IntSetInit(gGeneratedSyms) diff --git a/rod/cgmeth.nim b/rod/cgmeth.nim deleted file mode 100755 index f9b12647f..000000000 --- a/rod/cgmeth.nim +++ /dev/null @@ -1,196 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements code generation for multi methods. - -import - options, ast, astalgo, msgs, idents, rnimsyn, types, magicsys - -proc genConv(n: PNode, d: PType, downcast: bool): PNode = - var - dest, source: PType - diff: int - dest = skipTypes(d, abstractPtrs) - source = skipTypes(n.typ, abstractPtrs) - if (source.kind == tyObject) and (dest.kind == tyObject): - diff = inheritanceDiff(dest, source) - if diff == high(int): InternalError(n.info, "cgmeth.genConv") - if diff < 0: - result = newNodeIT(nkObjUpConv, n.info, d) - addSon(result, n) - if downCast: InternalError(n.info, "cgmeth.genConv: no upcast allowed") - elif diff > 0: - result = newNodeIT(nkObjDownConv, n.info, d) - addSon(result, n) - if not downCast: - InternalError(n.info, "cgmeth.genConv: no downcast allowed") - else: - result = n - else: - result = n - -proc methodCall*(n: PNode): PNode = - var disp: PSym - result = n - disp = lastSon(result.sons[0].sym.ast).sym - result.sons[0].sym = disp - for i in countup(1, sonsLen(result) - 1): - result.sons[i] = genConv(result.sons[i], disp.typ.sons[i], true) - -var gMethods: seq[TSymSeq] - -proc sameMethodBucket(a, b: PSym): bool = - var aa, bb: PType - result = false - if a.name.id != b.name.id: return - if sonsLen(a.typ) != sonsLen(b.typ): - return # check for return type: - if not sameTypeOrNil(a.typ.sons[0], b.typ.sons[0]): return - for i in countup(1, sonsLen(a.typ) - 1): - aa = a.typ.sons[i] - bb = b.typ.sons[i] - while true: - aa = skipTypes(aa, {tyGenericInst}) - bb = skipTypes(bb, {tyGenericInst}) - if (aa.kind == bb.kind) and (aa.kind in {tyVar, tyPtr, tyRef}): - aa = aa.sons[0] - bb = bb.sons[0] - else: - break - if sameType(aa, bb) or - (aa.kind == tyObject) and (bb.kind == tyObject) and - (inheritanceDiff(bb, aa) < 0): - nil - else: - return - result = true - -proc methodDef*(s: PSym) = - var - L, q: int - disp: PSym - L = len(gMethods) - for i in countup(0, L - 1): - if sameMethodBucket(gMethods[i][0], s): - add(gMethods[i], s) # store a symbol to the dispatcher: - addSon(s.ast, lastSon(gMethods[i][0].ast)) - return - add(gMethods, @[s]) # create a new dispatcher: - disp = copySym(s) - disp.typ = copyType(disp.typ, disp.typ.owner, false) - if disp.typ.callConv == ccInline: disp.typ.callConv = ccDefault - disp.ast = copyTree(s.ast) - disp.ast.sons[codePos] = ast.emptyNode - if s.typ.sons[0] != nil: - disp.ast.sons[resultPos].sym = copySym(s.ast.sons[resultPos].sym) - addSon(s.ast, newSymNode(disp)) - -proc relevantCol(methods: TSymSeq, col: int): bool = - var t: PType - # returns true iff the position is relevant - t = methods[0].typ.sons[col] - result = false - if skipTypes(t, skipPtrs).kind == tyObject: - for i in countup(1, high(methods)): - if not SameType(methods[i].typ.sons[col], t): - return true - -proc cmpSignatures(a, b: PSym, relevantCols: TIntSet): int = - var - d: int - aa, bb: PType - result = 0 - for col in countup(1, sonsLen(a.typ) - 1): - if intSetContains(relevantCols, col): - aa = skipTypes(a.typ.sons[col], skipPtrs) - bb = skipTypes(b.typ.sons[col], skipPtrs) - d = inheritanceDiff(aa, bb) - if (d != high(int)): - return d - -proc sortBucket(a: var TSymSeq, relevantCols: TIntSet) = - # we use shellsort here; fast and simple - var - N, j, h: int - v: PSym - N = len(a) - h = 1 - while true: - h = 3 * h + 1 - if h > N: break - while true: - h = h div 3 - for i in countup(h, N - 1): - v = a[i] - j = i - while cmpSignatures(a[j - h], v, relevantCols) >= 0: - a[j] = a[j - h] - j = j - h - if j < h: break - a[j] = v - if h == 1: break - -proc genDispatcher(methods: TSymSeq, relevantCols: TIntSet): PSym = - var - disp, cond, call, ret, a, isn: PNode - base, curr, ands, iss: PSym - paramLen: int - base = lastSon(methods[0].ast).sym - result = base - paramLen = sonsLen(base.typ) - disp = newNodeI(nkIfStmt, base.info) - ands = getSysSym("and") - iss = getSysSym("is") - for meth in countup(0, high(methods)): - curr = methods[meth] # generate condition: - cond = nil - for col in countup(1, paramLen - 1): - if IntSetContains(relevantCols, col): - isn = newNodeIT(nkCall, base.info, getSysType(tyBool)) - addSon(isn, newSymNode(iss)) - addSon(isn, newSymNode(base.typ.n.sons[col].sym)) - addSon(isn, newNodeIT(nkType, base.info, curr.typ.sons[col])) - if cond != nil: - a = newNodeIT(nkCall, base.info, getSysType(tyBool)) - addSon(a, newSymNode(ands)) - addSon(a, cond) - addSon(a, isn) - cond = a - else: - cond = isn - call = newNodeI(nkCall, base.info) - addSon(call, newSymNode(curr)) - for col in countup(1, paramLen - 1): - addSon(call, genConv(newSymNode(base.typ.n.sons[col].sym), - curr.typ.sons[col], false)) - if base.typ.sons[0] != nil: - a = newNodeI(nkAsgn, base.info) - addSon(a, newSymNode(base.ast.sons[resultPos].sym)) - addSon(a, call) - ret = newNodeI(nkReturnStmt, base.info) - addSon(ret, a) - else: - ret = call - a = newNodeI(nkElifBranch, base.info) - addSon(a, cond) - addSon(a, ret) - addSon(disp, a) - result.ast.sons[codePos] = disp - -proc generateMethodDispatchers*(): PNode = - var relevantCols: TIntSet - result = newNode(nkStmtList) - for bucket in countup(0, len(gMethods) - 1): - IntSetInit(relevantCols) - for col in countup(1, sonsLen(gMethods[bucket][0].typ) - 1): - if relevantCol(gMethods[bucket], col): IntSetIncl(relevantCols, col) - sortBucket(gMethods[bucket], relevantCols) - addSon(result, newSymNode(genDispatcher(gMethods[bucket], relevantCols))) - -gMethods = @[] diff --git a/rod/charsets.nim b/rod/charsets.nim deleted file mode 100755 index c952a73bd..000000000 --- a/rod/charsets.nim +++ /dev/null @@ -1,49 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -const - CharSize* = SizeOf(Char) - Lrz* = ' ' - Apo* = '\'' - Tabulator* = '\x09' - ESC* = '\x1B' - CR* = '\x0D' - FF* = '\x0C' - LF* = '\x0A' - BEL* = '\x07' - BACKSPACE* = '\x08' - VT* = '\x0B' - -when defined(macos): - DirSep == ':' - "\n" == CR & "" - FirstNLchar == CR - PathSep == ';' # XXX: is this correct? -else: - when defined(unix): - DirSep == '/' - "\n" == LF & "" - FirstNLchar == LF - PathSep == ':' - else: - # windows, dos - DirSep == '\\' - "\n" == CR + LF - FirstNLchar == CR - DriveSeparator == ':' - PathSep == ';' -UpLetters == {'A'..'Z', '\xC0'..'\xDE'} -DownLetters == {'a'..'z', '\xDF'..'\xFF'} -Numbers == {'0'..'9'} -Letters == UpLetters + DownLetters -type - TCharSet* = set[Char] - PCharSet* = ref TCharSet - -# implementation diff --git a/rod/commands.nim b/rod/commands.nim deleted file mode 100755 index d3eaf94a9..000000000 --- a/rod/commands.nim +++ /dev/null @@ -1,521 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module handles the parsing of command line arguments. - -import - os, msgs, options, nversion, condsyms, strutils, extccomp, platform, lists, - wordrecg, parseutils - -proc writeCommandLineUsage*() - -type - TCmdLinePass* = enum - passCmd1, # first pass over the command line - passCmd2, # second pass over the command line - passPP # preprocessor called ProcessCommand() - -proc ProcessCommand*(switch: string, pass: TCmdLinePass) -proc processSwitch*(switch, arg: string, pass: TCmdlinePass, info: TLineInfo) -# implementation - -const - HelpMessage = "Nimrod Compiler Version $1 (" & compileDate & ") [$2: $3]\n" & - "Copyright (c) 2004-2011 by Andreas Rumpf\n" - -const - Usage = """ -Usage: - nimrod command [options] [projectfile] [arguments] -Command: - compile, c compile project with default code generator (C) - doc generate the documentation for inputfile - i start Nimrod in interactive mode (limited) -Arguments: - arguments are passed to the program being run (if --run option is selected) -Options: - -p, --path:PATH add path to search paths - -d, --define:SYMBOL define a conditional symbol - -u, --undef:SYMBOL undefine a conditional symbol - -f, --forceBuild force rebuilding of all modules - --stackTrace:on|off turn stack tracing on|off - --lineTrace:on|off turn line tracing on|off - --threads:on|off turn support for multi-threading on|off - -x, --checks:on|off turn all runtime checks on|off - --objChecks:on|off turn obj conversion checks on|off - --fieldChecks:on|off turn case variant field checks on|off - --rangeChecks:on|off turn range checks on|off - --boundChecks:on|off turn bound checks on|off - --overflowChecks:on|off turn int over-/underflow checks on|off - -a, --assertions:on|off turn assertions on|off - --floatChecks:on|off turn all floating point (NaN/Inf) checks on|off - --nanChecks:on|off turn NaN checks on|off - --infChecks:on|off turn Inf checks on|off - --deadCodeElim:on|off whole program dead code elimination on|off - --opt:none|speed|size optimize not at all or for speed|size - --app:console|gui|lib generate a console|GUI application|dynamic library - -r, --run run the compiled program with given arguments - --advanced show advanced command line switches - -h, --help show this help -""" - - AdvancedUsage = """ -Advanced commands: - compileToC, cc compile project with C code generator - compileToOC, oc compile project to Objective C code - rst2html convert a reStructuredText file to HTML - rst2tex convert a reStructuredText file to TeX - run run the project (with Tiny C backend; buggy!) - pretty pretty print the inputfile - genDepend generate a DOT file containing the - module dependency graph - dump dump all defined conditionals and search paths - check checks the project for syntax and semantic - idetools compiler support for IDEs: possible options: - --track:FILE,LINE,COL track a file/cursor position - --suggest suggest all possible symbols at position - --def list all possible symbols at position - --context list possible invokation context -Advanced options: - -o, --out:FILE set the output filename - --stdout output to stdout - -w, --warnings:on|off turn all warnings on|off - --warning[X]:on|off turn specific warning X on|off - --hints:on|off turn all hints on|off - --hint[X]:on|off turn specific hint X on|off - --lib:PATH set the system library path - -c, --compileOnly compile only; do not assemble or link - --noLinking compile but do not link - --noMain do not generate a main procedure - --genScript generate a compile script (in the 'nimcache' - subdirectory named 'compile_$project$scriptext') - --os:SYMBOL set the target operating system (cross-compilation) - --cpu:SYMBOL set the target processor (cross-compilation) - --debuginfo enables debug information - --debugger:on|off turn Embedded Nimrod Debugger on|off - -t, --passc:OPTION pass an option to the C compiler - -l, --passl:OPTION pass an option to the linker - --genMapping generate a mapping file containing - (Nimrod, mangled) identifier pairs - --lineDir:on|off generation of #line directive on|off - --checkpoints:on|off turn checkpoints on|off; for debugging Nimrod - --skipCfg do not read the general configuration file - --skipProjCfg do not read the project's configuration file - --gc:refc|boehm|none use Nimrod's native GC|Boehm GC|no GC - --index:FILE use FILE to generate a documentation index file - --putenv:key=value set an environment variable - --listCmd list the commands used to execute external programs - --parallelBuild=0|1|... perform a parallel build - value = number of processors (0 for auto-detect) - --verbosity:0|1|2|3 set Nimrod's verbosity level (0 is default) - -v, --version show detailed version information -""" - -proc getCommandLineDesc(): string = - result = `%`(HelpMessage, [VersionAsString, platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name]) & Usage - -var - helpWritten: bool # BUGFIX 19 - versionWritten: bool - advHelpWritten: bool - -proc HelpOnError(pass: TCmdLinePass) = - if (pass == passCmd1) and not helpWritten: - # BUGFIX 19 - MsgWriteln(getCommandLineDesc()) - helpWritten = true - quit(0) - -proc writeAdvancedUsage(pass: TCmdLinePass) = - if (pass == passCmd1) and not advHelpWritten: - # BUGFIX 19 - MsgWriteln(`%`(HelpMessage, [VersionAsString, - platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name]) & AdvancedUsage) - advHelpWritten = true - helpWritten = true - quit(0) - -proc writeVersionInfo(pass: TCmdLinePass) = - if (pass == passCmd1) and not versionWritten: - versionWritten = true - helpWritten = true - MsgWriteln(`%`(HelpMessage, [VersionAsString, - platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name])) - quit(0) - -proc writeCommandLineUsage() = - if not helpWritten: - MsgWriteln(getCommandLineDesc()) - helpWritten = true - -proc InvalidCmdLineOption(pass: TCmdLinePass, switch: string, info: TLineInfo) = - LocalError(info, errInvalidCmdLineOption, switch) - -proc splitSwitch(switch: string, cmd, arg: var string, pass: TCmdLinePass, - info: TLineInfo) = - cmd = "" - var i = 0 - if i < len(switch) and switch[i] == '-': inc(i) - if i < len(switch) and switch[i] == '-': inc(i) - while i < len(switch): - case switch[i] - of 'a'..'z', 'A'..'Z', '0'..'9', '_', '.': add(cmd, switch[i]) - else: break - inc(i) - if i >= len(switch): arg = "" - elif switch[i] in {':', '=', '['}: arg = copy(switch, i + 1) - else: InvalidCmdLineOption(pass, switch, info) - -proc ProcessOnOffSwitch(op: TOptions, arg: string, pass: TCmdlinePass, - info: TLineInfo) = - case whichKeyword(arg) - of wOn: gOptions = gOptions + op - of wOff: gOptions = gOptions - op - else: LocalError(info, errOnOrOffExpectedButXFound, arg) - -proc ProcessOnOffSwitchG(op: TGlobalOptions, arg: string, pass: TCmdlinePass, - info: TLineInfo) = - case whichKeyword(arg) - of wOn: gGlobalOptions = gGlobalOptions + op - of wOff: gGlobalOptions = gGlobalOptions - op - else: LocalError(info, errOnOrOffExpectedButXFound, arg) - -proc ExpectArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = - if arg == "": LocalError(info, errCmdLineArgExpected, switch) - -proc ExpectNoArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = - if arg != "": LocalError(info, errCmdLineNoArgExpected, switch) - -proc ProcessSpecificNote(arg: string, state: TSpecialWord, pass: TCmdlinePass, - info: TLineInfo) = - var id = "" # arg = "X]:on|off" - var i = 0 - var n = hintMin - while i < len(arg) and (arg[i] != ']'): - add(id, arg[i]) - inc(i) - if i < len(arg) and (arg[i] == ']'): inc(i) - else: InvalidCmdLineOption(pass, arg, info) - if i < len(arg) and (arg[i] in {':', '='}): inc(i) - else: InvalidCmdLineOption(pass, arg, info) - if state == wHint: - var x = findStr(msgs.HintsToStr, id) - if x >= 0: n = TNoteKind(x + ord(hintMin)) - else: InvalidCmdLineOption(pass, arg, info) - else: - var x = findStr(msgs.WarningsToStr, id) - if x >= 0: n = TNoteKind(x + ord(warnMin)) - else: InvalidCmdLineOption(pass, arg, info) - case whichKeyword(copy(arg, i)) - of wOn: incl(gNotes, n) - of wOff: excl(gNotes, n) - else: LocalError(info, errOnOrOffExpectedButXFound, arg) - -proc processCompile(filename: string) = - var found = findFile(filename) - if found == "": found = filename - var trunc = changeFileExt(found, "") - extccomp.addExternalFileToCompile(found) - extccomp.addFileToLink(completeCFilePath(trunc, false)) - -proc testCompileOptionArg*(switch, arg: string, info: TLineInfo): bool = - case whichKeyword(switch) - of wGC: - case whichKeyword(arg) - of wBoehm: result = contains(gGlobalOptions, optBoehmGC) - of wRefc: result = contains(gGlobalOptions, optRefcGC) - of wNone: result = gGlobalOptions * {optBoehmGC, optRefcGC} == {} - else: LocalError(info, errNoneBoehmRefcExpectedButXFound, arg) - of wOpt: - case whichKeyword(arg) - of wSpeed: result = contains(gOptions, optOptimizeSpeed) - of wSize: result = contains(gOptions, optOptimizeSize) - of wNone: result = gOptions * {optOptimizeSpeed, optOptimizeSize} == {} - else: LocalError(info, errNoneSpeedOrSizeExpectedButXFound, arg) - else: InvalidCmdLineOption(passCmd1, switch, info) - -proc testCompileOption*(switch: string, info: TLineInfo): bool = - case whichKeyword(switch) - of wDebuginfo: result = contains(gGlobalOptions, optCDebug) - of wCompileOnly, wC: result = contains(gGlobalOptions, optCompileOnly) - of wNoLinking: result = contains(gGlobalOptions, optNoLinking) - of wNoMain: result = contains(gGlobalOptions, optNoMain) - of wForceBuild, wF: result = contains(gGlobalOptions, optForceFullMake) - of wWarnings, wW: result = contains(gOptions, optWarns) - of wHints: result = contains(gOptions, optHints) - of wCheckpoints: result = contains(gOptions, optCheckpoints) - of wStackTrace: result = contains(gOptions, optStackTrace) - of wLineTrace: result = contains(gOptions, optLineTrace) - of wDebugger: result = contains(gOptions, optEndb) - of wProfiler: result = contains(gOptions, optProfiler) - of wChecks, wX: result = gOptions * checksOptions == checksOptions - of wFloatChecks: - result = gOptions * {optNanCheck, optInfCheck} == {optNanCheck, optInfCheck} - of wInfChecks: result = contains(gOptions, optInfCheck) - of wNanChecks: result = contains(gOptions, optNanCheck) - of wObjChecks: result = contains(gOptions, optObjCheck) - of wFieldChecks: result = contains(gOptions, optFieldCheck) - of wRangeChecks: result = contains(gOptions, optRangeCheck) - of wBoundChecks: result = contains(gOptions, optBoundsCheck) - of wOverflowChecks: result = contains(gOptions, optOverflowCheck) - of wLineDir: result = contains(gOptions, optLineDir) - of wAssertions, wA: result = contains(gOptions, optAssert) - of wDeadCodeElim: result = contains(gGlobalOptions, optDeadCodeElim) - of wRun, wR: result = contains(gGlobalOptions, optRun) - of wSymbolFiles: result = contains(gGlobalOptions, optSymbolFiles) - of wGenScript: result = contains(gGlobalOptions, optGenScript) - of wThreads: result = contains(gGlobalOptions, optThreads) - else: InvalidCmdLineOption(passCmd1, switch, info) - -proc processPath(path: string): string = - result = UnixToNativePath(path % ["nimrod", getPrefixDir(), "lib", libpath, - "home", removeTrailingDirSep(os.getHomeDir())]) - -proc addPath(path: string, info: TLineInfo) = - if not contains(options.searchPaths, path): - lists.PrependStr(options.searchPaths, path) - -proc addPathRec(dir: string, info: TLineInfo) = - var pos = dir.len-1 - if dir[pos] in {DirSep, AltSep}: inc(pos) - for k,p in os.walkDir(dir): - if k == pcDir and p[pos] != '.': - addPathRec(p, info) - if not contains(options.searchPaths, p): - Message(info, hintPath, p) - lists.PrependStr(options.searchPaths, p) - -proc track(arg: string, info: TLineInfo) = - var a = arg.split(',') - if a.len != 3: LocalError(info, errTokenExpected, "FILE,LINE,COLMUN") - var line, column: int - if parseUtils.parseInt(a[1], line) <= 0: - LocalError(info, errInvalidNumber, a[1]) - if parseUtils.parseInt(a[2], column) <= 0: - LocalError(info, errInvalidNumber, a[2]) - msgs.addCheckpoint(newLineInfo(a[0], line, column)) - -proc processSwitch(switch, arg: string, pass: TCmdlinePass, info: TLineInfo) = - var - theOS: TSystemOS - cpu: TSystemCPU - key, val: string - case whichKeyword(switch) - of wPath, wP: - expectArg(switch, arg, pass, info) - addPath(processPath(arg), info) - of wRecursivePath: - expectArg(switch, arg, pass, info) - var path = processPath(arg) - addPathRec(path, info) - addPath(path, info) - of wOut, wO: - expectArg(switch, arg, pass, info) - options.outFile = arg - of wDefine, wD: - expectArg(switch, arg, pass, info) - DefineSymbol(arg) - of wUndef, wU: - expectArg(switch, arg, pass, info) - UndefSymbol(arg) - of wCompile: - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: processCompile(arg) - of wLink: - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: addFileToLink(arg) - of wDebuginfo: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optCDebug) - of wCompileOnly, wC: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optCompileOnly) - of wNoLinking: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optNoLinking) - of wNoMain: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optNoMain) - of wForceBuild, wF: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optForceFullMake) - of wGC: - expectArg(switch, arg, pass, info) - case whichKeyword(arg) - of wBoehm: - incl(gGlobalOptions, optBoehmGC) - excl(gGlobalOptions, optRefcGC) - DefineSymbol("boehmgc") - of wRefc: - excl(gGlobalOptions, optBoehmGC) - incl(gGlobalOptions, optRefcGC) - of wNone: - excl(gGlobalOptions, optRefcGC) - excl(gGlobalOptions, optBoehmGC) - defineSymbol("nogc") - else: LocalError(info, errNoneBoehmRefcExpectedButXFound, arg) - of wWarnings, wW: ProcessOnOffSwitch({optWarns}, arg, pass, info) - of wWarning: ProcessSpecificNote(arg, wWarning, pass, info) - of wHint: ProcessSpecificNote(arg, wHint, pass, info) - of wHints: ProcessOnOffSwitch({optHints}, arg, pass, info) - of wCheckpoints: ProcessOnOffSwitch({optCheckpoints}, arg, pass, info) - of wStackTrace: ProcessOnOffSwitch({optStackTrace}, arg, pass, info) - of wLineTrace: ProcessOnOffSwitch({optLineTrace}, arg, pass, info) - of wDebugger: - ProcessOnOffSwitch({optEndb}, arg, pass, info) - if optEndb in gOptions: DefineSymbol("endb") - else: UndefSymbol("endb") - of wProfiler: - ProcessOnOffSwitch({optProfiler}, arg, pass, info) - if optProfiler in gOptions: DefineSymbol("profiler") - else: UndefSymbol("profiler") - of wChecks, wX: ProcessOnOffSwitch(checksOptions, arg, pass, info) - of wFloatChecks: - ProcessOnOffSwitch({optNanCheck, optInfCheck}, arg, pass, info) - of wInfChecks: ProcessOnOffSwitch({optInfCheck}, arg, pass, info) - of wNanChecks: ProcessOnOffSwitch({optNanCheck}, arg, pass, info) - of wObjChecks: ProcessOnOffSwitch({optObjCheck}, arg, pass, info) - of wFieldChecks: ProcessOnOffSwitch({optFieldCheck}, arg, pass, info) - of wRangeChecks: ProcessOnOffSwitch({optRangeCheck}, arg, pass, info) - of wBoundChecks: ProcessOnOffSwitch({optBoundsCheck}, arg, pass, info) - of wOverflowChecks: ProcessOnOffSwitch({optOverflowCheck}, arg, pass, info) - of wLineDir: ProcessOnOffSwitch({optLineDir}, arg, pass, info) - of wAssertions, wA: ProcessOnOffSwitch({optAssert}, arg, pass, info) - of wDeadCodeElim: ProcessOnOffSwitchG({optDeadCodeElim}, arg, pass, info) - of wThreads: ProcessOnOffSwitchG({optThreads}, arg, pass, info) - of wOpt: - expectArg(switch, arg, pass, info) - case whichKeyword(arg) - of wSpeed: - incl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - of wSize: - excl(gOptions, optOptimizeSpeed) - incl(gOptions, optOptimizeSize) - of wNone: - excl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - else: LocalError(info, errNoneSpeedOrSizeExpectedButXFound, arg) - of wApp: - expectArg(switch, arg, pass, info) - case whichKeyword(arg) - of wGui: - incl(gGlobalOptions, optGenGuiApp) - defineSymbol("guiapp") - of wConsole: - excl(gGlobalOptions, optGenGuiApp) - of wLib: - incl(gGlobalOptions, optGenDynLib) - excl(gGlobalOptions, optGenGuiApp) - defineSymbol("library") - else: LocalError(info, errGuiConsoleOrLibExpectedButXFound, arg) - of wPassC, wT: - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: extccomp.addCompileOption(arg) - of wPassL, wL: - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: extccomp.addLinkOption(arg) - of wIndex: - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: gIndexFile = arg - of wImport: - expectArg(switch, arg, pass, info) - options.addImplicitMod(arg) - of wListCmd: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optListCmd) - of wGenMapping: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optGenMapping) - of wOS: - expectArg(switch, arg, pass, info) - if (pass == passCmd1): - theOS = platform.NameToOS(arg) - if theOS == osNone: LocalError(info, errUnknownOS, arg) - elif theOS != platform.hostOS: - setTarget(theOS, targetCPU) - incl(gGlobalOptions, optCompileOnly) - condsyms.InitDefines() - of wCPU: - expectArg(switch, arg, pass, info) - if (pass == passCmd1): - cpu = platform.NameToCPU(arg) - if cpu == cpuNone: LocalError(info, errUnknownCPU, arg) - elif cpu != platform.hostCPU: - setTarget(targetOS, cpu) - incl(gGlobalOptions, optCompileOnly) - condsyms.InitDefines() - of wRun, wR: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optRun) - of wVerbosity: - expectArg(switch, arg, pass, info) - gVerbosity = parseInt(arg) - of wParallelBuild: - expectArg(switch, arg, pass, info) - gNumberOfProcessors = parseInt(arg) - of wVersion, wV: - expectNoArg(switch, arg, pass, info) - writeVersionInfo(pass) - of wAdvanced: - expectNoArg(switch, arg, pass, info) - writeAdvancedUsage(pass) - of wHelp, wH: - expectNoArg(switch, arg, pass, info) - helpOnError(pass) - of wSymbolFiles: - ProcessOnOffSwitchG({optSymbolFiles}, arg, pass, info) - of wSkipCfg: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSkipConfigFile) - of wSkipProjCfg: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSkipProjConfigFile) - of wGenScript: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optGenScript) - of wLib: - expectArg(switch, arg, pass, info) - libpath = processPath(arg) - of wPutEnv: - expectArg(switch, arg, pass, info) - splitSwitch(arg, key, val, pass, info) - os.putEnv(key, val) - of wCC: - expectArg(switch, arg, pass, info) - setCC(arg) - of wTrack: - expectArg(switch, arg, pass, info) - track(arg, info) - of wSuggest: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSuggest) - of wDef: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optDef) - of wContext: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optContext) - of wStdout: - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optStdout) - else: - if strutils.find(switch, '.') >= 0: options.setConfigVar(switch, arg) - else: InvalidCmdLineOption(pass, switch, info) - -proc ProcessCommand(switch: string, pass: TCmdLinePass) = - var - cmd, arg: string - info: TLineInfo - info = newLineInfo("command line", 1, 1) - splitSwitch(switch, cmd, arg, pass, info) - ProcessSwitch(cmd, arg, pass, info) diff --git a/rod/condsyms.nim b/rod/condsyms.nim deleted file mode 100755 index 7a7505511..000000000 --- a/rod/condsyms.nim +++ /dev/null @@ -1,102 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module handles the conditional symbols. - -import - ast, astalgo, msgs, nhashes, platform, strutils, idents - -var gSymbols*: TStrTable - -proc InitDefines*() -proc DeinitDefines*() -proc DefineSymbol*(symbol: string) -proc UndefSymbol*(symbol: string) -proc isDefined*(symbol: PIdent): bool -proc ListSymbols*() -proc countDefinedSymbols*(): int -# implementation - -proc DefineSymbol(symbol: string) = - var i = getIdent(symbol) - var sym = StrTableGet(gSymbols, i) - if sym == nil: - new(sym) # circumvent the ID mechanism - sym.kind = skConditional - sym.name = i - StrTableAdd(gSymbols, sym) - sym.position = 1 - -proc UndefSymbol(symbol: string) = - var sym = StrTableGet(gSymbols, getIdent(symbol)) - if sym != nil: sym.position = 0 - -proc isDefined(symbol: PIdent): bool = - var sym = StrTableGet(gSymbols, symbol) - result = (sym != nil) and (sym.position == 1) - -proc ListSymbols() = - var it: TTabIter - var s = InitTabIter(it, gSymbols) - OutWriteln("-- List of currently defined symbols --") - while s != nil: - if s.position == 1: OutWriteln(s.name.s) - s = nextIter(it, gSymbols) - OutWriteln("-- End of list --") - -proc countDefinedSymbols(): int = - var it: TTabIter - var s = InitTabIter(it, gSymbols) - result = 0 - while s != nil: - if s.position == 1: inc(result) - s = nextIter(it, gSymbols) - -proc InitDefines() = - initStrTable(gSymbols) - DefineSymbol("nimrod") # 'nimrod' is always defined - - # add platform specific symbols: - case targetCPU - of cpuI386: DefineSymbol("x86") - of cpuIa64: DefineSymbol("itanium") - of cpuAmd64: DefineSymbol("x8664") - else: nil - case targetOS - of osDOS: - DefineSymbol("msdos") - of osWindows: - DefineSymbol("mswindows") - DefineSymbol("win32") - of osLinux, osMorphOS, osSkyOS, osIrix, osPalmOS, osQNX, osAtari, osAix: - # these are all 'unix-like' - DefineSymbol("unix") - DefineSymbol("posix") - of osSolaris: - DefineSymbol("sunos") - DefineSymbol("unix") - DefineSymbol("posix") - of osNetBSD, osFreeBSD, osOpenBSD: - DefineSymbol("unix") - DefineSymbol("bsd") - DefineSymbol("posix") - of osMacOS: - DefineSymbol("macintosh") - of osMacOSX: - DefineSymbol("macintosh") - DefineSymbol("unix") - DefineSymbol("posix") - else: nil - DefineSymbol("cpu" & $cpu[targetCPU].bit) - DefineSymbol(normalize(endianToStr[cpu[targetCPU].endian])) - DefineSymbol(cpu[targetCPU].name) - DefineSymbol(platform.os[targetOS].name) - -proc DeinitDefines() = - nil diff --git a/rod/crc.nim b/rod/crc.nim deleted file mode 100755 index be1aee16b..000000000 --- a/rod/crc.nim +++ /dev/null @@ -1,150 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - strutils - -type - TCrc32* = int32 - -const - InitCrc32* = TCrc32(- 1) - InitAdler32* = int32(1) - -proc updateCrc32*(val: int8, crc: TCrc32): TCrc32 {.inline.} -proc updateCrc32*(val: Char, crc: TCrc32): TCrc32 {.inline.} -proc crcFromBuf*(buf: Pointer, length: int): TCrc32 -proc strCrc32*(s: string): TCrc32 -proc crcFromFile*(filename: string): TCrc32 -proc updateAdler32*(adler: int32, buf: pointer, length: int): int32 -# implementation - -type - TCRC_TabEntry = int - -const - crc32table: array[0..255, TCRC_TabEntry] = [0, 1996959894, - 301047508, - - 1727442502, 124634137, 1886057615, - 379345611, - 1637575261, 249268274, - 2044508324, - 522852066, - 1747789432, 162941995, 2125561021, - 407360249, - - 1866523247, 498536548, 1789927666, - 205950648, - 2067906082, 450548861, - 1843258603, - 187386543, - 2083289657, 325883990, 1684777152, - 43845254, - - 1973040660, 335633487, 1661365465, - 99664541, - 1928851979, 997073096, - 1281953886, - 715111964, - 1570279054, 1006888145, 1258607687, - 770865667, - - 1526024853, 901097722, 1119000684, - 608450090, - 1396901568, 853044451, - 1172266101, - 589951537, - 1412350631, 651767980, 1373503546, - 925412992, - - 1076862698, 565507253, 1454621731, - 809855591, - 1195530993, 671266974, - 1594198024, - 972236366, - 1324619484, 795835527, 1483230225, - 1050600021, - - 1234817731, 1994146192, 31158534, - 1731059524, - 271249366, 1907459465, - 112637215, - 1614814043, - 390540237, 2013776290, 251722036, - 1777751922, - - 519137256, 2137656763, 141376813, - 1855689577, - 429695999, 1802195444, - 476864866, - 2056965928, - 228458418, 1812370925, 453092731, - 2113342271, - - 183516073, 1706088902, 314042704, - 1950435094, - 54949764, 1658658271, - 366619977, - 1932296973, - 69972891, 1303535960, 984961486, - 1547960204, - - 725929758, 1256170817, 1037604311, - 1529756563, - 740887301, 1131014506, - 879679996, - 1385723834, - 631195440, 1141124467, 855842277, - 1442165665, - - 586318647, 1342533948, 654459306, - 1106571248, - 921952122, 1466479909, - 544179635, - 1184443383, - 832445281, 1591671054, 702138776, - 1328506846, - - 942167884, 1504918807, 783551873, - 1212326853, - 1061524307, - 306674912, - - 1698712650, 62317068, 1957810842, - 355121351, - 1647151185, 81470997, - 1943803523, - 480048366, - 1805370492, 225274430, 2053790376, - 468791541, - - 1828061283, 167816743, 2097651377, - 267414716, - 2029476910, 503444072, - 1762050814, - 144550051, - 2140837941, 426522225, 1852507879, - 19653770, - - 1982649376, 282753626, 1742555852, - 105259153, - 1900089351, 397917763, - 1622183637, - 690576408, - 1580100738, 953729732, 1340076626, - 776247311, - - 1497606297, 1068828381, 1219638859, - 670225446, - 1358292148, 906185462, - 1090812512, - 547295293, - 1469587627, 829329135, 1181335161, - 882789492, - - 1134132454, 628085408, 1382605366, - 871598187, - 1156888829, 570562233, - 1426400815, - 977650754, - 1296233688, 733239954, 1555261956, - 1026031705, - - 1244606671, 752459403, 1541320221, - 1687895376, - 328994266, 1969922972, - 40735498, - 1677130071, - 351390145, 1913087877, 83908371, - 1782625662, - - 491226604, 2075208622, 213261112, - 1831694693, - 438977011, 2094854071, - 198958881, - 2032938284, - 237706686, 1759359992, 534414190, - 2118248755, - - 155638181, 1873836001, 414664567, - 2012718362, - 15766928, 1711684554, - 285281116, - 1889165569, - 127750551, 1634467795, 376229701, - 1609899400, - - 686959890, 1308918612, 956543938, - 1486412191, - 799009033, 1231636301, - 1047427035, - 1362007478, - 640263460, 1088359270, 936918000, - 1447252397, - - 558129467, 1202900863, 817233897, - 1111625188, - 893730166, 1404277552, - 615818150, - 1160759803, - 841546093, 1423857449, 601450431, - 1285129682, - - 1000256840, 1567103746, 711928724, - 1274298825, - 1022587231, 1510334235, - 755167117] - -proc updateCrc32(val: int8, crc: TCrc32): TCrc32 = - result = TCrc32(crc32Table[(int(crc) xor (int(val) and 0x000000FF)) and - 0x000000FF]) xor (crc shr TCrc32(8)) - -proc updateCrc32(val: Char, crc: TCrc32): TCrc32 = - result = updateCrc32(int8(ord(val)), crc) - -proc strCrc32(s: string): TCrc32 = - result = InitCrc32 - for i in countup(0, len(s) + 0 - 1): result = updateCrc32(s[i], result) - -proc `><`*(c: TCrc32, s: string): TCrc32 = - result = c - for i in 0..len(s)-1: result = updateCrc32(s[i], result) - -type - TByteArray = array[0..10000000, int8] - PByteArray = ref TByteArray - -proc crcFromBuf(buf: Pointer, length: int): TCrc32 = - var p = cast[PByteArray](buf) - result = InitCrc32 - for i in countup(0, length - 1): result = updateCrc32(p[i], result) - -proc crcFromFile(filename: string): TCrc32 = - const - bufSize = 8 * 1024 - var - bin: tfile - buf: Pointer - readBytes: int - p: PByteArray - result = InitCrc32 - if not open(bin, filename): - return # not equal if file does not exist - buf = alloc(BufSize) - p = cast[PByteArray](buf) - while true: - readBytes = readBuffer(bin, buf, bufSize) - for i in countup(0, readBytes - 1): result = updateCrc32(p[i], result) - if readBytes != bufSize: break - dealloc(buf) - close(bin) - -const - base = int32(65521) # largest prime smaller than 65536 - # NMAX = 5552; original code with unsigned 32 bit integer - # NMAX is the largest n - # such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 - nmax = 3854 # code with signed 32 bit integer - # NMAX is the largest n such that - # 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 - # The penalty is the time loss in the extra MOD-calls. - -proc updateAdler32(adler: int32, buf: pointer, length: int): int32 = - var - s1, s2: int32 - L, k, b: int - s1 = adler and int32(0x0000FFFF) - s2 = (adler shr int32(16)) and int32(0x0000FFFF) - L = length - b = 0 - while (L > 0): - if L < nmax: k = L - else: k = nmax - dec(L, k) - while (k > 0): - s1 = s1 +% int32((cast[cstring](buf))[b]) - s2 = s2 +% s1 - inc(b) - dec(k) - s1 = `%%`(s1, base) - s2 = `%%`(s2, base) - result = (s2 shl int32(16)) or s1 diff --git a/rod/depends.nim b/rod/depends.nim deleted file mode 100755 index 05d176436..000000000 --- a/rod/depends.nim +++ /dev/null @@ -1,61 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements a dependency file generator. - -import - os, options, ast, astalgo, msgs, ropes, idents, passes, importer - -proc genDependPass*(): TPass -proc generateDot*(project: string) - -type - TGen = object of TPassContext - module*: PSym - filename*: string - PGen = ref TGen - -var gDotGraph: PRope # the generated DOT file; we need a global variable - -proc addDependencyAux(importing, imported: string) = - appf(gDotGraph, "$1 -> $2;$n", [toRope(importing), toRope(imported)]) - # s1 -> s2_4[label="[0-9]"]; - -proc addDotDependency(c: PPassContext, n: PNode): PNode = - result = n - var g = PGen(c) - case n.kind - of nkImportStmt: - for i in countup(0, sonsLen(n) - 1): - var imported = splitFile(getModuleFile(n.sons[i])).name - addDependencyAux(g.module.name.s, imported) - of nkFromStmt: - var imported = splitFile(getModuleFile(n.sons[0])).name - addDependencyAux(g.module.name.s, imported) - of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: - for i in countup(0, sonsLen(n) - 1): discard addDotDependency(c, n.sons[i]) - else: - nil - -proc generateDot(project: string) = - writeRope(ropef("digraph $1 {$n$2}$n", [ - toRope(changeFileExt(extractFileName(project), "")), gDotGraph]), - changeFileExt(project, "dot")) - -proc myOpen(module: PSym, filename: string): PPassContext = - var g: PGen - new(g) - g.module = module - g.filename = filename - result = g - -proc gendependPass(): TPass = - initPass(result) - result.open = myOpen - result.process = addDotDependency diff --git a/rod/docgen.nim b/rod/docgen.nim deleted file mode 100755 index ed5ca20ed..000000000 --- a/rod/docgen.nim +++ /dev/null @@ -1,891 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This is the documentation generator. It is currently pretty simple: No -# semantic checking is done for the code. Cross-references are generated -# by knowing how the anchors are going to be named. - -import - ast, astalgo, strutils, nhashes, options, nversion, msgs, os, ropes, idents, - wordrecg, math, syntaxes, rnimsyn, scanner, rst, times, highlite - -proc CommandDoc*(filename: string) -proc CommandRst2Html*(filename: string) -proc CommandRst2TeX*(filename: string) -# implementation - -type - TTocEntry{.final.} = object - n*: PRstNode - refname*, header*: PRope - - TSections = array[TSymKind, PRope] - TMetaEnum = enum - metaNone, metaTitle, metaSubtitle, metaAuthor, metaVersion - TDocumentor{.final.} = object # contains a module's documentation - filename*: string # filename of the source file; without extension - basedir*: string # base directory (where to put the documentation) - modDesc*: PRope # module description - id*: int # for generating IDs - splitAfter*: int # split too long entries in the TOC - tocPart*: seq[TTocEntry] - hasToc*: bool - toc*, section*: TSections - indexFile*, theIndex*: PRstNode - indexValFilename*: string - indent*, verbatim*: int # for code generation - meta*: array[TMetaEnum, PRope] - - PDoc = ref TDocumentor - -var splitter: string = "<wbr />" - -proc findIndexNode(n: PRstNode): PRstNode = - if n == nil: - result = nil - elif n.kind == rnIndex: - result = n.sons[2] - if result == nil: - result = newRstNode(rnDefList) - n.sons[2] = result - elif result.kind == rnInner: - result = result.sons[0] - else: - result = nil - for i in countup(0, rsonsLen(n) - 1): - result = findIndexNode(n.sons[i]) - if result != nil: return - -proc initIndexFile(d: PDoc) = - var - h: PRstNode - dummyHasToc: bool - if gIndexFile.len == 0: return - gIndexFile = addFileExt(gIndexFile, "txt") - d.indexValFilename = changeFileExt(extractFilename(d.filename), HtmlExt) - if ExistsFile(gIndexFile): - d.indexFile = rstParse(readFile(gIndexFile), false, gIndexFile, 0, 1, - dummyHasToc) - d.theIndex = findIndexNode(d.indexFile) - if (d.theIndex == nil) or (d.theIndex.kind != rnDefList): - rawMessage(errXisNoValidIndexFile, gIndexFile) - clearIndex(d.theIndex, d.indexValFilename) - else: - d.indexFile = newRstNode(rnInner) - h = newRstNode(rnOverline) - h.level = 1 - addSon(h, newRstNode(rnLeaf, "Index")) - addSon(d.indexFile, h) - h = newRstNode(rnIndex) - addSon(h, nil) # no argument - addSon(h, nil) # no options - d.theIndex = newRstNode(rnDefList) - addSon(h, d.theIndex) - addSon(d.indexFile, h) - -proc newDocumentor(filename: string): PDoc = - new(result) - result.tocPart = @[] - result.filename = filename - result.id = 100 - result.splitAfter = 20 - var s = getConfigVar("split.item.toc") - if s != "": result.splitAfter = parseInt(s) - -proc getVarIdx(varnames: openarray[string], id: string): int = - for i in countup(0, high(varnames)): - if cmpIgnoreStyle(varnames[i], id) == 0: - return i - result = -1 - -proc ropeFormatNamedVars(frmt: TFormatStr, varnames: openarray[string], - varvalues: openarray[PRope]): PRope = - var i = 0 - var L = len(frmt) - result = nil - var num = 0 - while i < L: - if frmt[i] == '$': - inc(i) # skip '$' - case frmt[i] - of '#': - app(result, varvalues[num]) - inc(num) - inc(i) - of '$': - app(result, "$") - inc(i) - of '0'..'9': - var j = 0 - while true: - j = (j * 10) + Ord(frmt[i]) - ord('0') - inc(i) - if (i > L + 0 - 1) or not (frmt[i] in {'0'..'9'}): break - if j > high(varvalues) + 1: internalError("ropeFormatNamedVars") - num = j - app(result, varvalues[j - 1]) - of 'A'..'Z', 'a'..'z', '\x80'..'\xFF': - var id = "" - while true: - add(id, frmt[i]) - inc(i) - if not (frmt[i] in {'A'..'Z', '_', 'a'..'z', '\x80'..'\xFF'}): break - var idx = getVarIdx(varnames, id) - if idx >= 0: app(result, varvalues[idx]) - else: rawMessage(errUnkownSubstitionVar, id) - of '{': - var id = "" - inc(i) - while frmt[i] != '}': - if frmt[i] == '\0': rawMessage(errTokenExpected, "}") - add(id, frmt[i]) - inc(i) - inc(i) # skip } - # search for the variable: - var idx = getVarIdx(varnames, id) - if idx >= 0: app(result, varvalues[idx]) - else: rawMessage(errUnkownSubstitionVar, id) - else: InternalError("ropeFormatNamedVars") - var start = i - while i < L: - if (frmt[i] != '$'): inc(i) - else: break - if i - 1 >= start: app(result, copy(frmt, start, i - 1)) - -proc addXmlChar(dest: var string, c: Char) = - case c - of '&': add(dest, "&") - of '<': add(dest, "<") - of '>': add(dest, ">") - of '\"': add(dest, """) - else: add(dest, c) - -proc addRtfChar(dest: var string, c: Char) = - case c - of '{': add(dest, "\\{") - of '}': add(dest, "\\}") - of '\\': add(dest, "\\\\") - else: add(dest, c) - -proc addTexChar(dest: var string, c: Char) = - case c - of '_': add(dest, "\\_") - of '{': add(dest, "\\symbol{123}") - of '}': add(dest, "\\symbol{125}") - of '[': add(dest, "\\symbol{91}") - of ']': add(dest, "\\symbol{93}") - of '\\': add(dest, "\\symbol{92}") - of '$': add(dest, "\\$") - of '&': add(dest, "\\&") - of '#': add(dest, "\\#") - of '%': add(dest, "\\%") - of '~': add(dest, "\\symbol{126}") - of '@': add(dest, "\\symbol{64}") - of '^': add(dest, "\\symbol{94}") - of '`': add(dest, "\\symbol{96}") - else: add(dest, c) - -proc escChar(dest: var string, c: Char) = - if gCmd != cmdRst2Tex: addXmlChar(dest, c) - else: addTexChar(dest, c) - -proc nextSplitPoint(s: string, start: int): int = - result = start - while result < len(s) + 0: - case s[result] - of '_': return - of 'a'..'z': - if result + 1 < len(s) + 0: - if s[result + 1] in {'A'..'Z'}: return - else: nil - inc(result) - dec(result) # last valid index - -proc esc(s: string, splitAfter: int = - 1): string = - result = "" - if splitAfter >= 0: - var partLen = 0 - var j = 0 - while j < len(s): - var k = nextSplitPoint(s, j) - if (splitter != " ") or (partLen + k - j + 1 > splitAfter): - partLen = 0 - add(result, splitter) - for i in countup(j, k): escChar(result, s[i]) - inc(partLen, k - j + 1) - j = k + 1 - else: - for i in countup(0, len(s) + 0 - 1): escChar(result, s[i]) - -proc disp(xml, tex: string): string = - if gCmd != cmdRst2Tex: result = xml - else: result = tex - -proc dispF(xml, tex: string, args: openarray[PRope]): PRope = - if gCmd != cmdRst2Tex: result = ropef(xml, args) - else: result = ropef(tex, args) - -proc dispA(dest: var PRope, xml, tex: string, args: openarray[PRope]) = - if gCmd != cmdRst2Tex: appf(dest, xml, args) - else: appf(dest, tex, args) - -proc renderRstToOut(d: PDoc, n: PRstNode): PRope - -proc renderAux(d: PDoc, n: PRstNode, outer: string = "$1"): PRope = - result = nil - for i in countup(0, rsonsLen(n) - 1): app(result, renderRstToOut(d, n.sons[i])) - result = ropef(outer, [result]) - -proc setIndexForSourceTerm(d: PDoc, name: PRstNode, id: int) = - if d.theIndex == nil: return - var h = newRstNode(rnHyperlink) - var a = newRstNode(rnLeaf, d.indexValFilename & disp("#", "") & $id) - addSon(h, a) - addSon(h, a) - a = newRstNode(rnIdx) - addSon(a, name) - setIndexPair(d.theIndex, a, h) - -proc renderIndexTerm(d: PDoc, n: PRstNode): PRope = - inc(d.id) - result = dispF("<span id=\"$1\">$2</span>", "$2\\label{$1}", - [toRope(d.id), renderAux(d, n)]) - var h = newRstNode(rnHyperlink) - var a = newRstNode(rnLeaf, d.indexValFilename & disp("#", "") & $d.id) - addSon(h, a) - addSon(h, a) - setIndexPair(d.theIndex, n, h) - -proc genComment(d: PDoc, n: PNode): PRope = - var dummyHasToc: bool - if (n.comment != nil) and startsWith(n.comment, "##"): - result = renderRstToOut(d, rstParse(n.comment, true, toFilename(n.info), - toLineNumber(n.info), toColumn(n.info), - dummyHasToc)) - -proc genRecComment(d: PDoc, n: PNode): PRope = - if n == nil: return nil - result = genComment(d, n) - if result == nil: - if not (n.kind in {nkEmpty..nkNilLit}): - for i in countup(0, sonsLen(n) - 1): - result = genRecComment(d, n.sons[i]) - if result != nil: return - else: - n.comment = nil - -proc isVisible(n: PNode): bool = - result = false - if n.kind == nkPostfix: - if (sonsLen(n) == 2) and (n.sons[0].kind == nkIdent): - var v = n.sons[0].ident - result = (v.id == ord(wStar)) or (v.id == ord(wMinus)) - elif n.kind == nkSym: - result = sfInInterface in n.sym.flags - elif n.kind == nkPragmaExpr: - result = isVisible(n.sons[0]) - -proc getName(n: PNode, splitAfter: int = - 1): string = - case n.kind - of nkPostfix: result = getName(n.sons[1], splitAfter) - of nkPragmaExpr: result = getName(n.sons[0], splitAfter) - of nkSym: result = esc(n.sym.name.s, splitAfter) - of nkIdent: result = esc(n.ident.s, splitAfter) - of nkAccQuoted: result = esc("`") & getName(n.sons[0], splitAfter) & esc("`") - else: - internalError(n.info, "getName()") - result = "" - -proc getRstName(n: PNode): PRstNode = - case n.kind - of nkPostfix: result = getRstName(n.sons[1]) - of nkPragmaExpr: result = getRstName(n.sons[0]) - of nkSym: result = newRstNode(rnLeaf, n.sym.name.s) - of nkIdent: result = newRstNode(rnLeaf, n.ident.s) - of nkAccQuoted: result = getRstName(n.sons[0]) - else: - internalError(n.info, "getRstName()") - result = nil - -proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind) = - if not isVisible(nameNode): return - var name = toRope(getName(nameNode)) - var result: PRope = nil - var literal = "" - var kind = tkEof - var comm = genRecComment(d, n) # call this here for the side-effect! - var r: TSrcGen - initTokRender(r, n, {renderNoPragmas, renderNoBody, renderNoComments, - renderDocComments}) - while true: - getNextTok(r, kind, literal) - case kind - of tkEof: - break - of tkComment: - dispA(result, "<span class=\"Comment\">$1</span>", "\\spanComment{$1}", - [toRope(esc(literal))]) - of tokKeywordLow..tokKeywordHigh: - dispA(result, "<span class=\"Keyword\">$1</span>", "\\spanKeyword{$1}", - [toRope(literal)]) - of tkOpr, tkHat: - dispA(result, "<span class=\"Operator\">$1</span>", "\\spanOperator{$1}", - [toRope(esc(literal))]) - of tkStrLit..tkTripleStrLit: - dispA(result, "<span class=\"StringLit\">$1</span>", - "\\spanStringLit{$1}", [toRope(esc(literal))]) - of tkCharLit: - dispA(result, "<span class=\"CharLit\">$1</span>", "\\spanCharLit{$1}", - [toRope(esc(literal))]) - of tkIntLit..tkInt64Lit: - dispA(result, "<span class=\"DecNumber\">$1</span>", - "\\spanDecNumber{$1}", [toRope(esc(literal))]) - of tkFloatLit..tkFloat64Lit: - dispA(result, "<span class=\"FloatNumber\">$1</span>", - "\\spanFloatNumber{$1}", [toRope(esc(literal))]) - of tkSymbol: - dispA(result, "<span class=\"Identifier\">$1</span>", - "\\spanIdentifier{$1}", [toRope(esc(literal))]) - of tkInd, tkSad, tkDed, tkSpaces: - app(result, literal) - of tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, - tkBracketDotLe, tkBracketDotRi, tkCurlyDotLe, tkCurlyDotRi, tkParDotLe, - tkParDotRi, tkComma, tkSemiColon, tkColon, tkEquals, tkDot, tkDotDot, - tkAccent: - dispA(result, "<span class=\"Other\">$1</span>", "\\spanOther{$1}", - [toRope(esc(literal))]) - else: InternalError(n.info, "docgen.genThing(" & toktypeToStr[kind] & ')') - inc(d.id) - app(d.section[k], ropeFormatNamedVars(getConfigVar("doc.item"), - ["name", "header", "desc", "itemID"], - [name, result, comm, toRope(d.id)])) - app(d.toc[k], ropeFormatNamedVars(getConfigVar("doc.item.toc"), - ["name", "header", "desc", "itemID"], [ - toRope(getName(nameNode, d.splitAfter)), result, comm, toRope(d.id)])) - setIndexForSourceTerm(d, getRstName(nameNode), d.id) - -proc renderHeadline(d: PDoc, n: PRstNode): PRope = - result = nil - for i in countup(0, rsonsLen(n) - 1): app(result, renderRstToOut(d, n.sons[i])) - var refname = toRope(rstnodeToRefname(n)) - if d.hasToc: - var length = len(d.tocPart) - setlen(d.tocPart, length + 1) - d.tocPart[length].refname = refname - d.tocPart[length].n = n - d.tocPart[length].header = result - result = dispF("<h$1><a class=\"toc-backref\" id=\"$2\" href=\"#$2_toc\">$3</a></h$1>", - "\\rsth$4{$3}\\label{$2}$n", [toRope(n.level), - d.tocPart[length].refname, result, - toRope(chr(n.level - 1 + ord('A')) & "")]) - else: - result = dispF("<h$1 id=\"$2\">$3</h$1>", "\\rsth$4{$3}\\label{$2}$n", [ - toRope(n.level), refname, result, - toRope(chr(n.level - 1 + ord('A')) & "")]) - -proc renderOverline(d: PDoc, n: PRstNode): PRope = - var t: PRope = nil - for i in countup(0, rsonsLen(n) - 1): app(t, renderRstToOut(d, n.sons[i])) - result = nil - if d.meta[metaTitle] == nil: - d.meta[metaTitle] = t - elif d.meta[metaSubtitle] == nil: - d.meta[metaSubtitle] = t - else: - result = dispF("<h$1 id=\"$2\"><center>$3</center></h$1>", - "\\rstov$4{$3}\\label{$2}$n", [toRope(n.level), - toRope(rstnodeToRefname(n)), t, toRope(chr(n.level - 1 + ord('A')) & "")]) - -proc renderRstToRst(d: PDoc, n: PRstNode): PRope -proc renderRstSons(d: PDoc, n: PRstNode): PRope = - for i in countup(0, rsonsLen(n) - 1): - app(result, renderRstToRst(d, n.sons[i])) - -proc renderRstToRst(d: PDoc, n: PRstNode): PRope = - # this is needed for the index generation; it may also be useful for - # debugging, but most code is already debugged... - const - lvlToChar: array[0..8, char] = ['!', '=', '-', '~', '`', '<', '*', '|', '+'] - result = nil - if n == nil: return - var ind = toRope(repeatChar(d.indent)) - case n.kind - of rnInner: - result = renderRstSons(d, n) - of rnHeadline: - result = renderRstSons(d, n) - var L = ropeLen(result) - result = ropef("$n$1$2$n$1$3", - [ind, result, toRope(repeatChar(L, lvlToChar[n.level]))]) - of rnOverline: - result = renderRstSons(d, n) - var L = ropeLen(result) - result = ropef("$n$1$3$n$1$2$n$1$3", - [ind, result, toRope(repeatChar(L, lvlToChar[n.level]))]) - of rnTransition: - result = ropef("$n$n$1$2$n$n", [ind, toRope(repeatChar(78 - d.indent, '-'))]) - of rnParagraph: - result = renderRstSons(d, n) - result = ropef("$n$n$1$2", [ind, result]) - of rnBulletItem: - inc(d.indent, 2) - result = renderRstSons(d, n) - if result != nil: result = ropef("$n$1* $2", [ind, result]) - dec(d.indent, 2) - of rnEnumItem: - inc(d.indent, 4) - result = renderRstSons(d, n) - if result != nil: result = ropef("$n$1(#) $2", [ind, result]) - dec(d.indent, 4) - of rnOptionList, rnFieldList, rnDefList, rnDefItem, rnLineBlock, rnFieldName, - rnFieldBody, rnStandaloneHyperlink, rnBulletList, rnEnumList: - result = renderRstSons(d, n) - of rnDefName: - result = renderRstSons(d, n) - result = ropef("$n$n$1$2", [ind, result]) - of rnDefBody: - inc(d.indent, 2) - result = renderRstSons(d, n) - if n.sons[0].kind != rnBulletList: result = ropef("$n$1 $2", [ind, result]) - dec(d.indent, 2) - of rnField: - result = renderRstToRst(d, n.sons[0]) - var L = max(ropeLen(result) + 3, 30) - inc(d.indent, L) - result = ropef("$n$1:$2:$3$4", [ind, result, toRope( - repeatChar(L - ropeLen(result) - 2)), renderRstToRst(d, n.sons[1])]) - dec(d.indent, L) - of rnLineBlockItem: - result = renderRstSons(d, n) - result = ropef("$n$1| $2", [ind, result]) - of rnBlockQuote: - inc(d.indent, 2) - result = renderRstSons(d, n) - dec(d.indent, 2) - of rnRef: - result = renderRstSons(d, n) - result = ropef("`$1`_", [result]) - of rnHyperlink: - result = ropef("`$1 <$2>`_", - [renderRstToRst(d, n.sons[0]), renderRstToRst(d, n.sons[1])]) - of rnGeneralRole: - result = renderRstToRst(d, n.sons[0]) - result = ropef("`$1`:$2:", [result, renderRstToRst(d, n.sons[1])]) - of rnSub: - result = renderRstSons(d, n) - result = ropef("`$1`:sub:", [result]) - of rnSup: - result = renderRstSons(d, n) - result = ropef("`$1`:sup:", [result]) - of rnIdx: - result = renderRstSons(d, n) - result = ropef("`$1`:idx:", [result]) - of rnEmphasis: - result = renderRstSons(d, n) - result = ropef("*$1*", [result]) - of rnStrongEmphasis: - result = renderRstSons(d, n) - result = ropef("**$1**", [result]) - of rnInterpretedText: - result = renderRstSons(d, n) - result = ropef("`$1`", [result]) - of rnInlineLiteral: - inc(d.verbatim) - result = renderRstSons(d, n) - result = ropef("``$1``", [result]) - dec(d.verbatim) - of rnLeaf: - if (d.verbatim == 0) and (n.text == "\\"): - result = toRope("\\\\") # XXX: escape more special characters! - else: - result = toRope(n.text) - of rnIndex: - inc(d.indent, 3) - if n.sons[2] != nil: result = renderRstSons(d, n.sons[2]) - dec(d.indent, 3) - result = ropef("$n$n$1.. index::$n$2", [ind, result]) - of rnContents: - result = ropef("$n$n$1.. contents::", [ind]) - else: rawMessage(errCannotRenderX, $n.kind) - -proc renderTocEntry(d: PDoc, e: TTocEntry): PRope = - result = dispF( - "<li><a class=\"reference\" id=\"$1_toc\" href=\"#$1\">$2</a></li>$n", - "\\item\\label{$1_toc} $2\\ref{$1}$n", [e.refname, e.header]) - -proc renderTocEntries(d: PDoc, j: var int, lvl: int): PRope = - result = nil - while j <= high(d.tocPart): - var a = abs(d.tocPart[j].n.level) - if (a == lvl): - app(result, renderTocEntry(d, d.tocPart[j])) - inc(j) - elif (a > lvl): - app(result, renderTocEntries(d, j, a)) - else: - break - if lvl > 1: - result = dispF("<ul class=\"simple\">$1</ul>", - "\\begin{enumerate}$1\\end{enumerate}", [result]) - -proc fieldAux(s: string): PRope = - result = toRope(strip(s)) - -proc renderImage(d: PDoc, n: PRstNode): PRope = - var options: PRope = nil - var s = getFieldValue(n, "scale") - if s != "": dispA(options, " scale=\"$1\"", " scale=$1", [fieldAux(s)]) - s = getFieldValue(n, "height") - if s != "": dispA(options, " height=\"$1\"", " height=$1", [fieldAux(s)]) - s = getFieldValue(n, "width") - if s != "": dispA(options, " width=\"$1\"", " width=$1", [fieldAux(s)]) - s = getFieldValue(n, "alt") - if s != "": dispA(options, " alt=\"$1\"", "", [fieldAux(s)]) - s = getFieldValue(n, "align") - if s != "": dispA(options, " align=\"$1\"", "", [fieldAux(s)]) - if options != nil: options = dispF("$1", "[$1]", [options]) - result = dispF("<img src=\"$1\"$2 />", "\\includegraphics$2{$1}", - [toRope(getArgument(n)), options]) - if rsonsLen(n) >= 3: app(result, renderRstToOut(d, n.sons[2])) - -proc renderCodeBlock(d: PDoc, n: PRstNode): PRope = - result = nil - if n.sons[2] == nil: return - var m = n.sons[2].sons[0] - if (m.kind != rnLeaf): InternalError("renderCodeBlock") - var langstr = strip(getArgument(n)) - var lang: TSourceLanguage - if langstr == "": - lang = langNimrod # default language - else: - lang = getSourceLanguage(langstr) - if lang == langNone: - rawMessage(warnLanguageXNotSupported, langstr) - result = toRope(m.text) - else: - var g: TGeneralTokenizer - initGeneralTokenizer(g, m.text) - while true: - getNextToken(g, lang) - case g.kind - of gtEof: break - of gtNone, gtWhitespace: - app(result, copy(m.text, g.start + 0, g.length + g.start - 1 + 0)) - else: - dispA(result, "<span class=\"$2\">$1</span>", "\\span$2{$1}", [ - toRope(esc(copy(m.text, g.start + 0, g.length + g.start - 1 + 0))), - toRope(tokenClassToStr[g.kind])]) - deinitGeneralTokenizer(g) - if result != nil: - result = dispF("<pre>$1</pre>", "\\begin{rstpre}$n$1$n\\end{rstpre}$n", - [result]) - -proc renderContainer(d: PDoc, n: PRstNode): PRope = - result = renderRstToOut(d, n.sons[2]) - var arg = toRope(strip(getArgument(n))) - if arg == nil: result = dispF("<div>$1</div>", "$1", [result]) - else: result = dispF("<div class=\"$1\">$2</div>", "$2", [arg, result]) - -proc texColumns(n: PRstNode): string = - result = "" - for i in countup(1, rsonsLen(n)): add(result, "|X") - -proc renderField(d: PDoc, n: PRstNode): PRope = - var b = false - if gCmd == cmdRst2Tex: - var fieldname = addNodes(n.sons[0]) - var fieldval = toRope(esc(strip(addNodes(n.sons[1])))) - if cmpIgnoreStyle(fieldname, "author") == 0: - if d.meta[metaAuthor] == nil: - d.meta[metaAuthor] = fieldval - b = true - elif cmpIgnoreStyle(fieldName, "version") == 0: - if d.meta[metaVersion] == nil: - d.meta[metaVersion] = fieldval - b = true - if b: result = nil - else: result = renderAux(d, n, disp("<tr>$1</tr>$n", "$1")) - -proc renderRstToOut(d: PDoc, n: PRstNode): PRope = - if n == nil: - return nil - case n.kind - of rnInner: result = renderAux(d, n) - of rnHeadline: result = renderHeadline(d, n) - of rnOverline: result = renderOverline(d, n) - of rnTransition: result = renderAux(d, n, disp("<hr />\n", "\\hrule\n")) - of rnParagraph: result = renderAux(d, n, disp("<p>$1</p>\n", "$1$n$n")) - of rnBulletList: - result = renderAux(d, n, disp("<ul class=\"simple\">$1</ul>\n", - "\\begin{itemize}$1\\end{itemize}\n")) - of rnBulletItem, rnEnumItem: - result = renderAux(d, n, disp("<li>$1</li>\n", "\\item $1\n")) - of rnEnumList: - result = renderAux(d, n, disp("<ol class=\"simple\">$1</ol>\n", - "\\begin{enumerate}$1\\end{enumerate}\n")) - of rnDefList: - result = renderAux(d, n, disp("<dl class=\"docutils\">$1</dl>\n", - "\\begin{description}$1\\end{description}\n")) - of rnDefItem: result = renderAux(d, n) - of rnDefName: result = renderAux(d, n, disp("<dt>$1</dt>\n", "\\item[$1] ")) - of rnDefBody: result = renderAux(d, n, disp("<dd>$1</dd>\n", "$1\n")) - of rnFieldList: - result = nil - for i in countup(0, rsonsLen(n) - 1): - app(result, renderRstToOut(d, n.sons[i])) - if result != nil: - result = dispf( - "<table class=\"docinfo\" frame=\"void\" rules=\"none\">" & - "<col class=\"docinfo-name\" />" & - "<col class=\"docinfo-content\" />" & - "<tbody valign=\"top\">$1" & - "</tbody></table>", - "\\begin{description}$1\\end{description}\n", - [result]) - of rnField: result = renderField(d, n) - of rnFieldName: - result = renderAux(d, n, disp("<th class=\"docinfo-name\">$1:</th>", - "\\item[$1:]")) - of rnFieldBody: - result = renderAux(d, n, disp("<td>$1</td>", " $1$n")) - of rnIndex: - result = renderRstToOut(d, n.sons[2]) - of rnOptionList: - result = renderAux(d, n, disp("<table frame=\"void\">$1</table>", - "\\begin{description}$n$1\\end{description}\n")) - of rnOptionListItem: - result = renderAux(d, n, disp("<tr>$1</tr>$n", "$1")) - of rnOptionGroup: - result = renderAux(d, n, disp("<th align=\"left\">$1</th>", "\\item[$1]")) - of rnDescription: - result = renderAux(d, n, disp("<td align=\"left\">$1</td>$n", " $1$n")) - of rnOption, rnOptionString, rnOptionArgument: - InternalError("renderRstToOut") - of rnLiteralBlock: - result = renderAux(d, n, disp("<pre>$1</pre>$n", - "\\begin{rstpre}$n$1$n\\end{rstpre}$n")) - of rnQuotedLiteralBlock: - InternalError("renderRstToOut") - of rnLineBlock: - result = renderAux(d, n, disp("<p>$1</p>", "$1$n$n")) - of rnLineBlockItem: - result = renderAux(d, n, disp("$1<br />", "$1\\\\$n")) - of rnBlockQuote: - result = renderAux(d, n, disp("<blockquote><p>$1</p></blockquote>$n", - "\\begin{quote}$1\\end{quote}$n")) - of rnTable, rnGridTable: - result = renderAux(d, n, disp( - "<table border=\"1\" class=\"docutils\">$1</table>", - "\\begin{table}\\begin{rsttab}{" & - texColumns(n) & "|}$n\\hline$n$1\\end{rsttab}\\end{table}")) - of rnTableRow: - if rsonsLen(n) >= 1: - result = renderRstToOut(d, n.sons[0]) - for i in countup(1, rsonsLen(n) - 1): - dispa(result, "$1", " & $1", [renderRstToOut(d, n.sons[i])]) - result = dispf("<tr>$1</tr>$n", "$1\\\\$n\\hline$n", [result]) - else: - result = nil - of rnTableDataCell: result = renderAux(d, n, disp("<td>$1</td>", "$1")) - of rnTableHeaderCell: - result = renderAux(d, n, disp("<th>$1</th>", "\\textbf{$1}")) - of rnLabel: - InternalError("renderRstToOut") # used for footnotes and other - of rnFootnote: - InternalError("renderRstToOut") # a footnote - of rnCitation: - InternalError("renderRstToOut") # similar to footnote - of rnRef: - result = dispF("<a class=\"reference external\" href=\"#$2\">$1</a>", - "$1\\ref{$2}", [renderAux(d, n), toRope(rstnodeToRefname(n))]) - of rnStandaloneHyperlink: - result = renderAux(d, n, disp( - "<a class=\"reference external\" href=\"$1\">$1</a>", - "\\href{$1}{$1}")) - of rnHyperlink: - result = dispF("<a class=\"reference external\" href=\"$2\">$1</a>", - "\\href{$2}{$1}", - [renderRstToOut(d, n.sons[0]), renderRstToOut(d, n.sons[1])]) - of rnDirArg, rnRaw: result = renderAux(d, n) - of rnRawHtml: - if gCmd != cmdRst2Tex: - result = toRope(addNodes(lastSon(n))) - of rnRawLatex: - if gCmd == cmdRst2Tex: - result = toRope(addNodes(lastSon(n))) - - of rnImage, rnFigure: result = renderImage(d, n) - of rnCodeBlock: result = renderCodeBlock(d, n) - of rnContainer: result = renderContainer(d, n) - of rnSubstitutionReferences, rnSubstitutionDef: - result = renderAux(d, n, disp("|$1|", "|$1|")) - of rnDirective: - result = renderAux(d, n, "") # Inline markup: - of rnGeneralRole: - result = dispF("<span class=\"$2\">$1</span>", "\\span$2{$1}", - [renderRstToOut(d, n.sons[0]), renderRstToOut(d, n.sons[1])]) - of rnSub: result = renderAux(d, n, disp("<sub>$1</sub>", "\\rstsub{$1}")) - of rnSup: result = renderAux(d, n, disp("<sup>$1</sup>", "\\rstsup{$1}")) - of rnEmphasis: result = renderAux(d, n, disp("<em>$1</em>", "\\emph{$1}")) - of rnStrongEmphasis: - result = renderAux(d, n, disp("<strong>$1</strong>", "\\textbf{$1}")) - of rnInterpretedText: - result = renderAux(d, n, disp("<cite>$1</cite>", "\\emph{$1}")) - of rnIdx: - if d.theIndex == nil: - result = renderAux(d, n, disp("<span>$1</span>", "\\emph{$1}")) - else: - result = renderIndexTerm(d, n) - of rnInlineLiteral: - result = renderAux(d, n, disp( - "<tt class=\"docutils literal\"><span class=\"pre\">$1</span></tt>", - "\\texttt{$1}")) - of rnLeaf: result = toRope(esc(n.text)) - of rnContents: d.hasToc = true - of rnTitle: d.meta[metaTitle] = renderRstToOut(d, n.sons[0]) - else: InternalError("renderRstToOut") - -proc checkForFalse(n: PNode): bool = - result = n.kind == nkIdent and IdentEq(n.ident, "false") - -proc getModuleFile(n: PNode): string = - case n.kind - of nkStrLit, nkRStrLit, nkTripleStrLit: result = n.strVal - of nkIdent: result = n.ident.s - of nkSym: result = n.sym.name.s - else: - internalError(n.info, "getModuleFile()") - result = "" - -proc traceDeps(d: PDoc, n: PNode) = - const k = skModule - if d.section[k] != nil: app(d.section[k], ", ") - dispA(d.section[k], - "<a class=\"reference external\" href=\"$1.html\">$1</a>", - "$1", [toRope(getModuleFile(n))]) - -proc generateDoc(d: PDoc, n: PNode) = - case n.kind - of nkCommentStmt: app(d.modDesc, genComment(d, n)) - of nkProcDef: genItem(d, n, n.sons[namePos], skProc) - of nkMethodDef: genItem(d, n, n.sons[namePos], skMethod) - of nkIteratorDef: genItem(d, n, n.sons[namePos], skIterator) - of nkMacroDef: genItem(d, n, n.sons[namePos], skMacro) - of nkTemplateDef: genItem(d, n, n.sons[namePos], skTemplate) - of nkConverterDef: genItem(d, n, n.sons[namePos], skConverter) - of nkVarSection: - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkCommentStmt: - genItem(d, n.sons[i], n.sons[i].sons[0], skVar) - of nkConstSection: - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkCommentStmt: - genItem(d, n.sons[i], n.sons[i].sons[0], skConst) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkCommentStmt: - genItem(d, n.sons[i], n.sons[i].sons[0], skType) - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): generateDoc(d, n.sons[i]) - of nkWhenStmt: - # generate documentation for the first branch only: - if not checkForFalse(n.sons[0].sons[0]): - generateDoc(d, lastSon(n.sons[0])) - of nkImportStmt: - for i in 0 .. sonsLen(n)-1: traceDeps(d, n.sons[i]) - of nkFromStmt: traceDeps(d, n.sons[0]) - else: nil - -proc genSection(d: PDoc, kind: TSymKind) = - const sectionNames: array[skModule..skTemplate, string] = [ - "Imports", "Types", "Consts", "Vars", "Procs", "Methods", - "Iterators", "Converters", "Macros", "Templates" - ] - if d.section[kind] == nil: return - var title = toRope(sectionNames[kind]) - d.section[kind] = ropeFormatNamedVars(getConfigVar("doc.section"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - toRope(ord(kind)), title, toRope(ord(kind) + 50), d.section[kind]]) - d.toc[kind] = ropeFormatNamedVars(getConfigVar("doc.section.toc"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - toRope(ord(kind)), title, toRope(ord(kind) + 50), d.toc[kind]]) - -proc genOutFile(d: PDoc): PRope = - var - code, toc, title, content: PRope - bodyname: string - j: int - j = 0 - toc = renderTocEntries(d, j, 1) - code = nil - content = nil - title = nil - for i in countup(low(TSymKind), high(TSymKind)): - genSection(d, i) - app(toc, d.toc[i]) - if toc != nil: - toc = ropeFormatNamedVars(getConfigVar("doc.toc"), ["content"], [toc]) - for i in countup(low(TSymKind), high(TSymKind)): app(code, d.section[i]) - if d.meta[metaTitle] != nil: title = d.meta[metaTitle] - else: title = toRope("Module " & - extractFilename(changeFileExt(d.filename, ""))) - if d.hasToc: bodyname = "doc.body_toc" - else: bodyname = "doc.body_no_toc" - content = ropeFormatNamedVars(getConfigVar(bodyname), ["title", - "tableofcontents", "moduledesc", "date", "time", "content"], - [title, toc, d.modDesc, toRope(getDateStr()), - toRope(getClockStr()), code]) - if optCompileOnly notin gGlobalOptions: - code = ropeFormatNamedVars(getConfigVar("doc.file"), ["title", - "tableofcontents", "moduledesc", "date", "time", - "content", "author", "version"], - [title, toc, d.modDesc, toRope(getDateStr()), - toRope(getClockStr()), content, d.meta[metaAuthor], - d.meta[metaVersion]]) - else: - code = content - result = code - -proc generateIndex(d: PDoc) = - if d.theIndex != nil: - sortIndex(d.theIndex) - writeRope(renderRstToRst(d, d.indexFile), gIndexFile) - -proc writeOutput(d: PDoc, filename, outExt: string) = - var content = genOutFile(d) - if optStdout in gGlobalOptions: - writeRope(stdout, content) - else: - writeRope(content, getOutFile(filename, outExt)) - -proc CommandDoc(filename: string) = - var ast = parseFile(addFileExt(filename, nimExt)) - if ast == nil: return - var d = newDocumentor(filename) - initIndexFile(d) - d.hasToc = true - generateDoc(d, ast) - writeOutput(d, filename, HtmlExt) - generateIndex(d) - -proc CommandRstAux(filename, outExt: string) = - var filen = addFileExt(filename, "txt") - var d = newDocumentor(filen) - initIndexFile(d) - var rst = rstParse(readFile(filen), false, filen, 0, 1, d.hasToc) - d.modDesc = renderRstToOut(d, rst) - writeOutput(d, filename, outExt) - generateIndex(d) - -proc CommandRst2Html(filename: string) = - CommandRstAux(filename, HtmlExt) - -proc CommandRst2TeX(filename: string) = - splitter = "\\-" - CommandRstAux(filename, TexExt) diff --git a/rod/ecmasgen.nim b/rod/ecmasgen.nim deleted file mode 100755 index 6898b01d1..000000000 --- a/rod/ecmasgen.nim +++ /dev/null @@ -1,1454 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This is the EMCAScript (also known as JavaScript) code generator. -# **Invariant: each expression only occurs once in the generated -# code!** - -import - ast, astalgo, strutils, nhashes, trees, platform, magicsys, extccomp, - options, nversion, nimsets, msgs, crc, bitsets, idents, lists, types, os, - times, ropes, math, passes, ccgutils, wordrecg, rnimsyn, rodread, rodutils - -proc ecmasgenPass*(): TPass -# implementation - -type - TEcmasGen = object of TPassContext - filename*: string - module*: PSym - - BModule = ref TEcmasGen - TEcmasTypeKind = enum - etyNone, # no type - etyNull, # null type - etyProc, # proc type - etyBool, # bool type - etyInt, # Ecmascript's int - etyFloat, # Ecmascript's float - etyString, # Ecmascript's string - etyObject, # Ecmascript's reference to an object - etyBaseIndex # base + index needed - TCompRes{.final.} = object - kind*: TEcmasTypeKind - com*: PRope # computation part - # address if this is a (address, index)-tuple - res*: PRope # result part; index if this is an - # (address, index)-tuple - - TBlock{.final.} = object - id*: int # the ID of the label; positive means that it - # has been used (i.e. the label should be emitted) - nestedTryStmts*: int # how many try statements is it nested into - - TGlobals{.final.} = object - typeInfo*, code*: PRope - typeInfoGenerated*: TIntSet - - PGlobals = ref TGlobals - TProc{.final.} = object - procDef*: PNode - prc*: PSym - data*: PRope - options*: TOptions - module*: BModule - globals*: PGlobals - BeforeRetNeeded*: bool - nestedTryStmts*: int - unique*: int - blocks*: seq[TBlock] - - -proc newGlobals(): PGlobals = - new(result) - IntSetInit(result.typeInfoGenerated) - -proc initCompRes(r: var TCompRes) = - r.com = nil - r.res = nil - r.kind = etyNone - -proc initProc(p: var TProc, globals: PGlobals, module: BModule, procDef: PNode, - options: TOptions) = - p.blocks = @[] - p.options = options - p.module = module - p.procDef = procDef - p.globals = globals - if procDef != nil: p.prc = procDef.sons[namePos].sym - -const - MappedToObject = {tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray, - tySet, tyVar, tyRef, tyPtr} - -proc mapType(typ: PType): TEcmasTypeKind = - var t = skipTypes(typ, abstractInst) - case t.kind - of tyVar, tyRef, tyPtr: - if skipTypes(t.sons[0], abstractInst).kind in mappedToObject: - result = etyObject - else: - result = etyBaseIndex - of tyPointer: - # treat a tyPointer like a typed pointer to an array of bytes - result = etyInt - of tyRange, tyDistinct, tyOrdinal: result = mapType(t.sons[0]) - of tyInt..tyInt64, tyEnum, tyChar: result = etyInt - of tyBool: result = etyBool - of tyFloat..tyFloat128: result = etyFloat - of tySet: result = etyObject # map a set to a table - of tyString, tySequence: result = etyInt # little hack to get right semantics - of tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray: - result = etyObject - of tyNil: result = etyNull - of tyGenericInst, tyGenericParam, tyGenericBody, tyGenericInvokation, tyNone, - tyForward, tyEmpty, tyExpr, tyStmt, tyTypeDesc: - result = etyNone - of tyProc: result = etyProc - of tyCString: result = etyString - -proc mangle(name: string): string = - result = "" - for i in countup(0, len(name) - 1): - case name[i] - of 'A'..'Z': - add(result, chr(ord(name[i]) - ord('A') + ord('a'))) - of '_': - nil - of 'a'..'z', '0'..'9': - add(result, name[i]) - else: add(result, 'X' & toHex(ord(name[i]), 2)) - -proc mangleName(s: PSym): PRope = - result = s.loc.r - if result == nil: - result = toRope(mangle(s.name.s)) - app(result, "_") - app(result, toRope(s.id)) - s.loc.r = result - -proc genTypeInfo(p: var TProc, typ: PType): PRope -proc genObjectFields(p: var TProc, typ: PType, n: PNode): PRope = - var - s, u: PRope - length: int - field: PSym - b: PNode - result = nil - case n.kind - of nkRecList: - length = sonsLen(n) - if length == 1: - result = genObjectFields(p, typ, n.sons[0]) - else: - s = nil - for i in countup(0, length - 1): - if i > 0: app(s, ", " & tnl) - app(s, genObjectFields(p, typ, n.sons[i])) - result = ropef("{kind: 2, len: $1, offset: 0, " & - "typ: null, name: null, sons: [$2]}", [toRope(length), s]) - of nkSym: - field = n.sym - s = genTypeInfo(p, field.typ) - result = ropef("{kind: 1, offset: \"$1\", len: 0, " & - "typ: $2, name: $3, sons: null}", - [mangleName(field), s, makeCString(field.name.s)]) - of nkRecCase: - length = sonsLen(n) - if (n.sons[0].kind != nkSym): InternalError(n.info, "genObjectFields") - field = n.sons[0].sym - s = genTypeInfo(p, field.typ) - for i in countup(1, length - 1): - b = n.sons[i] # branch - u = nil - case b.kind - of nkOfBranch: - if sonsLen(b) < 2: - internalError(b.info, "genObjectFields; nkOfBranch broken") - for j in countup(0, sonsLen(b) - 2): - if u != nil: app(u, ", ") - if b.sons[j].kind == nkRange: - appf(u, "[$1, $2]", [toRope(getOrdValue(b.sons[j].sons[0])), - toRope(getOrdValue(b.sons[j].sons[1]))]) - else: - app(u, toRope(getOrdValue(b.sons[j]))) - of nkElse: - u = toRope(lengthOrd(field.typ)) - else: internalError(n.info, "genObjectFields(nkRecCase)") - if result != nil: app(result, ", " & tnl) - appf(result, "[SetConstr($1), $2]", - [u, genObjectFields(p, typ, lastSon(b))]) - result = ropef("{kind: 3, offset: \"$1\", len: $3, " & - "typ: $2, name: $4, sons: [$5]}", [mangleName(field), s, - toRope(lengthOrd(field.typ)), makeCString(field.name.s), result]) - else: internalError(n.info, "genObjectFields") - -proc genObjectInfo(p: var TProc, typ: PType, name: PRope) = - var s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) - prepend(p.globals.typeInfo, s) - appf(p.globals.typeInfo, "var NNI$1 = $2;$n", - [toRope(typ.id), genObjectFields(p, typ, typ.n)]) - appf(p.globals.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) - if (typ.kind == tyObject) and (typ.sons[0] != nil): - appf(p.globals.typeInfo, "$1.base = $2;$n", - [name, genTypeInfo(p, typ.sons[0])]) - -proc genEnumInfo(p: var TProc, typ: PType, name: PRope) = - var - s, n: PRope - length: int - field: PSym - length = sonsLen(typ.n) - s = nil - for i in countup(0, length - 1): - if (typ.n.sons[i].kind != nkSym): InternalError(typ.n.info, "genEnumInfo") - field = typ.n.sons[i].sym - if i > 0: app(s, ", " & tnl) - appf(s, "{kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}", - [toRope(field.position), name, makeCString(field.name.s)]) - n = ropef("var NNI$1 = {kind: 2, offset: 0, typ: null, " & - "name: null, len: $2, sons: [$3]};$n", [toRope(typ.id), toRope(length), s]) - s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) - prepend(p.globals.typeInfo, s) - app(p.globals.typeInfo, n) - appf(p.globals.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) - if typ.sons[0] != nil: - appf(p.globals.typeInfo, "$1.base = $2;$n", - [name, genTypeInfo(p, typ.sons[0])]) - -proc genTypeInfo(p: var TProc, typ: PType): PRope = - var t = typ - if t.kind == tyGenericInst: t = lastSon(t) - result = ropef("NTI$1", [toRope(t.id)]) - if IntSetContainsOrIncl(p.globals.TypeInfoGenerated, t.id): return - case t.kind - of tyDistinct: - result = genTypeInfo(p, typ.sons[0]) - of tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, tyInt..tyFloat128: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) - prepend(p.globals.typeInfo, s) - of tyVar, tyRef, tyPtr, tySequence, tyRange, tySet: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) - prepend(p.globals.typeInfo, s) - appf(p.globals.typeInfo, "$1.base = $2;$n", - [result, genTypeInfo(p, typ.sons[0])]) - of tyArrayConstr, tyArray: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) - prepend(p.globals.typeInfo, s) - appf(p.globals.typeInfo, "$1.base = $2;$n", - [result, genTypeInfo(p, typ.sons[1])]) - of tyEnum: genEnumInfo(p, t, result) - of tyObject, tyTuple: genObjectInfo(p, t, result) - else: InternalError("genTypeInfo(" & $t.kind & ')') - -proc gen(p: var TProc, n: PNode, r: var TCompRes) -proc genStmt(p: var TProc, n: PNode, r: var TCompRes) -proc useMagic(p: var TProc, ident: string) = - nil - # to implement - -proc mergeExpr(a, b: PRope): PRope = - if (a != nil): - if b != nil: result = ropef("($1, $2)", [a, b]) - else: result = a - else: - result = b - -proc mergeExpr(r: TCompRes): PRope = - result = mergeExpr(r.com, r.res) - -proc mergeStmt(r: TCompRes): PRope = - if r.res == nil: result = r.com - elif r.com == nil: result = r.res - else: result = ropef("$1$2", [r.com, r.res]) - -proc genAnd(p: var TProc, a, b: PNode, r: var TCompRes) = - var x, y: TCompRes - gen(p, a, x) - gen(p, b, y) - r.res = ropef("($1 && $2)", [mergeExpr(x), mergeExpr(y)]) - -proc genOr(p: var TProc, a, b: PNode, r: var TCompRes) = - var x, y: TCompRes - gen(p, a, x) - gen(p, b, y) - r.res = ropef("($1 || $2)", [mergeExpr(x), mergeExpr(y)]) - -type - TMagicFrmt = array[0..3, string] - -const # magic checked op; magic unchecked op; checked op; unchecked op - ops: array[mAddi..mStrToStr, TMagicFrmt] = [ - ["addInt", "", "addInt($1, $2)", "($1 + $2)"], # AddI - ["subInt", "", "subInt($1, $2)", "($1 - $2)"], # SubI - ["mulInt", "", "mulInt($1, $2)", "($1 * $2)"], # MulI - ["divInt", "", "divInt($1, $2)", "Math.floor($1 / $2)"], # DivI - ["modInt", "", "modInt($1, $2)", "Math.floor($1 % $2)"], # ModI - ["addInt64", "", "addInt64($1, $2)", "($1 + $2)"], # AddI64 - ["subInt64", "", "subInt64($1, $2)", "($1 - $2)"], # SubI64 - ["mulInt64", "", "mulInt64($1, $2)", "($1 * $2)"], # MulI64 - ["divInt64", "", "divInt64($1, $2)", "Math.floor($1 / $2)"], # DivI64 - ["modInt64", "", "modInt64($1, $2)", "Math.floor($1 % $2)"], # ModI64 - ["", "", "($1 + $2)", "($1 + $2)"], # AddF64 - ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 - ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 - ["", "", "($1 / $2)", "($1 / $2)"], # DivF64 - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # ShrI - ["", "", "($1 << $2)", "($1 << $2)"], # ShlI - ["", "", "($1 & $2)", "($1 & $2)"], # BitandI - ["", "", "($1 | $2)", "($1 | $2)"], # BitorI - ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # ShrI64 - ["", "", "($1 << $2)", "($1 << $2)"], # ShlI64 - ["", "", "($1 & $2)", "($1 & $2)"], # BitandI64 - ["", "", "($1 | $2)", "($1 | $2)"], # BitorI64 - ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 - ["AddU", "AddU", "AddU($1, $2)", "AddU($1, $2)"], # AddU - ["SubU", "SubU", "SubU($1, $2)", "SubU($1, $2)"], # SubU - ["MulU", "MulU", "MulU($1, $2)", "MulU($1, $2)"], # MulU - ["DivU", "DivU", "DivU($1, $2)", "DivU($1, $2)"], # DivU - ["ModU", "ModU", "ModU($1, $2)", "ModU($1, $2)"], # ModU - ["AddU64", "AddU64", "AddU64($1, $2)", "AddU64($1, $2)"], # AddU64 - ["SubU64", "SubU64", "SubU64($1, $2)", "SubU64($1, $2)"], # SubU64 - ["MulU64", "MulU64", "MulU64($1, $2)", "MulU64($1, $2)"], # MulU64 - ["DivU64", "DivU64", "DivU64($1, $2)", "DivU64($1, $2)"], # DivU64 - ["ModU64", "ModU64", "ModU64($1, $2)", "ModU64($1, $2)"], # ModU64 - ["", "", "($1 == $2)", "($1 == $2)"], # EqI - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI - ["", "", "($1 < $2)", "($1 < $2)"], # LtI - ["", "", "($1 == $2)", "($1 == $2)"], # EqI64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtI64 - ["", "", "($1 == $2)", "($1 == $2)"], # EqF64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeF64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtF64 - ["LeU", "LeU", "LeU($1, $2)", "LeU($1, $2)"], # LeU - ["LtU", "LtU", "LtU($1, $2)", "LtU($1, $2)"], # LtU - ["LeU64", "LeU64", "LeU64($1, $2)", "LeU64($1, $2)"], # LeU64 - ["LtU64", "LtU64", "LtU64($1, $2)", "LtU64($1, $2)"], # LtU64 - ["", "", "($1 == $2)", "($1 == $2)"], # EqEnum - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeEnum - ["", "", "($1 < $2)", "($1 < $2)"], # LtEnum - ["", "", "($1 == $2)", "($1 == $2)"], # EqCh - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeCh - ["", "", "($1 < $2)", "($1 < $2)"], # LtCh - ["", "", "($1 == $2)", "($1 == $2)"], # EqB - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeB - ["", "", "($1 < $2)", "($1 < $2)"], # LtB - ["", "", "($1 == $2)", "($1 == $2)"], # EqRef - ["", "", "($1 == $2)", "($1 == $2)"], # EqProc - ["", "", "($1 == $2)", "($1 == $2)"], # EqUntracedRef - ["", "", "($1 <= $2)", "($1 <= $2)"], # LePtr - ["", "", "($1 < $2)", "($1 < $2)"], # LtPtr - ["", "", "($1 == $2)", "($1 == $2)"], # EqCString - ["", "", "($1 != $2)", "($1 != $2)"], # Xor - ["NegInt", "", "NegInt($1)", "-($1)"], # UnaryMinusI - ["NegInt64", "", "NegInt64($1)", "-($1)"], # UnaryMinusI64 - ["AbsInt", "", "AbsInt($1)", "Math.abs($1)"], # AbsI - ["AbsInt64", "", "AbsInt64($1)", "Math.abs($1)"], # AbsI64 - ["", "", "!($1)", "!($1)"], # Not - ["", "", "+($1)", "+($1)"], # UnaryPlusI - ["", "", "~($1)", "~($1)"], # BitnotI - ["", "", "+($1)", "+($1)"], # UnaryPlusI64 - ["", "", "~($1)", "~($1)"], # BitnotI64 - ["", "", "+($1)", "+($1)"], # UnaryPlusF64 - ["", "", "-($1)", "-($1)"], # UnaryMinusF64 - ["", "", "Math.abs($1)", "Math.abs($1)"], # AbsF64 - ["Ze8ToI", "Ze8ToI", "Ze8ToI($1)", "Ze8ToI($1)"], # mZe8ToI - ["Ze8ToI64", "Ze8ToI64", "Ze8ToI64($1)", "Ze8ToI64($1)"], # mZe8ToI64 - ["Ze16ToI", "Ze16ToI", "Ze16ToI($1)", "Ze16ToI($1)"], # mZe16ToI - ["Ze16ToI64", "Ze16ToI64", "Ze16ToI64($1)", "Ze16ToI64($1)"], # mZe16ToI64 - ["Ze32ToI64", "Ze32ToI64", "Ze32ToI64($1)", "Ze32ToI64($1)"], # mZe32ToI64 - ["ZeIToI64", "ZeIToI64", "ZeIToI64($1)", "ZeIToI64($1)"], # mZeIToI64 - ["ToU8", "ToU8", "ToU8($1)", "ToU8($1)"], # ToU8 - ["ToU16", "ToU16", "ToU16($1)", "ToU16($1)"], # ToU16 - ["ToU32", "ToU32", "ToU32($1)", "ToU32($1)"], # ToU32 - ["", "", "$1", "$1"], # ToFloat - ["", "", "$1", "$1"], # ToBiggestFloat - ["", "", "Math.floor($1)", "Math.floor($1)"], # ToInt - ["", "", "Math.floor($1)", "Math.floor($1)"], # ToBiggestInt - ["nimCharToStr", "nimCharToStr", "nimCharToStr($1)", "nimCharToStr($1)"], - ["nimBoolToStr", "nimBoolToStr", "nimBoolToStr($1)", "nimBoolToStr($1)"], [ - "cstrToNimstr", "cstrToNimstr", "cstrToNimstr(($1)+\"\")", - "cstrToNimstr(($1)+\"\")"], ["cstrToNimstr", "cstrToNimstr", - "cstrToNimstr(($1)+\"\")", - "cstrToNimstr(($1)+\"\")"], ["cstrToNimstr", - "cstrToNimstr", "cstrToNimstr(($1)+\"\")", "cstrToNimstr(($1)+\"\")"], - ["cstrToNimstr", "cstrToNimstr", "cstrToNimstr($1)", "cstrToNimstr($1)"], - ["", "", "$1", "$1"]] - -proc binaryExpr(p: var TProc, n: PNode, r: var TCompRes, magic, frmt: string) = - var x, y: TCompRes - if magic != "": useMagic(p, magic) - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - r.res = ropef(frmt, [x.res, y.res]) - r.com = mergeExpr(x.com, y.com) - -proc binaryStmt(p: var TProc, n: PNode, r: var TCompRes, magic, frmt: string) = - var x, y: TCompRes - if magic != "": useMagic(p, magic) - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - if x.com != nil: appf(r.com, "$1;$n", [x.com]) - if y.com != nil: appf(r.com, "$1;$n", [y.com]) - appf(r.com, frmt, [x.res, y.res]) - -proc unaryExpr(p: var TProc, n: PNode, r: var TCompRes, magic, frmt: string) = - if magic != "": useMagic(p, magic) - gen(p, n.sons[1], r) - r.res = ropef(frmt, [r.res]) - -proc arith(p: var TProc, n: PNode, r: var TCompRes, op: TMagic) = - var - x, y: TCompRes - i: int - if optOverflowCheck in p.options: i = 0 - else: i = 1 - useMagic(p, ops[op][i]) - if sonsLen(n) > 2: - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - r.res = ropef(ops[op][i + 2], [x.res, y.res]) - r.com = mergeExpr(x.com, y.com) - else: - gen(p, n.sons[1], r) - r.res = ropef(ops[op][i + 2], [r.res]) - -proc genLineDir(p: var TProc, n: PNode, r: var TCompRes) = - var line: int - line = toLinenumber(n.info) - if optLineDir in p.Options: - appf(r.com, "// line $2 \"$1\"$n", - [toRope(toFilename(n.info)), toRope(line)]) - if ({optStackTrace, optEndb} * p.Options == {optStackTrace, optEndb}) and - ((p.prc == nil) or not (sfPure in p.prc.flags)): - useMagic(p, "endb") - appf(r.com, "endb($1);$n", [toRope(line)]) - elif ({optLineTrace, optStackTrace} * p.Options == - {optLineTrace, optStackTrace}) and - ((p.prc == nil) or not (sfPure in p.prc.flags)): - appf(r.com, "F.line = $1;$n", [toRope(line)]) - -proc finishTryStmt(p: var TProc, r: var TCompRes, howMany: int) = - for i in countup(1, howMany): - app(r.com, "excHandler = excHandler.prev;" & tnl) - -proc genWhileStmt(p: var TProc, n: PNode, r: var TCompRes) = - var - cond, stmt: TCompRes - length, labl: int - genLineDir(p, n, r) - inc(p.unique) - length = len(p.blocks) - setlen(p.blocks, length + 1) - p.blocks[length].id = - p.unique - p.blocks[length].nestedTryStmts = p.nestedTryStmts - labl = p.unique - gen(p, n.sons[0], cond) - genStmt(p, n.sons[1], stmt) - if p.blocks[length].id > 0: - appf(r.com, "L$3: while ($1) {$n$2}$n", - [mergeExpr(cond), mergeStmt(stmt), toRope(labl)]) - else: - appf(r.com, "while ($1) {$n$2}$n", [mergeExpr(cond), mergeStmt(stmt)]) - setlen(p.blocks, length) - -proc genTryStmt(p: var TProc, n: PNode, r: var TCompRes) = - # code to generate: - # - # var sp = {prev: excHandler, exc: null}; - # excHandler = sp; - # try { - # stmts; - # } catch (e) { - # if (e.typ && e.typ == NTI433 || e.typ == NTI2321) { - # stmts; - # } else if (e.typ && e.typ == NTI32342) { - # stmts; - # } else { - # stmts; - # } - # } finally { - # stmts; - # excHandler = excHandler.prev; - # } - # - var - i, length, blen: int - safePoint, orExpr, epart: PRope - a: TCompRes - genLineDir(p, n, r) - inc(p.unique) - safePoint = ropef("Tmp$1", [toRope(p.unique)]) - appf(r.com, - "var $1 = {prev: excHandler, exc: null};$n" & "excHandler = $1;$n", - [safePoint]) - if optStackTrace in p.Options: app(r.com, "framePtr = F;" & tnl) - app(r.com, "try {" & tnl) - length = sonsLen(n) - inc(p.nestedTryStmts) - genStmt(p, n.sons[0], a) - app(r.com, mergeStmt(a)) - i = 1 - epart = nil - while (i < length) and (n.sons[i].kind == nkExceptBranch): - blen = sonsLen(n.sons[i]) - if blen == 1: - # general except section: - if i > 1: app(epart, "else {" & tnl) - genStmt(p, n.sons[i].sons[0], a) - app(epart, mergeStmt(a)) - if i > 1: app(epart, '}' & tnl) - else: - orExpr = nil - for j in countup(0, blen - 2): - if (n.sons[i].sons[j].kind != nkType): - InternalError(n.info, "genTryStmt") - if orExpr != nil: app(orExpr, "||") - appf(orExpr, "($1.exc.m_type == $2)", - [safePoint, genTypeInfo(p, n.sons[i].sons[j].typ)]) - if i > 1: app(epart, "else ") - appf(epart, "if ($1.exc && $2) {$n", [safePoint, orExpr]) - genStmt(p, n.sons[i].sons[blen - 1], a) - appf(epart, "$1}$n", [mergeStmt(a)]) - inc(i) - if epart != nil: appf(r.com, "} catch (EXC) {$n$1", [epart]) - finishTryStmt(p, r, p.nestedTryStmts) - dec(p.nestedTryStmts) - app(r.com, "} finally {" & tnl & "excHandler = excHandler.prev;" & tnl) - if (i < length) and (n.sons[i].kind == nkFinally): - genStmt(p, n.sons[i].sons[0], a) - app(r.com, mergeStmt(a)) - app(r.com, '}' & tnl) - -proc genRaiseStmt(p: var TProc, n: PNode, r: var TCompRes) = - var - a: TCompRes - typ: PType - genLineDir(p, n, r) - if n.sons[0].kind != nkEmpty: - gen(p, n.sons[0], a) - if a.com != nil: appf(r.com, "$1;$n", [a.com]) - typ = skipTypes(n.sons[0].typ, abstractPtrs) - useMagic(p, "raiseException") - appf(r.com, "raiseException($1, $2);$n", - [a.res, makeCString(typ.sym.name.s)]) - else: - useMagic(p, "reraiseException") - app(r.com, "reraiseException();" & tnl) - -proc genCaseStmt(p: var TProc, n: PNode, r: var TCompRes) = - var - cond, stmt: TCompRes - it, e, v: PNode - stringSwitch: bool - genLineDir(p, n, r) - gen(p, n.sons[0], cond) - if cond.com != nil: appf(r.com, "$1;$n", [cond.com]) - stringSwitch = skipTypes(n.sons[0].typ, abstractVar).kind == tyString - if stringSwitch: - useMagic(p, "toEcmaStr") - appf(r.com, "switch (toEcmaStr($1)) {$n", [cond.res]) - else: - appf(r.com, "switch ($1) {$n", [cond.res]) - for i in countup(1, sonsLen(n) - 1): - it = n.sons[i] - case it.kind - of nkOfBranch: - for j in countup(0, sonsLen(it) - 2): - e = it.sons[j] - if e.kind == nkRange: - v = copyNode(e.sons[0]) - while (v.intVal <= e.sons[1].intVal): - gen(p, v, cond) - if cond.com != nil: internalError(v.info, "ecmasgen.genCaseStmt") - appf(r.com, "case $1: ", [cond.res]) - Inc(v.intVal) - else: - gen(p, e, cond) - if cond.com != nil: internalError(e.info, "ecmasgen.genCaseStmt") - if stringSwitch: - case e.kind - of nkStrLit..nkTripleStrLit: appf(r.com, "case $1: ", - [makeCString(e.strVal)]) - else: InternalError(e.info, "ecmasgen.genCaseStmt: 2") - else: - appf(r.com, "case $1: ", [cond.res]) - genStmt(p, lastSon(it), stmt) - appf(r.com, "$n$1break;$n", [mergeStmt(stmt)]) - of nkElse: - genStmt(p, it.sons[0], stmt) - appf(r.com, "default: $n$1break;$n", [mergeStmt(stmt)]) - else: internalError(it.info, "ecmasgen.genCaseStmt") - appf(r.com, "}$n", []) - -proc genStmtListExpr(p: var TProc, n: PNode, r: var TCompRes) -proc genBlock(p: var TProc, n: PNode, r: var TCompRes) = - var - idx, labl: int - sym: PSym - inc(p.unique) - idx = len(p.blocks) - if n.sons[0].kind != nkEmpty: - # named block? - if (n.sons[0].kind != nkSym): InternalError(n.info, "genBlock") - sym = n.sons[0].sym - sym.loc.k = locOther - sym.loc.a = idx - setlen(p.blocks, idx + 1) - p.blocks[idx].id = - p.unique # negative because it isn't used yet - p.blocks[idx].nestedTryStmts = p.nestedTryStmts - labl = p.unique - if n.kind == nkBlockExpr: genStmtListExpr(p, n.sons[1], r) - else: genStmt(p, n.sons[1], r) - if p.blocks[idx].id > 0: - # label has been used: - r.com = ropef("L$1: do {$n$2} while(false);$n", [toRope(labl), r.com]) - setlen(p.blocks, idx) - -proc genBreakStmt(p: var TProc, n: PNode, r: var TCompRes) = - var - idx: int - sym: PSym - genLineDir(p, n, r) - idx = len(p.blocks) - 1 - if n.sons[0].kind != nkEmpty: - # named break? - assert(n.sons[0].kind == nkSym) - sym = n.sons[0].sym - assert(sym.loc.k == locOther) - idx = sym.loc.a - p.blocks[idx].id = abs(p.blocks[idx].id) # label is used - finishTryStmt(p, r, p.nestedTryStmts - p.blocks[idx].nestedTryStmts) - appf(r.com, "break L$1;$n", [toRope(p.blocks[idx].id)]) - -proc genAsmStmt(p: var TProc, n: PNode, r: var TCompRes) = - genLineDir(p, n, r) - assert(n.kind == nkAsmStmt) - for i in countup(0, sonsLen(n) - 1): - case n.sons[i].Kind - of nkStrLit..nkTripleStrLit: app(r.com, n.sons[i].strVal) - of nkSym: app(r.com, mangleName(n.sons[i].sym)) - else: InternalError(n.sons[i].info, "ecmasgen: genAsmStmt()") - -proc genIfStmt(p: var TProc, n: PNode, r: var TCompRes) = - var - toClose: int - cond, stmt: TCompRes - it: PNode - toClose = 0 - for i in countup(0, sonsLen(n) - 1): - it = n.sons[i] - if sonsLen(it) != 1: - gen(p, it.sons[0], cond) - genStmt(p, it.sons[1], stmt) - if i > 0: - appf(r.com, "else {$n", []) - inc(toClose) - if cond.com != nil: appf(r.com, "$1;$n", [cond.com]) - appf(r.com, "if ($1) {$n$2}", [cond.res, mergeStmt(stmt)]) - else: - # else part: - genStmt(p, it.sons[0], stmt) - appf(r.com, "else {$n$1}$n", [mergeStmt(stmt)]) - app(r.com, repeatChar(toClose, '}') & tnl) - -proc genIfExpr(p: var TProc, n: PNode, r: var TCompRes) = - var - toClose: int - cond, stmt: TCompRes - it: PNode - toClose = 0 - for i in countup(0, sonsLen(n) - 1): - it = n.sons[i] - if sonsLen(it) != 1: - gen(p, it.sons[0], cond) - gen(p, it.sons[1], stmt) - if i > 0: - app(r.res, ": (") - inc(toClose) - r.com = mergeExpr(r.com, cond.com) - r.com = mergeExpr(r.com, stmt.com) - appf(r.res, "($1) ? ($2)", [cond.res, stmt.res]) - else: - # else part: - gen(p, it.sons[0], stmt) - r.com = mergeExpr(r.com, stmt.com) - appf(r.res, ": ($1)", [stmt.res]) - app(r.res, repeatChar(toClose, ')')) - -proc generateHeader(p: var TProc, typ: PType): PRope = - var - param: PSym - name: PRope - result = nil - for i in countup(1, sonsLen(typ.n) - 1): - if result != nil: app(result, ", ") - assert(typ.n.sons[i].kind == nkSym) - param = typ.n.sons[i].sym - name = mangleName(param) - app(result, name) - if mapType(param.typ) == etyBaseIndex: - app(result, ", ") - app(result, name) - app(result, "_Idx") - -const - nodeKindsNeedNoCopy = {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkCurly, nkPar, nkStringToCString, - nkCStringToString, nkCall, nkCommand, nkHiddenCallConv, nkCallStrLit} - -proc needsNoCopy(y: PNode): bool = - result = (y.kind in nodeKindsNeedNoCopy) or - (skipTypes(y.typ, abstractInst).kind in {tyRef, tyPtr, tyVar}) - -proc genAsgnAux(p: var TProc, x, y: PNode, r: var TCompRes, - noCopyNeeded: bool) = - var a, b: TCompRes - gen(p, x, a) - gen(p, y, b) - case mapType(x.typ) - of etyObject: - if a.com != nil: appf(r.com, "$1;$n", [a.com]) - if b.com != nil: appf(r.com, "$1;$n", [b.com]) - if needsNoCopy(y) or noCopyNeeded: - appf(r.com, "$1 = $2;$n", [a.res, b.res]) - else: - useMagic(p, "NimCopy") - appf(r.com, "$1 = NimCopy($2, $3);$n", - [a.res, b.res, genTypeInfo(p, y.typ)]) - of etyBaseIndex: - if (a.kind != etyBaseIndex) or (b.kind != etyBaseIndex): - internalError(x.info, "genAsgn") - appf(r.com, "$1 = $2; $3 = $4;$n", [a.com, b.com, a.res, b.res]) - else: - if a.com != nil: appf(r.com, "$1;$n", [a.com]) - if b.com != nil: appf(r.com, "$1;$n", [b.com]) - appf(r.com, "$1 = $2;$n", [a.res, b.res]) - -proc genAsgn(p: var TProc, n: PNode, r: var TCompRes) = - genLineDir(p, n, r) - genAsgnAux(p, n.sons[0], n.sons[1], r, false) - -proc genFastAsgn(p: var TProc, n: PNode, r: var TCompRes) = - genLineDir(p, n, r) - genAsgnAux(p, n.sons[0], n.sons[1], r, true) - -proc genSwap(p: var TProc, n: PNode, r: var TCompRes) = - var a, b: TCompRes - gen(p, n.sons[1], a) - gen(p, n.sons[2], b) - inc(p.unique) - var tmp = ropef("Tmp$1", [toRope(p.unique)]) - case mapType(n.sons[1].typ) - of etyBaseIndex: - inc(p.unique) - var tmp2 = ropef("Tmp$1", [toRope(p.unique)]) - if (a.kind != etyBaseIndex) or (b.kind != etyBaseIndex): - internalError(n.info, "genSwap") - appf(r.com, "var $1 = $2; $2 = $3; $3 = $1;$n", [tmp, a.com, b.com]) - appf(r.com, "var $1 = $2; $2 = $3; $3 = $1", [tmp2, a.res, b.res]) - else: - if a.com != nil: appf(r.com, "$1;$n", [a.com]) - if b.com != nil: appf(r.com, "$1;$n", [b.com]) - appf(r.com, "var $1 = $2; $2 = $3; $3 = $1", [tmp, a.res, b.res]) - -proc genFieldAddr(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - r.kind = etyBaseIndex - gen(p, n.sons[0], a) - if n.sons[1].kind != nkSym: InternalError(n.sons[1].info, "genFieldAddr") - var f = n.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(f) - r.res = makeCString(ropeToStr(f.loc.r)) - r.com = mergeExpr(a) - -proc genFieldAccess(p: var TProc, n: PNode, r: var TCompRes) = - r.kind = etyNone - gen(p, n.sons[0], r) - if n.sons[1].kind != nkSym: InternalError(n.sons[1].info, "genFieldAddr") - var f = n.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(f) - r.res = ropef("$1.$2", [r.res, f.loc.r]) - -proc genCheckedFieldAddr(p: var TProc, n: PNode, r: var TCompRes) = - genFieldAddr(p, n.sons[0], r) # XXX - -proc genCheckedFieldAccess(p: var TProc, n: PNode, r: var TCompRes) = - genFieldAccess(p, n.sons[0], r) # XXX - -proc genArrayAddr(p: var TProc, n: PNode, r: var TCompRes) = - var - a, b: TCompRes - first: biggestInt - r.kind = etyBaseIndex - gen(p, n.sons[0], a) - gen(p, n.sons[1], b) - r.com = mergeExpr(a) - var typ = skipTypes(n.sons[0].typ, abstractPtrs) - if typ.kind in {tyArray, tyArrayConstr}: first = FirstOrd(typ.sons[0]) - else: first = 0 - if (optBoundsCheck in p.options) and not isConstExpr(n.sons[1]): - useMagic(p, "chckIndx") - b.res = ropef("chckIndx($1, $2, $3.length)-$2", - [b.res, toRope(first), a.res]) - # XXX: BUG: a.res evaluated twice! - elif first != 0: - b.res = ropef("($1)-$2", [b.res, toRope(first)]) - r.res = mergeExpr(b) - -proc genArrayAccess(p: var TProc, n: PNode, r: var TCompRes) = - genArrayAddr(p, n, r) - r.kind = etyNone - r.res = ropef("$1[$2]", [r.com, r.res]) - r.com = nil - -proc genAddr(p: var TProc, n: PNode, r: var TCompRes) = - var s: PSym - case n.sons[0].kind - of nkSym: - s = n.sons[0].sym - if s.loc.r == nil: InternalError(n.info, "genAddr: 3") - case s.kind - of skVar: - if mapType(n.typ) == etyObject: - # make addr() a no-op: - r.kind = etyNone - r.res = s.loc.r - r.com = nil - elif sfGlobal in s.flags: - # globals are always indirect accessible - r.kind = etyBaseIndex - r.com = toRope("Globals") - r.res = makeCString(ropeToStr(s.loc.r)) - elif sfAddrTaken in s.flags: - r.kind = etyBaseIndex - r.com = s.loc.r - r.res = toRope("0") - else: - InternalError(n.info, "genAddr: 4") - else: InternalError(n.info, "genAddr: 2") - of nkCheckedFieldExpr: - genCheckedFieldAddr(p, n, r) - of nkDotExpr: - genFieldAddr(p, n, r) - of nkBracketExpr: - genArrayAddr(p, n, r) - else: InternalError(n.info, "genAddr") - -proc genSym(p: var TProc, n: PNode, r: var TCompRes) = - var s = n.sym - if s.loc.r == nil: - InternalError(n.info, "symbol has no generated name: " & s.name.s) - case s.kind - of skVar, skParam, skTemp: - var k = mapType(s.typ) - if k == etyBaseIndex: - r.kind = etyBaseIndex - if {sfAddrTaken, sfGlobal} * s.flags != {}: - r.com = ropef("$1[0]", [s.loc.r]) - r.res = ropef("$1[1]", [s.loc.r]) - else: - r.com = s.loc.r - r.res = con(s.loc.r, "_Idx") - elif (k != etyObject) and (sfAddrTaken in s.flags): - r.res = ropef("$1[0]", [s.loc.r]) - else: - r.res = s.loc.r - else: r.res = s.loc.r - -proc genDeref(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - if mapType(n.sons[0].typ) == etyObject: - gen(p, n.sons[0], r) - else: - gen(p, n.sons[0], a) - if a.kind != etyBaseIndex: InternalError(n.info, "genDeref") - r.res = ropef("$1[$2]", [a.com, a.res]) - -proc genArgs(p: var TProc, n: PNode, r: var TCompRes) = - app(r.res, "(") - for i in countup(1, sonsLen(n) - 1): - if i > 1: app(r.res, ", ") - var a: TCompRes - gen(p, n.sons[i], a) - if a.kind == etyBaseIndex: - app(r.res, a.com) - app(r.res, ", ") - app(r.res, a.res) - else: - app(r.res, mergeExpr(a)) - app(r.res, ")") - -proc genCall(p: var TProc, n: PNode, r: var TCompRes) = - gen(p, n.sons[0], r) - genArgs(p, n, r) - -proc genEcho(p: var TProc, n: PNode, r: var TCompRes) = - app(r.res, "rawEcho") - genArgs(p, n, r) - -proc putToSeq(s: string, indirect: bool): PRope = - result = toRope(s) - if indirect: result = ropef("[$1]", [result]) - -proc createVar(p: var TProc, typ: PType, indirect: bool): PRope -proc createRecordVarAux(p: var TProc, rec: PNode, c: var int): PRope = - result = nil - case rec.kind - of nkRecList: - for i in countup(0, sonsLen(rec) - 1): - app(result, createRecordVarAux(p, rec.sons[i], c)) - of nkRecCase: - app(result, createRecordVarAux(p, rec.sons[0], c)) - for i in countup(1, sonsLen(rec) - 1): - app(result, createRecordVarAux(p, lastSon(rec.sons[i]), c)) - of nkSym: - if c > 0: app(result, ", ") - app(result, mangleName(rec.sym)) - app(result, ": ") - app(result, createVar(p, rec.sym.typ, false)) - inc(c) - else: InternalError(rec.info, "createRecordVarAux") - -proc createVar(p: var TProc, typ: PType, indirect: bool): PRope = - var t = skipTypes(typ, abstractInst) - case t.kind - of tyInt..tyInt64, tyEnum, tyChar: - result = putToSeq("0", indirect) - of tyFloat..tyFloat128: - result = putToSeq("0.0", indirect) - of tyRange: - result = createVar(p, typ.sons[0], indirect) - of tySet: - result = toRope("{}") - of tyBool: - result = putToSeq("false", indirect) - of tyArray, tyArrayConstr: - var length = int(lengthOrd(t)) - var e = elemType(t) - if length > 32: - useMagic(p, "ArrayConstr") - result = ropef("ArrayConstr($1, $2, $3)", [toRope(length), - createVar(p, e, false), genTypeInfo(p, e)]) - else: - result = toRope("[") - var i = 0 - while i < length: - if i > 0: app(result, ", ") - app(result, createVar(p, e, false)) - inc(i) - app(result, "]") - of tyTuple: - result = toRope("{") - var c = 0 - app(result, createRecordVarAux(p, t.n, c)) - app(result, "}") - of tyObject: - result = toRope("{") - var c = 0 - if not (tfFinal in t.flags) or (t.sons[0] != nil): - inc(c) - appf(result, "m_type: $1", [genTypeInfo(p, t)]) - while t != nil: - app(result, createRecordVarAux(p, t.n, c)) - t = t.sons[0] - app(result, "}") - of tyVar, tyPtr, tyRef: - if mapType(t) == etyBaseIndex: result = putToSeq("[null, 0]", indirect) - else: result = putToSeq("null", indirect) - of tySequence, tyString, tyCString, tyPointer: - result = putToSeq("null", indirect) - else: - internalError("createVar: " & $t.kind) - result = nil - -proc isIndirect(v: PSym): bool = - result = (sfAddrTaken in v.flags) and (mapType(v.typ) != etyObject) - -proc genVarInit(p: var TProc, v: PSym, n: PNode, r: var TCompRes) = - var - a: TCompRes - s: PRope - if n.kind == nkEmpty: - appf(r.com, "var $1 = $2;$n", - [mangleName(v), createVar(p, v.typ, isIndirect(v))]) - else: - discard mangleName(v) - gen(p, n, a) - case mapType(v.typ) - of etyObject: - if a.com != nil: appf(r.com, "$1;$n", [a.com]) - if needsNoCopy(n): - s = a.res - else: - useMagic(p, "NimCopy") - s = ropef("NimCopy($1, $2)", [a.res, genTypeInfo(p, n.typ)]) - of etyBaseIndex: - if (a.kind != etyBaseIndex): InternalError(n.info, "genVarInit") - if {sfAddrTaken, sfGlobal} * v.flags != {}: - appf(r.com, "var $1 = [$2, $3];$n", [v.loc.r, a.com, a.res]) - else: - appf(r.com, "var $1 = $2; var $1_Idx = $3;$n", [v.loc.r, a.com, a.res]) - return - else: - if a.com != nil: appf(r.com, "$1;$n", [a.com]) - s = a.res - if isIndirect(v): appf(r.com, "var $1 = [$2];$n", [v.loc.r, s]) - else: appf(r.com, "var $1 = $2;$n", [v.loc.r, s]) - -proc genVarStmt(p: var TProc, n: PNode, r: var TCompRes) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - assert(a.kind == nkIdentDefs) - assert(a.sons[0].kind == nkSym) - var v = a.sons[0].sym - if lfNoDecl in v.loc.flags: continue - genLineDir(p, a, r) - genVarInit(p, v, a.sons[2], r) - -proc genConstStmt(p: var TProc, n: PNode, r: var TCompRes) = - genLineDir(p, n, r) - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind == nkCommentStmt: continue - assert(n.sons[i].kind == nkConstDef) - var c = n.sons[i].sons[0].sym - if (c.ast != nil) and (c.typ.kind in ConstantDataTypes) and - not (lfNoDecl in c.loc.flags): - genLineDir(p, n.sons[i], r) - genVarInit(p, c, c.ast, r) - -proc genNew(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - gen(p, n.sons[1], a) - var t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - if a.com != nil: appf(r.com, "$1;$n", [a.com]) - appf(r.com, "$1 = $2;$n", [a.res, createVar(p, t, true)]) - -proc genOrd(p: var TProc, n: PNode, r: var TCompRes) = - case skipTypes(n.sons[1].typ, abstractVar).kind - of tyEnum, tyInt..tyInt64, tyChar: gen(p, n.sons[1], r) - of tyBool: unaryExpr(p, n, r, "", "($1 ? 1:0)") - else: InternalError(n.info, "genOrd") - -proc genConStrStr(p: var TProc, n: PNode, r: var TCompRes) = - var a, b: TCompRes - gen(p, n.sons[1], a) - gen(p, n.sons[2], b) - r.com = mergeExpr(a.com, b.com) - if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyChar: - a.res = ropef("[$1, 0]", [a.res]) - if skipTypes(n.sons[2].typ, abstractVarRange).kind == tyChar: - b.res = ropef("[$1, 0]", [b.res]) - r.res = ropef("($1.slice(0,-1)).concat($2)", [a.res, b.res]) - -proc genMagic(p: var TProc, n: PNode, r: var TCompRes) = - var - a: TCompRes - line, filen: PRope - var op = n.sons[0].sym.magic - case op - of mOr: genOr(p, n.sons[1], n.sons[2], r) - of mAnd: genAnd(p, n.sons[1], n.sons[2], r) - of mAddi..mStrToStr: arith(p, n, r, op) #mRepr: genRepr(p, n, r); - of mSwap: genSwap(p, n, r) - of mUnaryLt: - # XXX: range checking? - if not (optOverflowCheck in p.Options): unaryExpr(p, n, r, "", "$1 - 1") - else: unaryExpr(p, n, r, "subInt", "subInt($1, 1)") - of mPred: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, n, r, "", "$1 - $2") - else: binaryExpr(p, n, r, "subInt", "subInt($1, $2)") - of mSucc: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, n, r, "", "$1 - $2") - else: binaryExpr(p, n, r, "addInt", "addInt($1, $2)") - of mAppendStrCh: binaryStmt(p, n, r, "addChar", "$1 = addChar($1, $2)") - of mAppendStrStr: - binaryStmt(p, n, r, "", "$1 = ($1.slice(0,-1)).concat($2)") - # XXX: make a copy of $2, because of EMCAScript's sucking semantics - of mAppendSeqElem: binaryStmt(p, n, r, "", "$1.push($2)") - of mConStrStr: genConStrStr(p, n, r) - of mEqStr: binaryExpr(p, n, r, "eqStrings", "eqStrings($1, $2)") - of mLeStr: binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) <= 0)") - of mLtStr: binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) < 0)") - of mIsNil: unaryExpr(p, n, r, "", "$1 == null") - of mAssert: - if (optAssert in p.Options): - useMagic(p, "internalAssert") - gen(p, n.sons[1], a) - line = toRope(toLinenumber(n.info)) - filen = makeCString(ToFilename(n.info)) - appf(r.com, "if (!($3)) internalAssert($1, $2)", - [filen, line, mergeExpr(a)]) - of mNew, mNewFinalize: genNew(p, n, r) - of mSizeOf: r.res = toRope(getSize(n.sons[1].typ)) - of mChr: gen(p, n.sons[1], r) # nothing to do - of mOrd: genOrd(p, n, r) - of mLengthStr: unaryExpr(p, n, r, "", "($1.length-1)") - of mLengthSeq, mLengthOpenArray, mLengthArray: - unaryExpr(p, n, r, "", "$1.length") - of mHigh: - if skipTypes(n.sons[0].typ, abstractVar).kind == tyString: - unaryExpr(p, n, r, "", "($1.length-2)") - else: - unaryExpr(p, n, r, "", "($1.length-1)") - of mInc: - if not (optOverflowCheck in p.Options): binaryStmt(p, n, r, "", "$1 += $2") - else: binaryStmt(p, n, r, "addInt", "$1 = addInt($1, $2)") - of ast.mDec: - if not (optOverflowCheck in p.Options): binaryStmt(p, n, r, "", "$1 -= $2") - else: binaryStmt(p, n, r, "subInt", "$1 = subInt($1, $2)") - of mSetLengthStr: binaryStmt(p, n, r, "", "$1.length = ($2)-1") - of mSetLengthSeq: binaryStmt(p, n, r, "", "$1.length = $2") - of mCard: unaryExpr(p, n, r, "SetCard", "SetCard($1)") - of mLtSet: binaryExpr(p, n, r, "SetLt", "SetLt($1, $2)") - of mLeSet: binaryExpr(p, n, r, "SetLe", "SetLe($1, $2)") - of mEqSet: binaryExpr(p, n, r, "SetEq", "SetEq($1, $2)") - of mMulSet: binaryExpr(p, n, r, "SetMul", "SetMul($1, $2)") - of mPlusSet: binaryExpr(p, n, r, "SetPlus", "SetPlus($1, $2)") - of mMinusSet: binaryExpr(p, n, r, "SetMinus", "SetMinus($1, $2)") - of mIncl: binaryStmt(p, n, r, "", "$1[$2] = true") - of mExcl: binaryStmt(p, n, r, "", "delete $1[$2]") - of mInSet: binaryExpr(p, n, r, "", "($1[$2] != undefined)") - of mNLen..mNError: - localError(n.info, errCannotGenerateCodeForX, n.sons[0].sym.name.s) - of mNewSeq: binaryStmt(p, n, r, "", "$1 = new Array($2)") - of mEcho: genEcho(p, n, r) - else: - genCall(p, n, r) - #else internalError(e.info, 'genMagic: ' + magicToStr[op]); - -proc genSetConstr(p: var TProc, n: PNode, r: var TCompRes) = - var - a, b: TCompRes - useMagic(p, "SetConstr") - r.res = toRope("SetConstr(") - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(r.res, ", ") - var it = n.sons[i] - if it.kind == nkRange: - gen(p, it.sons[0], a) - gen(p, it.sons[1], b) - r.com = mergeExpr(r.com, mergeExpr(a.com, b.com)) - appf(r.res, "[$1, $2]", [a.res, b.res]) - else: - gen(p, it, a) - r.com = mergeExpr(r.com, a.com) - app(r.res, a.res) - app(r.res, ")") - -proc genArrayConstr(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - r.res = toRope("[") - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(r.res, ", ") - gen(p, n.sons[i], a) - r.com = mergeExpr(r.com, a.com) - app(r.res, a.res) - app(r.res, "]") - -proc genRecordConstr(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - var i = 0 - var length = sonsLen(n) - r.res = toRope("{") - while i < length: - if i > 0: app(r.res, ", ") - if (n.sons[i].kind != nkSym): - internalError(n.sons[i].info, "genRecordConstr") - gen(p, n.sons[i + 1], a) - r.com = mergeExpr(r.com, a.com) - appf(r.res, "$1: $2", [mangleName(n.sons[i].sym), a.res]) - inc(i, 2) - -proc genConv(p: var TProc, n: PNode, r: var TCompRes) = - var dest = skipTypes(n.typ, abstractVarRange) - var src = skipTypes(n.sons[1].typ, abstractVarRange) - gen(p, n.sons[1], r) - if (dest.kind != src.kind) and (src.kind == tyBool): - r.res = ropef("(($1)? 1:0)", [r.res]) - -proc upConv(p: var TProc, n: PNode, r: var TCompRes) = - gen(p, n.sons[0], r) # XXX - -proc genRangeChck(p: var TProc, n: PNode, r: var TCompRes, magic: string) = - var a, b: TCompRes - gen(p, n.sons[0], r) - if optRangeCheck in p.options: - gen(p, n.sons[1], a) - gen(p, n.sons[2], b) - r.com = mergeExpr(r.com, mergeExpr(a.com, b.com)) - useMagic(p, "chckRange") - r.res = ropef("chckRange($1, $2, $3)", [r.res, a.res, b.res]) - -proc convStrToCStr(p: var TProc, n: PNode, r: var TCompRes) = - # we do an optimization here as this is likely to slow down - # much of the code otherwise: - if n.sons[0].kind == nkCStringToString: - gen(p, n.sons[0].sons[0], r) - else: - gen(p, n.sons[0], r) - if r.res == nil: InternalError(n.info, "convStrToCStr") - useMagic(p, "toEcmaStr") - r.res = ropef("toEcmaStr($1)", [r.res]) - -proc convCStrToStr(p: var TProc, n: PNode, r: var TCompRes) = - # we do an optimization here as this is likely to slow down - # much of the code otherwise: - if n.sons[0].kind == nkStringToCString: - gen(p, n.sons[0].sons[0], r) - else: - gen(p, n.sons[0], r) - if r.res == nil: InternalError(n.info, "convCStrToStr") - useMagic(p, "cstrToNimstr") - r.res = ropef("cstrToNimstr($1)", [r.res]) - -proc genReturnStmt(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - if p.procDef == nil: InternalError(n.info, "genReturnStmt") - p.BeforeRetNeeded = true - if (n.sons[0].kind != nkEmpty): - genStmt(p, n.sons[0], a) - if a.com != nil: appf(r.com, "$1;$n", mergeStmt(a)) - else: - genLineDir(p, n, r) - finishTryStmt(p, r, p.nestedTryStmts) - app(r.com, "break BeforeRet;" & tnl) - -proc genProcBody(p: var TProc, prc: PSym, r: TCompRes): PRope = - if optStackTrace in prc.options: - result = ropef("var F={procname:$1,prev:framePtr,filename:$2,line:0};$n" & - "framePtr = F;$n", [makeCString(prc.owner.name.s & '.' & prc.name.s), - makeCString(toFilename(prc.info))]) - else: - result = nil - if p.beforeRetNeeded: - appf(result, "BeforeRet: do {$n$1} while (false); $n", [mergeStmt(r)]) - else: - app(result, mergeStmt(r)) - if prc.typ.callConv == ccSysCall: - result = ropef("try {$n$1} catch (e) {$n" & - " alert(\"Unhandled exception:\\n\" + e.message + \"\\n\"$n}", [result]) - if optStackTrace in prc.options: - app(result, "framePtr = framePtr.prev;" & tnl) - -proc genProc(oldProc: var TProc, n: PNode, r: var TCompRes) = - var - p: TProc - resultSym: PSym - name, returnStmt, resultAsgn, header: PRope - a: TCompRes - var prc = n.sons[namePos].sym - initProc(p, oldProc.globals, oldProc.module, n, prc.options) - returnStmt = nil - resultAsgn = nil - name = mangleName(prc) - header = generateHeader(p, prc.typ) - if (prc.typ.sons[0] != nil) and not (sfPure in prc.flags): - resultSym = n.sons[resultPos].sym - resultAsgn = ropef("var $1 = $2;$n", [mangleName(resultSym), - createVar(p, resultSym.typ, isIndirect(resultSym))]) - gen(p, n.sons[resultPos], a) - if a.com != nil: appf(returnStmt, "$1;$n", [a.com]) - returnStmt = ropef("return $1;$n", [a.res]) - genStmt(p, n.sons[codePos], r) - r.com = ropef("function $1($2) {$n$3$4$5}$n", - [name, header, resultAsgn, genProcBody(p, prc, r), returnStmt]) - r.res = nil - -proc genStmtListExpr(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - # watch out this trick: ``function () { stmtList; return expr; }()`` - r.res = toRope("function () {") - for i in countup(0, sonsLen(n) - 2): - genStmt(p, n.sons[i], a) - app(r.res, mergeStmt(a)) - gen(p, lastSon(n), a) - if a.com != nil: appf(r.res, "$1;$n", [a.com]) - appf(r.res, "return $1; }()", [a.res]) - -proc genStmt(p: var TProc, n: PNode, r: var TCompRes) = - var a: TCompRes - r.kind = etyNone - r.com = nil - r.res = nil - case n.kind - of nkNilLit, nkEmpty: nil - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): - genStmt(p, n.sons[i], a) - app(r.com, mergeStmt(a)) - of nkBlockStmt: genBlock(p, n, r) - of nkIfStmt: genIfStmt(p, n, r) - of nkWhileStmt: genWhileStmt(p, n, r) - of nkVarSection: genVarStmt(p, n, r) - of nkConstSection: genConstStmt(p, n, r) - of nkForStmt: internalError(n.info, "for statement not eliminated") - of nkCaseStmt: genCaseStmt(p, n, r) - of nkReturnStmt: genReturnStmt(p, n, r) - of nkBreakStmt: genBreakStmt(p, n, r) - of nkAsgn: genAsgn(p, n, r) - of nkFastAsgn: genFastAsgn(p, n, r) - of nkDiscardStmt: - genLineDir(p, n, r) - gen(p, n.sons[0], r) - app(r.res, ';' & tnl) - of nkAsmStmt: genAsmStmt(p, n, r) - of nkTryStmt: genTryStmt(p, n, r) - of nkRaiseStmt: genRaiseStmt(p, n, r) - of nkTypeSection, nkCommentStmt, nkIteratorDef, nkIncludeStmt, nkImportStmt, - nkFromStmt, nkTemplateDef, nkMacroDef, nkPragma: - nil - of nkProcDef, nkMethodDef, nkConverterDef: - if (n.sons[genericParamsPos].kind == nkEmpty): - var prc = n.sons[namePos].sym - if (n.sons[codePos].kind != nkEmpty) and not (lfNoDecl in prc.loc.flags): - genProc(p, n, r) - else: - discard mangleName(prc) - else: - genLineDir(p, n, r) - gen(p, n, r) - app(r.res, ';' & tnl) - -proc gen(p: var TProc, n: PNode, r: var TCompRes) = - var f: BiggestFloat - r.kind = etyNone - r.com = nil - r.res = nil - case n.kind - of nkSym: - genSym(p, n, r) - of nkCharLit..nkInt64Lit: - r.res = toRope(n.intVal) - of nkNilLit: - if mapType(n.typ) == etyBaseIndex: - r.kind = etyBaseIndex - r.com = toRope("null") - r.res = toRope("0") - else: - r.res = toRope("null") - of nkStrLit..nkTripleStrLit: - if skipTypes(n.typ, abstractVarRange).kind == tyString: - useMagic(p, "cstrToNimstr") - r.res = ropef("cstrToNimstr($1)", [makeCString(n.strVal)]) - else: - r.res = makeCString(n.strVal) - of nkFloatLit..nkFloat64Lit: - f = n.floatVal - if f != f: r.res = toRope("NaN") - elif f == 0.0: r.res = toRope("0.0") - elif f == 0.5 * f: - if f > 0.0: r.res = toRope("Infinity") - else: r.res = toRope("-Infinity") - else: r.res = toRope(f.ToStrMaxPrecision) - of nkBlockExpr: genBlock(p, n, r) - of nkIfExpr: genIfExpr(p, n, r) - of nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit: - if (n.sons[0].kind == nkSym) and (n.sons[0].sym.magic != mNone): - genMagic(p, n, r) - else: - genCall(p, n, r) - of nkCurly: genSetConstr(p, n, r) - of nkBracket: genArrayConstr(p, n, r) - of nkPar: genRecordConstr(p, n, r) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, n, r) - of nkAddr, nkHiddenAddr: genAddr(p, n, r) - of nkDerefExpr, nkHiddenDeref: genDeref(p, n, r) - of nkBracketExpr: genArrayAccess(p, n, r) - of nkDotExpr: genFieldAccess(p, n, r) - of nkCheckedFieldExpr: genCheckedFieldAccess(p, n, r) - of nkObjDownConv: gen(p, n.sons[0], r) - of nkObjUpConv: upConv(p, n, r) - of nkChckRangeF: genRangeChck(p, n, r, "chckRangeF") - of nkChckRange64: genRangeChck(p, n, r, "chckRange64") - of nkChckRange: genRangeChck(p, n, r, "chckRange") - of nkStringToCString: convStrToCStr(p, n, r) - of nkCStringToString: convCStrToStr(p, n, r) - of nkPassAsOpenArray: gen(p, n.sons[0], r) - of nkStmtListExpr: genStmtListExpr(p, n, r) - of nkEmpty: nil - else: InternalError(n.info, "gen: unknown node type: " & $n.kind) - -var globals: PGlobals - -proc newModule(module: PSym, filename: string): BModule = - new(result) - result.filename = filename - result.module = module - if globals == nil: globals = newGlobals() - -proc genHeader(): PRope = - result = ropef("/* Generated by the Nimrod Compiler v$1 */$n" & - "/* (c) 2010 Andreas Rumpf */$n$n" & "$nvar Globals = this;$n" & - "var framePtr = null;$n" & "var excHandler = null;$n", - [toRope(versionAsString)]) - -proc genModule(p: var TProc, n: PNode, r: var TCompRes) = - genStmt(p, n, r) - if optStackTrace in p.options: - r.com = ropef("var F = {procname:$1,prev:framePtr,filename:$2,line:0};$n" & - "framePtr = F;$n" & "$3" & "framePtr = framePtr.prev;$n", [ - makeCString("module " & p.module.module.name.s), - makeCString(toFilename(p.module.module.info)), r.com]) - -proc myProcess(b: PPassContext, n: PNode): PNode = - if passes.skipCodegen(n): return n - var - p: TProc - r: TCompRes - result = n - var m = BModule(b) - if m.module == nil: InternalError(n.info, "myProcess") - initProc(p, globals, m, nil, m.module.options) - genModule(p, n, r) - app(p.globals.code, p.data) - app(p.globals.code, mergeStmt(r)) - -proc myClose(b: PPassContext, n: PNode): PNode = - if passes.skipCodegen(n): return n - result = myProcess(b, n) - var m = BModule(b) - if sfMainModule in m.module.flags: - # write the file: - var code = con(globals.typeInfo, globals.code) - var outfile = changeFileExt(completeCFilePath(m.filename), "js") - discard writeRopeIfNotEqual(con(genHeader(), code), outfile) - -proc myOpenCached(s: PSym, filename: string, rd: PRodReader): PPassContext = - InternalError("symbol files are not possible with the Ecmas code generator") - result = nil - -proc myOpen(s: PSym, filename: string): PPassContext = - result = newModule(s, filename) - -proc ecmasgenPass(): TPass = - InitPass(result) - result.open = myOpen - result.close = myClose - result.openCached = myOpenCached - result.process = myProcess diff --git a/rod/evals.nim b/rod/evals.nim deleted file mode 100755 index 7d0f9c801..000000000 --- a/rod/evals.nim +++ /dev/null @@ -1,1110 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This file implements the evaluator for Nimrod code. -# The evaluator is very slow, but simple. Since this -# is used mainly for evaluating macros and some other -# stuff at compile time, performance is not that -# important. - -import - strutils, magicsys, lists, options, ast, astalgo, trees, treetab, nimsets, - msgs, os, condsyms, idents, rnimsyn, types, passes, semfold - -type - PStackFrame* = ref TStackFrame - TStackFrame*{.final.} = object - mapping*: TIdNodeTable # mapping from symbols to nodes - prc*: PSym # current prc; proc that is evaluated - call*: PNode - next*: PStackFrame # for stacking - params*: TNodeSeq # parameters passed to the proc - - TEvalContext* = object of passes.TPassContext - module*: PSym - tos*: PStackFrame # top of stack - lastException*: PNode - optEval*: bool # evaluation done for optimization purposes - - PEvalContext* = ref TEvalContext - - TEvalFlag = enum - efNone, efLValue - TEvalFlags = set[TEvalFlag] - -proc eval*(c: PEvalContext, n: PNode): PNode - # eval never returns nil! This simplifies the code a lot and - # makes it faster too. -proc evalConstExpr*(module: PSym, e: PNode): PNode - -const - evalMaxIterations = 500_000 # max iterations of all loops - evalMaxRecDepth = 10_000 # max recursion depth for evaluation - -# Much better: use a timeout! -> Wether code compiles depends on the machine -# the compiler runs on then! Bad idea! - -proc newStackFrame*(): PStackFrame = - new(result) - initIdNodeTable(result.mapping) - result.params = @[] - -proc newEvalContext*(module: PSym, filename: string, - optEval: bool): PEvalContext = - new(result) - result.module = module - result.optEval = optEval - -proc pushStackFrame*(c: PEvalContext, t: PStackFrame) {.inline.} = - t.next = c.tos - c.tos = t - -proc popStackFrame*(c: PEvalContext) {.inline.} = - if (c.tos == nil): InternalError("popStackFrame") - c.tos = c.tos.next - -proc evalAux(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode - -proc stackTraceAux(x: PStackFrame) = - if x != nil: - stackTraceAux(x.next) - var info = if x.call != nil: x.call.info else: UnknownLineInfo() - # we now use the same format as in system/except.nim - var s = toFilename(info) - var line = toLineNumber(info) - if line > 0: - add(s, '(') - add(s, $line) - add(s, ')') - if x.prc != nil: - for k in 1..max(1, 25-s.len): add(s, ' ') - add(s, x.prc.name.s) - MsgWriteln(s) - -proc stackTrace(c: PEvalContext, n: PNode, msg: TMsgKind, arg = "") = - MsgWriteln("stack trace: (most recent call last)") - stackTraceAux(c.tos) - Fatal(n.info, msg, arg) - -proc isSpecial(n: PNode): bool {.inline.} = - result = (n.kind == nkExceptBranch) - # or (n.kind == nkEmpty) - # XXX this does not work yet! Better to compile too much than to compile to - # few programs - -proc myreset(n: PNode) {.inline.} = - when defined(system.reset): reset(n[]) - -proc evalIf(c: PEvalContext, n: PNode): PNode = - var i = 0 - var length = sonsLen(n) - while (i < length) and (sonsLen(n.sons[i]) >= 2): - result = evalAux(c, n.sons[i].sons[0], {}) - if isSpecial(result): return - if (result.kind == nkIntLit) and (result.intVal != 0): - return evalAux(c, n.sons[i].sons[1], {}) - inc(i) - if (i < length) and (sonsLen(n.sons[i]) < 2): - result = evalAux(c, n.sons[i].sons[0], {}) - else: - result = emptyNode - -proc evalCase(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - var res = result - result = emptyNode - for i in countup(1, sonsLen(n) - 1): - if n.sons[i].kind == nkOfBranch: - for j in countup(0, sonsLen(n.sons[i]) - 2): - if overlap(res, n.sons[i].sons[j]): - return evalAux(c, lastSon(n.sons[i]), {}) - else: - result = evalAux(c, lastSon(n.sons[i]), {}) - -var - gWhileCounter: int # Use a counter to prevent endless loops! - # We make this counter global, because otherwise - # nested loops could make the compiler extremely slow. - gNestedEvals: int # count the recursive calls to ``evalAux`` to prevent - # endless recursion - -proc evalWhile(c: PEvalContext, n: PNode): PNode = - while true: - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - if getOrdValue(result) == 0: break - result = evalAux(c, n.sons[1], {}) - case result.kind - of nkBreakStmt: - if result.sons[0].kind == nkEmpty: - result = emptyNode # consume ``break`` token - # Bugfix (see tmacro2): but break in any case! - break - of nkExceptBranch, nkReturnToken: break - else: nil - dec(gWhileCounter) - if gWhileCounter <= 0: - stackTrace(c, n, errTooManyIterations) - break - -proc evalBlock(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if result.kind == nkBreakStmt: - if result.sons[0] != nil: - assert(result.sons[0].kind == nkSym) - if n.sons[0].kind != nkEmpty: - assert(n.sons[0].kind == nkSym) - if result.sons[0].sym.id == n.sons[0].sym.id: result = emptyNode - else: - result = emptyNode # consume ``break`` token - -proc evalFinally(c: PEvalContext, n, exc: PNode): PNode = - var finallyNode = lastSon(n) - if finallyNode.kind == nkFinally: - result = evalAux(c, finallyNode, {}) - if result.kind != nkExceptBranch: result = exc - else: - result = exc - -proc evalTry(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - case result.kind - of nkBreakStmt, nkReturnToken: - nil - of nkExceptBranch: - if sonsLen(result) >= 1: - # creating a nkExceptBranch without sons means that it could not be - # evaluated - var exc = result - var i = 1 - var length = sonsLen(n) - while (i < length) and (n.sons[i].kind == nkExceptBranch): - var blen = sonsLen(n.sons[i]) - if blen == 1: - # general except section: - result = evalAux(c, n.sons[i].sons[0], {}) - exc = result - break - else: - for j in countup(0, blen - 2): - assert(n.sons[i].sons[j].kind == nkType) - if exc.typ.id == n.sons[i].sons[j].typ.id: - result = evalAux(c, n.sons[i].sons[blen - 1], {}) - exc = result - break - inc(i) - result = evalFinally(c, n, exc) - else: result = evalFinally(c, n, emptyNode) - -proc getNullValue(typ: PType, info: TLineInfo): PNode -proc getNullValueAux(obj: PNode, result: PNode) = - case obj.kind - of nkRecList: - for i in countup(0, sonsLen(obj) - 1): getNullValueAux(obj.sons[i], result) - of nkRecCase: - getNullValueAux(obj.sons[0], result) - for i in countup(1, sonsLen(obj) - 1): - getNullValueAux(lastSon(obj.sons[i]), result) - of nkSym: - var s = obj.sym - var p = newNodeIT(nkExprColonExpr, result.info, s.typ) - addSon(p, newSymNode(s, result.info)) - addSon(p, getNullValue(s.typ, result.info)) - addSon(result, p) - else: InternalError(result.info, "getNullValueAux") - -proc getNullValue(typ: PType, info: TLineInfo): PNode = - var t = skipTypes(typ, abstractRange) - result = emptyNode - case t.kind - of tyBool, tyChar, tyInt..tyInt64: - result = newNodeIT(nkIntLit, info, t) - of tyFloat..tyFloat128: - result = newNodeIt(nkFloatLit, info, t) - of tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr, - tyStmt, tyTypeDesc: - result = newNodeIT(nkNilLit, info, t) - of tyObject: - result = newNodeIT(nkPar, info, t) - getNullValueAux(t.n, result) - of tyArray, tyArrayConstr: - result = newNodeIT(nkBracket, info, t) - for i in countup(0, int(lengthOrd(t)) - 1): - addSon(result, getNullValue(elemType(t), info)) - of tyTuple: - result = newNodeIT(nkPar, info, t) - for i in countup(0, sonsLen(t) - 1): - var p = newNodeIT(nkExprColonExpr, info, t.sons[i]) - var field = if t.n != nil: t.n.sons[i].sym else: newSym( - skField, getIdent(":tmp" & $i), t.owner) - addSon(p, newSymNode(field, info)) - addSon(p, getNullValue(t.sons[i], info)) - addSon(result, p) - of tySet: - result = newNodeIT(nkCurly, info, t) - else: InternalError("getNullValue") - -proc evalVar(c: PEvalContext, n: PNode): PNode = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - assert(a.kind == nkIdentDefs) - assert(a.sons[0].kind == nkSym) - var v = a.sons[0].sym - if a.sons[2].kind != nkEmpty: - result = evalAux(c, a.sons[2], {}) - if isSpecial(result): return - else: - result = getNullValue(a.sons[0].typ, a.sons[0].info) - IdNodeTablePut(c.tos.mapping, v, result) - result = emptyNode - -proc evalCall(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - var prc = result - # bind the actual params to the local parameter of a new binding - var d = newStackFrame() - d.call = n - if prc.kind == nkSym: - d.prc = prc.sym - if not (prc.sym.kind in {skProc, skConverter}): - InternalError(n.info, "evalCall") - setlen(d.params, sonsLen(n)) - for i in countup(1, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], {}) - if isSpecial(result): return - d.params[i] = result - if n.typ != nil: d.params[0] = getNullValue(n.typ, n.info) - pushStackFrame(c, d) - result = evalAux(c, prc, {}) - if result.kind == nkExceptBranch: return - if n.typ != nil: result = d.params[0] - popStackFrame(c) - -proc aliasNeeded(n: PNode, flags: TEvalFlags): bool = - result = efLValue in flags or n.typ == nil or - n.typ.kind in {tyExpr, tyStmt, tyTypeDesc} - -proc evalVariable(c: PStackFrame, sym: PSym, flags: TEvalFlags): PNode = - # We need to return a node to the actual value, - # which can be modified. - var x = c - while x != nil: - if sfResult in sym.flags: - result = x.params[0] - if result == nil: result = emptyNode - return - result = IdNodeTableGet(x.mapping, sym) - if result != nil and not aliasNeeded(result, flags): - result = copyTree(result) - if result != nil: return - x = x.next - result = emptyNode - -proc evalArrayAccess(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], flags) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var idx = getOrdValue(result) - result = emptyNode - case x.kind - of nkPar: - if (idx >= 0) and (idx < sonsLen(x)): - result = x.sons[int(idx)] - if result.kind == nkExprColonExpr: result = result.sons[1] - else: stackTrace(c, n, errIndexOutOfBounds) - if not aliasNeeded(result, flags): result = copyTree(result) - of nkBracket, nkMetaNode: - if (idx >= 0) and (idx < sonsLen(x)): result = x.sons[int(idx)] - else: stackTrace(c, n, errIndexOutOfBounds) - if not aliasNeeded(result, flags): result = copyTree(result) - of nkStrLit..nkTripleStrLit: - if efLValue in flags: - InternalError(n.info, "cannot evaluate write access to char") - result = newNodeIT(nkCharLit, x.info, getSysType(tyChar)) - if (idx >= 0) and (idx < len(x.strVal)): - result.intVal = ord(x.strVal[int(idx) + 0]) - elif idx == len(x.strVal): - nil - else: - stackTrace(c, n, errIndexOutOfBounds) - else: stackTrace(c, n, errNilAccess) - -proc evalFieldAccess(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - # a real field access; proc calls have already been transformed - # XXX: field checks! - result = evalAux(c, n.sons[0], flags) - if isSpecial(result): return - var x = result - if x.kind != nkPar: InternalError(n.info, "evalFieldAccess") - var field = n.sons[1].sym - for i in countup(0, sonsLen(x) - 1): - var it = x.sons[i] - if it.kind != nkExprColonExpr: - InternalError(it.info, "evalFieldAccess") - if it.sons[0].sym.name.id == field.name.id: - result = x.sons[i].sons[1] - if not aliasNeeded(result, flags): result = copyTree(result) - return - stackTrace(c, n, errFieldXNotFound, field.name.s) - result = emptyNode - -proc evalAsgn(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - myreset(x) - x.kind = result.kind - x.typ = result.typ - case x.kind - of nkCharLit..nkInt64Lit: - x.intVal = result.intVal - of nkFloatLit..nkFloat64Lit: - x.floatVal = result.floatVal - of nkStrLit..nkTripleStrLit: - x.strVal = result.strVal - else: - if not (x.kind in {nkEmpty..nkNilLit}): - discardSons(x) - for i in countup(0, sonsLen(result) - 1): addSon(x, result.sons[i]) - result = emptyNode - assert result.kind == nkEmpty - -proc evalSwap(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - if (x.kind != result.kind): - stackTrace(c, n, errCannotInterpretNodeX, $n.kind) - else: - case x.kind - of nkCharLit..nkInt64Lit: - var tmpi = x.intVal - x.intVal = result.intVal - result.intVal = tmpi - of nkFloatLit..nkFloat64Lit: - var tmpf = x.floatVal - x.floatVal = result.floatVal - result.floatVal = tmpf - of nkStrLit..nkTripleStrLit: - var tmps = x.strVal - x.strVal = result.strVal - result.strVal = tmps - else: - var tmpn = copyTree(x) - discardSons(x) - for i in countup(0, sonsLen(result) - 1): addSon(x, result.sons[i]) - discardSons(result) - for i in countup(0, sonsLen(tmpn) - 1): addSon(result, tmpn.sons[i]) - result = emptyNode - -proc evalSym(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - case n.sym.kind - of skProc, skConverter, skMacro: result = n.sym.ast.sons[codePos] - of skVar, skForVar, skTemp: result = evalVariable(c.tos, n.sym, flags) - of skParam: - # XXX what about LValue? - result = c.tos.params[n.sym.position + 1] - of skConst: result = n.sym.ast - else: - stackTrace(c, n, errCannotInterpretNodeX, $n.sym.kind) - result = emptyNode - if result == nil: stackTrace(c, n, errCannotInterpretNodeX, n.sym.name.s) - -proc evalIncDec(c: PEvalContext, n: PNode, sign: biggestInt): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkCharLit..nkInt64Lit: a.intval = a.intVal + sign * getOrdValue(b) - else: internalError(n.info, "evalIncDec") - result = emptyNode - -proc getStrValue(n: PNode): string = - case n.kind - of nkStrLit..nkTripleStrLit: result = n.strVal - else: - InternalError(n.info, "getStrValue") - result = "" - -proc evalEcho(c: PEvalContext, n: PNode): PNode = - for i in countup(1, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], {}) - if isSpecial(result): return - Write(stdout, getStrValue(result)) - writeln(stdout, "") - result = emptyNode - -proc evalExit(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - Message(n.info, hintQuitCalled) - quit(int(getOrdValue(result))) - -proc evalOr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkIntLit: InternalError(n.info, "evalOr") - if result.intVal == 0: result = evalAux(c, n.sons[2], {}) - -proc evalAnd(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkIntLit: InternalError(n.info, "evalAnd") - if result.intVal != 0: result = evalAux(c, n.sons[2], {}) - -proc evalNoOpt(c: PEvalContext, n: PNode): PNode = - result = newNodeI(nkExceptBranch, n.info) - # creating a nkExceptBranch without sons - # means that it could not be evaluated - -proc evalNew(c: PEvalContext, n: PNode): PNode = - if c.optEval: return evalNoOpt(c, n) - # we ignore the finalizer for now and most likely forever :-) - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - var t = skipTypes(n.sons[1].typ, abstractVar) - if a.kind == nkEmpty: InternalError(n.info, "first parameter is empty") - myreset(a) - a.kind = nkRefTy - a.info = n.info - a.typ = t - a.sons = nil - addSon(a, getNullValue(t.sons[0], n.info)) - result = emptyNode - -proc evalDeref(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - case result.kind - of nkNilLit: stackTrace(c, n, errNilAccess) - of nkRefTy: - # XXX efLValue? - result = result.sons[0] - else: InternalError(n.info, "evalDeref " & $result.kind) - -proc evalAddr(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - var a = result - var t = newType(tyPtr, c.module) - addSon(t, a.typ) - result = newNodeIT(nkRefTy, n.info, t) - addSon(result, a) - -proc evalConv(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = foldConv(n, a) - if result == nil: - # foldConv() cannot deal with everything that we want to do here: - result = a - -proc evalCheckedFieldAccess(c: PEvalContext, n: PNode, - flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], flags) - -proc evalUpConv(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], flags) - if isSpecial(result): return - var dest = skipTypes(n.typ, abstractPtrs) - var src = skipTypes(result.typ, abstractPtrs) - if inheritanceDiff(src, dest) > 0: - stackTrace(c, n, errInvalidConversionFromTypeX, typeToString(src)) - -proc evalRangeChck(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if leValueConv(a, x) and leValueConv(x, b): - result = x # a <= x and x <= b - result.typ = n.typ - else: - stackTrace(c, n, errGenerated, msgKindToString(errIllegalConvFromXtoY) % [ - typeToString(n.sons[0].typ), typeToString(n.typ)]) - -proc evalConvStrToCStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - result.typ = n.typ - -proc evalConvCStrToStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - result.typ = n.typ - -proc evalRaise(c: PEvalContext, n: PNode): PNode = - if n.sons[0].kind != nkEmpty: - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkExceptBranch, n.info, a.typ) - addSon(result, a) - c.lastException = result - elif c.lastException != nil: - result = c.lastException - else: - stackTrace(c, n, errExceptionAlreadyHandled) - result = newNodeIT(nkExceptBranch, n.info, nil) - addSon(result, ast.emptyNode) - -proc evalReturn(c: PEvalContext, n: PNode): PNode = - if n.sons[0].kind != nkEmpty: - result = evalAsgn(c, n.sons[0]) - if isSpecial(result): return - result = newNodeIT(nkReturnToken, n.info, nil) - -proc evalProc(c: PEvalContext, n: PNode): PNode = - if n.sons[genericParamsPos].kind == nkEmpty: - if (resultPos < sonsLen(n)) and (n.sons[resultPos].kind != nkEmpty): - var v = n.sons[resultPos].sym - result = getNullValue(v.typ, n.info) - IdNodeTablePut(c.tos.mapping, v, result) - result = evalAux(c, n.sons[codePos], {}) - if result.kind == nkReturnToken: - result = IdNodeTableGet(c.tos.mapping, v) - else: - result = evalAux(c, n.sons[codePos], {}) - if result.kind == nkReturnToken: - result = emptyNode - else: - result = emptyNode - -proc evalHigh(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - case skipTypes(n.sons[1].typ, abstractVar).kind - of tyOpenArray, tySequence: result = newIntNodeT(sonsLen(result), n) - of tyString: result = newIntNodeT(len(result.strVal) - 1, n) - else: InternalError(n.info, "evalHigh") - -proc evalIs(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - result = newIntNodeT(ord(inheritanceDiff(result.typ, n.sons[2].typ) >= 0), n) - -proc evalSetLengthStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkStrLit..nkTripleStrLit: - var newLen = int(getOrdValue(b)) - setlen(a.strVal, newLen) - else: InternalError(n.info, "evalSetLengthStr") - result = emptyNode - -proc evalSetLengthSeq(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if a.kind != nkBracket: InternalError(n.info, "evalSetLengthSeq") - var newLen = int(getOrdValue(b)) - var oldLen = sonsLen(a) - setlen(a.sons, newLen) - for i in countup(oldLen, newLen - 1): - a.sons[i] = getNullValue(skipTypes(n.sons[1].typ, abstractVar), n.info) - result = emptyNode - -proc evalNewSeq(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - var t = skipTypes(n.sons[1].typ, abstractVar) - if a.kind == nkEmpty: InternalError(n.info, "first parameter is empty") - myreset(a) - a.kind = nkBracket - a.info = n.info - a.typ = t - a.sons = nil - var L = int(getOrdValue(b)) - newSeq(a.sons, L) - for i in countup(0, L-1): - a.sons[i] = getNullValue(t.sons[0], n.info) - result = emptyNode - -proc evalAssert(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if getOrdValue(result) != 0: result = emptyNode - else: stackTrace(c, n, errAssertionFailed) - -proc evalIncl(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if not inSet(a, b): addSon(a, copyTree(b)) - result = emptyNode - -proc evalExcl(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = newNodeIT(nkCurly, n.info, n.sons[1].typ) - addSon(b, result) - var r = diffSets(a, b) - discardSons(a) - for i in countup(0, sonsLen(r) - 1): addSon(a, r.sons[i]) - result = emptyNode - -proc evalAppendStrCh(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkStrLit..nkTripleStrLit: add(a.strVal, chr(int(getOrdValue(b)))) - else: InternalError(n.info, "evalAppendStrCh") - result = emptyNode - -proc evalConStrStr(c: PEvalContext, n: PNode): PNode = - # we cannot use ``evalOp`` for this as we can here have more than 2 arguments - var a = newNodeIT(nkStrLit, n.info, n.typ) - a.strVal = "" - for i in countup(1, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], {}) - if isSpecial(result): return - a.strVal.add(getStrValue(result)) - result = a - -proc evalAppendStrStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkStrLit..nkTripleStrLit: a.strVal = a.strVal & getStrValue(b) - else: InternalError(n.info, "evalAppendStrStr") - result = emptyNode - -proc evalAppendSeqElem(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if a.kind == nkBracket: addSon(a, copyTree(b)) - else: InternalError(n.info, "evalAppendSeqElem") - result = emptyNode - -proc evalRepr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - result = newStrNodeT(renderTree(result, {renderNoComments}), n) - -proc isEmpty(n: PNode): bool = - result = (n != nil) and (n.kind == nkEmpty) - -proc evalMagicOrCall(c: PEvalContext, n: PNode): PNode = - var m = getMagic(n) - case m - of mNone: result = evalCall(c, n) - of mIs: result = evalIs(c, n) - of mSizeOf: internalError(n.info, "sizeof() should have been evaluated") - of mHigh: result = evalHigh(c, n) - of mAssert: result = evalAssert(c, n) - of mExit: result = evalExit(c, n) - of mNew, mNewFinalize: result = evalNew(c, n) - of mNewSeq: result = evalNewSeq(c, n) - of mSwap: result = evalSwap(c, n) - of mInc: result = evalIncDec(c, n, 1) - of ast.mDec: result = evalIncDec(c, n, - 1) - of mEcho: result = evalEcho(c, n) - of mSetLengthStr: result = evalSetLengthStr(c, n) - of mSetLengthSeq: result = evalSetLengthSeq(c, n) - of mIncl: result = evalIncl(c, n) - of mExcl: result = evalExcl(c, n) - of mAnd: result = evalAnd(c, n) - of mOr: result = evalOr(c, n) - of mAppendStrCh: result = evalAppendStrCh(c, n) - of mAppendStrStr: result = evalAppendStrStr(c, n) - of mAppendSeqElem: result = evalAppendSeqElem(c, n) - of mNLen: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkIntLit, n.info, n.typ) - case a.kind - of nkEmpty..nkNilLit: nil - else: result.intVal = sonsLen(a) - of mNChild: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var k = getOrdValue(result) - if not (a.kind in {nkEmpty..nkNilLit}) and (k >= 0) and (k < sonsLen(a)): - result = a.sons[int(k)] - if result == nil: result = newNode(nkEmpty) - else: - stackTrace(c, n, errIndexOutOfBounds) - result = emptyNode - of mNSetChild: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var b = result - result = evalAux(c, n.sons[3], {efLValue}) - if isSpecial(result): return - var k = getOrdValue(b) - if (k >= 0) and (k < sonsLen(a)) and not (a.kind in {nkEmpty..nkNilLit}): - a.sons[int(k)] = result - else: - stackTrace(c, n, errIndexOutOfBounds) - result = emptyNode - of mNAdd: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - addSon(a, result) - result = emptyNode - of mNAddMultiple: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - for i in countup(0, sonsLen(result) - 1): addSon(a, result.sons[i]) - result = emptyNode - of mNDel: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var b = result - result = evalAux(c, n.sons[3], {efLValue}) - if isSpecial(result): return - for i in countup(0, int(getOrdValue(result)) - 1): - delSon(a, int(getOrdValue(b))) - result = emptyNode - of mNKind: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkIntLit, n.info, n.typ) - result.intVal = ord(a.kind) - of mNIntVal: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkIntLit, n.info, n.typ) - case a.kind - of nkCharLit..nkInt64Lit: result.intVal = a.intVal - else: InternalError(n.info, "no int value") - of mNFloatVal: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkFloatLit, n.info, n.typ) - case a.kind - of nkFloatLit..nkFloat64Lit: result.floatVal = a.floatVal - else: InternalError(n.info, "no float value") - of mNSymbol: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - if result.kind != nkSym: InternalError(n.info, "no symbol") - of mNIdent: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkIdent: InternalError(n.info, "no symbol") - of mNGetType: result = evalAux(c, n.sons[1], {}) - of mNStrVal: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkStrLit, n.info, n.typ) - case a.kind - of nkStrLit..nkTripleStrLit: result.strVal = a.strVal - else: InternalError(n.info, "no string value") - of mNSetIntVal: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - a.intVal = result.intVal # XXX: exception handling? - result = emptyNode - of mNSetFloatVal: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - a.floatVal = result.floatVal # XXX: exception handling? - result = emptyNode - of mNSetSymbol: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - a.sym = result.sym # XXX: exception handling? - result = emptyNode - of mNSetIdent: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - a.ident = result.ident # XXX: exception handling? - result = emptyNode - of mNSetType: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - a.typ = result.typ # XXX: exception handling? - result = emptyNode - of mNSetStrVal: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - a.strVal = result.strVal # XXX: exception handling? - result = emptyNode - of mNNewNimNode: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var k = getOrdValue(result) - result = evalAux(c, n.sons[2], {efLValue}) - if result.kind == nkExceptBranch: return - var a = result - if k < 0 or k > ord(high(TNodeKind)): - internalError(n.info, "request to create a NimNode with invalid kind") - result = newNodeI(TNodeKind(int(k)), - if a.kind == nkNilLit: n.info else: a.info) - of mNCopyNimNode: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - result = copyNode(result) - of mNCopyNimTree: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - result = copyTree(result) - of mStrToIdent: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if not (result.kind in {nkStrLit..nkTripleStrLit}): - InternalError(n.info, "no string node") - var a = result - result = newNodeIT(nkIdent, n.info, n.typ) - result.ident = getIdent(a.strVal) - of mIdentToStr: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkIdent: InternalError(n.info, "no ident node") - var a = result - result = newNodeIT(nkStrLit, n.info, n.typ) - result.strVal = a.ident.s - of mEqIdent: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - result = newNodeIT(nkIntLit, n.info, n.typ) - if (a.kind == nkIdent) and (b.kind == nkIdent): - if a.ident.id == b.ident.id: result.intVal = 1 - of mEqNimrodNode: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var b = result - result = newNodeIT(nkIntLit, n.info, n.typ) - if (a == b) or - (b.kind in {nkNilLit, nkEmpty}) and (a.kind in {nkNilLit, nkEmpty}): - result.intVal = 1 - of mNHint: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - Message(n.info, hintUser, getStrValue(result)) - result = emptyNode - of mNWarning: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - Message(n.info, warnUser, getStrValue(result)) - result = emptyNode - of mNError: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - stackTrace(c, n, errUser, getStrValue(result)) - result = emptyNode - of mConStrStr: - result = evalConStrStr(c, n) - of mRepr: - result = evalRepr(c, n) - of mNewString: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkStrLit, n.info, n.typ) - result.strVal = newString(int(getOrdValue(a))) - else: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - var b: PNode = nil - var cc: PNode = nil - if sonsLen(n) > 2: - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - b = result - if sonsLen(n) > 3: - result = evalAux(c, n.sons[3], {}) - if isSpecial(result): return - cc = result - if isEmpty(a) or isEmpty(b) or isEmpty(cc): result = emptyNode - else: result = evalOp(m, n, a, b, cc) - -proc evalAux(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = emptyNode - dec(gNestedEvals) - if gNestedEvals <= 0: stackTrace(c, n, errTooManyIterations) - case n.kind # atoms: - of nkEmpty: result = n - of nkSym: result = evalSym(c, n, flags) - of nkType..nkNilLit: result = copyNode(n) # end of atoms - of nkCall, nkHiddenCallConv, nkMacroStmt, nkCommand, nkCallStrLit: - result = evalMagicOrCall(c, n) - of nkCurly, nkBracket, nkRange: - # flags need to be passed here for mNAddMultiple :-( - # XXX this is not correct in every case! - var a = copyNode(n) - for i in countup(0, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], flags) - if isSpecial(result): return - addSon(a, result) - result = a - of nkPar: - var a = copyTree(n) - for i in countup(0, sonsLen(n) - 1): - result = evalAux(c, n.sons[i].sons[1], flags) - if isSpecial(result): return - a.sons[i].sons[1] = result - result = a - of nkBracketExpr: result = evalArrayAccess(c, n, flags) - of nkDotExpr: result = evalFieldAccess(c, n, flags) - of nkDerefExpr, nkHiddenDeref: result = evalDeref(c, n, flags) - of nkAddr, nkHiddenAddr: result = evalAddr(c, n, flags) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: result = evalConv(c, n) - of nkAsgn, nkFastAsgn: result = evalAsgn(c, n) - of nkWhenStmt, nkIfStmt, nkIfExpr: result = evalIf(c, n) - of nkWhileStmt: result = evalWhile(c, n) - of nkCaseStmt: result = evalCase(c, n) - of nkVarSection: result = evalVar(c, n) - of nkTryStmt: result = evalTry(c, n) - of nkRaiseStmt: result = evalRaise(c, n) - of nkReturnStmt: result = evalReturn(c, n) - of nkBreakStmt, nkReturnToken: result = n - of nkBlockExpr, nkBlockStmt: result = evalBlock(c, n) - of nkDiscardStmt: result = evalAux(c, n.sons[0], {}) - of nkCheckedFieldExpr: result = evalCheckedFieldAccess(c, n, flags) - of nkObjDownConv: result = evalAux(c, n.sons[0], flags) - of nkObjUpConv: result = evalUpConv(c, n, flags) - of nkChckRangeF, nkChckRange64, nkChckRange: result = evalRangeChck(c, n) - of nkStringToCString: result = evalConvStrToCStr(c, n) - of nkCStringToString: result = evalConvCStrToStr(c, n) - of nkPassAsOpenArray: result = evalAux(c, n.sons[0], flags) - of nkStmtListExpr, nkStmtList, nkModule: - for i in countup(0, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], flags) - case result.kind - of nkExceptBranch, nkReturnToken, nkBreakStmt: break - else: nil - of nkProcDef, nkMethodDef, nkMacroDef, nkCommentStmt, nkPragma, - nkTypeSection, nkTemplateDef, nkConstSection, nkIteratorDef, - nkConverterDef, nkIncludeStmt, nkImportStmt, nkFromStmt: - nil - of nkIdentDefs, nkCast, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, - nkLambda, nkContinueStmt, nkIdent: - stackTrace(c, n, errCannotInterpretNodeX, $n.kind) - else: InternalError(n.info, "evalAux: " & $n.kind) - if result == nil: - InternalError(n.info, "evalAux: returned nil " & $n.kind) - inc(gNestedEvals) - -proc eval(c: PEvalContext, n: PNode): PNode = - gWhileCounter = evalMaxIterations - gNestedEvals = evalMaxRecDepth - result = evalAux(c, n, {}) - if (result.kind == nkExceptBranch) and (sonsLen(result) >= 1): - stackTrace(c, n, errUnhandledExceptionX, typeToString(result.typ)) - -proc evalConstExpr(module: PSym, e: PNode): PNode = - var p = newEvalContext(module, "", true) - var s = newStackFrame() - s.call = e - pushStackFrame(p, s) - result = eval(p, e) - if result != nil and result.kind == nkExceptBranch: result = nil - popStackFrame(p) - -proc myOpen(module: PSym, filename: string): PPassContext = - var c = newEvalContext(module, filename, false) - pushStackFrame(c, newStackFrame()) - result = c - -proc myProcess(c: PPassContext, n: PNode): PNode = - result = eval(PEvalContext(c), n) - -proc evalPass*(): TPass = - initPass(result) - result.open = myOpen - result.close = myProcess - result.process = myProcess - diff --git a/rod/expandimportc.nim b/rod/expandimportc.nim deleted file mode 100755 index d4b2fee18..000000000 --- a/rod/expandimportc.nim +++ /dev/null @@ -1,73 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Simple tool to expand ``importc`` pragmas. Used for the clean up process of -## the diverse wrappers. - -import - os, ropes, idents, ast, pnimsyn, rnimsyn, msgs, wordrecg, syntaxes, pegs - -proc modifyPragmas(n: PNode, name: string) = - if n == nil: return - for i in 0..len(n)-1: - var it = n[i] - if it.kind == nkIdent and whichKeyword(it.ident) == wImportc: - var x = newNode(nkExprColonExpr) - add(x, it) - add(x, newStrNode(nkStrLit, name)) - n.sons[i] = x - -proc getName(n: PNode): string = - case n.kind - of nkPostfix: result = getName(n[1]) - of nkPragmaExpr: result = getName(n[0]) - of nkSym: result = n.sym.name.s - of nkIdent: result = n.ident.s - of nkAccQuoted: result = getName(n[0]) - else: internalError(n.info, "getName()") - -proc processRoutine(n: PNode) = - var name = getName(n[namePos]) - modifyPragmas(n[pragmasPos], name) - -proc processIdent(ident, prefix: string, n: PNode): string = - var pattern = sequence(capture(?(termIgnoreCase"T" / termIgnoreCase"P")), - termIgnoreCase(prefix), ?term('_'), capture(*any())) - if ident =~ pattern: - result = matches[0] & matches[1] - else: - result = ident - -proc processTree(n: PNode, prefix: string) = - if n == nil: return - case n.kind - of nkEmpty..pred(nkIdent), succ(nkIdent)..nkNilLit: nil - of nkIdent: - if prefix.len > 0: n.ident = getIdent(processIdent(n.ident.s, prefix, n)) - of nkProcDef, nkConverterDef: - processRoutine(n) - for i in 0..sonsLen(n)-1: processTree(n[i], prefix) - else: - for i in 0..sonsLen(n)-1: processTree(n[i], prefix) - -proc main*(infile, outfile, prefix: string) = - var module = ParseFile(infile) - processTree(module, prefix) - renderModule(module, outfile) - -when isMainModule: - if paramcount() >= 1: - var infile = addFileExt(paramStr(1), "nim") - var outfile = changeFileExt(infile, "new.nim") - if paramCount() >= 2: - outfile = addFileExt(paramStr(2), "new.nim") - var prefix = if paramCount() >= 3: paramStr(3) else: "" - main(infile, outfile, prefix) - else: - echo "usage: expand_importc filename[.nim] outfilename[.nim] [prefix]" diff --git a/rod/extccomp.nim b/rod/extccomp.nim deleted file mode 100755 index a673c5ca0..000000000 --- a/rod/extccomp.nim +++ /dev/null @@ -1,511 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# module for calling the different external C compilers -# some things are read in from the configuration file - -import - lists, ropes, os, strutils, osproc, platform, condsyms, options, msgs, crc - -type - TSystemCC* = enum - ccNone, ccGcc, ccLLVM_Gcc, ccCLang, ccLcc, ccBcc, ccDmc, ccWcc, ccVcc, - ccTcc, ccPcc, ccUcc, ccIcc, ccGpp - TInfoCCProp* = enum # properties of the C compiler: - hasSwitchRange, # CC allows ranges in switch statements (GNU C) - hasComputedGoto, # CC has computed goto (GNU C extension) - hasCpp, # CC is/contains a C++ compiler - hasAssume # CC has __assume (Visual C extension) - TInfoCCProps* = set[TInfoCCProp] - TInfoCC* = tuple[ - name: string, # the short name of the compiler - objExt: string, # the compiler's object file extenstion - optSpeed: string, # the options for optimization for speed - optSize: string, # the options for optimization for size - compilerExe: string, # the compiler's executable - compileTmpl: string, # the compile command template - buildGui: string, # command to build a GUI application - buildDll: string, # command to build a shared library - linkerExe: string, # the linker's executable - linkTmpl: string, # command to link files to produce an exe - includeCmd: string, # command to add an include dir - debug: string, # flags for debug build - pic: string, # command for position independent code - # used on some platforms - asmStmtFrmt: string, # format of ASM statement - props: TInfoCCProps] # properties of the C compiler - -const - CC*: array[succ(low(TSystemCC))..high(TSystemCC), TInfoCC] = [ - (name: "gcc", - objExt: "o", - optSpeed: " -O3 -ffast-math ", - optSize: " -Os -ffast-math ", - compilerExe: "gcc", - compileTmpl: "-c $options $include -o $objfile $file", - buildGui: " -mwindows", - buildDll: " -shared", - linkerExe: "gcc", - linkTmpl: "$options $buildgui $builddll -o $exefile $objfiles", - includeCmd: " -I", - debug: "", - pic: "-fPIC", - asmStmtFrmt: "asm($1);$n", - props: {hasSwitchRange, hasComputedGoto, hasCpp}), - (name: "llvm_gcc", - objExt: "o", - optSpeed: " -O3 -ffast-math ", - optSize: " -Os -ffast-math ", - compilerExe: "llvm-gcc", - compileTmpl: "-c $options $include -o $objfile $file", - buildGui: " -mwindows", - buildDll: " -shared", - linkerExe: "llvm-gcc", - linkTmpl: "$options $buildgui $builddll -o $exefile $objfiles", - includeCmd: " -I", - debug: "", pic: "-fPIC", - asmStmtFrmt: "asm($1);$n", - props: {hasSwitchRange, hasComputedGoto, hasCpp}), - (name: "clang", - objExt: "o", - optSpeed: " -O3 -ffast-math ", - optSize: " -Os -ffast-math ", - compilerExe: "clang", - compileTmpl: "-c $options $include -o $objfile $file", - buildGui: " -mwindows", - buildDll: " -shared", - linkerExe: "clang", - linkTmpl: "$options $buildgui $builddll -o $exefile $objfiles", - includeCmd: " -I", - debug: "", pic: "-fPIC", - asmStmtFrmt: "asm($1);$n", - props: {hasSwitchRange, hasComputedGoto, hasCpp}), - (name: "lcc", - objExt: "obj", - optSpeed: " -O -p6 ", - optSize: " -O -p6 ", - compilerExe: "lcc", - compileTmpl: "$options $include -Fo$objfile $file", - buildGui: " -subsystem windows", - buildDll: " -dll", - linkerExe: "lcclnk", - linkTmpl: "$options $buildgui $builddll -O $exefile $objfiles", - includeCmd: " -I", - debug: " -g5 ", - pic: "", - asmStmtFrmt: "_asm{$n$1$n}$n", - props: {}), - (name: "bcc", - objExt: "obj", - optSpeed: " -O2 -6 ", - optSize: " -O1 -6 ", - compilerExe: "bcc32", - compileTmpl: "-c $options $include -o$objfile $file", - buildGui: " -tW", - buildDll: " -tWD", - linkerExe: "bcc32", - linkTmpl: "$options $buildgui $builddll -e$exefile $objfiles", - includeCmd: " -I", - debug: "", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasCpp}), - (name: "dmc", - objExt: "obj", - optSpeed: " -ff -o -6 ", - optSize: " -ff -o -6 ", - compilerExe: "dmc", - compileTmpl: "-c $options $include -o$objfile $file", - buildGui: " -L/exet:nt/su:windows", - buildDll: " -WD", - linkerExe: "dmc", - linkTmpl: "$options $buildgui $builddll -o$exefile $objfiles", - includeCmd: " -I", - debug: " -g ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasCpp}), - (name: "wcc", - objExt: "obj", - optSpeed: " -ox -on -6 -d0 -fp6 -zW ", - optSize: "", - compilerExe: "wcl386", - compileTmpl: "-c $options $include -fo=$objfile $file", - buildGui: " -bw", - buildDll: " -bd", - linkerExe: "wcl386", - linkTmpl: "$options $buildgui $builddll -fe=$exefile $objfiles ", - includeCmd: " -i=", - debug: " -d2 ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasCpp}), - (name: "vcc", - objExt: "obj", - optSpeed: " /Ogityb2 /G7 /arch:SSE2 ", - optSize: " /O1 /G7 ", - compilerExe: "cl", - compileTmpl: "/c $options $include /Fo$objfile $file", - buildGui: " /link /SUBSYSTEM:WINDOWS ", - buildDll: " /LD", - linkerExe: "cl", - linkTmpl: "$options $builddll /Fe$exefile $objfiles $buildgui", - includeCmd: " /I", - debug: " /GZ /Zi ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasCpp, hasAssume}), - (name: "tcc", - objExt: "o", - optSpeed: "", - optSize: "", - compilerExe: "tcc", - compileTmpl: "-c $options $include -o $objfile $file", - buildGui: "UNAVAILABLE!", - buildDll: " -shared", - linkerExe: "tcc", - linkTmpl: "-o $exefile $options $buildgui $builddll $objfiles", - includeCmd: " -I", - debug: " -g ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasSwitchRange, hasComputedGoto}), - (name: "pcc", # Pelles C - objExt: "obj", - optSpeed: " -Ox ", - optSize: " -Os ", - compilerExe: "cc", - compileTmpl: "-c $options $include -Fo$objfile $file", - buildGui: " -SUBSYSTEM:WINDOWS", - buildDll: " -DLL", - linkerExe: "cc", - linkTmpl: "$options $buildgui $builddll -OUT:$exefile $objfiles", - includeCmd: " -I", - debug: " -Zi ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {}), - (name: "ucc", - objExt: "o", - optSpeed: " -O3 ", - optSize: " -O1 ", - compilerExe: "cc", - compileTmpl: "-c $options $include -o $objfile $file", - buildGui: "", - buildDll: " -shared ", - linkerExe: "cc", - linkTmpl: "-o $exefile $options $buildgui $builddll $objfiles", - includeCmd: " -I", - debug: "", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {}), - (name: "icc", - objExt: "o", - optSpeed: " -O3 ", - optSize: " -Os ", - compilerExe: "icc", - compileTmpl: "-c $options $include -o $objfile $file", - buildGui: " -mwindows", - buildDll: " -mdll", - linkerExe: "icc", - linkTmpl: "$options $buildgui $builddll -o $exefile $objfiles", - includeCmd: " -I", - debug: "", - pic: "-fPIC", - asmStmtFrmt: "asm($1);$n", - props: {hasSwitchRange, hasComputedGoto, hasCpp}), - (name: "gpp", - objExt: "o", - optSpeed: " -O3 -ffast-math ", - optSize: " -Os -ffast-math ", - compilerExe: "g++", - compileTmpl: "-c $options $include -o $objfile $file", - buildGui: " -mwindows", - buildDll: " -mdll", - linkerExe: "g++", - linkTmpl: "$options $buildgui $builddll -o $exefile $objfiles", - includeCmd: " -I", - debug: " -g ", - pic: "-fPIC", - asmStmtFrmt: "asm($1);$n", - props: {hasSwitchRange, hasComputedGoto, hasCpp})] - -var ccompiler*: TSystemCC = ccGcc - -const # the used compiler - hExt* = "h" - -var cExt*: string = "c" # extension of generated C/C++ files - # (can be changed to .cpp later) - -# implementation - -var - toLink, toCompile, externalToCompile: TLinkedList - linkOptions: string = "" - compileOptions: string = "" - ccompilerpath: string = "" - -proc NameToCC*(name: string): TSystemCC = - for i in countup(succ(ccNone), high(TSystemCC)): - if cmpIgnoreStyle(name, CC[i].name) == 0: - return i - result = ccNone - -proc setCC*(ccname: string) = - ccompiler = nameToCC(ccname) - if ccompiler == ccNone: rawMessage(errUnknownCcompiler, ccname) - compileOptions = getConfigVar(CC[ccompiler].name & ".options.always") - linkOptions = getConfigVar(CC[ccompiler].name & ".options.linker") - ccompilerpath = getConfigVar(CC[ccompiler].name & ".path") - for i in countup(low(CC), high(CC)): undefSymbol(CC[i].name) - defineSymbol(CC[ccompiler].name) - -proc addOpt(dest: var string, src: string) = - if len(dest) == 0 or dest[len(dest) - 1 + 0] != ' ': add(dest, " ") - add(dest, src) - -proc addLinkOption*(option: string) = - if find(linkOptions, option, 0) < 0: addOpt(linkOptions, option) - -proc addCompileOption*(option: string) = - if strutils.find(compileOptions, option, 0) < 0: - addOpt(compileOptions, option) - -proc initVars*() = - # we need to define the symbol here, because ``CC`` may have never been set! - for i in countup(low(CC), high(CC)): undefSymbol(CC[i].name) - defineSymbol(CC[ccompiler].name) - if gCmd == cmdCompileToCpp: cExt = ".cpp" - elif gCmd == cmdCompileToOC: cExt = ".m" - addCompileOption(getConfigVar(CC[ccompiler].name & ".options.always")) - addLinkOption(getConfigVar(CC[ccompiler].name & ".options.linker")) - if len(ccompilerPath) == 0: - ccompilerpath = getConfigVar(CC[ccompiler].name & ".path") - -proc completeCFilePath*(cfile: string, createSubDir: bool = true): string = - result = completeGeneratedFilePath(cfile, createSubDir) - -proc toObjFile*(filenameWithoutExt: string): string = - # Object file for compilation - result = changeFileExt(filenameWithoutExt, cc[ccompiler].objExt) - -proc addFileToCompile*(filename: string) = - appendStr(toCompile, filename) - -proc footprint(filename: string): TCrc32 = - result = crcFromFile(filename) >< - platform.OS[targetOS].name >< - platform.CPU[targetCPU].name >< - extccomp.CC[extccomp.ccompiler].name - -proc externalFileChanged(filename: string): bool = - var crcFile = toGeneratedFile(filename, "crc") - var currentCrc = int(footprint(filename)) - var f: TFile - if open(f, crcFile, fmRead): - var line = f.readLine() - if isNil(line) or line.len == 0: line = "0" - close(f) - var oldCrc = parseInt(line) - result = oldCrc != currentCrc - else: - result = true - if result: - if open(f, crcFile, fmWrite): - f.writeln($currentCrc) - close(f) - -proc addExternalFileToCompile*(filename: string) = - if optForceFullMake in gGlobalOptions or externalFileChanged(filename): - appendStr(externalToCompile, filename) - -proc addFileToLink*(filename: string) = - prependStr(toLink, filename) - # BUGFIX: was ``appendStr`` - -proc execExternalProgram*(cmd: string) = - if (optListCmd in gGlobalOptions) or (gVerbosity > 0): MsgWriteln(cmd) - if execCmd(cmd) != 0: rawMessage(errExecutionOfProgramFailed, "") - -proc generateScript(projectFile: string, script: PRope) = - var (dir, name, ext) = splitFile(projectFile) - WriteRope(script, dir / addFileExt("compile_" & name, - platform.os[targetOS].scriptExt)) - -proc getOptSpeed(c: TSystemCC): string = - result = getConfigVar(cc[c].name & ".options.speed") - if result == "": - result = cc[c].optSpeed # use default settings from this file - -proc getDebug(c: TSystemCC): string = - result = getConfigVar(cc[c].name & ".options.debug") - if result == "": - result = cc[c].debug # use default settings from this file - -proc getOptSize(c: TSystemCC): string = - result = getConfigVar(cc[c].name & ".options.size") - if result == "": - result = cc[c].optSize # use default settings from this file - -const - specialFileA = 42 - specialFileB = 42 - -var fileCounter: int - -proc getCompileCFileCmd*(cfilename: string, isExternal: bool = false): string = - var - cfile, objfile, options, includeCmd, compilePattern, key, trunk, exe: string - var c = ccompiler - options = compileOptions - trunk = splitFile(cfilename).name - if optCDebug in gGlobalOptions: - key = trunk & ".debug" - if existsConfigVar(key): addOpt(options, getConfigVar(key)) - else: addOpt(options, getDebug(c)) - if (optOptimizeSpeed in gOptions): - #if ((fileCounter >= specialFileA) and (fileCounter <= specialFileB)) then - key = trunk & ".speed" - if existsConfigVar(key): addOpt(options, getConfigVar(key)) - else: addOpt(options, getOptSpeed(c)) - elif optOptimizeSize in gOptions: - key = trunk & ".size" - if existsConfigVar(key): addOpt(options, getConfigVar(key)) - else: addOpt(options, getOptSize(c)) - key = trunk & ".always" - if existsConfigVar(key): addOpt(options, getConfigVar(key)) - exe = cc[c].compilerExe - key = cc[c].name & ".exe" - if existsConfigVar(key): exe = getConfigVar(key) - if targetOS == osWindows: exe = addFileExt(exe, "exe") - if optGenDynLib in gGlobalOptions and - ospNeedsPIC in platform.OS[targetOS].props: - add(options, ' ' & cc[c].pic) - if targetOS == platform.hostOS: - # compute include paths: - includeCmd = cc[c].includeCmd # this is more complex than needed, but - # a workaround of a FPC bug... - add(includeCmd, quoteIfContainsWhite(libpath)) - compilePattern = JoinPath(ccompilerpath, exe) - else: - includeCmd = "" - compilePattern = cc[c].compilerExe - if targetOS == platform.hostOS: cfile = cfilename - else: cfile = extractFileName(cfilename) - if not isExternal or targetOS != platform.hostOS: objfile = toObjFile(cfile) - else: objfile = completeCFilePath(toObjFile(cfile)) - cfile = quoteIfContainsWhite(AddFileExt(cfile, cExt)) - objfile = quoteIfContainsWhite(objfile) - result = quoteIfContainsWhite(`%`(compilePattern, ["file", cfile, "objfile", - objfile, "options", options, "include", includeCmd, "nimrod", - getPrefixDir(), "lib", libpath])) - add(result, ' ') - addf(result, cc[c].compileTmpl, [ - "file", cfile, "objfile", objfile, - "options", options, "include", includeCmd, - "nimrod", quoteIfContainsWhite(getPrefixDir()), - "lib", quoteIfContainsWhite(libpath)]) - -proc CompileCFile(list: TLinkedList, script: var PRope, cmds: var TStringSeq, - isExternal: bool) = - var it = PStrEntry(list.head) - while it != nil: - inc(fileCounter) # call the C compiler for the .c file: - var compileCmd = getCompileCFileCmd(it.data, isExternal) - if not (optCompileOnly in gGlobalOptions): - add(cmds, compileCmd) - if (optGenScript in gGlobalOptions): - app(script, compileCmd) - app(script, tnl) - it = PStrEntry(it.next) - -proc CallCCompiler*(projectfile: string) = - var - linkCmd, buildgui, builddll: string - if gGlobalOptions * {optCompileOnly, optGenScript} == {optCompileOnly}: - return # speed up that call if only compiling and no script shall be - # generated - fileCounter = 0 - var c = ccompiler - var script: PRope = nil - var cmds: TStringSeq = @[] - CompileCFile(toCompile, script, cmds, false) - CompileCFile(externalToCompile, script, cmds, true) - if optCompileOnly notin gGlobalOptions: - if gNumberOfProcessors == 0: gNumberOfProcessors = countProcessors() - var res = 0 - if gNumberOfProcessors <= 1: - for i in countup(0, high(cmds)): res = max(execCmd(cmds[i]), res) - elif (optListCmd in gGlobalOptions) or (gVerbosity > 0): - res = execProcesses(cmds, {poEchoCmd, poUseShell, poParentStreams}, - gNumberOfProcessors) - else: - res = execProcesses(cmds, {poUseShell, poParentStreams}, - gNumberOfProcessors) - if res != 0: rawMessage(errExecutionOfProgramFailed, []) - if optNoLinking notin gGlobalOptions: - # call the linker: - var linkerExe = getConfigVar(cc[c].name & ".linkerexe") - if len(linkerExe) == 0: linkerExe = cc[c].linkerExe - if targetOS == osWindows: linkerExe = addFileExt(linkerExe, "exe") - if (platform.hostOS != targetOS): linkCmd = quoteIfContainsWhite(linkerExe) - else: linkCmd = quoteIfContainsWhite(JoinPath(ccompilerpath, linkerExe)) - if optGenGuiApp in gGlobalOptions: buildGui = cc[c].buildGui - else: buildGui = "" - var exefile: string - if optGenDynLib in gGlobalOptions: - exefile = `%`(platform.os[targetOS].dllFrmt, [splitFile(projectFile).name]) - buildDll = cc[c].buildDll - else: - exefile = splitFile(projectFile).name & platform.os[targetOS].exeExt - buildDll = "" - if targetOS == platform.hostOS: - exefile = joinPath(splitFile(projectFile).dir, exefile) - exefile = quoteIfContainsWhite(exefile) - var it = PStrEntry(toLink.head) - var objfiles = "" - while it != nil: - add(objfiles, ' ') - if targetOS == platform.hostOS: - add(objfiles, quoteIfContainsWhite(addFileExt(it.data, cc[ccompiler].objExt))) - else: - add(objfiles, quoteIfContainsWhite(addFileExt(it.data, cc[ccompiler].objExt))) - it = PStrEntry(it.next) - linkCmd = quoteIfContainsWhite(linkCmd % ["builddll", builddll, - "buildgui", buildgui, "options", linkOptions, "objfiles", objfiles, - "exefile", exefile, "nimrod", getPrefixDir(), "lib", libpath]) - add(linkCmd, ' ') - addf(linkCmd, cc[c].linkTmpl, ["builddll", builddll, - "buildgui", buildgui, "options", linkOptions, - "objfiles", objfiles, "exefile", exefile, - "nimrod", quoteIfContainsWhite(getPrefixDir()), - "lib", quoteIfContainsWhite(libpath)]) - if not (optCompileOnly in gGlobalOptions): execExternalProgram(linkCmd) - else: - linkCmd = "" - if optGenScript in gGlobalOptions: - app(script, linkCmd) - app(script, tnl) - generateScript(projectFile, script) - -proc genMappingFiles(list: TLinkedList): PRope = - var it = PStrEntry(list.head) - while it != nil: - appf(result, "--file:r\"$1\"$n", [toRope(AddFileExt(it.data, cExt))]) - it = PStrEntry(it.next) - -proc writeMapping*(gSymbolMapping: PRope) = - if optGenMapping notin gGlobalOptions: return - var code = toRope("[C_Files]\n") - app(code, genMappingFiles(toCompile)) - app(code, genMappingFiles(externalToCompile)) - appf(code, "[Symbols]$n$1", [gSymbolMapping]) - WriteRope(code, joinPath(projectPath, "mapping.txt")) diff --git a/rod/filters.nim b/rod/filters.nim deleted file mode 100755 index d1c61749d..000000000 --- a/rod/filters.nim +++ /dev/null @@ -1,78 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements Nimrod's simple filters and helpers for filters. - -import - llstream, os, wordrecg, idents, strutils, ast, astalgo, msgs, options, rnimsyn - -proc filterReplace*(stdin: PLLStream, filename: string, call: PNode): PLLStream -proc filterStrip*(stdin: PLLStream, filename: string, call: PNode): PLLStream - # helpers to retrieve arguments: -proc charArg*(n: PNode, name: string, pos: int, default: Char): Char -proc strArg*(n: PNode, name: string, pos: int, default: string): string -proc boolArg*(n: PNode, name: string, pos: int, default: bool): bool -# implementation - -proc invalidPragma(n: PNode) = - LocalError(n.info, errXNotAllowedHere, renderTree(n, {renderNoComments})) - -proc getArg(n: PNode, name: string, pos: int): PNode = - result = nil - if n.kind in {nkEmpty..nkNilLit}: return - for i in countup(1, sonsLen(n) - 1): - if n.sons[i].kind == nkExprEqExpr: - if n.sons[i].sons[0].kind != nkIdent: invalidPragma(n) - if IdentEq(n.sons[i].sons[0].ident, name): - return n.sons[i].sons[1] - elif i == pos: - return n.sons[i] - -proc charArg(n: PNode, name: string, pos: int, default: Char): Char = - var x = getArg(n, name, pos) - if x == nil: result = default - elif x.kind == nkCharLit: result = chr(int(x.intVal)) - else: invalidPragma(n) - -proc strArg(n: PNode, name: string, pos: int, default: string): string = - var x = getArg(n, name, pos) - if x == nil: result = default - elif x.kind in {nkStrLit..nkTripleStrLit}: result = x.strVal - else: invalidPragma(n) - -proc boolArg(n: PNode, name: string, pos: int, default: bool): bool = - var x = getArg(n, name, pos) - if x == nil: result = default - elif (x.kind == nkIdent) and IdentEq(x.ident, "true"): result = true - elif (x.kind == nkIdent) and IdentEq(x.ident, "false"): result = false - else: invalidPragma(n) - -proc filterStrip(stdin: PLLStream, filename: string, call: PNode): PLLStream = - var pattern = strArg(call, "startswith", 1, "") - var leading = boolArg(call, "leading", 2, true) - var trailing = boolArg(call, "trailing", 3, true) - result = LLStreamOpen("") - while not LLStreamAtEnd(stdin): - var line = LLStreamReadLine(stdin) - var stripped = strip(line, leading, trailing) - if (len(pattern) == 0) or startsWith(stripped, pattern): - LLStreamWriteln(result, stripped) - else: - LLStreamWriteln(result, line) - LLStreamClose(stdin) - -proc filterReplace(stdin: PLLStream, filename: string, call: PNode): PLLStream = - var sub = strArg(call, "sub", 1, "") - if len(sub) == 0: invalidPragma(call) - var by = strArg(call, "by", 2, "") - result = LLStreamOpen("") - while not LLStreamAtEnd(stdin): - var line = LLStreamReadLine(stdin) - LLStreamWriteln(result, replace(line, sub, by)) - LLStreamClose(stdin) diff --git a/rod/hashtest.nim b/rod/hashtest.nim deleted file mode 100755 index c1b3ea0f4..000000000 --- a/rod/hashtest.nim +++ /dev/null @@ -1,5 +0,0 @@ - -import - nhashes - -writeln(stdout, getNormalizedHash(ParamStr(1))) \ No newline at end of file diff --git a/rod/highlite.nim b/rod/highlite.nim deleted file mode 100755 index c2fc95da8..000000000 --- a/rod/highlite.nim +++ /dev/null @@ -1,531 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Source highlighter for programming or markup languages. -# Currently only few languages are supported, other languages may be added. -# The interface supports one language nested in another. - -import - nhashes, options, msgs, strutils, platform, idents, lexbase, wordrecg, scanner - -type - TTokenClass* = enum - gtEof, gtNone, gtWhitespace, gtDecNumber, gtBinNumber, gtHexNumber, - gtOctNumber, gtFloatNumber, gtIdentifier, gtKeyword, gtStringLit, - gtLongStringLit, gtCharLit, gtEscapeSequence, # escape sequence like \xff - gtOperator, gtPunctation, gtComment, gtLongComment, gtRegularExpression, - gtTagStart, gtTagEnd, gtKey, gtValue, gtRawData, gtAssembler, - gtPreprocessor, gtDirective, gtCommand, gtRule, gtHyperlink, gtLabel, - gtReference, gtOther - TGeneralTokenizer* = object of TObject - kind*: TTokenClass - start*, length*: int # private: - buf*: cstring - pos*: int - state*: TTokenClass - - TSourceLanguage* = enum - langNone, langNimrod, langCpp, langCsharp, langC, langJava - -const - sourceLanguageToStr*: array[TSourceLanguage, string] = ["none", "Nimrod", - "C++", "C#", "C", "Java"] - tokenClassToStr*: array[TTokenClass, string] = ["Eof", "None", "Whitespace", - "DecNumber", "BinNumber", "HexNumber", "OctNumber", "FloatNumber", - "Identifier", "Keyword", "StringLit", "LongStringLit", "CharLit", - "EscapeSequence", "Operator", "Punctation", "Comment", "LongComment", - "RegularExpression", "TagStart", "TagEnd", "Key", "Value", "RawData", - "Assembler", "Preprocessor", "Directive", "Command", "Rule", "Hyperlink", - "Label", "Reference", "Other"] - -proc getSourceLanguage*(name: string): TSourceLanguage -proc initGeneralTokenizer*(g: var TGeneralTokenizer, buf: string) -proc deinitGeneralTokenizer*(g: var TGeneralTokenizer) -proc getNextToken*(g: var TGeneralTokenizer, lang: TSourceLanguage) -# implementation - -proc getSourceLanguage(name: string): TSourceLanguage = - for i in countup(succ(low(TSourceLanguage)), high(TSourceLanguage)): - if cmpIgnoreStyle(name, sourceLanguageToStr[i]) == 0: - return i - result = langNone - -proc initGeneralTokenizer(g: var TGeneralTokenizer, buf: string) = - g.buf = cstring(buf) - g.kind = low(TTokenClass) - g.start = 0 - g.length = 0 - g.state = low(TTokenClass) - var pos = 0 # skip initial whitespace: - while g.buf[pos] in {' ', '\x09'..'\x0D'}: inc(pos) - g.pos = pos - -proc deinitGeneralTokenizer(g: var TGeneralTokenizer) = - nil - -proc nimGetKeyword(id: string): TTokenClass = - var i = getIdent(id) - if (i.id >= ord(tokKeywordLow) - ord(tkSymbol)) and - (i.id <= ord(tokKeywordHigh) - ord(tkSymbol)): - result = gtKeyword - else: - result = gtIdentifier - -proc nimNumberPostfix(g: var TGeneralTokenizer, position: int): int = - var pos = position - if g.buf[pos] == '\'': - inc(pos) - case g.buf[pos] - of 'f', 'F': - g.kind = gtFloatNumber - inc(pos) - if g.buf[pos] in {'0'..'9'}: inc(pos) - if g.buf[pos] in {'0'..'9'}: inc(pos) - of 'i', 'I': - inc(pos) - if g.buf[pos] in {'0'..'9'}: inc(pos) - if g.buf[pos] in {'0'..'9'}: inc(pos) - else: - nil - result = pos - -proc nimNumber(g: var TGeneralTokenizer, position: int): int = - const decChars = {'0'..'9', '_'} - var pos = position - g.kind = gtDecNumber - while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] == '.': - g.kind = gtFloatNumber - inc(pos) - while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] in {'e', 'E'}: - g.kind = gtFloatNumber - inc(pos) - if g.buf[pos] in {'+', '-'}: inc(pos) - while g.buf[pos] in decChars: inc(pos) - result = nimNumberPostfix(g, pos) - -proc nimNextToken(g: var TGeneralTokenizer) = - const - hexChars = {'0'..'9', 'A'..'F', 'a'..'f', '_'} - octChars = {'0'..'7', '_'} - binChars = {'0'..'1', '_'} - var pos = g.pos - g.start = g.pos - if g.state == gtStringLit: - g.kind = gtStringLit - while true: - case g.buf[pos] - of '\\': - g.kind = gtEscapeSequence - inc(pos) - case g.buf[pos] - of 'x', 'X': - inc(pos) - if g.buf[pos] in hexChars: inc(pos) - if g.buf[pos] in hexChars: inc(pos) - of '0'..'9': - while g.buf[pos] in {'0'..'9'}: inc(pos) - of '\0': - g.state = gtNone - else: inc(pos) - break - of '\0', '\x0D', '\x0A': - g.state = gtNone - break - of '\"': - inc(pos) - g.state = gtNone - break - else: inc(pos) - else: - case g.buf[pos] - of ' ', '\x09'..'\x0D': - g.kind = gtWhitespace - while g.buf[pos] in {' ', '\x09'..'\x0D'}: inc(pos) - of '#': - g.kind = gtComment - while not (g.buf[pos] in {'\0', '\x0A', '\x0D'}): inc(pos) - of 'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF': - var id = "" - while g.buf[pos] in scanner.SymChars + {'_'}: - add(id, g.buf[pos]) - inc(pos) - if (g.buf[pos] == '\"'): - if (g.buf[pos + 1] == '\"') and (g.buf[pos + 2] == '\"'): - inc(pos, 3) - g.kind = gtLongStringLit - while true: - case g.buf[pos] - of '\0': - break - of '\"': - inc(pos) - if g.buf[pos] == '\"' and g.buf[pos+1] == '\"' and - g.buf[pos+2] != '\"': - inc(pos, 2) - break - else: inc(pos) - else: - g.kind = gtRawData - inc(pos) - while not (g.buf[pos] in {'\0', '\x0A', '\x0D'}): - if g.buf[pos] == '"' and g.buf[pos+1] != '"': break - inc(pos) - if g.buf[pos] == '\"': inc(pos) - else: - g.kind = nimGetKeyword(id) - of '0': - inc(pos) - case g.buf[pos] - of 'b', 'B': - inc(pos) - while g.buf[pos] in binChars: inc(pos) - pos = nimNumberPostfix(g, pos) - of 'x', 'X': - inc(pos) - while g.buf[pos] in hexChars: inc(pos) - pos = nimNumberPostfix(g, pos) - of 'o', 'O': - inc(pos) - while g.buf[pos] in octChars: inc(pos) - pos = nimNumberPostfix(g, pos) - else: pos = nimNumber(g, pos) - of '1'..'9': - pos = nimNumber(g, pos) - of '\'': - inc(pos) - g.kind = gtCharLit - while true: - case g.buf[pos] - of '\0', '\x0D', '\x0A': - break - of '\'': - inc(pos) - break - of '\\': - inc(pos, 2) - else: inc(pos) - of '\"': - inc(pos) - if (g.buf[pos] == '\"') and (g.buf[pos + 1] == '\"'): - inc(pos, 2) - g.kind = gtLongStringLit - while true: - case g.buf[pos] - of '\0': - break - of '\"': - inc(pos) - if g.buf[pos] == '\"' and g.buf[pos+1] == '\"' and - g.buf[pos+2] != '\"': - inc(pos, 2) - break - else: inc(pos) - else: - g.kind = gtStringLit - while true: - case g.buf[pos] - of '\0', '\x0D', '\x0A': - break - of '\"': - inc(pos) - break - of '\\': - g.state = g.kind - break - else: inc(pos) - of '(', ')', '[', ']', '{', '}', '`', ':', ',', ';': - inc(pos) - g.kind = gtPunctation - of '\0': - g.kind = gtEof - else: - if g.buf[pos] in scanner.OpChars: - g.kind = gtOperator - while g.buf[pos] in scanner.OpChars: inc(pos) - else: - inc(pos) - g.kind = gtNone - g.length = pos - g.pos - if (g.kind != gtEof) and (g.length <= 0): - InternalError("nimNextToken: " & $(g.buf)) - g.pos = pos - -proc generalNumber(g: var TGeneralTokenizer, position: int): int = - const decChars = {'0'..'9'} - var pos = position - g.kind = gtDecNumber - while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] == '.': - g.kind = gtFloatNumber - inc(pos) - while g.buf[pos] in decChars: inc(pos) - if g.buf[pos] in {'e', 'E'}: - g.kind = gtFloatNumber - inc(pos) - if g.buf[pos] in {'+', '-'}: inc(pos) - while g.buf[pos] in decChars: inc(pos) - result = pos - -proc generalStrLit(g: var TGeneralTokenizer, position: int): int = - const - decChars = {'0'..'9'} - hexChars = {'0'..'9', 'A'..'F', 'a'..'f'} - var pos = position - g.kind = gtStringLit - var c = g.buf[pos] - inc(pos) # skip " or ' - while true: - case g.buf[pos] - of '\0': - break - of '\\': - inc(pos) - case g.buf[pos] - of '\0': - break - of '0'..'9': - while g.buf[pos] in decChars: inc(pos) - of 'x', 'X': - inc(pos) - if g.buf[pos] in hexChars: inc(pos) - if g.buf[pos] in hexChars: inc(pos) - else: inc(pos, 2) - else: - if g.buf[pos] == c: - inc(pos) - break - else: - inc(pos) - result = pos - -proc isKeyword(x: openarray[string], y: string): int = - var a = 0 - var b = len(x) - 1 - while a <= b: - var mid = (a + b) div 2 - var c = cmp(x[mid], y) - if c < 0: - a = mid + 1 - elif c > 0: - b = mid - 1 - else: - return mid - result = - 1 - -proc isKeywordIgnoreCase(x: openarray[string], y: string): int = - var a = 0 - var b = len(x) - 1 - while a <= b: - var mid = (a + b) div 2 - var c = cmpIgnoreCase(x[mid], y) - if c < 0: - a = mid + 1 - elif c > 0: - b = mid - 1 - else: - return mid - result = - 1 - -type - TTokenizerFlag = enum - hasPreprocessor, hasNestedComments - TTokenizerFlags = set[TTokenizerFlag] - -proc clikeNextToken(g: var TGeneralTokenizer, keywords: openarray[string], - flags: TTokenizerFlags) = - const - hexChars = {'0'..'9', 'A'..'F', 'a'..'f'} - octChars = {'0'..'7'} - binChars = {'0'..'1'} - symChars = {'A'..'Z', 'a'..'z', '0'..'9', '_', '\x80'..'\xFF'} - var pos = g.pos - g.start = g.pos - if g.state == gtStringLit: - g.kind = gtStringLit - while true: - case g.buf[pos] - of '\\': - g.kind = gtEscapeSequence - inc(pos) - case g.buf[pos] - of 'x', 'X': - inc(pos) - if g.buf[pos] in hexChars: inc(pos) - if g.buf[pos] in hexChars: inc(pos) - of '0'..'9': - while g.buf[pos] in {'0'..'9'}: inc(pos) - of '\0': - g.state = gtNone - else: inc(pos) - break - of '\0', '\x0D', '\x0A': - g.state = gtNone - break - of '\"': - inc(pos) - g.state = gtNone - break - else: inc(pos) - else: - case g.buf[pos] - of ' ', '\x09'..'\x0D': - g.kind = gtWhitespace - while g.buf[pos] in {' ', '\x09'..'\x0D'}: inc(pos) - of '/': - inc(pos) - if g.buf[pos] == '/': - g.kind = gtComment - while not (g.buf[pos] in {'\0', '\x0A', '\x0D'}): inc(pos) - elif g.buf[pos] == '*': - g.kind = gtLongComment - var nested = 0 - inc(pos) - while true: - case g.buf[pos] - of '*': - inc(pos) - if g.buf[pos] == '/': - inc(pos) - if nested == 0: break - of '/': - inc(pos) - if g.buf[pos] == '*': - inc(pos) - if hasNestedComments in flags: inc(nested) - of '\0': - break - else: inc(pos) - of '#': - inc(pos) - if hasPreprocessor in flags: - g.kind = gtPreprocessor - while g.buf[pos] in {' ', Tabulator}: inc(pos) - while g.buf[pos] in symChars: inc(pos) - else: - g.kind = gtOperator - of 'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF': - var id = "" - while g.buf[pos] in SymChars: - add(id, g.buf[pos]) - inc(pos) - if isKeyword(keywords, id) >= 0: g.kind = gtKeyword - else: g.kind = gtIdentifier - of '0': - inc(pos) - case g.buf[pos] - of 'b', 'B': - inc(pos) - while g.buf[pos] in binChars: inc(pos) - if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of 'x', 'X': - inc(pos) - while g.buf[pos] in hexChars: inc(pos) - if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of '0'..'7': - inc(pos) - while g.buf[pos] in octChars: inc(pos) - if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - else: - pos = generalNumber(g, pos) - if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of '1'..'9': - pos = generalNumber(g, pos) - if g.buf[pos] in {'A'..'Z', 'a'..'z'}: inc(pos) - of '\'': - pos = generalStrLit(g, pos) - g.kind = gtCharLit - of '\"': - inc(pos) - g.kind = gtStringLit - while true: - case g.buf[pos] - of '\0': - break - of '\"': - inc(pos) - break - of '\\': - g.state = g.kind - break - else: inc(pos) - of '(', ')', '[', ']', '{', '}', ':', ',', ';', '.': - inc(pos) - g.kind = gtPunctation - of '\0': - g.kind = gtEof - else: - if g.buf[pos] in scanner.OpChars: - g.kind = gtOperator - while g.buf[pos] in scanner.OpChars: inc(pos) - else: - inc(pos) - g.kind = gtNone - g.length = pos - g.pos - if (g.kind != gtEof) and (g.length <= 0): InternalError("clikeNextToken") - g.pos = pos - -proc cNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..36, string] = ["_Bool", "_Complex", "_Imaginary", "auto", - "break", "case", "char", "const", "continue", "default", "do", "double", - "else", "enum", "extern", "float", "for", "goto", "if", "inline", "int", - "long", "register", "restrict", "return", "short", "signed", "sizeof", - "static", "struct", "switch", "typedef", "union", "unsigned", "void", - "volatile", "while"] - clikeNextToken(g, keywords, {hasPreprocessor}) - -proc cppNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..47, string] = ["asm", "auto", "break", "case", "catch", - "char", "class", "const", "continue", "default", "delete", "do", "double", - "else", "enum", "extern", "float", "for", "friend", "goto", "if", - "inline", "int", "long", "new", "operator", "private", "protected", - "public", "register", "return", "short", "signed", "sizeof", "static", - "struct", "switch", "template", "this", "throw", "try", "typedef", - "union", "unsigned", "virtual", "void", "volatile", "while"] - clikeNextToken(g, keywords, {hasPreprocessor}) - -proc csharpNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..76, string] = ["abstract", "as", "base", "bool", "break", - "byte", "case", "catch", "char", "checked", "class", "const", "continue", - "decimal", "default", "delegate", "do", "double", "else", "enum", "event", - "explicit", "extern", "false", "finally", "fixed", "float", "for", - "foreach", "goto", "if", "implicit", "in", "int", "interface", "internal", - "is", "lock", "long", "namespace", "new", "null", "object", "operator", - "out", "override", "params", "private", "protected", "public", "readonly", - "ref", "return", "sbyte", "sealed", "short", "sizeof", "stackalloc", - "static", "string", "struct", "switch", "this", "throw", "true", "try", - "typeof", "uint", "ulong", "unchecked", "unsafe", "ushort", "using", - "virtual", "void", "volatile", "while"] - clikeNextToken(g, keywords, {hasPreprocessor}) - -proc javaNextToken(g: var TGeneralTokenizer) = - const - keywords: array[0..52, string] = ["abstract", "assert", "boolean", "break", - "byte", "case", "catch", "char", "class", "const", "continue", "default", - "do", "double", "else", "enum", "extends", "false", "final", "finally", - "float", "for", "goto", "if", "implements", "import", "instanceof", "int", - "interface", "long", "native", "new", "null", "package", "private", - "protected", "public", "return", "short", "static", "strictfp", "super", - "switch", "synchronized", "this", "throw", "throws", "transient", "true", - "try", "void", "volatile", "while"] - clikeNextToken(g, keywords, {}) - -proc getNextToken(g: var TGeneralTokenizer, lang: TSourceLanguage) = - case lang - of langNimrod: nimNextToken(g) - of langCpp: cppNextToken(g) - of langCsharp: csharpNextToken(g) - of langC: cNextToken(g) - of langJava: javaNextToken(g) - else: InternalError("getNextToken") - diff --git a/rod/idents.nim b/rod/idents.nim deleted file mode 100755 index 13be258ba..000000000 --- a/rod/idents.nim +++ /dev/null @@ -1,132 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Identifier handling -# An identifier is a shared non-modifiable string that can be compared by its -# id. This module is essential for the compiler's performance. - -import - nhashes, strutils - -type - TIdObj* = object of TObject - id*: int # unique id; use this for comparisons and not the pointers - - PIdObj* = ref TIdObj - PIdent* = ref TIdent - TIdent*{.acyclic.} = object of TIdObj - s*: string - next*: PIdent # for hash-table chaining - h*: THash # hash value of s - - -proc getIdent*(identifier: string): PIdent -proc getIdent*(identifier: string, h: THash): PIdent -proc getIdent*(identifier: cstring, length: int, h: THash): PIdent - # special version for the scanner; the scanner's buffering scheme makes - # this horribly efficient. Most of the time no character copying is needed! -proc IdentEq*(id: PIdent, name: string): bool -# implementation - -proc IdentEq(id: PIdent, name: string): bool = - result = id.id == getIdent(name).id - -var buckets: array[0..4096 * 2 - 1, PIdent] - -proc cmpIgnoreStyle(a, b: cstring, blen: int): int = - var - aa, bb: char - i, j: int - i = 0 - j = 0 - result = 1 - while j < blen: - while a[i] == '_': inc(i) - while b[j] == '_': inc(j) - # tolower inlined: - aa = a[i] - bb = b[j] - if (aa >= 'A') and (aa <= 'Z'): aa = chr(ord(aa) + (ord('a') - ord('A'))) - if (bb >= 'A') and (bb <= 'Z'): bb = chr(ord(bb) + (ord('a') - ord('A'))) - result = ord(aa) - ord(bb) - if (result != 0) or (aa == '\0'): break - inc(i) - inc(j) - if result == 0: - if a[i] != '\0': result = 1 - -proc cmpExact(a, b: cstring, blen: int): int = - var - aa, bb: char - i, j: int - i = 0 - j = 0 - result = 1 - while j < blen: - aa = a[i] - bb = b[j] - result = ord(aa) - ord(bb) - if (result != 0) or (aa == '\0'): break - inc(i) - inc(j) - if result == 0: - if a[i] != '\0': result = 1 - -proc getIdent(identifier: string): PIdent = - result = getIdent(cstring(identifier), len(identifier), - getNormalizedHash(identifier)) - -proc getIdent(identifier: string, h: THash): PIdent = - result = getIdent(cstring(identifier), len(identifier), h) - -var wordCounter: int = 1 - -proc getIdent(identifier: cstring, length: int, h: THash): PIdent = - var - idx, id: int - last: PIdent - idx = h and high(buckets) - result = buckets[idx] - last = nil - id = 0 - while result != nil: - if cmpExact(cstring(result.s), identifier, length) == 0: - if last != nil: - # make access to last looked up identifier faster: - last.next = result.next - result.next = buckets[idx] - buckets[idx] = result - return - elif cmpIgnoreStyle(cstring(result.s), identifier, length) == 0: - #if (id <> 0) and (id <> result.id) then begin - # result := buckets[idx]; - # writeln('current id ', id); - # for i := 0 to len-1 do write(identifier[i]); - # writeln; - # while result <> nil do begin - # writeln(result.s, ' ', result.id); - # result := result.next - # end - # end; - assert((id == 0) or (id == result.id)) - id = result.id - last = result - result = result.next - new(result) - result.h = h - result.s = newString(length) - for i in countup(0, length + 0 - 1): result.s[i] = identifier[i - 0] - result.next = buckets[idx] - buckets[idx] = result - if id == 0: - inc(wordCounter) - result.id = - wordCounter - else: - result.id = id # writeln('new word ', result.s); - diff --git a/rod/importer.nim b/rod/importer.nim deleted file mode 100755 index 06eebcb4e..000000000 --- a/rod/importer.nim +++ /dev/null @@ -1,122 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the symbol importing mechanism. - -import - strutils, os, ast, astalgo, msgs, options, idents, rodread, lookups, semdata, - passes - -proc evalImport*(c: PContext, n: PNode): PNode -proc evalFrom*(c: PContext, n: PNode): PNode -proc importAllSymbols*(c: PContext, fromMod: PSym) -proc getModuleFile*(n: PNode): string -# implementation - -proc findModule(info: TLineInfo, modulename: string): string = - # returns path to module - result = options.FindFile(AddFileExt(modulename, nimExt)) - if result == "": Fatal(info, errCannotOpenFile, modulename) - -proc getModuleFile(n: PNode): string = - case n.kind - of nkStrLit, nkRStrLit, nkTripleStrLit: - result = findModule(n.info, UnixToNativePath(n.strVal)) - of nkIdent: - result = findModule(n.info, n.ident.s) - of nkSym: - result = findModule(n.info, n.sym.name.s) - else: - internalError(n.info, "getModuleFile()") - result = "" - -proc rawImportSymbol(c: PContext, s: PSym) = - # This does not handle stubs, because otherwise loading on demand would be - # pointless in practice. So importing stubs is fine here! - var copy = s # do not copy symbols when importing! - # check if we have already a symbol of the same name: - var check = StrTableGet(c.tab.stack[importTablePos], s.name) - if (check != nil) and (check.id != copy.id): - if not (s.kind in OverloadableSyms): - # s and check need to be qualified: - IntSetIncl(c.AmbiguousSymbols, copy.id) - IntSetIncl(c.AmbiguousSymbols, check.id) - StrTableAdd(c.tab.stack[importTablePos], copy) - if s.kind == skType: - var etyp = s.typ - if etyp.kind in {tyBool, tyEnum}: - for j in countup(0, sonsLen(etyp.n) - 1): - var e = etyp.n.sons[j].sym - if (e.Kind != skEnumField): - InternalError(s.info, "rawImportSymbol") - # BUGFIX: because of aliases for enums the symbol may already - # have been put into the symbol table - # BUGFIX: but only iff they are the same symbols! - var it: TIdentIter - check = InitIdentIter(it, c.tab.stack[importTablePos], e.name) - while check != nil: - if check.id == e.id: - e = nil - break - check = NextIdentIter(it, c.tab.stack[importTablePos]) - if e != nil: - rawImportSymbol(c, e) - elif s.kind == skConverter: - addConverter(c, s) # rodgen assures that converters are no stubs - -proc importSymbol(c: PContext, ident: PNode, fromMod: PSym) = - if (ident.kind != nkIdent): InternalError(ident.info, "importSymbol") - var s = StrTableGet(fromMod.tab, ident.ident) - if s == nil: GlobalError(ident.info, errUndeclaredIdentifier, ident.ident.s) - if s.kind == skStub: loadStub(s) - if not (s.Kind in ExportableSymKinds): - InternalError(ident.info, "importSymbol: 2") - # for an enumeration we have to add all identifiers - case s.Kind - of skProc, skMethod, skIterator, skMacro, skTemplate, skConverter: - # for a overloadable syms add all overloaded routines - var it: TIdentIter - var e = InitIdentIter(it, fromMod.tab, s.name) - while e != nil: - if (e.name.id != s.Name.id): InternalError(ident.info, "importSymbol: 3") - rawImportSymbol(c, e) - e = NextIdentIter(it, fromMod.tab) - else: rawImportSymbol(c, s) - -proc importAllSymbols(c: PContext, fromMod: PSym) = - var i: TTabIter - var s = InitTabIter(i, fromMod.tab) - while s != nil: - if s.kind != skModule: - if s.kind != skEnumField: - if not (s.Kind in ExportableSymKinds): - InternalError(s.info, "importAllSymbols: " & $s.kind) - rawImportSymbol(c, s) # this is correct! - s = NextIter(i, fromMod.tab) - -proc evalImport(c: PContext, n: PNode): PNode = - result = n - for i in countup(0, sonsLen(n) - 1): - var f = getModuleFile(n.sons[i]) - var m = gImportModule(f) - if sfDeprecated in m.flags: - Message(n.sons[i].info, warnDeprecated, m.name.s) - # ``addDecl`` needs to be done before ``importAllSymbols``! - addDecl(c, m) # add symbol to symbol table of module - importAllSymbols(c, m) - -proc evalFrom(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 2) - var f = getModuleFile(n.sons[0]) - var m = gImportModule(f) - n.sons[0] = newSymNode(m) - addDecl(c, m) # add symbol to symbol table of module - for i in countup(1, sonsLen(n) - 1): importSymbol(c, n.sons[i], m) - diff --git a/rod/lexbase.nim b/rod/lexbase.nim deleted file mode 100755 index f37fcc0a4..000000000 --- a/rod/lexbase.nim +++ /dev/null @@ -1,170 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Base Object of a lexer with efficient buffer handling. In fact -# I believe that this is the most efficient method of buffer -# handling that exists! Only at line endings checks are necessary -# if the buffer needs refilling. - -import - llstream, strutils - -const - Lrz* = ' ' - Apo* = '\'' - Tabulator* = '\x09' - ESC* = '\x1B' - CR* = '\x0D' - FF* = '\x0C' - LF* = '\x0A' - BEL* = '\x07' - BACKSPACE* = '\x08' - VT* = '\x0B' - -const - EndOfFile* = '\0' # end of file marker - # A little picture makes everything clear :-) - # buf: - # "Example Text\n ha!" bufLen = 17 - # ^pos = 0 ^ sentinel = 12 - # - NewLines* = {CR, LF} - -type - TBaseLexer* = object of TObject - bufpos*: int - buf*: cstring - bufLen*: int # length of buffer in characters - stream*: PLLStream # we read from this stream - LineNumber*: int # the current line number - # private data: - sentinel*: int - lineStart*: int # index of last line start in buffer - - -proc openBaseLexer*(L: var TBaseLexer, inputstream: PLLStream, - bufLen: int = 8192) - # 8K is a reasonable buffer size -proc closeBaseLexer*(L: var TBaseLexer) -proc getCurrentLine*(L: TBaseLexer, marker: bool = true): string -proc getColNumber*(L: TBaseLexer, pos: int): int -proc HandleCR*(L: var TBaseLexer, pos: int): int - # Call this if you scanned over CR in the buffer; it returns the - # position to continue the scanning from. `pos` must be the position - # of the CR. -proc HandleLF*(L: var TBaseLexer, pos: int): int - # Call this if you scanned over LF in the buffer; it returns the the - # position to continue the scanning from. `pos` must be the position - # of the LF. -# implementation - -const - chrSize = sizeof(char) - -proc closeBaseLexer(L: var TBaseLexer) = - dealloc(L.buf) - LLStreamClose(L.stream) - -proc FillBuffer(L: var TBaseLexer) = - var - charsRead, toCopy, s: int # all are in characters, - # not bytes (in case this - # is not the same) - oldBufLen: int - # we know here that pos == L.sentinel, but not if this proc - # is called the first time by initBaseLexer() - assert(L.sentinel < L.bufLen) - toCopy = L.BufLen - L.sentinel - 1 - assert(toCopy >= 0) - if toCopy > 0: - MoveMem(L.buf, addr(L.buf[L.sentinel + 1]), toCopy * chrSize) - # "moveMem" handles overlapping regions - charsRead = LLStreamRead(L.stream, addr(L.buf[toCopy]), - (L.sentinel + 1) * chrSize) div chrSize - s = toCopy + charsRead - if charsRead < L.sentinel + 1: - L.buf[s] = EndOfFile # set end marker - L.sentinel = s - else: - # compute sentinel: - dec(s) # BUGFIX (valgrind) - while true: - assert(s < L.bufLen) - while (s >= 0) and not (L.buf[s] in NewLines): Dec(s) - if s >= 0: - # we found an appropriate character for a sentinel: - L.sentinel = s - break - else: - # rather than to give up here because the line is too long, - # double the buffer's size and try again: - oldBufLen = L.BufLen - L.bufLen = L.BufLen * 2 - L.buf = cast[cstring](realloc(L.buf, L.bufLen * chrSize)) - assert(L.bufLen - oldBuflen == oldBufLen) - charsRead = LLStreamRead(L.stream, addr(L.buf[oldBufLen]), - oldBufLen * chrSize) div chrSize - if charsRead < oldBufLen: - L.buf[oldBufLen + charsRead] = EndOfFile - L.sentinel = oldBufLen + charsRead - break - s = L.bufLen - 1 - -proc fillBaseLexer(L: var TBaseLexer, pos: int): int = - assert(pos <= L.sentinel) - if pos < L.sentinel: - result = pos + 1 # nothing to do - else: - fillBuffer(L) - L.bufpos = 0 # XXX: is this really correct? - result = 0 - L.lineStart = result - -proc HandleCR(L: var TBaseLexer, pos: int): int = - assert(L.buf[pos] == CR) - inc(L.linenumber) - result = fillBaseLexer(L, pos) - if L.buf[result] == LF: - result = fillBaseLexer(L, result) - -proc HandleLF(L: var TBaseLexer, pos: int): int = - assert(L.buf[pos] == LF) - inc(L.linenumber) - result = fillBaseLexer(L, pos) #L.lastNL := result-1; // BUGFIX: was: result; - -proc skip_UTF_8_BOM(L: var TBaseLexer) = - if (L.buf[0] == '\xEF') and (L.buf[1] == '\xBB') and (L.buf[2] == '\xBF'): - inc(L.bufpos, 3) - inc(L.lineStart, 3) - -proc openBaseLexer(L: var TBaseLexer, inputstream: PLLStream, bufLen = 8192) = - assert(bufLen > 0) - L.bufpos = 0 - L.bufLen = bufLen - L.buf = cast[cstring](alloc(bufLen * chrSize)) - L.sentinel = bufLen - 1 - L.lineStart = 0 - L.linenumber = 1 # lines start at 1 - L.stream = inputstream - fillBuffer(L) - skip_UTF_8_BOM(L) - -proc getColNumber(L: TBaseLexer, pos: int): int = - result = abs(pos - L.lineStart) - -proc getCurrentLine(L: TBaseLexer, marker: bool = true): string = - result = "" - var i = L.lineStart - while not (L.buf[i] in {CR, LF, EndOfFile}): - add(result, L.buf[i]) - inc(i) - result.add("\n") - if marker: - result.add(RepeatChar(getColNumber(L, L.bufpos)) & '^' & "\n") - diff --git a/rod/lists.nim b/rod/lists.nim deleted file mode 100755 index b4610ab2f..000000000 --- a/rod/lists.nim +++ /dev/null @@ -1,108 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements a generic doubled linked list. - -type - PListEntry* = ref TListEntry - TListEntry* = object of TObject - prev*, next*: PListEntry - - TStrEntry* = object of TListEntry - data*: string - - PStrEntry* = ref TStrEntry - TLinkedList* = object # for the "find" operation: - head*, tail*: PListEntry - Counter*: int - - TCompareProc* = proc (entry: PListEntry, closure: Pointer): bool - -proc InitLinkedList*(list: var TLinkedList) -proc Append*(list: var TLinkedList, entry: PListEntry) -proc Prepend*(list: var TLinkedList, entry: PListEntry) -proc Remove*(list: var TLinkedList, entry: PListEntry) -proc InsertBefore*(list: var TLinkedList, pos, entry: PListEntry) -proc Find*(list: TLinkedList, fn: TCompareProc, closure: Pointer): PListEntry -proc AppendStr*(list: var TLinkedList, data: string) -proc IncludeStr*(list: var TLinkedList, data: string): bool -proc PrependStr*(list: var TLinkedList, data: string) -# implementation - -proc InitLinkedList(list: var TLinkedList) = - list.Counter = 0 - list.head = nil - list.tail = nil - -proc Append(list: var TLinkedList, entry: PListEntry) = - Inc(list.counter) - entry.next = nil - entry.prev = list.tail - if list.tail != nil: - assert(list.tail.next == nil) - list.tail.next = entry - list.tail = entry - if list.head == nil: list.head = entry - -proc newStrEntry(data: string): PStrEntry = - new(result) - result.data = data - -proc AppendStr(list: var TLinkedList, data: string) = - append(list, newStrEntry(data)) - -proc PrependStr(list: var TLinkedList, data: string) = - prepend(list, newStrEntry(data)) - -proc Contains*(list: TLinkedList, data: string): bool = - var it = list.head - while it != nil: - if PStrEntry(it).data == data: - return true - it = it.next - -proc IncludeStr(list: var TLinkedList, data: string): bool = - if Contains(list, data): return true - AppendStr(list, data) # else: add to list - -proc InsertBefore(list: var TLinkedList, pos, entry: PListEntry) = - assert(pos != nil) - if pos == list.head: - prepend(list, entry) - else: - Inc(list.counter) - entry.next = pos - entry.prev = pos.prev - if pos.prev != nil: pos.prev.next = entry - pos.prev = entry - -proc Prepend(list: var TLinkedList, entry: PListEntry) = - Inc(list.counter) - entry.prev = nil - entry.next = list.head - if list.head != nil: - assert(list.head.prev == nil) - list.head.prev = entry - list.head = entry - if list.tail == nil: list.tail = entry - -proc Remove(list: var TLinkedList, entry: PListEntry) = - Dec(list.counter) - if entry == list.tail: - list.tail = entry.prev - if entry == list.head: - list.head = entry.next - if entry.next != nil: entry.next.prev = entry.prev - if entry.prev != nil: entry.prev.next = entry.next - -proc Find(list: TLinkedList, fn: TCompareProc, closure: Pointer): PListEntry = - result = list.head - while result != nil: - if fn(result, closure): return - result = result.next diff --git a/rod/llstream.nim b/rod/llstream.nim deleted file mode 100755 index 8dfa1e78e..000000000 --- a/rod/llstream.nim +++ /dev/null @@ -1,229 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Low-level streams for high performance. - -import - strutils - -when not defined(windows) and defined(useGnuReadline): - import rdstdin - -type - TLLStreamKind* = enum # stream encapsulates stdin - llsNone, # null stream: reading and writing has no effect - llsString, # stream encapsulates a string - llsFile, # stream encapsulates a file - llsStdIn - TLLStream* = object of TObject - kind*: TLLStreamKind # accessible for low-level access (lexbase uses this) - f*: tfile - s*: string - rd*, wr*: int # for string streams - lineOffset*: int # for fake stdin line numbers - - PLLStream* = ref TLLStream - -proc LLStreamOpen*(data: string): PLLStream -proc LLStreamOpen*(f: var tfile): PLLStream -proc LLStreamOpen*(filename: string, mode: TFileMode): PLLStream -proc LLStreamOpen*(): PLLStream -proc LLStreamOpenStdIn*(): PLLStream -proc LLStreamClose*(s: PLLStream) -proc LLStreamRead*(s: PLLStream, buf: pointer, bufLen: int): int -proc LLStreamReadLine*(s: PLLStream): string -proc LLStreamReadAll*(s: PLLStream): string -proc LLStreamWrite*(s: PLLStream, data: string) -proc LLStreamWrite*(s: PLLStream, data: Char) -proc LLStreamWrite*(s: PLLStream, buf: pointer, buflen: int) -proc LLStreamWriteln*(s: PLLStream, data: string) -proc LLStreamAtEnd*(s: PLLStream): bool -# implementation - -proc LLStreamOpen(data: string): PLLStream = - new(result) - result.s = data - result.kind = llsString - -proc LLStreamOpen(f: var tfile): PLLStream = - new(result) - result.f = f - result.kind = llsFile - -proc LLStreamOpen(filename: string, mode: TFileMode): PLLStream = - new(result) - result.kind = llsFile - if not open(result.f, filename, mode): result = nil - -proc LLStreamOpen(): PLLStream = - new(result) - result.kind = llsNone - -proc LLStreamOpenStdIn(): PLLStream = - new(result) - result.kind = llsStdIn - result.s = "" - result.lineOffset = -1 - -proc LLStreamClose(s: PLLStream) = - case s.kind - of llsNone, llsString, llsStdIn: - nil - of llsFile: - close(s.f) - -when not defined(ReadLineFromStdin): - # fallback implementation: - proc ReadLineFromStdin(prompt: string): string = - stdout.write(prompt) - result = readLine(stdin) - -proc endsWith*(x: string, s: set[char]): bool = - var i = x.len-1 - while i >= 0 and x[i] == ' ': dec(i) - if i >= 0 and x[i] in s: - result = true - -const - LineContinuationOprs = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', - '|', '%', '&', '$', '@', '~', ','} - AdditionalLineContinuationOprs = {'#', ':', '='} - -proc endsWithOpr*(x: string): bool = - # also used be the standard template filter: - result = x.endsWith(LineContinuationOprs) - -proc continueLine(line: string, inTripleString: bool): bool {.inline.} = - result = inTriplestring or - line[0] == ' ' or - line.endsWith(LineContinuationOprs+AdditionalLineContinuationOprs) - -proc LLreadFromStdin(s: PLLStream, buf: pointer, bufLen: int): int = - var - line: string - L: int - inTripleString = false - s.s = "" - s.rd = 0 - while true: - line = ReadLineFromStdin(if s.s.len == 0: ">>> " else: "... ") - L = len(line) - add(s.s, line) - add(s.s, "\n") - if line.contains("\"\"\""): - inTripleString = not inTripleString - if not continueLine(line, inTripleString): break - inc(s.lineOffset) - result = min(bufLen, len(s.s) - s.rd) - if result > 0: - copyMem(buf, addr(s.s[s.rd]), result) - inc(s.rd, result) - -proc LLStreamRead(s: PLLStream, buf: pointer, bufLen: int): int = - case s.kind - of llsNone: - result = 0 - of llsString: - result = min(bufLen, len(s.s) - s.rd) - if result > 0: - copyMem(buf, addr(s.s[0 + s.rd]), result) - inc(s.rd, result) - of llsFile: - result = readBuffer(s.f, buf, bufLen) - of llsStdIn: - result = LLreadFromStdin(s, buf, bufLen) - -proc LLStreamReadLine(s: PLLStream): string = - case s.kind - of llsNone: - result = "" - of llsString: - result = "" - while s.rd < len(s.s): - case s.s[s.rd + 0] - of '\x0D': - inc(s.rd) - if s.s[s.rd + 0] == '\x0A': inc(s.rd) - break - of '\x0A': - inc(s.rd) - break - else: - add(result, s.s[s.rd + 0]) - inc(s.rd) - of llsFile: - result = readLine(s.f) - of llsStdIn: - result = readLine(stdin) - -proc LLStreamAtEnd(s: PLLStream): bool = - case s.kind - of llsNone: result = true - of llsString: result = s.rd >= len(s.s) - of llsFile: result = endOfFile(s.f) - of llsStdIn: result = false - -proc LLStreamWrite(s: PLLStream, data: string) = - case s.kind - of llsNone, llsStdIn: - nil - of llsString: - add(s.s, data) - inc(s.wr, len(data)) - of llsFile: - write(s.f, data) - -proc LLStreamWriteln(s: PLLStream, data: string) = - LLStreamWrite(s, data) - LLStreamWrite(s, "\n") - -proc LLStreamWrite(s: PLLStream, data: Char) = - var c: char - case s.kind - of llsNone, llsStdIn: - nil - of llsString: - add(s.s, data) - inc(s.wr) - of llsFile: - c = data - discard writeBuffer(s.f, addr(c), sizeof(c)) - -proc LLStreamWrite(s: PLLStream, buf: pointer, buflen: int) = - case s.kind - of llsNone, llsStdIn: - nil - of llsString: - if bufLen > 0: - setlen(s.s, len(s.s) + bufLen) - copyMem(addr(s.s[0 + s.wr]), buf, bufLen) - inc(s.wr, bufLen) - of llsFile: - discard writeBuffer(s.f, buf, bufLen) - -proc LLStreamReadAll(s: PLLStream): string = - const - bufSize = 2048 - var bytes, i: int - case s.kind - of llsNone, llsStdIn: - result = "" - of llsString: - if s.rd == 0: result = s.s - else: result = copy(s.s, s.rd + 0) - s.rd = len(s.s) - of llsFile: - result = newString(bufSize) - bytes = readBuffer(s.f, addr(result[0]), bufSize) - i = bytes - while bytes == bufSize: - setlen(result, i + bufSize) - bytes = readBuffer(s.f, addr(result[i + 0]), bufSize) - inc(i, bytes) - setlen(result, i) diff --git a/rod/llvmgen.nim b/rod/llvmgen.nim deleted file mode 100755 index f8acb624a..000000000 --- a/rod/llvmgen.nim +++ /dev/null @@ -1,890 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## LLVM code generator. - -import - ast, astalgo, strutils, nhashes, trees, platform, magicsys, extccomp, options, - nversion, nimsets, msgs, crc, bitsets, idents, lists, types, ccgutils, os, - times, ropes, math, passes, rodread, wordrecg, rnimsyn, treetab, cgmeth, - llvm - -proc llvmGenPass*(): TPass - - -type - TLabel = PRope # for the C generator a label is just a rope - TCFileSection = enum # the sections a generated C file consists of - cfsHeaders, # section for C include file headers - cfsForwardTypes, # section for C forward typedefs - cfsTypes, # section for C typedefs - cfsSeqTypes, # section for sequence types only - # this is needed for strange type generation - # reasons - cfsFieldInfo, # section for field information - cfsTypeInfo, # section for type information - cfsProcHeaders, # section for C procs prototypes - cfsData, # section for C constant data - cfsVars, # section for C variable declarations - cfsProcs, # section for C procs that are not inline - cfsTypeInit1, # section 1 for declarations of type information - cfsTypeInit2, # section 2 for init of type information - cfsTypeInit3, # section 3 for init of type information - cfsDebugInit, # section for init of debug information - cfsDynLibInit, # section for init of dynamic library binding - cfsDynLibDeinit # section for deinitialization of dynamic libraries - TCTypeKind = enum # describes the type kind of a C type - ctVoid, ctChar, ctBool, ctUInt, ctUInt8, ctUInt16, ctUInt32, ctUInt64, - ctInt, ctInt8, ctInt16, ctInt32, ctInt64, ctFloat, ctFloat32, ctFloat64, - ctFloat128, ctArray, ctStruct, ctPtr, ctNimStr, ctNimSeq, ctProc, ctCString - TCFileSections = array[TCFileSection, PRope] # represents a generated C file - TCProcSection = enum # the sections a generated C proc consists of - cpsLocals, # section of local variables for C proc - cpsInit, # section for init of variables for C proc - cpsStmts # section of local statements for C proc - TCProcSections = array[TCProcSection, PRope] # represents a generated C proc - BModule = ref TCGen - BProc = ref TCProc - TBlock{.final.} = object - id*: int # the ID of the label; positive means that it - # has been used (i.e. the label should be emitted) - nestedTryStmts*: int # how many try statements is it nested into - - TCProc{.final.} = object # represents C proc that is currently generated - s*: TCProcSections # the procs sections; short name for readability - prc*: PSym # the Nimrod proc that this C proc belongs to - BeforeRetNeeded*: bool # true iff 'BeforeRet' label for proc is needed - nestedTryStmts*: Natural # in how many nested try statements we are - # (the vars must be volatile then) - labels*: Natural # for generating unique labels in the C proc - blocks*: seq[TBlock] # nested blocks - options*: TOptions # options that should be used for code - # generation; this is the same as prc.options - # unless prc == nil - frameLen*: int # current length of frame descriptor - sendClosure*: PType # closure record type that we pass - receiveClosure*: PType # closure record type that we get - module*: BModule # used to prevent excessive parameter passing - - TTypeSeq = seq[PType] - TCGen = object of TPassContext # represents a C source file - module*: PSym - filename*: string - s*: TCFileSections # sections of the C file - cfilename*: string # filename of the module (including path, - # without extension) - typeCache*: TIdTable # cache the generated types - forwTypeCache*: TIdTable # cache for forward declarations of types - declaredThings*: TIntSet # things we have declared in this .c file - declaredProtos*: TIntSet # prototypes we have declared in this .c file - headerFiles*: TLinkedList # needed headers to include - typeInfoMarker*: TIntSet # needed for generating type information - initProc*: BProc # code for init procedure - typeStack*: TTypeSeq # used for type generation - dataCache*: TNodeTable - forwardedProcs*: TSymSeq # keep forwarded procs here - typeNodes*, nimTypes*: int # used for type info generation - typeNodesName*, nimTypesName*: PRope # used for type info generation - labels*: natural # for generating unique module-scope names - - -var - mainModProcs, mainModInit: PRope # parts of the main module - gMapping: PRope # the generated mapping file (if requested) - gProcProfile: Natural # proc profile counter - gGeneratedSyms: TIntSet # set of ID's of generated symbols - gPendingModules: seq[BModule] = @[] # list of modules that are not - # finished with code generation - gForwardedProcsCounter: int = 0 - gNimDat: BModule # generated global data - -proc ropeff(cformat, llvmformat: string, args: openarray[PRope]): PRope = - if gCmd == cmdCompileToLLVM: result = ropef(llvmformat, args) - else: result = ropef(cformat, args) - -proc appff(dest: var PRope, cformat, llvmformat: string, - args: openarray[PRope]) = - if gCmd == cmdCompileToLLVM: appf(dest, llvmformat, args) - else: appf(dest, cformat, args) - -proc addForwardedProc(m: BModule, prc: PSym) = - m.forwardedProcs.add(prc) - inc(gForwardedProcsCounter) - -proc addPendingModule(m: BModule) = - for i in countup(0, high(gPendingModules)): - if gPendingModules[i] == m: - InternalError("module already pending: " & m.module.name.s) - gPendingModules.add(m) - -proc findPendingModule(m: BModule, s: PSym): BModule = - var ms = getModule(s) - if ms.id == m.module.id: - return m - for i in countup(0, high(gPendingModules)): - result = gPendingModules[i] - if result.module.id == ms.id: return - InternalError(s.info, "no pending module found for: " & s.name.s) - -proc initLoc(result: var TLoc, k: TLocKind, typ: PType, s: TStorageLoc) = - result.k = k - result.s = s - result.t = GetUniqueType(typ) - result.r = nil - result.a = - 1 - result.flags = {} - -proc fillLoc(a: var TLoc, k: TLocKind, typ: PType, r: PRope, s: TStorageLoc) = - # fills the loc if it is not already initialized - if a.k == locNone: - a.k = k - a.t = getUniqueType(typ) - a.a = - 1 - a.s = s - if a.r == nil: a.r = r - -proc newProc(prc: PSym, module: BModule): BProc = - new(result) - result.prc = prc - result.module = module - if prc != nil: result.options = prc.options - else: result.options = gOptions - result.blocks = @[] - -proc isSimpleConst(typ: PType): bool = - result = not (skipTypes(typ, abstractVar).kind in - {tyTuple, tyObject, tyArray, tyArrayConstr, tySet, tySequence}) - -proc useHeader(m: BModule, sym: PSym) = - if lfHeader in sym.loc.Flags: - assert(sym.annex != nil) - discard lists.IncludeStr(m.headerFiles, getStr(sym.annex.path)) - -proc UseMagic(m: BModule, name: string) - -include "ccgtypes.nim" - -# ------------------------------ Manager of temporaries ------------------ - -proc getTemp(p: BProc, t: PType, result: var TLoc) = - inc(p.labels) - if gCmd == cmdCompileToLLVM: - result.r = con("%LOC", toRope(p.labels)) - else: - result.r = con("LOC", toRope(p.labels)) - appf(p.s[cpsLocals], "$1 $2;$n", [getTypeDesc(p.module, t), result.r]) - result.k = locTemp - result.a = - 1 - result.t = getUniqueType(t) - result.s = OnStack - result.flags = {} - -proc cstringLit(p: BProc, r: var PRope, s: string): PRope = - if gCmd == cmdCompileToLLVM: - inc(p.module.labels) - inc(p.labels) - result = ropef("%LOC$1", [toRope(p.labels)]) - appf(p.module.s[cfsData], "@C$1 = private constant [$2 x i8] $3$n", - [toRope(p.module.labels), toRope(len(s)), makeLLVMString(s)]) - appf(r, "$1 = getelementptr [$2 x i8]* @C$3, %NI 0, %NI 0$n", - [result, toRope(len(s)), toRope(p.module.labels)]) - else: - result = makeCString(s) - -proc cstringLit(m: BModule, r: var PRope, s: string): PRope = - if gCmd == cmdCompileToLLVM: - inc(m.labels, 2) - result = ropef("%MOC$1", [toRope(m.labels - 1)]) - appf(m.s[cfsData], "@MOC$1 = private constant [$2 x i8] $3$n", - [toRope(m.labels), toRope(len(s)), makeLLVMString(s)]) - appf(r, "$1 = getelementptr [$2 x i8]* @MOC$3, %NI 0, %NI 0$n", - [result, toRope(len(s)), toRope(m.labels)]) - else: - result = makeCString(s) - -proc allocParam(p: BProc, s: PSym) = - assert(s.kind == skParam) - if not (lfParamCopy in s.loc.flags): - inc(p.labels) - var tmp = con("%LOC", toRope(p.labels)) - incl(s.loc.flags, lfParamCopy) - incl(s.loc.flags, lfIndirect) - appf(p.s[cpsInit], "$1 = alloca $3$n" & "store $3 $2, $3* $1$n", - [tmp, s.loc.r, getTypeDesc(p.module, s.loc.t)]) - s.loc.r = tmp - -proc localDebugInfo(p: BProc, s: PSym) = - var name, a: PRope - if {optStackTrace, optEndb} * p.options != {optStackTrace, optEndb}: return - if gCmd == cmdCompileToLLVM: - # "address" is the 0th field - # "typ" is the 1rst field - # "name" is the 2nd field - name = cstringLit(p, p.s[cpsInit], normalize(s.name.s)) - if (s.kind == skParam) and not ccgIntroducedPtr(s): allocParam(p, s) - inc(p.labels, 3) - appf(p.s[cpsInit], "%LOC$6 = getelementptr %TF* %F, %NI 0, $1, %NI 0$n" & - "%LOC$7 = getelementptr %TF* %F, %NI 0, $1, %NI 1$n" & - "%LOC$8 = getelementptr %TF* %F, %NI 0, $1, %NI 2$n" & - "store i8* $2, i8** %LOC$6$n" & "store $3* $4, $3** %LOC$7$n" & - "store i8* $5, i8** %LOC$8$n", [toRope(p.frameLen), s.loc.r, - getTypeDesc(p.module, "TNimType"), - genTypeInfo(p.module, s.loc.t), name, - toRope(p.labels), toRope(p.labels - 1), - toRope(p.labels - 2)]) - else: - a = con("&", s.loc.r) - if (s.kind == skParam) and ccgIntroducedPtr(s): a = s.loc.r - appf(p.s[cpsInit], - "F.s[$1].address = (void*)$3; F.s[$1].typ = $4; F.s[$1].name = $2;$n", [ - toRope(p.frameLen), makeCString(normalize(s.name.s)), a, - genTypeInfo(p.module, s.loc.t)]) - inc(p.frameLen) - -proc assignLocalVar(p: BProc, s: PSym) = - #assert(s.loc.k == locNone) // not yet assigned - # this need not be fullfilled for inline procs; they are regenerated - # for each module that uses them! - if s.loc.k == locNone: - fillLoc(s.loc, locLocalVar, s.typ, mangleName(s), OnStack) - if gCmd == cmdCompileToLLVM: - appf(p.s[cpsLocals], "$1 = alloca $2$n", - [s.loc.r, getTypeDesc(p.module, s.loc.t)]) - incl(s.loc.flags, lfIndirect) - else: - app(p.s[cpsLocals], getTypeDesc(p.module, s.loc.t)) - if sfRegister in s.flags: app(p.s[cpsLocals], " register") - if (sfVolatile in s.flags) or (p.nestedTryStmts > 0): - app(p.s[cpsLocals], " volatile") - appf(p.s[cpsLocals], " $1;$n", [s.loc.r]) - localDebugInfo(p, s) - -proc assignGlobalVar(p: BProc, s: PSym) = - if s.loc.k == locNone: - fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), OnHeap) - if gCmd == cmdCompileToLLVM: - appf(p.module.s[cfsVars], "$1 = linkonce global $2 zeroinitializer$n", - [s.loc.r, getTypeDesc(p.module, s.loc.t)]) - incl(s.loc.flags, lfIndirect) - else: - useHeader(p.module, s) - if lfNoDecl in s.loc.flags: return - if sfImportc in s.flags: app(p.module.s[cfsVars], "extern ") - app(p.module.s[cfsVars], getTypeDesc(p.module, s.loc.t)) - if sfRegister in s.flags: app(p.module.s[cfsVars], " register") - if sfVolatile in s.flags: app(p.module.s[cfsVars], " volatile") - if sfThreadVar in s.flags: app(p.module.s[cfsVars], " NIM_THREADVAR") - appf(p.module.s[cfsVars], " $1;$n", [s.loc.r]) - if {optStackTrace, optEndb} * p.module.module.options == - {optStackTrace, optEndb}: - useMagic(p.module, "dbgRegisterGlobal") - appff(p.module.s[cfsDebugInit], "dbgRegisterGlobal($1, &$2, $3);$n", - "call void @dbgRegisterGlobal(i8* $1, i8* $2, $4* $3)$n", [cstringLit( - p, p.module.s[cfsDebugInit], normalize(s.owner.name.s & '.' & s.name.s)), - s.loc.r, genTypeInfo(p.module, s.typ), getTypeDesc(p.module, "TNimType")]) - -proc iff(cond: bool, the, els: PRope): PRope = - if cond: result = the - else: result = els - -proc assignParam(p: BProc, s: PSym) = - assert(s.loc.r != nil) - if (sfAddrTaken in s.flags) and (gCmd == cmdCompileToLLVM): allocParam(p, s) - localDebugInfo(p, s) - -proc fillProcLoc(sym: PSym) = - if sym.loc.k == locNone: - fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), OnStack) - -proc getLabel(p: BProc): TLabel = - inc(p.labels) - result = con("LA", toRope(p.labels)) - -proc fixLabel(p: BProc, labl: TLabel) = - appf(p.s[cpsStmts], "$1: ;$n", [labl]) - -proc genVarPrototype(m: BModule, sym: PSym) -proc genConstPrototype(m: BModule, sym: PSym) -proc genProc(m: BModule, prc: PSym) -proc genStmts(p: BProc, t: PNode) -proc genProcPrototype(m: BModule, sym: PSym) - -include "ccgexprs.nim", "ccgstmts.nim" - -# ----------------------------- dynamic library handling ----------------- -# We don't finalize dynamic libs as this does the OS for us. - -proc libCandidates(s: string, dest: var TStringSeq) = - var le = strutils.find(s, '(') - var ri = strutils.find(s, ')', le+1) - if le >= 0 and ri > le: - var prefix = copy(s, 0, le - 1) - var suffix = copy(s, ri + 1) - for middle in split(copy(s, le + 1, ri - 1), '|'): - libCandidates(prefix & middle & suffix, dest) - else: - add(dest, s) - -proc loadDynamicLib(m: BModule, lib: PLib) = - assert(lib != nil) - if not lib.generated: - lib.generated = true - var tmp = getGlobalTempName() - assert(lib.name == nil) - lib.name = tmp # BUGFIX: useMagic has awful side-effects - appf(m.s[cfsVars], "static void* $1;$n", [tmp]) - if lib.path.kind in {nkStrLit..nkTripleStrLit}: - var s: TStringSeq = @[] - libCandidates(lib.path.strVal, s) - var loadlib: PRope = nil - for i in countup(0, high(s)): - inc(m.labels) - if i > 0: app(loadlib, "||") - appf(loadlib, "($1 = nimLoadLibrary((NimStringDesc*) &$2))$n", - [tmp, getStrLit(m, s[i])]) - appf(m.s[cfsDynLibInit], - "if (!($1)) nimLoadLibraryError((NimStringDesc*) &$2);$n", - [loadlib, getStrLit(m, lib.path.strVal)]) - else: - var p = newProc(nil, m) - var dest: TLoc - initLocExpr(p, lib.path, dest) - app(m.s[cfsVars], p.s[cpsLocals]) - app(m.s[cfsDynLibInit], p.s[cpsInit]) - app(m.s[cfsDynLibInit], p.s[cpsStmts]) - appf(m.s[cfsDynLibInit], - "if (!($1 = nimLoadLibrary($2))) nimLoadLibraryError($2);$n", - [tmp, rdLoc(dest)]) - - useMagic(m, "nimLoadLibrary") - useMagic(m, "nimUnloadLibrary") - useMagic(m, "NimStringDesc") - useMagic(m, "nimLoadLibraryError") - if lib.name == nil: InternalError("loadDynamicLib") - -proc SymInDynamicLib(m: BModule, sym: PSym) = - var lib = sym.annex - var extname = sym.loc.r - loadDynamicLib(m, lib) - useMagic(m, "nimGetProcAddr") - if gCmd == cmdCompileToLLVM: incl(sym.loc.flags, lfIndirect) - var tmp = ropeff("Dl_$1", "@Dl_$1", [toRope(sym.id)]) - sym.loc.r = tmp # from now on we only need the internal name - sym.typ.sym = nil # generate a new name - inc(m.labels, 2) - appff(m.s[cfsDynLibInit], - "$1 = ($2) nimGetProcAddr($3, $4);$n", "%MOC$5 = load i8* $3$n" & - "%MOC$6 = call $2 @nimGetProcAddr(i8* %MOC$5, i8* $4)$n" & - "store $2 %MOC$6, $2* $1$n", [tmp, getTypeDesc(m, sym.typ), - lib.name, cstringLit(m, m.s[cfsDynLibInit], ropeToStr(extname)), - toRope(m.labels), toRope(m.labels - 1)]) - appff(m.s[cfsVars], "$2 $1;$n", - "$1 = linkonce global $2 zeroinitializer$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t)]) - -proc UseMagic(m: BModule, name: string) = - var sym = magicsys.getCompilerProc(name) - if sym != nil: - case sym.kind - of skProc, skMethod, skConverter: genProc(m, sym) - of skVar: genVarPrototype(m, sym) - of skType: discard getTypeDesc(m, sym.typ) - else: InternalError("useMagic: " & name) - elif not (sfSystemModule in m.module.flags): - rawMessage(errSystemNeeds, name) # don't be too picky here - -proc generateHeaders(m: BModule) = - app(m.s[cfsHeaders], "#include \"nimbase.h\"" & tnl & tnl) - var it = PStrEntry(m.headerFiles.head) - while it != nil: - if not (it.data[0] in {'\"', '<'}): - appf(m.s[cfsHeaders], "#include \"$1\"$n", [toRope(it.data)]) - else: - appf(m.s[cfsHeaders], "#include $1$n", [toRope(it.data)]) - it = PStrEntry(it.Next) - -proc getFrameDecl(p: BProc) = - var slots: PRope - if p.frameLen > 0: - useMagic(p.module, "TVarSlot") - slots = ropeff(" TVarSlot s[$1];$n", ", [$1 x %TVarSlot]", - [toRope(p.frameLen)]) - else: - slots = nil - appff(p.s[cpsLocals], "volatile struct {TFrame* prev;" & - "NCSTRING procname;NI line;NCSTRING filename;" & - "NI len;$n$1} F;$n", - "%TF = type {%TFrame*, i8*, %NI, %NI$1}$n" & - "%F = alloca %TF$n", [slots]) - inc(p.labels) - prepend(p.s[cpsInit], ropeff("F.len = $1;$n", - "%LOC$2 = getelementptr %TF %F, %NI 4$n" & - "store %NI $1, %NI* %LOC$2$n", [toRope(p.frameLen), toRope(p.labels)])) - -proc retIsNotVoid(s: PSym): bool = - result = (s.typ.sons[0] != nil) and not isInvalidReturnType(s.typ.sons[0]) - -proc initFrame(p: BProc, procname, filename: PRope): PRope = - inc(p.labels, 5) - result = ropeff("F.procname = $1;$n" & "F.prev = framePtr;$n" & - "F.filename = $2;$n" & "F.line = 0;$n" & "framePtr = (TFrame*)&F;$n", - "%LOC$3 = getelementptr %TF %F, %NI 1$n" & - "%LOC$4 = getelementptr %TF %F, %NI 0$n" & - "%LOC$5 = getelementptr %TF %F, %NI 3$n" & - "%LOC$6 = getelementptr %TF %F, %NI 2$n" & "store i8* $1, i8** %LOC$3$n" & - "store %TFrame* @framePtr, %TFrame** %LOC$4$n" & - "store i8* $2, i8** %LOC$5$n" & "store %NI 0, %NI* %LOC$6$n" & - "%LOC$7 = bitcast %TF* %F to %TFrame*$n" & - "store %TFrame* %LOC$7, %TFrame** @framePtr$n", [procname, filename, - toRope(p.labels), toRope(p.labels - 1), toRope(p.labels - 2), - toRope(p.labels - 3), toRope(p.labels - 4)]) - -proc deinitFrame(p: BProc): PRope = - inc(p.labels, 3) - result = ropeff("framePtr = framePtr->prev;$n", - "%LOC$1 = load %TFrame* @framePtr$n" & - "%LOC$2 = getelementptr %TFrame* %LOC$1, %NI 0$n" & - "%LOC$3 = load %TFrame** %LOC$2$n" & - "store %TFrame* $LOC$3, %TFrame** @framePtr", [toRope(p.labels), - toRope(p.labels - 1), toRope(p.labels - 2)]) - -proc genProcAux(m: BModule, prc: PSym) = - var - p: BProc - generatedProc, header, returnStmt, procname, filename: PRope - res, param: PSym - p = newProc(prc, m) - header = genProcHeader(m, prc) - if (gCmd != cmdCompileToLLVM) and (lfExportLib in prc.loc.flags): - header = con("N_LIB_EXPORT ", header) - returnStmt = nil - assert(prc.ast != nil) - if not (sfPure in prc.flags) and (prc.typ.sons[0] != nil): - res = prc.ast.sons[resultPos].sym # get result symbol - if not isInvalidReturnType(prc.typ.sons[0]): - # declare the result symbol: - assignLocalVar(p, res) - assert(res.loc.r != nil) - returnStmt = ropeff("return $1;$n", "ret $1$n", [rdLoc(res.loc)]) - else: - fillResult(res) - assignParam(p, res) - if skipTypes(res.typ, abstractInst).kind == tyArray: - incl(res.loc.flags, lfIndirect) - res.loc.s = OnUnknown - initVariable(p, res) - genObjectInit(p, res.typ, res.loc, true) - for i in countup(1, sonsLen(prc.typ.n) - 1): - param = prc.typ.n.sons[i].sym - assignParam(p, param) - genStmts(p, prc.ast.sons[codePos]) # modifies p.locals, p.init, etc. - if sfPure in prc.flags: - generatedProc = ropeff("$1 {$n$2$3$4}$n", "define $1 {$n$2$3$4}$n", [header, - p.s[cpsLocals], p.s[cpsInit], p.s[cpsStmts]]) - else: - generatedProc = ropeff("$1 {$n", "define $1 {$n", [header]) - if optStackTrace in prc.options: - getFrameDecl(p) - app(generatedProc, p.s[cpsLocals]) - procname = CStringLit(p, generatedProc, - prc.owner.name.s & '.' & prc.name.s) - filename = CStringLit(p, generatedProc, toFilename(prc.info)) - app(generatedProc, initFrame(p, procname, filename)) - else: - app(generatedProc, p.s[cpsLocals]) - if (optProfiler in prc.options) and (gCmd != cmdCompileToLLVM): - if gProcProfile >= 64 * 1024: - InternalError(prc.info, "too many procedures for profiling") - useMagic(m, "profileData") - app(p.s[cpsLocals], "ticks NIM_profilingStart;" & tnl) - if prc.loc.a < 0: - appf(m.s[cfsDebugInit], "profileData[$1].procname = $2;$n", [ - toRope(gProcProfile), - makeCString(prc.owner.name.s & '.' & prc.name.s)]) - prc.loc.a = gProcProfile - inc(gProcProfile) - prepend(p.s[cpsInit], toRope("NIM_profilingStart = getticks();" & tnl)) - app(generatedProc, p.s[cpsInit]) - app(generatedProc, p.s[cpsStmts]) - if p.beforeRetNeeded: app(generatedProc, "BeforeRet: ;" & tnl) - if optStackTrace in prc.options: app(generatedProc, deinitFrame(p)) - if (optProfiler in prc.options) and (gCmd != cmdCompileToLLVM): - appf(generatedProc, "profileData[$1].total += elapsed(getticks(), NIM_profilingStart);$n", - [toRope(prc.loc.a)]) - app(generatedProc, returnStmt) - app(generatedProc, '}' & tnl) - app(m.s[cfsProcs], generatedProc) #if prc.kind = skMethod then addMethodToCompile(gNimDat, prc); - -proc genProcPrototype(m: BModule, sym: PSym) = - useHeader(m, sym) - if (lfNoDecl in sym.loc.Flags): return - if lfDynamicLib in sym.loc.Flags: - if (sym.owner.id != m.module.id) and - not intSetContainsOrIncl(m.declaredThings, sym.id): - appff(m.s[cfsVars], "extern $1 Dl_$2;$n", - "@Dl_$2 = linkonce global $1 zeroinitializer$n", - [getTypeDesc(m, sym.loc.t), toRope(sym.id)]) - if gCmd == cmdCompileToLLVM: incl(sym.loc.flags, lfIndirect) - else: - if not IntSetContainsOrIncl(m.declaredProtos, sym.id): - appf(m.s[cfsProcHeaders], "$1;$n", [genProcHeader(m, sym)]) - -proc genProcNoForward(m: BModule, prc: PSym) = - fillProcLoc(prc) - useHeader(m, prc) - genProcPrototype(m, prc) - if (lfNoDecl in prc.loc.Flags): return - if prc.typ.callConv == ccInline: - # We add inline procs to the calling module to enable C based inlining. - # This also means that a check with ``gGeneratedSyms`` is wrong, we need - # a check for ``m.declaredThings``. - if not intSetContainsOrIncl(m.declaredThings, prc.id): genProcAux(m, prc) - elif lfDynamicLib in prc.loc.flags: - if not IntSetContainsOrIncl(gGeneratedSyms, prc.id): - SymInDynamicLib(findPendingModule(m, prc), prc) - elif not (sfImportc in prc.flags): - if not IntSetContainsOrIncl(gGeneratedSyms, prc.id): - genProcAux(findPendingModule(m, prc), prc) - -proc genProc(m: BModule, prc: PSym) = - if sfBorrow in prc.flags: return - fillProcLoc(prc) - if {sfForward, sfFromGeneric} * prc.flags != {}: addForwardedProc(m, prc) - else: genProcNoForward(m, prc) - -proc genVarPrototype(m: BModule, sym: PSym) = - assert(sfGlobal in sym.flags) - useHeader(m, sym) - fillLoc(sym.loc, locGlobalVar, sym.typ, mangleName(sym), OnHeap) - if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(m.declaredThings, sym.id): - return - if sym.owner.id != m.module.id: - # else we already have the symbol generated! - assert(sym.loc.r != nil) - if gCmd == cmdCompileToLLVM: - incl(sym.loc.flags, lfIndirect) - appf(m.s[cfsVars], "$1 = linkonce global $2 zeroinitializer$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t)]) - else: - app(m.s[cfsVars], "extern ") - app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)) - if sfRegister in sym.flags: app(m.s[cfsVars], " register") - if sfVolatile in sym.flags: app(m.s[cfsVars], " volatile") - if sfThreadVar in sym.flags: app(m.s[cfsVars], " NIM_THREADVAR") - appf(m.s[cfsVars], " $1;$n", [sym.loc.r]) - -proc genConstPrototype(m: BModule, sym: PSym) = - useHeader(m, sym) - if sym.loc.k == locNone: - fillLoc(sym.loc, locData, sym.typ, mangleName(sym), OnUnknown) - if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(m.declaredThings, sym.id): - return - if sym.owner.id != m.module.id: - # else we already have the symbol generated! - assert(sym.loc.r != nil) - appff(m.s[cfsData], "extern NIM_CONST $1 $2;$n", - "$1 = linkonce constant $2 zeroinitializer", - [getTypeDesc(m, sym.loc.t), sym.loc.r]) - -proc getFileHeader(cfilenoext: string): PRope = - if optCompileOnly in gGlobalOptions: - result = ropeff("/* Generated by Nimrod Compiler v$1 */$n" & - "/* (c) 2009 Andreas Rumpf */$n", "; Generated by Nimrod Compiler v$1$n" & - "; (c) 2009 Andreas Rumpf$n", [toRope(versionAsString)]) - else: - result = ropeff("/* Generated by Nimrod Compiler v$1 */$n" & - "/* (c) 2009 Andreas Rumpf */$n" & "/* Compiled for: $2, $3, $4 */$n" & - "/* Command for C compiler:$n $5 */$n", "; Generated by Nimrod Compiler v$1$n" & - "; (c) 2009 Andreas Rumpf$n" & "; Compiled for: $2, $3, $4$n" & - "; Command for LLVM compiler:$n $5$n", [toRope(versionAsString), - toRope(platform.OS[targetOS].name), - toRope(platform.CPU[targetCPU].name), - toRope(extccomp.CC[extccomp.ccompiler].name), - toRope(getCompileCFileCmd(cfilenoext))]) - case platform.CPU[targetCPU].intSize - of 16: - appff(result, - "$ntypedef short int NI;$n" & "typedef unsigned short int NU;$n", - "$n%NI = type i16$n", []) - of 32: - appff(result, - "$ntypedef long int NI;$n" & "typedef unsigned long int NU;$n", - "$n%NI = type i32$n", []) - of 64: - appff(result, "$ntypedef long long int NI;$n" & - "typedef unsigned long long int NU;$n", "$n%NI = type i64$n", []) - else: - nil - -proc genMainProc(m: BModule) = - const - CommonMainBody = " setStackBottom(dummy);$n" & " nim__datInit();$n" & - " systemInit();$n" & "$1" & "$2" - CommonMainBodyLLVM = " %MOC$3 = bitcast [8 x %NI]* %dummy to i8*$n" & - " call void @setStackBottom(i8* %MOC$3)$n" & - " call void @nim__datInit()$n" & " call void systemInit()$n" & "$1" & - "$2" - PosixNimMain = "int cmdCount;$n" & "char** cmdLine;$n" & "char** gEnv;$n" & - "N_CDECL(void, NimMain)(void) {$n" & " int dummy[8];$n" & - CommonMainBody & "}$n" - PosixCMain = "int main(int argc, char** args, char** env) {$n" & - " cmdLine = args;$n" & " cmdCount = argc;$n" & " gEnv = env;$n" & - " NimMain();$n" & " return 0;$n" & "}$n" - PosixNimMainLLVM = "@cmdCount = linkonce i32$n" & - "@cmdLine = linkonce i8**$n" & "@gEnv = linkonce i8**$n" & - "define void @NimMain(void) {$n" & " %dummy = alloca [8 x %NI]$n" & - CommonMainBodyLLVM & "}$n" - PosixCMainLLVM = "define i32 @main(i32 %argc, i8** %args, i8** %env) {$n" & - " store i8** %args, i8*** @cmdLine$n" & - " store i32 %argc, i32* @cmdCount$n" & - " store i8** %env, i8*** @gEnv$n" & " call void @NimMain()$n" & - " ret i32 0$n" & "}$n" - WinNimMain = "N_CDECL(void, NimMain)(void) {$n" & " int dummy[8];$n" & - CommonMainBody & "}$n" - WinCMain = "N_STDCALL(int, WinMain)(HINSTANCE hCurInstance, $n" & - " HINSTANCE hPrevInstance, $n" & - " LPSTR lpCmdLine, int nCmdShow) {$n" & - " NimMain();$n" & " return 0;$n" & "}$n" - WinNimMainLLVM = "define void @NimMain(void) {$n" & - " %dummy = alloca [8 x %NI]$n" & CommonMainBodyLLVM & "}$n" - WinCMainLLVM = "define stdcall i32 @WinMain(i32 %hCurInstance, $n" & - " i32 %hPrevInstance, $n" & - " i8* %lpCmdLine, i32 %nCmdShow) {$n" & - " call void @NimMain()$n" & " ret i32 0$n" & "}$n" - WinNimDllMain = "N_LIB_EXPORT N_CDECL(void, NimMain)(void) {$n" & - " int dummy[8];$n" & CommonMainBody & "}$n" - WinCDllMain = "BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fwdreason, $n" & - " LPVOID lpvReserved) {$n" & " NimMain();$n" & - " return 1;$n" & "}$n" - WinNimDllMainLLVM = WinNimMainLLVM - WinCDllMainLLVM = "define stdcall i32 @DllMain(i32 %hinstDLL, i32 %fwdreason, $n" & - " i8* %lpvReserved) {$n" & - " call void @NimMain()$n" & " ret i32 1$n" & "}$n" - var nimMain, otherMain: TFormatStr - useMagic(m, "setStackBottom") - if (platform.targetOS == osWindows) and - (gGlobalOptions * {optGenGuiApp, optGenDynLib} != {}): - if optGenGuiApp in gGlobalOptions: - if gCmd == cmdCompileToLLVM: - nimMain = WinNimMainLLVM - otherMain = WinCMainLLVM - else: - nimMain = WinNimMain - otherMain = WinCMain - else: - if gCmd == cmdCompileToLLVM: - nimMain = WinNimDllMainLLVM - otherMain = WinCDllMainLLVM - else: - nimMain = WinNimDllMain - otherMain = WinCDllMain - discard lists.IncludeStr(m.headerFiles, "<windows.h>") - else: - if gCmd == cmdCompileToLLVM: - nimMain = PosixNimMainLLVM - otherMain = PosixCMainLLVM - else: - nimMain = PosixNimMain - otherMain = PosixCMain - if gBreakpoints != nil: useMagic(m, "dbgRegisterBreakpoint") - inc(m.labels) - appf(m.s[cfsProcs], nimMain, [gBreakpoints, mainModInit, toRope(m.labels)]) - if not (optNoMain in gGlobalOptions): appf(m.s[cfsProcs], otherMain, []) - -proc getInitName(m: PSym): PRope = - result = ropeff("$1Init", "@$1Init", [toRope(m.name.s)]) - -proc registerModuleToMain(m: PSym) = - var initname = getInitName(m) - appff(mainModProcs, "N_NOINLINE(void, $1)(void);$n", - "declare void $1() noinline$n", [initname]) - if not (sfSystemModule in m.flags): - appff(mainModInit, "$1();$n", "call void ()* $1$n", [initname]) - -proc genInitCode(m: BModule) = - var initname, prc, procname, filename: PRope - if optProfiler in m.initProc.options: - # This does not really belong here, but there is no good place for this - # code. I don't want to put this to the proc generation as the - # ``IncludeStr`` call is quite slow. - discard lists.IncludeStr(m.headerFiles, "<cycle.h>") - initname = getInitName(m.module) - prc = ropeff("N_NOINLINE(void, $1)(void) {$n", - "define void $1() noinline {$n", [initname]) - if m.typeNodes > 0: - useMagic(m, "TNimNode") - appff(m.s[cfsTypeInit1], "static TNimNode $1[$2];$n", - "$1 = private alloca [$2 x @TNimNode]$n", - [m.typeNodesName, toRope(m.typeNodes)]) - if m.nimTypes > 0: - useMagic(m, "TNimType") - appff(m.s[cfsTypeInit1], "static TNimType $1[$2];$n", - "$1 = private alloca [$2 x @TNimType]$n", - [m.nimTypesName, toRope(m.nimTypes)]) - if optStackTrace in m.initProc.options: - getFrameDecl(m.initProc) - app(prc, m.initProc.s[cpsLocals]) - app(prc, m.s[cfsTypeInit1]) - procname = CStringLit(m.initProc, prc, "module " & m.module.name.s) - filename = CStringLit(m.initProc, prc, toFilename(m.module.info)) - app(prc, initFrame(m.initProc, procname, filename)) - else: - app(prc, m.initProc.s[cpsLocals]) - app(prc, m.s[cfsTypeInit1]) - app(prc, m.s[cfsTypeInit2]) - app(prc, m.s[cfsTypeInit3]) - app(prc, m.s[cfsDebugInit]) - app(prc, m.s[cfsDynLibInit]) - app(prc, m.initProc.s[cpsInit]) - app(prc, m.initProc.s[cpsStmts]) - if optStackTrace in m.initProc.options: app(prc, deinitFrame(m.initProc)) - app(prc, '}' & tnl & tnl) - app(m.s[cfsProcs], prc) - -proc genModule(m: BModule, cfilenoext: string): PRope = - result = getFileHeader(cfilenoext) - generateHeaders(m) - for i in countup(low(TCFileSection), cfsProcs): app(result, m.s[i]) - -proc rawNewModule(module: PSym, filename: string): BModule = - new(result) - InitLinkedList(result.headerFiles) - intSetInit(result.declaredThings) - intSetInit(result.declaredProtos) - result.cfilename = filename - result.filename = filename - initIdTable(result.typeCache) - initIdTable(result.forwTypeCache) - result.module = module - intSetInit(result.typeInfoMarker) - result.initProc = newProc(nil, result) - result.initProc.options = gOptions - initNodeTable(result.dataCache) - result.typeStack = @[] - result.forwardedProcs = @[] - result.typeNodesName = getTempName() - result.nimTypesName = getTempName() - -proc newModule(module: PSym, filename: string): BModule = - result = rawNewModule(module, filename) - if (optDeadCodeElim in gGlobalOptions): - if (sfDeadCodeElim in module.flags): - InternalError("added pending module twice: " & filename) - addPendingModule(result) - -proc registerTypeInfoModule() = - const moduleName = "nim__dat" - var s = NewSym(skModule, getIdent(moduleName), nil) - gNimDat = rawNewModule(s, joinPath(options.projectPath, moduleName) & ".nim") - addPendingModule(gNimDat) - appff(mainModProcs, "N_NOINLINE(void, $1)(void);$n", - "declare void $1() noinline$n", [getInitName(s)]) - -proc myOpen(module: PSym, filename: string): PPassContext = - if gNimDat == nil: registerTypeInfoModule() - result = newModule(module, filename) - -proc myOpenCached(module: PSym, filename: string, rd: PRodReader): PPassContext = - var cfile, cfilenoext, objFile: string - if gNimDat == nil: - registerTypeInfoModule() - #MessageOut('cgen.myOpenCached has been called ' + filename); - cfile = changeFileExt(completeCFilePath(filename), cExt) - cfilenoext = changeFileExt(cfile, "") - addFileToLink(cfilenoext) - registerModuleToMain(module) - # XXX: this cannot be right here, initalization has to be appended during - # the ``myClose`` call - result = nil - -proc shouldRecompile(code: PRope, cfile, cfilenoext: string): bool = - result = true - if not (optForceFullMake in gGlobalOptions): - var objFile = toObjFile(cfilenoext) - if writeRopeIfNotEqual(code, cfile): return - if ExistsFile(objFile) and os.FileNewer(objFile, cfile): result = false - else: - writeRope(code, cfile) - -proc myProcess(b: PPassContext, n: PNode): PNode = - result = n - if b == nil: return - var m = BModule(b) - m.initProc.options = gOptions - genStmts(m.initProc, n) - -proc finishModule(m: BModule) = - var i = 0 - while i <= high(m.forwardedProcs): - # Note: ``genProc`` may add to ``m.forwardedProcs``, so we cannot use - # a ``for`` loop here - var prc = m.forwardedProcs[i] - if sfForward in prc.flags: InternalError(prc.info, "still forwarded") - genProcNoForward(m, prc) - inc(i) - assert(gForwardedProcsCounter >= i) - dec(gForwardedProcsCounter, i) - setlen(m.forwardedProcs, 0) - -proc writeModule(m: BModule) = - var - cfile, cfilenoext: string - code: PRope - # generate code for the init statements of the module: - genInitCode(m) - finishTypeDescriptions(m) - cfile = completeCFilePath(m.cfilename) - cfilenoext = changeFileExt(cfile, "") - if sfMainModule in m.module.flags: - # generate main file: - app(m.s[cfsProcHeaders], mainModProcs) - code = genModule(m, cfilenoext) - if shouldRecompile(code, changeFileExt(cfile, cExt), cfilenoext): - addFileToCompile(cfilenoext) - addFileToLink(cfilenoext) - -proc myClose(b: PPassContext, n: PNode): PNode = - result = n - if b == nil: return - var m = BModule(b) - if n != nil: - m.initProc.options = gOptions - genStmts(m.initProc, n) - registerModuleToMain(m.module) - if not (optDeadCodeElim in gGlobalOptions) and - not (sfDeadCodeElim in m.module.flags): - finishModule(m) - if sfMainModule in m.module.flags: - var disp = generateMethodDispatchers() - for i in countup(0, sonsLen(disp) - 1): genProcAux(gNimDat, disp.sons[i].sym) - genMainProc(m) - # we need to process the transitive closure because recursive module - # deps are allowed (and the system module is processed in the wrong - # order anyway) - while gForwardedProcsCounter > 0: - for i in countup(0, high(gPendingModules)): - finishModule(gPendingModules[i]) - for i in countup(0, high(gPendingModules)): writeModule(gPendingModules[i]) - setlen(gPendingModules, 0) - if not (optDeadCodeElim in gGlobalOptions) and - not (sfDeadCodeElim in m.module.flags): - writeModule(m) - if sfMainModule in m.module.flags: writeMapping(gMapping) - -proc llvmgenPass(): TPass = - initPass(result) - result.open = myOpen - result.openCached = myOpenCached - result.process = myProcess - result.close = myClose - -InitIiTable(gToTypeInfoId) -IntSetInit(gGeneratedSyms) diff --git a/rod/llvmtype.nim b/rod/llvmtype.nim deleted file mode 100755 index 7790855ac..000000000 --- a/rod/llvmtype.nim +++ /dev/null @@ -1,125 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Converts Nimrod types to LLVM types. - -import llvm - -proc intFromSize(size: int): TypeRef = - case size - of 8: result = llvm.Int64Type() - of 4: result = llvm.Int32Type() - of 2: result = llvm.Int16Type() - of 1: result = llvm.Int8Type() - else: InternalError("unknown type size") - -type - TPending = TTypeHandleMap - -proc convertProcType(m: BModule, t: PType, pending: var TPending): TypeRef = - - -proc simpleType(m: BModule, t: PType): TypeRef = - case t.kind - of tyBool, tyChar, tyInt8: result = llvm.Int8Type() - of tyEnum: - if firstOrd(t) < 0: - result = llvm.Int32Type() - else: - case int(getSize(t)) - of 1: result = llvm.Int8Type() - of 2: result = llvm.Int16Type() - of 4: result = llvm.Int32Type() - of 8: result = llvm.Int64Type() - else: internalError(t.sym.info, "convertTypeAux") - of tyInt: result = intFromSize(getSize(t)) - of tyInt16: result = llvm.Int16Type() - of tyInt32: result = llvm.Int32Type() - of tyInt64: result = llvm.Int64Type() - of tyFloat, tyFloat64: result = llvm.DoubleType() - of tyFloat32: result = llvm.FloatType() - of tyCString, tyPointer, tyNil: result = llvm.PointerType(llvm.Int8Type()) - else: result = nil - -proc convertTypeAux(m: BModule, t: PType, pending: var TPending): TypeRef = - case t.kind - of tyDistinct, tyRange: - result = convertTypeAux(m, t.sons[0], pending) - of tyArray: - result = m.typeCache[t] - if result == nil: - var handle = pending[t] - if handle == nil: - handle = llvm.CreateTypeHandle(llvm.OpaqueType()) - pending[t] = handle - result = llvm.ArrayType(ResolveTypeHandle(handle), int32(lengthOrd(t))) - var elemConcrete = convertTypeAux(m, elemType(t), pending) - # this may destroy the types! - refineType(ResolveTypeHandle(handle), elemConcrete) - - # elemConcrete is potentially invalidated, but handle - # (a PATypeHolder) is kept up-to-date - elemConcrete = ResolveTypeHandle(handle) - - - else: - # we are pending! - result = ResolveTypeHandle(handle) - # now we have the correct type: - m.typeCache[t] = result - of tyOpenArray: - - of tySeq: - - of tyObject: - of tyTuple: - - of tyProc: - else: result = simpleType(m, t) - -proc CreateTypeHandle*(PotentiallyAbstractTy: TypeRef): TypeHandleRef{.cdecl, - dynlib: libname, importc: "LLVMCreateTypeHandle".} -proc RefineType*(AbstractTy: TypeRef, ConcreteTy: TypeRef){.cdecl, - dynlib: libname, importc: "LLVMRefineType".} -proc ResolveTypeHandle*(TypeHandle: TypeHandleRef): TypeRef{.cdecl, - dynlib: libname, importc: "LLVMResolveTypeHandle".} -proc DisposeTypeHandle*(TypeHandle: TypeHandleRef){.cdecl, dynlib: libname, - importc: "LLVMDisposeTypeHandle".} - - -proc `!`*(m: BModule, t: PType): TypeRef = - ## converts a Nimrod type to an LLVM type. Since this is so common, we use - ## an infix operator for this. - result = simpleType(m, t) - if result == nil: - var cl: TTypeMap - init(cl) - result = convertTypeAux(m, t, cl) - -proc FunctionType*(ReturnType: TypeRef, ParamTypes: ptr TypeRef, - ParamCount: int32, IsVarArg: int32): TypeRef {. - cdecl, dynlib: libname, importc: "LLVMFunctionType".} - - -proc VoidType*(): TypeRef{.cdecl, dynlib: libname, importc: "LLVMVoidType".} -proc LabelType*(): TypeRef{.cdecl, dynlib: libname, importc: "LLVMLabelType".} -proc OpaqueType*(): TypeRef{.cdecl, dynlib: libname, importc: "LLVMOpaqueType".} - # Operations on type handles -proc CreateTypeHandle*(PotentiallyAbstractTy: TypeRef): TypeHandleRef{.cdecl, - dynlib: libname, importc: "LLVMCreateTypeHandle".} -proc RefineType*(AbstractTy: TypeRef, ConcreteTy: TypeRef){.cdecl, - dynlib: libname, importc: "LLVMRefineType".} -proc ResolveTypeHandle*(TypeHandle: TypeHandleRef): TypeRef{.cdecl, - dynlib: libname, importc: "LLVMResolveTypeHandle".} -proc DisposeTypeHandle*(TypeHandle: TypeHandleRef){.cdecl, dynlib: libname, - importc: "LLVMDisposeTypeHandle".} - - -# m!typ, m!a[i] - diff --git a/rod/lookups.nim b/rod/lookups.nim deleted file mode 100755 index f65fe24b7..000000000 --- a/rod/lookups.nim +++ /dev/null @@ -1,234 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements lookup helpers. - -import - ast, astalgo, idents, semdata, types, msgs, options, rodread, rnimsyn - -type - TOverloadIterMode* = enum - oimDone, oimNoQualifier, oimSelfModule, oimOtherModule, oimSymChoice, - oimSymChoiceLocalLookup - TOverloadIter*{.final.} = object - stackPtr*: int - it*: TIdentIter - m*: PSym - mode*: TOverloadIterMode - inSymChoice: TIntSet - -proc getSymRepr*(s: PSym): string = - case s.kind - of skProc, skMethod, skConverter, skIterator: result = getProcHeader(s) - else: result = s.name.s - -proc CloseScope*(tab: var TSymTab) = - # check if all symbols have been used and defined: - if (tab.tos > len(tab.stack)): InternalError("CloseScope") - var it: TTabIter - var s = InitTabIter(it, tab.stack[tab.tos-1]) - while s != nil: - if sfForward in s.flags: - LocalError(s.info, errImplOfXexpected, getSymRepr(s)) - elif ({sfUsed, sfInInterface} * s.flags == {}) and - (optHints in s.options): # BUGFIX: check options in s! - if not (s.kind in {skForVar, skParam, skMethod, skUnknown}): - Message(s.info, hintXDeclaredButNotUsed, getSymRepr(s)) - s = NextIter(it, tab.stack[tab.tos-1]) - astalgo.rawCloseScope(tab) - -proc AddSym*(t: var TStrTable, n: PSym) = - if StrTableIncl(t, n): LocalError(n.info, errAttemptToRedefine, n.name.s) - -proc addDecl*(c: PContext, sym: PSym) = - if SymTabAddUnique(c.tab, sym) == Failure: - LocalError(sym.info, errAttemptToRedefine, sym.Name.s) - -proc addDeclAt*(c: PContext, sym: PSym, at: Natural) = - if SymTabAddUniqueAt(c.tab, sym, at) == Failure: - LocalError(sym.info, errAttemptToRedefine, sym.Name.s) - -proc AddInterfaceDeclAux(c: PContext, sym: PSym) = - if (sfInInterface in sym.flags): - # add to interface: - if c.module == nil: InternalError(sym.info, "AddInterfaceDeclAux") - StrTableAdd(c.module.tab, sym) - if getCurrOwner().kind == skModule: incl(sym.flags, sfGlobal) - -proc addInterfaceDeclAt*(c: PContext, sym: PSym, at: Natural) = - addDeclAt(c, sym, at) - AddInterfaceDeclAux(c, sym) - -proc addOverloadableSymAt*(c: PContext, fn: PSym, at: Natural) = - if fn.kind notin OverloadableSyms: - InternalError(fn.info, "addOverloadableSymAt") - var check = StrTableGet(c.tab.stack[at], fn.name) - if check != nil and check.Kind notin OverloadableSyms: - LocalError(fn.info, errAttemptToRedefine, fn.Name.s) - else: - SymTabAddAt(c.tab, fn, at) - -proc addInterfaceDecl*(c: PContext, sym: PSym) = - # it adds the symbol to the interface if appropriate - addDecl(c, sym) - AddInterfaceDeclAux(c, sym) - -proc addInterfaceOverloadableSymAt*(c: PContext, sym: PSym, at: int) = - # it adds the symbol to the interface if appropriate - addOverloadableSymAt(c, sym, at) - AddInterfaceDeclAux(c, sym) - -proc lookUp*(c: PContext, n: PNode): PSym = - # Looks up a symbol. Generates an error in case of nil. - case n.kind - of nkAccQuoted: - result = lookup(c, n.sons[0]) - of nkSym: - result = n.sym - of nkIdent: - result = SymtabGet(c.Tab, n.ident) - if result == nil: GlobalError(n.info, errUndeclaredIdentifier, n.ident.s) - else: InternalError(n.info, "lookUp") - if IntSetContains(c.AmbiguousSymbols, result.id): - LocalError(n.info, errUseQualifier, result.name.s) - if result.kind == skStub: loadStub(result) - -type - TLookupFlag* = enum - checkAmbiguity, checkUndeclared - -proc QualifiedLookUp*(c: PContext, n: PNode, flags = {checkUndeclared}): PSym = - case n.kind - of nkIdent: - result = SymtabGet(c.Tab, n.ident) - if result == nil and checkUndeclared in flags: - GlobalError(n.info, errUndeclaredIdentifier, n.ident.s) - elif checkAmbiguity in flags and result != nil and - IntSetContains(c.AmbiguousSymbols, result.id): - LocalError(n.info, errUseQualifier, n.ident.s) - of nkSym: - result = n.sym - if checkAmbiguity in flags and IntSetContains(c.AmbiguousSymbols, - result.id): - LocalError(n.info, errUseQualifier, n.sym.name.s) - of nkDotExpr: - result = nil - var m = qualifiedLookUp(c, n.sons[0], flags*{checkUndeclared}) - if (m != nil) and (m.kind == skModule): - var ident: PIdent = nil - if (n.sons[1].kind == nkIdent): - ident = n.sons[1].ident - elif (n.sons[1].kind == nkAccQuoted) and - (n.sons[1].sons[0].kind == nkIdent): - ident = n.sons[1].sons[0].ident - if ident != nil: - if m == c.module: - result = StrTableGet(c.tab.stack[ModuleTablePos], ident) - else: - result = StrTableGet(m.tab, ident) - if result == nil and checkUndeclared in flags: - GlobalError(n.sons[1].info, errUndeclaredIdentifier, ident.s) - elif checkUndeclared in flags: - GlobalError(n.sons[1].info, errIdentifierExpected, - renderTree(n.sons[1])) - of nkAccQuoted: - result = QualifiedLookup(c, n.sons[0], flags) - else: - result = nil - if (result != nil) and (result.kind == skStub): loadStub(result) - -proc InitOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = - case n.kind - of nkIdent: - o.stackPtr = c.tab.tos - o.mode = oimNoQualifier - while result == nil: - dec(o.stackPtr) - if o.stackPtr < 0: break - result = InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.ident) - of nkSym: - result = n.sym - o.mode = oimDone - of nkDotExpr: - o.mode = oimOtherModule - o.m = qualifiedLookUp(c, n.sons[0]) - if o.m != nil and o.m.kind == skModule: - var ident: PIdent = nil - if n.sons[1].kind == nkIdent: - ident = n.sons[1].ident - elif n.sons[1].kind == nkAccQuoted and - n.sons[1].sons[0].kind == nkIdent: - ident = n.sons[1].sons[0].ident - if ident != nil: - if o.m == c.module: - # a module may access its private members: - result = InitIdentIter(o.it, c.tab.stack[ModuleTablePos], ident) - o.mode = oimSelfModule - else: - result = InitIdentIter(o.it, o.m.tab, ident) - else: - GlobalError(n.sons[1].info, errIdentifierExpected, - renderTree(n.sons[1])) - of nkAccQuoted: - result = InitOverloadIter(o, c, n.sons[0]) - of nkSymChoice: - o.mode = oimSymChoice - result = n.sons[0].sym - o.stackPtr = 1 - IntSetInit(o.inSymChoice) - IntSetIncl(o.inSymChoice, result.id) - else: nil - if result != nil and result.kind == skStub: loadStub(result) - -proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = - case o.mode - of oimDone: - result = nil - of oimNoQualifier: - if n.kind == nkAccQuoted: - result = nextOverloadIter(o, c, n.sons[0]) - elif o.stackPtr >= 0: - result = nextIdentIter(o.it, c.tab.stack[o.stackPtr]) - while result == nil: - dec(o.stackPtr) - if o.stackPtr < 0: break - result = InitIdentIter(o.it, c.tab.stack[o.stackPtr], o.it.name) - # BUGFIX: o.it.name <-> n.ident - else: - result = nil - of oimSelfModule: - result = nextIdentIter(o.it, c.tab.stack[ModuleTablePos]) - of oimOtherModule: - result = nextIdentIter(o.it, o.m.tab) - of oimSymChoice: - if o.stackPtr < sonsLen(n): - result = n.sons[o.stackPtr].sym - IntSetIncl(o.inSymChoice, result.id) - inc(o.stackPtr) - else: - # try 'local' symbols too for Koenig's lookup: - o.mode = oimSymChoiceLocalLookup - o.stackPtr = c.tab.tos-1 - result = FirstIdentExcluding(o.it, c.tab.stack[o.stackPtr], - n.sons[0].sym.name, o.inSymChoice) - while result == nil: - dec(o.stackPtr) - if o.stackPtr < 0: break - result = FirstIdentExcluding(o.it, c.tab.stack[o.stackPtr], - n.sons[0].sym.name, o.inSymChoice) - of oimSymChoiceLocalLookup: - result = nextIdentExcluding(o.it, c.tab.stack[o.stackPtr], o.inSymChoice) - while result == nil: - dec(o.stackPtr) - if o.stackPtr < 0: break - result = FirstIdentExcluding(o.it, c.tab.stack[o.stackPtr], - n.sons[0].sym.name, o.inSymChoice) - - if result != nil and result.kind == skStub: loadStub(result) - diff --git a/rod/magicsys.nim b/rod/magicsys.nim deleted file mode 100755 index 1d758dcde..000000000 --- a/rod/magicsys.nim +++ /dev/null @@ -1,87 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Built-in types and compilerprocs are registered here. - -import - ast, astalgo, nhashes, msgs, platform, nversion, times, idents, rodread - -var SystemModule*: PSym - -proc registerSysType*(t: PType) - # magic symbols in the system module: -proc getSysType*(kind: TTypeKind): PType -proc getCompilerProc*(name: string): PSym -proc registerCompilerProc*(s: PSym) -proc InitSystem*(tab: var TSymTab) -proc FinishSystem*(tab: TStrTable) -proc getSysSym*(name: string): PSym -# implementation - -var - gSysTypes: array[TTypeKind, PType] - compilerprocs: TStrTable - -proc registerSysType(t: PType) = - if gSysTypes[t.kind] == nil: gSysTypes[t.kind] = t - -proc newSysType(kind: TTypeKind, size: int): PType = - result = newType(kind, systemModule) - result.size = size - result.align = size - -proc getSysSym(name: string): PSym = - result = StrTableGet(systemModule.tab, getIdent(name)) - if result == nil: rawMessage(errSystemNeeds, name) - if result.kind == skStub: loadStub(result) - -proc sysTypeFromName(name: string): PType = - result = getSysSym(name).typ - -proc getSysType(kind: TTypeKind): PType = - result = gSysTypes[kind] - if result == nil: - case kind - of tyInt: result = sysTypeFromName("int") - of tyInt8: result = sysTypeFromName("int8") - of tyInt16: result = sysTypeFromName("int16") - of tyInt32: result = sysTypeFromName("int32") - of tyInt64: result = sysTypeFromName("int64") - of tyFloat: result = sysTypeFromName("float") - of tyFloat32: result = sysTypeFromName("float32") - of tyFloat64: result = sysTypeFromName("float64") - of tyBool: result = sysTypeFromName("bool") - of tyChar: result = sysTypeFromName("char") - of tyString: result = sysTypeFromName("string") - of tyCstring: result = sysTypeFromName("cstring") - of tyPointer: result = sysTypeFromName("pointer") - of tyNil: result = newSysType(tyNil, ptrSize) - else: InternalError("request for typekind: " & $kind) - gSysTypes[kind] = result - if result.kind != kind: - InternalError("wanted: " & $kind & " got: " & $result.kind) - if result == nil: InternalError("type not found: " & $kind) - -proc getCompilerProc(name: string): PSym = - var ident = getIdent(name, getNormalizedHash(name)) - result = StrTableGet(compilerprocs, ident) - if result == nil: - result = StrTableGet(rodCompilerProcs, ident) - if result != nil: - strTableAdd(compilerprocs, result) - if result.kind == skStub: loadStub(result) - -proc registerCompilerProc(s: PSym) = - strTableAdd(compilerprocs, s) - -proc InitSystem(tab: var TSymTab) = nil -proc FinishSystem(tab: TStrTable) = nil - -initStrTable(compilerprocs) - diff --git a/rod/main.nim b/rod/main.nim deleted file mode 100755 index 11a139144..000000000 --- a/rod/main.nim +++ /dev/null @@ -1,279 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# implements the command dispatcher and several commands as well as the -# module handling - -import - llstream, strutils, ast, astalgo, scanner, syntaxes, rnimsyn, options, msgs, - os, lists, condsyms, rodread, rodwrite, ropes, trees, - wordrecg, sem, semdata, idents, passes, docgen, extccomp, - cgen, ecmasgen, - platform, nimconf, importer, passaux, depends, transf, evals, types - -const - has_LLVM_Backend = false - -when has_LLVM_Backend: - import llvmgen - -proc MainCommand*(cmd, filename: string) -# implementation -# ------------------ module handling ----------------------------------------- - -type - TFileModuleRec{.final.} = object - filename*: string - module*: PSym - - TFileModuleMap = seq[TFileModuleRec] - -var compMods: TFileModuleMap = @ [] - -proc registerModule(filename: string, module: PSym) = - # all compiled modules - var length = len(compMods) - setlen(compMods, length + 1) - compMods[length].filename = filename - compMods[length].module = module - -proc getModule(filename: string): PSym = - for i in countup(0, high(compMods)): - if sameFile(compMods[i].filename, filename): - return compMods[i].module - -proc newModule(filename: string): PSym = - # We cannot call ``newSym`` here, because we have to circumvent the ID - # mechanism, which we do in order to assign each module a persistent ID. - new(result) - result.id = - 1 # for better error checking - result.kind = skModule - result.name = getIdent(splitFile(filename).name) - if not isNimrodIdentifier(result.name.s): - rawMessage(errIdentifierExpected, result.name.s) - - result.owner = result # a module belongs to itself - result.info = newLineInfo(filename, 1, 1) - incl(result.flags, sfUsed) - initStrTable(result.tab) - RegisterModule(filename, result) - StrTableAdd(result.tab, result) # a module knows itself - -proc CompileModule(filename: string, isMainFile, isSystemFile: bool): PSym -proc importModule(filename: string): PSym = - # this is called by the semantic checking phase - result = getModule(filename) - if result == nil: - # compile the module - result = compileModule(filename, false, false) - elif sfSystemModule in result.flags: - LocalError(result.info, errAttemptToRedefine, result.Name.s) - -proc CompileModule(filename: string, isMainFile, isSystemFile: bool): PSym = - var rd: PRodReader = nil - var f = addFileExt(filename, nimExt) - result = newModule(filename) - if isMainFile: incl(result.flags, sfMainModule) - if isSystemFile: incl(result.flags, sfSystemModule) - if (gCmd == cmdCompileToC) or (gCmd == cmdCompileToCpp): - rd = handleSymbolFile(result, f) - if result.id < 0: - InternalError("handleSymbolFile should have set the module\'s ID") - else: - result.id = getID() - processModule(result, f, nil, rd) - -proc CompileProject(filename: string) = - discard CompileModule(JoinPath(options.libpath, addFileExt("system", nimExt)), - false, true) - discard CompileModule(addFileExt(filename, nimExt), true, false) - -proc semanticPasses() = - registerPass(verbosePass()) - registerPass(sem.semPass()) - registerPass(transf.transfPass()) - -proc CommandGenDepend(filename: string) = - semanticPasses() - registerPass(genDependPass()) - registerPass(cleanupPass()) - compileProject(filename) - generateDot(filename) - execExternalProgram("dot -Tpng -o" & changeFileExt(filename, "png") & ' ' & - changeFileExt(filename, "dot")) - -proc CommandCheck(filename: string) = - msgs.gErrorMax = high(int) # do not stop after first error - semanticPasses() # use an empty backend for semantic checking only - compileProject(filename) - -proc CommandCompileToC(filename: string) = - semanticPasses() - registerPass(cgen.cgenPass()) - registerPass(rodwrite.rodwritePass()) - #registerPass(cleanupPass()) - compileProject(filename) - if gCmd != cmdRun: - extccomp.CallCCompiler(changeFileExt(filename, "")) - -when has_LLVM_Backend: - proc CommandCompileToLLVM(filename: string) = - semanticPasses() - registerPass(llvmgen.llvmgenPass()) - registerPass(rodwrite.rodwritePass()) - #registerPass(cleanupPass()) - compileProject(filename) - -proc CommandCompileToEcmaScript(filename: string) = - incl(gGlobalOptions, optSafeCode) - setTarget(osEcmaScript, cpuEcmaScript) - initDefines() - semanticPasses() - registerPass(ecmasgenPass()) - compileProject(filename) - -proc CommandInteractive() = - msgs.gErrorMax = high(int) # do not stop after first error - incl(gGlobalOptions, optSafeCode) - setTarget(osNimrodVM, cpuNimrodVM) - initDefines() - registerPass(verbosePass()) - registerPass(sem.semPass()) - registerPass(transf.transfPass()) - registerPass(evals.evalPass()) # load system module: - discard CompileModule(JoinPath(options.libpath, addFileExt("system", nimExt)), - false, true) - var m = newModule("stdin") - m.id = getID() - incl(m.flags, sfMainModule) - processModule(m, "stdin", LLStreamOpenStdIn(), nil) - -proc CommandPretty(filename: string) = - var module = parseFile(addFileExt(filename, NimExt)) - if module != nil: - renderModule(module, getOutFile(filename, "pretty." & NimExt)) - -proc CommandScan(filename: string) = - var f = addFileExt(filename, nimExt) - var stream = LLStreamOpen(f, fmRead) - if stream != nil: - var - L: TLexer - tok: PToken - new(tok) - openLexer(L, f, stream) - while true: - rawGetTok(L, tok[]) - PrintTok(tok) - if tok.tokType == tkEof: break - CloseLexer(L) - else: - rawMessage(errCannotOpenFile, f) - -proc CommandSuggest(filename: string) = - msgs.gErrorMax = high(int) # do not stop after first error - semanticPasses() - compileProject(filename) - -proc WantFile(filename: string) = - if filename == "": - Fatal(newLineInfo("command line", 1, 1), errCommandExpectsFilename) - -proc MainCommand(cmd, filename: string) = - appendStr(searchPaths, options.libpath) - if filename != "": - # current path is always looked first for modules - prependStr(searchPaths, splitFile(filename).dir) - setID(100) - passes.gIncludeFile = syntaxes.parseFile - passes.gImportModule = importModule - case cmd.normalize - of "c", "cc", "compile", "compiletoc": - # compile means compileToC currently - gCmd = cmdCompileToC - wantFile(filename) - CommandCompileToC(filename) - of "compiletocpp": - extccomp.cExt = ".cpp" - gCmd = cmdCompileToCpp - wantFile(filename) - CommandCompileToC(filename) - of "oc", "compiletooc": - extccomp.cExt = ".m" - gCmd = cmdCompileToOC - wantFile(filename) - CommandCompileToC(filename) - of "run": - gCmd = cmdRun - wantFile(filename) - when hasTinyCBackend: - extccomp.setCC("tcc") - CommandCompileToC(filename) - else: - rawMessage(errInvalidCommandX, cmd) - of "js", "compiletoecmascript": - gCmd = cmdCompileToEcmaScript - wantFile(filename) - CommandCompileToEcmaScript(filename) - of "compiletollvm": - gCmd = cmdCompileToLLVM - wantFile(filename) - when has_LLVM_Backend: - CommandCompileToLLVM(filename) - else: - rawMessage(errInvalidCommandX, cmd) - of "pretty": - gCmd = cmdPretty - wantFile(filename) #CommandExportSymbols(filename); - CommandPretty(filename) - of "doc": - gCmd = cmdDoc - LoadSpecialConfig(DocConfig) - wantFile(filename) - CommandDoc(filename) - of "rst2html": - gCmd = cmdRst2html - LoadSpecialConfig(DocConfig) - wantFile(filename) - CommandRst2Html(filename) - of "rst2tex": - gCmd = cmdRst2tex - LoadSpecialConfig(DocTexConfig) - wantFile(filename) - CommandRst2TeX(filename) - of "gendepend": - gCmd = cmdGenDepend - wantFile(filename) - CommandGenDepend(filename) - of "dump": - gCmd = cmdDump - condsyms.ListSymbols() - for it in iterSearchPath(): MsgWriteln(it) - of "check": - gCmd = cmdCheck - wantFile(filename) - CommandCheck(filename) - of "parse": - gCmd = cmdParse - wantFile(filename) - discard parseFile(addFileExt(filename, nimExt)) - of "scan": - gCmd = cmdScan - wantFile(filename) - CommandScan(filename) - MsgWriteln("Beware: Indentation tokens depend on the parser\'s state!") - of "i": - gCmd = cmdInteractive - CommandInteractive() - of "idetools": - gCmd = cmdIdeTools - wantFile(filename) - CommandSuggest(filename) - else: rawMessage(errInvalidCommandX, cmd) - diff --git a/rod/msgs.nim b/rod/msgs.nim deleted file mode 100755 index 97d4179da..000000000 --- a/rod/msgs.nim +++ /dev/null @@ -1,580 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - options, strutils, os - -type - TMsgKind* = enum - errUnknown, errIllFormedAstX, errCannotOpenFile, errInternal, errGenerated, - errXCompilerDoesNotSupportCpp, errStringLiteralExpected, - errIntLiteralExpected, errInvalidCharacterConstant, - errClosingTripleQuoteExpected, errClosingQuoteExpected, - errTabulatorsAreNotAllowed, errInvalidToken, errLineTooLong, - errInvalidNumber, errNumberOutOfRange, errNnotAllowedInCharacter, - errClosingBracketExpected, errMissingFinalQuote, errIdentifierExpected, - errOperatorExpected, errTokenExpected, errStringAfterIncludeExpected, - errRecursiveDependencyX, errOnOrOffExpected, errNoneSpeedOrSizeExpected, - errInvalidPragma, errUnknownPragma, errInvalidDirectiveX, - errAtPopWithoutPush, errEmptyAsm, errInvalidIndentation, - errExceptionExpected, errExceptionAlreadyHandled, errYieldNotAllowedHere, - errInvalidNumberOfYieldExpr, errCannotReturnExpr, errAttemptToRedefine, - errStmtInvalidAfterReturn, errStmtExpected, errInvalidLabel, - errInvalidCmdLineOption, errCmdLineArgExpected, errCmdLineNoArgExpected, - errInvalidVarSubstitution, errUnknownVar, errUnknownCcompiler, - errOnOrOffExpectedButXFound, errNoneBoehmRefcExpectedButXFound, - errNoneSpeedOrSizeExpectedButXFound, errGuiConsoleOrLibExpectedButXFound, - errUnknownOS, errUnknownCPU, errGenOutExpectedButXFound, - errArgsNeedRunOption, errInvalidMultipleAsgn, errColonOrEqualsExpected, - errExprExpected, errUndeclaredIdentifier, errUseQualifier, errTypeExpected, - errSystemNeeds, errExecutionOfProgramFailed, errNotOverloadable, - errInvalidArgForX, errStmtHasNoEffect, errXExpectsTypeOrValue, - errXExpectsArrayType, errIteratorCannotBeInstantiated, errExprXAmbiguous, - errConstantDivisionByZero, errOrdinalTypeExpected, - errOrdinalOrFloatTypeExpected, errOverOrUnderflow, - errCannotEvalXBecauseIncompletelyDefined, errChrExpectsRange0_255, - errDynlibRequiresExportc, errUndeclaredFieldX, errNilAccess, - errIndexOutOfBounds, errIndexTypesDoNotMatch, errBracketsInvalidForType, - errValueOutOfSetBounds, errFieldInitTwice, errFieldNotInit, - errExprXCannotBeCalled, errExprHasNoType, errExprXHasNoType, - errCastNotInSafeMode, errExprCannotBeCastedToX, errCommaOrParRiExpected, - errCurlyLeOrParLeExpected, errSectionExpected, errRangeExpected, - errMagicOnlyInSystem, errPowerOfTwoExpected, - errStringMayNotBeEmpty, errCallConvExpected, errProcOnlyOneCallConv, - errSymbolMustBeImported, errExprMustBeBool, errConstExprExpected, - errDuplicateCaseLabel, errRangeIsEmpty, errSelectorMustBeOfCertainTypes, - errSelectorMustBeOrdinal, errOrdXMustNotBeNegative, errLenXinvalid, - errWrongNumberOfVariables, errExprCannotBeRaised, errBreakOnlyInLoop, - errTypeXhasUnknownSize, errConstNeedsConstExpr, errConstNeedsValue, - errResultCannotBeOpenArray, errSizeTooBig, errSetTooBig, - errBaseTypeMustBeOrdinal, errInheritanceOnlyWithNonFinalObjects, - errInheritanceOnlyWithEnums, errIllegalRecursionInTypeX, - errCannotInstantiateX, errExprHasNoAddress, errVarForOutParamNeeded, - errPureTypeMismatch, errTypeMismatch, errButExpected, errButExpectedX, - errAmbiguousCallXYZ, errWrongNumberOfArguments, errXCannotBePassedToProcVar, - errXCannotBeInParamDecl, errPragmaOnlyInHeaderOfProc, errImplOfXNotAllowed, - errImplOfXexpected, errNoSymbolToBorrowFromFound, errDiscardValue, - errInvalidDiscard, errIllegalConvFromXtoY, errCannotBindXTwice, - errInvalidOrderInArrayConstructor, - errInvalidOrderInEnumX, errEnumXHasHoles, errExceptExpected, errInvalidTry, - errOptionExpected, errXisNoLabel, errNotAllCasesCovered, - errUnkownSubstitionVar, errComplexStmtRequiresInd, errXisNotCallable, - errNoPragmasAllowedForX, errNoGenericParamsAllowedForX, - errInvalidParamKindX, errDefaultArgumentInvalid, errNamedParamHasToBeIdent, - errNoReturnTypeForX, errConvNeedsOneArg, errInvalidPragmaX, - errXNotAllowedHere, errInvalidControlFlowX, errATypeHasNoValue, - errXisNoType, errCircumNeedsPointer, errInvalidExpression, - errInvalidExpressionX, errEnumHasNoValueX, errNamedExprExpected, - errNamedExprNotAllowed, errXExpectsOneTypeParam, - errArrayExpectsTwoTypeParams, errInvalidVisibilityX, errInitHereNotAllowed, - errXCannotBeAssignedTo, errIteratorNotAllowed, errXNeedsReturnType, - errInvalidCommandX, errXOnlyAtModuleScope, - errXNeedsParamObjectType, - errTemplateInstantiationTooNested, errInstantiationFrom, - errInvalidIndexValueForTuple, errCommandExpectsFilename, errXExpected, - errInvalidSectionStart, errGridTableNotImplemented, errGeneralParseError, - errNewSectionExpected, errWhitespaceExpected, errXisNoValidIndexFile, - errCannotRenderX, errVarVarTypeNotAllowed, errIsExpectsTwoArguments, - errIsExpectsObjectTypes, errXcanNeverBeOfThisSubtype, errTooManyIterations, - errCannotInterpretNodeX, errFieldXNotFound, errInvalidConversionFromTypeX, - errAssertionFailed, errCannotGenerateCodeForX, errXRequiresOneArgument, - errUnhandledExceptionX, errCyclicTree, errXisNoMacroOrTemplate, - errXhasSideEffects, errIteratorExpected, errUser, warnCannotOpenFile, - warnOctalEscape, warnXIsNeverRead, warnXmightNotBeenInit, - warnCannotWriteMO2, warnCannotReadMO2, warnDeprecated, - warnSmallLshouldNotBeUsed, warnUnknownMagic, warnRedefinitionOfLabel, - warnUnknownSubstitutionX, warnLanguageXNotSupported, warnCommentXIgnored, - warnXisPassedToProcVar, warnDerefDeprecated, - warnUser, - hintSuccess, hintSuccessX, - hintLineTooLong, hintXDeclaredButNotUsed, hintConvToBaseNotNeeded, - hintConvFromXtoItselfNotNeeded, hintExprAlwaysX, hintQuitCalled, - hintProcessing, hintCodeBegin, hintCodeEnd, hintConf, hintPath, hintUser - -const - MsgKindToStr*: array[TMsgKind, string] = [ - errUnknown: "unknown error", - errIllFormedAstX: "illformed AST: $1", - errCannotOpenFile: "cannot open \'$1\'", - errInternal: "internal error: $1", - errGenerated: "$1", - errXCompilerDoesNotSupportCpp: "\'$1\' compiler does not support C++", - errStringLiteralExpected: "string literal expected", - errIntLiteralExpected: "integer literal expected", - errInvalidCharacterConstant: "invalid character constant", - errClosingTripleQuoteExpected: "closing \"\"\" expected, but end of file reached", - errClosingQuoteExpected: "closing \" expected", - errTabulatorsAreNotAllowed: "tabulators are not allowed", - errInvalidToken: "invalid token: $1", - errLineTooLong: "line too long", - errInvalidNumber: "$1 is not a valid number", - errNumberOutOfRange: "number $1 out of valid range", - errNnotAllowedInCharacter: "\\n not allowed in character literal", - errClosingBracketExpected: "closing ']' expected, but end of file reached", - errMissingFinalQuote: "missing final \'", - errIdentifierExpected: "identifier expected, but found \'$1\'", - errOperatorExpected: "operator expected, but found \'$1\'", - errTokenExpected: "\'$1\' expected", - errStringAfterIncludeExpected: "string after \'include\' expected", - errRecursiveDependencyX: "recursive dependency: \'$1\'", - errOnOrOffExpected: "\'on\' or \'off\' expected", - errNoneSpeedOrSizeExpected: "\'none\', \'speed\' or \'size\' expected", - errInvalidPragma: "invalid pragma", - errUnknownPragma: "unknown pragma: \'$1\'", - errInvalidDirectiveX: "invalid directive: \'$1\'", - errAtPopWithoutPush: "\'pop\' without a \'push\' pragma", - errEmptyAsm: "empty asm statement", - errInvalidIndentation: "invalid indentation", - errExceptionExpected: "exception expected", - errExceptionAlreadyHandled: "exception already handled", - errYieldNotAllowedHere: "\'yield\' only allowed in a loop of an iterator", - errInvalidNumberOfYieldExpr: "invalid number of \'yield\' expresions", - errCannotReturnExpr: "current routine cannot return an expression", - errAttemptToRedefine: "redefinition of \'$1\'", - errStmtInvalidAfterReturn: "statement not allowed after \'return\', \'break\' or \'raise\'", - errStmtExpected: "statement expected", - errInvalidLabel: "\'$1\' is no label", - errInvalidCmdLineOption: "invalid command line option: \'$1\'", - errCmdLineArgExpected: "argument for command line option expected: \'$1\'", - errCmdLineNoArgExpected: "invalid argument for command line option: \'$1\'", - errInvalidVarSubstitution: "invalid variable substitution in \'$1\'", - errUnknownVar: "unknown variable: \'$1\'", - errUnknownCcompiler: "unknown C compiler: \'$1\'", - errOnOrOffExpectedButXFound: "\'on\' or \'off\' expected, but \'$1\' found", - errNoneBoehmRefcExpectedButXFound: "'none', 'boehm' or 'refc' expected, but '$1' found", - errNoneSpeedOrSizeExpectedButXFound: "'none', 'speed' or 'size' expected, but '$1' found", - errGuiConsoleOrLibExpectedButXFound: "'gui', 'console' or 'lib' expected, but '$1' found", - errUnknownOS: "unknown OS: '$1'", - errUnknownCPU: "unknown CPU: '$1'", - errGenOutExpectedButXFound: "'c', 'c++' or 'yaml' expected, but '$1' found", - errArgsNeedRunOption: "arguments can only be given if the '--run' option is selected", - errInvalidMultipleAsgn: "multiple assignment is not allowed", - errColonOrEqualsExpected: "\':\' or \'=\' expected, but found \'$1\'", - errExprExpected: "expression expected, but found \'$1\'", - errUndeclaredIdentifier: "undeclared identifier: \'$1\'", - errUseQualifier: "ambiguous identifier: \'$1\' -- use a qualifier", - errTypeExpected: "type expected", - errSystemNeeds: "system module needs \'$1\'", - errExecutionOfProgramFailed: "execution of an external program failed", - errNotOverloadable: "overloaded \'$1\' leads to ambiguous calls", - errInvalidArgForX: "invalid argument for \'$1\'", - errStmtHasNoEffect: "statement has no effect", - errXExpectsTypeOrValue: "\'$1\' expects a type or value", - errXExpectsArrayType: "\'$1\' expects an array type", - errIteratorCannotBeInstantiated: "'$1' cannot be instantiated because its body has not been compiled yet", - errExprXAmbiguous: "expression '$1' ambiguous in this context", - errConstantDivisionByZero: "constant division by zero", - errOrdinalTypeExpected: "ordinal type expected", - errOrdinalOrFloatTypeExpected: "ordinal or float type expected", - errOverOrUnderflow: "over- or underflow", - errCannotEvalXBecauseIncompletelyDefined: "cannot evalutate '$1' because type is not defined completely", - errChrExpectsRange0_255: "\'chr\' expects an int in the range 0..255", - errDynlibRequiresExportc: "\'dynlib\' requires \'exportc\'", - errUndeclaredFieldX: "undeclared field: \'$1\'", - errNilAccess: "attempt to access a nil address", - errIndexOutOfBounds: "index out of bounds", - errIndexTypesDoNotMatch: "index types do not match", - errBracketsInvalidForType: "\'[]\' operator invalid for this type", - errValueOutOfSetBounds: "value out of set bounds", - errFieldInitTwice: "field initialized twice: \'$1\'", - errFieldNotInit: "field \'$1\' not initialized", - errExprXCannotBeCalled: "expression \'$1\' cannot be called", - errExprHasNoType: "expression has no type", - errExprXHasNoType: "expression \'$1\' has no type (or is ambiguous)", - errCastNotInSafeMode: "\'cast\' not allowed in safe mode", - errExprCannotBeCastedToX: "expression cannot be casted to $1", - errCommaOrParRiExpected: "',' or ')' expected", - errCurlyLeOrParLeExpected: "\'{\' or \'(\' expected", - errSectionExpected: "section (\'type\', \'proc\', etc.) expected", - errRangeExpected: "range expected", - errMagicOnlyInSystem: "\'magic\' only allowed in system module", - errPowerOfTwoExpected: "power of two expected", - errStringMayNotBeEmpty: "string literal may not be empty", - errCallConvExpected: "calling convention expected", - errProcOnlyOneCallConv: "a proc can only have one calling convention", - errSymbolMustBeImported: "symbol must be imported if 'lib' pragma is used", - errExprMustBeBool: "expression must be of type 'bool'", - errConstExprExpected: "constant expression expected", - errDuplicateCaseLabel: "duplicate case label", - errRangeIsEmpty: "range is empty", - errSelectorMustBeOfCertainTypes: "selector must be of an ordinal type, float or string", - errSelectorMustBeOrdinal: "selector must be of an ordinal type", - errOrdXMustNotBeNegative: "ord($1) must not be negative", - errLenXinvalid: "len($1) must be less than 32768", - errWrongNumberOfVariables: "wrong number of variables", - errExprCannotBeRaised: "only objects can be raised", - errBreakOnlyInLoop: "'break' only allowed in loop construct", - errTypeXhasUnknownSize: "type \'$1\' has unknown size", - errConstNeedsConstExpr: "a constant can only be initialized with a constant expression", - errConstNeedsValue: "a constant needs a value", - errResultCannotBeOpenArray: "the result type cannot be on open array", - errSizeTooBig: "computing the type\'s size produced an overflow", - errSetTooBig: "set is too large", - errBaseTypeMustBeOrdinal: "base type of a set must be an ordinal", - errInheritanceOnlyWithNonFinalObjects: "inheritance only works with non-final objects", - errInheritanceOnlyWithEnums: "inheritance only works with an enum", - errIllegalRecursionInTypeX: "illegal recursion in type \'$1\'", - errCannotInstantiateX: "cannot instantiate: \'$1\'", - errExprHasNoAddress: "expression has no address", - errVarForOutParamNeeded: "for a \'var\' type a variable needs to be passed", - errPureTypeMismatch: "type mismatch", - errTypeMismatch: "type mismatch: got (", - errButExpected: "but expected one of: ", - errButExpectedX: "but expected \'$1\'", - errAmbiguousCallXYZ: "ambiguous call; both $1 and $2 match for: $3", - errWrongNumberOfArguments: "wrong number of arguments", - errXCannotBePassedToProcVar: "\'$1\' cannot be passed to a procvar", - errXCannotBeInParamDecl: "$1 cannot be declared in parameter declaration", - errPragmaOnlyInHeaderOfProc: "pragmas are only in the header of a proc allowed", - errImplOfXNotAllowed: "implementation of \'$1\' is not allowed", - errImplOfXexpected: "implementation of \'$1\' expected", - errNoSymbolToBorrowFromFound: "no symbol to borrow from found", - errDiscardValue: "value returned by statement has to be discarded", - errInvalidDiscard: "statement returns no value that can be discarded", - errIllegalConvFromXtoY: "conversion from $1 to $2 is invalid", - errCannotBindXTwice: "cannot bind parameter \'$1\' twice", - errInvalidOrderInArrayConstructor: "invalid order in array constructor", - errInvalidOrderInEnumX: "invalid order in enum \'$1\'", - errEnumXHasHoles: "enum \'$1\' has holes", - errExceptExpected: "\'except\' or \'finally\' expected", - errInvalidTry: "after catch all \'except\' or \'finally\' no section may follow", - errOptionExpected: "option expected, but found \'$1\'", - errXisNoLabel: "\'$1\' is not a label", - errNotAllCasesCovered: "not all cases are covered", - errUnkownSubstitionVar: "unknown substitution variable: \'$1\'", - errComplexStmtRequiresInd: "complex statement requires indentation", - errXisNotCallable: "\'$1\' is not callable", - errNoPragmasAllowedForX: "no pragmas allowed for $1", - errNoGenericParamsAllowedForX: "no generic parameters allowed for $1", - errInvalidParamKindX: "invalid param kind: \'$1\'", - errDefaultArgumentInvalid: "default argument invalid", - errNamedParamHasToBeIdent: "named parameter has to be an identifier", - errNoReturnTypeForX: "no return type for $1 allowed", - errConvNeedsOneArg: "a type conversion needs exactly one argument", - errInvalidPragmaX: "invalid pragma: $1", - errXNotAllowedHere: "$1 not allowed here", - errInvalidControlFlowX: "invalid control flow: $1", - errATypeHasNoValue: "a type has no value", - errXisNoType: "invalid type: \'$1\'", - errCircumNeedsPointer: "\'^\' needs a pointer or reference type", - errInvalidExpression: "invalid expression", - errInvalidExpressionX: "invalid expression: \'$1\'", - errEnumHasNoValueX: "enum has no value \'$1\'", - errNamedExprExpected: "named expression expected", - errNamedExprNotAllowed: "named expression not allowed here", - errXExpectsOneTypeParam: "\'$1\' expects one type parameter", - errArrayExpectsTwoTypeParams: "array expects two type parameters", - errInvalidVisibilityX: "invalid visibility: \'$1\'", - errInitHereNotAllowed: "initialization not allowed here", - errXCannotBeAssignedTo: "\'$1\' cannot be assigned to", - errIteratorNotAllowed: "iterators can only be defined at the module\'s top level", - errXNeedsReturnType: "$1 needs a return type", - errInvalidCommandX: "invalid command: \'$1\'", - errXOnlyAtModuleScope: "\'$1\' is only allowed at top level", - errXNeedsParamObjectType: "'$1' needs a parameter that has an object type", - errTemplateInstantiationTooNested: "template/macro instantiation too nested", - errInstantiationFrom: "instantiation from here", - errInvalidIndexValueForTuple: "invalid index value for tuple subscript", - errCommandExpectsFilename: "command expects a filename argument", - errXExpected: "\'$1\' expected", - errInvalidSectionStart: "invalid section start", - errGridTableNotImplemented: "grid table is not implemented", - errGeneralParseError: "general parse error", - errNewSectionExpected: "new section expected", - errWhitespaceExpected: "whitespace expected, got \'$1\'", - errXisNoValidIndexFile: "\'$1\' is no valid index file", - errCannotRenderX: "cannot render reStructuredText element \'$1\'", - errVarVarTypeNotAllowed: "type \'var var\' is not allowed", - errIsExpectsTwoArguments: "\'is\' expects two arguments", - errIsExpectsObjectTypes: "\'is\' expects object types", - errXcanNeverBeOfThisSubtype: "\'$1\' can never be of this subtype", - errTooManyIterations: "interpretation requires too many iterations", - errCannotInterpretNodeX: "cannot interpret node kind \'$1\'", - errFieldXNotFound: "field \'$1\' cannot be found", - errInvalidConversionFromTypeX: "invalid conversion from type \'$1\'", - errAssertionFailed: "assertion failed", - errCannotGenerateCodeForX: "cannot generate code for \'$1\'", - errXRequiresOneArgument: "$1 requires one parameter", - errUnhandledExceptionX: "unhandled exception: $1", - errCyclicTree: "macro returned a cyclic abstract syntax tree", - errXisNoMacroOrTemplate: "\'$1\' is no macro or template", - errXhasSideEffects: "\'$1\' can have side effects", - errIteratorExpected: "iterator within for loop context expected", - errUser: "$1", - warnCannotOpenFile: "cannot open \'$1\' [CannotOpenFile]", - warnOctalEscape: "octal escape sequences do not exist; leading zero is ignored [OctalEscape]", - warnXIsNeverRead: "\'$1\' is never read [XIsNeverRead]", - warnXmightNotBeenInit: "\'$1\' might not have been initialized [XmightNotBeenInit]", - warnCannotWriteMO2: "cannot write file \'$1\' [CannotWriteMO2]", - warnCannotReadMO2: "cannot read file \'$1\' [CannotReadMO2]", - warnDeprecated: "\'$1\' is deprecated [Deprecated]", - warnSmallLshouldNotBeUsed: "\'l\' should not be used as an identifier; may look like \'1\' (one) [SmallLshouldNotBeUsed]", - warnUnknownMagic: "unknown magic \'$1\' might crash the compiler [UnknownMagic]", - warnRedefinitionOfLabel: "redefinition of label \'$1\' [RedefinitionOfLabel]", - warnUnknownSubstitutionX: "unknown substitution \'$1\' [UnknownSubstitutionX]", - warnLanguageXNotSupported: "language \'$1\' not supported [LanguageXNotSupported]", - warnCommentXIgnored: "comment \'$1\' ignored [CommentXIgnored]", - warnXisPassedToProcVar: "\'$1\' is passed to a procvar; deprecated [XisPassedToProcVar]", - warnDerefDeprecated: "p^ is deprecated; use p[] instead [DerefDeprecated]", - warnUser: "$1 [User]", - hintSuccess: "operation successful [Success]", - hintSuccessX: "operation successful ($1 lines compiled; $2 sec total) [SuccessX]", - hintLineTooLong: "line too long [LineTooLong]", - hintXDeclaredButNotUsed: "\'$1\' is declared but not used [XDeclaredButNotUsed]", - hintConvToBaseNotNeeded: "conversion to base object is not needed [ConvToBaseNotNeeded]", - hintConvFromXtoItselfNotNeeded: "conversion from $1 to itself is pointless [ConvFromXtoItselfNotNeeded]", - hintExprAlwaysX: "expression evaluates always to \'$1\' [ExprAlwaysX]", - hintQuitCalled: "quit() called [QuitCalled]", - hintProcessing: "$1 [Processing]", - hintCodeBegin: "generated code listing: [CodeBegin]", - hintCodeEnd: "end of listing [CodeEnd]", - hintConf: "used config file \'$1\' [Conf]", - hintPath: "added path: '$1' [Path]", - hintUser: "$1 [User]"] - -const - WarningsToStr*: array[0..15, string] = ["CannotOpenFile", "OctalEscape", - "XIsNeverRead", "XmightNotBeenInit", "CannotWriteMO2", "CannotReadMO2", - "Deprecated", "SmallLshouldNotBeUsed", "UnknownMagic", - "RedefinitionOfLabel", "UnknownSubstitutionX", "LanguageXNotSupported", - "CommentXIgnored", "XisPassedToProcVar", "DerefDeprecated", "User"] - - HintsToStr*: array[0..13, string] = ["Success", "SuccessX", "LineTooLong", - "XDeclaredButNotUsed", "ConvToBaseNotNeeded", "ConvFromXtoItselfNotNeeded", - "ExprAlwaysX", "QuitCalled", "Processing", "CodeBegin", "CodeEnd", "Conf", - "Path", - "User"] - -const - fatalMin* = errUnknown - fatalMax* = errInternal - errMin* = errUnknown - errMax* = errUser - warnMin* = warnCannotOpenFile - warnMax* = pred(hintSuccess) - hintMin* = hintSuccess - hintMax* = high(TMsgKind) - -type - TNoteKind* = range[warnMin..hintMax] # "notes" are warnings or hints - TNoteKinds* = set[TNoteKind] - TLineInfo*{.final.} = object # This is designed to be as small as possible, - # because it is used - # in syntax nodes. We safe space here by using - # two int16 and an int32. - # On 64 bit and on 32 bit systems this is - # only 8 bytes. - line*, col*: int16 - fileIndex*: int32 - - ERecoverableError* = object of EInvalidValue - -proc raiseRecoverableError*() {.noinline, noreturn.} = - raise newException(ERecoverableError, "") - -var - gNotes*: TNoteKinds = {low(TNoteKind)..high(TNoteKind)} - gErrorCounter*: int = 0 # counts the number of errors - gHintCounter*: int = 0 - gWarnCounter*: int = 0 - gErrorMax*: int = 1 # stop after gErrorMax errors - -# this format is understood by many text editors: it is the same that -# Borland and Freepascal use -const - PosErrorFormat* = "$1($2, $3) Error: $4" - PosWarningFormat* = "$1($2, $3) Warning: $4" - PosHintFormat* = "$1($2, $3) Hint: $4" - RawErrorFormat* = "Error: $1" - RawWarningFormat* = "Warning: $1" - RawHintFormat* = "Hint: $1" - -proc UnknownLineInfo*(): TLineInfo = - result.line = int16(-1) - result.col = int16(-1) - result.fileIndex = -1 - -var - filenames: seq[string] = @[] - msgContext: seq[TLineInfo] = @[] - -proc pushInfoContext*(info: TLineInfo) = - msgContext.add(info) - -proc popInfoContext*() = - setlen(msgContext, len(msgContext) - 1) - -proc includeFilename*(f: string): int = - for i in countdown(high(filenames), low(filenames)): - if filenames[i] == f: - return i - result = len(filenames) - filenames.add(f) - -proc newLineInfo*(filename: string, line, col: int): TLineInfo = - result.fileIndex = includeFilename(filename) - result.line = int16(line) - result.col = int16(col) - -proc ToFilename*(info: TLineInfo): string = - if info.fileIndex < 0: result = "???" - else: result = filenames[info.fileIndex] - -proc ToLinenumber*(info: TLineInfo): int {.inline.} = - result = info.line - -proc toColumn*(info: TLineInfo): int {.inline.} = - result = info.col - -var checkPoints: seq[TLineInfo] = @[] - -proc addCheckpoint*(info: TLineInfo) = - checkPoints.add(info) - -proc addCheckpoint*(filename: string, line: int) = - addCheckpoint(newLineInfo(filename, line, - 1)) - -proc OutWriteln*(s: string) = - ## Writes to stdout. Always. - Writeln(stdout, s) - -proc MsgWriteln*(s: string) = - ## Writes to stdout. If --stdout option is given, writes to stderr instead. - if optStdout in gGlobalOptions: Writeln(stderr, s) - else: Writeln(stdout, s) - -proc coordToStr(coord: int): string = - if coord == -1: result = "???" - else: result = $coord - -proc MsgKindToString*(kind: TMsgKind): string = - # later versions may provide translated error messages - result = msgKindToStr[kind] - -proc getMessageStr(msg: TMsgKind, arg: string): string = - result = msgKindToString(msg) % [arg] - -type - TCheckPointResult* = enum - cpNone, cpFuzzy, cpExact - -proc inCheckpoint*(current: TLineInfo): TCheckPointResult = - for i in countup(0, high(checkPoints)): - if current.fileIndex == checkPoints[i].fileIndex: - if current.line == checkPoints[i].line and - abs(current.col-checkPoints[i].col) < 4: - return cpExact - if current.line >= checkPoints[i].line: - return cpFuzzy - -type - TErrorHandling = enum doNothing, doAbort, doRaise - -proc handleError(msg: TMsgKind, eh: TErrorHandling) = - if msg == errInternal: - assert(false) # we want a stack trace here - if (msg >= fatalMin) and (msg <= fatalMax): - if gVerbosity >= 3: assert(false) - quit(1) - if (msg >= errMin) and (msg <= errMax): - inc(gErrorCounter) - options.gExitcode = 1'i8 - if gErrorCounter >= gErrorMax or eh == doAbort: - if gVerbosity >= 3: assert(false) - quit(1) # one error stops the compiler - elif eh == doRaise: - raiseRecoverableError() - -proc `==`(a, b: TLineInfo): bool = - result = a.line == b.line and a.fileIndex == b.fileIndex - -proc writeContext(lastinfo: TLineInfo) = - var info = lastInfo - for i in countup(0, len(msgContext) - 1): - if msgContext[i] != lastInfo and msgContext[i] != info: - MsgWriteln(posErrorFormat % [toFilename(msgContext[i]), - coordToStr(msgContext[i].line), - coordToStr(msgContext[i].col), - getMessageStr(errInstantiationFrom, "")]) - info = msgContext[i] - -proc rawMessage*(msg: TMsgKind, args: openarray[string]) = - var frmt: string - case msg - of errMin..errMax: - writeContext(unknownLineInfo()) - frmt = rawErrorFormat - of warnMin..warnMax: - if not (optWarns in gOptions): return - if not (msg in gNotes): return - frmt = rawWarningFormat - inc(gWarnCounter) - of hintMin..hintMax: - if not (optHints in gOptions): return - if not (msg in gNotes): return - frmt = rawHintFormat - inc(gHintCounter) - MsgWriteln(`%`(frmt, `%`(msgKindToString(msg), args))) - handleError(msg, doAbort) - -proc rawMessage*(msg: TMsgKind, arg: string) = - rawMessage(msg, [arg]) - -var - lastError = UnknownLineInfo() - -proc liMessage(info: TLineInfo, msg: TMsgKind, arg: string, - eh: TErrorHandling) = - var frmt: string - var ignoreMsg = false - case msg - of errMin..errMax: - writeContext(info) - frmt = posErrorFormat - # we try to filter error messages so that not two error message - # in the same file and line are produced: - ignoreMsg = lastError == info - lastError = info - of warnMin..warnMax: - ignoreMsg = optWarns notin gOptions or msg notin gNotes - frmt = posWarningFormat - inc(gWarnCounter) - of hintMin..hintMax: - ignoreMsg = optHints notin gOptions or msg notin gNotes - frmt = posHintFormat - inc(gHintCounter) - if not ignoreMsg: - MsgWriteln(frmt % [toFilename(info), coordToStr(info.line), - coordToStr(info.col), getMessageStr(msg, arg)]) - handleError(msg, eh) - -proc Fatal*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doAbort) - -proc GlobalError*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doRaise) - -proc LocalError*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doNothing) - -proc Message*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doNothing) - -proc GenericMessage*(info: TLineInfo, msg: TMsgKind, arg = "") = - ## does the right thing for old code that is written with "abort on first - ## error" in mind. - liMessage(info, msg, arg, doAbort) - -proc InternalError*(info: TLineInfo, errMsg: string) = - writeContext(info) - liMessage(info, errInternal, errMsg, doAbort) - -proc InternalError*(errMsg: string) = - writeContext(UnknownLineInfo()) - rawMessage(errInternal, errMsg) diff --git a/rod/nhashes.nim b/rod/nhashes.nim deleted file mode 100755 index b9dd3670a..000000000 --- a/rod/nhashes.nim +++ /dev/null @@ -1,150 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - strutils - -const - SmallestSize* = (1 shl 3) - 1 - DefaultSize* = (1 shl 11) - 1 - BiggestSize* = (1 shl 28) - 1 - -type - THash* = int - PHash* = ref THash - THashFunc* = proc (str: cstring): THash - -proc GetHash*(str: cstring): THash -proc GetHashCI*(str: cstring): THash -proc GetDataHash*(Data: Pointer, Size: int): THash -proc hashPtr*(p: Pointer): THash -proc GetHashStr*(s: string): THash -proc GetHashStrCI*(s: string): THash -proc getNormalizedHash*(s: string): THash - #function nextPowerOfTwo(x: int): int; -proc concHash*(h: THash, val: int): THash -proc finishHash*(h: THash): THash -# implementation - -proc concHash(h: THash, val: int): THash = - result = h +% val - result = result +% result shl 10 - result = result xor (result shr 6) - -proc finishHash(h: THash): THash = - result = h +% h shl 3 - result = result xor (result shr 11) - result = result +% result shl 15 - -proc GetDataHash(Data: Pointer, Size: int): THash = - var - h: THash - p: cstring - i, s: int - h = 0 - p = cast[cstring](Data) - i = 0 - s = size - while s > 0: - h = h +% ord(p[i]) - h = h +% h shl 10 - h = h xor (h shr 6) - Inc(i) - Dec(s) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - result = THash(h) - -proc hashPtr(p: Pointer): THash = - result = (cast[THash](p)) shr 3 # skip the alignment - -proc GetHash(str: cstring): THash = - var - h: THash - i: int - h = 0 - i = 0 - while str[i] != '\0': - h = h +% ord(str[i]) - h = h +% h shl 10 - h = h xor (h shr 6) - Inc(i) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - result = THash(h) - -proc GetHashStr(s: string): THash = - var h: THash - h = 0 - for i in countup(1, len(s)): - h = h +% ord(s[i]) - h = h +% h shl 10 - h = h xor (h shr 6) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - result = THash(h) - -proc getNormalizedHash(s: string): THash = - var - h: THash - c: Char - h = 0 - for i in countup(0, len(s) + 0 - 1): - c = s[i] - if c == '_': - continue # skip _ - if c in {'A'..'Z'}: - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = h +% ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - result = THash(h) - -proc GetHashStrCI(s: string): THash = - var - h: THash - c: Char - h = 0 - for i in countup(0, len(s) + 0 - 1): - c = s[i] - if c in {'A'..'Z'}: - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = h +% ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - result = THash(h) - -proc GetHashCI(str: cstring): THash = - var - h: THash - c: Char - i: int - h = 0 - i = 0 - while str[i] != '\0': - c = str[i] - if c in {'A'..'Z'}: - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = h +% ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - Inc(i) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - result = THash(h) diff --git a/rod/nimconf.nim b/rod/nimconf.nim deleted file mode 100755 index c41417fb1..000000000 --- a/rod/nimconf.nim +++ /dev/null @@ -1,257 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module handles the reading of the config file. - -import - llstream, nversion, commands, os, strutils, msgs, platform, condsyms, scanner, - options, idents, wordrecg - -proc LoadConfig*(project: string) -proc LoadSpecialConfig*(configfilename: string) -# implementation -# ---------------- configuration file parser ----------------------------- -# we use Nimrod's scanner here to safe space and work - -proc ppGetTok(L: var TLexer, tok: PToken) = - # simple filter - rawGetTok(L, tok[] ) - while (tok.tokType == tkInd) or (tok.tokType == tkSad) or - (tok.tokType == tkDed) or (tok.tokType == tkComment): - rawGetTok(L, tok[] ) - -proc parseExpr(L: var TLexer, tok: PToken): bool -proc parseAtom(L: var TLexer, tok: PToken): bool = - if tok.tokType == tkParLe: - ppGetTok(L, tok) - result = parseExpr(L, tok) - if tok.tokType == tkParRi: ppGetTok(L, tok) - else: lexMessage(L, errTokenExpected, "\')\'") - elif tok.ident.id == ord(wNot): - ppGetTok(L, tok) - result = not parseAtom(L, tok) - else: - result = isDefined(tok.ident) #condsyms.listSymbols(); - #writeln(tok.ident.s + ' has the value: ', result); - ppGetTok(L, tok) - -proc parseAndExpr(L: var TLexer, tok: PToken): bool = - var b: bool - result = parseAtom(L, tok) - while tok.ident.id == ord(wAnd): - ppGetTok(L, tok) # skip "and" - b = parseAtom(L, tok) - result = result and b - -proc parseExpr(L: var TLexer, tok: PToken): bool = - var b: bool - result = parseAndExpr(L, tok) - while tok.ident.id == ord(wOr): - ppGetTok(L, tok) # skip "or" - b = parseAndExpr(L, tok) - result = result or b - -proc EvalppIf(L: var TLexer, tok: PToken): bool = - ppGetTok(L, tok) # skip 'if' or 'elif' - result = parseExpr(L, tok) - if tok.tokType == tkColon: ppGetTok(L, tok) - else: lexMessage(L, errTokenExpected, "\':\'") - -var condStack: seq[bool] - -condStack = @ [] -proc doEnd(L: var TLexer, tok: PToken) = - if high(condStack) < 0: lexMessage(L, errTokenExpected, "@if") - ppGetTok(L, tok) # skip 'end' - setlen(condStack, high(condStack)) - -type - TJumpDest = enum - jdEndif, jdElseEndif - -proc jumpToDirective(L: var TLexer, tok: PToken, dest: TJumpDest) -proc doElse(L: var TLexer, tok: PToken) = - if high(condStack) < 0: lexMessage(L, errTokenExpected, "@if") - ppGetTok(L, tok) - if tok.tokType == tkColon: ppGetTok(L, tok) - if condStack[high(condStack)]: jumpToDirective(L, tok, jdEndif) - -proc doElif(L: var TLexer, tok: PToken) = - var res: bool - if high(condStack) < 0: lexMessage(L, errTokenExpected, "@if") - res = EvalppIf(L, tok) - if condStack[high(condStack)] or not res: jumpToDirective(L, tok, jdElseEndif) - else: condStack[high(condStack)] = true - -proc jumpToDirective(L: var TLexer, tok: PToken, dest: TJumpDest) = - var nestedIfs: int - nestedIfs = 0 - while True: - if (tok.ident != nil) and (tok.ident.s == "@"): - ppGetTok(L, tok) - case whichKeyword(tok.ident) - of wIf: - Inc(nestedIfs) - of wElse: - if (dest == jdElseEndif) and (nestedIfs == 0): - doElse(L, tok) - break - of wElif: - if (dest == jdElseEndif) and (nestedIfs == 0): - doElif(L, tok) - break - of wEnd: - if nestedIfs == 0: - doEnd(L, tok) - break - if nestedIfs > 0: Dec(nestedIfs) - else: - nil - ppGetTok(L, tok) - elif tok.tokType == tkEof: - lexMessage(L, errTokenExpected, "@end") - else: - ppGetTok(L, tok) - -proc parseDirective(L: var TLexer, tok: PToken) = - var - res: bool - key: string - ppGetTok(L, tok) # skip @ - case whichKeyword(tok.ident) - of wIf: - setlen(condStack, len(condStack) + 1) - res = EvalppIf(L, tok) - condStack[high(condStack)] = res - if not res: - jumpToDirective(L, tok, jdElseEndif) - of wElif: - doElif(L, tok) - of wElse: - doElse(L, tok) - of wEnd: - doEnd(L, tok) - of wWrite: - ppGetTok(L, tok) - msgs.MsgWriteln(tokToStr(tok)) - ppGetTok(L, tok) - of wPutEnv: - ppGetTok(L, tok) - key = tokToStr(tok) - ppGetTok(L, tok) - os.putEnv(key, tokToStr(tok)) - ppGetTok(L, tok) - of wPrependEnv: - ppGetTok(L, tok) - key = tokToStr(tok) - ppGetTok(L, tok) - os.putEnv(key, tokToStr(tok) & os.getenv(key)) - ppGetTok(L, tok) - of wAppendenv: - ppGetTok(L, tok) - key = tokToStr(tok) - ppGetTok(L, tok) - os.putEnv(key, os.getenv(key) & tokToStr(tok)) - ppGetTok(L, tok) - else: lexMessage(L, errInvalidDirectiveX, tokToStr(tok)) - -proc confTok(L: var TLexer, tok: PToken) = - ppGetTok(L, tok) - while (tok.ident != nil) and (tok.ident.s == "@"): - parseDirective(L, tok) # else: give the token to the parser - -proc checkSymbol(L: TLexer, tok: PToken) = - if not (tok.tokType in {tkSymbol..pred(tkIntLit), tkStrLit..tkTripleStrLit}): - lexMessage(L, errIdentifierExpected, tokToStr(tok)) - -proc parseAssignment(L: var TLexer, tok: PToken) = - var - s, val: string - info: TLineInfo - if (tok.ident.id == getIdent("-").id) or (tok.ident.id == getIdent("--").id): - confTok(L, tok) # skip unnecessary prefix - info = getLineInfo(L) # safe for later in case of an error - checkSymbol(L, tok) - s = tokToStr(tok) - confTok(L, tok) # skip symbol - val = "" - while tok.tokType == tkDot: - add(s, '.') - confTok(L, tok) - checkSymbol(L, tok) - add(s, tokToStr(tok)) - confTok(L, tok) - if tok.tokType == tkBracketLe: - # BUGFIX: val, not s! - # BUGFIX: do not copy '['! - confTok(L, tok) - checkSymbol(L, tok) - add(val, tokToStr(tok)) - confTok(L, tok) - if tok.tokType == tkBracketRi: confTok(L, tok) - else: lexMessage(L, errTokenExpected, "\']\'") - add(val, ']') - if (tok.tokType == tkColon) or (tok.tokType == tkEquals): - if len(val) > 0: - add(val, ':') # BUGFIX - confTok(L, tok) # skip ':' or '=' - checkSymbol(L, tok) - add(val, tokToStr(tok)) - confTok(L, tok) # skip symbol - while (tok.ident != nil) and (tok.ident.id == getIdent("&").id): - confTok(L, tok) - checkSymbol(L, tok) - add(val, tokToStr(tok)) - confTok(L, tok) - processSwitch(s, val, passPP, info) - -proc readConfigFile(filename: string) = - var - L: TLexer - tok: PToken - stream: PLLStream - new(tok) - stream = LLStreamOpen(filename, fmRead) - if stream != nil: - openLexer(L, filename, stream) - tok.tokType = tkEof # to avoid a pointless warning - confTok(L, tok) # read in the first token - while tok.tokType != tkEof: parseAssignment(L, tok) - if len(condStack) > 0: lexMessage(L, errTokenExpected, "@end") - closeLexer(L) - if gVerbosity >= 1: rawMessage(hintConf, filename) - -proc getConfigPath(filename: string): string = - # try local configuration file: - result = joinPath(getConfigDir(), filename) - if not ExistsFile(result): - # try standard configuration file (installation did not distribute files - # the UNIX way) - result = joinPath([getPrefixDir(), "config", filename]) - if not ExistsFile(result): - result = "/etc/" & filename - -proc LoadSpecialConfig(configfilename: string) = - if not (optSkipConfigFile in gGlobalOptions): - readConfigFile(getConfigPath(configfilename)) - -proc LoadConfig(project: string) = - var conffile, prefix: string - # set default value (can be overwritten): - if libpath == "": - # choose default libpath: - prefix = getPrefixDir() - if (prefix == "/usr"): libpath = "/usr/lib/nimrod" - elif (prefix == "/usr/local"): libpath = "/usr/local/lib/nimrod" - else: libpath = joinPath(prefix, "lib") - LoadSpecialConfig("nimrod.cfg") # read project config file: - if not (optSkipProjConfigFile in gGlobalOptions) and (project != ""): - conffile = changeFileExt(project, "cfg") - if existsFile(conffile): readConfigFile(conffile) - diff --git a/rod/nimrod.cfg b/rod/nimrod.cfg deleted file mode 100755 index 5168a3bb9..000000000 --- a/rod/nimrod.cfg +++ /dev/null @@ -1,12 +0,0 @@ -# Special configuration file for the Nimrod project - ---hint[XDeclaredButNotUsed]=off -path="llvm" - -@if llvm_gcc or gcc: - # GCC, LLVM and Visual C++ have a problem to optimize some modules. - # This is really strange. - # cgen.speed = "-O0" -@elif vcc: - # cgen.speed = "" -@end diff --git a/rod/nimrod.dot b/rod/nimrod.dot deleted file mode 100755 index 36429844f..000000000 --- a/rod/nimrod.dot +++ /dev/null @@ -1,591 +0,0 @@ -digraph nimrod { -times -> strutils; -os -> strutils; -os -> times; -posix -> times; -os -> posix; -nhashes -> strutils; -nstrtabs -> os; -nstrtabs -> nhashes; -nstrtabs -> strutils; -options -> os; -options -> lists; -options -> strutils; -options -> nstrtabs; -msgs -> options; -msgs -> strutils; -msgs -> os; -crc -> strutils; -platform -> strutils; -ropes -> msgs; -ropes -> strutils; -ropes -> platform; -ropes -> nhashes; -ropes -> crc; -idents -> nhashes; -idents -> strutils; -ast -> msgs; -ast -> nhashes; -ast -> nversion; -ast -> options; -ast -> strutils; -ast -> crc; -ast -> ropes; -ast -> idents; -ast -> lists; -astalgo -> ast; -astalgo -> nhashes; -astalgo -> strutils; -astalgo -> options; -astalgo -> msgs; -astalgo -> ropes; -astalgo -> idents; -condsyms -> ast; -condsyms -> astalgo; -condsyms -> msgs; -condsyms -> nhashes; -condsyms -> platform; -condsyms -> strutils; -condsyms -> idents; -hashes -> strutils; -strtabs -> os; -strtabs -> hashes; -strtabs -> strutils; -osproc -> strutils; -osproc -> os; -osproc -> strtabs; -osproc -> streams; -osproc -> posix; -extccomp -> lists; -extccomp -> ropes; -extccomp -> os; -extccomp -> strutils; -extccomp -> osproc; -extccomp -> platform; -extccomp -> condsyms; -extccomp -> options; -extccomp -> msgs; -wordrecg -> nhashes; -wordrecg -> strutils; -wordrecg -> idents; -commands -> os; -commands -> msgs; -commands -> options; -commands -> nversion; -commands -> condsyms; -commands -> strutils; -commands -> extccomp; -commands -> platform; -commands -> lists; -commands -> wordrecg; -llstream -> strutils; -lexbase -> llstream; -lexbase -> strutils; -scanner -> nhashes; -scanner -> options; -scanner -> msgs; -scanner -> strutils; -scanner -> platform; -scanner -> idents; -scanner -> lexbase; -scanner -> llstream; -scanner -> wordrecg; -nimconf -> llstream; -nimconf -> nversion; -nimconf -> commands; -nimconf -> os; -nimconf -> strutils; -nimconf -> msgs; -nimconf -> platform; -nimconf -> condsyms; -nimconf -> scanner; -nimconf -> options; -nimconf -> idents; -nimconf -> wordrecg; -pnimsyn -> llstream; -pnimsyn -> scanner; -pnimsyn -> idents; -pnimsyn -> strutils; -pnimsyn -> ast; -pnimsyn -> msgs; -pbraces -> llstream; -pbraces -> scanner; -pbraces -> idents; -pbraces -> strutils; -pbraces -> ast; -pbraces -> msgs; -pbraces -> pnimsyn; -rnimsyn -> scanner; -rnimsyn -> options; -rnimsyn -> idents; -rnimsyn -> strutils; -rnimsyn -> ast; -rnimsyn -> msgs; -rnimsyn -> lists; -filters -> llstream; -filters -> os; -filters -> wordrecg; -filters -> idents; -filters -> strutils; -filters -> ast; -filters -> astalgo; -filters -> msgs; -filters -> options; -filters -> rnimsyn; -ptmplsyn -> llstream; -ptmplsyn -> os; -ptmplsyn -> wordrecg; -ptmplsyn -> idents; -ptmplsyn -> strutils; -ptmplsyn -> ast; -ptmplsyn -> astalgo; -ptmplsyn -> msgs; -ptmplsyn -> options; -ptmplsyn -> rnimsyn; -ptmplsyn -> filters; -syntaxes -> strutils; -syntaxes -> llstream; -syntaxes -> ast; -syntaxes -> astalgo; -syntaxes -> idents; -syntaxes -> scanner; -syntaxes -> options; -syntaxes -> msgs; -syntaxes -> pnimsyn; -syntaxes -> pbraces; -syntaxes -> ptmplsyn; -syntaxes -> filters; -syntaxes -> rnimsyn; -paslex -> nhashes; -paslex -> options; -paslex -> msgs; -paslex -> strutils; -paslex -> platform; -paslex -> idents; -paslex -> lexbase; -paslex -> wordrecg; -paslex -> scanner; -pasparse -> os; -pasparse -> llstream; -pasparse -> scanner; -pasparse -> paslex; -pasparse -> idents; -pasparse -> wordrecg; -pasparse -> strutils; -pasparse -> ast; -pasparse -> astalgo; -pasparse -> msgs; -pasparse -> options; -rodread -> os; -rodread -> options; -rodread -> strutils; -rodread -> nversion; -rodread -> ast; -rodread -> astalgo; -rodread -> msgs; -rodread -> platform; -rodread -> condsyms; -rodread -> ropes; -rodread -> idents; -rodread -> crc; -trees -> ast; -trees -> astalgo; -trees -> scanner; -trees -> msgs; -trees -> strutils; -types -> ast; -types -> astalgo; -types -> trees; -types -> msgs; -types -> strutils; -types -> platform; -magicsys -> ast; -magicsys -> astalgo; -magicsys -> nhashes; -magicsys -> msgs; -magicsys -> platform; -magicsys -> nversion; -magicsys -> times; -magicsys -> idents; -magicsys -> rodread; -nimsets -> ast; -nimsets -> astalgo; -nimsets -> trees; -nimsets -> nversion; -nimsets -> msgs; -nimsets -> platform; -nimsets -> bitsets; -nimsets -> types; -nimsets -> rnimsyn; -passes -> strutils; -passes -> lists; -passes -> options; -passes -> ast; -passes -> astalgo; -passes -> llstream; -passes -> msgs; -passes -> platform; -passes -> os; -passes -> condsyms; -passes -> idents; -passes -> rnimsyn; -passes -> types; -passes -> extccomp; -passes -> math; -passes -> magicsys; -passes -> nversion; -passes -> nimsets; -passes -> syntaxes; -passes -> times; -passes -> rodread; -treetab -> nhashes; -treetab -> ast; -treetab -> astalgo; -treetab -> types; -semdata -> strutils; -semdata -> lists; -semdata -> options; -semdata -> scanner; -semdata -> ast; -semdata -> astalgo; -semdata -> trees; -semdata -> treetab; -semdata -> wordrecg; -semdata -> ropes; -semdata -> msgs; -semdata -> platform; -semdata -> os; -semdata -> condsyms; -semdata -> idents; -semdata -> rnimsyn; -semdata -> types; -semdata -> extccomp; -semdata -> math; -semdata -> magicsys; -semdata -> nversion; -semdata -> nimsets; -semdata -> pnimsyn; -semdata -> times; -semdata -> passes; -semdata -> rodread; -lookups -> ast; -lookups -> astalgo; -lookups -> idents; -lookups -> semdata; -lookups -> types; -lookups -> msgs; -lookups -> options; -lookups -> rodread; -lookups -> rnimsyn; -importer -> strutils; -importer -> os; -importer -> ast; -importer -> astalgo; -importer -> msgs; -importer -> options; -importer -> idents; -importer -> rodread; -importer -> lookups; -importer -> semdata; -importer -> passes; -rodwrite -> os; -rodwrite -> options; -rodwrite -> strutils; -rodwrite -> nversion; -rodwrite -> ast; -rodwrite -> astalgo; -rodwrite -> msgs; -rodwrite -> platform; -rodwrite -> condsyms; -rodwrite -> ropes; -rodwrite -> idents; -rodwrite -> crc; -rodwrite -> rodread; -rodwrite -> passes; -rodwrite -> importer; -semfold -> strutils; -semfold -> lists; -semfold -> options; -semfold -> ast; -semfold -> astalgo; -semfold -> trees; -semfold -> treetab; -semfold -> nimsets; -semfold -> times; -semfold -> nversion; -semfold -> platform; -semfold -> math; -semfold -> msgs; -semfold -> os; -semfold -> condsyms; -semfold -> idents; -semfold -> rnimsyn; -semfold -> types; -evals -> strutils; -evals -> magicsys; -evals -> lists; -evals -> options; -evals -> ast; -evals -> astalgo; -evals -> trees; -evals -> treetab; -evals -> nimsets; -evals -> msgs; -evals -> os; -evals -> condsyms; -evals -> idents; -evals -> rnimsyn; -evals -> types; -evals -> passes; -evals -> semfold; -procfind -> ast; -procfind -> astalgo; -procfind -> msgs; -procfind -> semdata; -procfind -> types; -procfind -> trees; -pragmas -> os; -pragmas -> platform; -pragmas -> condsyms; -pragmas -> ast; -pragmas -> astalgo; -pragmas -> idents; -pragmas -> semdata; -pragmas -> msgs; -pragmas -> rnimsyn; -pragmas -> wordrecg; -pragmas -> ropes; -pragmas -> options; -pragmas -> strutils; -pragmas -> lists; -pragmas -> extccomp; -pragmas -> math; -pragmas -> magicsys; -pragmas -> trees; -sem -> strutils; -sem -> nhashes; -sem -> lists; -sem -> options; -sem -> scanner; -sem -> ast; -sem -> astalgo; -sem -> trees; -sem -> treetab; -sem -> wordrecg; -sem -> ropes; -sem -> msgs; -sem -> os; -sem -> condsyms; -sem -> idents; -sem -> rnimsyn; -sem -> types; -sem -> platform; -sem -> math; -sem -> magicsys; -sem -> pnimsyn; -sem -> nversion; -sem -> nimsets; -sem -> semdata; -sem -> evals; -sem -> semfold; -sem -> importer; -sem -> procfind; -sem -> lookups; -sem -> rodread; -sem -> pragmas; -sem -> passes; -rst -> os; -rst -> msgs; -rst -> strutils; -rst -> platform; -rst -> nhashes; -rst -> ropes; -rst -> options; -highlite -> nhashes; -highlite -> options; -highlite -> msgs; -highlite -> strutils; -highlite -> platform; -highlite -> idents; -highlite -> lexbase; -highlite -> wordrecg; -highlite -> scanner; -docgen -> ast; -docgen -> astalgo; -docgen -> strutils; -docgen -> nhashes; -docgen -> options; -docgen -> nversion; -docgen -> msgs; -docgen -> os; -docgen -> ropes; -docgen -> idents; -docgen -> wordrecg; -docgen -> math; -docgen -> syntaxes; -docgen -> rnimsyn; -docgen -> scanner; -docgen -> rst; -docgen -> times; -docgen -> highlite; -ccgutils -> ast; -ccgutils -> astalgo; -ccgutils -> ropes; -ccgutils -> lists; -ccgutils -> nhashes; -ccgutils -> strutils; -ccgutils -> types; -ccgutils -> msgs; -cgmeth -> options; -cgmeth -> ast; -cgmeth -> astalgo; -cgmeth -> msgs; -cgmeth -> idents; -cgmeth -> rnimsyn; -cgmeth -> types; -cgmeth -> magicsys; -cgen -> ast; -cgen -> astalgo; -cgen -> strutils; -cgen -> nhashes; -cgen -> trees; -cgen -> platform; -cgen -> magicsys; -cgen -> extccomp; -cgen -> options; -cgen -> nversion; -cgen -> nimsets; -cgen -> msgs; -cgen -> crc; -cgen -> bitsets; -cgen -> idents; -cgen -> lists; -cgen -> types; -cgen -> ccgutils; -cgen -> os; -cgen -> times; -cgen -> ropes; -cgen -> math; -cgen -> passes; -cgen -> rodread; -cgen -> wordrecg; -cgen -> rnimsyn; -cgen -> treetab; -cgen -> cgmeth; -ecmasgen -> ast; -ecmasgen -> astalgo; -ecmasgen -> strutils; -ecmasgen -> nhashes; -ecmasgen -> trees; -ecmasgen -> platform; -ecmasgen -> magicsys; -ecmasgen -> extccomp; -ecmasgen -> options; -ecmasgen -> nversion; -ecmasgen -> nimsets; -ecmasgen -> msgs; -ecmasgen -> crc; -ecmasgen -> bitsets; -ecmasgen -> idents; -ecmasgen -> lists; -ecmasgen -> types; -ecmasgen -> os; -ecmasgen -> times; -ecmasgen -> ropes; -ecmasgen -> math; -ecmasgen -> passes; -ecmasgen -> ccgutils; -ecmasgen -> wordrecg; -ecmasgen -> rnimsyn; -ecmasgen -> rodread; -interact -> llstream; -interact -> strutils; -interact -> ropes; -interact -> nstrtabs; -interact -> msgs; -passaux -> strutils; -passaux -> ast; -passaux -> astalgo; -passaux -> passes; -passaux -> msgs; -passaux -> options; -depends -> os; -depends -> options; -depends -> ast; -depends -> astalgo; -depends -> msgs; -depends -> ropes; -depends -> idents; -depends -> passes; -depends -> importer; -transf -> strutils; -transf -> lists; -transf -> options; -transf -> ast; -transf -> astalgo; -transf -> trees; -transf -> treetab; -transf -> evals; -transf -> msgs; -transf -> os; -transf -> idents; -transf -> rnimsyn; -transf -> types; -transf -> passes; -transf -> semfold; -transf -> magicsys; -transf -> cgmeth; -main -> llstream; -main -> strutils; -main -> ast; -main -> astalgo; -main -> scanner; -main -> syntaxes; -main -> rnimsyn; -main -> options; -main -> msgs; -main -> os; -main -> lists; -main -> condsyms; -main -> paslex; -main -> pasparse; -main -> rodread; -main -> rodwrite; -main -> ropes; -main -> trees; -main -> wordrecg; -main -> sem; -main -> semdata; -main -> idents; -main -> passes; -main -> docgen; -main -> extccomp; -main -> cgen; -main -> ecmasgen; -main -> platform; -main -> interact; -main -> nimconf; -main -> importer; -main -> passaux; -main -> depends; -main -> transf; -main -> evals; -main -> types; -parseopt -> os; -parseopt -> strutils; -nimrod -> times; -nimrod -> commands; -nimrod -> scanner; -nimrod -> condsyms; -nimrod -> options; -nimrod -> msgs; -nimrod -> nversion; -nimrod -> nimconf; -nimrod -> ropes; -nimrod -> extccomp; -nimrod -> strutils; -nimrod -> os; -nimrod -> platform; -nimrod -> main; -nimrod -> parseopt; -} diff --git a/rod/nimrod.ini b/rod/nimrod.ini deleted file mode 100755 index 7a396d0ca..000000000 --- a/rod/nimrod.ini +++ /dev/null @@ -1,139 +0,0 @@ -[Project] -Name: "Nimrod" -Version: "$version" -; Windows and i386 must be first! -OS: "windows;linux;macosx;freebsd;netbsd;openbsd;solaris" -CPU: "i386;amd64;powerpc64" # ;sparc -Authors: "Andreas Rumpf" -Description: """This is the Nimrod Compiler. Nimrod is a new statically typed, -imperative programming language, that supports procedural, functional, object -oriented and generic programming styles while remaining simple and efficient. -A special feature that Nimrod inherited from Lisp is that Nimrod's abstract -syntax tree (AST) is part of the specification - this allows a powerful macro -system which can be used to create domain specific languages. - -Nimrod is a compiled, garbage-collected systems programming language -which has an excellent productivity/performance ratio. Nimrod's design -focuses on the 3E: efficiency, expressiveness, elegance (in the order of -priority).""" - -App: Console -License: "copying.txt" - -[Config] -Files: "config/nimrod.cfg" -Files: "config/nimdoc.cfg" -Files: "config/nimdoc.tex.cfg" - -[Documentation] -Files: "doc/*.txt" -Files: "doc/*.html" -Files: "doc/*.cfg" -Files: "doc/*.pdf" -Start: "doc/overview.html" - -[Other] -Files: "readme.txt;install.txt;contributors.txt" -Files: "configure;makefile" -Files: "gpl.html" -Files: "*.ini" -Files: "koch.nim" - -Files: "icons/nimrod.ico" -Files: "icons/nimrod.rc" -Files: "icons/nimrod.res" -Files: "icons/koch.ico" -Files: "icons/koch.rc" -Files: "icons/koch.res" - -Files: "rod/readme.txt" -Files: "rod/nimrod.ini" -Files: "rod/nimrod.cfg" -Files: "rod/*.nim" -Files: "build/empty.txt" -Files: "bin/empty.txt" -Files: "nim/*.*" - -Files: "data/*.yml" -Files: "data/*.txt" -Files: "obj/*.txt" -Files: "diff/*.txt" - -[Lib] -Files: "lib/nimbase.h;lib/cycle.h" -Files: "lib/*.nim" -Files: "lib/*.cfg" - -Files: "lib/system/*.nim" -Files: "lib/core/*.nim" -Files: "lib/pure/*.nim" -Files: "lib/impure/*.nim" -Files: "lib/wrappers/*.nim" - -Files: "lib/wrappers/cairo/*.nim" -Files: "lib/wrappers/gtk/*.nim" -Files: "lib/wrappers/lua/*.nim" -Files: "lib/wrappers/opengl/*.nim" -Files: "lib/wrappers/sdl/*.nim" -Files: "lib/wrappers/x11/*.nim" -Files: "lib/wrappers/zip/*.nim" -Files: "lib/wrappers/zip/libzip_all.c" - -Files: "lib/oldwrappers/*.nim" - -Files: "lib/oldwrappers/cairo/*.nim" -Files: "lib/oldwrappers/gtk/*.nim" -Files: "lib/oldwrappers/lua/*.nim" -Files: "lib/oldwrappers/opengl/*.nim" -Files: "lib/oldwrappers/pcre/*.nim" -Files: "lib/oldwrappers/pcre/pcre_all.c" -Files: "lib/oldwrappers/sdl/*.nim" -Files: "lib/oldwrappers/x11/*.nim" -Files: "lib/oldwrappers/zip/*.nim" -Files: "lib/oldwrappers/zip/libzip_all.c" - -Files: "lib/windows/*.nim" -Files: "lib/posix/*.nim" -Files: "lib/ecmas/*.nim" - -[Other] -Files: "tests/*.nim" -Files: "tests/*.html" -Files: "tests/*.txt" -Files: "tests/*.cfg" -Files: "tests/*.tmpl" -Files: "tests/accept/run/*.nim" -Files: "tests/accept/compile/*.nim" -Files: "tests/reject/*.nim" - -Files: "examples/*.nim" -Files: "examples/*.html" -Files: "examples/*.txt" -Files: "examples/*.cfg" -Files: "examples/*.tmpl" - -[Windows] -Files: "bin/nimrod.exe" -Files: "bin/c2nim.exe" -Files: "bin/niminst.exe" -Files: "deps/*.dll" -Files: "koch.exe" -Files: "dist/mingw" -Files: "start.bat" -BinPath: r"bin;dist\mingw\bin;deps" -InnoSetup: "Yes" - -[UnixBin] -Files: "bin/nimrod" - -[Unix] -InstallScript: "yes" -UninstallScript: "yes" - -[InnoSetup] -path = r"c:\programme\inno setup 5\iscc.exe" -flags = "/Q" - -[C_Compiler] -path = r"" -flags = "-w" diff --git a/rod/nimrod.nim b/rod/nimrod.nim deleted file mode 100755 index a1751da7f..000000000 --- a/rod/nimrod.nim +++ /dev/null @@ -1,87 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -when defined(gcc) and defined(windows): - {.link: "icons/nimrod.res".} - -import - times, commands, scanner, condsyms, options, msgs, nversion, nimconf, ropes, - extccomp, strutils, os, platform, main, parseopt - -when hasTinyCBackend: - import tccgen - -var - arguments: string = "" # the arguments to be passed to the program that - # should be run - cmdLineInfo: TLineInfo - -proc ProcessCmdLine(pass: TCmdLinePass, command, filename: var string) = - var p = parseopt.initOptParser() - while true: - parseopt.next(p) - case p.kind - of cmdEnd: break - of cmdLongOption, cmdShortOption: - # hint[X]:off is parsed as (p.key = "hint[X]", p.val = "off") - # we fix this here - var bracketLe = strutils.find(p.key, '[') - if bracketLe >= 0: - var key = copy(p.key, 0, bracketLe - 1) - var val = copy(p.key, bracketLe + 1) & ':' & p.val - ProcessSwitch(key, val, pass, cmdLineInfo) - else: - ProcessSwitch(p.key, p.val, pass, cmdLineInfo) - of cmdArgument: - if command == "": - command = p.key - elif filename == "": - filename = unixToNativePath(p.key) # BUGFIX for portable build scripts - break - if pass == passCmd2: - arguments = cmdLineRest(p) - if optRun notin gGlobalOptions and arguments != "": - rawMessage(errArgsNeedRunOption, []) - -proc HandleCmdLine() = - var start = getTime() - if paramCount() == 0: - writeCommandLineUsage() - else: - # Process command line arguments: - var command = "" - var filename = "" - ProcessCmdLine(passCmd1, command, filename) - if filename != "": options.projectPath = splitFile(filename).dir - nimconf.LoadConfig(filename) # load the right config file - # now process command line arguments again, because some options in the - # command line can overwite the config file's settings - extccomp.initVars() - command = "" - filename = "" - ProcessCmdLine(passCmd2, command, filename) - MainCommand(command, filename) - if gVerbosity >= 2: echo(GC_getStatistics()) - if msgs.gErrorCounter == 0: - when hasTinyCBackend: - if gCmd == cmdRun: - tccgen.run() - if gCmd notin {cmdInterpret, cmdRun}: - rawMessage(hintSuccessX, [$gLinesCompiled, $(getTime() - start)]) - if optRun in gGlobalOptions: - when defined(unix): - var prog = "./" & quoteIfContainsWhite(changeFileExt(filename, "")) - else: - var prog = quoteIfContainsWhite(changeFileExt(filename, "")) - execExternalProgram(prog & ' ' & arguments) - -cmdLineInfo = newLineInfo("command line", -1, -1) -condsyms.InitDefines() -HandleCmdLine() -quit(options.gExitcode) diff --git a/rod/nimsets.nim b/rod/nimsets.nim deleted file mode 100755 index 337aedda9..000000000 --- a/rod/nimsets.nim +++ /dev/null @@ -1,175 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# this unit handles Nimrod sets; it implements symbolic sets - -import - ast, astalgo, trees, nversion, msgs, platform, bitsets, types, rnimsyn - -proc toBitSet*(s: PNode, b: var TBitSet) - # this function is used for case statement checking: -proc overlap*(a, b: PNode): bool -proc inSet*(s: PNode, elem: PNode): bool -proc someInSet*(s: PNode, a, b: PNode): bool -proc emptyRange*(a, b: PNode): bool -proc SetHasRange*(s: PNode): bool - # returns true if set contains a range (needed by the code generator) - # these are used for constant folding: -proc unionSets*(a, b: PNode): PNode -proc diffSets*(a, b: PNode): PNode -proc intersectSets*(a, b: PNode): PNode -proc symdiffSets*(a, b: PNode): PNode -proc containsSets*(a, b: PNode): bool -proc equalSets*(a, b: PNode): bool -proc cardSet*(s: PNode): BiggestInt -# implementation - -proc inSet(s: PNode, elem: PNode): bool = - if s.kind != nkCurly: InternalError(s.info, "inSet") - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - if leValue(s.sons[i].sons[0], elem) and - leValue(elem, s.sons[i].sons[1]): - return true - else: - if sameValue(s.sons[i], elem): - return true - result = false - -proc overlap(a, b: PNode): bool = - if a.kind == nkRange: - if b.kind == nkRange: - result = leValue(a.sons[0], b.sons[1]) and - leValue(b.sons[1], a.sons[1]) or - leValue(a.sons[0], b.sons[0]) and leValue(b.sons[0], a.sons[1]) - else: - result = leValue(a.sons[0], b) and leValue(b, a.sons[1]) - else: - if b.kind == nkRange: - result = leValue(b.sons[0], a) and leValue(a, b.sons[1]) - else: - result = sameValue(a, b) - -proc SomeInSet(s: PNode, a, b: PNode): bool = - # checks if some element of a..b is in the set s - if s.kind != nkCurly: InternalError(s.info, "SomeInSet") - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - if leValue(s.sons[i].sons[0], b) and leValue(b, s.sons[i].sons[1]) or - leValue(s.sons[i].sons[0], a) and leValue(a, s.sons[i].sons[1]): - return true - else: - # a <= elem <= b - if leValue(a, s.sons[i]) and leValue(s.sons[i], b): - return true - result = false - -proc toBitSet(s: PNode, b: var TBitSet) = - var first, j: BiggestInt - first = firstOrd(s.typ.sons[0]) - bitSetInit(b, int(getSize(s.typ))) - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - j = getOrdValue(s.sons[i].sons[0]) - while j <= getOrdValue(s.sons[i].sons[1]): - BitSetIncl(b, j - first) - inc(j) - else: - BitSetIncl(b, getOrdValue(s.sons[i]) - first) - -proc ToTreeSet(s: TBitSet, settype: PType, info: TLineInfo): PNode = - var - a, b, e, first: BiggestInt # a, b are interval borders - elemType: PType - n: PNode - elemType = settype.sons[0] - first = firstOrd(elemType) - result = newNodeI(nkCurly, info) - result.typ = settype - result.info = info - e = 0 - while e < high(s) * elemSize: - if bitSetIn(s, e): - a = e - b = e - while true: - Inc(b) - if (b > high(s) * elemSize) or not bitSetIn(s, b): break - Dec(b) - if a == b: - addSon(result, newIntTypeNode(nkIntLit, a + first, elemType)) - else: - n = newNodeI(nkRange, info) - n.typ = elemType - addSon(n, newIntTypeNode(nkIntLit, a + first, elemType)) - addSon(n, newIntTypeNode(nkIntLit, b + first, elemType)) - addSon(result, n) - e = b - Inc(e) - -type - TSetOP = enum - soUnion, soDiff, soSymDiff, soIntersect - -proc nodeSetOp(a, b: PNode, op: TSetOp): PNode = - var x, y: TBitSet - toBitSet(a, x) - toBitSet(b, y) - case op - of soUnion: BitSetUnion(x, y) - of soDiff: BitSetDiff(x, y) - of soSymDiff: BitSetSymDiff(x, y) - of soIntersect: BitSetIntersect(x, y) - result = toTreeSet(x, a.typ, a.info) - -proc unionSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soUnion) - -proc diffSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soDiff) - -proc intersectSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soIntersect) - -proc symdiffSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soSymDiff) - -proc containsSets(a, b: PNode): bool = - var x, y: TBitSet - toBitSet(a, x) - toBitSet(b, y) - result = bitSetContains(x, y) - -proc equalSets(a, b: PNode): bool = - var x, y: TBitSet - toBitSet(a, x) - toBitSet(b, y) - result = bitSetEquals(x, y) - -proc cardSet(s: PNode): BiggestInt = - # here we can do better than converting it into a compact set - # we just count the elements directly - result = 0 - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - result = result + getOrdValue(s.sons[i].sons[1]) - - getOrdValue(s.sons[i].sons[0]) + 1 - else: - Inc(result) - -proc SetHasRange(s: PNode): bool = - if s.kind != nkCurly: InternalError(s.info, "SetHasRange") - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - return true - result = false - -proc emptyRange(a, b: PNode): bool = - result = not leValue(a, b) # a > b iff not (a <= b) - \ No newline at end of file diff --git a/rod/noprefix2.nim b/rod/noprefix2.nim deleted file mode 100755 index 6fbdaaddc..000000000 --- a/rod/noprefix2.nim +++ /dev/null @@ -1,15 +0,0 @@ -# strip those silly GTK/ATK prefixes... - -import - expandimportc, os - -const - filelist = [ - ("gtk/pango", "pango"), - ("gtk/pangoutils", "pango") - ] - -for filename, prefix in items(filelist): - var f = addFileExt(filename, "nim") - main("lib/newwrap" / f, "lib/newwrap" / filename & ".new.nim", prefix) - diff --git a/rod/nstrtabs.nim b/rod/nstrtabs.nim deleted file mode 100755 index 811e461cc..000000000 --- a/rod/nstrtabs.nim +++ /dev/null @@ -1,171 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# String tables. - -import - os, nhashes, strutils - -type - TStringTableMode* = enum - modeCaseSensitive, # the table is case sensitive - modeCaseInsensitive, # the table is case insensitive - modeStyleInsensitive # the table is style insensitive - TKeyValuePair* = tuple[key, val: string] - TKeyValuePairSeq* = seq[TKeyValuePair] - TStringTable* = object of TObject - counter*: int - data*: TKeyValuePairSeq - mode*: TStringTableMode - - PStringTable* = ref TStringTable - -proc newStringTable*(keyValuePairs: openarray[string], - mode: TStringTableMode = modeCaseSensitive): PStringTable -proc put*(t: PStringTable, key, val: string) -proc get*(t: PStringTable, key: string): string -proc hasKey*(t: PStringTable, key: string): bool -proc length*(t: PStringTable): int -type - TFormatFlag* = enum - useEnvironment, # use environment variable if the ``$key`` - # is not found in the table - useEmpty, # use the empty string as a default, thus it - # won't throw an exception if ``$key`` is not - # in the table - useKey # do not replace ``$key`` if it is not found - # in the table (or in the environment) - TFormatFlags* = set[TFormatFlag] - -proc `%`*(f: string, t: PStringTable, flags: TFormatFlags = {}): string -# implementation - -const - growthFactor = 2 - startSize = 64 - -proc newStringTable(keyValuePairs: openarray[string], - mode: TStringTableMode = modeCaseSensitive): PStringTable = - new(result) - result.mode = mode - result.counter = 0 - newSeq(result.data, startSize) - var i = 0 - while i < high(keyValuePairs): - put(result, keyValuePairs[i], keyValuePairs[i + 1]) - inc(i, 2) - -proc myhash(t: PStringTable, key: string): THash = - case t.mode - of modeCaseSensitive: result = nhashes.GetHashStr(key) - of modeCaseInsensitive: result = nhashes.GetHashStrCI(key) - of modeStyleInsensitive: result = nhashes.getNormalizedHash(key) - -proc myCmp(t: PStringTable, a, b: string): bool = - case t.mode - of modeCaseSensitive: result = cmp(a, b) == 0 - of modeCaseInsensitive: result = cmpIgnoreCase(a, b) == 0 - of modeStyleInsensitive: result = cmpIgnoreStyle(a, b) == 0 - -proc mustRehash(length, counter: int): bool = - assert(length > counter) - result = (length * 2 < counter * 3) or (length - counter < 4) - -proc length(t: PStringTable): int = - result = t.counter - -proc nextTry(h, maxHash: THash): THash = - result = ((5 * h) + 1) and maxHash - # For any initial h in range(maxHash), repeating that maxHash times - # generates each int in range(maxHash) exactly once (see any text on - # random-number generation for proof). - -proc RawGet(t: PStringTable, key: string): int = - var h = myhash(t, key) and high(t.data) # start with real hash value - while not isNil(t.data[h].key): - if mycmp(t, t.data[h].key, key): - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc get(t: PStringTable, key: string): string = - var index = RawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = "" - -proc hasKey(t: PStringTable, key: string): bool = - result = rawGet(t, key) >= 0 - -proc RawInsert(t: PStringTable, data: var TKeyValuePairSeq, key, val: string) = - var h = myhash(t, key) and high(data) - while not isNil(data[h].key): - h = nextTry(h, high(data)) - data[h].key = key - data[h].val = val - -proc Enlarge(t: PStringTable) = - var n: TKeyValuePairSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if not isNil(t.data[i].key): RawInsert(t, n, t.data[i].key, t.data[i].val) - swap(t.data, n) - -proc Put(t: PStringTable, key, val: string) = - var index = RawGet(t, key) - if index >= 0: - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): Enlarge(t) - RawInsert(t, t.data, key, val) - inc(t.counter) - -proc RaiseFormatException(s: string) = - var e: ref EInvalidValue - new(e) - e.msg = "format string: key not found: " & s - raise e - -proc getValue(t: PStringTable, flags: TFormatFlags, key: string): string = - if hasKey(t, key): return get(t, key) - if useEnvironment in flags: result = os.getEnv(key) - else: result = "" - if result.len == 0: - if useKey in flags: result = '$' & key - elif not (useEmpty in flags): raiseFormatException(key) - -proc `%`(f: string, t: PStringTable, flags: TFormatFlags = {}): string = - const - PatternChars = {'a'..'z', 'A'..'Z', '0'..'9', '_', '\x80'..'\xFF'} - result = "" - var i = 0 - while i <= len(f) + 0 - 1: - if f[i] == '$': - case f[i + 1] - of '$': - add(result, '$') - inc(i, 2) - of '{': - var j = i + 1 - while (j <= len(f) + 0 - 1) and (f[j] != '}'): inc(j) - var key = copy(f, i + 2 + 0 - 1, j - 1 + 0 - 1) - add(result, getValue(t, flags, key)) - i = j + 1 - of 'a'..'z', 'A'..'Z', '\x80'..'\xFF', '_': - var j = i + 1 - while (j <= len(f) + 0 - 1) and (f[j] in PatternChars): inc(j) - var key = copy(f, i + 1 + 0 - 1, j - 1 + 0 - 1) - add(result, getValue(t, flags, key)) - i = j - else: - add(result, f[i]) - inc(i) - else: - add(result, f[i]) - inc(i) - \ No newline at end of file diff --git a/rod/nversion.nim b/rod/nversion.nim deleted file mode 100755 index 8fb436f11..000000000 --- a/rod/nversion.nim +++ /dev/null @@ -1,20 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module contains Nimrod's version. It is the only place where it needs -# to be changed. - -const - MaxSetElements* = 1 shl 16 # (2^16) to support unicode character sets? - defaultAsmMarkerSymbol* = '!' - VersionMajor* = 0 - VersionMinor* = 8 - VersionPatch* = 11 - VersionAsString* = $VersionMajor & "." & $VersionMinor & "." & $VersionPatch - diff --git a/rod/options.nim b/rod/options.nim deleted file mode 100755 index 9dec04475..000000000 --- a/rod/options.nim +++ /dev/null @@ -1,207 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - os, lists, strutils, nstrtabs - -const - hasTinyCBackend* = defined(tinyc) - -type # please make sure we have under 32 options - # (improves code efficiency a lot!) - TOption* = enum # **keep binary compatible** - optNone, optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, - optOverflowCheck, optNilCheck, - optNaNCheck, optInfCheck, - optAssert, optLineDir, optWarns, optHints, - optOptimizeSpeed, optOptimizeSize, optStackTrace, # stack tracing support - optLineTrace, # line tracing support (includes stack tracing) - optEndb, # embedded debugger - optByRef, # use pass by ref for objects - # (for interfacing with C) - optCheckpoints, # check for checkpoints (used for debugging) - optProfiler # profiler turned on - TOptions* = set[TOption] - TGlobalOption* = enum - gloptNone, optForceFullMake, optBoehmGC, optRefcGC, optDeadCodeElim, - optListCmd, optCompileOnly, optNoLinking, - optSafeCode, # only allow safe code - optCDebug, # turn on debugging information - optGenDynLib, # generate a dynamic library - optGenGuiApp, # generate a GUI application - optGenScript, # generate a script file to compile the *.c files - optGenMapping, # generate a mapping file - optRun, # run the compiled project - optSymbolFiles, # use symbol files for speeding up compilation - optSkipConfigFile, # skip the general config file - optSkipProjConfigFile, # skip the project's config file - optNoMain, # do not generate a "main" proc - optThreads, # support for multi-threading - optStdout, # output to stdout - optSuggest, # ideTools: 'suggest' - optContext, # ideTools: 'context' - optDef # ideTools: 'def' - TGlobalOptions* = set[TGlobalOption] - TCommands* = enum # Nimrod's commands - cmdNone, cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, - cmdCompileToEcmaScript, cmdCompileToLLVM, cmdInterpret, cmdPretty, cmdDoc, - cmdGenDepend, cmdDump, - cmdCheck, # semantic checking for whole project - cmdParse, # parse a single file (for debugging) - cmdScan, # scan a single file (for debugging) - cmdIdeTools, # ide tools - cmdDef, # def feature (find definition for IDEs) - cmdRst2html, # convert a reStructuredText file to HTML - cmdRst2tex, # convert a reStructuredText file to TeX - cmdInteractive, # start interactive session - cmdRun # run the project via TCC backend - TStringSeq* = seq[string] - -const - ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, optNilCheck, - optOverflowCheck, optBoundsCheck, optAssert, optNaNCheck, optInfCheck} - -var - gOptions*: TOptions = {optObjCheck, optFieldCheck, optRangeCheck, - optBoundsCheck, optOverflowCheck, optAssert, optWarns, - optHints, optStackTrace, optLineTrace} - gGlobalOptions*: TGlobalOptions = {optRefcGC} - gExitcode*: int8 - searchPaths*: TLinkedList - outFile*: string = "" - gIndexFile*: string = "" - gCmd*: TCommands = cmdNone # the command - gVerbosity*: int # how verbose the compiler is - gNumberOfProcessors*: int # number of processors - -proc FindFile*(f: string): string - -const - genSubDir* = "nimcache" - NimExt* = "nim" - RodExt* = "rod" - HtmlExt* = "html" - TexExt* = "tex" - IniExt* = "ini" - DocConfig* = "nimdoc.cfg" - DocTexConfig* = "nimdoc.tex.cfg" - -proc completeGeneratedFilePath*(f: string, createSubDir: bool = true): string -proc toGeneratedFile*(path, ext: string): string - # converts "/home/a/mymodule.nim", "rod" to "/home/a/nimcache/mymodule.rod" -proc getPrefixDir*(): string - # gets the application directory - -# additional configuration variables: -var - gConfigVars*: PStringTable - libpath*: string = "" - projectPath*: string = "" - gKeepComments*: bool = true # whether the parser needs to keep comments - gImplicitMods*: TStringSeq = @[] # modules that are to be implicitly imported - -proc existsConfigVar*(key: string): bool -proc getConfigVar*(key: string): string -proc setConfigVar*(key, val: string) -proc addImplicitMod*(filename: string) -proc binaryStrSearch*(x: openarray[string], y: string): int -# implementation - -proc existsConfigVar(key: string): bool = - result = hasKey(gConfigVars, key) - -proc getConfigVar(key: string): string = - result = nstrtabs.get(gConfigVars, key) - -proc setConfigVar(key, val: string) = - nstrtabs.put(gConfigVars, key, val) - -proc getOutFile*(filename, ext: string): string = - if options.outFile != "": result = options.outFile - else: result = changeFileExt(filename, ext) - -proc addImplicitMod(filename: string) = - var length = len(gImplicitMods) - setlen(gImplicitMods, length + 1) - gImplicitMods[length] = filename - -proc getPrefixDir(): string = - result = SplitPath(getAppDir()).head - -proc shortenDir(dir: string): string = - # returns the interesting part of a dir - var prefix = getPrefixDir() & dirSep - if startsWith(dir, prefix): - return copy(dir, len(prefix)) - prefix = getCurrentDir() & dirSep - if startsWith(dir, prefix): - return copy(dir, len(prefix)) - prefix = projectPath & dirSep #writeln(output, prefix); - #writeln(output, dir); - if startsWith(dir, prefix): - return copy(dir, len(prefix)) - result = dir - -proc removeTrailingDirSep*(path: string): string = - if (len(path) > 0) and (path[len(path) - 1] == dirSep): - result = copy(path, 0, len(path) - 2) - else: - result = path - -proc toGeneratedFile(path, ext: string): string = - var (head, tail) = splitPath(path) - if len(head) > 0: head = shortenDir(head & dirSep) - result = joinPath([projectPath, genSubDir, head, changeFileExt(tail, ext)]) - -proc completeGeneratedFilePath(f: string, createSubDir: bool = true): string = - var (head, tail) = splitPath(f) - if len(head) > 0: head = removeTrailingDirSep(shortenDir(head & dirSep)) - var subdir = joinPath([projectPath, genSubDir, head]) - if createSubDir: - try: - createDir(subdir) - except EOS: - writeln(stdout, "cannot create directory: " & subdir) - quit(1) - result = joinPath(subdir, tail) - -iterator iterSearchPath*(): string = - var it = PStrEntry(SearchPaths.head) - while it != nil: - yield it.data - it = PStrEntry(it.Next) - -proc rawFindFile(f: string): string = - if ExistsFile(f): - result = f - else: - for it in iterSearchPath(): - result = JoinPath(it, f) - if ExistsFile(result): return - result = "" - -proc FindFile(f: string): string = - result = rawFindFile(f) - if len(result) == 0: result = rawFindFile(toLower(f)) - -proc binaryStrSearch(x: openarray[string], y: string): int = - var a = 0 - var b = len(x) - 1 - while a <= b: - var mid = (a + b) div 2 - var c = cmpIgnoreCase(x[mid], y) - if c < 0: - a = mid + 1 - elif c > 0: - b = mid - 1 - else: - return mid - result = - 1 - -gConfigVars = newStringTable([], modeStyleInsensitive) diff --git a/rod/parsecfg.nim b/rod/parsecfg.nim deleted file mode 100755 index 0b9574a41..000000000 --- a/rod/parsecfg.nim +++ /dev/null @@ -1,346 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# A HIGH-PERFORMANCE configuration file parser; -# the Nimrod version of this file is part of the -# standard library. - -import - llstream, nhashes, strutils, lexbase - -type - TCfgEventKind* = enum - cfgEof, # end of file reached - cfgSectionStart, # a ``[section]`` has been parsed - cfgKeyValuePair, # a ``key=value`` pair has been detected - cfgOption, # a ``--key=value`` command line option - cfgError # an error ocurred during parsing; msg contains the - # error message - TCfgEvent* = object of TObject - case kind*: TCfgEventKind - of cfgEof: - nil - - of cfgSectionStart: - section*: string - - of cfgKeyValuePair, cfgOption: - key*, value*: string - - of cfgError: - msg*: string - - - TTokKind* = enum - tkInvalid, tkEof, # order is important here! - tkSymbol, tkEquals, tkColon, tkBracketLe, tkBracketRi, tkDashDash - TToken*{.final.} = object # a token - kind*: TTokKind # the type of the token - literal*: string # the parsed (string) literal - - TParserState* = enum - startState, commaState - TCfgParser* = object of TBaseLexer - tok*: TToken - state*: TParserState - filename*: string - - -proc Open*(c: var TCfgParser, filename: string, inputStream: PLLStream) -proc Close*(c: var TCfgParser) -proc next*(c: var TCfgParser): TCfgEvent -proc getColumn*(c: TCfgParser): int -proc getLine*(c: TCfgParser): int -proc getFilename*(c: TCfgParser): string -proc errorStr*(c: TCfgParser, msg: string): string -# implementation - -const - SymChars: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '_', '\x80'..'\xFF'} # - # ---------------------------------------------------------------------------- - -proc rawGetTok(c: var TCfgParser, tok: var TToken) -proc open(c: var TCfgParser, filename: string, inputStream: PLLStream) = - openBaseLexer(c, inputStream) - c.filename = filename - c.state = startState - c.tok.kind = tkInvalid - c.tok.literal = "" - rawGetTok(c, c.tok) - -proc close(c: var TCfgParser) = - closeBaseLexer(c) - -proc getColumn(c: TCfgParser): int = - result = getColNumber(c, c.bufPos) - -proc getLine(c: TCfgParser): int = - result = c.linenumber - -proc getFilename(c: TCfgParser): string = - result = c.filename - -proc handleHexChar(c: var TCfgParser, xi: var int) = - case c.buf[c.bufpos] - of '0'..'9': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - of 'a'..'f': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('a') + 10) - inc(c.bufpos) - of 'A'..'F': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('A') + 10) - inc(c.bufpos) - else: - nil - -proc handleDecChars(c: var TCfgParser, xi: var int) = - while c.buf[c.bufpos] in {'0'..'9'}: - xi = (xi * 10) + (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - -proc getEscapedChar(c: var TCfgParser, tok: var TToken) = - var xi: int - inc(c.bufpos) # skip '\' - case c.buf[c.bufpos] - of 'n', 'N': - tok.literal = tok.literal & "\n" - Inc(c.bufpos) - of 'r', 'R', 'c', 'C': - add(tok.literal, CR) - Inc(c.bufpos) - of 'l', 'L': - add(tok.literal, LF) - Inc(c.bufpos) - of 'f', 'F': - add(tok.literal, FF) - inc(c.bufpos) - of 'e', 'E': - add(tok.literal, ESC) - Inc(c.bufpos) - of 'a', 'A': - add(tok.literal, BEL) - Inc(c.bufpos) - of 'b', 'B': - add(tok.literal, BACKSPACE) - Inc(c.bufpos) - of 'v', 'V': - add(tok.literal, VT) - Inc(c.bufpos) - of 't', 'T': - add(tok.literal, Tabulator) - Inc(c.bufpos) - of '\'', '\"': - add(tok.literal, c.buf[c.bufpos]) - Inc(c.bufpos) - of '\\': - add(tok.literal, '\\') - Inc(c.bufpos) - of 'x', 'X': - inc(c.bufpos) - xi = 0 - handleHexChar(c, xi) - handleHexChar(c, xi) - add(tok.literal, Chr(xi)) - of '0'..'9': - xi = 0 - handleDecChars(c, xi) - if (xi <= 255): add(tok.literal, Chr(xi)) - else: tok.kind = tkInvalid - else: tok.kind = tkInvalid - -proc HandleCRLF(c: var TCfgParser, pos: int): int = - case c.buf[pos] - of CR: result = lexbase.HandleCR(c, pos) - of LF: result = lexbase.HandleLF(c, pos) - else: result = pos - -proc getString(c: var TCfgParser, tok: var TToken, rawMode: bool) = - var - pos: int - ch: Char - buf: cstring - pos = c.bufPos + 1 # skip " - buf = c.buf # put `buf` in a register - tok.kind = tkSymbol - if (buf[pos] == '\"') and (buf[pos + 1] == '\"'): - # long string literal: - inc(pos, 2) # skip "" - # skip leading newline: - pos = HandleCRLF(c, pos) - buf = c.buf - while true: - case buf[pos] - of '\"': - if (buf[pos + 1] == '\"') and (buf[pos + 2] == '\"'): break - add(tok.literal, '\"') - Inc(pos) - of CR, LF: - pos = HandleCRLF(c, pos) - buf = c.buf - tok.literal = tok.literal & "\n" - of lexbase.EndOfFile: - tok.kind = tkInvalid - break - else: - add(tok.literal, buf[pos]) - Inc(pos) - c.bufpos = pos + - 3 # skip the three """ - else: - # ordinary string literal - while true: - ch = buf[pos] - if ch == '\"': - inc(pos) # skip '"' - break - if ch in {CR, LF, lexbase.EndOfFile}: - tok.kind = tkInvalid - break - if (ch == '\\') and not rawMode: - c.bufPos = pos - getEscapedChar(c, tok) - pos = c.bufPos - else: - add(tok.literal, ch) - Inc(pos) - c.bufpos = pos - -proc getSymbol(c: var TCfgParser, tok: var TToken) = - var - pos: int - buf: cstring - pos = c.bufpos - buf = c.buf - while true: - add(tok.literal, buf[pos]) - Inc(pos) - if not (buf[pos] in SymChars): break - c.bufpos = pos - tok.kind = tkSymbol - -proc skip(c: var TCfgParser) = - var - buf: cstring - pos: int - pos = c.bufpos - buf = c.buf - while true: - case buf[pos] - of ' ': - Inc(pos) - of Tabulator: - inc(pos) - of '#', ';': - while not (buf[pos] in {CR, LF, lexbase.EndOfFile}): inc(pos) - of CR, LF: - pos = HandleCRLF(c, pos) - buf = c.buf - else: - break # EndOfFile also leaves the loop - c.bufpos = pos - -proc rawGetTok(c: var TCfgParser, tok: var TToken) = - tok.kind = tkInvalid - setlen(tok.literal, 0) - skip(c) - case c.buf[c.bufpos] - of '=': - tok.kind = tkEquals - inc(c.bufpos) - tok.literal = "=" - of '-': - inc(c.bufPos) - if c.buf[c.bufPos] == '-': inc(c.bufPos) - tok.kind = tkDashDash - tok.literal = "--" - of ':': - tok.kind = tkColon - inc(c.bufpos) - tok.literal = ":" - of 'r', 'R': - if c.buf[c.bufPos + 1] == '\"': - Inc(c.bufPos) - getString(c, tok, true) - else: - getSymbol(c, tok) - of '[': - tok.kind = tkBracketLe - inc(c.bufpos) - tok.literal = "[" - of ']': - tok.kind = tkBracketRi - Inc(c.bufpos) - tok.literal = "]" - of '\"': - getString(c, tok, false) - of lexbase.EndOfFile: - tok.kind = tkEof - else: getSymbol(c, tok) - -proc errorStr(c: TCfgParser, msg: string): string = - result = `%`("$1($2, $3) Error: $4", - [c.filename, $(getLine(c)), $(getColumn(c)), msg]) - -proc getKeyValPair(c: var TCfgParser, kind: TCfgEventKind): TCfgEvent = - if c.tok.kind == tkSymbol: - result.kind = kind - result.key = c.tok.literal - result.value = "" - rawGetTok(c, c.tok) - while c.tok.literal == ".": - add(result.key, '.') - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - add(result.key, c.tok.literal) - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - break - if c.tok.kind in {tkEquals, tkColon}: - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - result.value = c.tok.literal - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - -proc next(c: var TCfgParser): TCfgEvent = - case c.tok.kind - of tkEof: - result.kind = cfgEof - of tkDashDash: - rawGetTok(c, c.tok) - result = getKeyValPair(c, cfgOption) - of tkSymbol: - result = getKeyValPair(c, cfgKeyValuePair) - of tkBracketLe: - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - result.kind = cfgSectionStart - result.section = c.tok.literal - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - if c.tok.kind == tkBracketRi: - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "\']\' expected, but found: " & c.tok.literal) - of tkInvalid, tkBracketRi, tkEquals, tkColon: - result.kind = cfgError - result.msg = errorStr(c, "invalid token: " & c.tok.literal) - rawGetTok(c, c.tok) diff --git a/rod/pas2nim/pas2nim.cfg b/rod/pas2nim/pas2nim.cfg deleted file mode 100755 index 789e6ec7f..000000000 --- a/rod/pas2nim/pas2nim.cfg +++ /dev/null @@ -1,4 +0,0 @@ -# Use the modules of the compiler - -path: "$nimrod/rod" - diff --git a/rod/pas2nim/pas2nim.nim b/rod/pas2nim/pas2nim.nim deleted file mode 100755 index 5c7b68857..000000000 --- a/rod/pas2nim/pas2nim.nim +++ /dev/null @@ -1,64 +0,0 @@ -# -# -# Pas2nim - Pascal to Nimrod source converter -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - strutils, os, parseopt, llstream, ast, rnimsyn, options, msgs, - paslex, pasparse - -const - Version = "0.8" - Usage = """ -pas2nim - Pascal to Nimrod source converter - (c) 2010 Andreas Rumpf -Usage: pas2nim [options] inputfile [options] -Options: - -o, --out:FILE set output filename - --ref convert ^typ to ref typ (default: ptr typ) - --boot use special translation rules for the Nimrod compiler - -v, --version write pas2nim's version - -h, --help show this help -""" - -proc main(infile, outfile: string, flags: set[TParserFlag]) = - var stream = LLStreamOpen(infile, fmRead) - if stream == nil: rawMessage(errCannotOpenFile, infile) - var p: TParser - openParser(p, infile, stream, flags) - var module = parseUnit(p) - closeParser(p) - renderModule(module, outfile) - -var - infile = "" - outfile = "" - flags: set[TParserFlag] = {} -for kind, key, val in getopt(): - case kind - of cmdArgument: infile = key - of cmdLongOption, cmdShortOption: - case key - of "help", "h": - stdout.write(Usage) - quit(0) - of "version", "v": - stdout.write(Version & "\n") - quit(0) - of "o", "out": outfile = key - of "ref": incl(flags, pfRefs) - of "boot": flags = flags + {pfRefs, pfMoreReplacements, pfImportBlackList} - else: stdout.write("[Error] unknown option: " & key) - of cmdEnd: assert(false) -if infile.len == 0: - # no filename has been given, so we show the help: - stdout.write(Usage) -else: - if outfile.len == 0: - outfile = changeFileExt(infile, "nim") - infile = addFileExt(infile, "pas") - main(infile, outfile, flags) diff --git a/rod/pas2nim/paslex.nim b/rod/pas2nim/paslex.nim deleted file mode 100755 index ed554bdc2..000000000 --- a/rod/pas2nim/paslex.nim +++ /dev/null @@ -1,570 +0,0 @@ -# -# -# Pas2nim - Pascal to Nimrod source converter -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements a FreePascal scanner. This is an adaption from -# the scanner module. - -import - nhashes, options, msgs, strutils, platform, idents, lexbase, llstream - -const - MaxLineLength* = 80 # lines longer than this lead to a warning - numChars*: TCharSet = {'0'..'9', 'a'..'z', 'A'..'Z'} - SymChars*: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} - SymStartChars*: TCharSet = {'a'..'z', 'A'..'Z', '\x80'..'\xFF'} - OpChars*: TCharSet = {'+', '-', '*', '/', '<', '>', '!', '?', '^', '.', '|', - '=', ':', '%', '&', '$', '@', '~', '\x80'..'\xFF'} - -# keywords are sorted! - -type - TTokKind* = enum - pxInvalid, pxEof, - pxAnd, pxArray, pxAs, pxAsm, pxBegin, pxCase, pxClass, pxConst, - pxConstructor, pxDestructor, pxDiv, pxDo, pxDownto, pxElse, pxEnd, pxExcept, - pxExports, pxFinalization, pxFinally, pxFor, pxFunction, pxGoto, pxIf, - pxImplementation, pxIn, pxInherited, pxInitialization, pxInline, - pxInterface, pxIs, pxLabel, pxLibrary, pxMod, pxNil, pxNot, pxObject, pxOf, - pxOr, pxOut, pxPacked, pxProcedure, pxProgram, pxProperty, pxRaise, - pxRecord, pxRepeat, pxResourcestring, pxSet, pxShl, pxShr, pxThen, - pxThreadvar, pxTo, pxTry, pxType, pxUnit, pxUntil, pxUses, pxVar, pxWhile, - pxWith, pxXor, - pxComment, # ordinary comment - pxCommand, # {@} - pxAmp, # {&} - pxPer, # {%} - pxStrLit, pxSymbol, # a symbol - pxIntLit, pxInt64Lit, # long constant like 0x70fffffff or out of int range - pxFloatLit, pxParLe, pxParRi, pxBracketLe, pxBracketRi, pxComma, - pxSemiColon, pxColon, # operators - pxAsgn, pxEquals, pxDot, pxDotDot, pxHat, pxPlus, pxMinus, pxStar, pxSlash, - pxLe, pxLt, pxGe, pxGt, pxNeq, pxAt, pxStarDirLe, pxStarDirRi, pxCurlyDirLe, - pxCurlyDirRi - TTokKinds* = set[TTokKind] - -const - Keywords = ["and", "array", "as", "asm", "begin", "case", "class", "const", - "constructor", "destructor", "div", "do", "downto", "else", "end", "except", - "exports", "finalization", "finally", "for", "function", "goto", "if", - "implementation", "in", "inherited", "initialization", "inline", - "interface", "is", "label", "library", "mod", "nil", "not", "object", "of", - "or", "out", "packed", "procedure", "program", "property", "raise", - "record", "repeat", "resourcestring", "set", "shl", "shr", "then", - "threadvar", "to", "try", "type", "unit", "until", "uses", "var", "while", - "with", "xor"] - - firstKeyword = pxAnd - lastKeyword = pxXor - -type - TNumericalBase* = enum base10, base2, base8, base16 - TToken* = object - xkind*: TTokKind # the type of the token - ident*: PIdent # the parsed identifier - iNumber*: BiggestInt # the parsed integer literal - fNumber*: BiggestFloat # the parsed floating point literal - base*: TNumericalBase # the numerical base; only valid for int - # or float literals - literal*: string # the parsed (string) literal - - TLexer* = object of TBaseLexer - filename*: string - - -proc getTok*(L: var TLexer, tok: var TToken) -proc PrintTok*(tok: TToken) -proc `$`*(tok: TToken): string -# implementation - -var - dummyIdent: PIdent - gLinesCompiled: int - -proc fillToken(L: var TToken) = - L.xkind = pxInvalid - L.iNumber = 0 - L.literal = "" - L.fNumber = 0.0 - L.base = base10 - L.ident = dummyIdent # this prevents many bugs! - -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) = - openBaseLexer(lex, inputstream) - lex.filename = filename - -proc closeLexer*(lex: var TLexer) = - inc(gLinesCompiled, lex.LineNumber) - closeBaseLexer(lex) - -proc getColumn(L: TLexer): int = - result = getColNumber(L, L.bufPos) - -proc getLineInfo*(L: TLexer): TLineInfo = - result = newLineInfo(L.filename, L.linenumber, getColNumber(L, L.bufpos)) - -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") = - msgs.GenericMessage(getLineInfo(L), msg, arg) - -proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = - var info = newLineInfo(L.filename, L.linenumber, pos - L.lineStart) - msgs.GenericMessage(info, msg, arg) - -proc TokKindToStr*(k: TTokKind): string = - case k - of pxEof: result = "[EOF]" - of firstKeyword..lastKeyword: - result = keywords[ord(k)-ord(firstKeyword)] - of pxInvalid, pxComment, pxStrLit: result = "string literal" - of pxCommand: result = "{@" - of pxAmp: result = "{&" - of pxPer: result = "{%" - of pxSymbol: result = "identifier" - of pxIntLit, pxInt64Lit: result = "integer literal" - of pxFloatLit: result = "floating point literal" - of pxParLe: result = "(" - of pxParRi: result = ")" - of pxBracketLe: result = "[" - of pxBracketRi: result = "]" - of pxComma: result = "," - of pxSemiColon: result = ";" - of pxColon: result = ":" - of pxAsgn: result = ":=" - of pxEquals: result = "=" - of pxDot: result = "." - of pxDotDot: result = ".." - of pxHat: result = "^" - of pxPlus: result = "+" - of pxMinus: result = "-" - of pxStar: result = "*" - of pxSlash: result = "/" - of pxLe: result = "<=" - of pxLt: result = "<" - of pxGe: result = ">=" - of pxGt: result = ">" - of pxNeq: result = "<>" - of pxAt: result = "@" - of pxStarDirLe: result = "(*$" - of pxStarDirRi: result = "*)" - of pxCurlyDirLe: result = "{$" - of pxCurlyDirRi: result = "}" - -proc `$`(tok: TToken): string = - case tok.xkind - of pxInvalid, pxComment, pxStrLit: result = tok.literal - of pxSymbol: result = tok.ident.s - of pxIntLit, pxInt64Lit: result = $tok.iNumber - of pxFloatLit: result = $tok.fNumber - else: result = TokKindToStr(tok.xkind) - -proc PrintTok(tok: TToken) = - writeln(stdout, $tok) - -proc setKeyword(L: var TLexer, tok: var TToken) = - var x = binaryStrSearch(keywords, toLower(tok.ident.s)) - if x < 0: tok.xkind = pxSymbol - else: tok.xKind = TTokKind(x + ord(firstKeyword)) - -proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: TCharSet) = - # matches ([chars]_)* - var pos = L.bufpos # use registers for pos, buf - var buf = L.buf - while true: - if buf[pos] in chars: - add(tok.literal, buf[pos]) - Inc(pos) - else: - break - if buf[pos] == '_': - add(tok.literal, '_') - Inc(pos) - L.bufPos = pos - -proc isFloatLiteral(s: string): bool = - for i in countup(0, len(s)-1): - if s[i] in {'.', 'e', 'E'}: - return true - -proc getNumber2(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 # skip % - if not (L.buf[pos] in {'0'..'1'}): - # BUGFIX for %date% - tok.xkind = pxInvalid - add(tok.literal, '%') - inc(L.bufpos) - return - tok.base = base2 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z', '2'..'9', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': - inc(pos) - of '0', '1': - xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits) - else: break - tok.iNumber = xi - if (bits > 32): tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber16(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 # skip $ - tok.base = base16 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'G'..'Z', 'g'..'z', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': inc(pos) - of '0'..'9': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits, 4) - of 'a'..'f': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) - inc(pos) - inc(bits, 4) - of 'A'..'F': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) - inc(pos) - inc(bits, 4) - else: break - tok.iNumber = xi - if (bits > 32): - tok.xkind = pxInt64Lit - else: - tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber10(L: var TLexer, tok: var TToken) = - tok.base = base10 - matchUnderscoreChars(L, tok, {'0'..'9'}) - if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): - add(tok.literal, '.') - inc(L.bufpos) - matchUnderscoreChars(L, tok, {'e', 'E', '+', '-', '0'..'9'}) - try: - if isFloatLiteral(tok.literal): - tok.fnumber = parseFloat(tok.literal) - tok.xkind = pxFloatLit - else: - tok.iNumber = ParseInt(tok.literal) - if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)): - tok.xkind = pxInt64Lit - else: - tok.xkind = pxIntLit - except EInvalidValue: - lexMessage(L, errInvalidNumber, tok.literal) - except EOverflow: - lexMessage(L, errNumberOutOfRange, tok.literal) - -proc HandleCRLF(L: var TLexer, pos: int): int = - case L.buf[pos] - of CR: result = lexbase.HandleCR(L, pos) - of LF: result = lexbase.HandleLF(L, pos) - else: result = pos - -proc getString(L: var TLexer, tok: var TToken) = - var xi: int - var pos = L.bufPos - var buf = L.buf - while true: - if buf[pos] == '\'': - inc(pos) - while true: - case buf[pos] - of CR, LF, lexbase.EndOfFile: - lexMessage(L, errClosingQuoteExpected) - break - of '\'': - inc(pos) - if buf[pos] == '\'': - inc(pos) - add(tok.literal, '\'') - else: - break - else: - add(tok.literal, buf[pos]) - inc(pos) - elif buf[pos] == '#': - inc(pos) - xi = 0 - case buf[pos] - of '$': - inc(pos) - xi = 0 - while true: - case buf[pos] - of '0'..'9': xi = (xi shl 4) or (ord(buf[pos]) - ord('0')) - of 'a'..'f': xi = (xi shl 4) or (ord(buf[pos]) - ord('a') + 10) - of 'A'..'F': xi = (xi shl 4) or (ord(buf[pos]) - ord('A') + 10) - else: break - inc(pos) - of '0'..'9': - xi = 0 - while buf[pos] in {'0'..'9'}: - xi = (xi * 10) + (ord(buf[pos]) - ord('0')) - inc(pos) - else: lexMessage(L, errInvalidCharacterConstant) - if (xi <= 255): add(tok.literal, Chr(xi)) - else: lexMessage(L, errInvalidCharacterConstant) - else: - break - tok.xkind = pxStrLit - L.bufpos = pos - -proc getSymbol(L: var TLexer, tok: var TToken) = - var h: THash = 0 - var pos = L.bufpos - var buf = L.buf - while true: - var c = buf[pos] - case c - of 'a'..'z', '0'..'9', '\x80'..'\xFF': - h = h +% Ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - of 'A'..'Z': - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = h +% Ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - of '_': nil - else: break - Inc(pos) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - tok.ident = getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) - L.bufpos = pos - setKeyword(L, tok) - -proc scanLineComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - # a comment ends if the next line does not start with the // on the same - # column after only whitespace - tok.xkind = pxComment - var col = getColNumber(L, pos) - while true: - inc(pos, 2) # skip // - add(tok.literal, '#') - while not (buf[pos] in {CR, LF, lexbase.EndOfFile}): - add(tok.literal, buf[pos]) - inc(pos) - pos = handleCRLF(L, pos) - buf = L.buf - var indent = 0 - while buf[pos] == ' ': - inc(pos) - inc(indent) - if (col == indent) and (buf[pos] == '/') and (buf[pos + 1] == '/'): - tok.literal = tok.literal & "\n" - else: - break - L.bufpos = pos - -proc scanCurlyComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - tok.literal = "#" - tok.xkind = pxComment - while true: - case buf[pos] - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - add(tok.literal, "\n#") - of '}': - inc(pos) - break - of lexbase.EndOfFile: lexMessage(L, errTokenExpected, "}") - else: - add(tok.literal, buf[pos]) - inc(pos) - L.bufpos = pos - -proc scanStarComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - tok.literal = "#" - tok.xkind = pxComment - while true: - case buf[pos] - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - add(tok.literal, "\n#") - of '*': - inc(pos) - if buf[pos] == ')': - inc(pos) - break - else: - add(tok.literal, '*') - of lexbase.EndOfFile: - lexMessage(L, errTokenExpected, "*)") - else: - add(tok.literal, buf[pos]) - inc(pos) - L.bufpos = pos - -proc skip(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - while true: - case buf[pos] - of ' ', Tabulator: - Inc(pos) # newline is special: - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - else: - break # EndOfFile also leaves the loop - L.bufpos = pos - -proc getTok(L: var TLexer, tok: var TToken) = - tok.xkind = pxInvalid - fillToken(tok) - skip(L, tok) - var c = L.buf[L.bufpos] - if c in SymStartChars: - getSymbol(L, tok) - elif c in {'0'..'9'}: - getNumber10(L, tok) - else: - case c - of ';': - tok.xkind = pxSemicolon - Inc(L.bufpos) - of '/': - if L.buf[L.bufpos + 1] == '/': - scanLineComment(L, tok) - else: - tok.xkind = pxSlash - inc(L.bufpos) - of ',': - tok.xkind = pxComma - Inc(L.bufpos) - of '(': - Inc(L.bufpos) - if (L.buf[L.bufPos] == '*'): - if (L.buf[L.bufPos + 1] == '$'): - Inc(L.bufpos, 2) - skip(L, tok) - getSymbol(L, tok) - tok.xkind = pxStarDirLe - else: - inc(L.bufpos) - scanStarComment(L, tok) - else: - tok.xkind = pxParLe - of '*': - inc(L.bufpos) - if L.buf[L.bufpos] == ')': - inc(L.bufpos) - tok.xkind = pxStarDirRi - else: - tok.xkind = pxStar - of ')': - tok.xkind = pxParRi - Inc(L.bufpos) - of '[': - Inc(L.bufpos) - tok.xkind = pxBracketLe - of ']': - Inc(L.bufpos) - tok.xkind = pxBracketRi - of '.': - inc(L.bufpos) - if L.buf[L.bufpos] == '.': - tok.xkind = pxDotDot - inc(L.bufpos) - else: - tok.xkind = pxDot - of '{': - Inc(L.bufpos) - case L.buf[L.bufpos] - of '$': - Inc(L.bufpos) - skip(L, tok) - getSymbol(L, tok) - tok.xkind = pxCurlyDirLe - of '&': - Inc(L.bufpos) - tok.xkind = pxAmp - of '%': - Inc(L.bufpos) - tok.xkind = pxPer - of '@': - Inc(L.bufpos) - tok.xkind = pxCommand - else: scanCurlyComment(L, tok) - of '+': - tok.xkind = pxPlus - inc(L.bufpos) - of '-': - tok.xkind = pxMinus - inc(L.bufpos) - of ':': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxAsgn - else: - tok.xkind = pxColon - of '<': - inc(L.bufpos) - if L.buf[L.bufpos] == '>': - inc(L.bufpos) - tok.xkind = pxNeq - elif L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxLe - else: - tok.xkind = pxLt - of '>': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxGe - else: - tok.xkind = pxGt - of '=': - tok.xkind = pxEquals - inc(L.bufpos) - of '@': - tok.xkind = pxAt - inc(L.bufpos) - of '^': - tok.xkind = pxHat - inc(L.bufpos) - of '}': - tok.xkind = pxCurlyDirRi - Inc(L.bufpos) - of '\'', '#': - getString(L, tok) - of '$': - getNumber16(L, tok) - of '%': - getNumber2(L, tok) - of lexbase.EndOfFile: - tok.xkind = pxEof - else: - tok.literal = c & "" - tok.xkind = pxInvalid - lexMessage(L, errInvalidToken, c & " (\\" & $(ord(c)) & ')') - Inc(L.bufpos) diff --git a/rod/pas2nim/pasparse.nim b/rod/pas2nim/pasparse.nim deleted file mode 100755 index 1db582f4e..000000000 --- a/rod/pas2nim/pasparse.nim +++ /dev/null @@ -1,1510 +0,0 @@ -# -# -# Pas2nim - Pascal to Nimrod source converter -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the parser of the Pascal variant Nimrod is written in. -# It transfers a Pascal module into a Nimrod AST. Then the renderer can be -# used to convert the AST to its text representation. - -import - os, llstream, paslex, idents, strutils, ast, astalgo, msgs, options - -type - TSection = enum - seImplementation, seInterface - TContext = enum - conExpr, conStmt, conTypeDesc - TParserFlag* = enum - pfRefs, ## use "ref" instead of "ptr" for Pascal's ^typ - pfMoreReplacements, ## use more than the default replacements - pfImportBlackList ## use import blacklist - TParser*{.final.} = object - section: TSection - inParamList: bool - context: TContext # needed for the @emit command - lastVarSection: PNode - lex: TLexer - tok: TToken - repl: TIdTable # replacements - flags: set[TParserFlag] - - TReplaceTuple* = array[0..1, string] - -const - ImportBlackList*: array[1..3, string] = ["nsystem", "sysutils", "charsets"] - stdReplacements*: array[1..19, TReplaceTuple] = [["include", "incl"], - ["exclude", "excl"], ["pchar", "cstring"], ["assignfile", "open"], - ["integer", "int"], ["longword", "int32"], ["cardinal", "int"], - ["boolean", "bool"], ["shortint", "int8"], ["smallint", "int16"], - ["longint", "int32"], ["byte", "int8"], ["word", "int16"], - ["single", "float32"], ["double", "float64"], ["real", "float"], - ["length", "len"], ["len", "length"], ["setlength", "setlen"]] - nimReplacements*: array[1..35, TReplaceTuple] = [["nimread", "read"], - ["nimwrite", "write"], ["nimclosefile", "close"], ["closefile", "close"], - ["openfile", "open"], ["nsystem", "system"], ["ntime", "times"], - ["nos", "os"], ["nmath", "math"], ["ncopy", "copy"], ["addChar", "add"], - ["halt", "quit"], ["nobject", "TObject"], ["eof", "EndOfFile"], - ["input", "stdin"], ["output", "stdout"], ["addu", "`+%`"], - ["subu", "`-%`"], ["mulu", "`*%`"], ["divu", "`/%`"], ["modu", "`%%`"], - ["ltu", "`<%`"], ["leu", "`<=%`"], ["shlu", "`shl`"], ["shru", "`shr`"], - ["assigned", "not isNil"], ["eintoverflow", "EOverflow"], ["format", "`%`"], - ["snil", "nil"], ["tostringf", "$"], ["ttextfile", "tfile"], - ["tbinaryfile", "tfile"], ["strstart", "0"], ["nl", "\"\\n\""], - ["tostring", "$"]] - -proc ParseUnit*(p: var TParser): PNode -proc openParser*(p: var TParser, filename: string, inputStream: PLLStream, - flags: set[TParserFlag] = {}) -proc closeParser*(p: var TParser) -proc exSymbol*(n: var PNode) -proc fixRecordDef*(n: var PNode) - # XXX: move these two to an auxiliary module - -# implementation - -proc OpenParser(p: var TParser, filename: string, - inputStream: PLLStream, flags: set[TParserFlag] = {}) = - OpenLexer(p.lex, filename, inputStream) - initIdTable(p.repl) - for i in countup(low(stdReplacements), high(stdReplacements)): - IdTablePut(p.repl, getIdent(stdReplacements[i][0]), - getIdent(stdReplacements[i][1])) - if pfMoreReplacements in flags: - for i in countup(low(nimReplacements), high(nimReplacements)): - IdTablePut(p.repl, getIdent(nimReplacements[i][0]), - getIdent(nimReplacements[i][1])) - p.flags = flags - -proc CloseParser(p: var TParser) = CloseLexer(p.lex) -proc getTok(p: var TParser) = getTok(p.lex, p.tok) - -proc parMessage(p: TParser, msg: TMsgKind, arg = "") = - lexMessage(p.lex, msg, arg) - -proc parLineInfo(p: TParser): TLineInfo = - result = getLineInfo(p.lex) - -proc skipCom(p: var TParser, n: PNode) = - while p.tok.xkind == pxComment: - if (n != nil): - if n.comment == nil: n.comment = p.tok.literal - else: add(n.comment, "\n" & p.tok.literal) - else: - parMessage(p, warnCommentXIgnored, p.tok.literal) - getTok(p) - -proc ExpectIdent(p: TParser) = - if p.tok.xkind != pxSymbol: - lexMessage(p.lex, errIdentifierExpected, $(p.tok)) - -proc Eat(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: getTok(p) - else: lexMessage(p.lex, errTokenExpected, TokKindToStr(xkind)) - -proc Opt(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: getTok(p) - -proc newNodeP(kind: TNodeKind, p: TParser): PNode = - result = newNodeI(kind, getLineInfo(p.lex)) - -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal - -proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, - p: TParser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal - -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal - -proc newIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident - -proc createIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - var x = PIdent(IdTableGet(p.repl, ident)) - if x != nil: result.ident = x - else: result.ident = ident - -proc parseExpr(p: var TParser): PNode -proc parseStmt(p: var TParser): PNode -proc parseTypeDesc(p: var TParser, definition: PNode = nil): PNode - -proc parseEmit(p: var TParser, definition: PNode): PNode = - getTok(p) # skip 'emit' - result = ast.emptyNode - if p.tok.xkind != pxCurlyDirRi: - case p.context - of conExpr: - result = parseExpr(p) - of conStmt: - result = parseStmt(p) - if p.tok.xkind != pxCurlyDirRi: - var a = result - result = newNodeP(nkStmtList, p) - addSon(result, a) - while p.tok.xkind != pxCurlyDirRi: - addSon(result, parseStmt(p)) - of conTypeDesc: - result = parseTypeDesc(p, definition) - eat(p, pxCurlyDirRi) - -proc parseCommand(p: var TParser, definition: PNode = nil): PNode = - result = ast.emptyNode - getTok(p) - if p.tok.ident.id == getIdent("discard").id: - result = newNodeP(nkDiscardStmt, p) - getTok(p) - eat(p, pxCurlyDirRi) - addSon(result, parseExpr(p)) - elif p.tok.ident.id == getIdent("set").id: - getTok(p) - eat(p, pxCurlyDirRi) - result = parseExpr(p) - if result.kind == nkEmpty: InternalError("emptyNode modified") - result.kind = nkCurly - elif p.tok.ident.id == getIdent("cast").id: - getTok(p) - eat(p, pxCurlyDirRi) - var a = parseExpr(p) - if (a.kind == nkCall) and (sonsLen(a) == 2): - result = newNodeP(nkCast, p) - addSon(result, a.sons[0]) - addSon(result, a.sons[1]) - else: - parMessage(p, errInvalidDirectiveX, $p.tok) - result = a - elif p.tok.ident.id == getIdent("emit").id: - result = parseEmit(p, definition) - elif p.tok.ident.id == getIdent("ignore").id: - getTok(p) - eat(p, pxCurlyDirRi) - while true: - case p.tok.xkind - of pxEof: - parMessage(p, errTokenExpected, "{@emit}") - of pxCommand: - getTok(p) - if p.tok.ident.id == getIdent("emit").id: - result = parseEmit(p, definition) - break - else: - while (p.tok.xkind != pxCurlyDirRi) and (p.tok.xkind != pxEof): - getTok(p) - eat(p, pxCurlyDirRi) - else: - getTok(p) # skip token - elif p.tok.ident.id == getIdent("ptr").id: - result = newNodeP(nkPtrTy, p) - getTok(p) - eat(p, pxCurlyDirRi) - elif p.tok.ident.id == getIdent("tuple").id: - result = newNodeP(nkTupleTy, p) - getTok(p) - eat(p, pxCurlyDirRi) - elif p.tok.ident.id == getIdent("acyclic").id: - result = newIdentNodeP(p.tok.ident, p) - getTok(p) - eat(p, pxCurlyDirRi) - else: - parMessage(p, errInvalidDirectiveX, $p.tok) - while true: - getTok(p) - if p.tok.xkind == pxCurlyDirRi or p.tok.xkind == pxEof: break - eat(p, pxCurlyDirRi) - result = ast.emptyNode - -proc getPrecedence(kind: TTokKind): int = - case kind - of pxDiv, pxMod, pxStar, pxSlash, pxShl, pxShr, pxAnd: result = 5 - of pxPlus, pxMinus, pxOr, pxXor: result = 4 - of pxIn, pxEquals, pxLe, pxLt, pxGe, pxGt, pxNeq, pxIs: result = 3 - else: result = -1 - -proc rangeExpr(p: var TParser): PNode = - var a = parseExpr(p) - if p.tok.xkind == pxDotDot: - result = newNodeP(nkRange, p) - addSon(result, a) - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - result = a - -proc bracketExprList(p: var TParser, first: PNode): PNode = - result = newNodeP(nkBracketExpr, p) - addSon(result, first) - getTok(p) - skipCom(p, result) - while true: - if p.tok.xkind == pxBracketRi: - getTok(p) - break - if p.tok.xkind == pxEof: - parMessage(p, errTokenExpected, TokKindToStr(pxBracketRi)) - break - var a = rangeExpr(p) - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - -proc exprColonEqExpr(p: var TParser, kind: TNodeKind, - tok: TTokKind): PNode = - var a = parseExpr(p) - if p.tok.xkind == tok: - result = newNodeP(kind, p) - getTok(p) - skipCom(p, result) - addSon(result, a) - addSon(result, parseExpr(p)) - else: - result = a - -proc exprListAux(p: var TParser, elemKind: TNodeKind, - endTok, sepTok: TTokKind, result: PNode) = - getTok(p) - skipCom(p, result) - while true: - if p.tok.xkind == endTok: - getTok(p) - break - if p.tok.xkind == pxEof: - parMessage(p, errTokenExpected, TokKindToStr(endtok)) - break - var a = exprColonEqExpr(p, elemKind, sepTok) - skipCom(p, a) - if (p.tok.xkind == pxComma) or (p.tok.xkind == pxSemicolon): - getTok(p) - skipCom(p, a) - addSon(result, a) - -proc qualifiedIdent(p: var TParser): PNode = - if p.tok.xkind == pxSymbol: - result = createIdentNodeP(p.tok.ident, p) - else: - parMessage(p, errIdentifierExpected, $p.tok) - return ast.emptyNode - getTok(p) - skipCom(p, result) - if p.tok.xkind == pxDot: - getTok(p) - skipCom(p, result) - if p.tok.xkind == pxSymbol: - var a = result - result = newNodeI(nkDotExpr, a.info) - addSon(result, a) - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - else: - parMessage(p, errIdentifierExpected, $p.tok) - -proc qualifiedIdentListAux(p: var TParser, endTok: TTokKind, - result: PNode) = - getTok(p) - skipCom(p, result) - while true: - if p.tok.xkind == endTok: - getTok(p) - break - if p.tok.xkind == pxEof: - parMessage(p, errTokenExpected, TokKindToStr(endtok)) - break - var a = qualifiedIdent(p) - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - -proc exprColonEqExprList(p: var TParser, kind, elemKind: TNodeKind, - endTok, sepTok: TTokKind): PNode = - result = newNodeP(kind, p) - exprListAux(p, elemKind, endTok, sepTok, result) - -proc setBaseFlags(n: PNode, base: TNumericalBase) = - case base - of base10: nil - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) - -proc identOrLiteral(p: var TParser): PNode = - case p.tok.xkind - of pxSymbol: - result = createIdentNodeP(p.tok.ident, p) - getTok(p) - of pxIntLit: - result = newIntNodeP(nkIntLit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of pxInt64Lit: - result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of pxFloatLit: - result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of pxStrLit: - if len(p.tok.literal) != 1: result = newStrNodeP(nkStrLit, p.tok.literal, p) - else: result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) - getTok(p) - of pxNil: - result = newNodeP(nkNilLit, p) - getTok(p) - of pxParLe: - # () constructor - result = exprColonEqExprList(p, nkPar, nkExprColonExpr, pxParRi, pxColon) - #if hasSonWith(result, nkExprColonExpr) then - # replaceSons(result, nkExprColonExpr, nkExprEqExpr) - if (sonsLen(result) > 1) and not hasSonWith(result, nkExprColonExpr): - result.kind = nkBracket # is an array constructor - of pxBracketLe: - # [] constructor - result = newNodeP(nkBracket, p) - getTok(p) - skipCom(p, result) - while (p.tok.xkind != pxBracketRi) and (p.tok.xkind != pxEof): - var a = rangeExpr(p) - if a.kind == nkRange: - result.kind = nkCurly # it is definitely a set literal - opt(p, pxComma) - skipCom(p, a) - assert(a != nil) - addSon(result, a) - eat(p, pxBracketRi) - of pxCommand: - result = parseCommand(p) - else: - parMessage(p, errExprExpected, $(p.tok)) - getTok(p) # we must consume a token here to prevend endless loops! - result = ast.emptyNode - if result.kind != nkEmpty: skipCom(p, result) - -proc primary(p: var TParser): PNode = - # prefix operator? - if (p.tok.xkind == pxNot) or (p.tok.xkind == pxMinus) or - (p.tok.xkind == pxPlus): - result = newNodeP(nkPrefix, p) - var a = newIdentNodeP(getIdent($p.tok), p) - addSon(result, a) - getTok(p) - skipCom(p, a) - addSon(result, primary(p)) - return - elif p.tok.xkind == pxAt: - result = newNodeP(nkAddr, p) - var a = newIdentNodeP(getIdent($p.tok), p) - getTok(p) - if p.tok.xkind == pxBracketLe: - result = newNodeP(nkPrefix, p) - addSon(result, a) - addSon(result, identOrLiteral(p)) - else: - addSon(result, primary(p)) - return - result = identOrLiteral(p) - while true: - case p.tok.xkind - of pxParLe: - var a = result - result = newNodeP(nkCall, p) - addSon(result, a) - exprListAux(p, nkExprEqExpr, pxParRi, pxEquals, result) - of pxDot: - var a = result - result = newNodeP(nkDotExpr, p) - addSon(result, a) - getTok(p) # skip '.' - skipCom(p, result) - if p.tok.xkind == pxSymbol: - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - else: - parMessage(p, errIdentifierExpected, $p.tok) - of pxHat: - var a = result - result = newNodeP(nkBracketExpr, p) - addSon(result, a) - getTok(p) - of pxBracketLe: - result = bracketExprList(p, result) - else: break - -proc lowestExprAux(p: var TParser, v: var PNode, limit: int): TTokKind = - var - nextop: TTokKind - v2, node, opNode: PNode - v = primary(p) # expand while operators have priorities higher than 'limit' - var op = p.tok.xkind - var opPred = getPrecedence(op) - while (opPred > limit): - node = newNodeP(nkInfix, p) - opNode = newIdentNodeP(getIdent($(p.tok)), p) # skip operator: - getTok(p) - case op - of pxPlus: - case p.tok.xkind - of pxPer: - getTok(p) - eat(p, pxCurlyDirRi) - opNode.ident = getIdent("+%") - of pxAmp: - getTok(p) - eat(p, pxCurlyDirRi) - opNode.ident = getIdent("&") - else: - nil - of pxMinus: - if p.tok.xkind == pxPer: - getTok(p) - eat(p, pxCurlyDirRi) - opNode.ident = getIdent("-%") - of pxEquals: - opNode.ident = getIdent("==") - of pxNeq: - opNode.ident = getIdent("!=") - else: - nil - skipCom(p, opNode) # read sub-expression with higher priority - nextop = lowestExprAux(p, v2, opPred) - addSon(node, opNode) - addSon(node, v) - addSon(node, v2) - v = node - op = nextop - opPred = getPrecedence(nextop) - result = op # return first untreated operator - -proc fixExpr(n: PNode): PNode = - result = n - case n.kind - of nkInfix: - if n.sons[1].kind == nkBracket: n.sons[1].kind = nkCurly - if n.sons[2].kind == nkBracket: n.sons[2].kind = nkCurly - if (n.sons[0].kind == nkIdent): - if (n.sons[0].ident.id == getIdent("+").id): - if (n.sons[1].kind == nkCharLit) and (n.sons[2].kind == nkStrLit) and - (n.sons[2].strVal == ""): - result = newStrNode(nkStrLit, chr(int(n.sons[1].intVal)) & "") - result.info = n.info - return # do not process sons as they don't exist anymore - elif (n.sons[1].kind in {nkCharLit, nkStrLit}) or - (n.sons[2].kind in {nkCharLit, nkStrLit}): - n.sons[0].ident = getIdent("&") # fix operator - else: - nil - if not (n.kind in {nkEmpty..nkNilLit}): - for i in countup(0, sonsLen(n) - 1): result.sons[i] = fixExpr(n.sons[i]) - -proc parseExpr(p: var TParser): PNode = - var oldcontext = p.context - p.context = conExpr - if p.tok.xkind == pxCommand: - result = parseCommand(p) - else: - discard lowestExprAux(p, result, - 1) - result = fixExpr(result) - p.context = oldcontext - -proc parseExprStmt(p: var TParser): PNode = - var info = parLineInfo(p) - var a = parseExpr(p) - if p.tok.xkind == pxAsgn: - getTok(p) - skipCom(p, a) - var b = parseExpr(p) - result = newNodeI(nkAsgn, info) - addSon(result, a) - addSon(result, b) - else: - result = a - -proc inImportBlackList(ident: PIdent): bool = - for i in countup(low(ImportBlackList), high(ImportBlackList)): - if ident.id == getIdent(ImportBlackList[i]).id: - return true - -proc parseUsesStmt(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkImportStmt, p) - getTok(p) # skip `import` - skipCom(p, result) - while true: - case p.tok.xkind - of pxEof: break - of pxSymbol: a = newIdentNodeP(p.tok.ident, p) - else: - parMessage(p, errIdentifierExpected, $(p.tok)) - break - getTok(p) # skip identifier, string - skipCom(p, a) - if pfImportBlackList notin p.flags or not inImportBlackList(a.ident): - addSon(result, createIdentNodeP(a.ident, p)) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - else: - break - if sonsLen(result) == 0: result = ast.emptyNode - -proc parseIncludeDir(p: var TParser): PNode = - result = newNodeP(nkIncludeStmt, p) - getTok(p) # skip `include` - var filename = "" - while true: - case p.tok.xkind - of pxSymbol, pxDot, pxDotDot, pxSlash: - add(filename, $p.tok) - getTok(p) - of pxStrLit: - filename = p.tok.literal - getTok(p) - break - of pxCurlyDirRi: - break - else: - parMessage(p, errIdentifierExpected, $p.tok) - break - addSon(result, newStrNodeP(nkStrLit, changeFileExt(filename, "nim"), p)) - if filename == "config.inc": result = ast.emptyNode - -proc definedExprAux(p: var TParser): PNode = - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP(getIdent("defined"), p)) - ExpectIdent(p) - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - -proc isHandledDirective(p: TParser): bool = - if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: - case toLower(p.tok.ident.s) - of "else", "endif": result = false - else: result = true - -proc parseStmtList(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while true: - case p.tok.xkind - of pxEof: - break - of pxCurlyDirLe, pxStarDirLe: - if not isHandledDirective(p): break - else: - nil - addSon(result, parseStmt(p)) - if sonsLen(result) == 1: result = result.sons[0] - -proc parseIfDirAux(p: var TParser, result: PNode) = - addSon(result.sons[0], parseStmtList(p)) - if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: - var endMarker = succ(p.tok.xkind) - if toLower(p.tok.ident.s) == "else": - var s = newNodeP(nkElse, p) - while p.tok.xkind != pxEof and p.tok.xkind != endMarker: getTok(p) - eat(p, endMarker) - addSon(s, parseStmtList(p)) - addSon(result, s) - if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: - endMarker = succ(p.tok.xkind) - if toLower(p.tok.ident.s) == "endif": - while p.tok.xkind != pxEof and p.tok.xkind != endMarker: getTok(p) - eat(p, endMarker) - else: - parMessage(p, errXExpected, "{$endif}") - else: - parMessage(p, errXExpected, "{$endif}") - -proc parseIfdefDir(p: var TParser, endMarker: TTokKind): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], definedExprAux(p)) - eat(p, endMarker) - parseIfDirAux(p, result) - -proc parseIfndefDir(p: var TParser, endMarker: TTokKind): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - var e = newNodeP(nkCall, p) - addSon(e, newIdentNodeP(getIdent("not"), p)) - addSon(e, definedExprAux(p)) - eat(p, endMarker) - addSon(result.sons[0], e) - parseIfDirAux(p, result) - -proc parseIfDir(p: var TParser, endMarker: TTokKind): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], parseExpr(p)) - eat(p, endMarker) - parseIfDirAux(p, result) - -proc parseDirective(p: var TParser): PNode = - result = ast.emptyNode - if not (p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}): return - var endMarker = succ(p.tok.xkind) - if p.tok.ident != nil: - case toLower(p.tok.ident.s) - of "include": - result = parseIncludeDir(p) - eat(p, endMarker) - of "if": result = parseIfDir(p, endMarker) - of "ifdef": result = parseIfdefDir(p, endMarker) - of "ifndef": result = parseIfndefDir(p, endMarker) - else: - # skip unknown compiler directive - while p.tok.xkind != pxEof and p.tok.xkind != endMarker: getTok(p) - eat(p, endMarker) - else: - eat(p, endMarker) - -proc parseRaise(p: var TParser): PNode = - result = newNodeP(nkRaiseStmt, p) - getTok(p) - skipCom(p, result) - if p.tok.xkind != pxSemicolon: addSon(result, parseExpr(p)) - else: addSon(result, ast.emptyNode) - -proc parseIf(p: var TParser): PNode = - result = newNodeP(nkIfStmt, p) - while true: - getTok(p) # skip ``if`` - var branch = newNodeP(nkElifBranch, p) - skipCom(p, branch) - addSon(branch, parseExpr(p)) - eat(p, pxThen) - skipCom(p, branch) - addSon(branch, parseStmt(p)) - skipCom(p, branch) - addSon(result, branch) - if p.tok.xkind == pxElse: - getTok(p) - if p.tok.xkind != pxIf: - # ordinary else part: - branch = newNodeP(nkElse, p) - skipCom(p, result) # BUGFIX - addSon(branch, parseStmt(p)) - addSon(result, branch) - break - else: - break - -proc parseWhile(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - eat(p, pxDo) - skipCom(p, result) - addSon(result, parseStmt(p)) - -proc parseRepeat(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, newIdentNodeP(getIdent("true"), p)) - var s = newNodeP(nkStmtList, p) - while p.tok.xkind != pxEof and p.tok.xkind != pxUntil: - addSon(s, parseStmt(p)) - eat(p, pxUntil) - var a = newNodeP(nkIfStmt, p) - skipCom(p, a) - var b = newNodeP(nkElifBranch, p) - var c = newNodeP(nkBreakStmt, p) - addSon(c, ast.emptyNode) - addSon(b, parseExpr(p)) - skipCom(p, a) - addSon(b, c) - addSon(a, b) - if b.sons[0].kind == nkIdent and b.sons[0].ident.id == getIdent("false").id: - nil - else: - addSon(s, a) - addSon(result, s) - -proc parseCase(p: var TParser): PNode = - var b: PNode - result = newNodeP(nkCaseStmt, p) - getTok(p) - addSon(result, parseExpr(p)) - eat(p, pxOf) - skipCom(p, result) - while (p.tok.xkind != pxEnd) and (p.tok.xkind != pxEof): - if p.tok.xkind == pxElse: - b = newNodeP(nkElse, p) - getTok(p) - else: - b = newNodeP(nkOfBranch, p) - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxColon): - addSon(b, rangeExpr(p)) - opt(p, pxComma) - skipcom(p, b) - eat(p, pxColon) - skipCom(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkElse: break - eat(p, pxEnd) - -proc parseTry(p: var TParser): PNode = - result = newNodeP(nkTryStmt, p) - getTok(p) - skipCom(p, result) - var b = newNodeP(nkStmtList, p) - while not (p.tok.xkind in {pxFinally, pxExcept, pxEof, pxEnd}): - addSon(b, parseStmt(p)) - addSon(result, b) - if p.tok.xkind == pxExcept: - getTok(p) - while p.tok.ident.id == getIdent("on").id: - b = newNodeP(nkExceptBranch, p) - getTok(p) - var e = qualifiedIdent(p) - if p.tok.xkind == pxColon: - getTok(p) - e = qualifiedIdent(p) - addSon(b, e) - eat(p, pxDo) - addSon(b, parseStmt(p)) - addSon(result, b) - if p.tok.xkind == pxCommand: discard parseCommand(p) - if p.tok.xkind == pxElse: - b = newNodeP(nkExceptBranch, p) - getTok(p) - addSon(b, parseStmt(p)) - addSon(result, b) - if p.tok.xkind == pxFinally: - b = newNodeP(nkFinally, p) - getTok(p) - var e = newNodeP(nkStmtList, p) - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxEnd): - addSon(e, parseStmt(p)) - if sonsLen(e) == 0: addSon(e, newNodeP(nkNilLit, p)) - addSon(result, e) - eat(p, pxEnd) - -proc parseFor(p: var TParser): PNode = - result = newNodeP(nkForStmt, p) - getTok(p) - skipCom(p, result) - expectIdent(p) - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - eat(p, pxAsgn) - var a = parseExpr(p) - var b = ast.emptyNode - var c = newNodeP(nkCall, p) - if p.tok.xkind == pxTo: - addSon(c, newIdentNodeP(getIdent("countup"), p)) - getTok(p) - b = parseExpr(p) - elif p.tok.xkind == pxDownto: - addSon(c, newIdentNodeP(getIdent("countdown"), p)) - getTok(p) - b = parseExpr(p) - else: - parMessage(p, errTokenExpected, TokKindToStr(pxTo)) - addSon(c, a) - addSon(c, b) - eat(p, pxDo) - skipCom(p, result) - addSon(result, c) - addSon(result, parseStmt(p)) - -proc parseParam(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkIdentDefs, p) - var v = ast.emptyNode - case p.tok.xkind - of pxConst: - getTok(p) - of pxVar: - getTok(p) - v = newNodeP(nkVarTy, p) - of pxOut: - getTok(p) - v = newNodeP(nkVarTy, p) - else: - nil - while true: - case p.tok.xkind - of pxSymbol: a = createIdentNodeP(p.tok.ident, p) - of pxColon, pxEof, pxParRi, pxEquals: break - else: - parMessage(p, errIdentifierExpected, $p.tok) - return - getTok(p) # skip identifier - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - if v.kind != nkEmpty: addSon(v, parseTypeDesc(p)) - else: v = parseTypeDesc(p) - addSon(result, v) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind != pxEquals: - parMessage(p, errColonOrEqualsExpected, $p.tok) - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - -proc parseParamList(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkFormalParams, p) - addSon(result, ast.emptyNode) # return type - if p.tok.xkind == pxParLe: - p.inParamList = true - getTok(p) - skipCom(p, result) - while true: - case p.tok.xkind - of pxSymbol, pxConst, pxVar, pxOut: - a = parseParam(p) - of pxParRi: - getTok(p) - break - else: - parMessage(p, errTokenExpected, ")") - break - skipCom(p, a) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, a) - addSon(result, a) - p.inParamList = false - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - result.sons[0] = parseTypeDesc(p) - -proc parseCallingConvention(p: var TParser): PNode = - result = ast.emptyNode - if p.tok.xkind == pxSymbol: - case toLower(p.tok.ident.s) - of "stdcall", "cdecl", "safecall", "syscall", "inline", "fastcall": - result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(p.tok.ident, p)) - getTok(p) - opt(p, pxSemicolon) - of "register": - result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("fastcall"), p)) - getTok(p) - opt(p, pxSemicolon) - else: - nil - -proc parseRoutineSpecifiers(p: var TParser, noBody: var bool): PNode = - var e: PNode - result = parseCallingConvention(p) - noBody = false - while p.tok.xkind == pxSymbol: - case toLower(p.tok.ident.s) - of "assembler", "overload", "far": - getTok(p) - opt(p, pxSemicolon) - of "forward": - noBody = true - getTok(p) - opt(p, pxSemicolon) - of "importc": - # This is a fake for platform module. There is no ``importc`` - # directive in Pascal. - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("importc"), p)) - noBody = true - getTok(p) - opt(p, pxSemicolon) - of "noconv": - # This is a fake for platform module. There is no ``noconv`` - # directive in Pascal. - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("noconv"), p)) - noBody = true - getTok(p) - opt(p, pxSemicolon) - of "procvar": - # This is a fake for the Nimrod compiler. There is no ``procvar`` - # directive in Pascal. - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("procvar"), p)) - getTok(p) - opt(p, pxSemicolon) - of "varargs": - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("varargs"), p)) - getTok(p) - opt(p, pxSemicolon) - of "external": - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - getTok(p) - noBody = true - e = newNodeP(nkExprColonExpr, p) - addSon(e, newIdentNodeP(getIdent("dynlib"), p)) - addSon(e, parseExpr(p)) - addSon(result, e) - opt(p, pxSemicolon) - if (p.tok.xkind == pxSymbol) and - (p.tok.ident.id == getIdent("name").id): - e = newNodeP(nkExprColonExpr, p) - getTok(p) - addSon(e, newIdentNodeP(getIdent("importc"), p)) - addSon(e, parseExpr(p)) - addSon(result, e) - else: - addSon(result, newIdentNodeP(getIdent("importc"), p)) - opt(p, pxSemicolon) - else: - e = parseCallingConvention(p) - if e.kind == nkEmpty: break - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, e.sons[0]) - -proc parseRoutineType(p: var TParser): PNode = - result = newNodeP(nkProcTy, p) - getTok(p) - skipCom(p, result) - addSon(result, parseParamList(p)) - opt(p, pxSemicolon) - addSon(result, parseCallingConvention(p)) - skipCom(p, result) - -proc parseEnum(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkEnumTy, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) # it does not inherit from any enumeration - while true: - case p.tok.xkind - of pxEof, pxParRi: break - of pxSymbol: a = newIdentNodeP(p.tok.ident, p) - else: - parMessage(p, errIdentifierExpected, $(p.tok)) - break - getTok(p) # skip identifier - skipCom(p, a) - if (p.tok.xkind == pxEquals) or (p.tok.xkind == pxAsgn): - getTok(p) - skipCom(p, a) - var b = a - a = newNodeP(nkEnumFieldDef, p) - addSon(a, b) - addSon(a, parseExpr(p)) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - eat(p, pxParRi) - -proc identVis(p: var TParser): PNode = - # identifier with visability - var a = createIdentNodeP(p.tok.ident, p) - if p.section == seInterface: - result = newNodeP(nkPostfix, p) - addSon(result, newIdentNodeP(getIdent("*"), p)) - addSon(result, a) - else: - result = a - getTok(p) - -type - TSymbolParser = proc (p: var TParser): PNode - -proc rawIdent(p: var TParser): PNode = - result = createIdentNodeP(p.tok.ident, p) - getTok(p) - -proc parseIdentColonEquals(p: var TParser, - identParser: TSymbolParser): PNode = - var a: PNode - result = newNodeP(nkIdentDefs, p) - while true: - case p.tok.xkind - of pxSymbol: a = identParser(p) - of pxColon, pxEof, pxParRi, pxEquals: break - else: - parMessage(p, errIdentifierExpected, $(p.tok)) - return - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind != pxEquals: - parMessage(p, errColonOrEqualsExpected, $(p.tok)) - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, result) - -proc parseRecordCase(p: var TParser): PNode = - var b, c: PNode - result = newNodeP(nkRecCase, p) - getTok(p) - var a = newNodeP(nkIdentDefs, p) - addSon(a, rawIdent(p)) - eat(p, pxColon) - addSon(a, parseTypeDesc(p)) - addSon(a, ast.emptyNode) - addSon(result, a) - eat(p, pxOf) - skipCom(p, result) - while true: - case p.tok.xkind - of pxEof, pxEnd: - break - of pxElse: - b = newNodeP(nkElse, p) - getTok(p) - else: - b = newNodeP(nkOfBranch, p) - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxColon): - addSon(b, rangeExpr(p)) - opt(p, pxComma) - skipcom(p, b) - eat(p, pxColon) - skipCom(p, b) - c = newNodeP(nkRecList, p) - eat(p, pxParLe) - while (p.tok.xkind != pxParRi) and (p.tok.xkind != pxEof): - addSon(c, parseIdentColonEquals(p, rawIdent)) - opt(p, pxSemicolon) - skipCom(p, lastSon(c)) - eat(p, pxParRi) - opt(p, pxSemicolon) - if sonsLen(c) > 0: skipCom(p, lastSon(c)) - else: addSon(c, newNodeP(nkNilLit, p)) - addSon(b, c) - addSon(result, b) - if b.kind == nkElse: break - -proc parseRecordPart(p: var TParser): PNode = - result = ast.emptyNode - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxEnd): - if result.kind == nkEmpty: result = newNodeP(nkRecList, p) - case p.tok.xkind - of pxSymbol: - addSon(result, parseIdentColonEquals(p, rawIdent)) - opt(p, pxSemicolon) - skipCom(p, lastSon(result)) - of pxCase: - addSon(result, parseRecordCase(p)) - of pxComment: - skipCom(p, lastSon(result)) - else: - parMessage(p, errIdentifierExpected, $p.tok) - break - -proc exSymbol(n: var PNode) = - case n.kind - of nkPostfix: - nil - of nkPragmaExpr: - exSymbol(n.sons[0]) - of nkIdent, nkAccQuoted: - var a = newNodeI(nkPostFix, n.info) - addSon(a, newIdentNode(getIdent("*"), n.info)) - addSon(a, n) - n = a - else: internalError(n.info, "exSymbol(): " & $n.kind) - -proc fixRecordDef(n: var PNode) = - case n.kind - of nkRecCase: - fixRecordDef(n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - var length = sonsLen(n.sons[i]) - fixRecordDef(n.sons[i].sons[length - 1]) - of nkRecList, nkRecWhen, nkElse, nkOfBranch, nkElifBranch, nkObjectTy: - for i in countup(0, sonsLen(n) - 1): fixRecordDef(n.sons[i]) - of nkIdentDefs: - for i in countup(0, sonsLen(n) - 3): exSymbol(n.sons[i]) - of nkNilLit, nkEmpty: nil - else: internalError(n.info, "fixRecordDef(): " & $n.kind) - -proc addPragmaToIdent(ident: var PNode, pragma: PNode) = - var pragmasNode: PNode - if ident.kind != nkPragmaExpr: - pragmasNode = newNodeI(nkPragma, ident.info) - var e = newNodeI(nkPragmaExpr, ident.info) - addSon(e, ident) - addSon(e, pragmasNode) - ident = e - else: - pragmasNode = ident.sons[1] - if pragmasNode.kind != nkPragma: - InternalError(ident.info, "addPragmaToIdent") - addSon(pragmasNode, pragma) - -proc parseRecordBody(p: var TParser, result, definition: PNode) = - skipCom(p, result) - var a = parseRecordPart(p) - if result.kind != nkTupleTy: fixRecordDef(a) - addSon(result, a) - eat(p, pxEnd) - case p.tok.xkind - of pxSymbol: - if p.tok.ident.id == getIdent("acyclic").id: - if definition != nil: - addPragmaToIdent(definition.sons[0], newIdentNodeP(p.tok.ident, p)) - else: - InternalError(result.info, "anonymous record is not supported") - getTok(p) - else: - InternalError(result.info, "parseRecordBody") - of pxCommand: - if definition != nil: addPragmaToIdent(definition.sons[0], parseCommand(p)) - else: InternalError(result.info, "anonymous record is not supported") - else: - nil - opt(p, pxSemicolon) - skipCom(p, result) - -proc parseRecordOrObject(p: var TParser, kind: TNodeKind, - definition: PNode): PNode = - result = newNodeP(kind, p) - getTok(p) - addSon(result, ast.emptyNode) - if p.tok.xkind == pxParLe: - var a = newNodeP(nkOfInherit, p) - getTok(p) - addSon(a, parseTypeDesc(p)) - addSon(result, a) - eat(p, pxParRi) - else: - addSon(result, ast.emptyNode) - parseRecordBody(p, result, definition) - -proc parseTypeDesc(p: var TParser, definition: PNode = nil): PNode = - var oldcontext = p.context - p.context = conTypeDesc - if p.tok.xkind == pxPacked: getTok(p) - case p.tok.xkind - of pxCommand: - result = parseCommand(p, definition) - of pxProcedure, pxFunction: - result = parseRoutineType(p) - of pxRecord: - getTok(p) - if p.tok.xkind == pxCommand: - result = parseCommand(p) - if result.kind != nkTupleTy: InternalError(result.info, "parseTypeDesc") - parseRecordBody(p, result, definition) - var a = lastSon(result) # embed nkRecList directly into nkTupleTy - for i in countup(0, sonsLen(a) - 1): - if i == 0: result.sons[sonsLen(result) - 1] = a.sons[0] - else: addSon(result, a.sons[i]) - else: - result = newNodeP(nkObjectTy, p) - addSon(result, ast.emptyNode) - addSon(result, ast.emptyNode) - parseRecordBody(p, result, definition) - if definition != nil: - addPragmaToIdent(definition.sons[0], newIdentNodeP(getIdent("final"), p)) - else: - InternalError(result.info, "anonymous record is not supported") - of pxObject: result = parseRecordOrObject(p, nkObjectTy, definition) - of pxParLe: result = parseEnum(p) - of pxArray: - result = newNodeP(nkBracketExpr, p) - getTok(p) - if p.tok.xkind == pxBracketLe: - addSon(result, newIdentNodeP(getIdent("array"), p)) - getTok(p) - addSon(result, rangeExpr(p)) - eat(p, pxBracketRi) - else: - if p.inParamList: addSon(result, newIdentNodeP(getIdent("openarray"), p)) - else: addSon(result, newIdentNodeP(getIdent("seq"), p)) - eat(p, pxOf) - addSon(result, parseTypeDesc(p)) - of pxSet: - result = newNodeP(nkBracketExpr, p) - getTok(p) - eat(p, pxOf) - addSon(result, newIdentNodeP(getIdent("set"), p)) - addSon(result, parseTypeDesc(p)) - of pxHat: - getTok(p) - if p.tok.xkind == pxCommand: result = parseCommand(p) - elif pfRefs in p.flags: result = newNodeP(nkRefTy, p) - else: result = newNodeP(nkPtrTy, p) - addSon(result, parseTypeDesc(p)) - of pxType: - getTok(p) - result = parseTypeDesc(p) - else: - var a = primary(p) - if p.tok.xkind == pxDotDot: - result = newNodeP(nkBracketExpr, p) - var r = newNodeP(nkRange, p) - addSon(result, newIdentNodeP(getIdent("range"), p)) - getTok(p) - addSon(r, a) - addSon(r, parseExpr(p)) - addSon(result, r) - else: - result = a - p.context = oldcontext - -proc parseTypeDef(p: var TParser): PNode = - result = newNodeP(nkTypeDef, p) - addSon(result, identVis(p)) - addSon(result, ast.emptyNode) # generic params - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseTypeDesc(p, result)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, result) - -proc parseTypeSection(p: var TParser): PNode = - result = newNodeP(nkTypeSection, p) - getTok(p) - skipCom(p, result) - while p.tok.xkind == pxSymbol: - addSon(result, parseTypeDef(p)) - -proc parseConstant(p: var TParser): PNode = - result = newNodeP(nkConstDef, p) - addSon(result, identVis(p)) - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind != pxEquals: - parMessage(p, errColonOrEqualsExpected, $(p.tok)) - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, result) - -proc parseConstSection(p: var TParser): PNode = - result = newNodeP(nkConstSection, p) - getTok(p) - skipCom(p, result) - while p.tok.xkind == pxSymbol: - addSon(result, parseConstant(p)) - -proc parseVar(p: var TParser): PNode = - result = newNodeP(nkVarSection, p) - getTok(p) - skipCom(p, result) - while p.tok.xkind == pxSymbol: - addSon(result, parseIdentColonEquals(p, identVis)) - p.lastVarSection = result - -proc parseRoutine(p: var TParser): PNode = - var noBody: bool - result = newNodeP(nkProcDef, p) - getTok(p) - skipCom(p, result) - expectIdent(p) - addSon(result, identVis(p)) - addSon(result, ast.emptyNode) # generic parameters - addSon(result, parseParamList(p)) - opt(p, pxSemicolon) - addSon(result, parseRoutineSpecifiers(p, noBody)) - if (p.section == seInterface) or noBody: - addSon(result, ast.emptyNode) - else: - var stmts = newNodeP(nkStmtList, p) - while true: - case p.tok.xkind - of pxVar: addSon(stmts, parseVar(p)) - of pxConst: addSon(stmts, parseConstSection(p)) - of pxType: addSon(stmts, parseTypeSection(p)) - of pxComment: skipCom(p, result) - of pxBegin: break - else: - parMessage(p, errTokenExpected, "begin") - break - var a = parseStmt(p) - for i in countup(0, sonsLen(a) - 1): addSon(stmts, a.sons[i]) - addSon(result, stmts) - -proc fixExit(p: var TParser, n: PNode): bool = - if (p.tok.ident.id == getIdent("exit").id): - var length = sonsLen(n) - if (length <= 0): return - var a = n.sons[length-1] - if (a.kind == nkAsgn) and (a.sons[0].kind == nkIdent) and - (a.sons[0].ident.id == getIdent("result").id): - delSon(a, 0) - a.kind = nkReturnStmt - result = true - getTok(p) - opt(p, pxSemicolon) - skipCom(p, a) - -proc fixVarSection(p: var TParser, counter: PNode) = - if p.lastVarSection == nil: return - assert(counter.kind == nkIdent) - for i in countup(0, sonsLen(p.lastVarSection) - 1): - var v = p.lastVarSection.sons[i] - for j in countup(0, sonsLen(v) - 3): - if v.sons[j].ident.id == counter.ident.id: - delSon(v, j) - if sonsLen(v) <= 2: - delSon(p.lastVarSection, i) - return - -proc exSymbols(n: PNode) = - case n.kind - of nkEmpty..nkNilLit: nil - of nkProcDef..nkIteratorDef: exSymbol(n.sons[namePos]) - of nkWhenStmt, nkStmtList: - for i in countup(0, sonsLen(n) - 1): exSymbols(n.sons[i]) - of nkVarSection, nkConstSection: - for i in countup(0, sonsLen(n) - 1): exSymbol(n.sons[i].sons[0]) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - exSymbol(n.sons[i].sons[0]) - if n.sons[i].sons[2].kind == nkObjectTy: - fixRecordDef(n.sons[i].sons[2]) - else: nil - -proc parseBegin(p: var TParser, result: PNode) = - getTok(p) - while true: - case p.tok.xkind - of pxComment: addSon(result, parseStmt(p)) - of pxSymbol: - if not fixExit(p, result): addSon(result, parseStmt(p)) - of pxEnd: - getTok(p) - break - of pxSemicolon: getTok(p) - of pxEof: parMessage(p, errExprExpected) - else: - var a = parseStmt(p) - if a.kind != nkEmpty: addSon(result, a) - if sonsLen(result) == 0: addSon(result, newNodeP(nkNilLit, p)) - -proc parseStmt(p: var TParser): PNode = - var oldcontext = p.context - p.context = conStmt - result = ast.emptyNode - case p.tok.xkind - of pxBegin: - result = newNodeP(nkStmtList, p) - parseBegin(p, result) - of pxCommand: result = parseCommand(p) - of pxCurlyDirLe, pxStarDirLe: - if isHandledDirective(p): result = parseDirective(p) - of pxIf: result = parseIf(p) - of pxWhile: result = parseWhile(p) - of pxRepeat: result = parseRepeat(p) - of pxCase: result = parseCase(p) - of pxTry: result = parseTry(p) - of pxProcedure, pxFunction: result = parseRoutine(p) - of pxType: result = parseTypeSection(p) - of pxConst: result = parseConstSection(p) - of pxVar: result = parseVar(p) - of pxFor: - result = parseFor(p) - fixVarSection(p, result.sons[0]) - of pxRaise: result = parseRaise(p) - of pxUses: result = parseUsesStmt(p) - of pxProgram, pxUnit, pxLibrary: - # skip the pointless header - while not (p.tok.xkind in {pxSemicolon, pxEof}): getTok(p) - getTok(p) - of pxInitialization: getTok(p) # just skip the token - of pxImplementation: - p.section = seImplementation - result = newNodeP(nkCommentStmt, p) - result.comment = "# implementation" - getTok(p) - of pxInterface: - p.section = seInterface - getTok(p) - of pxComment: - result = newNodeP(nkCommentStmt, p) - skipCom(p, result) - of pxSemicolon: getTok(p) - of pxSymbol: - if p.tok.ident.id == getIdent("break").id: - result = newNodeP(nkBreakStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) - elif p.tok.ident.id == getIdent("continue").id: - result = newNodeP(nkContinueStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) - elif p.tok.ident.id == getIdent("exit").id: - result = newNodeP(nkReturnStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) - else: - result = parseExprStmt(p) - of pxDot: getTok(p) # BUGFIX for ``end.`` in main program - else: result = parseExprStmt(p) - opt(p, pxSemicolon) - if result.kind != nkEmpty: skipCom(p, result) - p.context = oldcontext - -proc parseUnit(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - getTok(p) # read first token - while true: - case p.tok.xkind - of pxEof, pxEnd: break - of pxBegin: parseBegin(p, result) - of pxCurlyDirLe, pxStarDirLe: - if isHandledDirective(p): addSon(result, parseDirective(p)) - else: parMessage(p, errXNotAllowedHere, p.tok.ident.s) - else: addSon(result, parseStmt(p)) - opt(p, pxEnd) - opt(p, pxDot) - if p.tok.xkind != pxEof: - addSon(result, parseStmt(p)) # comments after final 'end.' - diff --git a/rod/passaux.nim b/rod/passaux.nim deleted file mode 100755 index a57963c06..000000000 --- a/rod/passaux.nim +++ /dev/null @@ -1,52 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## implements some little helper passes - -import - strutils, ast, astalgo, passes, msgs, options - -proc verboseOpen(s: PSym, filename: string): PPassContext = - #MessageOut('compiling ' + s.name.s); - result = nil # we don't need a context - if gVerbosity > 0: rawMessage(hintProcessing, s.name.s) - -proc verboseProcess(context: PPassContext, n: PNode): PNode = - result = n - if context != nil: InternalError("logpass: context is not nil") - if gVerbosity == 3: - # system.nim deactivates all hints, for verbosity:3 we want the processing - # messages nonetheless, so we activate them again unconditionally: - incl(msgs.gNotes, hintProcessing) - Message(n.info, hintProcessing, $ast.gid) - -proc verbosePass*(): TPass = - initPass(result) - result.open = verboseOpen - result.process = verboseProcess - -proc cleanUp(c: PPassContext, n: PNode): PNode = - result = n - # we cannot clean up if dead code elimination is activated - if optDeadCodeElim in gGlobalOptions: return - case n.kind - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): discard cleanup(c, n.sons[i]) - of nkProcDef, nkMethodDef: - if n.sons[namePos].kind == nkSym: - var s = n.sons[namePos].sym - if sfDeadCodeElim notin getModule(s).flags and not astNeeded(s): - s.ast.sons[codePos] = ast.emptyNode # free the memory - else: - nil - -proc cleanupPass*(): TPass = - initPass(result) - result.process = cleanUp - result.close = cleanUp diff --git a/rod/passes.nim b/rod/passes.nim deleted file mode 100755 index b380cd66f..000000000 --- a/rod/passes.nim +++ /dev/null @@ -1,155 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the passes functionality. A pass must implement the -# `TPass` interface. - -import - strutils, lists, options, ast, astalgo, llstream, msgs, platform, os, - condsyms, idents, rnimsyn, types, extccomp, math, magicsys, nversion, nimsets, - syntaxes, times, rodread - -type - TPassContext* = object of TObject # the pass's context - PPassContext* = ref TPassContext - TPass* = tuple[ - open: proc (module: PSym, filename: string): PPassContext, - openCached: proc (module: PSym, filename: string, - rd: PRodReader): PPassContext, - close: proc (p: PPassContext, n: PNode): PNode, - process: proc (p: PPassContext, topLevelStmt: PNode): PNode] - -# a pass is a tuple of procedure vars ``TPass.close`` may produce additional -# nodes. These are passed to the other close procedures. -# This mechanism used to be used for the instantiation of generics. - -proc registerPass*(p: TPass) -proc initPass*(p: var TPass) - # This implements a memory preserving scheme: Top level statements are - # processed in a pipeline. The compiler never looks at a whole module - # any longer. However, this is simple to change, as new passes may perform - # whole program optimizations. For now, we avoid it to save a lot of memory. -proc processModule*(module: PSym, filename: string, stream: PLLStream, - rd: PRodReader) - -# the semantic checker needs these: -var - gImportModule*: proc (filename: string): PSym - gIncludeFile*: proc (filename: string): PNode - -# implementation - -proc skipCodegen*(n: PNode): bool {.inline.} = - # can be used by codegen passes to determine whether they should do - # something with `n`. Currently, this ignores `n` and uses the global - # error count instead. - result = msgs.gErrorCounter > 0 - -proc astNeeded*(s: PSym): bool = - # The ``rodwrite`` module uses this to determine if the body of a proc - # needs to be stored. The passes manager frees s.sons[codePos] when - # appropriate to free the procedure body's memory. This is important - # to keep memory usage down. - if (s.kind in {skMethod, skProc}) and - ({sfCompilerProc, sfCompileTime} * s.flags == {}) and - (s.typ.callConv != ccInline) and - (s.ast.sons[genericParamsPos].kind == nkEmpty): - result = false - else: - result = true - -const - maxPasses = 10 - -type - TPassContextArray = array[0..maxPasses - 1, PPassContext] - -var - gPasses: array[0..maxPasses - 1, TPass] - gPassesLen: int - -proc registerPass(p: TPass) = - gPasses[gPassesLen] = p - inc(gPassesLen) - -proc openPasses(a: var TPassContextArray, module: PSym, filename: string) = - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].open): a[i] = gPasses[i].open(module, filename) - else: a[i] = nil - -proc openPassesCached(a: var TPassContextArray, module: PSym, filename: string, - rd: PRodReader) = - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].openCached): - a[i] = gPasses[i].openCached(module, filename, rd) - else: - a[i] = nil - -proc closePasses(a: var TPassContextArray) = - var m: PNode = nil - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].close): m = gPasses[i].close(a[i], m) - a[i] = nil # free the memory here - -proc processTopLevelStmt(n: PNode, a: var TPassContextArray) = - # this implements the code transformation pipeline - var m = n - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].process): m = gPasses[i].process(a[i], m) - -proc processTopLevelStmtCached(n: PNode, a: var TPassContextArray) = - # this implements the code transformation pipeline - var m = n - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].openCached): m = gPasses[i].process(a[i], m) - -proc closePassesCached(a: var TPassContextArray) = - var m = ast.emptyNode - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].openCached) and not isNil(gPasses[i].close): - m = gPasses[i].close(a[i], m) - a[i] = nil # free the memory here - -proc processModule(module: PSym, filename: string, stream: PLLStream, - rd: PRodReader) = - var - p: TParsers - a: TPassContextArray - s: PLLStream - if rd == nil: - openPasses(a, module, filename) - if stream == nil: - s = LLStreamOpen(filename, fmRead) - if s == nil: - rawMessage(errCannotOpenFile, filename) - return - else: - s = stream - while true: - openParsers(p, filename, s) - while true: - var n = parseTopLevelStmt(p) - if n.kind == nkEmpty: break - processTopLevelStmt(n, a) - closeParsers(p) - if s.kind != llsStdIn: break - closePasses(a) - # id synchronization point for more consistent code generation: - IDsynchronizationPoint(1000) - else: - openPassesCached(a, module, filename, rd) - var n = loadInitSection(rd) #MessageOut('init section' + renderTree(n)); - for i in countup(0, sonsLen(n) - 1): processTopLevelStmtCached(n.sons[i], a) - closePassesCached(a) - -proc initPass(p: var TPass) = - p.open = nil - p.openCached = nil - p.close = nil - p.process = nil diff --git a/rod/pbraces.nim b/rod/pbraces.nim deleted file mode 100755 index 45d38e342..000000000 --- a/rod/pbraces.nim +++ /dev/null @@ -1,1201 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - llstream, scanner, idents, strutils, ast, msgs, pnimsyn - -proc ParseAll*(p: var TParser): PNode -proc parseTopLevelStmt*(p: var TParser): PNode - # implements an iterator. Returns the next top-level statement or nil if end - # of stream. -# implementation -# ------------------- Expression parsing ------------------------------------ - -proc parseExpr(p: var TParser): PNode -proc parseStmt(p: var TParser): PNode -proc parseTypeDesc(p: var TParser): PNode -proc parseParamList(p: var TParser): PNode -proc optExpr(p: var TParser): PNode = - # [expr] - if (p.tok.tokType != tkComma) and (p.tok.tokType != tkBracketRi) and - (p.tok.tokType != tkDotDot): - result = parseExpr(p) - else: - result = nil - -proc dotdotExpr(p: var TParser, first: PNode = nil): PNode = - result = newNodeP(nkRange, p) - addSon(result, first) - getTok(p) - optInd(p, result) - addSon(result, optExpr(p)) - -proc indexExpr(p: var TParser): PNode = - # indexExpr ::= '..' [expr] | expr ['=' expr | '..' expr] - var a, b: PNode - if p.tok.tokType == tkDotDot: - result = dotdotExpr(p) - else: - a = parseExpr(p) - case p.tok.tokType - of tkEquals: - result = newNodeP(nkExprEqExpr, p) - addSon(result, a) - getTok(p) - if p.tok.tokType == tkDotDot: - addSon(result, dotdotExpr(p)) - else: - b = parseExpr(p) - if p.tok.tokType == tkDotDot: b = dotdotExpr(p, b) - addSon(result, b) - of tkDotDot: - result = dotdotExpr(p, a) - else: result = a - -proc indexExprList(p: var TParser, first: PNode): PNode = - var a: PNode - result = newNodeP(nkBracketExpr, p) - addSon(result, first) - getTok(p) - optInd(p, result) - while (p.tok.tokType != tkBracketRi) and (p.tok.tokType != tkEof) and - (p.tok.tokType != tkSad): - a = indexExpr(p) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkBracketRi) - -proc exprColonEqExpr(p: var TParser, kind: TNodeKind, tok: TTokType): PNode = - var a: PNode - a = parseExpr(p) - if p.tok.tokType == tok: - result = newNodeP(kind, p) - getTok(p) #optInd(p, result); - addSon(result, a) - addSon(result, parseExpr(p)) - else: - result = a - -proc exprListAux(p: var TParser, elemKind: TNodeKind, endTok, sepTok: TTokType, - result: PNode) = - var a: PNode - getTok(p) - optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): - a = exprColonEqExpr(p, elemKind, sepTok) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - eat(p, endTok) - -proc qualifiedIdent(p: var TParser): PNode = - var a: PNode - result = parseSymbol(p) - if p.tok.tokType == tkDot: - getTok(p) - optInd(p, result) - a = result - result = newNodeI(nkDotExpr, a.info) - addSon(result, a) - addSon(result, parseSymbol(p)) - -proc qualifiedIdentListAux(p: var TParser, endTok: TTokType, result: PNode) = - var a: PNode - getTok(p) - optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): - a = qualifiedIdent(p) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - eat(p, endTok) - -proc exprColonEqExprListAux(p: var TParser, elemKind: TNodeKind, - endTok, sepTok: TTokType, result: PNode) = - var a: PNode - getTok(p) - optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof) and - (p.tok.tokType != tkSad): - a = exprColonEqExpr(p, elemKind, sepTok) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, endTok) - -proc exprColonEqExprList(p: var TParser, kind, elemKind: TNodeKind, - endTok, sepTok: TTokType): PNode = - result = newNodeP(kind, p) - exprColonEqExprListAux(p, elemKind, endTok, sepTok, result) - -proc parseCast(p: var TParser): PNode = - result = newNodeP(nkCast, p) - getTok(p) - eat(p, tkBracketLe) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - optPar(p) - eat(p, tkBracketRi) - eat(p, tkParLe) - optInd(p, result) - addSon(result, parseExpr(p)) - optPar(p) - eat(p, tkParRi) - -proc parseAddr(p: var TParser): PNode = - result = newNodeP(nkAddr, p) - getTok(p) - eat(p, tkParLe) - optInd(p, result) - addSon(result, parseExpr(p)) - optPar(p) - eat(p, tkParRi) - -proc parseGStrLit(p: var TParser, a: PNode): PNode = - case p.tok.tokType - of tkGStrLit: - result = newNodeP(nkCallStrLit, p) - addSon(result, a) - addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) - getTok(p) - of tkGTripleStrLit: - result = newNodeP(nkCallStrLit, p) - addSon(result, a) - addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)) - getTok(p) - else: - result = a - -proc identOrLiteral(p: var TParser): PNode = - case p.tok.tokType - of tkSymbol: - result = newIdentNodeP(p.tok.ident, p) - getTok(p) - result = parseGStrLit(p, result) - of tkAccent: - result = accExpr(p) # literals - of tkIntLit: - result = newIntNodeP(nkIntLit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt8Lit: - result = newIntNodeP(nkInt8Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt16Lit: - result = newIntNodeP(nkInt16Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt32Lit: - result = newIntNodeP(nkInt32Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt64Lit: - result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkFloatLit: - result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkFloat32Lit: - result = newFloatNodeP(nkFloat32Lit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkFloat64Lit: - result = newFloatNodeP(nkFloat64Lit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkStrLit: - result = newStrNodeP(nkStrLit, p.tok.literal, p) - getTok(p) - of tkRStrLit: - result = newStrNodeP(nkRStrLit, p.tok.literal, p) - getTok(p) - of tkTripleStrLit: - result = newStrNodeP(nkTripleStrLit, p.tok.literal, p) - getTok(p) - of tkCharLit: - result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) - getTok(p) - of tkNil: - result = newNodeP(nkNilLit, p) - getTok(p) - of tkParLe: - # () constructor - result = exprColonEqExprList(p, nkPar, nkExprColonExpr, tkParRi, tkColon) - of tkCurlyLe: - # {} constructor - result = exprColonEqExprList(p, nkCurly, nkRange, tkCurlyRi, tkDotDot) - of tkBracketLe: - # [] constructor - result = exprColonEqExprList(p, nkBracket, nkExprColonExpr, tkBracketRi, - tkColon) - of tkCast: - result = parseCast(p) - of tkAddr: - result = parseAddr(p) - else: - parMessage(p, errExprExpected, tokToStr(p.tok)) - getTok(p) # we must consume a token here to prevend endless loops! - result = nil - -proc primary(p: var TParser): PNode = - var a: PNode - # prefix operator? - if (p.tok.tokType == tkNot) or (p.tok.tokType == tkOpr): - result = newNodeP(nkPrefix, p) - a = newIdentNodeP(p.tok.ident, p) - addSon(result, a) - getTok(p) - optInd(p, a) - addSon(result, primary(p)) - return - elif p.tok.tokType == tkBind: - result = newNodeP(nkBind, p) - getTok(p) - optInd(p, result) - addSon(result, primary(p)) - return - result = identOrLiteral(p) - while true: - case p.tok.tokType - of tkParLe: - a = result - result = newNodeP(nkCall, p) - addSon(result, a) - exprColonEqExprListAux(p, nkExprEqExpr, tkParRi, tkEquals, result) - of tkDot: - a = result - result = newNodeP(nkDotExpr, p) - addSon(result, a) - getTok(p) # skip '.' - optInd(p, result) - addSon(result, parseSymbol(p)) - result = parseGStrLit(p, result) - of tkHat: - a = result - result = newNodeP(nkDerefExpr, p) - addSon(result, a) - getTok(p) - of tkBracketLe: - result = indexExprList(p, result) - else: break - -proc lowestExprAux(p: var TParser, v: var PNode, limit: int): PToken = - var - op, nextop: PToken - opPred: int - v2, node, opNode: PNode - v = primary(p) # expand while operators have priorities higher than 'limit' - op = p.tok - opPred = getPrecedence(p.tok) - while (opPred > limit): - node = newNodeP(nkInfix, p) - opNode = newIdentNodeP(op.ident, p) # skip operator: - getTok(p) - optInd(p, opNode) # read sub-expression with higher priority - nextop = lowestExprAux(p, v2, opPred) - addSon(node, opNode) - addSon(node, v) - addSon(node, v2) - v = node - op = nextop - opPred = getPrecedence(nextop) - result = op # return first untreated operator - -proc lowestExpr(p: var TParser): PNode = - discard lowestExprAux(p, result, - 1) - -proc parseIfExpr(p: var TParser): PNode = - # if (expr) expr else expr - var branch: PNode - result = newNodeP(nkIfExpr, p) - while true: - getTok(p) # skip `if`, `elif` - branch = newNodeP(nkElifExpr, p) - eat(p, tkParLe) - addSon(branch, parseExpr(p)) - eat(p, tkParRi) - addSon(branch, parseExpr(p)) - addSon(result, branch) - if p.tok.tokType != tkElif: break - branch = newNodeP(nkElseExpr, p) - eat(p, tkElse) - addSon(branch, parseExpr(p)) - addSon(result, branch) - -proc parsePragma(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkPragma, p) - getTok(p) - optInd(p, result) - while (p.tok.tokType != tkCurlyDotRi) and (p.tok.tokType != tkCurlyRi) and - (p.tok.tokType != tkEof) and (p.tok.tokType != tkSad): - a = exprColonEqExpr(p, nkExprColonExpr, tkColon) - addSon(result, a) - if p.tok.tokType == tkComma: - getTok(p) - optInd(p, a) - optPar(p) - if (p.tok.tokType == tkCurlyDotRi) or (p.tok.tokType == tkCurlyRi): getTok(p) - else: parMessage(p, errTokenExpected, ".}") - -proc identVis(p: var TParser): PNode = - # identifier with visability - var a: PNode - a = parseSymbol(p) - if p.tok.tokType == tkOpr: - result = newNodeP(nkPostfix, p) - addSon(result, newIdentNodeP(p.tok.ident, p)) - addSon(result, a) - getTok(p) - else: - result = a - -proc identWithPragma(p: var TParser): PNode = - var a: PNode - a = identVis(p) - if p.tok.tokType == tkCurlyDotLe: - result = newNodeP(nkPragmaExpr, p) - addSon(result, a) - addSon(result, parsePragma(p)) - else: - result = a - -type - TDeclaredIdentFlag = enum - withPragma, # identifier may have pragma - withBothOptional # both ':' and '=' parts are optional - TDeclaredIdentFlags = set[TDeclaredIdentFlag] - -proc parseIdentColonEquals(p: var TParser, flags: TDeclaredIdentFlags): PNode = - var a: PNode - result = newNodeP(nkIdentDefs, p) - while true: - case p.tok.tokType - of tkSymbol, tkAccent: - if withPragma in flags: a = identWithPragma(p) - else: a = parseSymbol(p) - if a == nil: return - else: break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, nil) - if (p.tok.tokType != tkEquals) and not (withBothOptional in flags): - parMessage(p, errColonOrEqualsExpected, tokToStr(p.tok)) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, nil) - -proc parseTuple(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkTupleTy, p) - getTok(p) - eat(p, tkBracketLe) - optInd(p, result) - while (p.tok.tokType == tkSymbol) or (p.tok.tokType == tkAccent): - a = parseIdentColonEquals(p, {}) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkBracketRi) - -proc parseParamList(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkFormalParams, p) - addSon(result, nil) # return type - if p.tok.tokType == tkParLe: - getTok(p) - optInd(p, result) - while true: - case p.tok.tokType - of tkSymbol, tkAccent: a = parseIdentColonEquals(p, {}) - of tkParRi: break - else: - parMessage(p, errTokenExpected, ")") - break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkParRi) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - result.sons[0] = parseTypeDesc(p) - -proc parseProcExpr(p: var TParser, isExpr: bool): PNode = - # either a proc type or a anonymous proc - var - pragmas, params: PNode - info: TLineInfo - info = parLineInfo(p) - getTok(p) - params = parseParamList(p) - if p.tok.tokType == tkCurlyDotLe: pragmas = parsePragma(p) - else: pragmas = nil - if (p.tok.tokType == tkCurlyLe) and isExpr: - result = newNodeI(nkLambda, info) - addSon(result, nil) # no name part - addSon(result, nil) # no generic parameters - addSon(result, params) - addSon(result, pragmas) #getTok(p); skipComment(p, result); - addSon(result, parseStmt(p)) - else: - result = newNodeI(nkProcTy, info) - addSon(result, params) - addSon(result, pragmas) - -proc parseTypeDescKAux(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - -proc parseExpr(p: var TParser): PNode = - # - #expr ::= lowestExpr - # | 'if' expr ':' expr ('elif' expr ':' expr)* 'else' ':' expr - # | 'var' expr - # | 'ref' expr - # | 'ptr' expr - # | 'type' expr - # | 'tuple' tupleDesc - # | 'proc' paramList [pragma] ['=' stmt] - # - case p.tok.toktype - of tkVar: result = parseTypeDescKAux(p, nkVarTy) - of tkRef: result = parseTypeDescKAux(p, nkRefTy) - of tkPtr: result = parseTypeDescKAux(p, nkPtrTy) - of tkType: result = parseTypeDescKAux(p, nkTypeOfExpr) - of tkTuple: result = parseTuple(p) - of tkProc: result = parseProcExpr(p, true) - of tkIf: result = parseIfExpr(p) - else: result = lowestExpr(p) - -proc parseTypeDesc(p: var TParser): PNode = - if p.tok.toktype == tkProc: result = parseProcExpr(p, false) - else: result = parseExpr(p) - -proc isExprStart(p: TParser): bool = - case p.tok.tokType - of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkProc, tkBind, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, - tkTuple, tkType: - result = true - else: result = false - -proc parseExprStmt(p: var TParser): PNode = - var a, b, e: PNode - a = lowestExpr(p) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, result) - b = parseExpr(p) - result = newNodeI(nkAsgn, a.info) - addSon(result, a) - addSon(result, b) - else: - result = newNodeP(nkCommand, p) - result.info = a.info - addSon(result, a) - while true: - if not isExprStart(p): break - e = parseExpr(p) - addSon(result, e) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - if sonsLen(result) <= 1: result = a - else: a = result - if p.tok.tokType == tkCurlyLe: - # macro statement - result = newNodeP(nkMacroStmt, p) - result.info = a.info - addSon(result, a) - getTok(p) - skipComment(p, result) - if (p.tok.tokType == tkInd) or - not (p.tok.TokType in {tkOf, tkElif, tkElse, tkExcept}): - addSon(result, parseStmt(p)) - while true: - if p.tok.tokType == tkSad: getTok(p) - case p.tok.tokType - of tkOf: - b = newNodeP(nkOfBranch, p) - exprListAux(p, nkRange, tkCurlyLe, tkDotDot, b) - of tkElif: - b = newNodeP(nkElifBranch, p) - getTok(p) - optInd(p, b) - addSon(b, parseExpr(p)) - eat(p, tkCurlyLe) - of tkExcept: - b = newNodeP(nkExceptBranch, p) - qualifiedIdentListAux(p, tkCurlyLe, b) - skipComment(p, b) - of tkElse: - b = newNodeP(nkElse, p) - getTok(p) - eat(p, tkCurlyLe) - else: break - addSon(b, parseStmt(p)) - eat(p, tkCurlyRi) - addSon(result, b) - if b.kind == nkElse: break - eat(p, tkCurlyRi) - -proc parseImportOrIncludeStmt(p: var TParser, kind: TNodeKind): PNode = - var a: PNode - result = newNodeP(kind, p) - getTok(p) # skip `import` or `include` - optInd(p, result) - while true: - case p.tok.tokType - of tkEof, tkSad, tkDed: - break - of tkSymbol, tkAccent: - a = parseSymbol(p) - of tkRStrLit: - a = newStrNodeP(nkRStrLit, p.tok.literal, p) - getTok(p) - of tkStrLit: - a = newStrNodeP(nkStrLit, p.tok.literal, p) - getTok(p) - of tkTripleStrLit: - a = newStrNodeP(nkTripleStrLit, p.tok.literal, p) - getTok(p) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - -proc parseFromStmt(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkFromStmt, p) - getTok(p) # skip `from` - optInd(p, result) - case p.tok.tokType - of tkSymbol, tkAccent: - a = parseSymbol(p) - of tkRStrLit: - a = newStrNodeP(nkRStrLit, p.tok.literal, p) - getTok(p) - of tkStrLit: - a = newStrNodeP(nkStrLit, p.tok.literal, p) - getTok(p) - of tkTripleStrLit: - a = newStrNodeP(nkTripleStrLit, p.tok.literal, p) - getTok(p) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - return - addSon(result, a) #optInd(p, a); - eat(p, tkImport) - optInd(p, result) - while true: - case p.tok.tokType #optInd(p, a); - of tkEof, tkSad, tkDed: - break - of tkSymbol, tkAccent: - a = parseSymbol(p) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - -proc parseReturnOrRaise(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - case p.tok.tokType - of tkEof, tkSad, tkDed: addSon(result, nil) - else: addSon(result, parseExpr(p)) - -proc parseYieldOrDiscard(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - addSon(result, parseExpr(p)) - -proc parseBreakOrContinue(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - case p.tok.tokType - of tkEof, tkSad, tkDed: addSon(result, nil) - else: addSon(result, parseSymbol(p)) - -proc parseIfOrWhen(p: var TParser, kind: TNodeKind): PNode = - var branch: PNode - result = newNodeP(kind, p) - while true: - getTok(p) # skip `if`, `when`, `elif` - branch = newNodeP(nkElifBranch, p) - optInd(p, branch) - eat(p, tkParLe) - addSon(branch, parseExpr(p)) - eat(p, tkParRi) - skipComment(p, branch) - addSon(branch, parseStmt(p)) - skipComment(p, branch) - addSon(result, branch) - if p.tok.tokType != tkElif: break - if p.tok.tokType == tkElse: - branch = newNodeP(nkElse, p) - eat(p, tkElse) - skipComment(p, branch) - addSon(branch, parseStmt(p)) - addSon(result, branch) - -proc parseWhile(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p) - optInd(p, result) - eat(p, tkParLe) - addSon(result, parseExpr(p)) - eat(p, tkParRi) - skipComment(p, result) - addSon(result, parseStmt(p)) - -proc parseCase(p: var TParser): PNode = - var - b: PNode - inElif: bool - result = newNodeP(nkCaseStmt, p) - getTok(p) - eat(p, tkParLe) - addSon(result, parseExpr(p)) - eat(p, tkParRi) - skipComment(p, result) - inElif = false - while true: - if p.tok.tokType == tkSad: getTok(p) - case p.tok.tokType - of tkOf: - if inElif: break - b = newNodeP(nkOfBranch, p) - exprListAux(p, nkRange, tkColon, tkDotDot, b) - of tkElif: - inElif = true - b = newNodeP(nkElifBranch, p) - getTok(p) - optInd(p, b) - addSon(b, parseExpr(p)) - eat(p, tkColon) - of tkElse: - b = newNodeP(nkElse, p) - getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkElse: break - -proc parseTry(p: var TParser): PNode = - var b: PNode - result = newNodeP(nkTryStmt, p) - getTok(p) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) - b = nil - while true: - if p.tok.tokType == tkSad: getTok(p) - case p.tok.tokType - of tkExcept: - b = newNodeP(nkExceptBranch, p) - qualifiedIdentListAux(p, tkColon, b) - of tkFinally: - b = newNodeP(nkFinally, p) - getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkFinally: break - if b == nil: parMessage(p, errTokenExpected, "except") - -proc parseFor(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkForStmt, p) - getTok(p) - optInd(p, result) - a = parseSymbol(p) - addSon(result, a) - while p.tok.tokType == tkComma: - getTok(p) - optInd(p, a) - a = parseSymbol(p) - addSon(result, a) - eat(p, tkIn) - addSon(result, exprColonEqExpr(p, nkRange, tkDotDot)) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) - -proc parseBlock(p: var TParser): PNode = - result = newNodeP(nkBlockStmt, p) - getTok(p) - optInd(p, result) - case p.tok.tokType - of tkEof, tkSad, tkDed, tkColon: addSon(result, nil) - else: addSon(result, parseSymbol(p)) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) - -proc parseAsm(p: var TParser): PNode = - result = newNodeP(nkAsmStmt, p) - getTok(p) - optInd(p, result) - if p.tok.tokType == tkCurlyDotLe: addSon(result, parsePragma(p)) - else: addSon(result, nil) - case p.tok.tokType - of tkStrLit: addSon(result, newStrNodeP(nkStrLit, p.tok.literal, p)) - of tkRStrLit: addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) - of tkTripleStrLit: addSon(result, - newStrNodeP(nkTripleStrLit, p.tok.literal, p)) - else: - parMessage(p, errStringLiteralExpected) - addSon(result, nil) - return - getTok(p) - -proc parseGenericParamList(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkGenericParams, p) - getTok(p) - optInd(p, result) - while (p.tok.tokType == tkSymbol) or (p.tok.tokType == tkAccent): - a = parseIdentColonEquals(p, {withBothOptional}) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkBracketRi) - -proc parseRoutine(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - addSon(result, identVis(p)) - if p.tok.tokType == tkBracketLe: addSon(result, parseGenericParamList(p)) - else: addSon(result, nil) - addSon(result, parseParamList(p)) - if p.tok.tokType == tkCurlyDotLe: addSon(result, parsePragma(p)) - else: addSon(result, nil) - if p.tok.tokType == tkEquals: - getTok(p) - skipComment(p, result) - addSon(result, parseStmt(p)) - else: - addSon(result, nil) - indAndComment(p, result) # XXX: document this in the grammar! - -proc newCommentStmt(p: var TParser): PNode = - result = newNodeP(nkCommentStmt, p) - result.info.line = result.info.line - int16(1) - -type - TDefParser = proc (p: var TParser): PNode - -proc parseSection(p: var TParser, kind: TNodeKind, defparser: TDefParser): PNode = - var a: PNode - result = newNodeP(kind, p) - getTok(p) - skipComment(p, result) - case p.tok.tokType - of tkInd: - pushInd(p.lex[] , p.tok.indent) - getTok(p) - skipComment(p, result) - while true: - case p.tok.tokType - of tkSad: - getTok(p) - of tkSymbol, tkAccent: - a = defparser(p) - skipComment(p, a) - addSon(result, a) - of tkDed: - getTok(p) - break - of tkEof: - break # BUGFIX - of tkComment: - a = newCommentStmt(p) - skipComment(p, a) - addSon(result, a) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - popInd(p.lex[] ) - of tkSymbol, tkAccent, tkParLe: - # tkParLe is allowed for ``var (x, y) = ...`` tuple parsing - addSon(result, defparser(p)) - else: parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - -proc parseConstant(p: var TParser): PNode = - result = newNodeP(nkConstDef, p) - addSon(result, identWithPragma(p)) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, nil) - eat(p, tkEquals) - optInd(p, result) - addSon(result, parseExpr(p)) - indAndComment(p, result) # XXX: special extension! - -proc parseConstSection(p: var TParser): PNode = - result = newNodeP(nkConstSection, p) - getTok(p) - skipComment(p, result) - if p.tok.tokType == tkCurlyLe: - getTok(p) - skipComment(p, result) - while (p.tok.tokType != tkCurlyRi) and (p.tok.tokType != tkEof): - addSon(result, parseConstant(p)) - eat(p, tkCurlyRi) - else: - addSon(result, parseConstant(p)) - -proc parseEnum(p: var TParser): PNode = - var a, b: PNode - result = newNodeP(nkEnumTy, p) - a = nil - getTok(p) - optInd(p, result) - if p.tok.tokType == tkOf: - a = newNodeP(nkOfInherit, p) - getTok(p) - optInd(p, a) - addSon(a, parseTypeDesc(p)) - addSon(result, a) - else: - addSon(result, nil) - while true: - case p.tok.tokType - of tkEof, tkSad, tkDed: break - else: a = parseSymbol(p) - optInd(p, a) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, a) - b = a - a = newNodeP(nkEnumFieldDef, p) - addSon(a, b) - addSon(a, parseExpr(p)) - skipComment(p, a) - if p.tok.tokType == tkComma: - getTok(p) - optInd(p, a) - addSon(result, a) - -proc parseObjectPart(p: var TParser): PNode -proc parseObjectWhen(p: var TParser): PNode = - var branch: PNode - result = newNodeP(nkRecWhen, p) - while true: - getTok(p) # skip `when`, `elif` - branch = newNodeP(nkElifBranch, p) - optInd(p, branch) - addSon(branch, parseExpr(p)) - eat(p, tkColon) - skipComment(p, branch) - addSon(branch, parseObjectPart(p)) - skipComment(p, branch) - addSon(result, branch) - if p.tok.tokType != tkElif: break - if p.tok.tokType == tkElse: - branch = newNodeP(nkElse, p) - eat(p, tkElse) - eat(p, tkColon) - skipComment(p, branch) - addSon(branch, parseObjectPart(p)) - addSon(result, branch) - -proc parseObjectCase(p: var TParser): PNode = - var a, b: PNode - result = newNodeP(nkRecCase, p) - getTok(p) - a = newNodeP(nkIdentDefs, p) - addSon(a, identWithPragma(p)) - eat(p, tkColon) - addSon(a, parseTypeDesc(p)) - addSon(a, nil) - addSon(result, a) - skipComment(p, result) - while true: - if p.tok.tokType == tkSad: getTok(p) - case p.tok.tokType - of tkOf: - b = newNodeP(nkOfBranch, p) - exprListAux(p, nkRange, tkColon, tkDotDot, b) - of tkElse: - b = newNodeP(nkElse, p) - getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) - addSon(b, parseObjectPart(p)) - addSon(result, b) - if b.kind == nkElse: break - -proc parseObjectPart(p: var TParser): PNode = - case p.tok.tokType - of tkInd: - result = newNodeP(nkRecList, p) - pushInd(p.lex[] , p.tok.indent) - getTok(p) - skipComment(p, result) - while true: - case p.tok.tokType - of tkSad: - getTok(p) - of tkCase, tkWhen, tkSymbol, tkAccent, tkNil: - addSon(result, parseObjectPart(p)) - of tkDed: - getTok(p) - break - of tkEof: - break - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - popInd(p.lex[] ) - of tkWhen: - result = parseObjectWhen(p) - of tkCase: - result = parseObjectCase(p) - of tkSymbol, tkAccent: - result = parseIdentColonEquals(p, {withPragma}) - skipComment(p, result) - of tkNil: - result = newNodeP(nkNilLit, p) - getTok(p) - else: result = nil - -proc parseObject(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkObjectTy, p) - getTok(p) - if p.tok.tokType == tkCurlyDotLe: addSon(result, parsePragma(p)) - else: addSon(result, nil) - if p.tok.tokType == tkOf: - a = newNodeP(nkOfInherit, p) - getTok(p) - addSon(a, parseTypeDesc(p)) - addSon(result, a) - else: - addSon(result, nil) - skipComment(p, result) - addSon(result, parseObjectPart(p)) - -proc parseDistinct(p: var TParser): PNode = - result = newNodeP(nkDistinctTy, p) - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - -proc parseTypeDef(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkTypeDef, p) - addSon(result, identWithPragma(p)) - if p.tok.tokType == tkBracketLe: addSon(result, parseGenericParamList(p)) - else: addSon(result, nil) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, result) - case p.tok.tokType - of tkObject: a = parseObject(p) - of tkEnum: a = parseEnum(p) - of tkDistinct: a = parseDistinct(p) - else: a = parseTypeDesc(p) - addSon(result, a) - else: - addSon(result, nil) - indAndComment(p, result) # special extension! - -proc parseVarTuple(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkVarTuple, p) - getTok(p) # skip '(' - optInd(p, result) - while (p.tok.tokType == tkSymbol) or (p.tok.tokType == tkAccent): - a = identWithPragma(p) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - addSon(result, nil) # no type desc - optPar(p) - eat(p, tkParRi) - eat(p, tkEquals) - optInd(p, result) - addSon(result, parseExpr(p)) - -proc parseVariable(p: var TParser): PNode = - if p.tok.tokType == tkParLe: result = parseVarTuple(p) - else: result = parseIdentColonEquals(p, {withPragma}) - indAndComment(p, result) # special extension! - -proc simpleStmt(p: var TParser): PNode = - case p.tok.tokType - of tkReturn: result = parseReturnOrRaise(p, nkReturnStmt) - of tkRaise: result = parseReturnOrRaise(p, nkRaiseStmt) - of tkYield: result = parseYieldOrDiscard(p, nkYieldStmt) - of tkDiscard: result = parseYieldOrDiscard(p, nkDiscardStmt) - of tkBreak: result = parseBreakOrContinue(p, nkBreakStmt) - of tkContinue: result = parseBreakOrContinue(p, nkContinueStmt) - of tkCurlyDotLe: result = parsePragma(p) - of tkImport: result = parseImportOrIncludeStmt(p, nkImportStmt) - of tkFrom: result = parseFromStmt(p) - of tkInclude: result = parseImportOrIncludeStmt(p, nkIncludeStmt) - of tkComment: result = newCommentStmt(p) - else: - if isExprStart(p): result = parseExprStmt(p) - else: result = nil - if result != nil: skipComment(p, result) - -proc parseType(p: var TParser): PNode = - result = newNodeP(nkTypeSection, p) - while true: - case p.tok.tokType - of tkComment: - skipComment(p, result) - of tkType: - # type alias: - of tkEnum: - nil - of tkObject: - nil - of tkTuple: - nil - else: break - -proc complexOrSimpleStmt(p: var TParser): PNode = - case p.tok.tokType - of tkIf: - result = parseIfOrWhen(p, nkIfStmt) - of tkWhile: - result = parseWhile(p) - of tkCase: - result = parseCase(p) - of tkTry: - result = parseTry(p) - of tkFor: - result = parseFor(p) - of tkBlock: - result = parseBlock(p) - of tkAsm: - result = parseAsm(p) - of tkProc: - result = parseRoutine(p, nkProcDef) - of tkMethod: - result = parseRoutine(p, nkMethodDef) - of tkIterator: - result = parseRoutine(p, nkIteratorDef) - of tkMacro: - result = parseRoutine(p, nkMacroDef) - of tkTemplate: - result = parseRoutine(p, nkTemplateDef) - of tkConverter: - result = parseRoutine(p, nkConverterDef) - of tkType, tkEnum, tkObject, tkTuple: - result = nil #result := parseTypeAlias(p, nkTypeSection, parseTypeDef); - of tkConst: - result = parseConstSection(p) - of tkWhen: - result = parseIfOrWhen(p, nkWhenStmt) - of tkVar: - result = parseSection(p, nkVarSection, parseVariable) - else: result = simpleStmt(p) - -proc parseStmt(p: var TParser): PNode = - var a: PNode - if p.tok.tokType == tkCurlyLe: - result = newNodeP(nkStmtList, p) - getTok(p) - while true: - case p.tok.tokType - of tkSad, tkInd, tkDed: getTok(p) - of tkEof, tkCurlyRi: break - else: - a = complexOrSimpleStmt(p) - if a == nil: break - addSon(result, a) - eat(p, tkCurlyRi) - else: - # the case statement is only needed for better error messages: - case p.tok.tokType - of tkIf, tkWhile, tkCase, tkTry, tkFor, tkBlock, tkAsm, tkProc, tkIterator, - tkMacro, tkType, tkConst, tkWhen, tkVar: - parMessage(p, errComplexStmtRequiresInd) - result = nil - else: - result = simpleStmt(p) - if result == nil: parMessage(p, errExprExpected, tokToStr(p.tok)) - if p.tok.tokType in {tkInd, tkDed, tkSad}: getTok(p) - -proc parseAll(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkStmtList, p) - while true: - case p.tok.tokType - of tkDed, tkInd, tkSad: getTok(p) - of tkEof: break - else: - a = complexOrSimpleStmt(p) - if a == nil: parMessage(p, errExprExpected, tokToStr(p.tok)) - addSon(result, a) - -proc parseTopLevelStmt(p: var TParser): PNode = - result = nil - while true: - case p.tok.tokType - of tkDed, tkInd, tkSad: getTok(p) - of tkEof: break - else: - result = complexOrSimpleStmt(p) - if result == nil: parMessage(p, errExprExpected, tokToStr(p.tok)) - break diff --git a/rod/pendx.nim b/rod/pendx.nim deleted file mode 100755 index debe0d852..000000000 --- a/rod/pendx.nim +++ /dev/null @@ -1,23 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - llstream, scanner, idents, strutils, ast, msgs, pnimsyn - -proc ParseAll*(p: var TParser): PNode -proc parseTopLevelStmt*(p: var TParser): PNode - # implements an iterator. Returns the next top-level statement or nil if end - # of stream. -# implementation - -proc ParseAll(p: var TParser): PNode = - result = nil - -proc parseTopLevelStmt(p: var TParser): PNode = - result = nil diff --git a/rod/platform.nim b/rod/platform.nim deleted file mode 100755 index 422cc6134..000000000 --- a/rod/platform.nim +++ /dev/null @@ -1,213 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module contains data about the different processors -# and operating systems. -# Note: Unfortunately if an OS or CPU is listed here this does not mean that -# Nimrod has been tested on this platform or that the RTL has been ported. -# Feel free to test for your excentric platform! - -import - strutils - -type - TSystemOS* = enum # Also add OS in initialization section and alias - # conditionals to condsyms (end of module). - osNone, osDos, osWindows, osOs2, osLinux, osMorphos, osSkyos, osSolaris, - osIrix, osNetbsd, osFreebsd, osOpenbsd, osAix, osPalmos, osQnx, osAmiga, - osAtari, osNetware, osMacos, osMacosx, osEcmaScript, osNimrodVM - -type - TInfoOSProp* = enum - ospNeedsPIC, # OS needs PIC for libraries - ospCaseInsensitive, # OS filesystem is case insensitive - ospPosix # OS is posix-like - TInfoOSProps* = set[TInfoOSProp] - TInfoOS* = tuple[name: string, parDir: string, dllFrmt: string, - altDirSep: string, objExt: string, newLine: string, - pathSep: string, dirSep: string, scriptExt: string, - curDir: string, exeExt: string, extSep: string, - props: TInfoOSProps] - -const - OS*: array[succ(low(TSystemOS))..high(TSystemOS), TInfoOS] = [ - (name: "DOS", - parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".obj", - newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", scriptExt: ".bat", - curDir: ".", exeExt: ".exe", extSep: ".", props: {ospCaseInsensitive}), - (name: "Windows", parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", - objExt: ".obj", newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", - scriptExt: ".bat", curDir: ".", exeExt: ".exe", extSep: ".", - props: {ospCaseInsensitive}), - (name: "OS2", parDir: "..", - dllFrmt: "$1.dll", altDirSep: "/", - objExt: ".obj", newLine: "\x0D\x0A", - pathSep: ";", dirSep: "\\", - scriptExt: ".bat", curDir: ".", - exeExt: ".exe", extSep: ".", - props: {ospCaseInsensitive}), - (name: "Linux", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "MorphOS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "SkyOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "Solaris", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "Irix", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "NetBSD", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "FreeBSD", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "OpenBSD", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "AIX", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "PalmOS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC}), - (name: "QNX", - parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix}), - (name: "Amiga", - parDir: "..", dllFrmt: "$1.library", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {ospNeedsPIC}), - (name: "Atari", - parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: "", curDir: ".", - exeExt: ".tpp", extSep: ".", props: {ospNeedsPIC}), - (name: "Netware", - parDir: "..", dllFrmt: "$1.nlm", altDirSep: "/", objExt: "", - newLine: "\x0D\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", - curDir: ".", exeExt: ".nlm", extSep: ".", props: {ospCaseInsensitive}), - (name: "MacOS", parDir: "::", dllFrmt: "$1Lib", altDirSep: ":", - objExt: ".o", newLine: "\x0D", pathSep: ",", dirSep: ":", scriptExt: "", - curDir: ":", exeExt: "", extSep: ".", props: {ospCaseInsensitive}), - (name: "MacOSX", parDir: "..", dllFrmt: "lib$1.dylib", altDirSep: ":", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "EcmaScript", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {}), - (name: "NimrodVM", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {})] - -type - TSystemCPU* = enum # Also add CPU for in initialization section and - # alias conditionals to condsyms (end of module). - cpuNone, cpuI386, cpuM68k, cpuAlpha, cpuPowerpc, cpuPowerpc64, - cpuSparc, cpuVm, cpuIa64, cpuAmd64, cpuMips, cpuArm, - cpuEcmaScript, cpuNimrodVM - -type - TEndian* = enum - littleEndian, bigEndian - TInfoCPU* = tuple[name: string, intSize: int, endian: TEndian, floatSize: int, - bit: int] - -const - EndianToStr*: array[TEndian, string] = ["littleEndian", "bigEndian"] - CPU*: array[succ(low(TSystemCPU))..high(TSystemCPU), TInfoCPU] = [ - (name: "i386", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "m68k", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "alpha", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "powerpc", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "powerpc64", intSize: 64, endian: bigEndian, floatSize: 64, bit: 64), - (name: "sparc", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "vm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "ia64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "amd64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "mips", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "arm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "ecmascript", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "nimrodvm", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32)] - -var - targetCPU*, hostCPU*: TSystemCPU - targetOS*, hostOS*: TSystemOS - -proc NameToOS*(name: string): TSystemOS -proc NameToCPU*(name: string): TSystemCPU - -var - IntSize*: int - floatSize*: int - PtrSize*: int - tnl*: string # target newline - -proc setTarget*(o: TSystemOS, c: TSystemCPU) = - assert(c != cpuNone) - assert(o != osNone) - #echo "new Target: OS: ", o, " CPU: ", c - targetCPU = c - targetOS = o - intSize = cpu[c].intSize div 8 - floatSize = cpu[c].floatSize div 8 - ptrSize = cpu[c].bit div 8 - tnl = os[o].newLine - -proc NameToOS(name: string): TSystemOS = - for i in countup(succ(osNone), high(TSystemOS)): - if cmpIgnoreStyle(name, OS[i].name) == 0: - return i - result = osNone - -proc NameToCPU(name: string): TSystemCPU = - for i in countup(succ(cpuNone), high(TSystemCPU)): - if cmpIgnoreStyle(name, CPU[i].name) == 0: - return i - result = cpuNone - -hostCPU = nameToCPU(system.hostCPU) -hostOS = nameToOS(system.hostOS) - -setTarget(hostOS, hostCPU) # assume no cross-compiling - diff --git a/rod/pnimsyn.nim b/rod/pnimsyn.nim deleted file mode 100755 index 990ca543d..000000000 --- a/rod/pnimsyn.nim +++ /dev/null @@ -1,1439 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the parser of the standard Nimrod representation. -# The parser strictly reflects the grammar ("doc/grammar.txt"); however -# it uses several helper routines to keep the parser small. A special -# efficient algorithm is used for the precedence levels. The parser here can -# be seen as a refinement of the grammar, as it specifies how the AST is build -# from the grammar and how comments belong to the AST. - -import - llstream, scanner, idents, strutils, ast, msgs - -type - TParser*{.final.} = object # a TParser object represents a module that - # is being parsed - lex*: PLexer # the lexer that is used for parsing - tok*: PToken # the current token - - -proc ParseAll*(p: var TParser): PNode -proc openParser*(p: var TParser, filename: string, inputstream: PLLStream) -proc closeParser*(p: var TParser) -proc parseTopLevelStmt*(p: var TParser): PNode - # implements an iterator. Returns the next top-level statement or - # emtyNode if end of stream. - -# helpers for the other parsers -proc getPrecedence*(tok: PToken): int -proc isOperator*(tok: PToken): bool -proc getTok*(p: var TParser) -proc parMessage*(p: TParser, msg: TMsgKind, arg: string = "") -proc skipComment*(p: var TParser, node: PNode) -proc newNodeP*(kind: TNodeKind, p: TParser): PNode -proc newIntNodeP*(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode -proc newFloatNodeP*(kind: TNodeKind, floatVal: BiggestFloat, p: TParser): PNode -proc newStrNodeP*(kind: TNodeKind, strVal: string, p: TParser): PNode -proc newIdentNodeP*(ident: PIdent, p: TParser): PNode -proc expectIdentOrKeyw*(p: TParser) -proc ExpectIdent*(p: TParser) -proc expectIdentOrOpr*(p: TParser) -proc parLineInfo*(p: TParser): TLineInfo -proc Eat*(p: var TParser, TokType: TTokType) -proc skipInd*(p: var TParser) -proc optPar*(p: var TParser) -proc optInd*(p: var TParser, n: PNode) -proc indAndComment*(p: var TParser, n: PNode) -proc setBaseFlags*(n: PNode, base: TNumericalBase) -proc parseSymbol*(p: var TParser): PNode -proc accExpr*(p: var TParser): PNode -# implementation - -proc initParser(p: var TParser) = - new(p.lex) - new(p.tok) - -proc getTok(p: var TParser) = - rawGetTok(p.lex[], p.tok[]) - -proc OpenParser(p: var TParser, filename: string, inputStream: PLLStream) = - initParser(p) - OpenLexer(p.lex[], filename, inputstream) - getTok(p) # read the first token - -proc CloseParser(p: var TParser) = - CloseLexer(p.lex[]) - -proc parMessage(p: TParser, msg: TMsgKind, arg: string = "") = - lexMessage(p.lex[], msg, arg) - -proc skipComment(p: var TParser, node: PNode) = - if p.tok.tokType == tkComment: - if node != nil: - if node.comment == nil: node.comment = "" - add(node.comment, p.tok.literal) - else: - parMessage(p, errInternal, "skipComment") - getTok(p) - -proc skipInd(p: var TParser) = - if p.tok.tokType == tkInd: getTok(p) - -proc optPar(p: var TParser) = - if p.tok.tokType == tkSad or p.tok.tokType == tkInd: getTok(p) - -proc optInd(p: var TParser, n: PNode) = - skipComment(p, n) - skipInd(p) - -proc expectIdentOrKeyw(p: TParser) = - if p.tok.tokType != tkSymbol and not isKeyword(p.tok.tokType): - lexMessage(p.lex[], errIdentifierExpected, tokToStr(p.tok)) - -proc ExpectIdent(p: TParser) = - if p.tok.tokType != tkSymbol: - lexMessage(p.lex[], errIdentifierExpected, tokToStr(p.tok)) - -proc expectIdentOrOpr(p: TParser) = - if not (p.tok.tokType in tokOperators): - lexMessage(p.lex[], errOperatorExpected, tokToStr(p.tok)) - -proc Eat(p: var TParser, TokType: TTokType) = - if p.tok.TokType == TokType: getTok(p) - else: lexMessage(p.lex[], errTokenExpected, TokTypeToStr[tokType]) - -proc parLineInfo(p: TParser): TLineInfo = - result = getLineInfo(p.lex[]) - -proc indAndComment(p: var TParser, n: PNode) = - if p.tok.tokType == tkInd: - var info = parLineInfo(p) - getTok(p) - if p.tok.tokType == tkComment: skipComment(p, n) - else: LocalError(info, errInvalidIndentation) - else: - skipComment(p, n) - -proc newNodeP(kind: TNodeKind, p: TParser): PNode = - result = newNodeI(kind, getLineInfo(p.lex[])) - -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal - -proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, p: TParser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal - -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal - -proc newIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident - -proc parseExpr(p: var TParser): PNode -proc parseStmt(p: var TParser): PNode -proc parseTypeDesc(p: var TParser): PNode -proc parseParamList(p: var TParser): PNode - -proc IsLeftAssociative(tok: PToken): bool {.inline.} = - result = tok.tokType != tkOpr or tok.ident.s[0] != '^' - -proc getPrecedence(tok: PToken): int = - case tok.tokType - of tkOpr: - case tok.ident.s[0] - of '$', '^': result = 7 - of '*', '%', '/', '\\': result = 6 - of '+', '-', '~', '|': result = 5 - of '&': result = 4 - of '=', '<', '>', '!': result = 3 - else: result = 0 - of tkDiv, tkMod, tkShl, tkShr: result = 6 - of tkIn, tkNotIn, tkIs, tkIsNot: result = 3 - of tkAnd: result = 2 - of tkOr, tkXor: result = 1 - else: result = - 10 - -proc isOperator(tok: PToken): bool = - result = getPrecedence(tok) >= 0 - -proc parseSymbol(p: var TParser): PNode = - case p.tok.tokType - of tkSymbol: - result = newIdentNodeP(p.tok.ident, p) - getTok(p) - of tkAccent: - result = newNodeP(nkAccQuoted, p) - getTok(p) - case p.tok.tokType - of tkBracketLe: - var s = "[" - getTok(p) - while true: - if p.tok.tokType == tkComma: - add(s, ",") - getTok(p) - elif (p.tok.tokType == tkOpr) and (p.tok.ident.s == "$"): - add(s, "$..") - getTok(p) - eat(p, tkDotDot) - if (p.tok.tokType == tkOpr) and (p.tok.ident.s == "$"): - add(s, '$') - getTok(p) - elif p.tok.tokType == tkDotDot: - add(s, "..") - getTok(p) - if (p.tok.tokType == tkOpr) and (p.tok.ident.s == "$"): - add(s, '$') - getTok(p) - else: break - eat(p, tkBracketRi) - add(s, ']') - if p.tok.tokType == tkEquals: - add(s, '=') - getTok(p) - addSon(result, newIdentNodeP(getIdent(s), p)) - of tkParLe: - addSon(result, newIdentNodeP(getIdent("()"), p)) - getTok(p) - eat(p, tkParRi) - of tokKeywordLow..tokKeywordHigh, tkSymbol, tkOpr: - var id = p.tok.ident - getTok(p) - if p.tok.tokType == tkEquals: - addSon(result, newIdentNodeP(getIdent(id.s & '='), p)) - getTok(p) - else: - addSon(result, newIdentNodeP(id, p)) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - result = ast.emptyNode - eat(p, tkAccent) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - result = ast.emptyNode - -proc accExpr(p: var TParser): PNode = - result = newNodeP(nkAccQuoted, p) - getTok(p) # skip ` - var x = ast.emptyNode - var y = ast.emptyNode - case p.tok.tokType - of tkSymbol, tkOpr, tokKeywordLow..tokKeywordHigh: - x = newIdentNodeP(p.tok.ident, p) - getTok(p) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - if p.tok.tokType == tkDot: - getTok(p) - case p.tok.tokType - of tkSymbol, tkOpr, tokKeywordLow..tokKeywordHigh: - y = newNodeP(nkDotExpr, p) - addSon(y, x) - addSon(y, newIdentNodeP(p.tok.ident, p)) - getTok(p) - x = y - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - addSon(result, x) - eat(p, tkAccent) - -proc optExpr(p: var TParser): PNode = - # [expr] - if (p.tok.tokType != tkComma) and (p.tok.tokType != tkBracketRi) and - (p.tok.tokType != tkDotDot): - result = parseExpr(p) - else: - result = ast.emptyNode - -proc dotdotExpr(p: var TParser, first: PNode): PNode = - result = newNodeP(nkRange, p) - addSon(result, first) - getTok(p) - optInd(p, result) - addSon(result, optExpr(p)) - -proc indexExpr(p: var TParser): PNode = - # indexExpr ::= '..' [expr] | expr ['=' expr | '..' expr] - if p.tok.tokType == tkDotDot: - result = dotdotExpr(p, ast.emptyNode) - else: - var a = parseExpr(p) - case p.tok.tokType - of tkEquals: - result = newNodeP(nkExprEqExpr, p) - addSon(result, a) - getTok(p) - if p.tok.tokType == tkDotDot: - addSon(result, dotdotExpr(p, ast.emptyNode)) - else: - var b = parseExpr(p) - if p.tok.tokType == tkDotDot: b = dotdotExpr(p, b) - addSon(result, b) - of tkDotDot: - result = dotdotExpr(p, a) - else: result = a - -proc indexExprList(p: var TParser, first: PNode): PNode = - result = newNodeP(nkBracketExpr, p) - addSon(result, first) - getTok(p) - optInd(p, result) - while (p.tok.tokType != tkBracketRi) and (p.tok.tokType != tkEof) and - (p.tok.tokType != tkSad): - var a = indexExpr(p) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkBracketRi) - -proc exprColonEqExpr(p: var TParser, kind: TNodeKind, tok: TTokType): PNode = - var a = parseExpr(p) - if p.tok.tokType == tok: - result = newNodeP(kind, p) - getTok(p) - #optInd(p, result) - addSon(result, a) - addSon(result, parseExpr(p)) - else: - result = a - -proc exprListAux(p: var TParser, elemKind: TNodeKind, endTok, sepTok: TTokType, - result: PNode) = - getTok(p) - optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): - var a = exprColonEqExpr(p, elemKind, sepTok) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - eat(p, endTok) - -proc qualifiedIdent(p: var TParser): PNode = - result = parseSymbol(p) #optInd(p, result); - if p.tok.tokType == tkDot: - getTok(p) - optInd(p, result) - var a = result - result = newNodeI(nkDotExpr, a.info) - addSon(result, a) - addSon(result, parseSymbol(p)) - -proc qualifiedIdentListAux(p: var TParser, endTok: TTokType, result: PNode) = - getTok(p) - optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): - var a = qualifiedIdent(p) - addSon(result, a) #optInd(p, a); - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - eat(p, endTok) - -proc exprColonEqExprListAux(p: var TParser, elemKind: TNodeKind, - endTok, sepTok: TTokType, result: PNode) = - assert(endTok in {tkCurlyRi, tkCurlyDotRi, tkBracketRi, tkParRi}) - getTok(p) - optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof) and - (p.tok.tokType != tkSad) and (p.tok.tokType != tkInd): - var a = exprColonEqExpr(p, elemKind, sepTok) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, endTok) - -proc exprColonEqExprList(p: var TParser, kind, elemKind: TNodeKind, - endTok, sepTok: TTokType): PNode = - result = newNodeP(kind, p) - exprColonEqExprListAux(p, elemKind, endTok, sepTok, result) - -proc parseCast(p: var TParser): PNode = - result = newNodeP(nkCast, p) - getTok(p) - eat(p, tkBracketLe) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - optPar(p) - eat(p, tkBracketRi) - eat(p, tkParLe) - optInd(p, result) - addSon(result, parseExpr(p)) - optPar(p) - eat(p, tkParRi) - -proc parseAddr(p: var TParser): PNode = - result = newNodeP(nkAddr, p) - getTok(p) - eat(p, tkParLe) - optInd(p, result) - addSon(result, parseExpr(p)) - optPar(p) - eat(p, tkParRi) - -proc setBaseFlags(n: PNode, base: TNumericalBase) = - case base - of base10: nil - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) - -proc parseGStrLit(p: var TParser, a: PNode): PNode = - case p.tok.tokType - of tkGStrLit: - result = newNodeP(nkCallStrLit, p) - addSon(result, a) - addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) - getTok(p) - of tkGTripleStrLit: - result = newNodeP(nkCallStrLit, p) - addSon(result, a) - addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)) - getTok(p) - else: - result = a - -proc identOrLiteral(p: var TParser): PNode = - case p.tok.tokType - of tkSymbol: - result = newIdentNodeP(p.tok.ident, p) - getTok(p) - result = parseGStrLit(p, result) - of tkAccent: - result = accExpr(p) # literals - of tkIntLit: - result = newIntNodeP(nkIntLit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt8Lit: - result = newIntNodeP(nkInt8Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt16Lit: - result = newIntNodeP(nkInt16Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt32Lit: - result = newIntNodeP(nkInt32Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkInt64Lit: - result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkFloatLit: - result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkFloat32Lit: - result = newFloatNodeP(nkFloat32Lit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkFloat64Lit: - result = newFloatNodeP(nkFloat64Lit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of tkStrLit: - result = newStrNodeP(nkStrLit, p.tok.literal, p) - getTok(p) - of tkRStrLit: - result = newStrNodeP(nkRStrLit, p.tok.literal, p) - getTok(p) - of tkTripleStrLit: - result = newStrNodeP(nkTripleStrLit, p.tok.literal, p) - getTok(p) - of tkCharLit: - result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) - getTok(p) - of tkNil: - result = newNodeP(nkNilLit, p) - getTok(p) - of tkParLe: - # () constructor - result = exprColonEqExprList(p, nkPar, nkExprColonExpr, tkParRi, tkColon) - of tkCurlyLe: - # {} constructor - result = exprColonEqExprList(p, nkCurly, nkRange, tkCurlyRi, tkDotDot) - of tkBracketLe: - # [] constructor - result = exprColonEqExprList(p, nkBracket, nkExprColonExpr, tkBracketRi, - tkColon) - of tkCast: - result = parseCast(p) - of tkAddr: - result = parseAddr(p) - else: - parMessage(p, errExprExpected, tokToStr(p.tok)) - getTok(p) # we must consume a token here to prevend endless loops! - result = ast.emptyNode - -proc primary(p: var TParser): PNode = - # prefix operator? - if (p.tok.tokType == tkNot) or (p.tok.tokType == tkOpr): - result = newNodeP(nkPrefix, p) - var a = newIdentNodeP(p.tok.ident, p) - addSon(result, a) - getTok(p) - optInd(p, a) - addSon(result, primary(p)) - return - elif p.tok.tokType == tkBind: - result = newNodeP(nkBind, p) - getTok(p) - optInd(p, result) - addSon(result, primary(p)) - return - result = identOrLiteral(p) - while true: - case p.tok.tokType - of tkParLe: - var a = result - result = newNodeP(nkCall, p) - addSon(result, a) - exprColonEqExprListAux(p, nkExprEqExpr, tkParRi, tkEquals, result) - of tkDot: - var a = result - result = newNodeP(nkDotExpr, p) - addSon(result, a) - getTok(p) # skip '.' - optInd(p, result) - addSon(result, parseSymbol(p)) - result = parseGStrLit(p, result) - of tkHat: - var a = result - result = newNodeP(nkDerefExpr, p) - addSon(result, a) - getTok(p) - of tkBracketLe: - result = indexExprList(p, result) - else: break - -proc lowestExprAux(p: var TParser, v: var PNode, limit: int): PToken = - v = primary(p) # expand while operators have priorities higher than 'limit' - var op = p.tok - var opPrec = getPrecedence(op) - while opPrec >= limit: - var leftAssoc = ord(IsLeftAssociative(op)) - var node = newNodeP(nkInfix, p) - var opNode = newIdentNodeP(op.ident, p) # skip operator: - getTok(p) - optInd(p, opNode) # read sub-expression with higher priority - var v2: PNode - var nextop = lowestExprAux(p, v2, opPrec + leftAssoc) - addSon(node, opNode) - addSon(node, v) - addSon(node, v2) - v = node - op = nextop - opPrec = getPrecedence(nextop) - result = op # return first untreated operator - -proc lowestExpr(p: var TParser): PNode = - discard lowestExprAux(p, result, - 1) - -proc parseIfExpr(p: var TParser): PNode = - result = newNodeP(nkIfExpr, p) - while true: - getTok(p) # skip `if`, `elif` - var branch = newNodeP(nkElifExpr, p) - addSon(branch, parseExpr(p)) - eat(p, tkColon) - addSon(branch, parseExpr(p)) - addSon(result, branch) - if p.tok.tokType != tkElif: break - var branch = newNodeP(nkElseExpr, p) - eat(p, tkElse) - eat(p, tkColon) - addSon(branch, parseExpr(p)) - addSon(result, branch) - -proc parsePragma(p: var TParser): PNode = - result = newNodeP(nkPragma, p) - getTok(p) - optInd(p, result) - while (p.tok.tokType != tkCurlyDotRi) and (p.tok.tokType != tkCurlyRi) and - (p.tok.tokType != tkEof) and (p.tok.tokType != tkSad): - var a = exprColonEqExpr(p, nkExprColonExpr, tkColon) - addSon(result, a) - if p.tok.tokType == tkComma: - getTok(p) - optInd(p, a) - optPar(p) - if (p.tok.tokType == tkCurlyDotRi) or (p.tok.tokType == tkCurlyRi): getTok(p) - else: parMessage(p, errTokenExpected, ".}") - -proc identVis(p: var TParser): PNode = - # identifier with visability - var a = parseSymbol(p) - if p.tok.tokType == tkOpr: - result = newNodeP(nkPostfix, p) - addSon(result, newIdentNodeP(p.tok.ident, p)) - addSon(result, a) - getTok(p) - else: - result = a - -proc identWithPragma(p: var TParser): PNode = - var a = identVis(p) - if p.tok.tokType == tkCurlyDotLe: - result = newNodeP(nkPragmaExpr, p) - addSon(result, a) - addSon(result, parsePragma(p)) - else: - result = a - -type - TDeclaredIdentFlag = enum - withPragma, # identifier may have pragma - withBothOptional # both ':' and '=' parts are optional - TDeclaredIdentFlags = set[TDeclaredIdentFlag] - -proc parseIdentColonEquals(p: var TParser, flags: TDeclaredIdentFlags): PNode = - var a: PNode - result = newNodeP(nkIdentDefs, p) - while true: - case p.tok.tokType - of tkSymbol, tkAccent: - if withPragma in flags: a = identWithPragma(p) - else: a = parseSymbol(p) - if a.kind == nkEmpty: return - else: break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, ast.emptyNode) - if (p.tok.tokType != tkEquals) and not (withBothOptional in flags): - parMessage(p, errColonOrEqualsExpected, tokToStr(p.tok)) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - -proc parseTuple(p: var TParser): PNode = - result = newNodeP(nkTupleTy, p) - getTok(p) - eat(p, tkBracketLe) - optInd(p, result) - while (p.tok.tokType == tkSymbol) or (p.tok.tokType == tkAccent): - var a = parseIdentColonEquals(p, {}) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkBracketRi) - -proc parseParamList(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkFormalParams, p) - addSon(result, ast.emptyNode) # return type - if p.tok.tokType == tkParLe: - getTok(p) - optInd(p, result) - while true: - case p.tok.tokType #optInd(p, a); - of tkSymbol, tkAccent: - a = parseIdentColonEquals(p, {}) - of tkParRi: - break - else: - parMessage(p, errTokenExpected, ")") - break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkParRi) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - result.sons[0] = parseTypeDesc(p) - -proc parseProcExpr(p: var TParser, isExpr: bool): PNode = - # either a proc type or a anonymous proc - var - pragmas, params: PNode - info: TLineInfo - info = parLineInfo(p) - getTok(p) - params = parseParamList(p) - if p.tok.tokType == tkCurlyDotLe: pragmas = parsePragma(p) - else: pragmas = ast.emptyNode - if (p.tok.tokType == tkEquals) and isExpr: - result = newNodeI(nkLambda, info) - addSon(result, ast.emptyNode) # no name part - addSon(result, ast.emptyNode) # no generic parameters - addSon(result, params) - addSon(result, pragmas) - getTok(p) - skipComment(p, result) - addSon(result, parseStmt(p)) - else: - result = newNodeI(nkProcTy, info) - addSon(result, params) - addSon(result, pragmas) - -proc parseTypeDescKAux(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - -proc parseExpr(p: var TParser): PNode = - # - #expr ::= lowestExpr - # | 'if' expr ':' expr ('elif' expr ':' expr)* 'else' ':' expr - # | 'var' expr - # | 'ref' expr - # | 'ptr' expr - # | 'type' expr - # | 'tuple' tupleDesc - # | 'proc' paramList [pragma] ['=' stmt] - # - case p.tok.toktype - of tkVar: result = parseTypeDescKAux(p, nkVarTy) - of tkRef: result = parseTypeDescKAux(p, nkRefTy) - of tkPtr: result = parseTypeDescKAux(p, nkPtrTy) - of tkType: result = parseTypeDescKAux(p, nkTypeOfExpr) - of tkTuple: result = parseTuple(p) - of tkProc: result = parseProcExpr(p, true) - of tkIf: result = parseIfExpr(p) - else: result = lowestExpr(p) - -proc parseTypeDesc(p: var TParser): PNode = - if p.tok.toktype == tkProc: result = parseProcExpr(p, false) - else: result = parseExpr(p) - -proc isExprStart(p: TParser): bool = - case p.tok.tokType - of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkProc, tkBind, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, - tkTuple, tkType: - result = true - else: result = false - -proc parseExprStmt(p: var TParser): PNode = - var a = lowestExpr(p) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, result) - var b = parseExpr(p) - result = newNodeI(nkAsgn, a.info) - addSon(result, a) - addSon(result, b) - else: - result = newNodeP(nkCommand, p) - result.info = a.info - addSon(result, a) - while true: - if not isExprStart(p): break - var e = parseExpr(p) - addSon(result, e) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - if sonsLen(result) <= 1: result = a - else: a = result - if p.tok.tokType == tkColon: - # macro statement - result = newNodeP(nkMacroStmt, p) - result.info = a.info - addSon(result, a) - getTok(p) - skipComment(p, result) - if p.tok.tokType == tkSad: getTok(p) - if not (p.tok.TokType in {tkOf, tkElif, tkElse, tkExcept}): - addSon(result, parseStmt(p)) - while true: - if p.tok.tokType == tkSad: getTok(p) - var b: PNode - case p.tok.tokType - of tkOf: - b = newNodeP(nkOfBranch, p) - exprListAux(p, nkRange, tkColon, tkDotDot, b) - of tkElif: - b = newNodeP(nkElifBranch, p) - getTok(p) - optInd(p, b) - addSon(b, parseExpr(p)) - eat(p, tkColon) - of tkExcept: - b = newNodeP(nkExceptBranch, p) - qualifiedIdentListAux(p, tkColon, b) - skipComment(p, b) - of tkElse: - b = newNodeP(nkElse, p) - getTok(p) - eat(p, tkColon) - else: break - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkElse: break - -proc parseImportOrIncludeStmt(p: var TParser, kind: TNodeKind): PNode = - var a: PNode - result = newNodeP(kind, p) - getTok(p) # skip `import` or `include` - optInd(p, result) - while true: - case p.tok.tokType - of tkEof, tkSad, tkDed: - break - of tkSymbol, tkAccent: - a = parseSymbol(p) - of tkRStrLit: - a = newStrNodeP(nkRStrLit, p.tok.literal, p) - getTok(p) - of tkStrLit: - a = newStrNodeP(nkStrLit, p.tok.literal, p) - getTok(p) - of tkTripleStrLit: - a = newStrNodeP(nkTripleStrLit, p.tok.literal, p) - getTok(p) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - -proc parseFromStmt(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkFromStmt, p) - getTok(p) # skip `from` - optInd(p, result) - case p.tok.tokType - of tkSymbol, tkAccent: - a = parseSymbol(p) - of tkRStrLit: - a = newStrNodeP(nkRStrLit, p.tok.literal, p) - getTok(p) - of tkStrLit: - a = newStrNodeP(nkStrLit, p.tok.literal, p) - getTok(p) - of tkTripleStrLit: - a = newStrNodeP(nkTripleStrLit, p.tok.literal, p) - getTok(p) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - return - addSon(result, a) #optInd(p, a); - eat(p, tkImport) - optInd(p, result) - while true: - case p.tok.tokType #optInd(p, a); - of tkEof, tkSad, tkDed: - break - of tkSymbol, tkAccent: - a = parseSymbol(p) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - -proc parseReturnOrRaise(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - case p.tok.tokType - of tkEof, tkSad, tkDed: addSon(result, ast.emptyNode) - else: addSon(result, parseExpr(p)) - -proc parseYieldOrDiscard(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - addSon(result, parseExpr(p)) - -proc parseBreakOrContinue(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - case p.tok.tokType - of tkEof, tkSad, tkDed: addSon(result, ast.emptyNode) - else: addSon(result, parseSymbol(p)) - -proc parseIfOrWhen(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - while true: - getTok(p) # skip `if`, `when`, `elif` - var branch = newNodeP(nkElifBranch, p) - optInd(p, branch) - addSon(branch, parseExpr(p)) - eat(p, tkColon) - skipComment(p, branch) - addSon(branch, parseStmt(p)) - skipComment(p, branch) - addSon(result, branch) - if p.tok.tokType != tkElif: break - if p.tok.tokType == tkElse: - var branch = newNodeP(nkElse, p) - eat(p, tkElse) - eat(p, tkColon) - skipComment(p, branch) - addSon(branch, parseStmt(p)) - addSon(result, branch) - -proc parseWhile(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p) - optInd(p, result) - addSon(result, parseExpr(p)) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) - -proc parseCase(p: var TParser): PNode = - var - b: PNode - inElif: bool - result = newNodeP(nkCaseStmt, p) - getTok(p) - addSon(result, parseExpr(p)) - if p.tok.tokType == tkColon: getTok(p) - skipComment(p, result) - inElif = false - while true: - if p.tok.tokType == tkSad: getTok(p) - case p.tok.tokType - of tkOf: - if inElif: break - b = newNodeP(nkOfBranch, p) - exprListAux(p, nkRange, tkColon, tkDotDot, b) - of tkElif: - inElif = true - b = newNodeP(nkElifBranch, p) - getTok(p) - optInd(p, b) - addSon(b, parseExpr(p)) - eat(p, tkColon) - of tkElse: - b = newNodeP(nkElse, p) - getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkElse: break - -proc parseTry(p: var TParser): PNode = - result = newNodeP(nkTryStmt, p) - getTok(p) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) - var b: PNode = nil - while true: - if p.tok.tokType == tkSad: getTok(p) - case p.tok.tokType - of tkExcept: - b = newNodeP(nkExceptBranch, p) - qualifiedIdentListAux(p, tkColon, b) - of tkFinally: - b = newNodeP(nkFinally, p) - getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkFinally: break - if b == nil: parMessage(p, errTokenExpected, "except") - -proc parseFor(p: var TParser): PNode = - result = newNodeP(nkForStmt, p) - getTok(p) - optInd(p, result) - var a = parseSymbol(p) - addSon(result, a) - while p.tok.tokType == tkComma: - getTok(p) - optInd(p, a) - a = parseSymbol(p) - addSon(result, a) - eat(p, tkIn) - addSon(result, exprColonEqExpr(p, nkRange, tkDotDot)) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) - -proc parseBlock(p: var TParser): PNode = - result = newNodeP(nkBlockStmt, p) - getTok(p) - optInd(p, result) - case p.tok.tokType - of tkEof, tkSad, tkDed, tkColon: addSon(result, ast.emptyNode) - else: addSon(result, parseSymbol(p)) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) - -proc parseAsm(p: var TParser): PNode = - result = newNodeP(nkAsmStmt, p) - getTok(p) - optInd(p, result) - if p.tok.tokType == tkCurlyDotLe: addSon(result, parsePragma(p)) - else: addSon(result, ast.emptyNode) - case p.tok.tokType - of tkStrLit: addSon(result, newStrNodeP(nkStrLit, p.tok.literal, p)) - of tkRStrLit: addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) - of tkTripleStrLit: addSon(result, - newStrNodeP(nkTripleStrLit, p.tok.literal, p)) - else: - parMessage(p, errStringLiteralExpected) - addSon(result, ast.emptyNode) - return - getTok(p) - -proc parseGenericConstraint(p: var TParser): PNode = - case p.tok.tokType - of tkObject: - result = newNodeP(nkObjectTy, p) - getTok(p) - of tkTuple: - result = newNodeP(nkTupleTy, p) - getTok(p) - of tkEnum: - result = newNodeP(nkEnumTy, p) - getTok(p) - of tkProc: - result = newNodeP(nkProcTy, p) - getTok(p) - of tkVar: - result = newNodeP(nkVarTy, p) - getTok(p) - of tkPtr: - result = newNodeP(nkPtrTy, p) - getTok(p) - of tkRef: - result = newNodeP(nkRefTy, p) - getTok(p) - of tkDistinct: - result = newNodeP(nkDistinctTy, p) - getTok(p) - else: result = primary(p) - -proc parseGenericConstraintList(p: var TParser): PNode = - result = parseGenericConstraint(p) - while p.tok.tokType == tkOpr: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP(p.tok.ident, p)) - addSon(result, a) - getTok(p) - optInd(p, result) - addSon(result, parseGenericConstraint(p)) - -proc parseGenericParam(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkIdentDefs, p) - while true: - case p.tok.tokType - of tkSymbol, tkAccent: - a = parseSymbol(p) - if a.kind == nkEmpty: return - else: break - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - addSon(result, parseGenericConstraintList(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - -proc parseGenericParamList(p: var TParser): PNode = - result = newNodeP(nkGenericParams, p) - getTok(p) - optInd(p, result) - while (p.tok.tokType == tkSymbol) or (p.tok.tokType == tkAccent): - var a = parseGenericParam(p) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - optPar(p) - eat(p, tkBracketRi) - -proc parseRoutine(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p) - optInd(p, result) - addSon(result, identVis(p)) - if p.tok.tokType == tkBracketLe: addSon(result, parseGenericParamList(p)) - else: addSon(result, ast.emptyNode) - addSon(result, parseParamList(p)) - if p.tok.tokType == tkCurlyDotLe: addSon(result, parsePragma(p)) - else: addSon(result, ast.emptyNode) - if p.tok.tokType == tkEquals: - getTok(p) - skipComment(p, result) - addSon(result, parseStmt(p)) - else: - addSon(result, ast.emptyNode) - indAndComment(p, result) # XXX: document this in the grammar! - -proc newCommentStmt(p: var TParser): PNode = - result = newNodeP(nkCommentStmt, p) - result.info.line = result.info.line - int16(1) - -type - TDefParser = proc (p: var TParser): PNode - -proc parseSection(p: var TParser, kind: TNodeKind, - defparser: TDefParser): PNode = - result = newNodeP(kind, p) - getTok(p) - skipComment(p, result) - case p.tok.tokType - of tkInd: - pushInd(p.lex[], p.tok.indent) - getTok(p) - skipComment(p, result) - while true: - case p.tok.tokType - of tkSad: - getTok(p) - of tkSymbol, tkAccent: - var a = defparser(p) - skipComment(p, a) - addSon(result, a) - of tkDed: - getTok(p) - break - of tkEof: - break # BUGFIX - of tkComment: - var a = newCommentStmt(p) - skipComment(p, a) - addSon(result, a) - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - popInd(p.lex[]) - of tkSymbol, tkAccent, tkParLe: - # tkParLe is allowed for ``var (x, y) = ...`` tuple parsing - addSon(result, defparser(p)) - else: parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - -proc parseConstant(p: var TParser): PNode = - result = newNodeP(nkConstDef, p) - addSon(result, identWithPragma(p)) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, ast.emptyNode) - eat(p, tkEquals) - optInd(p, result) - addSon(result, parseExpr(p)) - indAndComment(p, result) # XXX: special extension! - -proc parseEnum(p: var TParser): PNode = - var a, b: PNode - result = newNodeP(nkEnumTy, p) - a = nil - getTok(p) - if false and p.tok.tokType == tkOf: - a = newNodeP(nkOfInherit, p) - getTok(p) - optInd(p, a) - addSon(a, parseTypeDesc(p)) - addSon(result, a) - else: - addSon(result, ast.emptyNode) - optInd(p, result) - while true: - case p.tok.tokType - of tkEof, tkSad, tkDed: break - else: a = parseSymbol(p) - optInd(p, a) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, a) - b = a - a = newNodeP(nkEnumFieldDef, p) - addSon(a, b) - addSon(a, parseExpr(p)) - skipComment(p, a) - if p.tok.tokType == tkComma: - getTok(p) - optInd(p, a) - addSon(result, a) - -proc parseObjectPart(p: var TParser): PNode -proc parseObjectWhen(p: var TParser): PNode = - result = newNodeP(nkRecWhen, p) - while true: - getTok(p) # skip `when`, `elif` - var branch = newNodeP(nkElifBranch, p) - optInd(p, branch) - addSon(branch, parseExpr(p)) - eat(p, tkColon) - skipComment(p, branch) - addSon(branch, parseObjectPart(p)) - skipComment(p, branch) - addSon(result, branch) - if p.tok.tokType != tkElif: break - if p.tok.tokType == tkElse: - var branch = newNodeP(nkElse, p) - eat(p, tkElse) - eat(p, tkColon) - skipComment(p, branch) - addSon(branch, parseObjectPart(p)) - addSon(result, branch) - -proc parseObjectCase(p: var TParser): PNode = - result = newNodeP(nkRecCase, p) - getTok(p) - var a = newNodeP(nkIdentDefs, p) - addSon(a, identWithPragma(p)) - eat(p, tkColon) - addSon(a, parseTypeDesc(p)) - addSon(a, ast.emptyNode) - addSon(result, a) - skipComment(p, result) - while true: - if p.tok.tokType == tkSad: getTok(p) - var b: PNode - case p.tok.tokType - of tkOf: - b = newNodeP(nkOfBranch, p) - exprListAux(p, nkRange, tkColon, tkDotDot, b) - of tkElse: - b = newNodeP(nkElse, p) - getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) - addSon(b, parseObjectPart(p)) - addSon(result, b) - if b.kind == nkElse: break - -proc parseObjectPart(p: var TParser): PNode = - case p.tok.tokType - of tkInd: - result = newNodeP(nkRecList, p) - pushInd(p.lex[], p.tok.indent) - getTok(p) - skipComment(p, result) - while true: - case p.tok.tokType - of tkSad: - getTok(p) - of tkCase, tkWhen, tkSymbol, tkAccent, tkNil: - addSon(result, parseObjectPart(p)) - of tkDed: - getTok(p) - break - of tkEof: - break - else: - parMessage(p, errIdentifierExpected, tokToStr(p.tok)) - break - popInd(p.lex[]) - of tkWhen: - result = parseObjectWhen(p) - of tkCase: - result = parseObjectCase(p) - of tkSymbol, tkAccent: - result = parseIdentColonEquals(p, {withPragma}) - skipComment(p, result) - of tkNil: - result = newNodeP(nkNilLit, p) - getTok(p) - else: result = ast.emptyNode - -proc parseObject(p: var TParser): PNode = - result = newNodeP(nkObjectTy, p) - getTok(p) - if p.tok.tokType == tkCurlyDotLe: addSon(result, parsePragma(p)) - else: addSon(result, ast.emptyNode) - if p.tok.tokType == tkOf: - var a = newNodeP(nkOfInherit, p) - getTok(p) - addSon(a, parseTypeDesc(p)) - addSon(result, a) - else: - addSon(result, ast.emptyNode) - skipComment(p, result) - addSon(result, parseObjectPart(p)) - -proc parseDistinct(p: var TParser): PNode = - result = newNodeP(nkDistinctTy, p) - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - -proc parseTypeDef(p: var TParser): PNode = - result = newNodeP(nkTypeDef, p) - addSon(result, identWithPragma(p)) - if p.tok.tokType == tkBracketLe: addSon(result, parseGenericParamList(p)) - else: addSon(result, ast.emptyNode) - if p.tok.tokType == tkEquals: - getTok(p) - optInd(p, result) - var a: PNode - case p.tok.tokType - of tkObject: a = parseObject(p) - of tkEnum: a = parseEnum(p) - of tkDistinct: a = parseDistinct(p) - else: a = parseTypeDesc(p) - addSon(result, a) - else: - addSon(result, ast.emptyNode) - indAndComment(p, result) # special extension! - -proc parseVarTuple(p: var TParser): PNode = - result = newNodeP(nkVarTuple, p) - getTok(p) # skip '(' - optInd(p, result) - while (p.tok.tokType == tkSymbol) or (p.tok.tokType == tkAccent): - var a = identWithPragma(p) - addSon(result, a) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, a) - addSon(result, ast.emptyNode) # no type desc - optPar(p) - eat(p, tkParRi) - eat(p, tkEquals) - optInd(p, result) - addSon(result, parseExpr(p)) - -proc parseVariable(p: var TParser): PNode = - if p.tok.tokType == tkParLe: result = parseVarTuple(p) - else: result = parseIdentColonEquals(p, {withPragma}) - indAndComment(p, result) # special extension! - -proc simpleStmt(p: var TParser): PNode = - case p.tok.tokType - of tkReturn: result = parseReturnOrRaise(p, nkReturnStmt) - of tkRaise: result = parseReturnOrRaise(p, nkRaiseStmt) - of tkYield: result = parseYieldOrDiscard(p, nkYieldStmt) - of tkDiscard: result = parseYieldOrDiscard(p, nkDiscardStmt) - of tkBreak: result = parseBreakOrContinue(p, nkBreakStmt) - of tkContinue: result = parseBreakOrContinue(p, nkContinueStmt) - of tkCurlyDotLe: result = parsePragma(p) - of tkImport: result = parseImportOrIncludeStmt(p, nkImportStmt) - of tkFrom: result = parseFromStmt(p) - of tkInclude: result = parseImportOrIncludeStmt(p, nkIncludeStmt) - of tkComment: result = newCommentStmt(p) - else: - if isExprStart(p): result = parseExprStmt(p) - else: result = ast.emptyNode - if result.kind != nkEmpty: skipComment(p, result) - -proc complexOrSimpleStmt(p: var TParser): PNode = - case p.tok.tokType - of tkIf: result = parseIfOrWhen(p, nkIfStmt) - of tkWhile: result = parseWhile(p) - of tkCase: result = parseCase(p) - of tkTry: result = parseTry(p) - of tkFor: result = parseFor(p) - of tkBlock: result = parseBlock(p) - of tkAsm: result = parseAsm(p) - of tkProc: result = parseRoutine(p, nkProcDef) - of tkMethod: result = parseRoutine(p, nkMethodDef) - of tkIterator: result = parseRoutine(p, nkIteratorDef) - of tkMacro: result = parseRoutine(p, nkMacroDef) - of tkTemplate: result = parseRoutine(p, nkTemplateDef) - of tkConverter: result = parseRoutine(p, nkConverterDef) - of tkType: result = parseSection(p, nkTypeSection, parseTypeDef) - of tkConst: result = parseSection(p, nkConstSection, parseConstant) - of tkWhen: result = parseIfOrWhen(p, nkWhenStmt) - of tkVar: result = parseSection(p, nkVarSection, parseVariable) - else: result = simpleStmt(p) - -proc parseStmt(p: var TParser): PNode = - if p.tok.tokType == tkInd: - result = newNodeP(nkStmtList, p) - pushInd(p.lex[], p.tok.indent) - getTok(p) - while true: - case p.tok.tokType - of tkSad: getTok(p) - of tkEof: break - of tkDed: - getTok(p) - break - else: - var a = complexOrSimpleStmt(p) - if a.kind == nkEmpty: break - addSon(result, a) - popInd(p.lex[] ) - else: - # the case statement is only needed for better error messages: - case p.tok.tokType - of tkIf, tkWhile, tkCase, tkTry, tkFor, tkBlock, tkAsm, tkProc, tkIterator, - tkMacro, tkType, tkConst, tkWhen, tkVar: - parMessage(p, errComplexStmtRequiresInd) - result = ast.emptyNode - else: - result = simpleStmt(p) - if result.kind == nkEmpty: parMessage(p, errExprExpected, tokToStr(p.tok)) - if p.tok.tokType == tkSad: getTok(p) - -proc parseAll(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while true: - case p.tok.tokType - of tkSad: getTok(p) - of tkDed, tkInd: parMessage(p, errInvalidIndentation) - of tkEof: break - else: - var a = complexOrSimpleStmt(p) - if a.kind == nkEmpty: parMessage(p, errExprExpected, tokToStr(p.tok)) - addSon(result, a) - -proc parseTopLevelStmt(p: var TParser): PNode = - result = ast.emptyNode - while true: - case p.tok.tokType - of tkSad: getTok(p) - of tkDed, tkInd: - parMessage(p, errInvalidIndentation) - getTok(p) - of tkEof: break - else: - result = complexOrSimpleStmt(p) - if result.kind == nkEmpty: parMessage(p, errExprExpected, tokToStr(p.tok)) - break diff --git a/rod/pragmas.nim b/rod/pragmas.nim deleted file mode 100755 index d7bda4099..000000000 --- a/rod/pragmas.nim +++ /dev/null @@ -1,543 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements semantic checking for pragmas - -import - os, platform, condsyms, ast, astalgo, idents, semdata, msgs, rnimsyn, - wordrecg, ropes, options, strutils, lists, extccomp, math, magicsys, trees, - rodread - -const - FirstCallConv* = wNimcall - LastCallConv* = wNoconv - -const - procPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wMagic, wNosideEffect, wSideEffect, wNoreturn, wDynLib, wHeader, - wCompilerProc, wPure, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, - wBorrow, wExtern} - converterPragmas* = procPragmas - methodPragmas* = procPragmas - macroPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wMagic, wNosideEffect, wCompilerProc, wDeprecated, wTypeCheck, wExtern} - iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideEffect, wSideEffect, - wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow, wExtern} - stmtPragmas* = {wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, - wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, wLinedir, - wStacktrace, wLinetrace, wOptimization, wHint, wWarning, wError, wFatal, - wDefine, wUndef, wCompile, wLink, wLinkSys, wPure, wPush, wPop, wBreakpoint, - wCheckpoint, wPassL, wPassC, wDeadCodeElim, wDeprecated, wFloatChecks, - wInfChecks, wNanChecks, wPragma, wEmit, wUnroll, wLinearScanEnd} - lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wNosideEffect, wSideEffect, wNoreturn, wDynLib, wHeader, wPure, - wDeprecated, wExtern} - typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, - wPure, wHeader, wCompilerProc, wFinal, wSize, wExtern, wShallow} - fieldPragmas* = {wImportc, wExportc, wDeprecated, wExtern} - varPragmas* = {wImportc, wExportc, wVolatile, wRegister, wThreadVar, wNodecl, - wMagic, wHeader, wDeprecated, wCompilerProc, wDynLib, wExtern} - constPragmas* = {wImportc, wExportc, wHeader, wDeprecated, wMagic, wNodecl, - wExtern} - procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNosideEffect} - -proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) -proc pragmaAsm*(c: PContext, n: PNode): char -# implementation - -proc invalidPragma(n: PNode) = - LocalError(n.info, errInvalidPragmaX, renderTree(n, {renderNoComments})) - -proc pragmaAsm(c: PContext, n: PNode): char = - result = '\0' - if n != nil: - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if (it.kind == nkExprColonExpr) and (it.sons[0].kind == nkIdent): - case whichKeyword(it.sons[0].ident) - of wSubsChar: - if it.sons[1].kind == nkCharLit: result = chr(int(it.sons[1].intVal)) - else: invalidPragma(it) - else: invalidPragma(it) - else: - invalidPragma(it) - -proc setExternName(s: PSym, extname: string) = - s.loc.r = toRope(extname % s.name.s) - -proc MakeExternImport(s: PSym, extname: string) = - setExternName(s, extname) - incl(s.flags, sfImportc) - excl(s.flags, sfForward) - -proc MakeExternExport(s: PSym, extname: string) = - setExternName(s, extname) - incl(s.flags, sfExportc) - -proc getStrLitNode(c: PContext, n: PNode): PNode = - if n.kind != nkExprColonExpr: - GlobalError(n.info, errStringLiteralExpected) - else: - n.sons[1] = c.semConstExpr(c, n.sons[1]) - case n.sons[1].kind - of nkStrLit, nkRStrLit, nkTripleStrLit: result = n.sons[1] - else: GlobalError(n.info, errStringLiteralExpected) - -proc expectStrLit(c: PContext, n: PNode): string = - result = getStrLitNode(c, n).strVal - -proc expectIntLit(c: PContext, n: PNode): int = - if n.kind != nkExprColonExpr: - LocalError(n.info, errIntLiteralExpected) - else: - n.sons[1] = c.semConstExpr(c, n.sons[1]) - case n.sons[1].kind - of nkIntLit..nkInt64Lit: result = int(n.sons[1].intVal) - else: LocalError(n.info, errIntLiteralExpected) - -proc getOptionalStr(c: PContext, n: PNode, defaultStr: string): string = - if n.kind == nkExprColonExpr: result = expectStrLit(c, n) - else: result = defaultStr - -proc processMagic(c: PContext, n: PNode, s: PSym) = - var v: string - #if not (sfSystemModule in c.module.flags) then - # liMessage(n.info, errMagicOnlyInSystem); - if n.kind != nkExprColonExpr: - LocalError(n.info, errStringLiteralExpected) - return - if n.sons[1].kind == nkIdent: v = n.sons[1].ident.s - else: v = expectStrLit(c, n) - incl(s.flags, sfImportc) - # magics don't need an implementation, so we - # treat them as imported, instead of modifing a lot of working code - # BUGFIX: magic does not imply ``lfNoDecl`` anymore! - for m in countup(low(TMagic), high(TMagic)): - if copy($m, 1) == v: - s.magic = m - return - Message(n.info, warnUnknownMagic, v) - -proc wordToCallConv(sw: TSpecialWord): TCallingConvention = - # this assumes that the order of special words and calling conventions is - # the same - result = TCallingConvention(ord(ccDefault) + ord(sw) - ord(wNimcall)) - -proc IsTurnedOn(c: PContext, n: PNode): bool = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): - case whichKeyword(n.sons[1].ident) - of wOn: result = true - of wOff: result = false - else: LocalError(n.info, errOnOrOffExpected) - else: - LocalError(n.info, errOnOrOffExpected) - -proc onOff(c: PContext, n: PNode, op: TOptions) = - if IsTurnedOn(c, n): gOptions = gOptions + op - else: gOptions = gOptions - op - -proc pragmaDeadCodeElim(c: PContext, n: PNode) = - if IsTurnedOn(c, n): incl(c.module.flags, sfDeadCodeElim) - else: excl(c.module.flags, sfDeadCodeElim) - -proc processCallConv(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): - var sw = whichKeyword(n.sons[1].ident) - case sw - of firstCallConv..lastCallConv: - POptionEntry(c.optionStack.tail).defaultCC = wordToCallConv(sw) - else: LocalError(n.info, errCallConvExpected) - else: - LocalError(n.info, errCallConvExpected) - -proc getLib(c: PContext, kind: TLibKind, path: PNode): PLib = - var it = PLib(c.libs.head) - while it != nil: - if it.kind == kind: - if trees.ExprStructuralEquivalent(it.path, path): return it - it = PLib(it.next) - result = newLib(kind) - result.path = path - Append(c.libs, result) - -proc expectDynlibNode(c: PContext, n: PNode): PNode = - if n.kind != nkExprColonExpr: GlobalError(n.info, errStringLiteralExpected) - else: - result = c.semExpr(c, n.sons[1]) - if result.kind == nkSym and result.sym.kind == skConst: - result = result.sym.ast # look it up - if result.typ == nil or result.typ.kind != tyString: - GlobalError(n.info, errStringLiteralExpected) - -proc processDynLib(c: PContext, n: PNode, sym: PSym) = - if (sym == nil) or (sym.kind == skModule): - POptionEntry(c.optionStack.tail).dynlib = getLib(c, libDynamic, - expectDynlibNode(c, n)) - elif n.kind == nkExprColonExpr: - var lib = getLib(c, libDynamic, expectDynlibNode(c, n)) - addToLib(lib, sym) - incl(sym.loc.flags, lfDynamicLib) - else: - incl(sym.loc.flags, lfExportLib) - -proc processNote(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (sonsLen(n) == 2) and - (n.sons[0].kind == nkBracketExpr) and - (n.sons[0].sons[1].kind == nkIdent) and - (n.sons[0].sons[0].kind == nkIdent) and (n.sons[1].kind == nkIdent): - var nk: TNoteKind - case whichKeyword(n.sons[0].sons[0].ident) - of wHint: - var x = findStr(msgs.HintsToStr, n.sons[0].sons[1].ident.s) - if x >= 0: nk = TNoteKind(x + ord(hintMin)) - else: invalidPragma(n) - of wWarning: - var x = findStr(msgs.WarningsToStr, n.sons[0].sons[1].ident.s) - if x >= 0: nk = TNoteKind(x + ord(warnMin)) - else: InvalidPragma(n) - else: - invalidPragma(n) - return - case whichKeyword(n.sons[1].ident) - of wOn: incl(gNotes, nk) - of wOff: excl(gNotes, nk) - else: LocalError(n.info, errOnOrOffExpected) - else: - invalidPragma(n) - -proc processOption(c: PContext, n: PNode) = - if n.kind != nkExprColonExpr: invalidPragma(n) - elif n.sons[0].kind == nkBracketExpr: processNote(c, n) - elif n.sons[0].kind != nkIdent: invalidPragma(n) - else: - var sw = whichKeyword(n.sons[0].ident) - case sw - of wChecks: OnOff(c, n, checksOptions) - of wObjChecks: OnOff(c, n, {optObjCheck}) - of wFieldchecks: OnOff(c, n, {optFieldCheck}) - of wRangechecks: OnOff(c, n, {optRangeCheck}) - of wBoundchecks: OnOff(c, n, {optBoundsCheck}) - of wOverflowchecks: OnOff(c, n, {optOverflowCheck}) - of wNilchecks: OnOff(c, n, {optNilCheck}) - of wFloatChecks: OnOff(c, n, {optNanCheck, optInfCheck}) - of wNaNchecks: OnOff(c, n, {optNanCheck}) - of wInfChecks: OnOff(c, n, {optInfCheck}) - of wAssertions: OnOff(c, n, {optAssert}) - of wWarnings: OnOff(c, n, {optWarns}) - of wHints: OnOff(c, n, {optHints}) - of wCallConv: processCallConv(c, n) - of wLinedir: OnOff(c, n, {optLineDir}) - of wStacktrace: OnOff(c, n, {optStackTrace}) - of wLinetrace: OnOff(c, n, {optLineTrace}) - of wDebugger: OnOff(c, n, {optEndb}) - of wProfiler: OnOff(c, n, {optProfiler}) - of wByRef: OnOff(c, n, {optByRef}) - of wDynLib: processDynLib(c, n, nil) - of wOptimization: - if n.sons[1].kind != nkIdent: - invalidPragma(n) - else: - case whichKeyword(n.sons[1].ident) - of wSpeed: - incl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - of wSize: - excl(gOptions, optOptimizeSpeed) - incl(gOptions, optOptimizeSize) - of wNone: - excl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - else: LocalError(n.info, errNoneSpeedOrSizeExpected) - else: LocalError(n.info, errOptionExpected) - -proc processPush(c: PContext, n: PNode, start: int) = - var x = newOptionEntry() - var y = POptionEntry(c.optionStack.tail) - x.options = gOptions - x.defaultCC = y.defaultCC - x.dynlib = y.dynlib - x.notes = gNotes - append(c.optionStack, x) - for i in countup(start, sonsLen(n) - 1): - processOption(c, n.sons[i]) - #liMessage(n.info, warnUser, ropeToStr(optionsToStr(gOptions))); - -proc processPop(c: PContext, n: PNode) = - if c.optionStack.counter <= 1: - LocalError(n.info, errAtPopWithoutPush) - else: - gOptions = POptionEntry(c.optionStack.tail).options - #liMessage(n.info, warnUser, ropeToStr(optionsToStr(gOptions))); - gNotes = POptionEntry(c.optionStack.tail).notes - remove(c.optionStack, c.optionStack.tail) - -proc processDefine(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): - DefineSymbol(n.sons[1].ident.s) - Message(n.info, warnDeprecated, "define") - else: - invalidPragma(n) - -proc processUndef(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): - UndefSymbol(n.sons[1].ident.s) - Message(n.info, warnDeprecated, "undef") - else: - invalidPragma(n) - -type - TLinkFeature = enum - linkNormal, linkSys - -proc processCompile(c: PContext, n: PNode) = - var s = expectStrLit(c, n) - var found = findFile(s) - if found == "": found = s - var trunc = ChangeFileExt(found, "") - extccomp.addExternalFileToCompile(found) - extccomp.addFileToLink(completeCFilePath(trunc, false)) - -proc processCommonLink(c: PContext, n: PNode, feature: TLinkFeature) = - var f = expectStrLit(c, n) - if splitFile(f).ext == "": f = addFileExt(f, cc[ccompiler].objExt) - var found = findFile(f) - if found == "": found = f # use the default - case feature - of linkNormal: extccomp.addFileToLink(found) - of linkSys: - extccomp.addFileToLink(joinPath(libpath, completeCFilePath(found, false))) - else: internalError(n.info, "processCommonLink") - -proc PragmaBreakpoint(c: PContext, n: PNode) = - discard getOptionalStr(c, n, "") - -proc PragmaCheckpoint(c: PContext, n: PNode) = - # checkpoints can be used to debug the compiler; they are not documented - var info = n.info - inc(info.line) # next line is affected! - msgs.addCheckpoint(info) - -proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = - case n.sons[1].kind - of nkStrLit, nkRStrLit, nkTripleStrLit: - result = copyNode(n) - var str = n.sons[1].strVal - if str == "": GlobalError(n.info, errEmptyAsm) - # now parse the string literal and substitute symbols: - var a = 0 - while true: - var b = strutils.find(str, marker, a) - var sub = if b < 0: copy(str, a) else: copy(str, a, b - 1) - if sub != "": addSon(result, newStrNode(nkStrLit, sub)) - if b < 0: break - var c = strutils.find(str, marker, b + 1) - if c < 0: sub = copy(str, b + 1) - else: sub = copy(str, b + 1, c - 1) - if sub != "": - var e = SymtabGet(con.tab, getIdent(sub)) - if e != nil: - if e.kind == skStub: loadStub(e) - addSon(result, newSymNode(e)) - else: - addSon(result, newStrNode(nkStrLit, sub)) - if c < 0: break - a = c + 1 - else: illFormedAst(n) - -proc PragmaEmit(c: PContext, n: PNode) = - discard getStrLitNode(c, n) - n.sons[1] = semAsmOrEmit(c, n, '`') - -proc noVal(n: PNode) = - if n.kind == nkExprColonExpr: invalidPragma(n) - -proc PragmaUnroll(c: PContext, n: PNode) = - if c.p.nestedLoopCounter <= 0: - invalidPragma(n) - elif n.kind == nkExprColonExpr: - var unrollFactor = expectIntLit(c, n) - if unrollFactor <% 32: - n.sons[1] = newIntNode(nkIntLit, unrollFactor) - else: - invalidPragma(n) - -proc PragmaLinearScanEnd(c: PContext, n: PNode) = - noVal(n) - -proc processPragma(c: PContext, n: PNode, i: int) = - var it = n.sons[i] - if it.kind != nkExprColonExpr: invalidPragma(n) - elif it.sons[0].kind != nkIdent: invalidPragma(n) - elif it.sons[1].kind != nkIdent: invalidPragma(n) - - var userPragma = NewSym(skTemplate, it.sons[1].ident, nil) - userPragma.info = it.info - var body = newNodeI(nkPragma, n.info) - for j in i+1 .. sonsLen(n)-1: addSon(body, n.sons[j]) - userPragma.ast = body - StrTableAdd(c.userPragmas, userPragma) - -proc pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = - if n == nil: return - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - var key = if it.kind == nkExprColonExpr: it.sons[0] else: it - if key.kind == nkIdent: - var userPragma = StrTableGet(c.userPragmas, key.ident) - if userPragma != nil: - pragma(c, sym, userPragma.ast, validPragmas) - # XXX BUG: possible infinite recursion! - else: - var k = whichKeyword(key.ident) - if k in validPragmas: - case k - of wExportc: - makeExternExport(sym, getOptionalStr(c, it, sym.name.s)) - incl(sym.flags, sfUsed) # avoid wrong hints - of wImportc: makeExternImport(sym, getOptionalStr(c, it, sym.name.s)) - of wExtern: setExternName(sym, expectStrLit(c, it)) - of wAlign: - if sym.typ == nil: invalidPragma(it) - var align = expectIntLit(c, it) - if not IsPowerOfTwo(align) and align != 0: - LocalError(it.info, errPowerOfTwoExpected) - else: - sym.typ.align = align - of wSize: - if sym.typ == nil: invalidPragma(it) - var size = expectIntLit(c, it) - if not IsPowerOfTwo(size) or size <= 0 or size > 8: - LocalError(it.info, errPowerOfTwoExpected) - else: - sym.typ.size = size - of wNodecl: - noVal(it) - incl(sym.loc.Flags, lfNoDecl) - of wPure: - noVal(it) - if sym != nil: incl(sym.flags, sfPure) - of wVolatile: - noVal(it) - incl(sym.flags, sfVolatile) - of wRegister: - noVal(it) - incl(sym.flags, sfRegister) - of wThreadVar: - noVal(it) - incl(sym.flags, sfThreadVar) - of wDeadCodeElim: pragmaDeadCodeElim(c, it) - of wMagic: processMagic(c, it, sym) - of wCompileTime: - noVal(it) - incl(sym.flags, sfCompileTime) - incl(sym.loc.Flags, lfNoDecl) - of wMerge: - noval(it) - incl(sym.flags, sfMerge) - of wHeader: - var lib = getLib(c, libHeader, getStrLitNode(c, it)) - addToLib(lib, sym) - incl(sym.flags, sfImportc) - incl(sym.loc.flags, lfHeader) - incl(sym.loc.Flags, lfNoDecl) - # implies nodecl, because otherwise header would not make sense - if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) - of wNosideeffect: - noVal(it) - incl(sym.flags, sfNoSideEffect) - if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) - of wSideEffect: - noVal(it) - incl(sym.flags, sfSideEffect) - of wNoReturn: - noVal(it) - incl(sym.flags, sfNoReturn) - of wDynLib: - processDynLib(c, it, sym) - of wCompilerProc: - noVal(it) # compilerproc may not get a string! - makeExternExport(sym, sym.name.s) - incl(sym.flags, sfCompilerProc) - incl(sym.flags, sfUsed) # suppress all those stupid warnings - registerCompilerProc(sym) - of wProcvar: - noVal(it) - incl(sym.flags, sfProcVar) - of wDeprecated: - noVal(it) - if sym != nil: incl(sym.flags, sfDeprecated) - else: incl(c.module.flags, sfDeprecated) - of wVarargs: - noVal(it) - if sym.typ == nil: invalidPragma(it) - incl(sym.typ.flags, tfVarargs) - of wBorrow: - noVal(it) - incl(sym.flags, sfBorrow) - of wFinal: - noVal(it) - if sym.typ == nil: invalidPragma(it) - incl(sym.typ.flags, tfFinal) - of wAcyclic: - noVal(it) - if sym.typ == nil: invalidPragma(it) - incl(sym.typ.flags, tfAcyclic) - of wShallow: - noVal(it) - if sym.typ == nil: invalidPragma(it) - incl(sym.typ.flags, tfShallow) - of wTypeCheck: - noVal(it) - incl(sym.flags, sfTypeCheck) - of wHint: Message(it.info, hintUser, expectStrLit(c, it)) - of wWarning: Message(it.info, warnUser, expectStrLit(c, it)) - of wError: LocalError(it.info, errUser, expectStrLit(c, it)) - of wFatal: Fatal(it.info, errUser, expectStrLit(c, it)) - of wDefine: processDefine(c, it) - of wUndef: processUndef(c, it) - of wCompile: processCompile(c, it) - of wLink: processCommonLink(c, it, linkNormal) - of wLinkSys: processCommonLink(c, it, linkSys) - of wPassL: extccomp.addLinkOption(expectStrLit(c, it)) - of wPassC: extccomp.addCompileOption(expectStrLit(c, it)) - of wBreakpoint: PragmaBreakpoint(c, it) - of wCheckpoint: PragmaCheckpoint(c, it) - of wPush: - processPush(c, n, i + 1) - break - of wPop: processPop(c, it) - of wPragma: - processPragma(c, n, i) - break - of wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, - wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, - wLinedir, wStacktrace, wLinetrace, wOptimization, wByRef, - wCallConv, - wDebugger, wProfiler, wFloatChecks, wNanChecks, wInfChecks: - processOption(c, it) # calling conventions (boring...): - of firstCallConv..lastCallConv: - assert(sym != nil) - if sym.typ == nil: invalidPragma(it) - sym.typ.callConv = wordToCallConv(k) - of wEmit: PragmaEmit(c, it) - of wUnroll: PragmaUnroll(c, it) - of wLinearScanEnd: PragmaLinearScanEnd(c, it) - else: invalidPragma(it) - else: invalidPragma(it) - else: processNote(c, it) - if (sym != nil) and (sym.kind != skModule): - if (lfExportLib in sym.loc.flags) and not (sfExportc in sym.flags): - LocalError(n.info, errDynlibRequiresExportc) - var lib = POptionEntry(c.optionstack.tail).dynlib - if ({lfDynamicLib, lfHeader} * sym.loc.flags == {}) and - (sfImportc in sym.flags) and (lib != nil): - incl(sym.loc.flags, lfDynamicLib) - addToLib(lib, sym) - if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) - diff --git a/rod/procfind.nim b/rod/procfind.nim deleted file mode 100755 index 30455c4c6..000000000 --- a/rod/procfind.nim +++ /dev/null @@ -1,83 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the searching for procs and iterators. -# This is needed for proper handling of forward declarations. - -import - ast, astalgo, msgs, semdata, types, trees - -proc SearchForProc*(c: PContext, fn: PSym, tos: int): PSym - # Searchs for the fn in the symbol table. If the parameter lists are exactly - # the same the sym in the symbol table is returned, else nil. -proc SearchForBorrowProc*(c: PContext, fn: PSym, tos: int): PSym - # Searchs for the fn in the symbol table. If the parameter lists are suitable - # for borrowing the sym in the symbol table is returned, else nil. -# implementation - -proc equalGenericParams(procA, procB: PNode): bool = - var a, b: PSym - result = procA == procB - if result: return - if (procA == nil) or (procB == nil): return - if sonsLen(procA) != sonsLen(procB): return - for i in countup(0, sonsLen(procA) - 1): - if procA.sons[i].kind != nkSym: - InternalError(procA.info, "equalGenericParams") - if procB.sons[i].kind != nkSym: - InternalError(procB.info, "equalGenericParams") - a = procA.sons[i].sym - b = procB.sons[i].sym - if (a.name.id != b.name.id) or not sameTypeOrNil(a.typ, b.typ): return - if (a.ast != nil) and (b.ast != nil): - if not ExprStructuralEquivalent(a.ast, b.ast): return - result = true - -proc SearchForProc(c: PContext, fn: PSym, tos: int): PSym = - var it: TIdentIter - result = initIdentIter(it, c.tab.stack[tos], fn.Name) - while result != nil: - if (result.Kind == fn.kind): - if equalGenericParams(result.ast.sons[genericParamsPos], - fn.ast.sons[genericParamsPos]): - case equalParams(result.typ.n, fn.typ.n) - of paramsEqual: - return - of paramsIncompatible: - LocalError(fn.info, errNotOverloadable, fn.name.s) - return - of paramsNotEqual: - nil - result = NextIdentIter(it, c.tab.stack[tos]) - -proc paramsFitBorrow(a, b: PNode): bool = - var length = sonsLen(a) - result = false - if length == sonsLen(b): - for i in countup(1, length - 1): - var m = a.sons[i].sym - var n = b.sons[i].sym - assert((m.kind == skParam) and (n.kind == skParam)) - if not equalOrDistinctOf(m.typ, n.typ): return - if not equalOrDistinctOf(a.sons[0].typ, b.sons[0].typ): return - result = true - -proc SearchForBorrowProc(c: PContext, fn: PSym, tos: int): PSym = - # Searchs for the fn in the symbol table. If the parameter lists are suitable - # for borrowing the sym in the symbol table is returned, else nil. - var it: TIdentIter - for scope in countdown(tos, 0): - result = initIdentIter(it, c.tab.stack[scope], fn.Name) - while result != nil: - # watchout! result must not be the same as fn! - if (result.Kind == fn.kind) and (result.id != fn.id): - if equalGenericParams(result.ast.sons[genericParamsPos], - fn.ast.sons[genericParamsPos]): - if paramsFitBorrow(fn.typ.n, result.typ.n): return - result = NextIdentIter(it, c.tab.stack[scope]) diff --git a/rod/ptmplsyn.nim b/rod/ptmplsyn.nim deleted file mode 100755 index 9699f1c58..000000000 --- a/rod/ptmplsyn.nim +++ /dev/null @@ -1,215 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements Nimrod's standard template filter. - -import - llstream, os, wordrecg, idents, strutils, ast, astalgo, msgs, options, - rnimsyn, filters - -proc filterTmpl*(stdin: PLLStream, filename: string, call: PNode): PLLStream - # #! template(subsChar='$', metaChar='#') | standard(version="0.7.2") -# implementation - -type - TParseState = enum - psDirective, psTempl - TTmplParser{.final.} = object - inp: PLLStream - state: TParseState - info: TLineInfo - indent, emitPar: int - x: string # the current input line - outp: PLLStream # the ouput will be parsed by pnimsyn - subsChar, NimDirective: Char - emit, conc, toStr: string - curly, bracket, par: int - pendingExprLine: bool - - -const - PatternChars = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF', '.', '_'} - -proc newLine(p: var TTmplParser) = - LLStreamWrite(p.outp, repeatChar(p.emitPar, ')')) - p.emitPar = 0 - if p.info.line > int16(1): LLStreamWrite(p.outp, "\n") - if p.pendingExprLine: - LLStreamWrite(p.outp, repeatChar(2)) - p.pendingExprLine = false - -proc scanPar(p: var TTmplParser, d: int) = - var i = d - while true: - case p.x[i] - of '\0': break - of '(': inc(p.par) - of ')': dec(p.par) - of '[': inc(p.bracket) - of ']': dec(p.bracket) - of '{': inc(p.curly) - of '}': dec(p.curly) - else: nil - inc(i) - -proc withInExpr(p: TTmplParser): bool {.inline.} = - result = p.par > 0 or p.bracket > 0 or p.curly > 0 - -proc parseLine(p: var TTmplParser) = - var - d, j, curly: int - keyw: string - j = 0 - while p.x[j] == ' ': inc(j) - if (p.x[0] == p.NimDirective) and (p.x[0 + 1] == '!'): - newLine(p) - elif (p.x[j] == p.NimDirective): - newLine(p) - inc(j) - while p.x[j] == ' ': inc(j) - d = j - keyw = "" - while p.x[j] in PatternChars: - add(keyw, p.x[j]) - inc(j) - - scanPar(p, j) - p.pendingExprLine = withInExpr(p) or llstream.endsWithOpr(p.x) - case whichKeyword(keyw) - of wEnd: - if p.indent >= 2: - dec(p.indent, 2) - else: - p.info.col = int16(j) - LocalError(p.info, errXNotAllowedHere, "end") - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, "#end") - of wIf, wWhen, wTry, wWhile, wFor, wBlock, wCase, wProc, wIterator, - wConverter, wMacro, wTemplate, wMethod: - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, copy(p.x, d)) - inc(p.indent, 2) - of wElif, wOf, wElse, wExcept, wFinally: - LLStreamWrite(p.outp, repeatChar(p.indent - 2)) - LLStreamWrite(p.outp, copy(p.x, d)) - else: - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, copy(p.x, d)) - p.state = psDirective - else: - # data line - # reset counters - p.par = 0 - p.curly = 0 - p.bracket = 0 - j = 0 - case p.state - of psTempl: - # next line of string literal: - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, "\n") - LLStreamWrite(p.outp, repeatChar(p.indent + 2)) - LLStreamWrite(p.outp, "\"") - of psDirective: - newLine(p) - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, p.emit) - LLStreamWrite(p.outp, "(\"") - inc(p.emitPar) - p.state = psTempl - while true: - case p.x[j] - of '\0': - break - of '\x01'..'\x1F', '\x80'..'\xFF': - LLStreamWrite(p.outp, "\\x") - LLStreamWrite(p.outp, toHex(ord(p.x[j]), 2)) - inc(j) - of '\\': - LLStreamWrite(p.outp, "\\\\") - inc(j) - of '\'': - LLStreamWrite(p.outp, "\\\'") - inc(j) - of '\"': - LLStreamWrite(p.outp, "\\\"") - inc(j) - else: - if p.x[j] == p.subsChar: - # parse Nimrod expression: - inc(j) - case p.x[j] - of '{': - p.info.col = int16(j) - LLStreamWrite(p.outp, '\"') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, p.toStr) - LLStreamWrite(p.outp, '(') - inc(j) - curly = 0 - while true: - case p.x[j] - of '\0': - LocalError(p.info, errXExpected, "}") - break - of '{': - inc(j) - inc(curly) - LLStreamWrite(p.outp, '{') - of '}': - inc(j) - if curly == 0: break - if curly > 0: dec(curly) - LLStreamWrite(p.outp, '}') - else: - LLStreamWrite(p.outp, p.x[j]) - inc(j) - LLStreamWrite(p.outp, ')') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, '\"') - of 'a'..'z', 'A'..'Z', '\x80'..'\xFF': - LLStreamWrite(p.outp, '\"') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, p.toStr) - LLStreamWrite(p.outp, '(') - while p.x[j] in PatternChars: - LLStreamWrite(p.outp, p.x[j]) - inc(j) - LLStreamWrite(p.outp, ')') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, '\"') - else: - if p.x[j] == p.subsChar: - LLStreamWrite(p.outp, p.subsChar) - inc(j) - else: - p.info.col = int16(j) - LocalError(p.info, errInvalidExpression, "$") - else: - LLStreamWrite(p.outp, p.x[j]) - inc(j) - LLStreamWrite(p.outp, "\\n\"") - -proc filterTmpl(stdin: PLLStream, filename: string, call: PNode): PLLStream = - var p: TTmplParser - p.info = newLineInfo(filename, 0, 0) - p.outp = LLStreamOpen("") - p.inp = stdin - p.subsChar = charArg(call, "subschar", 1, '$') - p.nimDirective = charArg(call, "metachar", 2, '#') - p.emit = strArg(call, "emit", 3, "result.add") - p.conc = strArg(call, "conc", 4, " & ") - p.toStr = strArg(call, "tostring", 5, "$") - while not LLStreamAtEnd(p.inp): - p.x = LLStreamReadLine(p.inp) - p.info.line = p.info.line + int16(1) - parseLine(p) - newLine(p) - result = p.outp - LLStreamClose(p.inp) diff --git a/rod/readme.txt b/rod/readme.txt deleted file mode 100755 index 3d3cf4b29..000000000 --- a/rod/readme.txt +++ /dev/null @@ -1,4 +0,0 @@ -This directory contains the Nimrod compiler written in Nimrod. Note that this -code has been translated from a bootstrapping version written in Pascal, so -the code is **not** a poster child of good Nimrod code. - diff --git a/rod/rnimsyn.nim b/rod/rnimsyn.nim deleted file mode 100755 index 4436467fa..000000000 --- a/rod/rnimsyn.nim +++ /dev/null @@ -1,1104 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the renderer of the standard Nimrod representation. - -import - scanner, options, idents, strutils, ast, msgs, lists - -type - TRenderFlag* = enum - renderNone, renderNoBody, renderNoComments, renderDocComments, - renderNoPragmas, renderIds - TRenderFlags* = set[TRenderFlag] - TRenderTok*{.final.} = object - kind*: TTokType - length*: int16 - - TRenderTokSeq* = seq[TRenderTok] - TSrcGen*{.final.} = object - 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*: seq[PNode] # comment stack - flags*: TRenderFlags - - -proc renderModule*(n: PNode, filename: string, renderFlags: TRenderFlags = {}) -proc renderTree*(n: PNode, renderFlags: TRenderFlags = {}): string -proc initTokRender*(r: var TSrcGen, n: PNode, renderFlags: TRenderFlags = {}) -proc getNextTok*(r: var TSrcGen, kind: var TTokType, literal: var 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 - -proc InitSrcGen(g: var TSrcGen, renderFlags: TRenderFlags) = - g.comStack = @[] - g.tokens = @[] - g.indent = 0 - g.lineLen = 0 - g.pos = 0 - g.idx = 0 - g.buf = "" - g.flags = renderFlags - g.pendingNL = - 1 - -proc addTok(g: var TSrcGen, kind: TTokType, s: string) = - var length = len(g.tokens) - setlen(g.tokens, length + 1) - g.tokens[length].kind = kind - g.tokens[length].length = int16(len(s)) - add(g.buf, s) - -proc addPendingNL(g: var TSrcGen) = - if g.pendingNL >= 0: - addTok(g, tkInd, "\n" & repeatChar(g.pendingNL)) - g.lineLen = g.pendingNL - g.pendingNL = - 1 - -proc putNL(g: var TSrcGen, indent: int) = - if g.pendingNL >= 0: addPendingNL(g) - else: addTok(g, tkInd, "\n") - g.pendingNL = indent - g.lineLen = indent - -proc putNL(g: var TSrcGen) = - putNL(g, g.indent) - -proc optNL(g: var TSrcGen, indent: int) = - g.pendingNL = indent - g.lineLen = indent # BUGFIX - -proc optNL(g: var TSrcGen) = - optNL(g, g.indent) - -proc indentNL(g: var TSrcGen) = - inc(g.indent, indentWidth) - g.pendingNL = g.indent - g.lineLen = g.indent - -proc Dedent(g: var TSrcGen) = - dec(g.indent, indentWidth) - assert(g.indent >= 0) - if g.pendingNL > indentWidth: - Dec(g.pendingNL, indentWidth) - Dec(g.lineLen, indentWidth) - -proc put(g: var TSrcGen, kind: TTokType, s: string) = - addPendingNL(g) - if len(s) > 0: - addTok(g, kind, s) - inc(g.lineLen, len(s)) - -proc putLong(g: var TSrcGen, kind: TTokType, s: string, lineLen: int) = - # use this for tokens over multiple lines. - addPendingNL(g) - addTok(g, kind, s) - g.lineLen = lineLen - -proc toNimChar(c: Char): string = - case c - of '\0': result = "\\0" - of '\x01'..'\x1F', '\x80'..'\xFF': result = "\\x" & strutils.toHex(ord(c), 2) - of '\'', '\"', '\\': result = '\\' & c - else: result = c & "" - -proc makeNimString(s: string): string = - result = "\"" - for i in countup(0, len(s) + 0 - 1): add(result, toNimChar(s[i])) - add(result, '\"') - -proc putComment(g: var TSrcGen, s: string) = - var i = 0 - var comIndent = 1 - var isCode = (len(s) >= 2) and (s[0 + 1] != ' ') - var ind = g.lineLen - var com = "" - while true: - case s[i] - of '\0': - break - of '\x0D': - put(g, tkComment, com) - com = "" - inc(i) - if s[i] == '\x0A': inc(i) - optNL(g, ind) - of '\x0A': - put(g, tkComment, com) - com = "" - inc(i) - optNL(g, ind) - of '#': - add(com, s[i]) - inc(i) - comIndent = 0 - while s[i] == ' ': - add(com, s[i]) - inc(i) - inc(comIndent) - of ' ', '\x09': - add(com, s[i]) - inc(i) - else: - # we may break the comment into a multi-line comment if the line - # gets too long: - # compute length of the following word: - var j = i - while s[j] > ' ': inc(j) - if not isCode and (g.lineLen + (j - i) > MaxLineLen): - put(g, tkComment, com) - com = "" - optNL(g, ind) - com = com & '#' & repeatChar(comIndent) - while s[i] > ' ': - add(com, s[i]) - inc(i) - put(g, tkComment, com) - optNL(g) - -proc maxLineLength(s: string): int = - result = 0 - var i = 0 - var lineLen = 0 - while true: - case s[i] - of '\0': - break - of '\x0D': - inc(i) - if s[i] == '\x0A': inc(i) - result = max(result, lineLen) - lineLen = 0 - of '\x0A': - inc(i) - result = max(result, lineLen) - lineLen = 0 - else: - inc(lineLen) - inc(i) - -proc putRawStr(g: var TSrcGen, kind: TTokType, s: string) = - var i = 0 - var hi = len(s) + 0 - 1 - var str = "" - while i <= hi: - case s[i] - of '\x0D': - put(g, kind, str) - str = "" - inc(i) - if (i <= hi) and (s[i] == '\x0A'): inc(i) - optNL(g, 0) - of '\x0A': - put(g, kind, str) - str = "" - inc(i) - optNL(g, 0) - else: - add(str, s[i]) - inc(i) - put(g, kind, str) - -proc containsNL(s: string): bool = - for i in countup(0, len(s) + 0 - 1): - case s[i] - of '\x0D', '\x0A': - return true - else: - nil - result = false - -proc pushCom(g: var TSrcGen, n: PNode) = - var length = len(g.comStack) - setlen(g.comStack, length + 1) - g.comStack[length] = n - -proc popAllComs(g: var TSrcGen) = - setlen(g.comStack, 0) - -proc popCom(g: var TSrcGen) = - setlen(g.comStack, len(g.comStack) - 1) - -const - Space = " " - -proc shouldRenderComment(g: var TSrcGen, n: PNode): bool = - result = false - if n.comment != nil: - result = not (renderNoComments in g.flags) or - (renderDocComments in g.flags) and startsWith(n.comment, "##") - -proc gcom(g: var TSrcGen, n: PNode) = - assert(n != nil) - if shouldRenderComment(g, n): - if (g.pendingNL < 0) and (len(g.buf) > 0) and (g.buf[len(g.buf)] != ' '): - 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 (len(g.buf) > 0) and - (g.lineLen < LineCommentColumn): - var ml = maxLineLength(n.comment) - if ml + LineCommentColumn <= maxLineLen: - put(g, tkSpaces, repeatChar(LineCommentColumn - g.lineLen)) - putComment(g, n.comment) #assert(g.comStack[high(g.comStack)] = n); - -proc gcoms(g: var TSrcGen) = - for i in countup(0, high(g.comStack)): gcom(g, g.comStack[i]) - popAllComs(g) - -proc lsub(n: PNode): int -proc litAux(n: PNode, x: biggestInt, size: int): string = - if nfBase2 in n.flags: result = "0b" & toBin(x, size * 8) - elif nfBase8 in n.flags: result = "0o" & toOct(x, size * 3) - elif nfBase16 in n.flags: result = "0x" & toHex(x, size * 2) - else: result = $(x) - -proc atom(n: PNode): string = - var f: float32 - case n.kind - of nkEmpty: result = "" - of nkIdent: result = n.ident.s - of nkSym: result = n.sym.name.s - of nkStrLit: result = makeNimString(n.strVal) - of nkRStrLit: result = "r\"" & replace(n.strVal, "\"", "\"\"") & '\"' - of nkTripleStrLit: result = "\"\"\"" & n.strVal & "\"\"\"" - of nkCharLit: result = '\'' & toNimChar(chr(int(n.intVal))) & '\'' - of nkIntLit: result = litAux(n, n.intVal, 4) - of nkInt8Lit: result = litAux(n, n.intVal, 1) & "\'i8" - of nkInt16Lit: result = litAux(n, n.intVal, 2) & "\'i16" - of nkInt32Lit: result = litAux(n, n.intVal, 4) & "\'i32" - of nkInt64Lit: result = litAux(n, n.intVal, 8) & "\'i64" - of nkFloatLit: - if n.flags * {nfBase2, nfBase8, nfBase16} == {}: result = $(n.floatVal) - else: result = litAux(n, (cast[PInt64](addr(n.floatVal)))[] , 8) - of nkFloat32Lit: - if n.flags * {nfBase2, nfBase8, nfBase16} == {}: - result = $(n.floatVal) & "\'f32" - else: - f = n.floatVal - result = litAux(n, (cast[PInt32](addr(f)))[] , 4) & "\'f32" - of nkFloat64Lit: - if n.flags * {nfBase2, nfBase8, nfBase16} == {}: - result = $(n.floatVal) & "\'f64" - else: - result = litAux(n, (cast[PInt64](addr(n.floatVal)))[] , 8) & "\'f64" - of nkNilLit: result = "nil" - of nkType: - if (n.typ != nil) and (n.typ.sym != nil): result = n.typ.sym.name.s - else: result = "[type node]" - else: InternalError("rnimsyn.atom " & $n.kind) - -proc lcomma(n: PNode, start: int = 0, theEnd: int = - 1): int = - assert(theEnd < 0) - result = 0 - for i in countup(start, sonsLen(n) + theEnd): - inc(result, lsub(n.sons[i])) - inc(result, 2) # for ``, `` - if result > 0: - dec(result, 2) # last does not get a comma! - -proc lsons(n: PNode, start: int = 0, theEnd: int = - 1): int = - assert(theEnd < 0) - result = 0 - for i in countup(start, sonsLen(n) + theEnd): inc(result, lsub(n.sons[i])) - -proc lsub(n: PNode): int = - # computes the length of a tree - if n.comment != nil: return maxLineLen + 1 - case n.kind - of nkEmpty: result = 0 - of nkTripleStrLit: - if containsNL(n.strVal): result = maxLineLen + 1 - else: result = len(atom(n)) - of succ(nkEmpty)..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: - result = len(atom(n)) - of nkCall, nkBracketExpr, nkConv: result = lsub(n.sons[0]) + lcomma(n, 1) + 2 - of nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: result = lsub(n[1]) - of nkCast: result = lsub(n.sons[0]) + lsub(n.sons[1]) + len("cast[]()") - of nkAddr: result = lsub(n.sons[0]) + len("addr()") - of nkHiddenAddr, nkHiddenDeref: result = lsub(n.sons[0]) - of nkCommand: result = lsub(n.sons[0]) + lcomma(n, 1) + 1 - of nkExprEqExpr, nkAsgn, nkFastAsgn: result = lsons(n) + 3 - of nkPar, nkCurly, nkBracket: result = lcomma(n) + 2 - of nkSymChoice: result = lsons(n) + len("()") + sonsLen(n) - 1 - of nkTupleTy: result = lcomma(n) + len("tuple[]") - of nkDotExpr: result = lsons(n) + 1 - of nkBind: result = lsons(n) + len("bind_") - of nkCheckedFieldExpr: result = lsub(n.sons[0]) - of nkLambda: result = lsons(n) + len("lambda__=_") - of nkConstDef, nkIdentDefs: - result = lcomma(n, 0, - 3) - var L = sonsLen(n) - if n.sons[L - 2].kind != nkEmpty: result = result + lsub(n.sons[L - 2]) + 2 - if n.sons[L - 1].kind != nkEmpty: result = result + lsub(n.sons[L - 1]) + 3 - of nkVarTuple: result = lcomma(n, 0, - 3) + len("() = ") + lsub(lastSon(n)) - of nkChckRangeF: result = len("chckRangeF") + 2 + lcomma(n) - of nkChckRange64: result = len("chckRange64") + 2 + lcomma(n) - of nkChckRange: result = len("chckRange") + 2 + lcomma(n) - of nkObjDownConv, nkObjUpConv, nkStringToCString, nkCStringToString, - nkPassAsOpenArray: - result = 2 - if sonsLen(n) >= 1: result = result + lsub(n.sons[0]) - result = result + lcomma(n, 1) - of nkExprColonExpr: result = lsons(n) + 2 - of nkInfix: result = lsons(n) + 2 - of nkPrefix: result = lsons(n) + 1 - of nkPostfix: result = lsons(n) - of nkCallStrLit: result = lsons(n) - of nkPragmaExpr: result = lsub(n.sons[0]) + lcomma(n, 1) - of nkRange: result = lsons(n) + 2 - of nkDerefExpr: result = lsub(n.sons[0]) + 2 - of nkAccQuoted: result = lsub(n.sons[0]) + 2 - of nkIfExpr: - result = lsub(n.sons[0].sons[0]) + lsub(n.sons[0].sons[1]) + lsons(n, 1) + - len("if_:_") - of nkElifExpr: result = lsons(n) + len("_elif_:_") - of nkElseExpr: result = lsub(n.sons[0]) + len("_else:_") # type descriptions - of nkTypeOfExpr: result = lsub(n.sons[0]) + len("type_") - of nkRefTy: result = lsub(n.sons[0]) + len("ref_") - of nkPtrTy: result = lsub(n.sons[0]) + len("ptr_") - of nkVarTy: result = lsub(n.sons[0]) + len("var_") - of nkDistinctTy: result = lsub(n.sons[0]) + len("Distinct_") - of nkTypeDef: result = lsons(n) + 3 - of nkOfInherit: result = lsub(n.sons[0]) + len("of_") - of nkProcTy: result = lsons(n) + len("proc_") - of nkEnumTy: result = lsub(n.sons[0]) + lcomma(n, 1) + len("enum_") - of nkEnumFieldDef: result = lsons(n) + 3 - of nkVarSection: - if sonsLen(n) > 1: result = maxLineLen + 1 - else: result = lsons(n) + len("var_") - of nkReturnStmt: result = lsub(n.sons[0]) + len("return_") - of nkRaiseStmt: result = lsub(n.sons[0]) + len("raise_") - of nkYieldStmt: result = lsub(n.sons[0]) + len("yield_") - of nkDiscardStmt: result = lsub(n.sons[0]) + len("discard_") - of nkBreakStmt: result = lsub(n.sons[0]) + len("break_") - of nkContinueStmt: result = lsub(n.sons[0]) + len("continue_") - of nkPragma: result = lcomma(n) + 4 - of nkCommentStmt: result = len(n.comment) - of nkOfBranch: result = lcomma(n, 0, - 2) + lsub(lastSon(n)) + len("of_:_") - of nkElifBranch: result = lsons(n) + len("elif_:_") - of nkElse: result = lsub(n.sons[0]) + len("else:_") - of nkFinally: result = lsub(n.sons[0]) + len("finally:_") - of nkGenericParams: result = lcomma(n) + 2 - of nkFormalParams: - result = lcomma(n, 1) + 2 - if n.sons[0].kind != nkEmpty: result = result + lsub(n.sons[0]) + 2 - of nkExceptBranch: - result = lcomma(n, 0, -2) + lsub(lastSon(n)) + len("except_:_") - else: result = maxLineLen + 1 - -proc fits(g: TSrcGen, x: int): bool = - result = x + g.lineLen <= maxLineLen - -type - TSubFlag = enum - rfLongMode, rfNoIndent, rfInConstExpr - TSubFlags = set[TSubFlag] - TContext = tuple[spacing: int, flags: TSubFlags] - -const - emptyContext: TContext = (spacing: 0, flags: {}) - -proc initContext(c: var TContext) = - c.spacing = 0 - c.flags = {} - -proc gsub(g: var TSrcGen, n: PNode, c: TContext) -proc gsub(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - gsub(g, n, c) - -proc hasCom(n: PNode): bool = - result = false - if n.comment != nil: return true - case n.kind - of nkEmpty..nkNilLit: nil - else: - for i in countup(0, sonsLen(n) - 1): - if hasCom(n.sons[i]): return true - -proc putWithSpace(g: var TSrcGen, kind: TTokType, s: string) = - put(g, kind, s) - put(g, tkSpaces, Space) - -proc gcommaAux(g: var TSrcGen, n: PNode, ind: int, start: int = 0, - theEnd: int = - 1) = - for i in countup(start, sonsLen(n) + theEnd): - var c = i < sonsLen(n) + theEnd - var sublen = lsub(n.sons[i]) + ord(c) - if not fits(g, sublen) and (ind + sublen < maxLineLen): optNL(g, ind) - gsub(g, n.sons[i]) - if c: - putWithSpace(g, tkComma, ",") - if hasCom(n.sons[i]): - gcoms(g) - optNL(g, ind) - -proc gcomma(g: var TSrcGen, n: PNode, c: TContext, start: int = 0, - theEnd: int = - 1) = - var ind: int - if rfInConstExpr in c.flags: - ind = g.indent + indentWidth - else: - ind = g.lineLen - if ind > maxLineLen div 2: ind = g.indent + longIndentWid - gcommaAux(g, n, ind, start, theEnd) - -proc gcomma(g: var TSrcGen, n: PNode, start: int = 0, theEnd: int = - 1) = - var ind = g.lineLen - if ind > maxLineLen div 2: ind = g.indent + longIndentWid - gcommaAux(g, n, ind, start, theEnd) - -proc gsons(g: var TSrcGen, n: PNode, c: TContext, start: int = 0, - theEnd: int = - 1) = - for i in countup(start, sonsLen(n) + theEnd): gsub(g, n.sons[i], c) - -proc gsection(g: var TSrcGen, n: PNode, c: TContext, kind: TTokType, - k: string) = - if sonsLen(n) == 0: return # empty var sections are possible - putWithSpace(g, kind, k) - gcoms(g) - indentNL(g) - for i in countup(0, sonsLen(n) - 1): - optNL(g) - gsub(g, n.sons[i], c) - gcoms(g) - dedent(g) - -proc longMode(n: PNode, start: int = 0, theEnd: int = - 1): bool = - result = n.comment != nil - if not result: - # check further - for i in countup(start, sonsLen(n) + theEnd): - if (lsub(n.sons[i]) > maxLineLen): - result = true - break - -proc gstmts(g: var TSrcGen, n: PNode, c: TContext) = - if n.kind == nkEmpty: return - if (n.kind == nkStmtList) or (n.kind == nkStmtListExpr): - indentNL(g) - for i in countup(0, sonsLen(n) - 1): - optNL(g) - gsub(g, n.sons[i]) - gcoms(g) - dedent(g) - else: - if rfLongMode in c.flags: indentNL(g) - gsub(g, n) - gcoms(g) - optNL(g) - if rfLongMode in c.flags: dedent(g) - -proc gif(g: var TSrcGen, n: PNode) = - var - c: TContext - 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): - incl(c.flags, rfLongMode) - gcoms(g) # a good place for comments - gstmts(g, n.sons[0].sons[1], c) - var length = sonsLen(n) - for i in countup(1, length - 1): - optNL(g) - gsub(g, n.sons[i], c) - -proc gwhile(g: var TSrcGen, n: PNode) = - var c: TContext - 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): - incl(c.flags, rfLongMode) - gcoms(g) # a good place for comments - gstmts(g, n.sons[1], c) - -proc gtry(g: var TSrcGen, n: PNode) = - var c: TContext - put(g, tkTry, "try") - putWithSpace(g, tkColon, ":") - initContext(c) - if longMode(n) or (lsub(n.sons[0]) + g.lineLen > maxLineLen): - incl(c.flags, rfLongMode) - gcoms(g) # a good place for comments - gstmts(g, n.sons[0], c) - gsons(g, n, c, 1) - -proc gfor(g: var TSrcGen, n: PNode) = - var c: TContext - var length = sonsLen(n) - putWithSpace(g, tkFor, "for") - initContext(c) - if longMode(n) or - (lsub(n.sons[length - 1]) + lsub(n.sons[length - 2]) + 6 + g.lineLen > - maxLineLen): - incl(c.flags, rfLongMode) - gcomma(g, n, c, 0, - 3) - put(g, tkSpaces, Space) - putWithSpace(g, tkIn, "in") - gsub(g, n.sons[length - 2], c) - putWithSpace(g, tkColon, ":") - gcoms(g) - gstmts(g, n.sons[length - 1], c) - -proc gmacro(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - gsub(g, n.sons[0]) - putWithSpace(g, tkColon, ":") - if longMode(n) or (lsub(n.sons[1]) + g.lineLen > maxLineLen): - incl(c.flags, rfLongMode) - gcoms(g) - gsons(g, n, c, 1) - -proc gcase(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - var length = sonsLen(n) - var last = if n.sons[length-1].kind == nkElse: -2 else: -1 - if longMode(n, 0, last): incl(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: - initContext(c) - if longMode(n.sons[length - 1]): incl(c.flags, rfLongMode) - gsub(g, n.sons[length - 1], c) - -proc gproc(g: var TSrcGen, n: PNode) = - var c: TContext - 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): - if n.sons[4].kind != nkEmpty: - put(g, tkSpaces, Space) - putWithSpace(g, tkEquals, "=") - indentNL(g) - gcoms(g) - dedent(g) - initContext(c) - gstmts(g, n.sons[4], c) - putNL(g) - else: - indentNL(g) - gcoms(g) - dedent(g) - -proc gblock(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - if n.sons[0].kind != nkEmpty: - putWithSpace(g, tkBlock, "block") - gsub(g, n.sons[0]) - else: - put(g, tkBlock, "block") - putWithSpace(g, tkColon, ":") - if longMode(n) or (lsub(n.sons[1]) + g.lineLen > maxLineLen): - incl(c.flags, rfLongMode) - gcoms(g) - # XXX I don't get why this is needed here! gstmts should already handle this! - indentNL(g) - gstmts(g, n.sons[1], c) - dedent(g) - -proc gasm(g: var TSrcGen, n: PNode) = - putWithSpace(g, tkAsm, "asm") - gsub(g, n.sons[0]) - gcoms(g) - gsub(g, n.sons[1]) - -proc gident(g: var TSrcGen, n: PNode) = - var t: TTokType - var s = atom(n) - if (s[0] in scanner.SymChars): - if (n.kind == nkIdent): - if (n.ident.id < ord(tokKeywordLow) - ord(tkSymbol)) or - (n.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): - t = tkSymbol - else: - t = TTokType(n.ident.id + ord(tkSymbol)) - else: - t = tkSymbol - else: - t = tkOpr - put(g, t, s) - if (n.kind == nkSym) and (renderIds in g.flags): put(g, tkIntLit, $(n.sym.id)) - -proc gsub(g: var TSrcGen, n: PNode, c: TContext) = - var - L: int - a: TContext - if n.comment != nil: pushCom(g, n) - case n.kind # atoms: - of nkTripleStrLit: putRawStr(g, tkTripleStrLit, n.strVal) - of nkEmpty: nil - of nkType: put(g, tkInvalid, atom(n)) - of nkSym, nkIdent: gident(g, n) - of nkIntLit: put(g, tkIntLit, atom(n)) - of nkInt8Lit: put(g, tkInt8Lit, atom(n)) - of nkInt16Lit: put(g, tkInt16Lit, atom(n)) - of nkInt32Lit: put(g, tkInt32Lit, atom(n)) - of nkInt64Lit: put(g, tkInt64Lit, atom(n)) - of nkFloatLit: put(g, tkFloatLit, atom(n)) - of nkFloat32Lit: put(g, tkFloat32Lit, atom(n)) - of nkFloat64Lit: put(g, tkFloat64Lit, atom(n)) - of nkStrLit: put(g, tkStrLit, atom(n)) - of nkRStrLit: put(g, tkRStrLit, atom(n)) - of nkCharLit: put(g, tkCharLit, atom(n)) - of nkNilLit: put(g, tkNil, atom(n)) # complex expressions - of nkCall, nkConv, nkDotCall: - if sonsLen(n) >= 1: gsub(g, n.sons[0]) - put(g, tkParLe, "(") - gcomma(g, n, 1) - put(g, tkParRi, ")") - of nkCallStrLit: - gsub(g, n.sons[0]) - if n.sons[1].kind == nkRStrLit: - put(g, tkRStrLit, '\"' & replace(n[1].strVal, "\"", "\"\"") & '\"') - else: - gsub(g, n.sons[1]) - of nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: gsub(g, n.sons[0]) - of nkCast: - 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, ")") - of nkAddr: - put(g, tkAddr, "addr") - put(g, tkParLe, "(") - gsub(g, n.sons[0]) - put(g, tkParRi, ")") - of nkBracketExpr: - gsub(g, n.sons[0]) - put(g, tkBracketLe, "[") - gcomma(g, n, 1) - put(g, tkBracketRi, "]") - of nkPragmaExpr: - gsub(g, n.sons[0]) - gcomma(g, n, 1) - of nkCommand: - gsub(g, n.sons[0]) - put(g, tkSpaces, space) - gcomma(g, n, 1) - of nkExprEqExpr, nkAsgn, nkFastAsgn: - gsub(g, n.sons[0]) - put(g, tkSpaces, Space) - putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[1]) - of nkChckRangeF: - put(g, tkSymbol, "chckRangeF") - put(g, tkParLe, "(") - gcomma(g, n) - put(g, tkParRi, ")") - of nkChckRange64: - put(g, tkSymbol, "chckRange64") - put(g, tkParLe, "(") - gcomma(g, n) - put(g, tkParRi, ")") - of nkChckRange: - put(g, tkSymbol, "chckRange") - put(g, tkParLe, "(") - gcomma(g, n) - put(g, tkParRi, ")") - of nkObjDownConv, nkObjUpConv, nkStringToCString, nkCStringToString, - nkPassAsOpenArray: - if sonsLen(n) >= 1: gsub(g, n.sons[0]) - put(g, tkParLe, "(") - gcomma(g, n, 1) - put(g, tkParRi, ")") - of nkSymChoice: - put(g, tkParLe, "(") - for i in countup(0, sonsLen(n) - 1): - if i > 0: put(g, tkOpr, "|") - gsub(g, n.sons[i], c) - put(g, tkParRi, ")") - of nkPar: - put(g, tkParLe, "(") - gcomma(g, n, c) - put(g, tkParRi, ")") - of nkCurly: - put(g, tkCurlyLe, "{") - gcomma(g, n, c) - put(g, tkCurlyRi, "}") - of nkBracket: - put(g, tkBracketLe, "[") - gcomma(g, n, c) - put(g, tkBracketRi, "]") - of nkDotExpr: - gsub(g, n.sons[0]) - put(g, tkDot, ".") - gsub(g, n.sons[1]) - of nkBind: - putWithSpace(g, tkBind, "bind") - gsub(g, n.sons[0]) - of nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref: - gsub(g, n.sons[0]) - of nkLambda: - assert(n.sons[genericParamsPos].kind == nkEmpty) - 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]) - of nkConstDef, nkIdentDefs: - gcomma(g, n, 0, - 3) - var L = sonsLen(n) - if n.sons[L - 2].kind != nkEmpty: - putWithSpace(g, tkColon, ":") - gsub(g, n.sons[L - 2]) - if n.sons[L - 1].kind != nkEmpty: - put(g, tkSpaces, Space) - putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[L - 1], c) - of nkVarTuple: - put(g, tkParLe, "(") - gcomma(g, n, 0, - 3) - put(g, tkParRi, ")") - put(g, tkSpaces, Space) - putWithSpace(g, tkEquals, "=") - gsub(g, lastSon(n), c) - of nkExprColonExpr: - gsub(g, n.sons[0]) - putWithSpace(g, tkColon, ":") - gsub(g, n.sons[1]) - of nkInfix: - 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): - optNL(g, g.indent + longIndentWid) - else: - put(g, tkSpaces, Space) - gsub(g, n.sons[2]) - of nkPrefix: - gsub(g, n.sons[0]) - put(g, tkSpaces, space) - gsub(g, n.sons[1]) - of nkPostfix: - gsub(g, n.sons[1]) - gsub(g, n.sons[0]) - of nkRange: - gsub(g, n.sons[0]) - put(g, tkDotDot, "..") - gsub(g, n.sons[1]) - of nkDerefExpr: - gsub(g, n.sons[0]) - putWithSpace(g, tkHat, "^") - # unfortunately this requires a space, because ^. would be only one operator - of nkAccQuoted: - put(g, tkAccent, "`") - gsub(g, n.sons[0]) - put(g, tkAccent, "`") - of nkIfExpr: - 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) - of nkElifExpr: - putWithSpace(g, tkElif, " elif") - gsub(g, n.sons[0]) - putWithSpace(g, tkColon, ":") - gsub(g, n.sons[1]) - of nkElseExpr: - put(g, tkElse, " else") - putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0]) - of nkTypeOfExpr: - putWithSpace(g, tkType, "type") - gsub(g, n.sons[0]) - of nkRefTy: - if sonsLen(n) > 0: - putWithSpace(g, tkRef, "ref") - gsub(g, n.sons[0]) - else: - put(g, tkRef, "ref") - of nkPtrTy: - if sonsLen(n) > 0: - putWithSpace(g, tkPtr, "ptr") - gsub(g, n.sons[0]) - else: - put(g, tkPtr, "ptr") - of nkVarTy: - if sonsLen(n) > 0: - putWithSpace(g, tkVar, "var") - gsub(g, n.sons[0]) - else: - put(g, tkVar, "var") - of nkDistinctTy: - if sonsLen(n) > 0: - putWithSpace(g, tkDistinct, "distinct") - gsub(g, n.sons[0]) - else: - put(g, tkDistinct, "distinct") - of nkTypeDef: - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) - put(g, tkSpaces, Space) - if n.sons[2].kind != nkEmpty: - putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[2]) - of nkObjectTy: - if sonsLen(n) > 0: - putWithSpace(g, tkObject, "object") - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) - gcoms(g) - gsub(g, n.sons[2]) - else: - put(g, tkObject, "object") - of nkRecList: - indentNL(g) - for i in countup(0, sonsLen(n) - 1): - optNL(g) - gsub(g, n.sons[i], c) - gcoms(g) - dedent(g) - putNL(g) - of nkOfInherit: - putWithSpace(g, tkOf, "of") - gsub(g, n.sons[0]) - of nkProcTy: - if sonsLen(n) > 0: - putWithSpace(g, tkProc, "proc") - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) - else: - put(g, tkProc, "proc") - of nkEnumTy: - if sonsLen(n) > 0: - 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) - else: - put(g, tkEnum, "enum") - of nkEnumFieldDef: - gsub(g, n.sons[0]) - put(g, tkSpaces, Space) - putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[1]) - of nkStmtList, nkStmtListExpr: gstmts(g, n, emptyContext) - of nkIfStmt: - putWithSpace(g, tkIf, "if") - gif(g, n) - of nkWhenStmt, nkRecWhen: - putWithSpace(g, tkWhen, "when") - gif(g, n) - of nkWhileStmt: gwhile(g, n) - of nkCaseStmt, nkRecCase: gcase(g, n) - of nkMacroStmt: gmacro(g, n) - of nkTryStmt: gtry(g, n) - of nkForStmt: gfor(g, n) - of nkBlockStmt, nkBlockExpr: gblock(g, n) - of nkAsmStmt: gasm(g, n) - of nkProcDef: - putWithSpace(g, tkProc, "proc") - gproc(g, n) - of nkMethodDef: - putWithSpace(g, tkMethod, "method") - gproc(g, n) - of nkIteratorDef: - putWithSpace(g, tkIterator, "iterator") - gproc(g, n) - of nkMacroDef: - putWithSpace(g, tkMacro, "macro") - gproc(g, n) - of nkTemplateDef: - putWithSpace(g, tkTemplate, "template") - gproc(g, n) - of nkTypeSection: - gsection(g, n, emptyContext, tkType, "type") - of nkConstSection: - initContext(a) - incl(a.flags, rfInConstExpr) - gsection(g, n, a, tkConst, "const") - of nkVarSection: - L = sonsLen(n) - if L == 0: return - putWithSpace(g, tkVar, "var") - if L > 1: - gcoms(g) - indentNL(g) - for i in countup(0, L - 1): - optNL(g) - gsub(g, n.sons[i]) - gcoms(g) - dedent(g) - else: - gsub(g, n.sons[0]) - of nkReturnStmt: - putWithSpace(g, tkReturn, "return") - gsub(g, n.sons[0]) - of nkRaiseStmt: - putWithSpace(g, tkRaise, "raise") - gsub(g, n.sons[0]) - of nkYieldStmt: - putWithSpace(g, tkYield, "yield") - gsub(g, n.sons[0]) - of nkDiscardStmt: - putWithSpace(g, tkDiscard, "discard") - gsub(g, n.sons[0]) - of nkBreakStmt: - putWithSpace(g, tkBreak, "break") - gsub(g, n.sons[0]) - of nkContinueStmt: - putWithSpace(g, tkContinue, "continue") - gsub(g, n.sons[0]) - of nkPragma: - if not (renderNoPragmas in g.flags): - put(g, tkCurlyDotLe, "{.") - gcomma(g, n, emptyContext) - put(g, tkCurlyDotRi, ".}") - of nkImportStmt: - putWithSpace(g, tkImport, "import") - gcoms(g) - indentNL(g) - gcommaAux(g, n, g.indent) - dedent(g) - putNL(g) - of nkFromStmt: - putWithSpace(g, tkFrom, "from") - gsub(g, n.sons[0]) - put(g, tkSpaces, Space) - putWithSpace(g, tkImport, "import") - gcomma(g, n, emptyContext, 1) - putNL(g) - of nkIncludeStmt: - putWithSpace(g, tkInclude, "include") - gcoms(g) - indentNL(g) - gcommaAux(g, n, g.indent) - dedent(g) - putNL(g) - of nkCommentStmt: - gcoms(g) - optNL(g) - of nkOfBranch: - optNL(g) - putWithSpace(g, tkOf, "of") - gcomma(g, n, c, 0, - 2) - putWithSpace(g, tkColon, ":") - gcoms(g) - gstmts(g, lastSon(n), c) - of nkElifBranch: - optNL(g) - putWithSpace(g, tkElif, "elif") - gsub(g, n.sons[0]) - putWithSpace(g, tkColon, ":") - gcoms(g) - gstmts(g, n.sons[1], c) - of nkElse: - optNL(g) - put(g, tkElse, "else") - putWithSpace(g, tkColon, ":") - gcoms(g) - gstmts(g, n.sons[0], c) - of nkFinally: - optNL(g) - put(g, tkFinally, "finally") - putWithSpace(g, tkColon, ":") - gcoms(g) - gstmts(g, n.sons[0], c) - of nkExceptBranch: - optNL(g) - putWithSpace(g, tkExcept, "except") - gcomma(g, n, 0, - 2) - putWithSpace(g, tkColon, ":") - gcoms(g) - gstmts(g, lastSon(n), c) - of nkGenericParams: - put(g, tkBracketLe, "[") - gcomma(g, n) - put(g, tkBracketRi, "]") - of nkFormalParams: - put(g, tkParLe, "(") - gcomma(g, n, 1) - put(g, tkParRi, ")") - if n.sons[0].kind != nkEmpty: - putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0]) - of nkTupleTy: - put(g, tkTuple, "tuple") - if sonsLen(n) > 0: - put(g, tkBracketLe, "[") - gcomma(g, n) - put(g, tkBracketRi, "]") - else: - #nkNone, nkMetaNode, nkTableConstr, nkExplicitTypeListCall: - InternalError(n.info, "rnimsyn.gsub(" & $n.kind & ')') - -proc renderTree(n: PNode, renderFlags: TRenderFlags = {}): string = - var g: TSrcGen - initSrcGen(g, renderFlags) - gsub(g, n) - result = g.buf - -proc renderModule(n: PNode, filename: string, renderFlags: TRenderFlags = {}) = - var - f: tfile - g: TSrcGen - initSrcGen(g, renderFlags) - for i in countup(0, sonsLen(n) - 1): - gsub(g, n.sons[i]) - optNL(g) - case n.sons[i].kind - of nkTypeSection, nkConstSection, nkVarSection, nkCommentStmt: putNL(g) - else: nil - gcoms(g) - if optStdout in gGlobalOptions: - write(stdout, g.buf) - elif open(f, filename, fmWrite): - write(f, g.buf) - close(f) - else: - rawMessage(errCannotOpenFile, filename) - -proc initTokRender(r: var TSrcGen, n: PNode, renderFlags: TRenderFlags = {}) = - initSrcGen(r, renderFlags) - gsub(r, n) - -proc getNextTok(r: var TSrcGen, kind: var TTokType, literal: var string) = - if r.idx < len(r.tokens): - kind = r.tokens[r.idx].kind - var length = r.tokens[r.idx].length - literal = copy(r.buf, r.pos + 0, r.pos + 0 + length - 1) - inc(r.pos, length) - inc(r.idx) - else: - kind = tkEof - diff --git a/rod/rodread.nim b/rod/rodread.nim deleted file mode 100755 index 36cb29185..000000000 --- a/rod/rodread.nim +++ /dev/null @@ -1,856 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module is responsible for loading of rod files. -# -# Reading and writing binary files are really hard to debug. Therefore we use -# a special text format. ROD-files are more efficient to process because -# symbols are only loaded on demand. -# It consists of: -# -# - a header: -# NIM:$fileversion\n -# - the module's id (even if the module changed, its ID will not!): -# ID:Ax3\n -# - CRC value of this module: -# CRC:CRC-val\n -# - a section containing the compiler options and defines this -# module has been compiled with: -# OPTIONS:options\n -# DEFINES:defines\n -# - FILES( -# myfile.inc -# lib/mymodA -# ) -# - a include file dependency section: -# INCLUDES( -# <fileidx> <CRC of myfile.inc>\n # fileidx is the LINE in the file section! -# ) -# - a module dependency section: -# DEPS: <fileidx> <fileidx>\n -# - an interface section: -# INTERF( -# identifier1 id\n # id is the symbol's id -# identifier2 id\n -# ) -# - a compiler proc section: -# COMPILERPROCS( -# identifier1 id\n # id is the symbol's id -# ) -# - an index consisting of (ID, linenumber)-pairs: -# INDEX( -# id-diff idx-diff\n -# id-diff idx-diff\n -# ) -# - an import index consisting of (ID, moduleID)-pairs: -# IMPORTS( -# id-diff moduleID-diff\n -# id-diff moduleID-diff\n -# ) -# - a list of all exported type converters because they are needed for correct -# semantic checking: -# CONVERTERS:id id\n # position of the symbol in the DATA section -# - an AST section that contains the module's AST: -# INIT( -# idx\n # position of the node in the DATA section -# idx\n -# ) -# - a data section, where each type, symbol or AST is stored. -# DATA( -# type -# (node) -# sym -# ) -# -# We now also do index compression, because an index always needs to be read. -# - -import - os, options, strutils, nversion, ast, astalgo, msgs, platform, condsyms, - ropes, idents, crc - -type - TReasonForRecompile* = enum - rrEmpty, # used by moddeps module - rrNone, # no need to recompile - rrRodDoesNotExist, # rod file does not exist - rrRodInvalid, # rod file is invalid - rrCrcChange, # file has been edited since last recompilation - rrDefines, # defines have changed - rrOptions, # options have changed - rrInclDeps, # an include has changed - rrModDeps # a module this module depends on has been changed - -const - reasonToFrmt*: array[TReasonForRecompile, string] = ["", - "no need to recompile: $1", "symbol file for $1 does not exist", - "symbol file for $1 has the wrong version", - "file edited since last compilation: $1", - "list of conditional symbols changed for: $1", - "list of options changed for: $1", "an include file edited: $1", - "a module $1 depends on has changed"] - -type - TIndex*{.final.} = object # an index with compression - lastIdxKey*, lastIdxVal*: int - tab*: TIITable - r*: PRope # writers use this - offset*: int # readers use this - - TRodReader* = object of TObject - pos*: int # position; used for parsing - s*: string # the whole file in memory - options*: TOptions - reason*: TReasonForRecompile - modDeps*: TStringSeq - files*: TStringSeq - dataIdx*: int # offset of start of data section - convertersIdx*: int # offset of start of converters section - initIdx*, interfIdx*, compilerProcsIdx*, cgenIdx*: int - filename*: string - index*, imports*: TIndex - readerIndex*: int - line*: int # only used for debugging, but is always in the code - moduleID*: int - syms*: TIdTable # already processed symbols - - PRodReader* = ref TRodReader - -const - FileVersion* = "1012" # modify this if the rod-format changes! - -var rodCompilerprocs*: TStrTable - -proc handleSymbolFile*(module: PSym, filename: string): PRodReader - # global because this is needed by magicsys -proc GetCRC*(filename: string): TCrc32 -proc loadInitSection*(r: PRodReader): PNode -proc loadStub*(s: PSym) -proc encodeInt*(x: BiggestInt): PRope -proc encode*(s: string): PRope -# implementation - -var gTypeTable: TIdTable - -proc rrGetSym(r: PRodReader, id: int, info: TLineInfo): PSym - # `info` is only used for debugging purposes -proc rrGetType(r: PRodReader, id: int, info: TLineInfo): PType -proc decode(r: PRodReader): string -proc decodeInt(r: PRodReader): int -proc decodeBInt(r: PRodReader): biggestInt - -proc encode(s: string): PRope = - var res = "" - for i in countup(0, len(s) - 1): - case s[i] - of 'a'..'z', 'A'..'Z', '0'..'9', '_': add(res, s[i]) - else: add(res, '\\' & toHex(ord(s[i]), 2)) - result = toRope(res) - -proc encodeIntAux(str: var string, x: BiggestInt) = - const chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" - var d: char - var v = x - var rem: biggestInt = v mod 190 - if (rem < 0): - add(str, '-') - v = - (v div 190) - rem = - rem - else: - v = v div 190 - var idx = int(rem) - if idx < 62: d = chars[idx + 0] - else: d = chr(idx - 62 + 128) - if (v != 0): encodeIntAux(str, v) - add(str, d) - -proc encodeInt(x: BiggestInt): PRope = - var res = "" - encodeIntAux(res, x) - result = toRope(res) - -proc decodeLineInfo(r: PRodReader, info: var TLineInfo) = - if r.s[r.pos] == '?': - inc(r.pos) - if r.s[r.pos] == ',': info.col = int16(- 1) - else: info.col = int16(decodeInt(r)) - if r.s[r.pos] == ',': - inc(r.pos) - if r.s[r.pos] == ',': info.line = int16(- 1) - else: info.line = int16(decodeInt(r)) - if r.s[r.pos] == ',': - inc(r.pos) - info = newLineInfo(r.files[decodeInt(r)], info.line, info.col) - -proc decodeNode(r: PRodReader, fInfo: TLineInfo): PNode = - result = nil - if r.s[r.pos] == '(': - inc(r.pos) - if r.s[r.pos] == ')': - inc(r.pos) - return # nil node - result = newNodeI(TNodeKind(decodeInt(r)), fInfo) - decodeLineInfo(r, result.info) - if r.s[r.pos] == '$': - inc(r.pos) - result.flags = cast[TNodeFlags](int32(decodeInt(r))) - if r.s[r.pos] == '^': - inc(r.pos) - var id = decodeInt(r) - result.typ = rrGetType(r, id, result.info) - case result.kind - of nkCharLit..nkInt64Lit: - if r.s[r.pos] == '!': - inc(r.pos) - result.intVal = decodeBInt(r) - of nkFloatLit..nkFloat64Lit: - if r.s[r.pos] == '!': - inc(r.pos) - var fl = decode(r) - result.floatVal = parseFloat(fl) - of nkStrLit..nkTripleStrLit: - if r.s[r.pos] == '!': - inc(r.pos) - result.strVal = decode(r) - else: - result.strVal = "" # BUGFIX - of nkIdent: - if r.s[r.pos] == '!': - inc(r.pos) - var fl = decode(r) - result.ident = getIdent(fl) - else: - internalError(result.info, "decodeNode: nkIdent") - of nkSym: - if r.s[r.pos] == '!': - inc(r.pos) - var id = decodeInt(r) - result.sym = rrGetSym(r, id, result.info) - else: - internalError(result.info, "decodeNode: nkSym") - else: - while r.s[r.pos] != ')': addSon(result, decodeNode(r, result.info)) - if r.s[r.pos] == ')': inc(r.pos) - else: internalError(result.info, "decodeNode") - else: - InternalError(result.info, "decodeNode " & r.s[r.pos]) - -proc decodeLoc(r: PRodReader, loc: var TLoc, info: TLineInfo) = - if r.s[r.pos] == '<': - inc(r.pos) - if r.s[r.pos] in {'0'..'9', 'a'..'z', 'A'..'Z'}: - loc.k = TLocKind(decodeInt(r)) - else: - loc.k = low(loc.k) - if r.s[r.pos] == '*': - inc(r.pos) - loc.s = TStorageLoc(decodeInt(r)) - else: - loc.s = low(loc.s) - if r.s[r.pos] == '$': - inc(r.pos) - loc.flags = cast[TLocFlags](int32(decodeInt(r))) - else: - loc.flags = {} - if r.s[r.pos] == '^': - inc(r.pos) - loc.t = rrGetType(r, decodeInt(r), info) - else: - loc.t = nil - if r.s[r.pos] == '!': - inc(r.pos) - loc.r = toRope(decode(r)) - else: - loc.r = nil - if r.s[r.pos] == '?': - inc(r.pos) - loc.a = decodeInt(r) - else: - loc.a = 0 - if r.s[r.pos] == '>': inc(r.pos) - else: InternalError(info, "decodeLoc " & r.s[r.pos]) - -proc decodeType(r: PRodReader, info: TLineInfo): PType = - result = nil - if r.s[r.pos] == '[': - inc(r.pos) - if r.s[r.pos] == ']': - inc(r.pos) - return # nil type - new(result) - result.kind = TTypeKind(decodeInt(r)) - if r.s[r.pos] == '+': - inc(r.pos) - result.id = decodeInt(r) - setId(result.id) - if debugIds: registerID(result) - else: - InternalError(info, "decodeType: no id") - # here this also avoids endless recursion for recursive type - IdTablePut(gTypeTable, result, result) - if r.s[r.pos] == '(': result.n = decodeNode(r, UnknownLineInfo()) - if r.s[r.pos] == '$': - inc(r.pos) - result.flags = cast[TTypeFlags](int32(decodeInt(r))) - if r.s[r.pos] == '?': - inc(r.pos) - result.callConv = TCallingConvention(decodeInt(r)) - if r.s[r.pos] == '*': - inc(r.pos) - result.owner = rrGetSym(r, decodeInt(r), info) - if r.s[r.pos] == '&': - inc(r.pos) - result.sym = rrGetSym(r, decodeInt(r), info) - if r.s[r.pos] == '/': - inc(r.pos) - result.size = decodeInt(r) - else: - result.size = - 1 - if r.s[r.pos] == '=': - inc(r.pos) - result.align = decodeInt(r) - else: - result.align = 2 - if r.s[r.pos] == '@': - inc(r.pos) - result.containerID = decodeInt(r) - decodeLoc(r, result.loc, info) - while r.s[r.pos] == '^': - inc(r.pos) - if r.s[r.pos] == '(': - inc(r.pos) - if r.s[r.pos] == ')': inc(r.pos) - else: InternalError(info, "decodeType ^(" & r.s[r.pos]) - addSon(result, nil) - else: - var d = decodeInt(r) - addSon(result, rrGetType(r, d, info)) - -proc decodeLib(r: PRodReader, info: TLineInfo): PLib = - result = nil - if r.s[r.pos] == '|': - new(result) - inc(r.pos) - result.kind = TLibKind(decodeInt(r)) - if r.s[r.pos] != '|': InternalError("decodeLib: 1") - inc(r.pos) - result.name = toRope(decode(r)) - if r.s[r.pos] != '|': InternalError("decodeLib: 2") - inc(r.pos) - result.path = decodeNode(r, info) - -proc decodeSym(r: PRodReader, info: TLineInfo): PSym = - var - id: int - ident: PIdent - result = nil - if r.s[r.pos] == '{': - inc(r.pos) - if r.s[r.pos] == '}': - inc(r.pos) - return # nil sym - var k = TSymKind(decodeInt(r)) - if r.s[r.pos] == '+': - inc(r.pos) - id = decodeInt(r) - setId(id) - else: - InternalError(info, "decodeSym: no id") - if r.s[r.pos] == '&': - inc(r.pos) - ident = getIdent(decode(r)) - else: - InternalError(info, "decodeSym: no ident") - result = PSym(IdTableGet(r.syms, id)) - if result == nil: - new(result) - result.id = id - IdTablePut(r.syms, result, result) - if debugIds: registerID(result) - elif (result.id != id): - InternalError(info, "decodeSym: wrong id") - result.kind = k - result.name = ident # read the rest of the symbol description: - if r.s[r.pos] == '^': - inc(r.pos) - result.typ = rrGetType(r, decodeInt(r), info) - decodeLineInfo(r, result.info) - if r.s[r.pos] == '*': - inc(r.pos) - result.owner = rrGetSym(r, decodeInt(r), result.info) - if r.s[r.pos] == '$': - inc(r.pos) - result.flags = cast[TSymFlags](int32(decodeInt(r))) - if r.s[r.pos] == '@': - inc(r.pos) - result.magic = TMagic(decodeInt(r)) - if r.s[r.pos] == '(': result.ast = decodeNode(r, result.info) - if r.s[r.pos] == '!': - inc(r.pos) - result.options = cast[TOptions](int32(decodeInt(r))) - else: - result.options = r.options - if r.s[r.pos] == '%': - inc(r.pos) - result.position = decodeInt(r) - else: - result.position = 0 - # BUGFIX: this may have been misused as reader index! - if r.s[r.pos] == '`': - inc(r.pos) - result.offset = decodeInt(r) - else: - result.offset = - 1 - decodeLoc(r, result.loc, result.info) - result.annex = decodeLib(r, info) - -proc decodeInt(r: PRodReader): int = - # base 190 numbers - var i = r.pos - var sign = - 1 - assert(r.s[i] in {'a'..'z', 'A'..'Z', '0'..'9', '-', '\x80'..'\xFF'}) - if r.s[i] == '-': - inc(i) - sign = 1 - result = 0 - while true: - case r.s[i] - of '0'..'9': result = result * 190 - (ord(r.s[i]) - ord('0')) - of 'a'..'z': result = result * 190 - (ord(r.s[i]) - ord('a') + 10) - of 'A'..'Z': result = result * 190 - (ord(r.s[i]) - ord('A') + 36) - of '\x80'..'\xFF': result = result * 190 - (ord(r.s[i]) - 128 + 62) - else: break - inc(i) - result = result * sign - r.pos = i - -proc decodeBInt(r: PRodReader): biggestInt = - var i = r.pos - var sign: biggestInt = - 1 - assert(r.s[i] in {'a'..'z', 'A'..'Z', '0'..'9', '-', '\x80'..'\xFF'}) - if r.s[i] == '-': - inc(i) - sign = 1 - result = 0 - while true: - case r.s[i] - of '0'..'9': result = result * 190 - (ord(r.s[i]) - ord('0')) - of 'a'..'z': result = result * 190 - (ord(r.s[i]) - ord('a') + 10) - of 'A'..'Z': result = result * 190 - (ord(r.s[i]) - ord('A') + 36) - of '\x80'..'\xFF': result = result * 190 - (ord(r.s[i]) - 128 + 62) - else: break - inc(i) - result = result * sign - r.pos = i - -proc hexChar(c: char, xi: var int) = - case c - of '0'..'9': xi = (xi shl 4) or (ord(c) - ord('0')) - of 'a'..'f': xi = (xi shl 4) or (ord(c) - ord('a') + 10) - of 'A'..'F': xi = (xi shl 4) or (ord(c) - ord('A') + 10) - else: nil - -proc decode(r: PRodReader): string = - var i = r.pos - result = "" - while true: - case r.s[i] - of '\\': - inc(i, 3) - var xi = 0 - hexChar(r.s[i-2], xi) - hexChar(r.s[i-1], xi) - add(result, chr(xi)) - of 'a'..'z', 'A'..'Z', '0'..'9', '_': - add(result, r.s[i]) - inc(i) - else: break - r.pos = i - -proc skipSection(r: PRodReader) = - if r.s[r.pos] == ':': - while r.s[r.pos] > '\x0A': inc(r.pos) - elif r.s[r.pos] == '(': - var c = 0 # count () pairs - inc(r.pos) - while true: - case r.s[r.pos] - of '\x0A': inc(r.line) - of '(': inc(c) - of ')': - if c == 0: - inc(r.pos) - break - elif c > 0: - dec(c) - of '\0': break # end of file - else: nil - inc(r.pos) - else: - InternalError("skipSection " & $r.line) - -proc rdWord(r: PRodReader): string = - result = "" - while r.s[r.pos] in {'A'..'Z', '_', 'a'..'z', '0'..'9'}: - add(result, r.s[r.pos]) - inc(r.pos) - -proc newStub(r: PRodReader, name: string, id: int): PSym = - new(result) - result.kind = skStub - result.id = id - result.name = getIdent(name) - result.position = r.readerIndex - setID(id) #MessageOut(result.name.s); - if debugIds: registerID(result) - -proc processInterf(r: PRodReader, module: PSym) = - if r.interfIdx == 0: InternalError("processInterf") - r.pos = r.interfIdx - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - var w = decode(r) - inc(r.pos) - var key = decodeInt(r) - inc(r.pos) # #10 - var s = newStub(r, w, key) - s.owner = module - StrTableAdd(module.tab, s) - IdTablePut(r.syms, s, s) - -proc processCompilerProcs(r: PRodReader, module: PSym) = - if r.compilerProcsIdx == 0: InternalError("processCompilerProcs") - r.pos = r.compilerProcsIdx - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - var w = decode(r) - inc(r.pos) - var key = decodeInt(r) - inc(r.pos) # #10 - var s = PSym(IdTableGet(r.syms, key)) - if s == nil: - s = newStub(r, w, key) - s.owner = module - IdTablePut(r.syms, s, s) - StrTableAdd(rodCompilerProcs, s) - -proc processIndex(r: PRodReader, idx: var TIndex) = - var key, val, tmp: int - inc(r.pos, 2) # skip "(\10" - inc(r.line) - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - tmp = decodeInt(r) - if r.s[r.pos] == ' ': - inc(r.pos) - key = idx.lastIdxKey + tmp - val = decodeInt(r) + idx.lastIdxVal - else: - key = idx.lastIdxKey + 1 - val = tmp + idx.lastIdxVal - IITablePut(idx.tab, key, val) - idx.lastIdxKey = key - idx.lastIdxVal = val - setID(key) # ensure that this id will not be used - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - if r.s[r.pos] == ')': inc(r.pos) - -proc processRodFile(r: PRodReader, crc: TCrc32) = - var - w: string - d, L, inclCrc: int - while r.s[r.pos] != '\0': - var section = rdWord(r) - if r.reason != rrNone: - break # no need to process this file further - case section - of "CRC": - inc(r.pos) # skip ':' - if int(crc) != decodeInt(r): r.reason = rrCrcChange - of "ID": - inc(r.pos) # skip ':' - r.moduleID = decodeInt(r) - setID(r.moduleID) - of "OPTIONS": - inc(r.pos) # skip ':' - r.options = cast[TOptions](int32(decodeInt(r))) - if options.gOptions != r.options: r.reason = rrOptions - of "DEFINES": - inc(r.pos) # skip ':' - d = 0 - while r.s[r.pos] > '\x0A': - w = decode(r) - inc(d) - if not condsyms.isDefined(getIdent(w)): - r.reason = rrDefines #MessageOut('not defined, but should: ' + w); - if r.s[r.pos] == ' ': inc(r.pos) - if (d != countDefinedSymbols()): r.reason = rrDefines - of "FILES": - inc(r.pos, 2) # skip "(\10" - inc(r.line) - L = 0 - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - setlen(r.files, L + 1) - r.files[L] = decode(r) - inc(r.pos) # skip #10 - inc(r.line) - inc(L) - if r.s[r.pos] == ')': inc(r.pos) - of "INCLUDES": - inc(r.pos, 2) # skip "(\10" - inc(r.line) - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - w = r.files[decodeInt(r)] - inc(r.pos) # skip ' ' - inclCrc = decodeInt(r) - if r.reason == rrNone: - if not ExistsFile(w) or (inclCrc != int(crcFromFile(w))): - r.reason = rrInclDeps - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - if r.s[r.pos] == ')': inc(r.pos) - of "DEPS": - inc(r.pos) # skip ':' - L = 0 - while (r.s[r.pos] > '\x0A'): - setlen(r.modDeps, L + 1) - r.modDeps[L] = r.files[decodeInt(r)] - inc(L) - if r.s[r.pos] == ' ': inc(r.pos) - of "INTERF": - r.interfIdx = r.pos + 2 - skipSection(r) - of "COMPILERPROCS": - r.compilerProcsIdx = r.pos + 2 - skipSection(r) - of "INDEX": - processIndex(r, r.index) - of "IMPORTS": - processIndex(r, r.imports) - of "CONVERTERS": - r.convertersIdx = r.pos + 1 - skipSection(r) - of "DATA": - r.dataIdx = r.pos + 2 # "(\10" - # We do not read the DATA section here! We read the needed objects on - # demand. - skipSection(r) - of "INIT": - r.initIdx = r.pos + 2 # "(\10" - skipSection(r) - of "CGEN": - r.cgenIdx = r.pos + 2 - skipSection(r) - else: - MsgWriteln("skipping section: " & $r.pos) - skipSection(r) - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - -proc newRodReader(modfilename: string, crc: TCrc32, - readerIndex: int): PRodReader = - new(result) - result.files = @[] - result.modDeps = @[] - var r = result - r.reason = rrNone - r.pos = 0 - r.line = 1 - r.readerIndex = readerIndex - r.filename = modfilename - InitIdTable(r.syms) - r.s = readFile(modfilename) - if startsWith(r.s, "NIM:"): - initIITable(r.index.tab) - initIITable(r.imports.tab) # looks like a ROD file - inc(r.pos, 4) - var version = "" - while not (r.s[r.pos] in {'\0', '\x0A'}): - add(version, r.s[r.pos]) - inc(r.pos) - if r.s[r.pos] == '\x0A': inc(r.pos) - if version == FileVersion: - # since ROD files are only for caching, no backwarts compatibility is - # needed - processRodFile(r, crc) - else: - result = nil - else: - result = nil - -proc rrGetType(r: PRodReader, id: int, info: TLineInfo): PType = - result = PType(IdTableGet(gTypeTable, id)) - if result == nil: - # load the type: - var oldPos = r.pos - var d = IITableGet(r.index.tab, id) - if d == invalidKey: InternalError(info, "rrGetType") - r.pos = d + r.dataIdx - result = decodeType(r, info) - r.pos = oldPos - -type - TFileModuleRec{.final.} = object - filename*: string - reason*: TReasonForRecompile - rd*: PRodReader - crc*: TCrc32 - - TFileModuleMap = seq[TFileModuleRec] - -var gMods: TFileModuleMap = @[] - -proc decodeSymSafePos(rd: PRodReader, offset: int, info: TLineInfo): PSym = - # all compiled modules - if rd.dataIdx == 0: InternalError(info, "dataIdx == 0") - var oldPos = rd.pos - rd.pos = offset + rd.dataIdx - result = decodeSym(rd, info) - rd.pos = oldPos - -proc rrGetSym(r: PRodReader, id: int, info: TLineInfo): PSym = - result = PSym(IdTableGet(r.syms, id)) - if result == nil: - # load the symbol: - var d = IITableGet(r.index.tab, id) - if d == invalidKey: - var moduleID = IiTableGet(r.imports.tab, id) - if moduleID < 0: - InternalError(info, - "missing from both indexes: +" & ropeToStr(encodeInt(id))) - # find the reader with the correct moduleID: - for i in countup(0, high(gMods)): - var rd = gMods[i].rd - if (rd != nil): - if (rd.moduleID == moduleID): - d = IITableGet(rd.index.tab, id) - if d != invalidKey: - result = decodeSymSafePos(rd, d, info) - break - else: - InternalError(info, "rrGetSym: no reader found: +" & - ropeToStr(encodeInt(id))) - else: - #if IiTableGet(rd.index.tab, id) <> invalidKey then - # XXX expensive check! - #InternalError(info, - #'id found in other module: +' + ropeToStr(encodeInt(id))) - else: - # own symbol: - result = decodeSymSafePos(r, d, info) - if (result != nil) and (result.kind == skStub): loadStub(result) - -proc loadInitSection(r: PRodReader): PNode = - if (r.initIdx == 0) or (r.dataIdx == 0): InternalError("loadInitSection") - var oldPos = r.pos - r.pos = r.initIdx - result = newNode(nkStmtList) - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - var d = decodeInt(r) - inc(r.pos) # #10 - var p = r.pos - r.pos = d + r.dataIdx - addSon(result, decodeNode(r, UnknownLineInfo())) - r.pos = p - r.pos = oldPos - -proc loadConverters(r: PRodReader) = - # We have to ensure that no exported converter is a stub anymore. - if (r.convertersIdx == 0) or (r.dataIdx == 0): - InternalError("importConverters") - r.pos = r.convertersIdx - while (r.s[r.pos] > '\x0A'): - var d = decodeInt(r) - discard rrGetSym(r, d, UnknownLineInfo()) - if r.s[r.pos] == ' ': inc(r.pos) - -proc getModuleIdx(filename: string): int = - for i in countup(0, high(gMods)): - if sameFile(gMods[i].filename, filename): return i - result = len(gMods) - setlen(gMods, result + 1) - -proc checkDep(filename: string): TReasonForRecompile = - var idx = getModuleIdx(filename) - if gMods[idx].reason != rrEmpty: - # reason has already been computed for this module: - return gMods[idx].reason - var crc: TCrc32 = crcFromFile(filename) - gMods[idx].reason = rrNone # we need to set it here to avoid cycles - gMods[idx].filename = filename - gMods[idx].crc = crc - result = rrNone - var r: PRodReader = nil - var rodfile = toGeneratedFile(filename, RodExt) - if ExistsFile(rodfile): - r = newRodReader(rodfile, crc, idx) - if r == nil: - result = rrRodInvalid - else: - result = r.reason - if result == rrNone: - # check modules it depends on - # NOTE: we need to process the entire module graph so that no ID will - # be used twice! However, compilation speed does not suffer much from - # this, since results are cached. - var res = checkDep(options.libpath / addFileExt("system", nimExt)) - if res != rrNone: result = rrModDeps - for i in countup(0, high(r.modDeps)): - res = checkDep(r.modDeps[i]) - if res != rrNone: - result = rrModDeps - # we cannot break here, because of side-effects of `checkDep` - else: - result = rrRodDoesNotExist - if (result != rrNone) and (gVerbosity > 0): - MsgWriteln(`%`(reasonToFrmt[result], [filename])) - if (result != rrNone) or (optForceFullMake in gGlobalOptions): - # recompilation is necessary: - r = nil - gMods[idx].rd = r - gMods[idx].reason = result # now we know better - -proc handleSymbolFile(module: PSym, filename: string): PRodReader = - if not (optSymbolFiles in gGlobalOptions): - module.id = getID() - return nil - discard checkDep(filename) - var idx = getModuleIdx(filename) - if gMods[idx].reason == rrEmpty: InternalError("handleSymbolFile") - result = gMods[idx].rd - if result != nil: - module.id = result.moduleID - IdTablePut(result.syms, module, module) - processInterf(result, module) - processCompilerProcs(result, module) - loadConverters(result) - else: - module.id = getID() - -proc GetCRC(filename: string): TCrc32 = - var idx = getModuleIdx(filename) - result = gMods[idx].crc - -proc loadStub(s: PSym) = - if s.kind != skStub: - InternalError("loadStub") #MessageOut('loading stub: ' + s.name.s); - var rd = gMods[s.position].rd - var theId = s.id # used for later check - var d = IITableGet(rd.index.tab, s.id) - if d == invalidKey: InternalError("loadStub: invalid key") - var rs = decodeSymSafePos(rd, d, UnknownLineInfo()) - if rs != s: - InternalError(rs.info, "loadStub: wrong symbol") - elif rs.id != theId: - InternalError(rs.info, "loadStub: wrong ID") - #MessageOut('loaded stub: ' + s.name.s); - -InitIdTable(gTypeTable) -InitStrTable(rodCompilerProcs) diff --git a/rod/rodutils.nim b/rod/rodutils.nim deleted file mode 100755 index dad5d679f..000000000 --- a/rod/rodutils.nim +++ /dev/null @@ -1,27 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Utilities for the compiler. Aim is to reduce the coupling between -## the compiler and the evolving stdlib. - -proc c_sprintf(buf, frmt: cstring) {.importc: "sprintf", nodecl, varargs.} - -proc ToStrMaxPrecision*(f: BiggestFloat): string = - if f != f: - result = "NAN" - elif f == 0.0: - result = "0.0" - elif f == 0.5 * f: - if f > 0.0: result = "INF" - else: result = "-INF" - else: - var buf: array [0..80, char] - c_sprintf(buf, "%#.16e", f) - result = $buf - diff --git a/rod/rodwrite.nim b/rod/rodwrite.nim deleted file mode 100755 index ea427dce9..000000000 --- a/rod/rodwrite.nim +++ /dev/null @@ -1,449 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module is responsible for writing of rod files. Note that writing of -# rod files is a pass, reading of rod files is not! This is why reading and -# writing of rod files is split into two different modules. - -import - os, options, strutils, nversion, ast, astalgo, msgs, platform, condsyms, - ropes, idents, crc, rodread, passes, importer - -proc rodwritePass*(): TPass -# implementation - -type - TRodWriter = object of TPassContext - module*: PSym - crc*: TCrc32 - options*: TOptions - defines*: PRope - inclDeps*: PRope - modDeps*: PRope - interf*: PRope - compilerProcs*: PRope - index*, imports*: TIndex - converters*: PRope - init*: PRope - data*: PRope - filename*: string - sstack*: TSymSeq # a stack of symbols to process - tstack*: TTypeSeq # a stack of types to process - files*: TStringSeq - - PRodWriter = ref TRodWriter - -proc newRodWriter(modfilename: string, crc: TCrc32, module: PSym): PRodWriter -proc addModDep(w: PRodWriter, dep: string) -proc addInclDep(w: PRodWriter, dep: string) -proc addInterfaceSym(w: PRodWriter, s: PSym) -proc addStmt(w: PRodWriter, n: PNode) -proc writeRod(w: PRodWriter) -proc encodeStr(w: PRodWriter, s: string): PRope = - result = encode(s) - -proc processStacks(w: PRodWriter) - -proc getDefines(): PRope = - var it: TTabIter - var s = InitTabIter(it, gSymbols) - result = nil - while s != nil: - if s.position == 1: - if result != nil: app(result, " ") - app(result, s.name.s) - s = nextIter(it, gSymbols) - -proc fileIdx(w: PRodWriter, filename: string): int = - for i in countup(0, high(w.files)): - if w.files[i] == filename: - return i - result = len(w.files) - setlen(w.files, result + 1) - w.files[result] = filename - -proc newRodWriter(modfilename: string, crc: TCrc32, module: PSym): PRodWriter = - new(result) - result.sstack = @[] - result.tstack = @[] - InitIITable(result.index.tab) - InitIITable(result.imports.tab) - result.filename = modfilename - result.crc = crc - result.module = module - result.defines = getDefines() - result.options = options.gOptions - result.files = @[] - -proc addModDep(w: PRodWriter, dep: string) = - if w.modDeps != nil: app(w.modDeps, " ") - app(w.modDeps, encodeInt(fileIdx(w, dep))) - -const - rodNL = "\x0A" - -proc addInclDep(w: PRodWriter, dep: string) = - app(w.inclDeps, encodeInt(fileIdx(w, dep))) - app(w.inclDeps, " ") - app(w.inclDeps, encodeInt(crcFromFile(dep))) - app(w.inclDeps, rodNL) - -proc pushType(w: PRodWriter, t: PType) = - # check so that the stack does not grow too large: - if IiTableGet(w.index.tab, t.id) == invalidKey: - var L = len(w.tstack) - setlen(w.tstack, L + 1) - w.tstack[L] = t - -proc pushSym(w: PRodWriter, s: PSym) = - # check so that the stack does not grow too large: - if IiTableGet(w.index.tab, s.id) == invalidKey: - var L = len(w.sstack) - setlen(w.sstack, L + 1) - w.sstack[L] = s - -proc encodeNode(w: PRodWriter, fInfo: TLineInfo, n: PNode): PRope = - if n == nil: - # nil nodes have to be stored too: - return toRope("()") - result = toRope("(") - app(result, encodeInt(ord(n.kind))) - # we do not write comments for now - # Line information takes easily 20% or more of the filesize! Therefore we - # omit line information if it is the same as the father's line information: - if (finfo.fileIndex != n.info.fileIndex): - appf(result, "?$1,$2,$3", [encodeInt(n.info.col), encodeInt(n.info.line), - encodeInt(fileIdx(w, toFilename(n.info)))]) - elif (finfo.line != n.info.line): - appf(result, "?$1,$2", [encodeInt(n.info.col), encodeInt(n.info.line)]) - elif (finfo.col != n.info.col): - appf(result, "?$1", [encodeInt(n.info.col)]) - # No need to output the file index, as this is the serialization of one - # file. - var f = n.flags * PersistentNodeFlags - if f != {}: appf(result, "$$$1", [encodeInt(cast[int32](f))]) - if n.typ != nil: - appf(result, "^$1", [encodeInt(n.typ.id)]) - pushType(w, n.typ) - case n.kind - of nkCharLit..nkInt64Lit: - if n.intVal != 0: appf(result, "!$1", [encodeInt(n.intVal)]) - of nkFloatLit..nkFloat64Lit: - if n.floatVal != 0.0: appf(result, "!$1", [encodeStr(w, $(n.floatVal))]) - of nkStrLit..nkTripleStrLit: - if n.strVal != "": appf(result, "!$1", [encodeStr(w, n.strVal)]) - of nkIdent: - appf(result, "!$1", [encodeStr(w, n.ident.s)]) - of nkSym: - appf(result, "!$1", [encodeInt(n.sym.id)]) - pushSym(w, n.sym) - else: - for i in countup(0, sonsLen(n) - 1): - app(result, encodeNode(w, n.info, n.sons[i])) - app(result, ")") - -proc encodeLoc(w: PRodWriter, loc: TLoc): PRope = - result = nil - if loc.k != low(loc.k): app(result, encodeInt(ord(loc.k))) - if loc.s != low(loc.s): appf(result, "*$1", [encodeInt(ord(loc.s))]) - if loc.flags != {}: appf(result, "$$$1", [encodeInt(cast[int32](loc.flags))]) - if loc.t != nil: - appf(result, "^$1", [encodeInt(loc.t.id)]) - pushType(w, loc.t) - if loc.r != nil: appf(result, "!$1", [encodeStr(w, ropeToStr(loc.r))]) - if loc.a != 0: appf(result, "?$1", [encodeInt(loc.a)]) - if result != nil: result = ropef("<$1>", [result]) - -proc encodeType(w: PRodWriter, t: PType): PRope = - if t == nil: - # nil nodes have to be stored too: - return toRope("[]") - result = nil - if t.kind == tyForward: InternalError("encodeType: tyForward") - app(result, encodeInt(ord(t.kind))) - appf(result, "+$1", [encodeInt(t.id)]) - if t.n != nil: app(result, encodeNode(w, UnknownLineInfo(), t.n)) - if t.flags != {}: appf(result, "$$$1", [encodeInt(cast[int32](t.flags))]) - if t.callConv != low(t.callConv): - appf(result, "?$1", [encodeInt(ord(t.callConv))]) - if t.owner != nil: - appf(result, "*$1", [encodeInt(t.owner.id)]) - pushSym(w, t.owner) - if t.sym != nil: - appf(result, "&$1", [encodeInt(t.sym.id)]) - pushSym(w, t.sym) - if t.size != - 1: appf(result, "/$1", [encodeInt(t.size)]) - if t.align != 2: appf(result, "=$1", [encodeInt(t.align)]) - if t.containerID != 0: appf(result, "@$1", [encodeInt(t.containerID)]) - app(result, encodeLoc(w, t.loc)) - for i in countup(0, sonsLen(t) - 1): - if t.sons[i] == nil: - app(result, "^()") - else: - appf(result, "^$1", [encodeInt(t.sons[i].id)]) - pushType(w, t.sons[i]) - -proc encodeLib(w: PRodWriter, lib: PLib, info: TLineInfo): PRope = - result = nil - appf(result, "|$1", [encodeInt(ord(lib.kind))]) - appf(result, "|$1", [encodeStr(w, ropeToStr(lib.name))]) - appf(result, "|$1", [encodeNode(w, info, lib.path)]) - -proc encodeSym(w: PRodWriter, s: PSym): PRope = - var - codeAst: PNode - col, line: PRope - codeAst = nil - if s == nil: - # nil nodes have to be stored too: - return toRope("{}") - result = nil - app(result, encodeInt(ord(s.kind))) - appf(result, "+$1", [encodeInt(s.id)]) - appf(result, "&$1", [encodeStr(w, s.name.s)]) - if s.typ != nil: - appf(result, "^$1", [encodeInt(s.typ.id)]) - pushType(w, s.typ) - if s.info.col == int16(- 1): col = nil - else: col = encodeInt(s.info.col) - if s.info.line == int16(- 1): line = nil - else: line = encodeInt(s.info.line) - appf(result, "?$1,$2,$3", - [col, line, encodeInt(fileIdx(w, toFilename(s.info)))]) - if s.owner != nil: - appf(result, "*$1", [encodeInt(s.owner.id)]) - pushSym(w, s.owner) - if s.flags != {}: appf(result, "$$$1", [encodeInt(cast[int32](s.flags))]) - if s.magic != mNone: appf(result, "@$1", [encodeInt(ord(s.magic))]) - if (s.ast != nil): - if not astNeeded(s): - codeAst = s.ast.sons[codePos] - s.ast.sons[codePos] = nil - app(result, encodeNode(w, s.info, s.ast)) - if codeAst != nil: - s.ast.sons[codePos] = codeAst - if s.options != w.options: - appf(result, "!$1", [encodeInt(cast[int32](s.options))]) - if s.position != 0: appf(result, "%$1", [encodeInt(s.position)]) - if s.offset != - 1: appf(result, "`$1", [encodeInt(s.offset)]) - app(result, encodeLoc(w, s.loc)) - if s.annex != nil: app(result, encodeLib(w, s.annex, s.info)) - -proc addToIndex(w: var TIndex, key, val: int) = - if key - w.lastIdxKey == 1: - # we do not store a key-diff of 1 to safe space - app(w.r, encodeInt(val - w.lastIdxVal)) - app(w.r, rodNL) - else: - appf(w.r, "$1 $2" & rodNL, - [encodeInt(key - w.lastIdxKey), encodeInt(val - w.lastIdxVal)]) - w.lastIdxKey = key - w.lastIdxVal = val - IiTablePut(w.tab, key, val) - -var debugWritten: TIntSet - -proc symStack(w: PRodWriter) = - var - i, L: int - s, m: PSym - i = 0 - while i < len(w.sstack): - s = w.sstack[i] - if IiTableGet(w.index.tab, s.id) == invalidKey: - m = getModule(s) - if m == nil: InternalError("symStack: module nil: " & s.name.s) - if (m.id == w.module.id) or (sfFromGeneric in s.flags): - # put definition in here - L = ropeLen(w.data) - addToIndex(w.index, s.id, L) #intSetIncl(debugWritten, s.id); - app(w.data, encodeSym(w, s)) - app(w.data, rodNL) - if sfInInterface in s.flags: - appf(w.interf, "$1 $2" & rodNL, [encode(s.name.s), encodeInt(s.id)]) - if sfCompilerProc in s.flags: - appf(w.compilerProcs, "$1 $2" & rodNL, - [encode(s.name.s), encodeInt(s.id)]) - if s.kind == skConverter: - if w.converters != nil: app(w.converters, " ") - app(w.converters, encodeInt(s.id)) - elif IiTableGet(w.imports.tab, s.id) == invalidKey: - addToIndex(w.imports, s.id, m.id) #if not IntSetContains(debugWritten, s.id) then begin - # MessageOut(w.filename); - # debug(s.owner); - # debug(s); - # InternalError('BUG!!!!'); - #end - inc(i) - setlen(w.sstack, 0) - -proc typeStack(w: PRodWriter) = - var i = 0 - while i < len(w.tstack): - if IiTableGet(w.index.tab, w.tstack[i].id) == invalidKey: - var L = ropeLen(w.data) - addToIndex(w.index, w.tstack[i].id, L) - app(w.data, encodeType(w, w.tstack[i])) - app(w.data, rodNL) - inc(i) - setlen(w.tstack, 0) - -proc processStacks(w: PRodWriter) = - while (len(w.tstack) > 0) or (len(w.sstack) > 0): - symStack(w) - typeStack(w) - -proc rawAddInterfaceSym(w: PRodWriter, s: PSym) = - pushSym(w, s) - processStacks(w) - -proc addInterfaceSym(w: PRodWriter, s: PSym) = - if w == nil: return - if {sfInInterface, sfCompilerProc} * s.flags != {}: - rawAddInterfaceSym(w, s) - -proc addStmt(w: PRodWriter, n: PNode) = - app(w.init, encodeInt(ropeLen(w.data))) - app(w.init, rodNL) - app(w.data, encodeNode(w, UnknownLineInfo(), n)) - app(w.data, rodNL) - processStacks(w) - -proc writeRod(w: PRodWriter) = - processStacks(w) # write header: - var content = toRope("NIM:") - app(content, toRope(FileVersion)) - app(content, rodNL) - app(content, toRope("ID:")) - app(content, encodeInt(w.module.id)) - app(content, rodNL) - app(content, toRope("CRC:")) - app(content, encodeInt(w.crc)) - app(content, rodNL) - app(content, toRope("OPTIONS:")) - app(content, encodeInt(cast[int32](w.options))) - app(content, rodNL) - app(content, toRope("DEFINES:")) - app(content, w.defines) - app(content, rodNL) - app(content, toRope("FILES(" & rodNL)) - for i in countup(0, high(w.files)): - app(content, encode(w.files[i])) - app(content, rodNL) - app(content, toRope(')' & rodNL)) - app(content, toRope("INCLUDES(" & rodNL)) - app(content, w.inclDeps) - app(content, toRope(')' & rodNL)) - app(content, toRope("DEPS:")) - app(content, w.modDeps) - app(content, rodNL) - app(content, toRope("INTERF(" & rodNL)) - app(content, w.interf) - app(content, toRope(')' & rodNL)) - app(content, toRope("COMPILERPROCS(" & rodNL)) - app(content, w.compilerProcs) - app(content, toRope(')' & rodNL)) - app(content, toRope("INDEX(" & rodNL)) - app(content, w.index.r) - app(content, toRope(')' & rodNL)) - app(content, toRope("IMPORTS(" & rodNL)) - app(content, w.imports.r) - app(content, toRope(')' & rodNL)) - app(content, toRope("CONVERTERS:")) - app(content, w.converters) - app(content, toRope(rodNL)) - app(content, toRope("INIT(" & rodNL)) - app(content, w.init) - app(content, toRope(')' & rodNL)) - app(content, toRope("DATA(" & rodNL)) - app(content, w.data) - app(content, toRope(')' & rodNL)) - #MessageOut('interf ' + ToString(ropeLen(w.interf))); - #MessageOut('index ' + ToString(ropeLen(w.indexRope))); - #MessageOut('init ' + ToString(ropeLen(w.init))); - #MessageOut('data ' + ToString(ropeLen(w.data))); - writeRope(content, completeGeneratedFilePath(changeFileExt(w.filename, "rod"))) - -proc process(c: PPassContext, n: PNode): PNode = - result = n - if c == nil: return - var w = PRodWriter(c) - case n.kind - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): discard process(c, n.sons[i]) - of nkTemplateDef, nkMacroDef: - var s = n.sons[namePos].sym - addInterfaceSym(w, s) - of nkProcDef, nkMethodDef, nkIteratorDef, nkConverterDef: - var s = n.sons[namePos].sym - if s == nil: InternalError(n.info, "rodwrite.process") - if (n.sons[codePos] != nil) or (s.magic != mNone) or - not (sfForward in s.flags): - addInterfaceSym(w, s) - of nkVarSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.kind != nkIdentDefs: InternalError(a.info, "rodwrite.process") - addInterfaceSym(w, a.sons[0].sym) - of nkConstSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.kind != nkConstDef: InternalError(a.info, "rodwrite.process") - addInterfaceSym(w, a.sons[0].sym) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.sons[0].kind != nkSym: InternalError(a.info, "rodwrite.process") - var s = a.sons[0].sym - addInterfaceSym(w, s) - # this takes care of enum fields too - # Note: The check for ``s.typ.kind = tyEnum`` is wrong for enum - # type aliasing! Otherwise the same enum symbol would be included - # several times! - # - # if (a.sons[2] <> nil) and (a.sons[2].kind = nkEnumTy) then begin - # a := s.typ.n; - # for j := 0 to sonsLen(a)-1 do - # addInterfaceSym(w, a.sons[j].sym); - # end - of nkImportStmt: - for i in countup(0, sonsLen(n) - 1): addModDep(w, getModuleFile(n.sons[i])) - addStmt(w, n) - of nkFromStmt: - addModDep(w, getModuleFile(n.sons[0])) - addStmt(w, n) - of nkIncludeStmt: - for i in countup(0, sonsLen(n) - 1): addInclDep(w, getModuleFile(n.sons[i])) - of nkPragma: - addStmt(w, n) - else: - nil - -proc myOpen(module: PSym, filename: string): PPassContext = - if module.id < 0: InternalError("rodwrite: module ID not set") - var w = newRodWriter(filename, rodread.GetCRC(filename), module) - rawAddInterfaceSym(w, module) - result = w - -proc myClose(c: PPassContext, n: PNode): PNode = - var w = PRodWriter(c) - writeRod(w) - result = n - -proc rodwritePass(): TPass = - initPass(result) - if optSymbolFiles in gGlobalOptions: - result.open = myOpen - result.close = myClose - result.process = process - -IntSetInit(debugWritten) diff --git a/rod/ropes.nim b/rod/ropes.nim deleted file mode 100755 index 62fdca4ae..000000000 --- a/rod/ropes.nim +++ /dev/null @@ -1,400 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Ropes for the C code generator -# -# Ropes are a data structure that represents a very long string -# efficiently; especially concatenation is done in O(1) instead of O(N). -# Ropes make use a lazy evaluation: They are essentially concatenation -# trees that are only flattened when converting to a native Nimrod -# string or when written to disk. The empty string is represented by a -# nil pointer. -# A little picture makes everything clear: -# -# "this string" & " is internally " & "represented as" -# -# con -- inner nodes do not contain raw data -# / \ -# / \ -# / \ -# con "represented as" -# / \ -# / \ -# / \ -# / \ -# / \ -#"this string" " is internally " -# -# Note that this is the same as: -# "this string" & (" is internally " & "represented as") -# -# con -# / \ -# / \ -# / \ -# "this string" con -# / \ -# / \ -# / \ -# / \ -# / \ -#" is internally " "represented as" -# -# The 'con' operator is associative! This does not matter however for -# the algorithms we use for ropes. -# -# Note that the left and right pointers are not needed for leafs. -# Leafs have relatively high memory overhead (~30 bytes on a 32 -# bit machines) and we produce many of them. This is why we cache and -# share leaves accross different rope trees. -# To cache them they are inserted in another tree, a splay tree for best -# performance. But for the caching tree we use the leaves' left and right -# pointers. -# - -import - msgs, strutils, platform, nhashes, crc - -const - CacheLeafs* = true - countCacheMisses* = False # see what our little optimization gives - -type - TFormatStr* = string # later we may change it to CString for better - # performance of the code generator (assignments - # copy the format strings - # though it is not necessary) - PRope* = ref TRope - TRope*{.acyclic.} = object of TObject # the empty rope is represented - # by nil to safe space - left*, right*: PRope - length*: int - data*: string # != nil if a leaf - - TRopeSeq* = seq[PRope] - -proc con*(a, b: PRope): PRope -proc con*(a: PRope, b: string): PRope -proc con*(a: string, b: PRope): PRope -proc con*(a: openarray[PRope]): PRope -proc app*(a: var PRope, b: PRope) -proc app*(a: var PRope, b: string) -proc prepend*(a: var PRope, b: PRope) -proc toRope*(s: string): PRope -proc toRope*(i: BiggestInt): PRope -proc ropeLen*(a: PRope): int -proc WriteRope*(head: PRope, filename: string) -proc writeRopeIfNotEqual*(r: PRope, filename: string): bool -proc ropeToStr*(p: PRope): string -proc ropef*(frmt: TFormatStr, args: openarray[PRope]): PRope -proc appf*(c: var PRope, frmt: TFormatStr, args: openarray[PRope]) -proc getCacheStats*(): string -proc RopeEqualsFile*(r: PRope, f: string): bool - # returns true if the rope r is the same as the contents of file f -proc RopeInvariant*(r: PRope): bool - # exported for debugging -# implementation - -proc ropeLen(a: PRope): int = - if a == nil: result = 0 - else: result = a.length - -proc newRope(data: string = nil): PRope = - new(result) - if data != nil: - result.length = len(data) - result.data = data - -var - cache: PRope # the root of the cache tree - misses, hits: int - N: PRope # dummy rope needed for splay algorithm - -proc getCacheStats(): string = - if hits + misses != 0: - result = "Misses: " & $(misses) & " total: " & $(hits + misses) & " quot: " & - $(toFloat(misses) / toFloat(hits + misses)) - else: - result = "" - -proc splay(s: string, tree: PRope, cmpres: var int): PRope = - var c: int - var t = tree - N.left = nil - N.right = nil # reset to nil - var le = N - var r = N - while true: - c = cmp(s, t.data) - if c < 0: - if (t.left != nil) and (s < t.left.data): - var y = t.left - t.left = y.right - y.right = t - t = y - if t.left == nil: break - r.left = t - r = t - t = t.left - elif c > 0: - if (t.right != nil) and (s > t.right.data): - var y = t.right - t.right = y.left - y.left = t - t = y - if t.right == nil: break - le.right = t - le = t - t = t.right - else: - break - cmpres = c - le.right = t.left - r.left = t.right - t.left = N.right - t.right = N.left - result = t - -proc insertInCache(s: string, tree: PRope): PRope = - # Insert i into the tree t, unless it's already there. - # Return a pointer to the resulting tree. - var t = tree - if t == nil: - result = newRope(s) - if countCacheMisses: inc(misses) - return - var cmp: int - t = splay(s, t, cmp) - if cmp == 0: - # We get here if it's already in the Tree - # Don't add it again - result = t - if countCacheMisses: inc(hits) - else: - if countCacheMisses: inc(misses) - result = newRope(s) - if cmp < 0: - result.left = t.left - result.right = t - t.left = nil - else: - # i > t.item: - result.right = t.right - result.left = t - t.right = nil - -proc RopeInvariant(r: PRope): bool = - if r == nil: - result = true - else: - result = true # - # if r.data <> snil then - # result := true - # else begin - # result := (r.left <> nil) and (r.right <> nil); - # if result then result := ropeInvariant(r.left); - # if result then result := ropeInvariant(r.right); - # end - -proc toRope(s: string): PRope = - if s == "": - result = nil - elif cacheLeafs: - result = insertInCache(s, cache) - cache = result - else: - result = newRope(s) - assert(RopeInvariant(result)) - -proc RopeSeqInsert(rs: var TRopeSeq, r: PRope, at: Natural) = - var length = len(rs) - if at > length: - setlen(rs, at + 1) - else: - setlen(rs, length + 1) # move old rope elements: - for i in countdown(length, at + 1): - rs[i] = rs[i - 1] # this is correct, I used pen and paper to validate it - rs[at] = r - -proc recRopeToStr(result: var string, resultLen: var int, p: PRope) = - if p == nil: - return # do not add to result - if (p.data == nil): - recRopeToStr(result, resultLen, p.left) - recRopeToStr(result, resultLen, p.right) - else: - CopyMem(addr(result[resultLen + 0]), addr(p.data[0]), p.length) - Inc(resultLen, p.length) - assert(resultLen <= len(result)) - -proc newRecRopeToStr(result: var string, resultLen: var int, r: PRope) = - var stack = @[r] - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it.data != nil) - CopyMem(addr(result[resultLen]), addr(it.data[0]), it.length) - Inc(resultLen, it.length) - assert(resultLen <= len(result)) - -proc ropeToStr(p: PRope): string = - if p == nil: - result = "" - else: - result = newString(p.length) - var resultLen = 0 - newRecRopeToStr(result, resultLen, p) - -proc con(a, b: PRope): PRope = - if a == nil: result = b - elif b == nil: result = a - else: - result = newRope() - result.length = a.length + b.length - result.left = a - result.right = b - -proc con(a: PRope, b: string): PRope = result = con(a, toRope(b)) -proc con(a: string, b: PRope): PRope = result = con(toRope(a), b) - -proc con(a: openarray[PRope]): PRope = - for i in countup(0, high(a)): result = con(result, a[i]) - -proc toRope(i: BiggestInt): PRope = result = toRope($i) -#proc toRopeF*(r: BiggestFloat): PRope = result = toRope($r) -proc app(a: var PRope, b: PRope) = a = con(a, b) -proc app(a: var PRope, b: string) = a = con(a, b) -proc prepend(a: var PRope, b: PRope) = a = con(b, a) - -proc writeRope*(f: var tfile, c: PRope) = - var stack = @[c] - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it != nil) - assert(it.data != nil) - write(f, it.data) - -proc WriteRope(head: PRope, filename: string) = - var f: tfile # we use a textfile for automatic buffer handling - if open(f, filename, fmWrite): - if head != nil: WriteRope(f, head) - close(f) - else: - rawMessage(errCannotOpenFile, filename) - -proc ropef(frmt: TFormatStr, args: openarray[PRope]): PRope = - var i = 0 - var length = len(frmt) - result = nil - var num = 0 - while i <= length - 1: - if frmt[i] == '$': - inc(i) # skip '$' - case frmt[i] - of '$': - app(result, "$") - inc(i) - of '#': - inc(i) - app(result, args[num]) - inc(num) - of '0'..'9': - var j = 0 - while true: - j = (j * 10) + Ord(frmt[i]) - ord('0') - inc(i) - if (i > length + 0 - 1) or not (frmt[i] in {'0'..'9'}): break - num = j - if j > high(args) + 1: - internalError("ropes: invalid format string $" & $(j)) - app(result, args[j - 1]) - of 'N', 'n': - app(result, tnl) - inc(i) - else: InternalError("ropes: invalid format string $" & frmt[i]) - var start = i - while (i <= length - 1): - if (frmt[i] != '$'): inc(i) - else: break - if i - 1 >= start: - app(result, copy(frmt, start, i - 1)) - assert(RopeInvariant(result)) - -proc appf(c: var PRope, frmt: TFormatStr, args: openarray[PRope]) = - app(c, ropef(frmt, args)) - -const - bufSize = 1024 # 1 KB is reasonable - -proc auxRopeEqualsFile(r: PRope, bin: var tfile, buf: Pointer): bool = - if (r.data != nil): - if r.length > bufSize: - internalError("ropes: token too long") - var readBytes = readBuffer(bin, buf, r.length) - result = (readBytes == r.length) and - equalMem(buf, addr(r.data[0]), r.length) # BUGFIX - else: - result = auxRopeEqualsFile(r.left, bin, buf) - if result: result = auxRopeEqualsFile(r.right, bin, buf) - -proc RopeEqualsFile(r: PRope, f: string): bool = - var bin: tfile - result = open(bin, f) - if not result: - return # not equal if file does not exist - var buf = alloc(BufSize) - result = auxRopeEqualsFile(r, bin, buf) - if result: - result = readBuffer(bin, buf, bufSize) == 0 # really at the end of file? - dealloc(buf) - close(bin) - -proc crcFromRopeAux(r: PRope, startVal: TCrc32): TCrc32 = - if r.data != nil: - result = startVal - for i in countup(0, len(r.data) - 1): - result = updateCrc32(r.data[i], result) - else: - result = crcFromRopeAux(r.left, startVal) - result = crcFromRopeAux(r.right, result) - -proc newCrcFromRopeAux(r: PRope, startVal: TCrc32): TCrc32 = - var stack: TRopeSeq = @[r] - result = startVal - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it.data != nil) - var i = 0 - var L = len(it.data) - while i < L: - result = updateCrc32(it.data[i], result) - inc(i) - -proc crcFromRope(r: PRope): TCrc32 = - result = newCrcFromRopeAux(r, initCrc32) - -proc writeRopeIfNotEqual(r: PRope, filename: string): bool = - # returns true if overwritten - var c: TCrc32 - c = crcFromFile(filename) - if c != crcFromRope(r): - writeRope(r, filename) - result = true - else: - result = false - -new(N) # init dummy node for splay algorithm diff --git a/rod/rst.nim b/rod/rst.nim deleted file mode 100755 index 85b0cf54e..000000000 --- a/rod/rst.nim +++ /dev/null @@ -1,1591 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements a *reStructuredText* parser. A large -# subset is provided. - -import - os, msgs, strutils, platform, nhashes, ropes, options - -type - TRstNodeKind* = enum - rnInner, # an inner node or a root - rnHeadline, # a headline - rnOverline, # an over- and underlined headline - rnTransition, # a transition (the ------------- <hr> thingie) - rnParagraph, # a paragraph - rnBulletList, # a bullet list - rnBulletItem, # a bullet item - rnEnumList, # an enumerated list - rnEnumItem, # an enumerated item - rnDefList, # a definition list - rnDefItem, # an item of a definition list consisting of ... - rnDefName, # ... a name part ... - rnDefBody, # ... and a body part ... - rnFieldList, # a field list - rnField, # a field item - rnFieldName, # consisting of a field name ... - rnFieldBody, # ... and a field body - rnOptionList, rnOptionListItem, rnOptionGroup, rnOption, rnOptionString, - rnOptionArgument, rnDescription, rnLiteralBlock, rnQuotedLiteralBlock, - rnLineBlock, # the | thingie - rnLineBlockItem, # sons of the | thing - rnBlockQuote, # text just indented - rnTable, rnGridTable, rnTableRow, rnTableHeaderCell, rnTableDataCell, - rnLabel, # used for footnotes and other things - rnFootnote, # a footnote - rnCitation, # similar to footnote - rnStandaloneHyperlink, rnHyperlink, rnRef, rnDirective, # a directive - rnDirArg, rnRaw, rnTitle, rnContents, rnImage, rnFigure, rnCodeBlock, - rnRawHtml, rnRawLatex, - rnContainer, # ``container`` directive - rnIndex, # index directve: - # .. index:: - # key - # * `file#id <file#id>`_ - # * `file#id <file#id>'_ - rnSubstitutionDef, # a definition of a substitution - rnGeneralRole, # Inline markup: - rnSub, rnSup, rnIdx, rnEmphasis, # "*" - rnStrongEmphasis, # "**" - rnInterpretedText, # "`" - rnInlineLiteral, # "``" - rnSubstitutionReferences, # "|" - rnLeaf # a leaf; the node's text field contains the - # leaf val - -type # the syntax tree of RST: - PRSTNode* = ref TRstNode - TRstNodeSeq* = seq[PRstNode] - TRSTNode*{.acyclic, final.} = object - kind*: TRstNodeKind - text*: string # valid for leafs in the AST; and the title of - # the document or the section - level*: int # valid for some node kinds - sons*: TRstNodeSeq # the node's sons - - -proc rstParse*(text: string, # the text to be parsed - skipPounds: bool, filename: string, # for error messages - line, column: int, hasToc: var bool): PRstNode -proc rsonsLen*(n: PRstNode): int -proc newRstNode*(kind: TRstNodeKind): PRstNode -proc newRstNode*(kind: TRstNodeKind, s: string): PRstNode -proc addSon*(father, son: PRstNode) -proc rstnodeToRefname*(n: PRstNode): string -proc addNodes*(n: PRstNode): string -proc getFieldValue*(n: PRstNode, fieldname: string): string -proc getArgument*(n: PRstNode): string - # index handling: -proc setIndexPair*(index, key, val: PRstNode) -proc sortIndex*(a: PRstNode) -proc clearIndex*(index: PRstNode, filename: string) -# implementation -# ----------------------------- scanner part -------------------------------- - -const - SymChars: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} - -type - TTokType = enum - tkEof, tkIndent, tkWhite, tkWord, tkAdornment, tkPunct, tkOther - TToken{.final.} = object # a RST token - kind*: TTokType # the type of the token - ival*: int # the indentation or parsed integer value - symbol*: string # the parsed symbol as string - line*, col*: int # line and column of the token - - TTokenSeq = seq[TToken] - TLexer = object of TObject - buf*: cstring - bufpos*: int - line*, col*, baseIndent*: int - skipPounds*: bool - - -proc getThing(L: var TLexer, tok: var TToken, s: TCharSet) = - tok.kind = tkWord - tok.line = L.line - tok.col = L.col - var pos = L.bufpos - while True: - add(tok.symbol, L.buf[pos]) - inc(pos) - if not (L.buf[pos] in s): break - inc(L.col, pos - L.bufpos) - L.bufpos = pos - -proc getAdornment(L: var TLexer, tok: var TToken) = - tok.kind = tkAdornment - tok.line = L.line - tok.col = L.col - var pos = L.bufpos - var c = L.buf[pos] - while True: - add(tok.symbol, L.buf[pos]) - inc(pos) - if L.buf[pos] != c: break - inc(L.col, pos - L.bufpos) - L.bufpos = pos - -proc getIndentAux(L: var TLexer, start: int): int = - var pos = start - var buf = L.buf - # skip the newline (but include it in the token!) - if buf[pos] == '\x0D': - if buf[pos + 1] == '\x0A': inc(pos, 2) - else: inc(pos) - elif buf[pos] == '\x0A': - inc(pos) - if L.skipPounds: - if buf[pos] == '#': inc(pos) - if buf[pos] == '#': inc(pos) - while True: - case buf[pos] - of ' ', '\x0B', '\x0C': - inc(pos) - inc(result) - of '\x09': - inc(pos) - result = result - (result mod 8) + 8 - else: - break # EndOfFile also leaves the loop - if buf[pos] == '\0': - result = 0 - elif (buf[pos] == '\x0A') or (buf[pos] == '\x0D'): - # look at the next line for proper indentation: - result = getIndentAux(L, pos) - L.bufpos = pos # no need to set back buf - -proc getIndent(L: var TLexer, tok: var TToken) = - inc(L.line) - tok.line = L.line - tok.col = 0 - tok.kind = tkIndent # skip the newline (but include it in the token!) - tok.ival = getIndentAux(L, L.bufpos) - L.col = tok.ival - tok.ival = max(tok.ival - L.baseIndent, 0) - tok.symbol = "\n" & repeatChar(tok.ival) - -proc rawGetTok(L: var TLexer, tok: var TToken) = - tok.symbol = "" - tok.ival = 0 - var c = L.buf[L.bufpos] - case c - of 'a'..'z', 'A'..'Z', '\x80'..'\xFF', '0'..'9': - getThing(L, tok, SymChars) - of ' ', '\x09', '\x0B', '\x0C': - getThing(L, tok, {' ', '\x09'}) - tok.kind = tkWhite - if L.buf[L.bufpos] in {'\x0D', '\x0A'}: - rawGetTok(L, tok) # ignore spaces before \n - of '\x0D', '\x0A': - getIndent(L, tok) - of '!', '\"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', - '/', ':', ';', '<', '=', '>', '?', '@', '[', '\\', ']', '^', '_', '`', '{', - '|', '}', '~': - getAdornment(L, tok) - if len(tok.symbol) <= 3: tok.kind = tkPunct - else: - tok.line = L.line - tok.col = L.col - if c == '\0': - tok.kind = tkEof - else: - tok.kind = tkOther - add(tok.symbol, c) - inc(L.bufpos) - inc(L.col) - tok.col = max(tok.col - L.baseIndent, 0) - -proc getTokens(buffer: string, skipPounds: bool, tokens: var TTokenSeq) = - var L: TLexer - var length = len(tokens) - L.buf = cstring(buffer) - L.line = 1 # skip UTF-8 BOM - if (L.buf[0] == '\xEF') and (L.buf[1] == '\xBB') and (L.buf[2] == '\xBF'): - inc(L.bufpos, 3) - L.skipPounds = skipPounds - if skipPounds: - if L.buf[L.bufpos] == '#': inc(L.bufpos) - if L.buf[L.bufpos] == '#': inc(L.bufpos) - L.baseIndent = 0 - while L.buf[L.bufpos] == ' ': - inc(L.bufpos) - inc(L.baseIndent) - while true: - inc(length) - setlen(tokens, length) - rawGetTok(L, tokens[length - 1]) - if tokens[length - 1].kind == tkEof: break - if tokens[0].kind == tkWhite: - # BUGFIX - tokens[0].ival = len(tokens[0].symbol) - tokens[0].kind = tkIndent - -proc addSon(father, son: PRstNode) = - add(father.sons, son) - -proc addSonIfNotNil(father, son: PRstNode) = - if son != nil: addSon(father, son) - -proc rsonsLen(n: PRstNode): int = - result = len(n.sons) - -proc newRstNode(kind: TRstNodeKind): PRstNode = - new(result) - result.sons = @[] - result.kind = kind - -proc newRstNode(kind: TRstNodeKind, s: string): PRstNode = - result = newRstNode(kind) - result.text = s - -proc lastSon*(n: PRstNode): PRstNode = - result = n.sons[len(n.sons)-1] - -type - TLevelMap = array[Char, int] - TSubstitution{.final.} = object - key*: string - value*: PRstNode - - TSharedState{.final.} = object - uLevel*, oLevel*: int # counters for the section levels - subs*: seq[TSubstitution] # substitutions - refs*: seq[TSubstitution] # references - underlineToLevel*: TLevelMap # Saves for each possible title adornment - # character its level in the - # current document. - # This is for single underline adornments. - overlineToLevel*: TLevelMap # Saves for each possible title adornment - # character its level in the current document. - # This is for over-underline adornments. - - PSharedState = ref TSharedState - TRstParser = object of TObject - idx*: int - tok*: TTokenSeq - s*: PSharedState - indentStack*: seq[int] - filename*: string - line*, col*: int - hasToc*: bool - - -proc newSharedState(): PSharedState = - new(result) - result.subs = @[] - result.refs = @[] - -proc tokInfo(p: TRstParser, tok: TToken): TLineInfo = - result = newLineInfo(p.filename, p.line + tok.line, p.col + tok.col) - -proc rstMessage(p: TRstParser, msgKind: TMsgKind, arg: string) = - GenericMessage(tokInfo(p, p.tok[p.idx]), msgKind, arg) - -proc rstMessage(p: TRstParser, msgKind: TMsgKind) = - GenericMessage(tokInfo(p, p.tok[p.idx]), msgKind, p.tok[p.idx].symbol) - -proc currInd(p: TRstParser): int = - result = p.indentStack[high(p.indentStack)] - -proc pushInd(p: var TRstParser, ind: int) = - add(p.indentStack, ind) - -proc popInd(p: var TRstParser) = - if len(p.indentStack) > 1: setlen(p.indentStack, len(p.indentStack) - 1) - -proc initParser(p: var TRstParser, sharedState: PSharedState) = - p.indentStack = @[0] - p.tok = @[] - p.idx = 0 - p.filename = "" - p.hasToc = false - p.col = 0 - p.line = 1 - p.s = sharedState - -proc addNodesAux(n: PRstNode, result: var string) = - if n.kind == rnLeaf: - add(result, n.text) - else: - for i in countup(0, rsonsLen(n) - 1): addNodesAux(n.sons[i], result) - -proc addNodes(n: PRstNode): string = - result = "" - addNodesAux(n, result) - -proc rstnodeToRefnameAux(n: PRstNode, r: var string, b: var bool) = - if n.kind == rnLeaf: - for i in countup(0, len(n.text) + 0 - 1): - case n.text[i] - of '0'..'9': - if b: - add(r, '-') - b = false - if len(r) == 0: add(r, 'Z') - add(r, n.text[i]) - of 'a'..'z': - if b: - add(r, '-') - b = false - add(r, n.text[i]) - of 'A'..'Z': - if b: - add(r, '-') - b = false - add(r, chr(ord(n.text[i]) - ord('A') + ord('a'))) - else: - if (len(r) > 0): b = true - else: - for i in countup(0, rsonsLen(n) - 1): rstnodeToRefnameAux(n.sons[i], r, b) - -proc rstnodeToRefname(n: PRstNode): string = - result = "" - var b = false - rstnodeToRefnameAux(n, result, b) - -proc findSub(p: var TRstParser, n: PRstNode): int = - var key = addNodes(n) - # the spec says: if no exact match, try one without case distinction: - for i in countup(0, high(p.s.subs)): - if key == p.s.subs[i].key: - return i - for i in countup(0, high(p.s.subs)): - if cmpIgnoreStyle(key, p.s.subs[i].key) == 0: - return i - result = - 1 - -proc setSub(p: var TRstParser, key: string, value: PRstNode) = - var length = len(p.s.subs) - for i in countup(0, length - 1): - if key == p.s.subs[i].key: - p.s.subs[i].value = value - return - setlen(p.s.subs, length + 1) - p.s.subs[length].key = key - p.s.subs[length].value = value - -proc setRef(p: var TRstParser, key: string, value: PRstNode) = - var length = len(p.s.refs) - for i in countup(0, length - 1): - if key == p.s.refs[i].key: - p.s.refs[i].value = value - rstMessage(p, warnRedefinitionOfLabel, key) - return - setlen(p.s.refs, length + 1) - p.s.refs[length].key = key - p.s.refs[length].value = value - -proc findRef(p: var TRstParser, key: string): PRstNode = - for i in countup(0, high(p.s.refs)): - if key == p.s.refs[i].key: - return p.s.refs[i].value - -proc cmpNodes(a, b: PRstNode): int = - assert(a.kind == rnDefItem) - assert(b.kind == rnDefItem) - var x = a.sons[0] - var y = b.sons[0] - result = cmpIgnoreStyle(addNodes(x), addNodes(y)) - -proc sortIndex(a: PRstNode) = - # we use shellsort here; fast and simple - assert(a.kind == rnDefList) - var N = rsonsLen(a) - var h = 1 - while true: - h = 3 * h + 1 - if h > N: break - while true: - h = h div 3 - for i in countup(h, N - 1): - var v = a.sons[i] - var j = i - while cmpNodes(a.sons[j - h], v) >= 0: - a.sons[j] = a.sons[j - h] - j = j - h - if j < h: break - a.sons[j] = v - if h == 1: break - -proc eqRstNodes(a, b: PRstNode): bool = - if a.kind != b.kind: return - if a.kind == rnLeaf: - result = a.text == b.text - else: - if rsonsLen(a) != rsonsLen(b): return - for i in countup(0, rsonsLen(a) - 1): - if not eqRstNodes(a.sons[i], b.sons[i]): return - result = true - -proc matchesHyperlink(h: PRstNode, filename: string): bool = - if h.kind == rnInner: # this may happen in broken indexes! - assert(rsonsLen(h) == 1) - result = matchesHyperlink(h.sons[0], filename) - elif h.kind == rnHyperlink: - var s = addNodes(h.sons[1]) - if startsWith(s, filename) and (s[len(filename)] == '#'): result = true - else: result = false - else: - result = false - -proc clearIndex(index: PRstNode, filename: string) = - var - k, items, lastItem: int - val: PRstNode - assert(index.kind == rnDefList) - for i in countup(0, rsonsLen(index) - 1): - assert(index.sons[i].sons[1].kind == rnDefBody) - val = index.sons[i].sons[1].sons[0] - if val.kind == rnInner: val = val.sons[0] - if val.kind == rnBulletList: - items = rsonsLen(val) - lastItem = - 1 # save the last valid item index - for j in countup(0, rsonsLen(val) - 1): - if val.sons[j] == nil: - dec(items) - elif matchesHyperlink(val.sons[j].sons[0], filename): - val.sons[j] = nil - dec(items) - else: - lastItem = j - if items == 1: - index.sons[i].sons[1].sons[0] = val.sons[lastItem].sons[0] - elif items == 0: - index.sons[i] = nil - elif matchesHyperlink(val, filename): - index.sons[i] = nil - k = 0 - for i in countup(0, rsonsLen(index) - 1): - if index.sons[i] != nil: - if k != i: index.sons[k] = index.sons[i] - inc(k) - setlen(index.sons, k) - -proc setIndexPair(index, key, val: PRstNode) = - var e, a, b: PRstNode - assert(index.kind == rnDefList) - assert(key.kind != rnDefName) - a = newRstNode(rnDefName) - addSon(a, key) - for i in countup(0, rsonsLen(index) - 1): - if eqRstNodes(index.sons[i].sons[0], a): - assert(index.sons[i].sons[1].kind == rnDefBody) - e = index.sons[i].sons[1].sons[0] - if e.kind != rnBulletList: - e = newRstNode(rnBulletList) - b = newRstNode(rnBulletItem) - addSon(b, index.sons[i].sons[1].sons[0]) - addSon(e, b) - index.sons[i].sons[1].sons[0] = e - b = newRstNode(rnBulletItem) - addSon(b, val) - addSon(e, b) - return # key already exists - e = newRstNode(rnDefItem) - assert(val.kind != rnDefBody) - b = newRstNode(rnDefBody) - addSon(b, val) - addSon(e, a) - addSon(e, b) - addSon(index, e) - -proc newLeaf(p: var TRstParser): PRstNode = - result = newRstNode(rnLeaf, p.tok[p.idx].symbol) - -proc getReferenceName(p: var TRstParser, endStr: string): PRstNode = - var res = newRstNode(rnInner) - while true: - case p.tok[p.idx].kind - of tkWord, tkOther, tkWhite: - addSon(res, newLeaf(p)) - of tkPunct: - if p.tok[p.idx].symbol == endStr: - inc(p.idx) - break - else: - addSon(res, newLeaf(p)) - else: - rstMessage(p, errXexpected, endStr) - break - inc(p.idx) - result = res - -proc untilEol(p: var TRstParser): PRstNode = - result = newRstNode(rnInner) - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): - addSon(result, newLeaf(p)) - inc(p.idx) - -proc expect(p: var TRstParser, tok: string) = - if p.tok[p.idx].symbol == tok: inc(p.idx) - else: rstMessage(p, errXexpected, tok) - -proc isInlineMarkupEnd(p: TRstParser, markup: string): bool = - result = p.tok[p.idx].symbol == markup - if not result: - return # Rule 3: - result = not (p.tok[p.idx - 1].kind in {tkIndent, tkWhite}) - if not result: - return # Rule 4: - result = (p.tok[p.idx + 1].kind in {tkIndent, tkWhite, tkEof}) or - (p.tok[p.idx + 1].symbol[0] in - {'\'', '\"', ')', ']', '}', '>', '-', '/', '\\', ':', '.', ',', ';', '!', - '?', '_'}) - if not result: - return # Rule 7: - if p.idx > 0: - if (markup != "``") and (p.tok[p.idx - 1].symbol == "\\"): - result = false - -proc isInlineMarkupStart(p: TRstParser, markup: string): bool = - var d: Char - result = p.tok[p.idx].symbol == markup - if not result: - return # Rule 1: - result = (p.idx == 0) or (p.tok[p.idx - 1].kind in {tkIndent, tkWhite}) or - (p.tok[p.idx - 1].symbol[0] in - {'\'', '\"', '(', '[', '{', '<', '-', '/', ':', '_'}) - if not result: - return # Rule 2: - result = not (p.tok[p.idx + 1].kind in {tkIndent, tkWhite, tkEof}) - if not result: - return # Rule 5 & 7: - if p.idx > 0: - if p.tok[p.idx - 1].symbol == "\\": - result = false - else: - var c = p.tok[p.idx - 1].symbol[0] - case c - of '\'', '\"': d = c - of '(': d = ')' - of '[': d = ']' - of '{': d = '}' - of '<': d = '>' - else: d = '\0' - if d != '\0': result = p.tok[p.idx + 1].symbol[0] != d - -proc parseBackslash(p: var TRstParser, father: PRstNode) = - assert(p.tok[p.idx].kind == tkPunct) - if p.tok[p.idx].symbol == "\\\\": - addSon(father, newRstNode(rnLeaf, "\\")) - inc(p.idx) - elif p.tok[p.idx].symbol == "\\": - # XXX: Unicode? - inc(p.idx) - if p.tok[p.idx].kind != tkWhite: addSon(father, newLeaf(p)) - inc(p.idx) - else: - addSon(father, newLeaf(p)) - inc(p.idx) - -proc match(p: TRstParser, start: int, expr: string): bool = - # regular expressions are: - # special char exact match - # 'w' tkWord - # ' ' tkWhite - # 'a' tkAdornment - # 'i' tkIndent - # 'p' tkPunct - # 'T' always true - # 'E' whitespace, indent or eof - # 'e' tkWord or '#' (for enumeration lists) - var i = 0 - var j = start - var last = len(expr) + 0 - 1 - while i <= last: - case expr[i] - of 'w': result = p.tok[j].kind == tkWord - of ' ': result = p.tok[j].kind == tkWhite - of 'i': result = p.tok[j].kind == tkIndent - of 'p': result = p.tok[j].kind == tkPunct - of 'a': result = p.tok[j].kind == tkAdornment - of 'o': result = p.tok[j].kind == tkOther - of 'T': result = true - of 'E': result = p.tok[j].kind in {tkEof, tkWhite, tkIndent} - of 'e': - result = (p.tok[j].kind == tkWord) or (p.tok[j].symbol == "#") - if result: - case p.tok[j].symbol[0] - of 'a'..'z', 'A'..'Z': result = len(p.tok[j].symbol) == 1 - of '0'..'9': result = allCharsInSet(p.tok[j].symbol, {'0'..'9'}) - else: nil - else: - var c = expr[i] - var length = 0 - while (i <= last) and (expr[i] == c): - inc(i) - inc(length) - dec(i) - result = (p.tok[j].kind in {tkPunct, tkAdornment}) and - (len(p.tok[j].symbol) == length) and (p.tok[j].symbol[0] == c) - if not result: return - inc(j) - inc(i) - result = true - -proc fixupEmbeddedRef(n, a, b: PRstNode) = - var sep = - 1 - for i in countdown(rsonsLen(n) - 2, 0): - if n.sons[i].text == "<": - sep = i - break - var incr = if (sep > 0) and (n.sons[sep - 1].text[0] == ' '): 2 else: 1 - for i in countup(0, sep - incr): addSon(a, n.sons[i]) - for i in countup(sep + 1, rsonsLen(n) - 2): addSon(b, n.sons[i]) - -proc parsePostfix(p: var TRstParser, n: PRstNode): PRstNode = - result = n - if isInlineMarkupEnd(p, "_"): - inc(p.idx) - if (p.tok[p.idx - 2].symbol == "`") and (p.tok[p.idx - 3].symbol == ">"): - var a = newRstNode(rnInner) - var b = newRstNode(rnInner) - fixupEmbeddedRef(n, a, b) - if rsonsLen(a) == 0: - result = newRstNode(rnStandaloneHyperlink) - addSon(result, b) - else: - result = newRstNode(rnHyperlink) - addSon(result, a) - addSon(result, b) - setRef(p, rstnodeToRefname(a), b) - elif n.kind == rnInterpretedText: - n.kind = rnRef - else: - result = newRstNode(rnRef) - addSon(result, n) - elif match(p, p.idx, ":w:"): - # a role: - if p.tok[p.idx + 1].symbol == "idx": - n.kind = rnIdx - elif p.tok[p.idx + 1].symbol == "literal": - n.kind = rnInlineLiteral - elif p.tok[p.idx + 1].symbol == "strong": - n.kind = rnStrongEmphasis - elif p.tok[p.idx + 1].symbol == "emphasis": - n.kind = rnEmphasis - elif (p.tok[p.idx + 1].symbol == "sub") or - (p.tok[p.idx + 1].symbol == "subscript"): - n.kind = rnSub - elif (p.tok[p.idx + 1].symbol == "sup") or - (p.tok[p.idx + 1].symbol == "supscript"): - n.kind = rnSup - else: - result = newRstNode(rnGeneralRole) - n.kind = rnInner - addSon(result, n) - addSon(result, newRstNode(rnLeaf, p.tok[p.idx + 1].symbol)) - inc(p.idx, 3) - -proc isURL(p: TRstParser, i: int): bool = - result = (p.tok[i + 1].symbol == ":") and (p.tok[i + 2].symbol == "//") and - (p.tok[i + 3].kind == tkWord) and (p.tok[i + 4].symbol == ".") - -proc parseURL(p: var TRstParser, father: PRstNode) = - #if p.tok[p.idx].symbol[strStart] = '<' then begin - if isURL(p, p.idx): - var n = newRstNode(rnStandaloneHyperlink) - while true: - case p.tok[p.idx].kind - of tkWord, tkAdornment, tkOther: - nil - of tkPunct: - if not (p.tok[p.idx + 1].kind in - {tkWord, tkAdornment, tkOther, tkPunct}): - break - else: break - addSon(n, newLeaf(p)) - inc(p.idx) - addSon(father, n) - else: - var n = newLeaf(p) - inc(p.idx) - if p.tok[p.idx].symbol == "_": n = parsePostfix(p, n) - addSon(father, n) - -proc parseUntil(p: var TRstParser, father: PRstNode, postfix: string, - interpretBackslash: bool) = - while true: - case p.tok[p.idx].kind - of tkPunct: - if isInlineMarkupEnd(p, postfix): - inc(p.idx) - break - elif interpretBackslash: - parseBackslash(p, father) - else: - addSon(father, newLeaf(p)) - inc(p.idx) - of tkAdornment, tkWord, tkOther: - addSon(father, newLeaf(p)) - inc(p.idx) - of tkIndent: - addSon(father, newRstNode(rnLeaf, " ")) - inc(p.idx) - if p.tok[p.idx].kind == tkIndent: - rstMessage(p, errXExpected, postfix) - break - of tkWhite: - addSon(father, newRstNode(rnLeaf, " ")) - inc(p.idx) - else: rstMessage(p, errXExpected, postfix) - -proc parseInline(p: var TRstParser, father: PRstNode) = - case p.tok[p.idx].kind - of tkPunct: - if isInlineMarkupStart(p, "**"): - inc(p.idx) - var n = newRstNode(rnStrongEmphasis) - parseUntil(p, n, "**", true) - addSon(father, n) - elif isInlineMarkupStart(p, "*"): - inc(p.idx) - var n = newRstNode(rnEmphasis) - parseUntil(p, n, "*", true) - addSon(father, n) - elif isInlineMarkupStart(p, "``"): - inc(p.idx) - var n = newRstNode(rnInlineLiteral) - parseUntil(p, n, "``", false) - addSon(father, n) - elif isInlineMarkupStart(p, "`"): - inc(p.idx) - var n = newRstNode(rnInterpretedText) - parseUntil(p, n, "`", true) - n = parsePostfix(p, n) - addSon(father, n) - elif isInlineMarkupStart(p, "|"): - inc(p.idx) - var n = newRstNode(rnSubstitutionReferences) - parseUntil(p, n, "|", false) - addSon(father, n) - else: - parseBackslash(p, father) - of tkWord: - parseURL(p, father) - of tkAdornment, tkOther, tkWhite: - addSon(father, newLeaf(p)) - inc(p.idx) - else: assert(false) - -proc getDirective(p: var TRstParser): string = - if (p.tok[p.idx].kind == tkWhite) and (p.tok[p.idx + 1].kind == tkWord): - var j = p.idx - inc(p.idx) - result = p.tok[p.idx].symbol - inc(p.idx) - while p.tok[p.idx].kind in {tkWord, tkPunct, tkAdornment, tkOther}: - if p.tok[p.idx].symbol == "::": break - add(result, p.tok[p.idx].symbol) - inc(p.idx) - if (p.tok[p.idx].kind == tkWhite): inc(p.idx) - if p.tok[p.idx].symbol == "::": - inc(p.idx) - if (p.tok[p.idx].kind == tkWhite): inc(p.idx) - else: - p.idx = j # set back - result = "" # error - else: - result = "" - -proc parseComment(p: var TRstParser): PRstNode = - case p.tok[p.idx].kind - of tkIndent, tkEof: - if p.tok[p.idx + 1].kind == tkIndent: - inc(p.idx) # empty comment - else: - var indent = p.tok[p.idx].ival - while True: - case p.tok[p.idx].kind - of tkEof: - break - of tkIndent: - if (p.tok[p.idx].ival < indent): break - else: - nil - inc(p.idx) - else: - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): inc(p.idx) - result = nil - -type - TDirKind = enum # must be ordered alphabetically! - dkNone, dkAuthor, dkAuthors, dkCodeBlock, dkContainer, dkContents, dkFigure, - dkImage, dkInclude, dkIndex, dkRaw, dkTitle - -const - DirIds: array[0..11, string] = ["", "author", "authors", "code-block", - "container", "contents", "figure", "image", "include", "index", "raw", - "title"] - -proc getDirKind(s: string): TDirKind = - var i: int - i = binaryStrSearch(DirIds, s) - if i >= 0: result = TDirKind(i) - else: result = dkNone - -proc parseLine(p: var TRstParser, father: PRstNode) = - while True: - case p.tok[p.idx].kind - of tkWhite, tkWord, tkOther, tkPunct: parseInline(p, father) - else: break - -proc parseSection(p: var TRstParser, result: PRstNode) -proc parseField(p: var TRstParser): PRstNode = - result = newRstNode(rnField) - var col = p.tok[p.idx].col - inc(p.idx) # skip : - var fieldname = newRstNode(rnFieldname) - parseUntil(p, fieldname, ":", false) - var fieldbody = newRstNode(rnFieldbody) - if p.tok[p.idx].kind != tkIndent: parseLine(p, fieldbody) - if p.tok[p.idx].kind == tkIndent: - var indent = p.tok[p.idx].ival - if indent > col: - pushInd(p, indent) - parseSection(p, fieldbody) - popInd(p) - addSon(result, fieldname) - addSon(result, fieldbody) - -proc parseFields(p: var TRstParser): PRstNode = - result = nil - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx + 1].symbol == ":"): - var col = p.tok[p.idx].ival # BUGFIX! - result = newRstNode(rnFieldList) - inc(p.idx) - while true: - addSon(result, parseField(p)) - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and - (p.tok[p.idx + 1].symbol == ":"): - inc(p.idx) - else: - break - -proc getFieldValue(n: PRstNode, fieldname: string): string = - result = "" - if n.sons[1] == nil: return - if (n.sons[1].kind != rnFieldList): - InternalError("getFieldValue (2): " & $n.sons[1].kind) - for i in countup(0, rsonsLen(n.sons[1]) - 1): - var f = n.sons[1].sons[i] - if cmpIgnoreStyle(addNodes(f.sons[0]), fieldname) == 0: - result = addNodes(f.sons[1]) - if result == "": result = "\x01\x01" # indicates that the field exists - return - -proc getArgument(n: PRstNode): string = - if n.sons[0] == nil: result = "" - else: result = addNodes(n.sons[0]) - -proc parseDotDot(p: var TRstParser): PRstNode -proc parseLiteralBlock(p: var TRstParser): PRstNode = - result = newRstNode(rnLiteralBlock) - var n = newRstNode(rnLeaf, "") - if p.tok[p.idx].kind == tkIndent: - var indent = p.tok[p.idx].ival - inc(p.idx) - while True: - case p.tok[p.idx].kind - of tkEof: - break - of tkIndent: - if (p.tok[p.idx].ival < indent): - break - else: - add(n.text, "\n") - add(n.text, repeatChar(p.tok[p.idx].ival - indent)) - inc(p.idx) - else: - add(n.text, p.tok[p.idx].symbol) - inc(p.idx) - else: - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): - add(n.text, p.tok[p.idx].symbol) - inc(p.idx) - addSon(result, n) - -proc getLevel(map: var TLevelMap, lvl: var int, c: Char): int = - if map[c] == 0: - inc(lvl) - map[c] = lvl - result = map[c] - -proc tokenAfterNewline(p: TRstParser): int = - result = p.idx - while true: - case p.tok[result].kind - of tkEof: - break - of tkIndent: - inc(result) - break - else: inc(result) - -proc isLineBlock(p: TRstParser): bool = - var j = tokenAfterNewline(p) - result = (p.tok[p.idx].col == p.tok[j].col) and (p.tok[j].symbol == "|") or - (p.tok[j].col > p.tok[p.idx].col) - -proc predNL(p: TRstParser): bool = - result = true - if (p.idx > 0): - result = (p.tok[p.idx - 1].kind == tkIndent) and - (p.tok[p.idx - 1].ival == currInd(p)) - -proc isDefList(p: TRstParser): bool = - var j = tokenAfterNewline(p) - result = (p.tok[p.idx].col < p.tok[j].col) and - (p.tok[j].kind in {tkWord, tkOther, tkPunct}) and - (p.tok[j - 2].symbol != "::") - -proc isOptionList(p: TRstParser): bool = - result = match(p, p.idx, "-w") or match(p, p.idx, "--w") or - match(p, p.idx, "/w") or match(p, p.idx, "//w") - -proc whichSection(p: TRstParser): TRstNodeKind = - case p.tok[p.idx].kind - of tkAdornment: - if match(p, p.idx + 1, "ii"): result = rnTransition - elif match(p, p.idx + 1, " a"): result = rnTable - elif match(p, p.idx + 1, "i"): result = rnOverline - else: result = rnLeaf - of tkPunct: - if match(p, tokenAfterNewLine(p), "ai"): - result = rnHeadline - elif p.tok[p.idx].symbol == "::": - result = rnLiteralBlock - elif predNL(p) and - ((p.tok[p.idx].symbol == "+") or (p.tok[p.idx].symbol == "*") or - (p.tok[p.idx].symbol == "-")) and (p.tok[p.idx + 1].kind == tkWhite): - result = rnBulletList - elif (p.tok[p.idx].symbol == "|") and isLineBlock(p): - result = rnLineBlock - elif (p.tok[p.idx].symbol == "..") and predNL(p): - result = rnDirective - elif (p.tok[p.idx].symbol == ":") and predNL(p): - result = rnFieldList - elif match(p, p.idx, "(e) "): - result = rnEnumList - elif match(p, p.idx, "+a+"): - result = rnGridTable - rstMessage(p, errGridTableNotImplemented) - elif isDefList(p): - result = rnDefList - elif isOptionList(p): - result = rnOptionList - else: - result = rnParagraph - of tkWord, tkOther, tkWhite: - if match(p, tokenAfterNewLine(p), "ai"): result = rnHeadline - elif isDefList(p): result = rnDefList - elif match(p, p.idx, "e) ") or match(p, p.idx, "e. "): result = rnEnumList - else: result = rnParagraph - else: result = rnLeaf - -proc parseLineBlock(p: var TRstParser): PRstNode = - result = nil - if p.tok[p.idx + 1].kind == tkWhite: - var col = p.tok[p.idx].col - result = newRstNode(rnLineBlock) - pushInd(p, p.tok[p.idx + 2].col) - inc(p.idx, 2) - while true: - var item = newRstNode(rnLineBlockItem) - parseSection(p, item) - addSon(result, item) - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and - (p.tok[p.idx + 1].symbol == "|") and - (p.tok[p.idx + 2].kind == tkWhite): - inc(p.idx, 3) - else: - break - popInd(p) - -proc parseParagraph(p: var TRstParser, result: PRstNode) = - while True: - case p.tok[p.idx].kind - of tkIndent: - if p.tok[p.idx + 1].kind == tkIndent: - inc(p.idx) - break - elif (p.tok[p.idx].ival == currInd(p)): - inc(p.idx) - case whichSection(p) - of rnParagraph, rnLeaf, rnHeadline, rnOverline, rnDirective: - addSon(result, newRstNode(rnLeaf, " ")) - of rnLineBlock: - addSonIfNotNil(result, parseLineBlock(p)) - else: break - else: - break - of tkPunct: - if (p.tok[p.idx].symbol == "::") and - (p.tok[p.idx + 1].kind == tkIndent) and - (currInd(p) < p.tok[p.idx + 1].ival): - addSon(result, newRstNode(rnLeaf, ":")) - inc(p.idx) # skip '::' - addSon(result, parseLiteralBlock(p)) - break - else: - parseInline(p, result) - of tkWhite, tkWord, tkAdornment, tkOther: - parseInline(p, result) - else: break - -proc parseParagraphWrapper(p: var TRstParser): PRstNode = - result = newRstNode(rnParagraph) - parseParagraph(p, result) - -proc parseHeadline(p: var TRstParser): PRstNode = - result = newRstNode(rnHeadline) - parseLine(p, result) - assert(p.tok[p.idx].kind == tkIndent) - assert(p.tok[p.idx + 1].kind == tkAdornment) - var c = p.tok[p.idx + 1].symbol[0] - inc(p.idx, 2) - result.level = getLevel(p.s.underlineToLevel, p.s.uLevel, c) - -type - TIntSeq = seq[int] - -proc tokEnd(p: TRstParser): int = - result = p.tok[p.idx].col + len(p.tok[p.idx].symbol) - 1 - -proc getColumns(p: var TRstParser, cols: var TIntSeq) = - var L = 0 - while true: - inc(L) - setlen(cols, L) - cols[L - 1] = tokEnd(p) - assert(p.tok[p.idx].kind == tkAdornment) - inc(p.idx) - if p.tok[p.idx].kind != tkWhite: break - inc(p.idx) - if p.tok[p.idx].kind != tkAdornment: break - if p.tok[p.idx].kind == tkIndent: inc(p.idx) - # last column has no limit: - cols[L - 1] = 32000 - -proc parseDoc(p: var TRstParser): PRstNode - -proc parseSimpleTable(p: var TRstParser): PRstNode = - var - cols: TIntSeq - row: seq[string] - i, last, line: int - c: Char - q: TRstParser - a, b: PRstNode - result = newRstNode(rnTable) - cols = @[] - row = @[] - a = nil - c = p.tok[p.idx].symbol[0] - while true: - if p.tok[p.idx].kind == tkAdornment: - last = tokenAfterNewline(p) - if p.tok[last].kind in {tkEof, tkIndent}: - # skip last adornment line: - p.idx = last - break - getColumns(p, cols) - setlen(row, len(cols)) - if a != nil: - for j in countup(0, rsonsLen(a) - 1): a.sons[j].kind = rnTableHeaderCell - if p.tok[p.idx].kind == tkEof: break - for j in countup(0, high(row)): row[j] = "" - # the following while loop iterates over the lines a single cell may span: - line = p.tok[p.idx].line - while true: - i = 0 - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): - if (tokEnd(p) <= cols[i]): - add(row[i], p.tok[p.idx].symbol) - inc(p.idx) - else: - if p.tok[p.idx].kind == tkWhite: inc(p.idx) - inc(i) - if p.tok[p.idx].kind == tkIndent: inc(p.idx) - if tokEnd(p) <= cols[0]: break - if p.tok[p.idx].kind in {tkEof, tkAdornment}: break - for j in countup(1, high(row)): add(row[j], '\x0A') - a = newRstNode(rnTableRow) - for j in countup(0, high(row)): - initParser(q, p.s) - q.col = cols[j] - q.line = line - 1 - q.filename = p.filename - getTokens(row[j], false, q.tok) - b = newRstNode(rnTableDataCell) - addSon(b, parseDoc(q)) - addSon(a, b) - addSon(result, a) - -proc parseTransition(p: var TRstParser): PRstNode = - result = newRstNode(rnTransition) - inc(p.idx) - if p.tok[p.idx].kind == tkIndent: inc(p.idx) - if p.tok[p.idx].kind == tkIndent: inc(p.idx) - -proc parseOverline(p: var TRstParser): PRstNode = - var c = p.tok[p.idx].symbol[0] - inc(p.idx, 2) - result = newRstNode(rnOverline) - while true: - parseLine(p, result) - if p.tok[p.idx].kind == tkIndent: - inc(p.idx) - if p.tok[p.idx - 1].ival > currInd(p): - addSon(result, newRstNode(rnLeaf, " ")) - else: - break - else: - break - result.level = getLevel(p.s.overlineToLevel, p.s.oLevel, c) - if p.tok[p.idx].kind == tkAdornment: - inc(p.idx) # XXX: check? - if p.tok[p.idx].kind == tkIndent: inc(p.idx) - -proc parseBulletList(p: var TRstParser): PRstNode = - result = nil - if p.tok[p.idx + 1].kind == tkWhite: - var bullet = p.tok[p.idx].symbol - var col = p.tok[p.idx].col - result = newRstNode(rnBulletList) - pushInd(p, p.tok[p.idx + 2].col) - inc(p.idx, 2) - while true: - var item = newRstNode(rnBulletItem) - parseSection(p, item) - addSon(result, item) - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and - (p.tok[p.idx + 1].symbol == bullet) and - (p.tok[p.idx + 2].kind == tkWhite): - inc(p.idx, 3) - else: - break - popInd(p) - -proc parseOptionList(p: var TRstParser): PRstNode = - result = newRstNode(rnOptionList) - while true: - if isOptionList(p): - var a = newRstNode(rnOptionGroup) - var b = newRstNode(rnDescription) - var c = newRstNode(rnOptionListItem) - if match(p, p.idx, "//w"): inc(p.idx) - while not (p.tok[p.idx].kind in {tkIndent, tkEof}): - if (p.tok[p.idx].kind == tkWhite) and (len(p.tok[p.idx].symbol) > 1): - inc(p.idx) - break - addSon(a, newLeaf(p)) - inc(p.idx) - var j = tokenAfterNewline(p) - if (j > 0) and (p.tok[j - 1].kind == tkIndent) and - (p.tok[j - 1].ival > currInd(p)): - pushInd(p, p.tok[j - 1].ival) - parseSection(p, b) - popInd(p) - else: - parseLine(p, b) - if (p.tok[p.idx].kind == tkIndent): inc(p.idx) - addSon(c, a) - addSon(c, b) - addSon(result, c) - else: - break - -proc parseDefinitionList(p: var TRstParser): PRstNode = - result = nil - var j = tokenAfterNewLine(p) - 1 - if (j >= 1) and (p.tok[j].kind == tkIndent) and - (p.tok[j].ival > currInd(p)) and (p.tok[j - 1].symbol != "::"): - var col = p.tok[p.idx].col - result = newRstNode(rnDefList) - while true: - j = p.idx - var a = newRstNode(rnDefName) - parseLine(p, a) - if (p.tok[p.idx].kind == tkIndent) and - (p.tok[p.idx].ival > currInd(p)) and - (p.tok[p.idx + 1].symbol != "::") and - not (p.tok[p.idx + 1].kind in {tkIndent, tkEof}): - pushInd(p, p.tok[p.idx].ival) - var b = newRstNode(rnDefBody) - parseSection(p, b) - var c = newRstNode(rnDefItem) - addSon(c, a) - addSon(c, b) - addSon(result, c) - popInd(p) - else: - p.idx = j - break - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col): - inc(p.idx) - j = tokenAfterNewLine(p) - 1 - if (j >= 1) and (p.tok[j].kind == tkIndent) and (p.tok[j].ival > col) and - (p.tok[j - 1].symbol != "::") and (p.tok[j + 1].kind != tkIndent): - nil - else: - break - if rsonsLen(result) == 0: result = nil - -proc parseEnumList(p: var TRstParser): PRstNode = - const - wildcards: array[0..2, string] = ["(e) ", "e) ", "e. "] - wildpos: array[0..2, int] = [1, 0, 0] - result = nil - var w = 0 - while w <= 2: - if match(p, p.idx, wildcards[w]): break - inc(w) - if w <= 2: - var col = p.tok[p.idx].col - result = newRstNode(rnEnumList) - inc(p.idx, wildpos[w] + 3) - var j = tokenAfterNewLine(p) - if (p.tok[j].col == p.tok[p.idx].col) or match(p, j, wildcards[w]): - pushInd(p, p.tok[p.idx].col) - while true: - var item = newRstNode(rnEnumItem) - parseSection(p, item) - addSon(result, item) - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival == col) and - match(p, p.idx + 1, wildcards[w]): - inc(p.idx, wildpos[w] + 4) - else: - break - popInd(p) - else: - dec(p.idx, wildpos[w] + 3) - result = nil - -proc sonKind(father: PRstNode, i: int): TRstNodeKind = - result = rnLeaf - if i < rsonsLen(father): result = father.sons[i].kind - -proc parseSection(p: var TRstParser, result: PRstNode) = - while true: - var leave = false - assert(p.idx >= 0) - while p.tok[p.idx].kind == tkIndent: - if currInd(p) == p.tok[p.idx].ival: - inc(p.idx) - elif p.tok[p.idx].ival > currInd(p): - pushInd(p, p.tok[p.idx].ival) - var a = newRstNode(rnBlockQuote) - parseSection(p, a) - addSon(result, a) - popInd(p) - else: - leave = true - break - if leave: break - if p.tok[p.idx].kind == tkEof: break - var a: PRstNode = nil - var k = whichSection(p) - case k - of rnLiteralBlock: - inc(p.idx) # skip '::' - a = parseLiteralBlock(p) - of rnBulletList: a = parseBulletList(p) - of rnLineblock: a = parseLineBlock(p) - of rnDirective: a = parseDotDot(p) - of rnEnumList: a = parseEnumList(p) - of rnLeaf: rstMessage(p, errNewSectionExpected) - of rnParagraph: nil - of rnDefList: a = parseDefinitionList(p) - of rnFieldList: - dec(p.idx) - a = parseFields(p) - of rnTransition: a = parseTransition(p) - of rnHeadline: a = parseHeadline(p) - of rnOverline: a = parseOverline(p) - of rnTable: a = parseSimpleTable(p) - of rnOptionList: a = parseOptionList(p) - else: InternalError("rst.parseSection()") - if (a == nil) and (k != rnDirective): - a = newRstNode(rnParagraph) - parseParagraph(p, a) - addSonIfNotNil(result, a) - if (sonKind(result, 0) == rnParagraph) and - (sonKind(result, 1) != rnParagraph): - result.sons[0].kind = rnInner - -proc parseSectionWrapper(p: var TRstParser): PRstNode = - result = newRstNode(rnInner) - parseSection(p, result) - while (result.kind == rnInner) and (rsonsLen(result) == 1): - result = result.sons[0] - -proc parseDoc(p: var TRstParser): PRstNode = - result = parseSectionWrapper(p) - if p.tok[p.idx].kind != tkEof: rstMessage(p, errGeneralParseError) - -type - TDirFlag = enum - hasArg, hasOptions, argIsFile, argIsWord - TDirFlags = set[TDirFlag] - TSectionParser = proc (p: var TRstParser): PRstNode - -proc parseDirective(p: var TRstParser, flags: TDirFlags): PRstNode = - result = newRstNode(rnDirective) - var args: PRstNode = nil - var options: PRstNode = nil - if hasArg in flags: - args = newRstNode(rnDirArg) - if argIsFile in flags: - while True: - case p.tok[p.idx].kind - of tkWord, tkOther, tkPunct, tkAdornment: - addSon(args, newLeaf(p)) - inc(p.idx) - else: break - elif argIsWord in flags: - while p.tok[p.idx].kind == tkWhite: inc(p.idx) - if p.tok[p.idx].kind == tkWord: - addSon(args, newLeaf(p)) - inc(p.idx) - else: - args = nil - else: - parseLine(p, args) - addSon(result, args) - if hasOptions in flags: - if (p.tok[p.idx].kind == tkIndent) and (p.tok[p.idx].ival >= 3) and - (p.tok[p.idx + 1].symbol == ":"): - options = parseFields(p) - addSon(result, options) - -proc indFollows(p: TRstParser): bool = - result = p.tok[p.idx].kind == tkIndent and p.tok[p.idx].ival > currInd(p) - -proc parseDirective(p: var TRstParser, flags: TDirFlags, - contentParser: TSectionParser): PRstNode = - result = parseDirective(p, flags) - if not isNil(contentParser) and indFollows(p): - pushInd(p, p.tok[p.idx].ival) - var content = contentParser(p) - popInd(p) - addSon(result, content) - else: - addSon(result, nil) - -proc parseDirBody(p: var TRstParser, contentParser: TSectionParser): PRstNode = - if indFollows(p): - pushInd(p, p.tok[p.idx].ival) - result = contentParser(p) - popInd(p) - -proc dirInclude(p: var TRstParser): PRstNode = - # - #The following options are recognized: - # - #start-after : text to find in the external data file - # Only the content after the first occurrence of the specified text will - # be included. - #end-before : text to find in the external data file - # Only the content before the first occurrence of the specified text - # (but after any after text) will be included. - #literal : flag (empty) - # The entire included text is inserted into the document as a single - # literal block (useful for program listings). - #encoding : name of text encoding - # The text encoding of the external data file. Defaults to the document's - # encoding (if specified). - # - result = nil - var n = parseDirective(p, {hasArg, argIsFile, hasOptions}, nil) - var filename = strip(addNodes(n.sons[0])) - var path = findFile(filename) - if path == "": - rstMessage(p, errCannotOpenFile, filename) - else: - # XXX: error handling; recursive file inclusion! - if getFieldValue(n, "literal") != "": - result = newRstNode(rnLiteralBlock) - addSon(result, newRstNode(rnLeaf, readFile(path))) - else: - var q: TRstParser - initParser(q, p.s) - q.filename = filename - getTokens(readFile(path), false, q.tok) # workaround a GCC bug: - if find(q.tok[high(q.tok)].symbol, "\0\x01\x02") > 0: - InternalError("Too many binary zeros in include file") - result = parseDoc(q) - -proc dirCodeBlock(p: var TRstParser): PRstNode = - result = parseDirective(p, {hasArg, hasOptions}, parseLiteralBlock) - var filename = strip(getFieldValue(result, "file")) - if filename != "": - var path = findFile(filename) - if path == "": rstMessage(p, errCannotOpenFile, filename) - var n = newRstNode(rnLiteralBlock) - addSon(n, newRstNode(rnLeaf, readFile(path))) - result.sons[2] = n - result.kind = rnCodeBlock - -proc dirContainer(p: var TRstParser): PRstNode = - result = parseDirective(p, {hasArg}, parseSectionWrapper) - assert(result.kind == rnDirective) - assert(rsonsLen(result) == 3) - result.kind = rnContainer - -proc dirImage(p: var TRstParser): PRstNode = - result = parseDirective(p, {hasOptions, hasArg, argIsFile}, nil) - result.kind = rnImage - -proc dirFigure(p: var TRstParser): PRstNode = - result = parseDirective(p, {hasOptions, hasArg, argIsFile}, - parseSectionWrapper) - result.kind = rnFigure - -proc dirTitle(p: var TRstParser): PRstNode = - result = parseDirective(p, {hasArg}, nil) - result.kind = rnTitle - -proc dirContents(p: var TRstParser): PRstNode = - result = parseDirective(p, {hasArg}, nil) - result.kind = rnContents - -proc dirIndex(p: var TRstParser): PRstNode = - result = parseDirective(p, {}, parseSectionWrapper) - result.kind = rnIndex - -proc dirRawAux(p: var TRstParser, result: var PRstNode, kind: TRstNodeKind, - contentParser: TSectionParser) = - var filename = getFieldValue(result, "file") - if filename.len > 0: - var path = findFile(filename) - if path.len == 0: - rstMessage(p, errCannotOpenFile, filename) - else: - var f = readFile(path) - result = newRstNode(kind) - addSon(result, newRstNode(rnLeaf, f)) - else: - result.kind = kind - addSon(result, parseDirBody(p, contentParser)) - -proc dirRaw(p: var TRstParser): PRstNode = - # - #The following options are recognized: - # - #file : string (newlines removed) - # The local filesystem path of a raw data file to be included. - # - # html - # latex - result = parseDirective(p, {hasOptions, hasArg, argIsWord}) - if result.sons[0] != nil: - if cmpIgnoreCase(result.sons[0].sons[0].text, "html") == 0: - dirRawAux(p, result, rnRawHtml, parseLiteralBlock) - elif cmpIgnoreCase(result.sons[0].sons[0].text, "latex") == 0: - dirRawAux(p, result, rnRawLatex, parseLiteralBlock) - else: - rstMessage(p, errInvalidDirectiveX, result.sons[0].text) - else: - dirRawAux(p, result, rnRaw, parseSectionWrapper) - -proc parseDotDot(p: var TRstParser): PRstNode = - result = nil - var col = p.tok[p.idx].col - inc(p.idx) - var d = getDirective(p) - if d != "": - pushInd(p, col) - case getDirKind(d) - of dkInclude: result = dirInclude(p) - of dkImage: result = dirImage(p) - of dkFigure: result = dirFigure(p) - of dkTitle: result = dirTitle(p) - of dkContainer: result = dirContainer(p) - of dkContents: result = dirContents(p) - of dkRaw: result = dirRaw(p) - of dkCodeblock: result = dirCodeBlock(p) - of dkIndex: result = dirIndex(p) - else: rstMessage(p, errInvalidDirectiveX, d) - popInd(p) - elif match(p, p.idx, " _"): - # hyperlink target: - inc(p.idx, 2) - var a = getReferenceName(p, ":") - if p.tok[p.idx].kind == tkWhite: inc(p.idx) - var b = untilEol(p) - setRef(p, rstnodeToRefname(a), b) - elif match(p, p.idx, " |"): - # substitution definitions: - inc(p.idx, 2) - var a = getReferenceName(p, "|") - var b: PRstNode - if p.tok[p.idx].kind == tkWhite: inc(p.idx) - if cmpIgnoreStyle(p.tok[p.idx].symbol, "replace") == 0: - inc(p.idx) - expect(p, "::") - b = untilEol(p) - elif cmpIgnoreStyle(p.tok[p.idx].symbol, "image") == 0: - inc(p.idx) - b = dirImage(p) - else: - rstMessage(p, errInvalidDirectiveX, p.tok[p.idx].symbol) - setSub(p, addNodes(a), b) - elif match(p, p.idx, " ["): - # footnotes, citations - inc(p.idx, 2) - var a = getReferenceName(p, "]") - if p.tok[p.idx].kind == tkWhite: inc(p.idx) - var b = untilEol(p) - setRef(p, rstnodeToRefname(a), b) - else: - result = parseComment(p) - -proc resolveSubs(p: var TRstParser, n: PRstNode): PRstNode = - result = n - if n == nil: return - case n.kind - of rnSubstitutionReferences: - var x = findSub(p, n) - if x >= 0: - result = p.s.subs[x].value - else: - var key = addNodes(n) - var e = getEnv(key) - if e != "": result = newRstNode(rnLeaf, e) - else: rstMessage(p, warnUnknownSubstitutionX, key) - of rnRef: - var y = findRef(p, rstnodeToRefname(n)) - if y != nil: - result = newRstNode(rnHyperlink) - n.kind = rnInner - addSon(result, n) - addSon(result, y) - of rnLeaf: - nil - of rnContents: - p.hasToc = true - else: - for i in countup(0, rsonsLen(n) - 1): n.sons[i] = resolveSubs(p, n.sons[i]) - -proc rstParse(text: string, # the text to be parsed - skipPounds: bool, filename: string, # for error messages - line, column: int, hasToc: var bool): PRstNode = - var p: TRstParser - if isNil(text): rawMessage(errCannotOpenFile, filename) - initParser(p, newSharedState()) - p.filename = filename - p.line = line - p.col = column - getTokens(text, skipPounds, p.tok) - result = resolveSubs(p, parseDoc(p)) - hasToc = p.hasToc diff --git a/rod/scanner.nim b/rod/scanner.nim deleted file mode 100755 index a14773773..000000000 --- a/rod/scanner.nim +++ /dev/null @@ -1,791 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This scanner is handwritten for efficiency. I used an elegant buffering -# scheme which I have not seen anywhere else: -# We guarantee that a whole line is in the buffer. Thus only when scanning -# the \n or \r character we have to check wether we need to read in the next -# chunk. (\n or \r already need special handling for incrementing the line -# counter; choosing both \n and \r allows the scanner to properly read Unix, -# DOS or Macintosh text files, even when it is not the native format. - -import - nhashes, options, msgs, strutils, platform, idents, lexbase, llstream, - wordrecg - -const - MaxLineLength* = 80 # lines longer than this lead to a warning - numChars*: TCharSet = {'0'..'9', 'a'..'z', 'A'..'Z'} - SymChars*: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} - SymStartChars*: TCharSet = {'a'..'z', 'A'..'Z', '\x80'..'\xFF'} - OpChars*: TCharSet = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '.', - '|', '=', '%', '&', '$', '@', '~', '\x80'..'\xFF'} - -type - TTokType* = enum - tkInvalid, tkEof, # order is important here! - tkSymbol, # keywords: - #[[[cog - #from string import split, capitalize - #keywords = split(open("data/keywords.txt").read()) - #idents = "" - #strings = "" - #i = 1 - #for k in keywords: - # idents = idents + "tk" + capitalize(k) + ", " - # strings = strings + "'" + k + "', " - # if i % 4 == 0: - # idents = idents + "\n" - # strings = strings + "\n" - # i = i + 1 - #cog.out(idents) - #]]] - tkAddr, tkAnd, tkAs, tkAsm, tkAtomic, - tkBind, tkBlock, tkBreak, tkCase, tkCast, - tkConst, tkContinue, tkConverter, tkDiscard, tkDistinct, tkDiv, tkElif, - tkElse, tkEnd, tkEnum, tkExcept, tkFinally, tkFor, tkFrom, tkGeneric, tkIf, - tkImplies, tkImport, tkIn, tkInclude, tkIs, tkIsnot, tkIterator, - tkLambda, tkLet, - tkMacro, tkMethod, tkMod, tkNil, tkNot, tkNotin, tkObject, tkOf, tkOr, - tkOut, tkProc, tkPtr, tkRaise, tkRef, tkReturn, tkShl, tkShr, tkTemplate, - tkTry, tkTuple, tkType, tkVar, tkWhen, tkWhile, tkWith, tkWithout, tkXor, - tkYield, #[[[end]]] - tkIntLit, tkInt8Lit, tkInt16Lit, tkInt32Lit, tkInt64Lit, tkFloatLit, - tkFloat32Lit, tkFloat64Lit, tkStrLit, tkRStrLit, tkTripleStrLit, - tkGStrLit, tkGTripleStrLit, tkCharLit, tkParLe, tkParRi, tkBracketLe, - tkBracketRi, tkCurlyLe, tkCurlyRi, - tkBracketDotLe, tkBracketDotRi, # [. and .] - tkCurlyDotLe, tkCurlyDotRi, # {. and .} - tkParDotLe, tkParDotRi, # (. and .) - tkComma, tkSemiColon, tkColon, tkEquals, tkDot, tkDotDot, tkHat, tkOpr, - tkComment, tkAccent, tkInd, tkSad, - tkDed, # pseudo token types used by the source renderers: - tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr - TTokTypes* = set[TTokType] - -const - tokKeywordLow* = succ(tkSymbol) - tokKeywordHigh* = pred(tkIntLit) - tokOperators*: TTokTypes = {tkOpr, tkSymbol, tkBracketLe, tkBracketRi, tkIn, - tkIs, tkIsNot, tkEquals, tkDot, tkHat, tkNot, tkAnd, tkOr, tkXor, tkShl, - tkShr, tkDiv, tkMod, tkNotIn} - TokTypeToStr*: array[TTokType, string] = ["tkInvalid", "[EOF]", - "tkSymbol", #[[[cog - #cog.out(strings) - #]]] - "addr", "and", "as", "asm", "atomic", - "bind", "block", "break", "case", "cast", - "const", "continue", "converter", "discard", "distinct", "div", "elif", - "else", "end", "enum", "except", "finally", "for", "from", "generic", "if", - "implies", "import", "in", "include", "is", "isnot", "iterator", - "lambda", "let", - "macro", "method", "mod", "nil", "not", "notin", "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", "shl", "shr", "template", - "try", "tuple", "type", "var", "when", "while", "with", "without", "xor", - "yield", #[[[end]]] - "tkIntLit", "tkInt8Lit", "tkInt16Lit", "tkInt32Lit", "tkInt64Lit", - "tkFloatLit", "tkFloat32Lit", "tkFloat64Lit", "tkStrLit", "tkRStrLit", - "tkTripleStrLit", "tkGStrLit", "tkGTripleStrLit", "tkCharLit", "(", - ")", "[", "]", "{", "}", "[.", ".]", "{.", ".}", "(.", ".)", ",", ";", ":", - "=", ".", "..", "^", "tkOpr", "tkComment", "`", "[new indentation]", - "[same indentation]", "[dedentation]", "tkSpaces", "tkInfixOpr", - "tkPrefixOpr", "tkPostfixOpr"] - -type - TNumericalBase* = enum - base10, # base10 is listed as the first element, - # so that it is the correct default value - base2, base8, base16 - PToken* = ref TToken - TToken* = object # a Nimrod token - tokType*: TTokType # the type of the token - indent*: int # the indentation; only valid if tokType = tkIndent - ident*: PIdent # the parsed identifier - iNumber*: BiggestInt # the parsed integer literal - fNumber*: BiggestFloat # the parsed floating point literal - base*: TNumericalBase # the numerical base; only valid for int - # or float literals - literal*: string # the parsed (string) literal; and - # documentation comments are here too - next*: PToken # next token; can be used for arbitrary look-ahead - - PLexer* = ref TLexer - TLexer* = object of TBaseLexer - filename*: string - indentStack*: seq[int] # the indentation stack - dedent*: int # counter for DED token generation - indentAhead*: int # if > 0 an indendation has already been read - # this is needed because scanning comments - # needs so much look-ahead - - -var gLinesCompiled*: int # all lines that have been compiled - -proc pushInd*(L: var TLexer, indent: int) - -proc popInd*(L: var TLexer) -proc isKeyword*(kind: TTokType): bool -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) -proc rawGetTok*(L: var TLexer, tok: var TToken) - # reads in the next token into tok and skips it -proc getColumn*(L: TLexer): int -proc getLineInfo*(L: TLexer): TLineInfo -proc closeLexer*(lex: var TLexer) -proc PrintTok*(tok: PToken) -proc tokToStr*(tok: PToken): string - -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") - # the Pascal scanner uses this too: -proc fillToken*(L: var TToken) -# implementation - -proc isKeyword(kind: TTokType): bool = - result = (kind >= tokKeywordLow) and (kind <= tokKeywordHigh) - -proc isNimrodIdentifier*(s: string): bool = - if s[0] in SymStartChars: - var i = 1 - while i < s.len: - if s[i] == '_': - inc(i) - if s[i] notin SymChars: return - if s[i] notin SymChars: return - inc(i) - result = true - -proc pushInd(L: var TLexer, indent: int) = - var length = len(L.indentStack) - setlen(L.indentStack, length + 1) - if (indent > L.indentStack[length - 1]): - L.indentstack[length] = indent - else: - InternalError("pushInd") - -proc popInd(L: var TLexer) = - var length = len(L.indentStack) - setlen(L.indentStack, length - 1) - -proc findIdent(L: TLexer, indent: int): bool = - for i in countdown(len(L.indentStack) - 1, 0): - if L.indentStack[i] == indent: - return true - -proc tokToStr(tok: PToken): string = - case tok.tokType - of tkIntLit..tkInt64Lit: result = $tok.iNumber - of tkFloatLit..tkFloat64Lit: result = $tok.fNumber - of tkInvalid, tkStrLit..tkCharLit, tkComment: result = tok.literal - of tkParLe..tkColon, tkEof, tkInd, tkSad, tkDed, tkAccent: - result = tokTypeToStr[tok.tokType] - else: - if (tok.ident != nil): - result = tok.ident.s - else: - InternalError("tokToStr") - result = "" - -proc PrintTok(tok: PToken) = - write(stdout, TokTypeToStr[tok.tokType]) - write(stdout, " ") - writeln(stdout, tokToStr(tok)) - -var dummyIdent: PIdent - -proc fillToken(L: var TToken) = - L.TokType = tkInvalid - L.iNumber = 0 - L.Indent = 0 - L.literal = "" - L.fNumber = 0.0 - L.base = base10 - L.ident = dummyIdent # this prevents many bugs! - -proc openLexer(lex: var TLexer, filename: string, inputstream: PLLStream) = - openBaseLexer(lex, inputstream) - lex.indentStack = @[0] - lex.filename = filename - lex.indentAhead = - 1 - inc(lex.Linenumber, inputstream.lineOffset) - -proc closeLexer(lex: var TLexer) = - inc(gLinesCompiled, lex.LineNumber) - closeBaseLexer(lex) - -proc getColumn(L: TLexer): int = - result = getColNumber(L, L.bufPos) - -proc getLineInfo(L: TLexer): TLineInfo = - result = newLineInfo(L.filename, L.linenumber, getColNumber(L, L.bufpos)) - -proc lexMessage(L: TLexer, msg: TMsgKind, arg = "") = - msgs.Message(getLineInfo(L), msg, arg) - -proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = - var info = newLineInfo(L.filename, L.linenumber, pos - L.lineStart) - msgs.Message(info, msg, arg) - -proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: TCharSet) = - var pos = L.bufpos # use registers for pos, buf - var buf = L.buf - while true: - if buf[pos] in chars: - add(tok.literal, buf[pos]) - Inc(pos) - else: - break - if buf[pos] == '_': - if buf[pos+1] notin chars: - lexMessage(L, errInvalidToken, "_") - break - add(tok.literal, '_') - Inc(pos) - L.bufPos = pos - -proc matchTwoChars(L: TLexer, first: Char, second: TCharSet): bool = - result = (L.buf[L.bufpos] == first) and (L.buf[L.bufpos + 1] in Second) - -proc isFloatLiteral(s: string): bool = - for i in countup(0, len(s) + 0 - 1): - if s[i] in {'.', 'e', 'E'}: - return true - result = false - -proc GetNumber(L: var TLexer): TToken = - var - pos, endpos: int - xi: biggestInt - # get the base: - result.tokType = tkIntLit # int literal until we know better - result.literal = "" - result.base = base10 # BUGFIX - pos = L.bufpos # make sure the literal is correct for error messages: - matchUnderscoreChars(L, result, {'A'..'Z', 'a'..'z', '0'..'9'}) - if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): - add(result.literal, '.') - inc(L.bufpos) - #matchUnderscoreChars(L, result, ['A'..'Z', 'a'..'z', '0'..'9']) - matchUnderscoreChars(L, result, {'0'..'9'}) - if L.buf[L.bufpos] in {'e', 'E'}: - add(result.literal, 'e') - inc(L.bufpos) - if L.buf[L.bufpos] in {'+', '-'}: - add(result.literal, L.buf[L.bufpos]) - inc(L.bufpos) - matchUnderscoreChars(L, result, {'0'..'9'}) - endpos = L.bufpos - if L.buf[endpos] == '\'': - #matchUnderscoreChars(L, result, ['''', 'f', 'F', 'i', 'I', '0'..'9']); - inc(endpos) - L.bufpos = pos # restore position - case L.buf[endpos] - of 'f', 'F': - inc(endpos) - if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): - result.tokType = tkFloat64Lit - inc(endpos, 2) - elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): - result.tokType = tkFloat32Lit - inc(endpos, 2) - else: - lexMessage(L, errInvalidNumber, result.literal) - of 'i', 'I': - inc(endpos) - if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): - result.tokType = tkInt64Lit - inc(endpos, 2) - elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): - result.tokType = tkInt32Lit - inc(endpos, 2) - elif (L.buf[endpos] == '1') and (L.buf[endpos + 1] == '6'): - result.tokType = tkInt16Lit - inc(endpos, 2) - elif (L.buf[endpos] == '8'): - result.tokType = tkInt8Lit - inc(endpos) - else: - lexMessage(L, errInvalidNumber, result.literal) - else: lexMessage(L, errInvalidNumber, result.literal) - else: - L.bufpos = pos # restore position - try: - if (L.buf[pos] == '0') and - (L.buf[pos + 1] in {'x', 'X', 'b', 'B', 'o', 'O', 'c', 'C'}): - inc(pos, 2) - xi = 0 # it may be a base prefix - case L.buf[pos - 1] # now look at the optional type suffix: - of 'b', 'B': - result.base = base2 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z', '2'..'9', '.': - lexMessage(L, errInvalidNumber, result.literal) - inc(pos) - of '_': - if L.buf[pos+1] notin {'0'..'1'}: - lexMessage(L, errInvalidToken, "_") - break - inc(pos) - of '0', '1': - xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - else: break - of 'o', 'c', 'C': - result.base = base8 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z', '8'..'9', '.': - lexMessage(L, errInvalidNumber, result.literal) - inc(pos) - of '_': - if L.buf[pos+1] notin {'0'..'7'}: - lexMessage(L, errInvalidToken, "_") - break - inc(pos) - of '0'..'7': - xi = `shl`(xi, 3) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - else: break - of 'O': - lexMessage(L, errInvalidNumber, result.literal) - of 'x', 'X': - result.base = base16 - while true: - case L.buf[pos] - of 'G'..'Z', 'g'..'z': - lexMessage(L, errInvalidNumber, result.literal) - inc(pos) - of '_': - if L.buf[pos+1] notin {'0'..'9', 'a'..'f', 'A'..'F'}: - lexMessage(L, errInvalidToken, "_") - break - inc(pos) - of '0'..'9': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - of 'a'..'f': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) - inc(pos) - of 'A'..'F': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) - inc(pos) - else: break - else: InternalError(getLineInfo(L), "getNumber") - case result.tokType - of tkIntLit, tkInt64Lit: result.iNumber = xi - of tkInt8Lit: result.iNumber = biggestInt(int8(toU8(int(xi)))) - of tkInt16Lit: result.iNumber = biggestInt(toU16(int(xi))) - of tkInt32Lit: result.iNumber = biggestInt(toU32(xi)) - of tkFloat32Lit: - result.fNumber = (cast[PFloat32](addr(xi)))[] - # note: this code is endian neutral! - # XXX: Test this on big endian machine! - of tkFloat64Lit: result.fNumber = (cast[PFloat64](addr(xi)))[] - else: InternalError(getLineInfo(L), "getNumber") - elif isFloatLiteral(result.literal) or (result.tokType == tkFloat32Lit) or - (result.tokType == tkFloat64Lit): - result.fnumber = parseFloat(result.literal) - if result.tokType == tkIntLit: result.tokType = tkFloatLit - else: - result.iNumber = ParseBiggestInt(result.literal) - if (result.iNumber < low(int32)) or (result.iNumber > high(int32)): - if result.tokType == tkIntLit: - result.tokType = tkInt64Lit - elif result.tokType != tkInt64Lit: - lexMessage(L, errInvalidNumber, result.literal) - except EInvalidValue: lexMessage(L, errInvalidNumber, result.literal) - except EOverflow: lexMessage(L, errNumberOutOfRange, result.literal) - except EOutOfRange: lexMessage(L, errNumberOutOfRange, result.literal) - L.bufpos = endpos - -proc handleHexChar(L: var TLexer, xi: var int) = - case L.buf[L.bufpos] - of '0'..'9': - xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('0')) - inc(L.bufpos) - of 'a'..'f': - xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('a') + 10) - inc(L.bufpos) - of 'A'..'F': - xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('A') + 10) - inc(L.bufpos) - else: - nil - -proc handleDecChars(L: var TLexer, xi: var int) = - while L.buf[L.bufpos] in {'0'..'9'}: - xi = (xi * 10) + (ord(L.buf[L.bufpos]) - ord('0')) - inc(L.bufpos) - -proc getEscapedChar(L: var TLexer, tok: var TToken) = - inc(L.bufpos) # skip '\' - case L.buf[L.bufpos] - of 'n', 'N': - if tok.toktype == tkCharLit: lexMessage(L, errNnotAllowedInCharacter) - add(tok.literal, tnl) - Inc(L.bufpos) - of 'r', 'R', 'c', 'C': - add(tok.literal, CR) - Inc(L.bufpos) - of 'l', 'L': - add(tok.literal, LF) - Inc(L.bufpos) - of 'f', 'F': - add(tok.literal, FF) - inc(L.bufpos) - of 'e', 'E': - add(tok.literal, ESC) - Inc(L.bufpos) - of 'a', 'A': - add(tok.literal, BEL) - Inc(L.bufpos) - of 'b', 'B': - add(tok.literal, BACKSPACE) - Inc(L.bufpos) - of 'v', 'V': - add(tok.literal, VT) - Inc(L.bufpos) - of 't', 'T': - add(tok.literal, Tabulator) - Inc(L.bufpos) - of '\'', '\"': - add(tok.literal, L.buf[L.bufpos]) - Inc(L.bufpos) - of '\\': - add(tok.literal, '\\') - Inc(L.bufpos) - of 'x', 'X': - inc(L.bufpos) - var xi = 0 - handleHexChar(L, xi) - handleHexChar(L, xi) - add(tok.literal, Chr(xi)) - of '0'..'9': - if matchTwoChars(L, '0', {'0'..'9'}): - lexMessage(L, warnOctalEscape) - var xi = 0 - handleDecChars(L, xi) - if (xi <= 255): add(tok.literal, Chr(xi)) - else: lexMessage(L, errInvalidCharacterConstant) - else: lexMessage(L, errInvalidCharacterConstant) - -proc HandleCRLF(L: var TLexer, pos: int): int = - case L.buf[pos] - of CR: - if getColNumber(L, pos) > MaxLineLength: - lexMessagePos(L, hintLineTooLong, pos) - result = lexbase.HandleCR(L, pos) - of LF: - if getColNumber(L, pos) > MaxLineLength: - lexMessagePos(L, hintLineTooLong, pos) - result = lexbase.HandleLF(L, pos) - else: result = pos - -proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = - var pos = L.bufPos + 1 # skip " - var buf = L.buf # put `buf` in a register - var line = L.linenumber # save linenumber for better error message - if buf[pos] == '\"' and buf[pos+1] == '\"': - tok.tokType = tkTripleStrLit # long string literal: - inc(pos, 2) # skip "" - # skip leading newline: - pos = HandleCRLF(L, pos) - buf = L.buf - while true: - case buf[pos] - of '\"': - if buf[pos+1] == '\"' and buf[pos+2] == '\"' and - buf[pos+3] != '\"': - L.bufpos = pos + 3 # skip the three """ - break - add(tok.literal, '\"') - Inc(pos) - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - tok.literal = tok.literal & tnl - of lexbase.EndOfFile: - var line2 = L.linenumber - L.LineNumber = line - lexMessagePos(L, errClosingTripleQuoteExpected, L.lineStart) - L.LineNumber = line2 - break - else: - add(tok.literal, buf[pos]) - Inc(pos) - else: - # ordinary string literal - if rawMode: tok.tokType = tkRStrLit - else: tok.tokType = tkStrLit - while true: - var c = buf[pos] - if c == '\"': - if rawMode and buf[pos+1] == '\"': - inc(pos, 2) - add(tok.literal, '"') - else: - inc(pos) # skip '"' - break - elif c in {CR, LF, lexbase.EndOfFile}: - lexMessage(L, errClosingQuoteExpected) - break - elif (c == '\\') and not rawMode: - L.bufPos = pos - getEscapedChar(L, tok) - pos = L.bufPos - else: - add(tok.literal, c) - Inc(pos) - L.bufpos = pos - -proc getCharacter(L: var TLexer, tok: var TToken) = - Inc(L.bufpos) # skip ' - var c = L.buf[L.bufpos] - case c - of '\0'..Pred(' '), '\'': lexMessage(L, errInvalidCharacterConstant) - of '\\': getEscapedChar(L, tok) - else: - tok.literal = $c - Inc(L.bufpos) - if L.buf[L.bufpos] != '\'': lexMessage(L, errMissingFinalQuote) - inc(L.bufpos) # skip ' - -proc getSymbol(L: var TLexer, tok: var TToken) = - var h: THash = 0 - var pos = L.bufpos - var buf = L.buf - while true: - var c = buf[pos] - case c - of 'a'..'z', '0'..'9', '\x80'..'\xFF': - h = h +% Ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - of 'A'..'Z': - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = h +% Ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - of '_': - if buf[pos+1] notin SymChars: - lexMessage(L, errInvalidToken, "_") - break - else: break - Inc(pos) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - tok.ident = getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) - L.bufpos = pos - if (tok.ident.id < ord(tokKeywordLow) - ord(tkSymbol)) or - (tok.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): - tok.tokType = tkSymbol - else: - tok.tokType = TTokType(tok.ident.id + ord(tkSymbol)) - -proc getOperator(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - var h: THash = 0 - while true: - var c = buf[pos] - if c in OpChars: - h = h +% Ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - else: - break - Inc(pos) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - tok.ident = getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) - if (tok.ident.id < oprLow) or (tok.ident.id > oprHigh): tok.tokType = tkOpr - else: tok.tokType = TTokType(tok.ident.id - oprLow + ord(tkColon)) - L.bufpos = pos - -proc handleIndentation(L: var TLexer, tok: var TToken, indent: int) = - tok.indent = indent - var i = high(L.indentStack) - if indent > L.indentStack[i]: - tok.tokType = tkInd - elif indent == L.indentStack[i]: - tok.tokType = tkSad - else: - # check we have the indentation somewhere in the stack: - while (i >= 0) and (indent != L.indentStack[i]): - dec(i) - inc(L.dedent) - dec(L.dedent) - tok.tokType = tkDed - if i < 0: - tok.tokType = tkSad # for the parser it is better as SAD - lexMessage(L, errInvalidIndentation) - -proc scanComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - # a comment ends if the next line does not start with the # on the same - # column after only whitespace - tok.tokType = tkComment - var col = getColNumber(L, pos) - while true: - while not (buf[pos] in {CR, LF, lexbase.EndOfFile}): - add(tok.literal, buf[pos]) - inc(pos) - pos = handleCRLF(L, pos) - buf = L.buf - var indent = 0 - while buf[pos] == ' ': - inc(pos) - inc(indent) - if (buf[pos] == '#') and (col == indent): - tok.literal = tok.literal & "\n" - else: - if buf[pos] > ' ': - L.indentAhead = indent - inc(L.dedent) - break - L.bufpos = pos - -proc skip(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - while true: - case buf[pos] - of ' ': - Inc(pos) - of Tabulator: - lexMessagePos(L, errTabulatorsAreNotAllowed, pos) - inc(pos) # BUGFIX - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - var indent = 0 - while buf[pos] == ' ': - Inc(pos) - Inc(indent) - if (buf[pos] > ' '): - handleIndentation(L, tok, indent) - break - else: - break # EndOfFile also leaves the loop - L.bufpos = pos - -proc rawGetTok(L: var TLexer, tok: var TToken) = - fillToken(tok) - if L.dedent > 0: - dec(L.dedent) - if L.indentAhead >= 0: - handleIndentation(L, tok, L.indentAhead) - L.indentAhead = - 1 - else: - tok.tokType = tkDed - return - skip(L, tok) - # got an documentation comment or tkIndent, return that: - if tok.toktype != tkInvalid: return - var c = L.buf[L.bufpos] - if c in SymStartChars - {'r', 'R', 'l'}: - getSymbol(L, tok) - elif c in {'0'..'9'}: - tok = getNumber(L) - else: - case c - of '#': - scanComment(L, tok) - of ':': - tok.tokType = tkColon - inc(L.bufpos) - of ',': - tok.toktype = tkComma - Inc(L.bufpos) - of 'l': - # if we parsed exactly one character and its a small L (l), this - # is treated as a warning because it may be confused with the number 1 - if not (L.buf[L.bufpos + 1] in (SymChars + {'_'})): - lexMessage(L, warnSmallLshouldNotBeUsed) - getSymbol(L, tok) - of 'r', 'R': - if L.buf[L.bufPos + 1] == '\"': - Inc(L.bufPos) - getString(L, tok, true) - else: - getSymbol(L, tok) - of '(': - Inc(L.bufpos) - if (L.buf[L.bufPos] == '.') and (L.buf[L.bufPos + 1] != '.'): - tok.toktype = tkParDotLe - Inc(L.bufpos) - else: - tok.toktype = tkParLe - of ')': - tok.toktype = tkParRi - Inc(L.bufpos) - of '[': - Inc(L.bufpos) - if (L.buf[L.bufPos] == '.') and (L.buf[L.bufPos + 1] != '.'): - tok.toktype = tkBracketDotLe - Inc(L.bufpos) - else: - tok.toktype = tkBracketLe - of ']': - tok.toktype = tkBracketRi - Inc(L.bufpos) - of '.': - if L.buf[L.bufPos + 1] == ']': - tok.tokType = tkBracketDotRi - Inc(L.bufpos, 2) - elif L.buf[L.bufPos + 1] == '}': - tok.tokType = tkCurlyDotRi - Inc(L.bufpos, 2) - elif L.buf[L.bufPos + 1] == ')': - tok.tokType = tkParDotRi - Inc(L.bufpos, 2) - else: - getOperator(L, tok) - of '{': - Inc(L.bufpos) - if (L.buf[L.bufPos] == '.') and (L.buf[L.bufPos + 1] != '.'): - tok.toktype = tkCurlyDotLe - Inc(L.bufpos) - else: - tok.toktype = tkCurlyLe - of '}': - tok.toktype = tkCurlyRi - Inc(L.bufpos) - of ';': - tok.toktype = tkSemiColon - Inc(L.bufpos) - of '`': - tok.tokType = tkAccent - Inc(L.bufpos) - of '\"': - # check for extended raw string literal: - var rawMode = L.bufpos > 0 and L.buf[L.bufpos-1] in SymChars - getString(L, tok, rawMode) - if rawMode: - # tkRStrLit -> tkGStrLit - # tkTripleStrLit -> tkGTripleStrLit - inc(tok.tokType, 2) - of '\'': - tok.tokType = tkCharLit - getCharacter(L, tok) - tok.tokType = tkCharLit - of lexbase.EndOfFile: - tok.toktype = tkEof - else: - if c in OpChars: - getOperator(L, tok) - else: - tok.literal = c & "" - tok.tokType = tkInvalid - lexMessage(L, errInvalidToken, c & " (\\" & $(ord(c)) & ')') - Inc(L.bufpos) - -dummyIdent = getIdent("") diff --git a/rod/sem.nim b/rod/sem.nim deleted file mode 100755 index bb948ffc9..000000000 --- a/rod/sem.nim +++ /dev/null @@ -1,234 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the semantic checking pass. - -import - strutils, nhashes, lists, options, scanner, ast, astalgo, trees, treetab, - wordrecg, ropes, msgs, os, condsyms, idents, rnimsyn, types, platform, math, - magicsys, pnimsyn, nversion, nimsets, semdata, evals, semfold, importer, - procfind, lookups, rodread, pragmas, passes, semtypinst, sigmatch, suggest - -proc semPass*(): TPass -# implementation - -proc considerAcc(n: PNode): PIdent = - var x = n - if x.kind == nkAccQuoted: x = x.sons[0] - case x.kind - of nkIdent: result = x.ident - of nkSym: result = x.sym.name - else: - GlobalError(n.info, errIdentifierExpected, renderTree(n)) - result = nil - -proc isTopLevel(c: PContext): bool {.inline.} = - result = c.tab.tos <= 2 - -proc newSymS(kind: TSymKind, n: PNode, c: PContext): PSym = - result = newSym(kind, considerAcc(n), getCurrOwner()) - result.info = n.info - -proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym - # identifier with visability -proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym -proc semStmtScope(c: PContext, n: PNode): PNode - -type - TExprFlag = enum - efAllowType, efLValue, efWantIterator - TExprFlags = set[TExprFlag] - -proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode -proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode -proc fitNode(c: PContext, formal: PType, arg: PNode): PNode -proc semLambda(c: PContext, n: PNode): PNode -proc semTypeNode(c: PContext, n: PNode, prev: PType): PType -proc semStmt(c: PContext, n: PNode): PNode -proc semParamList(c: PContext, n, genericParams: PNode, s: PSym) -proc addParams(c: PContext, n: PNode) -proc addResult(c: PContext, t: PType, info: TLineInfo) -proc addResultNode(c: PContext, n: PNode) -proc instGenericContainer(c: PContext, n: PNode, header: PType): PType - -proc semConstExpr(c: PContext, n: PNode): PNode = - result = semExprWithType(c, n) - if result == nil: - GlobalError(n.info, errConstExprExpected) - return - result = getConstExpr(c.module, result) - if result == nil: GlobalError(n.info, errConstExprExpected) - -proc semAndEvalConstExpr(c: PContext, n: PNode): PNode = - var e = semExprWithType(c, n) - if e == nil: - GlobalError(n.info, errConstExprExpected) - return nil - result = getConstExpr(c.module, e) - if result == nil: - #writeln(output, renderTree(n)); - result = evalConstExpr(c.module, e) - if (result == nil) or (result.kind == nkEmpty): - GlobalError(n.info, errConstExprExpected) - -proc semAfterMacroCall(c: PContext, n: PNode, s: PSym): PNode = - result = n - case s.typ.sons[0].kind - of tyExpr: - # BUGFIX: we cannot expect a type here, because module aliases would not - # work then (see the ``tmodulealias`` test) - result = semExpr(c, result) # semExprWithType(c, result) - of tyStmt: result = semStmt(c, result) - of tyTypeDesc: result.typ = semTypeNode(c, result, nil) - else: GlobalError(s.info, errInvalidParamKindX, typeToString(s.typ.sons[0])) - -include "semtempl.nim" - -proc semMacroExpr(c: PContext, n: PNode, sym: PSym, - semCheck: bool = true): PNode = - inc(evalTemplateCounter) - if evalTemplateCounter > 100: - GlobalError(n.info, errTemplateInstantiationTooNested) - markUsed(n, sym) - var p = newEvalContext(c.module, "", false) - var s = newStackFrame() - s.call = n - setlen(s.params, 2) - s.params[0] = newNodeIT(nkNilLit, n.info, sym.typ.sons[0]) - s.params[1] = n - pushStackFrame(p, s) - discard eval(p, sym.ast.sons[codePos]) - result = s.params[0] - popStackFrame(p) - if cyclicTree(result): GlobalError(n.info, errCyclicTree) - if semCheck: result = semAfterMacroCall(c, result, sym) - dec(evalTemplateCounter) - -include seminst, semcall - -proc typeMismatch(n: PNode, formal, actual: PType) = - GlobalError(n.Info, errGenerated, msgKindToString(errTypeMismatch) & - typeToString(actual) & ") " & - `%`(msgKindToString(errButExpectedX), [typeToString(formal)])) - -proc fitNode(c: PContext, formal: PType, arg: PNode): PNode = - result = IndexTypesMatch(c, formal, arg.typ, arg) - if result == nil: - #debug(arg) - typeMismatch(arg, formal, arg.typ) - -proc forceBool(c: PContext, n: PNode): PNode = - result = fitNode(c, getSysType(tyBool), n) - if result == nil: result = n - when false: - result = t - if (t.Typ == nil) or - (skipTypes(t.Typ, {tyGenericInst, tyVar, tyOrdinal}).kind != tyBool): - var a = ConvertTo(c, getSysType(tyBool), t) - if a != nil: result = a - else: LocalError(t.Info, errExprMustBeBool) - -proc semConstBoolExpr(c: PContext, n: PNode): PNode = - result = fitNode(c, getSysType(tyBool), semExprWithType(c, n)) - if result == nil: - GlobalError(n.info, errConstExprExpected) - return - result = getConstExpr(c.module, result) - if result == nil: GlobalError(n.info, errConstExprExpected) - -include semtypes, semexprs, semgnrc, semstmts - -proc addCodeForGenerics(c: PContext, n: PNode) = - for i in countup(c.lastGenericIdx, sonsLen(c.generics) - 1): - var it = c.generics.sons[i].sons[1] - if it.kind != nkSym: InternalError("addCodeForGenerics") - var prc = it.sym - if (prc.kind in {skProc, skMethod, skConverter}) and (prc.magic == mNone): - if (prc.ast == nil) or (prc.ast.sons[codePos] == nil): - InternalError(prc.info, "no code for " & prc.name.s) - addSon(n, prc.ast) - c.lastGenericIdx = sonsLen(c.generics) - -proc semExprNoFlags(c: PContext, n: PNode): PNode = - result = semExpr(c, n, {}) - -proc myOpen(module: PSym, filename: string): PPassContext = - var c = newContext(module, filename) - if (c.p != nil): InternalError(module.info, "sem.myOpen") - c.semConstExpr = semConstExpr - c.semExpr = semExprNoFlags - pushProcCon(c, module) - pushOwner(c.module) - openScope(c.tab) # scope for imported symbols - SymTabAdd(c.tab, module) # a module knows itself - if sfSystemModule in module.flags: - magicsys.SystemModule = module # set global variable! - InitSystem(c.tab) # currently does nothing - else: - SymTabAdd(c.tab, magicsys.SystemModule) # import the "System" identifier - importAllSymbols(c, magicsys.SystemModule) - openScope(c.tab) # scope for the module's symbols - result = c - -proc myOpenCached(module: PSym, filename: string, - rd: PRodReader): PPassContext = - var c = PContext(myOpen(module, filename)) - c.fromCache = true - result = c - -proc SemStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = - result = semStmt(c, n) - # BUGFIX: process newly generated generics here, not at the end! - if sonsLen(c.generics) > 0: - var a = newNodeI(nkStmtList, n.info) - addCodeForGenerics(c, a) - if sonsLen(a) > 0: - # a generic has been added to `a`: - if result.kind != nkEmpty: addSon(a, result) - result = a - -proc RecoverContext(c: PContext) = - # clean up in case of a semantic error: We clean up the stacks, etc. This is - # faster than wrapping every stack operation in a 'try finally' block and - # requires far less code. - while c.tab.tos-1 > ModuleTablePos: rawCloseScope(c.tab) - while getCurrOwner().kind != skModule: popOwner() - while c.p != nil and c.p.owner.kind != skModule: c.p = c.p.next - -proc myProcess(context: PPassContext, n: PNode): PNode = - var c = PContext(context) - # no need for an expensive 'try' if we stop after the first error anyway: - if msgs.gErrorMax <= 1: - result = SemStmtAndGenerateGenerics(c, n) - else: - try: - result = SemStmtAndGenerateGenerics(c, n) - except ERecoverableError: - RecoverContext(c) - result = ast.emptyNode - -proc myClose(context: PPassContext, n: PNode): PNode = - var c = PContext(context) - closeScope(c.tab) # close module's scope - rawCloseScope(c.tab) # imported symbols; don't check for unused ones! - if n == nil: - result = newNode(nkStmtList) - else: - InternalError(n.info, "n is not nil") #result := n; - addCodeForGenerics(c, result) - popOwner() - popProcCon(c) - -proc semPass(): TPass = - initPass(result) - result.open = myOpen - result.openCached = myOpenCached - result.close = myClose - result.process = myProcess diff --git a/rod/semcall.nim b/rod/semcall.nim deleted file mode 100755 index 294c0399b..000000000 --- a/rod/semcall.nim +++ /dev/null @@ -1,120 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements semantic checking for calls. - -proc sameMethodDispatcher(a, b: PSym): bool = - result = false - if a.kind == skMethod and b.kind == skMethod: - var aa = lastSon(a.ast) - var bb = lastSon(b.ast) - if aa.kind == nkSym and bb.kind == nkSym and aa.sym == bb.sym: - result = true - -proc semDirectCallWithBinding(c: PContext, n, f: PNode, filter: TSymKinds, - initialBinding: PNode): PNode = - var - o: TOverloadIter - x, y, z: TCandidate - #Message(n.info, warnUser, renderTree(n)) - var sym = initOverloadIter(o, c, f) - result = nil - if sym == nil: return - initCandidate(x, sym, initialBinding) - initCandidate(y, sym, initialBinding) - - while sym != nil: - if sym.kind in filter: - initCandidate(z, sym, initialBinding) - z.calleeSym = sym - matches(c, n, z) - if z.state == csMatch: - case x.state - of csEmpty, csNoMatch: x = z - of csMatch: - var cmp = cmpCandidates(x, z) - if cmp < 0: x = z # z is better than x - elif cmp == 0: y = z # z is as good as x - else: nil - sym = nextOverloadIter(o, c, f) - if x.state == csEmpty: - # no overloaded proc found - # do not generate an error yet; the semantic checking will check for - # an overloaded () operator - elif y.state == csMatch and cmpCandidates(x, y) == 0 and - not sameMethodDispatcher(x.calleeSym, y.calleeSym): - if x.state != csMatch: - InternalError(n.info, "x.state is not csMatch") - LocalError(n.Info, errGenerated, msgKindToString(errAmbiguousCallXYZ) % [ - getProcHeader(x.calleeSym), getProcHeader(y.calleeSym), - x.calleeSym.Name.s]) - else: - # only one valid interpretation found: - markUsed(n, x.calleeSym) - if x.calleeSym.ast == nil: - internalError(n.info, "calleeSym.ast is nil") # XXX: remove this check! - if x.calleeSym.ast.sons[genericParamsPos].kind != nkEmpty: - # a generic proc! - x.calleeSym = generateInstance(c, x.calleeSym, x.bindings, n.info) - x.callee = x.calleeSym.typ - result = x.call - result.sons[0] = newSymNode(x.calleeSym) - result.typ = x.callee.sons[0] - -proc semDirectCall(c: PContext, n: PNode, filter: TSymKinds): PNode = - # process the bindings once: - var initialBinding: PNode - var f = n.sons[0] - if f.kind == nkBracketExpr: - # fill in the bindings: - initialBinding = f - f = f.sons[0] - else: - initialBinding = nil - result = semDirectCallWithBinding(c, n, f, filter, initialBinding) - -proc explicitGenericInstError(n: PNode): PNode = - LocalError(n.info, errCannotInstantiateX, renderTree(n)) - result = n - -proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = - assert n.kind == nkBracketExpr - for i in 1..sonsLen(n)-1: - n.sons[i].typ = semTypeNode(c, n.sons[i], nil) - var s = s - var a = n.sons[0] - if a.kind == nkSym: - # common case; check the only candidate has the right - # number of generic type parameters: - if safeLen(s.ast.sons[genericParamsPos]) != n.len-1: - return explicitGenericInstError(n) - elif a.kind == nkSymChoice: - # choose the generic proc with the proper number of type parameters. - # XXX I think this could be improved by reusing sigmatch.ParamTypesMatch. - # It's good enough for now. - var candidateCount = 0 - for i in countup(0, len(a)-1): - var candidate = a.sons[i].sym - if candidate.kind in {skProc, skMethod, skConverter, skIterator}: - # if suffices that the candidate has the proper number of generic - # type parameters: - if safeLen(candidate.ast.sons[genericParamsPos]) == n.len-1: - s = candidate - inc(candidateCount) - if candidateCount != 1: return explicitGenericInstError(n) - else: - assert false - - var x: TCandidate - initCandidate(x, s, n) - var newInst = generateInstance(c, s, x.bindings, n.info) - - markUsed(n, s) - result = newSymNode(newInst, n.info) - diff --git a/rod/semdata.nim b/rod/semdata.nim deleted file mode 100755 index e052a0baf..000000000 --- a/rod/semdata.nim +++ /dev/null @@ -1,187 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module contains the data structures for the semantic checking phase. - -import - strutils, lists, options, scanner, ast, astalgo, trees, treetab, wordrecg, - ropes, msgs, platform, os, condsyms, idents, rnimsyn, types, extccomp, math, - magicsys, nversion, nimsets, pnimsyn, times, passes, rodread - -type - TOptionEntry* = object of lists.TListEntry # entries to put on a - # stack for pragma parsing - options*: TOptions - defaultCC*: TCallingConvention - dynlib*: PLib - Notes*: TNoteKinds - - POptionEntry* = ref TOptionEntry - PProcCon* = ref TProcCon - TProcCon*{.final.} = object # procedure context; also used for top-level - # statements - owner*: PSym # the symbol this context belongs to - resultSym*: PSym # the result symbol (if we are in a proc) - nestedLoopCounter*: int # whether we are in a loop or not - nestedBlockCounter*: int # whether we are in a block or not - next*: PProcCon # used for stacking procedure contexts - - PContext* = ref TContext - TContext* = object of TPassContext # a context represents a module - module*: PSym # the module sym belonging to the context - p*: PProcCon # procedure context - InstCounter*: int # to prevent endless instantiations - generics*: PNode # a list of the things to compile; list of - # nkExprEqExpr nodes which contain the - # generic symbol and the instantiated symbol - lastGenericIdx*: int # used for the generics stack - tab*: TSymTab # each module has its own symbol table - AmbiguousSymbols*: TIntSet # ids of all ambiguous symbols (cannot - # store this info in the syms themselves!) - converters*: TSymSeq # sequence of converters - optionStack*: TLinkedList - libs*: TLinkedList # all libs used by this module - fromCache*: bool # is the module read from a cache? - semConstExpr*: proc (c: PContext, n: PNode): PNode # for the pragmas - semExpr*: proc (c: PContext, n: PNode): PNode # for the pragmas - includedFiles*: TIntSet # used to detect recursive include files - filename*: string # the module's filename - userPragmas*: TStrTable - - -var gInstTypes*: TIdTable # map PType to PType - -proc newContext*(module: PSym, nimfile: string): PContext - -proc lastOptionEntry*(c: PContext): POptionEntry -proc newOptionEntry*(): POptionEntry -proc addConverter*(c: PContext, conv: PSym) -proc newLib*(kind: TLibKind): PLib -proc addToLib*(lib: PLib, sym: PSym) -proc makePtrType*(c: PContext, baseType: PType): PType -proc makeVarType*(c: PContext, baseType: PType): PType -proc newTypeS*(kind: TTypeKind, c: PContext): PType -proc fillTypeS*(dest: PType, kind: TTypeKind, c: PContext) -proc makeRangeType*(c: PContext, first, last: biggestInt, info: TLineInfo): PType - -# owner handling: -proc getCurrOwner*(): PSym -proc PushOwner*(owner: PSym) -proc PopOwner*() -# implementation - -var gOwners: seq[PSym] = @[] - -proc getCurrOwner(): PSym = - # owner stack (used for initializing the - # owner field of syms) - # the documentation comment always gets - # assigned to the current owner - # BUGFIX: global array is needed! - result = gOwners[high(gOwners)] - -proc PushOwner(owner: PSym) = - add(gOwners, owner) - -proc PopOwner() = - var length = len(gOwners) - if (length <= 0): InternalError("popOwner") - setlen(gOwners, length - 1) - -proc lastOptionEntry(c: PContext): POptionEntry = - result = POptionEntry(c.optionStack.tail) - -proc pushProcCon*(c: PContext, owner: PSym) {.inline.} = - if owner == nil: InternalError("owner is nil") - var x: PProcCon - new(x) - x.owner = owner - x.next = c.p - c.p = x - -proc popProcCon*(c: PContext) {.inline.} = c.p = c.p.next - -proc newOptionEntry(): POptionEntry = - new(result) - result.options = gOptions - result.defaultCC = ccDefault - result.dynlib = nil - result.notes = gNotes - -proc newContext(module: PSym, nimfile: string): PContext = - new(result) - InitSymTab(result.tab) - IntSetInit(result.AmbiguousSymbols) - initLinkedList(result.optionStack) - initLinkedList(result.libs) - append(result.optionStack, newOptionEntry()) - result.module = module - result.generics = newNode(nkStmtList) - result.converters = @[] - result.filename = nimfile - IntSetInit(result.includedFiles) - initStrTable(result.userPragmas) - -proc addConverter(c: PContext, conv: PSym) = - var L = len(c.converters) - for i in countup(0, L - 1): - if c.converters[i].id == conv.id: return - setlen(c.converters, L + 1) - c.converters[L] = conv - -proc newLib(kind: TLibKind): PLib = - new(result) - result.kind = kind #initObjectSet(result.syms) - -proc addToLib(lib: PLib, sym: PSym) = - #ObjectSetIncl(lib.syms, sym); - if sym.annex != nil: LocalError(sym.info, errInvalidPragma) - sym.annex = lib - -proc makePtrType(c: PContext, baseType: PType): PType = - if (baseType == nil): InternalError("makePtrType") - result = newTypeS(tyPtr, c) - addSon(result, baseType) - -proc makeVarType(c: PContext, baseType: PType): PType = - if (baseType == nil): InternalError("makeVarType") - result = newTypeS(tyVar, c) - addSon(result, baseType) - -proc newTypeS(kind: TTypeKind, c: PContext): PType = - result = newType(kind, getCurrOwner()) - -proc fillTypeS(dest: PType, kind: TTypeKind, c: PContext) = - dest.kind = kind - dest.owner = getCurrOwner() - dest.size = - 1 - -proc makeRangeType(c: PContext, first, last: biggestInt, - info: TLineInfo): PType = - var n = newNodeI(nkRange, info) - addSon(n, newIntNode(nkIntLit, first)) - addSon(n, newIntNode(nkIntLit, last)) - result = newTypeS(tyRange, c) - result.n = n - addSon(result, getSysType(tyInt)) # basetype of range - -proc markUsed*(n: PNode, s: PSym) = - incl(s.flags, sfUsed) - if sfDeprecated in s.flags: Message(n.info, warnDeprecated, s.name.s) - -proc illFormedAst*(n: PNode) = - GlobalError(n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) - -proc checkSonsLen*(n: PNode, length: int) = - if sonsLen(n) != length: illFormedAst(n) - -proc checkMinSonsLen*(n: PNode, length: int) = - if sonsLen(n) < length: illFormedAst(n) - -initIdTable(gInstTypes) diff --git a/rod/semexprs.nim b/rod/semexprs.nim deleted file mode 100755 index 8f8a1dc17..000000000 --- a/rod/semexprs.nim +++ /dev/null @@ -1,1092 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# this module does the semantic checking for expressions -const - ConstAbstractTypes = {tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, - tyArrayConstr, tyTuple, tySet} - -proc semTemplateExpr(c: PContext, n: PNode, s: PSym, semCheck = true): PNode = - markUsed(n, s) - pushInfoContext(n.info) - result = evalTemplate(c, n, s) - if semCheck: result = semAfterMacroCall(c, result, s) - popInfoContext() - -proc semFieldAccess(c: PContext, n: PNode, flags: TExprFlags = {}): PNode - -proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = - result = semExpr(c, n, flags) - if result.kind == nkEmpty: - # do not produce another redundant error message: - raiseRecoverableError() - if result.typ != nil: - if result.typ.kind == tyVar: - var d = newNodeIT(nkHiddenDeref, result.info, result.typ.sons[0]) - addSon(d, result) - result = d - else: - GlobalError(n.info, errExprXHasNoType, - renderTree(result, {renderNoComments})) - -proc semSym(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = - if s.kind == skType and efAllowType notin flags: - GlobalError(n.info, errATypeHasNoValue) - case s.kind - of skProc, skMethod, skIterator, skConverter: - if not (sfProcVar in s.flags) and (s.typ.callConv == ccDefault) and - (getModule(s).id != c.module.id): - LocalError(n.info, errXCannotBePassedToProcVar, s.name.s) - result = symChoice(c, n, s) - of skConst: - # - # Consider:: - # const x = [] - # proc p(a: openarray[int]) - # proc q(a: openarray[char]) - # p(x) - # q(x) - # - # It is clear that ``[]`` means two totally different things. Thus, we - # copy `x`'s AST into each context, so that the type fixup phase can - # deal with two different ``[]``. - # - markUsed(n, s) - if s.typ.kind in ConstAbstractTypes: - result = copyTree(s.ast) - result.typ = s.typ - result.info = n.info - else: - result = newSymNode(s, n.info) - of skMacro: result = semMacroExpr(c, n, s) - of skTemplate: result = semTemplateExpr(c, n, s) - of skVar: - markUsed(n, s) - # if a proc accesses a global variable, it is not side effect free: - if sfGlobal in s.flags: incl(c.p.owner.flags, sfSideEffect) - result = newSymNode(s, n.info) - of skGenericParam: - if s.ast == nil: InternalError(n.info, "no default for") - result = semExpr(c, s.ast) - else: - markUsed(n, s) - result = newSymNode(s, n.info) - -proc checkConversionBetweenObjects(info: TLineInfo, castDest, src: PType) = - var diff = inheritanceDiff(castDest, src) - if diff == high(int): - GlobalError(info, errGenerated, `%`(MsgKindToString(errIllegalConvFromXtoY), [ - typeToString(src), typeToString(castDest)])) - -proc checkConvertible(info: TLineInfo, castDest, src: PType) = - const - IntegralTypes = {tyBool, tyEnum, tyChar, tyInt..tyFloat128} - if sameType(castDest, src): - # don't annoy conversions that may be needed on another processor: - if not (castDest.kind in {tyInt..tyFloat128, tyNil}): - Message(info, hintConvFromXtoItselfNotNeeded, typeToString(castDest)) - return - var d = skipTypes(castDest, abstractVar) - var s = skipTypes(src, abstractVar) - while (d != nil) and (d.Kind in {tyPtr, tyRef}) and (d.Kind == s.Kind): - d = base(d) - s = base(s) - if d == nil: - GlobalError(info, errGenerated, `%`(msgKindToString(errIllegalConvFromXtoY), [ - typeToString(src), typeToString(castDest)])) - elif d.Kind == tyObject and s.Kind == tyObject: - checkConversionBetweenObjects(info, d, s) - elif (skipTypes(castDest, abstractVarRange).Kind in IntegralTypes) and - (skipTypes(src, abstractVarRange).Kind in IntegralTypes): - # accept conversion between integral types - else: - # we use d, s here to speed up that operation a bit: - case cmpTypes(d, s) - of isNone, isGeneric: - if not equalOrDistinctOf(castDest, src) and - not equalOrDistinctOf(src, castDest): - GlobalError(info, errGenerated, `%`( - MsgKindToString(errIllegalConvFromXtoY), - [typeToString(src), typeToString(castDest)])) - else: - nil - -proc isCastable(dst, src: PType): bool = - #const - # castableTypeKinds = {tyInt, tyPtr, tyRef, tyCstring, tyString, - # tySequence, tyPointer, tyNil, tyOpenArray, - # tyProc, tySet, tyEnum, tyBool, tyChar} - var ds, ss: biggestInt - # this is very unrestrictive; cast is allowed if castDest.size >= src.size - ds = computeSize(dst) - ss = computeSize(src) - if ds < 0: - result = false - elif ss < 0: - result = false - else: - result = (ds >= ss) or - (skipTypes(dst, abstractInst).kind in {tyInt..tyFloat128}) or - (skipTypes(src, abstractInst).kind in {tyInt..tyFloat128}) - -proc semConv(c: PContext, n: PNode, s: PSym): PNode = - if sonsLen(n) != 2: GlobalError(n.info, errConvNeedsOneArg) - result = newNodeI(nkConv, n.info) - result.typ = semTypeNode(c, n.sons[0], nil) - addSon(result, copyTree(n.sons[0])) - addSon(result, semExprWithType(c, n.sons[1])) - var op = result.sons[1] - if op.kind != nkSymChoice: - checkConvertible(result.info, result.typ, op.typ) - else: - for i in countup(0, sonsLen(op) - 1): - if sameType(result.typ, op.sons[i].typ): - markUsed(n, op.sons[i].sym) - return op.sons[i] - localError(n.info, errUseQualifier, op.sons[0].sym.name.s) - -proc semCast(c: PContext, n: PNode): PNode = - if optSafeCode in gGlobalOptions: localError(n.info, errCastNotInSafeMode) - incl(c.p.owner.flags, sfSideEffect) - checkSonsLen(n, 2) - result = newNodeI(nkCast, n.info) - result.typ = semTypeNode(c, n.sons[0], nil) - addSon(result, copyTree(n.sons[0])) - addSon(result, semExprWithType(c, n.sons[1])) - if not isCastable(result.typ, result.sons[1].Typ): - GlobalError(result.info, errExprCannotBeCastedToX, typeToString(result.Typ)) - -proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = - const - opToStr: array[mLow..mHigh, string] = ["low", "high"] - if sonsLen(n) != 2: - GlobalError(n.info, errXExpectsTypeOrValue, opToStr[m]) - else: - n.sons[1] = semExprWithType(c, n.sons[1], {efAllowType}) - var typ = skipTypes(n.sons[1].typ, abstractVarRange) - case typ.Kind - of tySequence, tyString, tyOpenArray: - n.typ = getSysType(tyInt) - of tyArrayConstr, tyArray: - n.typ = n.sons[1].typ.sons[0] # indextype - of tyInt..tyInt64, tyChar, tyBool, tyEnum: - n.typ = n.sons[1].typ - else: GlobalError(n.info, errInvalidArgForX, opToStr[m]) - result = n - -proc semSizeof(c: PContext, n: PNode): PNode = - if sonsLen(n) != 2: GlobalError(n.info, errXExpectsTypeOrValue, "sizeof") - else: n.sons[1] = semExprWithType(c, n.sons[1], {efAllowType}) - n.typ = getSysType(tyInt) - result = n - -proc semIs(c: PContext, n: PNode): PNode = - if sonsLen(n) == 3: - n.sons[1] = semExprWithType(c, n.sons[1], {efAllowType}) - n.sons[2] = semExprWithType(c, n.sons[2], {efAllowType}) - var a = n.sons[1].typ - var b = n.sons[2].typ - # a and b can be nil in case of an error: - if a != nil and b != nil: - if (b.kind != tyObject) or (a.kind != tyObject): - GlobalError(n.info, errIsExpectsObjectTypes) - while (b != nil) and (b.id != a.id): b = b.sons[0] - if b == nil: - GlobalError(n.info, errXcanNeverBeOfThisSubtype, typeToString(a)) - n.typ = getSysType(tyBool) - else: - GlobalError(n.info, errIsExpectsTwoArguments) - result = n - -proc semOpAux(c: PContext, n: PNode) = - for i in countup(1, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkExprEqExpr and sonsLen(a) == 2: - var info = a.sons[0].info - a.sons[0] = newIdentNode(considerAcc(a.sons[0]), info) - a.sons[1] = semExprWithType(c, a.sons[1]) - a.typ = a.sons[1].typ - else: - n.sons[i] = semExprWithType(c, a) - -proc overloadedCallOpr(c: PContext, n: PNode): PNode = - # quick check if there is *any* () operator overloaded: - var par = getIdent("()") - if SymtabGet(c.Tab, par) == nil: - result = nil - else: - result = newNodeI(nkCall, n.info) - addSon(result, newIdentNode(par, n.info)) - for i in countup(0, sonsLen(n) - 1): addSon(result, n.sons[i]) - result = semExpr(c, result) - -proc changeType(n: PNode, newType: PType) = - case n.kind - of nkCurly, nkBracket: - for i in countup(0, sonsLen(n) - 1): - changeType(n.sons[i], elemType(newType)) - of nkPar: - if newType.kind != tyTuple: - InternalError(n.info, "changeType: no tuple type for constructor") - if newType.n == nil: InternalError(n.info, "changeType: no tuple fields") - if (sonsLen(n) > 0) and (n.sons[0].kind == nkExprColonExpr): - for i in countup(0, sonsLen(n) - 1): - var m = n.sons[i].sons[0] - if m.kind != nkSym: - internalError(m.info, "changeType(): invalid tuple constr") - var f = getSymFromList(newType.n, m.sym.name) - if f == nil: internalError(m.info, "changeType(): invalid identifier") - changeType(n.sons[i].sons[1], f.typ) - else: - for i in countup(0, sonsLen(n) - 1): - var m = n.sons[i] - var a = newNodeIT(nkExprColonExpr, m.info, newType.sons[i]) - addSon(a, newSymNode(newType.n.sons[i].sym)) - addSon(a, m) - changeType(m, newType.sons[i]) - n.sons[i] = a - else: nil - n.typ = newType - -proc semArrayConstr(c: PContext, n: PNode): PNode = - result = newNodeI(nkBracket, n.info) - result.typ = newTypeS(tyArrayConstr, c) - addSon(result.typ, nil) # index type - if sonsLen(n) == 0: - addSon(result.typ, newTypeS(tyEmpty, c)) # needs an empty basetype! - else: - var x = n.sons[0] - var lastIndex: biggestInt = 0 - var indexType = getSysType(tyInt) - if x.kind == nkExprColonExpr and sonsLen(x) == 2: - var idx = semConstExpr(c, x.sons[0]) - lastIndex = getOrdValue(idx) - indexType = idx.typ - x = x.sons[1] - - addSon(result, semExprWithType(c, x)) - var typ = skipTypes(result.sons[0].typ, {tyGenericInst, tyVar, tyOrdinal}) - for i in countup(1, sonsLen(n) - 1): - x = n.sons[i] - if x.kind == nkExprColonExpr and sonsLen(x) == 2: - var idx = semConstExpr(c, x.sons[0]) - idx = fitNode(c, indexType, idx) - if lastIndex+1 != getOrdValue(idx): - localError(x.info, errInvalidOrderInArrayConstructor) - x = x.sons[1] - - n.sons[i] = semExprWithType(c, x) - addSon(result, fitNode(c, typ, n.sons[i])) - inc(lastIndex) - addSon(result.typ, typ) - result.typ.sons[0] = makeRangeType(c, 0, sonsLen(result) - 1, n.info) - -proc fixAbstractType(c: PContext, n: PNode) = - for i in countup(1, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkHiddenStdConv, nkHiddenSubConv: - if it.sons[1].kind == nkBracket: - it.sons[1] = semArrayConstr(c, it.sons[1]) - if skipTypes(it.typ, abstractVar).kind == tyOpenArray: - var s = skipTypes(it.sons[1].typ, abstractVar) - if (s.kind == tyArrayConstr) and (s.sons[1].kind == tyEmpty): - s = copyType(s, getCurrOwner(), false) - skipTypes(s, abstractVar).sons[1] = elemType( - skipTypes(it.typ, abstractVar)) - it.sons[1].typ = s - elif skipTypes(it.sons[1].typ, abstractVar).kind in - {tyNil, tyArrayConstr, tyTuple, tySet}: - var s = skipTypes(it.typ, abstractVar) - changeType(it.sons[1], s) - n.sons[i] = it.sons[1] - of nkBracket: - # an implicitely constructed array (passed to an open array): - n.sons[i] = semArrayConstr(c, it) - else: - if (it.typ == nil): - InternalError(it.info, "fixAbstractType: " & renderTree(it)) - -proc skipObjConv(n: PNode): PNode = - case n.kind - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - if skipTypes(n.sons[1].typ, abstractPtrs).kind in {tyTuple, tyObject}: - result = n.sons[1] - else: - result = n - of nkObjUpConv, nkObjDownConv: result = n.sons[0] - else: result = n - -type - TAssignableResult = enum - arNone, # no l-value and no discriminant - arLValue, # is an l-value - arDiscriminant # is a discriminant - -proc isAssignable(n: PNode): TAssignableResult = - result = arNone - case n.kind - of nkSym: - if (n.sym.kind in {skVar, skTemp}): result = arLValue - of nkDotExpr: - if skipTypes(n.sons[0].typ, abstractInst).kind in {tyVar, tyPtr, tyRef}: - result = arLValue - else: - result = isAssignable(n.sons[0]) - if (result == arLValue) and (sfDiscriminant in n.sons[1].sym.flags): - result = arDiscriminant - of nkBracketExpr: - if skipTypes(n.sons[0].typ, abstractInst).kind in {tyVar, tyPtr, tyRef}: - result = arLValue - else: - result = isAssignable(n.sons[0]) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - # Object and tuple conversions are still addressable, so we skip them - if skipTypes(n.typ, abstractPtrs).kind in {tyOpenArray, tyTuple, tyObject}: - result = isAssignable(n.sons[1]) - of nkHiddenDeref, nkDerefExpr: - result = arLValue - of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: - result = isAssignable(n.sons[0]) - else: - nil - -proc newHiddenAddrTaken(c: PContext, n: PNode): PNode = - if n.kind == nkHiddenDeref: - checkSonsLen(n, 1) - result = n.sons[0] - else: - result = newNodeIT(nkHiddenAddr, n.info, makeVarType(c, n.typ)) - addSon(result, n) - if isAssignable(n) != arLValue: - localError(n.info, errVarForOutParamNeeded) - -proc analyseIfAddressTaken(c: PContext, n: PNode): PNode = - result = n - case n.kind - of nkSym: - if skipTypes(n.sym.typ, abstractInst).kind != tyVar: - incl(n.sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) - of nkDotExpr: - checkSonsLen(n, 2) - if n.sons[1].kind != nkSym: internalError(n.info, "analyseIfAddressTaken") - if skipTypes(n.sons[1].sym.typ, abstractInst).kind != tyVar: - incl(n.sons[1].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) - of nkBracketExpr: - checkMinSonsLen(n, 1) - if skipTypes(n.sons[0].typ, abstractInst).kind != tyVar: - if n.sons[0].kind == nkSym: incl(n.sons[0].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) - else: - result = newHiddenAddrTaken(c, n) # BUGFIX! - -proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = - const - FakeVarParams = {mNew, mNewFinalize, mInc, ast.mDec, mIncl, mExcl, - mSetLengthStr, mSetLengthSeq, mAppendStrCh, mAppendStrStr, mSwap, - mAppendSeqElem, mNewSeq, mReset} - checkMinSonsLen(n, 1) - var t = n.sons[0].typ - if (n.sons[0].kind == nkSym) and (n.sons[0].sym.magic in FakeVarParams): - # BUGFIX: check for L-Value still needs to be done for the arguments! - for i in countup(1, sonsLen(n) - 1): - if i < sonsLen(t) and t.sons[i] != nil and - skipTypes(t.sons[i], abstractInst).kind == tyVar: - if isAssignable(n.sons[i]) != arLValue: - LocalError(n.sons[i].info, errVarForOutParamNeeded) - return - for i in countup(1, sonsLen(n) - 1): - if (i < sonsLen(t)) and - (skipTypes(t.sons[i], abstractInst).kind == tyVar): - n.sons[i] = analyseIfAddressTaken(c, n.sons[i]) - -proc semDirectCallAnalyseEffects(c: PContext, n: PNode, - flags: TExprFlags): PNode = - var symflags = {skProc, skMethod, skConverter} - if efWantIterator in flags: - # for ``type countup(1,3)``, see ``tests/ttoseq``. - symflags = {skIterator} - result = semDirectCall(c, n, symflags) - if result != nil: - if result.sons[0].kind != nkSym: - InternalError("semDirectCallAnalyseEffects") - var callee = result.sons[0].sym - if (callee.kind == skIterator) and (callee.id == c.p.owner.id): - GlobalError(n.info, errRecursiveDependencyX, callee.name.s) - if not (sfNoSideEffect in callee.flags): - if (sfForward in callee.flags) or - ({sfImportc, sfSideEffect} * callee.flags != {}): - incl(c.p.owner.flags, sfSideEffect) - -proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = - result = nil - var prc = n.sons[0] - checkMinSonsLen(n, 1) - if n.sons[0].kind == nkDotExpr: - checkSonsLen(n.sons[0], 2) - n.sons[0] = semFieldAccess(c, n.sons[0]) - if n.sons[0].kind == nkDotCall: - # it is a static call! - result = n.sons[0] - result.kind = nkCall - for i in countup(1, sonsLen(n) - 1): addSon(result, n.sons[i]) - return semExpr(c, result, flags) - else: - n.sons[0] = semExpr(c, n.sons[0]) - semOpAux(c, n) - var t: PType = nil - if (n.sons[0].typ != nil): t = skipTypes(n.sons[0].typ, abstractInst) - if (t != nil) and (t.kind == tyProc): - var m: TCandidate - initCandidate(m, t) - matches(c, n, m) - if m.state != csMatch: - var msg = msgKindToString(errTypeMismatch) - for i in countup(1, sonsLen(n) - 1): - if i > 1: add(msg, ", ") - add(msg, typeToString(n.sons[i].typ)) - add(msg, ")\n" & msgKindToString(errButExpected) & "\n" & - typeToString(n.sons[0].typ)) - GlobalError(n.Info, errGenerated, msg) - result = nil - else: - result = m.call - # we assume that a procedure that calls something indirectly - # has side-effects: - if not (tfNoSideEffect in t.flags): incl(c.p.owner.flags, sfSideEffect) - else: - result = overloadedCallOpr(c, n) - # Now that nkSym does not imply an iteration over the proc/iterator space, - # the old ``prc`` (which is likely an nkIdent) has to be restored: - if result == nil: - n.sons[0] = prc - result = semDirectCallAnalyseEffects(c, n, flags) - if result == nil: - GlobalError(n.info, errExprXCannotBeCalled, - renderTree(n, {renderNoComments})) - fixAbstractType(c, result) - analyseIfAddressTakenInCall(c, result) - -proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = - # this seems to be a hotspot in the compiler! - semOpAux(c, n) - result = semDirectCallAnalyseEffects(c, n, flags) - if result == nil: - result = overloadedCallOpr(c, n) - if result == nil: GlobalError(n.Info, errGenerated, getNotFoundError(c, n)) - fixAbstractType(c, result) - analyseIfAddressTakenInCall(c, result) - -proc buildStringify(c: PContext, arg: PNode): PNode = - if arg.typ != nil and skipTypes(arg.typ, abstractInst).kind == tyString: - result = arg - else: - result = newNodeI(nkCall, arg.info) - addSon(result, newIdentNode(getIdent"$", arg.info)) - addSon(result, arg) - -proc semEcho(c: PContext, n: PNode): PNode = - # this really is a macro - checkMinSonsLen(n, 1) - for i in countup(1, sonsLen(n) - 1): - var arg = semExprWithType(c, n.sons[i]) - n.sons[i] = semExpr(c, buildStringify(c, arg)) - result = n - -proc LookUpForDefined(c: PContext, n: PNode, onlyCurrentScope: bool): PSym = - case n.kind - of nkIdent: - if onlyCurrentScope: - result = SymtabLocalGet(c.tab, n.ident) - else: - result = SymtabGet(c.Tab, n.ident) # no need for stub loading - of nkDotExpr: - result = nil - if onlyCurrentScope: return - checkSonsLen(n, 2) - var m = LookupForDefined(c, n.sons[0], onlyCurrentScope) - if (m != nil) and (m.kind == skModule): - if (n.sons[1].kind == nkIdent): - var ident = n.sons[1].ident - if m == c.module: - result = StrTableGet(c.tab.stack[ModuleTablePos], ident) - else: - result = StrTableGet(m.tab, ident) - else: - GlobalError(n.sons[1].info, errIdentifierExpected, "") - of nkAccQuoted: - checkSonsLen(n, 1) - result = lookupForDefined(c, n.sons[0], onlyCurrentScope) - else: - GlobalError(n.info, errIdentifierExpected, renderTree(n)) - result = nil - -proc semDefined(c: PContext, n: PNode, onlyCurrentScope: bool): PNode = - checkSonsLen(n, 2) - # we replace this node by a 'true' or 'false' node: - result = newIntNode(nkIntLit, 0) - if LookUpForDefined(c, n.sons[1], onlyCurrentScope) != nil: - result.intVal = 1 - elif not onlyCurrentScope and (n.sons[1].kind == nkIdent) and - condsyms.isDefined(n.sons[1].ident): - result.intVal = 1 - result.info = n.info - result.typ = getSysType(tyBool) - -proc setMs(n: PNode, s: PSym): PNode = - result = n - n.sons[0] = newSymNode(s) - n.sons[0].info = n.info - -proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = - # this is a hotspot in the compiler! - result = n - case s.magic # magics that need special treatment - of mDefined: result = semDefined(c, setMs(n, s), false) - of mDefinedInScope: result = semDefined(c, setMs(n, s), true) - of mLow: result = semLowHigh(c, setMs(n, s), mLow) - of mHigh: result = semLowHigh(c, setMs(n, s), mHigh) - of mSizeOf: result = semSizeof(c, setMs(n, s)) - of mIs: result = semIs(c, setMs(n, s)) - of mEcho: result = semEcho(c, setMs(n, s)) - else: result = semDirectOp(c, n, flags) - -proc isTypeExpr(n: PNode): bool = - case n.kind - of nkType, nkTypeOfExpr: result = true - of nkSym: result = n.sym.kind == skType - else: result = false - -proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, - check: var PNode): PSym = - # transform in a node that contains the runtime check for the - # field, if it is in a case-part... - result = nil - case r.kind - of nkRecList: - for i in countup(0, sonsLen(r) - 1): - result = lookupInRecordAndBuildCheck(c, n, r.sons[i], field, check) - if result != nil: return - of nkRecCase: - checkMinSonsLen(r, 2) - if (r.sons[0].kind != nkSym): IllFormedAst(r) - result = lookupInRecordAndBuildCheck(c, n, r.sons[0], field, check) - if result != nil: return - var s = newNodeI(nkCurly, r.info) - for i in countup(1, sonsLen(r) - 1): - var it = r.sons[i] - case it.kind - of nkOfBranch: - result = lookupInRecordAndBuildCheck(c, n, lastSon(it), field, check) - if result == nil: - for j in 0..sonsLen(it)-2: addSon(s, copyTree(it.sons[j])) - else: - if check == nil: - check = newNodeI(nkCheckedFieldExpr, n.info) - addSon(check, ast.emptyNode) # make space for access node - s = newNodeI(nkCurly, n.info) - for j in countup(0, sonsLen(it) - 2): addSon(s, copyTree(it.sons[j])) - var inExpr = newNodeI(nkCall, n.info) - addSon(inExpr, newIdentNode(getIdent("in"), n.info)) - addSon(inExpr, copyTree(r.sons[0])) - addSon(inExpr, s) #writeln(output, renderTree(inExpr)); - addSon(check, semExpr(c, inExpr)) - return - of nkElse: - result = lookupInRecordAndBuildCheck(c, n, lastSon(it), field, check) - if result != nil: - if check == nil: - check = newNodeI(nkCheckedFieldExpr, n.info) - addSon(check, ast.emptyNode) # make space for access node - var inExpr = newNodeI(nkCall, n.info) - addSon(inExpr, newIdentNode(getIdent("in"), n.info)) - addSon(inExpr, copyTree(r.sons[0])) - addSon(inExpr, s) - var notExpr = newNodeI(nkCall, n.info) - addSon(notExpr, newIdentNode(getIdent("not"), n.info)) - addSon(notExpr, inExpr) - addSon(check, semExpr(c, notExpr)) - return - else: illFormedAst(it) - of nkSym: - if r.sym.name.id == field.id: result = r.sym - else: illFormedAst(n) - -proc makeDeref(n: PNode): PNode = - var t = skipTypes(n.typ, {tyGenericInst}) - result = n - if t.kind == tyVar: - result = newNodeIT(nkHiddenDeref, n.info, t.sons[0]) - addSon(result, n) - t = skipTypes(t.sons[0], {tyGenericInst}) - if t.kind in {tyPtr, tyRef}: - var a = result - result = newNodeIT(nkHiddenDeref, n.info, t.sons[0]) - addSon(result, a) - -proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = - ## returns nil if it's not a built-in field access - var s = qualifiedLookup(c, n, {checkAmbiguity, checkUndeclared}) - if s != nil: - return semSym(c, n, s, flags) - - checkSonsLen(n, 2) - n.sons[0] = semExprWithType(c, n.sons[0], {efAllowType} + flags) - var i = considerAcc(n.sons[1]) - var ty = n.sons[0].Typ - var f: PSym = nil - result = nil - if isTypeExpr(n.sons[0]): - if ty.kind == tyEnum: - # look up if the identifier belongs to the enum: - while ty != nil: - f = getSymFromList(ty.n, i) - if f != nil: break - ty = ty.sons[0] # enum inheritance - if f != nil: - result = newSymNode(f) - result.info = n.info - result.typ = ty - markUsed(n, f) - return - elif efAllowType notin flags: - GlobalError(n.sons[0].info, errATypeHasNoValue) - return - ty = skipTypes(ty, {tyGenericInst, tyVar, tyPtr, tyRef}) - var check: PNode = nil - if ty.kind == tyObject: - while true: - check = nil - f = lookupInRecordAndBuildCheck(c, n, ty.n, i, check) - if f != nil: break - if ty.sons[0] == nil: break - ty = skipTypes(ty.sons[0], {tyGenericInst}) - if f != nil: - if {sfStar, sfMinus} * f.flags != {} or getModule(f).id == c.module.id: - # is the access to a public field or in the same module? - n.sons[0] = makeDeref(n.sons[0]) - n.sons[1] = newSymNode(f) # we now have the correct field - n.typ = f.typ - markUsed(n, f) - if check == nil: - result = n - else: - check.sons[0] = n - check.typ = n.typ - result = check - elif ty.kind == tyTuple and ty.n != nil: - f = getSymFromList(ty.n, i) - if f != nil: - n.sons[0] = makeDeref(n.sons[0]) - n.sons[1] = newSymNode(f) - n.typ = f.typ - result = n - markUsed(n, f) - -proc semFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = - # this is difficult, because the '.' is used in many different contexts - # in Nimrod. We first allow types in the semantic checking. - result = builtinFieldAccess(c, n, flags) - if result == nil: - var i = considerAcc(n.sons[1]) - var f = SymTabGet(c.tab, i) - # if f != nil and f.kind == skStub: loadStub(f) - # ``loadStub`` is not correct here as we don't care for ``f`` really - if f != nil: - # BUGFIX: do not check for (f.kind in [skProc, skMethod, skIterator]) here - # This special node kind is to merge with the call handler in `semExpr`. - result = newNodeI(nkDotCall, n.info) - addSon(result, newIdentNode(i, n.info)) - addSon(result, copyTree(n[0])) - else: - GlobalError(n.Info, errUndeclaredFieldX, i.s) - -proc whichSliceOpr(n: PNode): string = - if n.sons[0].kind == nkEmpty: - if n.sons[1].kind == nkEmpty: result = "[..]" - else: result = "[..$]" - elif n.sons[1].kind == nkEmpty: - result = "[$..]" - else: - result = "[$..$]" - -proc addSliceOpr(result: var string, n: PNode) = - if n[0].kind == nkEmpty: - if n[1].kind == nkEmpty: result.add("..") - else: result.add("..$") - elif n[1].kind == nkEmpty: result.add("$..") - else: result.add("$..$") - -proc buildOverloadedSubscripts(n: PNode, inAsgn: bool): PNode = - result = newNodeI(nkCall, n.info) - add(result, ast.emptyNode) # fill with the correct node later - add(result, n[0]) - var opr = "[" - for i in 1..n.len-1: - if i > 1: add(opr, ",") - if n[i].kind == nkRange: - # we have a slice argument - checkSonsLen(n[i], 2) - addSliceOpr(opr, n[i]) - addSon(result, n[i][0]) - addSon(result, n[i][1]) - else: - add(result, n[i]) - if inAsgn: add(opr, "]=") - else: add(opr, "]") - # now we know the operator - result.sons[0] = newIdentNode(getIdent(opr), n.info) - -proc semDeref(c: PContext, n: PNode): PNode = - checkSonsLen(n, 1) - n.sons[0] = semExprWithType(c, n.sons[0]) - result = n - var t = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar}) - case t.kind - of tyRef, tyPtr: n.typ = t.sons[0] - else: GlobalError(n.sons[0].info, errCircumNeedsPointer) - result = n - -proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = - ## returns nil if not a built-in subscript operator; - if sonsLen(n) == 1: - var x = semDeref(c, n) - result = newNodeIT(nkDerefExpr, x.info, x.typ) - result.add(x[0]) - return - checkMinSonsLen(n, 2) - n.sons[0] = semExprWithType(c, n.sons[0], flags - {efAllowType}) - var arr = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar, tyPtr, tyRef}) - case arr.kind - of tyArray, tyOpenArray, tyArrayConstr, tySequence, tyString, tyCString: - checkSonsLen(n, 2) - n.sons[0] = makeDeref(n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - n.sons[i] = semExprWithType(c, n.sons[i], flags - {efAllowType}) - var indexType = if arr.kind == tyArray: arr.sons[0] else: getSysType(tyInt) - var arg = IndexTypesMatch(c, indexType, n.sons[1].typ, n.sons[1]) - if arg != nil: n.sons[1] = arg - else: GlobalError(n.info, errIndexTypesDoNotMatch) - result = n - result.typ = elemType(arr) - of tyTuple: - checkSonsLen(n, 2) - n.sons[0] = makeDeref(n.sons[0]) - # [] operator for tuples requires constant expression: - n.sons[1] = semConstExpr(c, n.sons[1]) - if skipTypes(n.sons[1].typ, {tyGenericInst, tyRange, tyOrdinal}).kind in - {tyInt..tyInt64}: - var idx = getOrdValue(n.sons[1]) - if (idx >= 0) and (idx < sonsLen(arr)): n.typ = arr.sons[int(idx)] - else: GlobalError(n.info, errInvalidIndexValueForTuple) - else: - GlobalError(n.info, errIndexTypesDoNotMatch) - result = n - else: nil - -proc semArrayAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = - result = semSubscript(c, n, flags) - if result == nil: - # overloaded [] operator: - result = semExpr(c, buildOverloadedSubscripts(n, inAsgn=false)) - -proc semIfExpr(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 2) - var typ: PType = nil - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkElifExpr: - checkSonsLen(it, 2) - it.sons[0] = forceBool(c, semExprWithType(c, it.sons[0])) - it.sons[1] = semExprWithType(c, it.sons[1]) - if typ == nil: typ = it.sons[1].typ - else: it.sons[1] = fitNode(c, typ, it.sons[1]) - of nkElseExpr: - checkSonsLen(it, 1) - it.sons[0] = semExprWithType(c, it.sons[0]) - if typ == nil: InternalError(it.info, "semIfExpr") - it.sons[0] = fitNode(c, typ, it.sons[0]) - else: illFormedAst(n) - result.typ = typ - -proc semSetConstr(c: PContext, n: PNode): PNode = - result = newNodeI(nkCurly, n.info) - result.typ = newTypeS(tySet, c) - if sonsLen(n) == 0: - addSon(result.typ, newTypeS(tyEmpty, c)) - else: - # only semantic checking for all elements, later type checking: - var typ: PType = nil - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind == nkRange: - checkSonsLen(n.sons[i], 2) - n.sons[i].sons[0] = semExprWithType(c, n.sons[i].sons[0]) - n.sons[i].sons[1] = semExprWithType(c, n.sons[i].sons[1]) - if typ == nil: - typ = skipTypes(n.sons[i].sons[0].typ, - {tyGenericInst, tyVar, tyOrdinal}) - n.sons[i].typ = n.sons[i].sons[1].typ # range node needs type too - else: - n.sons[i] = semExprWithType(c, n.sons[i]) - if typ == nil: - typ = skipTypes(n.sons[i].typ, {tyGenericInst, tyVar, tyOrdinal}) - if not isOrdinalType(typ): - GlobalError(n.info, errOrdinalTypeExpected) - return - if lengthOrd(typ) > MaxSetElements: - typ = makeRangeType(c, 0, MaxSetElements - 1, n.info) - addSon(result.typ, typ) - for i in countup(0, sonsLen(n) - 1): - var m: PNode - if n.sons[i].kind == nkRange: - m = newNodeI(nkRange, n.sons[i].info) - addSon(m, fitNode(c, typ, n.sons[i].sons[0])) - addSon(m, fitNode(c, typ, n.sons[i].sons[1])) - else: - m = fitNode(c, typ, n.sons[i]) - addSon(result, m) - -type - TParKind = enum - paNone, paSingle, paTupleFields, paTuplePositions - -proc checkPar(n: PNode): TParKind = - var length = sonsLen(n) - if length == 0: - result = paTuplePositions # () - elif length == 1: - result = paSingle # (expr) - else: - if n.sons[0].kind == nkExprColonExpr: result = paTupleFields - else: result = paTuplePositions - for i in countup(0, length - 1): - if result == paTupleFields: - if (n.sons[i].kind != nkExprColonExpr) or - not (n.sons[i].sons[0].kind in {nkSym, nkIdent}): - GlobalError(n.sons[i].info, errNamedExprExpected) - return paNone - else: - if n.sons[i].kind == nkExprColonExpr: - GlobalError(n.sons[i].info, errNamedExprNotAllowed) - return paNone - -proc semTupleFieldsConstr(c: PContext, n: PNode): PNode = - var ids: TIntSet - result = newNodeI(nkPar, n.info) - var typ = newTypeS(tyTuple, c) - typ.n = newNodeI(nkRecList, n.info) # nkIdentDefs - IntSetInit(ids) - for i in countup(0, sonsLen(n) - 1): - if (n.sons[i].kind != nkExprColonExpr) or - not (n.sons[i].sons[0].kind in {nkSym, nkIdent}): - illFormedAst(n.sons[i]) - var id: PIdent - if n.sons[i].sons[0].kind == nkIdent: id = n.sons[i].sons[0].ident - else: id = n.sons[i].sons[0].sym.name - if IntSetContainsOrIncl(ids, id.id): - localError(n.sons[i].info, errFieldInitTwice, id.s) - n.sons[i].sons[1] = semExprWithType(c, n.sons[i].sons[1]) - var f = newSymS(skField, n.sons[i].sons[0], c) - f.typ = n.sons[i].sons[1].typ - addSon(typ, f.typ) - addSon(typ.n, newSymNode(f)) - n.sons[i].sons[0] = newSymNode(f) - addSon(result, n.sons[i]) - result.typ = typ - -proc semTuplePositionsConstr(c: PContext, n: PNode): PNode = - result = n # we don't modify n, but compute the type: - var typ = newTypeS(tyTuple, c) # leave typ.n nil! - for i in countup(0, sonsLen(n) - 1): - n.sons[i] = semExprWithType(c, n.sons[i]) - addSon(typ, n.sons[i].typ) - result.typ = typ - -proc semStmtListExpr(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 1) - var length = sonsLen(n) - for i in countup(0, length - 2): - n.sons[i] = semStmt(c, n.sons[i]) - if length > 0: - n.sons[length - 1] = semExprWithType(c, n.sons[length - 1]) - n.typ = n.sons[length - 1].typ - -proc semBlockExpr(c: PContext, n: PNode): PNode = - result = n - Inc(c.p.nestedBlockCounter) - checkSonsLen(n, 2) - openScope(c.tab) # BUGFIX: label is in the scope of block! - if n.sons[0].kind != nkEmpty: addDecl(c, newSymS(skLabel, n.sons[0], c)) - n.sons[1] = semStmtListExpr(c, n.sons[1]) - n.typ = n.sons[1].typ - closeScope(c.tab) - Dec(c.p.nestedBlockCounter) - -proc isCallExpr(n: PNode): bool = - result = n.kind in {nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, - nkCallStrLit} - -proc semMacroStmt(c: PContext, n: PNode, semCheck = true): PNode = - checkMinSonsLen(n, 2) - var a: PNode - if isCallExpr(n.sons[0]): a = n.sons[0].sons[0] - else: a = n.sons[0] - var s = qualifiedLookup(c, a, {checkUndeclared}) - if s != nil: - case s.kind - of skMacro: - result = semMacroExpr(c, n, s, semCheck) - of skTemplate: - # transform - # nkMacroStmt(nkCall(a...), stmt, b...) - # to - # nkCall(a..., stmt, b...) - result = newNodeI(nkCall, n.info) - addSon(result, a) - if isCallExpr(n.sons[0]): - for i in countup(1, sonsLen(n.sons[0]) - 1): - addSon(result, n.sons[0].sons[i]) - for i in countup(1, sonsLen(n) - 1): addSon(result, n.sons[i]) - result = semTemplateExpr(c, result, s, semCheck) - else: GlobalError(n.info, errXisNoMacroOrTemplate, s.name.s) - else: - GlobalError(n.info, errInvalidExpressionX, renderTree(a, {renderNoComments})) - -proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = - result = n - if gCmd == cmdIdeTools: - suggestExpr(c, n) - if nfSem in n.flags: return - case n.kind # atoms: - of nkIdent: - var s = lookUp(c, n) - result = semSym(c, n, s, flags) - of nkSym: - # because of the changed symbol binding, this does not mean that we - # don't have to check the symbol for semantics here again! - result = semSym(c, n, n.sym, flags) - of nkEmpty, nkNone: - nil - of nkNilLit: - result.typ = getSysType(tyNil) - of nkType: - if not (efAllowType in flags): GlobalError(n.info, errATypeHasNoValue) - n.typ = semTypeNode(c, n, nil) - of nkIntLit: - if result.typ == nil: result.typ = getSysType(tyInt) - of nkInt8Lit: - if result.typ == nil: result.typ = getSysType(tyInt8) - of nkInt16Lit: - if result.typ == nil: result.typ = getSysType(tyInt16) - of nkInt32Lit: - if result.typ == nil: result.typ = getSysType(tyInt32) - of nkInt64Lit: - if result.typ == nil: result.typ = getSysType(tyInt64) - of nkFloatLit: - if result.typ == nil: result.typ = getSysType(tyFloat) - of nkFloat32Lit: - if result.typ == nil: result.typ = getSysType(tyFloat32) - of nkFloat64Lit: - if result.typ == nil: result.typ = getSysType(tyFloat64) - of nkStrLit..nkTripleStrLit: - if result.typ == nil: result.typ = getSysType(tyString) - of nkCharLit: - if result.typ == nil: result.typ = getSysType(tyChar) - of nkDotExpr: - result = semFieldAccess(c, n, flags) - if result.kind == nkDotCall: - result.kind = nkCall - result = semExpr(c, result, flags) - of nkBind: - result = semExpr(c, n.sons[0], flags) - of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: - # check if it is an expression macro: - checkMinSonsLen(n, 1) - var s = qualifiedLookup(c, n.sons[0], {checkUndeclared}) - if s != nil: - case s.kind - of skMacro: result = semMacroExpr(c, n, s) - of skTemplate: result = semTemplateExpr(c, n, s) - of skType: - if n.kind != nkCall: GlobalError(n.info, errXisNotCallable, s.name.s) - # XXX does this check make any sense? - result = semConv(c, n, s) - of skProc, skMethod, skConverter, skIterator: - if s.magic == mNone: result = semDirectOp(c, n, flags) - else: result = semMagic(c, n, s, flags) - else: - #liMessage(n.info, warnUser, renderTree(n)); - result = semIndirectOp(c, n, flags) - elif n.sons[0].kind == nkSymChoice: - result = semDirectOp(c, n, flags) - else: - result = semIndirectOp(c, n, flags) - of nkMacroStmt: - result = semMacroStmt(c, n) - of nkBracketExpr: - checkMinSonsLen(n, 1) - var s = qualifiedLookup(c, n.sons[0], {checkUndeclared}) - if s != nil and s.kind in {skProc, skMethod, skConverter, skIterator}: - # type parameters: partial generic specialization - n.sons[0] = semSym(c, n.sons[0], s, flags) - result = explicitGenericInstantiation(c, n, s) - else: - result = semArrayAccess(c, n, flags) - of nkPragmaExpr: - # which pragmas are allowed for expressions? `likely`, `unlikely` - internalError(n.info, "semExpr() to implement") # XXX: to implement - of nkPar: - case checkPar(n) - of paNone: result = nil - of paTuplePositions: result = semTuplePositionsConstr(c, n) - of paTupleFields: result = semTupleFieldsConstr(c, n) - of paSingle: result = semExpr(c, n.sons[0], flags) - of nkCurly: result = semSetConstr(c, n) - of nkBracket: result = semArrayConstr(c, n) - of nkLambda: result = semLambda(c, n) - of nkDerefExpr: - Message(n.info, warnDerefDeprecated) - result = semDeref(c, n) - of nkAddr: - result = n - checkSonsLen(n, 1) - n.sons[0] = semExprWithType(c, n.sons[0]) - if isAssignable(n.sons[0]) != arLValue: - GlobalError(n.info, errExprHasNoAddress) - n.typ = makePtrType(c, n.sons[0].typ) - of nkHiddenAddr, nkHiddenDeref: - checkSonsLen(n, 1) - n.sons[0] = semExpr(c, n.sons[0], flags) - of nkCast: result = semCast(c, n) - of nkAccQuoted: - checkSonsLen(n, 1) - result = semExpr(c, n.sons[0]) - of nkIfExpr: result = semIfExpr(c, n) - of nkStmtListExpr: result = semStmtListExpr(c, n) - of nkBlockExpr: result = semBlockExpr(c, n) - of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkHiddenCallConv: - checkSonsLen(n, 2) - of nkStringToCString, nkCStringToString, nkPassAsOpenArray, nkObjDownConv, - nkObjUpConv: - checkSonsLen(n, 1) - of nkChckRangeF, nkChckRange64, nkChckRange: - checkSonsLen(n, 3) - of nkCheckedFieldExpr: - checkMinSonsLen(n, 2) - of nkSymChoice: - GlobalError(n.info, errExprXAmbiguous, renderTree(n, {renderNoComments})) - else: - #InternalError(n.info, nodeKindToStr[n.kind]); - GlobalError(n.info, errInvalidExpressionX, renderTree(n, {renderNoComments})) - incl(result.flags, nfSem) diff --git a/rod/semfold.nim b/rod/semfold.nim deleted file mode 100755 index bae2a19bc..000000000 --- a/rod/semfold.nim +++ /dev/null @@ -1,449 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# this module folds constants; used by semantic checking phase -# and evaluation phase - -import - strutils, lists, options, ast, astalgo, trees, treetab, nimsets, times, - nversion, platform, math, msgs, os, condsyms, idents, rnimsyn, types, - commands - -proc getConstExpr*(m: PSym, n: PNode): PNode - # evaluates the constant expression or returns nil if it is no constant - # expression -proc evalOp*(m: TMagic, n, a, b, c: PNode): PNode -proc leValueConv*(a, b: PNode): bool -proc newIntNodeT*(intVal: BiggestInt, n: PNode): PNode -proc newFloatNodeT*(floatVal: BiggestFloat, n: PNode): PNode -proc newStrNodeT*(strVal: string, n: PNode): PNode - -# implementation - -proc newIntNodeT(intVal: BiggestInt, n: PNode): PNode = - if skipTypes(n.typ, abstractVarRange).kind == tyChar: - result = newIntNode(nkCharLit, intVal) - else: - result = newIntNode(nkIntLit, intVal) - result.typ = n.typ - result.info = n.info - -proc newFloatNodeT(floatVal: BiggestFloat, n: PNode): PNode = - result = newFloatNode(nkFloatLit, floatVal) - result.typ = n.typ - result.info = n.info - -proc newStrNodeT(strVal: string, n: PNode): PNode = - result = newStrNode(nkStrLit, strVal) - result.typ = n.typ - result.info = n.info - -proc ordinalValToString(a: PNode): string = - # because $ has the param ordinal[T], `a` is not necessarily an enum, but an - # ordinal - var x = getInt(a) - - var t = skipTypes(a.typ, abstractRange) - case t.kind - of tyChar: - result = $chr(int(x) and 0xff) - of tyEnum: - var n = t.n - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkSym: InternalError(a.info, "ordinalValToString") - var field = n.sons[i].sym - if field.position == x: - if field.ast == nil: - return field.name.s - else: - return field.ast.strVal - InternalError(a.info, "no symbol for ordinal value: " & $x) - else: - result = $x - -proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = - # b and c may be nil - result = nil - case m - of mOrd: result = newIntNodeT(getOrdValue(a), n) - of mChr: result = newIntNodeT(getInt(a), n) - of mUnaryMinusI, mUnaryMinusI64: result = newIntNodeT(- getInt(a), n) - of mUnaryMinusF64: result = newFloatNodeT(- getFloat(a), n) - of mNot: result = newIntNodeT(1 - getInt(a), n) - of mCard: result = newIntNodeT(nimsets.cardSet(a), n) - of mBitnotI, mBitnotI64: result = newIntNodeT(not getInt(a), n) - of mLengthStr: result = newIntNodeT(len(getStr(a)), n) - of mLengthArray: result = newIntNodeT(lengthOrd(a.typ), n) - of mLengthSeq, mLengthOpenArray: result = newIntNodeT(sonsLen(a), n) # BUGFIX - of mUnaryPlusI, mUnaryPlusI64, mUnaryPlusF64: result = a # throw `+` away - of mToFloat, mToBiggestFloat: - result = newFloatNodeT(toFloat(int(getInt(a))), n) - of mToInt, mToBiggestInt: result = newIntNodeT(system.toInt(getFloat(a)), n) - of mAbsF64: result = newFloatNodeT(abs(getFloat(a)), n) - of mAbsI, mAbsI64: - if getInt(a) >= 0: result = a - else: result = newIntNodeT(- getInt(a), n) - of mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: - # byte(-128) = 1...1..1000_0000'64 --> 0...0..1000_0000'64 - result = newIntNodeT(getInt(a) and (`shl`(1, getSize(a.typ) * 8) - 1), n) - of mToU8: result = newIntNodeT(getInt(a) and 0x000000FF, n) - of mToU16: result = newIntNodeT(getInt(a) and 0x0000FFFF, n) - of mToU32: result = newIntNodeT(getInt(a) and 0x00000000FFFFFFFF'i64, n) - of mUnaryLt: result = newIntNodeT(getOrdValue(a) - 1, n) - of mSucc: result = newIntNodeT(getOrdValue(a) + getInt(b), n) - of mPred: result = newIntNodeT(getOrdValue(a) - getInt(b), n) - of mAddI, mAddI64: result = newIntNodeT(getInt(a) + getInt(b), n) - of mSubI, mSubI64: result = newIntNodeT(getInt(a) - getInt(b), n) - of mMulI, mMulI64: result = newIntNodeT(getInt(a) * getInt(b), n) - of mMinI, mMinI64: - if getInt(a) > getInt(b): result = newIntNodeT(getInt(b), n) - else: result = newIntNodeT(getInt(a), n) - of mMaxI, mMaxI64: - if getInt(a) > getInt(b): result = newIntNodeT(getInt(a), n) - else: result = newIntNodeT(getInt(b), n) - of mShlI, mShlI64: - case skipTypes(n.typ, abstractRange).kind - of tyInt8: result = newIntNodeT(int8(getInt(a)) shl int8(getInt(b)), n) - of tyInt16: result = newIntNodeT(int16(getInt(a)) shl int16(getInt(b)), n) - of tyInt32: result = newIntNodeT(int32(getInt(a)) shl int32(getInt(b)), n) - of tyInt64, tyInt: result = newIntNodeT(`shl`(getInt(a), getInt(b)), n) - else: InternalError(n.info, "constant folding for shl") - of mShrI, mShrI64: - case skipTypes(n.typ, abstractRange).kind - of tyInt8: result = newIntNodeT(int8(getInt(a)) shr int8(getInt(b)), n) - of tyInt16: result = newIntNodeT(int16(getInt(a)) shr int16(getInt(b)), n) - of tyInt32: result = newIntNodeT(int32(getInt(a)) shr int32(getInt(b)), n) - of tyInt64, tyInt: result = newIntNodeT(`shr`(getInt(a), getInt(b)), n) - else: InternalError(n.info, "constant folding for shl") - of mDivI, mDivI64: result = newIntNodeT(getInt(a) div getInt(b), n) - of mModI, mModI64: result = newIntNodeT(getInt(a) mod getInt(b), n) - of mAddF64: result = newFloatNodeT(getFloat(a) + getFloat(b), n) - of mSubF64: result = newFloatNodeT(getFloat(a) - getFloat(b), n) - of mMulF64: result = newFloatNodeT(getFloat(a) * getFloat(b), n) - of mDivF64: - if getFloat(b) == 0.0: - if getFloat(a) == 0.0: result = newFloatNodeT(NaN, n) - else: result = newFloatNodeT(Inf, n) - else: - result = newFloatNodeT(getFloat(a) / getFloat(b), n) - of mMaxF64: - if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(a), n) - else: result = newFloatNodeT(getFloat(b), n) - of mMinF64: - if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(b), n) - else: result = newFloatNodeT(getFloat(a), n) - of mIsNil: result = newIntNodeT(ord(a.kind == nkNilLit), n) - of mLtI, mLtI64, mLtB, mLtEnum, mLtCh: - result = newIntNodeT(ord(getOrdValue(a) < getOrdValue(b)), n) - of mLeI, mLeI64, mLeB, mLeEnum, mLeCh: - result = newIntNodeT(ord(getOrdValue(a) <= getOrdValue(b)), n) - of mEqI, mEqI64, mEqB, mEqEnum, mEqCh: - result = newIntNodeT(ord(getOrdValue(a) == getOrdValue(b)), n) - of mLtF64: result = newIntNodeT(ord(getFloat(a) < getFloat(b)), n) - of mLeF64: result = newIntNodeT(ord(getFloat(a) <= getFloat(b)), n) - of mEqF64: result = newIntNodeT(ord(getFloat(a) == getFloat(b)), n) - of mLtStr: result = newIntNodeT(ord(getStr(a) < getStr(b)), n) - of mLeStr: result = newIntNodeT(ord(getStr(a) <= getStr(b)), n) - of mEqStr: result = newIntNodeT(ord(getStr(a) == getStr(b)), n) - of mLtU, mLtU64: - result = newIntNodeT(ord(`<%`(getOrdValue(a), getOrdValue(b))), n) - of mLeU, mLeU64: - result = newIntNodeT(ord(`<=%`(getOrdValue(a), getOrdValue(b))), n) - of mBitandI, mBitandI64, mAnd: result = newIntNodeT(getInt(a) and getInt(b), n) - of mBitorI, mBitorI64, mOr: result = newIntNodeT(getInt(a) or getInt(b), n) - of mBitxorI, mBitxorI64, mXor: result = newIntNodeT(getInt(a) xor getInt(b), n) - of mAddU, mAddU64: result = newIntNodeT(`+%`(getInt(a), getInt(b)), n) - of mSubU, mSubU64: result = newIntNodeT(`-%`(getInt(a), getInt(b)), n) - of mMulU, mMulU64: result = newIntNodeT(`*%`(getInt(a), getInt(b)), n) - of mModU, mModU64: result = newIntNodeT(`%%`(getInt(a), getInt(b)), n) - of mDivU, mDivU64: result = newIntNodeT(`/%`(getInt(a), getInt(b)), n) - of mLeSet: result = newIntNodeT(Ord(containsSets(a, b)), n) - of mEqSet: result = newIntNodeT(Ord(equalSets(a, b)), n) - of mLtSet: - result = newIntNodeT(Ord(containsSets(a, b) and not equalSets(a, b)), n) - of mMulSet: - result = nimsets.intersectSets(a, b) - result.info = n.info - of mPlusSet: - result = nimsets.unionSets(a, b) - result.info = n.info - of mMinusSet: - result = nimsets.diffSets(a, b) - result.info = n.info - of mSymDiffSet: - result = nimsets.symdiffSets(a, b) - result.info = n.info - of mConStrStr: result = newStrNodeT(getStrOrChar(a) & getStrOrChar(b), n) - of mInSet: result = newIntNodeT(Ord(inSet(a, b)), n) - of mRepr: - # BUGFIX: we cannot eval mRepr here. But this means that it is not - # available for interpretation. I don't know how to fix this. - #result := newStrNodeT(renderTree(a, {@set}[renderNoComments]), n); - of mIntToStr, mInt64ToStr: result = newStrNodeT($(getOrdValue(a)), n) - of mBoolToStr: - if getOrdValue(a) == 0: result = newStrNodeT("false", n) - else: result = newStrNodeT("true", n) - of mCopyStr: result = newStrNodeT(copy(getStr(a), int(getOrdValue(b))), n) - of mCopyStrLast: - result = newStrNodeT(copy(getStr(a), int(getOrdValue(b)), - int(getOrdValue(c))), n) - of mFloatToStr: result = newStrNodeT($(getFloat(a)), n) - of mCStrToStr, mCharToStr: result = newStrNodeT(getStrOrChar(a), n) - of mStrToStr: result = a - of mEnumToStr: result = newStrNodeT(ordinalValToString(a), n) - of mArrToSeq: - result = copyTree(a) - result.typ = n.typ - of mCompileOption: - result = newIntNodeT(Ord(commands.testCompileOption(getStr(a), n.info)), n) - of mCompileOptionArg: - result = newIntNodeT(Ord( - testCompileOptionArg(getStr(a), getStr(b), n.info)), n) - of mNewString, mExit, mInc, ast.mDec, mEcho, mAssert, mSwap, mAppendStrCh, - mAppendStrStr, mAppendSeqElem, mSetLengthStr, mSetLengthSeq, - mNLen..mNError, mEqRef: - nil - else: InternalError(a.info, "evalOp(" & $m & ')') - -proc getConstIfExpr(c: PSym, n: PNode): PNode = - result = nil - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkElifExpr: - var e = getConstExpr(c, it.sons[0]) - if e == nil: return nil - if getOrdValue(e) != 0: - if result == nil: - result = getConstExpr(c, it.sons[1]) - if result == nil: return - of nkElseExpr: - if result == nil: result = getConstExpr(c, it.sons[0]) - else: internalError(it.info, "getConstIfExpr()") - -proc partialAndExpr(c: PSym, n: PNode): PNode = - # partial evaluation - result = n - var a = getConstExpr(c, n.sons[1]) - var b = getConstExpr(c, n.sons[2]) - if a != nil: - if getInt(a) == 0: result = a - elif b != nil: result = b - else: result = n.sons[2] - elif b != nil: - if getInt(b) == 0: result = b - else: result = n.sons[1] - -proc partialOrExpr(c: PSym, n: PNode): PNode = - # partial evaluation - result = n - var a = getConstExpr(c, n.sons[1]) - var b = getConstExpr(c, n.sons[2]) - if a != nil: - if getInt(a) != 0: result = a - elif b != nil: result = b - else: result = n.sons[2] - elif b != nil: - if getInt(b) != 0: result = b - else: result = n.sons[1] - -proc leValueConv(a, b: PNode): bool = - result = false - case a.kind - of nkCharLit..nkInt64Lit: - case b.kind - of nkCharLit..nkInt64Lit: result = a.intVal <= b.intVal - of nkFloatLit..nkFloat64Lit: result = a.intVal <= round(b.floatVal) - else: InternalError(a.info, "leValueConv") - of nkFloatLit..nkFloat64Lit: - case b.kind - of nkFloatLit..nkFloat64Lit: result = a.floatVal <= b.floatVal - of nkCharLit..nkInt64Lit: result = a.floatVal <= toFloat(int(b.intVal)) - else: InternalError(a.info, "leValueConv") - else: InternalError(a.info, "leValueConv") - -proc magicCall(m: PSym, n: PNode): PNode = - if sonsLen(n) <= 1: return - - var s = n.sons[0].sym - var a = getConstExpr(m, n.sons[1]) - var b, c: PNode - if a == nil: return - if sonsLen(n) > 2: - b = getConstExpr(m, n.sons[2]) - if b == nil: return - if sonsLen(n) > 3: - c = getConstExpr(m, n.sons[3]) - if c == nil: return - else: - b = nil - result = evalOp(s.magic, n, a, b, c) - -proc getAppType(n: PNode): PNode = - if gGlobalOptions.contains(optGenDynLib): - result = newStrNodeT("lib", n) - elif gGlobalOptions.contains(optGenGuiApp): - result = newStrNodeT("gui", n) - else: - result = newStrNodeT("console", n) - -proc foldConv*(n, a: PNode): PNode = - case skipTypes(n.typ, abstractRange).kind - of tyInt..tyInt64: - case skipTypes(a.typ, abstractRange).kind - of tyFloat..tyFloat64: result = newIntNodeT(system.toInt(getFloat(a)), n) - of tyChar: result = newIntNodeT(getOrdValue(a), n) - else: - result = a - result.typ = n.typ - of tyFloat..tyFloat64: - case skipTypes(a.typ, abstractRange).kind - of tyInt..tyInt64, tyEnum, tyBool, tyChar: - result = newFloatNodeT(toFloat(int(getOrdValue(a))), n) - else: - result = a - result.typ = n.typ - of tyOpenArray, tyProc: - nil - else: - result = a - result.typ = n.typ - -proc getConstExpr(m: PSym, n: PNode): PNode = - result = nil - case n.kind - of nkSym: - var s = n.sym - if s.kind == skEnumField: - result = newIntNodeT(s.position, n) - elif (s.kind == skConst): - case s.magic - of mIsMainModule: result = newIntNodeT(ord(sfMainModule in m.flags), n) - of mCompileDate: result = newStrNodeT(times.getDateStr(), n) - of mCompileTime: result = newStrNodeT(times.getClockStr(), n) - of mNimrodVersion: result = newStrNodeT(VersionAsString, n) - of mNimrodMajor: result = newIntNodeT(VersionMajor, n) - of mNimrodMinor: result = newIntNodeT(VersionMinor, n) - of mNimrodPatch: result = newIntNodeT(VersionPatch, n) - of mCpuEndian: result = newIntNodeT(ord(CPU[targetCPU].endian), n) - of mHostOS: result = newStrNodeT(toLower(platform.OS[targetOS].name), n) - of mHostCPU: result = newStrNodeT(toLower(platform.CPU[targetCPU].name), n) - of mAppType: result = getAppType(n) - of mNaN: result = newFloatNodeT(NaN, n) - of mInf: result = newFloatNodeT(Inf, n) - of mNegInf: result = newFloatNodeT(NegInf, n) - else: result = copyTree(s.ast) - elif s.kind in {skProc, skMethod}: # BUGFIX - result = n - of nkCharLit..nkNilLit: - result = copyNode(n) - of nkIfExpr: - result = getConstIfExpr(m, n) - of nkCall, nkCommand, nkCallStrLit: - if (n.sons[0].kind != nkSym): return - var s = n.sons[0].sym - if (s.kind != skProc): return - try: - case s.magic - of mNone: - return # XXX: if it has no sideEffect, it should be evaluated - of mSizeOf: - var a = n.sons[1] - if computeSize(a.typ) < 0: - LocalError(a.info, errCannotEvalXBecauseIncompletelyDefined, - "sizeof") - result = nil - elif a.typ.kind in {tyArray, tyObject, tyTuple}: - result = nil - # XXX: size computation for complex types is still wrong - else: - result = newIntNodeT(getSize(a.typ), n) - of mLow: - result = newIntNodeT(firstOrd(n.sons[1].typ), n) - of mHigh: - if not (skipTypes(n.sons[1].typ, abstractVar).kind in - {tyOpenArray, tySequence, tyString}): - result = newIntNodeT(lastOrd(skipTypes(n.sons[1].typ, abstractVar)), - n) - of mLengthOpenArray: - var a = n.sons[1] - if a.kind == nkPassAsOpenArray: a = a.sons[0] - if a.kind == nkBracket: - # we can optimize it away! This fixes the bug ``len(134)``. - result = newIntNodeT(sonsLen(a), n) - else: - result = magicCall(m, n) - else: - result = magicCall(m, n) - except EOverflow: - LocalError(n.info, errOverOrUnderflow) - except EDivByZero: - LocalError(n.info, errConstantDivisionByZero) - of nkAddr: - var a = getConstExpr(m, n.sons[0]) - if a != nil: - result = n - n.sons[0] = a - of nkBracket: - result = copyTree(n) - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i]) - if a == nil: return nil - result.sons[i] = a - incl(result.flags, nfAllConst) - of nkRange: - var a = getConstExpr(m, n.sons[0]) - if a == nil: return - var b = getConstExpr(m, n.sons[1]) - if b == nil: return - result = copyNode(n) - addSon(result, a) - addSon(result, b) - of nkCurly: - result = copyTree(n) - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i]) - if a == nil: return nil - result.sons[i] = a - incl(result.flags, nfAllConst) - of nkPar: - # tuple constructor - result = copyTree(n) - if (sonsLen(n) > 0) and (n.sons[0].kind == nkExprColonExpr): - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i].sons[1]) - if a == nil: return nil - result.sons[i].sons[1] = a - else: - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i]) - if a == nil: return nil - result.sons[i] = a - incl(result.flags, nfAllConst) - of nkChckRangeF, nkChckRange64, nkChckRange: - var a = getConstExpr(m, n.sons[0]) - if a == nil: return - if leValueConv(n.sons[1], a) and leValueConv(a, n.sons[2]): - result = a # a <= x and x <= b - result.typ = n.typ - else: - LocalError(n.info, errGenerated, `%`( - msgKindToString(errIllegalConvFromXtoY), - [typeToString(n.sons[0].typ), typeToString(n.typ)])) - of nkStringToCString, nkCStringToString: - var a = getConstExpr(m, n.sons[0]) - if a == nil: return - result = a - result.typ = n.typ - of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkCast: - var a = getConstExpr(m, n.sons[1]) - if a == nil: return - result = foldConv(n, a) - else: - nil diff --git a/rod/semgnrc.nim b/rod/semgnrc.nim deleted file mode 100755 index 4894843f8..000000000 --- a/rod/semgnrc.nim +++ /dev/null @@ -1,245 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This implements the first pass over the generic body; it resolves some -# symbols. Thus for generics there is a two-phase symbol lookup just like -# in C++. -# A problem is that it cannot be detected if the symbol is introduced -# as in ``var x = ...`` or used because macros/templates can hide this! -# So we have to eval templates/macros right here so that symbol -# lookup can be accurate. - -type - TSemGenericFlag = enum - withinBind, withinTypeDesc - TSemGenericFlags = set[TSemGenericFlag] - -proc semGenericStmt(c: PContext, n: PNode, flags: TSemGenericFlags = {}): PNode -proc semGenericStmtScope(c: PContext, n: PNode, - flags: TSemGenericFlags = {}): PNode = - openScope(c.tab) - result = semGenericStmt(c, n, flags) - closeScope(c.tab) - -proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym): PNode = - incl(s.flags, sfUsed) - case s.kind - of skUnknown: - # Introduced in this pass! Leave it as an identifier. - result = n - of skProc, skMethod, skIterator, skConverter: - result = symChoice(c, n, s) - of skTemplate: - result = semTemplateExpr(c, n, s, false) - of skMacro: - result = semMacroExpr(c, n, s, false) - of skGenericParam: - result = newSymNode(s, n.info) - of skParam: - result = n - of skType: - if (s.typ != nil) and (s.typ.kind != tyGenericParam): - result = newSymNode(s, n.info) - else: - result = n - else: result = newSymNode(s, n.info) - -proc getIdentNode(n: PNode): PNode = - case n.kind - of nkPostfix: result = getIdentNode(n.sons[1]) - of nkPragmaExpr, nkAccQuoted: result = getIdentNode(n.sons[0]) - of nkIdent: result = n - else: - illFormedAst(n) - result = n - -# of nkAccQuoted: -# s = lookUp(c, n) -# if withinBind in flags: result = symChoice(c, n, s) -# else: result = semGenericStmtSymbol(c, n, s) - -proc semGenericStmt(c: PContext, n: PNode, - flags: TSemGenericFlags = {}): PNode = - result = n - if gCmd == cmdIdeTools: suggestStmt(c, n) - case n.kind - of nkIdent: - var s = SymtabGet(c.Tab, n.ident) - if s == nil: - # no error if symbol cannot be bound, unless in ``bind`` context: - if withinBind in flags: - localError(n.info, errUndeclaredIdentifier, n.ident.s) - else: - if withinBind in flags: result = symChoice(c, n, s) - else: result = semGenericStmtSymbol(c, n, s) - of nkDotExpr: - var s = QualifiedLookUp(c, n, {}) - if s != nil: result = semGenericStmtSymbol(c, n, s) - of nkEmpty, nkSym..nkNilLit: - nil - of nkBind: - result = semGenericStmt(c, n.sons[0], {withinBind}) - of nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkCommand, nkCallStrLit: - # check if it is an expression macro: - checkMinSonsLen(n, 1) - var s = qualifiedLookup(c, n.sons[0], {}) - if s != nil: - incl(s.flags, sfUsed) - case s.kind - of skMacro: - return semMacroExpr(c, n, s, false) - of skTemplate: - return semTemplateExpr(c, n, s, false) - of skUnknown, skParam: - # Leave it as an identifier. - of skProc, skMethod, skIterator, skConverter: - n.sons[0] = symChoice(c, n.sons[0], s) - of skGenericParam: - n.sons[0] = newSymNode(s, n.sons[0].info) - of skType: - # bad hack for generics: - if (s.typ != nil) and (s.typ.kind != tyGenericParam): - n.sons[0] = newSymNode(s, n.sons[0].info) - else: n.sons[0] = newSymNode(s, n.sons[0].info) - for i in countup(1, sonsLen(n) - 1): - n.sons[i] = semGenericStmt(c, n.sons[i], flags) - of nkMacroStmt: - result = semMacroStmt(c, n, false) - of nkIfStmt: - for i in countup(0, sonsLen(n)-1): - n.sons[i] = semGenericStmtScope(c, n.sons[i]) - of nkWhileStmt: - openScope(c.tab) - for i in countup(0, sonsLen(n)-1): n.sons[i] = semGenericStmt(c, n.sons[i]) - closeScope(c.tab) - of nkCaseStmt: - openScope(c.tab) - n.sons[0] = semGenericStmt(c, n.sons[0]) - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] - checkMinSonsLen(a, 1) - var L = sonsLen(a) - for j in countup(0, L - 2): a.sons[j] = semGenericStmt(c, a.sons[j]) - a.sons[L - 1] = semGenericStmtScope(c, a.sons[L - 1]) - closeScope(c.tab) - of nkForStmt: - var L = sonsLen(n) - openScope(c.tab) - n.sons[L - 2] = semGenericStmt(c, n.sons[L - 2]) - for i in countup(0, L - 3): addDecl(c, newSymS(skUnknown, n.sons[i], c)) - n.sons[L - 1] = semGenericStmt(c, n.sons[L - 1]) - closeScope(c.tab) - of nkBlockStmt, nkBlockExpr, nkBlockType: - checkSonsLen(n, 2) - openScope(c.tab) - if n.sons[0].kind != nkEmpty: addDecl(c, newSymS(skUnknown, n.sons[0], c)) - n.sons[1] = semGenericStmt(c, n.sons[1]) - closeScope(c.tab) - of nkTryStmt: - checkMinSonsLen(n, 2) - n.sons[0] = semGenericStmtScope(c, n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - var a = n.sons[i] - checkMinSonsLen(a, 1) - var L = sonsLen(a) - for j in countup(0, L - 2): - a.sons[j] = semGenericStmt(c, a.sons[j], {withinTypeDesc}) - a.sons[L - 1] = semGenericStmtScope(c, a.sons[L - 1]) - of nkVarSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): IllFormedAst(a) - checkMinSonsLen(a, 3) - var L = sonsLen(a) - a.sons[L-2] = semGenericStmt(c, a.sons[L-2], {withinTypeDesc}) - a.sons[L-1] = semGenericStmt(c, a.sons[L-1]) - for j in countup(0, L-3): - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)) - of nkGenericParams: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if (a.kind != nkIdentDefs): IllFormedAst(a) - checkMinSonsLen(a, 3) - var L = sonsLen(a) - a.sons[L-2] = semGenericStmt(c, a.sons[L-2], {withinTypeDesc}) - # do not perform symbol lookup for default expressions - for j in countup(0, L-3): - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)) - of nkConstSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkConstDef): IllFormedAst(a) - checkSonsLen(a, 3) - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[0]), c)) - a.sons[1] = semGenericStmt(c, a.sons[1], {withinTypeDesc}) - a.sons[2] = semGenericStmt(c, a.sons[2]) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[0]), c)) - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - if a.sons[1].kind != nkEmpty: - openScope(c.tab) - a.sons[1] = semGenericStmt(c, a.sons[1]) - a.sons[2] = semGenericStmt(c, a.sons[2], {withinTypeDesc}) - closeScope(c.tab) - else: - a.sons[2] = semGenericStmt(c, a.sons[2], {withinTypeDesc}) - of nkEnumTy: - checkMinSonsLen(n, 1) - if n.sons[0].kind != nkEmpty: - n.sons[0] = semGenericStmt(c, n.sons[0], {withinTypeDesc}) - for i in countup(1, sonsLen(n) - 1): - var a: PNode - case n.sons[i].kind - of nkEnumFieldDef: a = n.sons[i].sons[0] - of nkIdent: a = n.sons[i] - else: illFormedAst(n) - addDeclAt(c, newSymS(skUnknown, getIdentNode(a.sons[i]), c), c.tab.tos-1) - of nkObjectTy, nkTupleTy: - nil - of nkFormalParams: - checkMinSonsLen(n, 1) - if n.sons[0].kind != nkEmpty: - n.sons[0] = semGenericStmt(c, n.sons[0], {withinTypeDesc}) - for i in countup(1, sonsLen(n) - 1): - var a = n.sons[i] - if (a.kind != nkIdentDefs): IllFormedAst(a) - checkMinSonsLen(a, 3) - var L = sonsLen(a) - a.sons[L-2] = semGenericStmt(c, a.sons[L-2], {withinTypeDesc}) - a.sons[L-1] = semGenericStmt(c, a.sons[L-1]) - for j in countup(0, L-3): - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)) - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkIteratorDef, nkLambda: - checkSonsLen(n, codePos + 1) - addDecl(c, newSymS(skUnknown, getIdentNode(n.sons[0]), c)) - openScope(c.tab) - n.sons[genericParamsPos] = semGenericStmt(c, n.sons[genericParamsPos]) - if n.sons[paramsPos].kind != nkEmpty: - if n.sons[paramsPos].sons[0].kind != nkEmpty: - addDecl(c, newSym(skUnknown, getIdent("result"), nil)) - n.sons[paramsPos] = semGenericStmt(c, n.sons[paramsPos]) - n.sons[pragmasPos] = semGenericStmt(c, n.sons[pragmasPos]) - n.sons[codePos] = semGenericStmtScope(c, n.sons[codePos]) - closeScope(c.tab) - else: - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = semGenericStmt(c, n.sons[i], flags) - diff --git a/rod/seminst.nim b/rod/seminst.nim deleted file mode 100755 index e37c6e0fc..000000000 --- a/rod/seminst.nim +++ /dev/null @@ -1,128 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the instantiation of generic procs. - -proc instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable) = - if (n.kind != nkGenericParams): - InternalError(n.info, "instantiateGenericParamList; no generic params") - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind != nkSym: - InternalError(a.info, "instantiateGenericParamList; no symbol") - var q = a.sym - if not (q.typ.kind in {tyTypeDesc, tyGenericParam}): continue - var s = newSym(skType, q.name, getCurrOwner()) - var t = PType(IdTableGet(pt, q.typ)) - if t == nil: - LocalError(a.info, errCannotInstantiateX, s.name.s) - break - if (t.kind == tyGenericParam): - InternalError(a.info, "instantiateGenericParamList: " & q.name.s) - s.typ = t - addDecl(c, s) - -proc GenericCacheGet(c: PContext, genericSym, instSym: PSym): PSym = - result = nil - for i in countup(0, sonsLen(c.generics) - 1): - if c.generics.sons[i].kind != nkExprEqExpr: - InternalError(genericSym.info, "GenericCacheGet") - var a = c.generics.sons[i].sons[0].sym - if genericSym.id == a.id: - var b = c.generics.sons[i].sons[1].sym - if equalParams(b.typ.n, instSym.typ.n) == paramsEqual: - #if gVerbosity > 0 then - # MessageOut('found in cache: ' + getProcHeader(instSym)); - return b - -proc GenericCacheAdd(c: PContext, genericSym, instSym: PSym) = - var n = newNode(nkExprEqExpr) - addSon(n, newSymNode(genericSym)) - addSon(n, newSymNode(instSym)) - addSon(c.generics, n) - -proc removeDefaultParamValues(n: PNode) = - # we remove default params, because they cannot be instantiated properly - # and they are not needed anyway for instantiation (each param is already - # provided). - when false: - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] - if a.kind != nkIdentDefs: IllFormedAst(a) - var L = a.len - if a.sons[L-1].kind != nkEmpty and a.sons[L-2].kind != nkEmpty: - # ``param: typ = defaultVal``. - # We don't need defaultVal for semantic checking and it's wrong for - # ``cmp: proc (a, b: T): int = cmp``. Hm, for ``cmp = cmp`` that is - # not possible... XXX We don't solve this issue here. - a.sons[L-1] = ast.emptyNode - -proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, - info: TLineInfo): PSym = - # generates an instantiated proc - var - oldPrc, oldMod: PSym - n: PNode - if c.InstCounter > 1000: InternalError(fn.ast.info, "nesting too deep") - inc(c.InstCounter) - # NOTE: for access of private fields within generics from a different module - # and other identifiers we fake the current module temporarily! - # XXX bad hack! - oldMod = c.module - c.module = getModule(fn) - result = copySym(fn, false) - incl(result.flags, sfFromGeneric) - result.owner = getCurrOwner().owner - n = copyTree(fn.ast) - result.ast = n - pushOwner(result) - openScope(c.tab) - if (n.sons[genericParamsPos].kind == nkEmpty): - InternalError(n.info, "generateInstance") - n.sons[namePos] = newSymNode(result) - pushInfoContext(info) - instantiateGenericParamList(c, n.sons[genericParamsPos], pt) - n.sons[genericParamsPos] = ast.emptyNode - # semantic checking for the parameters: - if n.sons[paramsPos].kind != nkEmpty: - removeDefaultParamValues(n.sons[ParamsPos]) - semParamList(c, n.sons[ParamsPos], nil, result) - addParams(c, result.typ.n) - else: - result.typ = newTypeS(tyProc, c) - addSon(result.typ, nil) - result.typ.callConv = fn.typ.callConv - oldPrc = GenericCacheGet(c, fn, result) - if oldPrc == nil: - # add it here, so that recursive generic procs are possible: - GenericCacheAdd(c, fn, result) - addDecl(c, result) - if n.sons[codePos].kind != nkEmpty: - pushProcCon(c, result) - if result.kind in {skProc, skMethod, skConverter}: - addResult(c, result.typ.sons[0], n.info) - addResultNode(c, n) - n.sons[codePos] = semStmtScope(c, n.sons[codePos]) - popProcCon(c) - else: - result = oldPrc - popInfoContext() - closeScope(c.tab) # close scope for parameters - popOwner() - c.module = oldMod - dec(c.InstCounter) - -proc instGenericContainer(c: PContext, n: PNode, header: PType): PType = - var cl: TReplTypeVars - InitIdTable(cl.symMap) - InitIdTable(cl.typeMap) - cl.info = n.info - cl.c = c - result = ReplaceTypeVarsT(cl, header) - diff --git a/rod/semstmts.nim b/rod/semstmts.nim deleted file mode 100755 index 71d523540..000000000 --- a/rod/semstmts.nim +++ /dev/null @@ -1,898 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## this module does the semantic checking of statements - -proc buildEchoStmt(c: PContext, n: PNode): PNode = - # we MUST not check 'n' for semantics again here! - result = newNodeI(nkCall, n.info) - var e = StrTableGet(magicsys.systemModule.Tab, getIdent"echo") - if e == nil: GlobalError(n.info, errSystemNeeds, "echo") - addSon(result, newSymNode(e)) - var arg = buildStringify(c, n) - # problem is: implicit '$' is not checked for semantics yet. So we give up - # and check 'arg' for semantics again: - addSon(result, semExpr(c, arg)) - -proc semExprNoType(c: PContext, n: PNode): PNode = - result = semExpr(c, n) - if result.typ != nil and result.typ.kind != tyStmt: - if gCmd == cmdInteractive: - result = buildEchoStmt(c, result) - else: - localError(n.info, errDiscardValue) - -proc semCommand(c: PContext, n: PNode): PNode = - result = semExprNoType(c, n) - -proc semWhen(c: PContext, n: PNode): PNode = - result = nil - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkElifBranch: - checkSonsLen(it, 2) - var e = semConstBoolExpr(c, it.sons[0]) - if (e.kind != nkIntLit): InternalError(n.info, "semWhen") - if (e.intVal != 0) and (result == nil): - result = semStmt(c, it.sons[1]) # do not open a new scope! - of nkElse: - checkSonsLen(it, 1) - if result == nil: - result = semStmt(c, it.sons[0]) # do not open a new scope! - else: illFormedAst(n) - if result == nil: - result = newNodeI(nkNilLit, n.info) - # The ``when`` statement implements the mechanism for platform dependant - # code. Thus we try to ensure here consistent ID allocation after the - # ``when`` statement. - IDsynchronizationPoint(200) - -proc semIf(c: PContext, n: PNode): PNode = - result = n - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkElifBranch: - checkSonsLen(it, 2) - openScope(c.tab) - it.sons[0] = forceBool(c, semExprWithType(c, it.sons[0])) - it.sons[1] = semStmt(c, it.sons[1]) - closeScope(c.tab) - of nkElse: - if sonsLen(it) == 1: it.sons[0] = semStmtScope(c, it.sons[0]) - else: illFormedAst(it) - else: illFormedAst(n) - -proc semDiscard(c: PContext, n: PNode): PNode = - result = n - checkSonsLen(n, 1) - n.sons[0] = semExprWithType(c, n.sons[0]) - if n.sons[0].typ == nil: localError(n.info, errInvalidDiscard) - -proc semBreakOrContinue(c: PContext, n: PNode): PNode = - result = n - checkSonsLen(n, 1) - if n.sons[0].kind != nkEmpty: - var s: PSym - case n.sons[0].kind - of nkIdent: s = lookUp(c, n.sons[0]) - of nkSym: s = n.sons[0].sym - else: illFormedAst(n) - if s.kind == skLabel and s.owner.id == c.p.owner.id: - var x = newSymNode(s) - x.info = n.info - incl(s.flags, sfUsed) - n.sons[0] = x - else: - localError(n.info, errInvalidControlFlowX, s.name.s) - elif (c.p.nestedLoopCounter <= 0) and (c.p.nestedBlockCounter <= 0): - localError(n.info, errInvalidControlFlowX, - renderTree(n, {renderNoComments})) - -proc semBlock(c: PContext, n: PNode): PNode = - result = n - Inc(c.p.nestedBlockCounter) - checkSonsLen(n, 2) - openScope(c.tab) # BUGFIX: label is in the scope of block! - if n.sons[0].kind != nkEmpty: - var labl = newSymS(skLabel, n.sons[0], c) - addDecl(c, labl) - n.sons[0] = newSymNode(labl) - n.sons[1] = semStmt(c, n.sons[1]) - closeScope(c.tab) - Dec(c.p.nestedBlockCounter) - -proc semAsm(con: PContext, n: PNode): PNode = - checkSonsLen(n, 2) - var marker = pragmaAsm(con, n.sons[0]) - if marker == '\0': marker = '`' # default marker - result = semAsmOrEmit(con, n, marker) - -proc semWhile(c: PContext, n: PNode): PNode = - result = n - checkSonsLen(n, 2) - openScope(c.tab) - n.sons[0] = forceBool(c, semExprWithType(c, n.sons[0])) - inc(c.p.nestedLoopCounter) - n.sons[1] = semStmt(c, n.sons[1]) - dec(c.p.nestedLoopCounter) - closeScope(c.tab) - -proc toCover(t: PType): biggestInt = - var t2 = skipTypes(t, abstractVarRange) - if t2.kind == tyEnum and enumHasWholes(t2): - result = sonsLen(t2.n) - else: - result = lengthOrd(skipTypes(t, abstractVar)) - -proc semCase(c: PContext, n: PNode): PNode = - # check selector: - result = n - checkMinSonsLen(n, 2) - openScope(c.tab) - n.sons[0] = semExprWithType(c, n.sons[0]) - var chckCovered = false - var covered: biggestint = 0 - case skipTypes(n.sons[0].Typ, abstractVarRange).Kind - of tyInt..tyInt64, tyChar, tyEnum: - chckCovered = true - of tyFloat..tyFloat128, tyString: - nil - else: - LocalError(n.info, errSelectorMustBeOfCertainTypes) - return - for i in countup(1, sonsLen(n) - 1): - var x = n.sons[i] - case x.kind - of nkOfBranch: - checkMinSonsLen(x, 2) - semCaseBranch(c, n, x, i, covered) - var length = sonsLen(x) - x.sons[length - 1] = semStmtScope(c, x.sons[length - 1]) - of nkElifBranch: - chckCovered = false - checkSonsLen(x, 2) - x.sons[0] = forceBool(c, semExprWithType(c, x.sons[0])) - x.sons[1] = semStmtScope(c, x.sons[1]) - of nkElse: - chckCovered = false - checkSonsLen(x, 1) - x.sons[0] = semStmtScope(c, x.sons[0]) - else: illFormedAst(x) - if chckCovered and (covered != toCover(n.sons[0].typ)): - localError(n.info, errNotAllCasesCovered) - closeScope(c.tab) - -proc propertyWriteAccess(c: PContext, n, a: PNode): PNode = - var id = considerAcc(a[1]) - result = newNodeI(nkCall, n.info) - addSon(result, newIdentNode(getIdent(id.s & '='), n.info)) - # a[0] is already checked for semantics, that does ``builtinFieldAccess`` - # this is ugly. XXX Semantic checking should use the ``nfSem`` flag for - # nodes? - addSon(result, a[0]) - addSon(result, semExpr(c, n[1])) - result = semDirectCallAnalyseEffects(c, result, {}) - if result != nil: - fixAbstractType(c, result) - analyseIfAddressTakenInCall(c, result) - else: - globalError(n.Info, errUndeclaredFieldX, id.s) - -proc semAsgn(c: PContext, n: PNode): PNode = - checkSonsLen(n, 2) - var a = n.sons[0] - case a.kind - of nkDotExpr: - # r.f = x - # --> `f=` (r, x) - a = builtinFieldAccess(c, a, {efLValue}) - if a == nil: - return propertyWriteAccess(c, n, n[0]) - of nkBracketExpr: - # a[i..j] = x - # --> `[..]=`(a, i, j, x) - a = semSubscript(c, a, {efLValue}) - if a == nil: - result = buildOverloadedSubscripts(n.sons[0], inAsgn=true) - add(result, n[1]) - return semExprNoType(c, result) - else: - a = semExprWithType(c, a, {efLValue}) - n.sons[0] = a - n.sons[1] = semExprWithType(c, n.sons[1]) - var le = a.typ - if skipTypes(le, {tyGenericInst}).kind != tyVar and IsAssignable(a) == arNone: - # Direct assignment to a discriminant is allowed! - localError(a.info, errXCannotBeAssignedTo, - renderTree(a, {renderNoComments})) - else: - n.sons[1] = fitNode(c, le, n.sons[1]) - fixAbstractType(c, n) - result = n - -proc SemReturn(c: PContext, n: PNode): PNode = - var - restype: PType - a: PNode # temporary assignment for code generator - result = n - checkSonsLen(n, 1) - if not (c.p.owner.kind in {skConverter, skMethod, skProc, skMacro}): - globalError(n.info, errXNotAllowedHere, "\'return\'") - if n.sons[0].kind != nkEmpty: - n.sons[0] = SemExprWithType(c, n.sons[0]) # check for type compatibility: - restype = c.p.owner.typ.sons[0] - if restype != nil: - a = newNodeI(nkAsgn, n.sons[0].info) - n.sons[0] = fitNode(c, restype, n.sons[0]) - # optimize away ``return result``, because it would be transformed - # to ``result = result; return``: - if (n.sons[0].kind == nkSym) and (sfResult in n.sons[0].sym.flags): - n.sons[0] = ast.emptyNode - else: - if (c.p.resultSym == nil): InternalError(n.info, "semReturn") - addSon(a, semExprWithType(c, newSymNode(c.p.resultSym))) - addSon(a, n.sons[0]) - n.sons[0] = a - else: - localError(n.info, errCannotReturnExpr) - -proc SemYield(c: PContext, n: PNode): PNode = - result = n - checkSonsLen(n, 1) - if (c.p.owner == nil) or (c.p.owner.kind != skIterator): - GlobalError(n.info, errYieldNotAllowedHere) - if n.sons[0].kind != nkEmpty: - n.sons[0] = SemExprWithType(c, n.sons[0]) # check for type compatibility: - var restype = c.p.owner.typ.sons[0] - if restype != nil: - n.sons[0] = fitNode(c, restype, n.sons[0]) - if (n.sons[0].typ == nil): InternalError(n.info, "semYield") - else: - localError(n.info, errCannotReturnExpr) - -proc fitRemoveHiddenConv(c: PContext, typ: Ptype, n: PNode): PNode = - result = fitNode(c, typ, n) - if result.kind in {nkHiddenStdConv, nkHiddenSubConv}: - changeType(result.sons[1], typ) - result = result.sons[1] - elif not sameType(result.typ, typ): - changeType(result, typ) - -proc semIdentDef(c: PContext, n: PNode, kind: TSymKind): PSym = - if isTopLevel(c): - result = semIdentWithPragma(c, kind, n, {sfStar, sfMinus}) - incl(result.flags, sfGlobal) - else: - result = semIdentWithPragma(c, kind, n, {}) - -proc semVar(c: PContext, n: PNode): PNode = - var b: PNode - result = copyNode(n) - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] - if gCmd == cmdIdeTools: suggestStmt(c, a) - if a.kind == nkCommentStmt: continue - if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): IllFormedAst(a) - checkMinSonsLen(a, 3) - var length = sonsLen(a) - var typ: PType - if a.sons[length-2].kind != nkEmpty: - typ = semTypeNode(c, a.sons[length-2], nil) - else: - typ = nil - var def: PNode - if a.sons[length-1].kind != nkEmpty: - def = semExprWithType(c, a.sons[length-1]) - # BUGFIX: ``fitNode`` is needed here! - # check type compability between def.typ and typ: - if typ != nil: def = fitNode(c, typ, def) - else: typ = def.typ - else: - def = ast.emptyNode - # this can only happen for errornous var statements: - if typ == nil: continue - if not typeAllowed(typ, skVar): - GlobalError(a.info, errXisNoType, typeToString(typ)) - var tup = skipTypes(typ, {tyGenericInst}) - if a.kind == nkVarTuple: - if tup.kind != tyTuple: GlobalError(a.info, errXExpected, "tuple") - if length - 2 != sonsLen(tup): - GlobalError(a.info, errWrongNumberOfVariables) - b = newNodeI(nkVarTuple, a.info) - newSons(b, length) - b.sons[length - 2] = ast.emptyNode # no type desc - b.sons[length - 1] = def - addSon(result, b) - for j in countup(0, length-3): - var v = semIdentDef(c, a.sons[j], skVar) - if v.flags * {sfStar, sfMinus} != {}: incl(v.flags, sfInInterface) - addInterfaceDecl(c, v) - if a.kind != nkVarTuple: - v.typ = typ - b = newNodeI(nkIdentDefs, a.info) - addSon(b, newSymNode(v)) - addSon(b, ast.emptyNode) # no type description - addSon(b, copyTree(def)) - addSon(result, b) - else: - v.typ = tup.sons[j] - b.sons[j] = newSymNode(v) - -proc semConst(c: PContext, n: PNode): PNode = - result = copyNode(n) - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if gCmd == cmdIdeTools: suggestStmt(c, a) - if a.kind == nkCommentStmt: continue - if (a.kind != nkConstDef): IllFormedAst(a) - checkSonsLen(a, 3) - var v = semIdentDef(c, a.sons[0], skConst) - var typ: PType = nil - if a.sons[1].kind != nkEmpty: typ = semTypeNode(c, a.sons[1], nil) - var def = semAndEvalConstExpr(c, a.sons[2]) - # check type compability between def.typ and typ: - if (typ != nil): - def = fitRemoveHiddenConv(c, typ, def) - else: - typ = def.typ - if not typeAllowed(typ, skConst): - GlobalError(a.info, errXisNoType, typeToString(typ)) - v.typ = typ - v.ast = def # no need to copy - if v.flags * {sfStar, sfMinus} != {}: incl(v.flags, sfInInterface) - addInterfaceDecl(c, v) - var b = newNodeI(nkConstDef, a.info) - addSon(b, newSymNode(v)) - addSon(b, ast.emptyNode) # no type description - addSon(b, copyTree(def)) - addSon(result, b) - -proc transfFieldLoopBody(n: PNode, forLoop: PNode, - tupleType: PType, - tupleIndex, first: int): PNode = - case n.kind - of nkEmpty..pred(nkIdent), succ(nkIdent)..nkNilLit: result = n - of nkIdent: - result = n - var L = sonsLen(forLoop) - # field name: - if first > 0: - if n.ident.id == forLoop[0].ident.id: - if tupleType.n == nil: - # ugh, there are no field names: - result = newStrNode(nkStrLit, "") - else: - result = newStrNode(nkStrLit, tupleType.n.sons[tupleIndex].sym.name.s) - return - # other fields: - for i in first..L-3: - if n.ident.id == forLoop[i].ident.id: - var call = forLoop.sons[L-2] - var tupl = call.sons[i+1-first] - result = newNodeI(nkBracketExpr, n.info) - result.add(tupl) - result.add(newIntNode(nkIntLit, tupleIndex)) - break - else: - result = copyNode(n) - newSons(result, sonsLen(n)) - for i in countup(0, sonsLen(n)-1): - result.sons[i] = transfFieldLoopBody(n.sons[i], forLoop, - tupleType, tupleIndex, first) - -proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = - # so that 'break' etc. work as expected, we produce - # a 'while true: stmt; break' loop ... - result = newNodeI(nkWhileStmt, n.info) - var trueSymbol = StrTableGet(magicsys.systemModule.Tab, getIdent"true") - if trueSymbol == nil: GlobalError(n.info, errSystemNeeds, "true") - - result.add(newSymNode(trueSymbol, n.info)) - var stmts = newNodeI(nkStmtList, n.info) - result.add(stmts) - - var length = sonsLen(n) - var call = n.sons[length-2] - if length-2 != sonsLen(call)-1 + ord(m==mFieldPairs): - GlobalError(n.info, errWrongNumberOfVariables) - - var tupleTypeA = skipTypes(call.sons[1].typ, abstractVar) - if tupleTypeA.kind != tyTuple: InternalError(n.info, "no tuple type!") - for i in 1..call.len-1: - var tupleTypeB = skipTypes(call.sons[i].typ, abstractVar) - if not SameType(tupleTypeA, tupleTypeB): - typeMismatch(call.sons[i], tupleTypeA, tupleTypeB) - - Inc(c.p.nestedLoopCounter) - var loopBody = n.sons[length-1] - for i in 0..sonsLen(tupleTypeA)-1: - openScope(c.tab) - var body = transfFieldLoopBody(loopBody, n, tupleTypeA, i, - ord(m==mFieldPairs)) - stmts.add(SemStmt(c, body)) - closeScope(c.tab) - Dec(c.p.nestedLoopCounter) - var b = newNodeI(nkBreakStmt, n.info) - b.add(ast.emptyNode) - stmts.add(b) - -proc createCountupNode(c: PContext, rangeNode: PNode): PNode = - # convert ``in 3..5`` to ``in countup(3, 5)`` - checkSonsLen(rangeNode, 2) - result = newNodeI(nkCall, rangeNode.info) - var countUp = StrTableGet(magicsys.systemModule.Tab, getIdent"countup") - if countUp == nil: GlobalError(rangeNode.info, errSystemNeeds, "countup") - newSons(result, 3) - result.sons[0] = newSymNode(countup) - result.sons[1] = rangeNode.sons[0] - result.sons[2] = rangeNode.sons[1] - -proc semFor(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 3) - var length = sonsLen(n) - openScope(c.tab) - if n.sons[length-2].kind == nkRange: - n.sons[length-2] = createCountupNode(c, n.sons[length-2]) - n.sons[length-2] = semExprWithType(c, n.sons[length-2], {efWantIterator}) - var call = n.sons[length-2] - if call.kind != nkCall or call.sons[0].kind != nkSym or - call.sons[0].sym.kind != skIterator: - GlobalError(n.sons[length - 2].info, errIteratorExpected) - elif call.sons[0].sym.magic != mNone: - result = semForFields(c, n, call.sons[0].sym.magic) - else: - var iter = skipTypes(n.sons[length-2].typ, {tyGenericInst}) - if iter.kind != tyTuple: - if length != 3: GlobalError(n.info, errWrongNumberOfVariables) - var v = newSymS(skForVar, n.sons[0], c) - v.typ = iter - n.sons[0] = newSymNode(v) - addDecl(c, v) - else: - if length-2 != sonsLen(iter): - GlobalError(n.info, errWrongNumberOfVariables) - for i in countup(0, length - 3): - var v = newSymS(skForVar, n.sons[i], c) - v.typ = iter.sons[i] - n.sons[i] = newSymNode(v) - addDecl(c, v) - Inc(c.p.nestedLoopCounter) - n.sons[length-1] = SemStmt(c, n.sons[length-1]) - Dec(c.p.nestedLoopCounter) - closeScope(c.tab) - -proc semRaise(c: PContext, n: PNode): PNode = - result = n - checkSonsLen(n, 1) - if n.sons[0].kind != nkEmpty: - n.sons[0] = semExprWithType(c, n.sons[0]) - var typ = n.sons[0].typ - if (typ.kind != tyRef) or (typ.sons[0].kind != tyObject): - localError(n.info, errExprCannotBeRaised) - -proc semTry(c: PContext, n: PNode): PNode = - var check: TIntSet - result = n - checkMinSonsLen(n, 2) - n.sons[0] = semStmtScope(c, n.sons[0]) - IntSetInit(check) - for i in countup(1, sonsLen(n) - 1): - var a = n.sons[i] - checkMinSonsLen(a, 1) - var length = sonsLen(a) - if a.kind == nkExceptBranch: - for j in countup(0, length - 2): - var typ = semTypeNode(c, a.sons[j], nil) - if typ.kind == tyRef: typ = typ.sons[0] - if typ.kind != tyObject: - GlobalError(a.sons[j].info, errExprCannotBeRaised) - a.sons[j] = newNodeI(nkType, a.sons[j].info) - a.sons[j].typ = typ - if IntSetContainsOrIncl(check, typ.id): - localError(a.sons[j].info, errExceptionAlreadyHandled) - elif a.kind != nkFinally: - illFormedAst(n) - # last child of an nkExcept/nkFinally branch is a statement: - a.sons[length - 1] = semStmtScope(c, a.sons[length - 1]) - -proc addGenericParamListToScope(c: PContext, n: PNode) = - if n.kind != nkGenericParams: - InternalError(n.info, "addGenericParamListToScope") - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] - if a.kind != nkSym: internalError(a.info, "addGenericParamListToScope") - addDecl(c, a.sym) - -proc typeSectionLeftSidePass(c: PContext, n: PNode) = - # process the symbols on the left side for the whole type section, before - # we even look at the type definitions on the right - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if gCmd == cmdIdeTools: suggestStmt(c, a) - if a.kind == nkCommentStmt: continue - if a.kind != nkTypeDef: IllFormedAst(a) - checkSonsLen(a, 3) - var s = semIdentDef(c, a.sons[0], skType) - if s.flags * {sfStar, sfMinus} != {}: incl(s.flags, sfInInterface) - s.typ = newTypeS(tyForward, c) - s.typ.sym = s # process pragmas: - if a.sons[0].kind == nkPragmaExpr: - pragma(c, s, a.sons[0].sons[1], typePragmas) - # add it here, so that recursive types are possible: - addInterfaceDecl(c, s) - a.sons[0] = newSymNode(s) - -proc typeSectionRightSidePass(c: PContext, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - if (a.sons[0].kind != nkSym): IllFormedAst(a) - var s = a.sons[0].sym - if s.magic == mNone and a.sons[2].kind == nkEmpty: - GlobalError(a.info, errImplOfXexpected, s.name.s) - if s.magic != mNone: processMagicType(c, s) - if a.sons[1].kind != nkEmpty: - # We have a generic type declaration here. In generic types, - # symbol lookup needs to be done here. - openScope(c.tab) - pushOwner(s) - s.typ.kind = tyGenericBody - if s.typ.containerID != 0: - InternalError(a.info, "semTypeSection: containerID") - s.typ.containerID = getID() - a.sons[1] = semGenericParamList(c, a.sons[1], s.typ) - # we fill it out later. For magic generics like 'seq', it won't be filled - # so we use tyEmpty instead of nil to not crash for strange conversions - # like: mydata.seq - addSon(s.typ, newTypeS(tyEmpty, c)) - s.ast = a - var body = semTypeNode(c, a.sons[2], nil) - if body != nil: body.sym = s - s.typ.sons[sonsLen(s.typ) - 1] = body - popOwner() - closeScope(c.tab) - elif a.sons[2].kind != nkEmpty: - # process the type's body: - pushOwner(s) - var t = semTypeNode(c, a.sons[2], s.typ) - if s.typ == nil: - s.typ = t - elif t != s.typ: - # this can happen for e.g. tcan_alias_specialised_generic: - assignType(s.typ, t) - #debug s.typ - s.ast = a - popOwner() - -proc typeSectionFinalPass(c: PContext, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.sons[0].kind != nkSym): IllFormedAst(a) - var s = a.sons[0].sym - # compute the type's size and check for illegal recursions: - if a.sons[1].kind == nkEmpty: - if a.sons[2].kind in {nkSym, nkIdent, nkAccQuoted}: - # type aliases are hard: - #MessageOut('for type ' + typeToString(s.typ)); - var t = semTypeNode(c, a.sons[2], nil) - if t.kind in {tyObject, tyEnum}: - assignType(s.typ, t) - s.typ.id = t.id # same id - checkConstructedType(s.info, s.typ) - -proc SemTypeSection(c: PContext, n: PNode): PNode = - typeSectionLeftSidePass(c, n) - typeSectionRightSidePass(c, n) - typeSectionFinalPass(c, n) - result = n - -proc semParamList(c: PContext, n, genericParams: PNode, s: PSym) = - s.typ = semProcTypeNode(c, n, genericParams, nil) - -proc addParams(c: PContext, n: PNode) = - for i in countup(1, sonsLen(n)-1): - if (n.sons[i].kind != nkSym): InternalError(n.info, "addParams") - addDecl(c, n.sons[i].sym) - -proc semBorrow(c: PContext, n: PNode, s: PSym) = - # search for the correct alias: - var b = SearchForBorrowProc(c, s, c.tab.tos - 2) - if b != nil: - # store the alias: - n.sons[codePos] = newSymNode(b) - else: - LocalError(n.info, errNoSymbolToBorrowFromFound) - -proc sideEffectsCheck(c: PContext, s: PSym) = - if {sfNoSideEffect, sfSideEffect} * s.flags == - {sfNoSideEffect, sfSideEffect}: - LocalError(s.info, errXhasSideEffects, s.name.s) - -proc addResult(c: PContext, t: PType, info: TLineInfo) = - if t != nil: - var s = newSym(skVar, getIdent("result"), getCurrOwner()) - s.info = info - s.typ = t - incl(s.flags, sfResult) - incl(s.flags, sfUsed) - addDecl(c, s) - c.p.resultSym = s - -proc addResultNode(c: PContext, n: PNode) = - if c.p.resultSym != nil: addSon(n, newSymNode(c.p.resultSym)) - -proc semLambda(c: PContext, n: PNode): PNode = - result = n - checkSonsLen(n, codePos + 1) - var s = newSym(skProc, getIdent(":anonymous"), getCurrOwner()) - s.info = n.info - s.ast = n - n.sons[namePos] = newSymNode(s) - pushOwner(s) - openScope(c.tab) - if (n.sons[genericParamsPos].kind != nkEmpty): - illFormedAst(n) # process parameters: - if n.sons[paramsPos].kind != nkEmpty: - semParamList(c, n.sons[ParamsPos], nil, s) - addParams(c, s.typ.n) - else: - s.typ = newTypeS(tyProc, c) - addSon(s.typ, nil) - s.typ.callConv = ccClosure - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], lambdaPragmas) - s.options = gOptions - if n.sons[codePos].kind != nkEmpty: - if sfImportc in s.flags: - LocalError(n.sons[codePos].info, errImplOfXNotAllowed, s.name.s) - pushProcCon(c, s) - addResult(c, s.typ.sons[0], n.info) - n.sons[codePos] = semStmtScope(c, n.sons[codePos]) - addResultNode(c, n) - popProcCon(c) - else: - LocalError(n.info, errImplOfXexpected, s.name.s) - closeScope(c.tab) # close scope for parameters - popOwner() - result.typ = s.typ - -proc semProcAux(c: PContext, n: PNode, kind: TSymKind, - validPragmas: TSpecialWords): PNode = - var - proto: PSym - gp: PNode - result = n - checkSonsLen(n, codePos + 1) - var s = semIdentDef(c, n.sons[0], kind) - n.sons[namePos] = newSymNode(s) - if sfStar in s.flags: incl(s.flags, sfInInterface) - s.ast = n - pushOwner(s) - openScope(c.tab) - if n.sons[genericParamsPos].kind != nkEmpty: - n.sons[genericParamsPos] = semGenericParamList(c, n.sons[genericParamsPos]) - gp = n.sons[genericParamsPos] - else: - gp = newNodeI(nkGenericParams, n.info) - # process parameters: - if n.sons[paramsPos].kind != nkEmpty: - semParamList(c, n.sons[ParamsPos], gp, s) - if sonsLen(gp) > 0: - if n.sons[genericParamsPos].kind == nkEmpty: - # we have a list of implicit type parameters: - n.sons[genericParamsPos] = gp - # check for semantics again: - semParamList(c, n.sons[ParamsPos], nil, s) - addParams(c, s.typ.n) - else: - s.typ = newTypeS(tyProc, c) - addSon(s.typ, nil) - proto = SearchForProc(c, s, c.tab.tos - 2) # -2 because we have a scope open - # for parameters - if proto == nil: - if c.p.owner.kind != skModule: - s.typ.callConv = ccClosure - else: - s.typ.callConv = lastOptionEntry(c).defaultCC - # add it here, so that recursive procs are possible: - # -2 because we have a scope open for parameters - if kind in OverloadableSyms: - addInterfaceOverloadableSymAt(c, s, c.tab.tos - 2) - else: - addInterfaceDeclAt(c, s, c.tab.tos - 2) - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], validPragmas) - else: - if n.sons[pragmasPos].kind != nkEmpty: - LocalError(n.sons[pragmasPos].info, errPragmaOnlyInHeaderOfProc) - if sfForward notin proto.flags: - LocalError(n.info, errAttemptToRedefine, proto.name.s) - excl(proto.flags, sfForward) - closeScope(c.tab) # close scope with wrong parameter symbols - openScope(c.tab) # open scope for old (correct) parameter symbols - if proto.ast.sons[genericParamsPos].kind != nkEmpty: - addGenericParamListToScope(c, proto.ast.sons[genericParamsPos]) - addParams(c, proto.typ.n) - proto.info = s.info # more accurate line information - s.typ = proto.typ - s = proto - n.sons[genericParamsPos] = proto.ast.sons[genericParamsPos] - n.sons[paramsPos] = proto.ast.sons[paramsPos] - if (n.sons[namePos].kind != nkSym): InternalError(n.info, "semProcAux") - n.sons[namePos].sym = proto - proto.ast = n # needed for code generation - popOwner() - pushOwner(s) - s.options = gOptions - if n.sons[codePos].kind != nkEmpty: - # for DLL generation it is annoying to check for sfImportc! - if sfBorrow in s.flags: - LocalError(n.sons[codePos].info, errImplOfXNotAllowed, s.name.s) - if n.sons[genericParamsPos].kind == nkEmpty: - pushProcCon(c, s) - if (s.typ.sons[0] != nil) and (kind != skIterator): - addResult(c, s.typ.sons[0], n.info) - if sfImportc notin s.flags: - # no semantic checking for importc: - n.sons[codePos] = semStmtScope(c, n.sons[codePos]) - if s.typ.sons[0] != nil and kind != skIterator: addResultNode(c, n) - popProcCon(c) - else: - if s.typ.sons[0] != nil and kind != skIterator: - addDecl(c, newSym(skUnknown, getIdent("result"), nil)) - n.sons[codePos] = semGenericStmtScope(c, n.sons[codePos]) - if sfImportc in s.flags: - # so we just ignore the body after semantic checking for importc: - n.sons[codePos] = ast.emptyNode - else: - if proto != nil: LocalError(n.info, errImplOfXexpected, proto.name.s) - if {sfImportc, sfBorrow} * s.flags == {}: incl(s.flags, sfForward) - elif sfBorrow in s.flags: semBorrow(c, n, s) - sideEffectsCheck(c, s) - closeScope(c.tab) # close scope for parameters - popOwner() - -proc semIterator(c: PContext, n: PNode): PNode = - result = semProcAux(c, n, skIterator, iteratorPragmas) - var s = result.sons[namePos].sym - var t = s.typ - if t.sons[0] == nil: - LocalError(n.info, errXNeedsReturnType, "iterator") - if n.sons[codePos].kind == nkEmpty and s.magic == mNone: - LocalError(n.info, errImplOfXexpected, s.name.s) - -proc semProc(c: PContext, n: PNode): PNode = - result = semProcAux(c, n, skProc, procPragmas) - -proc semMethod(c: PContext, n: PNode): PNode = - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "method") - result = semProcAux(c, n, skMethod, methodPragmas) - - var s = result.sons[namePos].sym - var t = s.typ - var hasObjParam = false - - for col in countup(1, sonsLen(t)-1): - if skipTypes(t.sons[col], skipPtrs).kind == tyObject: - hasObjParam = true - break - - # XXX this not really correct way to do it: Perhaps it should be done after - # generic instantiation. Well it's good enough for now: - if not hasObjParam: - LocalError(n.info, errXNeedsParamObjectType, "method") - -proc semConverterDef(c: PContext, n: PNode): PNode = - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "converter") - checkSonsLen(n, codePos + 1) - if n.sons[genericParamsPos].kind != nkEmpty: - LocalError(n.info, errNoGenericParamsAllowedForX, "converter") - result = semProcAux(c, n, skConverter, converterPragmas) - var s = result.sons[namePos].sym - var t = s.typ - if t.sons[0] == nil: LocalError(n.info, errXNeedsReturnType, "converter") - if sonsLen(t) != 2: LocalError(n.info, errXRequiresOneArgument, "converter") - addConverter(c, s) - -proc semMacroDef(c: PContext, n: PNode): PNode = - checkSonsLen(n, codePos + 1) - if n.sons[genericParamsPos].kind != nkEmpty: - LocalError(n.info, errNoGenericParamsAllowedForX, "macro") - result = semProcAux(c, n, skMacro, macroPragmas) - var s = result.sons[namePos].sym - var t = s.typ - if t.sons[0] == nil: LocalError(n.info, errXNeedsReturnType, "macro") - if sonsLen(t) != 2: LocalError(n.info, errXRequiresOneArgument, "macro") - if n.sons[codePos].kind == nkEmpty: - LocalError(n.info, errImplOfXexpected, s.name.s) - -proc evalInclude(c: PContext, n: PNode): PNode = - result = newNodeI(nkStmtList, n.info) - addSon(result, n) # the rodwriter needs include information! - for i in countup(0, sonsLen(n) - 1): - var f = getModuleFile(n.sons[i]) - var fileIndex = includeFilename(f) - if IntSetContainsOrIncl(c.includedFiles, fileIndex): - GlobalError(n.info, errRecursiveDependencyX, f) - addSon(result, semStmt(c, gIncludeFile(f))) - IntSetExcl(c.includedFiles, fileIndex) - -proc SemStmt(c: PContext, n: PNode): PNode = - const # must be last statements in a block: - LastBlockStmts = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} - result = n - if gCmd == cmdIdeTools: - suggestStmt(c, n) - if nfSem in n.flags: return - case n.kind - of nkAsgn: result = semAsgn(c, n) - of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkMacroStmt, nkCallStrLit: - result = semCommand(c, n) - of nkEmpty, nkCommentStmt, nkNilLit: nil - of nkBlockStmt: result = semBlock(c, n) - of nkStmtList: - var length = sonsLen(n) - for i in countup(0, length - 1): - n.sons[i] = semStmt(c, n.sons[i]) - if n.sons[i].kind in LastBlockStmts: - for j in countup(i + 1, length - 1): - case n.sons[j].kind - of nkPragma, nkCommentStmt, nkNilLit, nkEmpty: nil - else: localError(n.sons[j].info, errStmtInvalidAfterReturn) - of nkRaiseStmt: result = semRaise(c, n) - of nkVarSection: result = semVar(c, n) - of nkConstSection: result = semConst(c, n) - of nkTypeSection: result = SemTypeSection(c, n) - of nkIfStmt: result = SemIf(c, n) - of nkWhenStmt: result = semWhen(c, n) - of nkDiscardStmt: result = semDiscard(c, n) - of nkWhileStmt: result = semWhile(c, n) - of nkTryStmt: result = semTry(c, n) - of nkBreakStmt, nkContinueStmt: result = semBreakOrContinue(c, n) - of nkForStmt: result = semFor(c, n) - of nkCaseStmt: result = semCase(c, n) - of nkReturnStmt: result = semReturn(c, n) - of nkAsmStmt: result = semAsm(c, n) - of nkYieldStmt: result = semYield(c, n) - of nkPragma: pragma(c, c.p.owner, n, stmtPragmas) - of nkIteratorDef: result = semIterator(c, n) - of nkProcDef: result = semProc(c, n) - of nkMethodDef: result = semMethod(c, n) - of nkConverterDef: result = semConverterDef(c, n) - of nkMacroDef: result = semMacroDef(c, n) - of nkTemplateDef: result = semTemplateDef(c, n) - of nkImportStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "import") - result = evalImport(c, n) - of nkFromStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "from") - result = evalFrom(c, n) - of nkIncludeStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "include") - result = evalInclude(c, n) - else: - # in interactive mode, we embed the expression in an 'echo': - if gCmd == cmdInteractive: - result = buildEchoStmt(c, semExpr(c, n)) - else: - LocalError(n.info, errStmtExpected) - result = ast.emptyNode - if result == nil: InternalError(n.info, "SemStmt: result = nil") - incl(result.flags, nfSem) - -proc semStmtScope(c: PContext, n: PNode): PNode = - openScope(c.tab) - result = semStmt(c, n) - closeScope(c.tab) diff --git a/rod/semtempl.nim b/rod/semtempl.nim deleted file mode 100755 index 7782c7b42..000000000 --- a/rod/semtempl.nim +++ /dev/null @@ -1,204 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -proc isExpr(n: PNode): bool = - # returns true if ``n`` looks like an expression - case n.kind - of nkIdent..nkNilLit: - result = true - of nkCall..nkPassAsOpenArray: - for i in countup(0, sonsLen(n) - 1): - if not isExpr(n.sons[i]): - return false - result = true - else: result = false - -proc isTypeDesc(n: PNode): bool = - # returns true if ``n`` looks like a type desc - case n.kind - of nkIdent, nkSym, nkType: - result = true - of nkDotExpr, nkBracketExpr: - for i in countup(0, sonsLen(n) - 1): - if not isTypeDesc(n.sons[i]): - return false - result = true - of nkTypeOfExpr..nkEnumTy: - result = true - else: result = false - -proc evalTemplateAux(c: PContext, templ, actual: PNode, sym: PSym): PNode = - case templ.kind - of nkSym: - var p = templ.sym - if (p.kind == skParam) and (p.owner.id == sym.id): - result = copyTree(actual.sons[p.position]) - else: - result = copyNode(templ) - of nkNone..nkIdent, nkType..nkNilLit: # atom - result = copyNode(templ) - else: - result = copyNode(templ) - newSons(result, sonsLen(templ)) - for i in countup(0, sonsLen(templ) - 1): - result.sons[i] = evalTemplateAux(c, templ.sons[i], actual, sym) - -var evalTemplateCounter: int = 0 - # to prevend endless recursion in templates instantation - -proc evalTemplateArgs(c: PContext, n: PNode, s: PSym): PNode = - var - f, a: int - arg: PNode - f = sonsLen(s.typ) - # if the template has zero arguments, it can be called without ``()`` - # `n` is then a nkSym or something similar - case n.kind - of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: - a = sonsLen(n) - else: a = 0 - if a > f: LocalError(n.info, errWrongNumberOfArguments) - result = copyNode(n) - for i in countup(1, f - 1): - if i < a: arg = n.sons[i] - else: arg = copyTree(s.typ.n.sons[i].sym.ast) - if arg == nil or arg.kind == nkEmpty: - LocalError(n.info, errWrongNumberOfArguments) - elif not (s.typ.sons[i].kind in {tyTypeDesc, tyStmt, tyExpr}): - # concrete type means semantic checking for argument: - # XXX This is horrible! Better make semantic checking use some kind - # of fixpoint iteration ... - arg = fitNode(c, s.typ.sons[i], semExprWithType(c, arg)) - addSon(result, arg) - -proc evalTemplate(c: PContext, n: PNode, sym: PSym): PNode = - var args: PNode - inc(evalTemplateCounter) - if evalTemplateCounter <= 100: - # replace each param by the corresponding node: - args = evalTemplateArgs(c, n, sym) - result = evalTemplateAux(c, sym.ast.sons[codePos], args, sym) - dec(evalTemplateCounter) - else: - GlobalError(n.info, errTemplateInstantiationTooNested) - result = n - -proc symChoice(c: PContext, n: PNode, s: PSym): PNode = - var - a: PSym - o: TOverloadIter - i: int - i = 0 - a = initOverloadIter(o, c, n) - while a != nil: - a = nextOverloadIter(o, c, n) - inc(i) - if i <= 1: - result = newSymNode(s) - result.info = n.info - markUsed(n, s) - else: - # semantic checking requires a type; ``fitNode`` deals with it - # appropriately - result = newNodeIT(nkSymChoice, n.info, newTypeS(tyNone, c)) - a = initOverloadIter(o, c, n) - while a != nil: - addSon(result, newSymNode(a)) - a = nextOverloadIter(o, c, n) - -proc resolveTemplateParams(c: PContext, n: PNode, withinBind: bool, - toBind: var TIntSet): PNode = - var s: PSym - case n.kind - of nkIdent: - if not withinBind and not IntSetContains(toBind, n.ident.id): - s = SymTabLocalGet(c.Tab, n.ident) - if (s != nil): - result = newSymNode(s) - result.info = n.info - else: - result = n - else: - IntSetIncl(toBind, n.ident.id) - result = symChoice(c, n, lookup(c, n)) - of nkEmpty, nkSym..nkNilLit: # atom - result = n - of nkBind: - result = resolveTemplateParams(c, n.sons[0], true, toBind) - else: - result = n - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = resolveTemplateParams(c, n.sons[i], withinBind, toBind) - -proc transformToExpr(n: PNode): PNode = - var realStmt: int - result = n - case n.kind - of nkStmtList: - realStmt = - 1 - for i in countup(0, sonsLen(n) - 1): - case n.sons[i].kind - of nkCommentStmt, nkEmpty, nkNilLit: - nil - else: - if realStmt == - 1: realStmt = i - else: realStmt = - 2 - if realStmt >= 0: result = transformToExpr(n.sons[realStmt]) - else: n.kind = nkStmtListExpr - of nkBlockStmt: - n.kind = nkBlockExpr - #nkIfStmt: n.kind := nkIfExpr; // this is not correct! - else: - nil - -proc semTemplateDef(c: PContext, n: PNode): PNode = - var - s: PSym - toBind: TIntSet - if c.p.owner.kind == skModule: - s = semIdentVis(c, skTemplate, n.sons[0], {sfStar}) - incl(s.flags, sfGlobal) - else: - s = semIdentVis(c, skTemplate, n.sons[0], {}) - if sfStar in s.flags: - incl(s.flags, sfInInterface) # check parameter list: - pushOwner(s) - openScope(c.tab) - n.sons[namePos] = newSymNode(s) # check that no pragmas exist: - if n.sons[pragmasPos].kind != nkEmpty: - LocalError(n.info, errNoPragmasAllowedForX, "template") - # check that no generic parameters exist: - if n.sons[genericParamsPos].kind != nkEmpty: - LocalError(n.info, errNoGenericParamsAllowedForX, "template") - if n.sons[paramsPos].kind == nkEmpty: - # use ``stmt`` as implicit result type - s.typ = newTypeS(tyProc, c) - s.typ.n = newNodeI(nkFormalParams, n.info) - addSon(s.typ, newTypeS(tyStmt, c)) - addSon(s.typ.n, newNodeIT(nkType, n.info, s.typ.sons[0])) - else: - semParamList(c, n.sons[ParamsPos], nil, s) - if n.sons[paramsPos].sons[0].kind == nkEmpty: - # use ``stmt`` as implicit result type - s.typ.sons[0] = newTypeS(tyStmt, c) - s.typ.n.sons[0] = newNodeIT(nkType, n.info, s.typ.sons[0]) - addParams(c, s.typ.n) # resolve parameters: - IntSetInit(toBind) - n.sons[codePos] = resolveTemplateParams(c, n.sons[codePos], false, toBind) - if not (s.typ.sons[0].kind in {tyStmt, tyTypeDesc}): - n.sons[codePos] = transformToExpr(n.sons[codePos]) - # only parameters are resolved, no type checking is performed - closeScope(c.tab) - popOwner() - s.ast = n - result = n - if n.sons[codePos].kind == nkEmpty: - LocalError(n.info, errImplOfXexpected, s.name.s) - # add identifier of template as a last step to not allow recursive templates: - addInterfaceDecl(c, s) diff --git a/rod/semtypes.nim b/rod/semtypes.nim deleted file mode 100755 index bb0bcdf93..000000000 --- a/rod/semtypes.nim +++ /dev/null @@ -1,733 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# this module does the semantic checking of type declarations - -proc newOrPrevType(kind: TTypeKind, prev: PType, c: PContext): PType = - if prev == nil: - result = newTypeS(kind, c) - else: - result = prev - if result.kind == tyForward: result.kind = kind - -proc semEnum(c: PContext, n: PNode, prev: PType): PType = - var - counter, x: BiggestInt - e: PSym - base: PType - counter = 0 - base = nil - result = newOrPrevType(tyEnum, prev, c) - result.n = newNodeI(nkEnumTy, n.info) - checkMinSonsLen(n, 1) - if n.sons[0].kind != nkEmpty: - base = semTypeNode(c, n.sons[0].sons[0], nil) - if base.kind != tyEnum: - localError(n.sons[0].info, errInheritanceOnlyWithEnums) - counter = lastOrd(base) + 1 - addSon(result, base) - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkEnumFieldDef: - e = newSymS(skEnumField, n.sons[i].sons[0], c) - var v = semConstExpr(c, n.sons[i].sons[1]) - var strVal: PNode = nil - case skipTypes(v.typ, abstractInst).kind - of tyTuple: - if sonsLen(v) != 2: GlobalError(v.info, errWrongNumberOfVariables) - strVal = v.sons[1] # second tuple part is the string value - if skipTypes(strVal.typ, abstractInst).kind notin {tyString, tyCstring}: - GlobalError(strVal.info, errStringLiteralExpected) - x = getOrdValue(v.sons[0]) # first tuple part is the ordinal - of tyString, tyCstring: - strVal = v - x = counter - else: - x = getOrdValue(v) - if i != 1: - if (x != counter): incl(result.flags, tfEnumHasWholes) - if x < counter: - GlobalError(n.sons[i].info, errInvalidOrderInEnumX, e.name.s) - e.ast = strVal # might be nil - counter = x - of nkSym: - e = n.sons[i].sym - of nkIdent: - e = newSymS(skEnumField, n.sons[i], c) - else: illFormedAst(n) - e.typ = result - e.position = int(counter) - if (result.sym != nil) and (sfInInterface in result.sym.flags): - incl(e.flags, sfUsed) # BUGFIX - incl(e.flags, sfInInterface) # BUGFIX - StrTableAdd(c.module.tab, e) # BUGFIX - addSon(result.n, newSymNode(e)) - addDeclAt(c, e, c.tab.tos - 1) - inc(counter) - -proc semSet(c: PContext, n: PNode, prev: PType): PType = - result = newOrPrevType(tySet, prev, c) - if sonsLen(n) == 2: - var base = semTypeNode(c, n.sons[1], nil) - addSon(result, base) - if base.kind == tyGenericInst: base = lastSon(base) - if base.kind != tyGenericParam: - if not isOrdinalType(base): GlobalError(n.info, errOrdinalTypeExpected) - if lengthOrd(base) > MaxSetElements: GlobalError(n.info, errSetTooBig) - else: - GlobalError(n.info, errXExpectsOneTypeParam, "set") - -proc semContainer(c: PContext, n: PNode, kind: TTypeKind, kindStr: string, - prev: PType): PType = - result = newOrPrevType(kind, prev, c) - if sonsLen(n) == 2: - var base = semTypeNode(c, n.sons[1], nil) - addSon(result, base) - else: - GlobalError(n.info, errXExpectsOneTypeParam, kindStr) - -proc semAnyRef(c: PContext, n: PNode, kind: TTypeKind, kindStr: string, - prev: PType): PType = - result = newOrPrevType(kind, prev, c) - if sonsLen(n) == 1: - var base = semTypeNode(c, n.sons[0], nil) - addSon(result, base) - else: - GlobalError(n.info, errXExpectsOneTypeParam, kindStr) - -proc semVarType(c: PContext, n: PNode, prev: PType): PType = - result = newOrPrevType(tyVar, prev, c) - if sonsLen(n) == 1: - var base = semTypeNode(c, n.sons[0], nil) - if base.kind == tyVar: GlobalError(n.info, errVarVarTypeNotAllowed) - addSon(result, base) - else: - GlobalError(n.info, errXExpectsOneTypeParam, "var") - -proc semDistinct(c: PContext, n: PNode, prev: PType): PType = - result = newOrPrevType(tyDistinct, prev, c) - if sonsLen(n) == 1: addSon(result, semTypeNode(c, n.sons[0], nil)) - else: GlobalError(n.info, errXExpectsOneTypeParam, "distinct") - -proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = - if (n.kind != nkRange): InternalError(n.info, "semRangeAux") - checkSonsLen(n, 2) - result = newOrPrevType(tyRange, prev, c) - result.n = newNodeI(nkRange, n.info) - if (n.sons[0].kind == nkEmpty) or (n.sons[1].kind == nkEmpty): - GlobalError(n.Info, errRangeIsEmpty) - var a = semConstExpr(c, n.sons[0]) - var b = semConstExpr(c, n.sons[1]) - if not sameType(a.typ, b.typ): GlobalError(n.info, errPureTypeMismatch) - if not (a.typ.kind in - {tyInt..tyInt64, tyEnum, tyBool, tyChar, tyFloat..tyFloat128}): - GlobalError(n.info, errOrdinalTypeExpected) - if enumHasWholes(a.typ): - GlobalError(n.info, errEnumXHasHoles, a.typ.sym.name.s) - if not leValue(a, b): GlobalError(n.Info, errRangeIsEmpty) - addSon(result.n, a) - addSon(result.n, b) - addSon(result, b.typ) - -proc semRange(c: PContext, n: PNode, prev: PType): PType = - result = nil - if sonsLen(n) == 2: - if n.sons[1].kind == nkRange: result = semRangeAux(c, n.sons[1], prev) - else: GlobalError(n.sons[0].info, errRangeExpected) - else: - GlobalError(n.info, errXExpectsOneTypeParam, "range") - -proc semArray(c: PContext, n: PNode, prev: PType): PType = - var indx, base: PType - result = newOrPrevType(tyArray, prev, c) - if sonsLen(n) == 3: - # 3 = length(array indx base) - if n.sons[1].kind == nkRange: indx = semRangeAux(c, n.sons[1], nil) - else: indx = semTypeNode(c, n.sons[1], nil) - addSon(result, indx) - if indx.kind == tyGenericInst: indx = lastSon(indx) - if indx.kind != tyGenericParam: - if not isOrdinalType(indx): - GlobalError(n.sons[1].info, errOrdinalTypeExpected) - if enumHasWholes(indx): - GlobalError(n.sons[1].info, errEnumXHasHoles, indx.sym.name.s) - base = semTypeNode(c, n.sons[2], nil) - addSon(result, base) - else: - GlobalError(n.info, errArrayExpectsTwoTypeParams) - -proc semOrdinal(c: PContext, n: PNode, prev: PType): PType = - result = newOrPrevType(tyOrdinal, prev, c) - if sonsLen(n) == 2: - var base = semTypeNode(c, n.sons[1], nil) - if base.kind != tyGenericParam: - if not isOrdinalType(base): - GlobalError(n.sons[1].info, errOrdinalTypeExpected) - addSon(result, base) - else: - GlobalError(n.info, errXExpectsOneTypeParam, "ordinal") - -proc semTypeIdent(c: PContext, n: PNode): PSym = - if n.kind == nkSym: - result = n.sym - else: - result = qualifiedLookup(c, n, {checkAmbiguity, checkUndeclared}) - if result != nil: - markUsed(n, result) - if result.kind != skType: GlobalError(n.info, errTypeExpected) - if result.typ.kind != tyGenericParam: - # XXX get rid of this hack! - reset(n[]) - n.kind = nkSym - n.sym = result - else: - GlobalError(n.info, errIdentifierExpected) - -proc semTuple(c: PContext, n: PNode, prev: PType): PType = - var - typ: PType - check: TIntSet - result = newOrPrevType(tyTuple, prev, c) - result.n = newNodeI(nkRecList, n.info) - IntSetInit(check) - var counter = 0 - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if (a.kind != nkIdentDefs): IllFormedAst(a) - checkMinSonsLen(a, 3) - var length = sonsLen(a) - if a.sons[length - 2].kind != nkEmpty: - typ = semTypeNode(c, a.sons[length - 2], nil) - else: GlobalError(a.info, errTypeExpected) - if a.sons[length - 1].kind != nkEmpty: - GlobalError(a.sons[length - 1].info, errInitHereNotAllowed) - for j in countup(0, length - 3): - var field = newSymS(skField, a.sons[j], c) - field.typ = typ - field.position = counter - inc(counter) - if IntSetContainsOrIncl(check, field.name.id): - GlobalError(a.sons[j].info, errAttemptToRedefine, field.name.s) - addSon(result.n, newSymNode(field)) - addSon(result, typ) - -proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = - var - elem: PType - isConcrete: bool - if (s.typ == nil) or (s.typ.kind != tyGenericBody): - GlobalError(n.info, errCannotInstantiateX, s.name.s) - result = newOrPrevType(tyGenericInvokation, prev, c) - if (s.typ.containerID == 0): InternalError(n.info, "semtypes.semGeneric") - if sonsLen(n) != sonsLen(s.typ): - GlobalError(n.info, errWrongNumberOfArguments) - addSon(result, s.typ) - isConcrete = true # iterate over arguments: - for i in countup(1, sonsLen(n) - 1): - elem = semTypeNode(c, n.sons[i], nil) - if elem.kind == tyGenericParam: isConcrete = false - addSon(result, elem) - if isConcrete: - if s.ast == nil: GlobalError(n.info, errCannotInstantiateX, s.name.s) - result = instGenericContainer(c, n, result) - -proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym = - # identifier with visibility - if n.kind == nkPostfix: - if sonsLen(n) == 2 and n.sons[0].kind == nkIdent: - result = newSymS(kind, n.sons[1], c) - var v = n.sons[0].ident - if (sfStar in allowed) and (v.id == ord(wStar)): - incl(result.flags, sfStar) - elif (sfMinus in allowed) and (v.id == ord(wMinus)): - incl(result.flags, sfMinus) - else: - LocalError(n.sons[0].info, errInvalidVisibilityX, v.s) - else: - illFormedAst(n) - else: - result = newSymS(kind, n, c) - -proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym = - if n.kind == nkPragmaExpr: - checkSonsLen(n, 2) - result = semIdentVis(c, kind, n.sons[0], allowed) - case kind - of skType: - # process pragmas later, because result.typ has not been set yet - of skField: pragma(c, result, n.sons[1], fieldPragmas) - of skVar: pragma(c, result, n.sons[1], varPragmas) - of skConst: pragma(c, result, n.sons[1], constPragmas) - else: nil - else: - result = semIdentVis(c, kind, n, allowed) - -proc checkForOverlap(c: PContext, t, ex: PNode, branchIndex: int) = - for i in countup(1, branchIndex - 1): - for j in countup(0, sonsLen(t.sons[i]) - 2): - if overlap(t.sons[i].sons[j], ex): - LocalError(ex.info, errDuplicateCaseLabel) - -proc semBranchExpr(c: PContext, t: PNode, ex: var PNode) = - ex = semConstExpr(c, ex) - checkMinSonsLen(t, 1) - if (cmpTypes(t.sons[0].typ, ex.typ) <= isConvertible): - typeMismatch(ex, t.sons[0].typ, ex.typ) - -proc SemCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, - covered: var biggestInt) = - for i in countup(0, sonsLen(branch) - 2): - var b = branch.sons[i] - if b.kind == nkRange: - checkSonsLen(b, 2) - semBranchExpr(c, t, b.sons[0]) - semBranchExpr(c, t, b.sons[1]) - if emptyRange(b.sons[0], b.sons[1]): - #MessageOut(renderTree(t)); - GlobalError(b.info, errRangeIsEmpty) - covered = covered + getOrdValue(b.sons[1]) - getOrdValue(b.sons[0]) + 1 - else: - semBranchExpr(c, t, branch.sons[i]) # NOT: `b`, because of var-param! - inc(covered) - checkForOverlap(c, t, branch.sons[i], branchIndex) - -proc semRecordNodeAux(c: PContext, n: PNode, check: var TIntSet, pos: var int, - father: PNode, rectype: PSym) -proc semRecordCase(c: PContext, n: PNode, check: var TIntSet, pos: var int, - father: PNode, rectype: PSym) = - var - covered: biggestint - chckCovered: bool - a, b: PNode - typ: PType - a = copyNode(n) - checkMinSonsLen(n, 2) - semRecordNodeAux(c, n.sons[0], check, pos, a, rectype) - if a.sons[0].kind != nkSym: - internalError("semRecordCase: dicriminant is no symbol") - incl(a.sons[0].sym.flags, sfDiscriminant) - covered = 0 - typ = skipTypes(a.sons[0].Typ, abstractVar) - if not isOrdinalType(typ): GlobalError(n.info, errSelectorMustBeOrdinal) - if firstOrd(typ) < 0: - GlobalError(n.info, errOrdXMustNotBeNegative, a.sons[0].sym.name.s) - if lengthOrd(typ) > 0x00007FFF: - GlobalError(n.info, errLenXinvalid, a.sons[0].sym.name.s) - chckCovered = true - for i in countup(1, sonsLen(n) - 1): - b = copyTree(n.sons[i]) - case n.sons[i].kind - of nkOfBranch: - checkMinSonsLen(b, 2) - semCaseBranch(c, a, b, i, covered) - of nkElse: - chckCovered = false - checkSonsLen(b, 1) - else: illFormedAst(n) - delSon(b, sonsLen(b) - 1) - semRecordNodeAux(c, lastSon(n.sons[i]), check, pos, b, rectype) - addSon(a, b) - if chckCovered and (covered != lengthOrd(a.sons[0].typ)): - localError(a.info, errNotAllCasesCovered) - addSon(father, a) - -proc semRecordNodeAux(c: PContext, n: PNode, check: var TIntSet, pos: var int, - father: PNode, rectype: PSym) = - var - length: int - f: PSym # new field - a, it, e, branch: PNode - typ: PType - if n == nil: - return # BUGFIX: nil is possible - case n.kind - of nkRecWhen: - branch = nil # the branch to take - for i in countup(0, sonsLen(n) - 1): - it = n.sons[i] - if it == nil: illFormedAst(n) - case it.kind - of nkElifBranch: - checkSonsLen(it, 2) - e = semConstBoolExpr(c, it.sons[0]) - if (e.kind != nkIntLit): InternalError(e.info, "semRecordNodeAux") - if (e.intVal != 0) and (branch == nil): branch = it.sons[1] - of nkElse: - checkSonsLen(it, 1) - if branch == nil: branch = it.sons[0] - else: illFormedAst(n) - if branch != nil: semRecordNodeAux(c, branch, check, pos, father, rectype) - of nkRecCase: - semRecordCase(c, n, check, pos, father, rectype) - of nkNilLit: - if father.kind != nkRecList: addSon(father, newNodeI(nkRecList, n.info)) - of nkRecList: - # attempt to keep the nesting at a sane level: - var a = if father.kind == nkRecList: father else: copyNode(n) - for i in countup(0, sonsLen(n) - 1): - semRecordNodeAux(c, n.sons[i], check, pos, a, rectype) - if a != father: addSon(father, a) - of nkIdentDefs: - checkMinSonsLen(n, 3) - length = sonsLen(n) - if (father.kind != nkRecList) and (length >= 4): - a = newNodeI(nkRecList, n.info) - else: - a = ast.emptyNode - if n.sons[length - 1].kind != nkEmpty: - localError(n.sons[length - 1].info, errInitHereNotAllowed) - if n.sons[length - 2].kind == nkEmpty: - GlobalError(n.info, errTypeExpected) - typ = semTypeNode(c, n.sons[length-2], nil) - for i in countup(0, sonsLen(n) - 3): - f = semIdentWithPragma(c, skField, n.sons[i], {sfStar, sfMinus}) - f.typ = typ - f.position = pos - if (rectype != nil) and ({sfImportc, sfExportc} * rectype.flags != {}) and - (f.loc.r == nil): - f.loc.r = toRope(f.name.s) - f.flags = f.flags + ({sfImportc, sfExportc} * rectype.flags) - inc(pos) - if IntSetContainsOrIncl(check, f.name.id): - localError(n.sons[i].info, errAttemptToRedefine, f.name.s) - if a.kind == nkEmpty: addSon(father, newSymNode(f)) - else: addSon(a, newSymNode(f)) - if a.kind != nkEmpty: addSon(father, a) - of nkEmpty: nil - else: illFormedAst(n) - -proc addInheritedFieldsAux(c: PContext, check: var TIntSet, pos: var int, - n: PNode) = - case n.kind - of nkRecCase: - if (n.sons[0].kind != nkSym): InternalError(n.info, "addInheritedFieldsAux") - addInheritedFieldsAux(c, check, pos, n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - addInheritedFieldsAux(c, check, pos, lastSon(n.sons[i])) - else: internalError(n.info, "addInheritedFieldsAux(record case branch)") - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - addInheritedFieldsAux(c, check, pos, n.sons[i]) - of nkSym: - IntSetIncl(check, n.sym.name.id) - inc(pos) - else: InternalError(n.info, "addInheritedFieldsAux()") - -proc addInheritedFields(c: PContext, check: var TIntSet, pos: var int, - obj: PType) = - if (sonsLen(obj) > 0) and (obj.sons[0] != nil): - addInheritedFields(c, check, pos, obj.sons[0]) - addInheritedFieldsAux(c, check, pos, obj.n) - -proc skipGenericInvokation(t: PType): PType {.inline.} = - result = t - if result.kind == tyGenericInvokation: - result = result.sons[0] - if result.kind == tyGenericBody: - result = lastSon(result) - -proc semObjectNode(c: PContext, n: PNode, prev: PType): PType = - var check: TIntSet - IntSetInit(check) - var pos = 0 - var base: PType = nil - # n.sons[0] contains the pragmas (if any). We process these later... - checkSonsLen(n, 3) - if n.sons[1].kind != nkEmpty: - base = semTypeNode(c, n.sons[1].sons[0], nil) - var concreteBase = skipGenericInvokation(skipTypes(base, skipPtrs)) - if concreteBase.kind == tyObject and tfFinal notin concreteBase.flags: - addInheritedFields(c, check, pos, concreteBase) - else: - localError(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects) - if n.kind != nkObjectTy: InternalError(n.info, "semObjectNode") - result = newOrPrevType(tyObject, prev, c) - addSon(result, base) - result.n = newNodeI(nkRecList, n.info) - semRecordNodeAux(c, n.sons[2], check, pos, result.n, result.sym) - -proc addTypeVarsOfGenericBody(c: PContext, t: PType, genericParams: PNode, - cl: var TIntSet): PType = - result = t - if t == nil: return - if IntSetContainsOrIncl(cl, t.id): return - case t.kind - of tyGenericBody: - #debug(t) - result = newTypeS(tyGenericInvokation, c) - addSon(result, t) - for i in countup(0, sonsLen(t) - 2): - if t.sons[i].kind != tyGenericParam: - InternalError("addTypeVarsOfGenericBody") - # do not declare ``TKey`` twice: - #if not IntSetContainsOrIncl(cl, t.sons[i].sym.ident.id): - var s = copySym(t.sons[i].sym) - s.position = sonsLen(genericParams) - if s.typ == nil or s.typ.kind != tyGenericParam: - InternalError("addTypeVarsOfGenericBody 2") - addDecl(c, s) - addSon(genericParams, newSymNode(s)) - addSon(result, t.sons[i]) - of tyGenericInst: - #debug(t) - var L = sonsLen(t) - 1 - t.sons[L] = addTypeVarsOfGenericBody(c, t.sons[L], genericParams, cl) - of tyGenericInvokation: - #debug(t) - for i in countup(1, sonsLen(t) - 1): - t.sons[i] = addTypeVarsOfGenericBody(c, t.sons[i], genericParams, cl) - else: - for i in countup(0, sonsLen(t) - 1): - t.sons[i] = addTypeVarsOfGenericBody(c, t.sons[i], genericParams, cl) - -proc paramType(c: PContext, n, genericParams: PNode, cl: var TIntSet): PType = - result = semTypeNode(c, n, nil) - if (genericParams != nil) and (sonsLen(genericParams) == 0): - result = addTypeVarsOfGenericBody(c, result, genericParams, cl) - #if result.kind == tyGenericInvokation: debug(result) - -proc semProcTypeNode(c: PContext, n, genericParams: PNode, - prev: PType): PType = - var - def, res: PNode - typ: PType - check, cl: TIntSet - checkMinSonsLen(n, 1) - result = newOrPrevType(tyProc, prev, c) - result.callConv = lastOptionEntry(c).defaultCC - result.n = newNodeI(nkFormalParams, n.info) - if (genericParams != nil) and (sonsLen(genericParams) == 0): IntSetInit(cl) - addSon(result, nil) # return type - res = newNodeI(nkType, n.info) - addSon(result.n, res) - IntSetInit(check) - var counter = 0 - for i in countup(1, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind != nkIdentDefs: IllFormedAst(a) - checkMinSonsLen(a, 3) - var length = sonsLen(a) - if a.sons[length - 2].kind != nkEmpty: - typ = paramType(c, a.sons[length - 2], genericParams, cl) - else: - typ = nil - if a.sons[length - 1].kind != nkEmpty: - def = semExprWithType(c, a.sons[length - 1]) - # check type compability between def.typ and typ: - if typ == nil: - typ = def.typ - elif def != nil: - # and def.typ != nil and def.typ.kind != tyNone: - # example code that triggers it: - # proc sort[T](cmp: proc(a, b: T): int = cmp) - def = fitNode(c, typ, def) - else: - def = ast.emptyNode - for j in countup(0, length - 3): - var arg = newSymS(skParam, a.sons[j], c) - arg.typ = typ - arg.position = counter - inc(counter) - if def.kind != nkEmpty: arg.ast = copyTree(def) - if IntSetContainsOrIncl(check, arg.name.id): - LocalError(a.sons[j].info, errAttemptToRedefine, arg.name.s) - addSon(result.n, newSymNode(arg)) - addSon(result, typ) - if n.sons[0].kind != nkEmpty: - result.sons[0] = paramType(c, n.sons[0], genericParams, cl) - res.typ = result.sons[0] - -proc semStmtListType(c: PContext, n: PNode, prev: PType): PType = - checkMinSonsLen(n, 1) - var length = sonsLen(n) - for i in countup(0, length - 2): - n.sons[i] = semStmt(c, n.sons[i]) - if length > 0: - result = semTypeNode(c, n.sons[length - 1], prev) - n.typ = result - n.sons[length - 1].typ = result - else: - result = nil - -proc semBlockType(c: PContext, n: PNode, prev: PType): PType = - Inc(c.p.nestedBlockCounter) - checkSonsLen(n, 2) - openScope(c.tab) - if n.sons[0].kind != nkEmpty: - addDecl(c, newSymS(skLabel, n.sons[0], c)) - result = semStmtListType(c, n.sons[1], prev) - n.sons[1].typ = result - n.typ = result - closeScope(c.tab) - Dec(c.p.nestedBlockCounter) - -proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = - result = nil - if gCmd == cmdIdeTools: suggestExpr(c, n) - case n.kind - of nkEmpty: nil - of nkTypeOfExpr: - # for ``type countup(1,3)``, see ``tests/ttoseq``. - # XXX We should find a better solution. - checkSonsLen(n, 1) - result = semExprWithType(c, n.sons[0], {efWantIterator}).typ - of nkPar: - if sonsLen(n) == 1: result = semTypeNode(c, n.sons[0], prev) - else: GlobalError(n.info, errTypeExpected) - of nkBracketExpr: - checkMinSonsLen(n, 2) - var s = semTypeIdent(c, n.sons[0]) - case s.magic - of mArray: result = semArray(c, n, prev) - of mOpenArray: result = semContainer(c, n, tyOpenArray, "openarray", prev) - of mRange: result = semRange(c, n, prev) - of mSet: result = semSet(c, n, prev) - of mOrdinal: result = semOrdinal(c, n, prev) - of mSeq: result = semContainer(c, n, tySequence, "seq", prev) - else: result = semGeneric(c, n, s, prev) - of nkIdent, nkDotExpr, nkAccQuoted: - var s = semTypeIdent(c, n) - if s.typ == nil: GlobalError(n.info, errTypeExpected) - if prev == nil: - result = s.typ - else: - assignType(prev, s.typ) - prev.id = s.typ.id - result = prev - of nkSym: - if (n.sym.kind == skType) and (n.sym.typ != nil): - var t = n.sym.typ - if prev == nil: - result = t - else: - assignType(prev, t) - result = prev - markUsed(n, n.sym) - else: - GlobalError(n.info, errTypeExpected) - of nkObjectTy: result = semObjectNode(c, n, prev) - of nkTupleTy: result = semTuple(c, n, prev) - of nkRefTy: result = semAnyRef(c, n, tyRef, "ref", prev) - of nkPtrTy: result = semAnyRef(c, n, tyPtr, "ptr", prev) - of nkVarTy: result = semVarType(c, n, prev) - of nkDistinctTy: result = semDistinct(c, n, prev) - of nkProcTy: - checkSonsLen(n, 2) - result = semProcTypeNode(c, n.sons[0], nil, prev) - # dummy symbol for `pragma`: - var s = newSymS(skProc, newIdentNode(getIdent("dummy"), n.info), c) - s.typ = result - pragma(c, s, n.sons[1], procTypePragmas) - of nkEnumTy: result = semEnum(c, n, prev) - of nkType: result = n.typ - of nkStmtListType: result = semStmtListType(c, n, prev) - of nkBlockType: result = semBlockType(c, n, prev) - else: GlobalError(n.info, errTypeExpected) - #internalError(n.info, 'semTypeNode(' +{&} nodeKindToStr[n.kind] +{&} ')'); - -proc setMagicType(m: PSym, kind: TTypeKind, size: int) = - m.typ.kind = kind - m.typ.align = size - m.typ.size = size - -proc processMagicType(c: PContext, m: PSym) = - case m.magic - of mInt: setMagicType(m, tyInt, intSize) - of mInt8: setMagicType(m, tyInt8, 1) - of mInt16: setMagicType(m, tyInt16, 2) - of mInt32: setMagicType(m, tyInt32, 4) - of mInt64: setMagicType(m, tyInt64, 8) - of mFloat: setMagicType(m, tyFloat, floatSize) - of mFloat32: setMagicType(m, tyFloat32, 4) - of mFloat64: setMagicType(m, tyFloat64, 8) - of mBool: setMagicType(m, tyBool, 1) - of mChar: setMagicType(m, tyChar, 1) - of mString: - setMagicType(m, tyString, ptrSize) - addSon(m.typ, getSysType(tyChar)) - of mCstring: - setMagicType(m, tyCString, ptrSize) - addSon(m.typ, getSysType(tyChar)) - of mPointer: setMagicType(m, tyPointer, ptrSize) - of mEmptySet: - setMagicType(m, tySet, 1) - addSon(m.typ, newTypeS(tyEmpty, c)) - of mIntSetBaseType: setMagicType(m, tyRange, intSize) - of mNil: setMagicType(m, tyNil, ptrSize) - of mExpr: setMagicType(m, tyExpr, 0) - of mStmt: setMagicType(m, tyStmt, 0) - of mTypeDesc: setMagicType(m, tyTypeDesc, 0) - of mArray, mOpenArray, mRange, mSet, mSeq, mOrdinal: nil - else: GlobalError(m.info, errTypeExpected) - -proc newConstraint(c: PContext, k: TTypeKind): PType = - result = newTypeS(tyOrdinal, c) - result.addSon(newTypeS(k, c)) - -proc semGenericConstraints(c: PContext, n: PNode, result: PType) = - case n.kind - of nkProcTy: result.addSon(newConstraint(c, tyProc)) - of nkEnumTy: result.addSon(newConstraint(c, tyEnum)) - of nkObjectTy: result.addSon(newConstraint(c, tyObject)) - of nkTupleTy: result.addSon(newConstraint(c, tyTuple)) - of nkDistinctTy: result.addSon(newConstraint(c, tyDistinct)) - of nkVarTy: result.addSon(newConstraint(c, tyVar)) - of nkPtrTy: result.addSon(newConstraint(c, tyPtr)) - of nkRefTy: result.addSon(newConstraint(c, tyRef)) - of nkInfix: - semGenericConstraints(c, n.sons[1], result) - semGenericConstraints(c, n.sons[2], result) - else: - result.addSon(semTypeNode(c, n, nil)) - -proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = - result = copyNode(n) - if n.kind != nkGenericParams: InternalError(n.info, "semGenericParamList") - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] - if a.kind != nkIdentDefs: illFormedAst(n) - var L = sonsLen(a) - var def = a.sons[L-1] - var typ: PType - if a.sons[L-2].kind != nkEmpty: - typ = newTypeS(tyGenericParam, c) - semGenericConstraints(c, a.sons[L-2], typ) - if sonsLen(typ) == 1 and typ.sons[0].kind == tyTypeDesc: - typ = typ.sons[0] - elif def.kind != nkEmpty: typ = newTypeS(tyExpr, c) - else: typ = nil - for j in countup(0, L-3): - var s: PSym - if typ == nil: - s = newSymS(skType, a.sons[j], c) - s.typ = newTypeS(tyGenericParam, c) - else: - case typ.kind - of tyTypeDesc: - s = newSymS(skType, a.sons[j], c) - s.typ = newTypeS(tyGenericParam, c) - of tyExpr: - # not a type param, but an expression - s = newSymS(skGenericParam, a.sons[j], c) - s.typ = typ - else: - s = newSymS(skType, a.sons[j], c) - s.typ = typ - if def.kind != nkEmpty: s.ast = def - s.typ.sym = s - if father != nil: addSon(father, s.typ) - s.position = i - addSon(result, newSymNode(s)) - addDecl(c, s) - - diff --git a/rod/semtypinst.nim b/rod/semtypinst.nim deleted file mode 100755 index b6126e285..000000000 --- a/rod/semtypinst.nim +++ /dev/null @@ -1,151 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module does the instantiation of generic procs and types. - -import ast, astalgo, msgs, types, semdata - -proc checkConstructedType*(info: TLineInfo, t: PType) = - if tfAcyclic in t.flags and skipTypes(t, abstractInst).kind != tyObject: - LocalError(info, errInvalidPragmaX, "acyclic") - elif computeSize(t) < 0: - LocalError(info, errIllegalRecursionInTypeX, typeToString(t)) - elif t.kind == tyVar and t.sons[0].kind == tyVar: - LocalError(info, errVarVarTypeNotAllowed) - when false: - if t.kind == tyObject and t.sons[0] != nil: - if t.sons[0].kind != tyObject or tfFinal in t.sons[0].flags: - localError(info, errInheritanceOnlyWithNonFinalObjects) - -proc containsGenericTypeIter(t: PType, closure: PObject): bool = - result = t.kind in GenericTypes - -proc containsGenericType*(t: PType): bool = - result = iterOverType(t, containsGenericTypeIter, nil) - -proc searchInstTypes(tab: TIdTable, key: PType): PType = - # returns nil if we need to declare this type - result = PType(IdTableGet(tab, key)) - if (result == nil) and (tab.counter > 0): - # we have to do a slow linear search because types may need - # to be compared by their structure: - for h in countup(0, high(tab.data)): - var t = PType(tab.data[h].key) - if t != nil: - if key.containerId == t.containerID: - var match = true - for j in countup(0, sonsLen(t) - 1): - # XXX sameType is not really correct for nested generics? - if not sameType(t.sons[j], key.sons[j]): - match = false - break - if match: - return PType(tab.data[h].val) - -type - TReplTypeVars* {.final.} = object - c*: PContext - typeMap*: TIdTable # map PType to PType - symMap*: TIdTable # map PSym to PSym - info*: TLineInfo - -proc ReplaceTypeVarsT*(cl: var TReplTypeVars, t: PType): PType -proc ReplaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym -proc ReplaceTypeVarsN(cl: var TReplTypeVars, n: PNode): PNode = - if n != nil: - result = copyNode(n) - result.typ = ReplaceTypeVarsT(cl, n.typ) - case n.kind - of nkNone..pred(nkSym), succ(nkSym)..nkNilLit: - nil - of nkSym: - result.sym = ReplaceTypeVarsS(cl, n.sym) - else: - var length = sonsLen(n) - if length > 0: - newSons(result, length) - for i in countup(0, length - 1): - result.sons[i] = ReplaceTypeVarsN(cl, n.sons[i]) - -proc ReplaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = - if s == nil: return nil - result = PSym(idTableGet(cl.symMap, s)) - if result == nil: - result = copySym(s, false) - incl(result.flags, sfFromGeneric) - idTablePut(cl.symMap, s, result) - result.typ = ReplaceTypeVarsT(cl, s.typ) - result.owner = s.owner - result.ast = ReplaceTypeVarsN(cl, s.ast) - -proc lookupTypeVar(cl: TReplTypeVars, t: PType): PType = - result = PType(idTableGet(cl.typeMap, t)) - if result == nil: - GlobalError(t.sym.info, errCannotInstantiateX, typeToString(t)) - elif result.kind == tyGenericParam: - InternalError(cl.info, "substitution with generic parameter") - -proc ReplaceTypeVarsT*(cl: var TReplTypeVars, t: PType): PType = - var body, newbody, x, header: PType - result = t - if t == nil: return - case t.kind - of tyGenericParam: - result = lookupTypeVar(cl, t) - of tyGenericInvokation: - body = t.sons[0] - if body.kind != tyGenericBody: InternalError(cl.info, "no generic body") - header = nil - for i in countup(1, sonsLen(t) - 1): - if t.sons[i].kind == tyGenericParam: - x = lookupTypeVar(cl, t.sons[i]) - if header == nil: header = copyType(t, t.owner, false) - header.sons[i] = x - else: - x = t.sons[i] - idTablePut(cl.typeMap, body.sons[i - 1], x) - if header == nil: header = t - result = searchInstTypes(gInstTypes, header) - if result != nil: return - result = newType(tyGenericInst, t.sons[0].owner) - for i in countup(0, sonsLen(t) - 1): - # if one of the params is not concrete, we cannot do anything - # but we already raised an error! - addSon(result, header.sons[i]) - idTablePut(gInstTypes, header, result) - newbody = ReplaceTypeVarsT(cl, lastSon(body)) - newbody.n = ReplaceTypeVarsN(cl, lastSon(body).n) - addSon(result, newbody) - #writeln(output, ropeToStr(Typetoyaml(newbody))); - checkConstructedType(cl.info, newbody) - of tyGenericBody: - InternalError(cl.info, "ReplaceTypeVarsT: tyGenericBody") - result = ReplaceTypeVarsT(cl, lastSon(t)) - else: - if containsGenericType(t): - result = copyType(t, t.owner, false) - for i in countup(0, sonsLen(result) - 1): - result.sons[i] = ReplaceTypeVarsT(cl, result.sons[i]) - result.n = ReplaceTypeVarsN(cl, result.n) - if result.Kind in GenericTypes: - LocalError(cl.info, errCannotInstantiateX, TypeToString(t, preferName)) - #writeln(output, ropeToStr(Typetoyaml(result))) - #checkConstructedType(cl.info, result) - -proc generateTypeInstance*(p: PContext, pt: TIdTable, arg: PNode, - t: PType): PType = - var cl: TReplTypeVars - InitIdTable(cl.symMap) - copyIdTable(cl.typeMap, pt) - cl.info = arg.info - cl.c = p - pushInfoContext(arg.info) - result = ReplaceTypeVarsT(cl, t) - popInfoContext() - diff --git a/rod/sigmatch.nim b/rod/sigmatch.nim deleted file mode 100755 index 1e61ddfe0..000000000 --- a/rod/sigmatch.nim +++ /dev/null @@ -1,714 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the signature matching for resolving -# the call to overloaded procs, generic procs and operators. - -import - ast, astalgo, semdata, types, msgs, rnimsyn, lookups, semtypinst, - magicsys - -type - TCandidateState* = enum - csEmpty, csMatch, csNoMatch - TCandidate* {.final.} = object - exactMatches: int - subtypeMatches: int - intConvMatches: int # conversions to int are not as expensive - convMatches: int - genericMatches: int - state*: TCandidateState - callee*: PType # may not be nil! - calleeSym*: PSym # may be nil - call*: PNode # modified call - bindings*: TIdTable # maps sym-ids to types - baseTypeMatch: bool # needed for conversions from T to openarray[T] - # for example - - TTypeRelation* = enum # order is important! - isNone, isConvertible, isIntConv, isSubtype, - isLifted, # match, but do not change argument type to formal's type! - isGeneric, - isEqual - -proc initCandidateAux(c: var TCandidate, callee: PType) {.inline.} = - c.exactMatches = 0 - c.subtypeMatches = 0 - c.convMatches = 0 - c.intConvMatches = 0 - c.genericMatches = 0 - c.state = csEmpty - c.callee = callee - c.call = nil - c.baseTypeMatch = false - -proc initCandidate*(c: var TCandidate, callee: PType) = - initCandidateAux(c, callee) - c.calleeSym = nil - initIdTable(c.bindings) - -proc initCandidate*(c: var TCandidate, callee: PSym, binding: PNode) = - initCandidateAux(c, callee.typ) - c.calleeSym = callee - initIdTable(c.bindings) - if binding != nil: - var typeParams = callee.ast[genericParamsPos] - for i in 1..min(sonsLen(typeParams), sonsLen(binding)-1): - var formalTypeParam = typeParams.sons[i-1].typ - #debug(formalTypeParam) - IdTablePut(c.bindings, formalTypeParam, binding[i].typ) - -proc copyCandidate(a: var TCandidate, b: TCandidate) = - a.exactMatches = b.exactMatches - a.subtypeMatches = b.subtypeMatches - a.convMatches = b.convMatches - a.intConvMatches = b.intConvMatches - a.genericMatches = b.genericMatches - a.state = b.state - a.callee = b.callee - a.calleeSym = b.calleeSym - a.call = copyTree(b.call) - a.baseTypeMatch = b.baseTypeMatch - copyIdTable(a.bindings, b.bindings) - -proc cmpCandidates*(a, b: TCandidate): int = - result = a.exactMatches - b.exactMatches - if result != 0: return - result = a.genericMatches - b.genericMatches - if result != 0: return - result = a.subtypeMatches - b.subtypeMatches - if result != 0: return - result = a.intConvMatches - b.intConvMatches - if result != 0: return - result = a.convMatches - b.convMatches - -proc writeMatches(c: TCandidate) = - Writeln(stdout, "exact matches: " & $c.exactMatches) - Writeln(stdout, "subtype matches: " & $c.subtypeMatches) - Writeln(stdout, "conv matches: " & $c.convMatches) - Writeln(stdout, "intconv matches: " & $c.intConvMatches) - Writeln(stdout, "generic matches: " & $c.genericMatches) - -proc getNotFoundError*(c: PContext, n: PNode): string = - # Gives a detailed error message; this is separated from semDirectCall, - # as semDirectCall is already pretty slow (and we need this information only - # in case of an error). - result = msgKindToString(errTypeMismatch) - for i in countup(1, sonsLen(n) - 1): - #debug(n.sons[i].typ); - if n.sons[i].kind == nkExprEqExpr: - add(result, renderTree(n.sons[i].sons[0])) - add(result, ": ") - add(result, typeToString(n.sons[i].typ)) - if i != sonsLen(n) - 1: add(result, ", ") - add(result, ')') - var candidates = "" - var o: TOverloadIter - var sym = initOverloadIter(o, c, n.sons[0]) - while sym != nil: - if sym.kind in {skProc, skMethod, skIterator, skConverter}: - add(candidates, getProcHeader(sym)) - add(candidates, "\n") - sym = nextOverloadIter(o, c, n.sons[0]) - if candidates != "": - add(result, "\n" & msgKindToString(errButExpected) & "\n" & candidates) - -proc typeRel(mapping: var TIdTable, f, a: PType): TTypeRelation -proc concreteType(mapping: TIdTable, t: PType): PType = - case t.kind - of tyArrayConstr: - # make it an array - result = newType(tyArray, t.owner) - addSon(result, t.sons[0]) # XXX: t.owner is wrong for ID! - addSon(result, t.sons[1]) # XXX: semantic checking for the type? - of tyNil: - result = nil # what should it be? - of tyGenericParam: - result = t - while true: - result = PType(idTableGet(mapping, t)) - if result == nil: - break # it's ok, no match - # example code that triggers it: - # proc sort[T](cmp: proc(a, b: T): int = cmp) - if result.kind != tyGenericParam: break - else: - result = t # Note: empty is valid here - -proc handleRange(f, a: PType, min, max: TTypeKind): TTypeRelation = - if a.kind == f.kind: - result = isEqual - else: - var k = skipTypes(a, {tyRange}).kind - if k == f.kind: result = isSubtype - elif f.kind == tyInt and k in {tyInt..tyInt32}: result = isIntConv - elif k >= min and k <= max: result = isConvertible - else: result = isNone - -proc handleFloatRange(f, a: PType): TTypeRelation = - if a.kind == f.kind: - result = isEqual - else: - var k = skipTypes(a, {tyRange}).kind - if k == f.kind: result = isSubtype - elif (k >= tyFloat) and (k <= tyFloat128): result = isConvertible - else: result = isNone - -proc isObjectSubtype(a, f: PType): bool = - var t = a - while t != nil and t.id != f.id: t = base(t) - result = t != nil - -proc minRel(a, b: TTypeRelation): TTypeRelation = - if a <= b: result = a - else: result = b - -proc tupleRel(mapping: var TIdTable, f, a: PType): TTypeRelation = - result = isNone - if sonsLen(a) == sonsLen(f): - result = isEqual - for i in countup(0, sonsLen(f) - 1): - var m = typeRel(mapping, f.sons[i], a.sons[i]) - if m < isSubtype: return isNone - result = minRel(result, m) - if f.n != nil and a.n != nil: - for i in countup(0, sonsLen(f.n) - 1): - # check field names: - if f.n.sons[i].kind != nkSym: InternalError(f.n.info, "tupleRel") - if a.n.sons[i].kind != nkSym: InternalError(a.n.info, "tupleRel") - var x = f.n.sons[i].sym - var y = a.n.sons[i].sym - if x.name.id != y.name.id: return isNone - elif sonsLen(f) == 0: - idTablePut(mapping, f, a) - result = isLifted - -proc constraintRel(mapping: var TIdTable, f, a: PType): TTypeRelation = - result = isNone - if f.kind == a.kind: result = isGeneric - -proc typeRel(mapping: var TIdTable, f, a: PType): TTypeRelation = - # is a subtype of f? - result = isNone - assert(f != nil) - assert(a != nil) - if a.kind == tyGenericInst and - skipTypes(f, {tyVar}).kind notin {tyGenericBody, tyGenericInvokation}: - return typeRel(mapping, f, lastSon(a)) - if a.kind == tyVar and f.kind != tyVar: - return typeRel(mapping, f, a.sons[0]) - case f.kind - of tyEnum: - if a.kind == f.kind and a.id == f.id: result = isEqual - elif skipTypes(a, {tyRange}).id == f.id: result = isSubtype - of tyBool, tyChar: - if a.kind == f.kind: result = isEqual - elif skipTypes(a, {tyRange}).kind == f.kind: result = isSubtype - of tyRange: - if a.kind == f.kind: - result = typeRel(mapping, base(a), base(f)) - if result < isGeneric: result = isNone - elif skipTypes(f, {tyRange}).kind == a.kind: - result = isConvertible # a convertible to f - of tyInt: result = handleRange(f, a, tyInt8, tyInt32) - of tyInt8: result = handleRange(f, a, tyInt8, tyInt8) - of tyInt16: result = handleRange(f, a, tyInt8, tyInt16) - of tyInt32: result = handleRange(f, a, tyInt, tyInt32) - of tyInt64: result = handleRange(f, a, tyInt, tyInt64) - of tyFloat: result = handleFloatRange(f, a) - of tyFloat32: result = handleFloatRange(f, a) - of tyFloat64: result = handleFloatRange(f, a) - of tyFloat128: result = handleFloatRange(f, a) - of tyVar: - if (a.kind == f.kind): result = typeRel(mapping, base(f), base(a)) - else: result = typeRel(mapping, base(f), a) - of tyArray, tyArrayConstr: - # tyArrayConstr cannot happen really, but - # we wanna be safe here - case a.kind - of tyArray: - result = minRel(typeRel(mapping, f.sons[0], a.sons[0]), - typeRel(mapping, f.sons[1], a.sons[1])) - if result < isGeneric: result = isNone - of tyArrayConstr: - result = typeRel(mapping, f.sons[1], a.sons[1]) - if result < isGeneric: - result = isNone - else: - if (result != isGeneric) and (lengthOrd(f) != lengthOrd(a)): - result = isNone - elif f.sons[0].kind in GenericTypes: - result = minRel(result, typeRel(mapping, f.sons[0], a.sons[0])) - else: nil - of tyOpenArray: - case a.Kind - of tyOpenArray: - result = typeRel(mapping, base(f), base(a)) - if result < isGeneric: result = isNone - of tyArrayConstr: - if (f.sons[0].kind != tyGenericParam) and (a.sons[1].kind == tyEmpty): - result = isSubtype # [] is allowed here - elif typeRel(mapping, base(f), a.sons[1]) >= isGeneric: - result = isSubtype - of tyArray: - if (f.sons[0].kind != tyGenericParam) and (a.sons[1].kind == tyEmpty): - result = isSubtype - elif typeRel(mapping, base(f), a.sons[1]) >= isGeneric: - result = isConvertible - of tySequence: - if (f.sons[0].kind != tyGenericParam) and (a.sons[0].kind == tyEmpty): - result = isConvertible - elif typeRel(mapping, base(f), a.sons[0]) >= isGeneric: - result = isConvertible - else: nil - of tySequence: - case a.Kind - of tyNil: - result = isSubtype - of tySequence: - if (f.sons[0].kind != tyGenericParam) and (a.sons[0].kind == tyEmpty): - result = isSubtype - else: - result = typeRel(mapping, f.sons[0], a.sons[0]) - if result < isGeneric: result = isNone - else: nil - of tyOrdinal: - if f.sons[0].kind != tyGenericParam: - # some constraint: - result = constraintRel(mapping, f.sons[0], a) - elif isOrdinalType(a): - var x = if a.kind == tyOrdinal: a.sons[0] else: a - result = typeRel(mapping, f.sons[0], x) - if result < isGeneric: result = isNone - of tyForward: InternalError("forward type in typeRel()") - of tyNil: - if a.kind == f.kind: result = isEqual - of tyTuple: - if a.kind == tyTuple: result = tupleRel(mapping, f, a) - of tyObject: - if a.kind == tyObject: - if a.id == f.id: result = isEqual - elif isObjectSubtype(a, f): result = isSubtype - of tyDistinct: - if (a.kind == tyDistinct) and (a.id == f.id): result = isEqual - of tySet: - if a.kind == tySet: - if (f.sons[0].kind != tyGenericParam) and (a.sons[0].kind == tyEmpty): - result = isSubtype - else: - result = typeRel(mapping, f.sons[0], a.sons[0]) - if result <= isConvertible: - result = isNone # BUGFIX! - of tyPtr: - case a.kind - of tyPtr: - result = typeRel(mapping, base(f), base(a)) - if result <= isConvertible: result = isNone - of tyNil: result = isSubtype - else: nil - of tyRef: - case a.kind - of tyRef: - result = typeRel(mapping, base(f), base(a)) - if result <= isConvertible: result = isNone - of tyNil: result = isSubtype - else: nil - of tyProc: - case a.kind - of tyNil: result = isSubtype - of tyProc: - if (sonsLen(f) == sonsLen(a)) and (f.callconv == a.callconv): - # Note: We have to do unification for the parameters before the - # return type! - result = isEqual # start with maximum; also correct for no - # params at all - var m: TTypeRelation - for i in countup(1, sonsLen(f) - 1): - m = typeRel(mapping, f.sons[i], a.sons[i]) - if (m == isNone) and - (typeRel(mapping, a.sons[i], f.sons[i]) == isSubtype): - # allow ``f.son`` as subtype of ``a.son``! - result = isConvertible - elif m < isSubtype: - return isNone - else: - result = minRel(m, result) - if f.sons[0] != nil: - if a.sons[0] != nil: - m = typeRel(mapping, f.sons[0], a.sons[0]) - # Subtype is sufficient for return types! - if m < isSubtype: result = isNone - elif m == isSubtype: result = isConvertible - else: result = minRel(m, result) - else: - result = isNone - elif a.sons[0] != nil: - result = isNone - if (tfNoSideEffect in f.flags) and not (tfNoSideEffect in a.flags): - result = isNone - else: nil - of tyPointer: - case a.kind - of tyPointer: result = isEqual - of tyNil: result = isSubtype - of tyPtr, tyProc, tyCString: result = isConvertible - else: nil - of tyString: - case a.kind - of tyString: result = isEqual - of tyNil: result = isSubtype - else: nil - of tyCString: - # conversion from string to cstring is automatic: - case a.Kind - of tyCString: result = isEqual - of tyNil: result = isSubtype - of tyString: result = isConvertible - of tyPtr: - if a.sons[0].kind == tyChar: result = isConvertible - of tyArray: - if (firstOrd(a.sons[0]) == 0) and - (skipTypes(a.sons[0], {tyRange}).kind in {tyInt..tyInt64}) and - (a.sons[1].kind == tyChar): - result = isConvertible - else: nil - of tyEmpty: - if a.kind == tyEmpty: result = isEqual - of tyGenericInst: - result = typeRel(mapping, lastSon(f), a) - of tyGenericBody: - result = typeRel(mapping, lastSon(f), a) - of tyGenericInvokation: - assert(f.sons[0].kind == tyGenericBody) - if a.kind == tyGenericInvokation: - InternalError("typeRel: tyGenericInvokation -> tyGenericInvokation") - if (a.kind == tyGenericInst): - if (f.sons[0].containerID == a.sons[0].containerID) and - (sonsLen(a) - 1 == sonsLen(f)): - assert(a.sons[0].kind == tyGenericBody) - for i in countup(1, sonsLen(f) - 1): - if a.sons[i].kind == tyGenericParam: - InternalError("wrong instantiated type!") - if typeRel(mapping, f.sons[i], a.sons[i]) < isGeneric: return - result = isGeneric - else: - result = typeRel(mapping, f.sons[0], a) - if result != isNone: - # we steal the generic parameters from the tyGenericBody: - for i in countup(1, sonsLen(f) - 1): - var x = PType(idTableGet(mapping, f.sons[0].sons[i - 1])) - if (x == nil) or (x.kind == tyGenericParam): - InternalError("wrong instantiated type!") - idTablePut(mapping, f.sons[i], x) - of tyGenericParam: - var x = PType(idTableGet(mapping, f)) - if x == nil: - if sonsLen(f) == 0: - # no constraints - var concrete = concreteType(mapping, a) - if concrete != nil: - #MessageOut('putting: ' + f.sym.name.s); - idTablePut(mapping, f, concrete) - result = isGeneric - else: - # check constraints: - for i in countup(0, sonsLen(f) - 1): - if typeRel(mapping, f.sons[i], a) >= isSubtype: - var concrete = concreteType(mapping, a) - if concrete != nil: - idTablePut(mapping, f, concrete) - result = isGeneric - break - elif a.kind == tyEmpty: - result = isGeneric - elif x.kind == tyGenericParam: - result = isGeneric - else: - result = typeRel(mapping, x, a) # check if it fits - of tyExpr, tyStmt, tyTypeDesc: - if a.kind == f.kind: - result = isEqual - else: - case a.kind - of tyExpr, tyStmt, tyTypeDesc: result = isGeneric - of tyNil: result = isSubtype - else: nil - else: internalError("typeRel(" & $f.kind & ')') - -proc cmpTypes*(f, a: PType): TTypeRelation = - var mapping: TIdTable - InitIdTable(mapping) - result = typeRel(mapping, f, a) - -proc getInstantiatedType(c: PContext, arg: PNode, m: TCandidate, - f: PType): PType = - result = PType(idTableGet(m.bindings, f)) - if result == nil: - result = generateTypeInstance(c, m.bindings, arg, f) - if result == nil: InternalError(arg.info, "getInstantiatedType") - -proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, - c: PContext): PNode = - result = newNodeI(kind, arg.info) - if containsGenericType(f): result.typ = getInstantiatedType(c, arg, m, f) - else: result.typ = f - if result.typ == nil: InternalError(arg.info, "implicitConv") - addSon(result, ast.emptyNode) - addSon(result, arg) - -proc userConvMatch(c: PContext, m: var TCandidate, f, a: PType, - arg: PNode): PNode = - result = nil - for i in countup(0, len(c.converters) - 1): - var src = c.converters[i].typ.sons[1] - var dest = c.converters[i].typ.sons[0] - if (typeRel(m.bindings, f, dest) == isEqual) and - (typeRel(m.bindings, src, a) == isEqual): - markUsed(arg, c.converters[i]) - var s = newSymNode(c.converters[i]) - s.typ = c.converters[i].typ - s.info = arg.info - result = newNodeIT(nkHiddenCallConv, arg.info, s.typ.sons[0]) - addSon(result, s) - addSon(result, copyTree(arg)) - inc(m.convMatches) - return - -proc ParamTypesMatchAux(c: PContext, m: var TCandidate, f, a: PType, - arg: PNode): PNode = - var r = typeRel(m.bindings, f, a) - case r - of isConvertible: - inc(m.convMatches) - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) - of isIntConv: - inc(m.intConvMatches) - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) - of isSubtype: - inc(m.subtypeMatches) - result = implicitConv(nkHiddenSubConv, f, copyTree(arg), m, c) - of isLifted: - inc(m.genericMatches) - result = copyTree(arg) - of isGeneric: - inc(m.genericMatches) - result = copyTree(arg) - result.typ = getInstantiatedType(c, arg, m, f) - # BUG: f may not be the right key! - if (skipTypes(result.typ, abstractVar).kind in {tyTuple, tyOpenArray}): - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) - # BUGFIX: use ``result.typ`` and not `f` here - of isEqual: - inc(m.exactMatches) - result = copyTree(arg) - if (skipTypes(f, abstractVar).kind in {tyTuple, tyOpenArray}): - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) - of isNone: - result = userConvMatch(c, m, f, a, arg) - # check for a base type match, which supports openarray[T] without [] - # constructor in a call: - if (result == nil) and (f.kind == tyOpenArray): - r = typeRel(m.bindings, base(f), a) - if r >= isGeneric: - inc(m.convMatches) - result = copyTree(arg) - if r == isGeneric: result.typ = getInstantiatedType(c, arg, m, base(f)) - m.baseTypeMatch = true - else: - result = userConvMatch(c, m, base(f), a, arg) - -proc ParamTypesMatch(c: PContext, m: var TCandidate, f, a: PType, - arg: PNode): PNode = - if (arg == nil) or (arg.kind != nkSymChoice): - result = ParamTypesMatchAux(c, m, f, a, arg) - else: - # CAUTION: The order depends on the used hashing scheme. Thus it is - # incorrect to simply use the first fitting match. However, to implement - # this correctly is inefficient. We have to copy `m` here to be able to - # roll back the side effects of the unification algorithm. - var x, y, z: TCandidate - initCandidate(x, m.callee) - initCandidate(y, m.callee) - initCandidate(z, m.callee) - x.calleeSym = m.calleeSym - y.calleeSym = m.calleeSym - z.calleeSym = m.calleeSym - var best = -1 - for i in countup(0, sonsLen(arg) - 1): - # iterators are not first class yet, so ignore them - if arg.sons[i].sym.kind in {skProc, skMethod, skConverter}: - copyCandidate(z, m) - var r = typeRel(z.bindings, f, arg.sons[i].typ) - if r != isNone: - case x.state - of csEmpty, csNoMatch: - x = z - best = i - x.state = csMatch - of csMatch: - var cmp = cmpCandidates(x, z) - if cmp < 0: - best = i - x = z - elif cmp == 0: - y = z # z is as good as x - else: - nil - if x.state == csEmpty: - result = nil - elif (y.state == csMatch) and (cmpCandidates(x, y) == 0): - if x.state != csMatch: - InternalError(arg.info, "x.state is not csMatch") - # ambiguous: more than one symbol fits - result = nil - else: - # only one valid interpretation found: - markUsed(arg, arg.sons[best].sym) - result = ParamTypesMatchAux(c, m, f, arg.sons[best].typ, arg.sons[best]) - -proc IndexTypesMatch*(c: PContext, f, a: PType, arg: PNode): PNode = - var m: TCandidate - initCandidate(m, f) - result = paramTypesMatch(c, m, f, a, arg) - -proc ConvertTo*(c: PContext, f: PType, n: PNode): PNode = - var m: TCandidate - initCandidate(m, f) - result = paramTypesMatch(c, m, f, n.typ, n) - -proc argtypeMatches*(c: PContext, f, a: PType): bool = - var m: TCandidate - initCandidate(m, f) - result = paramTypesMatch(c, m, f, a, ast.emptyNode) != nil - -proc setSon(father: PNode, at: int, son: PNode) = - if sonsLen(father) <= at: setlen(father.sons, at + 1) - father.sons[at] = son - -proc matchesAux*(c: PContext, n: PNode, m: var TCandidate, - marker: var TIntSet) = - var f = 1 # iterates over formal parameters - var a = 1 # iterates over the actual given arguments - m.state = csMatch # until proven otherwise - m.call = newNodeI(nkCall, n.info) - m.call.typ = base(m.callee) # may be nil - var formalLen = sonsLen(m.callee.n) - addSon(m.call, copyTree(n.sons[0])) - var container: PNode = nil # constructed container - var formal: PSym = nil - while a < sonsLen(n): - if n.sons[a].kind == nkExprEqExpr: - # named param - # check if m.callee has such a param: - if n.sons[a].sons[0].kind != nkIdent: - LocalError(n.sons[a].info, errNamedParamHasToBeIdent) - m.state = csNoMatch - return - formal = getSymFromList(m.callee.n, n.sons[a].sons[0].ident, 1) - if formal == nil: - # no error message! - m.state = csNoMatch - return - if IntSetContainsOrIncl(marker, formal.position): - # already in namedParams: - LocalError(n.sons[a].info, errCannotBindXTwice, formal.name.s) - m.state = csNoMatch - return - m.baseTypeMatch = false - var arg = ParamTypesMatch(c, m, formal.typ, - n.sons[a].typ, n.sons[a].sons[1]) - if (arg == nil): - m.state = csNoMatch - return - if m.baseTypeMatch: - assert(container == nil) - container = newNodeI(nkBracket, n.sons[a].info) - addSon(container, arg) - setSon(m.call, formal.position + 1, container) - if f != formalLen - 1: container = nil - else: - setSon(m.call, formal.position + 1, arg) - else: - # unnamed param - if f >= formalLen: - # too many arguments? - if tfVarArgs in m.callee.flags: - # is ok... but don't increment any counters... - if skipTypes(n.sons[a].typ, abstractVar).kind == tyString: - addSon(m.call, implicitConv(nkHiddenStdConv, getSysType(tyCString), - copyTree(n.sons[a]), m, c)) - else: - addSon(m.call, copyTree(n.sons[a])) - elif formal != nil: - m.baseTypeMatch = false - var arg = ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, n.sons[a]) - if (arg != nil) and m.baseTypeMatch and (container != nil): - addSon(container, arg) - else: - m.state = csNoMatch - return - else: - m.state = csNoMatch - return - else: - if m.callee.n.sons[f].kind != nkSym: - InternalError(n.sons[a].info, "matches") - formal = m.callee.n.sons[f].sym - if IntSetContainsOrIncl(marker, formal.position): - # already in namedParams: - LocalError(n.sons[a].info, errCannotBindXTwice, formal.name.s) - m.state = csNoMatch - return - m.baseTypeMatch = false - var arg = ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, n.sons[a]) - if arg == nil: - m.state = csNoMatch - return - if m.baseTypeMatch: - assert(container == nil) - container = newNodeI(nkBracket, n.sons[a].info) - addSon(container, arg) - setSon(m.call, formal.position + 1, - implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) - if f != formalLen - 1: container = nil - else: - setSon(m.call, formal.position + 1, arg) - inc(a) - inc(f) - -proc partialMatch*(c: PContext, n: PNode, m: var TCandidate) = - # for 'suggest' support: - var marker: TIntSet - IntSetInit(marker) - matchesAux(c, n, m, marker) - -proc matches*(c: PContext, n: PNode, m: var TCandidate) = - var marker: TIntSet - IntSetInit(marker) - matchesAux(c, n, m, marker) - if m.state == csNoMatch: return - # check that every formal parameter got a value: - var f = 1 - while f < sonsLen(m.callee.n): - var formal = m.callee.n.sons[f].sym - if not IntSetContainsOrIncl(marker, formal.position): - if formal.ast == nil: - if formal.typ.kind == tyOpenArray: - var container = newNodeI(nkBracket, n.info) - addSon(m.call, implicitConv(nkHiddenStdConv, formal.typ, - container, m, c)) - else: - # no default value - m.state = csNoMatch - break - else: - # use default value: - setSon(m.call, formal.position + 1, copyTree(formal.ast)) - inc(f) - diff --git a/rod/suggest.nim b/rod/suggest.nim deleted file mode 100755 index 6f4babe63..000000000 --- a/rod/suggest.nim +++ /dev/null @@ -1,236 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This file implements features required for IDE support. - -import scanner, idents, ast, astalgo, semdata, msgs, types, sigmatch, options - -const - sep = '\t' - sectionSuggest = "sug" - sectionDef = "def" - sectionContext = "con" - -proc SymToStr(s: PSym, isLocal: bool, section: string): string = - result = section - result.add(sep) - result.add($s.kind) - result.add(sep) - if not isLocal: - if s.kind != skModule and s.owner != nil: - result.add(s.owner.name.s) - result.add('.') - result.add(s.name.s) - result.add(sep) - if s.typ != nil: - result.add(typeToString(s.typ)) - result.add(sep) - result.add(toFilename(s.info)) - result.add(sep) - result.add($ToLinenumber(s.info)) - result.add(sep) - result.add($ToColumn(s.info)) - -proc filterSym(s: PSym): bool {.inline.} = - result = s.name.s[0] in scanner.SymChars - -proc suggestField(s: PSym) = - if filterSym(s): - OutWriteln(SymToStr(s, isLocal=true, sectionSuggest)) - -template wholeSymTab(cond, section: expr) = - for i in countdown(c.tab.tos-1, 0): - for it in items(c.tab.stack[i]): - if cond: - OutWriteln(SymToStr(it, isLocal = i > ModuleTablePos, section)) - -proc suggestSymList(list: PNode) = - for i in countup(0, sonsLen(list) - 1): - if list.sons[i].kind != nkSym: InternalError(list.info, "getSymFromList") - suggestField(list.sons[i].sym) - -proc suggestObject(n: PNode) = - case n.kind - of nkRecList: - for i in countup(0, sonsLen(n)-1): suggestObject(n.sons[i]) - of nkRecCase: - var L = sonsLen(n) - if L > 0: - suggestObject(n.sons[0]) - for i in countup(1, L-1): suggestObject(lastSon(n.sons[i])) - of nkSym: suggestField(n.sym) - else: nil - -proc nameFits(c: PContext, s: PSym, n: PNode): bool = - var op = n.sons[0] - if op.kind == nkSymChoice: op = op.sons[0] - var opr: PIdent - case op.kind - of nkSym: opr = op.sym.name - of nkIdent: opr = op.ident - else: return false - result = opr.id == s.name.id - -proc argsFit(c: PContext, candidate: PSym, n: PNode): bool = - case candidate.kind - of skProc, skIterator, skMethod: - var m: TCandidate - initCandidate(m, candidate, nil) - sigmatch.partialMatch(c, n, m) - result = m.state != csNoMatch - of skTemplate, skMacro: - result = true - else: - result = false - -proc suggestCall(c: PContext, n: PNode) = - wholeSymTab(filterSym(it) and nameFits(c, it, n) and argsFit(c, it, n), - sectionContext) - -proc typeFits(c: PContext, s: PSym, firstArg: PType): bool {.inline.} = - if s.typ != nil and sonsLen(s.typ) > 1 and s.typ.sons[1] != nil: - result = sigmatch.argtypeMatches(c, s.typ.sons[1], firstArg) - -proc suggestOperations(c: PContext, n: PNode, typ: PType) = - assert typ != nil - wholeSymTab(filterSym(it) and typeFits(c, it, typ), sectionSuggest) - -proc suggestEverything(c: PContext, n: PNode) = - wholeSymTab(filterSym(it), sectionSuggest) - -proc suggestFieldAccess(c: PContext, n: PNode) = - # special code that deals with ``myObj.``. `n` is NOT the nkDotExpr-node, but - # ``myObj``. - var typ = n.Typ - if typ == nil: - # a module symbol has no type for example: - if n.kind == nkSym and n.sym.kind == skModule: - if n.sym == c.module: - # all symbols accessible, because we are in the current module: - for it in items(c.tab.stack[ModuleTablePos]): - if filterSym(it): - OutWriteln(SymToStr(it, isLocal=false, sectionSuggest)) - else: - for it in items(n.sym.tab): - if filterSym(it): - OutWriteln(SymToStr(it, isLocal=false, sectionSuggest)) - else: - # fallback: - suggestEverything(c, n) - elif typ.kind == tyEnum and n.kind == nkSym and n.sym.kind == skType: - # look up if the identifier belongs to the enum: - var t = typ - while t != nil: - suggestSymList(t.n) - t = t.sons[0] - suggestOperations(c, n, typ) - else: - typ = skipTypes(typ, {tyGenericInst, tyVar, tyPtr, tyRef}) - if typ.kind == tyObject: - var t = typ - while true: - suggestObject(t.n) - if t.sons[0] == nil: break - t = skipTypes(t.sons[0], {tyGenericInst}) - suggestOperations(c, n, typ) - elif typ.kind == tyTuple and typ.n != nil: - suggestSymList(typ.n) - suggestOperations(c, n, typ) - else: - # fallback: - suggestEverything(c, n) - -proc findClosestDot(n: PNode): PNode = - if msgs.inCheckpoint(n.info) == cpExact: - result = n - elif n.kind notin {nkNone..nkNilLit}: - for i in 0.. <sonsLen(n): - if n.sons[i].kind == nkDotExpr: - result = findClosestDot(n.sons[i]) - if result != nil: return - -const - CallNodes = {nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit, - nkMacroStmt} - -proc findClosestCall(n: PNode): PNode = - if msgs.inCheckpoint(n.info) == cpExact: - result = n - elif n.kind notin {nkNone..nkNilLit}: - for i in 0.. <sonsLen(n): - if n.sons[i].kind in callNodes: - result = findClosestCall(n.sons[i]) - if result != nil: return - -proc findClosestSym(n: PNode): PNode = - if n.kind == nkSym and msgs.inCheckpoint(n.info) == cpExact: - result = n - elif n.kind notin {nkNone..nkNilLit}: - for i in 0.. <sonsLen(n): - result = findClosestSym(n.sons[i]) - if result != nil: return - -var recursiveCheck = 0 - -proc safeSemExpr(c: PContext, n: PNode): PNode = - try: - result = c.semExpr(c, n) - except ERecoverableError: - result = ast.emptyNode - -proc fuzzySemCheck(c: PContext, n: PNode): PNode = - result = safeSemExpr(c, n) - if result == nil or result.kind == nkEmpty: - result = newNodeI(n.kind, n.info) - if n.kind notin {nkNone..nkNilLit}: - for i in 0 .. < sonsLen(n): result.addSon(fuzzySemCheck(c, n.sons[i])) - -proc suggestExpr*(c: PContext, node: PNode) = - var cp = msgs.inCheckpoint(node.info) - if cp == cpNone: return - # HACK: This keeps semExpr() from coming here recursively: - if recursiveCheck > 0: return - inc(recursiveCheck) - - if optSuggest in gGlobalOptions: - var n = findClosestDot(node) - if n == nil: n = node - else: cp = cpExact - - if n.kind == nkDotExpr and cp == cpExact: - var obj = safeSemExpr(c, n.sons[0]) - suggestFieldAccess(c, obj) - else: - suggestEverything(c, n) - - if optContext in gGlobalOptions: - var n = findClosestCall(node) - if n == nil: n = node - else: cp = cpExact - - if n.kind in CallNodes: - var a = copyNode(n) - var x = safeSemExpr(c, n.sons[0]) - if x.kind == nkEmpty or x.typ == nil: x = n.sons[0] - addSon(a, x) - for i in 1..sonsLen(n)-1: - # use as many typed arguments as possible: - var x = safeSemExpr(c, n.sons[i]) - if x.kind == nkEmpty or x.typ == nil: break - addSon(a, x) - suggestCall(c, a) - - if optDef in gGlobalOptions: - var n = findClosestSym(fuzzySemCheck(c, node)) - if n != nil: OutWriteln(SymToStr(n.sym, isLocal=false, sectionDef)) - quit(0) - -proc suggestStmt*(c: PContext, n: PNode) = - suggestExpr(c, n) - diff --git a/rod/syntaxes.nim b/rod/syntaxes.nim deleted file mode 100755 index adb17efee..000000000 --- a/rod/syntaxes.nim +++ /dev/null @@ -1,173 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Implements the dispatcher for the different parsers. - -import - strutils, llstream, ast, astalgo, idents, scanner, options, msgs, pnimsyn, - pbraces, ptmplsyn, filters, rnimsyn - -type - TFilterKind* = enum - filtNone, filtTemplate, filtReplace, filtStrip - TParserKind* = enum - skinStandard, skinBraces, skinEndX - -const - parserNames*: array[TParserKind, string] = ["standard", "braces", "endx"] - filterNames*: array[TFilterKind, string] = ["none", "stdtmpl", "replace", - "strip"] - -type - TParsers*{.final.} = object - skin*: TParserKind - parser*: TParser - - -proc ParseFile*(filename: string): PNode{.procvar.} -proc openParsers*(p: var TParsers, filename: string, inputstream: PLLStream) -proc closeParsers*(p: var TParsers) -proc parseAll*(p: var TParsers): PNode -proc parseTopLevelStmt*(p: var TParsers): PNode - # implements an iterator. Returns the next top-level statement or nil if end - # of stream. - -# implementation - -proc ParseFile(filename: string): PNode = - var - p: TParsers - f: tfile - if not open(f, filename): - rawMessage(errCannotOpenFile, filename) - return - OpenParsers(p, filename, LLStreamOpen(f)) - result = ParseAll(p) - CloseParsers(p) - -proc parseAll(p: var TParsers): PNode = - case p.skin - of skinStandard: - result = pnimsyn.parseAll(p.parser) - of skinBraces: - result = pbraces.parseAll(p.parser) - of skinEndX: - InternalError("parser to implement") - result = ast.emptyNode - # skinEndX: result := pendx.parseAll(p.parser); - -proc parseTopLevelStmt(p: var TParsers): PNode = - case p.skin - of skinStandard: - result = pnimsyn.parseTopLevelStmt(p.parser) - of skinBraces: - result = pbraces.parseTopLevelStmt(p.parser) - of skinEndX: - InternalError("parser to implement") - result = ast.emptyNode - #skinEndX: result := pendx.parseTopLevelStmt(p.parser); - -proc UTF8_BOM(s: string): int = - if (s[0] == '\xEF') and (s[1] == '\xBB') and (s[2] == '\xBF'): - result = 3 - else: - result = 0 - -proc containsShebang(s: string, i: int): bool = - if (s[i] == '#') and (s[i + 1] == '!'): - var j = i + 2 - while s[j] in WhiteSpace: inc(j) - result = s[j] == '/' - -proc parsePipe(filename: string, inputStream: PLLStream): PNode = - result = ast.emptyNode - var s = LLStreamOpen(filename, fmRead) - if s != nil: - var line = LLStreamReadLine(s) - var i = UTF8_Bom(line) - if containsShebang(line, i): - line = LLStreamReadLine(s) - i = 0 - if (line[i] == '#') and (line[i + 1] == '!'): - inc(i, 2) - while line[i] in WhiteSpace: inc(i) - var q: TParser - OpenParser(q, filename, LLStreamOpen(copy(line, i))) - result = pnimsyn.parseAll(q) - CloseParser(q) - LLStreamClose(s) - -proc getFilter(ident: PIdent): TFilterKind = - for i in countup(low(TFilterKind), high(TFilterKind)): - if IdentEq(ident, filterNames[i]): - return i - result = filtNone - -proc getParser(ident: PIdent): TParserKind = - for i in countup(low(TParserKind), high(TParserKind)): - if IdentEq(ident, parserNames[i]): - return i - rawMessage(errInvalidDirectiveX, ident.s) - -proc getCallee(n: PNode): PIdent = - if (n.kind == nkCall) and (n.sons[0].kind == nkIdent): - result = n.sons[0].ident - elif n.kind == nkIdent: - result = n.ident - else: - rawMessage(errXNotAllowedHere, renderTree(n)) - -proc applyFilter(p: var TParsers, n: PNode, filename: string, - stdin: PLLStream): PLLStream = - var ident = getCallee(n) - var f = getFilter(ident) - case f - of filtNone: - p.skin = getParser(ident) - result = stdin - of filtTemplate: - result = filterTmpl(stdin, filename, n) - of filtStrip: - result = filterStrip(stdin, filename, n) - of filtReplace: - result = filterReplace(stdin, filename, n) - if f != filtNone: - if gVerbosity >= 2: - rawMessage(hintCodeBegin, []) - MsgWriteln(result.s) - rawMessage(hintCodeEnd, []) - -proc evalPipe(p: var TParsers, n: PNode, filename: string, - start: PLLStream): PLLStream = - result = start - if n.kind == nkEmpty: return - if (n.kind == nkInfix) and (n.sons[0].kind == nkIdent) and - IdentEq(n.sons[0].ident, "|"): - for i in countup(1, 2): - if n.sons[i].kind == nkInfix: - result = evalPipe(p, n.sons[i], filename, result) - else: - result = applyFilter(p, n.sons[i], filename, result) - elif n.kind == nkStmtList: - result = evalPipe(p, n.sons[0], filename, result) - else: - result = applyFilter(p, n, filename, result) - -proc openParsers(p: var TParsers, filename: string, inputstream: PLLStream) = - var s: PLLStream - p.skin = skinStandard - var pipe = parsePipe(filename, inputStream) - if pipe != nil: s = evalPipe(p, pipe, filename, inputStream) - else: s = inputStream - case p.skin - of skinStandard, skinBraces, skinEndX: - pnimsyn.openParser(p.parser, filename, s) - -proc closeParsers(p: var TParsers) = - pnimsyn.closeParser(p.parser) diff --git a/rod/tccgen.nim b/rod/tccgen.nim deleted file mode 100755 index 2fd207aaa..000000000 --- a/rod/tccgen.nim +++ /dev/null @@ -1,76 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - os, strutils, options, msgs, tinyc - -{.compile: "../tinyc/libtcc.c".} - -proc tinyCErrorHandler(closure: pointer, msg: cstring) {.cdecl.} = - rawMessage(errGenerated, $msg) - -proc initTinyCState: PccState = - result = openCCState() - setErrorFunc(result, nil, tinyCErrorHandler) - -var - gTinyC = initTinyCState() - libIncluded = false - -proc addFile(filename: string) = - if addFile(gTinyC, filename) != 0'i32: - rawMessage(errCannotOpenFile, filename) - -proc setupEnvironment = - when defined(amd64): - defineSymbol(gTinyC, "__x86_64__", nil) - elif defined(i386): - defineSymbol(gTinyC, "__i386__", nil) - when defined(linux): - defineSymbol(gTinyC, "__linux__", nil) - defineSymbol(gTinyC, "__linux", nil) - var nimrodDir = getPrefixDir() - - addIncludePath(gTinyC, libpath) - when defined(windows): - addSysincludePath(gTinyC, nimrodDir / "tinyc/win32/include") - addSysincludePath(gTinyC, nimrodDir / "tinyc/include") - when defined(windows): - defineSymbol(gTinyC, "_WIN32", nil) - # we need Mingw's headers too: - var gccbin = getConfigVar("gcc.path") % ["nimrod", nimrodDir] - addSysincludePath(gTinyC, gccbin /../ "include") - #addFile(nimrodDir / r"tinyc\win32\wincrt1.o") - addFile(nimrodDir / r"tinyc\win32\alloca86.o") - addFile(nimrodDir / r"tinyc\win32\chkstk.o") - #addFile(nimrodDir / r"tinyc\win32\crt1.o") - - #addFile(nimrodDir / r"tinyc\win32\dllcrt1.o") - #addFile(nimrodDir / r"tinyc\win32\dllmain.o") - addFile(nimrodDir / r"tinyc\win32\libtcc1.o") - - #addFile(nimrodDir / r"tinyc\win32\lib\crt1.c") - #addFile(nimrodDir / r"tinyc\lib\libtcc1.c") - else: - addSysincludePath(gTinyC, "/usr/include") - -proc compileCCode*(ccode: string) = - if not libIncluded: - libIncluded = true - setupEnvironment() - discard compileString(gTinyC, ccode) - -proc run*() = - var a: array[0..1, cstring] - a[0] = "" - a[1] = "" - var err = tinyc.run(gTinyC, 0'i32, addr(a)) != 0'i32 - closeCCState(gTinyC) - if err: rawMessage(errExecutionOfProgramFailed, "") - diff --git a/rod/tigen.nim b/rod/tigen.nim deleted file mode 100755 index ef13fe42b..000000000 --- a/rod/tigen.nim +++ /dev/null @@ -1,33 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Type information generator. It transforms types into the AST of walker -# procs. This is used by the code generators. - -import - ast, astalgo, strutils, nhashes, trees, treetab, platform, magicsys, options, - msgs, crc, idents, lists, types, rnimsyn - -proc gcWalker*(t: PType): PNode -proc initWalker*(t: PType): PNode -proc asgnWalker*(t: PType): PNode -proc reprWalker*(t: PType): PNode -# implementation - -proc gcWalker(t: PType): PNode = - nil - -proc initWalker(t: PType): PNode = - nil - -proc asgnWalker(t: PType): PNode = - nil - -proc reprWalker(t: PType): PNode = - nil diff --git a/rod/transf.nim b/rod/transf.nim deleted file mode 100755 index db5146bb5..000000000 --- a/rod/transf.nim +++ /dev/null @@ -1,742 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the transformator. It transforms the syntax tree -# to ease the work of the code generators. Does some transformations: -# -# * inlines iterators -# * inlines constants -# * performes contant folding -# * converts "continue" to "break" -# * introduces method dispatchers - -import - strutils, lists, options, ast, astalgo, trees, treetab, evals, msgs, os, - idents, rnimsyn, types, passes, semfold, magicsys, cgmeth - -const - genPrefix* = ":tmp" # prefix for generated names - -proc transfPass*(): TPass -# implementation - -type - PTransNode* = distinct PNode - - PTransCon = ref TTransCon - TTransCon{.final.} = object # part of TContext; stackable - mapping: TIdNodeTable # mapping from symbols to nodes - owner: PSym # current owner - forStmt: PNode # current for stmt - forLoopBody: PTransNode # transformed for loop body - yieldStmts: int # we count the number of yield statements, - # because we need to introduce new variables - # if we encounter the 2nd yield statement - next: PTransCon # for stacking - - TTransfContext = object of passes.TPassContext - module: PSym - transCon: PTransCon # top of a TransCon stack - inlining: int # > 0 if we are in inlining context (copy vars) - blocksyms: seq[PSym] - - PTransf = ref TTransfContext - -proc newTransNode(a: PNode): PTransNode {.inline.} = - result = PTransNode(shallowCopy(a)) - -proc newTransNode(kind: TNodeKind, info: TLineInfo, - sons: int): PTransNode {.inline.} = - var x = newNodeI(kind, info) - newSeq(x.sons, sons) - result = x.PTransNode - -proc newTransNode(kind: TNodeKind, n: PNode, - sons: int): PTransNode {.inline.} = - var x = newNodeIT(kind, n.info, n.typ) - newSeq(x.sons, sons) - x.typ = n.typ - result = x.PTransNode - -proc `[]=`(a: PTransNode, i: int, x: PTransNode) {.inline.} = - var n = PNode(a) - n.sons[i] = PNode(x) - -proc `[]`(a: PTransNode, i: int): PTransNode {.inline.} = - var n = PNode(a) - result = n.sons[i].PTransNode - -proc add(a, b: PTransNode) {.inline.} = addSon(PNode(a), PNode(b)) -proc len(a: PTransNode): int {.inline.} = result = sonsLen(a.PNode) - -proc newTransCon(owner: PSym): PTransCon = - assert owner != nil - new(result) - initIdNodeTable(result.mapping) - result.owner = owner - -proc pushTransCon(c: PTransf, t: PTransCon) = - t.next = c.transCon - c.transCon = t - -proc popTransCon(c: PTransf) = - if (c.transCon == nil): InternalError("popTransCon") - c.transCon = c.transCon.next - -proc getCurrOwner(c: PTransf): PSym = - if c.transCon != nil: result = c.transCon.owner - else: result = c.module - -proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PSym = - result = newSym(skTemp, getIdent(genPrefix), getCurrOwner(c)) - result.info = info - result.typ = skipTypes(typ, {tyGenericInst}) - incl(result.flags, sfFromGeneric) - -proc transform(c: PTransf, n: PNode): PTransNode - -proc transformSons(c: PTransf, n: PNode): PTransNode = - result = newTransNode(n) - for i in countup(0, sonsLen(n)-1): - result[i] = transform(c, n.sons[i]) - -# Transforming iterators into non-inlined versions is pretty hard, but -# unavoidable for not bloating the code too much. If we had direct access to -# the program counter, things'd be much easier. -# :: -# -# iterator items(a: string): char = -# var i = 0 -# while i < length(a): -# yield a[i] -# inc(i) -# -# for ch in items("hello world"): # `ch` is an iteration variable -# echo(ch) -# -# Should be transformed into:: -# -# type -# TItemsClosure = record -# i: int -# state: int -# proc items(a: string, c: var TItemsClosure): char = -# case c.state -# of 0: goto L0 # very difficult without goto! -# of 1: goto L1 # can be implemented by GCC's computed gotos -# -# block L0: -# c.i = 0 -# while c.i < length(a): -# c.state = 1 -# return a[i] -# block L1: inc(c.i) -# -# More efficient, but not implementable:: -# -# type -# TItemsClosure = record -# i: int -# pc: pointer -# -# proc items(a: string, c: var TItemsClosure): char = -# goto c.pc -# c.i = 0 -# while c.i < length(a): -# c.pc = label1 -# return a[i] -# label1: inc(c.i) -# - -proc newAsgnStmt(c: PTransf, le: PNode, ri: PTransNode): PTransNode = - result = newTransNode(nkFastAsgn, PNode(ri).info, 2) - result[0] = PTransNode(le) - result[1] = ri - -proc transformSymAux(c: PTransf, n: PNode): PNode = - var b: PNode - if (n.kind != nkSym): internalError(n.info, "transformSym") - var tc = c.transCon - if sfBorrow in n.sym.flags: - # simply exchange the symbol: - b = n.sym.ast.sons[codePos] - if b.kind != nkSym: internalError(n.info, "wrong AST for borrowed symbol") - b = newSymNode(b.sym) - b.info = n.info - else: - b = n - while tc != nil: - result = IdNodeTableGet(tc.mapping, b.sym) - if result != nil: return - tc = tc.next - result = b - case b.sym.kind - of skConst, skEnumField: - # BUGFIX: skEnumField was missing - if not (skipTypes(b.sym.typ, abstractInst).kind in ConstantDataTypes): - result = getConstExpr(c.module, b) - if result == nil: InternalError(b.info, "transformSym: const") - else: - nil - -proc transformSym(c: PTransf, n: PNode): PTransNode = - result = PTransNode(transformSymAux(c, n)) - -proc transformVarSection(c: PTransf, v: PNode): PTransNode = - result = newTransNode(v) - for i in countup(0, sonsLen(v)-1): - var it = v.sons[i] - if it.kind == nkCommentStmt: - result[i] = PTransNode(it) - elif it.kind == nkIdentDefs: - if (it.sons[0].kind != nkSym): - InternalError(it.info, "transformVarSection") - var newVar = copySym(it.sons[0].sym) - incl(newVar.flags, sfFromGeneric) - # fixes a strange bug for rodgen: - #include(it.sons[0].sym.flags, sfFromGeneric); - newVar.owner = getCurrOwner(c) - IdNodeTablePut(c.transCon.mapping, it.sons[0].sym, newSymNode(newVar)) - var defs = newTransNode(nkIdentDefs, it.info, 3) - defs[0] = newSymNode(newVar).PTransNode - defs[1] = it.sons[1].PTransNode - defs[2] = transform(c, it.sons[2]) - result[i] = defs - else: - if it.kind != nkVarTuple: - InternalError(it.info, "transformVarSection: not nkVarTuple") - var L = sonsLen(it) - var defs = newTransNode(it.kind, it.info, L) - for j in countup(0, L-3): - var newVar = copySym(it.sons[j].sym) - incl(newVar.flags, sfFromGeneric) - newVar.owner = getCurrOwner(c) - IdNodeTablePut(c.transCon.mapping, it.sons[j].sym, newSymNode(newVar)) - defs[j] = newSymNode(newVar).PTransNode - assert(it.sons[L-2].kind == nkEmpty) - defs[L-1] = transform(c, it.sons[L-1]) - result[i] = defs - -proc hasContinue(n: PNode): bool = - case n.kind - of nkEmpty..nkNilLit, nkForStmt, nkWhileStmt: nil - of nkContinueStmt: result = true - else: - for i in countup(0, sonsLen(n) - 1): - if hasContinue(n.sons[i]): return true - -proc transformLoopBody(c: PTransf, n: PNode): PTransNode = - # XXX BUG: What if it contains "continue" and "break"? "break" needs - # an explicit label too, but not the same! - if hasContinue(n): - var labl = newSym(skLabel, nil, getCurrOwner(c)) - labl.name = getIdent(genPrefix & $labl.id) - labl.info = n.info - c.blockSyms.add(labl) - - result = newTransNode(nkBlockStmt, n.info, 2) - result[0] = newSymNode(labl).PTransNode - result[1] = transform(c, n) - discard c.blockSyms.pop() - else: - result = transform(c, n) - -proc skipConv(n: PNode): PNode = - case n.kind - of nkObjUpConv, nkObjDownConv, nkPassAsOpenArray, nkChckRange, nkChckRangeF, - nkChckRange64: - result = n.sons[0] - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - result = n.sons[1] - else: result = n - -proc newTupleAccess(tup: PNode, i: int): PNode = - result = newNodeIT(nkBracketExpr, tup.info, tup.typ.sons[i]) - addSon(result, copyTree(tup)) - var lit = newNodeIT(nkIntLit, tup.info, getSysType(tyInt)) - lit.intVal = i - addSon(result, lit) - -proc unpackTuple(c: PTransf, n: PNode, father: PTransNode) = - # XXX: BUG: what if `n` is an expression with side-effects? - for i in countup(0, sonsLen(c.transCon.forStmt) - 3): - add(father, newAsgnStmt(c, c.transCon.forStmt.sons[i], - transform(c, newTupleAccess(n, i)))) - -proc introduceNewLocalVars(c: PTransf, n: PNode): PTransNode = - case n.kind - of nkSym: - return transformSym(c, n) - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: - # nothing to be done for leaves: - result = PTransNode(n) - of nkVarSection: - result = transformVarSection(c, n) - else: - result = newTransNode(n) - for i in countup(0, sonsLen(n)-1): - result[i] = introduceNewLocalVars(c, n.sons[i]) - -proc transformYield(c: PTransf, n: PNode): PTransNode = - result = newTransNode(nkStmtList, n.info, 0) - var e = n.sons[0] - if skipTypes(e.typ, {tyGenericInst}).kind == tyTuple: - e = skipConv(e) - if e.kind == nkPar: - for i in countup(0, sonsLen(e) - 1): - add(result, newAsgnStmt(c, c.transCon.forStmt.sons[i], - transform(c, e.sons[i]))) - else: - unpackTuple(c, e, result) - else: - var x = transform(c, e) - add(result, newAsgnStmt(c, c.transCon.forStmt.sons[0], x)) - - inc(c.transCon.yieldStmts) - if c.transCon.yieldStmts <= 1: - # common case - add(result, c.transCon.forLoopBody) - else: - # we need to introduce new local variables: - add(result, introduceNewLocalVars(c, c.transCon.forLoopBody.pnode)) - -proc addVar(father, v: PNode) = - var vpart = newNodeI(nkIdentDefs, v.info) - addSon(vpart, v) - addSon(vpart, ast.emptyNode) - addSon(vpart, ast.emptyNode) - addSon(father, vpart) - -proc transformAddrDeref(c: PTransf, n: PNode, a, b: TNodeKind): PTransNode = - case n.sons[0].kind - of nkObjUpConv, nkObjDownConv, nkPassAsOpenArray, nkChckRange, nkChckRangeF, - nkChckRange64: - var m = n.sons[0].sons[0] - if (m.kind == a) or (m.kind == b): - # addr ( nkPassAsOpenArray ( deref ( x ) ) ) --> nkPassAsOpenArray(x) - var x = copyTree(n) - x.sons[0].sons[0] = m.sons[0] - result = transform(c, x.sons[0]) - - #result = newTransNode(n.sons[0]) - #result[0] = transform(c, m.sons[0]) - else: - result = transformSons(c, n) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - var m = n.sons[0].sons[1] - if (m.kind == a) or (m.kind == b): - # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - - var x = copyTree(n) - x.sons[0].sons[1] = m.sons[0] - result = transform(c, x.sons[0]) - - #result = newTransNode(n.sons[0]) - #result[1] = transform(c, m.sons[0]) - - else: - result = transformSons(c, n) - else: - if (n.sons[0].kind == a) or (n.sons[0].kind == b): - # addr ( deref ( x )) --> x - result = transform(c, n.sons[0].sons[0]) - else: - result = transformSons(c, n) - -proc transformConv(c: PTransf, n: PNode): PTransNode = - # numeric types need range checks: - var dest = skipTypes(n.typ, abstractVarRange) - var source = skipTypes(n.sons[1].typ, abstractVarRange) - case dest.kind - of tyInt..tyInt64, tyEnum, tyChar, tyBool: - if not isOrdinalType(source): - # XXX int64 -> float conversion? - result = transformSons(c, n) - elif firstOrd(dest) <= firstOrd(source) and - lastOrd(source) <= lastOrd(dest): - # BUGFIX: simply leave n as it is; we need a nkConv node, - # but no range check: - result = transformSons(c, n) - else: - # generate a range check: - if (dest.kind == tyInt64) or (source.kind == tyInt64): - result = newTransNode(nkChckRange64, n, 3) - else: - result = newTransNode(nkChckRange, n, 3) - dest = skipTypes(n.typ, abstractVar) - result[0] = transform(c, n.sons[1]) - result[1] = newIntTypeNode(nkIntLit, firstOrd(dest), source).PTransNode - result[2] = newIntTypeNode(nkIntLit, lastOrd(dest), source).PTransNode - of tyFloat..tyFloat128: - if skipTypes(n.typ, abstractVar).kind == tyRange: - result = newTransNode(nkChckRangeF, n, 3) - dest = skipTypes(n.typ, abstractVar) - result[0] = transform(c, n.sons[1]) - result[1] = copyTree(dest.n.sons[0]).PTransNode - result[2] = copyTree(dest.n.sons[1]).PTransNode - else: - result = transformSons(c, n) - of tyOpenArray: - result = newTransNode(nkPassAsOpenArray, n, 1) - result[0] = transform(c, n.sons[1]) - of tyCString: - if source.kind == tyString: - result = newTransNode(nkStringToCString, n, 1) - result[0] = transform(c, n.sons[1]) - else: - result = transformSons(c, n) - of tyString: - if source.kind == tyCString: - result = newTransNode(nkCStringToString, n, 1) - result[0] = transform(c, n.sons[1]) - else: - result = transformSons(c, n) - of tyRef, tyPtr: - dest = skipTypes(dest, abstractPtrs) - source = skipTypes(source, abstractPtrs) - if source.kind == tyObject: - var diff = inheritanceDiff(dest, source) - if diff < 0: - result = newTransNode(nkObjUpConv, n, 1) - result[0] = transform(c, n.sons[1]) - elif diff > 0: - result = newTransNode(nkObjDownConv, n, 1) - result[0] = transform(c, n.sons[1]) - else: - result = transform(c, n.sons[1]) - else: - result = transformSons(c, n) - of tyObject: - var diff = inheritanceDiff(dest, source) - if diff < 0: - result = newTransNode(nkObjUpConv, n, 1) - result[0] = transform(c, n.sons[1]) - elif diff > 0: - result = newTransNode(nkObjDownConv, n, 1) - result[0] = transform(c, n.sons[1]) - else: - result = transform(c, n.sons[1]) - of tyGenericParam, tyOrdinal: - result = transform(c, n.sons[1]) - # happens sometimes for generated assignments, etc. - else: - result = transformSons(c, n) - -proc skipPassAsOpenArray(n: PNode): PNode = - result = n - while result.kind == nkPassAsOpenArray: result = result.sons[0] - -type - TPutArgInto = enum - paDirectMapping, paFastAsgn, paVarAsgn - -proc putArgInto(arg: PNode, formal: PType): TPutArgInto = - # This analyses how to treat the mapping "formal <-> arg" in an - # inline context. - if skipTypes(formal, abstractInst).kind == tyOpenArray: - return paDirectMapping # XXX really correct? - # what if ``arg`` has side-effects? - case arg.kind - of nkEmpty..nkNilLit: - result = paDirectMapping - of nkPar, nkCurly, nkBracket: - result = paFastAsgn - for i in countup(0, sonsLen(arg) - 1): - if putArgInto(arg.sons[i], formal) != paDirectMapping: return - result = paDirectMapping - else: - if skipTypes(formal, abstractInst).kind == tyVar: result = paVarAsgn - else: result = paFastAsgn - -proc transformFor(c: PTransf, n: PNode): PTransNode = - # generate access statements for the parameters (unless they are constant) - # put mapping from formal parameters to actual parameters - if n.kind != nkForStmt: InternalError(n.info, "transformFor") - result = newTransNode(nkStmtList, n.info, 0) - var length = sonsLen(n) - var loopBody = transformLoopBody(c, n.sons[length-1]) - var v = newNodeI(nkVarSection, n.info) - for i in countup(0, length - 3): - addVar(v, copyTree(n.sons[i])) # declare new vars - add(result, v.ptransNode) - var call = n.sons[length - 2] - if (call.kind != nkCall) or (call.sons[0].kind != nkSym): - InternalError(call.info, "transformFor") - - var newC = newTransCon(call.sons[0].sym) - newC.forStmt = n - newC.forLoopBody = loopBody - if (newC.owner.kind != skIterator): - InternalError(call.info, "transformFor") - # generate access statements for the parameters (unless they are constant) - pushTransCon(c, newC) - for i in countup(1, sonsLen(call) - 1): - var arg = skipPassAsOpenArray(transform(c, call.sons[i]).pnode) - var formal = skipTypes(newC.owner.typ, abstractInst).n.sons[i].sym - case putArgInto(arg, formal.typ) - of paDirectMapping: - IdNodeTablePut(newC.mapping, formal, arg) - of paFastAsgn: - # generate a temporary and produce an assignment statement: - var temp = newTemp(c, formal.typ, formal.info) - addVar(v, newSymNode(temp)) - add(result, newAsgnStmt(c, newSymNode(temp), arg.ptransNode)) - IdNodeTablePut(newC.mapping, formal, newSymNode(temp)) - of paVarAsgn: - assert(skipTypes(formal.typ, abstractInst).kind == tyVar) - InternalError(arg.info, "not implemented: pass to var parameter") - var body = newC.owner.ast.sons[codePos] - pushInfoContext(n.info) - inc(c.inlining) - add(result, transform(c, body)) - dec(c.inlining) - popInfoContext() - popTransCon(c) - -proc getMagicOp(call: PNode): TMagic = - if (call.sons[0].kind == nkSym) and - (call.sons[0].sym.kind in {skProc, skMethod, skConverter}): - result = call.sons[0].sym.magic - else: - result = mNone - -proc gatherVars(c: PTransf, n: PNode, marked: var TIntSet, owner: PSym, - container: PNode) = - # gather used vars for closure generation - case n.kind - of nkSym: - var s = n.sym - var found = false - case s.kind - of skVar: found = not (sfGlobal in s.flags) - of skTemp, skForVar, skParam: found = true - else: nil - if found and (owner.id != s.owner.id) and - not IntSetContainsOrIncl(marked, s.id): - incl(s.flags, sfInClosure) - addSon(container, copyNode(n)) # DON'T make a copy of the symbol! - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: - nil - else: - for i in countup(0, sonsLen(n) - 1): - gatherVars(c, n.sons[i], marked, owner, container) - -proc addFormalParam(routine: PSym, param: PSym) = - addSon(routine.typ, param.typ) - addSon(routine.ast.sons[paramsPos], newSymNode(param)) - -proc indirectAccess(a, b: PSym): PNode = - # returns a^ .b as a node - var x = newSymNode(a) - var y = newSymNode(b) - var deref = newNodeI(nkHiddenDeref, x.info) - deref.typ = x.typ.sons[0] - addSon(deref, x) - result = newNodeI(nkDotExpr, x.info) - addSon(result, deref) - addSon(result, y) - result.typ = y.typ - -proc transformLambda(c: PTransf, n: PNode): PNode = - var marked: TIntSet - result = n - IntSetInit(marked) - if (n.sons[namePos].kind != nkSym): InternalError(n.info, "transformLambda") - var s = n.sons[namePos].sym - var closure = newNodeI(nkRecList, n.sons[codePos].info) - gatherVars(c, n.sons[codePos], marked, s, closure) - # add closure type to the param list (even if closure is empty!): - var cl = newType(tyObject, s) - cl.n = closure - addSon(cl, nil) # no super class - var p = newType(tyRef, s) - addSon(p, cl) - var param = newSym(skParam, getIdent(genPrefix & "Cl"), s) - param.typ = p - addFormalParam(s, param) - # all variables that are accessed should be accessed by the new closure - # parameter: - if sonsLen(closure) > 0: - var newC = newTransCon(c.transCon.owner) - for i in countup(0, sonsLen(closure) - 1): - IdNodeTablePut(newC.mapping, closure.sons[i].sym, - indirectAccess(param, closure.sons[i].sym)) - pushTransCon(c, newC) - n.sons[codePos] = transform(c, n.sons[codePos]).pnode - popTransCon(c) - -proc transformCase(c: PTransf, n: PNode): PTransNode = - # removes `elif` branches of a case stmt - # adds ``else: nil`` if needed for the code generator - result = newTransNode(nkCaseStmt, n, 0) - var ifs = PTransNode(nil) - for i in 0 .. sonsLen(n)-1: - var it = n.sons[i] - var e = transform(c, it) - case it.kind - of nkElifBranch: - if ifs.pnode == nil: - ifs = newTransNode(nkIfStmt, it.info, 0) - ifs.add(e) - of nkElse: - if ifs.pnode == nil: result.add(e) - else: ifs.add(e) - else: - result.add(e) - if ifs.pnode != nil: - var elseBranch = newTransNode(nkElse, n.info, 1) - elseBranch[0] = ifs - result.add(elseBranch) - elif result.Pnode.lastSon.kind != nkElse and not ( - skipTypes(n.sons[0].Typ, abstractVarRange).Kind in - {tyInt..tyInt64, tyChar, tyEnum}): - # fix a stupid code gen bug by normalizing: - var elseBranch = newTransNode(nkElse, n.info, 1) - elseBranch[0] = newTransNode(nkNilLit, n.info, 0) - add(result, elseBranch) - -proc transformArrayAccess(c: PTransf, n: PNode): PTransNode = - result = newTransNode(n) - result[0] = transform(c, skipConv(n.sons[0])) - result[1] = transform(c, skipConv(n.sons[1])) - -proc getMergeOp(n: PNode): PSym = - case n.kind - of nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, - nkCallStrLit: - if (n.sons[0].Kind == nkSym) and (n.sons[0].sym.kind == skProc) and - (sfMerge in n.sons[0].sym.flags): - result = n.sons[0].sym - else: nil - -proc flattenTreeAux(d, a: PNode, op: PSym) = - var op2 = getMergeOp(a) - if op2 != nil and - (op2.id == op.id or op.magic != mNone and op2.magic == op.magic): - for i in countup(1, sonsLen(a)-1): flattenTreeAux(d, a.sons[i], op) - else: - addSon(d, copyTree(a)) - -proc flattenTree(root: PNode): PNode = - var op = getMergeOp(root) - if op != nil: - result = copyNode(root) - addSon(result, copyTree(root.sons[0])) - flattenTreeAux(result, root, op) - else: - result = root - -proc transformCall(c: PTransf, n: PNode): PTransNode = - var n = flattenTree(n) - var op = getMergeOp(n) - if (op != nil) and (op.magic != mNone) and (sonsLen(n) >= 3): - result = newTransNode(nkCall, n, 0) - add(result, transform(c, n.sons[0])) - var j = 1 - while j < sonsLen(n): - var a = n.sons[j] - inc(j) - if isConstExpr(a): - while (j < sonsLen(n)) and isConstExpr(n.sons[j]): - a = evalOp(op.magic, n, a, n.sons[j], nil) - inc(j) - add(result, transform(c, a)) - if len(result) == 2: result = result[1] - elif (n.sons[0].kind == nkSym) and (n.sons[0].sym.kind == skMethod): - # use the dispatcher for the call: - result = methodCall(transformSons(c, n).pnode).ptransNode - else: - result = transformSons(c, n) - -proc transform(c: PTransf, n: PNode): PTransNode = - case n.kind - of nkSym: - return transformSym(c, n) - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: - # nothing to be done for leaves: - result = PTransNode(n) - of nkBracketExpr: - result = transformArrayAccess(c, n) - of nkLambda: - when false: result = transformLambda(c, n) - of nkForStmt: - result = transformFor(c, n) - of nkCaseStmt: - result = transformCase(c, n) - of nkProcDef, nkMethodDef, nkIteratorDef, nkMacroDef, nkConverterDef: - if n.sons[genericParamsPos].kind == nkEmpty: - n.sons[codePos] = PNode(transform(c, n.sons[codePos])) - if n.kind == nkMethodDef: methodDef(n.sons[namePos].sym) - result = PTransNode(n) - of nkContinueStmt: - result = PTransNode(newNode(nkBreakStmt)) - var labl = c.blockSyms[c.blockSyms.high] - add(result, PTransNode(newSymNode(labl))) - of nkWhileStmt: - result = newTransNode(n) - result[0] = transform(c, n.sons[0]) - result[1] = transformLoopBody(c, n.sons[1]) - of nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, - nkCallStrLit: - result = transformCall(c, n) - of nkAddr, nkHiddenAddr: - result = transformAddrDeref(c, n, nkDerefExpr, nkHiddenDeref) - of nkDerefExpr, nkHiddenDeref: - result = transformAddrDeref(c, n, nkAddr, nkHiddenAddr) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - result = transformConv(c, n) - of nkDiscardStmt: - result = transformSons(c, n) - if isConstExpr(PNode(result).sons[0]): - # ensure that e.g. discard "some comment" gets optimized away completely: - result = PTransNode(newNode(nkCommentStmt)) - of nkCommentStmt, nkTemplateDef: - return n.ptransNode - of nkConstSection: - # do not replace ``const c = 3`` with ``const 3 = 3`` - return n.ptransNode - of nkVarSection: - if c.inlining > 0: - # we need to copy the variables for multiple yield statements: - result = transformVarSection(c, n) - else: - result = transformSons(c, n) - of nkYieldStmt: - if c.inlining > 0: - result = transformYield(c, n) - else: - result = transformSons(c, n) - else: - result = transformSons(c, n) - var cnst = getConstExpr(c.module, PNode(result)) - if cnst != nil: - result = PTransNode(cnst) # do not miss an optimization - -proc processTransf(context: PPassContext, n: PNode): PNode = - # Note: For interactive mode we cannot call 'passes.skipCodegen' and skip - # this step! We have to rely that the semantic pass transforms too errornous - # nodes into an empty node. - var c = PTransf(context) - pushTransCon(c, newTransCon(getCurrOwner(c))) - result = PNode(transform(c, n)) - popTransCon(c) - -proc openTransf(module: PSym, filename: string): PPassContext = - var n: PTransf - new(n) - n.blocksyms = @[] - n.module = module - result = n - -proc transfPass(): TPass = - initPass(result) - result.open = openTransf - result.process = processTransf - result.close = processTransf # we need to process generics too! - diff --git a/rod/transtmp.nim b/rod/transtmp.nim deleted file mode 100755 index 44a462fea..000000000 --- a/rod/transtmp.nim +++ /dev/null @@ -1,111 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# -# This module implements a transformator. It transforms the syntax tree -# to ease the work of the code generators. Does the transformation to -# introduce temporaries to split up complex expressions. -# THIS MODULE IS NOT USED! - -proc transInto(c: PContext, dest: var PNode, father, src: PNode) - # transforms the expression `src` into the destination `dest`. Uses `father` - # for temorary statements. If dest = nil, the expression is put into a - # temporary. -proc transTmp(c: PContext, father, src: PNode): PNode = - # convienence proc - result = nil - transInto(c, result, father, src) - -proc newLabel(c: PContext): PSym = - inc(gTmpId) - result = newSym(skLabel, getIdent(genPrefix & $(gTmpId), c.transCon.owner)) - -proc fewCmps(s: PNode): bool = - # this function estimates whether it is better to emit code - # for constructing the set or generating a bunch of comparisons directly - assert(s.kind in {nkSetConstr, nkConstSetConstr}) - if (s.typ.size <= platform.intSize) and (s.kind == nkConstSetConstr): - result = false # it is better to emit the set generation code - elif skipRange(s.typ.sons[0]).Kind in {tyInt..tyInt64}: - result = true # better not emit the set if int is basetype! - else: - result = sonsLen(s) <= - 8 # 8 seems to be a good value - -proc transformIn(c: PContext, father, n: PNode): PNode = - var - a, b, e, setc: PNode - destLabel, label2: PSym - if (n.sons[1].kind == nkSetConstr) and fewCmps(n.sons[1]): - # a set constructor but not a constant set: - # do not emit the set, but generate a bunch of comparisons - result = newSymNode(newTemp(c, n.typ, n.info)) - e = transTmp(c, father, n.sons[2]) - setc = n.sons[1] - destLabel = newLabel(c) - for i in countup(0, sonsLen(setc) - 1): - if setc.sons[i].kind == nkRange: - a = transTmp(c, father, setc.sons[i].sons[0]) - b = transTmp(c, father, setc.sons[i].sons[1]) - label2 = newLabel(c) - addSon(father, newLt(result, e, a)) # e < a? --> goto end - addSon(father, newCondJmp(result, label2)) - addSon(father, newLe(result, e, b)) # e <= b? --> goto set end - addSon(father, newCondJmp(result, destLabel)) - addSon(father, newLabelNode(label2)) - else: - a = transTmp(c, father, setc.sons[i]) - addSon(father, newEq(result, e, a)) - addSon(father, newCondJmp(result, destLabel)) - addSon(father, newLabelNode(destLabel)) - else: - result = n - -proc transformOp2(c: PContext, dest: var PNode, father, n: PNode) = - var a, b: PNode - if dest == nil: dest = newSymNode(newTemp(c, n.typ, n.info)) - a = transTmp(c, father, n.sons[1]) - b = transTmp(c, father, n.sons[2]) - addSon(father, newAsgnStmt(dest, newOp2(n, a, b))) - -proc transformOp1(c: PContext, dest: var PNode, father, n: PNode) = - var a: PNode - if dest == nil: dest = newSymNode(newTemp(c, n.typ, n.info)) - a = transTmp(c, father, n.sons[1]) - addSon(father, newAsgnStmt(dest, newOp1(n, a))) - -proc genTypeInfo(c: PContext, initSection: PNode) = - nil - -proc genNew(c: PContext, father, n: PNode) = - # how do we handle compilerprocs? - -proc transformCase(c: PContext, father, n: PNode): PNode = - var - ty: PType - e: PNode - ty = skipGeneric(n.sons[0].typ) - if ty.kind == tyString: - # transform a string case to a bunch of comparisons: - result = newNodeI(nkIfStmt, n) - e = transTmp(c, father, n.sons[0]) - else: - result = n - -proc transInto(c: PContext, dest: var PNode, father, src: PNode) = - if src == nil: return - if (src.typ != nil) and (src.typ.kind == tyGenericInst): - src.typ = skipGeneric(src.typ) - case src.kind - of nkIdent..nkNilLit: - if dest == nil: - dest = copyTree(src) - else: - # generate assignment: - addSon(father, newAsgnStmt(dest, src)) - of nkCall, nkCommand, nkCallStrLit: - nil diff --git a/rod/trees.nim b/rod/trees.nim deleted file mode 100755 index 69b77b8ab..000000000 --- a/rod/trees.nim +++ /dev/null @@ -1,140 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# tree helper routines - -import - ast, astalgo, scanner, msgs, strutils - -proc getMagic*(op: PNode): TMagic - -proc isConstExpr*(n: PNode): bool -proc flattenTree*(root: PNode, op: TMagic): PNode -proc TreeToSym*(t: PNode): PSym -proc SwapOperands*(op: PNode) -proc getOpSym*(op: PNode): PSym -proc getProcSym*(call: PNode): PSym -proc ExprStructuralEquivalent*(a, b: PNode): bool -proc sameTree*(a, b: PNode): bool -proc cyclicTree*(n: PNode): bool -# implementation - -proc hasSon(father, son: PNode): bool = - for i in countup(0, sonsLen(father) - 1): - if father.sons[i] == son: - return true - result = false - -proc cyclicTreeAux(n, s: PNode): bool = - if n == nil: - return false - if hasSon(s, n): - return true - var m = sonsLen(s) - addSon(s, n) - if not (n.kind in {nkEmpty..nkNilLit}): - for i in countup(0, sonsLen(n) - 1): - if cyclicTreeAux(n.sons[i], s): - return true - result = false - delSon(s, m) - -proc cyclicTree(n: PNode): bool = - var s = newNodeI(nkEmpty, n.info) - result = cyclicTreeAux(n, s) - -proc ExprStructuralEquivalent(a, b: PNode): bool = - result = false - if a == b: - result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): - case a.kind - of nkSym: - # don't go nuts here: same symbol as string is enough: - result = a.sym.name.id == b.sym.name.id - of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal - of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal - of nkEmpty, nkNilLit, nkType: result = true - else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not ExprStructuralEquivalent(a.sons[i], b.sons[i]): return - result = true - -proc sameTree(a, b: PNode): bool = - result = false - if a == b: - result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): - if a.flags != b.flags: return - if a.info.line != b.info.line: return - if a.info.col != b.info.col: - return #if a.info.fileIndex <> b.info.fileIndex then exit; - case a.kind - of nkSym: - # don't go nuts here: same symbol as string is enough: - result = a.sym.name.id == b.sym.name.id - of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal - of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal - of nkEmpty, nkNilLit, nkType: result = true - else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not sameTree(a.sons[i], b.sons[i]): return - result = true - -proc getProcSym(call: PNode): PSym = - result = call.sons[0].sym - -proc getOpSym(op: PNode): PSym = - if not (op.kind in {nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit}): - result = nil - else: - if (sonsLen(op) <= 0): InternalError(op.info, "getOpSym") - if op.sons[0].Kind == nkSym: result = op.sons[0].sym - else: result = nil - -proc getMagic(op: PNode): TMagic = - case op.kind - of nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit: - case op.sons[0].Kind - of nkSym: result = op.sons[0].sym.magic - else: result = mNone - else: result = mNone - -proc TreeToSym(t: PNode): PSym = - result = t.sym - -proc isConstExpr(n: PNode): bool = - result = (n.kind in - {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkNilLit}) or (nfAllConst in n.flags) - -proc flattenTreeAux(d, a: PNode, op: TMagic) = - if (getMagic(a) == op): # a is a "leaf", so add it: - for i in countup(1, sonsLen(a) - 1): # BUGFIX - flattenTreeAux(d, a.sons[i], op) - else: - addSon(d, copyTree(a)) - -proc flattenTree(root: PNode, op: TMagic): PNode = - result = copyNode(root) - if (getMagic(root) == op): - # BUGFIX: forget to copy prc - addSon(result, copyNode(root.sons[0])) - flattenTreeAux(result, root, op) - -proc SwapOperands(op: PNode) = - var tmp = op.sons[1] - op.sons[1] = op.sons[2] - op.sons[2] = tmp diff --git a/rod/treetab.nim b/rod/treetab.nim deleted file mode 100755 index 797ef5029..000000000 --- a/rod/treetab.nim +++ /dev/null @@ -1,125 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Implements a table from trees to trees. Does structural equavilent checking. - -import - nhashes, ast, astalgo, types - -proc NodeTableGet*(t: TNodeTable, key: PNode): int -proc NodeTablePut*(t: var TNodeTable, key: PNode, val: int) -proc NodeTableTestOrSet*(t: var TNodeTable, key: PNode, val: int): int -# implementation - -proc hashTree(n: PNode): THash = - result = 0 - if n == nil: return - result = ord(n.kind) - case n.kind - of nkEmpty, nkNilLit, nkType: - nil - of nkIdent: - result = concHash(result, n.ident.h) - of nkSym: - result = concHash(result, n.sym.name.h) - of nkCharLit..nkInt64Lit: - if (n.intVal >= low(int)) and (n.intVal <= high(int)): - result = concHash(result, int(n.intVal)) - of nkFloatLit..nkFloat64Lit: - if (n.floatVal >= - 1000000.0) and (n.floatVal <= 1000000.0): - result = concHash(result, toInt(n.floatVal)) - of nkStrLit..nkTripleStrLit: - result = concHash(result, GetHashStr(n.strVal)) - else: - for i in countup(0, sonsLen(n) - 1): - result = concHash(result, hashTree(n.sons[i])) - -proc TreesEquivalent(a, b: PNode): bool = - result = false - if a == b: - result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): - case a.kind - of nkEmpty, nkNilLit, nkType: result = true - of nkSym: result = a.sym.id == b.sym.id - of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal - of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal - else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not TreesEquivalent(a.sons[i], b.sons[i]): return - result = true - if result: result = sameTypeOrNil(a.typ, b.typ) - -proc NodeTableRawGet(t: TNodeTable, k: THash, key: PNode): int = - var h: THash - h = k and high(t.data) - while t.data[h].key != nil: - if (t.data[h].h == k) and TreesEquivalent(t.data[h].key, key): - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc NodeTableGet(t: TNodeTable, key: PNode): int = - var index: int - index = NodeTableRawGet(t, hashTree(key), key) - if index >= 0: result = t.data[index].val - else: result = low(int) - -proc NodeTableRawInsert(data: var TNodePairSeq, k: THash, key: PNode, val: int) = - var h: THash - h = k and high(data) - while data[h].key != nil: h = nextTry(h, high(data)) - assert(data[h].key == nil) - data[h].h = k - data[h].key = key - data[h].val = val - -proc NodeTablePut(t: var TNodeTable, key: PNode, val: int) = - var - index: int - n: TNodePairSeq - k: THash - k = hashTree(key) - index = NodeTableRawGet(t, k, key) - if index >= 0: - assert(t.data[index].key != nil) - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: - NodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val) - swap(t.data, n) - NodeTableRawInsert(t.data, k, key, val) - inc(t.counter) - -proc NodeTableTestOrSet(t: var TNodeTable, key: PNode, val: int): int = - var - index: int - n: TNodePairSeq - k: THash - k = hashTree(key) - index = NodeTableRawGet(t, k, key) - if index >= 0: - assert(t.data[index].key != nil) - result = t.data[index].val - else: - if mustRehash(len(t.data), t.counter): - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: - NodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val) - swap(t.data, n) - NodeTableRawInsert(t.data, k, key, val) - result = val - inc(t.counter) diff --git a/rod/types.nim b/rod/types.nim deleted file mode 100755 index dcabbd3ee..000000000 --- a/rod/types.nim +++ /dev/null @@ -1,974 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# this module contains routines for accessing and iterating over types - -import - ast, astalgo, trees, msgs, strutils, platform - -proc firstOrd*(t: PType): biggestInt -proc lastOrd*(t: PType): biggestInt -proc lengthOrd*(t: PType): biggestInt -type - TPreferedDesc* = enum - preferName, preferDesc - -proc TypeToString*(typ: PType, prefer: TPreferedDesc = preferName): string -proc getProcHeader*(sym: PSym): string -proc base*(t: PType): PType - # ------------------- type iterator: ---------------------------------------- -type - TTypeIter* = proc (t: PType, closure: PObject): bool # should return true if the iteration should stop - TTypeMutator* = proc (t: PType, closure: PObject): PType # copy t and mutate it - TTypePredicate* = proc (t: PType): bool - -proc IterOverType*(t: PType, iter: TTypeIter, closure: PObject): bool - # Returns result of `iter`. -proc mutateType*(t: PType, iter: TTypeMutator, closure: PObject): PType - # Returns result of `iter`. -proc SameType*(x, y: PType): bool -proc SameTypeOrNil*(a, b: PType): bool -proc equalOrDistinctOf*(x, y: PType): bool -type - TParamsEquality* = enum # they are equal, but their - # identifiers or their return - # type differ (i.e. they cannot be - # overloaded) - # this used to provide better error messages - paramsNotEqual, # parameters are not equal - paramsEqual, # parameters are equal - paramsIncompatible - -proc equalParams*(a, b: PNode): TParamsEquality - # returns whether the parameter lists of the procs a, b are exactly the same -proc isOrdinalType*(t: PType): bool -proc enumHasWholes*(t: PType): bool -const - abstractPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst, tyDistinct, tyOrdinal} - abstractVar* = {tyVar, tyGenericInst, tyDistinct, tyOrdinal} - abstractRange* = {tyGenericInst, tyRange, tyDistinct, tyOrdinal} - abstractVarRange* = {tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal} - abstractInst* = {tyGenericInst, tyDistinct, tyOrdinal} - - skipPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst} - -proc skipTypes*(t: PType, kinds: TTypeKinds): PType -proc elemType*(t: PType): PType -proc containsObject*(t: PType): bool -proc containsGarbageCollectedRef*(typ: PType): bool -proc containsHiddenPointer*(typ: PType): bool -proc canFormAcycle*(typ: PType): bool -proc isCompatibleToCString*(a: PType): bool -proc getOrdValue*(n: PNode): biggestInt -proc computeSize*(typ: PType): biggestInt -proc getSize*(typ: PType): biggestInt -proc isPureObject*(typ: PType): bool -proc inheritanceDiff*(a, b: PType): int - # | returns: 0 iff `a` == `b` - # | returns: -x iff `a` is the x'th direct superclass of `b` - # | returns: +x iff `a` is the x'th direct subclass of `b` - # | returns: `maxint` iff `a` and `b` are not compatible at all -proc InvalidGenericInst*(f: PType): bool - # for debugging -type - TTypeFieldResult* = enum - frNone, # type has no object type field - frHeader, # type has an object type field only in the header - frEmbedded # type has an object type field somewhere embedded - -proc analyseObjectWithTypeField*(t: PType): TTypeFieldResult - # this does a complex analysis whether a call to ``objectInit`` needs to be - # made or intializing of the type field suffices or if there is no type field - # at all in this type. -proc typeAllowed*(t: PType, kind: TSymKind): bool -# implementation - -proc InvalidGenericInst(f: PType): bool = - result = (f.kind == tyGenericInst) and (lastSon(f) == nil) - -proc inheritanceDiff(a, b: PType): int = - # conversion to superclass? - var x = a - result = 0 - while (x != nil): - if x.id == b.id: return - x = x.sons[0] - dec(result) - var y = b - result = 0 - while (y != nil): - if y.id == a.id: return - y = y.sons[0] - inc(result) - result = high(int) - -proc isPureObject(typ: PType): bool = - var t: PType - t = typ - while t.sons[0] != nil: t = t.sons[0] - result = (t.sym != nil) and (sfPure in t.sym.flags) - -proc getOrdValue(n: PNode): biggestInt = - case n.kind - of nkCharLit..nkInt64Lit: result = n.intVal - of nkNilLit: result = 0 - else: - LocalError(n.info, errOrdinalTypeExpected) - result = 0 - -proc isCompatibleToCString(a: PType): bool = - result = false - if a.kind == tyArray: - if (firstOrd(a.sons[0]) == 0) and - (skipTypes(a.sons[0], {tyRange}).kind in {tyInt..tyInt64}) and - (a.sons[1].kind == tyChar): - result = true - -proc getProcHeader(sym: PSym): string = - result = sym.name.s & '(' - var n = sym.typ.n - for i in countup(1, sonsLen(n) - 1): - var p = n.sons[i] - if (p.kind != nkSym): InternalError("getProcHeader") - add(result, p.sym.name.s) - add(result, ": ") - add(result, typeToString(p.sym.typ)) - if i != sonsLen(n) - 1: add(result, ", ") - add(result, ')') - if n.sons[0].typ != nil: result = result & ": " & typeToString(n.sons[0].typ) - -proc elemType(t: PType): PType = - assert(t != nil) - case t.kind - of tyGenericInst, tyDistinct: result = elemType(lastSon(t)) - of tyArray, tyArrayConstr: result = t.sons[1] - else: result = t.sons[0] - assert(result != nil) - -proc skipGeneric(t: PType): PType = - result = t - while result.kind == tyGenericInst: result = lastSon(result) - -proc skipRange(t: PType): PType = - result = t - while result.kind == tyRange: result = base(result) - -proc skipAbstract(t: PType): PType = - result = t - while result.kind in {tyRange, tyGenericInst}: result = lastSon(result) - -proc skipVar(t: PType): PType = - result = t - while result.kind == tyVar: result = result.sons[0] - -proc skipVarGeneric(t: PType): PType = - result = t - while result.kind in {tyGenericInst, tyVar}: result = lastSon(result) - -proc skipPtrsGeneric(t: PType): PType = - result = t - while result.kind in {tyGenericInst, tyVar, tyPtr, tyRef}: - result = lastSon(result) - -proc skipVarGenericRange(t: PType): PType = - result = t - while result.kind in {tyGenericInst, tyVar, tyRange}: result = lastSon(result) - -proc skipGenericRange(t: PType): PType = - result = t - while result.kind in {tyGenericInst, tyVar, tyRange}: result = lastSon(result) - -proc skipTypes(t: PType, kinds: TTypeKinds): PType = - result = t - while result.kind in kinds: result = lastSon(result) - -proc isOrdinalType(t: PType): bool = - assert(t != nil) - result = (t.Kind in {tyChar, tyInt..tyInt64, tyBool, tyEnum}) or - (t.Kind in {tyRange, tyOrdinal}) and isOrdinalType(t.sons[0]) - -proc enumHasWholes(t: PType): bool = - var b = t - while b.kind == tyRange: b = b.sons[0] - result = (b.Kind == tyEnum) and (tfEnumHasWholes in b.flags) - -proc iterOverTypeAux(marker: var TIntSet, t: PType, iter: TTypeIter, - closure: PObject): bool -proc iterOverNode(marker: var TIntSet, n: PNode, iter: TTypeIter, - closure: PObject): bool = - result = false - if n != nil: - case n.kind - of nkNone..nkNilLit: - # a leaf - result = iterOverTypeAux(marker, n.typ, iter, closure) - else: - for i in countup(0, sonsLen(n) - 1): - result = iterOverNode(marker, n.sons[i], iter, closure) - if result: return - -proc iterOverTypeAux(marker: var TIntSet, t: PType, iter: TTypeIter, - closure: PObject): bool = - result = false - if t == nil: return - result = iter(t, closure) - if result: return - if not IntSetContainsOrIncl(marker, t.id): - case t.kind - of tyGenericInst, tyGenericBody: - result = iterOverTypeAux(marker, lastSon(t), iter, closure) - else: - for i in countup(0, sonsLen(t) - 1): - result = iterOverTypeAux(marker, t.sons[i], iter, closure) - if result: return - if t.n != nil: result = iterOverNode(marker, t.n, iter, closure) - -proc IterOverType(t: PType, iter: TTypeIter, closure: PObject): bool = - var marker: TIntSet - IntSetInit(marker) - result = iterOverTypeAux(marker, t, iter, closure) - -proc searchTypeForAux(t: PType, predicate: TTypePredicate, - marker: var TIntSet): bool - -proc searchTypeNodeForAux(n: PNode, p: TTypePredicate, - marker: var TIntSet): bool = - result = false - case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = searchTypeNodeForAux(n.sons[i], p, marker) - if result: return - of nkRecCase: - assert(n.sons[0].kind == nkSym) - result = searchTypeNodeForAux(n.sons[0], p, marker) - if result: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - result = searchTypeNodeForAux(lastSon(n.sons[i]), p, marker) - if result: return - else: internalError("searchTypeNodeForAux(record case branch)") - of nkSym: - result = searchTypeForAux(n.sym.typ, p, marker) - else: internalError(n.info, "searchTypeNodeForAux()") - -proc searchTypeForAux(t: PType, predicate: TTypePredicate, marker: var TIntSet): bool = - # iterates over VALUE types! - result = false - if t == nil: return - if IntSetContainsOrIncl(marker, t.id): return - result = Predicate(t) - if result: return - case t.kind - of tyObject: - result = searchTypeForAux(t.sons[0], predicate, marker) - if not result: result = searchTypeNodeForAux(t.n, predicate, marker) - of tyGenericInst, tyDistinct: - result = searchTypeForAux(lastSon(t), predicate, marker) - of tyArray, tyArrayConstr, tySet, tyTuple: - for i in countup(0, sonsLen(t) - 1): - result = searchTypeForAux(t.sons[i], predicate, marker) - if result: return - else: - nil - -proc searchTypeFor(t: PType, predicate: TTypePredicate): bool = - var marker: TIntSet - IntSetInit(marker) - result = searchTypeForAux(t, predicate, marker) - -proc isObjectPredicate(t: PType): bool = - result = t.kind == tyObject - -proc containsObject(t: PType): bool = - result = searchTypeFor(t, isObjectPredicate) - -proc isObjectWithTypeFieldPredicate(t: PType): bool = - result = (t.kind == tyObject) and (t.sons[0] == nil) and - not ((t.sym != nil) and (sfPure in t.sym.flags)) and - not (tfFinal in t.flags) - -proc analyseObjectWithTypeFieldAux(t: PType, marker: var TIntSet): TTypeFieldResult = - var res: TTypeFieldResult - result = frNone - if t == nil: return - case t.kind - of tyObject: - if (t.n != nil): - if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker): - return frEmbedded - for i in countup(0, sonsLen(t) - 1): - res = analyseObjectWithTypeFieldAux(t.sons[i], marker) - if res == frEmbedded: - return frEmbedded - if res == frHeader: result = frHeader - if result == frNone: - if isObjectWithTypeFieldPredicate(t): result = frHeader - of tyGenericInst, tyDistinct: - result = analyseObjectWithTypeFieldAux(lastSon(t), marker) - of tyArray, tyArrayConstr, tyTuple: - for i in countup(0, sonsLen(t) - 1): - res = analyseObjectWithTypeFieldAux(t.sons[i], marker) - if res != frNone: - return frEmbedded - else: - nil - -proc analyseObjectWithTypeField(t: PType): TTypeFieldResult = - var marker: TIntSet - IntSetInit(marker) - result = analyseObjectWithTypeFieldAux(t, marker) - -proc isGBCRef(t: PType): bool = - result = t.kind in {tyRef, tySequence, tyString} - -proc containsGarbageCollectedRef(typ: PType): bool = - # returns true if typ contains a reference, sequence or string (all the things - # that are garbage-collected) - result = searchTypeFor(typ, isGBCRef) - -proc isHiddenPointer(t: PType): bool = - result = t.kind in {tyString, tySequence} - -proc containsHiddenPointer(typ: PType): bool = - # returns true if typ contains a string, table or sequence (all the things - # that need to be copied deeply) - result = searchTypeFor(typ, isHiddenPointer) - -proc canFormAcycleAux(marker: var TIntSet, typ: PType, startId: int): bool -proc canFormAcycleNode(marker: var TIntSet, n: PNode, startId: int): bool = - result = false - if n != nil: - result = canFormAcycleAux(marker, n.typ, startId) - if not result: - case n.kind - of nkNone..nkNilLit: - nil - else: - for i in countup(0, sonsLen(n) - 1): - result = canFormAcycleNode(marker, n.sons[i], startId) - if result: return - -proc canFormAcycleAux(marker: var TIntSet, typ: PType, startId: int): bool = - var t: PType - result = false - if typ == nil: return - if tfAcyclic in typ.flags: return - t = skipTypes(typ, abstractInst) - if tfAcyclic in t.flags: return - case t.kind - of tyTuple, tyObject, tyRef, tySequence, tyArray, tyArrayConstr, tyOpenArray: - if not IntSetContainsOrIncl(marker, t.id): - for i in countup(0, sonsLen(t) - 1): - result = canFormAcycleAux(marker, t.sons[i], startId) - if result: return - if t.n != nil: result = canFormAcycleNode(marker, t.n, startId) - else: - result = t.id == startId - else: - nil - -proc canFormAcycle(typ: PType): bool = - var marker: TIntSet - IntSetInit(marker) - result = canFormAcycleAux(marker, typ, typ.id) - -proc mutateTypeAux(marker: var TIntSet, t: PType, iter: TTypeMutator, - closure: PObject): PType -proc mutateNode(marker: var TIntSet, n: PNode, iter: TTypeMutator, - closure: PObject): PNode = - result = nil - if n != nil: - result = copyNode(n) - result.typ = mutateTypeAux(marker, n.typ, iter, closure) - case n.kind - of nkNone..nkNilLit: - # a leaf - else: - for i in countup(0, sonsLen(n) - 1): - addSon(result, mutateNode(marker, n.sons[i], iter, closure)) - -proc mutateTypeAux(marker: var TIntSet, t: PType, iter: TTypeMutator, - closure: PObject): PType = - result = nil - if t == nil: return - result = iter(t, closure) - if not IntSetContainsOrIncl(marker, t.id): - for i in countup(0, sonsLen(t) - 1): - result.sons[i] = mutateTypeAux(marker, result.sons[i], iter, closure) - if (result.sons[i] == nil) and (result.kind == tyGenericInst): - assert(false) - if t.n != nil: result.n = mutateNode(marker, t.n, iter, closure) - assert(result != nil) - -proc mutateType(t: PType, iter: TTypeMutator, closure: PObject): PType = - var marker: TIntSet - IntSetInit(marker) - result = mutateTypeAux(marker, t, iter, closure) - -proc rangeToStr(n: PNode): string = - assert(n.kind == nkRange) - result = ValueToString(n.sons[0]) & ".." & ValueToString(n.sons[1]) - -proc TypeToString(typ: PType, prefer: TPreferedDesc = preferName): string = - const - typeToStr: array[TTypeKind, string] = ["None", "bool", "Char", "empty", - "Array Constructor [$1]", "nil", "expr", "stmt", "typeDesc", - "GenericInvokation", "GenericBody", "GenericInst", "GenericParam", - "distinct $1", "enum", "ordinal[$1]", "array[$1, $2]", "object", "tuple", - "set[$1]", "range[$1]", "ptr ", "ref ", "var ", "seq[$1]", "proc", - "pointer", "OpenArray[$1]", "string", "CString", "Forward", "int", "int8", - "int16", "int32", "int64", "float", "float32", "float64", "float128"] - var t = typ - result = "" - if t == nil: return - if (prefer == preferName) and (t.sym != nil): - return t.sym.Name.s - case t.Kind - of tyGenericBody, tyGenericInst, tyGenericInvokation: - result = typeToString(t.sons[0]) & '[' - for i in countup(1, sonsLen(t) -1 -ord(t.kind != tyGenericInvokation)): - if i > 1: add(result, ", ") - add(result, typeToString(t.sons[i])) - add(result, ']') - of tyArray: - if t.sons[0].kind == tyRange: - result = "array[" & rangeToStr(t.sons[0].n) & ", " & - typeToString(t.sons[1]) & ']' - else: - result = "array[" & typeToString(t.sons[0]) & ", " & - typeToString(t.sons[1]) & ']' - of tyArrayConstr: - result = "Array constructor[" & rangeToStr(t.sons[0].n) & ", " & - typeToString(t.sons[1]) & ']' - of tySequence: - result = "seq[" & typeToString(t.sons[0]) & ']' - of tyOrdinal: - result = "ordinal[" & typeToString(t.sons[0]) & ']' - of tySet: - result = "set[" & typeToString(t.sons[0]) & ']' - of tyOpenArray: - result = "openarray[" & typeToString(t.sons[0]) & ']' - of tyDistinct: - result = "distinct " & typeToString(t.sons[0], preferName) - of tyTuple: - # we iterate over t.sons here, because t.n may be nil - result = "tuple[" - if t.n != nil: - assert(sonsLen(t.n) == sonsLen(t)) - for i in countup(0, sonsLen(t.n) - 1): - assert(t.n.sons[i].kind == nkSym) - add(result, t.n.sons[i].sym.name.s & ": " & typeToString(t.sons[i])) - if i < sonsLen(t.n) - 1: add(result, ", ") - else: - for i in countup(0, sonsLen(t) - 1): - add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") - add(result, ']') - of tyPtr, tyRef, tyVar: - result = typeToStr[t.kind] & typeToString(t.sons[0]) - of tyRange: - result = "range " & rangeToStr(t.n) - of tyProc: - result = "proc (" - for i in countup(1, sonsLen(t) - 1): - add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") - add(result, ')') - if t.sons[0] != nil: add(result, ": " & TypeToString(t.sons[0])) - var prag: string - if t.callConv != ccDefault: prag = CallingConvToStr[t.callConv] - else: prag = "" - if tfNoSideEffect in t.flags: - addSep(prag) - add(prag, "noSideEffect") - if len(prag) != 0: add(result, "{." & prag & ".}") - else: - result = typeToStr[t.kind] - -proc resultType(t: PType): PType = - assert(t.kind == tyProc) - result = t.sons[0] # nil is allowed - -proc base(t: PType): PType = - result = t.sons[0] - -proc firstOrd(t: PType): biggestInt = - case t.kind - of tyBool, tyChar, tySequence, tyOpenArray, tyString: - result = 0 - of tySet, tyVar: - result = firstOrd(t.sons[0]) - of tyArray, tyArrayConstr: - result = firstOrd(t.sons[0]) - of tyRange: - assert(t.n != nil) # range directly given: - assert(t.n.kind == nkRange) - result = getOrdValue(t.n.sons[0]) - of tyInt: - if platform.intSize == 4: result = - (2147483646) - 2 - else: result = 0x8000000000000000'i64 - of tyInt8: - result = - 128 - of tyInt16: - result = - 32768 - of tyInt32: - result = - 2147483646 - 2 - of tyInt64: - result = 0x8000000000000000'i64 - of tyEnum: - # if basetype <> nil then return firstOrd of basetype - if (sonsLen(t) > 0) and (t.sons[0] != nil): - result = firstOrd(t.sons[0]) - else: - assert(t.n.sons[0].kind == nkSym) - result = t.n.sons[0].sym.position - of tyGenericInst, tyDistinct: - result = firstOrd(lastSon(t)) - else: - InternalError("invalid kind for first(" & $t.kind & ')') - result = 0 - -proc lastOrd(t: PType): biggestInt = - case t.kind - of tyBool: - result = 1 - of tyChar: - result = 255 - of tySet, tyVar: - result = lastOrd(t.sons[0]) - of tyArray, tyArrayConstr: - result = lastOrd(t.sons[0]) - of tyRange: - assert(t.n != nil) # range directly given: - assert(t.n.kind == nkRange) - result = getOrdValue(t.n.sons[1]) - of tyInt: - if platform.intSize == 4: result = 0x7FFFFFFF - else: result = 0x7FFFFFFFFFFFFFFF'i64 - of tyInt8: - result = 0x0000007F - of tyInt16: - result = 0x00007FFF - of tyInt32: - result = 0x7FFFFFFF - of tyInt64: - result = 0x7FFFFFFFFFFFFFFF'i64 - of tyEnum: - assert(t.n.sons[sonsLen(t.n) - 1].kind == nkSym) - result = t.n.sons[sonsLen(t.n) - 1].sym.position - of tyGenericInst, tyDistinct: - result = firstOrd(lastSon(t)) - else: - InternalError("invalid kind for last(" & $t.kind & ')') - result = 0 - -proc lengthOrd(t: PType): biggestInt = - case t.kind - of tyInt64, tyInt32, tyInt: result = lastOrd(t) - of tyDistinct: result = lengthOrd(t.sons[0]) - else: result = lastOrd(t) - firstOrd(t) + 1 - -proc equalParam(a, b: PSym): TParamsEquality = - if SameTypeOrNil(a.typ, b.typ): - if (a.ast == b.ast): - result = paramsEqual - elif (a.ast != nil) and (b.ast != nil): - if ExprStructuralEquivalent(a.ast, b.ast): result = paramsEqual - else: result = paramsIncompatible - elif (a.ast != nil): - result = paramsEqual - elif (b.ast != nil): - result = paramsIncompatible - else: - result = paramsNotEqual - -proc equalParams(a, b: PNode): TParamsEquality = - var - length: int - m, n: PSym - result = paramsEqual - length = sonsLen(a) - if length != sonsLen(b): - result = paramsNotEqual - else: - for i in countup(1, length - 1): - m = a.sons[i].sym - n = b.sons[i].sym - assert((m.kind == skParam) and (n.kind == skParam)) - case equalParam(m, n) - of paramsNotEqual: - return paramsNotEqual - of paramsEqual: - nil - of paramsIncompatible: - result = paramsIncompatible - if (m.name.id != n.name.id): - # BUGFIX - return paramsNotEqual # paramsIncompatible; - # continue traversal! If not equal, we can return immediately; else - # it stays incompatible - if not SameTypeOrNil(a.sons[0].typ, b.sons[0].typ): - if (a.sons[0].typ == nil) or (b.sons[0].typ == nil): - result = paramsNotEqual # one proc has a result, the other not is OK - else: - result = paramsIncompatible # overloading by different - # result types does not work - -proc SameTypeOrNil(a, b: PType): bool = - if a == b: - result = true - else: - if (a == nil) or (b == nil): result = false - else: result = SameType(a, b) - -proc SameLiteral(x, y: PNode): bool = - result = false - if x.kind == y.kind: - case x.kind - of nkCharLit..nkInt64Lit: result = x.intVal == y.intVal - of nkFloatLit..nkFloat64Lit: result = x.floatVal == y.floatVal - of nkNilLit: result = true - else: assert(false) - -proc SameRanges(a, b: PNode): bool = - result = SameLiteral(a.sons[0], b.sons[0]) and - SameLiteral(a.sons[1], b.sons[1]) - -proc sameTuple(a, b: PType, DistinctOf: bool): bool = - # two tuples are equivalent iff the names, types and positions are the same; - # however, both types may not have any field names (t.n may be nil) which - # complicates the matter a bit. - var x, y: PSym - if sonsLen(a) == sonsLen(b): - result = true - for i in countup(0, sonsLen(a) - 1): - if DistinctOf: result = equalOrDistinctOf(a.sons[i], b.sons[i]) - else: result = SameType(a.sons[i], b.sons[i]) - if not result: return - if (a.n != nil) and (b.n != nil): - for i in countup(0, sonsLen(a.n) - 1): - # check field names: - if a.n.sons[i].kind != nkSym: InternalError(a.n.info, "sameTuple") - if b.n.sons[i].kind != nkSym: InternalError(b.n.info, "sameTuple") - x = a.n.sons[i].sym - y = b.n.sons[i].sym - result = x.name.id == y.name.id - if not result: break - else: - result = false - -proc SameType(x, y: PType): bool = - if x == y: - return true - var a = skipTypes(x, {tyGenericInst}) - var b = skipTypes(y, {tyGenericInst}) - assert(a != nil) - assert(b != nil) - if a.kind != b.kind: - return false - case a.Kind - of tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, - tyInt..tyFloat128, tyExpr, tyStmt, tyTypeDesc: - result = true - of tyEnum, tyForward, tyObject, tyDistinct: - result = (a.id == b.id) - of tyTuple: - result = sameTuple(a, b, false) - of tyGenericInst: - result = sameType(lastSon(a), lastSon(b)) - of tyGenericParam, tyGenericInvokation, tyGenericBody, tySequence, tyOrdinal, - tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyArrayConstr, tyArray, tyProc: - if sonsLen(a) == sonsLen(b): - result = true - for i in countup(0, sonsLen(a) - 1): - result = SameTypeOrNil(a.sons[i], b.sons[i]) # BUGFIX - if not result: return - if result and (a.kind == tyProc): - result = a.callConv == b.callConv # BUGFIX - else: - result = false - of tyRange: - result = SameTypeOrNil(a.sons[0], b.sons[0]) and - SameValue(a.n.sons[0], b.n.sons[0]) and - SameValue(a.n.sons[1], b.n.sons[1]) - of tyNone: - result = false - -proc equalOrDistinctOf(x, y: PType): bool = - if x == y: - return true - if (x == nil) or (y == nil): - return false - var a = skipTypes(x, {tyGenericInst}) - var b = skipTypes(y, {tyGenericInst}) - assert(a != nil) - assert(b != nil) - if a.kind != b.kind: - if a.kind == tyDistinct: a = a.sons[0] - if a.kind != b.kind: - return false - case a.Kind - of tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, - tyInt..tyFloat128, tyExpr, tyStmt, tyTypeDesc: - result = true - of tyEnum, tyForward, tyObject, tyDistinct: - result = (a.id == b.id) - of tyTuple: - result = sameTuple(a, b, true) - of tyGenericInst: - result = equalOrDistinctOf(lastSon(a), lastSon(b)) - of tyGenericParam, tyGenericInvokation, tyGenericBody, tySequence, tyOrdinal, - tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyArrayConstr, tyArray, tyProc: - if sonsLen(a) == sonsLen(b): - result = true - for i in countup(0, sonsLen(a) - 1): - result = equalOrDistinctOf(a.sons[i], b.sons[i]) - if not result: return - if result and (a.kind == tyProc): result = a.callConv == b.callConv - else: - result = false - of tyRange: - result = equalOrDistinctOf(a.sons[0], b.sons[0]) and - SameValue(a.n.sons[0], b.n.sons[0]) and - SameValue(a.n.sons[1], b.n.sons[1]) - of tyNone: - result = false - -proc typeAllowedAux(marker: var TIntSet, typ: PType, kind: TSymKind): bool -proc typeAllowedNode(marker: var TIntSet, n: PNode, kind: TSymKind): bool = - result = true - if n != nil: - result = typeAllowedAux(marker, n.typ, kind) - #if not result: debug(n.typ) - if result: - case n.kind - of nkNone..nkNilLit: - nil - else: - for i in countup(0, sonsLen(n) - 1): - result = typeAllowedNode(marker, n.sons[i], kind) - if not result: return - -proc typeAllowedAux(marker: var TIntSet, typ: PType, kind: TSymKind): bool = - var t, t2: PType - assert(kind in {skVar, skConst, skParam}) - result = true - if typ == nil: - return # if we have already checked the type, return true, because we stop the - # evaluation if something is wrong: - if IntSetContainsOrIncl(marker, typ.id): return - t = skipTypes(typ, abstractInst) - case t.kind - of tyVar: - t2 = skipTypes(t.sons[0], abstractInst) - case t2.kind - of tyVar: - result = false # ``var var`` is always an invalid type: - of tyOpenArray: - result = (kind == skParam) and typeAllowedAux(marker, t2, kind) - else: result = (kind != skConst) and typeAllowedAux(marker, t2, kind) - of tyProc: - for i in countup(1, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], skParam) - if not result: return - if t.sons[0] != nil: result = typeAllowedAux(marker, t.sons[0], skVar) - of tyExpr, tyStmt, tyTypeDesc: - result = true - of tyGenericBody, tyGenericParam, tyForward, tyNone, tyGenericInvokation: - result = false #InternalError('shit found'); - of tyEmpty, tyNil: - result = kind == skConst - of tyString, tyBool, tyChar, tyEnum, tyInt..tyFloat128, tyCString, tyPointer: - result = true - of tyOrdinal: - result = kind == skParam - of tyGenericInst, tyDistinct: - result = typeAllowedAux(marker, lastSon(t), kind) - of tyRange: - result = skipTypes(t.sons[0], abstractInst).kind in - {tyChar, tyEnum, tyInt..tyFloat128} - of tyOpenArray: - result = (kind == skParam) and typeAllowedAux(marker, t.sons[0], skVar) - of tySequence: - result = (kind != skConst) and typeAllowedAux(marker, t.sons[0], skVar) or - (t.sons[0].kind == tyEmpty) - of tyArray: - result = typeAllowedAux(marker, t.sons[1], skVar) - of tyPtr, tyRef: - result = typeAllowedAux(marker, t.sons[0], skVar) - of tyArrayConstr, tyTuple, tySet: - for i in countup(0, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], kind) - if not result: return - of tyObject: - for i in countup(0, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], skVar) - if not result: return - if t.n != nil: result = typeAllowedNode(marker, t.n, skVar) - -proc typeAllowed(t: PType, kind: TSymKind): bool = - var marker: TIntSet - IntSetInit(marker) - result = typeAllowedAux(marker, t, kind) - -proc align(address, alignment: biggestInt): biggestInt = - result = (address + (alignment - 1)) and not (alignment - 1) - -proc computeSizeAux(typ: PType, a: var biggestInt): biggestInt -proc computeRecSizeAux(n: PNode, a, currOffset: var biggestInt): biggestInt = - var maxAlign, maxSize, b, res: biggestInt - case n.kind - of nkRecCase: - assert(n.sons[0].kind == nkSym) - result = computeRecSizeAux(n.sons[0], a, currOffset) - maxSize = 0 - maxAlign = 1 - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - res = computeRecSizeAux(lastSon(n.sons[i]), b, currOffset) - if res < 0: - return res - maxSize = max(maxSize, res) - maxAlign = max(maxAlign, b) - else: internalError("computeRecSizeAux(record case branch)") - currOffset = align(currOffset, maxAlign) + maxSize - result = align(result, maxAlign) + maxSize - a = maxAlign - of nkRecList: - result = 0 - maxAlign = 1 - for i in countup(0, sonsLen(n) - 1): - res = computeRecSizeAux(n.sons[i], b, currOffset) - if res < 0: - return res - currOffset = align(currOffset, b) + res - result = align(result, b) + res - if b > maxAlign: maxAlign = b - a = maxAlign - of nkSym: - result = computeSizeAux(n.sym.typ, a) - n.sym.offset = int(currOffset) - else: - InternalError("computeRecSizeAux()") - a = 1 - result = - 1 - -proc computeSizeAux(typ: PType, a: var biggestInt): biggestInt = - var res, maxAlign, length, currOffset: biggestInt - if typ.size == - 2: - # we are already computing the size of the type - # --> illegal recursion in type - return - 2 - if typ.size >= 0: - # size already computed - result = typ.size - a = typ.align - return - typ.size = - 2 # mark as being computed - case typ.kind - of tyInt: - result = IntSize - a = result - of tyInt8, tyBool, tyChar: - result = 1 - a = result - of tyInt16: - result = 2 - a = result - of tyInt32, tyFloat32: - result = 4 - a = result - of tyInt64, tyFloat64: - result = 8 - a = result - of tyFloat: - result = floatSize - a = result - of tyProc: - if typ.callConv == ccClosure: result = 2 * ptrSize - else: result = ptrSize - a = ptrSize - of tyNil, tyCString, tyString, tySequence, tyPtr, tyRef, tyOpenArray: - result = ptrSize - a = result - of tyArray, tyArrayConstr: - result = lengthOrd(typ.sons[0]) * computeSizeAux(typ.sons[1], a) - of tyEnum: - if firstOrd(typ) < 0: - result = 4 # use signed int32 - else: - length = lastOrd(typ) # BUGFIX: use lastOrd! - if length + 1 < `shl`(1, 8): result = 1 - elif length + 1 < `shl`(1, 16): result = 2 - elif length + 1 < `shl`(biggestInt(1), 32): result = 4 - else: result = 8 - a = result - of tySet: - length = lengthOrd(typ.sons[0]) - if length <= 8: - result = 1 - elif length <= 16: - result = 2 - elif length <= 32: - result = 4 - elif length <= 64: - result = 8 - elif align(length, 8) mod 8 == 0: - result = align(length, 8) div 8 - else: - result = align(length, 8) div 8 + 1 # BUGFIX! - a = result - of tyRange: - result = computeSizeAux(typ.sons[0], a) - of tyTuple: - result = 0 - maxAlign = 1 - for i in countup(0, sonsLen(typ) - 1): - res = computeSizeAux(typ.sons[i], a) - if res < 0: - return res - maxAlign = max(maxAlign, a) - result = align(result, a) + res - result = align(result, maxAlign) - a = maxAlign - of tyObject: - if typ.sons[0] != nil: - result = computeSizeAux(typ.sons[0], a) - if result < 0: return - maxAlign = a - elif isObjectWithTypeFieldPredicate(typ): - result = intSize - maxAlign = result - else: - result = 0 - maxAlign = 1 - currOffset = result - result = computeRecSizeAux(typ.n, a, currOffset) - if result < 0: return - if a < maxAlign: a = maxAlign - result = align(result, a) - of tyGenericInst, tyDistinct, tyGenericBody: - result = computeSizeAux(lastSon(typ), a) - else: - #internalError('computeSizeAux()'); - result = - 1 - typ.size = result - typ.align = int(a) - -proc computeSize(typ: PType): biggestInt = - var a: biggestInt = 1 - result = computeSizeAux(typ, a) - -proc getSize(typ: PType): biggestInt = - result = computeSize(typ) - if result < 0: InternalError("getSize(" & $typ.kind & ')') - diff --git a/rod/wordrecg.nim b/rod/wordrecg.nim deleted file mode 100755 index 8376fa01b..000000000 --- a/rod/wordrecg.nim +++ /dev/null @@ -1,129 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2011 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module contains a word recognizer, i.e. a simple -# procedure which maps special words to an enumeration. -# It is primarily needed because Pascal's case statement -# does not support strings. Without this the code would -# be slow and unreadable. - -import - nhashes, strutils, idents - -# Keywords must be kept sorted and within a range - -type - TSpecialWord* = enum - wInvalid, - - wAddr, wAnd, wAs, wAsm, wAtomic, - wBind, wBlock, wBreak, wCase, wCast, wConst, - wContinue, wConverter, wDiscard, wDistinct, wDiv, wElif, wElse, wEnd, wEnum, - wExcept, wFinally, wFor, wFrom, wGeneric, wIf, wImplies, wImport, wIn, - wInclude, wIs, wIsnot, wIterator, wLambda, wLet, - wMacro, wMethod, wMod, wNil, - wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, wRaise, wRef, wReturn, - wShl, wShr, wTemplate, wTry, wTuple, wType, wVar, wWhen, wWhile, wWith, - wWithout, wXor, wYield, - - wColon, wEquals, wDot, wDotDot, wHat, wStar, wMinus, - wMagic, wTypeCheck, wFinal, wProfiler, wObjChecks, wImportc, wExportc, - wExtern, - wAlign, wNodecl, wPure, wVolatile, wRegister, wSideeffect, wHeader, - wNosideeffect, wNoreturn, wMerge, wLib, wDynlib, wCompilerproc, wProcVar, - wFatal, wError, wWarning, wHint, wLine, wPush, wPop, wDefine, wUndef, - wLinedir, wStacktrace, wLinetrace, wParallelBuild, wLink, wCompile, - wLinksys, wDeprecated, wVarargs, wByref, wCallconv, wBreakpoint, wDebugger, - wNimcall, wStdcall, wCdecl, wSafecall, wSyscall, wInline, wNoInline, - wFastcall, wClosure, wNoconv, wOn, wOff, wChecks, wRangechecks, - wBoundchecks, wOverflowchecks, wNilchecks, - wFloatchecks, wNanChecks, wInfChecks, - wAssertions, wWarnings, wW, - wHints, wOptimization, wSpeed, wSize, wNone, wPath, wP, wD, wU, wDebuginfo, - wCompileonly, wNolinking, wForcebuild, wF, wDeadCodeElim, wSafecode, - wPragma, - wCompileTime, wGc, wRefc, wBoehm, wA, wOpt, wO, wApp, wConsole, wGui, - wPassc, wT, wPassl, wL, wListcmd, wGendoc, wGenmapping, wOs, wCpu, - wGenerate, wG, wC, wCpp, wBorrow, wRun, wR, wVerbosity, wV, wHelp, wH, - wSymbolFiles, wFieldChecks, wX, wVersion, wAdvanced, wSkipcfg, wSkipProjCfg, - wCc, wGenscript, wCheckPoint, wCheckPoints, wNoMain, wSubsChar, - wAcyclic, wShallow, wUnroll, wLinearScanEnd, - wIndex, - wWrite, wPutEnv, wPrependEnv, wAppendEnv, wThreadVar, wEmit, wThreads, - wRecursivePath, - wStdout, - wIdeTools, wSuggest, wTrack, wDef, wContext - - TSpecialWords* = set[TSpecialWord] - -const - oprLow* = ord(wColon) - oprHigh* = ord(wHat) - specialWords*: array[low(TSpecialWord)..high(TSpecialWord), string] = ["", - - "addr", "and", "as", "asm", "atomic", - "bind", "block", "break", "case", "cast", - "const", "continue", "converter", "discard", "distinct", "div", "elif", - "else", "end", "enum", "except", "finally", "for", "from", "generic", "if", - "implies", "import", "in", "include", "is", "isnot", "iterator", - "lambda", "let", - "macro", "method", "mod", "nil", "not", "notin", "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", "shl", "shr", "template", - "try", "tuple", "type", "var", "when", "while", "with", "without", "xor", - "yield", - - ":", "=", ".", "..", "^", "*", "-", - "magic", "typecheck", "final", "profiler", "objchecks", "importc", - "exportc", "extern", - "align", "nodecl", "pure", "volatile", "register", "sideeffect", - "header", "nosideeffect", "noreturn", "merge", "lib", "dynlib", - "compilerproc", "procvar", "fatal", "error", "warning", "hint", "line", - "push", "pop", "define", "undef", "linedir", "stacktrace", "linetrace", - "parallelbuild", "link", "compile", "linksys", "deprecated", "varargs", - "byref", "callconv", "breakpoint", "debugger", "nimcall", "stdcall", - "cdecl", "safecall", "syscall", "inline", "noinline", "fastcall", "closure", - "noconv", "on", "off", "checks", "rangechecks", "boundchecks", - "overflowchecks", "nilchecks", - "floatchecks", "nanchecks", "infchecks", - - "assertions", "warnings", "w", "hints", - "optimization", "speed", "size", "none", "path", "p", "d", "u", "debuginfo", - "compileonly", "nolinking", "forcebuild", "f", "deadcodeelim", "safecode", - "pragma", - "compiletime", "gc", "refc", "boehm", "a", "opt", "o", "app", "console", - "gui", "passc", "t", "passl", "l", "listcmd", "gendoc", "genmapping", "os", - "cpu", "generate", "g", "c", "cpp", "borrow", "run", "r", "verbosity", "v", - "help", "h", "symbolfiles", "fieldchecks", "x", "version", "advanced", - "skipcfg", "skipprojcfg", "cc", "genscript", "checkpoint", "checkpoints", - "nomain", "subschar", "acyclic", "shallow", "unroll", "linearscanend", - "index", - "write", "putenv", "prependenv", "appendenv", "threadvar", "emit", - "threads", "recursivepath", - "stdout", - "idetools", "suggest", "track", "def", "context"] - -proc findStr*(a: openarray[string], s: string): int = - for i in countup(low(a), high(a)): - if cmpIgnoreStyle(a[i], s) == 0: - return i - result = - 1 - -proc whichKeyword*(id: PIdent): TSpecialWord = - if id.id < 0: result = wInvalid - else: result = TSpecialWord(id.id) - -proc whichKeyword*(id: String): TSpecialWord = - result = whichKeyword(getIdent(id)) - -proc initSpecials() = - # initialize the keywords: - for s in countup(succ(low(specialWords)), high(specialWords)): - getIdent(specialWords[s], getNormalizedHash(specialWords[s])).id = ord(s) - -initSpecials() |