dev-std-c-mangle-type.lsts

let std-c-mangle-type(tt: Type, blame: AST): S = (
   tt = tt.normalize.rewrite-opaque-type-alias.normalize.without-any-phi;
   let r = std-c-mangle-type-internal(tt, blame);
   if not(non-zero(r)) then fail("Unable To Mangle \{tt}\nAt \{blame.location}\n\{blame}\n");
   r
);

let std-c-mangle-type-internal(tt: Type, blame: AST): S = (
   let r = std-c-mangle-type-internal-internal(tt, blame);
   if not(non-zero(r)) then r = std-c-mangle-type-internal-internal(tt.slot(c"Sized",1).l1, blame);
   r
);

let std-c-mangle-type-internal-internal(tt: Type, blame: AST): S = (
   match tt {
      TAnd{ conjugate=conjugate } => (
         let is-c = can-unify(t1(c"C",ta), tt);
         let modifiers = SNil;
         let result = SNil;
         for vector c in conjugate {
            if is-c and c.simple-tag != c"C" {} else {
               if c.simple-tag == c"C" {
                  let rt = std-c-mangle-type-internal-internal(c, blame);
                  if non-zero(rt) then modifiers = modifiers + SAtom(c" ") + rt;
               } else {
                  let rt = std-c-mangle-type-internal-internal(c, blame);
                  if non-zero(rt) then result = rt;
               }
            }
         };
         modifiers + result;
      );
      TAny{} => SNil();
      TGround{tag:c"Nil", parameters:[]} => SAtom(c"void");
      TGround{tag:c"Never", parameters:[]} => SAtom(c"void");
      TGround{tag:c"U8", parameters:[]} => SAtom(c"char");
      TGround{tag:c"U16", parameters:[]} => SAtom(c"unsigned short");
      TGround{tag:c"U32", parameters:[]} => SAtom(c"unsigned int");
      TGround{tag:c"U64", parameters:[]} => SAtom(c"unsigned long");
      TGround{tag:c"I8", parameters:[]} => SAtom(c"signed char");
      TGround{tag:c"I16", parameters:[]} => SAtom(c"signed short");
      TGround{tag:c"I32", parameters:[]} => SAtom(c"signed int");
      TGround{tag:c"I64", parameters:[]} => SAtom(c"signed long");
      TGround{tag:c"F64", parameters:[]} => SAtom(c"double");
      TGround{tag:c"CString", parameters:[]} => SAtom(c"char*");
      TGround{tag:c"File", parameters:[]} => SAtom(c"FILE");
      TGround{tag:c"IO::File", parameters:[]} => SAtom(c"FILE*");
      TGround{tag:c"PID", parameters:[]} => SAtom(c"pid_t");
      TGround{tag:c"Regex", parameters:[]} => SAtom(c"regex_t");
      TGround{tag:c"C_regex__t_*_", parameters:[]} => SAtom(c"regex_t*");
      TGround{tag:c"C_char", parameters:[]} => SAtom(c"char");
      TGround{tag:c"C_int", parameters:[]} => SAtom(c"int");
      TGround{tag:c"C_char_*", parameters:[]} => SAtom(c"char*");
      TGround{tag:c"C_size__t_", parameters:[]} => SAtom(c"size_t");
      TGround{tag:c"C_regmatch__t_*", parameters:[]} => SAtom(c"regmatch_t*");
      TGround{tag:c"C_regmatch__t_", parameters:[]} => SAtom(c"regmatch_t");
      TGround{tag:c"DefaultPrintable", parameters:[]} => SNil;
      TGround{tag:c"Type", parameters:[inner-tt..]} => SAtom(c"int");
      TGround{tag:c"Array", parameters:[_.. TAny{}..]} => SAtom(c"void*");
      TGround{tag:c"Array", parameters:[_.. array-base..]} => (
         if array-base.is-arrow
         then std-c-mangle-type-internal-internal(array-base, blame)
         else ( std-c-mangle-type-internal-internal(array-base, blame) + SAtom(c"*") );
      );
      TGround{tag:c"Arrow"} => (
         (let pre, let post) = std-c-mangle-declaration-internal(tt, blame);
         let td-id = uuid();
         assemble-header-typedef-section = assemble-header-typedef-section
                                 + SAtom(c"typedef ")
                                 + pre
                                 + SAtom(c" ")
                                 + SAtom(td-id)
                                 + SAtom(c" ")
                                 + post
                                 + SAtom(c";\n");
         SAtom(td-id)
      );
      TGround{tag:c"C", parameters:[TGround{tag1=tag}..]} => (
         SAtom(tag1)
      );
      TGround{tag:c"Sized", parameters:[_..]} => SNil;
      TGround{tag=tag, parameters=parameters} => (
         let r = mangle-identifier(tag);
         if parameters.length > 0 {
            r = r + mangle-identifier(c"<");
            let pi = 0;
            for vector p in parameters {
               if pi > 0 then r = r + mangle-identifier(c",");
               r = r + std-c-mangle-type-simple(p, blame);
               pi = pi + 1;
            };
            r = r + mangle-identifier(c">");
         };
         r;
      );
      _ => SNil();
   }
);

let std-c-mangle-type-simple(tt: Type, blame: AST): S = (
   match tt {
      TAnd{ conjugate=conjugate } => (
         let is-c = can-unify(t1(c"C",ta), tt);
         let result = SNil();
         for vector c in conjugate {
            if is-c and c.simple-tag != c"C" {} else {
               let rt = std-c-mangle-type-internal-internal(c, blame);
               result = if non-zero(result) and non-zero(rt) then result + SAtom(c" ") + rt
               else if non-zero(result) then result
               else rt;
            }
         };
         result;
      );
      TGround{tag:c"Nil", parameters:[]} => SAtom(c"void");
      TGround{tag:c"Never", parameters:[]} => SAtom(c"void");
      TGround{tag=tag, parameters=parameters} => (
         let r = mangle-identifier(tag);
         if parameters.length > 0 {
            r = r + mangle-identifier(c"<");
            let pi = 0;
            for vector p in parameters {
               if pi > 0 then r = r + mangle-identifier(c",");
               r = r + std-c-mangle-type-simple(p, blame);
               pi = pi + 1;
            };
            r = r + mangle-identifier(c">");
         };
         r;
      );
      _ => SNil();
   }
);