typechecker working in ghcjs

pact.cabal

@@ -49,6 +49,8 @@ library
                      , Pact.Types.Util
                      , Pact.Types.Version
                      , Crypto.Hash.Blake2Native
+                  , Pact.Types.Typecheck
+                  , Pact.Typechecker
 
 
   -- other-extensions:
@@ -117,8 +119,6 @@ library
                   , Pact.Types.Crypto
                   , Pact.Types.RPC
                   , Pact.Types.SQLite
-                  , Pact.Types.Typecheck
-                  , Pact.Typechecker
 
 
 

src/Pact/Repl/Lib.hs

@@ -38,9 +38,9 @@ import Data.Maybe
 import Criterion
 import Criterion.Types
 import Statistics.Resampling.Bootstrap
-import Pact.Types.Typecheck
-import Pact.Typechecker
 #endif
+import Pact.Typechecker
+import Pact.Types.Typecheck
 
 import Pact.Native.Internal
 import Pact.Types.Runtime
@@ -307,7 +307,6 @@ bench' i _ = evalError' i "Benchmarking not supported in GHCJS"
 #endif
 
 tc :: RNativeFun LibState
-#if !defined(ghcjs_HOST_OS)
 tc i as = case as of
   [TLitString s] -> go s False
   [TLitString s,TLiteral (LBool d) _] -> go s d
@@ -327,9 +326,7 @@ tc i as = case as of
               _ -> do
                 setop $ TcErrors $ map (\(Failure ti s) -> renderInfo (_tiInfo ti) ++ ":Warning: " ++ s) fails
                 return $ tStr $ "Typecheck " <> modname <> ": Unable to resolve all types"
-#else
-tc i _ = evalError' i "Typecheck not supported in GHCJS"
-#endif
+
 
 json' :: RNativeFun LibState
 json' _ [a] = return $ TValue (toJSON a) def

src/Pact/Typechecker.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
@@ -827,17 +826,17 @@ singLens = iso pure head
 
 -- | Typecheck a top-level production.
 typecheck :: TopLevel Node -> TC (TopLevel Node)
-typecheck f@(TopFun FDefun {}) = typecheckBody (f,tlFun . fBody)
+typecheck f@(TopFun FDefun {}) = typecheckBody f (tlFun . fBody)
 typecheck c@TopConst {..} = do
   assocAstTy (_aNode _tlConstVal) _tlType
-  typecheckBody (c,tlConstVal . singLens)
+  typecheckBody c (tlConstVal . singLens)
 typecheck tl = return tl
 
 
 -- | Workhorse function. Perform AST substitutions, associate types, solve overloads,
 -- enforce schemas, resolve all type variables, populate back into AST.
-typecheckBody :: (TopLevel Node,Traversal' (TopLevel Node) [AST Node]) -> TC (TopLevel Node)
-typecheckBody (tl,bodyLens) = do
+typecheckBody :: TopLevel Node -> Traversal' (TopLevel Node) [AST Node] -> TC (TopLevel Node)
+typecheckBody tl bodyLens = do
   let body = view bodyLens tl
   debug "Substitute defuns"
   appSub <- mapM (walkAST $ substAppDefun Nothing) body

src/Pact/Types/Typecheck.hs

@@ -1,12 +1,8 @@
-{-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -63,7 +59,7 @@ data CheckerException = CheckerException Info String deriving (Eq,Ord)
 instance Exception CheckerException
 instance Show CheckerException where show (CheckerException i s) = renderInfo i ++ ": " ++ s
 
--- | Model a user type. Currently only Schemas are supported.
+-- | Model a user type. Currently only Schemas are supported..
 data UserType = Schema {
   _utName :: TypeName,
   _utModule :: ModuleName,

stack-ghcjs.yaml

@@ -28,6 +28,7 @@ extra-deps:
   - bound-2
   - ed25519-donna-0.1.1
   - hashable-1.2.6.1
+  - cabal-doctest-1.0.3
 
 flags:
   thyme: