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 13:36

>>8
Not J-pop.
Fucking weeaboo

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