Compare commits
No commits in common. "13c3e4d0077983ab7d6d326bd156dceef3e7df53" and "05397334edf2526210596dbe7faedeb5bd8eedb0" have entirely different histories.
13c3e4d007
...
05397334ed
13 changed files with 14 additions and 218 deletions
|
@ -22,8 +22,6 @@ default-extensions:
|
|||
- DerivingStrategies
|
||||
- ImportQualifiedPost
|
||||
- NoImplicitPrelude
|
||||
- OverloadedRecordDot
|
||||
- OverloadedStrings
|
||||
- StandaloneKindSignatures
|
||||
- RoleAnnotations
|
||||
|
||||
|
@ -62,5 +60,3 @@ tests:
|
|||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- scalie
|
||||
- tasty
|
||||
- tasty-quickcheck
|
||||
|
|
14
scalie.cabal
14
scalie.cabal
|
@ -24,12 +24,6 @@ library
|
|||
Language.Scalie.Ast.Expression
|
||||
Language.Scalie.Ast.Module
|
||||
Language.Scalie.Ast.Pattern
|
||||
Language.Scalie.Ast.Provenance
|
||||
Language.Scalie.Ast.Provenance.SourceLocation
|
||||
Language.Scalie.Bytecode.Instruction
|
||||
Language.Scalie.Bytecode.Object
|
||||
Language.Scalie.Bytecode.Object.Builder
|
||||
Language.Scalie.Compiler.Bytecode
|
||||
Language.Scalie.Domain.Type
|
||||
other-modules:
|
||||
Paths_scalie
|
||||
|
@ -39,8 +33,6 @@ library
|
|||
DerivingStrategies
|
||||
ImportQualifiedPost
|
||||
NoImplicitPrelude
|
||||
OverloadedRecordDot
|
||||
OverloadedStrings
|
||||
StandaloneKindSignatures
|
||||
RoleAnnotations
|
||||
ghc-options: -Weverything -Wno-unsafe
|
||||
|
@ -62,8 +54,6 @@ executable scalie-exe
|
|||
DerivingStrategies
|
||||
ImportQualifiedPost
|
||||
NoImplicitPrelude
|
||||
OverloadedRecordDot
|
||||
OverloadedStrings
|
||||
StandaloneKindSignatures
|
||||
RoleAnnotations
|
||||
ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
|
||||
|
@ -89,8 +79,6 @@ test-suite scalie-test
|
|||
DerivingStrategies
|
||||
ImportQualifiedPost
|
||||
NoImplicitPrelude
|
||||
OverloadedRecordDot
|
||||
OverloadedStrings
|
||||
StandaloneKindSignatures
|
||||
RoleAnnotations
|
||||
ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
|
||||
|
@ -99,8 +87,6 @@ test-suite scalie-test
|
|||
, base
|
||||
, containers
|
||||
, scalie
|
||||
, tasty
|
||||
, tasty-quickcheck
|
||||
, text
|
||||
, vector
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
{-# LANGUAGE StandaloneDeriving #-} -- derive Eq
|
||||
-- | A Map that derives the keys for the mapping from the items.
|
||||
|
||||
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty, fromList, lookup) where
|
||||
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where
|
||||
import Data.Kind (Type, Constraint)
|
||||
import Data.Map (Map)
|
||||
import Text.Show (Show (show))
|
||||
|
@ -21,7 +21,6 @@ import Data.Ord (Ord)
|
|||
import Data.Eq (Eq)
|
||||
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
|
||||
import Test.QuickCheck.Gen (Gen)
|
||||
import Data.Maybe (Maybe)
|
||||
|
||||
-- | This map will use the 'ImplicitKeyOf' class to compute the keys of the values.
|
||||
|
||||
|
@ -62,20 +61,10 @@ class ImplicitKeyOf v where
|
|||
type KeyType v :: Type
|
||||
keyOf :: v -> KeyType v
|
||||
|
||||
-- | The empty map
|
||||
|
||||
empty :: ImplicitMap v
|
||||
empty = ImplicitMap Map.empty
|
||||
|
||||
-- | Build from a List of values, keys will be inferred using 'ImplicitKeyOf'.
|
||||
-- If multiple values have the same key, the last one specified in the list will be used.
|
||||
|
||||
fromList :: (ImplicitKeyOf v, Ord (KeyType v)) => [v] -> ImplicitMap v
|
||||
fromList = List.map (keyOf &&& id)
|
||||
>>> Map.fromList
|
||||
>>> ImplicitMap
|
||||
|
||||
-- | Retrieve the value associated with its implicit key from the map.
|
||||
|
||||
lookup :: Ord (KeyType a) => KeyType a -> ImplicitMap a -> Maybe a
|
||||
lookup k m = Map.lookup k (get m)
|
||||
|
|
|
@ -3,8 +3,6 @@
|
|||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
module Language.Scalie.Ast.Definition (Definition(..)) where
|
||||
|
||||
import Data.Kind (Type)
|
||||
|
@ -24,9 +22,6 @@ import Data.Text qualified as Text
|
|||
import Control.Category (Category((.)))
|
||||
import Test.QuickCheck.Modifiers (UnicodeString(getUnicodeString))
|
||||
import Data.Functor (Functor)
|
||||
import Language.Scalie.Ast.Provenance (Provenance (value))
|
||||
import Data.Functor.Identity (Identity)
|
||||
import Data.Maybe (Maybe)
|
||||
|
||||
-- | The definition of a value or a function (which is also a value)
|
||||
--
|
||||
|
@ -60,19 +55,9 @@ deriving stock instance (Show (f Expression), Show (f Scalie.Domain.Type), Show
|
|||
deriving stock instance (Read (f Expression), Read (f Scalie.Domain.Type), Read (f Text)) => Read (Definition f)
|
||||
deriving stock instance (Eq (f Expression) , Eq (f Scalie.Domain.Type) , Eq (f Text)) => Eq (Definition f)
|
||||
|
||||
instance ImplicitKeyOf (Definition (Provenance a)) where
|
||||
type KeyType (Definition (Provenance a)) = Text
|
||||
keyOf :: Definition (Provenance a) -> KeyType (Definition (Provenance a))
|
||||
keyOf = (.name.value)
|
||||
|
||||
instance ImplicitKeyOf (Definition Identity) where
|
||||
type KeyType (Definition Identity) = Identity Text
|
||||
keyOf :: Definition Identity -> KeyType (Definition Identity)
|
||||
keyOf = name
|
||||
|
||||
instance ImplicitKeyOf (Definition Maybe) where
|
||||
type KeyType (Definition Maybe) = Maybe Text
|
||||
keyOf :: Definition Maybe -> KeyType (Definition Maybe)
|
||||
instance ImplicitKeyOf (Definition f) where
|
||||
type KeyType (Definition f) = f Text
|
||||
keyOf :: Definition f -> KeyType (Definition f)
|
||||
keyOf = name
|
||||
|
||||
instance (Functor f, Arbitrary (f UnicodeString), Arbitrary (f Scalie.Domain.Type), Arbitrary (f Expression)) => Arbitrary (Definition f) where
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
module Language.Scalie.Ast.Pattern (Pattern(..)) where
|
||||
import Prelude (Integer)
|
||||
import Text.Show (Show)
|
||||
import Text.Read (Read)
|
||||
import Text.Read (Read, readMaybe)
|
||||
import Data.Kind qualified
|
||||
|
||||
|
||||
|
@ -13,7 +13,6 @@ import Data.Kind qualified
|
|||
-- RawInt 15
|
||||
--
|
||||
-- >>> import Data.Maybe (Maybe)
|
||||
-- >>> import Text.Read (readMaybe)
|
||||
-- >>> readMaybe "RawInt (-5)" :: Maybe Pattern
|
||||
-- Just (RawInt (-5))
|
||||
--
|
||||
|
@ -22,7 +21,6 @@ import Data.Kind qualified
|
|||
--
|
||||
-- >>> readMaybe "RawInt (5)" :: Maybe Pattern
|
||||
-- Just (RawInt 5)
|
||||
|
||||
type Pattern :: Data.Kind.Type
|
||||
data Pattern
|
||||
= RawInt Integer
|
||||
|
|
|
@ -1,37 +0,0 @@
|
|||
{-# LANGUAGE Safe #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE DeriveTraversable #-} -- implies DeriveFunctor and DeriveFoldable
|
||||
module Language.Scalie.Ast.Provenance (Provenance(..)) where
|
||||
import Data.Kind (Type)
|
||||
import Text.Show (Show)
|
||||
import Text.Read (Read)
|
||||
import Data.Functor (Functor)
|
||||
import Data.Foldable (Foldable)
|
||||
import Data.Bifunctor (Bifunctor (bimap))
|
||||
import Data.Traversable (Traversable)
|
||||
import Data.Bifoldable (Bifoldable (bifoldMap))
|
||||
import Data.Monoid (Monoid)
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.Bitraversable (Bitraversable (bitraverse))
|
||||
import Control.Applicative (Applicative (liftA2))
|
||||
|
||||
type Provenance :: Type -> Type -> Type
|
||||
type role Provenance representational representational
|
||||
data Provenance source value = Provenance
|
||||
{ source :: source
|
||||
, value :: value
|
||||
}
|
||||
deriving stock (Show, Read, Functor, Foldable, Traversable)
|
||||
|
||||
instance Bifunctor Provenance where
|
||||
bimap :: (a -> b) -> (c -> d) -> Provenance a c -> Provenance b d
|
||||
bimap f g (Provenance a b) = Provenance (f a) (g b)
|
||||
|
||||
instance Bifoldable Provenance where
|
||||
bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> Provenance a b -> m
|
||||
bifoldMap f g (Provenance a b) = f a <> g b
|
||||
|
||||
instance Bitraversable Provenance where
|
||||
bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Provenance a b -> f (Provenance c d)
|
||||
bitraverse f g (Provenance a b) = liftA2 Provenance (f a) (g b)
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
{-# LANGUAGE Safe #-}
|
||||
module Language.Scalie.Ast.Provenance.SourceLocation (SourceLocation(..)) where
|
||||
import Data.Kind (Type)
|
||||
import Text.Show (Show)
|
||||
import Text.Read (Read)
|
||||
import Data.Eq (Eq)
|
||||
|
||||
type SourceLocation :: Type
|
||||
data SourceLocation
|
||||
= Synthesized
|
||||
deriving stock (Show, Read, Eq)
|
|
@ -1,15 +0,0 @@
|
|||
{-# LANGUAGE Safe #-}
|
||||
{-# LANGUAGE EmptyDataDeriving #-} -- instruction doesn't have any cases yet
|
||||
module Language.Scalie.Bytecode.Instruction (Instruction(..)) where
|
||||
import Data.Kind (Type)
|
||||
import Text.Show (Show)
|
||||
import Text.Read (Read)
|
||||
import Data.Eq (Eq)
|
||||
import Prelude (Integer) -- this is apparently the only safe way to import 'Integer'
|
||||
import Data.Word (Word8)
|
||||
|
||||
type Instruction :: Type
|
||||
data Instruction
|
||||
= PushInteger Integer
|
||||
| ReturnValues Word8
|
||||
deriving stock (Show, Read, Eq)
|
|
@ -1,21 +0,0 @@
|
|||
{-# LANGUAGE Trustworthy #-} -- Trustworthy because it imports Vector but does not do unsafe things
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
-- | This module describes a Bytecode Object, similar to a java classfile. It will hold source information, shared constants and
|
||||
|
||||
module Language.Scalie.Bytecode.Object (Object(..)) where
|
||||
import Data.Kind (Type)
|
||||
import Data.Vector (Vector)
|
||||
import Language.Scalie.Ast.Provenance (Provenance)
|
||||
import Language.Scalie.Bytecode.Instruction (Instruction)
|
||||
import Language.Scalie.Ast.Provenance.SourceLocation (SourceLocation)
|
||||
import Text.Show (Show)
|
||||
import Text.Read (Read)
|
||||
import Data.Semigroup (Semigroup)
|
||||
import Data.Monoid (Monoid)
|
||||
|
||||
type Object :: Type
|
||||
type role Object
|
||||
newtype Object = Object { instructions :: Vector (Provenance SourceLocation Instruction) }
|
||||
deriving stock (Show, Read)
|
||||
deriving newtype (Semigroup, Monoid)
|
|
@ -1,29 +0,0 @@
|
|||
{-# LANGUAGE Safe #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
module Language.Scalie.Bytecode.Object.Builder (Builder, runBuilder) where
|
||||
import Data.Kind (Type)
|
||||
import Language.Scalie.Bytecode.Object qualified as Bytecode
|
||||
import Data.Functor (Functor)
|
||||
import Control.Applicative (Applicative (pure, (<*>)))
|
||||
import Control.Monad (Monad ((>>=)))
|
||||
import Prelude (undefined)
|
||||
|
||||
type Builder :: Type -> Type
|
||||
type role Builder representational
|
||||
newtype Builder a = Builder a
|
||||
deriving stock (Functor)
|
||||
|
||||
instance Applicative Builder where
|
||||
pure :: a -> Builder a
|
||||
pure = Builder
|
||||
(<*>) :: Builder (a -> b) -> Builder a -> Builder b
|
||||
(<*>) (Builder f) (Builder x) = Builder (f x)
|
||||
|
||||
instance Monad Builder where
|
||||
(>>=) :: Builder a -> (a -> Builder b) -> Builder b
|
||||
(>>=) (Builder x) f = f x
|
||||
|
||||
|
||||
runBuilder :: Builder a -> (Bytecode.Object, a)
|
||||
runBuilder = undefined
|
|
@ -1,37 +0,0 @@
|
|||
{-# LANGUAGE Trustworthy #-} -- uses vector operations
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
module Language.Scalie.Compiler.Bytecode (EntryPoint, compile, CompilationError(..)) where
|
||||
import Language.Scalie.Ast.Module (Module (definitions))
|
||||
import Data.Text (Text)
|
||||
import Language.Scalie.Ast.Provenance (Provenance (value, Provenance, source))
|
||||
import Language.Scalie.Ast.Provenance.SourceLocation (SourceLocation)
|
||||
import Language.Scalie.Bytecode.Object qualified as Bytecode
|
||||
import Data.Kind (Type)
|
||||
import Data.Either (Either (Left, Right))
|
||||
import Data.Vector qualified as Vector
|
||||
import Control.Category ((.))
|
||||
import Data.Function (($))
|
||||
import Data.Functor ((<$>))
|
||||
import Data.Map.Implicit qualified as ImplicitMap
|
||||
import Data.Maybe (Maybe(Nothing, Just))
|
||||
import Language.Scalie.Ast.Definition (Definition(body, name))
|
||||
import Language.Scalie.Ast.Expression (Expression(RawInt))
|
||||
import Language.Scalie.Bytecode.Instruction qualified as Instruction
|
||||
|
||||
-- | The name of the entrypoint function
|
||||
|
||||
type EntryPoint :: Type
|
||||
type EntryPoint = Text
|
||||
|
||||
type CompilationError :: Type
|
||||
newtype CompilationError = NameNotFound Text
|
||||
|
||||
compile :: Module (Provenance SourceLocation) -> EntryPoint -> Either CompilationError Bytecode.Object
|
||||
compile mod entry = let
|
||||
topLevelDefinitions = mod.definitions.value
|
||||
in Bytecode.Object . Vector.fromList <$> case ImplicitMap.lookup entry topLevelDefinitions of
|
||||
Nothing -> Left $ NameNotFound entry
|
||||
Just def -> Right
|
||||
[ (\(RawInt i) -> Instruction.PushInteger i) <$> def.body
|
||||
, Provenance def.name.source (Instruction.ReturnValues 1)
|
||||
]
|
11
test/Spec.hs
11
test/Spec.hs
|
@ -1,12 +1,9 @@
|
|||
{-# LANGUAGE Unsafe #-} -- unsafe: Uses functions imported from unsafe modules
|
||||
import System.IO (IO)
|
||||
import Control.Applicative (pure)
|
||||
import Test.Data.Map.Implicit qualified
|
||||
import Test.Tasty qualified as Tasty
|
||||
import Data.Function (($))
|
||||
|
||||
main :: IO ()
|
||||
main = Tasty.defaultMain $ Tasty.testGroup "all"
|
||||
[ Tasty.testGroup "Properties"
|
||||
[ Test.Data.Map.Implicit.testGroup
|
||||
]
|
||||
]
|
||||
main = do
|
||||
_ <- Test.Data.Map.Implicit.runTests
|
||||
pure ()
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
{-# LANGUAGE TemplateHaskell #-} -- for 'quickCheckAll'
|
||||
{-# OPTIONS_GHC -Wno-all-missed-specialisations #-} -- a lot of warnings for unspecialized 'read' and 'show', which I cannot specialize
|
||||
-- I wouldn't know how at least, they're not my datatypes, I cannot use the hint and add an 'INLINABLE' pragma
|
||||
module Test.Data.Map.Implicit (testGroup) where
|
||||
module Test.Data.Map.Implicit (prop_readShowIdentityRoundtrip, prop_readShowMaybeRoundtrip, runTests) where
|
||||
import Test.QuickCheck.Roundtrip (roundtrips)
|
||||
import Text.Show (show)
|
||||
import Text.Read (read)
|
||||
|
@ -10,12 +10,10 @@ import Data.Map.Implicit (ImplicitMap)
|
|||
import Data.Bool (Bool)
|
||||
import Language.Scalie.Ast.Definition (Definition)
|
||||
import Data.Functor.Identity (Identity)
|
||||
import Test.QuickCheck (Property, allProperties)
|
||||
import Data.String (String)
|
||||
import Test.QuickCheck.All (quickCheckAll)
|
||||
import System.IO (IO)
|
||||
import Control.Applicative (pure)
|
||||
import Data.Maybe (Maybe)
|
||||
import Test.Tasty.QuickCheck qualified as Tasty.QuickCheck
|
||||
import Test.Tasty (TestTree)
|
||||
|
||||
-- | This is testworthy since I have somehow hand-hacked the read/show de/serialization of 'ImplicitMap'
|
||||
|
||||
|
@ -26,8 +24,5 @@ prop_readShowMaybeRoundtrip :: ImplicitMap (Definition Maybe) -> Bool
|
|||
prop_readShowMaybeRoundtrip = roundtrips read show
|
||||
|
||||
pure []
|
||||
allTests :: [(String, Property)]
|
||||
allTests = $allProperties
|
||||
|
||||
testGroup :: TestTree
|
||||
testGroup = Tasty.QuickCheck.testProperties "Data.Map.Implicit" allTests
|
||||
runTests :: IO Bool
|
||||
runTests = $quickCheckAll
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue