From: Christiaan Baaij Date: Thu, 20 Aug 2009 07:15:43 +0000 (+0200) Subject: Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=a09063e81d573bfa513d30ae97dba95485dc67e9;hp=21d23c869733745ec2d0533772e881d88c682261;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Merge branch 'cλash' of git.stderr.nl/matthijs/projects/master-project * 'cλash' of http://git.stderr.nl/matthijs/projects/master-project: Add a not in isUserDefined. Let vhld_ty handle free tyvars gracefully. Add ty_has_free_tyvars predicate. Split substitute into substitute and substitute_clone. Rewrite substitute to clone the substitution range. Don't error on type abstraction when cloning binders. When inlining top level functions, guarantee uniqueness. Make all binders unique before normalizing. Add genUniques function to regenerate all uniques. Add mapAccumLM helper function. Don't try to inline non-normalizeable top level functions. Add andM and orM utility functions. Add isNormalizeable predicate. Make isRepr work on TypedThings instead of CoreExpr. Also inline functions named "fromInteger". Don't extra non-representable values in simplres. Use isUserDefined for (not) inlining top level functions. Add isUserDefined predicate. Inline all top level functions that look simple. --- diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 642ff9c..d1bf375 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -90,9 +90,10 @@ createEntityAST vhdl_id args res = -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids. ports = map (mkIfaceSigDec AST.In) args ++ (Maybe.maybeToList res_port) - ++ [clk_port] + ++ [clk_port,resetn_port] -- Add a clk port if we have state clk_port = AST.IfaceSigDec clockId AST.In std_logicTM + resetn_port = AST.IfaceSigDec resetId AST.In std_logicTM res_port = fmap (mkIfaceSigDec AST.Out) res -- | Create a port declaration @@ -347,12 +348,13 @@ genFCall' switch (Left res) f args = do genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name genFromSizedWord :: BuiltinBuilder -genFromSizedWord = genNoInsts $ genExprArgs $ genExprRes genFromSizedWord' -genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr -genFromSizedWord' (Left res) f args = do - let fname = varToString f - return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $ - map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args +genFromSizedWord = genNoInsts $ genExprArgs genFromSizedWord' +genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm] +genFromSizedWord' (Left res) f args@[arg] = do + return $ [mkUncondAssign (Left res) arg] + -- let fname = varToString f + -- return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $ + -- map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name genResize :: BuiltinBuilder @@ -381,17 +383,17 @@ genFromInteger' (Left res) f lits = do { ; (tycon, args) = Type.splitTyConApp ty ; name = Name.getOccString (TyCon.tyConName tycon) } ; - ; case name of - "RangedWord" -> return $ AST.PrimLit (show (last lits)) - otherwise -> do { - ; len <- case name of - "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty) - "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty) - "RangedWord" -> MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty) - ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId - ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname)) - [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))] + ; len <- case name of + "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty) + "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty) + "RangedWord" -> do { + ; bound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty) + ; return $ floor (logBase 2 (fromInteger (toInteger (bound)))) + 1 } + ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId ; "RangedWord" -> toUnsignedId + ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname)) + [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))] + } genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name @@ -859,7 +861,8 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res) let resname' = varToVHDLName res let resname = mkSelectedName resname' (reslabels!!0) - let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr + let rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) rdaddr + let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int let assign = mkUncondAssign (Right resname) argexpr let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res)) let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm] @@ -871,7 +874,8 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do where proclabel = mkVHDLBasicId "updateRAM" rising_edge = mkVHDLBasicId "rising_edge" - ramloc = mkIndexedName (AST.NSimple ram_id) wraddr + wraddr_int = genExprFCall (mkVHDLBasicId toIntegerId) wraddr + ramloc = mkIndexedName (AST.NSimple ram_id) wraddr_int wform = AST.Wform [AST.WformElem data_in Nothing] ramassign = AST.SigAssign ramloc wform rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId) @@ -1054,12 +1058,11 @@ genUnconsVectorFuns elemTM vectorTM = sPar = AST.unsafeVHDLBasicId "s" resId = AST.unsafeVHDLBasicId "res" exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM, - AST.IfaceVarDec ixPar naturalTM] elemTM + AST.IfaceVarDec ixPar unsignedTM] elemTM exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed - (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $ - AST.NSimple ixPar])) + (AST.IndexedName (AST.NSimple vecPar) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ ixPar)])) replaceSpec = AST.Function (mkVHDLExtId replaceId) [ AST.IfaceVarDec vecPar vectorTM - , AST.IfaceVarDec iPar naturalTM + , AST.IfaceVarDec iPar unsignedTM , AST.IfaceVarDec aPar elemTM ] vectorTM -- variable res : fsvec_x (0 to vec'length-1); @@ -1074,7 +1077,7 @@ genUnconsVectorFuns elemTM vectorTM = Nothing -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1) replaceExpr1 = AST.NSimple resId AST.:= AST.PrimName (AST.NSimple vecPar) - replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName $ AST.NSimple iPar]) AST.:= AST.PrimName (AST.NSimple aPar) + replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ iPar)]) AST.:= AST.PrimName (AST.NSimple aPar) replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId) vecSlice init last = AST.PrimName (AST.NSlice (AST.SliceName diff --git "a/c\316\273ash/CLasH/VHDL/Testbench.hs" "b/c\316\273ash/CLasH/VHDL/Testbench.hs" index 84f550a..bc23262 100644 --- "a/c\316\273ash/CLasH/VHDL/Testbench.hs" +++ "b/c\316\273ash/CLasH/VHDL/Testbench.hs" @@ -52,7 +52,7 @@ createTestbenchEntity :: -> Entity createTestbenchEntity bndr = entity where - vhdl_id = mkVHDLBasicId $ varToString bndr + vhdl_id = mkVHDLBasicId "testbench" -- Create an AST entity declaration with no ports ent_decl = AST.EntityDec vhdl_id [] -- Create a signature with no input and no output ports diff --git "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" index 39506f8..cff65a6 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" +++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" @@ -119,7 +119,8 @@ mkComponentInst label entity_id portassigns = AST.CSISm compins where -- We always have a clock port, so no need to map it anywhere but here clk_port = mkAssocElem clockId (idToVHDLExpr clockId) - compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port])) + resetn_port = mkAssocElem resetId (idToVHDLExpr resetId) + compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port,resetn_port])) ----------------------------------------------------------------------------- -- Functions to generate VHDL Exprs @@ -238,7 +239,7 @@ mkVHDLExtId s = AST.unsafeVHDLExtId $ strip_invalid s where -- Allowed characters, taken from ForSyde's mkVHDLExtId - allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&\\'()*+,./:;<=>_|!$%@?[]^`{}~-" + allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&'()*+,./:;<=>_|!$%@?[]^`{}~-" strip_invalid = filter (`elem` allowed) -- Create a record field selector that selects the given label from the record @@ -437,9 +438,10 @@ mk_natural_ty :: -> TypeSession (Either String (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))) -- ^ An error message or The typemark created. mk_natural_ty min_bound max_bound = do - let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound) - let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound)) - let ty_def = AST.SubtypeIn naturalTM (Just range) + let bitsize = floor (logBase 2 (fromInteger (toInteger max_bound))) + let ty_id = mkVHDLExtId $ "natural_" ++ (show min_bound) ++ "_to_" ++ (show max_bound) + let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit $ show min_bound) (AST.PrimLit $ show bitsize)] + let ty_def = AST.SubtypeIn unsignedTM (Just range) return (Right $ Just (ty_id, Right ty_def)) mk_unsigned_ty :: @@ -682,14 +684,14 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr] , AST.SubProgBody showBoolSpec [] [showBoolExpr] , AST.SubProgBody showSingedSpec [] [showSignedExpr] , AST.SubProgBody showUnsignedSpec [] [showUnsignedExpr] - , AST.SubProgBody showNaturalSpec [] [showNaturalExpr] + -- , AST.SubProgBody showNaturalSpec [] [showNaturalExpr] ] where bitPar = AST.unsafeVHDLBasicId "s" boolPar = AST.unsafeVHDLBasicId "b" signedPar = AST.unsafeVHDLBasicId "sint" unsignedPar = AST.unsafeVHDLBasicId "uint" - naturalPar = AST.unsafeVHDLBasicId "nat" + -- naturalPar = AST.unsafeVHDLBasicId "nat" showBitSpec = AST.Function showId [AST.IfaceVarDec bitPar std_logicTM] stringTM -- if s = '1' then return "'1'" else return "'0'" showBitExpr = AST.IfSm (AST.PrimName (AST.NSimple bitPar) AST.:=: AST.PrimLit "'1'") @@ -714,10 +716,10 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr] (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [unsignToInt]) Nothing ) where unsignToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ unsignedPar) - showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM - showNaturalExpr = AST.ReturnSm (Just $ - AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) - (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [AST.PrimName $ AST.NSimple $ naturalPar]) Nothing ) + -- showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM + -- showNaturalExpr = AST.ReturnSm (Just $ + -- AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) + -- (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [AST.PrimName $ AST.NSimple $ naturalPar]) Nothing ) genExprFCall :: AST.VHDLId -> AST.Expr -> AST.Expr diff --git a/reducer.hs b/reducer.hs index 2dba485..ecc0051 100644 --- a/reducer.hs +++ b/reducer.hs @@ -47,7 +47,7 @@ type FpAdderState = State (Vector AdderDepth ReducerSignal) type OutputState = State ( MemState DiscrRange DataInt , MemState DiscrRange DataInt - , RAM DiscrRange ArrayIndex + , MemState DiscrRange ArrayIndex , RAM DiscrRange Bit ) {- @@ -105,8 +105,8 @@ valid indicates if the output contains a valid discriminator -} inputBuffer :: InputState -> ((DataInt, Discr), RangedWord D2) -> - (InputState, (ReducerSignal, ReducerSignal)) -inputBuffer (State (mem,wrptr)) (inp,enable) = (State (mem',wrptr'),(out1, out2)) + (InputState, ReducerSignal, ReducerSignal) +inputBuffer (State (mem,wrptr)) (inp,enable) = (State (mem',wrptr'),out1, out2) where out1 = last mem -- output head of FIFO out2 = last (init mem) -- output 2nd element @@ -204,14 +204,13 @@ outputter :: OutputState -> , Discr , Bit ) -> - (OutputState, (ReducerSignal, OutputSignal)) + (OutputState, ReducerSignal, OutputSignal) outputter (State (mem1, mem2, lut, valid)) (discr, index, new_discr, data_in, rdaddr, wraddr, wrenable) = - ((State (mem1', mem2', lut', valid')), (data_out, output)) + ((State (mem1', mem2', lut', valid')), data_out, output) where -- Lut is updated when new discriminator/index combination enters system - lut' | new_discr /= Low = replace lut discr index - | otherwise = lut + (lut', lut_out) = blockRAM lut index discr discr new_discr -- Location becomes invalid when Reduced row leaves system valid'' | (new_discr /= Low) && ((valid!discr) /= Low) = replace valid discr Low @@ -229,7 +228,7 @@ outputter (State (mem1, mem2, lut, valid)) -- Reduced row is released when new discriminator enters system -- And the position at the discriminator holds a valid value output = ( ( (mem_out2) - , (lut!discr) + , (lut_out) ) , (new_discr `hwand` (valid!discr)) ) @@ -346,7 +345,7 @@ reducer (State (discrstate,inputstate,fpadderstate,outputstate)) input = (State (discrstate',inputstate',fpadderstate',outputstate'),output) where (discrstate', discr_out) = discriminator discrstate input - (inputstate',(fifo_out1, fifo_out2)) = inputBuffer inputstate ( + (inputstate',fifo_out1, fifo_out2) = inputBuffer inputstate ( (fst discr_out), enable) (fpadderstate', fp_out) = fpAdder fpadderstate (fifo_out1, fifo_out2, grant, mem_out) @@ -356,7 +355,7 @@ reducer (State (discrstate,inputstate,fpadderstate,outputstate)) input = rdaddr = snd (fst fp_out) wraddr = rdaddr data_in = fst (fst fp_out) - (outputstate', (mem_out, output)) = outputter outputstate (discr, + (outputstate', mem_out, output) = outputter outputstate (discr, index, new_discr, data_in, rdaddr, wraddr, wr_enable) (grant,enable,wr_enable) = controller (fp_out, mem_out, @@ -439,22 +438,23 @@ initstate = State , State (copy ((0::DataInt,0::Discr),Low)) , State ( State (copy (0::DataInt)) , State (copy (0::DataInt)) - , (copy (0::ArrayIndex)) + , State (copy (0::ArrayIndex)) , (copy Low) ) ) +{-# ANN siminput TestInput #-} siminput :: [(DataInt, ArrayIndex)] -siminput = [(13,0),(7,0),(14,0),(14,0),(12,0),(10,0),(19,1),(20,1),(13,1) - ,(5,1),(9,1),(16,1),(15,1),(10,2),(13,2),(3,2),(9,2),(19,2),(5,3) - ,(5,3),(10,3),(17,3),(14,3),(5,3),(15,3),(11,3),(5,3),(1,3),(8,4) - ,(20,4),(8,4),(1,4),(11,4),(10,4),(13,5),(18,5),(5,5),(6,5),(6,5) - ,(4,6),(4,6),(11,6),(11,6),(11,6),(1,6),(11,6),(3,6),(12,6),(12,6) - ,(2,6),(14,6),(11,7),(13,7),(17,7),(9,7),(19,8),(4,9),(18,10) - ,(6,10),(18,11),(1,12),(3,12),(14,12),(18,12),(14,12),(6,13) - ,(9,13),(11,14),(4,14),(1,14),(14,14),(14,14),(6,14),(11,15) - ,(13,15),(7,15),(2,16),(16,16),(17,16),(5,16),(20,16),(17,16) - ,(14,16),(18,17),(13,17),(1,17),(19,18),(1,18),(20,18),(4,18) - ,(5,19),(4,19),(6,19),(19,19),(4,19),(3,19),(7,19),(13,19),(19,19) - ,(8,19) +siminput = [(13,0)::(DataInt, ArrayIndex),(7,0)::(DataInt, ArrayIndex),(14,0)::(DataInt, ArrayIndex),(14,0)::(DataInt, ArrayIndex),(12,0)::(DataInt, ArrayIndex),(10,0)::(DataInt, ArrayIndex),(19,1)::(DataInt, ArrayIndex),(20,1)::(DataInt, ArrayIndex),(13,1)::(DataInt, ArrayIndex) + ,(5,1)::(DataInt, ArrayIndex),(9,1)::(DataInt, ArrayIndex),(16,1)::(DataInt, ArrayIndex),(15,1)::(DataInt, ArrayIndex),(10,2)::(DataInt, ArrayIndex),(13,2)::(DataInt, ArrayIndex),(3,2)::(DataInt, ArrayIndex),(9,2)::(DataInt, ArrayIndex),(19,2)::(DataInt, ArrayIndex),(5,3)::(DataInt, ArrayIndex) + ,(5,3)::(DataInt, ArrayIndex),(10,3)::(DataInt, ArrayIndex),(17,3)::(DataInt, ArrayIndex),(14,3)::(DataInt, ArrayIndex),(5,3)::(DataInt, ArrayIndex),(15,3)::(DataInt, ArrayIndex),(11,3)::(DataInt, ArrayIndex),(5,3)::(DataInt, ArrayIndex),(1,3)::(DataInt, ArrayIndex),(8,4)::(DataInt, ArrayIndex) + ,(20,4)::(DataInt, ArrayIndex),(8,4)::(DataInt, ArrayIndex),(1,4)::(DataInt, ArrayIndex),(11,4)::(DataInt, ArrayIndex),(10,4)::(DataInt, ArrayIndex),(13,5)::(DataInt, ArrayIndex),(18,5)::(DataInt, ArrayIndex),(5,5)::(DataInt, ArrayIndex),(6,5)::(DataInt, ArrayIndex),(6,5)::(DataInt, ArrayIndex) + ,(4,6)::(DataInt, ArrayIndex),(4,6)::(DataInt, ArrayIndex),(11,6)::(DataInt, ArrayIndex),(11,6)::(DataInt, ArrayIndex),(11,6)::(DataInt, ArrayIndex),(1,6)::(DataInt, ArrayIndex),(11,6)::(DataInt, ArrayIndex),(3,6)::(DataInt, ArrayIndex),(12,6)::(DataInt, ArrayIndex),(12,6)::(DataInt, ArrayIndex) + ,(2,6)::(DataInt, ArrayIndex),(14,6)::(DataInt, ArrayIndex),(11,7)::(DataInt, ArrayIndex),(13,7)::(DataInt, ArrayIndex),(17,7)::(DataInt, ArrayIndex),(9,7)::(DataInt, ArrayIndex),(19,8)::(DataInt, ArrayIndex),(4,9)::(DataInt, ArrayIndex),(18,10)::(DataInt, ArrayIndex) + ,(6,10)::(DataInt, ArrayIndex),(18,11)::(DataInt, ArrayIndex),(1,12)::(DataInt, ArrayIndex),(3,12)::(DataInt, ArrayIndex),(14,12)::(DataInt, ArrayIndex),(18,12)::(DataInt, ArrayIndex),(14,12)::(DataInt, ArrayIndex),(6,13)::(DataInt, ArrayIndex) + ,(9,13)::(DataInt, ArrayIndex),(11,14)::(DataInt, ArrayIndex),(4,14)::(DataInt, ArrayIndex),(1,14)::(DataInt, ArrayIndex),(14,14)::(DataInt, ArrayIndex),(14,14)::(DataInt, ArrayIndex),(6,14)::(DataInt, ArrayIndex),(11,15)::(DataInt, ArrayIndex) + ,(13,15)::(DataInt, ArrayIndex),(7,15)::(DataInt, ArrayIndex),(2,16)::(DataInt, ArrayIndex),(16,16)::(DataInt, ArrayIndex),(17,16)::(DataInt, ArrayIndex),(5,16)::(DataInt, ArrayIndex),(20,16)::(DataInt, ArrayIndex),(17,16)::(DataInt, ArrayIndex) + ,(14,16)::(DataInt, ArrayIndex),(18,17)::(DataInt, ArrayIndex),(13,17)::(DataInt, ArrayIndex),(1,17)::(DataInt, ArrayIndex),(19,18)::(DataInt, ArrayIndex),(1,18)::(DataInt, ArrayIndex),(20,18)::(DataInt, ArrayIndex),(4,18)::(DataInt, ArrayIndex) + ,(5,19)::(DataInt, ArrayIndex),(4,19)::(DataInt, ArrayIndex),(6,19)::(DataInt, ArrayIndex),(19,19)::(DataInt, ArrayIndex),(4,19)::(DataInt, ArrayIndex),(3,19)::(DataInt, ArrayIndex),(7,19)::(DataInt, ArrayIndex),(13,19)::(DataInt, ArrayIndex),(19,19)::(DataInt, ArrayIndex) + ,(8,19)::(DataInt, ArrayIndex) ]