# Language5

The fifth installment. Our language has grown quite a bit. See the factorial definition in the initlib to see what it can do.

Our library now includes

```
Arithmetic + * - / > <
Boolean =? and or not
Predicates: odd? even? zero? empty?
Control Structures: if, if*
Definitions: .
Stack management:
dup | 1 2 3 dup == 1 2 3 3
swap | 1 2 3 swap == 1 3 2
pop | 1 2 3 pop == 1 2
cons | 1 [2 3 4] cons == [1 2 3 4]
concat | [1 2 3] [4 5 6] concat = [1 2 3 4 5]
nwrap | 1 2 3 4 5 2 nwrap == 1 2 3 [4 5]
| 1 2 3 4 5 1 nwrap == 1 2 3 4 [5]
| 1 2 3 4 5 0 nwrap == 1 2 3 4 5 []
i | 1 2 3 4 5 [+] i == 1 2 3 9
| 1 2 3 4 5 [+ +] i == 1 2 12
! | 1 2 3 4 5 [+] ! == 1 2 3 4 5 9
| 1 2 3 4 5 [+ +] ! == 1 2 3 4 5 12
dip | 1 2 3 4 [+] 5 dip == 1 2 7 5
dip | 1 2 3 4 [* +] 5 dip == 1 14 5
```

What you can do.

- Evaluate the following.

```
ghci> eval "5 factorial"
ghci> eval "1 2 3 4 2 nwrap [+] dip"
```

- Can you write sigma of a given n i.e (sum 0..n)? Hint. look at factorial definition in initlib.

```
ghci> eval "5 sigma"
15
```

- can you define the word nrotate that does the following

```
ghci> eval "1 2 3 4 5 6 7 8 9 2 nrotate"
1 2 3 4 5 6 8 9 7
ghci> eval "1 2 3 4 5 6 7 8 9 4 nrotate"
1 2 3 4 6 7 8 9 5
```

### Here is the code so far.

