Skip to content

Instantly share code, notes, and snippets.

@petermarks
Created March 17, 2012 15:34
Show Gist options
  • Save petermarks/2061259 to your computer and use it in GitHub Desktop.
Save petermarks/2061259 to your computer and use it in GitHub Desktop.
Coded (dead end)
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment