From 551cfb83fd8f3cb88a3428c0bb6a7cbb933e4eeb Mon Sep 17 00:00:00 2001 From: Marvin Borner Date: Mon, 28 Oct 2024 02:15:06 +0100 Subject: [PATCH] Improved minibruijn and parser --- samples/fun/minibruijn.bruijn | 65 ++++++++++++++++++++++------------- src/Parser.hs | 2 +- std/Monad/Parser.bruijn | 9 ++++- std/Option.bruijn | 5 +++ 4 files changed, 55 insertions(+), 26 deletions(-) diff --git a/samples/fun/minibruijn.bruijn b/samples/fun/minibruijn.bruijn index 43dd4a1..e0450dd 100644 --- a/samples/fun/minibruijn.bruijn +++ b/samples/fun/minibruijn.bruijn @@ -1,4 +1,5 @@ # MIT License, Copyright (c) 2024 Marvin Borner + # usage: # write a file test.bruijn # ``` @@ -10,49 +11,65 @@ # ``` # run `cat test.bruijn | bruijn minibruijn.bruijn` -:import std/Char C +# This parser/interpreter works by parsing the input to the meta encoding +# (similar to Mogensen-Scott) and reducing it using its self-interpreter! +# Substituting the definitions is done *while parsing* using hashmaps + +:import std/Char :import std/Combinator . :import std/List . -:import std/Meta M +:import std/Meta :import std/Monad/Parser . -:import std/Number/Conversion O -:import std/Map H -:import std/Result R -:import std/String S +:import std/Number/Conversion +:import std/Map +:import std/Result +:import std/String +:import std/Option # meta encoding uses Church numerals instead of binary! -char→number (\C.sub '0') → O.binary→unary +char→number (\Char.sub '0') → Conversion.binary→unary -identifier some (satisfy C.alpha?) +# parses [a-z]+ +identifier some (satisfy Char.alpha?) -spaces many (satisfy C.space?) +# parses * +spaces many (satisfy Char.space?) -newlines some (satisfy (C.eq? '\n')) +# parses \n+ +newlines some (satisfy (Char.eq? '\n')) +# parses between parentheses parens between (char '(') (char ')') -number char→number <$> (satisfy C.numeric?) +# parses a single number (as number) +number char→number <$> (satisfy Char.numeric?) + +error-identifier error-custom "identifier not found" # T := [T] # Abstraction # | T..T # Application -# | (T) # Parenthesised +# | (T) # Parenthesized # | 0-9 # de Bruijn index # identifiers ([a-z]*) just get looked up in the hashmap! -term [y [(foldl1 M.app) <$> (some (spaces *> singleton <* spaces))]] +term [y [(foldl1 Meta.app) <$> (some (spaces *> singleton <* spaces))]] singleton abs <|> idx <|> def <|> (parens 0) - abs M.abs <$> (between (char '[') (char ']') 0) - idx M.idx <$> number - def [S.#H.lookup 0 2 i i] <$> identifier + abs Meta.abs <$> (between (char '[') (char ']') 0) + idx Meta.idx <$> number + def identifier >>= [lift-result (Option.result-or error-identifier lookup)] + lookup String.#Map.lookup 0 2 -:test (term H.empty "()") (R.err (error-compose (error-unexpected "(") (error-unexpected ")"))) -:test (term H.empty "[[0 1]]") (R.ok [0 `[[(0 1)]] empty]) -:test (term (S.#H.insert "foo" `[[1]] H.empty) "[foo 0]") (R.ok [0 `[[[1]] 0] empty]) +:test (term Map.empty "()") (Result.err (error-compose (error-unexpected "(") (error-unexpected ")"))) +:test (term Map.empty "[[0 1]]") (Result.ok [0 `[[(0 1)]] empty]) +:test (term (String.#Map.insert "foo" `[[1]] Map.empty) "[foo 0]") (Result.ok [0 `[[[1]] 0] empty]) -block [[[S.#H.insert 1 0 2]] <$> identifier <*> (term 0) <* newlines] +# parses an identifier, a term, and newlines to a hashmap insertion +block [[[String.#Map.insert 1 0 2]] <$> identifier <*> (term 0) <* newlines] -:test (block H.empty "main [0]\n") (R.ok [0 (S.#H.insert "main" `[0] H.empty) empty]) -:test (block H.empty "main ()\n") (R.err (error-compose (error-unexpected "(") (error-unexpected ")"))) +:test (block Map.empty "main [0]\n") (Result.ok [0 (String.#Map.insert "main" `[0] Map.empty) empty]) +:test (block Map.empty "main ()\n") (Result.err (error-compose (error-unexpected "(") (error-unexpected ")"))) -program y [[[(R.apply (block 1 0) [3 ^0 ~0])] <|> (eof *> (pure 0))]] H.empty +# iterates parsing of blocks starting with an empty hashmap until end +program y [[((block 0) >>= 1) <|> (eof *> (pure 0))]] Map.empty -main M.eval <$> ([S.#H.lookup "main" 0 i i] <$> program) → [0 i i] +# evaluates the main function of a program +main Meta.eval <$> ([String.#Map.lookup "main" 0 i i] <$> program) → [0 i i] diff --git a/src/Parser.hs b/src/Parser.hs index 01dda6e..fa8e59b 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -385,7 +385,7 @@ parseImport :: Parser Command parseImport = do _ <- string ":import" <* sc "import instruction" path <- importPath - ns <- try (sc *> (namespace <|> string ".")) <|> (eof >> return "") + ns <- try (sc *> (namespace <|> string ".")) <|> return "" pure $ Import (path ++ ".bruijn") ns parseInput :: Parser Command diff --git a/std/Monad/Parser.bruijn b/std/Monad/Parser.bruijn index 2201aec..0364ea0 100644 --- a/std/Monad/Parser.bruijn +++ b/std/Monad/Parser.bruijn @@ -34,6 +34,8 @@ map [[[R.map ok (1 0)]]] ⧗ (a → b) → (Parser a) → (Parser b) …<$>… map +fail [[R.err 1]] ⧗ a → (Parser a) + pure [[R.ok (1 : 0)]] ⧗ a → (Parser a) ap [[[R.apply (2 0) ok]]] ⧗ (Parser (a → b)) → (Parser a) → (Parser b) @@ -50,7 +52,7 @@ string y [[0 [[[go]]] (pure [[0]])]] ⧗ String → (Parser a) return pure ⧗ a → (Parser a) -bind [[[R.apply ok (2 0)]]] ⧗ (Parser a) → (a → (Parser b)) → (Parser a) +bind [[[R.apply (2 0) ok]]] ⧗ (Parser a) → (a → (Parser b)) → (Parser a) ok &[[3 1 0]] …>>=… bind @@ -70,6 +72,11 @@ eof [0 [[[go]]] end] ⧗ (Parser a) go R.err error-expected-end end R.ok ([[0]] : [[0]]) +lift-result [0 pure fail] ⧗ (Result a) → (Parser a) + +:test (lift-result (R.ok "ok") "rst") (R.ok ("ok" : "rst")) +:test (lift-result (R.err "oh") "rst") (R.err "oh") + # =========================================================================== # # most relevant functions are defined - we can now derive from Generic/Monad! # # =========================================================================== # diff --git a/std/Option.bruijn b/std/Option.bruijn index 3b1c0a1..a6323d2 100644 --- a/std/Option.bruijn +++ b/std/Option.bruijn @@ -45,3 +45,8 @@ apply [[1 none 0]] ⧗ (Option a) → (a → b) → c :test (apply none [some ([[1]] 0)]) (none) :test (apply (some [[0]]) [some ([[1]] 0)]) (some [[[0]]]) + +result-or [[0 [[0 3]] [[[1 2]]]]] + +:test (result-or "fail" none) ([[0 "fail"]]) +:test (result-or "fail" (some "ok")) ([[1 "ok"]])