From c20de441de88b755291dc6c627dac10b592f889c Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 14 Aug 2025 10:44:09 +0200 Subject: [PATCH 1/5] feat: Export `fromList` for `ImplicitMap` --- src/Data/Map/Implicit.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Map/Implicit.hs b/src/Data/Map/Implicit.hs index 3cbc43f..7996c15 100644 --- a/src/Data/Map/Implicit.hs +++ b/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) where import Data.Kind (Type, Constraint) import Data.Map (Map) import Text.Show (Show (show)) From 0d8470a87f0299e390d3292a7caa8202eb5f2e61 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 14 Aug 2025 10:44:37 +0200 Subject: [PATCH 2/5] fix[doc]: Move import to the right place --- src/Language/Scalie/Ast/Pattern.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Language/Scalie/Ast/Pattern.hs b/src/Language/Scalie/Ast/Pattern.hs index 9a07dc4..cd1b2e9 100644 --- a/src/Language/Scalie/Ast/Pattern.hs +++ b/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 From 766528677f594b2bc914d58a93d135c083052a3e Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 14 Aug 2025 10:45:08 +0200 Subject: [PATCH 3/5] feat[tests]: Use tasty for hierarchical tests --- package.yaml | 3 +++ scalie.cabal | 5 +++++ test/Spec.hs | 11 +++++++---- test/Test/Data/Map/Implicit.hs | 15 ++++++++++----- 4 files changed, 25 insertions(+), 9 deletions(-) diff --git a/package.yaml b/package.yaml index e247398..67426df 100644 --- a/package.yaml +++ b/package.yaml @@ -22,6 +22,7 @@ default-extensions: - DerivingStrategies - ImportQualifiedPost - NoImplicitPrelude + - OverloadedStrings - StandaloneKindSignatures - RoleAnnotations @@ -60,3 +61,5 @@ tests: - -with-rtsopts=-N dependencies: - scalie + - tasty + - tasty-quickcheck diff --git a/scalie.cabal b/scalie.cabal index 9e834db..651b71d 100644 --- a/scalie.cabal +++ b/scalie.cabal @@ -33,6 +33,7 @@ library DerivingStrategies ImportQualifiedPost NoImplicitPrelude + OverloadedStrings StandaloneKindSignatures RoleAnnotations ghc-options: -Weverything -Wno-unsafe @@ -54,6 +55,7 @@ executable scalie-exe DerivingStrategies ImportQualifiedPost NoImplicitPrelude + OverloadedStrings StandaloneKindSignatures RoleAnnotations ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N @@ -79,6 +81,7 @@ test-suite scalie-test DerivingStrategies ImportQualifiedPost NoImplicitPrelude + OverloadedStrings StandaloneKindSignatures RoleAnnotations ghc-options: -Weverything -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N @@ -87,6 +90,8 @@ test-suite scalie-test , base , containers , scalie + , tasty + , tasty-quickcheck , text , vector default-language: Haskell2010 diff --git a/test/Spec.hs b/test/Spec.hs index 0b0fab7..a3b14ce 100644 --- a/test/Spec.hs +++ b/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 - _ <- Test.Data.Map.Implicit.runTests - pure () +main = Tasty.defaultMain $ Tasty.testGroup "all" + [ Tasty.testGroup "Properties" + [ Test.Data.Map.Implicit.testGroup + ] + ] diff --git a/test/Test/Data/Map/Implicit.hs b/test/Test/Data/Map/Implicit.hs index c456df0..1c4cb3d 100644 --- a/test/Test/Data/Map/Implicit.hs +++ b/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 System.IO (IO) +import Test.QuickCheck (Property, allProperties) +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 -runTests = $quickCheckAll +allTests :: [(String, Property)] +allTests = $allProperties + +testGroup :: TestTree +testGroup = Tasty.QuickCheck.testProperties "Data.Map.Implicit" allTests From f9ea61d3486e7e35617180f9f932c68ba6ffd8c6 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 14 Aug 2025 13:22:31 +0200 Subject: [PATCH 4/5] feat[bytecode]: A lot of scaffolding for setup --- scalie.cabal | 6 +++ src/Language/Scalie/Ast/Provenance.hs | 37 +++++++++++++++++++ .../Scalie/Ast/Provenance/SourceLocation.hs | 11 ++++++ src/Language/Scalie/Bytecode/Instruction.hs | 11 ++++++ src/Language/Scalie/Bytecode/Object.hs | 21 +++++++++++ .../Scalie/Bytecode/Object/Builder.hs | 28 ++++++++++++++ src/Language/Scalie/Compiler/Bytecode.hs | 16 ++++++++ 7 files changed, 130 insertions(+) create mode 100644 src/Language/Scalie/Ast/Provenance.hs create mode 100644 src/Language/Scalie/Ast/Provenance/SourceLocation.hs create mode 100644 src/Language/Scalie/Bytecode/Instruction.hs create mode 100644 src/Language/Scalie/Bytecode/Object.hs create mode 100644 src/Language/Scalie/Bytecode/Object/Builder.hs create mode 100644 src/Language/Scalie/Compiler/Bytecode.hs diff --git a/scalie.cabal b/scalie.cabal index 651b71d..f4acf24 100644 --- a/scalie.cabal +++ b/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 diff --git a/src/Language/Scalie/Ast/Provenance.hs b/src/Language/Scalie/Ast/Provenance.hs new file mode 100644 index 0000000..9c021c5 --- /dev/null +++ b/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) + diff --git a/src/Language/Scalie/Ast/Provenance/SourceLocation.hs b/src/Language/Scalie/Ast/Provenance/SourceLocation.hs new file mode 100644 index 0000000..5de2a01 --- /dev/null +++ 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) diff --git a/src/Language/Scalie/Bytecode/Instruction.hs b/src/Language/Scalie/Bytecode/Instruction.hs new file mode 100644 index 0000000..493f9a5 --- /dev/null +++ b/src/Language/Scalie/Bytecode/Instruction.hs @@ -0,0 +1,11 @@ +{-# 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) + +type Instruction :: Type +data Instruction + deriving stock (Show, Read, Eq) diff --git a/src/Language/Scalie/Bytecode/Object.hs b/src/Language/Scalie/Bytecode/Object.hs new file mode 100644 index 0000000..326941e --- /dev/null +++ b/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) diff --git a/src/Language/Scalie/Bytecode/Object/Builder.hs b/src/Language/Scalie/Bytecode/Object/Builder.hs new file mode 100644 index 0000000..fcd41ef --- /dev/null +++ b/src/Language/Scalie/Bytecode/Object/Builder.hs @@ -0,0 +1,28 @@ +{-# 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 ((>>=))) + +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 = _ diff --git a/src/Language/Scalie/Compiler/Bytecode.hs b/src/Language/Scalie/Compiler/Bytecode.hs new file mode 100644 index 0000000..8d95b9c --- /dev/null +++ b/src/Language/Scalie/Compiler/Bytecode.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE Safe #-} +module Language.Scalie.Compiler.Bytecode (EntryPoint, compile) where +import Language.Scalie.Ast.Module (Module) +import Data.Text (Text) +import Language.Scalie.Ast.Provenance (Provenance) +import Language.Scalie.Ast.Provenance.SourceLocation (SourceLocation) +import Language.Scalie.Bytecode.Object qualified as Bytecode +import Data.Kind (Type) + +-- | The name of the entrypoint function + +type EntryPoint :: Type +type EntryPoint = Text + +compile :: Module (Provenance SourceLocation) -> EntryPoint -> Bytecode.Object +compile = _ From 13c3e4d0077983ab7d6d326bd156dceef3e7df53 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 14 Aug 2025 14:44:23 +0200 Subject: [PATCH 5/5] feat[compiler]: Compile to bytecode --- package.yaml | 1 + scalie.cabal | 3 ++ src/Data/Map/Implicit.hs | 13 +++++++- src/Language/Scalie/Ast/Definition.hs | 21 ++++++++++-- src/Language/Scalie/Bytecode/Instruction.hs | 4 +++ .../Scalie/Bytecode/Object/Builder.hs | 3 +- src/Language/Scalie/Compiler/Bytecode.hs | 33 +++++++++++++++---- 7 files changed, 67 insertions(+), 11 deletions(-) diff --git a/package.yaml b/package.yaml index 67426df..043e986 100644 --- a/package.yaml +++ b/package.yaml @@ -22,6 +22,7 @@ default-extensions: - DerivingStrategies - ImportQualifiedPost - NoImplicitPrelude + - OverloadedRecordDot - OverloadedStrings - StandaloneKindSignatures - RoleAnnotations diff --git a/scalie.cabal b/scalie.cabal index f4acf24..fab9b99 100644 --- a/scalie.cabal +++ b/scalie.cabal @@ -39,6 +39,7 @@ library DerivingStrategies ImportQualifiedPost NoImplicitPrelude + OverloadedRecordDot OverloadedStrings StandaloneKindSignatures RoleAnnotations @@ -61,6 +62,7 @@ executable scalie-exe DerivingStrategies ImportQualifiedPost NoImplicitPrelude + OverloadedRecordDot OverloadedStrings StandaloneKindSignatures RoleAnnotations @@ -87,6 +89,7 @@ test-suite scalie-test DerivingStrategies ImportQualifiedPost NoImplicitPrelude + OverloadedRecordDot OverloadedStrings StandaloneKindSignatures RoleAnnotations diff --git a/src/Data/Map/Implicit.hs b/src/Data/Map/Implicit.hs index 7996c15..b4b367e 100644 --- a/src/Data/Map/Implicit.hs +++ b/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, fromList) 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) diff --git a/src/Language/Scalie/Ast/Definition.hs b/src/Language/Scalie/Ast/Definition.hs index 7ebc156..b8ebb3d 100644 --- a/src/Language/Scalie/Ast/Definition.hs +++ b/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 - type KeyType (Definition f) = f Text - keyOf :: Definition f -> KeyType (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) keyOf = name instance (Functor f, Arbitrary (f UnicodeString), Arbitrary (f Scalie.Domain.Type), Arbitrary (f Expression)) => Arbitrary (Definition f) where diff --git a/src/Language/Scalie/Bytecode/Instruction.hs b/src/Language/Scalie/Bytecode/Instruction.hs index 493f9a5..e15156c 100644 --- a/src/Language/Scalie/Bytecode/Instruction.hs +++ b/src/Language/Scalie/Bytecode/Instruction.hs @@ -5,7 +5,11 @@ 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) diff --git a/src/Language/Scalie/Bytecode/Object/Builder.hs b/src/Language/Scalie/Bytecode/Object/Builder.hs index fcd41ef..c75cd33 100644 --- a/src/Language/Scalie/Bytecode/Object/Builder.hs +++ b/src/Language/Scalie/Bytecode/Object/Builder.hs @@ -7,6 +7,7 @@ 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 @@ -25,4 +26,4 @@ instance Monad Builder where runBuilder :: Builder a -> (Bytecode.Object, a) -runBuilder = _ +runBuilder = undefined diff --git a/src/Language/Scalie/Compiler/Bytecode.hs b/src/Language/Scalie/Compiler/Bytecode.hs index 8d95b9c..50a30ae 100644 --- a/src/Language/Scalie/Compiler/Bytecode.hs +++ b/src/Language/Scalie/Compiler/Bytecode.hs @@ -1,16 +1,37 @@ -{-# LANGUAGE Safe #-} -module Language.Scalie.Compiler.Bytecode (EntryPoint, compile) where -import Language.Scalie.Ast.Module (Module) +{-# 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) +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 -compile :: Module (Provenance SourceLocation) -> EntryPoint -> Bytecode.Object -compile = _ +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) + ]