<commit_before>%%%
%%% Author:
%%%   <NAME> <<EMAIL>>
%%%
%%% Copyright:
%%%   <NAME>, 1998
%%%
%%% Last change:
%%%   $Date$ by $Author$
%%%   $Revision$
%%%
%%% This file is part of Mozart, an implementation of Oz 3:
%%%    http://mozart.ps.uni-sb.de
%%%
%%% See the file "LICENSE" or
%%%    http://mozart.ps.uni-sb.de/LICENSE.html
%%% for information on usage and redistribution
%%% of this file, and for a DISCLAIMER OF ALL
%%% WARRANTIES.
%%%

%%
%% Clause = Pattern#Statement
%% Pattern = [Pos#Test]
%% Pos = [FeatureV]
%% Test = scalar(Scalar)
%%      | record(Label Arity)
%%      | get([Feature#Reg])
%%      | nonbasic(LabelV ArityV)
%%      | label(LabelV)
%%      | feature(FeatureV)
%%      | equal(Pos)
%%      | constant(VariableOccurrence)
%%      | expr(SideCondition)
%%
%% Scalar = number
%%        | literal
%%
%% Label = literal
%% Arity = int
%%       | [Feature]   % must be sorted
%% Feature = int
%%         | literal
%%
%% LabelV = Label | VariableOccurrence
%% ArityV = [FeatureV]   % variables to the back, sorted by printname
%% FeatureV = Feature | VariableOccurrence
%%
%% Tree = node(Pos Test Tree Tree Count Shared)
%%      | leaf(Statement Shared)
%%      | default
%% Count = cell
%% Shared = VInstr   % vShared(...)
%%

local
   fun {PosSmaller Pos1 Pos2}
      case Pos1 of I|Ir then
         case Pos2 of J|Jr then
            {CompilerSupport.featureLess I J} orelse
            I == J andthen {PosSmaller Ir Jr}
         [] nil then false
         end
      [] nil then true
      end
   end

   fun {MayMoveOver Test1 Test2}
      case Test1 of scalar(L1) then
         case Test2 of scalar(L2) then L1 \= L2
         [] record(_ _) then true
         [] nonbasic(_ _) then true
         [] label(L2) then {IsLiteral L2} andthen L1 \= L2
         else false
         end
      [] record(L1 _) then
         case Test2 of scalar(_) then true
         [] record(_ _) then Test1 \= Test2
         [] nonbasic(_ _) then
            %--** this approximation could be improved
            false
         [] label(L2) then
            {IsLiteral L1} andthen {IsLiteral L2} andthen L1 \= L2
         else false
         end
      [] nonbasic(_ _) then
         %--** this approximation could be improved
         false
      [] label(L1) then
         {IsLiteral L1} andthen
         case Test2 of scalar(L2) then L1 \= L2
         [] record(L2 _) then L1 \= L2
         [] nonbasic(L2 _) then {IsLiteral L2} andthen L1 \= L2
         [] label(L2) then
            %--** this could be more fine-grained by considering features
            {IsLiteral L2} andthen L1 \= L2
         else false
         end
      else false
      end
   end

   fun {FindPos Tree Pos0 ?NewTree ?Hole ?RestTree}
      case Tree of node(Pos Test ThenTree ElseTree Count Shared) then
         if Pos == Pos0 then
            NewTree = Hole
            RestTree = Tree
            true
         elseif {PosSmaller Pos Pos0} then NewElseTree in
            NewTree = node(Pos Test ThenTree NewElseTree Count Shared)
            {FindPos ElseTree Pos0 ?NewElseTree ?Hole ?RestTree}
         else
            NewTree = Hole
            RestTree = Tree
            false
         end
      else
         NewTree = Hole
         RestTree = Tree
         false
      end
   end

   fun {FindTest Tree Pos0 Test0 ?NewTree ?Hole ?RestTree}
      case Tree of node(Pos Test ThenTree ElseTree Count Shared) then
         if Pos \= Pos0 then false
         elseif Test == Test0 then
            NewTree = node(Pos Test Hole ElseTree Count Shared)
            RestTree = ThenTree
            true
         elseif {MayMoveOver Test0 Test} then NewElseTree in
            if {FindTest ElseTree Pos0 Test0 ?NewElseTree ?Hole ?RestTree} then
               NewTree = node(Pos Test ThenTree NewElseTree Count Shared)
               true
            else false
            end
         else false
         end
      else false
      end
   end

   fun {PatternToTree Pattern Then}
      case Pattern of nil then
         leaf(Then _)
      [] Pos#Test|Rest then
         node(Pos Test {PatternToTree Rest Then} default {NewCell 0} _)
      end
   end

   proc {MergeSub Pattern Then Tree ?NewTree}
      case Pattern of nil then
         %% Tree is unreachable
         NewTree = leaf(Then _)
      [] Pos#Test|Rest then Hole1 RestTree1 Hole RestTree in
         if {FindPos Tree Pos ?NewTree ?Hole1 ?RestTree1}
            andthen {FindTest RestTree1 Pos Test ?Hole1 ?Hole ?RestTree}
         then
            Hole = {MergeSub Rest Then RestTree}
         else ThenTree in
            ThenTree = {PatternToTree Rest Then}
            Hole1 = node(Pos Test ThenTree RestTree1 {NewCell 0} _)
         end
      end
   end

   fun {MergePatternIntoTree Pattern#Then Tree}
      {MergeSub Pattern Then Tree}
   end

   fun {ClipTree Pos0 Test0 Tree}
      case Tree of node(Pos Test _ ElseTree _ _) then
         if Pos == Pos0 andthen {MayMoveOver Test0 Test} then
            {ClipTree Pos0 Test0 ElseTree}
         else
            Tree
         end
      [] leaf(_ _) then
         Tree
      end
   end

   fun {PropagateElses Tree DefaultTree}
      case Tree of node(Pos Test ThenTree ElseTree Count Shared) then
         NewElseTree NewDefaultTree NewThenTree
      in
         NewElseTree = {PropagateElses ElseTree DefaultTree}
         NewDefaultTree = {ClipTree Pos Test NewElseTree}
         NewThenTree = {PropagateElses ThenTree NewDefaultTree}
         node(Pos Test NewThenTree NewElseTree Count Shared)
      [] leaf(_ _) then
         Tree<commit_msg>Bug fix: order of clauses is preserved, i.e., the following now works:    proc {_ X Y}       case X#Y of no#_ then skip       [] _#no then skip       [] yes(A)#_ then skip       end    end<commit_after>%%%
%%% Author:
%%%   <NAME> <<EMAIL>>
%%%
%%% Copyright:
%%%   <NAME>, 1998
%%%
%%% Last change:
%%%   $Date$ by $Author$
%%%   $Revision$
%%%
%%% This file is part of Mozart, an implementation of Oz 3:
%%%    http://mozart.ps.uni-sb.de
%%%
%%% See the file "LICENSE" or
%%%    http://mozart.ps.uni-sb.de/LICENSE.html
%%% for information on usage and redistribution
%%% of this file, and for a DISCLAIMER OF ALL
%%% WARRANTIES.
%%%

%%
%% Clause = Pattern#Statement
%% Pattern = [Pos#Test]
%% Pos = [FeatureV]
%% Test = scalar(Scalar)
%%      | record(Label Arity)
%%      | get([Feature#Reg])
%%      | nonbasic(LabelV ArityV)
%%      | label(LabelV)
%%      | feature(FeatureV)
%%      | equal(Pos)
%%      | constant(VariableOccurrence)
%%      | expr(SideCondition)
%%
%% Scalar = number
%%        | literal
%%
%% Label = literal
%% Arity = int
%%       | [Feature]   % must be sorted
%% Feature = int
%%         | literal
%%
%% LabelV = Label | VariableOccurrence
%% ArityV = [FeatureV]   % variables to the back, sorted by printname
%% FeatureV = Feature | VariableOccurrence
%%
%% Tree = node(Pos Test Tree Tree Count Shared)
%%      | leaf(Statement Shared)
%%      | default
%% Count = cell
%% Shared = VInstr   % vShared(...)
%%

local
   fun {MayMoveOver Test1 Test2}
      case Test1 of scalar(L1) then
         case Test2 of scalar(L2) then L1 \= L2
         [] record(_ _) then true
         [] nonbasic(_ _) then true
         [] label(L2) then {IsLiteral L2} andthen L1 \= L2
         else false
         end
      [] record(L1 _) then
         case Test2 of scalar(_) then true
         [] record(_ _) then Test1 \= Test2
         [] nonbasic(_ _) then
            %--** this approximation could be improved
            false
         [] label(L2) then
            {IsLiteral L1} andthen {IsLiteral L2} andthen L1 \= L2
         else false
         end
      [] nonbasic(_ _) then
         %--** this approximation could be improved
         false
      [] label(L1) then
         {IsLiteral L1} andthen
         case Test2 of scalar(L2) then L1 \= L2
         [] record(L2 _) then L1 \= L2
         [] nonbasic(L2 _) then {IsLiteral L2} andthen L1 \= L2
         [] label(L2) then
            %--** this could be more fine-grained by considering features
            {IsLiteral L2} andthen L1 \= L2
         else false
         end
      else false
      end
   end

   fun {FindTest Tree Pos0 Test0 ?NewTree ?Hole ?RestTree}
      case Tree of node(Pos Test ThenTree ElseTree Count Shared) then
         if Pos \= Pos0 then false
         elseif Test == Test0 then
            NewTree = node(Pos Test Hole ElseTree Count Shared)
            RestTree = ThenTree
            true
         elseif {MayMoveOver Test0 Test} then NewElseTree in
            if {FindTest ElseTree Pos0 Test0 ?NewElseTree ?Hole ?RestTree} then
               NewTree = node(Pos Test ThenTree NewElseTree Count Shared)
               true
            else false
            end
         else false
         end
      else false
      end
   end

   fun {PatternToTree Pattern Then}
      case Pattern of nil then
         leaf(Then _)
      [] Pos#Test|Rest then
         node(Pos Test {PatternToTree Rest Then} default {NewCell 0} _)
      end
   end

   proc {MergeSub Pattern Then Tree ?NewTree}
      case Pattern of nil then
         %% Tree is unreachable
         NewTree = leaf(Then _)
      [] Pos#Test|Rest then
         case Tree of node(!Pos _ _ _ _ _) andthen Hole RestTree in
            {FindTest Tree Pos Test ?NewTree ?Hole ?RestTree}
         then
            Hole = {MergeSub Rest Then RestTree}
         else ThenTree in
            ThenTree = {PatternToTree Rest Then}
            NewTree = node(Pos Test ThenTree Tree {NewCell 0} _)
         end
      end
   end

   fun {MergePatternIntoTree Pattern#Then Tree}
      {MergeSub Pattern Then Tree}
   end

   fun {ClipTree Pos0 Test0 Tree}
      case Tree of node(Pos Test _ ElseTree _ _) then
         if Pos == Pos0 andthen {MayMoveOver Test0 Test} then
            {ClipTree Pos0 Test0 ElseTree}
         else
            Tree
         end
      [] leaf(_ _) then
         Tree
      end
   end

   fun {PropagateElses Tree DefaultTree}
      case Tree of node(Pos Test ThenTree ElseTree Count Shared) then
         NewElseTree NewDefaultTree NewThenTree
      in
         NewElseTree = {PropagateElses ElseTree DefaultTree}
         NewDefaultTree = {ClipTree Pos Test NewElseTree}
         NewThenTree = {PropagateElses ThenTree NewDefaultTree}
         node(Pos Test NewThenTree NewElseTree Count Shared)
      [] leaf(_ _) then
         Tree
{'fraction_non_alphanumeric': 0.09293357755711945, 'fraction_numerical': 0.012725344644750796, 'mean_word_length': 1.9589275527666856, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5263090', 'n_tokens_mistral': 3176, 'n_tokens_neox': 3065, 'n_words': 1042}