letm= qualNameOfFile.Range

lettcImplEnv= Tc.AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType

if hadSigthen tcState.tcsTcSigEnv

else Tc.AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType

match prefixPathOptwith

| None-> tcImplEnv

| Some prefixPath->

TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath

| Some prefixPath-> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath

|_-> tcImplEnv

match prefixPathOptwith

| Some prefixPathwhennot hadSig-> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath

|_-> tcSigEnv

letallImplementedSigModulTyp= combineModuleOrNamespaceTypeList[] m[implFileSigType; allImplementedSigModulTyp]

if verbosethen dprintf"done TypecheckOneInputEventually...\n"

lettopSigsAndImpls= RootSigsAndImpls(rootSigs,rootImpls,allSigModulTyp,allImplementedSigModulTyp)

letres=(topAttrs,[implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv,topSigsAndImpls,ccuType)

letres=(topAttrs,[implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv,topSigsAndImpls,ccuType)

return res}

return(tcEnvAtEnd,topAttrs,mimpls),

||> List.foldBack (fun id (cpath, mexpr) -> (parentCompPath cpath, wrapModuleOrNamespaceExprInNamespace id (parentCompPath cpath) mexpr))

|> snd

let ImplicitlyOpenOwnNamespace tcSinkg amap scopem enclosingNamespacePath env =

let ImplicitlyOpenOwnNamespace tcSink(g:TcGlobals) amap scopem(enclosingNamespacePath: Ident list) env =

if isNil enclosingNamespacePath then

env

else

// For F# interactive, skip "FSI_0002" prefixes when determining the path to open implicitly

let enclosingNamespacePathToOpen =

match enclosingNamespacePath with

| p::rest when g.isInteractive &&

p.idText.StartsWith(FsiDynamicModulePrefix,System.StringComparison.Ordinal) &&

p.idText.[FsiDynamicModulePrefix.Length..] |> String.forall System.Char.IsDigit &&

rest.Length > 0 -> rest

| rest -> rest

let ad = env.eAccessRights

match ResolveLongIndentAsModuleOrNamespace amap scopem OpenQualified env.eNameResEnv adenclosingNamespacePath with

match ResolveLongIndentAsModuleOrNamespace amap scopem OpenQualified env.eNameResEnv adenclosingNamespacePathToOpen with

| Result modrefs -> OpenModulesOrNamespaces tcSink g amap scopem false env (List.map p23 modrefs)

| Exception _ -> env

| (".ctor" | ".cctor") as r -> errorR(Error(FSComp.SR.tcInvalidMemberNameCtor(),id.idRange)); r

| r -> r

| MemberKind.PropertyGetSet -> error(InternalError(FSComp.SR.tcMemberKindPropertyGetSetNotExpected(),id.idRange))

| MemberKind.PropertyGet -> "get_"^id.idText

| MemberKind.PropertySet -> "set_"^id.idText

| MemberKind.PropertyGet -> "get_" +id.idText

| MemberKind.PropertySet -> "set_" +id.idText

/// ValMemberInfoTransient(memberInfo,logicalName,compiledName)

type ValMemberInfoTransient = ValMemberInfoTransient of ValMemberInfo * string * string

let compiledName =

if isExtrinsic then

let tname = tcref.LogicalName

let text = tname^"."^logicalName

let text = tname +"." +logicalName

let text = if memberFlags.MemberKind <> MemberKind.Constructor && memberFlags.MemberKind <> MemberKind.ClassConstructor && not memberFlags.IsInstance then text^".Static" else text

let text = if memberFlags.IsOverrideOrExplicitImpl then text^".Override" else text

text

thisTy --> (delTy --> cenv.g.unit_ty)

else

(delTy --> cenv.g.unit_ty)

yield reallyGenerateOneMember(ident("add_"^id.idText,id.idRange),valSynInfo,ty,memberFlags)

yield reallyGenerateOneMember(ident("remove_"^id.idText,id.idRange),valSynInfo,ty,memberFlags) ]

yield reallyGenerateOneMember(ident("add_" +id.idText,id.idRange),valSynInfo,ty,memberFlags)

yield reallyGenerateOneMember(ident("remove_" +id.idText,id.idRange),valSynInfo,ty,memberFlags) ]

// This is a little awkward since it would be nice if this was

// uniform with the process where we give names to other (more complex)

// patterns used in argument position, e.g. "let f (D(x)) = ..."

