content: {-# LANGUAGE ParallelListComp #-}
  module Main where
  
  import Text.PrettyPrint
  
  import System.Environment ( getArgs )
  
  main = do
           [s] <- getArgs
           let n = read s
           mapM_ (putStrLn . render . generate) [2..n]
  
  generate :: Int -> Doc
  generate n =
    vcat [ text "#ifdef DEFINE_INSTANCES"
         , data_instance "MVector s" "MV"
         , data_instance "Vector" "V"
         , class_instance "Unbox"
         , class_instance "M.MVector MVector" <+> text "where"
         , nest 2 $ vcat $ map method methods_MVector
         , class_instance "G.Vector Vector" <+> text "where"
         , nest 2 $ vcat $ map method methods_Vector
         , text "#endif"
         , text "#ifdef DEFINE_MUTABLE"
         , define_zip "MVector s" "MV"
         , define_unzip "MVector s" "MV"
         , text "#endif"
         , text "#ifdef DEFINE_IMMUTABLE"
         , define_zip "Vector" "V"
         , define_zip_rule
         , define_unzip "Vector" "V"
         , text "#endif"
         ]
  
    where
      vars  = map char $ take n ['a'..]
      varss = map (<> char 's') vars
      tuple xs = parens $ hsep $ punctuate comma xs
      vtuple xs = parens $ sep $ punctuate comma xs
      con s = text s <> char '_' <> int n
      var c = text (c : "_")
  
      data_instance ty c
        = hang (hsep [text "data instance", text ty, tuple vars])
               4
               (hsep [char '=', con c, text "{-# UNPACK #-} !Int"
                     , vcat $ map (\v -> char '!' <> parens (text ty <+> v)) vars])
  
      class_instance cls
        = text "instance" <+> vtuple [text "Unbox" <+> v | v <- vars]
                          <+> text "=>" <+> text cls <+> tuple vars
  
  
      define_zip ty c
        = sep [text "-- | /O(1)/ Zip" <+> int n <+> text "vectors"
              ,name <+> text "::"
                    <+> vtuple [text "Unbox" <+> v | v <- vars]
                    <+> text "=>"
                    <+> sep (punctuate (text " ->") [text ty <+> v | v <- vars])
                    <+> text "->"
                    <+> text ty <+> tuple vars
               ,text "{-# INLINE_STREAM"  <+> name <+> text "#-}"
               ,name <+> sep varss
                     <+> text "="
                     <+> con c
                     <+> text "len"
                     <+> sep [parens $ text "unsafeSlice"
                                       <+> char '0'
                                       <+> text "len"
                                       <+> vs | vs <- varss]
               ,nest 2 $ hang (text "where")
                              2
                       $ text "len ="
                         <+> sep (punctuate (text " `delayed_min`")
                                            [text "length" <+> vs | vs <- varss])
               ]
        where
          name | n == 2    = text "zip"
               | otherwise = text "zip" <> int n
  
      define_zip_rule
        = hang (text "{-# RULES" <+> text "\"stream/" <> name "zip"
                <> text " [Vector.Unboxed]\" forall" <+> sep varss <+> char '.')
               2 $
               text "G.stream" <+> parens (name "zip" <+> sep varss)
               <+> char '='
               <+> text "Stream." <> name "zipWith" <+> tuple (replicate n empty)
               <+> sep [parens $ text "G.stream" <+> vs | vs <- varss]
               $$ text "#-}"
       where
         name s | n == 2    = text s
                | otherwise = text s <> int n
         
  
      define_unzip ty c
        = sep [text "-- | /O(1)/ Unzip" <+> int n <+> text "vectors"
              ,name <+> text "::"
                    <+> vtuple [text "Unbox" <+> v | v <- vars]
                    <+> text "=>"
                    <+> text ty <+> tuple vars
                    <+> text "->" <+> vtuple [text ty <+> v | v <- vars]
              ,text "{-# INLINE" <+> name <+> text "#-}"
              ,name <+> pat c <+> text "="
                    <+> vtuple varss
              ]
        where
          name | n == 2    = text "unzip"
               | otherwise = text "unzip" <> int n
  
      pat c = parens $ con c <+> var 'n' <+> sep varss
      patn c n = parens $ con c <+> (var 'n' <> int n)
                                <+> sep [v <> int n | v <- varss]
  
      qM s = text "M." <> text s
      qG s = text "G." <> text s
  
      gen_length c _ = (pat c, var 'n')
  
      gen_unsafeSlice mod c rec
        = (var 'i' <+> var 'm' <+> pat c,
           con c <+> var 'm'
                 <+> vcat [parens
                           $ text mod <> char '.' <> text rec
                                      <+> var 'i' <+> var 'm' <+> vs
                                          | vs <- varss])
  
  
      gen_overlaps rec = (patn "MV" 1 <+> patn "MV" 2,
                          vcat $ r : [text "||" <+> r | r <- rs])
        where
          r : rs = [qM rec <+> v <> char '1' <+> v <> char '2' | v <- varss]
  
      gen_unsafeNew rec
        = (var 'n',
           mk_do [v <+> text "<-" <+> qM rec <+> var 'n' | v <- varss]
                 $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss)
  
      gen_unsafeReplicate rec
        = (var 'n' <+> tuple vars,
           mk_do [vs <+> text "<-" <+> qM rec <+> var 'n' <+> v
                          | v  <- vars | vs <- varss]
                 $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss)
  
      gen_unsafeRead rec
        = (pat "MV" <+> var 'i',
           mk_do [v <+> text "<-" <+> qM rec <+> vs <+> var 'i' | v  <- vars
                                                                | vs <- varss]
                 $ text "return" <+> tuple vars)
  
      gen_unsafeWrite rec
        = (pat "MV" <+> var 'i' <+> tuple vars,
           mk_do [qM rec <+> vs <+> var 'i' <+> v | v  <- vars | vs <- varss]
                 empty)
  
      gen_clear rec
        = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty)
  
      gen_set rec
        = (pat "MV" <+> tuple vars,
           mk_do [qM rec <+> vs <+> v | vs <- varss | v <- vars] empty)
  
      gen_unsafeCopy c q rec
        = (patn "MV" 1 <+> patn c 2,
           mk_do [q rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss]
                 empty)
  
      gen_unsafeMove rec
        = (patn "MV" 1 <+> patn "MV" 2,
           mk_do [qM rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss]
                 empty)
  
      gen_unsafeGrow rec
        = (pat "MV" <+> var 'm',
           mk_do [vs <> char '\'' <+> text "<-"
                                  <+> qM rec <+> vs <+> var 'm' | vs <- varss]
                 $ text "return $" <+> con "MV"
                                   <+> parens (var 'm' <> char '+' <> var 'n')
                                   <+> sep (map (<> char '\'') varss))
  
      gen_unsafeFreeze rec
        = (pat "MV",
           mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss]
                 $ text "return $" <+> con "V" <+> var 'n'
                                   <+> sep [vs <> char '\'' | vs <- varss])
  
      gen_unsafeThaw rec
        = (pat "V",
           mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss]
                 $ text "return $" <+> con "MV" <+> var 'n'
                                   <+> sep [vs <> char '\'' | vs <- varss])
  
      gen_basicUnsafeIndexM rec
        = (pat "V" <+> var 'i',
           mk_do [v <+> text "<-" <+> qG rec <+> vs <+> var 'i'
                          | vs <- varss | v <- vars]
                 $ text "return" <+> tuple vars)
  
      gen_elemseq rec
        = (char '_' <+> tuple vars,
           vcat $ r : [char '.' <+> r | r <- rs])
        where
          r : rs = [qG rec <+> parens (text "undefined :: Vector" <+> v)
                           <+> v | v <- vars]
  
      mk_do cmds ret = hang (text "do")
                            2
                            $ vcat $ cmds ++ [ret]
  
      method (s, f) = case f s of
                        (p,e) ->  text "{-# INLINE" <+> text s <+> text " #-}"
                                  $$ hang (text s <+> p)
                                     4
                                     (char '=' <+> e)
                               
  
      methods_MVector = [("basicLength",            gen_length "MV")
                        ,("basicUnsafeSlice",       gen_unsafeSlice "M" "MV")
                        ,("basicOverlaps",          gen_overlaps)
                        ,("basicUnsafeNew",         gen_unsafeNew)
                        ,("basicUnsafeReplicate",   gen_unsafeReplicate)
                        ,("basicUnsafeRead",        gen_unsafeRead)
                        ,("basicUnsafeWrite",       gen_unsafeWrite)
                        ,("basicClear",             gen_clear)
                        ,("basicSet",               gen_set)
                        ,("basicUnsafeCopy",        gen_unsafeCopy "MV" qM)
                        ,("basicUnsafeMove",        gen_unsafeMove)
                        ,("basicUnsafeGrow",        gen_unsafeGrow)]
  
      methods_Vector  = [("basicUnsafeFreeze",      gen_unsafeFreeze)
                        ,("basicUnsafeThaw",        gen_unsafeThaw)
                        ,("basicLength",            gen_length "V")
                        ,("basicUnsafeSlice",       gen_unsafeSlice "G" "V")
                        ,("basicUnsafeIndexM",      gen_basicUnsafeIndexM)
                        ,("basicUnsafeCopy",        gen_unsafeCopy "V" qG)
                        ,("elemseq",                gen_elemseq)]
  