diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2025-02-09 21:59:12 +0100 | 
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-02-11 20:49:15 +0100 | 
| commit | d67825ea3f441523e2814b831d397d95c0dc46a4 (patch) | |
| tree | 0224df35bdfa6acaca2587b86e3921bf60ffccf4 /src | |
| parent | 7cebff0d30b628e4a7d32feff83a767c126e32e7 (diff) | |
Provide imported definitions at run-time
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 10 | ||||
| -rw-r--r-- | src/Parser.hs | 21 | ||||
| -rw-r--r-- | src/Parser/Core.hs | 22 | ||||
| -rw-r--r-- | src/Parser/Expr.hs | 2 | ||||
| -rw-r--r-- | src/Run.hs | 10 | ||||
| -rw-r--r-- | src/Run/Monad.hs | 2 | ||||
| -rw-r--r-- | src/Test.hs | 94 | ||||
| -rw-r--r-- | src/Test/Builtins.hs | 16 | 
8 files changed, 102 insertions, 75 deletions
| diff --git a/src/Main.hs b/src/Main.hs index 73d8c02..1f15e68 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,8 +2,9 @@ module Main (main) where  import Control.Monad +import Data.Bifunctor  import Data.Maybe -import qualified Data.Text as T +import Data.Text qualified as T  import Text.Read (readMaybe) @@ -148,13 +149,14 @@ main = do          Nothing -> queryTerminal (Fd 1)      out <- startOutput (optVerbose opts) useColor -    modules <- parseTestFiles $ map fst files +    ( modules, allModules ) <- parseTestFiles $ map fst files      tests <- forM (zip modules $ map snd files) $ \( Module {..}, mbTestName ) -> do -        return $ map ( , moduleDefinitions ) $ case mbTestName of +        return $ map ( , map (first LocalVarName) moduleDefinitions ) $ case mbTestName of              Nothing -> moduleTests              Just name -> filter ((==name) . testName) moduleTests +    let globalDefs = concatMap (map snd . moduleExportedDefinitions) allModules -    ok <- allM (uncurry $ runTest out $ optTest opts) $ +    ok <- allM (\( test, defs ) -> runTest out (optTest opts) test (defs ++ globalDefs)) $          concat $ replicate (optRepeat opts) $ concat tests      when (not ok) exitFailure diff --git a/src/Parser.hs b/src/Parser.hs index 323f2cf..174babb 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -47,13 +47,13 @@ parseTestDefinition = label "test definition" $ toplevel ToplevelTest $ do  parseDefinition :: TestParser ( VarName, SomeExpr )  parseDefinition = label "symbol definition" $ do -    def <- localState $ L.indentBlock scn $ do +    def@( name, expr ) <- localState $ L.indentBlock scn $ do          wsymbol "def"          name <- varName          argsDecl <- functionArguments (\off _ -> return . ( off, )) varName mzero (\_ -> return . VarName)          atypes <- forM argsDecl $ \( off, vname :: VarName ) -> do              tvar <- newTypeVar -            modify $ \s -> s { testVars = ( vname, ExprTypeVar tvar ) : testVars s } +            modify $ \s -> s { testVars = ( vname, ( LocalVarName vname, ExprTypeVar tvar )) : testVars s }              return ( off, vname, tvar )          choice              [ do @@ -68,7 +68,7 @@ parseDefinition = label "symbol definition" $ do                  atypes' <- getInferredTypes atypes                  L.IndentNone . ( name, ) . SomeExpr . ArgsReq atypes' . FunctionAbstraction <$> replaceDynArgs expr              ] -    modify $ \s -> s { testVars = fmap someExprType def : testVars s } +    modify $ \s -> s { testVars = ( name, ( LocalVarName name, someExprType expr )) : testVars s }      return def    where      getInferredTypes atypes = forM atypes $ \( off, vname, tvar@(TypeVar tvarname) ) -> do @@ -112,10 +112,9 @@ parseExport = label "export declaration" $ toplevel id $ do  parseImport :: TestParser [ Toplevel ]  parseImport = label "import declaration" $ toplevel (\() -> []) $ do      wsymbol "import" -    name <- parseModuleName -    importedModule <- getOrParseModule name -    let importedDefs = filter ((`elem` moduleExports importedModule) . fst) (moduleDefinitions importedModule) -    modify $ \s -> s { testVars = map (fmap someExprType) importedDefs ++ testVars s } +    modName <- parseModuleName +    importedModule <- getOrParseModule modName +    modify $ \s -> s { testVars = map (fmap (fmap someExprType)) (moduleExportedDefinitions importedModule) ++ testVars s }      eol >> scn  parseTestModule :: FilePath -> TestParser Module @@ -146,10 +145,12 @@ parseTestModule absPath = do      eof      return Module {..} -parseTestFiles :: [ FilePath ] -> IO [ Module ] +parseTestFiles :: [ FilePath ] -> IO ( [ Module ], [ Module ] )  parseTestFiles paths = do      parsedModules <- newIORef [] -    reverse <$> foldM (go parsedModules) [] paths +    requestedModules <- reverse <$> foldM (go parsedModules) [] paths +    allModules <- map snd <$> readIORef parsedModules +    return ( requestedModules, allModules )    where      go parsedModules res path = do          let moduleName = error "current module name should be set at the beginning of parseTestModule" @@ -168,7 +169,7 @@ parseTestFile parsedModules moduleName path = do          Nothing -> do              let initState = TestParserState                      { testVars = concat -                        [ map (fmap someVarValueType) builtins +                        [ map (\( name, value ) -> ( unqualifyName name, ( name, someVarValueType value ))) builtins                          ]                      , testContext = SomeExpr (Undefined "void" :: Expr Void)                      , testNextTypeVar = 0 diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs index f964291..a0ba229 100644 --- a/src/Parser/Core.hs +++ b/src/Parser/Core.hs @@ -61,7 +61,7 @@ data Toplevel      | ToplevelImport ( ModuleName, VarName )  data TestParserState = TestParserState -    { testVars :: [ ( VarName, SomeExprType ) ] +    { testVars :: [ ( VarName, ( FqVarName, SomeExprType )) ]      , testContext :: SomeExpr      , testNextTypeVar :: Int      , testTypeUnif :: Map TypeVar SomeExprType @@ -75,25 +75,27 @@ newTypeVar = do      modify $ \s -> s { testNextTypeVar = idx + 1 }      return $ TypeVar $ T.pack $ 'a' : show idx -lookupVarType :: Int -> VarName -> TestParser SomeExprType +lookupVarType :: Int -> VarName -> TestParser ( FqVarName, SomeExprType )  lookupVarType off name = do      gets (lookup name . testVars) >>= \case          Nothing -> do              registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $                  "variable not in scope: `" <> textVarName name <> "'"              vtype <- ExprTypeVar <$> newTypeVar -            modify $ \s -> s { testVars = ( name, vtype ) : testVars s } -            return vtype -        Just t@(ExprTypeVar tvar) -> do -            gets (fromMaybe t . M.lookup tvar . testTypeUnif) +            let fqName = LocalVarName name +            modify $ \s -> s { testVars = ( name, ( fqName, vtype )) : testVars s } +            return ( fqName, vtype ) +        Just ( fqName, t@(ExprTypeVar tvar) ) -> do +            ( fqName, ) <$> gets (fromMaybe t . M.lookup tvar . testTypeUnif)          Just x -> return x  lookupVarExpr :: Int -> SourceLine -> VarName -> TestParser SomeExpr  lookupVarExpr off sline name = do -    lookupVarType off name >>= \case -        ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline name :: Expr a) -        ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar sline name -        ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args sline name :: Expr (FunctionType a)) +    ( fqn, etype ) <- lookupVarType off name +    case etype of +        ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline fqn :: Expr a) +        ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar sline fqn +        ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args sline fqn :: Expr (FunctionType a))  unify :: Int -> SomeExprType -> SomeExprType -> TestParser SomeExprType  unify _ (ExprTypeVar aname) (ExprTypeVar bname) | aname == bname = do diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index 41790bb..d59e0b2 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -80,7 +80,7 @@ addVarName off (TypedVarName name) = do          Just _ -> registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $              T.pack "variable '" <> textVarName name <> T.pack "' already exists"          Nothing -> return () -    modify $ \s -> s { testVars = ( name, ExprTypePrim @a Proxy ) : testVars s } +    modify $ \s -> s { testVars = ( name, ( LocalVarName name, ExprTypePrim @a Proxy )) : testVars s }  someExpansion :: TestParser SomeExpr  someExpansion = do @@ -33,7 +33,7 @@ import Run.Monad  import Test  import Test.Builtins -runTest :: Output -> TestOptions -> Test -> [ ( VarName, SomeExpr ) ] -> IO Bool +runTest :: Output -> TestOptions -> Test -> [ ( FqVarName, SomeExpr ) ] -> IO Bool  runTest out opts test variables = do      let testDir = optTestDir opts      when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e -> @@ -249,7 +249,7 @@ exprFailed desc sline pname exprVars = do      outLine OutputMatchFail (Just prompt) $ T.concat [desc, T.pack " failed on ", textSourceLine sline]      forM_ exprVars $ \((name, sel), value) ->          outLine OutputMatchFail (Just prompt) $ T.concat -            [ "  ", textVarName name, T.concat (map ("."<>) sel) +            [ "  ", textFqVarName name, T.concat (map ("."<>) sel)              , " = ", textSomeVarValue sline value              ]      throwError Failed @@ -273,12 +273,6 @@ expect sline p (Traced trace re) tvars inner = do                   outProc OutputMatchFail p $ T.pack "mismatched number of capture variables on " `T.append` textSourceLine sline                   throwError Failed -             forM_ vars $ \name -> do -                 cur <- asks (lookup name . tsVars . snd) -                 when (isJust cur) $ do -                     outProc OutputError p $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` textSourceLine sline -                     throwError Failed -               outProc OutputMatch p line               inner capture diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs index 3739e2e..a550070 100644 --- a/src/Run/Monad.hs +++ b/src/Run/Monad.hs @@ -38,7 +38,7 @@ data TestEnv = TestEnv      }  data TestState = TestState -    { tsVars :: [(VarName, SomeVarValue)] +    { tsVars :: [ ( FqVarName, SomeVarValue ) ]      , tsDisconnectedUp :: Set NetworkNamespace      , tsDisconnectedBridge :: Set NetworkNamespace      , tsNodePacketLoss :: Map NetworkNamespace Scientific diff --git a/src/Test.hs b/src/Test.hs index 01b2d95..0f65b3c 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -1,12 +1,14 @@  module Test ( -    Module(..), ModuleName(..), textModuleName, +    Module(..), ModuleName(..), textModuleName, moduleExportedDefinitions,      Test(..),      TestStep(..),      TestBlock(..),      SourceLine(..), textSourceLine,      MonadEval(..), lookupVar, tryLookupVar, withVar, -    VarName(..), TypedVarName(..), textVarName, unpackVarName, withTypedVar, +    VarName(..), textVarName, unpackVarName, +    FqVarName(..), textFqVarName, unpackFqVarName, unqualifyName, +    TypedVarName(..), withTypedVar,      ExprType(..), SomeExpr(..),      TypeVar(..), SomeExprType(..), someExprType, textSomeExprType,      FunctionType, DynamicType, @@ -34,6 +36,7 @@ import Control.Monad  import Control.Monad.Reader  import Data.Char +import Data.Bifunctor  import Data.Foldable  import Data.List  import Data.Map (Map) @@ -60,11 +63,16 @@ data Module = Module      }  newtype ModuleName = ModuleName [ Text ] -    deriving (Eq, Ord) +    deriving (Eq, Ord, Show)  textModuleName :: ModuleName -> Text  textModuleName (ModuleName parts) = T.intercalate "." parts +moduleExportedDefinitions :: Module -> [ ( VarName, ( FqVarName, SomeExpr )) ] +moduleExportedDefinitions Module {..} = +    map (\( var, expr ) -> ( var, ( GlobalVarName moduleName var, expr ))) $ +        filter ((`elem` moduleExports) . fst) moduleDefinitions +  data Test = Test      { testName :: Text      , testSteps :: Expr TestBlock @@ -100,37 +108,55 @@ class MonadFail m => MonadEval m where      askDictionary :: m VariableDictionary      withDictionary :: (VariableDictionary -> VariableDictionary) -> m a -> m a -type VariableDictionary = [ ( VarName, SomeVarValue ) ] +type VariableDictionary = [ ( FqVarName, SomeVarValue ) ] -lookupVar :: MonadEval m => VarName -> m SomeVarValue -lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return . lookup name =<< askDictionary +lookupVar :: MonadEval m => FqVarName -> m SomeVarValue +lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackFqVarName name ++ "'") return . lookup name =<< askDictionary -tryLookupVar :: MonadEval m => VarName -> m (Maybe SomeVarValue) +tryLookupVar :: MonadEval m => FqVarName -> m (Maybe SomeVarValue)  tryLookupVar name = lookup name <$> askDictionary  withVar :: (MonadEval m, ExprType e) => VarName -> e -> m a -> m a -withVar name value = withDictionary (( name, someConstValue value ) : ) +withVar name value = withDictionary (( LocalVarName name, someConstValue value ) : ) -newtype VarName = VarName Text -    deriving (Eq, Ord, Show) -newtype TypedVarName a = TypedVarName { fromTypedVarName :: VarName } +newtype VarName = VarName Text      deriving (Eq, Ord)  textVarName :: VarName -> Text -textVarName (VarName name ) = name +textVarName (VarName name) = name  unpackVarName :: VarName -> String  unpackVarName = T.unpack . textVarName -isInternalVar :: VarName -> Bool -isInternalVar (VarName name) -    | Just ( '$', _ ) <- T.uncons name = True -    | otherwise                        = False +data FqVarName +    = GlobalVarName ModuleName VarName +    | LocalVarName VarName +    deriving (Eq, Ord) + +textFqVarName :: FqVarName -> Text +textFqVarName (GlobalVarName mname vname) = textModuleName mname <> "." <> textVarName vname +textFqVarName (LocalVarName vname) = textVarName vname + +unpackFqVarName :: FqVarName -> String +unpackFqVarName = T.unpack . textFqVarName + +unqualifyName :: FqVarName -> VarName +unqualifyName (GlobalVarName _ name) = name +unqualifyName (LocalVarName name) = name + +newtype TypedVarName a = TypedVarName { fromTypedVarName :: VarName } +    deriving (Eq, Ord)  withTypedVar :: (MonadEval m, ExprType e) => TypedVarName e -> e -> m a -> m a  withTypedVar (TypedVarName name) = withVar name +isInternalVar :: FqVarName -> Bool +isInternalVar (GlobalVarName {}) = False +isInternalVar (LocalVarName (VarName name)) +    | Just ( '$', _ ) <- T.uncons name = True +    | otherwise                        = False +  class Typeable a => ExprType a where      textExprType :: proxy a -> Text @@ -269,22 +295,22 @@ data VarValue a = VarValue  someConstValue :: ExprType a => a -> SomeVarValue  someConstValue = SomeVarValue . VarValue [] mempty . const . const -fromConstValue :: forall a m. (ExprType a, MonadFail m) => SourceLine -> VarName -> VarValue a -> m a +fromConstValue :: forall a m. (ExprType a, MonadFail m) => SourceLine -> FqVarName -> VarValue a -> m a  fromConstValue sline name (VarValue _ args value :: VarValue b) = do      maybe (fail err) return $ do          guard $ anull args          cast $ value sline mempty    where -    err = T.unpack $ T.concat [ T.pack "expected ", textExprType @a Proxy, T.pack ", but variable '", textVarName name, T.pack "' has type ", +    err = T.unpack $ T.concat [ T.pack "expected ", textExprType @a Proxy, T.pack ", but variable '", textFqVarName name, T.pack "' has type ",              if anull args then textExprType @b Proxy else "function type" ] -fromSomeVarValue :: forall a m. (ExprType a, MonadFail m) => SourceLine -> VarName -> SomeVarValue -> m a +fromSomeVarValue :: forall a m. (ExprType a, MonadFail m) => SourceLine -> FqVarName -> SomeVarValue -> m a  fromSomeVarValue sline name (SomeVarValue (VarValue _ args value :: VarValue b)) = do      maybe (fail err) return $ do          guard $ anull args          cast $ value sline mempty    where -    err = T.unpack $ T.concat [ T.pack "expected ", textExprType @a Proxy, T.pack ", but variable '", textVarName name, T.pack "' has type ", +    err = T.unpack $ T.concat [ T.pack "expected ", textExprType @a Proxy, T.pack ", but variable '", textFqVarName name, T.pack "' has type ",              if anull args then textExprType @b Proxy else "function type" ]  textSomeVarValue :: SourceLine -> SomeVarValue -> Text @@ -307,9 +333,9 @@ data ExprEnumerator a = ExprEnumerator (a -> a -> [a]) (a -> a -> a -> [a])  data Expr a where      Let :: forall a b. ExprType b => SourceLine -> TypedVarName b -> Expr b -> Expr a -> Expr a -    Variable :: ExprType a => SourceLine -> VarName -> Expr a -    DynVariable :: TypeVar -> SourceLine -> VarName -> Expr DynamicType -    FunVariable :: ExprType a => FunctionArguments SomeArgumentType -> SourceLine -> VarName -> Expr (FunctionType a) +    Variable :: ExprType a => SourceLine -> FqVarName -> Expr a +    DynVariable :: TypeVar -> SourceLine -> FqVarName -> Expr DynamicType +    FunVariable :: ExprType a => FunctionArguments SomeArgumentType -> SourceLine -> FqVarName -> Expr (FunctionType a)      ArgsReq :: ExprType a => FunctionArguments ( VarName, SomeArgumentType ) -> Expr (FunctionType a) -> Expr (FunctionType a)      ArgsApp :: ExprType a => FunctionArguments SomeExpr -> Expr (FunctionType a) -> Expr (FunctionType a)      FunctionAbstraction :: ExprType a => Expr a -> Expr (FunctionType a) @@ -339,7 +365,7 @@ instance Monoid a => Monoid (Expr a) where      mempty = Pure mempty  varExpr :: ExprType a => SourceLine -> TypedVarName a -> Expr a -varExpr sline (TypedVarName name) = Variable sline name +varExpr sline (TypedVarName name) = Variable sline (LocalVarName name)  mapExpr :: forall a. (forall b. Expr b -> Expr b) -> Expr a -> Expr a  mapExpr f = go @@ -383,13 +409,13 @@ eval = \case          val <- eval valExpr          withVar name val $ eval expr      Variable sline name -> fromSomeVarValue sline name =<< lookupVar name -    DynVariable _ _ name -> fail $ "ambiguous type of ‘" <> unpackVarName name <> "’" +    DynVariable _ _ name -> fail $ "ambiguous type of ‘" <> unpackFqVarName name <> "’"      FunVariable _ sline name -> funFromSomeVarValue sline name =<< lookupVar name      ArgsReq (FunctionArguments req) efun -> do          dict <- askDictionary          return $ FunctionType $ \(FunctionArguments args) ->              let used = M.intersectionWith (\value ( vname, _ ) -> ( vname, value )) args req -                FunctionType fun = runSimpleEval (eval efun) (toList used ++ dict) +                FunctionType fun = runSimpleEval (eval efun) (map (first LocalVarName) (toList used) ++ dict)               in fun $ FunctionArguments $ args `M.difference` req      ArgsApp eargs efun -> do          FunctionType fun <- eval efun @@ -403,7 +429,7 @@ eval = \case          return $ fun mempty      LambdaAbstraction (TypedVarName name) expr -> do          dict <- askDictionary -        return $ \x -> runSimpleEval (eval expr) (( name, someConstValue x ) : dict) +        return $ \x -> runSimpleEval (eval expr) (( LocalVarName name, someConstValue x ) : dict)      Pure value -> return value      App _ f x -> eval f <*> eval x      Concat xs -> T.concat <$> mapM eval xs @@ -431,7 +457,7 @@ evalSome (SomeExpr expr)  data Traced a = Traced EvalTrace a -type VarNameSelectors = ( VarName, [ Text ] ) +type VarNameSelectors = ( FqVarName, [ Text ] )  type EvalTrace = [ ( VarNameSelectors, SomeVarValue ) ]  gatherVars :: forall a m. MonadEval m => Expr a -> m EvalTrace @@ -439,20 +465,20 @@ gatherVars = fmap (uniqOn fst . sortOn fst) . helper    where      helper :: forall b. Expr b -> m EvalTrace      helper = \case -        Let _ (TypedVarName var) _ expr -> withDictionary (filter ((var /=) . fst)) $ helper expr +        Let _ (TypedVarName var) _ expr -> withDictionary (filter ((LocalVarName var /=) . fst)) $ helper expr          Variable _ var              | isInternalVar var -> return []              | otherwise -> maybe [] (\x -> [ (( var, [] ), x ) ]) <$> tryLookupVar var          DynVariable _ _ var -> maybe [] (\x -> [ (( var, [] ), x ) ]) <$> tryLookupVar var          FunVariable _ _ var -> maybe [] (\x -> [ (( var, [] ), x ) ]) <$> tryLookupVar var -        ArgsReq args expr -> withDictionary (filter ((`notElem` map fst (toList args)) . fst)) $ helper expr +        ArgsReq args expr -> withDictionary (filter ((`notElem` map (LocalVarName . fst) (toList args)) . fst)) $ helper expr          ArgsApp (FunctionArguments args) fun -> do              v <- helper fun              vs <- mapM (\(SomeExpr e) -> helper e) $ M.elems args              return $ concat (v : vs)          FunctionAbstraction expr -> helper expr          FunctionEval efun -> helper efun -        LambdaAbstraction (TypedVarName var) expr -> withDictionary (filter ((var /=) . fst)) $ helper expr +        LambdaAbstraction (TypedVarName var) expr -> withDictionary (filter ((LocalVarName var /=) . fst)) $ helper expr          Pure _ -> return []          e@(App (AnnRecord sel) _ x)              | Just (var, sels) <- gatherSelectors x @@ -467,7 +493,7 @@ gatherVars = fmap (uniqOn fst . sortOn fst) . helper          Undefined {} -> return []          Trace expr -> helper expr -    gatherSelectors :: forall b. Expr b -> Maybe (VarName, [Text]) +    gatherSelectors :: forall b. Expr b -> Maybe ( FqVarName, [ Text ] )      gatherSelectors = \case          Variable _ var -> Just (var, [])          App (AnnRecord sel) _ x -> do @@ -500,13 +526,13 @@ exprArgs = \case      App {} -> error "exprArgs: app"      Undefined {} -> error "exprArgs: undefined" -funFromSomeVarValue :: forall a m. (ExprType a, MonadFail m) => SourceLine -> VarName -> SomeVarValue -> m (FunctionType a) +funFromSomeVarValue :: forall a m. (ExprType a, MonadFail m) => SourceLine -> FqVarName -> SomeVarValue -> m (FunctionType a)  funFromSomeVarValue sline name (SomeVarValue (VarValue _ args value :: VarValue b)) = do      maybe (fail err) return $ do          guard $ not $ anull args          FunctionType <$> cast (value sline)    where -    err = T.unpack $ T.concat [ T.pack "expected function returning ", textExprType @a Proxy, T.pack ", but variable '", textVarName name, T.pack "' has ", +    err = T.unpack $ T.concat [ T.pack "expected function returning ", textExprType @a Proxy, T.pack ", but variable '", textFqVarName name, T.pack "' has ",              (if anull args then "type " else "function type returting ") <> textExprType @b Proxy ]  data SomeArgumentType = forall a. ExprType a => SomeArgumentType (ArgumentType a) diff --git a/src/Test/Builtins.hs b/src/Test/Builtins.hs index a676a35..29e54af 100644 --- a/src/Test/Builtins.hs +++ b/src/Test/Builtins.hs @@ -9,22 +9,24 @@ import Data.Text (Text)  import Process (Process)  import Test -builtins :: [ ( VarName, SomeVarValue ) ] +builtins :: [ ( FqVarName, SomeVarValue ) ]  builtins = -    [ ( VarName "send", builtinSend ) -    , ( VarName "flush", builtinFlush ) -    , ( VarName "guard", builtinGuard ) -    , ( VarName "wait", builtinWait ) +    [ fq "send" builtinSend +    , fq "flush" builtinFlush +    , fq "guard" builtinGuard +    , fq "wait" builtinWait      ] +  where +    fq name impl = ( GlobalVarName (ModuleName [ "$" ]) (VarName name), impl )  getArg :: ExprType a => FunctionArguments SomeVarValue -> Maybe ArgumentKeyword -> a  getArg args = fromMaybe (error "parameter mismatch") . getArgMb args  getArgMb :: ExprType a => FunctionArguments SomeVarValue -> Maybe ArgumentKeyword -> Maybe a  getArgMb (FunctionArguments args) kw = do -    fromSomeVarValue SourceLineBuiltin (VarName "") =<< M.lookup kw args +    fromSomeVarValue SourceLineBuiltin (LocalVarName (VarName "")) =<< M.lookup kw args -getArgVars :: FunctionArguments SomeVarValue -> Maybe ArgumentKeyword -> [ (( VarName, [ Text ] ), SomeVarValue ) ] +getArgVars :: FunctionArguments SomeVarValue -> Maybe ArgumentKeyword -> [ (( FqVarName, [ Text ] ), SomeVarValue ) ]  getArgVars (FunctionArguments args) kw = do      maybe [] svvVariables $ M.lookup kw args |