diff options
| -rw-r--r-- | src/Eval.hs | 113 | ||||
| -rw-r--r-- | src/Helper.hs | 53 | ||||
| -rw-r--r-- | src/Parser.hs | 64 | ||||
| -rw-r--r-- | std/Byte.bruijn | 4 | ||||
| -rw-r--r-- | std/Church.bruijn | 8 | ||||
| -rw-r--r-- | std/Combinator.bruijn | 16 | ||||
| -rw-r--r-- | std/List.bruijn | 46 | ||||
| -rw-r--r-- | std/Logic.bruijn | 12 | ||||
| -rw-r--r-- | std/Math.bruijn | 4 | ||||
| -rw-r--r-- | std/Number.bruijn | 44 | ||||
| -rw-r--r-- | std/Pair.bruijn | 6 | ||||
| -rw-r--r-- | std/String.bruijn | 6 |
12 files changed, 196 insertions, 180 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index fe8dbe8..c457889 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -13,6 +13,7 @@ import Data.List import qualified Data.Map as M import Data.Maybe import Helper +-- import Inet ( reduce ) import Parser import Paths_bruijn import Reducer @@ -65,20 +66,20 @@ loadFile path conf cache = do evalFun :: Identifier -> Environment -> EvalState (Failable Expression) evalFun fun (Environment sub) = state $ \env@(Environment e) -> - let lookup' name env' = case M.lookup fun env' of - Nothing -> Left $ UndefinedIdentifier name + let lookup' env' = case M.lookup fun env' of + Nothing -> Left $ UndefinedIdentifier fun Just (EnvDef { _exp = x }) -> Right x matching n - | length e == 0 = "<no idea>" + | null e = "<no idea>" | otherwise = snd $ minimumBy (compare `on` fst) $ map (\f -> (levenshtein (functionName f) n, show f)) (M.keys e) suggest (Left u@(UndefinedIdentifier n)) = Left $ SuggestSolution u (matching $ functionName n) suggest x = x - in case lookup' fun sub of -- search in sub env + in case lookup' sub of -- search in sub env s@(Right _) -> (s, env) - _ -> (suggest $ lookup' fun e, env) -- search in global env + _ -> (suggest $ lookup' e, env) -- search in global env evalAbs :: Expression -> Environment -> EvalState (Failable Expression) evalAbs e sub = evalExp e sub >>= pure . fmap Abstraction @@ -89,14 +90,22 @@ evalApp f g sub = evalExp f sub >>= \case Left e -> pure $ Left e Right f' -> fmap (Application f') <$> evalExp g sub - -evalInfix - :: Expression - -> Identifier - -> Expression - -> Environment - -> EvalState (Failable Expression) -evalInfix le i re = evalExp $ Application (Application (Function i) le) re +evalMixfix :: [Mixfix] -> Environment -> EvalState (Failable Expression) +evalMixfix m sub = resolve (mixfixKind m) mixfixArgs + where + -- longestMatching [] _ = error "invalid" + -- longestMatching x xs = evalFun (MixfixFunction x) sub >>= \case + -- Left _ -> longestMatching (init x) ((last x) : xs) + -- Right f -> (f, Function $ MixfixFunction xs) + resolve f args + | null [ s | s@(MixfixSome _) <- f ] = evalExp (foldl1 Application args) sub + | otherwise = evalExp + (foldl1 Application ((Function $ MixfixFunction f) : args)) + sub + mixfixArgs = [ a | (MixfixExpression a) <- m ] + mixfixKind = map $ \case + MixfixOperator i -> MixfixSome $ functionName i + _ -> MixfixNone evalPrefix :: Identifier -> Expression -> Environment -> EvalState (Failable Expression) @@ -107,7 +116,7 @@ evalExp idx@(Bruijn _ ) = const $ pure $ Right idx evalExp ( Function fun) = evalFun fun evalExp ( Abstraction e ) = evalAbs e evalExp ( Application f g) = evalApp f g -evalExp ( Infix le i re ) = evalInfix le i re +evalExp ( MixfixChain es ) = evalMixfix es evalExp ( Prefix p e ) = evalPrefix p e evalDefinition @@ -223,6 +232,19 @@ evalCommand inp s@(EnvState env@(Environment envDefs) conf cache) = \case | otherwise -> pure s +-- TODO: Reduce redundancy +showResult :: Expression -> Expression -> Environment -> IO () +showResult orig reduced env = + putStrLn + $ "<> " + <> (show orig) + <> "\n*> " + <> (show reduced) + <> "\n?> " + <> (humanifyExpression reduced) + <> "\n#> " + <> (matchingFunctions reduced env) + evalInstruction :: Instruction -> EnvState -> (EnvState -> IO EnvState) -> IO EnvState evalInstruction (ContextualInstruction instr inp) s@(EnvState env conf _) rec = @@ -239,20 +261,10 @@ evalInstruction (ContextualInstruction instr inp) s@(EnvState env conf _) rec = | otherwise -> rec s { _env = env' } Evaluate e -> let (res, _) = evalExp e (Environment M.empty) `runState` env - in putStrLn - (case res of - Left err -> show err - Right e' -> - "<> " - <> (show e') - <> "\n*> " - <> (show reduced) - <> "\n?> " - <> (humanifyExpression reduced) - <> "\n#> " - <> (matchingFunctions reduced env) - where reduced = reduce e' - ) + in (case res of + Left err -> print err + Right e' -> showResult e' (reduce e') env + ) >> rec s Commands cs -> yeet (pure s) cs >>= rec where -- TODO: sus @@ -281,21 +293,6 @@ eval (block : bs) s@(EnvState _ conf _) = blockParser | _isRepl conf = parseReplLine | otherwise = parseBlock 0 -evalMainFunc :: Environment -> Expression -> Maybe Expression -evalMainFunc (Environment env) arg = do - EnvDef { _exp = e } <- M.lookup entryFunction env - pure $ reduce $ Application e arg - -evalFileConf - :: String -> (a -> IO ()) -> (Expression -> a) -> EvalConf -> IO () -evalFileConf path wr conv conf = do - EnvState env _ _ <- loadFile path conf (EnvCache M.empty) - arg <- encodeStdin - case evalMainFunc env arg of - Nothing -> print - $ ContextualError (UndefinedIdentifier entryFunction) (Context "" path) - Just e -> wr $ conv e - dumpFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO () dumpFile path wr conv = do EnvState (Environment env) _ _ <- loadFile path @@ -306,23 +303,31 @@ dumpFile path wr conv = do $ ContextualError (UndefinedIdentifier entryFunction) (Context "" path) Just EnvDef { _exp = e } -> wr $ conv e -evalFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO () -evalFile path wr conv = evalFileConf path wr conv (defaultConf path) +evalFileConf :: String -> EvalConf -> IO () +evalFileConf path conf = do + EnvState (Environment env) _ _ <- loadFile path conf (EnvCache M.empty) + arg <- encodeStdin + case M.lookup entryFunction env of + Nothing -> print + $ ContextualError (UndefinedIdentifier entryFunction) (Context "" path) + Just EnvDef { _exp = e } -> + showResult e (reduce $ Application e arg) (Environment env) + +evalFile :: String -> IO () +evalFile path = evalFileConf path (defaultConf path) -- TODO: Merge with evalFile -evalYolo :: String -> (a -> IO ()) -> (Expression -> a) -> IO () -evalYolo path wr conv = - evalFileConf path wr conv (defaultConf path) { _evalTests = False } +evalYolo :: String -> IO () +evalYolo path = evalFileConf path (defaultConf path) { _evalTests = False } exec :: String -> (String -> IO (Either IOError a)) -> (a -> String) -> IO () exec path rd conv = do f <- rd path arg <- encodeStdin case f of - Left exception -> print (exception :: IOError) - Right f' -> putStr $ humanifyExpression $ reduce $ Application - (fromBinary $ conv f') - arg + Left exception -> print (exception :: IOError) + Right f' -> showResult e (reduce $ Application e arg) (Environment M.empty) + where e = fromBinary $ conv f' repl :: EnvState -> InputT M () repl (EnvState env conf cache) = @@ -401,7 +406,7 @@ evalMain = do ["-e", path] -> exec path (try . Byte.readFile) (fromBitString . Bit.bitString) ["-E", path] -> exec path (try . readFile) id - ["-y", path] -> evalYolo path putStr humanifyExpression + ["-y", path] -> evalYolo path ['-' : _] -> usage - [path ] -> evalFile path putStr humanifyExpression + [path ] -> evalFile path _ -> usage diff --git a/src/Helper.hs b/src/Helper.hs index 0c2b576..b0dea79 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -23,9 +23,9 @@ printContext :: Context -> String printContext (Context inp "" ) = printContext (Context inp "<unknown>") printContext (Context inp path) = p $ lines inp where - withinText = "\ESC[42mwithin\ESC[0m " - inText = "\ESC[44min\ESC[0m " - nearText = "\ESC[45mnear\ESC[0m\n" + withinText = "\ESC[106m\ESC[30mwithin\ESC[0m " + inText = "\ESC[104m\ESC[30min\ESC[0m " + nearText = "\ESC[105m\ESC[30mnear\ESC[0m\n" p [] = withinText <> show path <> "\n" p [l] = inText <> show l <> "\n" <> withinText <> show path <> "\n" p (l : ls) = @@ -35,13 +35,16 @@ printContext (Context inp path) = p $ lines inp <> "\n" errPrefix :: String -errPrefix = "\ESC[41mERROR\ESC[0m " +errPrefix = "\ESC[101m\ESC[30mERROR\ESC[0m " data Error = SyntaxError String | UndefinedIdentifier Identifier | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error Context | SuggestSolution Error String | ImportError String instance Show Error where show (ContextualError err ctx) = show err <> "\n" <> (printContext ctx) - show (SuggestSolution err sol) = show err <> "\nPerhaps you meant: " <> sol + show (SuggestSolution err sol) = + show err + <> "\n\ESC[102m\ESC[30msuggestion\ESC[0m Perhaps you meant: " + <> sol show (SyntaxError err) = - errPrefix <> "invalid syntax\n\ESC[45mnear\ESC[0m " <> err + errPrefix <> "invalid syntax\n\ESC[105m\ESC[30mnear\ESC[0m " <> err show (UndefinedIdentifier ident) = errPrefix <> "undefined identifier " <> show ident show (InvalidIndex err) = errPrefix <> "invalid index " <> show err @@ -92,37 +95,43 @@ printBundle ParseErrorBundle {..} = <> pointer <> "\n" -data Identifier = NormalFunction String | InfixFunction String | PrefixFunction String | NamespacedFunction String Identifier +data MixfixIdentifierKind = MixfixSome String | MixfixNone + deriving (Ord, Eq) +instance Show MixfixIdentifierKind where + show (MixfixSome e) = e + show _ = "…" +data Identifier = NormalFunction String | MixfixFunction [MixfixIdentifierKind] | PrefixFunction String | NamespacedFunction String Identifier deriving (Ord, Eq) functionName :: Identifier -> String functionName = \case NormalFunction f -> f - InfixFunction i -> "(" <> i <> ")" - PrefixFunction p -> p <> "(" + MixfixFunction is -> intercalate "" $ map show is + PrefixFunction p -> p <> "‣" NamespacedFunction n f -> n <> functionName f instance Show Identifier where show ident = "\ESC[95m" <> functionName ident <> "\ESC[0m" -data Expression = Bruijn Int | Function Identifier | Abstraction Expression | Application Expression Expression | Infix Expression Identifier Expression | Prefix Identifier Expression + +data Mixfix = MixfixOperator Identifier | MixfixExpression Expression + deriving (Ord, Eq) +instance Show Mixfix where + show (MixfixOperator i) = show i + show (MixfixExpression e) = show e +-- TODO: Remove Application and replace with Chain (renaming of MixfixChain) +data Expression = Bruijn Int | Function Identifier | Abstraction Expression | Application Expression Expression | MixfixChain [Mixfix] | Prefix Identifier Expression deriving (Ord, Eq) -data Command = Input String | Import String String | Test Expression Expression - deriving (Show) -data Instruction = Define Identifier Expression [Instruction] | Evaluate Expression | Comment | Commands [Command] | ContextualInstruction Instruction String - deriving (Show) instance Show Expression where show (Bruijn x ) = "\ESC[91m" <> show x <> "\ESC[0m" show (Function ident) = "\ESC[95m" <> show ident <> "\ESC[0m" show (Abstraction e ) = "\ESC[36m[\ESC[0m" <> show e <> "\ESC[36m]\ESC[0m" show (Application exp1 exp2) = "\ESC[33m(\ESC[0m" <> show exp1 <> " " <> show exp2 <> "\ESC[33m)\ESC[0m" - show (Infix le i re) = - "\ESC[33m(\ESC[0m" - <> show i - <> " " - <> show le - <> " " - <> show re - <> "\ESC[33m)\ESC[0m" + show (MixfixChain ms) = + "\ESC[33m(\ESC[0m" <> (intercalate " " $ map show ms) <> "\ESC[33m)\ESC[0m" show (Prefix p e) = show p <> " " <> show e +data Command = Input String | Import String String | Test Expression Expression + deriving (Show) +data Instruction = Define Identifier Expression [Instruction] | Evaluate Expression | Comment | Commands [Command] | ContextualInstruction Instruction String + deriving (Show) data EvalConf = EvalConf { _isRepl :: Bool diff --git a/src/Parser.hs b/src/Parser.hs index 04b09e1..984c276 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -19,7 +19,7 @@ sc = void $ char ' ' -- "'" can't be in special chars because of 'c' char notation and prefixation specialChar :: Parser Char -specialChar = oneOf "!?*@.:;+-_#$%^&<>/\\|~=" +specialChar = oneOf "!?*@.,:;+-_#$%^&<>/\\|{}~=" -- lower or upper greekLetter :: Parser Char @@ -38,12 +38,19 @@ mathematicalArrow :: Parser Char mathematicalArrow = satisfy isMathematicalOperator where isMathematicalOperator c = '←' <= c && c <= '⇿' -infixOperator :: Parser Identifier -infixOperator = normalInfix <|> namespacedInfix +mixfixNone :: Parser MixfixIdentifierKind +mixfixNone = char '…' >> pure MixfixNone + +mixfixSome :: Parser MixfixIdentifierKind +mixfixSome = + MixfixSome + <$> (some $ specialChar <|> mathematicalOperator <|> mathematicalArrow) + +mixfixOperator :: Parser Identifier +mixfixOperator = normalMixfix <|> namespacedMixfix where - normalInfix = InfixFunction - <$> some (specialChar <|> mathematicalOperator <|> mathematicalArrow) - namespacedInfix = NamespacedFunction <$> dottedNamespace <*> infixOperator + normalMixfix = MixfixFunction <$> (some $ mixfixNone <|> mixfixSome) + namespacedMixfix = NamespacedFunction <$> dottedNamespace <*> mixfixOperator prefixOperator :: Parser Identifier prefixOperator = normalPrefix <|> namespacedPrefix @@ -54,13 +61,14 @@ prefixOperator = normalPrefix <|> namespacedPrefix defIdentifier :: Parser Identifier defIdentifier = - ( NormalFunction - <$> ((:) <$> (lowerChar <|> greekLetter <|> emoticon) <*> many - (alphaNumChar <|> specialChar <|> char '\'') - ) - ) - <|> (char '(' *> infixOperator <* char ')') - <|> (prefixOperator <* char '(') + try + ( NormalFunction + <$> ((:) <$> (lowerChar <|> greekLetter <|> emoticon) <*> many + (alphaNumChar <|> specialChar <|> char '\'') + ) + ) + <|> try (prefixOperator <* char '‣') + <|> mixfixOperator <?> "defining identifier" identifier :: Parser Identifier @@ -88,12 +96,6 @@ parseAbstraction = do _ <- string "]" <?> "closing abstraction" pure $ Abstraction e --- one or more singletons wrapped in coupled application -parseApplication :: Parser Expression -parseApplication = do - s <- sepEndBy1 (try parsePrefix <|> parseSingleton) sc - pure $ foldl1 Application s - parseBruijn :: Parser Expression parseBruijn = do idx <- digitChar <?> "bruijn index" @@ -139,14 +141,16 @@ parseFunction = do var <- identifier pure $ Function var -parseInfix :: Parser Expression -parseInfix = do - e1 <- parseSingleton - sc - i <- infixOperator - sc - e2 <- parseSingleton - pure $ Infix e1 i e2 +parseMixfix :: Parser Expression +parseMixfix = do + s <- sepBy1 + (try prefixAsMixfix <|> try operatorAsMixfix <|> singletonAsMixfix) + sc + pure $ MixfixChain s + where + prefixAsMixfix = MixfixExpression <$> parsePrefix + operatorAsMixfix = MixfixOperator <$> mixfixOperator + singletonAsMixfix = MixfixExpression <$> parseSingleton parsePrefix :: Parser Expression parsePrefix = do @@ -162,13 +166,12 @@ parseSingleton = <|> parseChar <|> parseAbstraction <|> try parseFunction - <|> try (parens parseInfix <?> "enclosed infix expr") - <|> (parens parseApplication <?> "enclosed application") <|> parsePrefix + <|> try (parens parseMixfix <?> "enclosed mixfix chain") parseExpression :: Parser Expression parseExpression = do - e <- try parseInfix <|> try parseApplication <|> parsePrefix + e <- parseMixfix pure e <?> "expression" parseEvaluate :: Parser Instruction @@ -183,7 +186,6 @@ parseDefine lvl = do var <- defIdentifier sc e <- parseExpression - -- TODO: Fix >1 sub-defs subs <- (try $ newline *> (many (parseBlock (lvl + 1)))) <|> (try eof >> return []) pure $ ContextualInstruction (Define var e subs) inp diff --git a/std/Byte.bruijn b/std/Byte.bruijn index 2d7e397..36aaf58 100644 --- a/std/Byte.bruijn +++ b/std/Byte.bruijn @@ -11,9 +11,9 @@ b0 false b1 true # returns true if two bytes are equal -eq? &&( .. (zip-with xnor?) +eq? &&‣ .. (zip-with xnor?) -(=?) eq? +…=?… eq? :test ('a' =? 'a') (true) :test ('a' =? 'b') (false) diff --git a/std/Church.bruijn b/std/Church.bruijn index bba2784..6277dcc 100644 --- a/std/Church.bruijn +++ b/std/Church.bruijn @@ -4,16 +4,16 @@ zero [[0]] inc [[[1 (2 1 0)]]] -++( inc +++‣ inc add [[[[3 1 (2 1 0)]]]] -(+) add +…+… add mul [[[2 (1 0)]]] -(*) mul +…*… mul exp [[0 1]] -(^) exp +…^… exp diff --git a/std/Combinator.bruijn b/std/Combinator.bruijn index 4e11708..ceb9c48 100644 --- a/std/Combinator.bruijn +++ b/std/Combinator.bruijn @@ -5,22 +5,22 @@ # apply combinator a [[1 0]] -($) a +…$… a # bluebird combinator: function composition: (f . g) x = f (g x) b [[[2 (1 0)]]] -(.) b +….… b # blackbird combinator: 2x function composition: (f .. g) x y = f (g x y) b' [[[[3 (2 1 0)]]]] -(..) b' +…..… b' # bunting combinator: 3x function composition: (f ... g) x y z = f (g x y z) b'' [[[[[4 (3 2 1 0)]]]]] -(...) b'' +…...… b'' # becard combinator b''' [[[[3 (2 (1 0))]]]] @@ -28,7 +28,7 @@ b''' [[[[3 (2 (1 0))]]]] # cardinal combinator: reverse arguments: \f x y = f y z c [[[2 0 1]]] -\( c +\‣ c # cardinal once removed combinator c* [[[[3 2 0 1]]]] @@ -119,7 +119,7 @@ o [[0 (1 0)]] # queer combinator: reverse function composition: (f , g) x = g (f x) q [[[1 (2 0)]]] -(,) q +…,… q # quixotic bird combinator q' [[[2 (0 1)]]] @@ -145,12 +145,12 @@ r** [[[[[4 3 1 0 2]]]]] # starling combinator: (f <*> g) x = f x (g x) s [[[2 0 (1 0)]]] -(<*>) s +…<*>… s # thrush combinator: flipped $ t [[0 1]] -(&) t +…&… t # turing combinator u [[0 (1 1 0)]] diff --git a/std/List.bruijn b/std/List.bruijn index 8e59ffd..1d43ecd 100644 --- a/std/List.bruijn +++ b/std/List.bruijn @@ -12,14 +12,14 @@ empty false # returns true if a list is empty empty? [0 [[[false]]] true] -<>?( empty? +<>?‣ empty? :test (<>?empty) (true) # prepends an element to a list cons P.pair -(:) cons +…:… cons :test ((+1) : ((+2) : empty)) (P.pair (+1) (P.pair (+2) empty)) :test (<>?((+2) : empty)) (false) @@ -27,14 +27,14 @@ cons P.pair # returns the head of a list or empty head P.fst -^( head +^‣ head :test (^((+1) : ((+2) : empty))) ((+1)) # returns the tail of a list or empty tail P.snd -~( tail +~‣ tail :test (~((+1) : ((+2) : empty))) ((+2) : empty) @@ -44,7 +44,7 @@ length z [[[rec]]] (+0) case-inc 2 ++1 ~0 case-end 1 -#( length +#‣ length :test (#((+1) : ((+2) : empty))) ((+2)) :test (#empty) ((+0)) @@ -55,7 +55,7 @@ index z [[[rec]]] case-index =?1 ^0 (2 --1 ~0) case-end empty -(!!) \index +…!!… \index :test (((+1) : ((+2) : ((+3) : empty))) !! (+0)) ((+1)) :test (((+1) : ((+2) : ((+3) : empty))) !! (+2)) ((+3)) @@ -68,8 +68,8 @@ foldl z [[[[rec]]]] case-fold 3 2 (2 1 ^0) ~0 case-end 1 -:test ((foldl (+) (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true) -:test ((foldl (-) (+6) ((+1) : ((+2) : ((+3) : empty)))) =? (+0)) (true) +:test ((foldl add (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true) +:test ((foldl sub (+6) ((+1) : ((+2) : ((+3) : empty)))) =? (+0)) (true) # foldl without starting value foldl1 [[foldl 1 ^0 ~0]] @@ -80,8 +80,8 @@ foldr [[[z [[rec]] 0]]] case-fold 4 ^0 (1 ~0) case-end 3 -:test ((foldr (+) (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true) -:test ((foldr (-) (+2) ((+1) : ((+2) : ((+3) : empty)))) =? (+0)) (true) +:test ((foldr add (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true) +:test ((foldr sub (+2) ((+1) : ((+2) : ((+3) : empty)))) =? (+0)) (true) # foldr without starting value foldr1 [[foldl 1 ^0 ~0]] @@ -89,7 +89,7 @@ foldr1 [[foldl 1 ^0 ~0]] # applies or to all list elements lor? foldr or? false -||( lor? +||‣ lor? :test (||(true : (true : empty))) (true) :test (||(true : (false : empty))) (true) @@ -98,7 +98,7 @@ lor? foldr or? false # applies and to all list elements land? foldr and? true -&&( land? +&&‣ land? :test (&&(true : (true : empty))) (true) :test (&&(true : (false : empty))) (false) @@ -112,7 +112,7 @@ product foldl mul (+1) :test (Π ((+1) : ((+2) : ((+3) : empty)))) ((+6)) # adds all values in list -sum foldl (+) (+0) +sum foldl add (+0) Σ sum @@ -131,7 +131,7 @@ lmin foldl1 min # reverses a list reverse foldl \cons empty -<~>( reverse +<~>‣ reverse :test (<~>((+1) : ((+2) : ((+3) : empty)))) ((+3) : ((+2) : ((+1) : empty))) @@ -145,14 +145,14 @@ append z [[[rec]]] case-merge ^1 : (2 ~1 0) case-end 0 -(++) append +…++… append :test (((+1) : ((+2) : ((+3) : empty))) ++ ((+4) : empty)) ((+1) : ((+2) : ((+3) : ((+4) : empty)))) # appends an element to a list snoc [[1 ++ (0 : empty)]] -(;) snoc +…;… snoc :test (empty ; (+1)) ((+1) : empty) :test (((+1) : empty) ; (+2)) ((+1) : ((+2) : empty)) @@ -163,7 +163,7 @@ map z [[[rec]]] case-map (1 ^0) : (2 1 ~0) case-end empty -(<$>) map +…<$>… map :test (inc <$> ((+1) : ((+2) : ((+3) : empty)))) ((+2) : ((+3) : ((+4) : empty))) @@ -173,7 +173,7 @@ filter z [[[rec]]] case-filter 1 ^0 (cons ^0) i (2 1 ~0) case-end empty -(<#>) \filter +…<#>… \filter :test (((+1) : ((+0) : ((+3) : empty))) <#> zero?) ((+0) : empty) @@ -183,7 +183,7 @@ last z [[rec]] case-last <>?(~0) ^0 (1 ~0) case-end empty -_( last +_‣ last :test (last ((+1) : ((+2) : ((+3) : empty)))) ((+3)) @@ -222,7 +222,7 @@ zip-with z [[[[rec]]]] case-zip <>?0 empty ((2 ^1 ^0) : (3 2 ~1 ~0)) case-end empty -:test (zip-with (+) ((+1) : ((+2) : empty)) ((+2) : ((+1) : empty))) ((+3) : ((+3) : empty)) +:test (zip-with add ((+1) : ((+2) : empty)) ((+2) : ((+1) : empty))) ((+3) : ((+3) : empty)) # returns first n elements of a list take z [[[rec]]] @@ -271,13 +271,13 @@ break [span (not! . 0)] :test (break (\(>?) (+3)) ((+1) : ((+2) : ((+4) : ((+1) : empty))))) (((+1) : ((+2) : empty)) : ((+4) : ((+1) : empty))) # returns true if any element in a list matches a predicate -any? [||( . (map 0)] +any? [||‣ . (map 0)] :test (any? (\gre? (+2)) ((+1) : ((+2) : ((+3) : empty)))) (true) :test (any? (\gre? (+2)) ((+1) : ((+2) : ((+2) : empty)))) (false) # returns true if all elements in a list match a predicate -all? [&&( . (map 0)] +all? [&&‣ . (map 0)] :test (all? (\gre? (+2)) ((+3) : ((+4) : ((+5) : empty)))) (true) :test (all? (\gre? (+2)) ((+4) : ((+3) : ((+2) : empty)))) (false) @@ -289,7 +289,7 @@ in? [[any? (\1 0)]] :test (in? (=?) (+0) ((+1) : ((+2) : ((+3) : empty)))) (false) # returns true if all elements of one list are equal to corresponding elements of other list -eq? &&( ... zip-with +eq? &&‣ ... zip-with :test (eq? (=?) ((+1) : ((+2) : empty)) ((+1) : ((+2) : empty))) (true) :test (eq? (=?) ((+1) : ((+2) : empty)) ((+2) : ((+2) : empty))) (false) diff --git a/std/Logic.bruijn b/std/Logic.bruijn index 0e7c1ba..e8127ab 100644 --- a/std/Logic.bruijn +++ b/std/Logic.bruijn @@ -11,7 +11,7 @@ false ki # inverts boolean value not! [0 false true] -!( not! +!‣ not! :test (!true) (false) :test (!false) (true) @@ -19,7 +19,7 @@ not! [0 false true] # true if both args are true and? [[1 0 false]] -(&&) and? +…&&… and? :test (true && true) (true) :test (true && false) (false) @@ -37,7 +37,7 @@ nand? [[1 0 1 false true]] # true if one of the args is true or? [[1 true 0]] -(||) or? +…||… or? :test (true || true) (true) :test (true || false) (true) @@ -73,7 +73,7 @@ xnor? [[1 0 !0]] # I personally just write (exp? case-T case-F) directly if [[[2 1 0]]] -(?!) if +…?!… if :test (if true true false) (true) :test ((true ?! true) false) (true) @@ -83,7 +83,7 @@ if [[[2 1 0]]] # mathematical implies definition implies [[!1 || 0]] -(=>?) implies +…=>?… implies :test (true =>? true) (true) :test (true =>? false) (false) @@ -93,7 +93,7 @@ implies [[!1 || 0]] # mathematical iff (if and only if) definition iff [[(1 =>? 0) && (0 =>? 1)]] -(<=>?) iff +…<=>?… iff :test (true <=>? true) (true) :test (true <=>? false) (false) diff --git a/std/Math.bruijn b/std/Math.bruijn index 47b0267..db97d3c 100644 --- a/std/Math.bruijn +++ b/std/Math.bruijn @@ -17,13 +17,13 @@ gcd z [[[(1 =? 0) case-eq ((1 >? 0) case-gre case-les)]]] # power function pow [(!!) (iterate ((*) 0) (+1))] -(**) pow +…**… pow :test (((+2) ** (+3)) =? ((+8))) (true) # factorial function # fac Z [[(0 <? (+2)) (+1) (0 * (1 --0))]] -fac [Π (take 0 (iterate ++( (+1)))] +fac [Π (take 0 (iterate ++‣ (+1)))] :test ((fac (+3)) =? (+6)) (true) diff --git a/std/Number.bruijn b/std/Number.bruijn index b6bea75..60920aa 100644 --- a/std/Number.bruijn +++ b/std/Number.bruijn @@ -38,7 +38,7 @@ t=? [0 false false true] # shifts a negative trit into a balanced ternary number up-neg [[[[[2 (4 3 2 1 0)]]]]] -^<( up-neg +^<‣ up-neg :test (^<(+0)) ((-1)) :test (^<(-1)) ((-4)) @@ -47,7 +47,7 @@ up-neg [[[[[2 (4 3 2 1 0)]]]]] # shifts a positive trit into a balanced ternary number up-pos [[[[[1 (4 3 2 1 0)]]]]] -^>( up-pos +^>‣ up-pos :test (^>(+0)) ((+1)) :test (^>(-1)) ((-2)) @@ -56,7 +56,7 @@ up-pos [[[[[1 (4 3 2 1 0)]]]]] # shifts a zero trit into a balanced ternary number up-zero [[[[[0 (4 3 2 1 0)]]]]] -^=( up-zero +^=‣ up-zero :test (^=(+0)) ([[[[0 3]]]]) :test (^=(+1)) ((+3)) @@ -79,7 +79,7 @@ down [snd (0 z a< a> a=)] # negates a balanced ternary number negate [[[[[4 3 1 2 0]]]]] --( negate +-‣ negate :test (-(+0)) ((+0)) :test (-(-1)) ((+1)) @@ -101,7 +101,7 @@ strip [fst (0 z a< a> a=)] a> [0 [[^>1 : false]]] a= [0 [[(0 (+0) ^=1) : 0]]] -%( strip +%‣ strip :test (%[[[[0 3]]]]) ((+0)) :test (%[[[[2 (0 (0 (0 (0 3))))]]]]) ((-1)) @@ -119,7 +119,7 @@ lst [0 t= [t<] [t>] [t=]] # TODO: Find a more elegant way to do this (and resolve list import loop?) mst [fix (last (list! %0))] last z [[<>?0 [false] [<>?(snd 1) (fst 1) (2 (snd 1))] i]] - <>?( [0 [[[false]]] true] + <>?‣ [0 [[[false]]] true] fix [((t<? 0) || ((t>? 0) || (t=? 0))) 0 t=] :test (mst (-1)) (t<) @@ -130,7 +130,7 @@ mst [fix (last (list! %0))] # returns true if balanced ternary number is negative negative? [t<? (mst 0)] -<?( negative? +<?‣ negative? :test (<?(+0)) (false) :test (<?(-1)) (true) @@ -140,7 +140,7 @@ negative? [t<? (mst 0)] # returns true if balanced ternary number is positive positive? [t>? (mst 0)] ->?( positive? +>?‣ positive? :test (>?(+0)) (false) :test (>?(-1)) (false) @@ -150,7 +150,7 @@ positive? [t>? (mst 0)] # checks true if balanced ternary number is zero zero? [0 true [false] [false] i] -=?( zero? +=?‣ zero? :test (=?(+0)) (true) :test (=?(-1)) (false) @@ -165,7 +165,7 @@ abstract! [0 z a< a> a=] a> [[[[[1 4]]]]] a= [[[[[0 4]]]]] -->^( abstract! +->^‣ abstract! :test (->^(-3)) ([[[[0 [[[[2 [[[[3]]]]]]]]]]]]) :test (->^(+0)) ([[[[3]]]]) @@ -176,7 +176,7 @@ abstract! [0 z a< a> a=] normal! ω rec rec [[0 (+0) [^<([3 3 0] 0)] [^>([3 3 0] 0)] [^=([3 3 0] 0)]]] -->_( normal! +->_‣ normal! :test (->_[[[[3]]]]) ((+0)) :test (->_(->^(+42))) ((+42)) @@ -192,9 +192,9 @@ eq? [[abs 1 ->^0]] a> [[0 false [false] [2 0] [false]]] a= [[0 (1 0) [false] [false] [2 0]]] -(=?) eq? +…=?… eq? -(/=?) not! .. eq? +…/=?… not! .. eq? :test ((-42) =? (-42)) (true) :test ((-1) =? (-1)) (true) @@ -219,7 +219,7 @@ inc [snd (0 z a< a> a=)] a> [0 [[^>1 : ^<0]]] a= [0 [[^=1 : ^>1]]] -++( inc +++‣ inc # adds (+1) to a balanced ternary number and strips leading 0s ssinc strip . inc @@ -237,7 +237,7 @@ dec [snd (0 z a< a> a=)] a> [0 [[^>1 : ^=1]]] a= [0 [[^=1 : ^<1]]] ---( dec +--‣ dec # subs (+1) from a balanced ternary number and strips leading 0s sdec strip . dec @@ -263,7 +263,7 @@ add [[abs 1 ->^0]] z [[0 --(->_1) ++(->_1) ->_1]] c [[1 0 t=]] -(+) add +…+… add # adds two balanced ternary numbers and strips leading 0s sadd strip .. add @@ -279,7 +279,7 @@ sadd strip .. add # larger numbers should be second argument (performance) sub [[1 + -0]] -(-) sub +…-… sub # subs two balanced ternary numbers and strips leading 0s ssub strip .. sub @@ -295,7 +295,7 @@ ssub strip .. sub # larger numbers should be second argument (performance) gre? [[>?(1 - 0)]] -(>?) gre? +…>?… gre? :test ((+1) >? (+2)) (false) :test ((+2) >? (+2)) (false) @@ -305,7 +305,7 @@ gre? [[>?(1 - 0)]] # smaller numbers should be second argument (performance) les? \gre? -(<?) les? +…<?… les? :test ((+1) <? (+2)) (true) :test ((+2) <? (+2)) (false) @@ -315,7 +315,7 @@ les? \gre? # smaller numbers should be second argument (performance) leq? [[!(1 >? 0)]] -(<=?) leq? +…<=?… leq? :test ((+1) <=? (+2)) (true) :test ((+2) <=? (+2)) (true) @@ -325,7 +325,7 @@ leq? [[!(1 >? 0)]] # smaller numbers should be second argument (performance) geq? \leq? -(>=?) geq? +…>=?… geq? :test ((+1) >=? (+2)) (false) :test ((+2) >=? (+2)) (true) @@ -343,7 +343,7 @@ mul [[1 (+0) a< a> a=]] a> [^=0 + 1] a= [^=0] -(*) mul +…*… mul smul strip .. mul diff --git a/std/Pair.bruijn b/std/Pair.bruijn index 8dffe7d..7cc93fb 100644 --- a/std/Pair.bruijn +++ b/std/Pair.bruijn @@ -5,19 +5,19 @@ # pairs two expressions into one pair [[[0 2 1]]] -(:) pair +…:… pair # extracts first expression from pair fst [0 k] -^( fst +^‣ fst :test (^([[0]] : [[1]])) ([[0]]) # extracts second expression from pair snd [0 ki] -~( snd +~‣ snd :test (~([[0]] : [[1]])) ([[1]]) diff --git a/std/String.bruijn b/std/String.bruijn index c74d950..bc80840 100644 --- a/std/String.bruijn +++ b/std/String.bruijn @@ -7,7 +7,7 @@ # returns true if two strings are the same eq? eq? B.eq? -(=?) eq? +…=?… eq? :test ("ab" =? "ab") (true) :test ("ab" =? "aa") (false) @@ -15,11 +15,11 @@ eq? eq? B.eq? # returns true if character is part of a string in? in? B.eq? -(∈) in? +…∈… in? ni? \in? -(∋) ni? +…∋… ni? :test ('b' ∈ "ab") (true) :test ('c' ∈ "ab") (false) |