Add records to the Inferno language

inferno-core/CHANGELOG.md

@@ -1,6 +1,9 @@
 # Revision History for inferno-core
 *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH)
 
+## 0.11.0.0 -- 2024-03-12
+* Add records to the Inferno language
+
 ## 0.10.1.0 -- 2024-01-30
 * Fix `ToValue` instances for functions and `ImplicitCast`
 

inferno-core/app/Main.hs

@@ -3,28 +3,68 @@
 
 module Main where
 
+import Data.Bifunctor (bimap)
 import qualified Data.Map as Map
 import qualified Data.Text.IO as Text
 import Inferno.Core (Interpreter (..), mkInferno)
 import Inferno.Module.Prelude (builtinModules)
+import Inferno.Types.VersionControl (pinnedToMaybe)
 import Inferno.Utils.Prettyprinter (showPretty)
-import System.Environment (getArgs)
+import Options.Applicative
+  ( Parser,
+    argument,
+    execParser,
+    fullDesc,
+    header,
+    help,
+    helper,
+    info,
+    long,
+    metavar,
+    progDesc,
+    short,
+    str,
+    switch,
+    (<**>),
+  )
 import System.Exit (exitFailure)
-import System.IO (hPutStrLn, stderr)
+import System.IO (hPrint, stderr)
+
+data CliArgs = CliArgs {file :: String, typecheck :: Bool}
+
+cliargs :: Parser CliArgs
+cliargs =
+  CliArgs
+    <$> argument str (metavar "FILE" <> help "Input file path")
+    <*> switch (long "typecheck" <> short 't' <> help "Only run type inference")
 
 main :: IO ()
 main = do
-  file <- head <$> getArgs
-  src <- Text.readFile file
-  Interpreter {evalExpr, defaultEnv, parseAndInferTypeReps} <-
+  let opts =
+        info
+          (cliargs <**> helper)
+          ( fullDesc
+              <> progDesc "Run Inferno on FILE"
+              <> header "inferno - a functional scripting language"
+          )
+  args <- execParser opts
+
+  src <- Text.readFile $ file args
+  Interpreter {evalExpr, defaultEnv, parseAndInfer} <-
     mkInferno builtinModules [] :: IO (Interpreter IO ())
-  case parseAndInferTypeReps src of
+  case parseAndInfer src of
     Left err -> do
-      hPutStrLn stderr $ show err
+      hPrint stderr err
       exitFailure
-    Right ast -> do
-      evalExpr defaultEnv Map.empty ast >>= \case
-        Left err -> do
-          hPutStrLn stderr $ show err
-          exitFailure
-        Right res -> showPretty res
+    Right (ast, ty, _, _) -> do
+      if typecheck args
+        then do
+          putStrLn "Inferred type:"
+          showPretty ty
+        else do
+          let ast' = bimap pinnedToMaybe (const ()) ast
+          evalExpr defaultEnv Map.empty ast' >>= \case
+            Left err -> do
+              hPrint stderr err
+              exitFailure
+            Right res -> showPretty res

inferno-core/inferno-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.4
 name:                inferno-core
-version:             0.10.1.0
+version:             0.11.0.0
 synopsis:            A statically-typed functional scripting language
 description:         Parser, type inference, and interpreter for a statically-typed functional scripting language
 category:            DSL,Scripting
@@ -46,7 +46,7 @@ library
     , Inferno.Utils.QQ.Common
   hs-source-dirs:
       src
-  ghc-options: -Wall -Wunused-packages -Wincomplete-uni-patterns -Wincomplete-record-updates
+  ghc-options: -Wall -Wunused-packages -Wincomplete-uni-patterns -Wincomplete-record-updates -Wincomplete-patterns
   build-depends:
       base                      >= 4.13 && < 4.17
     , bimap                     >= 0.5.0 && < 0.6
@@ -59,7 +59,7 @@ library
     , extra                     >= 1.7.12 && < 1.8
     , generic-lens              >= 2.2.1 && < 2.3
     , inferno-vc                >= 0.3.0 && < 0.4
-    , inferno-types             >= 0.3.0 && < 0.4
+    , inferno-types             >= 0.4.0 && < 0.5
     , megaparsec                >= 9.2.1 && < 9.3
     , memory                    >= 0.18.0 && < 0.19
     , mtl                       >= 2.2.2 && < 2.3
@@ -137,5 +137,6 @@ executable inferno
     , containers
     , inferno-core
     , inferno-types
+    , optparse-applicative
     , text
   default-language: Haskell2010

inferno-core/src/Inferno/Eval.hs

@@ -29,19 +29,7 @@ import Inferno.Types.Syntax
   )
 import Inferno.Types.Value
   ( ImplEnvM,
-    Value
-      ( VArray,
-        VDouble,
-        VEmpty,
-        VEnum,
-        VFun,
-        VInt,
-        VOne,
-        VText,
-        VTuple,
-        VTypeRep,
-        VWord64
-      ),
+    Value (..),
     runImplEnvM,
   )
 import Inferno.Types.VersionControl (VCObjectHash)
@@ -204,6 +192,17 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
       _ -> throwM $ RuntimeError "failed to match with a bool"
   Tuple_ es ->
     foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] (tListToList es) >>= return . VTuple
+  Record_ fs -> do
+    valMap <- foldrM (\(f, e, _) vs -> eval env e >>= \v -> return ((f, v) : vs)) [] fs
+    return $ VRecord $ Map.fromList valMap
+  RecordField_ (Ident r) f -> do
+    case Map.lookup (ExtIdent $ Right r) localEnv of
+      Just (VRecord fs) -> do
+        case Map.lookup f fs of
+          Just v -> return v
+          Nothing -> throwM $ RuntimeError "record field not found"
+      Just _ -> throwM $ RuntimeError "failed to match with a record"
+      Nothing -> throwM $ RuntimeError $ show (ExtIdent $ Right r) <> " not found in the unpinned env"
   One_ e -> eval env e >>= return . VOne
   Empty_ -> return $ VEmpty
   Assert_ cond e ->