<commit_before>(* Copyright (c) 2008, <NAME>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *
 * - Redistributions of source code must retain the above copyright notice,
 *   this list of conditions and the following disclaimer.
 * - Redistributions in binary form must reproduce the above copyright notice,
 *   this list of conditions and the following disclaimer in the documentation
 *   and/or other materials provided with the distribution.
 * - The names of contributors may not be used to endorse or promote products
 *   derived from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 *)

structure CoreUtil :> CORE_UTIL = struct

open Core

structure S = Search

structure Kind = struct

open Order

fun compare ((k1, _), (k2, _)) =
    case (k1, k2) of
        (KType, KType) => EQUAL
      | (KType, _) => LESS
      | (_, KType) => GREATER

      | (KArrow (d1, r1), KArrow (d2, r2)) => join (compare (d1, d2), fn () => compare (r1, r2))
      | (KArrow _, _) => LESS
      | (_, KArrow _) => GREATER

      | (KName, KName) => EQUAL
      | (KName, _) => LESS
      | (_, KName) => GREATER

      | (KRecord k1, KRecord k2) => compare (k1, k2)
      | (KRecord _, _) => LESS
      | (_, KRecord _) => GREATER

      | (KUnit, KUnit) => EQUAL
      | (KUnit, _) => LESS
      | (_, KUnit) => GREATER

      | (KTuple ks1, KTuple ks2) => joinL compare (ks1, ks2)

