<commit_before>{-# language ViewPatterns #-}
{-# language PatternGuards #-}
{-# language TupleSections #-}
{-# language PatternSynonyms #-}

module Unison.Runtime.Pattern
  ( splitPatterns
  ) where

import Control.Monad.State (State, state, runState, modify)

import Data.List (splitAt, findIndex)

import Data.Set as Set (Set, insert, fromList)

import Unison.ABT
  (absChain', freshIn, visitPure, pattern AbsN', changeVars)
-- import qualified Unison.ABT as ABT
import Unison.Pattern
-- import Unison.Reference (Reference)
import Unison.Term
import Unison.Var (Var, typed, pattern Pattern)

import Data.Map.Strict as Map
  (Map, fromListWith, lookup, toList, insertWith)

-- newtype DataSpec = DS (Map Reference [Int])

type PatternV a v = PatternP (a, v)

data PatternRow v a
  = PR
  { _pats :: [PatternV a v]
  , guard :: Maybe (Term v a)
  , body :: Term v a
  }

rebind
  :: Semigroup a
  => Var v
  => [Term v a]
  -> PatternRow v a
  -> Term v a
  -> Term v a
rebind tms0 (PR ps0 _ _) = let1' False . reverse $ collect [] tms0 ps0
  where
  collect acc (Var' u : tms) (VarP (_, v) : ps)
    | u == v = collect acc tms ps
    | otherwise = error "pattern rebind: mismatched variables"
  collect acc (tm : tms) (VarP (_, v) : ps)
    = collect ((v, tm) : acc) tms ps
  collect acc [] [] = acc
  collect _ tms@(_:_) []
    = error $ "pattern rebind: more terms than patterns: " ++ show tms
  collect _ [] ps@(_:_)
    = error $ "pattern rebind: more patterns than terms: " ++ show ps
  collect _ (_:_) (p:_)
    = error $ "pattern rebind: unsplit pattern" ++ show p

-- collectRowVars
--   :: Var v
--   => [PatternV a v]
--   -> Maybe (Term v a)
--   -> Term v a
--   -> Set v
-- collectRowVars ps g b
--   = (foldMap.foldMap.foldMap) singleton ps
--       <> foldMap freeVars g <> freeVars b

data PatternMatrix v a
  = PM { _rows :: [PatternRow v a] }

type Heuristic v a = PatternMatrix v a -> Maybe Int

choose :: [Heuristic v a] -> PatternMatrix v a -> Int
choose [] _ = 0
choose (h:hs) m
  | Just i <- h m = i
  | otherwise = choose hs m<commit_msg>Provide more information in a pattern compiler error<commit_after>{-# language ViewPatterns #-}
{-# language PatternGuards #-}
{-# language TupleSections #-}
{-# language PatternSynonyms #-}

module Unison.Runtime.Pattern
  ( splitPatterns
  ) where

import Control.Monad.State (State, state, runState, modify)

import Data.List (splitAt, findIndex)

import Data.Set as Set (Set, insert, fromList)

import Unison.ABT
  (absChain', freshIn, visitPure, pattern AbsN', changeVars)
-- import qualified Unison.ABT as ABT
import Unison.Pattern
-- import Unison.Reference (Reference)
import Unison.Term
import Unison.Var (Var, typed, pattern Pattern)

import Data.Map.Strict as Map
  (Map, fromListWith, lookup, toList, insertWith)

-- newtype DataSpec = DS (Map Reference [Int])

type PatternV a v = PatternP (a, v)

data PatternRow v a
  = PR
  { _pats :: [PatternV a v]
  , guard :: Maybe (Term v a)
  , body :: Term v a
  }

rebind
  :: Semigroup a
  => Var v
  => [Term v a]
  -> PatternRow v a
  -> Term v a
  -> Term v a
rebind tms0 (PR ps0 _ _) = let1' False . reverse $ collect [] tms0 ps0
  where
  collect acc (Var' u : tms) (VarP (_, v) : ps)
    | u == v = collect acc tms ps
    | otherwise
    = error $ "pattern rebind: mismatched variables: " ++ show (u,v)
  collect acc (tm : tms) (VarP (_, v) : ps)
    = collect ((v, tm) : acc) tms ps
  collect acc [] [] = acc
  collect _ tms@(_:_) []
    = error $ "pattern rebind: more terms than patterns: " ++ show tms
  collect _ [] ps@(_:_)
    = error $ "pattern rebind: more patterns than terms: " ++ show ps
  collect _ (_:_) (p:_)
    = error $ "pattern rebind: unsplit pattern" ++ show p

-- collectRowVars
--   :: Var v
--   => [PatternV a v]
--   -> Maybe (Term v a)
--   -> Term v a
--   -> Set v
-- collectRowVars ps g b
--   = (foldMap.foldMap.foldMap) singleton ps
--       <> foldMap freeVars g <> freeVars b

data PatternMatrix v a
  = PM { _rows :: [PatternRow v a] }

type Heuristic v a = PatternMatrix v a -> Maybe Int

choose :: [Heuristic v a] -> PatternMatrix v a -> Int
choose [] _ = 0
choose (h:hs) m
  | Just i <- h m = i
  | otherwise = choose hs m
{'fraction_non_alphanumeric': 0.1349414855505135, 'fraction_numerical': 0.002866013852400287, 'mean_word_length': 2.939793038570085, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 31, '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': '5004915', 'n_tokens_mistral': 1480, 'n_tokens_neox': 1465, 'n_words': 524}