```
module Main where
import System.Environment
import System.IO
import Data.Char
-- Parsing code: Parses into Nest data type
-- Our nesting in expressions is provided by square brackets.
import Text.ParserCombinators.Parsec
type Word = String
type Env = [(String, [Nest])]
type Stack = [Nest]
initlib = unlines[
"[succ 1 +].",
"[pred 1 -].",
"[even? odd? not].",
"[double dup +].",
"[half dup odd? [succ 2 /] [2 /] if].",
"[if* 2 nwrap [!] swap dip i if].",
"[zero? 0 =?].",
"[factorial [zero?] [pop 1] [dup pred factorial *] if*]."
]
-- Read a line and Parse it, returing the Nest data structure.
readLine :: String -> Nest
readLine input = case parse parseExpr "nest" input of
Left err -> error (show err)
Right q -> q
eval :: String -> String
eval str = unwords $ map show $ bigStep [] e []
where Nested e = readLine (initlib ++ " " ++ str)
evalFile file = do
str <- readFile file
return $ eval str
main = do
fn <- getArgs
case fn of
[] -> error "Need file.nst to evaluate."
(x:xs) -> do res <- evalFile $ fn !! 0
putStrLn (show res)
-- Parse a number of words or nested structures.
parseExpr = do
x <- many parseSingle
return $ Nested x
-- Parse either a single word or a nested []
parseSingle :: Parser Nest
parseSingle = do
spaces
x <- (try parseFloat) <|>
(try parseInt) <|>
(try parseBool) <|>
(try parseString) <|>
(try parseWord) <|>
(try parseNest)
spaces
return x
-- Parse a nested structure starting with [ and ending with ]
parseNest :: Parser Nest
parseNest = do
char '['
e <- parseExpr
char ']'
return e
parseFloat :: Parser Nest
parseFloat = do
I i <- parseInt
char '.'
I j <- parseInt
res <- return $ (show i) ++ ['.'] ++ (show j)
return $ F (read res)
parseInt :: Parser Nest
parseInt = do
i <- many1 digit
return $ I (read i)
-- Parse a simple word without any spaces or nesting between them.
parseWord :: Parser Nest
parseWord = do
w <- many1 (noneOf " nrt[]")
return $ W w
parseBool :: Parser Nest
parseBool = do
(x:xs) <- string "true" <|> string "false"
return $ B (read (toUpper x : xs))
parseString :: Parser Nest
parseString = do
char '''
s <- many (noneOf "'")
char '''
return $ S s
-- bigStep semantics
bigStep :: Env -> [Nest] -> Stack -> Stack
-- Base case. Nothing on execution stack.
bigStep _ [] r = r
-- BigStep semantics for literals. i.e integers,
-- floats strings and nests evaluate to themselves.
bigStep env (Nested n: xs) ys = bigStep env xs (Nested n: ys)
bigStep env (I i: xs) ys = bigStep env xs (I i: ys)
-- implement the same for Float, Boolean, and String
bigStep env (F i: xs) ys = bigStep env xs (F i: ys)
bigStep env (B i: xs) ys = bigStep env xs (B i: ys)
bigStep env (S i: xs) ys = bigStep env xs (S i: ys)
-- BigStep Semantics for addition.
bigStep env (W "+": xs) (I i: I j: ys) = bigStep env xs (I (j+i): ys)
bigStep env (W "*": xs) (I i: I j: ys) = bigStep env xs (I (j*i): ys)
bigStep env (W "-": xs) (I i: I j: ys) = bigStep env xs (I (j-i): ys)
bigStep env (W "/": xs) (I i: I j: ys) = bigStep env xs (F ((fromIntegral j)/(fromIntegral i)): ys)
bigStep env (W ">": xs) (I i: I j: ys) = bigStep env xs (B (j > i): ys)
bigStep env (W "<": xs) (I i: I j: ys) = bigStep env xs (B (j < i): ys)
bigStep env (W "=?": xs) (I i: I j: ys) = bigStep env xs (B (j == i): ys)
bigStep env (W "=?": xs) (S i: S j: ys) = bigStep env xs (B (j == i): ys)
bigStep env (W "=?": xs) (B i: B j: ys) = bigStep env xs (B (j == i): ys)
bigStep env (W "=?": xs) (F i: F j: ys) = bigStep env xs (B (j == i): ys)
bigStep env (W "=?": xs) (Nested i: Nested j: ys) = bigStep env xs (B (j == i): ys)
bigStep env (W "odd?": xs) (I i: ys) = bigStep env xs (B (odd i): ys)
bigStep env (W "and": xs) (B a:B b:ys) = bigStep env xs (B (b && a):ys)
bigStep env (W "or": xs) (B a:B b:ys) = bigStep env xs (B (b || a):ys)
bigStep env (W "not": xs) (B a:ys) = bigStep env xs (B (not a):ys)
-- implement the same for - : if you have - a b , then the result
-- of (a - b) should be on the stack.
-- same for *. Can you implement it for division?
-- (hint, remember to use F Float for result)
-- implement the same for dup : duplicate the topmost element.
bigStep env (W "dup": xs) (y:ys) = bigStep env xs (y:y:ys)
-- implement the same for swap : swap the two topmost elements.
bigStep env (W "swap": xs) (y:y':ys) = bigStep env xs (y':y:ys)
-- implement the same for pop : remove the topmost element.
bigStep env (W "pop": xs) (y:ys) = bigStep env xs ys
-- implement cons operator -- a:as in haskell
bigStep env (W "cons": xs) (Nested y':y:ys) = bigStep env xs (Nested (y:y'):ys)
-- implement concat operator -- ++ in haskell
bigStep env (W "concat": xs) (Nested y':Nested y:ys) = bigStep env xs (Nested (y ++ y'):ys)
-- implement empty? for a list.
bigStep env (W "empty?": xs) (Nested y:ys) = bigStep env xs (B (length y == 0):ys)
-- Another operator is nwrap that takes an integer and pulls out that many
-- elements in the stack into
-- a list.
bigStep env (W "nwrap": xs) (I i:ys) = bigStep env xs ((Nested lst) : rest)
where lst = reverse $ take i ys
rest = drop i ys
-- Remember the i combinator? that is
[1 2] i + == 3
[1 2 +] i == 3
-- implement the i. - pull out the topmost nesting out of the stack and push it into the execution queue
bigStep env (W "i":xs) (Nested v:ys) = bigStep env (v ++ xs) ys
-- implement ! it executes the statement on the stack non destructively.
-- 1 2 3 [+ +] ! == 1 2 3 6
-- 1 2 3 [+] ! == 1 2 3 5
bigStep env (W "!":xs) ys = bigStep env xs $ (head res):(tail ys)
where res = bigStep env (W "i":xs) ys
-- We also need something called "dip" - an operator that pulls out the last
-- element from the stack, executes the current list on the remaining stack
-- elements and puts the pulled element back. This is useful to provide a
-- temporary place to store values. (see the example of if* to see how it is
-- used.)
bigStep env (W "dip":xs) (y:ys) = bigStep env xs $ y:lst
where lst = bigStep env [W "i"] ys
-- if then else
bigStep env (W "if":xs) (Nested v2:Nested v1:B c:ys) = bigStep env (res ++ xs) ys
where res = if c then v1 else v2
-- Implementing definitions.
bigStep env (W ".":xs) (Nested ((W w):as):ys) = bigStep ((w,as):env) xs ys
-- If not built in, look up in the environment.
bigStep env (W x :xs) ys = bigStep env (def ++ xs) ys
where def = case lookup x env of
Nothing -> error ("Definition not found or is not applicable for word {" ++ x ++ "} with stack " ++ (show ys))
Just x -> x
```