let id = ident("unitVar"^string takenNames.Count,m)

let id = ident("unitVar" +string takenNames.Count,m)

UnifyTypes cenv env m ty cenv.g.unit_ty

let _,names,takenNames = TcPatBindingName cenv env id ty false None None (ValInline.Optional,permitInferTypars,noArgOrRetAttribs,false,None,true) (names,takenNames)

[id.idText],(tpenv,names,takenNames)

| SynConst.UserNum (s,suffix) ->

let expr =

let modName = ("NumericLiteral"^suffix)

let modName = ("NumericLiteral" +suffix)

let ad = env.eAccessRights

match ResolveLongIndentAsModuleOrNamespace cenv.amap m OpenQualified env.eNameResEnv ad [ident (modName,m)] with

| Result []

// This is where the constructor expects arguments but is not applied to arguments, hence build a lambda

nargtys,

(fun () ->

let vs,args = argtys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg"^string i) ty) |> List.unzip

let vs,args = argtys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" +string i) ty) |> List.unzip

let constrApp = mkConstrApp mItem args

let lam = mkMultiLambda mItem vs (constrApp, tyOfExpr cenv.g constrApp)

lam)

let argTys = argTypars |> List.map mkTyparTy

let retTy = mkTyparTy retTypar

let vs,ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg"^string i) ty) |> List.unzip

let vs,ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" +string i) ty) |> List.unzip

let memberFlags = StaticMemberFlags MemberKind.Member

let logicalCompiledName = ComputeLogicalName id memberFlags

let args = match args with (UnionCaseFields args) -> args | _ -> error(Error(FSComp.SR.tcExplicitTypeSpecificationCannotBeUsedForExceptionConstructors(),m))

let ad = env.eAccessRights

let args' = List.mapi (fun i fdef -> TcRecdUnionAndEnumDeclarations.TcAnonFieldDecl cenv env parent tpenv ("Data"^string i) fdef) args

let args' = List.mapi (fun i fdef -> TcRecdUnionAndEnumDeclarations.TcAnonFieldDecl cenv env parent tpenv ("Data" +string i) fdef) args

TcRecdUnionAndEnumDeclarations.ValidateFieldNames(args, args')

if not (String.isUpper id.idText) then errorR(NotUpperCaseConstructor(m))

let vis,cpath = ComputeAccessAndCompPath env None m vis parent

CheckNamespaceModuleOrTypeName cenv.g id

let enclosingNamespacePath = if isModule then fst (List.frontAndBack longId) else longId

let defs =

if isModule then

[SynModuleSigDecl.NestedModule(ComponentInfo(attribs,[], [],[snd(List.frontAndBack longId)],xml,false,vis,m),defs,m)]

else

defs

let envinner = LocateEnv cenv.topCcu env enclosingNamespacePath

let envinner = ImplicitlyOpenOwnNamespace cenv.tcSink cenv.g cenv.amap m enclosingNamespacePath envinner

let! envAtEnd = TcSignatureElements cenv ParentNone m.EndRange envinner xml defs

| SynModuleDecl.NamespaceFragment(SynModuleOrNamespace(longId,isModule,defs,xml,attribs,vis,m)) ->

if !progress then dprintn ("Typecheck implementation "^textOfLid longId)

if !progress then dprintn ("Typecheck implementation " +textOfLid longId)

let endm = m.EndRange

do for id in longId do

typeDU= A| B

typeB={ Prop:DU}

typeDU= A| B

typeB={ Prop:DU}

typeB={ Prop:DU}

#load"a1.fs"

#load"a2.fs"

letos= System.IO.File.CreateText"test.ok"in os.Close()

#load"b1.fs"

#load"b2.fsi""b2.fs"

letos= System.IO.File.CreateText"test.ok"in os.Close()

"%FSI%"%fsi_flags% --maxerrors:1< test1.ml

ifNOTEXIST test.okgoto SetError

ifexist test.ok (del /f /q test.ok)

"%FSI%"%fsi_flags% --maxerrors:1 load1.fsx

ifNOTEXIST test.okgoto SetError

ifexist test.ok (del /f /q test.ok)

"%FSI%"%fsi_flags% --maxerrors:1 load2.fsx

ifNOTEXIST test.okgoto SetError

"%FSC%" load1.fsx

@if ERRORLEVEL1goto Error

"%FSC%" load2.fsx

@if ERRORLEVEL1goto Error

:Ok

echo Ran fsharp%~f0 ok.