feat[compiler]: Compile to bytecode

package.yaml

@@ -22,6 +22,8 @@ default-extensions:
   - DerivingStrategies
   - ImportQualifiedPost
   - NoImplicitPrelude
+  - OverloadedRecordDot
+  - OverloadedStrings
   - StandaloneKindSignatures
   - RoleAnnotations
 
@@ -60,3 +62,5 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - scalie
+    - tasty
+    - tasty-quickcheck

scalie.cabal

@@ -24,6 +24,12 @@ 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
@@ -33,6 +39,8 @@ library
       DerivingStrategies
       ImportQualifiedPost
       NoImplicitPrelude
+      OverloadedRecordDot
+      OverloadedStrings
       StandaloneKindSignatures
       RoleAnnotations
   ghc-options: -Weverything -Wno-unsafe
@@ -54,6 +62,8 @@ executable scalie-exe
       DerivingStrategies
       ImportQualifiedPost
       NoImplicitPrelude
+      OverloadedRecordDot
+      OverloadedStrings
       StandaloneKindSignatures
       RoleAnnotations
   ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
@@ -79,6 +89,8 @@ test-suite scalie-test
       DerivingStrategies
       ImportQualifiedPost
       NoImplicitPrelude
+      OverloadedRecordDot
+      OverloadedStrings
       StandaloneKindSignatures
       RoleAnnotations
   ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N
@@ -87,6 +99,8 @@ test-suite scalie-test
     , base
     , containers
     , scalie
+    , tasty
+    , tasty-quickcheck
     , text
     , vector
   default-language: Haskell2010

src/Data/Map/Implicit.hs

@@ -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) where
+module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty, fromList, lookup) where
 import Data.Kind (Type, Constraint)
 import Data.Map (Map)
 import Text.Show (Show (show))
@@ -21,6 +21,7 @@ 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.
 
@@ -61,10 +62,20 @@ 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)

src/Language/Scalie/Ast/Definition.hs

@@ -3,6 +3,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module Language.Scalie.Ast.Definition (Definition(..)) where
 
 import Data.Kind (Type)
@@ -22,6 +24,9 @@ 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)
 --
@@ -55,9 +60,19 @@ 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 f) where
+instance ImplicitKeyOf (Definition (Provenance a)) where
-  type KeyType (Definition f) = f Text
+  type KeyType (Definition (Provenance a)) = Text
-  keyOf :: Definition f -> KeyType (Definition f)
+  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)
   keyOf = name
 
 instance (Functor f, Arbitrary (f UnicodeString), Arbitrary (f Scalie.Domain.Type), Arbitrary (f Expression)) => Arbitrary (Definition f) where

src/Language/Scalie/Ast/Pattern.hs

@@ -3,7 +3,7 @@
 module Language.Scalie.Ast.Pattern (Pattern(..)) where
 import Prelude (Integer)
 import Text.Show (Show)
-import Text.Read (Read, readMaybe)
+import Text.Read (Read)
 import Data.Kind qualified
 
 
@@ -13,6 +13,7 @@ import Data.Kind qualified
 -- RawInt 15
 --
 -- >>> import Data.Maybe (Maybe)
+-- >>> import Text.Read (readMaybe)
 -- >>> readMaybe "RawInt (-5)" :: Maybe Pattern
 -- Just (RawInt (-5))
 --
@@ -21,6 +22,7 @@ import Data.Kind qualified
 --
 -- >>> readMaybe "RawInt (5)" :: Maybe Pattern
 -- Just (RawInt 5)
+
 type Pattern :: Data.Kind.Type
 data Pattern
   = RawInt Integer

src/Language/Scalie/Ast/Provenance.hs

@@ -0,0 +1,37 @@
+{-# 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)
+

src/Language/Scalie/Ast/Provenance/SourceLocation.hs

@@ -0,0 +1,11 @@
+{-# 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)

src/Language/Scalie/Bytecode/Instruction.hs

@@ -0,0 +1,15 @@
+{-# 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)

src/Language/Scalie/Bytecode/Object.hs

@@ -0,0 +1,21 @@
+{-# 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)

src/Language/Scalie/Bytecode/Object/Builder.hs

@@ -0,0 +1,29 @@
+{-# 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

src/Language/Scalie/Compiler/Bytecode.hs

@@ -0,0 +1,37 @@
+{-# 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)
+      ]

test/Spec.hs

@@ -1,9 +1,12 @@
 {-# 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 = do
+main = Tasty.defaultMain $ Tasty.testGroup "all"
-  _ <- Test.Data.Map.Implicit.runTests
+  [ Tasty.testGroup "Properties"
-  pure ()
+    [ Test.Data.Map.Implicit.testGroup
+    ]
+  ]

test/Test/Data/Map/Implicit.hs

@@ -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 (prop_readShowIdentityRoundtrip, prop_readShowMaybeRoundtrip, runTests) where
+module Test.Data.Map.Implicit (testGroup) where
 import Test.QuickCheck.Roundtrip (roundtrips)
 import Text.Show (show)
 import Text.Read (read)
@@ -10,10 +10,12 @@ import Data.Map.Implicit (ImplicitMap)
 import Data.Bool (Bool)
 import Language.Scalie.Ast.Definition (Definition)
 import Data.Functor.Identity (Identity)
-import Test.QuickCheck.All (quickCheckAll)
+import Test.QuickCheck (Property, allProperties)
-import System.IO (IO)
+import Data.String (String)
 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'
 
@@ -24,5 +26,8 @@ prop_readShowMaybeRoundtrip :: ImplicitMap (Definition Maybe) -> Bool
 prop_readShowMaybeRoundtrip = roundtrips read show
 
 pure []
-runTests :: IO Bool
+allTests :: [(String, Property)]
-runTests = $quickCheckAll
+allTests = $allProperties
+
+testGroup :: TestTree
+testGroup = Tasty.QuickCheck.testProperties "Data.Map.Implicit" allTests