Tests.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-} --
   2 {-# LANGUAGE FlexibleContexts #-} --
   3 {-# LANGUAGE TupleSections #-} -- Convenience
   4 {-# LANGUAGE AllowAmbiguousTypes #-} -- For using reifyImplicit
   5 {-# LANGUAGE TypeApplications #-} -- For using reifyImplicit
   6 {-# LANGUAGE TemplateHaskell #-} -- For using reifyTH
   7 module Tests where
   8
   9 import qualified Examples
  10 import Reify
  11 import SemanticAlp as Alp
  12 import SemanticSplice
  13 import SemanticEval
  14
  15 -- * Reifying 'Examples.e0'
  16 e0_ReprExplicit = reify (base-->base-->base-->base) Examples.e0
  17 e0_ReprImplicit = reifyImplicit Examples.e0
  18 e0_ReprTemplate = $(reifyTH 'Examples.e0)
  19 -- e0_ReprExplicit, e0_ReprImplicit, e0_ReprTemplate ::
  20 --   (Syntax.Abstractable repr, Fractional (repr o2)) =>
  21 --   repr (o2 -> o2 -> o2 -> o2)
  22 -- Note: @repr@ is polymorphic, hence those representations
  23 -- can be instantiated to many syntaxes.
  24
  25 -- ** First syntax
  26 e0_ExprExplicit = Alp.compile e0_ReprExplicit
  27 -- | 'inferRR' can't infer that the last polymorphic type
  28 -- must not be the arrow-type.
  29 -- | 'inferRR' can't infer that 'o2' is not the arrow type.
  30 e0_ExprImplicit = Alp.compile @(_ -> _ -> _ -> Float) e0_ReprImplicit
  31 -- | But 'reifyTH' can.
  32 e0_ExprTemplate = Alp.compile e0_ReprTemplate
  33
  34 -- ** Second syntax
  35 e0_EvalExplicit = eval e0_ReprExplicit
  36 e0_EvalImplicit = eval @(_ -> _ -> _ -> Float) e0_ReprImplicit
  37 e0_EvalTemplate = eval e0_ReprTemplate
  38
  39 -- ** Third syntax
  40 e0_SpliceExplicit = splice e0_ReprExplicit
  41 e0_SpliceImplicit = splice @(_ -> _ -> _ -> Float) e0_ReprImplicit
  42 e0_SpliceTemplate = splice e0_ReprTemplate
  43
  44 print_e0 = do
  45   print ("e0_ExprExplicit", e0_ExprExplicit)
  46   print ("e0_ExprImplicit", e0_ExprImplicit)
  47   print ("e0_ExprTemplate", e0_ExprTemplate)
  48   print ("e0_EvalExplicit 1 2 3", e0_EvalExplicit 1 2 3)
  49   print ("e0_EvalImplicit 1 2 3", e0_EvalImplicit 1 2 3)
  50   print ("e0_EvalTemplate 1 2 3", e0_EvalTemplate 1 2 3)
  51   print =<< ("e0_SpliceExplicit",) <$> e0_SpliceExplicit
  52   print =<< ("e0_SpliceImplicit",) <$> e0_SpliceImplicit
  53   print =<< ("e0_SpliceTemplate",) <$> e0_SpliceTemplate
  54
  55 -- * Reifying 'Examples.e1'
  56 e1_ReprExplicit = reify ((base-->base)-->base-->base) Examples.e1
  57 e1_ReprImplicit = reifyImplicit Examples.e1
  58 e1_ReprTemplate = $(reifyTH 'Examples.e1)
  59 -- e1_ReprExplicit, e1_ReprImplicit, e1_ReprTemplate ::
  60 --   Syntax.Abstractable repr =>
  61 --   repr ((o1 -> o2) -> o1 -> o2)
  62
  63 -- ** First syntax
  64 e1_ExprExplicit = Alp.compile e1_ReprExplicit
  65 -- | 'inferRR' can't infer 'o1' and 'o2' aren't the arrow type.
  66 e1_ExprImplicit = Alp.compile @((_ -> _) -> Float -> Float) e1_ReprImplicit
  67 -- | But 'reifyTH' can.
  68 e1_ExprTemplate = Alp.compile e1_ReprTemplate
  69
  70 -- ** Second syntax
  71 e1_EvalExplicit = eval e1_ReprExplicit
  72 -- | 'inferRR' can't keep the function polymorphic.
  73 e1_EvalImplicit = eval @((_ -> _) -> Float -> Float) e1_ReprImplicit
  74 -- | But 'reifyTH' can.
  75 e1_EvalTemplate = eval e1_ReprTemplate
  76
  77 -- ** Third syntax
  78 e1_SpliceExplicit = splice e1_ReprExplicit
  79 e1_SpliceImplicit = splice @((_ -> _) -> Float -> Float) e1_ReprImplicit
  80 e1_SpliceTemplate = splice e1_ReprTemplate
  81
  82 print_e1 = do
  83   print ("e1_ExprExplicit", e1_ExprExplicit)
  84   print ("e1_ExprImplicit", e1_ExprImplicit)
  85   print ("e1_ExprTemplate", e1_ExprTemplate)
  86   print ("e1_EvalExplicit id 42", e1_EvalExplicit id 42) -- 42
  87   print ("e1_EvalImplicit id 42", e1_EvalImplicit id 42) -- 42.0
  88   print ("e1_EvalTemplate id 42", e1_EvalTemplate id 42) -- 42
  89   print =<< ("e1_SpliceExplicit",) <$> e1_SpliceExplicit
  90   print =<< ("e1_SpliceImplicit",) <$> e1_SpliceImplicit
  91   print =<< ("e1_SpliceTemplate",) <$> e1_SpliceTemplate