Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

HLint everything and add to CI #105

Merged
merged 8 commits into from Mar 18, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
19 changes: 19 additions & 0 deletions .github/hlint.json
@@ -0,0 +1,19 @@
{
"problemMatcher": [
{
"owner": "hlint",
"pattern": [
{
"regexp": "^hlint\\t(?<file>[^\\t]*)\\t(?<fromPath>[^\\t]*)\\t(?<line>[^\\t]*)\\t(?<column>[^\\t]*)\\t(?<severity>[^\\t]*)\\t(?<code>[^\\t]*)\\t(?<message>[^\\t]*)$",
"file": 1,
"fromPath": 2,
"line": 3,
"column": 4,
"severity": 5,
"code": 6,
"message": 7
}
]
}
]
}
16 changes: 15 additions & 1 deletion .github/workflows/build.yml
Expand Up @@ -19,7 +19,19 @@ jobs:
MNIST_FNAME: /tmp/mnist/mnist.ts.pt
MNIST_COMMIT: 94b288a631362aa44edc219eb8f54a7c39891169
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4

# Lint code with HLint
- name: Set up HLint
uses: haskell-actions/hlint-setup@v2
with:
version: "3.8"
- name: Run HLint
uses: haskell-actions/hlint-run@v2
with:
path: '["inferno-core/", "inferno-lsp/", "inferno-ml/", "inferno-ml-server-types/", "inferno-types/", "inferno-vc/"]'
fail-on: error

- uses: cachix/install-nix-action@v18
with:
install_url: https://releases.nixos.org/nix/nix-2.13.3/install
Expand All @@ -32,6 +44,8 @@ jobs:
name: inferno
authToken: "${{ secrets.CACHIX_TOKEN }}"
- uses: DeterminateSystems/magic-nix-cache-action@main

# Build inferno and run all tests
- run: |
nix build -L .#

Expand Down
3 changes: 3 additions & 0 deletions 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.1.0 -- 2024-03-18
* HLint everything

## 0.11.0.0 -- 2024-03-12
* Add records to the Inferno language

Expand Down
2 changes: 1 addition & 1 deletion inferno-core/inferno-core.cabal
@@ -1,6 +1,6 @@
cabal-version: 2.4
name: inferno-core
version: 0.11.0.0
version: 0.11.1.0
synopsis: A statically-typed functional scripting language
description: Parser, type inference, and interpreter for a statically-typed functional scripting language
category: DSL,Scripting
Expand Down
5 changes: 2 additions & 3 deletions inferno-core/src/Inferno/Core.hs
@@ -1,14 +1,13 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Inferno.Core where