fun mapfold f =
    let
        fun mfk k acc =
            S.bindP (mfk' k acc, f)

        and mfk' (kAll as (k, loc)) =
            case k of
                KType => S.return2 kAll

              | KArrow (k1, k2) =>
                S.bind2 (mfk k1,
                      fn k1' =>
                         S.map2 (mfk k2,
                              fn k2' =>
                                 (KArrow (k1', k2'), loc)))

              | KName => S.return2 kAll

              | KRecord k =>
                S.map2 (mfk k,
                        fn k' =>
                           (KRecord k', loc))

              | KUnit => S.return2 kAll

              | KTuple ks =>
                S.map2 (ListUtil.mapfold mfk ks,
                        fn ks' =>
                           (KTuple ks', loc))
    in
        mfk
    end

fun map f k =
    case mapfold (fn k => fn () => S.Continue (f k, ())) k () of
        S.Return () => raise Fail "Core_util.Kind.map"
      | S.Continue (k, ()) => k

fun exists f k =
    case mapfold (fn k => fn () =>
                             if f k then
                                 S.Return ()
                             else
                                 S.Continue (k, ())) k () of
        S.Return _ => true
      | S.Continue _ => false

end

structure Con = struct

open Order

fun compare ((c1, _), (c2, _)) =
    case (c1, c2) of
        (TFun (d1, r1), TFun (d2, r2)) => join (compare (d1, d2), fn () => compare (r1, r2))
      | (TFun _, _) => LESS
      | (_, TFun _) => GREATER

      | (TCFun (x1, k1, r1), TCFun (x2, k2, r2)) =>
        join (String.compare (x1, x2),
           fn () => join (Kind.compare (k1, k2),
                          fn () => compare (r1, r2)))
      | (TCFun _, _) => LESS
      | (_, TCFun _) => GREATER

      | (TRecord c1, TRecord c2) => compare (c1, c2)
      | (TRecord _, _) => LESS
      | (_, TRecord _) => GREATER

      | (CRel n1, CRel n2) => Int.compare (n1, n2)
      | (CRel _, _) => LESS
      | (_, CRel _) => GREATER

      | (CNamed n1, CNamed n2) => Int.compare (n1, n2)
      | (CNamed _, _) => LESS
      | (_, CNamed _) => GREATER

      | (CFfi (m1, s1), CFfi (m2, s2)) => join (String.compare (m1, m2),
                                                fn () => String.compare (s1, s2))
      | (CFfi _, _) => LESS
      | (_, CFfi _) => GREATER

      | (CApp (f1, x1), CApp (f2, x2)) => join (compare (f1, f2),
                                                fn () => compare (x1, x2))
      | (CApp _, _) => LESS
      | (_, CApp _) => GREATER

      | (CAbs (x1, k1, b1), CAbs (x2, k2, b2)) =>
        join (String.compare (x1, x2),
              fn () => join (Kind.compare (k1, k2),
                             fn () => compare (b1, b2)))
      | (CAbs _, _) => LESS
      | (_, CAbs _) => GREATER

      | (CName s1, CName s2) => String.compare (s1, s2)
      | (CName _, _) => LESS
      | (_, CName _) => GREATER

      | (CRecord (k1, xvs1), CRecord (k2, xvs2)) =>
        join (Kind.compare (k1, k2),
              fn () => joinL (fn ((x1, v1), (x2, v2)) =>
                                 join (compare (x1, x2),
                                       fn () => compare (v1, v2))) (xvs1, xvs2))
      | (CRecord _, _) => LESS
      | (_, CRecord _) => GREATER

      | (CConcat (f1, s1), CConcat (f2, s2)) =>
        join (compare (f1, f2),<commit_msg>Fix Core con comparison<commit_after>(* Copyright (c) 2008, <NAME>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *
 * - Redistributions of source code must retain the above copyright notice,
 *   this list of conditions and the following disclaimer.
 * - Redistributions in binary form must reproduce the above copyright notice,
 *   this list of conditions and the following disclaimer in the documentation
 *   and/or other materials provided with the distribution.
 * - The names of contributors may not be used to endorse or promote products
 *   derived from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 *)

structure CoreUtil :> CORE_UTIL = struct

open Core

structure S = Search

structure Kind = struct

open Order

fun compare ((k1, _), (k2, _)) =
    case (k1, k2) of
        (KType, KType) => EQUAL
      | (KType, _) => LESS
      | (_, KType) => GREATER

      | (KArrow (d1, r1), KArrow (d2, r2)) => join (compare (d1, d2), fn () => compare (r1, r2))
      | (KArrow _, _) => LESS
      | (_, KArrow _) => GREATER

      | (KName, KName) => EQUAL
      | (KName, _) => LESS
      | (_, KName) => GREATER

      | (KRecord k1, KRecord k2) => compare (k1, k2)
      | (KRecord _, _) => LESS
      | (_, KRecord _) => GREATER

      | (KUnit, KUnit) => EQUAL
      | (KUnit, _) => LESS
      | (_, KUnit) => GREATER

      | (KTuple ks1, KTuple ks2) => joinL compare (ks1, ks2)

fun mapfold f =
    let
        fun mfk k acc =
            S.bindP (mfk' k acc, f)

        and mfk' (kAll as (k, loc)) =
            case k of
                KType => S.return2 kAll

              | KArrow (k1, k2) =>
                S.bind2 (mfk k1,
                      fn k1' =>
                         S.map2 (mfk k2,
                              fn k2' =>
                                 (KArrow (k1', k2'), loc)))

              | KName => S.return2 kAll

              | KRecord k =>
                S.map2 (mfk k,
                        fn k' =>
                           (KRecord k', loc))

              | KUnit => S.return2 kAll

              | KTuple ks =>
                S.map2 (ListUtil.mapfold mfk ks,
                        fn ks' =>
                           (KTuple ks', loc))
    in
        mfk
    end

fun map f k =
    case mapfold (fn k => fn () => S.Continue (f k, ())) k () of
        S.Return () => raise Fail "Core_util.Kind.map"
      | S.Continue (k, ()) => k

fun exists f k =
    case mapfold (fn k => fn () =>
                             if f k then
                                 S.Return ()
                             else
                                 S.Continue (k, ())) k () of
        S.Return _ => true
      | S.Continue _ => false

end

structure Con = struct

open Order

fun compare ((c1, _), (c2, _)) =
    case (c1, c2) of
        (TFun (d1, r1), TFun (d2, r2)) => join (compare (d1, d2), fn () => compare (r1, r2))
      | (TFun _, _) => LESS
      | (_, TFun _) => GREATER

      | (TCFun (x1, k1, r1), TCFun (x2, k2, r2)) =>
        join (String.compare (x1, x2),
           fn () => join (Kind.compare (k1, k2),
                          fn () => compare (r1, r2)))
      | (TCFun _, _) => LESS
      | (_, TCFun _) => GREATER

      | (TRecord c1, TRecord c2) => compare (c1, c2)
      | (TRecord _, _) => LESS
      | (_, TRecord _) => GREATER

      | (CRel n1, CRel n2) => Int.compare (n1, n2)
      | (CRel _, _) => LESS
      | (_, CRel _) => GREATER

      | (CNamed n1, CNamed n2) => Int.compare (n1, n2)
      | (CNamed _, _) => LESS
      | (_, CNamed _) => GREATER

      | (CFfi (m1, s1), CFfi (m2, s2)) => join (String.compare (m1, m2),
                                                fn () => String.compare (s1, s2))
      | (CFfi _, _) => LESS
      | (_, CFfi _) => GREATER

      | (CApp (f1, x1), CApp (f2, x2)) => join (compare (f1, f2),
                                                fn () => compare (x1, x2))
      | (CApp _, _) => LESS
      | (_, CApp _) => GREATER

      | (CAbs (x1, k1, b1), CAbs (x2, k2, b2)) =>
        join (String.compare (x1, x2),
              fn () => join (Kind.compare (k1, k2),
                             fn () => compare (b1, b2)))
      | (CAbs _, _) => LESS
      | (_, CAbs _) => GREATER

      | (CName s1, CName s2) => String.compare (s1, s2)
      | (CName _, _) => LESS
      | (_, CName _) => GREATER

      | (CRecord (k1, xvs1), CRecord (k2, xvs2)) =>
        join (Kind.compare (k1, k2),
              fn () =>
                 let
                     val sort = ListMergeSort.sort (fn ((x1, _), (x2, _)) =>
                                                       compare (x1, x2) = GREATER)
                 in
                     joinL (fn ((x1, v1), (x2, v2)) =>
                               join (compare (x1, x2),
                                  fn () => compare (v1, v2))) (sort xvs1, sort xvs2)
                 end)
      | (CRecord _, _) => LESS
      | (_, CRecord _) => GREATER

      | (CConcat (f1, s1), CConcat (f2, s2)) =>
        join (compare (f1, f2),
{'fraction_non_alphanumeric': 0.131171512127989, 'fraction_numerical': 0.022535695854120075, 'mean_word_length': 1.641299409359382, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 160, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 24, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2177860', 'n_tokens_mistral': 3956, 'n_tokens_neox': 3725, 'n_words': 1241}