DeepDarkFantasy 0.2017.8.11 → 0.2017.8.12

raw patch · 2 files changed

+31/−16 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- DDF.Show: App :: String -> AST -> [AST] -> AST

- DDF.Show: Lam :: String -> [String] -> AST -> AST

- DDF.Show: Leaf :: String -> AST

+ DDF.Show: Infix :: String -> Name

+ DDF.Show: Node :: [String] -> Name -> [AST] -> AST

+ DDF.Show: Prefix :: String -> Name

+ DDF.Show: apps :: Name -> [AST] -> String

+ DDF.Show: cname :: Name -> Show h a

+ DDF.Show: data Name

+ DDF.Show: iname :: String -> Show h a

+ DDF.Show: leaf :: Name -> AST

+ DDF.Show: paren :: String -> String

Files

DDF/Show.hs +30/−15
DeepDarkFantasy.cabal +1/−1

DDF/Show.hs view

@@ -7,34 +7,49 @@ import qualified DDF.Map as Map import qualified DDF.VectorTF as VTF -data AST = Leaf M.String | App M.String AST [AST] | Lam M.String [M.String] AST+data Name = Prefix M.String | Infix M.String -appAST (Leaf f) x = App f x []-appAST (App f x l) r = App f x (l ++ [r])-appAST l r = appAST (Leaf $ show l) r+data AST = Node [M.String] Name [AST] -lamAST str (Lam st l t) = Lam str (st:l) t-lamAST str r = Lam str [] r+appAST (Node [] n rest) x = Node [] n (rest ++ [x])+appAST f x = Node [] (Prefix (show f)) [x] +lamAST str (Node abst n rest) = Node (str:abst) n rest+ vars = [pre : suf | suf <- "":M.map show [0..], pre <- ['a'..'z']] +leaf x = Node [] x []++paren :: M.String -> M.String+paren str = "(" ++ str ++ ")"++apps :: Name -> [AST] -> M.String+apps (Prefix n) rest = M.unwords (n:(M.map show rest))+apps (Infix n) [] = n+apps (Infix n) [l] = (n ++ " " ++ show l)+apps (Infix n) [l, r] = show l ++ " " ++ n ++ " " ++ show r+apps (Infix n) (l:r:rest) = apps (Prefix (paren (show l ++ " " ++ n ++ " " ++ show r))) rest+ instance M.Show AST where-  show (Leaf f) = f-  show (App f x l) = "(" ++ f ++ " " ++ show x ++ M.concatMap ((" " ++) . show) l ++ ")"-  show (Lam str l t) = "(\\" ++ str ++ M.concatMap (" " ++) l ++ " -> " ++ show t ++ ")"+  show (Node [] n []) = apps n []+  show (Node [] n rest) = paren $ apps n rest+  show (Node abst n rest) = paren ("\\" ++ M.unwords abst ++ " -> " ++ apps n rest)  newtype Show h a = Show {runShow :: [M.String] -> M.Int -> AST}-name = Show . M.const . M.const . Leaf +cname = Show . M.const . M.const . leaf+name = cname . Prefix+iname = cname . Infix+ showAST (Show sh) = sh vars 0  instance DBI Show where-  z = Show $ M.const $ Leaf . show . M.flip (-) 1+  z = Show $ M.const $ leaf . Prefix . show . M.flip (-) 1   s (Show v) = Show $ \va -> v va . M.flip (-) 1   abs (Show f) = Show $ \va x -> lamAST (show x) (f va (x + 1))   app (Show f) (Show x) = Show $ \va h -> appAST (f va h) (x va h)   hoas f = Show $ \(v:va) h ->-    lamAST v (runShow (f $ Show $ M.const $ M.const $ Leaf v) va (h + 1))+    lamAST v (runShow (f $ Show $ M.const $ M.const $ leaf $ Prefix v) va (h + 1))  instance Bool Show where   bool = name . show@@ -108,10 +123,10 @@   isZero = name "isZero"  instance List Show where-  nil = name "nil"-  cons = name "cons"+  nil = name "[]"+  cons = iname ":"   listMatch = name "listMatch"-  listAppend = name "++"+  listAppend = iname "++"  instance Y Show where   y = name "Y"

DeepDarkFantasy.cabal view

@@ -1,5 +1,5 @@ name: DeepDarkFantasy-version: 0.2017.8.11+version: 0.2017.8.12 cabal-version: 1.12 build-type: Simple license: Apache