WIP: Syntax for creating ImmutableArrays

src/Compiler/Checking/CheckBasics.fs

@@ -326,7 +326,7 @@ type TcFileState =
       TcSequenceExpressionEntry: TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv
 
       // forward call
-      TcArrayOrListComputedExpression: TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv
+      TcArrayOrListComputedExpression: TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> CollectionType * SynExpr -> range -> Expr * UnscopedTyparEnv
 
       // forward call
       TcComputationExpression: TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> range * Expr * TType * SynExpr -> Expr * UnscopedTyparEnv

src/Compiler/Checking/CheckBasics.fsi

@@ -304,7 +304,7 @@ type TcFileState =
             -> TcEnv
             -> OverallTy
             -> UnscopedTyparEnv
-            -> bool * SynExpr
+            -> CollectionType * SynExpr
             -> range
             -> Expr * UnscopedTyparEnv
 
@@ -332,6 +332,6 @@ type TcFileState =
         tcPat: (WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv) *
         tcSimplePats: (TcFileState -> bool -> CheckConstraints -> TType -> TcEnv -> TcPatLinearEnv -> SynSimplePats -> string list * TcPatLinearEnv) *
         tcSequenceExpressionEntry: (TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv) *
-        tcArrayOrListSequenceExpression: (TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv) *
+        tcArrayOrListSequenceExpression: (TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> CollectionType * SynExpr -> range -> Expr * UnscopedTyparEnv) *
         tcComputationExpression: (TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> range * Expr * TType * SynExpr -> Expr * UnscopedTyparEnv) ->
             TcFileState

src/Compiler/Checking/CheckComputationExpressions.fs

@@ -2218,18 +2218,20 @@ let TcSequenceExpressionEntry (cenv: cenv) env (overallTy: OverallTy) tpenv (has
 
     TcSequenceExpression cenv env tpenv comp overallTy m
 
-let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (isArray, comp) m  =
+let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (cType: CollectionType, comp) m  =
     let g = cenv.g
 
     // The syntax '[ n .. m ]' and '[ n .. step .. m ]' is not really part of array or list syntax.
     // It could be in the future, e.g. '[ 1; 2..30; 400 ]'
     //
     // The elaborated form of '[ n .. m ]' is 'List.ofSeq (seq (op_Range n m))' and this shouldn't change
+    let mkType =
+        match cType with CollectionType.Array -> mkArrayType | CollectionType.List -> mkListTy | CollectionType.ImmutableArray -> mkBlockType
     match RewriteRangeExpr comp with
     | Some replacementExpr -> 
         let genCollElemTy = NewInferenceType g
 
-        let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy
+        let genCollTy = mkType cenv.g genCollElemTy
 
         UnifyTypes cenv env m overallTy.Commit genCollTy
 
@@ -2248,10 +2250,13 @@ let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpen
         let expr = mkCoerceExpr(expr, exprTy, expr.Range, overallTy.Commit)
 
         let expr = 
-            if isArray then 
+            match cType with
+            | CollectionType.Array ->
                 mkCallSeqToArray cenv.g m genCollElemTy expr
-            else 
+            | CollectionType.List ->
                 mkCallSeqToList cenv.g m genCollElemTy expr
+            | CollectionType.ImmutableArray ->
+                mkCallSeqToBlock cenv.g m genCollElemTy expr
         expr, tpenv
 
     | None ->
@@ -2268,29 +2273,29 @@ let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpen
         | _ when validateExpressionWithIfRequiresParenthesis -> errorR(Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis(), m))
         | _ -> ()
 
-        let replacementExpr = 
-            if isArray then 
+        let replacementExpr =
+            match cType with
+            | CollectionType.Array ->
                 // This are to improve parsing/processing speed for parser tables by converting to an array blob ASAP 
                 let nelems = elems.Length 
                 if nelems > 0 && List.forall (function SynExpr.Const (SynConst.UInt16 _, _) -> true | _ -> false) elems 
                 then SynExpr.Const (SynConst.UInt16s (Array.ofList (List.map (function SynExpr.Const (SynConst.UInt16 x, _) -> x | _ -> failwith "unreachable") elems)), m)
                 elif nelems > 0 && List.forall (function SynExpr.Const (SynConst.Byte _, _) -> true | _ -> false) elems 
                 then SynExpr.Const (SynConst.Bytes (Array.ofList (List.map (function SynExpr.Const (SynConst.Byte x, _) -> x | _ -> failwith "unreachable") elems), SynByteStringKind.Regular, m), m)
-                else SynExpr.ArrayOrList (isArray, elems, m)
-            else
-                if cenv.g.langVersion.SupportsFeature(LanguageFeature.ReallyLongLists) then
-                     SynExpr.ArrayOrList (isArray, elems, m)
-                 else
-                    if elems.Length > 500 then 
-                        error(Error(FSComp.SR.tcListLiteralMaxSize(), m))
-                    SynExpr.ArrayOrList (isArray, elems, m)
+                else SynExpr.ArrayOrList (cType, elems, m)
+            | CollectionType.ImmutableArray -> // NOTE: if the compiler moves internally from array to immarray then the optimization above should be moved here
+                SynExpr.ArrayOrList (cType, elems, m)
+            | CollectionType.List ->
+                if elems.Length > 500 then 
+                    error(Error(FSComp.SR.tcListLiteralMaxSize(), m))
+                SynExpr.ArrayOrList (cType, elems, m)
 
         TcExprUndelayed cenv overallTy env tpenv replacementExpr
     | _ -> 
 
       let genCollElemTy = NewInferenceType g
 
-      let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy
+      let genCollTy = mkType cenv.g genCollElemTy
 
       // Propagating type directed conversion, e.g. for 
       //     let x : seq<int64>  = [ yield 1; if true then yield 2 ]
@@ -2315,9 +2320,12 @@ let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpen
         let expr = mkCoerceExpr(expr, exprTy, expr.Range, overallTy.Commit)
 
         let expr = 
-            if isArray then 
+            match cType with
+            | CollectionType.Array ->
                 mkCallSeqToArray cenv.g m genCollElemTy expr
-            else 
+            | CollectionType.List ->
                 mkCallSeqToList cenv.g m genCollElemTy expr
+            | CollectionType.ImmutableArray ->
+                mkCallSeqToBlock cenv.g m genCollElemTy expr
 
         expr, tpenv)

src/Compiler/Checking/CheckComputationExpressions.fsi

@@ -22,7 +22,7 @@ val TcArrayOrListComputedExpression:
     env: TcEnv ->
     overallTy: OverallTy ->
     tpenv: UnscopedTyparEnv ->
-    isArray: bool * comp: SynExpr ->
+    cType: CollectionType * comp: SynExpr ->
         m: range ->
             Expr * UnscopedTyparEnv
 

src/Compiler/Checking/CheckExpressions.fs

@@ -5852,12 +5852,16 @@ and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) =
         expr, tpenv
     )
 
-and TcExprArrayOrList (cenv: cenv) overallTy env tpenv (isArray, args, m) =
+and TcExprArrayOrList (cenv: cenv) overallTy env tpenv (cType: CollectionType, args, m) =
     let g = cenv.g
 
     CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy.Commit, env.AccessRights)
     let argTy = NewInferenceType g
-    let actualTy = if isArray then mkArrayType g argTy else mkListTy g argTy
+    let actualTy =
+        match cType with
+        | CollectionType.Array -> mkArrayType g argTy
+        | CollectionType.List -> mkListTy g argTy
+        | CollectionType.ImmutableArray -> mkBlockType g argTy
 
     // Propagating type directed conversion, e.g. for 
     //     let x : seq<int64>  = [ 1; 2 ]
