module Main where import VerifiedCompilation open import Agda.Builtin.IO using (IO) import IO.Primitive.Core as IO using (return;_>>=_) open import Agda.Builtin.Unit using (⊤;tt) open import Function using (_$_;_∘_) open import Data.String using (String;_++_) open import Agda.Builtin.Nat open import Agda.Builtin.Int using (pos) open import Data.Integer.Show using (show) open import Data.Product using (Σ) renaming (_,_ to _,,_) open import Data.Bool using (Bool) open import Data.List using (List) open import Data.Empty using (⊥) open import Type using (Ctx⋆;∅;_,⋆_) open import Check using (TypeError;inferType;inferKind;decKind;checkKind;checkType) open TypeError -- Bring all TypeError constructors in scope. open import Scoped.Extrication using (extricateNf⋆;extricate) open import Type.BetaNormal using (_⊢Nf⋆_) import Untyped as U using (_⊢;scopeCheckU0;extricateU0;decUTm) import Untyped.CEKWithCost as U using (stepperC) open import Cost.Base open import Cost using (machineParameters;tallyingMachineParameters;countingReport;tallyingReport) open import Cost.Raw using (RawCostModel) open import Cost.Model using (createMap) import RawU as U using (Untyped) open import Untyped.CEK as U using (stepper;Stack;ε;Env;[];State) open U.State open import Raw using (RawTm;RawTy;rawPrinter;rawTyPrinter;decRTy;decRTm) open import Scoped using (FreeVariableError;ScopeError;freeVariableError;extricateScopeTy;ScopedTm;Weirdℕ;scopeCheckTm;shifter;unshifter;extricateScope;unshifterTy;scopeCheckTy;shifterTy) open Weirdℕ -- Bring Weirdℕ constructors in scope open import Utils using (Either;inj₁;inj₂;withE;Kind;*;Maybe;nothing;just;Monad;RuntimeError;dec2Either;_,_) open RuntimeError open Monad open import Algorithmic using (_⊢_;∅;error) open import Algorithmic.CK using (stepper;State;Stack;ε) open Algorithmic.CK.State open import Algorithmic.CEK using (stepper;State;Stack;ε;Env;[]) open Algorithmic.CEK.State open import Algorithmic.Erasure using (erase) import Algorithmic.Evaluation as L using(stepper) open import Evaluator.Base using (ERROR;reportError) open import Evaluator.Program using (Input;Format;EvalMode;BudgetMode;ProgramN;ProgramNU;evalProgramNU;evalProgramN;typeCheckProgramN) open EvalMode import Evaluator.Term -- Needed only to generate the compiled Haskell file -- There's a long prelude here that could go in a different file but -- currently it's only used here -- Text Stuff postulate putStrLn : String → IO ⊤ {-# FOREIGN GHC import qualified Data.Text.IO as TextIO #-} {-# COMPILE GHC putStrLn = TextIO.putStrLn #-} -- IO Stuff instance IOMonad : Monad IO IOMonad = record { return = IO.return; _>>=_ = IO._>>=_ } -- Parsing stuff postulate FilePath : Set {-# COMPILE GHC FilePath = type FilePath #-} -- System.Exit stuff postulate exitFailure : IO ⊤ exitSuccess : IO ⊤ {-# FOREIGN GHC import System.Exit #-} {-# COMPILE GHC exitSuccess = exitSuccess #-} {-# COMPILE GHC exitFailure = exitFailure #-} -- Input Options stuff {-# FOREIGN GHC import Opts #-} data EvalOptions (A : Set) : Set where EvalOpts : Input → Format → EvalMode → BudgetMode A → EvalOptions A {-# COMPILE GHC EvalOptions = data EvalOptions (EvalOpts) #-} data TypecheckOptions : Set where TCOpts : Input → Format → TypecheckOptions {-# COMPILE GHC TypecheckOptions = data TypecheckOptions (TCOpts) #-} data Command (A : Set) : Set where Eval : EvalOptions A → Command A Typecheck : TypecheckOptions → Command A {-# COMPILE GHC Command = data Command (Eval | Typecheck) #-} {-# FOREIGN GHC import PlutusCore.Executable.Common #-} {-# FOREIGN GHC import PlutusCore.Executable.Parsers #-} postulate execP : IO (Command RawCostModel) parse : Format → Input → IO ProgramN parseU : Format → Input → IO ProgramNU {-# COMPILE GHC execP = execP #-} {-# COMPILE GHC parse = readProgram #-} {-# COMPILE GHC parseU = readProgram #-} evalInput : EvalMode → BudgetMode RawCostModel → Format → Input → IO (Either ERROR String) evalInput U bm fmt inp = fmap (evalProgramNU bm) (parseU fmt inp) evalInput m _ fmt inp = fmap (evalProgramN m) (parse fmt inp) tcInput : Format → Input → IO (Either ERROR String) tcInput fmt inp = fmap typeCheckProgramN (parse fmt inp) main' : Command RawCostModel → IO ⊤ main' (Eval (EvalOpts inp fmt m bm)) = do inj₂ s ← evalInput m bm fmt inp where inj₁ e → putStrLn (reportError e) >> exitFailure putStrLn s >> exitSuccess main' (Typecheck (TCOpts inp fmt)) = do inj₂ s ← tcInput fmt inp where inj₁ e → putStrLn (reportError e) >> exitFailure putStrLn s >> exitSuccess main : IO ⊤ main = execP >>= main'