diff --git a/crates/cm-syntax/src/lower.rs b/crates/cm-syntax/src/lower.rs index 3797a9cb3..6ed755b90 100644 --- a/crates/cm-syntax/src/lower.rs +++ b/crates/cm-syntax/src/lower.rs @@ -16,6 +16,8 @@ pub(crate) fn get(root: ParseRoot) -> Result { let kind = match cls { Some(class) => match class.val { Class::Sml(k) => PathKind::Sml(k), + Class::MlLex => PathKind::MlLex, + Class::MlYacc => PathKind::MlYacc, Class::Cm => PathKind::Cm, Class::Other(s) => { return Err(Error::new(ErrorKind::UnsupportedClass(path, s), class.range)) diff --git a/crates/cm-syntax/src/types.rs b/crates/cm-syntax/src/types.rs index fcc413d55..2846c2c4a 100644 --- a/crates/cm-syntax/src/types.rs +++ b/crates/cm-syntax/src/types.rs @@ -122,6 +122,10 @@ pub enum CmFileKind { pub enum PathKind { /// SML files. Sml(sml_file::Kind), + /// ML-Lex files. + MlLex, + /// ML-Yacc files. + MlYacc, /// CM files. Cm, } @@ -221,6 +225,10 @@ impl Member { pub enum Class { /// SML files. Sml(sml_file::Kind), + /// ML-Lex files. + MlLex, + /// ML-Yacc files. + MlYacc, /// CM files. Cm, /// Some other class. @@ -230,8 +238,15 @@ pub enum Class { impl Class { fn from_path(path: &Path) -> Option { let ext = path.extension()?.to_str()?; - let ret = if ext == "cm" { Self::Cm } else { Self::Sml(ext.parse().ok()?) }; - Some(ret) + match ext.parse::() { + Ok(kind) => Some(Self::Sml(kind)), + Err(_) => match ext { + "cm" => Some(Self::Cm), + "y" | "grm" => Some(Self::MlYacc), + "l" | "lex" => Some(Self::MlLex), + _ => None, + }, + } } } @@ -252,6 +267,8 @@ impl fmt::Display for Class { fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { match self { Class::Sml(_) => f.write_str("sml"), + Class::MlLex => f.write_str("lex"), + Class::MlYacc => f.write_str("grm"), Class::Cm => f.write_str("cm"), Class::Other(s) => f.write_str(s), } diff --git a/crates/input/src/lower_cm.rs b/crates/input/src/lower_cm.rs index d3b9fa69b..5aad8046d 100644 --- a/crates/input/src/lower_cm.rs +++ b/crates/input/src/lower_cm.rs @@ -6,7 +6,8 @@ use crate::util::{ StartedGroup, }; use fast_hash::FxHashSet; -use paths::PathMap; +use paths::{CleanPathBuf, PathMap}; +use sml_file::Kind; use std::collections::BTreeMap; use text_size_util::{TextRange, WithRange}; @@ -108,6 +109,13 @@ where Ok(()) } +/// Append a second extension to a path (keeping the original extension) +fn append_extension(path: &std::path::Path, extension2: &str) -> Option { + let path = + path.extension()?.to_str().map(|ext| path.with_extension(format!("{ext}.{extension2}"))); + CleanPathBuf::new(path?) +} + fn get_one_cm_file( st: &mut St<'_, F>, ret: &mut CmFile, @@ -131,6 +139,50 @@ fn get_one_cm_file( st.sources.insert(path_id, contents); ret.sml_paths.insert((path_id, kind)); } + cm_syntax::PathKind::MlLex => { + let Some(lex_sml_path) = append_extension(path.as_path(), "sml") else { + continue; + }; + let contents = match read_file(st.fs, source, lex_sml_path.as_path()) { + Ok(x) => x, + Err(e) => { + st.errors.push(e); + continue; + } + }; + let path_id = st.paths.get_id_owned(lex_sml_path); + st.sources.insert(path_id, contents); + ret.sml_paths.insert((path_id, Kind::Sml)); + } + cm_syntax::PathKind::MlYacc => { + let Some(yacc_sig_path) = append_extension(path.as_path(), "sig") else { + continue; + }; + let contents = match read_file(st.fs, source.clone(), yacc_sig_path.as_path()) { + Ok(x) => x, + Err(e) => { + st.errors.push(e); + continue; + } + }; + let path_id = st.paths.get_id_owned(yacc_sig_path); + st.sources.insert(path_id, contents); + ret.sml_paths.insert((path_id, Kind::Sig)); + + let Some(yacc_sml_path) = append_extension(path.as_path(), "sml") else { + continue; + }; + let contents = match read_file(st.fs, source, yacc_sml_path.as_path()) { + Ok(x) => x, + Err(e) => { + st.errors.push(e); + continue; + } + }; + let path_id = st.paths.get_id_owned(yacc_sml_path); + st.sources.insert(path_id, contents); + ret.sml_paths.insert((path_id, Kind::Sml)); + } cm_syntax::PathKind::Cm => { let cur = GroupPathToProcess { parent: cur_path_id, range: source.range, path: path_id }; match get_one(st, cur) { diff --git a/crates/tests/src/input/cm/syntax.rs b/crates/tests/src/input/cm/syntax.rs index 6ef56c529..a82b796f4 100644 --- a/crates/tests/src/input/cm/syntax.rs +++ b/crates/tests/src/input/cm/syntax.rs @@ -134,6 +134,70 @@ is ); } +#[test] +fn ml_lex_file() { + check( + r" +Library + functor TigerLexerFun +is + lexer.lex +", + vec![mk_name(Namespace::Functor, "TigerLexerFun")], + &[("lexer.lex", PathKind::MlLex)], + ); +} + +#[test] +fn ml_lex_l_file() { + check( + r" +Library + functor TigerLexerFun +is + lexer.l +", + vec![mk_name(Namespace::Functor, "TigerLexerFun")], + &[("lexer.l", PathKind::MlLex)], + ); +} + +#[test] +fn ml_yacc_file() { + check( + r" +Library + functor TigerLrValsFun + signature Tiger_TOKENS +is + parser.grm +", + vec![ + mk_name(Namespace::Functor, "TigerLrValsFun"), + mk_name(Namespace::Signature, "Tiger_TOKENS"), + ], + &[("parser.grm", PathKind::MlYacc)], + ); +} + +#[test] +fn ml_yacc_y_file() { + check( + r" +Library + functor TigerLrValsFun + signature Tiger_TOKENS +is + parser.y +", + vec![ + mk_name(Namespace::Functor, "TigerLrValsFun"), + mk_name(Namespace::Signature, "Tiger_TOKENS"), + ], + &[("parser.y", PathKind::MlYacc)], + ); +} + #[test] fn unknown_class() { let e =