#![deny(missing_docs)]
extern crate proc_macro;
use convert_case::{Case, Casing};
use proc_macro::TokenStream;
use proc_macro2::{Ident, Span};
use quote::quote;
use syn::{
punctuated::Punctuated, Fields, FnArg, GenericParam, PredicateType, ReturnType, TraitBound,
TraitBoundModifier, Type, TypeParamBound, TypePath, WherePredicate,
};
#[proc_macro_attribute]
pub fn func(_attribute: TokenStream, item: TokenStream) -> TokenStream {
let item_fn: syn::ItemFn = syn::parse(item).expect("couldn't parse item");
let rust_name = &item_fn.sig.ident;
let inputs = &item_fn.sig.inputs;
let output = &item_fn.sig.output;
let ocaml_name = rust_ident_to_ocaml(&rust_name.to_string());
let inputs: Vec<_> = inputs
.into_iter()
.filter_map(|i| match i {
FnArg::Typed(t) => Some(&t.ty),
FnArg::Receiver(_) => None,
})
.collect();
let return_value = match output {
ReturnType::Default => quote! { "unit".to_string() },
ReturnType::Type(_, t) => quote! {
<#t as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &[])
},
};
let rust_name_str = rust_name.to_string();
let fn_name = Ident::new(&format!("{rust_name}_to_ocaml"), Span::call_site());
let new_fn = quote! {
pub fn #fn_name(env: &::ocaml_gen::Env, rename: Option<&'static str>) -> String {
let ocaml_name = rename.unwrap_or(#ocaml_name);
let mut args: Vec<String> = vec![];
#(
args.push(
<#inputs as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &[])
);
);*
let inputs = if args.len() == 0 {
"unit".to_string()
} else {
args.join(" -> ")
};
let return_value = #return_value;
if args.len() <= 5 {
format!(
"external {} : {} -> {} = \"{}\"",
ocaml_name, inputs, return_value, #rust_name_str
)
}
else {
format!(
"external {} : {} -> {} = \"{}_bytecode\" \"{}\"",
ocaml_name, inputs, return_value, #rust_name_str, #rust_name_str
)
}
}
};
let gen = quote! {
#item_fn
#new_fn
};
gen.into()
}
#[proc_macro_derive(Enum)]
pub fn derive_ocaml_enum(item: TokenStream) -> TokenStream {
let item_enum: syn::ItemEnum = syn::parse(item).expect("only enum are supported with Enum");
let generics_ident: Vec<_> = item_enum
.generics
.params
.iter()
.filter_map(|g| match g {
GenericParam::Type(t) => Some(&t.ident),
_ => None,
})
.collect();
let name_str = item_enum.ident.to_string();
let ocaml_desc = quote! {
fn ocaml_desc(env: &::ocaml_gen::Env, generics: &[&str]) -> String {
let mut generics_ocaml: Vec<String> = vec![];
#(
generics_ocaml.push(
<#generics_ident as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, generics)
);
);*
let type_id = <Self as ::ocaml_gen::OCamlDesc>::unique_id();
let (name, aliased) = env.get_type(type_id, #name_str);
if generics_ocaml.is_empty() || aliased {
name.to_string()
} else {
format!("({}) {}", generics_ocaml.join(", "), name)
}
}
};
let unique_id = quote! {
fn unique_id() -> u128 {
::ocaml_gen::const_random!(u128)
}
};
let generics_str: Vec<String> = item_enum
.generics
.params
.iter()
.filter_map(|g| match g {
GenericParam::Type(t) => Some(t.ident.to_string().to_case(Case::Snake)),
_ => None,
})
.collect();
let body = {
let mut variants: Vec<String> = vec![];
let mut punctured_types: Vec<Vec<String>> = vec![];
let mut fields_to_call = vec![];
for variant in &item_enum.variants {
let name = &variant.ident;
variants.push(name.to_string());
let mut types = vec![];
match &variant.fields {
Fields::Named(_f) => panic!("named types not implemented"),
Fields::Unnamed(fields) => {
for field in &fields.unnamed {
if let Some(ty) = is_generic(&generics_str, &field.ty) {
types.push(format!("'{}", ty.to_case(Case::Snake)));
} else {
types.push("#".to_string());
fields_to_call.push(&field.ty);
}
}
}
Fields::Unit => (),
};
punctured_types.push(types);
}
fields_to_call.reverse();
quote! {
let mut generics_ocaml: Vec<String> = vec![];
let variants: Vec<&str> = vec![
#(#variants),*
];
let punctured_types: Vec<Vec<&str>> = vec![
#(
vec![
#(#punctured_types),*
]
),*
];
let mut missing_types: Vec<String> = vec![];
#(
missing_types.push(
<#fields_to_call as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &global_generics)
);
);*
for (name, types) in variants.into_iter().zip(punctured_types) {
let mut fields = vec![];
for ty in types {
if ty != "#" {
fields.push(ty.to_string());
} else {
let ty = missing_types
.pop()
.expect("number of types to call should match number of missing types");
fields.push(ty);
}
}
let tag = if fields.is_empty() {
name.to_string()
} else {
format!("{} of {}", name, fields.join(" * "))
};
generics_ocaml.push(tag);
}
format!("{}", generics_ocaml.join(" | "))
}
};
let ocaml_name = rust_ident_to_ocaml(&name_str);
let ocaml_binding = quote! {
fn ocaml_binding(
env: &mut ::ocaml_gen::Env,
rename: Option<&'static str>,
new_type: bool,
) -> String {
if new_type {
let ty_name = rename.unwrap_or(#ocaml_name);
let ty_id = <Self as ::ocaml_gen::OCamlDesc>::unique_id();
env.new_type(ty_id, ty_name);
}
let global_generics: Vec<&str> = vec![#(#generics_str),*];
let generics_ocaml = {
#body
};
let name = <Self as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &global_generics);
if new_type {
format!("type nonrec {} = {}", name, generics_ocaml)
} else {
format!("type nonrec {} = {}", rename.expect("type alias must have a name"), name)
}
}
};
let (impl_generics, ty_generics, _where_clause) = item_enum.generics.split_for_impl();
let mut extended_generics = item_enum.generics.clone();
extended_generics.make_where_clause();
let mut extended_where_clause = extended_generics.where_clause.unwrap();
let path: syn::Path = syn::parse_str("::ocaml_gen::OCamlDesc").unwrap();
let impl_ocaml_desc = TraitBound {
paren_token: None,
modifier: TraitBoundModifier::None,
lifetimes: None,
path,
};
for generic in &item_enum.generics.params {
if let GenericParam::Type(t) = generic {
let mut bounds = Punctuated::<TypeParamBound, syn::token::Add>::new();
bounds.push(TypeParamBound::Trait(impl_ocaml_desc.clone()));
let path: syn::Path = syn::parse_str(&t.ident.to_string()).unwrap();
let bounded_ty = Type::Path(TypePath { qself: None, path });
extended_where_clause
.predicates
.push(WherePredicate::Type(PredicateType {
lifetimes: None,
bounded_ty,
colon_token: syn::token::Colon {
spans: [Span::call_site()],
},
bounds,
}));
};
}
let name = item_enum.ident;
let gen = quote! {
impl #impl_generics ::ocaml_gen::OCamlDesc for #name #ty_generics #extended_where_clause {
#ocaml_desc
#unique_id
}
impl #impl_generics ::ocaml_gen::OCamlBinding for #name #ty_generics #extended_where_clause {
#ocaml_binding
}
};
gen.into()
}
#[proc_macro_derive(Struct)]
pub fn derive_ocaml_gen(item: TokenStream) -> TokenStream {
let item_struct: syn::ItemStruct =
syn::parse(item).expect("only structs are supported with Struct");
let name = &item_struct.ident;
let generics = &item_struct.generics.params;
let fields = &item_struct.fields;
let generics_ident: Vec<_> = generics
.iter()
.filter_map(|g| match g {
GenericParam::Type(t) => Some(&t.ident),
_ => None,
})
.collect();
let name_str = name.to_string();
let ocaml_desc = quote! {
fn ocaml_desc(env: &::ocaml_gen::Env, generics: &[&str]) -> String {
let mut generics_ocaml: Vec<String> = vec![];
#(
generics_ocaml.push(
<#generics_ident as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, generics)
);
);*
let type_id = <Self as ::ocaml_gen::OCamlDesc>::unique_id();
let (name, aliased) = env.get_type(type_id, #name_str);
if generics_ocaml.is_empty() || aliased {
name.to_string()
} else {
format!("({}) {}", generics_ocaml.join(", "), name)
}
}
};
let unique_id = quote! {
fn unique_id() -> u128 {
::ocaml_gen::const_random!(u128)
}
};
let generics_str: Vec<String> = generics
.iter()
.filter_map(|g| match g {
GenericParam::Type(t) => Some(t.ident.to_string().to_case(Case::Snake)),
_ => None,
})
.collect();
let body = match fields {
Fields::Named(fields) => {
let mut punctured_generics_name: Vec<String> = vec![];
let mut punctured_generics_type: Vec<String> = vec![];
let mut fields_to_call = vec![];
for field in &fields.named {
let name = field.ident.as_ref().expect("a named field has an ident");
punctured_generics_name.push(name.to_string());
if let Some(ty) = is_generic(&generics_str, &field.ty) {
punctured_generics_type.push(format!("'{}", ty.to_case(Case::Snake)));
} else {
punctured_generics_type.push("#".to_string());
fields_to_call.push(&field.ty);
}
}
fields_to_call.reverse();
quote! {
let mut generics_ocaml: Vec<String> = vec![];
let punctured_generics_name: Vec<&str> = vec![
#(#punctured_generics_name),*
];
let punctured_generics_type: Vec<&str> = vec![
#(#punctured_generics_type),*
];
let mut missing_types: Vec<String> = vec![];
#(
missing_types.push(
<#fields_to_call as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &global_generics)
);
);*
for (name, ty) in punctured_generics_name.into_iter().zip(punctured_generics_type) {
if ty != "#" {
generics_ocaml.push(
format!("{}: {}", name, ty.to_string())
);
} else {
let ty = missing_types
.pop()
.expect("number of types to call should match number of missing types");
generics_ocaml.push(
format!("{}: {}", name, ty)
);
}
}
if generics_ocaml.len() == 1 {
format!("{{ {} }} [@@boxed]", generics_ocaml[0])
} else {
format!("{{ {} }}", generics_ocaml.join("; "))
}
}
}
Fields::Unnamed(fields) => {
let mut punctured_generics: Vec<String> = vec![];
let mut fields_to_call = vec![];
for field in &fields.unnamed {
if let Some(ident) = is_generic(&generics_str, &field.ty) {
punctured_generics.push(format!("'{}", ident.to_case(Case::Snake)));
} else {
punctured_generics.push("#".to_string());
fields_to_call.push(&field.ty);
}
}
fields_to_call.reverse();
quote! {
let mut generics_ocaml: Vec<String> = vec![];
let punctured_generics: Vec<&str> = vec![
#(#punctured_generics),*
];
let mut missing_types: Vec<String> = vec![];
#(
missing_types.push(<#fields_to_call as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &global_generics));
);*
for ty in punctured_generics {
if ty != "#" {
generics_ocaml.push(ty.to_string());
} else {
let ident = missing_types
.pop()
.expect("number of types to call should match number of missing types");
generics_ocaml.push(ident);
}
}
if generics_ocaml.len() == 1 {
format!("{{ inner: {} }} [@@boxed]", generics_ocaml[0])
} else {
generics_ocaml.join(" * ")
}
}
}
Fields::Unit => panic!("only named, and unnamed field supported"),
};
let ocaml_name = rust_ident_to_ocaml(&name_str);
let ocaml_binding = quote! {
fn ocaml_binding(
env: &mut ::ocaml_gen::Env,
rename: Option<&'static str>,
new_type: bool,
) -> String {
let ty_id = <Self as ::ocaml_gen::OCamlDesc>::unique_id();
if new_type {
let ty_name = rename.unwrap_or(#ocaml_name);
env.new_type(ty_id, ty_name);
}
let global_generics: Vec<&str> = vec![#(#generics_str),*];
let generics_ocaml = {
#body
};
let name = <Self as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &global_generics);
if new_type {
format!("type nonrec {} = {}", name, generics_ocaml)
} else {
let ty_name = rename.expect("bug in ocaml-gen: rename should be Some");
env.add_alias(ty_id, ty_name);
format!("type nonrec {} = {}", ty_name, name)
}
}
};
let (impl_generics, ty_generics, _where_clause) = item_struct.generics.split_for_impl();
let mut extended_generics = item_struct.generics.clone();
extended_generics.make_where_clause();
let mut extended_where_clause = extended_generics.where_clause.unwrap();
let path: syn::Path = syn::parse_str("::ocaml_gen::OCamlDesc").unwrap();
let impl_ocaml_desc = TraitBound {
paren_token: None,
modifier: TraitBoundModifier::None,
lifetimes: None,
path,
};
for generic in generics {
if let GenericParam::Type(t) = generic {
let mut bounds = Punctuated::<TypeParamBound, syn::token::Add>::new();
bounds.push(TypeParamBound::Trait(impl_ocaml_desc.clone()));
let path: syn::Path = syn::parse_str(&t.ident.to_string()).unwrap();
let bounded_ty = Type::Path(TypePath { qself: None, path });
extended_where_clause
.predicates
.push(WherePredicate::Type(PredicateType {
lifetimes: None,
bounded_ty,
colon_token: syn::token::Colon {
spans: [Span::call_site()],
},
bounds,
}));
};
}
let gen = quote! {
impl #impl_generics ::ocaml_gen::OCamlDesc for #name #ty_generics #extended_where_clause {
#ocaml_desc
#unique_id
}
impl #impl_generics ::ocaml_gen::OCamlBinding for #name #ty_generics #extended_where_clause {
#ocaml_binding
}
};
gen.into()
}
#[proc_macro_derive(CustomType)]
pub fn derive_ocaml_custom(item: TokenStream) -> TokenStream {
let item_struct: syn::ItemStruct =
syn::parse(item).expect("only structs are supported at the moment");
let name = &item_struct.ident;
let name_str = name.to_string();
let ocaml_desc = quote! {
fn ocaml_desc(env: &::ocaml_gen::Env, _generics: &[&str]) -> String {
let type_id = <Self as ::ocaml_gen::OCamlDesc>::unique_id();
env.get_type(type_id, #name_str).0
}
};
let unique_id = quote! {
fn unique_id() -> u128 {
::ocaml_gen::const_random!(u128)
}
};
let ocaml_name = rust_ident_to_ocaml(&name_str);
let ocaml_binding = quote! {
fn ocaml_binding(
env: &mut ::ocaml_gen::Env,
rename: Option<&'static str>,
new_type: bool,
) -> String {
let ty_id = <Self as ::ocaml_gen::OCamlDesc>::unique_id();
if new_type {
let ty_name = rename.unwrap_or(#ocaml_name);
env.new_type(ty_id, ty_name);
}
let name = <Self as ::ocaml_gen::OCamlDesc>::ocaml_desc(env, &[]);
if new_type {
format!("type nonrec {}", name)
} else {
let ty_name = rename.expect("bug in ocaml-gen: rename should be Some");
env.add_alias(ty_id, ty_name);
format!("type nonrec {} = {}", ty_name, name)
}
}
};
let (impl_generics, ty_generics, where_clause) = item_struct.generics.split_for_impl();
let gen = quote! {
impl #impl_generics ::ocaml_gen::OCamlDesc for #name #ty_generics #where_clause {
#ocaml_desc
#unique_id
}
impl #impl_generics ::ocaml_gen::OCamlBinding for #name #ty_generics #where_clause {
#ocaml_binding
}
};
gen.into()
}
fn rust_ident_to_ocaml(ident: &str) -> String {
ident.to_case(Case::Snake)
}
fn is_generic(generics: &[String], ty: &Type) -> Option<String> {
if let Type::Path(p) = ty {
if let Some(ident) = p.path.get_ident() {
let ident = ident.to_string();
if generics.contains(&ident) {
return Some(ident);
}
}
}
None
}