From ea7b6562f41b4f8845828db7ee10e1f9036752e4 Mon Sep 17 00:00:00 2001
From: Marvin Borner
Date: Tue, 30 Aug 2022 16:14:09 +0200
Subject: Fixed mixfix matching

---
 src/Eval.hs | 27 ++++++++++++++++++++-------
 1 file changed, 20 insertions(+), 7 deletions(-)

(limited to 'src/Eval.hs')

diff --git a/src/Eval.hs b/src/Eval.hs
index c457889..f6974de 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -90,18 +90,31 @@ evalApp f g sub = evalExp f sub >>= \case
   Left  e  -> pure $ Left e
   Right f' -> fmap (Application f') <$> evalExp g sub
 
+-- TODO: This could be nicer and more performant (current is redundantly recursive)
 evalMixfix :: [Mixfix] -> Environment -> EvalState (Failable Expression)
 evalMixfix m sub = resolve (mixfixKind m) mixfixArgs
  where
-  -- longestMatching [] _  = error "invalid"
-  -- longestMatching x  xs = evalFun (MixfixFunction x) sub >>= \case
-  --   Left  _ -> longestMatching (init x) ((last x) : xs)
-  --   Right f -> (f, Function $ MixfixFunction xs)
+  longestMatching [] = pure $ Left $ UnmatchedMixfix (mixfixKind m) m
+  longestMatching x  = evalFun (MixfixFunction x) sub >>= \case
+    Left  _ -> longestMatching $ init x
+    Right _ -> pure $ Right $ Function $ MixfixFunction x
+  holeCount f = length [ h | h@(MixfixNone) <- f ]
   resolve f args
     | null [ s | s@(MixfixSome _) <- f ] = evalExp (foldl1 Application args) sub
-    | otherwise = evalExp
-      (foldl1 Application ((Function $ MixfixFunction f) : args))
-      sub
+    | otherwise = longestMatching f >>= \case
+      e@(Left _) -> pure e
+      Right l@(Function (MixfixFunction l')) ->
+        let splitted = take (holeCount l') args
+            chainRst = drop (length l') m
+        in  case chainRst of
+              [] -> evalExp (foldl1 Application $ l : splitted) sub
+              _  -> evalExp
+                ( MixfixChain
+                $ (MixfixExpression $ foldl1 Application $ l : splitted)
+                : chainRst
+                )
+                sub
+      _ -> invalidProgramState
   mixfixArgs = [ a | (MixfixExpression a) <- m ]
   mixfixKind = map $ \case
     MixfixOperator i -> MixfixSome $ functionName i
-- 
cgit v1.2.3