bool.coffee

eg1 = ['not', ['nor', ['var', 'a'], ['var', 'c']]]
eg2 = ['nor', ['nor', ['var', 'a'], ['var', 'b']], ['var', 'a']]
eg3 = ['not', ['nor', ['var', 'a'], ['var', 'b']]]

findVars = (q) ->
  switch q[0]
    when 'nor'
      # Intersect these two vals
      findVars(q[1]) + findVars(q[2])
    when 'not' then findVars(q[1])
    when 'var' then [q[1]]

console.log findVars(eg1)
console.log findVars(eg2)

transformer = (q) ->
  eval = (env) ->
    switch q[0]
      when 'var' then env[q[1]]
      when 'not' then not transformer(q[1])(env)
      when 'nor' then not (transformer(q[1])(env) or transformer(q[2])(env))

  return eval

console.log transformer(eg3)(a: false, b: false)
console.log transformer(eg3)(a: true, b: false)

simplify = (q) ->
  # (not (not (var a))) == (var a)
  if q[0] == 'not' and q[1][0] == 'not'
    simplify(q[1][1])
  else
    switch q[0]
      when 'not' then ['not', simplify(q[1])]
      when 'nor' then ['nor', simplify(q[1]), simplify(q[2])]
      when 'var' then q

console.log simplify(['not', ['not', ['var', 'a']]])

bool.hs

import Data.List (union)
import Data.Maybe (fromMaybe)
import Data.Data
import Data.Generics.Schemes (everywhere)
import Data.Generics.Aliases (mkT)

nor = not . or

type VarName = String

data Query = SVar VarName
           | SNot Query
           | SNor Query Query
           deriving (Eq, Show, Typeable, Data)

type Env = [(VarName, Bool)]

findVars :: Query -> [VarName]
findVars (SVar a) = [a]
findVars (SNot a) = findVars a
findVars (SNor a b) = (findVars a) `union` (findVars b)

transformer :: Query -> Env -> Bool
transformer (SVar name) env =
  fromMaybe (error ("no var named " ++name)) (lookup name env)

transformer (SNot a) env = not $ transformer a env

transformer (SNor a b) env =
  nor [(transformer a env), (transformer b env)]

simplify :: Query -> Query
simplify = everywhere (mkT f)
  where
    f (SNot (SNot x)) = x
    f x = x

nor = not . or - you can eta-reduce and get rid of the named parameter.

although really, you might as well just have it take two args rather than a list, it's the only way you use it anyway :)

it's generally worth running 'hlint' over any haskell code - you can usually get a few good tips out of it.

➜ ~ hlint eval.hs
eval.hs:16:29: Error: Redundant bracket
Found:
(a)
Why not:
a

eval.hs:17:31: Error: Redundant bracket
Found:
(a)
Why not:
a

eval.hs:17:51: Error: Redundant bracket
Found:
(b)
Why not:
b

eval.hs:21:3: Error: Use fromMaybe
Found:
maybe (error ("no var named " ++ name)) id
Why not:
Data.Maybe.fromMaybe (error ("no var named " ++ name))

eval.hs:27:7: Warning: Redundant bracket
Found:
[(transformer a env), (transformer b env)]
Why not:
[transformer a env, (transformer b env)]

eval.hs:27:7: Warning: Redundant bracket
Found:
[(transformer a env), (transformer b env)]
Why not:
[(transformer a env), transformer b env]

6 suggestions

-- so, pushing it a bit further:
...
import Data.List (union,nub)
import Data.Generics.Schemes (everywhere,listify)
...

findVars :: Query -> [VarName]
findVars = map ((SVar v) -> v) . nub . listify isVar

isVar (SVar v) = True
isVar _ = False

Gah, you beat me to it. All the Generics stuff feels awesome but there is almost a little bit _too_ much black magic. Thanks again for all your help with this. Can't wait to Haskell nerd out at the next RORO/SydJS! Chris

…

On 16 August 2011 17:16, mwotton < ***@***.***>wrote: -- so, pushing it a bit further: ... import Data.List (union,nub) import Data.Generics.Schemes (everywhere,listify) ... findVars :: Query -> [VarName] findVars = map ((SVar v) -> v) . nub . listify isVar isVar (SVar v) = True isVar _ = False ## Reply to this email directly or view it on GitHub: https://gist.github.com/1144680

It's entirely possible :) it's pretty advanced stuff. I'm looking into template Haskell atm - got the lisp goodness too...

…

Sent from my iPad

On 17/08/2011, at 10:35 AM, ***@***.*** wrote: Gah, you beat me to it. All the Generics stuff feels awesome but there is almost a little bit _too_ much black magic. Thanks again for all your help with this. Can't wait to Haskell nerd out at the next RORO/SydJS! Chris On 16 August 2011 17:16, mwotton < ***@***.***>wrote: > -- so, pushing it a bit further: > ... > import Data.List (union,nub) > import Data.Generics.Schemes (everywhere,listify) > ... > > findVars :: Query -> [VarName] > findVars = map ((SVar v) -> v) . nub . listify isVar > > isVar (SVar v) = True > isVar _ = False > ## > > Reply to this email directly or view it on GitHub: > https://gist.github.com/1144680 ## Reply to this email directly or view it on GitHub: https://gist.github.com/1144680