DeepDarkFantasy 0.2017.8.9 → 0.2017.8.10

raw patch · 6 files changed

+82/−148 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• DDF/IO.hs +6/−1
• DDF/List.hs +1/−0
• DDF/Sam/Hello.lhs +63/−0
• DDF/Show.hs +2/−0
• DDF/UInt.hs +0/−136
• DeepDarkFantasy.cabal +10/−11

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude, FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude, FlexibleContexts, NoMonomorphismRestriction #-}  module DDF.IO (module DDF.IO, module DDF.List, module DDF.Char, module DDF.Unit) where @@ -7,5 +7,10 @@ import DDF.Unit import qualified Prelude as M +string [] = nil+string (c:str) = cons2 (char c) (string str)+ class (List r, Unit r, Char r, Monad r M.IO) => IO r where   putStrLn :: r h (String -> M.IO ())++putStrLn1 = app putStrLn

@@ -13,3 +13,4 @@  cons2 = app2 cons listMatch2 = app2 listMatch+listAppend2 = app2 listAppend

@@ -0,0 +1,63 @@+> {-# LANGUAGE+>   NoImplicitPrelude,+>   ExplicitForAll,+>   KindSignatures,+>   NoMonomorphismRestriction+> #-}++> module DDF.Sam.Hello where+> import DDF.Lang+> import DDF.Eval+> import DDF.Show+> import qualified Prelude as M++DDF is a language embedded in Haskell, written using Finally Tagless Style.+Being an embedded language mean it is a piece of cake to write DDF macro - they are just Haskell function!+Another benefit is that DDF code is typed check when GHC compile, so you can do type driven developement.++> hello :: forall (int :: * -> * -> *) (h :: *). Lang int => int h String+> hello = string "Hello"++Let's get to action!+The code above define a literal in hello.+Note that it has strange type: it take an (int :: * -> * -> *), and (h :: *), and return int h String.+Well, h is an enviroment of variable, and int h is an interpreter which interpret term in enviroment h.+int h String mean the final result is an int, so we had constrained the term to be scope-correct and type safe at Haskell compile time.+Lang int is simply the constraint that int can interpret anything inside Lang.++> world :: (List int, Char int) => int () String+> world = string "world"++Well, we are just defining string literal, so it don't need the full power of Lang.+Since string is list of char, using List and Char should be enough.+Also note that we had manually select an enviromnet, instead of letting it be anything.+The enviroment is simply (), which mean there's no free variable.++> space :: (List int, Char int) => int h (String -> String -> String)+> space = lam2 $ \l r -> listAppend2 l (cons2 (char ' ') r)++And now we should play with lambda a bit.+Lambda abstraction is just Haskell Lambda abstraction (with some magic), so it is relatively easy to use.+Also, note how everything is scope safe again: it is impossible to append x to z, because variable z doesnt exist.+It is assumed that every interpreter know how to deal with lambda, so we dont need another constraint (it is implied by both List and Char).++> addTail :: (List int, Char int) => int h String -> M.Char -> int h String+> addTail l r = listAppend2 l (cons2 (char r) nil)++Now this is some macro: just ordinary Haskell function that generate AST.+They can take both Haskell term, DDF term as input, and notice that the macro is type safe.++> str = addTail (app2 space hello world) '!'++Finally, notice that, under NoMonomorphismRestriction, GHC will infer the most general type automatically.+Unfortunately, since we specify Lang, and use () as env in the component, it's type are more restrictive than we hope.++> main :: M.IO ()+> main = do+>   print $ runEval str ()+>   print $ showAST str+>   M.return ()++Now we show two interpreter: the evaluator and the pretty printer.+One output the final result and one output the AST.+The () floating around is the enviroment we feed into the evaluator.

@@ -26,6 +26,8 @@ newtype Show h a = Show {runShow :: [M.String] -> M.Int -> AST} name = Show . M.const . M.const . Leaf +showAST (Show sh) = sh vars 0+ instance DBI Show where   z = Show $ M.const $ Leaf . show . M.flip (-) 1   s (Show v) = Show $ \va -> v va . M.flip (-) 1

@@ -1,136 +0,0 @@-{-# LANGUAGE NoImplicitPrelude, TypeFamilies, MultiParamTypeClasses, PartialTypeSignatures, FlexibleInstances #-}--module DDF.UInt where--import DDF.Lang-import qualified DDF.Map as Map-import qualified DDF.VectorTF as VTF--data UInt h x = UInt--instance DBI UInt where-  z = UInt-  s _ = UInt-  abs _ = UInt-  app _ _ = UInt--instance Bool UInt where-  bool _ = UInt-  ite = UInt--instance Char UInt where-  char _ = UInt--instance Double UInt where-  double _ = UInt-  doublePlus = UInt-  doubleMinus = UInt-  doubleMult = UInt-  doubleDivide = UInt-  doubleExp = UInt-  doubleEq = UInt--instance Float UInt where-  float _ = UInt-  floatPlus = UInt-  floatMinus = UInt-  floatMult = UInt-  floatDivide = UInt-  floatExp = UInt--instance Bimap UInt where-  size = UInt-  empty = UInt-  singleton = UInt-  lookupL = UInt-  lookupR = UInt-  toMapL = UInt-  toMapR = UInt-  insert = UInt-  updateL = UInt-  updateR = UInt--instance Dual UInt where-  dual = UInt-  runDual = UInt--instance Map.Map UInt where-  empty = UInt-  singleton = UInt-  lookup = UInt-  alter = UInt-  mapMap = UInt-  unionWith = UInt--instance Prod UInt where-  mkProd = UInt-  zro = UInt-  fst = UInt--instance Option UInt where-  nothing = UInt-  just = UInt-  optionMatch = UInt--instance Unit UInt where-  unit = UInt--instance Sum UInt where-  left = UInt-  right = UInt-  sumMatch = UInt--instance Int UInt where-  int _ = UInt-  pred = UInt-  isZero = UInt--instance Y UInt where-  y = UInt--instance Functor UInt x where-  map = UInt--instance Applicative UInt x where-  ap = UInt-  pure = UInt--instance Monad UInt x where-  join = UInt-  bind = UInt--instance IO UInt where-  putStrLn = UInt--instance List UInt where-  nil = UInt-  cons = UInt-  listMatch = UInt--instance VTF.VectorTF UInt where-  zero = UInt-  basis = UInt-  plus = UInt-  mult = UInt-  vtfMatch = UInt--instance DiffWrapper UInt where-  diffWrapper = UInt-  runDiffWrapper = UInt--instance Fix UInt where-  fix = UInt-  runFix = UInt--instance FreeVector UInt where-  freeVector = UInt-  runFreeVector = UInt--instance Lang UInt where-  exfalso = UInt-  runWriter = UInt-  writer = UInt-  double2Float = UInt-  float2Double = UInt-  state = UInt-  runState = UInt

@@ -1,5 +1,5 @@ name: DeepDarkFantasy-version: 0.2017.8.9+version: 0.2017.8.10 cabal-version: 1.12 build-type: Simple license: Apache@@ -47,6 +47,7 @@                    DDF.Option                    DDF.PE                    DDF.Prod+                   DDF.Sam.Hello                    DDF.Sam.Poly                    DDF.Sam.Xor                    DDF.Show@@ -54,7 +55,6 @@                    DDF.Sum                    DDF.Term                    DDF.TermGen-                   DDF.UInt                    DDF.UnHOAS                    DDF.Unit                    DDF.UnLiftEnv@@ -63,15 +63,14 @@                    DDF.VectorTF                    DDF.WithDiff                    DDF.Y-  build-depends:-    base >= 4.9.0.0 && <= 4.9.1.0,-    mtl -any,-    random -any,-    constraints -any,-    containers -any,-    bimap -any,-    recursion-schemes -any,-    template-haskell -any+  build-depends: base >= 4.9.0.0 && <= 4.9.1.0,+                 mtl -any,+                 random -any,+                 constraints -any,+                 containers -any,+                 bimap -any,+                 recursion-schemes -any,+                 template-haskell -any   ghc-options: -Wall -Wno-type-defaults -Wno-missing-signatures -Wno-orphans -fwarn-tabs -ferror-spans -Wno-partial-type-signatures   if flag(WError)     ghc-options: -Werror