import Control.Monad (foldM)
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.Except (MonadFix)
import Data.Bifunctor (bimap)
import Data.Bifunctor (bimap, first)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as Map
import qualified Data.Set as Set
Expand Down Expand Up @@ -130,7 +129,7 @@ mkInferno prelude customTypes = do
foldM
( \env (hash, obj) -> case obj of
VCFunction expr _ -> do
let expr' = bimap pinnedToMaybe id expr
let expr' = first pinnedToMaybe expr
pure $ Map.insert hash (Left expr') env
_ -> pure env
)
Expand Down
55 changes: 30 additions & 25 deletions inferno-core/src/Inferno/Eval.hs
Expand Up @@ -7,6 +7,7 @@ import Control.Monad.Catch (MonadCatch, MonadThrow (throwM), try)
import Control.Monad.Except (forM)
import Control.Monad.Reader (ask, local)
import Data.Foldable (foldrM)
import Data.Functor ((<&>))
import Data.List.NonEmpty (NonEmpty (..), toList)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
Expand Down Expand Up @@ -67,7 +68,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
toText (VText t) = t
toText e = renderStrict $ layoutPretty (LayoutOptions Unbounded) $ pretty e
Array_ es ->
foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] es >>= return . VArray
foldrM (\(e, _) vs -> eval env e <&> (: vs)) [] es <&> VArray
ArrayComp_ e srcs mCond -> do
vals <- sequence' env srcs
VArray <$> case mCond of
Expand All @@ -76,19 +77,21 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
let nenv = foldr (uncurry Map.insert) localEnv vs in eval (nenv, pinnedEnv) e
Just (_, cond) ->
catMaybes
<$> ( forM vals $ \vs -> do
let nenv = foldr (uncurry Map.insert) localEnv vs
eval (nenv, pinnedEnv) cond >>= \case
VEnum hash "true" ->
if hash == enumBoolHash
then Just <$> (eval (nenv, pinnedEnv) e)
else throwM $ RuntimeError "failed to match with a bool"
VEnum hash "false" ->
if hash == enumBoolHash
then return Nothing
else throwM $ RuntimeError "failed to match with a bool"
_ -> throwM $ RuntimeError "failed to match with a bool"
)
<$> forM
vals
( \vs -> do
let nenv = foldr (uncurry Map.insert) localEnv vs
eval (nenv, pinnedEnv) cond >>= \case
VEnum hash "true" ->
if hash == enumBoolHash
then Just <$> eval (nenv, pinnedEnv) e
else throwM $ RuntimeError "failed to match with a bool"
VEnum hash "false" ->
if hash == enumBoolHash
then return Nothing
else throwM $ RuntimeError "failed to match with a bool"
_ -> throwM $ RuntimeError "failed to match with a bool"
)
where
sequence' :: (MonadThrow m, Pretty c) => TermEnv VCObjectHash c (ImplEnvM m c) a -> NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a) -> ImplEnvM m c [[(ExtIdent, Value c (ImplEnvM m c))]]
sequence' env'@(localEnv', pinnedEnv') = \case
Expand All @@ -100,10 +103,12 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
eval env' e_s >>= \case
VArray vals ->
concat
<$> ( forM vals $ \v -> do
res <- sequence' (Map.insert (ExtIdent $ Right x) v localEnv', pinnedEnv') (r :| rs)
return $ map ((ExtIdent $ Right x, v) :) res
)
<$> forM
vals
( \v -> do
res <- sequence' (Map.insert (ExtIdent $ Right x) v localEnv', pinnedEnv') (r :| rs)
return $ map ((ExtIdent $ Right x, v) :) res
)
_ -> throwM $ RuntimeError "failed to match with an array"
Enum_ (Just hash) _ i -> return $ VEnum hash i
Enum_ Nothing _ _ -> throwM $ RuntimeError "All enums must be pinned"
Expand Down Expand Up @@ -162,7 +167,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
(_, Just x) : xs ->
return $ VFun $ \arg -> go (Map.insert x arg nenv) xs
(_, Nothing) : xs -> return $ VFun $ \_arg -> go nenv xs
App_ fun arg -> do
App_ fun arg ->
eval env fun >>= \case
VFun f -> do
argv <- eval env arg
Expand All @@ -178,7 +183,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
eval (nenv, pinnedEnv) body
Let_ (Impl x) e body -> do
e' <- eval env e
local (\impEnv -> Map.insert x e' impEnv) $ eval env body
local (Map.insert x e') $ eval env body
If_ cond tr fl ->
eval env cond >>= \case
VEnum hash "true" ->
Expand All @@ -191,7 +196,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
else throwM $ RuntimeError "failed to match with a bool"
_ -> throwM $ RuntimeError "failed to match with a bool"
Tuple_ es ->
foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] (tListToList es) >>= return . VTuple
foldrM (\(e, _) vs -> eval env e <&> (: vs)) [] (tListToList es) <&> VTuple
Record_ fs -> do
valMap <- foldrM (\(f, e, _) vs -> eval env e >>= \v -> return ((f, v) : vs)) [] fs
return $ VRecord $ Map.fromList valMap
Expand All @@ -203,8 +208,8 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
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
One_ e -> eval env e <&> VOne
Empty_ -> return VEmpty
Assert_ cond e ->
eval env cond >>= \case
VEnum hash "false" ->
Expand All @@ -224,13 +229,13 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
Just nenv ->
-- (<>) is left biased so this will correctly override any shadowed vars from nenv onto env
eval (nenv <> env) body
Nothing -> throwM $ RuntimeError $ "non-exhaustive patterns in case detected in " <> (Text.unpack $ renderPretty v)
Nothing -> throwM $ RuntimeError $ "non-exhaustive patterns in case detected in " <> Text.unpack (renderPretty v)
matchAny v ((_, p, _, body) :| (r : rs)) = case match v p of
Just nenv -> eval (nenv <> env) body
Nothing -> matchAny v (r :| rs)

match v p = case (v, p) of
(_, PVar _ (Just (Ident x))) -> Just $ (Map.singleton (ExtIdent $ Right x) v, mempty)
(_, PVar _ (Just (Ident x))) -> Just (Map.singleton (ExtIdent $ Right x) v, mempty)
(_, PVar _ Nothing) -> Just mempty
(VEnum h1 i1, PEnum _ (Just h2) _ i2) ->
if h1 == h2 && i1 == i2
Expand Down