Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Language thread

Name: Anonymous 2018-12-23 1:36

Please rate my language. I was bored this night and so I ended up wasting my time writing this.
#!/usr/bin/env runhaskell

{-# LANGUAGE LambdaCase #-}

module Stack where

import Data.List
import Data.Char

type Stack = [Term]
type Ret = Either String Stack

data Term = I Int
| Q (Stack -> Ret)

eval :: String -> Ret
eval s = eval2 s [] "" 1

eval2space :: String -> Stack -> String -> Int -> Ret
eval2space (c:s) stack buf line = eval2space2 (' ':s) stack buf (case c of
'\n' -> line + 1
_ -> line) (c == '\n')
eval2space2 :: String -> Stack -> String -> Int -> Bool -> Ret
eval2space2 (' ':s) stack "" line _ = eval2 s stack "" line
eval2space2 (' ':s) stack buf line nl
| foldl' (\r -> \c -> isDigit c && r) True buf = eval2 s ((I (read buf :: Int)):stack) "" line
| True = primeval buf stack (case nl of
True -> line - 1
False -> line) >>= (\stack -> eval2 s stack "" line)

eval2 :: String -> Stack -> String -> Int -> Ret
eval2 ('[':s) stack "" line = inner s 0 "" line >>= (\(s, r, line2) -> eval2 s ((Q (\stack -> eval2 r stack "" line)):stack) "" line2)
where inner (']':s) 0 r line = return (s, r, line)
inner (c:s) i r line = inner s (case c of
']' -> i - 1
'[' -> i + 1
_ -> i) (r ++ [c]) (case c of
'\n' -> line + 1
_ -> line)
inner "" _ _ line = Left $ show line ++ ":EOF before ]"
eval2 ('[':s) stack _ line = Left $ show line ++ ":Expected space before ["

eval2 (c:s) stack buf line
| isSpace c = eval2space (c:s) stack buf line
| True = eval2 s stack (buf ++ [c]) line
eval2 "" stack "" line = return stack
eval2 "" stack buf line = eval2space " " stack buf line

primeval :: String -> Stack -> Int -> Ret
primeval s stack line = case lookup s prims of
Just (n, x)
| n <= length stack -> case x stack of
Left e -> Left $ show line ++ ":" ++ s ++ ":" ++ e
Right r -> return r
| True -> Left $ show line ++ ":Primitive " ++ s ++ " requres a stack that is at least " ++ show n ++ " big. Stack: " ++ show stack
Nothing -> Left $ show line ++ ":Primitive " ++ s ++ " not found. Stack: " ++ show stack

arithm name f = (name, (2, \case ((I a):(I b):t) -> return ((I $ f a b):t)
_ -> Left $ "Expected two numbers"))

prims = [("dup", (1, \(h:t) -> return (h:h:t))),
("pop", (1, \(_:t) -> return t)),
("eval", (1, \case ((Q f):t) -> f t
_ -> Left "Expected function")),
("if", (3, \case ((I 0):el:_:t) -> return (el:t)
((I _):_:t) -> return t
_ -> Left "First argument must be an integer")),
arithm "+" (+),
arithm "-" (-),
arithm "*" (*),
arithm "/" quot,
arithm "%" rem,
arithm "^" (^),
arithm "<" (\a -> fromEnum . (>) a),
arithm ">" (\a -> fromEnum . (<) a),
arithm "<=" (\a -> fromEnum . (>=) a),
arithm ">=" (\a -> fromEnum . (<=) a)]

main = getContents >>= (putStrLn . (\case Left s -> "Error: " ++ s
Right s -> show s) . eval)

instance Show Term where
show (I i) = show i
show _ = "function"


Examples:
[99] [11] 0 1 <= if eval
-> [99]


1 [1 +] eval dup
-> [2,2]


It is also turing complete. The following will not halt:
[dup eval] dup eval

Name: Anonymous 2018-12-24 11:20

These posts show we really need to decentralize everything even if not seemingly bad, but for the fact that any one person can effect their will.

If you build software, push forward.

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List