content: -- | Module BoxTemplates defines Carp's Box type, a container for managed,
  -- heap allocated objects.
  module BoxTemplates
    ( delete,
      str,
      prn,
      BoxTemplates.init,
      copy,
      unbox,
      peek,
    )
  where
  
  import Concretize
  import Obj
  import Polymorphism
  import Template
  import ToTemplate
  import Types
  
  boxTy :: Ty
  boxTy = StructTy (ConcreteNameTy (SymPath [] "Box")) [(VarTy "t")]
  
  -- | Defines a template for initializing Boxes.
  init :: (String, Binder)
  init =
    let path = SymPath ["Box"] "init"
        t = FuncTy [(VarTy "t")] boxTy StaticLifetimeTy
        docs = "Initializes a box pointing to value t."
        decl = templateLiteral "$t* $NAME ($t t)"
        body =
          const
            ( multilineTemplate
                [ "$DECL {",
                  "  $t* instance;",
                  "  instance = CARP_MALLOC(sizeof($t));",
                  "  *instance = t;",
                  "  return instance;",
                  "}"
                ]
            )
        deps = const []
        template = TemplateCreator $ \_ _ -> Template t decl body deps
     in defineTypeParameterizedTemplate template path t docs
  
  -- | Defines a template for converting a boxed value to a local value.
  unbox :: (String, Binder)
  unbox =
    let path = SymPath ["Box"] "unbox"
        t = FuncTy [(StructTy (ConcreteNameTy (SymPath [] "Box")) [(VarTy "t")])] (VarTy "t") StaticLifetimeTy
        docs = "Converts a boxed value to a reference to the value and delete the box."
        decl = templateLiteral "$t $NAME($t* box)"
        body =
          const
            ( multilineTemplate
                [ "$DECL {",
                  "  $t local;",
                  "  local = *box;",
                  "  CARP_FREE(box);",
                  "  return local;",
                  "}"
                ]
            )
        deps = const []
        template = TemplateCreator $ \_ _ -> Template t decl body deps
     in defineTypeParameterizedTemplate template path t docs
  
  -- | Defines a template for getting a reference to the value stored in a box without performing an additional allocation.
  peek :: (String, Binder)
  peek =
    let path = SymPath ["Box"] "peek"
        t = FuncTy [(RefTy (StructTy (ConcreteNameTy (SymPath [] "Box")) [(VarTy "t")]) (VarTy "q"))] (RefTy (VarTy "t") (VarTy "q")) StaticLifetimeTy
        docs = "Returns a reference to the value stored in a box without performing an additional allocation."
        decl = templateLiteral "$t* $NAME($t** box_ref)"
        body =
          const
            ( multilineTemplate
                [ "$DECL {",
                  "  return *box_ref;",
                  "}"
                ]
            )
        deps = const []
        template = TemplateCreator $ \_ _ -> Template t decl body deps
     in defineTypeParameterizedTemplate template path t docs
  
  -- | Defines a template for copying a box. The copy will also be heap allocated.
  copy :: (String, Binder)
  copy =
    let path = SymPath ["Box"] "copy"
        t = FuncTy [(RefTy (StructTy (ConcreteNameTy (SymPath [] "Box")) [(VarTy "t")]) (VarTy "q"))] (StructTy (ConcreteNameTy (SymPath [] "Box")) [(VarTy "t")]) StaticLifetimeTy
        docs = "Copies a box."
        decl = (templateLiteral "$t* $NAME ($t** box)")
        template = TemplateCreator $
          \tenv env ->
            Template
              t
              decl
              ( \ft ->
                  case ft of
                    (FuncTy [RefTy (StructTy (ConcreteNameTy (SymPath [] "Box")) [inner]) _] _ _) ->
                      innerCopy tenv env inner
                    _ -> error "box templates: copy called with non box"
              )
              ( \ft ->
                  case ft of
                    (FuncTy [RefTy boxType@(StructTy (ConcreteNameTy (SymPath [] "Box")) [inner]) _] _ _) ->
                      depsForCopyFunc tenv env inner
                        ++ depsForDeleteFunc tenv env boxType
                    _ -> error "box templates: copy called with non box"
              )
     in defineTypeParameterizedTemplate template path t docs
    where
      innerCopy typeEnv valEnv innerTy =
        case findFunctionForMemberIncludePrimitives typeEnv valEnv "copy" (typesCopyFunctionType innerTy) ("Inside box.", innerTy) of
          FunctionFound functionFullName ->
            multilineTemplate
              [ "$DECL {",
                "  $t* copy;",
                "  copy = CARP_MALLOC(sizeof($t));",
                "  *copy = " ++ functionFullName ++ "(*box);",
                "  return copy;",
                "}"
              ]
          _ ->
            multilineTemplate
              [ "$DECL {",
                "  $t* copy;",
                "  copy = CARP_MALLOC(sizeof($t));",
                "  *copy = *box;",
                "  return copy;",
                "}"
              ]
  
  -- | Defines a template for deleting a box.
  delete :: (String, Binder)
  delete =
    let path = SymPath ["Box"] "delete"
        t = FuncTy [boxTy] UnitTy StaticLifetimeTy
        docs = "Deletes a box, freeing its associated memory."
        decl = (templateLiteral "void $NAME ($t* box)")
        templateCreator = TemplateCreator $
          \tenv env ->
            Template
              t
              decl
              ( \ft ->
                  case ft of
                    (FuncTy [bTy] UnitTy _) ->
                      multilineTemplate
                        [ "$DECL {",
                          "  " ++ innerDelete tenv env bTy,
                          "}"
                        ]
                    _ -> error "box templates: delete called with non box"
              )
              ( \ft ->
                  case ft of
                    (FuncTy [StructTy (ConcreteNameTy (SymPath [] "Box")) [insideType]] UnitTy _) ->
                      depsForDeleteFunc tenv env insideType
                    _ -> error "box templates: delete called with non box"
              )
     in defineTypeParameterizedTemplate templateCreator path t docs
    where
      innerDelete :: TypeEnv -> Env -> Ty -> String
      innerDelete tenv env (StructTy (ConcreteNameTy (SymPath [] "Box")) [inner]) =
        case findFunctionForMember tenv env "delete" (typesDeleterFunctionType inner) ("Inside box.", inner) of
          FunctionFound functionFullName ->
            "  " ++ functionFullName ++ "(*box);\n"
              ++ "  CARP_FREE(box);"
          FunctionNotFound msg -> error msg
          FunctionIgnored ->
            "  /* Ignore non-managed type inside Box: '" ++ show inner ++ "' */\n"
              ++ "  CARP_FREE(box);"
      innerDelete _ _ _ = ""
  
  -- | Defines a template for printing a box as a string.
  prn :: (String, Binder)
  prn =
    let path = SymPath ["Box"] "prn"
        t = FuncTy [boxTy] StringTy StaticLifetimeTy
        docs = "Returns a string representation of a Box."
        decl = templateLiteral "String $NAME ($t* box)"
        templateCreator =
          TemplateCreator $
            ( \tenv env ->
                Template
                  t
                  decl
                  ( \ft ->
                      case ft of
                        (FuncTy [boxT] StringTy _) ->
                          multilineTemplate
                            [ "$DECL {",
                              "  if(!box){",
                              "    String buffer = CARP_MALLOC(4);",
                              "    sprintf(buffer, \"Nil\");",
                              "    return buffer;",
                              "  }",
                              innerStr tenv env boxT,
                              "  return buffer;",
                              "}"
                            ]
                        _ -> error "box templates: prn called with non box"
                  )
                  ( \ft ->
                      case ft of
                        (FuncTy [(StructTy (ConcreteNameTy (SymPath [] "Box")) [inner])] StringTy _) ->
                          depsForPrnFunc tenv env inner
                        _ -> error "box tempaltes: prn called with non box"
                  )
            )
     in defineTypeParameterizedTemplate templateCreator path t docs
  
  -- | Defines a template for printing a reference to a box as a string.
  str :: (String, Binder)
  str =
    let path = SymPath ["Box"] "str"
        t = FuncTy [(RefTy boxTy (VarTy "q"))] StringTy StaticLifetimeTy
        docs = "Returns a string representation of a Box."
        templateCreator =
          TemplateCreator $
            ( \tenv env ->
                Template
                  t
                  (templateLiteral "String $NAME ($t** box)")
                  ( \ft ->
                      case ft of
                        (FuncTy [RefTy boxT _] StringTy _) ->
                          multilineTemplate
                            [ "$DECL {",
                              "  if(!box){",
                              "    String buffer = CARP_MALLOC(4);",
                              "    sprintf(buffer, \"Nil\");",
                              "    return buffer;",
                              "  }",
                              innerStr tenv env boxT,
                              "  return buffer;",
                              "}"
                            ]
                        _ -> error "box templates: str called with non box ref"
                  )
                  ( \ft ->
                      case ft of
                        (FuncTy [RefTy (StructTy (ConcreteNameTy (SymPath [] "Box")) [inner]) _] StringTy _) ->
                          depsForPrnFunc tenv env inner
                        _ -> error "box templates: str template called with non box type"
                  )
            )
     in defineTypeParameterizedTemplate templateCreator path t docs
  
  innerStr :: TypeEnv -> Env -> Ty -> String
  innerStr tenv env (StructTy _ [t]) =
    case findFunctionForMemberIncludePrimitives tenv env "prn" (typesStrFunctionType tenv env (RefTy t StaticLifetimeTy)) ("Inside box.", t) of
      FunctionFound functionFullName ->
        unlines
          [ "  char* temp = " ++ functionFullName ++ "(*box);",
            "  int size = snprintf(NULL, 0, \"(Box %s)\", temp);",
            "  String buffer = CARP_MALLOC(size);",
            "  sprintf(buffer, \"(Box %s)\", temp);",
            "  if(temp) {",
            "    CARP_FREE(temp);",
            "    temp = NULL;",
            "  }"
          ]
      FunctionNotFound _ ->
        unlines
          [ "  String buffer = CARP_MALLOC(14);",
            "  sprintf(buffer, \"(Box unknown)\");"
          ]
      FunctionIgnored -> "    /* Ignore type inside Box: '" ++ show t ++ "' ??? */\n"
  innerStr _ _ _ = ""
  