Added basic support for ML-Lex and ML-Yacc files to CM file parser (#60)

crates/cm-syntax/src/lower.rs

@@ -16,6 +16,8 @@ pub(crate) fn get(root: ParseRoot) -> Result<CmFile> {
     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))

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<Self> {
     let ext = path.extension()?.to_str()?;
-    let ret = if ext == "cm" { Self::Cm } else { Self::Sml(ext.parse().ok()?) };
-    Some(ret)
+    match ext.parse::<sml_file::Kind>() {
+      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),
     }

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<CleanPathBuf> {
+  let path =
+    path.extension()?.to_str().map(|ext| path.with_extension(format!("{ext}.{extension2}")));
+  CleanPathBuf::new(path?)
+}
+
 fn get_one_cm_file<F>(
   st: &mut St<'_, F>,
   ret: &mut CmFile,
@@ -131,6 +139,50 @@ fn get_one_cm_file<F>(
         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) {

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 =