diff options
Diffstat (limited to 'lambda-calcul/haskell')
17 files changed, 769 insertions, 137 deletions
diff --git a/lambda-calcul/haskell/app/Main.hs b/lambda-calcul/haskell/app/Main.hs index 6ba9321..8846c81 100644 --- a/lambda-calcul/haskell/app/Main.hs +++ b/lambda-calcul/haskell/app/Main.hs @@ -1,9 +1,11 @@ -import Minilang.REPL (withIO, withTerminal) +import Minilang.REPL (evaluatorFromEnv, withIO, withTerminal) +import Minilang.REPL.Types (Evaluator (..)) import Minilang.Server (startServer, waitServer) import Options.Applicative import System.IO (stdin, stdout) import System.Posix.IO (stdInput) import System.Posix.Terminal (queryTerminal) +import Text.Read (readMaybe) data RunMode = Local @@ -12,7 +14,9 @@ data RunMode data Options = Options { serverPort :: Int, - runMode :: RunMode + runMode :: RunMode, + -- | 'Nothing' means "read from MINILANG_EVAL env var". + evalOpt :: Maybe Evaluator } deriving (Eq, Show) @@ -26,7 +30,7 @@ optionsParser = minilangOptions :: Parser Options minilangOptions = - Options <$> portOption <*> runModeOption + Options <$> portOption <*> runModeOption <*> evalOption portOption :: Parser Int portOption = @@ -36,7 +40,7 @@ portOption = <> short 'p' <> value 7890 <> metavar "INT" - <> help "port to listent on (default: 7890)" + <> help "port to listen on (default: 7890)" ) runModeOption :: Parser RunMode @@ -49,13 +53,32 @@ runModeOption = <> help "run in server mode, listening for client REPLs over HTTP" ) +evalOption :: Parser (Maybe Evaluator) +evalOption = + optional $ + option + (eitherReader parseEvaluator) + ( long "eval" + <> short 'E' + <> metavar "EVALUATOR" + <> help "reduction strategy: DeBruijn (default) or NbE. \ + \Falls back to the MINILANG_EVAL environment variable." + ) + +parseEvaluator :: String -> Either String Evaluator +parseEvaluator s = case readMaybe s of + Just ev -> Right ev + Nothing -> Left $ "Unknown evaluator: " <> show s <> ". Valid values: DeBruijn, NbE" + main :: IO () main = do Options {..} <- execParser optionsParser + -- CLI flag takes precedence; fall back to env var. + ev <- maybe evaluatorFromEnv pure evalOpt case runMode of Local -> do hasTty <- queryTerminal stdInput if hasTty - then withTerminal - else withIO stdin stdout - Server -> startServer serverPort >>= waitServer + then withTerminal ev + else withIO ev stdin stdout + Server -> startServer serverPort ev >>= waitServer diff --git a/lambda-calcul/haskell/challenges.json b/lambda-calcul/haskell/challenges.json index 119115b..75561c5 100644 --- a/lambda-calcul/haskell/challenges.json +++ b/lambda-calcul/haskell/challenges.json @@ -73,7 +73,7 @@ }, { "level": 12, - "description": "Church-encoded booleans: False = lam (f t) f, True = lam (f t) t. A boolean selects one of two arguments — False picks the first, True picks the second. Not flips a boolean by applying it to True and False in swapped order. What is (Not True)?", + "description": "Church-encoded booleans: False = lam (f t) f, True = lam (f t) t. A boolean selects one of two arguments \u2014 False picks the first, True picks the second. Not flips a boolean by applying it to True and False in swapped order. What is (Not True)?", "expr": "(let ((False (lam (f t) f))\n (True (lam (f t) t))\n (Not (lam (b) (b True False))))\n (Not True))", "answer": "(lam (f t) f)" }, @@ -91,7 +91,7 @@ }, { "level": 15, - "description": "Three def declarations with no final expression to evaluate. def statements produce no output on their own — they only extend the environment.", + "description": "Three def declarations with no final expression to evaluate. def statements produce no output on their own \u2014 they only extend the environment.", "expr": "(def False (lam (f t) f))\n (def True (lam (f t) t))\n (def Not (lam (b) (b True False)))", "answer": "" }, @@ -109,7 +109,7 @@ }, { "level": 18, - "description": "Integer literals are native values in this interpreter — they are already fully reduced and need no evaluation. What does the integer 42 reduce to?", + "description": "Integer literals are native values in this interpreter \u2014 they are already fully reduced and need no evaluation. What does the integer 42 reduce to?", "expr": "42", "answer": "42" }, @@ -145,13 +145,13 @@ }, { "level": 24, - "description": "An integer passed as argument to a free variable f produces a stuck neutral term — f has no definition, so (f 42) cannot reduce further. What does (f 42) reduce to?", + "description": "An integer passed as argument to a free variable f produces a stuck neutral term \u2014 f has no definition, so (f 42) cannot reduce further. What does (f 42) reduce to?", "expr": "(f 42)", "answer": "(f 42)" }, { "level": 25, - "description": "An integer in function position applied to an argument cannot reduce — 42 is not a lambda. The result is a stuck neutral application. What does (42 x) reduce to?", + "description": "An integer in function position applied to an argument cannot reduce \u2014 42 is not a lambda. The result is a stuck neutral application. What does (42 x) reduce to?", "expr": "(42 x)", "answer": "(42 x)" }, @@ -169,200 +169,314 @@ }, { "level": 28, + "description": "The interpreter now has built-in arithmetic operators. + takes two integers and returns their sum. What does (+ 3 4) reduce to?", + "expr": "(+ 3 4)", + "answer": "7" + }, + { + "level": 29, + "description": "The built-in - subtracts its second argument from its first. What does (- 10 3) reduce to?", + "expr": "(- 10 3)", + "answer": "7" + }, + { + "level": 30, + "description": "The built-in * multiplies two integers. What does (* 6 7) reduce to?", + "expr": "(* 6 7)", + "answer": "42" + }, + { + "level": 31, + "description": "div performs integer division (truncated toward negative infinity). What does (div 17 5) reduce to?", + "expr": "(div 17 5)", + "answer": "3" + }, + { + "level": 32, + "description": "mod returns the remainder of integer division. What does (mod 17 5) reduce to?", + "expr": "(mod 17 5)", + "answer": "2" + }, + { + "level": 33, + "description": "neg is a unary built-in that negates its argument. What does (neg 5) reduce to?", + "expr": "(neg 5)", + "answer": "-5" + }, + { + "level": 34, + "description": "Built-ins compose freely. * and + can be nested just like lambda applications. What does (* 2 (+ 3 4)) reduce to?", + "expr": "(* 2 (+ 3 4))", + "answer": "14" + }, + { + "level": 35, + "description": "Pythagorean-style expression: (+ (* 3 3) (* 4 4)) computes 9 + 16. What is the result?", + "expr": "(+ (* 3 3) (* 4 4))", + "answer": "25" + }, + { + "level": 36, + "description": "= is a built-in equality test. It returns the Church boolean True (lam (f t) t) when both arguments are equal and False (lam (f t) f) otherwise. What does (= 42 42) reduce to?", + "expr": "(= 42 42)", + "answer": "(lam (f t) t)" + }, + { + "level": 37, + "description": "What does (= 42 0) reduce to? The two integers are not equal, so = returns the Church boolean False.", + "expr": "(= 42 0)", + "answer": "(lam (f t) f)" + }, + { + "level": 38, + "description": "< is a built-in less-than test. It returns the Church boolean True when the first argument is strictly less than the second, False otherwise. What does (< 3 5) reduce to?", + "expr": "(< 3 5)", + "answer": "(lam (f t) t)" + }, + { + "level": 39, + "description": "What does (< 5 3) reduce to? 5 is not less than 3, so < returns the Church boolean False.", + "expr": "(< 5 3)", + "answer": "(lam (f t) f)" + }, + { + "level": 40, + "description": "Built-ins support partial application just like lambdas. Applying + to only one argument produces a function waiting for its second argument. What does (+ 1) reduce to?", + "expr": "(+ 1)", + "answer": "(+ 1)" + }, + { + "level": 41, + "description": "A partially applied built-in is a first-class value that can be passed to and invoked by a lambda. What does ((lam (f) (f 10)) (+ 5)) reduce to?", + "expr": "((lam (f) (f 10)) (+ 5))", + "answer": "15" + }, + { + "level": 42, + "description": "When a built-in operator receives a free variable as one of its arguments it cannot reduce and stays as a stuck neutral term. What does (+ x 1) reduce to?", + "expr": "(+ x 1)", + "answer": "(+ x 1)" + }, + { + "level": 43, + "description": "Division by zero cannot be reduced \u2014 it stays as a stuck neutral application. What does (div 7 0) reduce to?", + "expr": "(div 7 0)", + "answer": "(div 7 0)" + }, + { + "level": 44, + "description": "Use def to bind a lambda that uses * to square its argument, then apply it. What does (square 9) produce in this program?", + "expr": "(def square (lam (x) (* x x)))\n(square 9)", + "answer": "81" + }, + { + "level": 45, + "description": "Use let to bind two integers and compute the sum of their squares. What does (let ((x 3) (y 4)) (+ (* x x) (* y y))) reduce to?", + "expr": "(let ((x 3) (y 4)) (+ (* x x) (* y y)))", + "answer": "25" + }, + { + "level": 46, + "description": "Built-in operators are first-class values: they can be passed as arguments to lambdas. Here a lambda takes an operator f and two arguments x y and applies (f x y). What does ((lam (f x y) (f x y)) + 10 20) reduce to?", + "expr": "((lam (f x y) (f x y)) + 10 20)", + "answer": "30" + }, + { + "level": 47, "description": "Introduce And. And a b = a False b: if a is True it selects its second argument (b); if a is False it selects its first argument (False). Evaluate (And True True).", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def Or (lam (a b) (a b True)))\n(def And (lam (a b) (a False b)))\n(And True True)", "answer": "(lam (f t) t)" }, { - "level": 29, + "level": 48, "description": "Combine Or, And and Not. Evaluate (And (Or False True) (Not False)). Both sub-expressions must reduce to True for And to return True.", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def Not (lam (b) (b True False)))\n(def Or (lam (a b) (a b True)))\n(def And (lam (a b) (a False b)))\n(And (Or False True) (Not False))", "answer": "(lam (f t) t)" }, { - "level": 30, + "level": 49, "description": "Xor (exclusive or) is True when exactly one argument is True. It can be defined as And (Or a b) (Not (And a b)). Evaluate (Xor True False).", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def Not (lam (b) (b True False)))\n(def And (lam (a b) (a False b)))\n(def Or (lam (a b) (a b True)))\n(def Xor (lam (a b) (And (Or a b) (Not (And a b)))))\n(Xor True False)", "answer": "(lam (f t) t)" }, { - "level": 31, + "level": 50, "description": "Evaluate (Xor False False). Two identical inputs to Xor should always yield False.", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def Not (lam (b) (b True False)))\n(def And (lam (a b) (a False b)))\n(def Or (lam (a b) (a b True)))\n(def Xor (lam (a b) (And (Or a b) (Not (And a b)))))\n(Xor False False)", "answer": "(lam (f t) f)" }, { - "level": 32, - "description": "Church-encoded if-then-else. Because our True selects its second argument and False selects its first, ite must swap the branches: ite c t e = c e t. Evaluate (ite True a b) — which branch is returned?", + "level": 51, + "description": "Church-encoded if-then-else. Because our True selects its second argument and False selects its first, ite must swap the branches: ite c t e = c e t. Evaluate (ite True a b) \u2014 which branch is returned?", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def Not (lam (b) (b True False)))\n(def And (lam (a b) (a False b)))\n(def Or (lam (a b) (a b True)))\n(def ite (lam (c t e) (c e t)))\n(ite True a b)", "answer": "a" }, { - "level": 33, + "level": 52, "description": "Evaluate (ite False a b). When the condition is False, the else-branch should be returned.", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def Not (lam (b) (b True False)))\n(def And (lam (a b) (a False b)))\n(def Or (lam (a b) (a b True)))\n(def ite (lam (c t e) (c e t)))\n(ite False a b)", "answer": "b" }, { - "level": 34, + "level": 53, "description": "Church-encoded pairs. pair x y = lam f -> f x y stores two values by passing them to a selector function. fst p = p (lam x y -> x) retrieves the first. Evaluate (fst (pair a b)).", "expr": "(def pair (lam (x y f) (f x y)))\n(def fst (lam (p) (p (lam (x y) x))))\n(def snd (lam (p) (p (lam (x y) y))))\n(fst (pair a b))", "answer": "a" }, { - "level": 35, + "level": 54, "description": "snd p = p (lam x y -> y) retrieves the second element of a Church pair. Evaluate (snd (pair a b)).", "expr": "(def pair (lam (x y f) (f x y)))\n(def fst (lam (p) (p (lam (x y) x))))\n(def snd (lam (p) (p (lam (x y) y))))\n(snd (pair a b))", "answer": "b" }, { - "level": 36, + "level": 55, "description": "Pairs can be nested. (pair a (pair b c)) is a pair whose second element is itself a pair. Evaluate (snd (snd (pair a (pair b c)))).", "expr": "(def pair (lam (x y f) (f x y)))\n(def fst (lam (p) (p (lam (x y) x))))\n(def snd (lam (p) (p (lam (x y) y))))\n(snd (snd (pair a (pair b c))))", "answer": "c" }, { - "level": 37, + "level": 56, "description": "swap exchanges the two elements of a pair: swap p = pair (snd p) (fst p). Evaluate (fst (swap (pair a b))). After swapping, fst should return what was previously snd.", "expr": "(def pair (lam (x y f) (f x y)))\n(def fst (lam (p) (p (lam (x y) x))))\n(def snd (lam (p) (p (lam (x y) y))))\n(def swap (lam (p) (pair (snd p) (fst p))))\n(fst (swap (pair a b)))", "answer": "b" }, { - "level": 38, + "level": 57, "description": "Church numerals encode natural numbers as higher-order functions: n applies its first argument (the successor step) to its second argument (the base) exactly n times. zero = lam s z -> z applies s zero times. Evaluate (zero f x).", "expr": "(def zero (lam (s z) z))\n(zero f x)", "answer": "x" }, { - "level": 39, - "description": "two = lam s z -> s (s z) applies s twice. Evaluate (two f x) — you should see f applied to x twice.", + "level": 58, + "description": "two = lam s z -> s (s z) applies s twice. Evaluate (two f x) \u2014 you should see f applied to x twice.", "expr": "(def two (lam (s z) (s (s z))))\n(two f x)", "answer": "(f (f x))" }, { - "level": 40, + "level": 59, "description": "three = lam s z -> s (s (s z)) applies s three times. Evaluate (three f x).", "expr": "(def three (lam (s z) (s (s (s z)))))\n(three f x)", "answer": "(f (f (f x)))" }, { - "level": 41, + "level": 60, "description": "isZero tests whether a Church numeral is zero. isZero n = n (lam x -> False) True: if n > 0 the step function (lam x -> False) is applied at least once, discarding its argument and returning False; if n = 0 the base True is returned. Evaluate (isZero zero).", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def zero (lam (s z) z))\n(def isZero (lam (n) (n (lam (x) False) True)))\n(isZero zero)", "answer": "(lam (f t) t)" }, { - "level": 42, + "level": 61, "description": "Evaluate (isZero three). Three is not zero, so the step function fires and the result is False.", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def three (lam (s z) (s (s (s z)))))\n(def isZero (lam (n) (n (lam (x) False) True)))\n(isZero three)", "answer": "(lam (f t) f)" }, { - "level": 43, + "level": 62, "description": "The I combinator (identity): I x = x. It is the simplest combinator and the building block of the SKI calculus. Evaluate (I a).", "expr": "(def I (lam (x) x))\n(I a)", "answer": "a" }, { - "level": 44, + "level": 63, "description": "The K combinator (constant): K x y = x. It ignores its second argument and always returns its first. Evaluate (K a b).", "expr": "(def K (lam (x y) x))\n(K a b)", "answer": "a" }, { - "level": 45, - "description": "The S combinator (substitution): S f g x = f x (g x). It distributes its third argument over two functions and applies the results. Evaluate (S f g x) — f and g are free variables here.", + "level": 64, + "description": "The S combinator (substitution): S f g x = f x (g x). It distributes its third argument over two functions and applies the results. Evaluate (S f g x) \u2014 f and g are free variables here.", "expr": "(def S (lam (f g x) ((f x) (g x))))\n(S f g x)", "answer": "(f x (g x))" }, { - "level": 46, + "level": 65, "description": "SKI completeness: S K K encodes the identity function. S K K x = K x (K x) = x. Evaluate (S K K a) and confirm it equals a.", "expr": "(def S (lam (f g x) ((f x) (g x))))\n(def K (lam (x y) x))\n(S K K a)", "answer": "a" }, { - "level": 47, - "description": "The B combinator (composition): B f g x = f (g x). It is function composition. Evaluate (B f g x) — you should see f applied to the result of g applied to x.", + "level": 66, + "description": "The B combinator (composition): B f g x = f (g x). It is function composition. Evaluate (B f g x) \u2014 you should see f applied to the result of g applied to x.", "expr": "(def B (lam (f g x) (f (g x))))\n(B f g x)", "answer": "(f (g x))" }, { - "level": 48, + "level": 67, "description": "The C combinator (flip): C f x y = f y x. It flips the order of the last two arguments of a function. Evaluate (C f a b).", "expr": "(def C (lam (f x y) (f y x)))\n(C f a b)", "answer": "(f b a)" }, { - "level": 49, + "level": 68, "description": "The W combinator (duplication): W f x = f x x. It applies f to x twice, duplicating the argument. Evaluate (W f a).", "expr": "(def W (lam (f x) (f x x)))\n(W f a)", "answer": "(f a a)" }, { - "level": 50, + "level": 69, "description": "Scott-encoded lists. nil = lam c n -> n (the empty list). cons h t = lam c n -> c h t stores head and tail directly. head l = l (lam h t -> h) nil extracts the first element. Evaluate (head (cons a nil)).", "expr": "(def nil (lam (c n) n))\n(def cons (lam (h t c n) (c h t)))\n(def head (lam (l) (l (lam (h t) h) nil)))\n(head (cons a nil))", "answer": "a" }, { - "level": 51, - "description": "tail l = l (lam h t -> t) nil retrieves the rest of a Scott-encoded list. Evaluate (head (tail (cons a (cons b nil)))) — the head of the tail of a two-element list is its second element.", + "level": 70, + "description": "tail l = l (lam h t -> t) nil retrieves the rest of a Scott-encoded list. Evaluate (head (tail (cons a (cons b nil)))) \u2014 the head of the tail of a two-element list is its second element.", "expr": "(def nil (lam (c n) n))\n(def cons (lam (h t c n) (c h t)))\n(def head (lam (l) (l (lam (h t) h) nil)))\n(def tail (lam (l) (l (lam (h t) t) nil)))\n(head (tail (cons a (cons b nil))))", "answer": "b" }, { - "level": 52, + "level": 71, "description": "isNil tests whether a Scott-encoded list is empty. isNil l = l (lam h t -> False) True: a non-empty list immediately calls its cons branch returning False; nil returns its base True. Evaluate (isNil nil).", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def nil (lam (c n) n))\n(def cons (lam (h t c n) (c h t)))\n(def isNil (lam (l) (l (lam (h t) False) True)))\n(isNil nil)", "answer": "(lam (f t) t)" }, { - "level": 53, + "level": 72, "description": "Evaluate (isNil (cons a nil)). A non-empty list is not nil, so the result should be False.", "expr": "(def False (lam (f t) f))\n(def True (lam (f t) t))\n(def nil (lam (c n) n))\n(def cons (lam (h t c n) (c h t)))\n(def isNil (lam (l) (l (lam (h t) False) True)))\n(isNil (cons a nil))", "answer": "(lam (f t) f)" }, { - "level": 54, + "level": 73, "description": "Church-encoded sum types (Either). Left x = lam l r -> l x tags a value as Left; Right x = lam l r -> r x tags it as Right. either f g e = e f g eliminates the sum by applying the matching handler. Evaluate (either f g (Left a)).", "expr": "(def Left (lam (x l r) (l x)))\n(def Right (lam (x l r) (r x)))\n(def either (lam (f g e) (e f g)))\n(either f g (Left a))", "answer": "(f a)" }, { - "level": 55, + "level": 74, "description": "Evaluate (either f g (Right a)). The Right handler g should be applied to a.", "expr": "(def Left (lam (x l r) (l x)))\n(def Right (lam (x l r) (r x)))\n(def either (lam (f g e) (e f g)))\n(either f g (Right a))", "answer": "(g a)" }, { - "level": 56, + "level": 75, "description": "Church-encoded option (Maybe). None = lam n s -> n is the absent case. Some x = lam n s -> s x wraps a value. fromOption default opt = opt default (lam x -> x) returns the wrapped value or the default. Evaluate (fromOption a None).", "expr": "(def None (lam (n s) n))\n(def Some (lam (x n s) (s x)))\n(def fromOption (lam (default opt) (opt default (lam (x) x))))\n(fromOption a None)", "answer": "a" }, { - "level": 57, + "level": 76, "description": "Evaluate (fromOption a (Some b)). The option contains b, so the default a is ignored and b is returned.", "expr": "(def None (lam (n s) n))\n(def Some (lam (x n s) (s x)))\n(def fromOption (lam (default opt) (opt default (lam (x) x))))\n(fromOption a (Some b))", "answer": "b" }, { - "level": 58, + "level": 77, "description": "mapOption applies a function inside an Option without unwrapping it. mapOption f opt = opt None (lam x -> Some (f x)): None maps to None; Some x maps to Some (f x). Evaluate (mapOption f (Some a)) and give its fully reduced form.", "expr": "(def None (lam (n s) n))\n(def Some (lam (x n s) (s x)))\n(def mapOption (lam (f opt) (opt None (lam (x) (Some (f x))))))\n(mapOption f (Some a))", "answer": "(lam (n s) (s (f a)))" }, { - "level": 59, - "description": "The Kleene predecessor uses a pair-stepping trick to compute pred n = n - 1 (with pred zero = zero). Starting from (pair zero zero), each step shifts: (pair (snd p)) (succ (snd p)). After n steps fst of the pair is n-1. Evaluate (pred zero) — it should return zero.", + "level": 78, + "description": "The Kleene predecessor uses a pair-stepping trick to compute pred n = n - 1 (with pred zero = zero). Starting from (pair zero zero), each step shifts: (pair (snd p)) (succ (snd p)). After n steps fst of the pair is n-1. Evaluate (pred zero) \u2014 it should return zero.", "expr": "(def zero (lam (s z) z))\n(def one (lam (s z) (s z)))\n(def pair (lam (x y f) (f x y)))\n(def fst (lam (p) (p (lam (x y) x))))\n(def snd (lam (p) (p (lam (x y) y))))\n(def succ (lam (n s z) (s ((n s) z))))\n(def pred (lam (n) (fst (n (lam (p) (pair (snd p) (succ (snd p)))) (pair zero zero)))))\n(pred zero)", "answer": "(lam (s z) z)" }, { - "level": 60, + "level": 79, "description": "Evaluate (pred one) using the same Kleene predecessor. After one pair-step starting from (pair zero zero) the fst is still zero. Confirm that the predecessor of one is zero.", "expr": "(def zero (lam (s z) z))\n(def one (lam (s z) (s z)))\n(def pair (lam (x y f) (f x y)))\n(def fst (lam (p) (p (lam (x y) x))))\n(def snd (lam (p) (p (lam (x y) y))))\n(def succ (lam (n s z) (s ((n s) z))))\n(def pred (lam (n) (fst (n (lam (p) (pair (snd p) (succ (snd p)))) (pair zero zero)))))\n(pred one)", "answer": "(lam (s z) z)" } -] +]
\ No newline at end of file diff --git a/lambda-calcul/haskell/plan.md b/lambda-calcul/haskell/plan.md index 724b719..7c5627e 100644 --- a/lambda-calcul/haskell/plan.md +++ b/lambda-calcul/haskell/plan.md @@ -83,7 +83,7 @@ self-evaluating value — it needs no reduction. This is the smallest possible e ### What it is -Depends on Extension 1. Add `+`, `-`, `*`, `/`, `mod`, `=`, `<` as first-class built-in +Depends on Extension 1. Add `+`, `-`, `*`, `div`, `mod`, `=`, `<` as first-class built-in functions. The key interpreter challenge beyond the trivial "add a case" is *partial application*: `(+ 1)` must be a valid value — a closure waiting for its second argument — rather than an error. @@ -99,7 +99,7 @@ rather than an error. reads back as a neutral application. **`Minilang.Lambda.Parser`** -- Builtin names (`+`, `-`, `*`, `/`, `mod`, `=`, `<`) are already valid identifiers under +- Builtin names (`+`, `-`, `*`, `div`, `mod`, `=`, `<`) are already valid identifiers under the current `extraIdentifierChars` definition, so no parser change is needed beyond registering them as known names. diff --git a/lambda-calcul/haskell/src/Minilang/App.hs b/lambda-calcul/haskell/src/Minilang/App.hs index 3373b75..0174547 100644 --- a/lambda-calcul/haskell/src/Minilang/App.hs +++ b/lambda-calcul/haskell/src/Minilang/App.hs @@ -20,9 +20,9 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Time (getCurrentTime) import Minilang.API (Challenge (..), LambdaAPI, Score (..), Token (..), User (..), newToken) import Minilang.Lambda.Parser (pretty) -import Minilang.REPL (withInputs) +import Minilang.REPL (withInputs, replEnvWith) import Minilang.REPL.Purer (PurerEnv (..)) -import Minilang.REPL.Types (Command (..), Content (..), In (..), Out (..), initialREPL) +import Minilang.REPL.Types (Command (..), Content (..), Evaluator (..), In (..), Out (..), initialREPL) import Network.Wai.Application.Static (defaultFileServerSettings, staticApp) import Servant (ServerT, err400, err500, errBody, (:<|>) (..), err404) import Servant.Server (Application, Handler (..), Tagged (..)) @@ -31,15 +31,17 @@ import System.Random (StdGen) data Env = Env { gen :: TVar StdGen, users :: TVar (Map Token Score), - challenges :: [Challenge] + challenges :: [Challenge], + evaluator :: Evaluator } -makeEnv :: StdGen -> [Challenge] -> IO Env -makeEnv gen challenges = +makeEnv :: StdGen -> [Challenge] -> Evaluator -> IO Env +makeEnv gen challenges ev = Env <$> newTVarIO gen <*> newTVarIO mempty <*> pure challenges + <*> pure ev newtype AppM a = AppM {runAppM :: ReaderT Env IO a} deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Env) @@ -147,7 +149,8 @@ postAnswer Nothing _ = liftIO $ throwM $ err400 {errBody = "Missing token"} postAnswer (Just token) expected = do checkUserToken token Challenge {expr} <- getCurrentChallenge token - let PurerEnv {outputs} = withInputs initialREPL [Com (Load (Data expr))] + ev <- asks evaluator + let PurerEnv {outputs} = withInputs (replEnvWith ev) [Com (Load (Data expr))] result = evaluateOutputs outputs expected updateUserLastTest token result case result of diff --git a/lambda-calcul/haskell/src/Minilang/Lambda.hs b/lambda-calcul/haskell/src/Minilang/Lambda.hs index ff636ce..fbaf35d 100644 --- a/lambda-calcul/haskell/src/Minilang/Lambda.hs +++ b/lambda-calcul/haskell/src/Minilang/Lambda.hs @@ -1,24 +1,26 @@ module Minilang.Lambda where import Data.Bifunctor (second) -import Minilang.Lambda.DeBruijn (eval, eval', fromDeBruijn, toDeBruijn) -import Minilang.Lambda.Eval (Env, Term) +import Minilang.Lambda.DeBruijn (builtinDeBruijnEnv, eval', fromDeBruijn, toDeBruijn) +import Minilang.Lambda.Eval (Env, Term, builtinEnvValue) +import qualified Minilang.Lambda.Eval as Eval import Minilang.Lambda.Infer (Context, TypeError, extendContext, infer) import Minilang.Lambda.Parser (AST (..), desugar) import Minilang.Lambda.Unify (Type (..)) -import Minilang.REPL.Types (Language (..)) +import Minilang.REPL.Types (Evaluator (..), Language (..)) -- | Top-level evaluator -- Load a list of expressions into given `Env` and `Context`, returning an extended -- `Env` and `Context` with declarations bound and the list of evaluated top-level -- terms along with their types. loadProgram :: + Evaluator -> Language -> Env -> Context -> [AST] -> Either TypeError ([(Term, Type)], Env, Context) -loadProgram language env context exprs = +loadProgram evaluator language env context exprs = fmap (\(res, e, c) -> (reverse res, e, c)) result where result = @@ -38,7 +40,7 @@ loadProgram language env context exprs = exprs runExpr language (Def ident body) env context = - let term = evalInEnv env body + let term = evalInEnvWith evaluator env body in case language of Typed -> case infer term of @@ -48,7 +50,7 @@ loadProgram language env context exprs = Untyped -> Right (Nothing, (ident, term) : env, context) runExpr language expr env context = - let v = evalInEnv env expr + let v = evalInEnvWith evaluator env expr in case language of Typed -> case infer v of @@ -58,8 +60,25 @@ loadProgram language env context exprs = Untyped -> Right (Just (v, TyVar "<?>"), env, context) +-- | Evaluate an 'AST' in the given 'Env' using the De Bruijn CBV evaluator. +-- This is the default evaluator used by the server and REPL. evalInEnv :: Env -> AST -> Term -evalInEnv env expr = +evalInEnv = evalInEnvWith DeBruijn + +-- | Evaluate an 'AST' using the selected 'Evaluator'. +evalInEnvWith :: Evaluator -> Env -> AST -> Term +evalInEnvWith DeBruijn env expr = let term = desugar expr - env' = second toDeBruijn <$> env + -- User-defined bindings take precedence over builtins (rightmost wins + -- in a left-to-right lookup, so put user env first). + env' = (second toDeBruijn <$> env) ++ builtinDeBruijnEnv in fromDeBruijn $ eval' env' (toDeBruijn term) +evalInEnvWith NbE env expr = + let term = desugar expr + -- Build an EnvValue from the user Env by evaluating each binding's + -- Term in the accumulated value env (builtins always available at the + -- bottom). foldl builds left-to-right so earlier bindings are visible + -- when evaluating later ones. + envV = foldl addBinding builtinEnvValue env + addBinding acc (name, t) = (name, Eval.eval acc t) : acc + in Eval.readBack (Eval.eval envV term) diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs b/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs index 1e85ca6..1d2f9e8 100644 --- a/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs +++ b/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs @@ -3,6 +3,7 @@ module Minilang.Lambda.DeBruijn where import Data.List (elemIndex) +import qualified Data.Map.Strict as Map import Data.Text (Text) import qualified Data.Text import Minilang.Lambda.Eval (Term) @@ -11,6 +12,7 @@ import qualified Minilang.Lambda.Eval as Eval data DeBruijn ann = FV Text | FNum Int + | FBuiltin Text -- ^ a fully-applied or partial built-in operator | Var ann Int | Lam ann (DeBruijn ann) | App (DeBruijn ann) (DeBruijn ann) @@ -21,13 +23,21 @@ type Env ann = [(Text, DeBruijn ann)] newEnv :: Env ann newEnv = [] +-- | An environment pre-seeded with every built-in operator name. +-- Each entry maps the name to an 'FBuiltin' node so that 'eval\'' can +-- recognise and reduce applications of those names. +builtinDeBruijnEnv :: Env ann +builtinDeBruijnEnv = + map (\name -> (name, FBuiltin name)) (Map.keys Eval.builtinArity) + fromDeBruijn :: DeBruijn Text -> Term fromDeBruijn = \case - FV x -> Eval.Var x - FNum n -> Eval.Num n - Var s _ -> Eval.Var s - Lam s body -> Eval.Lam s (fromDeBruijn body) - App f a -> Eval.App (fromDeBruijn f) (fromDeBruijn a) + FV x -> Eval.Var x + FNum n -> Eval.Num n + FBuiltin b -> Eval.Var b -- reads back as a Var; eval recognises it + Var s _ -> Eval.Var s + Lam s body -> Eval.Lam s (fromDeBruijn body) + App f a -> Eval.App (fromDeBruijn f) (fromDeBruijn a) -- Convert a term with named variables to De Bruijn indices toDeBruijn :: Term -> DeBruijn Text @@ -36,7 +46,7 @@ toDeBruijn term = go term [] go (Eval.Var x) env = case elemIndex x env of Just idx -> Var x idx - Nothing -> FV x + Nothing -> FV x go (Eval.Lam x body) env = Lam x (go body (x : env)) go (Eval.App f a) env = @@ -48,40 +58,119 @@ eval :: DeBruijn ann -> DeBruijn ann eval (App f a) = case eval f of Lam _ body -> eval (substitute [] 0 a body) - f' -> App f' a + f' -> App f' a eval term = term -eval' :: (Show ann, Eq ann) => Env ann -> DeBruijn ann -> DeBruijn ann -eval' env (FV v) = case lookup v env of - Just term -> term - Nothing -> FV v -eval' env (App f a) = - case eval' env f of - Lam _ body -> eval' env (substitute env 0 a body) - f' -> if f' /= f - then eval' env $ App f' a - else App f' a -eval' _ term = term +eval' :: Env Text -> DeBruijn Text -> DeBruijn Text +eval' env = \case + FV v -> case lookup v env of + Just term -> term + Nothing -> FV v + FBuiltin b -> FBuiltin b + App f a -> + let f' = eval' env f + a' = eval' env a + in case f' of + -- Beta-reduction + Lam _ body -> eval' env (substitute env 0 a' body) + -- Built-in: collect arguments and reduce when saturated + FBuiltin b -> evalBuiltin env b [a'] + -- Left-spine is itself a partial builtin application + App g arg -> + case collectBuiltin (App g arg) of + Just (b, accumulated) -> evalBuiltin env b (accumulated ++ [a']) + Nothing -> + let applied = App f' a' + in if applied /= App f a + then eval' env applied + else applied + f'' -> + let applied = App f'' a' + in if applied /= App f a + then eval' env applied + else applied + term -> term + +-- | Walk a left-spine of 'App' nodes and check whether the root is an +-- 'FBuiltin'. If so, return the builtin name and the already-accumulated +-- arguments (left-to-right order). +collectBuiltin :: DeBruijn Text -> Maybe (Text, [DeBruijn Text]) +collectBuiltin = go [] + where + go acc (App f arg) = go (arg : acc) f + go acc (FBuiltin b) = Just (b, acc) + go _ _ = Nothing + +-- | Attempt to reduce a built-in application once all required arguments +-- are present. Falls back to a neutral 'App' spine when the arity has not +-- been reached yet or when the arguments are not integer literals. +evalBuiltin :: Env Text -> Text -> [DeBruijn Text] -> DeBruijn Text +evalBuiltin env b args = + case Map.lookup b Eval.builtinArity of + Nothing -> rebuild (FBuiltin b) args -- unknown builtin; leave as-is + Just ar + | length args < ar -> + -- Still partial: return the spine as-is for now + rebuild (FBuiltin b) args + | length args == ar -> + case tryReduce b args of + Just result -> result + Nothing -> rebuild (FBuiltin b) args + | otherwise -> + -- Over-applied: reduce with exactly `ar` args then apply the rest + let (sat, extra) = splitAt ar args + in case tryReduce b sat of + Just reduced -> foldl (\acc x -> eval' env (App acc x)) reduced extra + Nothing -> rebuild (FBuiltin b) args + +-- | Church-encoded True as a DeBruijn term: lam f -> lam t -> t +churchTrue :: DeBruijn Text +churchTrue = Lam "f" (Lam "t" (Var "t" 0)) + +-- | Church-encoded False as a DeBruijn term: lam f -> lam t -> f +churchFalse :: DeBruijn Text +churchFalse = Lam "f" (Lam "t" (Var "f" 1)) + +-- | Attempt a numeric reduction. Returns 'Nothing' when either argument is +-- not an 'FNum' (e.g. it is still a free variable). +-- Comparison operators return Church booleans rather than integer flags. +tryReduce :: Text -> [DeBruijn Text] -> Maybe (DeBruijn Text) +tryReduce name args = case (name, args) of + ("+", [FNum x, FNum y]) -> Just $ FNum (x + y) + ("-", [FNum x, FNum y]) -> Just $ FNum (x - y) + ("*", [FNum x, FNum y]) -> Just $ FNum (x * y) + ("div", [FNum x, FNum y]) | y /= 0 -> Just $ FNum (x `div` y) + ("mod", [FNum x, FNum y]) | y /= 0 -> Just $ FNum (x `mod` y) + ("=", [FNum x, FNum y]) -> Just $ if x == y then churchTrue else churchFalse + ("<", [FNum x, FNum y]) -> Just $ if x < y then churchTrue else churchFalse + ("neg", [FNum x]) -> Just $ FNum (negate x) + _ -> Nothing + +-- | Rebuild a left-spine application from a head and a list of arguments. +rebuild :: DeBruijn Text -> [DeBruijn Text] -> DeBruijn Text +rebuild = foldl App substitute :: Env ann -> Int -> DeBruijn ann -> DeBruijn ann -> DeBruijn ann substitute env n arg term = case term of FV x -> case lookup x env of - Just term -> term + Just t -> t Nothing -> FV x - FNum _ -> term + FNum _ -> term + FBuiltin _ -> term Var t x - | x == n -> arg + | x == n -> arg | otherwise -> Var t x - Lam x body -> Lam x (substitute env (n + 1) arg body) - App f a -> App (substitute env n arg f) (substitute env n arg a) + Lam x body -> Lam x (substitute env (n + 1) arg body) + App f a -> App (substitute env n arg f) (substitute env n arg a) pretty :: DeBruijn Text -> Text pretty = \case - FV x -> x - FNum n -> showNum n - Var s _ -> s + FV x -> x + FNum n -> showNum n + FBuiltin b -> b + Var s _ -> s Lam s body -> "(lam (" <> s <> ") " <> pretty body <> ")" - App f a -> "(" <> pretty f <> " " <> pretty a <> ")" + App f a -> "(" <> pretty f <> " " <> pretty a <> ")" -- | Render an integer, using no space between '-' and digits for negative numbers. showNum :: Int -> Text diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs index 650c4bd..324c881 100644 --- a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs +++ b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs @@ -4,6 +4,8 @@ module Minilang.Lambda.Eval where import Data.Aeson (FromJSON, ToJSON) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.String (IsString (..)) import Data.Text (Text, pack) import GHC.Generics (Generic) @@ -18,7 +20,14 @@ data Term instance IsString Term where fromString = Var . pack -data Value = Clos EnvValue Text Term | VNeut Neutral | VNum Int +-- | A built-in arithmetic operator value. +-- Carries its name, the number of arguments still needed, and the +-- already-accumulated argument values (in order of application). +data Value + = Clos EnvValue Text Term + | VNeut Neutral + | VNum Int + | Builtin Text Int [Value] deriving (Show, Read, Eq) data Neutral = NVar Text | NNum Int | NApp Neutral Value @@ -31,15 +40,36 @@ type EnvValue = [(Text, Value)] newEnv :: Env newEnv = [] +-- | Arity table for every built-in operator. +builtinArity :: Map Text Int +builtinArity = Map.fromList + [ ("+", 2) + , ("-", 2) + , ("*", 2) + , ("div", 2) + , ("mod", 2) + , ("=", 2) + , ("<", 2) + , ("neg", 1) + ] + +-- | The set of built-in names, for fast membership testing. +builtinNames :: Map Text Value +builtinNames = Map.mapWithKey (\name ar -> Builtin name ar []) builtinArity + normalise :: Term -> Term -normalise term = readBack (eval [] term) +normalise term = readBack (eval builtinEnvValue term) + +-- | An 'EnvValue' pre-seeded with all built-in operators. +builtinEnvValue :: EnvValue +builtinEnvValue = Map.toList builtinNames -- call-by-value evaluator -- from https://davidchristiansen.dk/tutorials/nbe/#%28part._untyped-eval%29 eval :: EnvValue -> Term -> Value eval env = \case Var x -> case lookup x env of - Just term -> term + Just v -> v Nothing -> VNeut (NVar x) Lam x body -> Clos env x body App f a -> @@ -55,21 +85,59 @@ apply f a = let env' = (x, a) : closureEnv in eval env' body VNeut f' -> VNeut (NApp f' a) - VNum n -> VNeut (NApp (NNum n) a) + VNum n -> VNeut (NApp (NNum n) a) + -- Last argument arrives: dispatch and reduce. + Builtin name 1 args -> dispatchBuiltin name (args ++ [a]) + -- Still waiting for more arguments: accumulate. + Builtin name ar args -> Builtin name (ar - 1) (args ++ [a]) + +-- | Church-encoded True: lam f t -> t +churchTrue :: Value +churchTrue = Clos builtinEnvValue "f" (Lam "t" (Var "t")) + +-- | Church-encoded False: lam f t -> f +churchFalse :: Value +churchFalse = Clos builtinEnvValue "f" (Lam "t" (Var "f")) + +-- | Reduce a fully-saturated built-in application. +-- If the arguments are not both integers (free variables in function +-- position), fall back to a stuck neutral term. +-- Comparison operators (= and <) return Church booleans rather than integers. +dispatchBuiltin :: Text -> [Value] -> Value +dispatchBuiltin name args = case (name, args) of + ("+", [VNum x, VNum y]) -> VNum (x + y) + ("-", [VNum x, VNum y]) -> VNum (x - y) + ("*", [VNum x, VNum y]) -> VNum (x * y) + ("div", [VNum x, VNum y]) + | y /= 0 -> VNum (x `div` y) + ("mod", [VNum x, VNum y]) + | y /= 0 -> VNum (x `mod` y) + ("=", [VNum x, VNum y]) -> if x == y then churchTrue else churchFalse + ("<", [VNum x, VNum y]) -> if x < y then churchTrue else churchFalse + ("neg", [VNum x]) -> VNum (negate x) + -- Stuck: reconstruct a neutral application chain rooted at the builtin name. + _ -> foldl (\acc v -> VNeut (NApp (neutralOf acc) v)) (VNeut (NVar name)) args + where + neutralOf (VNeut n) = n + neutralOf v = NApp (NVar name) v -- shouldn't happen in practice readBack :: Value -> Term readBack = go [] where go names = \case Clos env x body -> - let name = freshName x names + let name = freshName x names names' = name : names - val' = eval ((x, VNeut (NVar name)) : env) body + val' = eval ((x, VNeut (NVar name)) : env) body in Lam name (go names' val') - VNeut (NVar n) -> Var n - VNeut (NNum n) -> Num n - VNeut (NApp f a) -> App (go names (VNeut f)) (go names a) - VNum n -> Num n + VNeut (NVar n) -> Var n + VNeut (NNum n) -> Num n + VNeut (NApp f a) -> App (go names (VNeut f)) (go names a) + VNum n -> Num n + -- A partial builtin reads back as a chain of applications rooted at + -- the builtin name, e.g. Builtin "+" 1 [VNum 3] → App (Var "+") (Num 3) + Builtin bname _ accumulated -> + foldl (\acc v -> App acc (go names v)) (Var bname) accumulated freshName :: Text -> [Text] -> Text freshName x names diff --git a/lambda-calcul/haskell/src/Minilang/REPL.hs b/lambda-calcul/haskell/src/Minilang/REPL.hs index a8d3c77..7da2042 100644 --- a/lambda-calcul/haskell/src/Minilang/REPL.hs +++ b/lambda-calcul/haskell/src/Minilang/REPL.hs @@ -23,6 +23,8 @@ import Minilang.REPL.Pure import Minilang.REPL.Purer import Minilang.REPL.Run import Minilang.REPL.Types +import System.Environment (lookupEnv) +import Text.Read (readMaybe) import System.Console.Haskeline ( defaultBehavior, defaultSettings, @@ -30,13 +32,32 @@ import System.Console.Haskeline runInputTBehavior, setComplete, ) -import System.IO (Handle) +import System.IO (Handle, stderr) + +-- | Read the evaluator selection from the @MINILANG_EVAL@ environment variable. +-- Returns 'DeBruijn' when the variable is absent or unrecognised. +evaluatorFromEnv :: IO Evaluator +evaluatorFromEnv = + lookupEnv "MINILANG_EVAL" >>= \case + Nothing -> pure DeBruijn + Just raw -> case readMaybe raw of + Just ev -> pure ev + Nothing -> do + Text.hPutStrLn stderr $ + "Warning: unknown MINILANG_EVAL value " <> Text.pack (show raw) + <> ", falling back to DeBruijn" + pure DeBruijn + +-- | Build the initial 'REPLEnv' using the given 'Evaluator'. +replEnvWith :: Evaluator -> REPLEnv +replEnvWith ev = initialREPL { evaluator = ev } -- * Haskeline REPL -withTerminal :: IO () -withTerminal = - runInputTBehavior defaultBehavior settings $ evalStateT (runHaskeline runREPL) initialREPL +withTerminal :: Evaluator -> IO () +withTerminal ev = + runInputTBehavior defaultBehavior settings $ + evalStateT (runHaskeline runREPL) (replEnvWith ev) where settings = setComplete completion $ defaultSettings {historyFile = Just "~/.minilang.history"} @@ -50,12 +71,12 @@ withHandles hin hout = evalStateT (runConsole runREPL) (IOEnv hin hout initialREPL) -- | Simple IO REPL, used to evaluate programs from stdin or file loading -withIO :: Handle -> Handle -> IO () -withIO hin hout = do +withIO :: Evaluator -> Handle -> Handle -> IO () +withIO ev hin hout = do programText <- parseProgram <$> Text.hGetContents hin case programText of Left err -> Text.hPutStrLn hout (Text.pack (show err)) - Right prog -> case loadProgram Untyped newEnv newContext prog of + Right prog -> case loadProgram ev Untyped newEnv newContext prog of Right (results, _, _) -> mapM_ (Text.hPutStrLn hout . render) results Left err -> Text.hPutStrLn hout (Text.pack $ show err) where diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs index 8b9b844..26f3cad 100644 --- a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs +++ b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs @@ -8,7 +8,7 @@ module Minilang.REPL.Run where import Control.Monad.Catch import Data.Text hiding (replicate) -import Minilang.Lambda (loadProgram, evalInEnv) +import Minilang.Lambda (loadProgram, evalInEnvWith) import Minilang.Lambda.Eval (newEnv) import Minilang.Lambda.Infer (extendContext, infer, newContext) import qualified Minilang.Lambda.Infer as Infer @@ -34,11 +34,11 @@ handleUserInput :: Text -> m () handleUserInput txt = do - repl@REPLEnv {language, env, context} <- getEnv + repl@REPLEnv {language, evaluator, env, context} <- getEnv case parse txt of Left err -> output (Msg $ pack $ show err) Right (Def ident body) -> do - let v = evalInEnv env body + let v = evalInEnvWith evaluator env body case language of Typed -> case infer v of @@ -54,7 +54,7 @@ handleUserInput txt = do setEnv $ repl {env = (ident, v) : env} output (Defined ident (TyVar "<?>")) Right expr -> do - let v = evalInEnv env expr + let v = evalInEnvWith evaluator env expr ast = resugar v case language of Typed -> @@ -86,6 +86,10 @@ handleCommand (Set (SelectLanguage lang)) = getEnv >>= \e -> setEnv (e {language = lang}) >> output (Msg $ "Language set to " <> pack (show lang)) +handleCommand (Set (SelectEvaluator ev)) = + getEnv >>= \e -> + setEnv (e {evaluator = ev}) + >> output (Msg $ "Evaluator set to " <> pack (show ev)) handleCommand Help = output (Msg helpText) @@ -94,11 +98,11 @@ loadProgramInEnv :: Text -> m () loadProgramInEnv prog = do - repl@REPLEnv {env, context, language} <- getEnv + repl@REPLEnv {env, context, language, evaluator} <- getEnv case parseProgram prog of Left err -> output (Msg $ pack $ show err) Right exprs -> do - case loadProgram language env context exprs of + case loadProgram evaluator language env context exprs of Left typeError -> output (Msg $ pack $ show typeError) Right (results, env', context') -> do setEnv (repl {env = env', context = context'}) diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs index baa59ff..0b0472e 100644 --- a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs +++ b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs @@ -49,11 +49,12 @@ data REPLEnv = REPLEnv curIndent :: Int, stepTypeCheck :: Bool, debugParser :: Bool, - language :: Language + language :: Language, + evaluator :: Evaluator } initialREPL :: REPLEnv -initialREPL = REPLEnv newEnv newContext 0 False False Untyped +initialREPL = REPLEnv newEnv newContext 0 False False Untyped DeBruijn -- | Input data In @@ -87,11 +88,22 @@ data Flag = StepTypeChecker Bool | DebugParser Bool | SelectLanguage Language + | SelectEvaluator Evaluator deriving (Eq, Show, Generic, ToJSON, FromJSON) data Language = Untyped | Typed deriving (Eq, Show, Read, Generic, ToJSON, FromJSON) +-- | Which reduction strategy to use. +-- +-- * 'DeBruijn' — call-by-value head reduction on De Bruijn-indexed terms +-- (the original evaluator). +-- * 'NbE' — Normalisation by Evaluation: eval to a 'Value' semantic domain, +-- then read back to a 'Term'. Reduces under lambda binders and therefore +-- produces fully-normalised terms. +data Evaluator = DeBruijn | NbE + deriving (Eq, Show, Read, Generic, ToJSON, FromJSON) + -- | "Parse" given `Text` into some input for the REPL interpret :: Text -> In @@ -113,6 +125,10 @@ interpret (unpack -> (':' : 'l' : 'a' : 'n' : 'g' : ' ' : lang)) = case readMaybe lang of Nothing -> Com Help Just l -> Com $ Set $ SelectLanguage l +interpret (unpack -> (':' : 'e' : 'v' : 'a' : 'l' : ' ' : ev)) = + case readMaybe ev of + Nothing -> Com Help + Just e -> Com $ Set $ SelectEvaluator e interpret t = In t helpText :: Text @@ -128,6 +144,8 @@ helpText = " :set <option> : Set an option modifying the interpreter's behaviour", " :unset <option> : Remove an option that's been set previously", " :l(oad) <file> : load content of <file> into the interpreter, parsing and type-checking it", + " :lang <Language> : Switch type-checking language (Untyped | Typed)", + " :eval <Evaluator>: Switch reduction strategy (DeBruijn | NbE)", "", "Options: ", " step : Run the typechecker step-by-step, pausing at each rule application and", diff --git a/lambda-calcul/haskell/src/Minilang/Server.hs b/lambda-calcul/haskell/src/Minilang/Server.hs index 4252669..1b9fa25 100644 --- a/lambda-calcul/haskell/src/Minilang/Server.hs +++ b/lambda-calcul/haskell/src/Minilang/Server.hs @@ -26,6 +26,7 @@ import Data.Swagger (Swagger) import Data.Text (Text) import Minilang.API (Challenge, LambdaAPI, defaultChallenges) import Minilang.App (Env (..), lambdaApp, makeEnv, runApp) +import Minilang.REPL.Types (Evaluator (..)) import Minilang.Log import Minilang.OpenApi (lambdaSwagger) import Minilang.REPL.Net @@ -45,16 +46,16 @@ data Server = Server serverPort :: Int } --- | Starts HTTP server on given port. +-- | Starts HTTP server on given port using the specified 'Evaluator'. -- This server serves static files from public/ directory and also -- exposes a WebSocket-based REPL under `/repl` path. -startServer :: Int -> IO Server -startServer serverPort = do +startServer :: Int -> Evaluator -> IO Server +startServer serverPort ev = do envs <- newTVarIO mempty logger <- newLog "minilang" loggerMiddleware <- runHTTPLog logger challenges <- readChallenges logger - env <- newStdGen >>= (`makeEnv` challenges) + env <- newStdGen >>= \g -> makeEnv g challenges ev let app = loggerMiddleware $ runNetREPL logger envs (serveAPI env) diff --git a/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs b/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs index fa87cef..ef05e20 100644 --- a/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs @@ -7,6 +7,7 @@ import Data.Aeson (eitherDecodeFileStrict) import Data.Proxy (Proxy (..)) import Data.Text (Text) import Minilang.API +import Minilang.REPL.Types (Evaluator (..)) import Minilang.Server (Server (..), startServer, stopServer) import Network.HTTP.Client (defaultManagerSettings, newManager) import Servant.API ((:<|>) (..)) @@ -24,7 +25,6 @@ leaderboardClient :: ClientM [Score] scoreClient :: Maybe Token -> ClientM Score challengeClient :: Maybe Token -> ClientM Challenge answerClient :: Maybe Token -> Text -> ClientM () - registerClient :<|> unregisterClient :<|> leaderboardClient @@ -57,7 +57,7 @@ runC env action = spec :: Spec spec = - around withServer $ + around (withServer DeBruijn) $ describe "Full contest integration" $ do it "Alice can solve all challenges and reach the maximum grade" $ \Server{serverPort} -> do @@ -102,5 +102,5 @@ solveChallenge env token Challenge{level, answer} = do -- | Spawn the real server (which itself reads challenges.json and picks a -- free port) and tear it down after the test. -withServer :: (Server -> IO ()) -> IO () -withServer = bracket (startServer 0) stopServer +withServer :: Evaluator -> (Server -> IO ()) -> IO () +withServer evaluator = bracket (startServer 0 evaluator) stopServer diff --git a/lambda-calcul/haskell/test/Minilang/Lambda/DeBruijnSpec.hs b/lambda-calcul/haskell/test/Minilang/Lambda/DeBruijnSpec.hs index 85c9d6b..eaff77c 100644 --- a/lambda-calcul/haskell/test/Minilang/Lambda/DeBruijnSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/Lambda/DeBruijnSpec.hs @@ -1,9 +1,9 @@ {-# LANGUAGE TypeApplications #-} module Minilang.Lambda.DeBruijnSpec where -import Minilang.Lambda.DeBruijn (DeBruijn (..), eval, toDeBruijn, eval') +import Minilang.Lambda.DeBruijn (DeBruijn (..), Env, builtinDeBruijnEnv, eval, toDeBruijn, eval') import qualified Minilang.Lambda.Eval as Eval -import Test.Hspec (Spec, it, shouldBe) +import Test.Hspec (Spec, describe, it, shouldBe) import Data.Text (Text) spec :: Spec @@ -21,5 +21,63 @@ spec = do it "evaluates deBruijn term in env" $ do let term = App (FV "z") (FV "t") - env = [("z", toDeBruijn $ Eval.Lam "x" (Eval.Var "x"))] - eval' @Text env term `shouldBe` FV "t" + env = [("z", toDeBruijn $ Eval.Lam "x" (Eval.Var "x"))] + eval' env term `shouldBe` FV "t" + + describe "built-in arithmetic" $ do + let benv = builtinDeBruijnEnv :: Env Text + + it "(+ 3 4) reduces to FNum 7" $ + eval' benv (App (App (FBuiltin "+") (FNum 3)) (FNum 4)) + `shouldBe` FNum 7 + + it "(- 10 3) reduces to FNum 7" $ + eval' benv (App (App (FBuiltin "-") (FNum 10)) (FNum 3)) + `shouldBe` FNum 7 + + it "(* 2 5) reduces to FNum 10" $ + eval' benv (App (App (FBuiltin "*") (FNum 2)) (FNum 5)) + `shouldBe` FNum 10 + + it "(div 10 3) reduces to FNum 3" $ + eval' benv (App (App (FBuiltin "div") (FNum 10)) (FNum 3)) + `shouldBe` FNum 3 + + it "(mod 10 3) reduces to FNum 1" $ + eval' benv (App (App (FBuiltin "mod") (FNum 10)) (FNum 3)) + `shouldBe` FNum 1 + + it "(= 3 3) reduces to Church True" $ + eval' benv (App (App (FBuiltin "=") (FNum 3)) (FNum 3)) + `shouldBe` Lam "f" (Lam "t" (Var "t" 0)) + + it "(= 3 4) reduces to Church False" $ + eval' benv (App (App (FBuiltin "=") (FNum 3)) (FNum 4)) + `shouldBe` Lam "f" (Lam "t" (Var "f" 1)) + + it "(< 2 5) reduces to Church True" $ + eval' benv (App (App (FBuiltin "<") (FNum 2)) (FNum 5)) + `shouldBe` Lam "f" (Lam "t" (Var "t" 0)) + + it "(< 5 2) reduces to Church False" $ + eval' benv (App (App (FBuiltin "<") (FNum 5)) (FNum 2)) + `shouldBe` Lam "f" (Lam "t" (Var "f" 1)) + + it "(neg 7) reduces to FNum -7" $ + eval' benv (App (FBuiltin "neg") (FNum 7)) + `shouldBe` FNum (-7) + + it "(+ 1) partial: stays as a spine without reducing" $ + eval' benv (App (FBuiltin "+") (FNum 1)) + `shouldBe` App (FBuiltin "+") (FNum 1) + + it "(div 1 0) stays stuck" $ + eval' benv (App (App (FBuiltin "div") (FNum 1)) (FNum 0)) + `shouldBe` App (App (FBuiltin "div") (FNum 1)) (FNum 0) + + it "(+ x 1) with free x stays stuck" $ + eval' benv (App (App (FBuiltin "+") (FV "x")) (FNum 1)) + `shouldBe` App (App (FBuiltin "+") (FV "x")) (FNum 1) + + it "lookup of '+' in builtin env yields FBuiltin" $ + eval' benv (FV "+") `shouldBe` FBuiltin "+" diff --git a/lambda-calcul/haskell/test/Minilang/Lambda/EvalSpec.hs b/lambda-calcul/haskell/test/Minilang/Lambda/EvalSpec.hs index f07b5a2..e5075f0 100644 --- a/lambda-calcul/haskell/test/Minilang/Lambda/EvalSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/Lambda/EvalSpec.hs @@ -1,11 +1,21 @@ +{-# LANGUAGE LambdaCase #-} module Minilang.Lambda.EvalSpec (spec) where import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_) -import Minilang.Lambda.Eval (Term (..), Value (..), eval, normalise) -import Test.Hspec (Spec, describe, it, shouldBe) +import Data.Aeson (eitherDecodeFileStrict) +import Data.Text (Text, pack) +import qualified Data.Text as Text +import Minilang.API (Challenge (..)) +import Minilang.Lambda (loadProgram) +import qualified Minilang.Lambda.DeBruijn as DB +import Minilang.Lambda.DeBruijn (toDeBruijn) +import Minilang.Lambda.Eval (Env, Term (..), Value (..), eval, normalise, builtinEnvValue, newEnv) +import Minilang.Lambda.Infer (newContext) +import Minilang.Lambda.Parser (parseProgram) +import Minilang.REPL.Types (Evaluator (..), Language (..)) +import Test.Hspec (Spec, describe, it, runIO, shouldBe) import Test.Hspec.QuickCheck (prop) -import Data.Text (pack) import Test.QuickCheck (NonEmptyList (..), arbitrary, forAll, (===)) spec :: Spec @@ -87,6 +97,113 @@ spec = do normalise (App (Num n) (Var (pack x))) === App (Num (n :: Int)) (Var (pack x)) + describe "built-in arithmetic" $ do + -- Basic two-argument reductions + it "(+ 3 4) normalises to 7" $ + normalise (App (App (Var "+") (Num 3)) (Num 4)) `shouldBe` Num 7 + + it "(- 10 3) normalises to 7" $ + normalise (App (App (Var "-") (Num 10)) (Num 3)) `shouldBe` Num 7 + + it "(* 2 5) normalises to 10" $ + normalise (App (App (Var "*") (Num 2)) (Num 5)) `shouldBe` Num 10 + + it "(div 10 3) normalises to 3" $ + normalise (App (App (Var "div") (Num 10)) (Num 3)) `shouldBe` Num 3 + + it "(mod 10 3) normalises to 1" $ + normalise (App (App (Var "mod") (Num 10)) (Num 3)) `shouldBe` Num 1 + + it "(= 3 3) normalises to Church True" $ + normalise (App (App (Var "=") (Num 3)) (Num 3)) + `shouldBe` Lam "f" (Lam "t" (Var "t")) + + it "(= 3 4) normalises to Church False" $ + normalise (App (App (Var "=") (Num 3)) (Num 4)) + `shouldBe` Lam "f" (Lam "t" (Var "f")) + + it "(< 2 5) normalises to Church True" $ + normalise (App (App (Var "<") (Num 2)) (Num 5)) + `shouldBe` Lam "f" (Lam "t" (Var "t")) + + it "(< 5 2) normalises to Church False" $ + normalise (App (App (Var "<") (Num 5)) (Num 2)) + `shouldBe` Lam "f" (Lam "t" (Var "f")) + + -- Compose with Church ite: (ite (= 3 3) (Num 1) (Num 2)) == 1 + -- ite c t e = c e t (True picks second arg, False picks first) + it "(= 3 3) composes with Church ite to select then-branch" $ + let ite = Lam "c" (Lam "t" (Lam "e" (App (App (Var "c") (Var "e")) (Var "t")))) + in normalise (App (App (App ite (App (App (Var "=") (Num 3)) (Num 3))) (Num 1)) (Num 2)) + `shouldBe` Num 1 + + it "(< 5 2) composes with Church ite to select else-branch" $ + let ite = Lam "c" (Lam "t" (Lam "e" (App (App (Var "c") (Var "e")) (Var "t")))) + in normalise (App (App (App ite (App (App (Var "<") (Num 5)) (Num 2))) (Num 1)) (Num 2)) + `shouldBe` Num 2 + + it "(neg 7) normalises to -7" $ + normalise (App (Var "neg") (Num 7)) `shouldBe` Num (-7) + + it "(neg -3) normalises to 3" $ + normalise (App (Var "neg") (Num (-3))) `shouldBe` Num 3 + + -- Nested arithmetic + it "(* 2 (+ 1 4)) normalises to 10" $ + normalise (App (App (Var "*") (Num 2)) (App (App (Var "+") (Num 1)) (Num 4))) + `shouldBe` Num 10 + + -- Properties + prop "addition is commutative" $ \x y -> + normalise (App (App (Var "+") (Num x)) (Num y)) + === normalise (App (App (Var "+") (Num y)) (Num (x :: Int))) + + prop "subtraction is the inverse of addition" $ \x y -> + normalise (App (App (Var "-") (App (App (Var "+") (Num x)) (Num y))) (Num y)) + === Num (x :: Int) + + prop "multiplication by 0 is 0" $ \x -> + normalise (App (App (Var "*") (Num x)) (Num 0)) + === Num (0 :: Int) + + prop "neg is its own inverse" $ \x -> + normalise (App (Var "neg") (App (Var "neg") (Num x))) + === Num (x :: Int) + + -- Partial application + it "(+ 1) evaluates to a Builtin waiting for one more arg" $ + eval builtinEnvValue (App (Var "+") (Num 1)) + `shouldBe` Builtin "+" 1 [VNum 1] + + it "partial builtin applied to its last arg reduces" $ + eval builtinEnvValue (App (App (Var "+") (Num 1)) (Num 2)) + `shouldBe` VNum 3 + + it "partial builtin passed through a lambda reduces when applied" $ + normalise (App (Lam "f" (App (App (Var "f") (Num 3)) (Num 4))) (Var "+")) + `shouldBe` Num 7 + + -- Stuck / neutral cases + it "(+ x 1) with free x stays stuck" $ + normalise (App (App (Var "+") (Var "x")) (Num 1)) + `shouldBe` App (App (Var "+") (Var "x")) (Num 1) + + it "(div 1 0) stays stuck" $ + normalise (App (App (Var "div") (Num 1)) (Num 0)) + `shouldBe` App (App (Var "div") (Num 1)) (Num 0) + + it "(mod 5 0) stays stuck" $ + normalise (App (App (Var "mod") (Num 5)) (Num 0)) + `shouldBe` App (App (Var "mod") (Num 5)) (Num 0) + + describe "evaluator equivalence on challenges" $ do + challenges <- runIO $ + eitherDecodeFileStrict "challenges.json" >>= \case + Left err -> fail $ "Could not load challenges.json: " <> err + Right cs -> pure (cs :: [Challenge]) + + mapM_ (challengeEquivalenceTest newEnv) challenges + -- describe "call-by-name eval" $ do -- it "evaluates 'x' as itself" $ do -- normalise' (Var "x") `shouldBe` Var "x" @@ -96,6 +213,41 @@ spec = do -- shouldDiverge $ -- normalise' omega +-- | For a single challenge expression, parse it and run both evaluators, +-- asserting they produce alpha-equivalent results. +-- Alpha-equivalence is checked by converting both results to De Bruijn-indexed +-- form (which strips variable names) before comparing. +challengeEquivalenceTest :: Env -> Challenge -> Spec +challengeEquivalenceTest env Challenge{level, expr} = + it ("level " <> show level <> ": " <> Text.unpack (Text.take 60 expr)) $ + case parseProgram expr of + Left err -> + fail $ "Parse error for level " <> show level <> ": " <> show err + Right asts -> + let runWith ev = loadProgram ev Untyped env newContext asts + extractTerms (Right (terms, _, _)) = map fst terms + extractTerms (Left err) = error $ "Type error: " <> show err + -- Convert to annotation-erased De Bruijn to compare up to + -- alpha-equivalence. Both evaluators may choose different fresh + -- names for lambda binders (NbE normalises under binders and must + -- avoid capture); erasing names leaves only structure and indices. + toAlpha = map (eraseNames . toDeBruijn) . extractTerms + debruijnTerms = toAlpha (runWith DeBruijn) + nbeTerms = toAlpha (runWith NbE) + in nbeTerms `shouldBe` debruijnTerms + +-- | Erase all name annotations from a 'DeBruijn' term, leaving only the +-- structural skeleton (indices, numeric literals, free-variable names, and +-- builtin names). Two terms that are identical up to alpha-renaming of bound +-- variables will be equal after erasure. +eraseNames :: DB.DeBruijn Text -> DB.DeBruijn () +eraseNames (DB.FV x) = DB.FV x +eraseNames (DB.FNum n) = DB.FNum n +eraseNames (DB.FBuiltin b) = DB.FBuiltin b +eraseNames (DB.Var _ i) = DB.Var () i +eraseNames (DB.Lam _ body) = DB.Lam () (eraseNames body) +eraseNames (DB.App f a) = DB.App (eraseNames f) (eraseNames a) + shouldDiverge :: Term -> IO () shouldDiverge t = race_ diff --git a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs index e9cfc6b..08ec661 100644 --- a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs @@ -11,6 +11,7 @@ import qualified Data.Text as Text import Minilang.Lambda.Eval (Term (Lam)) import qualified Minilang.Lambda.Eval as Eval import Minilang.Lambda.Parser (AST (..), desugar, initialChars, parse, parseProgram, pretty, restChars) +import Minilang.Lambda.Eval (normalise) import Test.Hspec (Spec, describe, it, parallel, shouldBe, shouldSatisfy) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck ( @@ -114,6 +115,66 @@ spec = parallel $ do let spaced = "- " <> Text.pack (show n) in parse spaced `shouldSatisfy` (/= Right (Lit (negate n))) + describe "arithmetic operators" $ do + -- Operator names are valid identifiers: they parse as Sym and round-trip. + it "parses + as a symbol" $ + parse "+" `shouldBe` Right (Sym "+") + + it "parses - as a symbol" $ + parse "-" `shouldBe` Right (Sym "-") + + it "parses * as a symbol" $ + parse "*" `shouldBe` Right (Sym "*") + + it "parses div as a symbol" $ + parse "div" `shouldBe` Right (Sym "div") + + it "parses mod as a symbol" $ + parse "mod" `shouldBe` Right (Sym "mod") + + it "parses = as a symbol" $ + parse "=" `shouldBe` Right (Sym "=") + + it "parses < as a symbol" $ + parse "<" `shouldBe` Right (Sym "<") + + it "parses neg as a symbol" $ + parse "neg" `shouldBe` Right (Sym "neg") + + -- Full expression parses and round-trips + it "parses (+ 3 4) and pretty-prints back" $ + let expr = App (Sym "+") (Lit 3) [Lit 4] + in parse "(+ 3 4)" `shouldBe` Right expr + + it "pretty (+ 3 4) round-trips through parse" $ + let expr = App (Sym "+") (Lit 3) [Lit 4] + in parse (pretty expr) `shouldBe` Right expr + + -- desugar of an arithmetic expression produces a normalised integer + it "desugar and normalise (+ 3 4) == Num 7" $ + normalise (desugar (App (Sym "+") (Lit 3) [Lit 4])) `shouldBe` Eval.Num 7 + + it "desugar and normalise (* 2 (+ 1 4)) == Num 10" $ + normalise (desugar (App (Sym "*") (Lit 2) [App (Sym "+") (Lit 1) [Lit 4]])) + `shouldBe` Eval.Num 10 + + -- Comparison operators produce Church booleans + it "desugar and normalise (= 3 3) == Church True" $ + normalise (desugar (App (Sym "=") (Lit 3) [Lit 3])) + `shouldBe` Eval.Lam "f" (Eval.Lam "t" (Eval.Var "t")) + + it "desugar and normalise (= 3 4) == Church False" $ + normalise (desugar (App (Sym "=") (Lit 3) [Lit 4])) + `shouldBe` Eval.Lam "f" (Eval.Lam "t" (Eval.Var "f")) + + it "desugar and normalise (< 2 5) == Church True" $ + normalise (desugar (App (Sym "<") (Lit 2) [Lit 5])) + `shouldBe` Eval.Lam "f" (Eval.Lam "t" (Eval.Var "t")) + + -- A partial application (missing second arg) pretty-prints as an App + it "pretty (+ 1) is \"(+ 1)\"" $ + pretty (App (Sym "+") (Lit 1) []) `shouldBe` "(+ 1)" + it "parses multiline program with blank lines" $ do let program = "(def id (lam (x) x))\n\ diff --git a/lambda-calcul/haskell/test/Minilang/REPLSpec.hs b/lambda-calcul/haskell/test/Minilang/REPLSpec.hs index bd64adf..e382df4 100644 --- a/lambda-calcul/haskell/test/Minilang/REPLSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/REPLSpec.hs @@ -66,7 +66,7 @@ spec = parallel $ out `shouldBe` [ "Bye!", - "(lam (z s) (s ((lam (n z s) (s n)) (lam (z s) z)))) : <?>" + "(lam (z s) (s (lam (z s) (s (lam (z s) z))))) : <?>" ] it "do typecheck term when language is set to 'Typed'" $ do @@ -80,7 +80,7 @@ spec = parallel $ out `shouldBe` [ "Bye!", - "(lam (z s) (s ((lam (n z s) (s n)) (lam (z s) z)))) : a -> ((d -> ((g -> h -> g) -> f) -> f) -> j) -> j", + "(lam (z s) (s (lam (z s) (s (lam (z s) z))))) : a -> ((c -> ((e -> f -> e) -> g) -> g) -> h) -> h", "Language set to Typed" ] diff --git a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs index f61969a..2860c40 100644 --- a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs @@ -17,6 +17,7 @@ import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Encoding (decodeUtf8) import Minilang.API (Challenge (..), Score (..), User (..), defaultChallenges, newToken) import Minilang.App (makeEnv) +import Minilang.REPL.Types (Evaluator (..)) import Minilang.Server (serveAPI) import Network.Wai (Application) import Network.Wai.Test (SResponse) @@ -200,7 +201,7 @@ arrayOfLengthOf _ len = MatchBody $ \_ actual -> app :: StdGen -> IO Application app g = do - env <- makeEnv g defaultChallenges + env <- makeEnv g defaultChallenges DeBruijn pure $ serveAPI env testSeed :: StdGen |