public
Created

Coded (dead end)

  • Download Gist
Coded.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
{-# LANGUAGE DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
module Coded where
 
import Control.Unification
import Control.Unification.IntVar
import Control.Monad.Logic
import Data.Functor.Fixedpoint
import Data.List
import Data.Foldable
import Data.Traversable
 
data TermF r = C Char
| L [r]
| P r r
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
 
type Term = Fix TermF
 
instance Unifiable TermF where
zipMatch (C a) (C b) | a == b = Just $ C a
zipMatch (L as) (L bs) | length as == length bs = Just $ L $ zip as bs
zipMatch (P a1 b1) (P a2 b2) = Just $ P (a1, a2) (b1, b2)
zipMatch _ _ = Nothing
 
main = do
let ps = solve ["a"] ["1"]
print ps
 
solve :: [String]-> [String] -> String
-- solve _ _ = [('a', '1')]
solve ws ds = pretty . observe . evalIntBindingT $ solve1 (parse ws) (parse ds)
 
type Solver a = IntBindingT TermF Logic a
 
solve1 :: Term -> Term -> Solver Term
solve1 wt dt = undefined
 
parse :: [String] -> Term
parse = Fix . L . map parseWord
where parseWord = Fix . L . map (Fix . C)
 
pretty :: Term -> String
pretty = cata trans
where trans (C c) = [c]
trans (L ss) = intercalate ", " ss
trans (P s1 s2) = s1++"="++s2

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.