@@ -5874,13 +5878,30 @@ and TcExprArrayOrList (cenv: cenv) overallTy env tpenv (isArray, args, m) =
                 first <- false
                 env
             else
-                { env with eContextInfo = ContextInfo.CollectionElement (isArray, m) }
+                { env with eContextInfo = ContextInfo.CollectionElement (cType, m) }
 
         let argsR, tpenv = List.mapFold (fun tpenv (x: SynExpr) -> TcExprFlex cenv flex false argTy (getInitEnv x.Range) tpenv x) tpenv args
 
         let expr =
-            if isArray then Expr.Op (TOp.Array, [argTy], argsR, m)
-            else List.foldBack (mkCons g argTy) argsR (mkNil g m argTy)
+            match cType with
+            | CollectionType.Array ->
+                Expr.Op (TOp.Array, [argTy], argsR, m)
+            | CollectionType.List ->
+                List.foldBack (mkCons g argTy) argsR (mkNil g m argTy)
+            | CollectionType.ImmutableArray ->
+                //// TODO: the idea is to use code from builder called in LowerComputedListOrArraySeqExpr. Need to find tcVal to check whether the approach works.
+                //let infoReader = InfoReader(g, cenv.amap)
+                //let collectorTy = g.mk_BlockCollector_ty argTy
+                //let name = "AddMany"
+                //let collVal, collExpr = mkMutableCompGenLocal m "@collector" collectorTy
+                //let listCollectorTy = tyOfExpr g collExpr
+                //let addMethod = 
+                //    match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with
+                //    | [x] -> x
+                //    | _ -> error(InternalError("no " + name + " method found on Collector", m))
+                //let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args None
+                //expr
+                Expr.Op (TOp.Block, [argTy], argsR, m) // This code goes down a path that is currently not handled
         expr, tpenv
     )
 
@@ -7850,7 +7871,7 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl
                 // expr[idx1..]
                 // expr[..idx1]
                 // expr[idx1..idx2]
-                | SynExpr.ArrayOrListComputed(false, _, _) ->
+                | SynExpr.ArrayOrListComputed(CollectionType.List, _, _) ->
                     let isAdjacent = isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg
                     if isAdjacent && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot then
                         // This is the non-error path
