diff --git a/app/App.hs b/app/App.hs index 7455690f87..359bf2a2b5 100644 --- a/app/App.hs +++ b/app/App.hs @@ -11,6 +11,7 @@ import System.Console.ANSI qualified as Ansi data App m a where ExitMsg :: ExitCode -> Text -> App m () ExitJuvixError :: JuvixError -> App m a + PrintJuvixError :: JuvixError -> App m () ReadGlobalOptions :: App m GlobalOptions RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m () RunPipelineEither :: Sem PipelineEff a -> App m (Either JuvixError a) @@ -31,11 +32,16 @@ runAppIO g = interpret $ \case Say t | g ^. globalOnlyErrors -> return () | otherwise -> embed (putStrLn t) + PrintJuvixError e -> do + printErr e ExitJuvixError e -> do - (embed . hPutStrLn stderr . Error.render (not (g ^. globalNoColors)) (g ^. globalOnlyErrors)) e + printErr e embed exitFailure ExitMsg exitCode t -> embed (putStrLn t >> exitWith exitCode) Raw b -> embed (ByteString.putStr b) + where + printErr e = + (embed . hPutStrLn stderr . Error.render (not (g ^. globalNoColors)) (g ^. globalOnlyErrors)) e runPipeline :: Member App r => Sem PipelineEff a -> Sem r a runPipeline p = do diff --git a/app/Commands/Dev.hs b/app/Commands/Dev.hs index 720f6230e6..2522902362 100644 --- a/app/Commands/Dev.hs +++ b/app/Commands/Dev.hs @@ -1,5 +1,6 @@ module Commands.Dev ( module Commands.Dev, + module Commands.Dev.Core, module Commands.Dev.Internal, module Commands.Dev.Parse, module Commands.Dev.Scope, @@ -8,6 +9,7 @@ module Commands.Dev ) where +import Commands.Dev.Core import Commands.Dev.Doc import Commands.Dev.Internal import Commands.Dev.Parse @@ -21,6 +23,7 @@ data InternalCommand = DisplayRoot | Highlight HighlightOptions | Internal MicroCommand + | Core CoreCommand | MiniC | MiniHaskell | MonoJuvix @@ -39,6 +42,7 @@ parseInternalCommand = ( mconcat [ commandHighlight, commandInternal, + commandCore, commandMiniC, commandMiniHaskell, commandMonoJuvix, @@ -96,6 +100,13 @@ commandInternal = (Internal <$> parseMicroCommand) (progDesc "Subcommands related to Internal") +commandCore :: Mod CommandFields InternalCommand +commandCore = + command "core" $ + info + (Core <$> parseCoreCommand) + (progDesc "Subcommands related to JuvixCore") + commandMiniHaskell :: Mod CommandFields InternalCommand commandMiniHaskell = command "minihaskell" $ diff --git a/app/Commands/Dev/Core.hs b/app/Commands/Dev/Core.hs new file mode 100644 index 0000000000..a3220e2d62 --- /dev/null +++ b/app/Commands/Dev/Core.hs @@ -0,0 +1,69 @@ +module Commands.Dev.Core where + +import Juvix.Prelude hiding (Doc) +import Options.Applicative + +data CoreCommand + = Repl CoreReplOptions + | Eval CoreEvalOptions + +newtype CoreReplOptions = CoreReplOptions + { _coreReplShowDeBruijn :: Bool + } + +newtype CoreEvalOptions = CoreEvalOptions + { _coreEvalNoIO :: Bool + } + +makeLenses ''CoreReplOptions +makeLenses ''CoreEvalOptions + +defaultCoreEvalOptions :: CoreEvalOptions +defaultCoreEvalOptions = + CoreEvalOptions + { _coreEvalNoIO = False + } + +parseCoreCommand :: Parser CoreCommand +parseCoreCommand = + hsubparser $ + mconcat + [ commandRepl, + commandEval + ] + where + commandRepl :: Mod CommandFields CoreCommand + commandRepl = command "repl" replInfo + + commandEval :: Mod CommandFields CoreCommand + commandEval = command "eval" evalInfo + + replInfo :: ParserInfo CoreCommand + replInfo = + info + (Repl <$> parseCoreReplOptions) + (progDesc "Start an interactive session of the JuvixCore evaluator") + + evalInfo :: ParserInfo CoreCommand + evalInfo = + info + (Eval <$> parseCoreEvalOptions) + (progDesc "Evaluate a JuvixCore file and pretty print the result") + +parseCoreEvalOptions :: Parser CoreEvalOptions +parseCoreEvalOptions = do + _coreEvalNoIO <- + switch + ( long "no-io" + <> help "Don't interpret the IO effects" + ) + pure CoreEvalOptions {..} + +parseCoreReplOptions :: Parser CoreReplOptions +parseCoreReplOptions = do + _coreReplShowDeBruijn <- + switch + ( long "show-de-bruijn" + <> help "Show variable de Bruijn indices" + ) + pure CoreReplOptions {..} diff --git a/app/Main.hs b/app/Main.hs index c691077d7f..58a557c4b3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -23,6 +23,15 @@ import Juvix.Compiler.Concrete.Data.InfoTable qualified as Scoper import Juvix.Compiler.Concrete.Pretty qualified as Scoper import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser +import Juvix.Compiler.Core.Data.InfoTable qualified as Core +import Juvix.Compiler.Core.Error qualified as Core +import Juvix.Compiler.Core.Evaluator qualified as Core +import Juvix.Compiler.Core.Extra.Base qualified as Core +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Info.NoDisplayInfo qualified as Info +import Juvix.Compiler.Core.Language qualified as Core +import Juvix.Compiler.Core.Pretty qualified as Core +import Juvix.Compiler.Core.Translation.FromSource qualified as Core import Juvix.Compiler.Internal.Pretty qualified as Internal import Juvix.Compiler.Internal.Translation.FromAbstract qualified as Internal import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination qualified as Termination @@ -39,6 +48,7 @@ import Juvix.Prelude.Pretty hiding (Doc) import Options.Applicative import System.Environment (getProgName) import System.Process qualified as Process +import Text.Megaparsec.Pos qualified as M import Text.Show.Pretty hiding (Html) findRoot :: CommandGlobalOptions -> IO (FilePath, Package) @@ -103,6 +113,7 @@ runCommand cmdWithOpts = do (root, pkg) <- embed (findRoot cmdWithOpts) case cmd of (Dev DisplayRoot) -> say (pack root) + (Dev (Core cmd')) -> runCoreCommand globalOpts cmd' _ -> do -- Other commands require an entry point: case getEntryPoint root pkg globalOpts of @@ -264,6 +275,147 @@ runCommand cmdWithOpts = do printSuccessExit (n <> " Terminates with order " <> show (toList k)) _ -> impossible +runCoreCommand :: Members '[Embed IO, App] r => GlobalOptions -> CoreCommand -> Sem r () +runCoreCommand globalOpts = \case + Repl opts -> do + embed showReplWelcome + runRepl opts Core.emptyInfoTable + Eval opts -> + case globalOpts ^. globalInputFiles of + [] -> printFailureExit "Provide a JuvixCore file to run this command\nUse --help to see all the options" + files -> mapM_ (evalFile opts) files + where + runRepl :: + forall r. + Members '[Embed IO, App] r => + CoreReplOptions -> + Core.InfoTable -> + Sem r () + runRepl opts tab = do + embed (putStr "> ") + embed (hFlush stdout) + done <- embed isEOF + unless done $ do + s <- embed getLine + case fromText (strip s) of + ":q" -> return () + ":h" -> do + embed showReplHelp + runRepl opts tab + ':' : 'p' : ' ' : s' -> + case Core.parseText tab (fromString s') of + Left err -> do + printJuvixError (JuvixError err) + runRepl opts tab + Right (tab', Just node) -> do + renderStdOut (Core.ppOutDefault node) + embed (putStrLn "") + runRepl opts tab' + Right (tab', Nothing) -> + runRepl opts tab' + ':' : 'e' : ' ' : s' -> + case Core.parseText tab (fromString s') of + Left err -> do + printJuvixError (JuvixError err) + runRepl opts tab + Right (tab', Just node) -> + replEval True tab' node + Right (tab', Nothing) -> + runRepl opts tab' + ':' : 'l' : ' ' : f -> do + s' <- embed (readFile f) + case Core.runParser "" f Core.emptyInfoTable s' of + Left err -> do + printJuvixError (JuvixError err) + runRepl opts tab + Right (tab', Just node) -> + replEval False tab' node + Right (tab', Nothing) -> + runRepl opts tab' + ":r" -> + runRepl opts Core.emptyInfoTable + _ -> + case Core.parseText tab s of + Left err -> do + printJuvixError (JuvixError err) + runRepl opts tab + Right (tab', Just node) -> + replEval False tab' node + Right (tab', Nothing) -> + runRepl opts tab' + where + replEval :: Bool -> Core.InfoTable -> Core.Node -> Sem r () + replEval noIO tab' node = do + r <- doEval noIO defaultLoc tab' node + case r of + Left err -> do + printJuvixError (JuvixError err) + runRepl opts tab' + Right node' + | Info.member Info.kNoDisplayInfo (Core.getInfo node') -> + runRepl opts tab' + Right node' -> do + renderStdOut (Core.ppOut docOpts node') + embed (putStrLn "") + runRepl opts tab' + where + defaultLoc = singletonInterval (mkLoc "stdin" 0 (M.initialPos "stdin")) + docOpts = set Core.optShowDeBruijnIndices (opts ^. coreReplShowDeBruijn) Core.defaultOptions + + showReplWelcome :: IO () + showReplWelcome = do + putStrLn "JuvixCore REPL" + putStrLn "" + putStrLn "Type \":h\" for help." + putStrLn "" + + showReplHelp :: IO () + showReplHelp = do + putStrLn "" + putStrLn "JuvixCore REPL" + putStrLn "" + putStrLn "Type in a JuvixCore program to evaluate." + putStrLn "" + putStrLn "Available commands:" + putStrLn ":p expr Pretty print \"expr\"." + putStrLn ":e expr Evaluate \"expr\" without interpreting IO actions." + putStrLn ":l file Load and evaluate \"file\". Resets REPL state." + putStrLn ":r Reset REPL state." + putStrLn ":q Quit." + putStrLn ":h Display this help message." + putStrLn "" + + evalFile :: Members '[Embed IO, App] r => CoreEvalOptions -> FilePath -> Sem r () + evalFile opts f = do + s <- embed (readFile f) + case Core.runParser "" f Core.emptyInfoTable s of + Left err -> exitJuvixError (JuvixError err) + Right (tab, Just node) -> do + r <- doEval (opts ^. coreEvalNoIO) defaultLoc tab node + case r of + Left err -> exitJuvixError (JuvixError err) + Right node' + | Info.member Info.kNoDisplayInfo (Core.getInfo node') -> + return () + Right node' -> do + renderStdOut (Core.ppOutDefault node') + embed (putStrLn "") + Right (_, Nothing) -> return () + where + defaultLoc = singletonInterval (mkLoc f 0 (M.initialPos f)) + + doEval :: + Members '[Embed IO, App] r => + Bool -> + Interval -> + Core.InfoTable -> + Core.Node -> + Sem r (Either Core.CoreError Core.Node) + doEval noIO loc tab node = + if noIO + then embed $ Core.catchEvalError loc (Core.eval (tab ^. Core.identContext) [] node) + else embed $ Core.catchEvalErrorIO loc (Core.evalIO (tab ^. Core.identContext) [] node) + showHelpText :: ParserPrefs -> IO () showHelpText p = do progn <- getProgName diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs index 4a27c3b8f8..522f217c09 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs @@ -13,8 +13,8 @@ import Juvix.Compiler.Concrete.Data.ScopedName qualified as S import Juvix.Compiler.Concrete.Language import Juvix.Compiler.Concrete.Language qualified as L import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty -import Juvix.Compiler.Concrete.Translation.FromSource.Error qualified as Parser import Juvix.Data.CodeAnn +import Juvix.Parser.Error qualified as Parser import Juvix.Prelude data MultipleDeclarations = MultipleDeclarations diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 1488c778fa..56d56353a0 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -2,7 +2,7 @@ module Juvix.Compiler.Concrete.Translation.FromSource ( module Juvix.Compiler.Concrete.Translation.FromSource, module Juvix.Compiler.Concrete.Translation.FromSource.Data.Context, module Juvix.Compiler.Concrete.Data.ParsedInfoTable, - module Juvix.Compiler.Concrete.Translation.FromSource.Error, + module Juvix.Parser.Error, ) where @@ -14,9 +14,9 @@ import Juvix.Compiler.Concrete.Extra (MonadParsec (takeWhile1P)) import Juvix.Compiler.Concrete.Extra qualified as P import Juvix.Compiler.Concrete.Language import Juvix.Compiler.Concrete.Translation.FromSource.Data.Context -import Juvix.Compiler.Concrete.Translation.FromSource.Error import Juvix.Compiler.Concrete.Translation.FromSource.Lexer hiding (symbol) import Juvix.Compiler.Pipeline.EntryPoint +import Juvix.Parser.Error import Juvix.Prelude import Juvix.Prelude.Pretty (Pretty, prettyText) diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs index d7c047b85d..8ed631411e 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs @@ -1,39 +1,21 @@ -module Juvix.Compiler.Concrete.Translation.FromSource.Lexer where +module Juvix.Compiler.Concrete.Translation.FromSource.Lexer + ( module Juvix.Compiler.Concrete.Translation.FromSource.Lexer, + module Juvix.Parser.Lexer, + ) +where import Data.Text qualified as Text import GHC.Unicode import Juvix.Compiler.Concrete.Data.ParsedInfoTableBuilder -import Juvix.Compiler.Concrete.Extra hiding (Pos, space) +import Juvix.Compiler.Concrete.Extra hiding (Pos, space, string') import Juvix.Compiler.Concrete.Extra qualified as P import Juvix.Extra.Strings qualified as Str +import Juvix.Parser.Lexer import Juvix.Prelude import Text.Megaparsec.Char.Lexer qualified as L type OperatorSym = Text -type ParsecS r = ParsecT Void Text (Sem r) - -newtype ParserParams = ParserParams - { _parserParamsRoot :: FilePath - } - -makeLenses ''ParserParams - -space :: forall r. Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r () -space = L.space space1 lineComment block - where - skipLineComment :: ParsecS r () - skipLineComment = do - notFollowedBy (P.chunk Str.judocStart) - void (P.chunk "--") - void (P.takeWhileP Nothing (/= '\n')) - - lineComment :: ParsecS r () - lineComment = comment_ skipLineComment - - block :: ParsecS r () - block = comment_ (L.skipBlockComment "{-" "-}") - comment :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r a -> ParsecS r a comment c = do (a, i) <- interval c @@ -43,6 +25,9 @@ comment c = do comment_ :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r a -> ParsecS r () comment_ = void . comment +space :: forall r. Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r () +space = space' True comment_ + lexeme :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r a -> ParsecS r a lexeme = L.lexeme space @@ -62,13 +47,7 @@ identifierL :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r ( identifierL = lexeme bareIdentifier integer :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (Integer, Interval) -integer = do - minus <- optional (char '-') - (nat, i) <- decimal - let nat' = case minus of - Nothing -> nat - _ -> (-nat) - return (nat', i) +integer = integer' decimal bracedString :: forall e m. MonadParsec e Text m => m Text bracedString = @@ -86,9 +65,7 @@ bracedString = char '}' string :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (Text, Interval) -string = - lexemeInterval $ - pack <$> (char '"' >> manyTill L.charLiteral (char '"')) +string = lexemeInterval string' judocExampleStart :: ParsecS r () judocExampleStart = P.chunk Str.judocExample >> hspace @@ -99,51 +76,14 @@ judocStart = P.chunk Str.judocStart >> hspace judocEmptyLine :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r () judocEmptyLine = lexeme (void (P.try (judocStart >> P.newline))) -curLoc :: Member (Reader ParserParams) r => ParsecS r Loc -curLoc = do - sp <- getSourcePos - offset <- getOffset - root <- lift (asks (^. parserParamsRoot)) - return (mkLoc root offset sp) - -interval :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (a, Interval) -interval ma = do - start <- curLoc - res <- ma - end <- curLoc - return (res, mkInterval start end) - -withLoc :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (WithLoc a) -withLoc ma = do - (a, i) <- interval ma - return (WithLoc i a) - keyword :: Members '[Reader ParserParams, InfoTableBuilder] r => Text -> ParsecS r () keyword kw = do - l <- P.try $ do - i <- snd <$> interval (P.chunk kw) - notFollowedBy (satisfy validTailChar) - space - return i + l <- keywordL' space kw lift (registerKeyword l) -- | Same as @identifier@ but does not consume space after it. bareIdentifier :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (Text, Interval) -bareIdentifier = interval $ do - notFollowedBy (choice allKeywords) - h <- P.satisfy validFirstChar - t <- P.takeWhileP Nothing validTailChar - return (Text.cons h t) - -validTailChar :: Char -> Bool -validTailChar c = - isAlphaNum c || validFirstChar c - -reservedSymbols :: [Char] -reservedSymbols = "\";(){}[].≔λ\\" - -validFirstChar :: Char -> Bool -validFirstChar c = not $ isNumber c || isSpace c || (c `elem` reservedSymbols) +bareIdentifier = interval $ rawIdentifier allKeywords dot :: forall e m. MonadParsec e Text m => m Char dot = P.char '.' diff --git a/src/Juvix/Compiler/Core/Data/BinderList.hs b/src/Juvix/Compiler/Core/Data/BinderList.hs new file mode 100644 index 0000000000..703172eba2 --- /dev/null +++ b/src/Juvix/Compiler/Core/Data/BinderList.hs @@ -0,0 +1,45 @@ +module Juvix.Compiler.Core.Data.BinderList where + +import Data.HashMap.Strict qualified as HashMap +import Data.List qualified as List +import Juvix.Compiler.Core.Language.Base + +data BinderList a = BinderList + { _blLength :: Int, + _blMap :: HashMap Index a + } + +makeLenses ''BinderList + +fromList :: [a] -> BinderList a +fromList l = BinderList (List.length l) (HashMap.fromList (zip [0 ..] l)) + +toList :: BinderList a -> [a] +toList bl = + List.map snd $ + sortBy (\x y -> compare (fst y) (fst x)) $ + HashMap.toList (bl ^. blMap) + +empty :: BinderList a +empty = BinderList 0 mempty + +length :: BinderList a -> Int +length = (^. blLength) + +lookup :: Index -> BinderList a -> a +lookup idx bl = + fromMaybe + (error "invalid binder lookup") + (HashMap.lookup (bl ^. blLength - 1 - idx) (bl ^. blMap)) + +extend :: a -> BinderList a -> BinderList a +extend a bl = + BinderList + (bl ^. blLength + 1) + (HashMap.insert (bl ^. blLength) a (bl ^. blMap)) + +map :: (a -> b) -> BinderList a -> BinderList b +map f bl = bl {_blMap = HashMap.map f (bl ^. blMap)} + +prepend :: [a] -> BinderList a -> BinderList a +prepend l bl = foldr extend bl l diff --git a/src/Juvix/Compiler/Core/Data/InfoTable.hs b/src/Juvix/Compiler/Core/Data/InfoTable.hs new file mode 100644 index 0000000000..bf9751276a --- /dev/null +++ b/src/Juvix/Compiler/Core/Data/InfoTable.hs @@ -0,0 +1,78 @@ +module Juvix.Compiler.Core.Data.InfoTable where + +import Juvix.Compiler.Core.Language + +type IdentContext = HashMap Symbol Node + +data InfoTable = InfoTable + { _identContext :: IdentContext, + -- `_identMap` is needed only for REPL + _identMap :: HashMap Text (Either Symbol Tag), + _infoMain :: Maybe Symbol, + _infoIdents :: HashMap Symbol IdentInfo, + _infoInductives :: HashMap Name InductiveInfo, + _infoConstructors :: HashMap Tag ConstructorInfo, + _infoAxioms :: HashMap Name AxiomInfo + } + +emptyInfoTable :: InfoTable +emptyInfoTable = + InfoTable + { _identContext = mempty, + _identMap = mempty, + _infoMain = Nothing, + _infoIdents = mempty, + _infoInductives = mempty, + _infoConstructors = mempty, + _infoAxioms = mempty + } + +data IdentInfo = IdentInfo + { _identName :: Name, + _identSymbol :: Symbol, + _identType :: Type, + -- _identArgsNum will be used often enough to justify avoiding recomputation + _identArgsNum :: Int, + _identArgsInfo :: [ArgumentInfo], + _identIsExported :: Bool + } + +data ArgumentInfo = ArgumentInfo + { _argumentName :: Name, + _argumentType :: Type, + _argumentIsImplicit :: Bool + } + +data InductiveInfo = InductiveInfo + { _inductiveName :: Name, + _inductiveKind :: Type, + _inductiveConstructors :: [ConstructorInfo], + _inductiveParams :: [ParameterInfo], + _inductivePositive :: Bool + } + +data ConstructorInfo = ConstructorInfo + { _constructorName :: Name, + _constructorTag :: Tag, + _constructorType :: Type, + _constructorArgsNum :: Int + } + +data ParameterInfo = ParameterInfo + { _paramName :: Name, + _paramKind :: Type, + _paramIsImplicit :: Bool + } + +data AxiomInfo = AxiomInfo + { _axiomName :: Name, + _axiomType :: Type + } + +makeLenses ''InfoTable +makeLenses ''IdentInfo +makeLenses ''ArgumentInfo +makeLenses ''InductiveInfo +makeLenses ''ConstructorInfo +makeLenses ''ParameterInfo +makeLenses ''AxiomInfo diff --git a/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs new file mode 100644 index 0000000000..1423ae24eb --- /dev/null +++ b/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs @@ -0,0 +1,83 @@ +module Juvix.Compiler.Core.Data.InfoTableBuilder where + +import Data.HashMap.Strict qualified as HashMap +import Juvix.Compiler.Core.Data.InfoTable +import Juvix.Compiler.Core.Language + +data InfoTableBuilder m a where + FreshSymbol :: InfoTableBuilder m Symbol + FreshTag :: InfoTableBuilder m Tag + RegisterIdent :: IdentInfo -> InfoTableBuilder m () + RegisterConstructor :: ConstructorInfo -> InfoTableBuilder m () + RegisterIdentNode :: Symbol -> Node -> InfoTableBuilder m () + SetIdentArgsInfo :: Symbol -> [ArgumentInfo] -> InfoTableBuilder m () + GetIdent :: Text -> InfoTableBuilder m (Maybe (Either Symbol Tag)) + GetInfoTable :: InfoTableBuilder m InfoTable + +makeSem ''InfoTableBuilder + +hasIdent :: Member InfoTableBuilder r => Text -> Sem r Bool +hasIdent txt = do + i <- getIdent txt + case i of + Just _ -> return True + Nothing -> return False + +getConstructorInfo :: Member InfoTableBuilder r => Tag -> Sem r ConstructorInfo +getConstructorInfo tag = do + tab <- getInfoTable + return $ fromJust (HashMap.lookup tag (tab ^. infoConstructors)) + +checkSymbolDefined :: Member InfoTableBuilder r => Symbol -> Sem r Bool +checkSymbolDefined sym = do + tab <- getInfoTable + return $ HashMap.member sym (tab ^. identContext) + +data BuilderState = BuilderState + { _stateNextSymbol :: Word, + _stateNextUserTag :: Word, + _stateInfoTable :: InfoTable + } + +makeLenses ''BuilderState + +initBuilderState :: InfoTable -> BuilderState +initBuilderState tab = + BuilderState + { _stateNextSymbol = fromIntegral $ HashMap.size (tab ^. infoIdents), + _stateNextUserTag = fromIntegral $ HashMap.size (tab ^. infoConstructors), + _stateInfoTable = tab + } + +runInfoTableBuilder :: InfoTable -> Sem (InfoTableBuilder ': r) a -> Sem r (InfoTable, a) +runInfoTableBuilder tab = + fmap (first (^. stateInfoTable)) + . runState (initBuilderState tab) + . reinterpret interp + where + interp :: InfoTableBuilder m a -> Sem (State BuilderState : r) a + interp = \case + FreshSymbol -> do + modify' (over stateNextSymbol (+ 1)) + s <- get + return (s ^. stateNextSymbol - 1) + FreshTag -> do + modify' (over stateNextUserTag (+ 1)) + s <- get + return (UserTag (s ^. stateNextUserTag - 1)) + RegisterIdent ii -> do + modify' (over stateInfoTable (over infoIdents (HashMap.insert (ii ^. identSymbol) ii))) + modify' (over stateInfoTable (over identMap (HashMap.insert (ii ^. (identName . nameText)) (Left (ii ^. identSymbol))))) + RegisterConstructor ci -> do + modify' (over stateInfoTable (over infoConstructors (HashMap.insert (ci ^. constructorTag) ci))) + modify' (over stateInfoTable (over identMap (HashMap.insert (ci ^. (constructorName . nameText)) (Right (ci ^. constructorTag))))) + RegisterIdentNode sym node -> + modify' (over stateInfoTable (over identContext (HashMap.insert sym node))) + SetIdentArgsInfo sym argsInfo -> do + modify' (over stateInfoTable (over infoIdents (HashMap.adjust (set identArgsInfo argsInfo) sym))) + modify' (over stateInfoTable (over infoIdents (HashMap.adjust (set identArgsNum (length argsInfo)) sym))) + GetIdent txt -> do + s <- get + return $ HashMap.lookup txt (s ^. (stateInfoTable . identMap)) + GetInfoTable -> + get <&> (^. stateInfoTable) diff --git a/src/Juvix/Compiler/Core/Error.hs b/src/Juvix/Compiler/Core/Error.hs new file mode 100644 index 0000000000..0f29965eda --- /dev/null +++ b/src/Juvix/Compiler/Core/Error.hs @@ -0,0 +1,30 @@ +module Juvix.Compiler.Core.Error where + +import Juvix.Compiler.Core.Language +import Juvix.Compiler.Core.Pretty + +data CoreError = CoreError + { _coreErrorMsg :: Text, + _coreErrorNode :: Maybe Node, + _coreErrorLoc :: Location + } + +makeLenses ''CoreError + +instance ToGenericError CoreError where + genericError e = + GenericError + { _genericErrorLoc = i, + _genericErrorMessage = AnsiText $ pretty @_ @AnsiStyle e, + _genericErrorIntervals = [i] + } + where + i = getLoc e + +instance Pretty CoreError where + pretty (CoreError {..}) = case _coreErrorNode of + Just node -> pretty _coreErrorMsg <> colon <> space <> pretty (ppTrace node) + Nothing -> pretty _coreErrorMsg + +instance HasLoc CoreError where + getLoc (CoreError {..}) = _coreErrorLoc diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs new file mode 100644 index 0000000000..75c3ca97c0 --- /dev/null +++ b/src/Juvix/Compiler/Core/Evaluator.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Avoid restricted extensions" #-} +{-# HLINT ignore "Avoid restricted flags" #-} + +module Juvix.Compiler.Core.Evaluator where + +import Control.Exception qualified as Exception +import Data.HashMap.Strict qualified as HashMap +import Debug.Trace qualified as Debug +import GHC.Show as S +import Juvix.Compiler.Core.Data.InfoTable +import Juvix.Compiler.Core.Error +import Juvix.Compiler.Core.Extra +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Info.NoDisplayInfo +import Juvix.Compiler.Core.Language +import Juvix.Compiler.Core.Pretty + +data EvalError = EvalError + { _evalErrorMsg :: !Text, + _evalErrorNode :: !(Maybe Node) + } + +makeLenses ''EvalError + +instance Show EvalError where + show :: EvalError -> String + show (EvalError {..}) = + "evaluation error: " + ++ fromText _evalErrorMsg + ++ case _evalErrorNode of + Nothing -> "" + Just node -> ": " ++ fromText (ppTrace node) + +-- We definitely do _not_ want to wrap the evaluator in an exception monad / the +-- polysemy effects! This would almost double the execution time (whether an +-- error occurred needs to be checked at every point). Evaluation errors should +-- not happen for well-typed input (except perhaps division by zero), so it is +-- reasonable to catch them only at the CLI toplevel and just exit when they +-- occur. Use `catchEvalError` to catch evaluation errors in the IO monad. + +instance Exception.Exception EvalError + +-- `eval ctx env n` evalues a node `n` whose all free variables point into +-- `env`. All nodes in `ctx` must be closed. All nodes in `env` must be values. +-- Invariant for values v: eval ctx env v = v +eval :: IdentContext -> Env -> Node -> Node +eval !ctx !env0 = convertRuntimeNodes . eval' env0 + where + evalError :: Text -> Node -> a + evalError !msg !node = Exception.throw (EvalError msg (Just node)) + + eval' :: Env -> Node -> Node + eval' !env !n = case n of + Var _ idx -> env !! idx + Ident _ sym -> eval' [] (lookupContext n sym) + Constant {} -> n + App i l r -> + case eval' env l of + Closure _ env' b -> let !v = eval' env r in eval' (v : env') b + v -> evalError "invalid application" (App i v (substEnv env r)) + BuiltinApp _ op args -> applyBuiltin n env op args + Constr i tag args -> Constr i tag (map (eval' env) args) + Lambda i b -> Closure i env b + Let _ v b -> let !v' = eval' env v in eval' (v' : env) b + Case i v bs def -> + case eval' env v of + Constr _ tag args -> branch n env args tag def bs + v' -> evalError "matching on non-data" (substEnv env (Case i v' bs def)) + Pi {} -> substEnv env n + Univ {} -> n + TypeConstr i sym args -> TypeConstr i sym (map (eval' env) args) + Closure {} -> n + + branch :: Node -> Env -> [Node] -> Tag -> Maybe Node -> [CaseBranch] -> Node + branch n !env !args !tag !def = \case + (CaseBranch tag' _ b) : _ | tag' == tag -> eval' (revAppend args env) b + _ : bs' -> branch n env args tag def bs' + [] -> case def of + Just b -> eval' env b + Nothing -> evalError "no matching case branch" (substEnv env n) + + applyBuiltin :: Node -> Env -> BuiltinOp -> [Node] -> Node + applyBuiltin _ env OpIntAdd [l, r] = nodeFromInteger (integerFromNode (eval' env l) + integerFromNode (eval' env r)) + applyBuiltin _ env OpIntSub [l, r] = nodeFromInteger (integerFromNode (eval' env l) - integerFromNode (eval' env r)) + applyBuiltin _ env OpIntMul [l, r] = nodeFromInteger (integerFromNode (eval' env l) * integerFromNode (eval' env r)) + applyBuiltin n env OpIntDiv [l, r] = + case integerFromNode (eval' env r) of + 0 -> evalError "division by zero" (substEnv env n) + k -> nodeFromInteger (div (integerFromNode (eval' env l)) k) + applyBuiltin n env OpIntMod [l, r] = + case integerFromNode (eval' env r) of + 0 -> evalError "division by zero" (substEnv env n) + k -> nodeFromInteger (mod (integerFromNode (eval' env l)) k) + applyBuiltin _ env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r)) + applyBuiltin _ env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r)) + applyBuiltin _ env OpEq [l, r] = nodeFromBool (eval' env l == eval' env r) + applyBuiltin _ env OpTrace [msg, x] = Debug.trace (printNode (eval' env msg)) (eval' env x) + applyBuiltin _ env OpFail [msg] = + Exception.throw (EvalError (fromString ("failure: " ++ printNode (eval' env msg))) Nothing) + applyBuiltin n env _ _ = evalError "invalid builtin application" (substEnv env n) + + nodeFromInteger :: Integer -> Node + nodeFromInteger !int = Constant Info.empty (ConstInteger int) + + nodeFromBool :: Bool -> Node + nodeFromBool True = Constr Info.empty (BuiltinTag TagTrue) [] + nodeFromBool False = Constr Info.empty (BuiltinTag TagFalse) [] + + integerFromNode :: Node -> Integer + integerFromNode = \case + Constant _ (ConstInteger int) -> int + v -> evalError "not an integer" v + + printNode :: Node -> String + printNode = \case + Constant _ (ConstString s) -> fromText s + v -> fromText $ ppPrint v + + lookupContext :: Node -> Symbol -> Node + lookupContext n sym = + case HashMap.lookup sym ctx of + Just n' -> n' + Nothing -> evalError "symbol not defined" n + +-- Evaluate `node` and interpret the builtin IO actions. +hEvalIO :: Handle -> Handle -> IdentContext -> Env -> Node -> IO Node +hEvalIO hin hout ctx env node = + let node' = eval ctx env node + in case node' of + Constr _ (BuiltinTag TagReturn) [x] -> + return x + Constr _ (BuiltinTag TagBind) [x, f] -> do + x' <- hEvalIO hin hout ctx env x + hEvalIO hin hout ctx env (App Info.empty f x') + Constr _ (BuiltinTag TagWrite) [Constant _ (ConstString s)] -> do + hPutStr hout s + return unitNode + Constr _ (BuiltinTag TagWrite) [arg] -> do + hPutStr hout (ppPrint arg) + return unitNode + Constr _ (BuiltinTag TagReadLn) [] -> do + hFlush hout + Constant Info.empty . ConstString <$> hGetLine hin + _ -> + return node' + where + unitNode = Constr (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagTrue) [] + +evalIO :: IdentContext -> Env -> Node -> IO Node +evalIO = hEvalIO stdin stdout + +-- Catch EvalError and convert it to CoreError. Needs a default location in case +-- no location is available in EvalError. +catchEvalError :: Location -> a -> IO (Either CoreError a) +catchEvalError loc a = + Exception.catch + (Exception.evaluate a <&> Right) + (\(ex :: EvalError) -> return (Left (toCoreError loc ex))) + +catchEvalErrorIO :: Location -> IO a -> IO (Either CoreError a) +catchEvalErrorIO loc ma = + Exception.catch + (Exception.evaluate ma >>= \ma' -> ma' <&> Right) + (\(ex :: EvalError) -> return (Left (toCoreError loc ex))) + +toCoreError :: Location -> EvalError -> CoreError +toCoreError loc (EvalError {..}) = + CoreError + { _coreErrorMsg = mappend "evaluation error: " _evalErrorMsg, + _coreErrorNode = _evalErrorNode, + _coreErrorLoc = fromMaybe loc (lookupLocation =<< _evalErrorNode) + } diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs new file mode 100644 index 0000000000..93f2e2ff6b --- /dev/null +++ b/src/Juvix/Compiler/Core/Extra.hs @@ -0,0 +1,98 @@ +module Juvix.Compiler.Core.Extra + ( module Juvix.Compiler.Core.Extra, + module Juvix.Compiler.Core.Extra.Base, + module Juvix.Compiler.Core.Extra.Recursors, + module Juvix.Compiler.Core.Extra.Info, + ) +where + +import Data.HashSet qualified as HashSet +import Juvix.Compiler.Core.Extra.Base +import Juvix.Compiler.Core.Extra.Info +import Juvix.Compiler.Core.Extra.Recursors +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Language + +-- `isClosed` may short-circuit evaluation due to the use of `&&`, so it's not +-- entirely reducible to `getFreeVars` in terms of computation time. +isClosed :: Node -> Bool +isClosed = ufoldN (&&) go + where + go :: Index -> Node -> Bool + go k = \case + Var _ idx | idx >= k -> False + _ -> True + +getFreeVars :: Node -> HashSet Index +getFreeVars = gatherN go HashSet.empty + where + go :: Index -> HashSet Index -> Node -> HashSet Index + go k acc = \case + Var _ idx | idx >= k -> HashSet.insert (idx - k) acc + _ -> acc + +getIdents :: Node -> HashSet Symbol +getIdents = gather go HashSet.empty + where + go :: HashSet Symbol -> Node -> HashSet Symbol + go acc = \case + Ident _ sym -> HashSet.insert sym acc + _ -> acc + +countFreeVarOccurrences :: Index -> Node -> Int +countFreeVarOccurrences idx = gatherN go 0 + where + go k acc = \case + Var _ idx' | idx' == idx + k -> acc + 1 + _ -> acc + +-- increase all free variable indices by a given value +shift :: Index -> Node -> Node +shift 0 = id +shift m = umapN go + where + go k n = case n of + Var i idx | idx >= k -> Var i (idx + m) + _ -> n + +-- substitute a term t for the free variable with de Bruijn index 0, avoiding +-- variable capture +subst :: Node -> Node -> Node +subst t = umapN go + where + go k n = case n of + Var _ idx | idx == k -> shift k t + _ -> n + +-- reduce all beta redexes present in a term and the ones created immediately +-- downwards (i.e., a "beta-development") +developBeta :: Node -> Node +developBeta = umap go + where + go :: Node -> Node + go n = case n of + App _ (Lambda _ body) arg -> subst arg body + _ -> n + +etaExpand :: Int -> Node -> Node +etaExpand 0 n = n +etaExpand k n = mkLambdas k (mkApp (shift k n) (map (Var Info.empty) (reverse [0 .. k - 1]))) + +-- substitution of all free variables for values in an environment +substEnv :: Env -> Node -> Node +substEnv env = if null env then id else umapN go + where + go k n = case n of + Var _ idx | idx >= k -> env !! (idx - k) + _ -> n + +convertClosures :: Node -> Node +convertClosures = umap go + where + go :: Node -> Node + go n = case n of + Closure i env b -> substEnv env (Lambda i b) + _ -> n + +convertRuntimeNodes :: Node -> Node +convertRuntimeNodes = convertClosures diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs new file mode 100644 index 0000000000..84412d6369 --- /dev/null +++ b/src/Juvix/Compiler/Core/Extra/Base.hs @@ -0,0 +1,180 @@ +module Juvix.Compiler.Core.Extra.Base where + +import Data.Functor.Identity +import Data.List qualified as List +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Info.BinderInfo +import Juvix.Compiler.Core.Language + +{------------------------------------------------------------------------} +{- functions on Type -} + +-- unfold a type into the target and the arguments (left-to-right) +unfoldType' :: Type -> (Type, [(Info, Type)]) +unfoldType' ty = case ty of + Pi i l r -> let (tgt, args) = unfoldType' r in (tgt, (i, l) : args) + _ -> (ty, []) + +{------------------------------------------------------------------------} +{- functions on Node -} + +mkIf :: Info -> Node -> Node -> Node -> Node +mkIf i v b1 b2 = Case i v [CaseBranch (BuiltinTag TagTrue) 0 b1] (Just b2) + +mkApp' :: Node -> [(Info, Node)] -> Node +mkApp' = foldl' (\acc (i, n) -> App i acc n) + +mkApp :: Node -> [Node] -> Node +mkApp = foldl' (App Info.empty) + +unfoldApp' :: Node -> (Node, [(Info, Node)]) +unfoldApp' = go [] + where + go :: [(Info, Node)] -> Node -> (Node, [(Info, Node)]) + go acc n = case n of + App i l r -> go ((i, r) : acc) l + _ -> (n, acc) + +unfoldApp :: Node -> (Node, [Node]) +unfoldApp = second (map snd) . unfoldApp' + +mkLambdas' :: [Info] -> Node -> Node +mkLambdas' is n = foldr Lambda n is + +mkLambdas :: Int -> Node -> Node +mkLambdas k = mkLambdas' (replicate k Info.empty) + +unfoldLambdas' :: Node -> ([Info], Node) +unfoldLambdas' = go [] + where + go :: [Info] -> Node -> ([Info], Node) + go acc n = case n of + Lambda i b -> go (i : acc) b + _ -> (acc, n) + +unfoldLambdas :: Node -> (Int, Node) +unfoldLambdas = first length . unfoldLambdas' + +-- `NodeDetails` is a convenience datatype which provides the most commonly needed +-- information about a node in a generic fashion. +data NodeDetails = NodeDetails + { -- `nodeInfo` is the info associated with the node, + _nodeInfo :: Info, + -- `nodeChildren` are the children, in a fixed order, i.e., the immediate + -- recursive subnodes + _nodeChildren :: [Node], + -- `nodeChildBindersNum` is the number of binders introduced for each child + -- in the parent node. Same length and order as in `nodeChildren`. + _nodeChildBindersNum :: [Int], + -- `nodeChildBindersInfo` is information about binders for each child, if + -- present. Same length and order as in `nodeChildren`. + _nodeChildBindersInfo :: [Maybe [BinderInfo]], + -- `nodeReassemble` reassembles the node from the info and the children + -- (which should be in the same fixed order as in the `nodeChildren` + -- component). + _nodeReassemble :: Info -> [Node] -> Node + } + +makeLenses ''NodeDetails + +-- Destruct a node into NodeDetails. This is an ugly internal function used to +-- implement more high-level accessors and recursors. +destruct :: Node -> NodeDetails +destruct = \case + Var i idx -> NodeDetails i [] [] [] (\i' _ -> Var i' idx) + Ident i sym -> NodeDetails i [] [] [] (\i' _ -> Ident i' sym) + Constant i c -> NodeDetails i [] [] [] (\i' _ -> Constant i' c) + App i l r -> NodeDetails i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1)) + BuiltinApp i op args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`BuiltinApp` op) + Constr i tag args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`Constr` tag) + Lambda i b -> NodeDetails i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args')) + Let i v b -> NodeDetails i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Let i' (hd args') (args' !! 1)) + Case i v bs Nothing -> + NodeDetails + i + (v : map (\(CaseBranch _ _ br) -> br) bs) + (0 : map (\(CaseBranch _ k _) -> k) bs) + (Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing)) + ( \i' args' -> + Case + i' + (hd args') + ( zipWithExact + (\(CaseBranch tag k _) br' -> CaseBranch tag k br') + bs + (tl args') + ) + Nothing + ) + Case i v bs (Just def) -> + NodeDetails + i + (v : def : map (\(CaseBranch _ _ br) -> br) bs) + (0 : 0 : map (\(CaseBranch _ k _) -> k) bs) + (Nothing : Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing)) + ( \i' args' -> + Case + i' + (hd args') + ( zipWithExact + (\(CaseBranch tag k _) br' -> CaseBranch tag k br') + bs + (tl (tl args')) + ) + (Just (hd (tl args'))) + ) + Pi i ty b -> + NodeDetails i [ty, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Pi i' (hd args') (args' !! 1)) + Univ i l -> + NodeDetails i [] [] [] (\i' _ -> Univ i' l) + TypeConstr i sym args -> + NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`TypeConstr` sym) + Closure i env b -> + NodeDetails + i + (b : env) + (1 : map (const 0) env) + (fetchBinderInfo i : map (const Nothing) env) + (\i' args' -> Closure i' (tl args') (hd args')) + where + fetchBinderInfo :: Info -> Maybe [BinderInfo] + fetchBinderInfo i = case Info.lookup kBinderInfo i of + Just bi -> Just [bi] + Nothing -> Nothing + + fetchCaseBinderInfo :: Info -> [Maybe [BinderInfo]] -> [Maybe [BinderInfo]] + fetchCaseBinderInfo i d = case Info.lookup kCaseBinderInfo i of + Just cbi -> map Just (cbi ^. infoBranchBinders) + Nothing -> d + + hd :: [a] -> a + hd = List.head + + tl :: [a] -> [a] + tl = List.tail + +children :: Node -> [Node] +children = (^. nodeChildren) . destruct + +-- children together with the number of binders +bchildren :: Node -> [(Int, Node)] +bchildren n = + let ni = destruct n + in zipExact (ni ^. nodeChildBindersNum) (ni ^. nodeChildren) + +-- shallow children: not under binders +schildren :: Node -> [Node] +schildren = map snd . filter (\p -> fst p == 0) . bchildren + +getInfo :: Node -> Info +getInfo = (^. nodeInfo) . destruct + +modifyInfoM :: Applicative m => (Info -> m Info) -> Node -> m Node +modifyInfoM f n = + let ni = destruct n + in do + i' <- f (ni ^. nodeInfo) + return ((ni ^. nodeReassemble) i' (ni ^. nodeChildren)) + +modifyInfo :: (Info -> Info) -> Node -> Node +modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n diff --git a/src/Juvix/Compiler/Core/Extra/Info.hs b/src/Juvix/Compiler/Core/Extra/Info.hs new file mode 100644 index 0000000000..07d69ffb11 --- /dev/null +++ b/src/Juvix/Compiler/Core/Extra/Info.hs @@ -0,0 +1,22 @@ +module Juvix.Compiler.Core.Extra.Info where + +import Juvix.Compiler.Core.Extra.Base +import Juvix.Compiler.Core.Extra.Recursors +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Info.LocationInfo +import Juvix.Compiler.Core.Info.NameInfo +import Juvix.Compiler.Core.Language + +mapInfo :: (Info -> Info) -> Node -> Node +mapInfo f = umap (modifyInfo f) + +removeInfo :: IsInfo i => Key i -> Node -> Node +removeInfo k = mapInfo (Info.delete k) + +lookupLocation :: Node -> Maybe Location +lookupLocation node = + case Info.lookup kLocationInfo (getInfo node) of + Just li -> Just (li ^. infoLocation) + Nothing -> case Info.lookup kNameInfo (getInfo node) of + Just ni -> Just $ ni ^. (infoName . nameLoc) + Nothing -> Nothing diff --git a/src/Juvix/Compiler/Core/Extra/Recursors.hs b/src/Juvix/Compiler/Core/Extra/Recursors.hs new file mode 100644 index 0000000000..0efd2659b2 --- /dev/null +++ b/src/Juvix/Compiler/Core/Extra/Recursors.hs @@ -0,0 +1,180 @@ +module Juvix.Compiler.Core.Extra.Recursors + ( module Juvix.Compiler.Core.Extra.Recursors, + BinderList, + ) +where + +import Data.Functor.Identity +import Juvix.Compiler.Core.Data.BinderList (BinderList) +import Juvix.Compiler.Core.Data.BinderList qualified as BL +import Juvix.Compiler.Core.Extra.Base +import Juvix.Compiler.Core.Info.BinderInfo +import Juvix.Compiler.Core.Language + +{---------------------------------------------------------------------------------} +{- General recursors on Node -} + +-- a collector collects information top-down on a single path in the program +-- tree +data Collector a c = Collector + { _cEmpty :: c, + _cCollect :: a -> c -> c + } + +makeLenses ''Collector + +unitCollector :: Collector a () +unitCollector = Collector () (\_ _ -> ()) + +binderInfoCollector :: Collector (Int, Maybe [BinderInfo]) (BinderList (Maybe BinderInfo)) +binderInfoCollector = + Collector + BL.empty + (\(k, bi) c -> if k == 0 then c else BL.prepend (map Just (fromJust bi)) c) + +binderNumCollector :: Collector (Int, Maybe [BinderInfo]) Index +binderNumCollector = Collector 0 (\(k, _) c -> c + k) + +-- `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the +-- recursive subnodes have already been mapped +umapG :: + forall c m. + Monad m => + Collector (Int, Maybe [BinderInfo]) c -> + (c -> Node -> m Node) -> + Node -> + m Node +umapG coll f = go (coll ^. cEmpty) + where + go :: c -> Node -> m Node + go c n = + let ni = destruct n + in do + ns <- + sequence $ + zipWith3Exact + (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n') + (ni ^. nodeChildren) + (ni ^. nodeChildBindersNum) + (ni ^. nodeChildBindersInfo) + f c ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns) + +umapM :: Monad m => (Node -> m Node) -> Node -> m Node +umapM f = umapG unitCollector (const f) + +umapMB :: Monad m => (BinderList (Maybe BinderInfo) -> Node -> m Node) -> Node -> m Node +umapMB f = umapG binderInfoCollector f + +umapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node +umapMN f = umapG binderNumCollector f + +umap :: (Node -> Node) -> Node -> Node +umap f n = runIdentity $ umapM (return . f) n + +umapB :: (BinderList (Maybe BinderInfo) -> Node -> Node) -> Node -> Node +umapB f n = runIdentity $ umapMB (\is -> return . f is) n + +umapN :: (Index -> Node -> Node) -> Node -> Node +umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n + +-- `dmapG` maps the nodes top-down +dmapG :: + forall c m. + Monad m => + Collector (Int, Maybe [BinderInfo]) c -> + (c -> Node -> m Node) -> + Node -> + m Node +dmapG coll f = go (coll ^. cEmpty) + where + go :: c -> Node -> m Node + go c n = do + n' <- f c n + let ni = destruct n' + ns <- + sequence $ + zipWith3Exact + (\n'' k bis -> go ((coll ^. cCollect) (k, bis) c) n'') + (ni ^. nodeChildren) + (ni ^. nodeChildBindersNum) + (ni ^. nodeChildBindersInfo) + return ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns) + +dmapM :: Monad m => (Node -> m Node) -> Node -> m Node +dmapM f = dmapG unitCollector (const f) + +dmapMB :: Monad m => (BinderList (Maybe BinderInfo) -> Node -> m Node) -> Node -> m Node +dmapMB f = dmapG binderInfoCollector f + +dmapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node +dmapMN f = dmapG binderNumCollector f + +dmap :: (Node -> Node) -> Node -> Node +dmap f n = runIdentity $ dmapM (return . f) n + +dmapB :: (BinderList (Maybe BinderInfo) -> Node -> Node) -> Node -> Node +dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n + +dmapN :: (Index -> Node -> Node) -> Node -> Node +dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n + +-- `ufoldG` folds the tree bottom-up. The `uplus` argument combines the values - +-- it should be commutative and associative. +ufoldG :: + forall c a m. + Monad m => + Collector (Int, Maybe [BinderInfo]) c -> + (a -> a -> a) -> + (c -> Node -> m a) -> + Node -> + m a +ufoldG coll uplus f = go (coll ^. cEmpty) + where + go :: c -> Node -> m a + go c n = foldr (liftM2 uplus) (f c n) mas + where + ni :: NodeDetails + ni = destruct n + mas :: [m a] + mas = + zipWith3Exact + (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n') + (ni ^. nodeChildren) + (ni ^. nodeChildBindersNum) + (ni ^. nodeChildBindersInfo) + +ufoldM :: Monad m => (a -> a -> a) -> (Node -> m a) -> Node -> m a +ufoldM uplus f = ufoldG unitCollector uplus (const f) + +ufoldMB :: Monad m => (a -> a -> a) -> (BinderList (Maybe BinderInfo) -> Node -> m a) -> Node -> m a +ufoldMB uplus f = ufoldG binderInfoCollector uplus f + +ufoldMN :: Monad m => (a -> a -> a) -> (Index -> Node -> m a) -> Node -> m a +ufoldMN uplus f = ufoldG binderNumCollector uplus f + +ufold :: (a -> a -> a) -> (Node -> a) -> Node -> a +ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n + +ufoldB :: (a -> a -> a) -> (BinderList (Maybe BinderInfo) -> Node -> a) -> Node -> a +ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n + +ufoldN :: (a -> a -> a) -> (Index -> Node -> a) -> Node -> a +ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n + +walk :: Monad m => (Node -> m ()) -> Node -> m () +walk = ufoldM mappend + +walkB :: Monad m => (BinderList (Maybe BinderInfo) -> Node -> m ()) -> Node -> m () +walkB = ufoldMB mappend + +walkN :: Monad m => (Index -> Node -> m ()) -> Node -> m () +walkN = ufoldMN mappend + +gather :: (a -> Node -> a) -> a -> Node -> a +gather f acc n = run $ execState acc (walk (\n' -> modify' (`f` n')) n) + +gatherB :: (BinderList (Maybe BinderInfo) -> a -> Node -> a) -> a -> Node -> a +gatherB f acc n = run $ execState acc (walkB (\is n' -> modify' (\a -> f is a n')) n) + +gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a +gatherN f acc n = run $ execState acc (walkN (\idx n' -> modify' (\a -> f idx a n')) n) diff --git a/src/Juvix/Compiler/Core/Info.hs b/src/Juvix/Compiler/Core/Info.hs new file mode 100644 index 0000000000..acfb9feddd --- /dev/null +++ b/src/Juvix/Compiler/Core/Info.hs @@ -0,0 +1,81 @@ +module Juvix.Compiler.Core.Info where + +{- + This file defines Infos stored in JuvixCore Nodes. The Info data structure + maps an info type to an info of that type. +-} + +import Data.Dynamic +import Data.HashMap.Strict qualified as HashMap +import Juvix.Prelude + +class Typeable a => IsInfo a + +newtype Info = Info + { _infoMap :: HashMap TypeRep Dynamic + } + +type Key = Proxy + +makeLenses ''Info + +empty :: Info +empty = Info HashMap.empty + +singleton :: forall a. IsInfo a => a -> Info +singleton a = Juvix.Compiler.Core.Info.insert a Juvix.Compiler.Core.Info.empty + +member :: forall a. IsInfo a => Key a -> Info -> Bool +member k i = HashMap.member (typeRep k) (i ^. infoMap) + +lookup :: IsInfo a => Key a -> Info -> Maybe a +lookup k i = case HashMap.lookup (typeRep k) (i ^. infoMap) of + Just a -> Just $ fromDyn a impossible + Nothing -> Nothing + +lookupDefault :: IsInfo a => a -> Info -> a +lookupDefault a i = + fromDyn (HashMap.lookupDefault (toDyn a) (typeOf a) (i ^. infoMap)) impossible + +lookup' :: IsInfo a => Key a -> Info -> a +lookup' k i = fromMaybe impossible (Juvix.Compiler.Core.Info.lookup k i) + +(!) :: IsInfo a => Key a -> Info -> a +(!) = lookup' + +insert :: IsInfo a => a -> Info -> Info +insert a i = Info (HashMap.insert (typeOf a) (toDyn a) (i ^. infoMap)) + +insertWith :: IsInfo a => (a -> a -> a) -> a -> Info -> Info +insertWith f a i = Info (HashMap.insertWith f' (typeOf a) (toDyn a) (i ^. infoMap)) + where + f' x1 x2 = toDyn (f (fromDyn x1 impossible) (fromDyn x2 impossible)) + +delete :: IsInfo a => Key a -> Info -> Info +delete k i = Info (HashMap.delete (typeRep k) (i ^. infoMap)) + +adjust :: forall a. IsInfo a => (a -> a) -> Info -> Info +adjust f i = + Info $ + HashMap.adjust + (\x -> toDyn $ f $ fromDyn x impossible) + (typeRep (Proxy :: Proxy a)) + (i ^. infoMap) + +update :: forall a. IsInfo a => (a -> Maybe a) -> Info -> Info +update f i = Info (HashMap.update f' (typeRep (Proxy :: Proxy a)) (i ^. infoMap)) + where + f' x = case f (fromDyn x impossible) of + Just y -> Just (toDyn y) + Nothing -> Nothing + +alter :: forall a. IsInfo a => (Maybe a -> Maybe a) -> Info -> Info +alter f i = Info (HashMap.alter f' (typeRep (Proxy :: Proxy a)) (i ^. infoMap)) + where + f' x = case y of + Just y' -> Just (toDyn y') + Nothing -> Nothing + where + y = case x of + Just x' -> f (fromDyn x' impossible) + Nothing -> f Nothing diff --git a/src/Juvix/Compiler/Core/Info/BinderInfo.hs b/src/Juvix/Compiler/Core/Info/BinderInfo.hs new file mode 100644 index 0000000000..09911f2f85 --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/BinderInfo.hs @@ -0,0 +1,25 @@ +module Juvix.Compiler.Core.Info.BinderInfo where + +import Juvix.Compiler.Core.Language + +data BinderInfo = BinderInfo + { _infoName :: Name, + _infoType :: Type + } + +instance IsInfo BinderInfo + +kBinderInfo :: Key BinderInfo +kBinderInfo = Proxy + +newtype CaseBinderInfo = CaseBinderInfo + { _infoBranchBinders :: [[BinderInfo]] + } + +instance IsInfo CaseBinderInfo + +kCaseBinderInfo :: Key CaseBinderInfo +kCaseBinderInfo = Proxy + +makeLenses ''BinderInfo +makeLenses ''CaseBinderInfo diff --git a/src/Juvix/Compiler/Core/Info/BranchInfo.hs b/src/Juvix/Compiler/Core/Info/BranchInfo.hs new file mode 100644 index 0000000000..1dbfcf6936 --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/BranchInfo.hs @@ -0,0 +1,24 @@ +module Juvix.Compiler.Core.Info.BranchInfo where + +import Juvix.Compiler.Core.Language.Base + +newtype BranchInfo = BranchInfo + { _infoTagName :: Name + } + +instance IsInfo BranchInfo + +kBranchInfo :: Key BranchInfo +kBranchInfo = Proxy + +newtype CaseBranchInfo = CaseBranchInfo + { _infoBranches :: [BranchInfo] + } + +instance IsInfo CaseBranchInfo + +kCaseBranchInfo :: Key CaseBranchInfo +kCaseBranchInfo = Proxy + +makeLenses ''BranchInfo +makeLenses ''CaseBranchInfo diff --git a/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs b/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs new file mode 100644 index 0000000000..6faaaded66 --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs @@ -0,0 +1,47 @@ +module Juvix.Compiler.Core.Info.FreeVarsInfo where + +import Data.HashMap.Strict qualified as HashMap +import Juvix.Compiler.Core.Extra +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Language + +newtype FreeVarsInfo = FreeVarsInfo + { -- map free variables to the number of their occurrences + _infoFreeVars :: HashMap Index Int + } + +instance IsInfo FreeVarsInfo + +kFreeVarsInfo :: Key FreeVarsInfo +kFreeVarsInfo = Proxy + +makeLenses ''FreeVarsInfo + +computeFreeVarsInfo :: Node -> Node +computeFreeVarsInfo = umapN go + where + go :: Index -> Node -> Node + go k n = case n of + Var i idx | idx >= k -> Var (Info.insert fvi i) idx + where + fvi = FreeVarsInfo (HashMap.singleton (idx - k) 1) + _ -> modifyInfo (Info.insert fvi) n + where + fvi = + FreeVarsInfo $ + foldr + ( \(m, n') acc -> + HashMap.unionWith (+) acc $ + HashMap.mapKeys (\j -> j - m) $ + HashMap.filterWithKey + (\j _ -> j < m) + (getFreeVarsInfo n' ^. infoFreeVars) + ) + mempty + (bchildren n) + +getFreeVarsInfo :: Node -> FreeVarsInfo +getFreeVarsInfo = fromJust . Info.lookup kFreeVarsInfo . getInfo + +freeVarOccurrences :: Index -> Node -> Int +freeVarOccurrences idx n = fromMaybe 0 (HashMap.lookup idx (getFreeVarsInfo n ^. infoFreeVars)) diff --git a/src/Juvix/Compiler/Core/Info/IdentInfo.hs b/src/Juvix/Compiler/Core/Info/IdentInfo.hs new file mode 100644 index 0000000000..6a26518f30 --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/IdentInfo.hs @@ -0,0 +1,41 @@ +module Juvix.Compiler.Core.Info.IdentInfo where + +import Data.HashMap.Strict qualified as HashMap +import Juvix.Compiler.Core.Extra +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Language + +newtype IdentInfo = IdentInfo + { -- map symbols to the number of their occurrences + _infoIdents :: HashMap Symbol Int + } + +instance IsInfo IdentInfo + +kIdentInfo :: Key IdentInfo +kIdentInfo = Proxy + +makeLenses ''IdentInfo + +computeIdentInfo :: Node -> Node +computeIdentInfo = umap go + where + go :: Node -> Node + go n = case n of + Ident i sym -> Ident (Info.insert fvi i) sym + where + fvi = IdentInfo (HashMap.singleton sym 1) + _ -> modifyInfo (Info.insert fvi) n + where + fvi = + IdentInfo $ + foldr + (HashMap.unionWith (+) . (^. infoIdents) . getIdentInfo) + mempty + (children n) + +getIdentInfo :: Node -> IdentInfo +getIdentInfo = Info.lookupDefault (IdentInfo mempty) . getInfo + +identOccurrences :: Symbol -> Node -> Int +identOccurrences sym = fromMaybe 0 . HashMap.lookup sym . (^. infoIdents) . getIdentInfo diff --git a/src/Juvix/Compiler/Core/Info/LocationInfo.hs b/src/Juvix/Compiler/Core/Info/LocationInfo.hs new file mode 100644 index 0000000000..5055152695 --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/LocationInfo.hs @@ -0,0 +1,12 @@ +module Juvix.Compiler.Core.Info.LocationInfo where + +import Juvix.Compiler.Core.Language.Base + +newtype LocationInfo = LocationInfo {_infoLocation :: Location} + +instance IsInfo LocationInfo + +kLocationInfo :: Key LocationInfo +kLocationInfo = Proxy + +makeLenses ''LocationInfo diff --git a/src/Juvix/Compiler/Core/Info/NameInfo.hs b/src/Juvix/Compiler/Core/Info/NameInfo.hs new file mode 100644 index 0000000000..dee6d91ac2 --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/NameInfo.hs @@ -0,0 +1,12 @@ +module Juvix.Compiler.Core.Info.NameInfo where + +import Juvix.Compiler.Core.Language.Base + +newtype NameInfo = NameInfo {_infoName :: Name} + +instance IsInfo NameInfo + +kNameInfo :: Key NameInfo +kNameInfo = Proxy + +makeLenses ''NameInfo diff --git a/src/Juvix/Compiler/Core/Info/NoDisplayInfo.hs b/src/Juvix/Compiler/Core/Info/NoDisplayInfo.hs new file mode 100644 index 0000000000..0549362fc3 --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/NoDisplayInfo.hs @@ -0,0 +1,10 @@ +module Juvix.Compiler.Core.Info.NoDisplayInfo where + +import Juvix.Compiler.Core.Language.Base + +newtype NoDisplayInfo = NoDisplayInfo () + +instance IsInfo NoDisplayInfo + +kNoDisplayInfo :: Key NoDisplayInfo +kNoDisplayInfo = Proxy diff --git a/src/Juvix/Compiler/Core/Info/TypeInfo.hs b/src/Juvix/Compiler/Core/Info/TypeInfo.hs new file mode 100644 index 0000000000..3c935d5dab --- /dev/null +++ b/src/Juvix/Compiler/Core/Info/TypeInfo.hs @@ -0,0 +1,12 @@ +module Juvix.Compiler.Core.Info.TypeInfo where + +import Juvix.Compiler.Core.Language + +newtype TypeInfo = TypeInfo {_infoType :: Type} + +instance IsInfo TypeInfo + +kTypeInfo :: Key TypeInfo +kTypeInfo = Proxy + +makeLenses ''TypeInfo diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs new file mode 100644 index 0000000000..47240a6898 --- /dev/null +++ b/src/Juvix/Compiler/Core/Language.hs @@ -0,0 +1,147 @@ +{-# OPTIONS_GHC -Wno-partial-fields #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Avoid restricted flags" #-} + +module Juvix.Compiler.Core.Language + ( module Juvix.Compiler.Core.Language, + module Juvix.Compiler.Core.Language.Base, + ) +where + +{- + This file defines the tree representation of JuvixCore (Node datatype). +-} + +import Juvix.Compiler.Core.Language.Base + +{---------------------------------------------------------------------------------} +{- Program tree datatype -} + +-- `Node` is the type of nodes in the program tree. The nodes themselves +-- contain only runtime-relevant information. Runtime-irrelevant annotations +-- (including all type information) are stored in the infos associated with each +-- node. +data Node + = -- De Bruijn index of a locally bound variable. + Var {_varInfo :: !Info, _varIndex :: !Index} + | -- Global identifier of a function (with corresponding `Node` in the global + -- context). + Ident {_identInfo :: !Info, _identSymbol :: !Symbol} + | Constant {_constantInfo :: !Info, _constantValue :: !ConstantValue} + | App {_appInfo :: !Info, _appLeft :: !Node, _appRight :: !Node} + | -- A builtin application. A builtin has no corresponding Node. It is treated + -- specially by the evaluator and the code generator. For example, basic + -- arithmetic operations go into `Builtin`. The number of arguments supplied + -- must be equal to the number of arguments expected by the builtin + -- operation (this simplifies evaluation and code generation). If you need + -- partial application, eta-expand with lambdas, e.g., eta-expand `(+) 2` to + -- `\x -> (+) 2 x`. See Transformation/Eta.hs. + BuiltinApp {_builtinInfo :: !Info, _builtinOp :: !BuiltinOp, _builtinArgs :: ![Node]} + | -- A data constructor application. The number of arguments supplied must be + -- equal to the number of arguments expected by the constructor. + Constr + { _constrInfo :: !Info, + _constrTag :: !Tag, + _constrArgs :: ![Node] + } + | Lambda {_lambdaInfo :: !Info, _lambdaBody :: !Node} + | -- `let x := value in body` is not reducible to lambda + application for the purposes + -- of ML-polymorphic / dependent type checking or code generation! + Let {_letInfo :: !Info, _letValue :: !Node, _letBody :: !Node} + | -- One-level case matching on the tag of a data constructor: `Case value + -- branches default`. `Case` is lazy: only the selected branch is evaluated. + Case + { _caseInfo :: !Info, + _caseValue :: !Node, + _caseBranches :: ![CaseBranch], + _caseDefault :: !(Maybe Node) + } + | -- Dependent Pi-type. Compilation-time only. Pi implicitly introduces a binder + -- in the body, exactly like Lambda. So `Pi info ty body` is `Pi x : ty . + -- body` in more familiar notation, but references to `x` in `body` are via de + -- Bruijn index. For example, Pi A : Type . A -> A translates to (omitting + -- Infos): Pi (Univ level) (Pi (Var 0) (Var 1)). + Pi {_piInfo :: !Info, _piType :: !Type, _piBody :: !Type} + | -- Universe. Compilation-time only. + Univ {_univInfo :: !Info, _univLevel :: !Int} + | -- Type constructor application. Compilation-time only. + TypeConstr {_typeConstrInfo :: !Info, _typeConstrSymbol :: !Symbol, _typeConstrArgs :: ![Type]} + | -- Evaluation only: `Closure env body` + Closure + { _closureInfo :: !Info, + _closureEnv :: !Env, + _closureBody :: !Node + } + +-- Other things we might need in the future: +-- - laziness annotations (converting these to closure/thunk creation should be +-- done further down the pipeline) + +data ConstantValue + = ConstInteger !Integer + | ConstString !Text + deriving stock (Eq) + +-- Other things we might need in the future: +-- - ConstFloat + +-- `CaseBranch tag argsNum branch` +-- - `argsNum` is the number of arguments of the constructor tagged with `tag`, +-- equal to the number of implicit binders above `branch` +data CaseBranch = CaseBranch {_caseTag :: !Tag, _caseBindersNum :: !Int, _caseBranch :: !Node} + deriving stock (Eq) + +-- A node (term) is closed if it has no free variables, i.e., no de Bruijn +-- indices pointing outside the term. + +-- Values are closed nodes of the following kinds: +-- - Constant +-- - Constr if all arguments are values +-- - Closure +-- +-- Whether something is a value matters only for the evaluation semantics. It +-- doesn't matter much outside the evaluator. + +-- All nodes in an environment must be values. +type Env = [Node] + +type Type = Node + +instance HasAtomicity Node where + atomicity = \case + Var {} -> Atom + Ident {} -> Atom + Constant {} -> Atom + App {} -> Aggregate appFixity + BuiltinApp {..} | null _builtinArgs -> Atom + BuiltinApp {} -> Aggregate lambdaFixity + Constr {..} | null _constrArgs -> Atom + Constr {} -> Aggregate lambdaFixity + Lambda {} -> Aggregate lambdaFixity + Let {} -> Aggregate lambdaFixity + Case {} -> Aggregate lambdaFixity + Pi {} -> Aggregate lambdaFixity + Univ {} -> Atom + TypeConstr {} -> Aggregate appFixity + Closure {} -> Aggregate lambdaFixity + +lambdaFixity :: Fixity +lambdaFixity = Fixity (PrecNat 0) (Unary AssocPostfix) + +instance Eq Node where + (==) :: Node -> Node -> Bool + Var _ idx1 == Var _ idx2 = idx1 == idx2 + Ident _ sym1 == Ident _ sym2 = sym1 == sym2 + Constant _ v1 == Constant _ v2 = v1 == v2 + App _ l1 r1 == App _ l2 r2 = l1 == l2 && r1 == r2 + BuiltinApp _ op1 args1 == BuiltinApp _ op2 args2 = op1 == op2 && args1 == args2 + Constr _ tag1 args1 == Constr _ tag2 args2 = tag1 == tag2 && args1 == args2 + Lambda _ b1 == Lambda _ b2 = b1 == b2 + Let _ v1 b1 == Let _ v2 b2 = v1 == v2 && b1 == b2 + Case _ v1 bs1 def1 == Case _ v2 bs2 def2 = v1 == v2 && bs1 == bs2 && def1 == def2 + Pi _ ty1 b1 == Pi _ ty2 b2 = ty1 == ty2 && b1 == b2 + Univ _ l1 == Univ _ l2 = l1 == l2 + TypeConstr _ sym1 args1 == TypeConstr _ sym2 args2 = sym1 == sym2 && args1 == args2 + Closure _ env1 b1 == Closure _ env2 b2 = env1 == env2 && b1 == b2 + _ == _ = False diff --git a/src/Juvix/Compiler/Core/Language/Base.hs b/src/Juvix/Compiler/Core/Language/Base.hs new file mode 100644 index 0000000000..82b1f9a01d --- /dev/null +++ b/src/Juvix/Compiler/Core/Language/Base.hs @@ -0,0 +1,35 @@ +module Juvix.Compiler.Core.Language.Base + ( Info, + Key, + IsInfo, + module Juvix.Compiler.Core.Language.Builtins, + module Juvix.Prelude, + module Juvix.Compiler.Abstract.Data.Name, + Location, + Symbol, + Tag (..), + Index, + ) +where + +import Juvix.Compiler.Abstract.Data.Name +import Juvix.Compiler.Core.Info (Info, IsInfo, Key) +import Juvix.Compiler.Core.Language.Builtins +import Juvix.Prelude + +type Location = Interval + +-- Consecutive symbol IDs for reachable user functions. +type Symbol = Word + +-- Tag of a constructor, uniquely identifying it. Tag values are consecutive and +-- separate from symbol IDs. We might need fixed special tags in Core for common +-- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code +-- generator can treat them specially. +data Tag = BuiltinTag BuiltinDataTag | UserTag Word + deriving stock (Eq, Generic) + +instance Hashable Tag + +-- de Bruijn index +type Index = Int diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs new file mode 100644 index 0000000000..4a8cef7472 --- /dev/null +++ b/src/Juvix/Compiler/Core/Language/Builtins.hs @@ -0,0 +1,52 @@ +module Juvix.Compiler.Core.Language.Builtins where + +import Juvix.Prelude + +-- Builtin operations which the evaluator and the code generator treat +-- specially and non-uniformly. +data BuiltinOp + = OpIntAdd + | OpIntSub + | OpIntMul + | OpIntDiv + | OpIntMod + | OpIntLt + | OpIntLe + | OpEq + | OpTrace + | OpFail + deriving stock (Eq) + +-- Builtin data tags +data BuiltinDataTag + = TagTrue + | TagFalse + | TagReturn + | TagBind + | TagWrite + | TagReadLn + deriving stock (Eq, Generic) + +instance Hashable BuiltinDataTag + +builtinOpArgsNum :: BuiltinOp -> Int +builtinOpArgsNum = \case + OpIntAdd -> 2 + OpIntSub -> 2 + OpIntMul -> 2 + OpIntDiv -> 2 + OpIntMod -> 2 + OpIntLt -> 2 + OpIntLe -> 2 + OpEq -> 2 + OpTrace -> 2 + OpFail -> 1 + +builtinConstrArgsNum :: BuiltinDataTag -> Int +builtinConstrArgsNum = \case + TagTrue -> 0 + TagFalse -> 0 + TagReturn -> 1 + TagBind -> 2 + TagWrite -> 1 + TagReadLn -> 0 diff --git a/src/Juvix/Compiler/Core/Pretty.hs b/src/Juvix/Compiler/Core/Pretty.hs new file mode 100644 index 0000000000..4c8a856137 --- /dev/null +++ b/src/Juvix/Compiler/Core/Pretty.hs @@ -0,0 +1,25 @@ +module Juvix.Compiler.Core.Pretty + ( module Juvix.Compiler.Core.Pretty, + module Juvix.Compiler.Core.Pretty.Base, + module Juvix.Compiler.Core.Pretty.Options, + module Juvix.Data.PPOutput, + ) +where + +import Juvix.Compiler.Core.Pretty.Base +import Juvix.Compiler.Core.Pretty.Options +import Juvix.Data.PPOutput +import Juvix.Prelude +import Prettyprinter.Render.Terminal qualified as Ansi + +ppOutDefault :: PrettyCode c => c -> AnsiText +ppOutDefault = AnsiText . PPOutput . doc defaultOptions + +ppOut :: PrettyCode c => Options -> c -> AnsiText +ppOut o = AnsiText . PPOutput . doc o + +ppTrace :: PrettyCode c => c -> Text +ppTrace = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc defaultOptions + +ppPrint :: PrettyCode c => c -> Text +ppPrint = show . ppOutDefault diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs new file mode 100644 index 0000000000..9f3b069e20 --- /dev/null +++ b/src/Juvix/Compiler/Core/Pretty/Base.hs @@ -0,0 +1,255 @@ +module Juvix.Compiler.Core.Pretty.Base + ( module Juvix.Compiler.Core.Pretty.Base, + module Juvix.Data.CodeAnn, + module Juvix.Compiler.Core.Pretty.Options, + ) +where + +import Juvix.Compiler.Core.Extra +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Info.BinderInfo as BinderInfo +import Juvix.Compiler.Core.Info.BranchInfo as BranchInfo +import Juvix.Compiler.Core.Info.NameInfo as NameInfo +import Juvix.Compiler.Core.Language +import Juvix.Compiler.Core.Pretty.Options +import Juvix.Data.CodeAnn +import Juvix.Extra.Strings qualified as Str + +doc :: PrettyCode c => Options -> c -> Doc Ann +doc opts = + run + . runReader opts + . ppCode + +class PrettyCode c where + ppCode :: Member (Reader Options) r => c -> Sem r (Doc Ann) + +runPrettyCode :: PrettyCode c => Options -> c -> Doc Ann +runPrettyCode opts = run . runReader opts . ppCode + +instance PrettyCode NameId where + ppCode (NameId k) = return (pretty k) + +instance PrettyCode Name where + ppCode n = do + showNameId <- asks (^. optShowNameIds) + return (prettyName showNameId n) + +instance PrettyCode BuiltinOp where + ppCode = \case + OpIntAdd -> return kwPlus + OpIntSub -> return kwMinus + OpIntMul -> return kwMul + OpIntDiv -> return kwDiv + OpIntMod -> return kwMod + OpIntLt -> return kwLess + OpIntLe -> return kwLessEquals + OpEq -> return kwEquals + OpTrace -> return kwTrace + OpFail -> return kwFail + +instance PrettyCode BuiltinDataTag where + ppCode = \case + TagTrue -> return $ annotate (AnnKind KNameConstructor) (pretty ("true" :: String)) + TagFalse -> return $ annotate (AnnKind KNameConstructor) (pretty ("false" :: String)) + TagReturn -> return $ annotate (AnnKind KNameConstructor) (pretty ("return" :: String)) + TagBind -> return $ annotate (AnnKind KNameConstructor) (pretty ("bind" :: String)) + TagWrite -> return $ annotate (AnnKind KNameConstructor) (pretty ("write" :: String)) + TagReadLn -> return $ annotate (AnnKind KNameConstructor) (pretty ("readLn" :: String)) + +instance PrettyCode Tag where + ppCode = \case + BuiltinTag tag -> ppCode tag + UserTag tag -> return $ kwUnnamedConstr <> pretty tag + +instance PrettyCode Node where + ppCode node = case node of + Var {..} -> + case Info.lookup kNameInfo _varInfo of + Just ni -> do + showDeBruijn <- asks (^. optShowDeBruijnIndices) + n <- ppCode (ni ^. NameInfo.infoName) + if showDeBruijn + then return $ n <> kwDeBruijnVar <> pretty _varIndex + else return n + Nothing -> return $ kwDeBruijnVar <> pretty _varIndex + Ident {..} -> + case Info.lookup kNameInfo _identInfo of + Just ni -> ppCode (ni ^. NameInfo.infoName) + Nothing -> return $ kwUnnamedIdent <> pretty _identSymbol + Constant _ (ConstInteger int) -> + return $ annotate AnnLiteralInteger (pretty int) + Constant _ (ConstString txt) -> + return $ annotate AnnLiteralString (pretty (show txt :: String)) + App {..} -> do + l' <- ppLeftExpression appFixity _appLeft + r' <- ppRightExpression appFixity _appRight + return $ l' <+> r' + BuiltinApp {..} -> do + args' <- mapM (ppRightExpression appFixity) _builtinArgs + op' <- ppCode _builtinOp + return $ foldl' (<+>) op' args' + Constr {..} -> do + args' <- mapM (ppRightExpression appFixity) _constrArgs + n' <- + case Info.lookup kNameInfo _constrInfo of + Just ni -> ppCode (ni ^. NameInfo.infoName) + Nothing -> ppCode _constrTag + return $ foldl' (<+>) n' args' + Lambda {} -> do + let (infos, body) = unfoldLambdas' node + pplams <- mapM ppLam infos + b <- ppCode body + return $ foldl' (flip (<+>)) b pplams + where + ppLam :: Member (Reader Options) r => Info -> Sem r (Doc Ann) + ppLam i = + case Info.lookup kBinderInfo i of + Just bi -> do + n <- ppCode (bi ^. BinderInfo.infoName) + return $ kwLambda <> n + Nothing -> return $ kwLambda <> kwQuestion + Let {..} -> do + n' <- + case Info.lookup kBinderInfo _letInfo of + Just bi -> ppCode (bi ^. BinderInfo.infoName) + Nothing -> return kwQuestion + v' <- ppCode _letValue + b' <- ppCode _letBody + return $ kwLet <+> n' <+> kwAssign <+> v' <+> kwIn <+> b' + Case {..} -> do + bns <- + case Info.lookup kCaseBinderInfo _caseInfo of + Just ci -> mapM (mapM (ppCode . (^. BinderInfo.infoName))) (ci ^. infoBranchBinders) + Nothing -> mapM (\(CaseBranch _ n _) -> replicateM n (return kwQuestion)) _caseBranches + cns <- + case Info.lookup kCaseBranchInfo _caseInfo of + Just ci -> mapM (ppCode . (^. BranchInfo.infoTagName)) (ci ^. infoBranches) + Nothing -> mapM (\(CaseBranch tag _ _) -> ppCode tag) _caseBranches + let bs = map (\(CaseBranch _ _ br) -> br) _caseBranches + v <- ppCode _caseValue + bs' <- sequence $ zipWith3Exact (\cn bn br -> ppCode br >>= \br' -> return $ foldl' (<+>) cn bn <+> kwMapsto <+> br') cns bns bs + bs'' <- + case _caseDefault of + Just def -> do + d' <- ppCode def + return $ bs' ++ [kwDefault <+> kwMapsto <+> d'] + Nothing -> return bs' + let bss = bracesIndent $ align $ concatWith (\a b -> a <> kwSemicolon <> line <> b) bs'' + return $ kwCase <+> v <+> kwOf <+> bss + Pi {..} -> + case Info.lookup kBinderInfo _piInfo of + Just bi -> do + n <- ppCode (bi ^. BinderInfo.infoName) + b <- ppCode _piBody + return $ kwLambda <> n <+> b + Nothing -> do + b <- ppCode _piBody + return $ kwLambda <> kwQuestion <+> b + Univ {..} -> + return $ kwType <+> pretty _univLevel + TypeConstr {..} -> do + args' <- mapM (ppRightExpression appFixity) _typeConstrArgs + n' <- + case Info.lookup kNameInfo _typeConstrInfo of + Just ni -> ppCode (ni ^. NameInfo.infoName) + Nothing -> return $ kwUnnamedIdent <> pretty _typeConstrSymbol + return $ foldl' (<+>) n' args' + Closure {..} -> + ppCode (substEnv _closureEnv (Lambda _closureInfo _closureBody)) + +instance PrettyCode a => PrettyCode (NonEmpty a) where + ppCode x = do + cs <- mapM ppCode (toList x) + return $ encloseSep "(" ")" ", " cs + +{--------------------------------------------------------------------------------} +{- helper functions -} + +parensIf :: Bool -> Doc Ann -> Doc Ann +parensIf t = if t then parens else id + +ppPostExpression :: + (PrettyCode a, HasAtomicity a, Member (Reader Options) r) => + Fixity -> + a -> + Sem r (Doc Ann) +ppPostExpression = ppLRExpression isPostfixAssoc + +ppRightExpression :: + (PrettyCode a, HasAtomicity a, Member (Reader Options) r) => + Fixity -> + a -> + Sem r (Doc Ann) +ppRightExpression = ppLRExpression isRightAssoc + +ppLeftExpression :: + (PrettyCode a, HasAtomicity a, Member (Reader Options) r) => + Fixity -> + a -> + Sem r (Doc Ann) +ppLeftExpression = ppLRExpression isLeftAssoc + +ppLRExpression :: + (HasAtomicity a, PrettyCode a, Member (Reader Options) r) => + (Fixity -> Bool) -> + Fixity -> + a -> + Sem r (Doc Ann) +ppLRExpression associates fixlr e = + parensIf (atomParens associates (atomicity e) fixlr) + <$> ppCode e + +{--------------------------------------------------------------------------------} +{- keywords -} + +kwDeBruijnVar :: Doc Ann +kwDeBruijnVar = keyword Str.deBruijnVar + +kwUnnamedIdent :: Doc Ann +kwUnnamedIdent = keyword Str.exclamation + +kwUnnamedConstr :: Doc Ann +kwUnnamedConstr = keyword Str.exclamation + +kwQuestion :: Doc Ann +kwQuestion = keyword Str.questionMark + +kwLess :: Doc Ann +kwLess = keyword Str.less + +kwLessEquals :: Doc Ann +kwLessEquals = keyword Str.lessEqual + +kwPlus :: Doc Ann +kwPlus = keyword Str.plus + +kwMinus :: Doc Ann +kwMinus = keyword Str.minus + +kwMul :: Doc Ann +kwMul = keyword Str.mul + +kwDiv :: Doc Ann +kwDiv = keyword Str.div + +kwMod :: Doc Ann +kwMod = keyword Str.mod + +kwCase :: Doc Ann +kwCase = keyword Str.case_ + +kwOf :: Doc Ann +kwOf = keyword Str.of_ + +kwDefault :: Doc Ann +kwDefault = keyword Str.underscore + +kwPi :: Doc Ann +kwPi = keyword Str.pi_ + +kwTrace :: Doc Ann +kwTrace = keyword Str.trace_ + +kwFail :: Doc Ann +kwFail = keyword Str.fail_ diff --git a/src/Juvix/Compiler/Core/Pretty/Options.hs b/src/Juvix/Compiler/Core/Pretty/Options.hs new file mode 100644 index 0000000000..2386deb6ad --- /dev/null +++ b/src/Juvix/Compiler/Core/Pretty/Options.hs @@ -0,0 +1,19 @@ +module Juvix.Compiler.Core.Pretty.Options where + +import Juvix.Prelude + +data Options = Options + { _optIndent :: Int, + _optShowNameIds :: Bool, + _optShowDeBruijnIndices :: Bool + } + +defaultOptions :: Options +defaultOptions = + Options + { _optIndent = 2, + _optShowNameIds = False, + _optShowDeBruijnIndices = False + } + +makeLenses ''Options diff --git a/src/Juvix/Compiler/Core/Transformation.hs b/src/Juvix/Compiler/Core/Transformation.hs new file mode 100644 index 0000000000..0da169b0b2 --- /dev/null +++ b/src/Juvix/Compiler/Core/Transformation.hs @@ -0,0 +1,10 @@ +module Juvix.Compiler.Core.Transformation + ( module Juvix.Compiler.Core.Transformation.Base, + module Juvix.Compiler.Core.Transformation.Eta, + module Juvix.Compiler.Core.Transformation.LambdaLifting, + ) +where + +import Juvix.Compiler.Core.Transformation.Base +import Juvix.Compiler.Core.Transformation.Eta +import Juvix.Compiler.Core.Transformation.LambdaLifting diff --git a/src/Juvix/Compiler/Core/Transformation/Base.hs b/src/Juvix/Compiler/Core/Transformation/Base.hs new file mode 100644 index 0000000000..65172aa968 --- /dev/null +++ b/src/Juvix/Compiler/Core/Transformation/Base.hs @@ -0,0 +1,22 @@ +module Juvix.Compiler.Core.Transformation.Base + ( module Juvix.Compiler.Core.Transformation.Base, + module Juvix.Compiler.Core.Data.InfoTable, + module Juvix.Compiler.Core.Language, + ) +where + +import Data.HashMap.Strict qualified as HashMap +import Juvix.Compiler.Core.Data.InfoTable +import Juvix.Compiler.Core.Data.InfoTableBuilder +import Juvix.Compiler.Core.Language + +type Transformation = InfoTable -> InfoTable + +mapT :: (Node -> Node) -> InfoTable -> InfoTable +mapT f tab = tab {_identContext = HashMap.map f (tab ^. identContext)} + +mapT' :: (Node -> Sem (InfoTableBuilder ': r) Node) -> InfoTable -> Sem r InfoTable +mapT' f tab = fmap fst $ runInfoTableBuilder tab $ do + mapM_ + (\(k, v) -> f v >>= registerIdentNode k) + (HashMap.toList (tab ^. identContext)) diff --git a/src/Juvix/Compiler/Core/Transformation/Eta.hs b/src/Juvix/Compiler/Core/Transformation/Eta.hs new file mode 100644 index 0000000000..99f6f2b722 --- /dev/null +++ b/src/Juvix/Compiler/Core/Transformation/Eta.hs @@ -0,0 +1,55 @@ +module Juvix.Compiler.Core.Transformation.Eta + ( module Juvix.Compiler.Core.Transformation.Eta, + module Juvix.Compiler.Core.Transformation.Base, + ) +where + +import Data.HashMap.Strict qualified as HashMap +import Juvix.Compiler.Core.Extra +import Juvix.Compiler.Core.Transformation.Base + +etaExpandBuiltins :: Node -> Node +etaExpandBuiltins = umap go + where + go :: Node -> Node + go n = case n of + BuiltinApp {..} + | builtinOpArgsNum _builtinOp > length _builtinArgs -> + etaExpand (builtinOpArgsNum _builtinOp - length _builtinArgs) n + _ -> n + +etaExpandConstrs :: (Tag -> Int) -> Node -> Node +etaExpandConstrs argsNum = umap go + where + go :: Node -> Node + go n = case n of + Constr {..} + | k > length _constrArgs -> + etaExpand (k - length _constrArgs) n + where + k = argsNum _constrTag + _ -> n + +squashApps :: Node -> Node +squashApps = dmap go + where + go :: Node -> Node + go n = + let (l, args) = unfoldApp n + in case l of + Constr i tag args' -> Constr i tag (args' ++ args) + BuiltinApp i op args' -> BuiltinApp i op (args' ++ args) + _ -> n + +etaExpandApps :: InfoTable -> Node -> Node +etaExpandApps tab = + squashApps . etaExpandConstrs constrArgsNum . etaExpandBuiltins . squashApps + where + constrArgsNum :: Tag -> Int + constrArgsNum tag = + case HashMap.lookup tag (tab ^. infoConstructors) of + Just ci -> ci ^. constructorArgsNum + Nothing -> 0 + +etaExpansionApps :: Transformation +etaExpansionApps tab = mapT (etaExpandApps tab) tab diff --git a/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs b/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs new file mode 100644 index 0000000000..21592a1a5a --- /dev/null +++ b/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs @@ -0,0 +1,16 @@ +module Juvix.Compiler.Core.Transformation.LambdaLifting + ( module Juvix.Compiler.Core.Transformation.LambdaLifting, + module Juvix.Compiler.Core.Transformation.Base, + ) +where + +import Juvix.Compiler.Core.Data.InfoTableBuilder +import Juvix.Compiler.Core.Transformation.Base + +lambdaLiftNode :: Member InfoTableBuilder r => Node -> Sem r Node +lambdaLiftNode _ = do + void freshSymbol + error "not yet implemented" + +lambdaLifting :: Transformation +lambdaLifting = run . mapT' lambdaLiftNode diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs new file mode 100644 index 0000000000..5acbe02d37 --- /dev/null +++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs @@ -0,0 +1,664 @@ +module Juvix.Compiler.Core.Translation.FromSource + ( module Juvix.Compiler.Core.Translation.FromSource, + module Juvix.Parser.Error, + ) +where + +import Control.Monad.Trans.Class (lift) +import Data.HashMap.Strict qualified as HashMap +import Data.List qualified as List +import Juvix.Compiler.Core.Data.InfoTable +import Juvix.Compiler.Core.Data.InfoTableBuilder +import Juvix.Compiler.Core.Extra.Base +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Info.BinderInfo as BinderInfo +import Juvix.Compiler.Core.Info.BranchInfo as BranchInfo +import Juvix.Compiler.Core.Info.LocationInfo as LocationInfo +import Juvix.Compiler.Core.Info.NameInfo as NameInfo +import Juvix.Compiler.Core.Language +import Juvix.Compiler.Core.Transformation.Eta +import Juvix.Compiler.Core.Translation.FromSource.Lexer +import Juvix.Parser.Error +import Text.Megaparsec qualified as P + +parseText :: InfoTable -> Text -> Either ParserError (InfoTable, Maybe Node) +parseText = runParser "" "" + +-- Note: only new symbols and tags that are not in the InfoTable already will be +-- generated during parsing, but nameIds are generated starting from 0 +-- regardless of the names already in the InfoTable +runParser :: FilePath -> FilePath -> InfoTable -> Text -> Either ParserError (InfoTable, Maybe Node) +runParser root fileName tab input = + case run $ + runInfoTableBuilder tab $ + runReader params $ + runNameIdGen $ + P.runParserT parseToplevel fileName input of + (_, Left err) -> Left (ParserError err) + (tbl, Right r) -> Right (tbl, r) + where + params = + ParserParams + { _parserParamsRoot = root + } + +starType :: Type +starType = Pi Info.empty (Univ Info.empty 0) (Var Info.empty 0) + +freshName :: + Members '[InfoTableBuilder, NameIdGen] r => + NameKind -> + Text -> + Interval -> + Sem r Name +freshName kind txt i = do + nid <- freshNameId + return $ + Name + { _nameText = txt, + _nameId = nid, + _nameKind = kind, + _namePretty = txt, + _nameLoc = i + } + +declareBuiltinConstr :: + Members '[InfoTableBuilder, NameIdGen] r => + BuiltinDataTag -> + Text -> + Interval -> + Sem r () +declareBuiltinConstr btag nameTxt i = do + name <- freshName KNameConstructor nameTxt i + registerConstructor + ( ConstructorInfo + { _constructorName = name, + _constructorTag = BuiltinTag btag, + _constructorType = starType, + _constructorArgsNum = builtinConstrArgsNum btag + } + ) + +guardSymbolNotDefined :: + Member InfoTableBuilder r => + Symbol -> + ParsecS r () -> + ParsecS r () +guardSymbolNotDefined sym err = do + b <- lift $ checkSymbolDefined sym + when b err + +declareBuiltins :: Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => ParsecS r () +declareBuiltins = do + loc <- curLoc + let i = mkInterval loc loc + lift $ declareBuiltinConstr TagTrue "true" i + lift $ declareBuiltinConstr TagFalse "false" i + lift $ declareBuiltinConstr TagReturn "return" i + lift $ declareBuiltinConstr TagBind "bind" i + lift $ declareBuiltinConstr TagWrite "write" i + lift $ declareBuiltinConstr TagReadLn "readLn" i + +parseToplevel :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r (Maybe Node) +parseToplevel = do + declareBuiltins + space + P.endBy statement kwSemicolon + r <- optional expression + P.eof + return r + +statement :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r () +statement = statementDef <|> statementConstr + +statementDef :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r () +statementDef = do + kwDef + off <- P.getOffset + (txt, i) <- identifierL + r <- lift (getIdent txt) + case r of + Just (Left sym) -> do + guardSymbolNotDefined + sym + (parseFailure off ("duplicate definition of: " ++ fromText txt)) + parseDefinition sym + Just (Right {}) -> + parseFailure off ("duplicate identifier: " ++ fromText txt) + Nothing -> do + sym <- lift freshSymbol + name <- lift $ freshName KNameFunction txt i + let info = + IdentInfo + { _identName = name, + _identSymbol = sym, + _identType = starType, + _identArgsNum = 0, + _identArgsInfo = [], + _identIsExported = False + } + lift $ registerIdent info + void $ optional (parseDefinition sym) + +parseDefinition :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Symbol -> + ParsecS r () +parseDefinition sym = do + kwAssignment + node <- expression + lift $ registerIdentNode sym node + let (is, _) = unfoldLambdas' node + lift $ setIdentArgsInfo sym (map toArgumentInfo is) + where + toArgumentInfo :: Info -> ArgumentInfo + toArgumentInfo i = + case Info.lookup kBinderInfo i of + Just bi -> + ArgumentInfo + { _argumentName = bi ^. BinderInfo.infoName, + _argumentType = bi ^. BinderInfo.infoType, + _argumentIsImplicit = False + } + Nothing -> error "missing binder info" + +statementConstr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r () +statementConstr = do + kwConstr + off <- P.getOffset + (txt, i) <- identifierL + (argsNum, _) <- number 0 128 + dupl <- lift (hasIdent txt) + when + dupl + (parseFailure off ("duplicate identifier: " ++ fromText txt)) + tag <- lift freshTag + name <- lift $ freshName KNameConstructor txt i + let info = + ConstructorInfo + { _constructorName = name, + _constructorTag = tag, + _constructorType = starType, + _constructorArgsNum = argsNum + } + lift $ registerConstructor info + +expression :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r Node +expression = do + node <- expr 0 mempty + tab <- lift getInfoTable + return $ etaExpandApps tab node + +expr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + -- current de Bruijn index, i.e., the number of binders upwards + Index -> + -- reverse de Bruijn indices + HashMap Text Index -> + ParsecS r Node +expr varsNum vars = ioExpr varsNum vars + +ioExpr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +ioExpr varsNum vars = cmpExpr varsNum vars >>= ioExpr' varsNum vars + +ioExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +ioExpr' varsNum vars node = do + bindExpr' varsNum vars node + <|> seqExpr' varsNum vars node + <|> return node + +bindExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +bindExpr' varsNum vars node = do + kwBind + node' <- cmpExpr varsNum vars + ioExpr' varsNum vars (Constr Info.empty (BuiltinTag TagBind) [node, node']) + +seqExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +seqExpr' varsNum vars node = do + ((), i) <- interval kwSeq + node' <- cmpExpr (varsNum + 1) vars + name <- lift $ freshName KNameLocal "_" i + ioExpr' varsNum vars $ + Constr + Info.empty + (BuiltinTag TagBind) + [node, Lambda (Info.singleton (BinderInfo name starType)) node'] + +cmpExpr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +cmpExpr varsNum vars = arithExpr varsNum vars >>= cmpExpr' varsNum vars + +cmpExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +cmpExpr' varsNum vars node = + eqExpr' varsNum vars node + <|> ltExpr' varsNum vars node + <|> leExpr' varsNum vars node + <|> gtExpr' varsNum vars node + <|> geExpr' varsNum vars node + <|> return node + +eqExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +eqExpr' varsNum vars node = do + kwEq + node' <- arithExpr varsNum vars + return $ BuiltinApp Info.empty OpEq [node, node'] + +ltExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +ltExpr' varsNum vars node = do + kwLt + node' <- arithExpr varsNum vars + return $ BuiltinApp Info.empty OpIntLt [node, node'] + +leExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +leExpr' varsNum vars node = do + kwLe + node' <- arithExpr varsNum vars + return $ BuiltinApp Info.empty OpIntLe [node, node'] + +gtExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +gtExpr' varsNum vars node = do + kwGt + node' <- arithExpr varsNum vars + return $ BuiltinApp Info.empty OpIntLt [node', node] + +geExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +geExpr' varsNum vars node = do + kwGe + node' <- arithExpr varsNum vars + return $ BuiltinApp Info.empty OpIntLe [node', node] + +arithExpr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +arithExpr varsNum vars = factorExpr varsNum vars >>= arithExpr' varsNum vars + +arithExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +arithExpr' varsNum vars node = + plusExpr' varsNum vars node + <|> minusExpr' varsNum vars node + <|> return node + +plusExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +plusExpr' varsNum vars node = do + kwPlus + node' <- factorExpr varsNum vars + arithExpr' varsNum vars (BuiltinApp Info.empty OpIntAdd [node, node']) + +minusExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +minusExpr' varsNum vars node = do + kwMinus + node' <- factorExpr varsNum vars + arithExpr' varsNum vars (BuiltinApp Info.empty OpIntSub [node, node']) + +factorExpr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +factorExpr varsNum vars = appExpr varsNum vars >>= factorExpr' varsNum vars + +factorExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +factorExpr' varsNum vars node = + mulExpr' varsNum vars node + <|> divExpr' varsNum vars node + <|> modExpr' varsNum vars node + <|> return node + +mulExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +mulExpr' varsNum vars node = do + kwMul + node' <- appExpr varsNum vars + factorExpr' varsNum vars (BuiltinApp Info.empty OpIntMul [node, node']) + +divExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +divExpr' varsNum vars node = do + kwDiv + node' <- appExpr varsNum vars + factorExpr' varsNum vars (BuiltinApp Info.empty OpIntDiv [node, node']) + +modExpr' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + Node -> + ParsecS r Node +modExpr' varsNum vars node = do + kwMod + node' <- appExpr varsNum vars + factorExpr' varsNum vars (BuiltinApp Info.empty OpIntMod [node, node']) + +appExpr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +appExpr varsNum vars = builtinAppExpr varsNum vars <|> atoms varsNum vars + +builtinAppExpr :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +builtinAppExpr varsNum vars = do + op <- + (kwEq >> return OpEq) + <|> (kwLt >> return OpIntLt) + <|> (kwLe >> return OpIntLe) + <|> (kwPlus >> return OpIntAdd) + <|> (kwMinus >> return OpIntSub) + <|> (kwDiv >> return OpIntDiv) + <|> (kwMul >> return OpIntMul) + <|> (kwTrace >> return OpTrace) + <|> (kwFail >> return OpFail) + args <- P.many (atom varsNum vars) + return $ BuiltinApp Info.empty op args + +atoms :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +atoms varsNum vars = do + es <- P.some (atom varsNum vars) + return $ mkApp (List.head es) (List.tail es) + +atom :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +atom varsNum vars = + exprNamed varsNum vars + <|> exprConstInt + <|> exprConstString + <|> exprLambda varsNum vars + <|> exprLet varsNum vars + <|> exprCase varsNum vars + <|> exprIf varsNum vars + <|> parens (expr varsNum vars) + <|> braces (expr varsNum vars) + +exprNamed :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +exprNamed varsNum vars = do + off <- P.getOffset + (txt, i) <- identifierL + case HashMap.lookup txt vars of + Just k -> do + name <- lift $ freshName KNameLocal txt i + return $ Var (Info.singleton (NameInfo name)) (varsNum - k - 1) + Nothing -> do + r <- lift (getIdent txt) + case r of + Just (Left sym) -> do + name <- lift $ freshName KNameFunction txt i + return $ Ident (Info.singleton (NameInfo name)) sym + Just (Right tag) -> do + name <- lift $ freshName KNameConstructor txt i + return $ Constr (Info.singleton (NameInfo name)) tag [] + Nothing -> + parseFailure off ("undeclared identifier: " ++ fromText txt) + +exprConstInt :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r Node +exprConstInt = P.try $ do + (n, i) <- integer + return $ Constant (Info.singleton (LocationInfo i)) (ConstInteger n) + +exprConstString :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r Node +exprConstString = P.try $ do + (s, i) <- string + return $ Constant (Info.singleton (LocationInfo i)) (ConstString s) + +parseLocalName :: + forall r. + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + ParsecS r Name +parseLocalName = parseWildcardName <|> parseIdentName + where + parseWildcardName :: ParsecS r Name + parseWildcardName = do + ((), i) <- interval kwWildcard + lift $ freshName KNameLocal "_" i + + parseIdentName :: ParsecS r Name + parseIdentName = do + (txt, i) <- identifierL + lift $ freshName KNameLocal txt i + +exprLambda :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +exprLambda varsNum vars = do + kwLambda + name <- parseLocalName + let vars' = HashMap.insert (name ^. nameText) varsNum vars + body <- expr (varsNum + 1) vars' + return $ Lambda (Info.singleton (BinderInfo name starType)) body + +exprLet :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +exprLet varsNum vars = do + kwLet + name <- parseLocalName + kwAssignment + value <- expr varsNum vars + kwIn + let vars' = HashMap.insert (name ^. nameText) varsNum vars + body <- expr (varsNum + 1) vars' + return $ Let (Info.singleton (BinderInfo name starType)) value body + +exprCase :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +exprCase varsNum vars = do + off <- P.getOffset + kwCase + value <- expr varsNum vars + kwOf + braces (exprCase' off value varsNum vars) + <|> exprCase' off value varsNum vars + +exprCase' :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Int -> + Node -> + Index -> + HashMap Text Index -> + ParsecS r Node +exprCase' off value varsNum vars = do + bs <- P.sepEndBy (caseBranch varsNum vars) kwSemicolon + let bs' = map fromLeft' $ filter isLeft bs + let bss = map fst bs' + let bsns = map snd bs' + let def' = map fromRight' $ filter isRight bs + let bi = CaseBinderInfo $ map (map (`BinderInfo` starType)) bsns + bri <- + CaseBranchInfo + <$> mapM + ( \(CaseBranch tag _ _) -> do + ci <- lift $ getConstructorInfo tag + return $ BranchInfo (ci ^. constructorName) + ) + bss + let info = Info.insert bri (Info.singleton bi) + case def' of + [def] -> + return $ Case info value bss (Just def) + [] -> + return $ Case info value bss Nothing + _ -> + parseFailure off "multiple default branches" + +caseBranch :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r (Either (CaseBranch, [Name]) Node) +caseBranch varsNum vars = + (defaultBranch varsNum vars <&> Right) + <|> (matchingBranch varsNum vars <&> Left) + +defaultBranch :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +defaultBranch varsNum vars = do + kwWildcard + kwMapsTo + expr varsNum vars + +matchingBranch :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r (CaseBranch, [Name]) +matchingBranch varsNum vars = do + off <- P.getOffset + txt <- identifier + r <- lift (getIdent txt) + case r of + Just (Left {}) -> + parseFailure off ("not a constructor: " ++ fromText txt) + Just (Right tag) -> do + ns <- P.many parseLocalName + let bindersNum = length ns + ci <- lift $ getConstructorInfo tag + when + (ci ^. constructorArgsNum /= bindersNum) + (parseFailure off "wrong number of constructor arguments") + kwMapsTo + let vars' = + fst $ + foldl' + ( \(vs, k) name -> + (HashMap.insert (name ^. nameText) k vs, k + 1) + ) + (vars, varsNum) + ns + br <- expr (varsNum + bindersNum) vars' + return (CaseBranch tag bindersNum br, ns) + Nothing -> + parseFailure off ("undeclared identifier: " ++ fromText txt) + +exprIf :: + Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => + Index -> + HashMap Text Index -> + ParsecS r Node +exprIf varsNum vars = do + kwIf + value <- expr varsNum vars + kwThen + br1 <- expr varsNum vars + kwElse + br2 <- expr varsNum vars + return $ mkIf Info.empty value br1 br2 diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs new file mode 100644 index 0000000000..9c8aab6fc1 --- /dev/null +++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs @@ -0,0 +1,196 @@ +module Juvix.Compiler.Core.Translation.FromSource.Lexer + ( module Juvix.Compiler.Core.Translation.FromSource.Lexer, + module Juvix.Parser.Lexer, + ) +where + +import Juvix.Extra.Strings qualified as Str +import Juvix.Parser.Lexer +import Juvix.Prelude +import Text.Megaparsec as P hiding (sepBy1, sepEndBy1, some) +import Text.Megaparsec.Char.Lexer qualified as L + +space :: ParsecS r () +space = space' False void + +lexeme :: ParsecS r a -> ParsecS r a +lexeme = L.lexeme space + +lexemeInterval :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (a, Interval) +lexemeInterval = lexeme . interval + +symbol :: Text -> ParsecS r () +symbol = void . L.symbol space + +decimal :: (Member (Reader ParserParams) r, Num n) => ParsecS r (n, Interval) +decimal = lexemeInterval L.decimal + +integer :: Member (Reader ParserParams) r => ParsecS r (Integer, Interval) +integer = integer' decimal + +number :: Member (Reader ParserParams) r => Int -> Int -> ParsecS r (Int, Interval) +number = number' integer + +string :: Member (Reader ParserParams) r => ParsecS r (Text, Interval) +string = lexemeInterval string' + +keyword :: Text -> ParsecS r () +keyword = keyword' space + +rawKeyword :: Text -> ParsecS r () +rawKeyword = rawKeyword' space + +identifier :: ParsecS r Text +identifier = lexeme bareIdentifier + +identifierL :: Member (Reader ParserParams) r => ParsecS r (Text, Interval) +identifierL = lexemeInterval bareIdentifier + +-- | Same as @identifier@ but does not consume space after it. +bareIdentifier :: ParsecS r Text +bareIdentifier = rawIdentifier allKeywords + +allKeywords :: [ParsecS r ()] +allKeywords = + [ kwAssignment, + kwColon, + kwLambda, + kwLet, + kwIn, + kwConstr, + kwCase, + kwOf, + kwIf, + kwThen, + kwElse, + kwDef, + kwMapsTo, + kwRightArrow, + kwSemicolon, + kwWildcard, + kwPlus, + kwMinus, + kwMul, + kwDiv, + kwMod, + kwEq, + kwLt, + kwLe, + kwGt, + kwGe, + kwBind, + kwSeq, + kwTrace, + kwFail + ] + +lbrace :: ParsecS r () +lbrace = symbol "{" + +rbrace :: ParsecS r () +rbrace = symbol "}" + +lparen :: ParsecS r () +lparen = symbol "(" + +rparen :: ParsecS r () +rparen = symbol ")" + +parens :: ParsecS r a -> ParsecS r a +parens = between lparen rparen + +braces :: ParsecS r a -> ParsecS r a +braces = between (symbol "{") (symbol "}") + +kwAssignment :: ParsecS r () +kwAssignment = keyword Str.assignUnicode <|> keyword Str.assignAscii + +kwColon :: ParsecS r () +kwColon = keyword Str.colon + +kwInductive :: ParsecS r () +kwInductive = keyword Str.inductive + +kwLambda :: ParsecS r () +kwLambda = rawKeyword Str.lambdaUnicode <|> rawKeyword Str.lambdaAscii + +kwLet :: ParsecS r () +kwLet = keyword Str.let_ + +kwIn :: ParsecS r () +kwIn = keyword Str.in_ + +kwConstr :: ParsecS r () +kwConstr = keyword Str.constr + +kwCase :: ParsecS r () +kwCase = keyword Str.case_ + +kwOf :: ParsecS r () +kwOf = keyword Str.of_ + +kwIf :: ParsecS r () +kwIf = keyword Str.if_ + +kwThen :: ParsecS r () +kwThen = keyword Str.then_ + +kwElse :: ParsecS r () +kwElse = keyword Str.else_ + +kwDef :: ParsecS r () +kwDef = keyword Str.def + +kwMapsTo :: ParsecS r () +kwMapsTo = keyword Str.mapstoUnicode <|> keyword Str.mapstoAscii + +kwRightArrow :: ParsecS r () +kwRightArrow = keyword Str.toUnicode <|> keyword Str.toAscii + +kwSemicolon :: ParsecS r () +kwSemicolon = keyword Str.semicolon + +kwWildcard :: ParsecS r () +kwWildcard = keyword Str.underscore + +kwPlus :: ParsecS r () +kwPlus = keyword Str.plus + +kwMinus :: ParsecS r () +kwMinus = keyword Str.minus + +kwMul :: ParsecS r () +kwMul = keyword Str.mul + +kwDiv :: ParsecS r () +kwDiv = keyword Str.div + +kwMod :: ParsecS r () +kwMod = keyword Str.mod + +kwEq :: ParsecS r () +kwEq = keyword Str.equal + +kwLt :: ParsecS r () +kwLt = keyword Str.less + +kwLe :: ParsecS r () +kwLe = keyword Str.lessEqual + +kwGt :: ParsecS r () +kwGt = keyword Str.greater + +kwGe :: ParsecS r () +kwGe = keyword Str.greaterEqual + +kwBind :: ParsecS r () +kwBind = keyword Str.bind + +kwSeq :: ParsecS r () +kwSeq = keyword Str.seq_ + +kwTrace :: ParsecS r () +kwTrace = keyword Str.trace_ + +kwFail :: ParsecS r () +kwFail = keyword Str.fail_ diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs index 198bb8b3d5..8e1fdcea75 100644 --- a/src/Juvix/Extra/Strings.hs +++ b/src/Juvix/Extra/Strings.hs @@ -41,6 +41,9 @@ function = "function" constructor :: IsString s => s constructor = "constructor" +constr :: IsString s => s +constr = "constr" + topModule :: IsString s => s topModule = "top module" @@ -128,9 +131,39 @@ pipe = "|" equal :: IsString s => s equal = "=" +less :: IsString s => s +less = "<" + +lessEqual :: IsString s => s +lessEqual = "<=" + +greater :: IsString s => s +greater = ">" + +greaterEqual :: IsString s => s +greaterEqual = ">=" + +bind :: IsString s => s +bind = ">>=" + +seq_ :: IsString s => s +seq_ = ">>" + +trace_ :: IsString s => s +trace_ = "trace" + +fail_ :: IsString s => s +fail_ = "fail" + data_ :: IsString s => s data_ = "data" +deBruijnVar :: IsString s => s +deBruijnVar = "$" + +exclamation :: IsString s => s +exclamation = "!" + lambdaUnicode :: IsString s => s lambdaUnicode = "λ" @@ -227,6 +260,9 @@ sizeof = "sizeof" true_ :: IsString s => s true_ = "true" +false_ :: IsString s => s +false_ = "false" + tag :: IsString s => s tag = "tag" @@ -242,6 +278,60 @@ putStrLn_ = "putStrLn" debug_ :: IsString s => s debug_ = "debug" +plus :: IsString s => s +plus = "+" + +minus :: IsString s => s +minus = "-" + +mul :: IsString s => s +mul = "*" + +div :: IsString s => s +div = "/" + +mod :: IsString s => s +mod = "%" + +if_ :: IsString s => s +if_ = "if" + +then_ :: IsString s => s +then_ = "then" + +else_ :: IsString s => s +else_ = "else" + +pi_ :: IsString s => s +pi_ = "pi" + +def :: IsString s => s +def = "def" + +zero :: IsString s => s +zero = "0" + +succ :: IsString s => s +succ = "S" + +unit :: IsString s => s +unit = "unit" + +nil :: IsString s => s +nil = "nil" + +cons :: IsString s => s +cons = "cons" + +pair :: IsString s => s +pair = "pair" + +case_ :: IsString s => s +case_ = "case" + +of_ :: IsString s => s +of_ = "of" + juvixFunctionT :: IsString s => s juvixFunctionT = "juvix_function_t" diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource/Error.hs b/src/Juvix/Parser/Error.hs similarity index 88% rename from src/Juvix/Compiler/Concrete/Translation/FromSource/Error.hs rename to src/Juvix/Parser/Error.hs index e0c2706231..c240e30c6d 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource/Error.hs +++ b/src/Juvix/Parser/Error.hs @@ -1,9 +1,9 @@ -module Juvix.Compiler.Concrete.Translation.FromSource.Error where +module Juvix.Parser.Error where -import Juvix.Compiler.Concrete.Extra (errorOffset) import Juvix.Prelude import Juvix.Prelude.Pretty import Text.Megaparsec qualified as M +import Text.Megaparsec.Error (errorOffset) newtype ParserError = ParserError { _parseError :: M.ParseErrorBundle Text Void diff --git a/src/Juvix/Parser/Lexer.hs b/src/Juvix/Parser/Lexer.hs new file mode 100644 index 0000000000..168ea3ebf1 --- /dev/null +++ b/src/Juvix/Parser/Lexer.hs @@ -0,0 +1,121 @@ +module Juvix.Parser.Lexer where + +{- + +This module contains lexing functions common to all parsers in the pipeline +(Juvix, JuvixCore, JuvixAsm). + +-} + +import Control.Monad.Trans.Class (lift) +import Data.Set qualified as Set +import Data.Text qualified as Text +import GHC.Unicode +import Juvix.Extra.Strings qualified as Str +import Juvix.Prelude +import Text.Megaparsec as P hiding (sepBy1, sepEndBy1, some) +import Text.Megaparsec.Char hiding (space) +import Text.Megaparsec.Char.Lexer qualified as L + +type ParsecS r = ParsecT Void Text (Sem r) + +newtype ParserParams = ParserParams + { _parserParamsRoot :: FilePath + } + +makeLenses ''ParserParams + +parseFailure :: Int -> String -> ParsecS r a +parseFailure off str = P.parseError $ P.FancyError off (Set.singleton (P.ErrorFail str)) + +space' :: forall r. Bool -> (forall a. ParsecS r a -> ParsecS r ()) -> ParsecS r () +space' judoc comment_ = L.space space1 lineComment block + where + lineComment :: ParsecS r () + lineComment = comment_ $ do + when + judoc + (notFollowedBy (P.chunk Str.judocStart)) + void (P.chunk "--") + void (P.takeWhileP Nothing (/= '\n')) + + block :: ParsecS r () + block = comment_ (L.skipBlockComment "{-" "-}") + +integer' :: ParsecS r (Integer, Interval) -> ParsecS r (Integer, Interval) +integer' dec = do + minus <- optional (char '-') + (nat, i) <- dec + let nat' = case minus of + Nothing -> nat + _ -> (-nat) + return (nat', i) + +number' :: ParsecS r (Integer, Interval) -> Int -> Int -> ParsecS r (Int, Interval) +number' int mn mx = do + off <- getOffset + (n, i) <- int + when + (n < fromIntegral mn || n > fromIntegral mx) + (parseFailure off ("number out of bounds: " ++ show n)) + return (fromInteger n, i) + +string' :: ParsecS r Text +string' = pack <$> (char '"' >> manyTill L.charLiteral (char '"')) + +keyword' :: ParsecS r () -> Text -> ParsecS r () +keyword' spc kw = do + P.try $ do + P.chunk kw + notFollowedBy (satisfy validTailChar) + spc + +keywordL' :: Member (Reader ParserParams) r => ParsecS r () -> Text -> ParsecS r Interval +keywordL' spc kw = do + P.try $ do + i <- snd <$> interval (P.chunk kw) + notFollowedBy (satisfy validTailChar) + spc + return i + +rawKeyword' :: ParsecS r () -> Text -> ParsecS r () +rawKeyword' spc kw = do + P.try $ do + void (P.chunk kw) + spc + +rawIdentifier :: [ParsecS r ()] -> ParsecS r Text +rawIdentifier allKeywords = do + notFollowedBy (choice allKeywords) + h <- P.satisfy validFirstChar + t <- P.takeWhileP Nothing validTailChar + return (Text.cons h t) + +validTailChar :: Char -> Bool +validTailChar c = + isAlphaNum c || validFirstChar c + +reservedSymbols :: [Char] +reservedSymbols = "\";(){}[].≔λ\\" + +validFirstChar :: Char -> Bool +validFirstChar c = not $ isNumber c || isSpace c || (c `elem` reservedSymbols) + +curLoc :: Member (Reader ParserParams) r => ParsecS r Loc +curLoc = do + sp <- getSourcePos + offset <- getOffset + root <- lift (asks (^. parserParamsRoot)) + return (mkLoc root offset sp) + +interval :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (a, Interval) +interval ma = do + start <- curLoc + res <- ma + end <- curLoc + return (res, mkInterval start end) + +withLoc :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (WithLoc a) +withLoc ma = do + (a, i) <- interval ma + return (WithLoc i a) diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs index 608bd0fc26..4a82465073 100644 --- a/src/Juvix/Prelude/Base.hs +++ b/src/Juvix/Prelude/Base.hs @@ -218,6 +218,14 @@ tableNestedInsert :: HashMap k1 (HashMap k2 a) tableNestedInsert k1 k2 = tableInsert (HashMap.singleton k2) (HashMap.insert k2) k1 +-------------------------------------------------------------------------------- +-- List +-------------------------------------------------------------------------------- + +revAppend :: [a] -> [a] -> [a] +revAppend [] ys = ys +revAppend (x : xs) ys = revAppend xs (x : ys) + -------------------------------------------------------------------------------- -- NonEmpty -------------------------------------------------------------------------------- diff --git a/test/Core.hs b/test/Core.hs new file mode 100644 index 0000000000..52a22ed4b5 --- /dev/null +++ b/test/Core.hs @@ -0,0 +1,8 @@ +module Core where + +import Base +import Core.Negative qualified as N +import Core.Positive qualified as P + +allTests :: TestTree +allTests = testGroup "JuvixCore tests" [P.allTests, N.allTests] diff --git a/test/Core/Base.hs b/test/Core/Base.hs new file mode 100644 index 0000000000..afd23810c3 --- /dev/null +++ b/test/Core/Base.hs @@ -0,0 +1,82 @@ +module Core.Base where + +import Base +import Data.Text.IO qualified as TIO +import Juvix.Compiler.Core.Data.InfoTable +import Juvix.Compiler.Core.Error +import Juvix.Compiler.Core.Evaluator +import Juvix.Compiler.Core.Extra +import Juvix.Compiler.Core.Info qualified as Info +import Juvix.Compiler.Core.Info.NoDisplayInfo +import Juvix.Compiler.Core.Language +import Juvix.Compiler.Core.Pretty +import Juvix.Compiler.Core.Translation.FromSource +import System.IO.Extra (withTempDir) +import Text.Megaparsec.Pos qualified as M + +coreEvalAssertion :: FilePath -> FilePath -> (String -> IO ()) -> Assertion +coreEvalAssertion mainFile expectedFile step = do + step "Parse" + r <- parseFile mainFile + case r of + Left err -> assertFailure (show (pretty err)) + Right (_, Nothing) -> do + step "Compare expected and actual program output" + expected <- TIO.readFile expectedFile + assertEqDiff ("Check: EVAL output = " <> expectedFile) "" expected + Right (tab, Just node) -> do + withTempDir + ( \dirPath -> do + let outputFile = dirPath "out.out" + hout <- openFile outputFile WriteMode + step "Evaluate" + r' <- doEval mainFile hout tab node + case r' of + Left err -> do + hClose hout + assertFailure (show (pretty err)) + Right value -> do + unless + (Info.member kNoDisplayInfo (getInfo value)) + (hPutStrLn hout (ppPrint value)) + hClose hout + actualOutput <- TIO.readFile outputFile + step "Compare expected and actual program output" + expected <- TIO.readFile expectedFile + assertEqDiff ("Check: EVAL output = " <> expectedFile) actualOutput expected + ) + +coreEvalErrorAssertion :: FilePath -> (String -> IO ()) -> Assertion +coreEvalErrorAssertion mainFile step = do + step "Parse" + r <- parseFile mainFile + case r of + Left _ -> assertBool "" True + Right (_, Nothing) -> assertFailure "no error" + Right (tab, Just node) -> do + withTempDir + ( \dirPath -> do + let outputFile = dirPath "out.out" + hout <- openFile outputFile WriteMode + step "Evaluate" + r' <- doEval mainFile hout tab node + case r' of + Left _ -> assertBool "" True + Right _ -> assertFailure "no error" + ) + +parseFile :: FilePath -> IO (Either ParserError (InfoTable, Maybe Node)) +parseFile f = do + s <- readFile f + return $ runParser "" f emptyInfoTable s + +doEval :: + FilePath -> + Handle -> + InfoTable -> + Node -> + IO (Either CoreError Node) +doEval f hout tab node = + catchEvalErrorIO defaultLoc (hEvalIO stdin hout (tab ^. identContext) [] node) + where + defaultLoc = singletonInterval (mkLoc f 0 (M.initialPos f)) diff --git a/test/Core/Negative.hs b/test/Core/Negative.hs new file mode 100644 index 0000000000..ddffc58b04 --- /dev/null +++ b/test/Core/Negative.hs @@ -0,0 +1,68 @@ +module Core.Negative where + +import Base +import Core.Base + +data NegTest = NegTest + { _name :: String, + _relDir :: FilePath, + _file :: FilePath + } + +root :: FilePath +root = "tests/Core/negative" + +testDescr :: NegTest -> TestDescr +testDescr NegTest {..} = + let tRoot = root _relDir + in TestDescr + { _testName = _name, + _testRoot = tRoot, + _testAssertion = Steps $ coreEvalErrorAssertion _file + } + +allTests :: TestTree +allTests = + testGroup + "JuvixCore negative tests" + (map (mkTest . testDescr) tests) + +tests :: [NegTest] +tests = + [ NegTest + "Division by zero" + "." + "test001.jvc", + NegTest + "Arithmetic operations on non-numbers" + "." + "test002.jvc", + NegTest + "Matching on non-data" + "." + "test003.jvc", + NegTest + "If on non-boolean" + "." + "test004.jvc", + NegTest + "No matching case branch" + "." + "test005.jvc", + NegTest + "Invalid application" + "." + "test006.jvc", + NegTest + "Invalid builtin application" + "." + "test007.jvc", + NegTest + "Undefined symbol" + "." + "test008.jvc", + NegTest + "Erroneous Church numerals" + "." + "test009.jvc" + ] diff --git a/test/Core/Positive.hs b/test/Core/Positive.hs new file mode 100644 index 0000000000..43a8f18ee3 --- /dev/null +++ b/test/Core/Positive.hs @@ -0,0 +1,228 @@ +module Core.Positive where + +import Base +import Core.Base + +data PosTest = PosTest + { _name :: String, + _relDir :: FilePath, + _file :: FilePath, + _expectedFile :: FilePath + } + +root :: FilePath +root = "tests/Core/positive" + +testDescr :: PosTest -> TestDescr +testDescr PosTest {..} = + let tRoot = root _relDir + in TestDescr + { _testName = _name, + _testRoot = tRoot, + _testAssertion = Steps $ coreEvalAssertion _file _expectedFile + } + +allTests :: TestTree +allTests = + testGroup + "JuvixCore positive tests" + (map (mkTest . testDescr) tests) + +tests :: [PosTest] +tests = + [ PosTest + "Arithmetic operators" + "." + "test001.jvc" + "out/test001.out", + PosTest + "Arithmetic operators inside lambdas" + "." + "test002.jvc" + "out/test002.out", + PosTest + "Empty program with comments" + "." + "test003.jvc" + "out/test003.out", + PosTest + "IO builtins" + "." + "test004.jvc" + "out/test004.out", + PosTest + "Higher-order functions" + "." + "test005.jvc" + "out/test005.out", + PosTest + "If-then-else" + "." + "test006.jvc" + "out/test006.out", + PosTest + "Case" + "." + "test007.jvc" + "out/test007.out", + PosTest + "Recursion" + "." + "test008.jvc" + "out/test008.out", + PosTest + "Tail recursion" + "." + "test009.jvc" + "out/test009.out", + PosTest + "Let" + "." + "test010.jvc" + "out/test010.out", + PosTest + "Tail recursion: Fibonacci numbers in linear time" + "." + "test011.jvc" + "out/test011.out", + PosTest + "Trees" + "." + "test012.jvc" + "out/test012.out", + PosTest + "Functions returning functions with variable capture" + "." + "test013.jvc" + "out/test013.out", + PosTest + "Arithmetic" + "." + "test014.jvc" + "out/test014.out", + PosTest + "Local functions with free variables" + "." + "test015.jvc" + "out/test015.out", + PosTest + "Recursion through higher-order functions" + "." + "test016.jvc" + "out/test016.out", + PosTest + "Tail recursion through higher-order functions" + "." + "test017.jvc" + "out/test017.out", + PosTest + "Higher-order functions and recursion" + "." + "test018.jvc" + "out/test018.out", + PosTest + "Self-application" + "." + "test019.jvc" + "out/test019.out", + PosTest + "Recursive functions: McCarthy's 91 function, subtraction by increments" + "." + "test020.jvc" + "out/test020.out", + PosTest + "Higher-order recursive functions" + "." + "test021.jvc" + "out/test021.out", + PosTest + "Fast exponentiation" + "." + "test022.jvc" + "out/test022.out", + PosTest + "Lists" + "." + "test023.jvc" + "out/test023.out", + PosTest + "Structural equality" + "." + "test024.jvc" + "out/test024.out", + PosTest + "Mutual recursion" + "." + "test025.jvc" + "out/test025.out", + PosTest + "Nested 'case', 'let' and 'if' with variable capture" + "." + "test026.jvc" + "out/test026.out", + PosTest + "Euclid's algorithm" + "." + "test027.jvc" + "out/test027.out", + PosTest + "Functional queues" + "." + "test028.jvc" + "out/test028.out", + PosTest + "Church numerals" + "." + "test029.jvc" + "out/test029.out", + PosTest + "Streams without memoization" + "." + "test030.jvc" + "out/test030.out", + PosTest + "Ackermann function" + "." + "test031.jvc" + "out/test031.out", + PosTest + "Ackermann function (higher-order definition)" + "." + "test032.jvc" + "out/test032.out", + PosTest + "Nested lists" + "." + "test033.jvc" + "out/test033.out", + {- PosTest + "Evaluation order" + "." + "test034.jvc" + "out/test034.out", -} + PosTest + "Merge sort" + "." + "test035.jvc" + "out/test035.out", + PosTest + "Big numbers" + "." + "test036.jvc" + "out/test036.out", + PosTest + "Global variables" + "." + "test037.jvc" + "out/test037.out", + PosTest + "Global variables and forward declarations" + "." + "test038.jvc" + "out/test038.out", + PosTest + "Eta-expansion of builtins and constructors" + "." + "test039.jvc" + "out/test039.out" + ] diff --git a/test/Main.hs b/test/Main.hs index b72482e350..0e63bc512d 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -3,6 +3,7 @@ module Main (main) where import Arity qualified import BackendC qualified import Base +import Core qualified import MonoJuvix qualified import Reachability qualified import Scope qualified @@ -13,7 +14,9 @@ slowTests :: TestTree slowTests = testGroup "Juvix slow tests" - [BackendC.allTests] + [ BackendC.allTests, + Core.allTests + ] fastTests :: TestTree fastTests = diff --git a/tests/Core/benchmark/out/test001.out b/tests/Core/benchmark/out/test001.out new file mode 100644 index 0000000000..a114a9cf86 --- /dev/null +++ b/tests/Core/benchmark/out/test001.out @@ -0,0 +1,6 @@ +50005000 +5000050000 +500000500000 +50000005000000 +5000000050000000 +500000000500000000 diff --git a/tests/Core/benchmark/out/test002.out b/tests/Core/benchmark/out/test002.out new file mode 100644 index 0000000000..d4662de4a8 --- /dev/null +++ b/tests/Core/benchmark/out/test002.out @@ -0,0 +1,6 @@ +55 +354224848179261915075 +43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875 +33644764876431783266621612005107543310302148460680063906564769974680081442166662368155595513633734025582065332680836159373734790483865268263040892463056431887354544369559827491606602099884183933864652731300088830269235673613135117579297437854413752130520504347701602264758318906527890855154366159582987279682987510631200575428783453215515103870818298969791613127856265033195487140214287532698187962046936097879900350962302291026368131493195275630227837628441540360584402572114334961180023091208287046088923962328835461505776583271252546093591128203925285393434620904245248929403901706233888991085841065183173360437470737908552631764325733993712871937587746897479926305837065742830161637408969178426378624212835258112820516370298089332099905707920064367426202389783111470054074998459250360633560933883831923386783056136435351892133279732908133732642652633989763922723407882928177953580570993691049175470808931841056146322338217465637321248226383092103297701648054726243842374862411453093812206564914032751086643394517512161526545361333111314042436854805106765843493523836959653428071768775328348234345557366719731392746273629108210679280784718035329131176778924659089938635459327894523777674406192240337638674004021330343297496902028328145933418826817683893072003634795623117103101291953169794607632737589253530772552375943788434504067715555779056450443016640119462580972216729758615026968443146952034614932291105970676243268515992834709891284706740862008587135016260312071903172086094081298321581077282076353186624611278245537208532365305775956430072517744315051539600905168603220349163222640885248852433158051534849622434848299380905070483482449327453732624567755879089187190803662058009594743150052402532709746995318770724376825907419939632265984147498193609285223945039707165443156421328157688908058783183404917434556270520223564846495196112460268313970975069382648706613264507665074611512677522748621598642530711298441182622661057163515069260029861704945425047491378115154139941550671256271197133252763631939606902895650288268608362241082050562430701794976171121233066073310059947366875 +2597406934722172416615503402127591541488048538651769658472477070395253454351127368626555677283671674475463758722307443211163839947387509103096569738218830449305228763853133492135302679278956701051276578271635608073050532200243233114383986516137827238124777453778337299916214634050054669860390862750996639366409211890125271960172105060300350586894028558103675117658251368377438684936413457338834365158775425371912410500332195991330062204363035213756525421823998690848556374080179251761629391754963458558616300762819916081109836526352995440694284206571046044903805647136346033000520852277707554446794723709030979019014860432846819857961015951001850608264919234587313399150133919932363102301864172536477136266475080133982431231703431452964181790051187957316766834979901682011849907756686456845066287392485603914047605199550066288826345877189410680370091879365001733011710028310473947456256091444932821374855573864080579813028266640270354294412104919995803131876805899186513425175959911520563155337703996941035518275274919959802257507902037798103089922984996304496255814045517000250299764322193462165366210841876745428298261398234478366581588040819003307382939500082132009374715485131027220817305432264866949630987914714362925554252624043999615326979876807510646819068792118299167964409178271868561702918102212679267401362650499784968843680975254700131004574186406448299485872551744746695651879126916993244564817673322257149314967763345846623830333820239702436859478287641875788572910710133700300094229333597292779191409212804901545976262791057055248158884051779418192905216769576608748815567860128818354354292307397810154785701328438612728620176653953444993001980062953893698550072328665131718113588661353747268458543254898113717660519461693791688442534259478126310388952047956594380715301911253964847112638900713362856910155145342332944128435722099628674611942095166100230974070996553190050815866991144544264788287264284501725332048648319457892039984893823636745618220375097348566847433887249049337031633826571760729778891798913667325190623247118037280173921572390822769228077292456662750538337500692607721059361942126892030256744356537800831830637593334502350256972906515285327194367756015666039916404882563967693079290502951488693413799125174856667074717514938979038653338139534684837808612673755438382110844897653836848318258836339917310455850905663846202501463131183108742907729262215943020429159474030610183981685506695026197376150857176119947587572212987205312060791864980361596092339594104118635168854883911918517906151156275293615849000872150192226511785315089251027528045151238603792184692121533829287136924321527332714157478829590260157195485316444794546750285840236000238344790520345108033282013803880708980734832620122795263360677366987578332625485944906021917368867786241120562109836985019729017715780112040458649153935115783499546100636635745448508241888279067531359950519206222976015376529797308588164873117308237059828489404487403932053592935976454165560795472477862029969232956138971989467942218727360512336559521133108778758228879597580320459608479024506385194174312616377510459921102486879496341706862092908893068525234805692599833377510390101316617812305114571932706629167125446512151746802548190358351688971707570677865618800822034683632101813026232996027599403579997774046244952114531588370357904483293150007246173417355805567832153454341170020258560809166294198637401514569572272836921963229511187762530753402594781448204657460288485500062806934811398276016855584079542162057543557291510641537592939022884356120792643705560062367986544382464373946972471945996555795505838034825597839682776084731530251788951718630722761103630509360074262261717363058613291544024695432904616258691774630578507674937487992329181750163484068813465534370997589353607405172909412697657593295156818624747127636468836551757018353417274662607306510451195762866349922848678780591085118985653555434958761664016447588028633629704046289097067736256584300235314749461233912068632146637087844699210427541569410912246568571204717241133378489816764096924981633421176857150311671040068175303192115415611958042570658693127276213710697472226029655524611053715554532499750843275200199214301910505362996007042963297805103066650638786268157658772683745128976850796366371059380911225428835839194121154773759981301921650952140133306070987313732926518169226845063443954056729812031546392324981793780469103793422169495229100793029949237507299325063050942813902793084134473061411643355614764093104425918481363930542369378976520526456347648318272633371512112030629233889286487949209737847861884868260804647319539200840398308008803869049557419756219293922110825766397681361044490024720948340326796768837621396744075713887292863079821849314343879778088737958896840946143415927131757836511457828935581859902923534388888846587452130838137779443636119762839036894595760120316502279857901545344747352706972851454599861422902737291131463782045516225447535356773622793648545035710208644541208984235038908770223039849380214734809687433336225449150117411751570704561050895274000206380497967960402617818664481248547269630823473377245543390519841308769781276565916764229022948181763075710255793365008152286383634493138089971785087070863632205869018938377766063006066757732427272929247421295265000706646722730009956124191409138984675224955790729398495608750456694217771551107346630456603944136235888443676215273928597072287937355966723924613827468703217858459948257514745406436460997059316120596841560473234396652457231650317792833860590388360417691428732735703986803342604670071717363573091122981306903286137122597937096605775172964528263757434075792282180744352908669606854021718597891166333863858589736209114248432178645039479195424208191626088571069110433994801473013100869848866430721216762473119618190737820766582968280796079482259549036328266578006994856825300536436674822534603705134503603152154296943991866236857638062351209884448741138600171173647632126029961408561925599707566827866778732377419444462275399909291044697716476151118672327238679208133367306181944849396607123345271856520253643621964198782752978813060080313141817069314468221189275784978281094367751540710106350553798003842219045508482239386993296926659221112742698133062300073465628498093636693049446801628553712633412620378491919498600097200836727876650786886306933418995225768314390832484886340318940194161036979843833346608676709431643653538430912157815543512852077720858098902099586449602479491970687230765687109234380719509824814473157813780080639358418756655098501321882852840184981407690738507369535377711880388528935347600930338598691608289335421147722936561907276264603726027239320991187820407067412272258120766729040071924237930330972132364184093956102995971291799828290009539147382437802779051112030954582532888721146170133440385939654047806199333224547317803407340902512130217279595753863158148810392952475410943880555098382627633127606718126171022011356181800775400227516734144169216424973175621363128588281978005788832454534581522434937268133433997710512532081478345067139835038332901313945986481820272322043341930929011907832896569222878337497354301561722829115627329468814853281922100752373626827643152685735493223028018101449649009015529248638338885664893002250974343601200814365153625369199446709711126951966725780061891215440222487564601554632812091945824653557432047644212650790655208208337976071465127508320487165271577472325887275761128357592132553934446289433258105028633583669291828566894736223508250294964065798630809614341696830467595174355313224362664207197608459024263017473392225291248366316428006552870975051997504913009859468071013602336440164400179188610853230764991714372054467823597211760465153200163085336319351589645890681722372812310320271897917951272799656053694032111242846590994556380215461316106267521633805664394318881268199494005537068697621855231858921100963441012933535733918459668197539834284696822889460076352031688922002021931318369757556962061115774305826305535862015637891246031220672933992617378379625150999935403648731423208873977968908908369996292995391977217796533421249291978383751460062054967341662833487341011097770535898066498136011395571584328308713940582535274056081011503907941688079197212933148303072638678631411038443128215994936824342998188719768637604496342597524256886188688978980888315865076262604856465004322896856149255063968811404400429503894245872382233543101078691517328333604779262727765686076177705616874050257743749983775830143856135427273838589774133526949165483929721519554793578923866762502745370104660909382449626626935321303744538892479216161188889702077910448563199514826630802879549546453583866307344423753319712279158861707289652090149848305435983200771326653407290662016775706409690183771201306823245333477966660525325490873601961480378241566071271650383582257289215708209369510995890132859490724306183325755201208090007175022022949742801823445413711916298449914722254196594682221468260644961839254249670903104007581488857971672246322887016438403908463856731164308169537326790303114583680575021119639905615169154708510459700542098571797318015564741406172334145847111268547929892443001391468289103679179216978616582489007322033591376706527676521307143985302760988478056216994659655461379174985659739227379416726495377801992098355427866179123126699374730777730569324430166839333011554515542656864937492128687049121754245967831132969248492466744261999033972825674873460201150442228780466124320183016108232183908654771042398228531316559685688005226571474428823317539456543881928624432662503345388199590085105211383124491861802624432195540433985722841341254409411771722156867086291742124053110620522842986199273629406208834754853645128123279609097213953775360023076765694208219943034648783348544492713539450224591334374664937701655605763384697062918725745426505879414630176639760457474311081556747091652708748125267159913793240527304613693961169892589808311906322510777928562071999459487700611801002296132304588294558440952496611158342804908643860880796440557763691857743754025896855927252514563404385217825890599553954627451385454452916761042969267970893580056234501918571489030418495767400819359973218711957496357095967825171096264752068890806407651445893132870767454169607107931692704285168093413311046353506242209810363216771910420786162184213763938194625697286781413636389620123976910465418956806197323148414224550071617215851321302030684176087215892702098879108938081045903397276547326416916845445627600759561367103584575649094430692452532085003091068783157561519847567569191284784654692558665111557913461272425336083635131342183905177154511228464455136016013513228948543271504760839307556100908786096663870612278690274831819331606701484957163004705262228238406266818448788374548131994380387613830128859885264201992286188208499588640888521352501457615396482647451025902530743172956899636499615707551855837165935367125448515089362904567736630035562457374779100987992499146967224041481601289530944015488942613783140087804311431741858071826185149051138744831358439067228949408258286021650288927228387426432786168690381960530155894459451808735197246008221529343980828254126128257157209350985382800738560472910941184006084485235377833503306861977724501886364070344973366473100602018128792886991861824418453968994777259482169137133647470453172979809245844361129618997595696240971845564020511432589591844724920942930301651488713079802102379065536525154780298059407529440513145807551537794861635879901158192019808879694967187448224156836463534326160242632934761634458163890163805123894184523973421841496889262398489648642093409816681494771155177009562669029850101513537599801272501241971119871526593747484778935488777815192931171431167444773882941064615028751327709474504763922874890662989841540259350834035142035136168819248238998027706666916342133424312054507359388616687691188185776118135771332483965209882085982391298606386822804754362408956522921410859852037330544625953261340234864689275060526893755148403298542086991221052597005628576707702567695300978970046408920009852106980295419699802138053295798159478289934443245491565327845223840551240445208226435420656313310702940722371552770504263482073984454889589248861397657079145414427653584572951329719091947694411910966797474262675590953832039169673494261360032263077428684105040061351052194413778158095005714526846009810352109249040027958050736436961021241137739717164869525493114805040126568351268829598413983222676377804500626507241731757395219796890754825199329259649801627068665658030178877405615167159731927320479376247375505855052839660294566992522173600874081212014209071041937598571721431338017425141582491824710905084715977249417049320254165239323233258851588893337097136310892571531417761978326033750109026284066415801371359356529278088456305951770081443994114674291850360748852366654744869928083230516815711602911836374147958492100860528981469547750812338896943152861021202736747049903930417035171342126923486700566627506229058636911882228903170510305406882096970875545329369434063981297696478031825451642178347347716471058423238594580183052756213910186997604305844068665712346869679456044155742100039179758348979935882751881524675930878928159243492197545387668305684668420775409821781247053354523194797398953320175988640281058825557698004397120538312459428957377696001857497335249965013509368925958021863811725906506436882127156815751021712900765992750370228283963962915973251173418586721023497317765969454283625519371556009143680329311962842546628403142444370648432390374906410811300792848955767243481200090309888457270907750873638873299642555050473812528975962934822878917619920725138309388288292510416837622758204081918933603653875284116785703720989718832986921927816629675844580174911809119663048187434155067790863948831489241504300476704527971283482211522202837062857314244107823792513645086677566622804977211397140621664116324756784216612961477109018826094677377686406176721484293894976671380122788941309026553511096118347012565197540807095384060916863936906673786627209429434264260402902158317345003727462588992622049877121178405563348492490326003508569099382392777297498413565614830788262363322368380709822346012274241379036473451735925215754757160934270935192901723954921426490691115271523338109124042812102893738488167358953934508930697715522989199698903885883275409044300321986834003470271220020159699371690650330547577095398748580670024491045504890061727189168031394528036165633941571334637222550477547460756055024108764382121688848916940371258901948490685379722244562009483819491532724502276218589169507405794983759821006604481996519360110261576947176202571702048684914616894068404140833587562118319210838005632144562018941505945780025318747471911604840677997765414830622179069330853875129298983009580277554145435058768984944179136535891620098725222049055183554603706533183176716110738009786625247488691476077664470147193074476302411660335671765564874440577990531996271632972009109449249216456030618827772947750764777446452586328919159107444252320082918209518021083700353881330983215894608680127954224752071924134648334963915094813097541433244209299930751481077919002346128122330161799429930618800533414550633932139339646861616416955220216447995417243171165744471364197733204899365074767844149929548073025856442942381787641506492878361767978677158510784235702640213388018875601989234056868423215585628508645525258377010620532224244987990625263484010774322488172558602233302076399933854152015343847725442917895130637050320444917797752370871958277976799686113626532291118629631164685159934660693460557545956063155830033697634000276685151293843638886090828376141157732003527565158745906567025439437931104838571313294490604926582363108949535090082673154497226396648088618041573977888472892174618974189721700770009862449653759012727015227634510874906948012210684952063002519011655963580552429180205586904259685261047412834518466736938580027700252965356366721619883672428226933950325930390994583168665542234654857020875504617520521853721567282679903418135520602999895366470106557900532129541336924472492212436324523042895188461779122338069674233980694887270587503389228395095135209123109258159006960395156367736067109050566299603571876423247920752836160805597697778756476767210521222327184821484446631261487584226092608875764331731023263768864822594691211032367737558122133470556805958008310127481673962019583598023967414489867276845869819376783757167936723213081586191045995058970991064686919463448038574143829629547131372173669836184558144505748676124322451519943362182916191468026091121793001864788050061351603144350076189213441602488091741051232290357179205497927970924502479940842696158818442616163780044759478212240873204124421169199805572649118243661921835714762891425805771871743688000324113008704819373962295017143090098476927237498875938639942530595331607891618810863505982444578942799346514915952884869757488025823353571677864826828051140885429732788197765736966005727700162592404301688659946862983717270595809808730901820120931003430058796552694788049809205484305467611034654748067290674399763612592434637719995843862812391985470202414880076880818848087892391591369463293113276849329777201646641727587259122354784480813433328050087758855264686119576962172239308693795757165821852416204341972383989932734803429262340722338155102209101262949249742423271698842023297303260161790575673111235465890298298313115123607606773968998153812286999642014609852579793691246016346088762321286205634215901479188632194659637483482564291616278532948239313229440231043277288768139550213348266388687453259281587854503890991561949632478855035090289390973718988003999026132015872678637873095678109625311008054489418857983565902063680699643165033912029944327726770869305240718416592070096139286401966725750087012218149733133695809600369751764951350040285926249203398111014953227533621844500744331562434532484217986108346261345897591234839970751854223281677187215956827243245910829019886390369784542622566912542747056097567984857136623679023878478161201477982939080513150258174523773529510165296934562786122241150783587755373348372764439838082000667214740034466322776918936967612878983488942094688102308427036452854504966759697318836044496702853190637396916357980928865719935397723495486787180416401415281489443785036291071517805285857583987711145474240156416477194116391354935466755593592608849200546384685403028080936417250583653368093407225310820844723570226809826951426162451204040711501448747856199922814664565893938488028643822313849852328452360667045805113679663751039248163336173274547275775636810977344539275827560597425160705468689657794530521602315939865780974801515414987097778078705357058008472376892422189750312758527140173117621279898744958406199843913365680297721208751934988504499713914285158032324823021340630312586072624541637765234505522051086318285359658520708173392709566445011404055106579055037417780393351658360904543047721422281816832539613634982525215232257690920254216409657452618066051777901592902884240599998882753691957540116954696152270401280857579766154722192925655963991820948894642657512288766330302133746367449217449351637104725732980832812726468187759356584218383594702792013663907689741738962252575782663990809792647011407580367850599381887184560094695833270775126181282015391041773950918244137561999937819240362469558235924171478702779448443108751901807414110290370706052085162975798361754251041642244867577350756338018895379263183389855955956527857227926155524494739363665533904528656215464288343162282921123290451842212532888101415884061619939195042230059898349966569463580186816717074818823215848647734386780911564660755175385552224428524049468033692299989300783900020690121517740696428573930196910500988278523053797637940257968953295112436166778910585557213381789089945453947915927374958600268237844486872037243488834616856290097850532497036933361942439802882364323553808208003875741710969289725499878566253048867033095150518452126944989251596392079421452606508516052325614861938282489838000815085351564642761700832096483117944401971780149213345335903336672376719229722069970766055482452247416927774637522135201716231722137632445699154022395494158227418930589911746931773776518735850032318014432883916374243795854695691221774098948611515564046609565094538115520921863711518684562543275047870530006998423140180169421109105925493596116719457630962328831271268328501760321771680400249657674186927113215573270049935709942324416387089242427584407651215572676037924765341808984312676941110313165951429479377670698881249643421933287404390485538222160837088907598277390184204138197811025854537088586701450623578513960109987476052535450100439353062072439709976445146790993381448994644609780957731953604938734950026860564555693224229691815630293922487606470873431166384205442489628760213650246991893040112513103835085621908060270866604873585849001704200923929789193938125116798421788115209259130435572321635660895603514383883939018953166274355609970015699780289236362349895374653428746875 +86391617809488124960608318740159275265498323596782759161693937448741870629955503137178780434084967514367416506802913025639497559552051870388547845728812610874133859341867131143305222540691470665516281930037646222263014920710489148357613800264639385823850725391990969678225562142614515891818856143468670464935446854665538274898407248669782797147190835875524343198257904828924213192423166436094091429816470043275067217690133625422738179870318314889917899468681383740126376880066807240245862277942745366001846621941044073483315458747498049491756921517996959726046905743179258284589556546378190004662030374966926777613892276603513444865261403734239127679073370984149633778514512445272009126187995659060552674497099499991189265928646916223062178638854131027720406343143645374534075679342718869937062565763416175806763506903624554633407426157646702695268599891815363810287000278474826663893249005303547133457757517437609832253279432382191687168655452097538789312997286384274170065453313034494247809778172108447537586680513365438323141236165037058337991309388747787444694302442210452520138624736570601970535466290963332219806256885615644120834521101047984047181472444172642062942912350909215924173508127936392262412694138362912034698534029602874371349686312645232853996957976163258772472985304034401810599887432335221736838719270283821174326132014143378618897543737530647766954485507101953259463412403207876080425319530269850147848238403593207706143511226987997665125478359120826534307134449329434042881949850023769389738133684830431861695463185785381153636314641651921527907513630065471177134566196342784943941683758784136080537245930816907032857330995458432708878474930245865704889101435288873790979286977089076246151229405434080353764702356956481604608591294749061106715817457735261872022340875520219757677438546033297950413253442913378312381261840320064306093429209624078106284893447313130018324126771447021965237618221531649706300589588649047354665816855013585311360083134754152394507729753906869560913454153783164553183232496559915866730081737774785879760196572433426073987987833420481720268085560040205888529950221419202006931068266703877812467275405556015147770039985743358691859456184885873339803049514638803377810038953611968069882599925536003920105830690413349486511054851281382362208659273200017333194060536134476378029495784158033549101306300166777069296528444835714262602271833606085412143030908605339936965207061740300452404886399066784416715727683825937574376122653190607830631811670742129070511968502894014955888272154858841210260228953116936794477521811516547573272399161021191869929296273598419968909634316338885851213606344211310428884266037865682896451509904477684153824057371934957871068265235573428144355686528070175063681402613833189778005057437359709375318197838949838474184672784242028595321701572448959915657988186638015280501953133315692590089769572353129496237832301867518335222933547667689916438863487286929436939765986961368381159054807275234877196870547093178752561812529838144811693171402880460849631575464022329195973574440958072657230603702038852456114852567350637252192188739854859055490172316463142654863087677482632594349356367426241455488330506865993778315054522396406104921602936133550061252024956556234835030993188819156767534874300225847133237663479548702410522940765043534088621497103337262078590010579548147363232752891706169013713473842118751363928717634834490897128262097154784117008147460954184074337943389949991358075647787920432117440928862549642418537745097224828362958917927526326932054091380935051870102627562454057887229338190092427755509705760667196302471417644534221609511146848351280732791697294750306416829242854882595278515971071555101941785825346938092293010694329968559988024833272005004779230087804497110957963594115974750243730708007632862480749798043719266772897381217593503430439873983918165168261839640694502091824578525689274811807319406894273775319394389133180915242646080117455988358970096539112307455728700473522500852134296990104059526628563607590236571773718087304699511462943566781622840893405003748470582759114000971955318470495069619282307604695834239149482009998684352653464770530351484138783900107105879104944040066134553579001701204669513582259935226942467624082085360525607628273346754479067347096685944444884764939352504754336914864412681923247591722941982198858453434466090696180747006702709063466104567114203631009310863271280622648177254659027414937523366742067515636843302953138299913974157602360662851153005113792688178623896037486033726440697972770292634848265410746527459383931198680817545485498942469612819309522677193170219735983367749469945087051737683897680106474061563189164254822181079055751818024600344632142045136481348197353754103074504200251441745223957646125971680361956403470279083044732203501839798367696489434312276262178552717014254283315698522941126463745931097569624660352390612648093496467354108241738261083596712150550578478606995390804104011722834769872831897068708573191320670423931588646375200914988178240229516317088683298891479658240748014570873772849012760702113640079639799182210249085149700525324629324132747002079578102438578402171666793394590554455943340534487707963771188610498523187755045799644586167684088056107171970597882575881256163531876806117774379599004773623712811869089617251943939369330585160382125801953458370847795742417368643297511477520679725269418131643610223375709669505773571004996235783457301360941580161314660369715584780305217772742722143948123041635001121516195567806875993358177860898835933212092035701710563825067855180566913493796759814673212193104828134147908779554743466524184190135327403035785470472280891868531158703651246356545710611980416977241381573826864163959201427858427235545429757452025357266037154051532937658298050264342134989935801353842434458192796384339037205054300480389128627046694578583909218742172850735600804441819501137887585645123698620572054452389316937664495214096644842105411526548610487510957754126925831595832143034565470225511124731881255534338004632006069640190015122034757048299518242312531191581328142191448345438130389978209071710993949488896728286690341137363026202313621323614096465717418351085302380547260165251808708143637381182568878367961672764429978462802943968574302226134572909943397046768372792613699401327899659281405612554347170474539407279074520803480443363454095715850796149288331608502522373998887499093369824786970028409289815755045330491637973895369994296399826632932922589564886072067190505817419587024164068923768106081827603263857989804374735186257788523473239936171608865782604717322567888235412369561667469163580673255215257568015075052632636146329059661156264244675785882758738660961344319890619120833753656525652236977906323815830932586059557698757515918455062863750413704348013156521641516052104281364743090760249429509273045871069747982051917325443758192819302168715289796654069062273032958278466717617569783045329127551936424201370279134038729674285823111922409258250651879292838216830669503185162359201649936990829343163509593096427072341448323883539249596057729788396903779090877461840118485036038333605645958130102860543951487754249671669571496690450527460538572583022416163264211557452282846202040938845592409130513717077010291900185753830922380999867084182983960117775992932734641627150864920451453110889060423935530013431758924430974801368883507407757734145305725526211556254721466467720066857198081651671897453523527082665511960940285725794247067819163081369797295928154121430723748431786824576850355580219408094553821054272893848435163185967853476191166193207812939193543063324740578994914555860972993152031624503548872267845726845229140212757127116930849052462836684634746410884505229948921572900587351985971148768521387323307715884776511738234870389960977578920613975789781225099235576053861424136270347279250433104816389503732898259497802519258652515327490730782833374498318687986723563160254370603914870966658385553974563323993843754925717811317650307025316767064088105013892267609210664264102048091859071991363691749013517953191631211836750422764925387759521255073706315022304727260799730368073971980805776485675285617940492390140347635257323698331040190269629640803921296656373645021385416897672101946112782619250702262152593124541358276161125609529438155113304952468789927780106745839228568042774043309735542757297022420487487412934381740044927674895120675623610636094588819104848472980851012770245457449547105931997368379754754249811005018212193607219183676492971103046904019978489872006356766718894073817790589202183486710334386437685630938282994402396882348193338284985573170804840950878733138434762916485983722923778124109961303860169481917122305765475600012349248552543396504343070018140560441117993586961385988910598034680118346525383596024355134963731232826135142835093190584617176214557276231597250049511726475424606921101085814676642355433314606078996686202964124847202650630282340459157883077000079251859608694062107577123768032410768704558568699320449681797237866666362504915746487299837753573633333307424072583319986851848451747001953861888352699974337386718868354962343130198505766758238703835244190630885623572628181233509202019272239780343219223080086811027188764191013922997719111274999491717060899332480794825713505840499425744694266776156689091208200208990745323381810321645601675622169119144023828191662132205057502642635719735244931629835921407760500162258419905430043371822324200863508469775480051358328398178661214045843796681021496878853973705349517148323100017258338582158437845409675183954418359796556743537426151990806370776525789830696288164239693235522373006704988120864434596911509571529525370282659877711418022459564559994565063563834190133915479546312863069624136765258038957544028259810448156487022412129168535659228897129465021586684239410674329099840167575036065595774849125473354628817341189814574265759740215386613087429353905500124361361322220921947318044014731939666033637066767458880118219445907334660441128381728281695021648882817271376035759418306398933568069827507754844686088469254046015467222194986727515953378357283936608214829673145198377171650957070150209430133636532052729616649044102572638857291121598554183984206320166161460078461529430639847604795291614364391218795794922085516152324246861788850797169961813397435956352747379220060342189342732061559785266155219926851262102840082200317621475316637888807194798090946090591502515033627036291948287835349814637570305594337014452339023583504914225477035062968226098968863495169877999363138372390120835058285967083402452384844154093756808456553500446874483013564411249354853939423315579783799494092835668094604141550836817978779517181321408759292765945454813790461591508325117389486089416838442380771542719215926962901856914292495167676153237388732500001566631961681934676063082207198291326207441260346105650461337313505112555838887617386073837160224092775990276096675031874833117914551786672284151020824869882531367187959364701522911663884566846577874796370150183823195607359435505813900164991783896162374627309014541595965943953217137402465255848473521497481977820540488058199139641887855382243570119750397818407332510434328400202057164284811017319978923050293812811910397180085124911249178363735339373814627400390210015195068750531099401352316803369272064771307342700308915060931268713556060632764342152245638626069119506824589668935282720250472299241933584792052734124507376559721479332875647607780091933086818674969611351436845417276514659597737148207256750432258477391722370498763763057852364880856562758103601091188786991975525576291759136121421047240359842415411786964339415720777418732786755530587835970842498225826968515671718852019511342896378666891591817872324493883685509919175808998323852152675446485340020050826485415270204743326768268613659254922073531087252460474396657944022129960915736177299626458124285063893345047291798282725476047247559760123037079952797316830439814793881405817872695451661570634794251432213580319770750488568812569807783281984904668252068263042281466759744246869429557328155125830569322604815029795215691792034811754048953767416928956616208062670414531766146162325295091795030436121112184455920859047115429459834797046585340655086770779821076464234173051386828497539566205627936823417555997467085412145582243327695153132650584350781243765164179963353530207305736622795491922911753872629430852200734301710075765493712488215504773481019118863882168343748485515261091545040755531225789080122313853784005777502412904191707760611518013799039662977695839632557956151233227793943969210404736958779651380732333898035362260865401701111988965595174995535074536658389688554746305219206866240745479095525342282556770193441577105841489903640125077864158255529366387431270128328492308978725083072902191534221777462145762834828430678649503119786637325533317072193260807986462985094778294837981682302008399491930570495083987476235676038760272327997801840300430566304352085149732957331258801828586285820579004187990984259669844351147109556599322347861361245793137866151512179920126739698094104741077233687321525822298530292904960115573398233314505567167687818385961670457305640333207364966296676971338504155009944656854175026777107065705465957143991643827558497781082826807112069765096872035523854153209461885363043511221966680320915240137655091749983746837474061145179767515183936982311577948284419164041918375234460325537453546882218388816096336476688397568593335416943201534848672493506560071387171088058309675454603060477314219421889075765739053581357964188126104897817648628673044000898467546023669615427624851377967815770398303280936467582126894692196063822308148430350394894208911723397170595973108875564915459358749992760296739342174349538228888430989341053455429250668307235842231136382485518388805776889053504085352206145593152926741505497606094351694402400010103533411685610651050209061138052252838975725467824630424933553579864260239445730683061085100988809753488220053820587522722080820431248991556582008452560809442636954053017779689009350075183099128827930091730880995063726815435986408935574184481565728709745571816004522633145399709356222472451863925601433945582980875162564019023663606623281537624406459938073226263634783836530973675033498974803916096419620717487333415062806913833932251096335784624709063141072836864676054363906444092052842257085800574527587928663692065543899307757920938015819507912567629991978406040520226353210077911238747898581551874233928623907179520206526562670037616601659171905262500220561942089641956465590938150908643056934644900740872995612639959966200801287299316731154844822520263369098395851996235844173197906509067985945936452025905667368290181252665579744207456322482835128987895444836948952665706289458444206330096535500793500146160570659637650227441755967405489001968051277018819543074129614200263633421720891381754180192634547350681359209926140734853769512367297013339906319383527998241848826891775279343584940075385897743491166044563829096432179953136691170353123579706823248915543252913351173629922527896847750580839004177431959526449935501165967143024532625989940650715995888531526665342929281216650398790195762648503497651821155408516672071854577917807473113566188980576062140418053097864056803517356309514002768002269382638045770115816442203802894363681730187129077037011832837031169175822942608989513311234164426659907151224688888274493590667969962807705665491267073066772192712201301459930896565654015404561468477883906612346758724544094063531497921166418786881377572404906798474889972359185952559287216146129753580251542245903385750680311710796307697697538553858862595693680775757796664663533664152520890270366618887905705858104693577416117729341183017892035877581208208737375977718056375988783455813704348533774729310546692908997740348121354970856695072478096575302683157924751536198974477905572794037229573092915778567383641396674498815613659950868325375903192592166095550609850321976761856140590690371310509087753580264641477226616292369481441022294937885620436349248291103448686160279894444591096874238973605355031125972071388534061573700678349164125819522945814409140362241632753610994463811882591985121535304658980936675244992697756417094598990904682499034292192392582125202555250730891817272048404347264534186891188409594490919717211163697254056079049740357338850225440113211098228763386019316909010561474222252270919468162276292743387855651992083483256084963207692130629707604850046830943694269695141881658092273055885425354024011681318523407407307992479721279263869896207728467749628951800026079038674213822265436200441140857099926596675765309998829599029231138959761336550418913454236179858870121164635641962071745868774738148225087667400971365155407499417008731817753408115952121654435121541157113781812012506404456875249272001277751108003323732202289736119350461448798242288590380058101216891487325633349957121561087225771584016267704228131390448296879740957382217399146002369049908783530275660793849485128969007185782515488395547513342169181736368536095337750162712522377454474668927357796506881957490741693200438009176467025512888487749625522071704147885289075694417513969809222071410250466608398099456715891638652718165196711062818269933641527315900616126740005341222381595344307775037803829567640701650992076074859218751751684808661099563191668439562162545519709015309777173238031916239791600643636555279068195294482165728173457192921319183996026702735881594333444284421226182781271826185527370325940168008224555990070053975421133955335162605090389294722018930734405134003200204336947910002952860106529001823124185637699084489820717600637338649495287191872158754457047471907986293010473144946554743803722340641390514554629402142302069003104741355273681013346850415149232076538182243921553026695966033885734660418494158120078629809109615960567914563798717307257629688318546194033642271024899535605542286613944718308754356430019523073633166617946447191292827177384344405475614816917585727115061244152934316911728694982312262434796256220196448846861051071569998624122745958813731732644765452681732432825381069952626548495349480095369410951481996617355631640220284127277763673456992174737123675034539306475653320230908568827165652343651336244570190738775477531957003150588842184233376355404217887556820059729051736783895670685221520216425045144861739795741334241527191579169553319045580890827309448299383194395331280904943089572350832276300293065054870457084460870206861822138320737455403257091512618492111114974468103680007187934556632298405027684684747548227130776891701537582802512555409970177049701830592973970528330784225285303150289166688497622714281956527148316445176806069106769472868705559264007756107137171620680187393298363751290534235146115308046062098169336930774997155366867317670467185549256406586019861053574424688894977696788768691547092638006149899573635162724633575330938004487634031318038192923018836426382701854059909964764525599601783033017724399119463921891489062259250359598507798778312405447160298489240983422030664931918695842209470239177329476910225077955983722140096730615990361423790937247681255065361604562100483933572656679052241169296198744666516331070472800093424137134612249848888939436828636908088488502015131969918723213716743515481812928179172413845161345687603736073673257587216657287676371494525521517796019409307250180387813212225769513540004638009613901731137635897505726043945870793194802709580503104489636608907745312078456164790778807584763560717280681183999102653581080469732241003256659566662000644111650456659227304263651233010498036666712610244224490922994871983998680827073201848451323596952856430131643046222369365113989817445964538728193721487060600774186344731462361234662207731440083802551216054319559628127833531820714362007318755636050038330421611669150702795475685985199257198553662521148971995942417612723964590612796122991297677558622748938045205099223662030565159427055742817182265874992584625083048148395649776239129625422899275514297106041186726653498946182121569919246519669133290588920604931218043727146020190425141957535111803793466461807226919542343148130738717850633273179516391442796645628196262045437343732237813727380802808864168462246911351906971734620470833845053142706889956273442946947086863972333940861128541888396761914409718582767510277489001761922176147932370041281323408212550832005698591542371940420830874789555739566522721035377279840129499810198812734613439724111633208517809299978962377782050000783318678719955175367117518741108968566039911424204954799658914478891688888887902416711759321819119274683684363511136639141279248816957812834560113980491157454717394002086468212111392452193789957348301211277854503693545894139376492526113088611818450136571153964970796078844869644321162119739290669418575353887865180250938853040065134520895660848154034832821415034666023895388705537612629361124447253239627770041368213722542162682661908996350463032195542772486974155941713913064531792715034765509837831840504775004918046276255077455476645087664032394117501671426065979352911963475883648860967289322802901431167208183198299624606685536854661942866758318427963714770747300224668687185932067890029701988910742665054949274721649340029965090762787616021673707650790227068199470173376734791617102322799228400825782637142282713017845028958178877301159719017325028680708434169703531285646267835917529670178689017217475801902948424261911766854130757738321393089078604278644967290599488961983424727469595655858035242892924061661516354611223639479292304047787132919250656397877904350105111406925577154144821529613561635406345229202566107699613245129589803347226092397155037514601931714657177073200844694144773367472165221014324638916332647957224792799242527081940401880206594679660377980567894008963860019162900691783294823945281493194544110137765576473346037659512978197353022688932034686109720452275882452792021164589064252703368944143300654074516229717703238105917527366151688210689969340931510117553619664142155718499138433937673559758664725537940047900456040747459655022128152758738888998585439382594640617829729709906538966176421297061948422336032656603115913916502538530806539977680579643705936526787510100536774926544010980317455475588587567473539479687364553711721759306152498235126743584675828922814203168102661043995673196489261782052539719890422936308203388710062973854110619597927600115999155260060057506167532492827036417615053562191567193440355059828764310589785588941377161879969769254803939686820690316359711942142416854811900845137229955791223302054344979902991074995882899388608128240821256484715102404125073673680702797027437864223650331983285626563097292464710420506829052700690992087840073668033114525263929444515466926235325557676366353086279508584469346521383616765675214539157854189272101657179690583489367982763027001655527807862430310606309524346846447591247701441511128171647769439049318318255936741580675371390662085379651193936585420963026858563609860180929864357324661788962358134544060900224067489464784626738433768952477207116615758604977891974264196667486475523677347998380057492852492022166864542083214517267780709578013121467203100897539704071959337050146009143488195520622511925422622143225005741526829852638093416536815205083353699473215307036669522783298429669600164899239773114944464830872124667977814242926953856340029185888134096530845313520911457647391868573115136524405832962275741682620356099739091284680490204849191160260700758937560354400380102629408120608211165674505426971955600215434692911020847002876530495840035219773287016838172275335604138455890203371838896676021578789752387614791032623365218615942732728798224674813745455249260080680296169276663816097584682397446535989552095023914755547684084500213257939433721136577128130619593176397089311888507032610264031324194552085423430743172952875387431511051225201623598629998855398647236864705045471473761566438220787838015350032099154116117242326133544713102237240701331156984204367679552250701589358266961116203044229512352348726668188086630759402689822915601573571071728953439461212642969467192168261046145423661876022087042255954995186550080278980932099736519179888112483721466570118199016274168544759913402173528601967815862226349056308598873061470704607436853889519920518266511348803244961980584123841215349054364404715194431058644377143805842840337066715290618589020323559084005341566213484319233035958316112590359563170876965978262092158227231031166826881939493863773207392937017402697592225018983070955896580711464283823811593823825061262531756702527915910654611144812096200820952969368580944923981187105150909433755993586987307207209555173893837158436170650759282157861234814711397056122509338299425048859494774668710465358314398100920364440110910934351529933131023905062933071424241492175720027768655935545397557208258739890273936680812220853907531936472261799890311956163945186008623016934167954392087756273815330371976212806458086137697216790592015943055993310879567191475647092066182100446455688339701252538322258328395741517956269734015529240124561242940489653221263065661010972343323232257746310009605299305415047777916700658340638778022362350826141835206349979008771079856537852294691640998466979646696038038811363617686189311440973710895810983169371596171098288867559180703859730811442684471682250482661321935624684066852134527316840990898691875270317946817084870603460098341255711675344061633801241415400628233359610197829672875291452991479474308905414039537121244443365596341695567425873370791366134585384444800191212678381466711726559689048780765193677057678376614020836019635265839321931481319096211192144686706818422310064172560653927237945810709200044521231246078547777095562379159802059745859096840990292033038007708622162885107186000447756400478492890957143575978364274378473595098634821793224318045250297952996370145073255657312702497799848789291843294798455669350105228602395215074400866797688907938182915929102026826574633914199314363614260403317843549901625056698545968009379026007135161387782536009105071672759702329182190865546807006334707775010938749752013853092082006394305491802524508729914736696086410186182409590988054428760009946433724388127356470618198532427942973434863605893931433086444008868527675245162410975054336835641751460751711181621941738237149631522263312192071653803243322926739170518302989359866028413688577615201821360685560970590055738438451813264270953817965721509244485904462567802865009498077190212704137360720233072245994561876633455254770483569760173520071771942521169001020085026852453914921156320915551401348779457438306251837853048193112986523190798482256419796872820162100148332294661140934771911261638316817306820603568111770448276551591801827689473230259044465380515980907386856806319179258960122378037964041378385077814467687142356538994566370211784170818262554138206386887579983532407785367002212632708390716327946350720046384794608870368796050959555721823765875250639988220237030955744825693670464384169947974470184227698439880480330627192276636154129643929829010652489464527746583239462135792039896869227478071572461123828257152441213103270205999701372380053289510146535803438964377145571224407411100712669427025442520473228618846847510209247878012043406122305812561699203097751638922988074721196746483766946097179121483886490966539513807374129767123935996174925404413998971662760595951359596375637064053400172830551589877541654375992913260090936755709143107433753105882893851431880662254239813960958698087855574588809335798621457738009043424441015517393069231026914564186921976040401600119075692555376867445421249017966729948467002453189991968372448026897464462718163142168645227183123252303379626650134219983226448869803697978590522429182061106882129321647999144608678150197445650874223081217250411553556621751595820945057809690280214927369803997087767616810712390493358095719453832621031646604474981810547960006178608178899750707655446480256230795896536428237160171648195456545668454337774276560868749822964442766300621015540830164341438338438225995540401620108165713725404236588241609965476268328280899656131062161460281153982306499375745640638144971406282779348932865376579198297604581948861594446114221347493188749171296745899421179957807630290719889524234733831910023823443554458261601065553281499317776535173821664016652366210610884637021546959556874325389358779391454645798055141088185843553135075720575377323235398467373167604899270769112503993232393790778747063477696717505816928534111471953238096523058569577559634184585294841271978336667224845282727285899747353253350830654767667074597564685755666745336924262430296539460916326295636994310000682600237436985776866029736393178421541401711830631527343317342201407561028772532833772983523657614678769458922694737230578522069646923492970584620363649983538137038367166115455421449742852486364421312750873894118200324833415827702820659205753993350094142325974729452541658469659400245581547070624371610960810571475553953439295742791935283391632289391851751720640320940962851703997766632450281559585197338143547102808016431311138599733804579086988417052760571753209911006113770592555880621407184342206769024469860544041439986001080208435860567111960746709433190524473871257313528691915097111525074370527761195523277746882205259773238949535201874134912655405762268866977571880510070422092369083152758701780798727702427070791290084969169186759791666237623310983254362046836343173629913617890513689587898237582285027323923764436207136447600522079632632984338285429444520261989197013425721809710853274870815998583389076965340733212010994915903001331616197959954481743523762723519923890767016825374843754252662493756025336923415861500676816782128364013361639559129981258295831305657693430231547206243831660553069105008790177286540113521078416487701623591555484766511311435033911362916128856324824384399710948469669964851816138672384830761272318164126842443334425790345904772856470953070303769279946921667065377609710149983767130849080143591308986680247304134511101721215141668015925336023407653895540325570816353348581069207957254657277829830378809008803256739084098636848250813710130161459596158758089961694518241070882308569410618218264221245267280982064617280201160765856114281135611571815224536611584320617961642521861357263621921107371010769300194302439596282518730231526033034930575952585493071677328671174804978528057647190746725820152493185070526240051933677648014743832641440274502887921797860623539224384602609063644330757804122799273877852247381258648718601339379736770225468581060113452620313054119216892079482832729555514429540214536708158456783475118558098862533961270706962151603657777875136944545158092967368911042058592178671070714502351375587110786086658533530633558079153426891646160254946663655457965105467812707892552126650556129573547836696659497590753062266333477728939768299466575355230537459776810331331160241382234944281672214161214424647484193059351908460507023322555586172901656591875054331943027841514117967343947748871410719335697799863808317563698628607308253706052403380405140789040772315627250184458794440402711657896688238191331438478578414877746647407060376456620018848764394143877769435494189441974579121839190318915362334959374249767494200155788230849252868546965400544513380361199067171549892498783210616687219843774427521724327963702571980256492170755390227449233918500494585054987089516247392993432150889198200381782814403271431170925677409514331290615968943736603875624049852585356166180114922582145395825332958109483930170500856598389732551911557687193598803145988159888078376701166758564149652356826377840419093045811266163744870066666224180506469587118808695058263490374836411157903873377639097620214808164215338083869661092386528488089931745939443178542356757566424676408282723683254366240644309981516354725066550444143000207401603122837341117099904525688157402451239486349296944267643967561682713755456524067383016245213492839356335176511493611596557522533095463115188452529829843422712978092461672084541889794591695439977776693443491008897071973966140333444081967268961968845681656079579907252183214319745985747675121376168508974961819239115727730828723992602274783557243979323536896390406465868643457007472165970967145644987186955239230882840874725168573235503612559755251070841934785165149065264182632491492843988407067539987068067879327954661976766635244079415404887006065088482803270654049969988247570907753508027244041377685005096273474155986165808626742208198410687696554558399751075890535037088686062493271342472431449343376247130707073213546237332081187091809353759305327934530063339674898284686751083027484727907372549768184980698806497521442529263316283992174264087452072046691920267855102202320709567126162295188040787173438870226332554974092183449479538450925005769250822114889873106724339994671856586347717931733386023348483494103031547045940320844732611809857277359033762554413800731952126257761960629461695267877073838628733000434941658753669104444625859254841732797978134013857080348028235857514929619342233225111125775913404506222277644337050643209247682137012221060563915742214373755158839482296904823957582488775558060484558623716729345810780846331679207444497809769460950144063930392231688582643713481412725686623479129844553733462329364672572184779930699162053656929858859403870060203388840671662403107190079760051328295541456145724615168756919459873892574147576272843005275040492894360954149293884353287490244715833817011373206738973136373607859925942259081074525144248580786687513199026914658311236376970889528643032179439303436860121986573873979920396482082593360782591341308548275314836709631468177469721884723057657233927108627737116775966164774465973027449755695357444287555359404381594756073345514798055956810027847927462763477840239273815059331739599435497770590448953826540475199259024855566858177727516719261947776394509262274914498556843621279619475681289330176312318997965657756048803963845992084017451958116442288681720482496850129661679909343435471608028380555654460040988871132394375971855251566533797354146837875167239510249731887872836475506360990258217589707503326740817631201552332719427777506072401392106001157710559783863234349416285903156175047845469531621838436699404233262593522503262828587261780945357124195006891207788407245637969551577590148125609007670161949526711754903022436298527198586267321934654280038925723406389573273490499360149093300653356506402015117359851842829116301475575273093800344435119537482307204005823592461801847947945098939361458343689169422254693951203894919934952530689463276558849442725360335832234476004061435248699252446652391967359491750868287604232604245212321058379983079866972443688457733417690463530311429385430110241585593385713882119129412952610508558263931354089221872473359113225826651573714324215686938751879245423144505040526680333383337452802368529138876098246682998842950932350697632474267049196979289695416628830901797446351849079195431576553123710635438449974564199564923702734037161851818097997030547121492333382757519685845712145672325437613350289133890761950397281335364079107519335370350360004528433413777606681157520696245826642703259542986650338014745243515933085439345782199715933077494965128062939833220837478948635265801041201431146949831741025185571011421047572561898905830473128681070386735624407328057016111062651917265444200751818642197632217316336452859242893857048467171496535871921759589420891319938688204998542389052432569464477965981795626798453209155753050282143573757875422839756525978740067558878394173184554739980816116066968874836670028017885332135718624025978707925350222280817736085498132275532355885931587048100376511426872476327757101181976957689361000211337954124234078819627262227689040700746648698443820673041743818969244994195633022969907173117411014544459476753907157577451757815276171900365962044313789626675278303256899390875390386911627550005882799501728994333419948352573935798314244406789475314481357364275535807006399572364519059206157894335611585373120347089886547070268301680900288364999157603642498491130225241279942583271550323686378668740835331545831788609511513039521147272325433500095425257937574726314991736193877226152268195712702576964464788729845192402641178184197277886804636312626729313901118619524433017311035160005904185949963081064927855322036769528181978317786975091837893619394545480241578952793710856230054149256415615175866032857294169731508325588039162766608197407466065176252565060447509660689172826888366607344417833678526668032496153189365826536895327650361432430074634615159337696525001175767596942430237056672630297135050358763785053439188040350980418983606119692641825809142184284616427505896911075688516470740380877368527749098261704336309093910171041268578640776671098048829360361491581284543814229559429788436544932509367251057096832839589204849525017604667789392562525467768317743144920259177057020939910289857468304265616362504947345088615010364968061291928440302430179753054988686841035358368188537802036697140978480742969657515130065724520378551329310230768198421399152657990615611604691111577947462305649338901179326679898236606336282504803183385676292513423692305033210580816366039506539903319384081005409866846222375982270991317102972309039487189007497821283853610045261816964212323839629054358563725825636071724276847374335256030003348880782066786098059772800677229279046038165622824985149468947422891191667419757433645595421174451209988075069272227927738865351976480540183803462799415234897368408457856962008023747142833147938215570117348637883652118705965892208482173230002058682459939995585311282065703913650192130551708595178122805644607329156966061723545013872079514010885633868046309431488420132801122195852898749517008906336660989846442315150865379401132209602687697083055405663367163718725569607937737054014085142553783468470311313144129875045804895664687083994346815059871380353772700651997153332303007065771967415055249904307575402247319335874046704600756398685355400831780107818516460419788736486291710087310967926279737374644809406277184419038922117985716054886712993720732651399270075029656227713050572478869909194073657529871399063634647836366865194016304718191207983132257662461751361540819964894203961353691857951795873740131728839970617442333813412051072483146544004001739160390961618633802297146194509614685941537992544041518038576858263207240988327066671838554736465798941176238669397690291037697920775113424288082931872326519757177726248359701296275945305648114799639517079130616743895352046644378745762035553600985041191336031036397201195422259903101869479746838421964586157949973271545423156796709394492013994530178371135773250103828243038538185705933992851370812760079244339404109004215318993466717684643674263381888613160390929621938447531118853568836639921038838510253271679878330321727672270233600952467189715078524918476466896128902761800889137239907194692946355196166076728075903050153600668708244332649882915323507584710638911477554386389706280031160039809129461540904980192551167965979150055003799732896977773655190282273864288229990724003821255413610649004114529848239712345842480504795993715591076737834590163592374938300356322419570083288574136749580642074977191759526702556482000310308458210303969957743388036368287799814829067525720445626377245659652703388016088177577856155094795329034879144453600834908062146074088490852755810560731613442779645262194634025618841486208878335280500603481881697829007878925052389265568200155282119704086107558576771153896139053641413799388107790701448595967426377503521955544414630480431507842537832584126706637536330748345915044813713967388684508172111514119020828031809427090743556031490938799810208789780836935539096404634141953719723021957316234996825734606641764506101313222789217754928201742729116505234331181790859575883923683750385290996377817505205432368249937753274248467555543819518745972578794991730984766142562404643240869622507178371939397898842975082664631187302399703567746190001151316316328477032739770108627881996826593040166075176690635271785780737196027379681264512336929563288462870362942894011000685999245588217697838831585285715301532420283130654446876388566580623439682552981527366442051390153955855141810366808720557104389674019177384141585431011506327801780255186173129507543136661694285972899881670304086336378640678461338455032562687194966653649060880113636162254014929268068122689525897129776403426266956682169582880086329042181756074894764200436136615467663074570438293136133972596684593926263786444679852812644513902093145453361130501365088360571366020444755919792270964290237658657822242920280879171406861830214699686346613766368868572917316841520295864333402673713007976334337277697006727467084983278668798349357366440843500267090909695735924097468274175722250607752469388568947850027702936003935201052040873128479910669503625324409363666859389682289002963885799014997859740569778960972695823381292902537645512704464258526464055214677552213580923641806040893329653662479504291416887422237000481966411563609136165836422562138578831833902395187283779921305958852781330259146127861402073820696214977203150988949696060301845383332778198707871696229973321818775180833760767681160832234295216786089372600076337048753679654964802801275864972738154422126854415152451380529340386177510534818303828621698503184016166795127231878553707229457620574022274796195552822698060233348079379943721284230894826383511034058743723370805008519719937159581444190408573620434202939536513248138997225787695156477528276980706939663940107722488182935325501554442342959162848531656012402297846716680117245335729329673101712447814484117346342835884052910754989382096219714472424413055914512220105634688443505317675418804492486262358256093411230501495229935926061492467940926480910744658298906805968086325370260070149917783387033551897345974534355968226490642290139992796096559631067683585565483124248108070411241864496288278775013367814234676106615790155892833100345673846243104676900000936756893803676769777642059716492347060997973282994459039755683869105685411058885051979862321618071659608643166523833695792515458773247974295235724915183100135059940954313672345441853967639642257048786844333673556851153585056517249014177233301807239035068983866253233826620354847687722321662223383305226882245421258277211223435986491973881404168406609216954760818955479619408040043497601356464084611480778855378911228881396187039079060331474168814336581362769420066445056796904807027922065208551224508683937565519686130523209213804180827319885292805824696457556180161852004664494926234186485934292896521378574554544426221453176445385228867960454072522804961741905198550911362542849130027243353553345377968558497801959766365162905984572190434898213582212068569241211393131371321348657414408926700036655556324464997755685351468128988739170090705797083912419192306257054777274861099092451916822532682357814072123818963141147129610287340041050015549547086272721534936510345705849389706515725684266079756708385889612130516276472992631596744745949011999508491789521497159877319531917595916234240217185796967781020544965987668461439596506473322198532352137810818703064287550695189034358718163360412639767502090913354848015113595182411243263608049744737395896608759569909256138919905403404664655310556021101996525724843421071082933739200159651403373870955680756568226835379339839824880227237703197854614809323023472557966211738929885417307414847072116640441570575360458225614322429985978068323969654385552378378141386675079286837205802043347225419033684684301719893411568996526838242546875 diff --git a/tests/Core/benchmark/out/test003.out b/tests/Core/benchmark/out/test003.out new file mode 100644 index 0000000000..852f88d3eb --- /dev/null +++ b/tests/Core/benchmark/out/test003.out @@ -0,0 +1,5 @@ +50005000 +5000050000 +500000500000 +50000005000000 +5000000050000000 diff --git a/tests/Core/benchmark/out/test004.out b/tests/Core/benchmark/out/test004.out new file mode 100644 index 0000000000..fd784f3c9d --- /dev/null +++ b/tests/Core/benchmark/out/test004.out @@ -0,0 +1,4 @@ +541 +7919 +104729 +224737 diff --git a/tests/Core/benchmark/test001.jvc b/tests/Core/benchmark/test001.jvc new file mode 100644 index 0000000000..20a7770821 --- /dev/null +++ b/tests/Core/benchmark/test001.jvc @@ -0,0 +1,13 @@ +-- tail recursion + +def sum' := \x \acc if x = 0 then acc else sum' (x - 1) (x + acc); +def sum := \x sum' x 0; + +def writeLn := \x write x >> write "\n"; + +writeLn (sum 10000) >> +writeLn (sum 100000) >> +writeLn (sum 1000000) >> +writeLn (sum 10000000) >> +writeLn (sum 100000000) >> +writeLn (sum 1000000000) diff --git a/tests/Core/benchmark/test002.jvc b/tests/Core/benchmark/test002.jvc new file mode 100644 index 0000000000..cc5ad43374 --- /dev/null +++ b/tests/Core/benchmark/test002.jvc @@ -0,0 +1,13 @@ +-- tail recursion: compute n-th Fibonacci number in O(n) + +def fib' := \n \x \y if n = 0 then x else fib' (n - 1) y (x + y); +def fib := \n fib' n 0 1; + +def writeLn := \x write x >> write "\n"; + +writeLn (fib 10) >> +writeLn (fib 100) >> +writeLn (fib 1000) >> +writeLn (fib 10000) >> +writeLn (fib 100000) >> +writeLn (fib 1000000) diff --git a/tests/Core/benchmark/test003.jvc b/tests/Core/benchmark/test003.jvc new file mode 100644 index 0000000000..f3693ec0d7 --- /dev/null +++ b/tests/Core/benchmark/test003.jvc @@ -0,0 +1,13 @@ +-- tail recursion through higher-order functions + +def sumb := \f \x \acc if x = 0 then acc else f (x - 1) acc; +def sum' := \x \acc sumb sum' x (x + acc); +def sum := \x sum' x 0; + +def writeLn := \x write x >> write "\n"; + +writeLn (sum 10000) >> +writeLn (sum 100000) >> +writeLn (sum 1000000) >> +writeLn (sum 10000000) >> +writeLn (sum 100000000) diff --git a/tests/Core/benchmark/test004.jvc b/tests/Core/benchmark/test004.jvc new file mode 100644 index 0000000000..0e0b65aded --- /dev/null +++ b/tests/Core/benchmark/test004.jvc @@ -0,0 +1,37 @@ +-- streams without memoization + +constr nil 0; +constr cons 2; + +def force := \f f nil; + +def filter := \p \s \_ + case force s of { + cons h t -> + if p h then + cons h (filter p t) + else + force (filter p t) + }; + +def nth := \n \s + case force s of { + cons h t -> if n = 1 then h else nth (n - 1) t + }; + +def numbers := \n \_ cons n (numbers (n + 1)); + +def indivisible := \n \x if x % n = 0 then false else true; +def eratostenes := \s \_ + case force s of { + cons n t -> + cons n (eratostenes (filter (indivisible n) t)) + }; +def primes := eratostenes (numbers 2); + +def writeLn := \x write x >> write "\n"; + +writeLn (nth 100 primes) >> +writeLn (nth 1000 primes) >> +writeLn (nth 10000 primes) >> +writeLn (nth 20000 primes) diff --git a/tests/Core/negative/test001.jvc b/tests/Core/negative/test001.jvc new file mode 100644 index 0000000000..a0a78e1554 --- /dev/null +++ b/tests/Core/negative/test001.jvc @@ -0,0 +1,5 @@ +-- division by zero + +def f := \x 2 / x; + +f 0 diff --git a/tests/Core/negative/test002.jvc b/tests/Core/negative/test002.jvc new file mode 100644 index 0000000000..eb59095a49 --- /dev/null +++ b/tests/Core/negative/test002.jvc @@ -0,0 +1,5 @@ +-- arithmetic operations on non-numbers + +def y := 3 + \x x; + +y diff --git a/tests/Core/negative/test003.jvc b/tests/Core/negative/test003.jvc new file mode 100644 index 0000000000..f25a2508e2 --- /dev/null +++ b/tests/Core/negative/test003.jvc @@ -0,0 +1,3 @@ +-- matching on non-data + +case \x x of nil -> nil diff --git a/tests/Core/negative/test004.jvc b/tests/Core/negative/test004.jvc new file mode 100644 index 0000000000..669679c84b --- /dev/null +++ b/tests/Core/negative/test004.jvc @@ -0,0 +1,3 @@ +-- if on non-boolean + +if 2 then 1 else 0 diff --git a/tests/Core/negative/test005.jvc b/tests/Core/negative/test005.jvc new file mode 100644 index 0000000000..0e95d61269 --- /dev/null +++ b/tests/Core/negative/test005.jvc @@ -0,0 +1,7 @@ +-- no matching case branch + +constr cons 2; + +case cons 1 2 of { + nil -> true +} diff --git a/tests/Core/negative/test006.jvc b/tests/Core/negative/test006.jvc new file mode 100644 index 0000000000..48321673d5 --- /dev/null +++ b/tests/Core/negative/test006.jvc @@ -0,0 +1,3 @@ +-- invalid application + +(if true then 1 else 2) 3 diff --git a/tests/Core/negative/test007.jvc b/tests/Core/negative/test007.jvc new file mode 100644 index 0000000000..6134d2a842 --- /dev/null +++ b/tests/Core/negative/test007.jvc @@ -0,0 +1,3 @@ +-- invalid builtin application + +(+ 2 3 4) diff --git a/tests/Core/negative/test008.jvc b/tests/Core/negative/test008.jvc new file mode 100644 index 0000000000..e667518f3a --- /dev/null +++ b/tests/Core/negative/test008.jvc @@ -0,0 +1,5 @@ +-- undefined symbol + +def f; + +f diff --git a/tests/Core/negative/test009.jvc b/tests/Core/negative/test009.jvc new file mode 100644 index 0000000000..6aff7d429d --- /dev/null +++ b/tests/Core/negative/test009.jvc @@ -0,0 +1,34 @@ +-- erroneous Church numerals + +constr pair 2; + +def fst := \p case p of { pair x _ -> x }; +def snd := \p case p of { pair _ x -> x }; + +def compose := \f \g \x f (g x); + +def zero := \f \x x; + +def num := \n + if n = 0 then + zero + else + \f compose f (num (n - 1) f); + +def succ := \n \f compose f n; -- wrong + +def isZero := \n n (\_ false) true; + +def pred := \n + fst ( + n (\x + if isZero (snd x) then + pair (fst x) (succ (snd x)) + else + pair (succ (fst x)) (succ (snd x))) + (pair zero zero) + ); + +def toInt := \n n (+ 1) 0; + +toInt (pred (num 7)) diff --git a/tests/Core/positive/out/test001.out b/tests/Core/positive/out/test001.out new file mode 100644 index 0000000000..b4de394767 --- /dev/null +++ b/tests/Core/positive/out/test001.out @@ -0,0 +1 @@ +11 diff --git a/tests/Core/positive/out/test002.out b/tests/Core/positive/out/test002.out new file mode 100644 index 0000000000..b4de394767 --- /dev/null +++ b/tests/Core/positive/out/test002.out @@ -0,0 +1 @@ +11 diff --git a/tests/Core/positive/out/test003.out b/tests/Core/positive/out/test003.out new file mode 100644 index 0000000000..e69de29bb2 diff --git a/tests/Core/positive/out/test004.out b/tests/Core/positive/out/test004.out new file mode 100644 index 0000000000..b28e3e2177 --- /dev/null +++ b/tests/Core/positive/out/test004.out @@ -0,0 +1,2 @@ +12345 +12345 diff --git a/tests/Core/positive/out/test005.out b/tests/Core/positive/out/test005.out new file mode 100644 index 0000000000..1e8b314962 --- /dev/null +++ b/tests/Core/positive/out/test005.out @@ -0,0 +1 @@ +6 diff --git a/tests/Core/positive/out/test006.out b/tests/Core/positive/out/test006.out new file mode 100644 index 0000000000..0cfbf08886 --- /dev/null +++ b/tests/Core/positive/out/test006.out @@ -0,0 +1 @@ +2 diff --git a/tests/Core/positive/out/test007.out b/tests/Core/positive/out/test007.out new file mode 100644 index 0000000000..a4f2b94cf5 --- /dev/null +++ b/tests/Core/positive/out/test007.out @@ -0,0 +1,7 @@ +false +true +0 +cons 1 nil +1 +cons 1 (cons 2 nil) +cons 1 (cons 2 nil) diff --git a/tests/Core/positive/out/test008.out b/tests/Core/positive/out/test008.out new file mode 100644 index 0000000000..b9d569380c --- /dev/null +++ b/tests/Core/positive/out/test008.out @@ -0,0 +1 @@ +50005000 diff --git a/tests/Core/positive/out/test009.out b/tests/Core/positive/out/test009.out new file mode 100644 index 0000000000..0aeb73169b --- /dev/null +++ b/tests/Core/positive/out/test009.out @@ -0,0 +1,5 @@ +50005000 +5000050000 +120 +3628800 +93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000 diff --git a/tests/Core/positive/out/test010.out b/tests/Core/positive/out/test010.out new file mode 100644 index 0000000000..425151f3a4 --- /dev/null +++ b/tests/Core/positive/out/test010.out @@ -0,0 +1 @@ +40 diff --git a/tests/Core/positive/out/test011.out b/tests/Core/positive/out/test011.out new file mode 100644 index 0000000000..a6561c95bc --- /dev/null +++ b/tests/Core/positive/out/test011.out @@ -0,0 +1,3 @@ +55 +354224848179261915075 +43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875 diff --git a/tests/Core/positive/out/test012.out b/tests/Core/positive/out/test012.out new file mode 100644 index 0000000000..5396d94af2 --- /dev/null +++ b/tests/Core/positive/out/test012.out @@ -0,0 +1,5 @@ +13200200200 +21320020020013200200200 +3213200200200132002002002132002002001320020020021320020020013200200200 +13213200200200132002002002132002002001320020020021320020020013200200200 +21321320020020013200200200213200200200132002002002132002002001320020020013213200200200132002002002132002002001320020020021320020020013200200200 diff --git a/tests/Core/positive/out/test013.out b/tests/Core/positive/out/test013.out new file mode 100644 index 0000000000..8a49268b39 --- /dev/null +++ b/tests/Core/positive/out/test013.out @@ -0,0 +1,4 @@ +1 +0 +2 +5 diff --git a/tests/Core/positive/out/test014.out b/tests/Core/positive/out/test014.out new file mode 100644 index 0000000000..5dbd7c07fc --- /dev/null +++ b/tests/Core/positive/out/test014.out @@ -0,0 +1,4 @@ +7 +17 +37 +-29 diff --git a/tests/Core/positive/out/test015.out b/tests/Core/positive/out/test015.out new file mode 100644 index 0000000000..0a2b6b13fb --- /dev/null +++ b/tests/Core/positive/out/test015.out @@ -0,0 +1,6 @@ +600 +25 +30 +45 +55 +16 diff --git a/tests/Core/positive/out/test016.out b/tests/Core/positive/out/test016.out new file mode 100644 index 0000000000..c3f407c095 --- /dev/null +++ b/tests/Core/positive/out/test016.out @@ -0,0 +1 @@ +55 diff --git a/tests/Core/positive/out/test017.out b/tests/Core/positive/out/test017.out new file mode 100644 index 0000000000..b7a2459a37 --- /dev/null +++ b/tests/Core/positive/out/test017.out @@ -0,0 +1,2 @@ +50005000 +5000050000 diff --git a/tests/Core/positive/out/test018.out b/tests/Core/positive/out/test018.out new file mode 100644 index 0000000000..b4de394767 --- /dev/null +++ b/tests/Core/positive/out/test018.out @@ -0,0 +1 @@ +11 diff --git a/tests/Core/positive/out/test019.out b/tests/Core/positive/out/test019.out new file mode 100644 index 0000000000..7f8f011eb7 --- /dev/null +++ b/tests/Core/positive/out/test019.out @@ -0,0 +1 @@ +7 diff --git a/tests/Core/positive/out/test020.out b/tests/Core/positive/out/test020.out new file mode 100644 index 0000000000..0b1f3d9ff0 --- /dev/null +++ b/tests/Core/positive/out/test020.out @@ -0,0 +1,9 @@ +91 +91 +91 +91 +100 +6 +6 +400 +4000 diff --git a/tests/Core/positive/out/test021.out b/tests/Core/positive/out/test021.out new file mode 100644 index 0000000000..04d888dd93 --- /dev/null +++ b/tests/Core/positive/out/test021.out @@ -0,0 +1,24 @@ +6 +4 +7 +9 +40 +6 +3 +7 +9 +30 +6 +2 +7 +9 +20 +6 +1 +7 +9 +10 +6 +0 +7 +end diff --git a/tests/Core/positive/out/test022.out b/tests/Core/positive/out/test022.out new file mode 100644 index 0000000000..3e43902eab --- /dev/null +++ b/tests/Core/positive/out/test022.out @@ -0,0 +1,3 @@ +8 +2187 +476837158203125 diff --git a/tests/Core/positive/out/test023.out b/tests/Core/positive/out/test023.out new file mode 100644 index 0000000000..f3a9cf67e2 --- /dev/null +++ b/tests/Core/positive/out/test023.out @@ -0,0 +1,10 @@ +cons 10 (cons 9 (cons 8 (cons 7 (cons 6 (cons 5 (cons 4 (cons 3 (cons 2 (cons 1 nil))))))))) +cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 nil))))))))) +cons 10 (cons 9 (cons 8 (cons 7 (cons 6 nil)))) +cons 0 (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 nil))))))))) +50005000 +5000050000 +50005000 +5000050000 +50005000 +5000050000 diff --git a/tests/Core/positive/out/test024.out b/tests/Core/positive/out/test024.out new file mode 100644 index 0000000000..0a60ee37e3 --- /dev/null +++ b/tests/Core/positive/out/test024.out @@ -0,0 +1,8 @@ +true +false +true +false +false +true +false +true diff --git a/tests/Core/positive/out/test025.out b/tests/Core/positive/out/test025.out new file mode 100644 index 0000000000..b2058379a3 --- /dev/null +++ b/tests/Core/positive/out/test025.out @@ -0,0 +1,2 @@ +120 +3628800 diff --git a/tests/Core/positive/out/test026.out b/tests/Core/positive/out/test026.out new file mode 100644 index 0000000000..a5e1d4be0b --- /dev/null +++ b/tests/Core/positive/out/test026.out @@ -0,0 +1,6 @@ +-12096 +-1448007509520 +5510602057585725 +-85667472308246220 +527851146861989286336 +-441596546382859135501706333021475 diff --git a/tests/Core/positive/out/test027.out b/tests/Core/positive/out/test027.out new file mode 100644 index 0000000000..f513e60960 --- /dev/null +++ b/tests/Core/positive/out/test027.out @@ -0,0 +1,5 @@ +14 +70 +1 +1 +1 diff --git a/tests/Core/positive/out/test028.out b/tests/Core/positive/out/test028.out new file mode 100644 index 0000000000..fdbca9a789 --- /dev/null +++ b/tests/Core/positive/out/test028.out @@ -0,0 +1 @@ +cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 (cons 12 (cons 13 (cons 14 (cons 15 (cons 16 (cons 17 (cons 18 (cons 19 (cons 20 (cons 21 (cons 22 (cons 23 (cons 24 (cons 25 (cons 26 (cons 27 (cons 28 (cons 29 (cons 30 (cons 31 (cons 32 (cons 33 (cons 34 (cons 35 (cons 36 (cons 37 (cons 38 (cons 39 (cons 40 (cons 41 (cons 42 (cons 43 (cons 44 (cons 45 (cons 46 (cons 47 (cons 48 (cons 49 (cons 50 (cons 51 (cons 52 (cons 53 (cons 54 (cons 55 (cons 56 (cons 57 (cons 58 (cons 59 (cons 60 (cons 61 (cons 62 (cons 63 (cons 64 (cons 65 (cons 66 (cons 67 (cons 68 (cons 69 (cons 70 (cons 71 (cons 72 (cons 73 (cons 74 (cons 75 (cons 76 (cons 77 (cons 78 (cons 79 (cons 80 (cons 81 (cons 82 (cons 83 (cons 84 (cons 85 (cons 86 (cons 87 (cons 88 (cons 89 (cons 90 (cons 91 (cons 92 (cons 93 (cons 94 (cons 95 (cons 96 (cons 97 (cons 98 (cons 99 (cons 100 nil))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) diff --git a/tests/Core/positive/out/test029.out b/tests/Core/positive/out/test029.out new file mode 100644 index 0000000000..a94dbefc6b --- /dev/null +++ b/tests/Core/positive/out/test029.out @@ -0,0 +1,7 @@ +7 +21 +6 +5 +8 +13 +21 diff --git a/tests/Core/positive/out/test030.out b/tests/Core/positive/out/test030.out new file mode 100644 index 0000000000..1c266518b8 --- /dev/null +++ b/tests/Core/positive/out/test030.out @@ -0,0 +1,3 @@ +cons 2 (cons 3 (cons 5 (cons 7 (cons 11 (cons 13 (cons 17 (cons 19 (cons 23 (cons 29 nil))))))))) +547 +1229 diff --git a/tests/Core/positive/out/test031.out b/tests/Core/positive/out/test031.out new file mode 100644 index 0000000000..215125f069 --- /dev/null +++ b/tests/Core/positive/out/test031.out @@ -0,0 +1,6 @@ +8 +9 +15 +17 +29 +1021 diff --git a/tests/Core/positive/out/test032.out b/tests/Core/positive/out/test032.out new file mode 100644 index 0000000000..6e557e13de --- /dev/null +++ b/tests/Core/positive/out/test032.out @@ -0,0 +1,4 @@ +10 +21 +2187 +1021 diff --git a/tests/Core/positive/out/test033.out b/tests/Core/positive/out/test033.out new file mode 100644 index 0000000000..79e9454d7b --- /dev/null +++ b/tests/Core/positive/out/test033.out @@ -0,0 +1,2 @@ +cons (cons 4 (cons 3 (cons 2 (cons 1 nil)))) (cons (cons 3 (cons 2 (cons 1 nil))) (cons (cons 2 (cons 1 nil)) (cons (cons 1 nil) nil))) +cons 4 (cons 3 (cons 2 (cons 1 (cons 3 (cons 2 (cons 1 (cons 2 (cons 1 (cons 1 nil))))))))) diff --git a/tests/Core/positive/out/test034.out b/tests/Core/positive/out/test034.out new file mode 100644 index 0000000000..f5308ca637 --- /dev/null +++ b/tests/Core/positive/out/test034.out @@ -0,0 +1,20 @@ +1 +2 +3 +6 +1 +0 +1 +0 +1 +0 +1 +0 +1 +0 +9 +7 +2 +8 +3 +6 diff --git a/tests/Core/positive/out/test035.out b/tests/Core/positive/out/test035.out new file mode 100644 index 0000000000..1fefa77c83 --- /dev/null +++ b/tests/Core/positive/out/test035.out @@ -0,0 +1,3 @@ +cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 nil))))))))) +cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 nil))))))))) +cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 nil))))))))) diff --git a/tests/Core/positive/out/test036.out b/tests/Core/positive/out/test036.out new file mode 100644 index 0000000000..37c8061232 --- /dev/null +++ b/tests/Core/positive/out/test036.out @@ -0,0 +1,51 @@ +1267650600228229401496703205376 +-126765060022822940149670320537674809325432 +-126765060021555289549442091136178106120056 +126765060024090590749898549939171512530808 +-160693804425899027554196209234211092338506843125049000988103690715922432 +-100000000001 +1267650600228229401421893879944 + +1073741824 +2147483648 +4294967296 +4611686018427387904 +9223372036854775808 +18446744073709551616 +1267650600228229401496703205376 +1073741824 +-2147483648 +4294967296 +4611686018427387904 +-9223372036854775808 +18446744073709551616 +-2535301200456458802993406410752 + +18446744073709551616 +8727963568087712425891397479476727340041449 +1267650600228229401496703205376 +126765060022822940149670320537674809325432 + +100 +100 +50 + +1073741824 +2147483648 +4294967296 +4611686018427387904 +9223372036854775808 +18446744073709551616 +1267650600228229401496703205376 +1073741824 +-2147483648 +4294967296 +4611686018427387904 +-9223372036854775808 +18446744073709551616 +-2535301200456458802993406410752 + +10715086071862673209484250490600018105614048117055336074437503883703510511249361224931983788156958581275946729175531468251871452856923140435984577574698574803934567774824230985421074605062371141877954182153046474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069376 +1322070819480806636890455259752144365965422032752148167664920368226828597346704899540778313850608061963909777696872582355950954582100618911865342725257953674027620225198320803878014774228964841274390400117588618041128947815623094438061566173054086674490506178125480344405547054397038895817465368254916136220830268563778582290228416398307887896918556404084898937609373242171846359938695516765018940588109060426089671438864102814350385648747165832010614366132173102768902855220001 +19950631168807583848837421626835850838234968318861924548520089498529438830221946631919961684036194597899331129423209124271556491349413781117593785932096323957855730046793794526765246551266059895520550086918193311542508608460618104685509074866089624888090489894838009253941633257850621568309473902556912388065225096643874441046759871626985453222868538161694315775629640762836880760732228535091641476183956381458969463899410840960536267821064621427333394036525565649530603142680234969400335934316651459297773279665775606172582031407994198179607378245683762280037302885487251900834464581454650557929601414833921615734588139257095379769119277800826957735674444123062018757836325502728323789270710373802866393031428133241401624195671690574061419654342324638801248856147305207431992259611796250130992860241708340807605932320161268492288496255841312844061536738951487114256315111089745514203313820202931640957596464756010405845841566072044962867016515061920631004186422275908670900574606417856951911456055068251250406007519842261898059237118054444788072906395242548339221982707404473162376760846613033778706039803413197133493654622700563169937455508241780972810983291314403571877524768509857276937926433221599399876886660808368837838027643282775172273657572744784112294389733810861607423253291974813120197604178281965697475898164531258434135959862784130128185406283476649088690521047580882615823961985770122407044330583075869039319604603404973156583208672105913300903752823415539745394397715257455290510212310947321610753474825740775273986348298498340756937955646638621874569499279016572103701364433135817214311791398222983845847334440270964182851005072927748364550578634501100852987812389473928699540834346158807043959118985815145779177143619698728131459483783202081474982171858011389071228250905826817436220577475921417653715687725614904582904992461028630081535583308130101987675856234343538955409175623400844887526162643568648833519463720377293240094456246923254350400678027273837755376406726898636241037491410966718557050759098100246789880178271925953381282421954028302759408448955014676668389697996886241636313376393903373455801407636741877711055384225739499110186468219696581651485130494222369947714763069155468217682876200362777257723781365331611196811280792669481887201298643660768551639860534602297871557517947385246369446923087894265948217008051120322365496288169035739121368338393591756418733850510970271613915439590991598154654417336311656936031122249937969999226781732358023111862644575299135758175008199839236284615249881088960232244362173771618086357015468484058622329792853875623486556440536962622018963571028812361567512543338303270029097668650568557157505516727518899194129711337690149916181315171544007728650573189557450920330185304847113818315407324053319038462084036421763703911550639789000742853672196280903477974533320468368795868580237952218629120080742819551317948157624448298518461509704888027274721574688131594750409732115080498190455803416826949787141316063210686391511681774304792596709376 +9990020930143845079440327643300335909804291390541816917715292738631458324642573483274873313324496504031643944455558549300187996607656176562908471354247492875198889629873671093246350427373112479265800278531241088737085605287228390164568691026850675923517914697052857644696801524832345475543250292786520806957770971741102232042976351205330777996897925116619870771785775955521720081320295204617949229259295623920965797873558158667525495797313144806249260261837941305080582686031535134178739622834990886357758062104606636372130587795322344972010808486369541401835851359858035603574021872908155566580607186461268972839794621842267579349638893357247588761959137656762411125020708704870465179396398710109200363934745618090601613377898560296863598558024761448933047052222860131377095958357319485898496404572383875170702242332633436894423297381877733153286944217936125301907868903603663283161502726139934152804071171914923903341874935394455896301292197256417717233543544751552379310892268182402452755752094704642185943862865632744231332084742221551493315002717750064228826211822549349600557457334964678483269180951895955769174509673224417740432840455882109137905375646772139976621785265057169854834562487518322383250318645505472114369934167981678170255122812978065194806295405339154657479941297499190348507544336414505631657396006693382427316434039580121280260984212247514207834712224831410304068603719640161855741656439472253464945249700314509890093162268952744428705476425472253167514521182231455388374308232642200633025137533129365164341725206256155311794738619142904761445654927128418175183531327052975495370561438239573227939673030106077456848477427832195349227983836436163764742969545906672369124136325932123335643135894465219101882123829740907916386023235450959388766736403229577993901152154448003637215069115591111996001530589107729421032230424262035693493216052927569625858445822354594645276923108197305806280326516736449343761732409753342333289730282959173569273013286423311759605230495171677033163709522256952460402143387655197644016528148022348331881097559421960476479388520198541017348985948511005469246617234143135309938405923268953586538886974427008607028635502085562029549352480050796521564919683265106744100967822951954161617717542997520009887307377876210685890770969411610438028623950445323789591870760289260393489826100774887672852918106468489143893649064784591211612193300707900537059042188012856559403699070888032966871611655961232331998310923225082866180321880439447572986762096935819784385927969250123326935194693207724335527365566248223787833888074999276831633440318604463618703789784313032843823470410944306591471928341190975185239212327674384990561563688432939039442002617530976850605132937101449086396141620556053547335569926700941375271829142407234267937565069765567475934101310225342830080409079587329544213551307302050171598424230760469209732907290141606353960880559202357376885647852240092777111489134492416995607171786298436533978180869474106751111353523711540436599310889697485658800887861974934357929246204051767246012250618404011966289872673803070498361217974484679100747846356194664829224736134115135567179291781968056053726484141128347858241259121954601184412409349782963317042002530418661694962318735860652485410222211869544223788289189712080514575141361964805369723164570564998479537657174548128597406077339158775332355215609435919275199351014222246963017013717419337504919295363295101115292951836282819191821651676455946515828048984256116748150367805267878662716999649296949377045794876146628110929982020737013330324451005385378551188803474148198665114579322684900993000236736168555294173442059925371965244997925483159343706343970371809611470323074186985035054722289027174850333368328300281132910841693150457389933183934593292994942796015309756118708918929528449074243284767006243171171622731766606796101967802204564589015899524704741001158110963633731329388356868949408759334176909387806398584647300588928175998844477486130063153068760070084837267527789777356830042778902772105683833021470279728595336332110564064263909724579949686162908019604141753935768876587992428549912151737924270343248648414247456838889541893241450987505759403013249697541696955330296880219304874163501097920036210238768275176369980977614979636096704348140124130683576879904997436596296495705459524735382000363770324894982103331332913562315169854410415317054193928234723398848453552173203688088312100943941434938282203549650281530751087098604681224802973825631244989331965296202372608586509050307993308652001231671915182765742095689513136184095412121473786311042897717861448158316965848766949554826252504961227044714712229620274682362909803877469376987358942125441792355298387479830450253909788733469732603097544156474805473732732767248652759034995336354126953900458854988683574927864615252040800490114785892289085443353996994780867471613519785838571456421583171193004117989440790268346357550339888086725127883577297626499213827436573992927302238792576924232785487201297255386071968303782483063725899808484638503828356258403917311872694381464553651690062530023217591343084755215901475299149215296944362366910833233693767993138209275870024246238331218236715236772098417187703860172308522448043176333602759733161201262248323085329288986154559221427378507410978822244729512663572225567169779409767341543017289268332635077451210167869121334465680739797372711461919299938118178827541421792926883790285430909942441260511945849237909966329550263865701114884142266162969810073652710928504579470861508094054577797864301504899958634164700528220562786008864025709432444254044034243140203812074857537999016066465520986980790589347320243050635907363821521280600041827529325485247927904235727598574209554632363830932428250711518801775633739811523761994686263270550635099851254333875594601540900862014293625673738331693082328854327001487476635118830885173775268819526360165345900556160767713453617655450974424979076063906093300028416964847594027046669468486593636425428625241644836652173922586528474244952363302305311413449332339822336551611431469131900170488226836525916399723912626616140205707996727383529597479125488961419287261259757561701592645823541151922177253919651034344793680369057003813056557866311011476313189571556336518727757991908862890765494952019474922148851417079252352394293801701149485239005844358329748769279941586384640877265901749104933238853465429979253900561311562288241147192158137210120267399648622831610430287268739840335142120299516610846193164688075944526965248570070554452152547493450434852917987512185973647190461515413582582139040172118295702327537027389787793506904044938553587650503557155872873201596885061331145477101575699375441097493374115991199114962726801718038950907803041184400075585468560976965669584325627283327416418044590727844680051360774154288412712456353383625469068936430902068216750459819321744513362913853983154560610459692604508787700304184579153478291725762810632722108035826060904572460619204237580363147200158749075361633785243462298769917887808671453928846572417223504887766803869453474588831907597355292800709241471370696647029530700507083091412492771404776193459007315206233634226128137074504162520473449597415678882003845446774388950379192344594171245510231738995030348421937088083329709108176561010708693158020695060096428352046647333361163476664106311247065173802510599409266908984046663298613648854871230659903565772327667696057187057276814394932559371368029375974604116075641599919402266794230681485723361363592903676841480358328093127506801111571615062761556607158236612268544268330274725849294875852089790850962835235527978491475563744318483993474633300330972497012808415900969455190375849945750379465019166009861502794606130794726898507849610303884846035423392175449505876157130344700415823080225786693300512126831846009510203543174323783292176865976076275412421892808138872880175813109296020150746331979561488146333412674896256883784351178477592660577212734269328382384711746083782209939646612308343952169576581065423771981899573840430315930973215059901371218399762585055435459516340055149080565627330475362528926945020226163130902420795006258931367813005222140742964756194053782182452833097021554210929638693005460011927178302761563505715735405672652524175925436371863471836292012162456662093642074605500842449347289830619506077570528754845277680661218358066130291463288932240701043887535007851997159198390084654596996197138399723495863749806582439384615049184048485819193560667125968018574877819561104335238420873417743385185735663101292757409280586840011804854994149478736882949368786637202682607198707656286436753775709560349718397405565505269425218354301348910785234517795519757516484711545928466003754558485470994737493796615841040414239875763335201795518644856632201598556341934286668912522153446348791218159622744525372314219184738770596659942181275403613660438538829201810204850917717791485256026242529802492309229562177062770027659288158473994804255067730903420043491632913588644627415318468517462580180901314477358637486528221274450661883667873545037139535563260349778209992416559111602097437491432360787879331015052417047437823553506205617017572175387061751192919715660363028302343819584946594328460482931960515124867123604625653903565173322856758210937541222674223847046664733620292824834065137814475367747671882220098389682019784216724015491253360436437847479770633657905418133523010804559958547379685864708937791659340223795537045273849435441105983887969741143051069401271065628507537039823308867819868298171415185218271493613110963984021912448323423901392553811725954153209435002954807640291982765741514042956666953177304003358701503703497424897898108939453026976878231557938158928996868766367603579055322794822757659104812835219745724022347569914650240636730492833286151875049129873457930874999488048681250802904606446223569562767964898914869924201946458521355165709887118378290437174375625282606140534611987395334677500936625746765638459629521872262777473480491233965194281353725068660782076683862565487279038020486778099991754380815789820825255566234983933217491493864966284116889874665005414748264599972752003370084542592544301190399041231752771993767799847551279448012913842034323154888137932524887172099381195722163148101670274877379161830968937348720168944903299658932511996504109653674618914861599481632040891930577238630396311858213341337110096389113836596895914715370925073998461682046426447290788976525593505136546978364603183820619560578517561504972661817649030304982138534738696212234626114043035600967042547012317360449724623287452575151198771801585742829389025650825988275495110865424704218337264023078045681651420517807418196096401513461760794362769612228126118610912766814880500950963889032877710837651051900076128058473969258768737937306664751387942217354694021157675557568970168734104342446525522568974329716152742558110503495045718931752447070410307760830365536714180388723602948872805590752711115590794756926903978519601939790311768070356801944936106850640568519290645048685535628256787225734544146565541187816717729850612874044620890718502108518025052924590359814117522720320552642597751984410742492179242039080014606225999422109717176118746845802673724801365603866909971071347255859723217027554055085082090418987534829222004178998475030519537179062001509333023023881806519182405550818672164711702307529922652228033820404113386625335815042934115143980939986416365633923620673874259342713444701242702722227197573203194489407856355511639619115985907995399083680129468810771595938084908111251938016414866250141095286680914828503123938960997659175977315432797173945762560365023587931559926170852315074247849814256564693008105061976397395591733545472917526739598790117477449217745771908169489543790314578152667389689410604588351445026130645637237687631129964576699475767340673583537218704935177320214779403972566532581731659202199752942824432778102107532160580104432121067208273876100778332426569624765621063126975491546224343978061253999313893915782008560011171319773443130412998215626985098895722778159524505640435534979855872234521991778419564106622122049039017886737997905270552302412002780864726282517525092332555378737792434915926182736151242592242725872699844014132567954640475742451126102857394193479716383187138370722782422619384021010896271281685732287764210298708895557148397743497418109849633633910397778254225179400022143485886207532122646613614487518735142494469575836744785028013193033901949738716163113800864093408529297729741462836142201120573027427309566658849884965134295188287937016147499504685185116851709758146686994243673140036992381232483920618628663037402351333907771907455224248515748726136075048020960976567862025232356273025557054386729189255571672396871991669651834736987440295942395220863481341484029838939485593327256627318194137735451891544384960966451285561476772564932516923822003229733483331726306200059192067441136913243720403578098676440894672367334549903905283682411422011886949265324531399323764100563996744273693606586851243936737155349696358970470706246743064681511525580772367129358691546677179280674603197443660235664811911175324239792271603213932690900431433572511935591785787438931910836722219749594385217682817205537433987939372420698422586002026702204502341484432231418159837133223467338185995720215212999066855318593765188122815644349842897804044474253173187198249880219056124756835053121936684091113613451740380400041281474527453687530122741226292549431008458868082627169312891414237466973215688306962596297824286828479758198382340345222708757345393897126910174835179971320922911746435455023926629385455742630840473245989374307836875864087914312319228307304975362481708579849870550314357368660453504099679685389802578477910419231052505144696885248726344365369453921372194715998156624454330562798282777349584666757018969900985110164491047993602922961645132995224271404908186948080818144765441476070834943179921347693205775493727581146799477819807044909830887802418354528095576268178221596410712216509995196961932368766959924336939018675830477951348564967496643006978548120861013029026482640402316621018258604172734501970838570222765188590393123627245232006535983907604127898007628220791246163222713051906678029644273228763460060289213316094057396003523608149487855784819923604033709243920895785100953666245538047118419834068589948934026518132741951749125192568729824877982938351710224389886834755562218214866075518628420508441240855088408499405226548535776678864444680504301285988469915501692621173049550268365498340637943341584797390666973271817567111123445212701138287733170703648843560692535012857745637166012927846194135756491508269323010063559087991831480179606664893606864875569154700860602703909640090514609360513037280984989976472934205971076104365706670369636731086616773064361333184164332104073479210775688703754193241101764488071673304176268034528127946729244452919161882095335945667158450941476301537032588109254921620602423998383939639570864268315557737923542830477169053850721939927266830567227442913752680237178175908437269780708099690192695002592421020485193953805155158663266418230452129371046840218806665165231438597498081621420148051355131865453014871298249938624272154345372391802215126115854861975398983110888196358875565793593310597895992053240439684590862193232015232257668969509415398393721308747247732944493053757577694362680328316055060353219685001207195191671426063364056179006218671604638684249067247572855764071631397824639188693789635247708232195940400450829593853651517642510129335911478337995658501766175785429966837417247838838645892319920041196390925354226074199412181950196251598137076467085022479201649174056794994024967593003129957099742026595785390010668925864718839026058417582396497109522944729874183273952292247592156943695682037477731049514128818431210317476600507328613045698141876738705835589680568812062901672389707603039549708273418484069037215179862266581929555420755695654139976814235027490594662592770986044588793675562143709648705744665319814772892177290937799834952769995145061157204394128687121538756842568036622321369508041915737469009917048039885947260486258684449762362318724085339500204989295963618739437408918888568903691128987832325892601331155260901131911962536529384643993465666490271108522834470184768391573623895239732781158399355178022076177450755929138381468526577309152290502509145241134006895661073761320484545645543610238773087594308408699782711315425513472058939339453013548135244176754131385012770024156261936169649709944156933541666590935759784775946468953923516229723673403650805886186209888123677098892944769654360324668874429740130365009770291603536426502844618046128137324006034947889707723262364927515545013731797277615272236008596598736693841467685030166103516988390995570659331713219574003251046303604196295276316972893990945091279545361627593486818455830168634280653205028729105026906643726170661778439311154737149759096116144493812106746037251452616271615212935043141124155849847574091878458410177325030553207237661933970254488335435069113577757765584551136714634629223114497809546405079026755854160954260557783406467356189398503160303046687522579708387993298769182986822970667356246647939653365454544268386404322650296028881298557242198187208040207296077496128886166773288838620609977925416822156713703667391333322086520871904473048593017466793578173830832406459585018177267447690376523178740142636502172093102619263046542112708094769682392207383797482057034793196525139221370199877543931178601238198924707047629587501516299912892933069025343575488251454948469328322898202956506903308470482517744131166464774750723477861518055343466858040987132273453081836794564364430155246274158100731069323080734901590517008753654169600998911569598454702926629374049393677685285723039754691181021469267219333846563053673846537824970049506209403506606244584412627902384242785280551599253188262786271531989567165398385428909311577122438618119724985644233907558812574859217687149721341833317289714977694982117227337669878361212788465289349470676995146785835955074121568375032937822352378665103266923449887690619794116574936418347914823983988002067649967289214983486424468737742286438563064425223461210639952418146166111391586408089740413945879849036682695488197808766021959964846771145698159367567904768112047055740602351237499012258567357965107013251562237843754994747236883821060645969480067316032381351192535148322216761442411144695361182838761115795911310362420741510826322048374540404146990479647073113428368300158247350712922331119789013179701651764033036649606749518628656836032556353205617386602749327417799524243899880581322620681297935615821202736455540414428705857131835238951742471239050758919353490570268302812810704750603181709274434806504843422134152201579626776393642698168851485545206897802036257496043584180735523092410264794436423951474855853980259367017205588767985309971043290404884467541701918912275745752402121744890326681160647837985004639864193645792082105266057503921195311457592621400830660301768120178560328650220171413811642155986702637531155554821958388905393544592180587272433749899242041542816666821846374863337522729077994208960545264863862516411718049112903451378140021506899966762080732651380427792460930762263446994159193223142565029996403134383564087766689537759857473403120477091886596355579944643688205981242040477802943803932459722207541739589596692034052161680837588921636048584789929663903107349945667027830610483130862872680661015300745521669893857383782690975026078691245077096697355744971063878379083608563324774011426604588797712843335089341752120843133549155805945217503766728136818989701075795034975931147113851177529084708382646930943663837851488798723688771534770333456570254004964039987760745951276145936694695508877796318400093229973736770518512573233230127134210937068680950264362225510872877141635601716276267040168996816287213326422268377855327887822310204539762272583014902609710931194995685950834598509258803363019551891846212990914920155838298607568190737375958573348261713794703592503972126314316192159571451081744034114847904386601284244643362857392442316767411036417557776991886719910511456902002905771699177497748359489810115650557253501242519595931483440417116222205504589671636754478042893488385500275211497526246421122010774862333476246182576597178403980436617669560567049936789350370893174617560282074679058110806280348893136768773133234721178541038289213080580369302853910384704528018344058313252744129928355732704028220901951560054449764635932065083760864473989692709381120504251266930834839999956860216356148940167442564078469350152730245749435722205009403680810321136898946443062041659878360406811331217133504960504944165472883926378607868385731515366373416312566122603235977742473940324793478740770352725436532455308438250865693864330020957120719122826689237609273524467576647981797622831709248187143189474449928329051087066866263901462754600186683583622062445553828867143621415773638244852570664653423002003386087185683387095282564231892337305827467825102905239214464117590700082862874915647212962223100149842773910585262712095702633425139069275541249925826898755913048489059083665047386569005980726512682643809800080768716889749767005747228285165430935469423701296901225200041775975278099341399149455675655415791289014141807180970818010668626000334746783492116354330741766556197865412944331579610856733907210970815247694360208231077377319255935591919361509992241851869762511821971598449396422923222586939583205849537600173388242916813257003198490942805178528782842560021549233235032941872842601109623432061485547579038802849228139397130979180562447703494299530585909415031237400213445431607049538809117870571045686211621069655023028886617060314580222884344906879404890744067164557565160596397488164744575409400891911083945126233990453364772541741331330821153758983077390402549739751620825837898384996200874749622331436354553599710472896396262914675542281735624665804212007275401273982269651802596130334329792865330063654175676003369688243926391280713123038760076039957285658333390838592534249337153070457471482743551037417147024006867419141874398230449202772009682282474640802779068104741602882613440803256607530230172031981070796893051954145239327661783905828943932146148894821695918579498502263858318704473290299790473193753803543920285706350672484245008920689712995308213747335255792982565803469779504974053329506220584586976782376547358092670753891736652401577525890202354883227480678961328466821865972869785592672826822656457577958670571097728396605101516387163615321918203652729897586807786443044896628670393188486921931839182927172554503767733076856308657600665342622254535057629030862718937364327448083558928220102374951534665262857504222950995446014428801859061443379679142717413278286975998259993819084477469775220567898395378570154609157695006128689610825519373486612568225010585752375050450503641627804406676905130564807191014132285063482665726828511933059433717373899623654715534816591630086838520905491060194596758223701911513581142071521220673521948777069521608531717477580542554138038978873716058241771904252401056370661792996395808706717083872950238057238547610495061732689587948240319569499000594593719849004104550034415014066154526994609094441391439071866309009249691812468813088126242358787204856089608234037677437509496768451058059579977189006605354903359961784245121096144877063187466910292356627771165203522647016166296488083808997887687769308220856530068153940856748041349469491870704992660210066455819832886130678021460369893174499939107231230405088342485383796742208847060385334943928147519685791292174441917386398739155908915859310750449419969425856920503891277550092560029225566028245733054164370482965351532695757311986033153861767127072322962670122480612322195488891848040149357757131302308897501348573600357134307046628157178720021578705983302856401851403674168523579202306440644159448586566246905477964086572462611834063213025126230896949713642334585419351128373132157232101577687884147986752364441711298472354763142715850293434746434127230225735792097083439910498394019789979870351837786010778667226102241684498686398874227580631272581474396676719404444290071284914286251867085092358453277091441099575357659812178523756848934429670368686181229928033433456696493460770903592231804072849827640955873854491455416480621098619090449331761288966135325413062313991971462332768487224184119088841054819270878948939590681778579588918587881426099241767753862382406002451821149035160124492893940578494055432173589779503867792448614769448734671863583817296627073341404027631029821562303142157743379294616649374361560459036060298581224576085252700570061877609582745974967405315882162695982851143006320897730473133461172142945805407178876223011462558510520930761771493278603541262719880522826864107055049364370555816945830840650960447321868266858216903784868032280479864021706315653687489290467679015864709379478762373013822026373788822827564163725872670921602434077279298565679825234946428376162918717556993454693724759744644374586123577768842647346924365909558553162571564807969034052671504760754742676960038255814034354716520834598864538432593908154392918939089896109083521992519053530398359081516289247571043354786424954980741388745386023113329591390636006694539437438690759589121288758007804082911975207095278133335550232776761783391381794105109412999680430103899475051243232331431120663598726618610084717254696908726637456858466646162093223427680684601718516702427671125913080059583053658180035991214447685286534985397013876080817020918472863351368783745251292936294373137797794168163130983688833624592488270042533275310174037401858155192663147588032450316349828944090941459435709839331454077937638533884824056964583661906580362312059760037127664830995125859310214290237306052000883415749724405028863402500028747055233688541068593389039662379913776485715772093749681055718277781429659244251666703110135820625316518906936462663613376783677001574909561444962828205690820330013121289873007855206280915035880334071746233511142838096550651818271177825964147342275885803162473648253508879276299074813242692461714169521068548818275361612786955216412383263246164034602771053052217127416909831714425842754359325193708367920524870186212708574531518197079797624156322369627530303625010057401503185241771381716916959066550480494267473696656051819527729740440782487416353087074803447126307550453018768734511631260002571765708294113447159058326859464022975489061868569715529325333679192904509181338989039531226114077604146341395120253199068720690450654317360799352434791082039695478061926453254644053124586362026016156957888326419910345519741792140396061817459467332211367113051675844970722080638249309285348257747082754939860608508486386549912912220391895379332321814344998458680557267915553525212113907723389037979427485209309504641599639196053296030292739274663906234190084882219800040754390250718430168480866157009022053158273857417267902310193566064243660834080202786392263652453395504706244108957791049298908397097715806857036527872932846771952274875201321856644284239116502005786314083266606564469023548865452436995428173054383481532525156311603438941440612599662264959878769003712412406305072713049361060777519351766684350979095112470377728527045181653556285621656761979382960837252084759203181114384404005114613990326273362146150667851880079327563486444803726963278475818453468509565365380723807736793526242145533088833679727074192838872685484977387306670007551965761431583941102042492623133242770270821710047137152167948872468741189259805623910487138975034203376673344989060052111727844670530521327425332189734978888307943626099125569741350839434061750712876445222039557455150019442996232739317091487905148812821582894579949748623433452865460274945133477267345362799684706610937707688048379567860499887327287273158785195505216946986571759372875984514994087366735699690322212619073372131984972873714823922056361158276719293687517950957314775347729780073870450969204201405641649670458849057466793682155521901095027966023590200629563426621697556166261956721403439803621918243177242110484823901622121433246394511832190737036276362556947535372619436126996645342229589006736952014870393865015087074414735220220770411070088328030731545041085721762448600324574529642445801550887535581445128918173686346116567111050151109714760544361537920207546115073529167935359803746233158035402507293585422134950239655004818456256327794930441926282941363007224150758144477688955569616025741423859274415740477217643474948663183182648210083785749080222199122144694117400270856159095104885845967392332602301843740328702808569782311182460392642129024729192535226787567897868564600570545108945374190649371558894253329703486982693386634574807801078719254129784907155276683405362407228975018016417486695226639468897799829747034414846605232977531914266638473906810541671168066131262918834764800639654762345192540580400257727950859061817326000188356677576249635084512266410557551645134470262083485480776173701923626406384831371842087477223094467978661221649689842322789248762605167898686475739012260361067924661728390016267344059903224026536343550301552983264519865881303942586617734987280231892544278016113318354276103258002393942607858756949485119300715853929843163967575531352484221274814864027297307155457109423432471856970523635672286551516265672389248080659279448953078708153606666741314598260798811278754656313007785743484189610809499119436037561075326359414143476882494692530787790693275290895909945065272071979419682741840819830567497688086236460819345623637702467815073133466197923119939117195979352833117496820500577299938566476984260815518940866776320855483159836188850448339911351505132909703990088919063133375804094886955895465912648104534621430295733375992898959329664444686900648674531661878821297194146191914132978673375283702995190706179924178140249356285006536273771636355569720003246996130665282451695167273161831393867558791278264933758040011059211372270839123518459709107480669852696080909181872978501574064544548264471078633386599113188810137746318984496745989011540334259315347740082110734818471521253374507271538131048296612979081477663269791394570357390537422769779633811568396223208402597025155304734389883109376 diff --git a/tests/Core/positive/out/test037.out b/tests/Core/positive/out/test037.out new file mode 100644 index 0000000000..987e7ca9a7 --- /dev/null +++ b/tests/Core/positive/out/test037.out @@ -0,0 +1 @@ +77 diff --git a/tests/Core/positive/out/test038.out b/tests/Core/positive/out/test038.out new file mode 100644 index 0000000000..b1bd38b62a --- /dev/null +++ b/tests/Core/positive/out/test038.out @@ -0,0 +1 @@ +13 diff --git a/tests/Core/positive/out/test039.out b/tests/Core/positive/out/test039.out new file mode 100644 index 0000000000..afc7b9f254 --- /dev/null +++ b/tests/Core/positive/out/test039.out @@ -0,0 +1,4 @@ +9 +cons 7 2 +5 +cons 3 2 diff --git a/tests/Core/positive/reference/test026.hs b/tests/Core/positive/reference/test026.hs new file mode 100644 index 0000000000..c3fe024d6b --- /dev/null +++ b/tests/Core/positive/reference/test026.hs @@ -0,0 +1,32 @@ +data Tree = Leaf | Node Tree Tree + +gen :: Int -> Tree +gen n = if n <= 0 then Leaf else Node (gen (n - 2)) (gen (n - 1)) + +f :: Tree -> Integer +f Leaf = 1 +f (Node l r) = + let l' = g l + in let r' = g r + in let a = case l' of + Leaf -> -3 + Node l r -> f l + f r + in let b = case r' of + Node l r -> f l + f r + _ -> 2 + in a * b + +isNode :: Tree -> Bool +isNode (Node _ _) = True +isNode Leaf = False + +isLeaf :: Tree -> Bool +isLeaf Leaf = True +isLeaf _ = False + +g :: Tree -> Tree +g t = + if isLeaf t + then t + else case t of + Node l r -> if isNode l then r else Node r l diff --git a/tests/Core/positive/reference/test030.hs b/tests/Core/positive/reference/test030.hs new file mode 100644 index 0000000000..68b499d699 --- /dev/null +++ b/tests/Core/positive/reference/test030.hs @@ -0,0 +1,7 @@ +import Data.List + +eratostenes :: [Integer] -> [Integer] +eratostenes (h : t) = h : eratostenes (filter (\x -> x `mod` h /= 0) t) + +primes :: [Integer] +primes = eratostenes [2 ..] diff --git a/tests/Core/positive/reference/test036.hs b/tests/Core/positive/reference/test036.hs new file mode 100644 index 0000000000..289f1ed59a --- /dev/null +++ b/tests/Core/positive/reference/test036.hs @@ -0,0 +1,103 @@ +power :: Integer -> Int -> Integer +power x y = power' x y 1 + where + power' x y acc = + if y == 0 + then acc + else power' x (y - 1) (x * acc) + +num1 :: Integer +num1 = 1267650600228229401496703205376 + +num2 :: Integer +num2 = -126765060022822940149670320537674809325432 + +msqrt :: Integer -> Integer +msqrt x = sqrt' x (x + 1) 0 + where + sqrt' x top bot = + if top - bot <= 1 + then bot + else + let y = (top + bot) `div` 2 + in if y * y > x + then sqrt' x y bot + else sqrt' x top y + +dlog :: Integer -> Integer -> Integer +dlog x y = log' x y 0 + where + log' x y acc = + if y == 1 + then acc + else log' x (y `div` x) (acc + 1) + +fast_power :: Integer -> Int -> Integer +fast_power x y = fast_power' x y 1 + where + fast_power' x y acc = + if y == 0 + then acc + else + if y `mod` 2 == 1 + then fast_power' (x * x) (y `div` 2) (x * acc) + else fast_power' (x * x) (y `div` 2) acc + +main :: IO () +main = do + putStrLn $ show num1 + putStrLn $ show num2 + putStrLn $ show (num1 + num2) + putStrLn $ show (num1 - num2) + putStrLn $ show (num1 * num2) + putStrLn $ show (num2 `div` num1) + putStrLn $ show (num2 `mod` num1) + putStrLn "" + + putStrLn $ show (power 2 30) + putStrLn $ show (power 2 31) + putStrLn $ show (power 2 32) + putStrLn $ show (power 2 62) + putStrLn $ show (power 2 63) + putStrLn $ show (power 2 64) + putStrLn $ show (power 2 100) + putStrLn $ show (power (-2) 30) + putStrLn $ show (power (-2) 31) + putStrLn $ show (power (-2) 32) + putStrLn $ show (power (-2) 62) + putStrLn $ show (power (-2) 63) + putStrLn $ show (power (-2) 64) + putStrLn $ show (power (-2) 101) + putStrLn "" + + putStrLn $ show (msqrt (power 2 128)) + putStrLn $ show (msqrt (power 3 180)) + putStrLn $ show (msqrt (power num1 2)) + putStrLn $ show (msqrt (power num2 2)) + putStrLn "" + + putStrLn $ show (dlog 2 (power 2 100)) + putStrLn $ show (dlog 20 (power 20 100)) + putStrLn $ show (dlog 9 (power 3 100)) + putStrLn "" + + putStrLn $ show (fast_power 2 30) + putStrLn $ show (fast_power 2 31) + putStrLn $ show (fast_power 2 32) + putStrLn $ show (fast_power 2 62) + putStrLn $ show (fast_power 2 63) + putStrLn $ show (fast_power 2 64) + putStrLn $ show (fast_power 2 100) + putStrLn $ show (fast_power (-2) 30) + putStrLn $ show (fast_power (-2) 31) + putStrLn $ show (fast_power (-2) 32) + putStrLn $ show (fast_power (-2) 62) + putStrLn $ show (fast_power (-2) 63) + putStrLn $ show (fast_power (-2) 64) + putStrLn $ show (fast_power (-2) 101) + putStrLn "" + + putStrLn $ show (fast_power 2 1000) + putStrLn $ show (fast_power 3 1000) + putStrLn $ show (fast_power 2 10000) + putStrLn $ show (fast_power 2 100000) diff --git a/tests/Core/positive/test001.jvc b/tests/Core/positive/test001.jvc new file mode 100644 index 0000000000..aa142fc941 --- /dev/null +++ b/tests/Core/positive/test001.jvc @@ -0,0 +1 @@ +5 + 2 * 3 diff --git a/tests/Core/positive/test002.jvc b/tests/Core/positive/test002.jvc new file mode 100644 index 0000000000..104766618b --- /dev/null +++ b/tests/Core/positive/test002.jvc @@ -0,0 +1 @@ +(\x \y \z z + x * y) 2 3 5 diff --git a/tests/Core/positive/test003.jvc b/tests/Core/positive/test003.jvc new file mode 100644 index 0000000000..248dae302c --- /dev/null +++ b/tests/Core/positive/test003.jvc @@ -0,0 +1,9 @@ +-- Empty file with comments + +{- + +Multiline comment + +{- nested comments don't work -- } + +-} diff --git a/tests/Core/positive/test004.jvc b/tests/Core/positive/test004.jvc new file mode 100644 index 0000000000..df6c543d7c --- /dev/null +++ b/tests/Core/positive/test004.jvc @@ -0,0 +1,14 @@ +-- Test IO builtins + +write 1 >> +write 2 >> +write 3 >> +write 4 >> +write 5 >> +write "\n" >> +return 1 >>= write >> +return 2 >>= write >> +return 3 >>= write >> +return 4 >>= write >> +return 5 >>= write >> +return "\n" >>= write diff --git a/tests/Core/positive/test005.jvc b/tests/Core/positive/test005.jvc new file mode 100644 index 0000000000..daceedb331 --- /dev/null +++ b/tests/Core/positive/test005.jvc @@ -0,0 +1,7 @@ +-- Higher-order functions + +def S := \x \y \z x z (y z); +def K := \x \y x; +def I := S K K; + +I 1 + I I 1 + I (I 1) + I I I 1 + I (I I) I (I I I) 1 + I I I (I I I (I I)) I (I I) I I I 1 diff --git a/tests/Core/positive/test006.jvc b/tests/Core/positive/test006.jvc new file mode 100644 index 0000000000..e766bb9c6a --- /dev/null +++ b/tests/Core/positive/test006.jvc @@ -0,0 +1,5 @@ +-- if then else + +def loop := loop; + +(if 3 > 0 then 1 else loop) + (if 2 < 1 then loop else if 7 >= 8 then loop else 1) diff --git a/tests/Core/positive/test007.jvc b/tests/Core/positive/test007.jvc new file mode 100644 index 0000000000..45be90b850 --- /dev/null +++ b/tests/Core/positive/test007.jvc @@ -0,0 +1,23 @@ +-- case + +constr nil 0; +constr cons 2; + +def hd := \x case x of { cons x' _ -> x' }; +def tl := \x case x of { cons _ x' -> x' }; +def null := \x case x of { nil -> true; _ -> false }; + +def map := \f \x case x of { nil -> nil; cons h t -> cons (f h) (map f t) }; +def map' := \f \x if null x then nil else cons (f (hd x)) (map' f (tl x)); + +def lst := cons 0 (cons 1 nil); + +def writeLn := \x write x >> write "\n"; + +writeLn (null lst) >> +writeLn (null nil) >> +writeLn (hd lst) >> +writeLn (tl lst) >> +writeLn (hd (tl lst)) >> +writeLn (map (+ 1) lst) >> +writeLn (map' (+ 1) lst) diff --git a/tests/Core/positive/test008.jvc b/tests/Core/positive/test008.jvc new file mode 100644 index 0000000000..360827c69b --- /dev/null +++ b/tests/Core/positive/test008.jvc @@ -0,0 +1,5 @@ +-- recursion + +def sum := \x if x = 0 then 0 else x + sum (x - 1); + +sum 10000 diff --git a/tests/Core/positive/test009.jvc b/tests/Core/positive/test009.jvc new file mode 100644 index 0000000000..78adb63f22 --- /dev/null +++ b/tests/Core/positive/test009.jvc @@ -0,0 +1,15 @@ +-- tail recursion + +def sum' := \x \acc if x = 0 then acc else sum' (x - 1) (x + acc); +def sum := \x sum' x 0; + +def fact' := \x \acc if x = 0 then acc else fact' (x - 1) (acc * x); +def fact := \x fact' x 1; + +def writeLn := \x write x >> write "\n"; + +writeLn (sum 10000) >> +writeLn (sum 100000) >> +writeLn (fact 5) >> +writeLn (fact 10) >> +writeLn (fact 100) diff --git a/tests/Core/positive/test010.jvc b/tests/Core/positive/test010.jvc new file mode 100644 index 0000000000..006b711984 --- /dev/null +++ b/tests/Core/positive/test010.jvc @@ -0,0 +1,8 @@ +-- let + +let x := 1 in +let x := x + let x := 2 in x in +let x := x * x in +let y := x + 2 in +let z := x + y in +x + y + z diff --git a/tests/Core/positive/test011.jvc b/tests/Core/positive/test011.jvc new file mode 100644 index 0000000000..1353462a14 --- /dev/null +++ b/tests/Core/positive/test011.jvc @@ -0,0 +1,10 @@ +-- tail recursion: compute the n-th Fibonacci number in O(n) + +def fib' := \n \x \y if n = 0 then x else fib' (n - 1) y (x + y); +def fib := \n fib' n 0 1; + +def writeLn := \x write x >> write "\n"; + +writeLn (fib 10) >> +writeLn (fib 100) >> +writeLn (fib 1000) diff --git a/tests/Core/positive/test012.jvc b/tests/Core/positive/test012.jvc new file mode 100644 index 0000000000..9e0f27e63f --- /dev/null +++ b/tests/Core/positive/test012.jvc @@ -0,0 +1,29 @@ +-- trees + +constr node1 1; +constr node2 2; +constr node3 3; +constr leaf 0; + +def gen := \n + if n = 0 then + leaf + else if n % 3 = 0 then + node1 (gen (n - 1)) + else if n % 3 = 1 then + node2 (gen (n - 1)) (gen (n - 1)) + else + node3 (gen (n - 1)) (gen (n - 1)) (gen (n - 1)); + +def preorder := \t case t of { + node1 c -> write 1 >> preorder c; + node2 l r -> write 2 >> preorder l >> preorder r; + node3 l m r -> write 3 >> preorder l >> preorder m >> preorder r; + leaf -> write 0; +}; + +preorder (gen 3) >> write "\n" >> +preorder (gen 4) >> write "\n" >> +preorder (gen 5) >> write "\n" >> +preorder (gen 6) >> write "\n" >> +preorder (gen 7) >> write "\n" diff --git a/tests/Core/positive/test013.jvc b/tests/Core/positive/test013.jvc new file mode 100644 index 0000000000..5bbc6bbced --- /dev/null +++ b/tests/Core/positive/test013.jvc @@ -0,0 +1,14 @@ +-- functions returning functions with variable capture + +def f := \x + if x = 6 then \x 0 + else if x = 5 then \x 1 + else if x = 10 then \y (\x x) 2 + else \x x; + +def writeLn := \x write x >> write "\n"; + +writeLn (f 5 6) >> +writeLn (f 6 5) >> +writeLn (f 10 5) >> +writeLn (f 11 5) diff --git a/tests/Core/positive/test014.jvc b/tests/Core/positive/test014.jvc new file mode 100644 index 0000000000..635af7bc39 --- /dev/null +++ b/tests/Core/positive/test014.jvc @@ -0,0 +1,23 @@ +-- arithmetic + +def writeLn := \x write x >> write "\n"; + +def f := \x \y writeLn (x + y); + +def g := \x \y (x + 1) - (y * 7); + +def h := \f \y \z f y y * z; + +def x := 5; +def y := 17; +def func := \x x + 4; +def z := 0; + +def vx := 30; def vy := 7; + +writeLn (func (y / x)) >> -- 17 div 5 + 4 = 7 +writeLn (+ (* z x) y) >> -- 17 + +writeLn (+ vx (* vy (+ z 1))) >> -- 37 + +f (h g 2 3) 4 -- (g 2 2) * 3 + 4 = (2+1-2*7)*3 + 4 = -11*3 + 4 = -33+4 = -29 diff --git a/tests/Core/positive/test015.jvc b/tests/Core/positive/test015.jvc new file mode 100644 index 0000000000..9bc8d5d5a0 --- /dev/null +++ b/tests/Core/positive/test015.jvc @@ -0,0 +1,21 @@ +-- local functions with free variables + +def f := \x { + let g := \y x + y in + if x = 0 then f 10 + else if x < 10 then \y g (f (x - 1) y) + else g +}; + +def g := \x \h x + h x; + +def h := \x if x = 0 then 0 else g (x - 1) h; + +def writeLn := \x write x >> write "\n"; + +writeLn (f 100 500) >> -- 600 +writeLn (f 5 0) >> -- 25 +writeLn (f 5 5) >> -- 30 +writeLn (h 10) >> -- 45 +writeLn (g 10 h) >> -- 55 +writeLn (g 3 (f 10)) -- 16 diff --git a/tests/Core/positive/test016.jvc b/tests/Core/positive/test016.jvc new file mode 100644 index 0000000000..4960d1951e --- /dev/null +++ b/tests/Core/positive/test016.jvc @@ -0,0 +1,6 @@ +-- recursion through higher-order functions + +def g := \f \x if x = 0 then 0 else f (x - 1); +def f := \x x + g f x; + +f 10 -- 55 diff --git a/tests/Core/positive/test017.jvc b/tests/Core/positive/test017.jvc new file mode 100644 index 0000000000..3f27647695 --- /dev/null +++ b/tests/Core/positive/test017.jvc @@ -0,0 +1,10 @@ +-- tail recursion through higher-order functions + +def sumb := \f \x \acc if x = 0 then acc else f (x - 1) acc; +def sum' := \x \acc sumb sum' x (x + acc); +def sum := \x sum' x 0; + +def writeLn := \x write x >> write "\n"; + +writeLn (sum 10000) >> +writeLn (sum 100000) diff --git a/tests/Core/positive/test018.jvc b/tests/Core/positive/test018.jvc new file mode 100644 index 0000000000..3e73ca1871 --- /dev/null +++ b/tests/Core/positive/test018.jvc @@ -0,0 +1,7 @@ +-- higher-order functions & recursion + +def f := \g g 5; +def h := \x \z x + z; +def u := \x f (h 4) + x; + +u 2 -- 11 diff --git a/tests/Core/positive/test019.jvc b/tests/Core/positive/test019.jvc new file mode 100644 index 0000000000..b188d9369c --- /dev/null +++ b/tests/Core/positive/test019.jvc @@ -0,0 +1,3 @@ +-- self-application + +(\x x x) (\x x) (3 + 4) diff --git a/tests/Core/positive/test020.jvc b/tests/Core/positive/test020.jvc new file mode 100644 index 0000000000..e024482156 --- /dev/null +++ b/tests/Core/positive/test020.jvc @@ -0,0 +1,20 @@ +-- recursive functions + +-- McCarthy's 91 function +def f91 := \n if n > 100 then n - 10 else f91 (f91 (n + 11)); + +-- subtraction by increments +def subp := \i \j if i = j then 0 else subp i (j + 1) + 1; + +def writeLn := \x write x >> write "\n"; + +writeLn (f91 101) >> +writeLn (f91 95) >> +writeLn (f91 16) >> +writeLn (f91 5) >> + +writeLn (subp 101 1) >> +writeLn (subp 11 5) >> +writeLn (subp 10 4) >> +writeLn (subp 1000 600) >> +writeLn (subp 10000 6000) diff --git a/tests/Core/positive/test021.jvc b/tests/Core/positive/test021.jvc new file mode 100644 index 0000000000..a39e35348b --- /dev/null +++ b/tests/Core/positive/test021.jvc @@ -0,0 +1,26 @@ +-- higher-order recursive functions + +def not := \x if x then false else true; + +def writeLn := \x write x >> write "\n"; + +def f0 := \f \g \x { + writeLn 6 >> + writeLn x >> + writeLn 7 >> + if (not (x = 0)) then { + writeLn 9 >> + g x >>= \y + f f g y + } else + writeLn "end" +}; + +def g := \x { + writeLn (10 * x) >> + return (x - 1) +}; + +def f := f0 f0 g; + +f 4 diff --git a/tests/Core/positive/test022.jvc b/tests/Core/positive/test022.jvc new file mode 100644 index 0000000000..c83b051d14 --- /dev/null +++ b/tests/Core/positive/test022.jvc @@ -0,0 +1,30 @@ +-- power + +def power' := \a \b \acc + if b = 0 then + acc + else if b % 2 = 0 then + power' (a * a) (b / 2) acc + else + power' (a * a) (b / 2) (acc * a); + +def power := \a \b power' a b 1; + +{- + +def power := loop a b (acc := 1) { + if b = 0 then + acc + else if b % 2 = 0 then + next (a * a) (b / 2) acc + else + next (a * a) (b / 2) (acc * a) +}; + +-} + +def writeLn := \x write x >> write "\n"; + +writeLn (power 2 3) >> +writeLn (power 3 7) >> +writeLn (power 5 21) diff --git a/tests/Core/positive/test023.jvc b/tests/Core/positive/test023.jvc new file mode 100644 index 0000000000..6f2d644d32 --- /dev/null +++ b/tests/Core/positive/test023.jvc @@ -0,0 +1,42 @@ +-- lists + +constr nil 0; +constr cons 2; + +def head := \l case l of { cons h _ -> h }; +def tail := \l case l of { cons _ t -> t }; +def null := \l case l of { nil -> true; cons _ _ -> false }; +def map := \f \l case l of { nil -> nil; cons h t -> cons (f h) (map f t) }; +def foldl := \f \acc \l case l of { nil -> acc; cons h t -> foldl f (f acc h) t }; +def foldr := \f \acc \l case l of { nil -> acc; cons h t -> f h (foldr f acc t) }; +def filter := \f \l + case l of { + nil -> nil; + cons h t -> + if f h then + cons h (filter f t) + else + filter f t + }; +def rev := foldl (\acc \x cons x acc) nil; + +def gen := \n if n = 0 then nil else cons n (gen (n - 1)); + +def sum := \n foldl (+) 0 (gen n); +def sum' := \n foldr (+) 0 (gen n); + +def foldl' := \f \acc \l if null l then acc else foldl' f (f acc (head l)) (tail l); +def sum'' := \n foldl' (+) 0 (gen n); + +def writeLn := \x write x >> write "\n"; + +writeLn (gen 10) >> +writeLn (rev (gen 10)) >> +writeLn (filter (\x x > 5) (gen 10)) >> +writeLn (rev (map (\x x - 1) (gen 10))) >> +writeLn (sum 10000) >> +writeLn (sum 100000) >> +writeLn (sum' 10000) >> +writeLn (sum' 100000) >> +writeLn (sum' 10000) >> +writeLn (sum' 100000) diff --git a/tests/Core/positive/test024.jvc b/tests/Core/positive/test024.jvc new file mode 100644 index 0000000000..3985c13f1d --- /dev/null +++ b/tests/Core/positive/test024.jvc @@ -0,0 +1,15 @@ +-- structural equality + +constr nil 0; +constr cons 2; + +def writeLn := \x write x >> write "\n"; + +writeLn (1 = 1) >> +writeLn (0 = 1) >> +writeLn (nil = nil) >> +writeLn (cons 1 nil = nil) >> +writeLn (cons 1 nil = cons 2 nil) >> +writeLn (cons 1 nil = cons 1 nil) >> +writeLn (cons 1 nil = cons 1 (cons 2 nil)) >> +writeLn (cons 1 (cons 2 nil) = cons 1 (cons 2 nil)) diff --git a/tests/Core/positive/test025.jvc b/tests/Core/positive/test025.jvc new file mode 100644 index 0000000000..18c98dd714 --- /dev/null +++ b/tests/Core/positive/test025.jvc @@ -0,0 +1,31 @@ +-- mutual recursion + +def g; + +def f := \x { + if x < 1 then + 1 + else + x * g (x - 1) +}; + +def h; + +def g := \x { + if x < 1 then + 1 + else + x * h (x - 1) +}; + +def h := \x { + if x < 1 then + 1 + else + x * f (x - 1) +}; + +def writeLn := \x write x >> write "\n"; + +writeLn (f 5) >> +writeLn (f 10) diff --git a/tests/Core/positive/test026.jvc b/tests/Core/positive/test026.jvc new file mode 100644 index 0000000000..a40507307d --- /dev/null +++ b/tests/Core/positive/test026.jvc @@ -0,0 +1,40 @@ +-- nested case, let & if + +constr leaf 0; +constr node 2; + +def gen := \n if n <= 0 then leaf else node (gen (n - 2)) (gen (n - 1)); + +def g; + +def f := \t case t of { + leaf -> 1; + node l r -> + let l := g l in + let r := g r in + let a := case l of { + leaf -> 0 - 3; + node l r -> f l + f r + } in + let b := case r of { + node l r -> f l + f r; + _ -> 2 + } in + a * b +}; + +def isNode := \t case t of { node _ _ -> true; _ -> false }; +def isLeaf := \t case t of { leaf -> true; _ -> false }; + +def g := \t if isLeaf t then t else case t of { + node l r -> if isNode l then r else node r l +}; + +def writeLn := \x write x >> write "\n"; + +writeLn (f (gen 10)) >> +writeLn (f (gen 15)) >> +writeLn (f (gen 16)) >> +writeLn (f (gen 17)) >> +writeLn (f (gen 18)) >> +writeLn (f (gen 20)) diff --git a/tests/Core/positive/test027.jvc b/tests/Core/positive/test027.jvc new file mode 100644 index 0000000000..ae00ca518a --- /dev/null +++ b/tests/Core/positive/test027.jvc @@ -0,0 +1,18 @@ +-- Euclid's algorithm + +def gcd := \a \b { + if a > b then + gcd b a + else if a = 0 then + b + else + gcd (b % a) a +}; + +def writeLn := \x write x >> write "\n"; + +writeLn (gcd (3 * 7 * 2) (7 * 2)) >> +writeLn (gcd (3 * 7 * 2 * 11 * 5) (7 * 2 * 5)) >> +writeLn (gcd 3 7) >> +writeLn (gcd 7 3) >> +writeLn (gcd (11 * 7 * 3) (2 * 5 * 13)) diff --git a/tests/Core/positive/test028.jvc b/tests/Core/positive/test028.jvc new file mode 100644 index 0000000000..ac6c683e34 --- /dev/null +++ b/tests/Core/positive/test028.jvc @@ -0,0 +1,45 @@ +-- functional queues + +constr nil 0; +constr cons 2; + +def hd := \l case l of { cons x _ -> x }; +def tl := \l case l of { cons _ x -> x }; + +def rev' := \l \acc case l of { + nil -> acc; + cons h t -> rev' t (cons h acc) +}; + +def rev := \l rev' l nil; + +constr queue 2; + +def fst := \q case q of { queue x _ -> x }; +def snd := \q case q of { queue _ x -> x }; + +def front := \q hd (fst q); + +def pop_front := \q + let q' := queue (tl (fst q)) (snd q) in + case fst q' of { + nil -> queue (rev (snd q')) nil; + _ -> q' + }; + +def push_back := \q \x case fst q of { + nil -> queue (cons x nil) (snd q); + _ -> queue (fst q) (cons x (snd q)) +}; + +def is_empty := \q case fst q of { + nil -> case snd q of { nil -> true; _ -> false }; + _ -> false +}; + +def empty := queue nil nil; + +def g := \q \acc if is_empty q then acc else g (pop_front q) (cons (front q) acc); +def f := \n \q if n = 0 then g q nil else f (n - 1) (push_back q n); + +f 100 empty diff --git a/tests/Core/positive/test029.jvc b/tests/Core/positive/test029.jvc new file mode 100644 index 0000000000..aa1919e8c9 --- /dev/null +++ b/tests/Core/positive/test029.jvc @@ -0,0 +1,56 @@ +-- Church numerals + +constr pair 2; + +def fst := \p case p of { pair x _ -> x }; +def snd := \p case p of { pair _ x -> x }; + +def compose := \f \g \x f (g x); + +def zero := \f \x x; + +def num := \n + if n = 0 then + zero + else + \f compose f (num (n - 1) f); + +def succ := \n \f compose f (n f); + +def add := \n \m \f compose (n f) (m f); + +def mul := \n \m \f n (m f); + +def isZero := \n n (\_ false) true; + +def pred := \n + fst ( + n (\x + if isZero (snd x) then + pair (fst x) (succ (snd x)) + else + pair (succ (fst x)) (succ (snd x))) + (pair zero zero) + ); + +def toInt := \n n (+ 1) 0; + +def writeLn := \x write x >> write "\n"; + +def fib := \n + if isZero n then + zero + else + let n' := pred n in + if isZero n' then + succ zero + else + add (fib n') (fib (pred n')); + +writeLn (toInt (num 7)) >> +writeLn (toInt (mul (num 7) (num 3))) >> +writeLn (toInt (pred (num 7))) >> +writeLn (toInt (fib (num 5))) >> +writeLn (toInt (fib (num 6))) >> +writeLn (toInt (fib (num 7))) >> +writeLn (toInt (fib (num 8))) diff --git a/tests/Core/positive/test030.jvc b/tests/Core/positive/test030.jvc new file mode 100644 index 0000000000..744aefbc76 --- /dev/null +++ b/tests/Core/positive/test030.jvc @@ -0,0 +1,44 @@ +-- streams without memoization + +constr nil 0; +constr cons 2; + +def force := \f f nil; + +def filter := \p \s \_ + case force s of { + cons h t -> + if p h then + cons h (filter p t) + else + force (filter p t) + }; + +def take := \n \s + if n = 0 then + nil + else + case force s of { + cons h t -> cons h (take (n - 1) t) + }; + +def nth := \n \s + case force s of { + cons h t -> if n = 0 then h else nth (n - 1) t + }; + +def numbers := \n \_ cons n (numbers (n + 1)); + +def indivisible := \n \x if x % n = 0 then false else true; +def eratostenes := \s \_ + case force s of { + cons n t -> + cons n (eratostenes (filter (indivisible n) t)) + }; +def primes := eratostenes (numbers 2); + +def writeLn := \x write x >> write "\n"; + +writeLn (take 10 primes) >> +writeLn (nth 100 primes) >> +writeLn (nth 200 primes) diff --git a/tests/Core/positive/test031.jvc b/tests/Core/positive/test031.jvc new file mode 100644 index 0000000000..75bc70519b --- /dev/null +++ b/tests/Core/positive/test031.jvc @@ -0,0 +1,18 @@ +-- Ackermann function + +def ack := \m \n + if m = 0 then + n + 1 + else if n = 0 then + ack (m - 1) 1 + else + ack (m - 1) (ack m (n - 1)); + +def writeLn := \x write x >> write "\n"; + +writeLn (ack 0 7) >> +writeLn (ack 1 7) >> +writeLn (ack 1 13) >> +writeLn (ack 2 7) >> +writeLn (ack 2 13) >> +writeLn (ack 3 7) diff --git a/tests/Core/positive/test032.jvc b/tests/Core/positive/test032.jvc new file mode 100644 index 0000000000..1bb72ee68f --- /dev/null +++ b/tests/Core/positive/test032.jvc @@ -0,0 +1,25 @@ +-- Ackermann function (higher-order definition) + +def compose := \f \g \x g (f x); + +def iterate := \f \n + if n = 0 then + \x x + else + compose f (iterate f (n - 1)); + +def plus := iterate (+ 1); + +def mult := \m \n iterate (plus n) m 0; + +def exp := \m \n iterate (mult m) n 1; + +def ackermann := \m + iterate (\f \n iterate f (n + 1) 1) m (+ 1); + +def writeLn := \x write x >> write "\n"; + +writeLn (plus 3 7) >> +writeLn (mult 3 7) >> +writeLn (exp 3 7) >> +writeLn (ackermann 3 7) diff --git a/tests/Core/positive/test033.jvc b/tests/Core/positive/test033.jvc new file mode 100644 index 0000000000..b1c4308625 --- /dev/null +++ b/tests/Core/positive/test033.jvc @@ -0,0 +1,22 @@ +-- nested lists + +constr nil 0; +constr cons 2; + +def mklst := \n if n = 0 then nil else cons n (mklst (n - 1)); +def mklst2 := \n if n = 0 then nil else cons (mklst n) (mklst2 (n - 1)); + +def append := \xs \ys case xs of { + nil -> ys; + cons x xs' -> cons x (append xs' ys); +}; + +def flatten := \xs case xs of { + nil -> nil; + cons x xs' -> append x (flatten xs'); +}; + +def writeLn := \x write x >> write "\n"; + +writeLn (mklst2 4) >> +writeLn (flatten (mklst2 4)) diff --git a/tests/Core/positive/test034.jvc b/tests/Core/positive/test034.jvc new file mode 100644 index 0000000000..8a09945f55 --- /dev/null +++ b/tests/Core/positive/test034.jvc @@ -0,0 +1,16 @@ +-- evaluation order + +def g := \x trace x g; + +def f := \x \y + if x = 0 then + 9 + else + trace 1 (f (x - 1) (y 0)); + +def h := \x trace 8 (trace x (x + x)); + +trace ((\x \y \z x + y + z) (trace "1" 1) (trace "2" 2) (trace "3" 3)) ( +trace (f 5 g) (trace 7 ( +h (trace 2 3) +))) diff --git a/tests/Core/positive/test035.jvc b/tests/Core/positive/test035.jvc new file mode 100644 index 0000000000..d3d357438b --- /dev/null +++ b/tests/Core/positive/test035.jvc @@ -0,0 +1,83 @@ +-- merge sort + +constr nil 0; +constr cons 2; + +constr pair 2; + +def length := \xs case xs of { + nil -> 0; + cons _ xs' -> length xs' + 1 +}; + +def split := \n \xs + if n = 0 then + pair nil xs + else + case xs of { + nil -> pair nil nil; + cons x xs' -> + case split (n - 1) xs' of { + pair l1 l2 -> pair (cons x l1) l2 + } + }; + +def merge := \xs \ys case xs of { + nil -> ys; + cons x xs' -> case ys of { + nil -> xs; + cons y ys' -> + if x <= y then + cons x (merge xs' ys) + else + cons y (merge xs ys') + } +}; + +def sort := \xs + let n := length xs in + if n <= 1 then + xs + else + case split (length xs / 2) xs of { + pair l1 l2 -> merge (sort l1) (sort l2) + }; + +def uniq := \xs case xs of { + nil -> nil; + cons x xs' -> case xs' of { + nil -> xs; + cons x' _ -> + if x = x' then + uniq xs' + else + cons x (uniq xs') + } +}; + +def append := \xs \ys case xs of { + nil -> ys; + cons x xs' -> cons x (append xs' ys); +}; + +def flatten := \xs case xs of { + nil -> nil; + cons x xs' -> append x (flatten xs'); +}; + +def take := \n \xs + if n = 0 then + nil + else + case xs of { + cons x xs' -> cons x (take (n - 1) xs') + }; + +def gen := \n \f \acc if n = 0 then acc else gen (n - 1) f (cons (f n) acc); +def gen2 := \m \n \acc if n = 0 then acc else gen2 m (n - 1) (cons (gen m (+ n) nil) acc); + +def writeLn := \x write x >> write "\n"; + +writeLn (take 10 (uniq (sort (flatten (gen2 6 40 nil))))) >> +writeLn (take 10 (uniq (sort (flatten (gen2 9 80 nil))))) >> +writeLn (take 10 (uniq (sort (flatten (gen2 6 80 nil))))) diff --git a/tests/Core/positive/test036.jvc b/tests/Core/positive/test036.jvc new file mode 100644 index 0000000000..60d2d6e7e1 --- /dev/null +++ b/tests/Core/positive/test036.jvc @@ -0,0 +1,100 @@ +-- big numbers + +def power' := \x \y \acc + if y = 0 then + acc + else + power' x (y - 1) (x * acc); +def power := \x \y power' x y 1; + +def neg := \x 0 - x; + +def num1 := 1267650600228229401496703205376; +def num2 := neg 126765060022822940149670320537674809325432; + +def sqrt' := \x \top \bot + if top - bot <= 1 then + bot + else + let y := (top + bot) / 2 + in + if y * y > x then + sqrt' x y bot + else + sqrt' x top y; +def sqrt := \x sqrt' x (x + 1) 0; + +def log' := \x \y \acc + if y = 1 then + acc + else + log' x (y / x) (acc + 1); +def log := \x \y log' x y 0; + +def fast_power' := \x \y \acc + if y = 0 then + acc + else if y % 2 = 1 then + fast_power' (x * x) (y / 2) (x * acc) + else + fast_power' (x * x) (y / 2) acc; +def fast_power := \x \y fast_power' x y 1; + +def writeLn := \x write x >> write "\n"; + +writeLn num1 >> +writeLn num2 >> +writeLn (num1 + num2) >> +writeLn (num1 - num2) >> +writeLn (num1 * num2) >> +writeLn (num2 / num1) >> +writeLn (num2 % num1) >> +writeLn "" >> + +writeLn (power 2 30) >> +writeLn (power 2 31) >> +writeLn (power 2 32) >> +writeLn (power 2 62) >> +writeLn (power 2 63) >> +writeLn (power 2 64) >> +writeLn (power 2 100) >> +writeLn (power (neg 2) 30) >> +writeLn (power (neg 2) 31) >> +writeLn (power (neg 2) 32) >> +writeLn (power (neg 2) 62) >> +writeLn (power (neg 2) 63) >> +writeLn (power (neg 2) 64) >> +writeLn (power (neg 2) 101) >> +writeLn "" >> + +writeLn (sqrt (power 2 128)) >> +writeLn (sqrt (power 3 180)) >> +writeLn (sqrt (power num1 2)) >> +writeLn (sqrt (power num2 2)) >> +writeLn "" >> + +writeLn (log 2 (power 2 100)) >> +writeLn (log 20 (power 20 100)) >> +writeLn (log 9 (power 3 100)) >> +writeLn "" >> + +writeLn (fast_power 2 30) >> +writeLn (fast_power 2 31) >> +writeLn (fast_power 2 32) >> +writeLn (fast_power 2 62) >> +writeLn (fast_power 2 63) >> +writeLn (fast_power 2 64) >> +writeLn (fast_power 2 100) >> +writeLn (fast_power (neg 2) 30) >> +writeLn (fast_power (neg 2) 31) >> +writeLn (fast_power (neg 2) 32) >> +writeLn (fast_power (neg 2) 62) >> +writeLn (fast_power (neg 2) 63) >> +writeLn (fast_power (neg 2) 64) >> +writeLn (fast_power (neg 2) 101) >> +writeLn "" >> + +writeLn (fast_power 2 1000) >> +writeLn (fast_power 3 1000) >> +writeLn (fast_power 2 10000) >> +writeLn (fast_power 2 100000) diff --git a/tests/Core/positive/test037.jvc b/tests/Core/positive/test037.jvc new file mode 100644 index 0000000000..648b6d69ca --- /dev/null +++ b/tests/Core/positive/test037.jvc @@ -0,0 +1,13 @@ +-- global variables + +constr nil 0; + +def x := 3 + 4; + +def f := \y x; + +def g := \y \z x; + +write (f nil) >> +write (g nil nil) >> +write "\n" diff --git a/tests/Core/positive/test038.jvc b/tests/Core/positive/test038.jvc new file mode 100644 index 0000000000..3c325c3bd3 --- /dev/null +++ b/tests/Core/positive/test038.jvc @@ -0,0 +1,11 @@ +-- global variables and forward declarations + +def x := (\x x) 5; + +def g; + +def f := \a \b g a + b; + +def g := \y x * y; + +f 2 3 diff --git a/tests/Core/positive/test039.jvc b/tests/Core/positive/test039.jvc new file mode 100644 index 0000000000..3256c1e3a6 --- /dev/null +++ b/tests/Core/positive/test039.jvc @@ -0,0 +1,22 @@ +-- eta-expansion of builtins and constructors + +constr cons 2; + +def f := \g g 2; +def f' := \x f (+ x); + +def g := \f f 2; +def g' := \x g (cons x); + +def f1 := \g g 2; +def f1' := \x \y f (+ (x / y)); + +def g1 := \f f 2; +def g1' := \x \y g (cons (x / y)); + +def writeLn := \x write x >> write "\n"; + +writeLn (f' 7) >> +writeLn (g' 7) >> +writeLn (f1' 7 2) >> +writeLn (g1' 7 2)