Шаг к перестройке сверху — функции-патчи (#362)

bmstu-iu9 · Sep 1, 2021 · b2862c6 · b2862c6
1 parent 750aef6
commit b2862c6
Show file tree

Hide file tree

Showing 3 changed files with 43 additions and 35 deletions.
diff --git a/src/compiler/Log-AST.ref b/src/compiler/Log-AST.ref
@@ -27,6 +27,7 @@ Element {
   (Entries e.Names) = <Log-EntryList e.Names>;
 
   (Function (e.Name) e.Body) = <Function (e.Name) e.Body>;
+  (PatchFunc (e.Name) e.Body) = <PatchFunc (e.Name) e.Body>;
   (ColdFunction s.ColdBy (e.Name) e.Body)
     = <ColdFunction s.ColdBy (e.Name) e.Body>;
 
@@ -109,6 +110,10 @@ Function {
   (e.Name) e.Body = <Function-Aux (<DisplayName e.Name>) e.Body>;
 }
 
+PatchFunc {
+  (e.Name) e.Body = <Function-Aux ('$PATCH '<DisplayName e.Name>) e.Body>;
+}
+
 ColdFunction {
   s.ColdBy (e.Name) e.Body
     = <Function (e.Name) e.Body>

diff --git a/src/compiler/OptTree-Spec.ref b/src/compiler/OptTree-Spec.ref
@@ -844,19 +844,16 @@ SpecCall-NewSignature-Generalize {
       = <NameSignatureVars-Expr (e.UsedVars) e.GenSignature>
       : (e.UsedVars^) e.GenSignature^
 
+      = <GenericMatch (e.HistorySignature) (e.GenSignature)> : Clear e.PatchSg
       = <GenericMatch (e.NewArg) (e.GenSignature)> : Clear e.NewSg
 
-      = <IsTrivialSubstitutions e.NewSg>
-      : {
-          /*
-            Если подстановка e.NewSg является тривиальной, проверку
-            отношения Хигмана-Крускала в рекурсивном вызове не выполняем
-          */
-          True = &SpecCall-BuildSignature-False;
-
-          False = &SpecCall-BuildSignature-True;
-        }
-      : s.SpecCall-BuildSignature
+      = <Map
+          {
+            (e.Expr ':' (s.Mode e.Index)) = (e.Expr ':' (Var s.Mode e.Index))
+          }
+          e.PatchSg
+        >
+      : e.PatchSg^
 
       = <Map
           {
@@ -866,11 +863,38 @@ SpecCall-NewSignature-Generalize {
         >
       : e.NewSg^
 
-      = <s.SpecCall-BuildSignature
+      = <SpecCall-BuildSignature-False
           (e.Name) (e.Body) s.NextNumber e.Signatures (e.UsedVars)
           (e.OldArg) (e.GenSignature) (e.NewSg e.Sg)
           (e.History-B)
-        >;
+        >
+      : {
+          (e.SpecInfo) t.NewCall /* нет новых функций */ (e.NewHistory)
+            = (e.SpecInfo) t.NewCall /* нет новых функций */ (e.NewHistory);
+
+          (e.SpecInfo) t.NewCall
+          (Function (e.NewName) Sentences e.NewBody)
+          (e.NewHistory)
+            = (e.SpecInfo) t.NewCall
+              (Function (e.NewName) Sentences e.NewBody)
+              (PatchFunc
+                (e.HistoryName)
+                Sentences
+                (
+                  (<WrapVars e.HistorySignature>)
+                  /* = */
+                  (
+                    (CallBrackets
+                      (Symbol Name e.NewName)
+                      <ApplySequentalAssigns
+                        <WrapVars e.GenSignature> (e.PatchSg)
+                      >
+                    )
+                  )
+                )
+              )
+              (e.NewHistory)
+      }
 }
 
 SpecCall-NewSignature-MakeFunction {
@@ -999,28 +1023,6 @@ FindInSignatures {
   (e.Signature) e.Signatures = NotFound e.Signatures;
 }
 
-/**
-  <IsTrivialSubstitutions e.StaticMatches>
-*/
-IsTrivialSubstitutions {
-  e.StaticMatches
-    = <Reduce
-        {
-          False t.Any = False;
-
-          True ((Var s.Mode e.Index1) ':' (Var s.Mode e.Index2))
-            = True;
-
-          True ((Var s.Mode e.Index1) ':' (s.Mode e.Index2))
-            = True;
-
-          True t.OtherSubstitution = False;
-        }
-        True
-        e.StaticMatches
-      >;
-}
-
 CreateNewSentences {
   (e.Arg) (e.NewSentences) (e.Solutions) (e.Body)
     = <WrapVars e.Arg> : e.PatternTemplate

diff --git a/src/compiler/OptTree.ref b/src/compiler/OptTree.ref
@@ -106,6 +106,7 @@ $ENTRY OptTree-CleanupMarkup {
           (Specs e.Names) = /* пропускаем */;
           (NoDrives e.Names) = /* пропускаем */;
           (NoSpecs e.Names) = /* пропускаем */;
+          (PatchFunc e._) = /* пропускаем */;
 
           (DriveInfo e.Info) = /* пропускаем */;
           (SpecInfo e.Info) = /* пропускаем */;