@@ -8083,15 +8104,15 @@ and isAdjacentListExpr isSugar atomicFlag (synLeftExprOpt: SynExpr option) (synA
     not isSugar  &&
     if atomicFlag = ExprAtomicFlag.Atomic then
         match synArg with
-        | SynExpr.ArrayOrList (false, _, _)
-        | SynExpr.ArrayOrListComputed (false, _, _) -> true
+        | SynExpr.ArrayOrList (CollectionType.List, _, _)
+        | SynExpr.ArrayOrListComputed (CollectionType.List, _, _) -> true
         | _ -> false
     else
         match synLeftExprOpt with
         | Some synLeftExpr -> 
             match synArg with
-            | SynExpr.ArrayOrList (false, _, _)
-            | SynExpr.ArrayOrListComputed (false, _, _) ->
+            | SynExpr.ArrayOrList (CollectionType.List, _, _)
+            | SynExpr.ArrayOrListComputed (CollectionType.List, _, _) ->
                 synLeftExpr.Range.IsAdjacentTo synArg.Range 
             | _ -> false
         | _ -> false
@@ -8114,7 +8135,7 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg
         // atomicLeftExpr[idx] unifying as application gives a warning 
         if not isSugar then
             match synArg, atomicFlag with
-            | (SynExpr.ArrayOrList (false, _, _) | SynExpr.ArrayOrListComputed (false, _, _)), ExprAtomicFlag.Atomic ->
+            | (SynExpr.ArrayOrList (CollectionType.List, _, _) | SynExpr.ArrayOrListComputed (CollectionType.List, _, _)), ExprAtomicFlag.Atomic ->
                 if g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot then
                     informationalWarning(Error(FSComp.SR.tcHighPrecedenceFunctionApplicationToListDeprecated(), mExprAndArg))
                 elif not (g.langVersion.IsExplicitlySpecifiedAs50OrBefore()) then
@@ -8166,7 +8187,7 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg
         match synArg with
         // leftExpr[idx]
         // leftExpr[idx] <- expr2
-        | SynExpr.ArrayOrListComputed(false, IndexerArgs indexArgs, m) 
+        | SynExpr.ArrayOrListComputed(CollectionType.List, IndexerArgs indexArgs, m) 
               when 
                 isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg && 
                 g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot ->

src/Compiler/Checking/CheckPatterns.fs

@@ -336,7 +336,7 @@ and TcConstPat warnOnUpper cenv env vFlags patEnv ty synConst m =
     match synConst with
     | SynConst.Bytes (bytes, _, m) ->
         UnifyTypes cenv env m ty (mkByteArrayTy g)
-        let synReplacementExpr = SynPat.ArrayOrList (true, [ for b in bytes -> SynPat.Const(SynConst.Byte b, m) ], m)
+        let synReplacementExpr = SynPat.ArrayOrList (CollectionType.Array, [ for b in bytes -> SynPat.Const(SynConst.Byte b, m) ], m)
         TcPat warnOnUpper cenv env None vFlags patEnv ty synReplacementExpr
 
     | SynConst.UserNum _ ->
@@ -435,15 +435,17 @@ and TcPatTuple warnOnUpper cenv env vFlags patEnv ty isExplicitStruct args m =
         let phase2 _ = TPat_error m
         phase2, acc
 
-and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m =
+and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty cType args m =
     let g = cenv.g
     let argTy = NewInferenceType g
-    UnifyTypes cenv env m ty (if isArray then mkArrayType g argTy else mkListTy g argTy)
+    UnifyTypes cenv env m ty (match cType with | CollectionType.Array -> mkArrayType g argTy | CollectionType.List -> mkListTy g argTy | CollectionType.ImmutableArray -> mkBlockType g argTy)
     let argsR, acc = TcPatterns warnOnUpper cenv env vFlags patEnv (List.map (fun _ -> argTy) args) args
     let phase2 values =
         let argsR = List.map (fun f -> f values) argsR
-        if isArray then TPat_array(argsR, argTy, m)
-        else List.foldBack (mkConsListPat g argTy) argsR (mkNilListPat g m argTy)
+        match cType with
+        | CollectionType.Array -> TPat_array(argsR, argTy, m)
+        | CollectionType.List -> List.foldBack (mkConsListPat g argTy) argsR (mkNilListPat g m argTy)
+        | CollectionType.ImmutableArray -> TPat_block(argsR, argTy, m)
     phase2, acc
 
 and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =

src/Compiler/Checking/ConstraintSolver.fs

@@ -176,7 +176,7 @@ type ContextInfo =
     | TupleInRecordFields
 
     /// The type equation comes from a list or array constructor
-    | CollectionElement of bool * range
+    | CollectionElement of CollectionType * range
 
     /// The type equation comes from a return in a computation expression.
 

src/Compiler/Checking/ConstraintSolver.fsi

@@ -93,7 +93,7 @@ type ContextInfo =
     | TupleInRecordFields
 
     /// The type equation comes from a list or array constructor
-    | CollectionElement of bool * range
+    | CollectionElement of CollectionType * range
 
     /// The type equation comes from a return in a computation expression.
     | ReturnInComputationExpression

src/Compiler/Checking/PatternMatchCompilation.fs

@@ -47,6 +47,7 @@ type Pattern =
     | TPat_exnconstr of TyconRef * Pattern list * range
     | TPat_tuple of  TupInfo * Pattern list * TType list * range
     | TPat_array of  Pattern list * TType * range
+    | TPat_block of Pattern list * TType * range // so far no different logic from TPat_array - may be able to consolidate
     | TPat_recd of TyconRef * TypeInst * Pattern list * range
     | TPat_range of char * char * range
     | TPat_null of range
@@ -65,6 +66,7 @@ type Pattern =
         | TPat_exnconstr(_, _, m) -> m
         | TPat_tuple(_, _, _, m) -> m
         | TPat_array(_, _, m) -> m
+        | TPat_block(_, _, m) -> m
         | TPat_recd(_, _, _, m) -> m
         | TPat_range(_, _, m) -> m
         | TPat_null m -> m
@@ -921,6 +923,7 @@ let rec investigationPoints inpPat =
             for subPat in subPats do 
                 yield! investigationPoints subPat
         | TPat_array (subPats, _, _)
+        | TPat_block (subPats, _, _)
         | TPat_unioncase (_, _, subPats, _) ->
             yield false
             for subPat in subPats do 
@@ -944,6 +947,7 @@ let rec erasePartialPatterns inpPat =
     | TPat_tuple (tupInfo, subPats, x, m) -> TPat_tuple(tupInfo, erasePartials subPats, x, m)
     | TPat_exnconstr(x, subPats, m) -> TPat_exnconstr(x, erasePartials subPats, m)
     | TPat_array (subPats, x, m) -> TPat_array (erasePartials subPats, x, m)
+    | TPat_block (subPats, x, m) -> TPat_block (erasePartials subPats, x, m)
     | TPat_unioncase (x, y, ps, m) -> TPat_unioncase (x, y, erasePartials ps, m)
     | TPat_recd (x, y, ps, m) -> TPat_recd (x, y, List.map erasePartialPatterns ps, m)
     | TPat_isinst (x, y, subPatOpt, m) -> TPat_isinst (x, y, Option.map erasePartialPatterns subPatOpt, m)
@@ -965,6 +969,7 @@ let rec isPatternDisjunctive inpPat =
     | TPat_tuple (_, subPats, _, _)
     | TPat_exnconstr(_, subPats, _)
     | TPat_array (subPats, _, _)
+    | TPat_block (subPats, _, _)
     | TPat_unioncase (_, _, subPats, _)
     | TPat_recd (_, _, subPats, _) -> List.exists isPatternDisjunctive subPats
     | TPat_isinst (_, _, subPatOpt, _) -> Option.exists isPatternDisjunctive subPatOpt

src/Compiler/Checking/PatternMatchCompilation.fsi

@@ -32,6 +32,7 @@ type Pattern =
     | TPat_exnconstr of TyconRef * Pattern list * range
     | TPat_tuple of TupInfo * Pattern list * TType list * range
     | TPat_array of Pattern list * TType * range
+    | TPat_block of Pattern list * TType * range
     | TPat_recd of TyconRef * TypeInst * Pattern list * range
     | TPat_range of char * char * range
     | TPat_null of range

src/Compiler/CodeGen/IlxGen.fs

@@ -3001,6 +3001,9 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr (sequel: sequel) =
             | TOp.LValueOp (LByrefSet, v), [ e ], [] -> GenSetByref cenv cgbuf eenv (v, e, m) sequel
             | TOp.LValueOp (LAddrOf _, v), [], [] -> GenGetValAddr cenv cgbuf eenv (v, m) sequel
             | TOp.Array, elems, [ elemTy ] -> GenNewArray cenv cgbuf eenv (elems, elemTy, m) sequel
+            | TOp.Block, elems, [ elemTy ] ->
+                // This codepath is currently reached with non-computation-expression arrays and not handled
+                failwith $"entering | TOp.Block, {elems}, [ {elemTy} ] ->"
             | TOp.Bytes bytes, [], [] ->
                 if cenv.options.emitConstantArraysUsingStaticDataBlobs then
                     GenConstArray cenv cgbuf eenv g.ilg.typ_Byte bytes (fun buf b -> buf.EmitByte b)