summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lambda-calcul/haskell/public/repl.js17
-rw-r--r--lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs5
-rw-r--r--lambda-calcul/haskell/src/Minilang/REPL/Pure.hs2
-rw-r--r--lambda-calcul/haskell/src/Minilang/REPL/Run.hs17
-rw-r--r--lambda-calcul/haskell/src/Minilang/REPL/Types.hs3
-rw-r--r--lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs5
6 files changed, 26 insertions, 23 deletions
diff --git a/lambda-calcul/haskell/public/repl.js b/lambda-calcul/haskell/public/repl.js
index bd7e743..17be218 100644
--- a/lambda-calcul/haskell/public/repl.js
+++ b/lambda-calcul/haskell/public/repl.js
@@ -49,13 +49,18 @@ function appendOutput(text) {
}
};
-function prettyTerm(term) {
- if(term.tag === "Var") {
+function prettyAST(term) {
+ if(term.tag === "Sym") {
return term.contents;
- } else if(term.tag === "Lam") {
- return "(lam (" + term.contents[0] + ") " + prettyTerm(term.contents[1]) + ")";
+ } else if(term.tag === "Abs") {
+ return "(lam (" + term.contents[0].join(" ") + ") " + prettyAST(term.contents[1]) + ")";
} else if(term.tag === "App") {
- return "(" + prettyTerm(term.contents[0]) + " " + prettyTerm(term.contents[1]) + ")";
+ const pref = "(" + prettyAST(term.contents[0]) + " " + prettyAST(term.contents[1]);
+ if(term.contents[2]) {
+ return pref + " " + term.contents[2].map(prettyAST).join(" ") + ")";
+ } else {
+ return pref + ")";
+ }
}
return JSON.stringify(term);
}
@@ -72,7 +77,7 @@ function prettyType(type) {
function formatResult(text) {
const result = JSON.parse(text);
if (result.tag === "Evaluated") {
- return prettyTerm(result.contents[0]) + ' : ' + prettyType(result.contents[1]);
+ return prettyAST(result.contents[0]) + ' : ' + prettyType(result.contents[2]);
} else if (result.tag === "Msg" ) {
return result.contents;
}
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index fd02ebe..e15dc00 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DeriveAnyClass #-}
module Minilang.Lambda.Parser where
@@ -14,6 +15,8 @@ import qualified Minilang.Lambda.Eval as Eval
import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, parse, some, try)
import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, symbolChar)
import qualified Text.Megaparsec.Char.Lexer as L
+import GHC.Generics (Generic)
+import Data.Aeson (ToJSON, FromJSON)
type Parser = Parsec Void Text
@@ -21,7 +24,7 @@ data ParseError = ParseError Text
deriving (Eq, Show)
data AST = Sym Text | Abs [Text] AST | App AST AST [AST]
- deriving (Eq, Show)
+ deriving (Eq, Show, Generic, ToJSON, FromJSON)
desugar :: AST -> Term
desugar = \case
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs b/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
index 91e71b9..7ca0c85 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
@@ -41,7 +41,7 @@ instance MonadREPL PureREPL where
render :: Out -> Text
render = \case
Msg t -> t
- Evaluated term typ -> pretty (resugar term) <> " : " <> Type.pretty typ
+ Evaluated ast _term typ -> pretty ast <> " : " <> Type.pretty typ
Bye -> "Bye!"
other -> pack (show other)
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs
index 37d4dd2..3984dec 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs
@@ -15,7 +15,7 @@ import Minilang.Lambda.DeBruijn (eval, fromDeBruijn, toDeBruijn)
import Minilang.Lambda.Eval (newEnv)
import Minilang.Lambda.Infer (infer, newContext)
import qualified Minilang.Lambda.Infer as Infer
-import Minilang.Lambda.Parser (desugar, parse)
+import Minilang.Lambda.Parser (desugar, parse, resugar)
import Minilang.Lambda.Unify (Type (TyVar))
import Minilang.REPL.Types
@@ -43,15 +43,16 @@ handleUserInput txt = do
Right expr -> do
let term = desugar expr
v = fromDeBruijn $ eval (toDeBruijn term)
+ ast = resugar v
case language of
Typed ->
case infer term of
Left typeError -> output (Msg $ Infer.render typeError)
Right typ -> do
let
- output (Evaluated v typ)
+ output (Evaluated ast v typ)
Untyped ->
- output (Evaluated v (TyVar "<?>"))
+ output (Evaluated ast v (TyVar "<?>"))
handleCommand ::
(MonadCatch m, MonadREPL m) =>
@@ -89,12 +90,4 @@ loadProgramInEnv prog = do
Left typeError -> output (Msg $ pack $ show typeError)
Right (term, typ, env', context') -> do
setEnv (repl {env = env', context = context'})
- output (Evaluated term typ)
- where
- makeMessage =
- "Loaded \""
- <> ( if Text.length prog > 15
- then Text.take 15 prog <> "..."
- else prog
- )
- <> "\""
+ output (Evaluated (resugar term) term typ)
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs
index 61e92e0..74cf028 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs
@@ -11,6 +11,7 @@ import Minilang.Lambda.Eval (Env, Term, newEnv)
import Minilang.Lambda.Infer (Context, newContext)
import Minilang.Lambda.Unify (Type)
import Text.Read (readMaybe)
+import Minilang.Lambda.Parser (AST)
class (Monad m) => MonadREPL m where
-- | Returns the current environment for this session
@@ -76,7 +77,7 @@ data Content
data Out
= Defined Text Term
- | Evaluated Term Type
+ | Evaluated AST Term Type
| CurrentEnv Env Context Language
| Msg Text
| Bye
diff --git a/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
index b8f8b22..0c2be66 100644
--- a/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
@@ -8,6 +8,7 @@ import Control.Monad (forM)
import Data.Aeson (eitherDecode, encode)
import Minilang.Lambda.Eval (Term (..), newEnv)
import Minilang.Lambda.Infer (newContext)
+import qualified Minilang.Lambda.Parser as AST
import Minilang.Lambda.Unify (Type (..))
import Minilang.Log
import Minilang.REPL.Net
@@ -68,7 +69,7 @@ spec = around withServer $
describe "MiniLang Network REPL" $ do
it "evaluates expression and returns evaluation result" $ \Server {serverPort} -> do
let inp = [In "((lam (x) x) y)"]
- expectedOutput = [Right $ Evaluated (Var "y") (TyVar "b")]
+ expectedOutput = [Right $ Evaluated (AST.Sym "y") (Var "y") (TyVar "b")]
res <- runTestClient serverPort ".newenv1" inp
res `shouldBe` expectedOutput
@@ -91,5 +92,5 @@ spec = around withServer $
res `shouldSatisfy` isEvaluated
isEvaluated :: [Either a Out] -> Bool
-isEvaluated [Right (Evaluated _ _)] = True
+isEvaluated [Right (Evaluated _ _ _)] = True
isEvaluated _ = False
generated by cgit v1.3.1 (git 2.54.0) at 2026-10-24 03:25:04 +0000