Skip to content

Commit

Permalink
Merge branch 'develop' into mariari/LLVM
Browse files Browse the repository at this point in the history
  • Loading branch information
mariari committed Nov 8, 2019
2 parents 7609386 + 6c2f941 commit 3622749
Show file tree
Hide file tree
Showing 48 changed files with 1,489 additions and 824 deletions.
1 change: 1 addition & 0 deletions .circleci/config.yml
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,7 @@ jobs:
- run:
name: Run tests
command: stack test
no_output_timeout: 1200

workflows:
version: 2.1
Expand Down
6 changes: 4 additions & 2 deletions app/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,15 @@ import Protolude

data Config
= Config
{ configTezosNode Text
{ configTezosNodeHost Text,
configTezosNodePort Int
}
deriving (Generic)

defaultConfig Config
defaultConfig = Config
{ configTezosNode = "127.0.0.1"
{ configTezosNodeHost = "127.0.0.1",
configTezosNodePort = 8732
}

loadConfig FilePath IO (Maybe Config)
Expand Down
98 changes: 32 additions & 66 deletions app/Interactive.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,12 +8,14 @@ import qualified Juvix.Backends.Graph as Graph
import qualified Juvix.Backends.Maps as Maps ()
import qualified Juvix.Bohm as Bohm
import qualified Juvix.Core as Core
import qualified Juvix.Core.Erased as Erased
import qualified Juvix.Core.HR as HR
import qualified Juvix.Core.HR as Core
import Juvix.Core.Parameterisations.Naturals
import qualified Juvix.EAC as EAC
import Juvix.Library
import qualified Juvix.Nets.Bohm as Bohm
import Monad
import Options
import Protolude
import qualified System.Console.Haskeline as H
import Text.PrettyPrint.ANSI.Leijen hiding ((<>))
import Prelude (String)
Expand Down Expand Up @@ -44,7 +46,7 @@ mainLoop func = do
mainLoop func

parseString String Maybe (Core.Term NatTy NatVal)
parseString = Core.generateParser naturals
parseString = Core.generateParser nat

handleSpecial String H.InputT IO () H.InputT IO ()
handleSpecial str cont = do
Expand All @@ -56,65 +58,35 @@ handleSpecial str cont = do
cont
'c' : 'p' : ' ' : rest do
let parsed = parseString rest
H.outputStrLn $ show parsed
cont
{-
'c' : 't' : ' ' : rest → do
let parsed = Core.parseString Core.term rest
H.outputStrLn $ show parsed
case parsed of
Just cterm → do
let eval = Core.cEval cterm []
H.outputStrLn $ show eval
Nothing → return ()
H.outputStrLn (show parsed)
cont
'c' : 'e' : ' ' : rest do
let parsed = Core.parseString Core.term rest
H.outputStrLn $ show parsed
case parsed of
Just cterm → do
eal ← eraseAndSolveCore cterm
case eal of
Right (term, _) → do
transformAndEvaluateEal True term
_ → return ()
Nothing → return ()
cont
-}
'e' : 'p' : ' ' : rest do
let parsed = EAC.parseEal rest
case parsed of
Right r transformAndEvaluateEal True r
_ return ()
cont
'e' : 'q' : ' ' : rest do
let parsed = EAC.parseEal rest
let parsed = parseString rest
H.outputStrLn (show parsed)
case parsed of
Right r transformAndEvaluateEal False r
_ return ()
Just (HR.Elim (HR.Ann usage term ty)) do
erased liftIO (exec (Core.typecheckErase term usage ty))
H.outputStrLn (show erased)
_ H.outputStrLn "must enter a valid annotated core term"
cont
'e' : 'e' : ' ' : rest do
let parsed = EAC.parseEal rest
H.outputStrLn $ show parsed
'c' : 't' : ' ' : rest do
let parsed = parseString rest
H.outputStrLn (show parsed)
case parsed of
Right r transformAndEvaluateEal True r
_ return ()
Just (HR.Elim (HR.Ann usage term ty)) do
erased liftIO (exec (Core.typecheckAffineErase term usage ty))
H.outputStrLn (show erased)
case erased of
(Right (term, _), _) do
transformAndEvaluateErasedCore True term
_ return ()
_ H.outputStrLn "must enter a valid annotated core term"
cont
_ H.outputStrLn "Unknown special command" >> cont

{-
eraseAndSolveCore ∷
Core.Term → H.InputT IO (Either EAC.Errors (EAC.RPT, EAC.ParamTypeAssignment))
eraseAndSolveCore cterm = do
let (term, typeAssignment) = Core.erase' cterm
res ← liftIO (EAC.validEal term typeAssignment)
H.outputStrLn ("Inferred EAC term & type: " <> show res)
pure res
-}

transformAndEvaluateEal Bool EAC.RPTO H.InputT IO ()
transformAndEvaluateEal debug term = do
let bohm = EAC.ealToBohm term
transformAndEvaluateErasedCore primVal. Bool Erased.Term primVal H.InputT IO ()
transformAndEvaluateErasedCore debug term = do
let bohm = Bohm.erasedCoreToBohm term
when debug $ H.outputStrLn ("Converted to BOHM: " <> show bohm)
let net Graph.FlipNet Bohm.Lang
net = Bohm.astToNet bohm Bohm.defaultEnv
Expand All @@ -129,26 +101,20 @@ transformAndEvaluateEal debug term = do

specialsDoc Doc
specialsDoc =
mconcat
[ line,
mconcat (fmap (flip (<>) line . specialDoc) specials),
line
]
mconcat [line, mconcat (fmap (flip (<>) line . specialDoc) specials), line]

specialDoc Special Doc
specialDoc (Special command helpDesc) =
text $ T.unpack $ mconcat [":", command, " - ", helpDesc]

specials [Special]
specials =
[ Special "cp [term]" "Parse a Juvix Core term",
Special "ct [term}" "Parse, typecheck, & evaluate a Juvix Core term",
[ Special "cp [term]" "Parse a core term",
Special "ce [term]" "Parse, typecheck, & erase a core term",
Special "ct [term}" "Parse, typecheck, & evaluate a core term",
Special
"ce [term"
"Parse a Juvix Core term, translate to EAC, solve constraints, evaluate & read-back",
Special "ep [term]" "Parse an EAC term",
Special "ee [term]" "Parse an EAC term, evaluate & read-back",
Special "eq [term]" "Parse an EAC term, evaluate & read-back quietly",
"cs [term"
"Parse a core term, erase it, translate it to EAC, solve constraints, evaluate & read-back",
Special "tutorial" "Embark upon an interactive tutorial",
Special "?" "Show this help message",
Special "exit" "Quit interactive mode"
Expand Down
2 changes: 1 addition & 1 deletion app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ interactiveDoc =
| |_| | \ V / / \| |
\___/ \_/ /_/\_\_|
|],
mconcat [line, "Juvix interactive alpha. Currently supported backends: in-process interpreter.", line, "Enter :? for help. Enter :tutorial for an interactive tutorial.", line]
mconcat [line, "Juvix interactive alpha.", line, "Currently supported backends: in-process interpreter, in-process interaction net.", line, "Coming soon: Michelson, LLVM, WASM.", line, "Enter :? for help. Enter :tutorial for an interactive tutorial.", line]
]

run Context Options IO ()
Expand Down
32 changes: 32 additions & 0 deletions app/Monad.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
module Monad where

import Juvix.Core.Parameterisations.Naturals
import qualified Juvix.Core.Types as Core
import Juvix.Library hiding (log)

exec EnvExec NatTy NatVal a IO (Either (Core.PipelineError NatTy NatVal) a, [Core.PipelineLog NatTy NatVal])
exec (EnvE env) = do
(ret, env) runStateT (runExceptT env) (Env nat [])
pure (ret, log env)

data Env primTy primVal
= Env
{ parameterisation Core.Parameterisation primTy primVal,
log [Core.PipelineLog primTy primVal]
}
deriving (Generic)

newtype EnvExec primTy primVal a = EnvE (ExceptT (Core.PipelineError primTy primVal) (StateT (Env primTy primVal) IO) a)
deriving (Functor, Applicative, Monad, MonadIO)
deriving
( HasStream "log" [Core.PipelineLog primTy primVal],
HasWriter "log" [Core.PipelineLog primTy primVal]
)
via WriterLog (Field "log" () (MonadState (ExceptT (Core.PipelineError primTy primVal) (StateT (Env primTy primVal) IO))))
deriving
-- TODO: Should be HasReader, this library is finicky.
(HasState "parameterisation" (Core.Parameterisation primTy primVal))
via (Field "parameterisation" () (MonadState (ExceptT (Core.PipelineError primTy primVal) (StateT (Env primTy primVal) IO))))
deriving
(HasThrow "error" (Core.PipelineError primTy primVal))
via MonadError (ExceptT (Core.PipelineError primTy primVal) (StateT (Env primTy primVal) IO))
Binary file modified doc/reference/language-reference.pdf
Binary file not shown.
Loading

0 comments on commit 3622749

Please sign in to comment.