Added advanced suggestion AI

blockchain soon

4 files changed, 41 insertions, 5 deletions

diff --git a/bruijn.cabal b/bruijn.cabal
index cd844b2..f5d3bb4 100644
--- a/bruijn.cabal
+++ b/bruijn.cabal
@@ -22,8 +22,10 @@ data-files:
     std/Byte.bruijn
     std/Church.bruijn
     std/Combinator.bruijn
+    std/Float.bruijn
     std/List.bruijn
     std/Logic.bruijn
+    std/Math.bruijn
     std/Number.bruijn
     std/Option.bruijn
     std/Pair.bruijn
@@ -49,7 +51,8 @@ library
       LambdaCase
   ghc-options: -Wall -Wextra -Wincomplete-uni-patterns -Wincomplete-record-updates -Widentities -Wredundant-constraints
   build-depends:
-      base >=4.7 && <5
+      array
+    , base >=4.7 && <5
     , binary
     , bitstring
     , bytestring
@@ -71,7 +74,8 @@ executable bruijn
       LambdaCase
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      array
+    , base >=4.7 && <5
     , binary
     , bitstring
     , bruijn
@@ -95,7 +99,8 @@ test-suite bruijn-test
       LambdaCase
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      array
+    , base >=4.7 && <5
     , binary
     , bitstring
     , bruijn
diff --git a/package.yaml b/package.yaml
index c0c6249..0bd59a1 100644
--- a/package.yaml
+++ b/package.yaml
@@ -28,6 +28,7 @@ default-extensions:
 dependencies:
 - base >= 4.7 && < 5
 - binary
+- array
 - bitstring
 - bytestring
 - containers
diff --git a/src/Eval.hs b/src/Eval.hs
index 2f1bb7e..fe8dbe8 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -8,6 +8,7 @@ import           Control.Monad.State
 import qualified Control.Monad.State.Strict    as StrictState
 import qualified Data.BitString                as Bit
 import qualified Data.ByteString               as Byte
+import           Data.Function                  ( on )
 import           Data.List
 import qualified Data.Map                      as M
 import           Data.Maybe
@@ -67,9 +68,17 @@ evalFun fun (Environment sub) = state $ \env@(Environment e) ->
   let lookup' name env' = case M.lookup fun env' of
         Nothing                    -> Left $ UndefinedIdentifier name
         Just (EnvDef { _exp = x }) -> Right x
+      matching n
+        | length e == 0 = "<no idea>"
+        | otherwise = snd $ minimumBy (compare `on` fst) $ map
+          (\f -> (levenshtein (functionName f) n, show f))
+          (M.keys e)
+      suggest (Left u@(UndefinedIdentifier n)) =
+        Left $ SuggestSolution u (matching $ functionName n)
+      suggest x = x
   in  case lookup' fun sub of -- search in sub env
         s@(Right _) -> (s, env)
-        _           -> (lookup' fun e, env) -- search in global env
+        _           -> (suggest $ lookup' fun e, env) -- search in global env
 
 evalAbs :: Expression -> Environment -> EvalState (Failable Expression)
 evalAbs e sub = evalExp e sub >>= pure . fmap Abstraction
diff --git a/src/Helper.hs b/src/Helper.hs
index 5433dd0..0c2b576 100644
--- a/src/Helper.hs
+++ b/src/Helper.hs
@@ -6,6 +6,7 @@
 module Helper where
 
 import qualified Control.Monad.State           as S
+import           Data.Array
 import qualified Data.BitString                as Bit
 import qualified Data.ByteString               as Byte
 import qualified Data.ByteString.Char8         as C
@@ -35,9 +36,10 @@ printContext (Context inp path) = p $ lines inp
 
 errPrefix :: String
 errPrefix = "\ESC[41mERROR\ESC[0m "
-data Error = SyntaxError String | UndefinedIdentifier Identifier | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error Context | ImportError String
+data Error = SyntaxError String | UndefinedIdentifier Identifier | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error Context | SuggestSolution Error String | ImportError String
 instance Show Error where
   show (ContextualError err ctx) = show err <> "\n" <> (printContext ctx)
+  show (SuggestSolution err sol) = show err <> "\nPerhaps you meant: " <> sol
   show (SyntaxError err) =
     errPrefix <> "invalid syntax\n\ESC[45mnear\ESC[0m " <> err
   show (UndefinedIdentifier ident) =
@@ -211,6 +213,25 @@ decodeStdout e = do
 
 ---
 
+-- from reddit u/cgibbard
+levenshtein :: (Eq a) => [a] -> [a] -> Int
+levenshtein xs ys = levMemo ! (n, m)
+ where
+  levMemo =
+    array ((0, 0), (n, m)) [ ((i, j), lev i j) | i <- [0 .. n], j <- [0 .. m] ]
+  n  = length xs
+  m  = length ys
+  xa = listArray (1, n) xs
+  ya = listArray (1, m) ys
+  lev 0 v = v
+  lev u 0 = u
+  lev u v
+    | xa ! u == ya ! v = levMemo ! (u - 1, v - 1)
+    | otherwise = 1 + minimum
+      [levMemo ! (u, v - 1), levMemo ! (u - 1, v), levMemo ! (u - 1, v - 1)]
+
+---
+
 -- TODO: Performanize
 matchingFunctions :: Expression -> Environment -> String
 matchingFunctions e (Environment env) =