# Scheme in 48 hours

11 Aug 2014

As of March 2020, School of Haskell has been switched to read-only mode.

this is a tutorial of writing scheme in haskell

``````
module Main where

import Data.Complex
import Data.Ratio
import Numeric
import System.Environment
import Text.Parsec hiding (spaces)
import Text.Parsec.String

main :: IO ()
main = do args <- getLine

symbol :: Parser Char
symbol = oneOf "!\$%&|*+-/:<=>?@^_~"

readExpr input = case parse parseExpr "lisp" input of
Left err -> "No match: " ++ show err
Right val -> "Found value"

spaces :: Parser ()
spaces = skipMany1 space

toDouble :: LispVal -> Double
toDouble(Float f) = f
toDouble(Number n) = fromIntegral n

data LispVal = Atom String
| List [LispVal]
| DottedList [LispVal] LispVal
| Number Integer
| String String
| Bool Bool
| Character Char
| Float Double
| Ratio Rational
| Complex (Complex Double)

escapedChars :: Parser Char
escapedChars = do char '\\' -- a backslash
x <- oneOf "\\\"nrt" -- either backslash or doublequote or n,r, or t
return \$ case x of -- return the escaped character
'\\' -> x
'"'  -> x
'n'  ->'\n'
'r'  ->'\r'
't'  ->'\t'

parseCharacter :: Parser LispVal
parseCharacter = do try \$ string "#\\"
value <- try (string "newline" <|> string "space") <|> do { x <- anyChar; notFollowedBy alphaNum ; return [x] }
return \$ Character \$ case value of
"space" -> ' '
"newline" -> '\n'
otherwise -> (value !! 0)

parseBool :: Parser LispVal
parseBool = do char '#'
(char 't' >> return (Bool True)) <|> (char 'f' >> return (Bool False))

parseString :: Parser LispVal
parseString = do char '"'
x <- many \$ escapedChars <|> noneOf ['\34', '\92'] -- double-quote, backslash
char '"'
return \$ String x

parseAtom :: Parser LispVal
parseAtom = do first <- letter <|> symbol
rest <- many (letter <|> digit <|> symbol)
let atom = [first] ++ rest
return \$ case atom of
"#t" -> Bool True
"#f" -> Bool False
otherwise -> Atom atom

--was used before parseDigital came along
--parseNumber :: Parser LispVal
--parseNumber = liftM (Number . read) \$ many1 digit
--parseNumber = many1 digit >>= \x -> (return. Number. read) x

parseNumber :: Parser LispVal
parseNumber = parseDigital1 <|> parseDigital2 <|> parseHex <|> parseOct <|> parseBin

parseFloat :: Parser LispVal
parseFloat = do x <- many1 digit
char '.'
y <- many1 digit

parseComplex :: Parser LispVal
parseComplex = do x <- (try parseFloat <|> parseDigital1)
char '+'
y <- (try parseFloat <|> parseDigital1)
char 'i'
return \$ Complex (toDouble x :+ toDouble y)

parseRatio :: Parser LispVal
parseRatio = do x <- many1 digit
char '/'
y <- many1 digit

parseDigital1 :: Parser LispVal
parseDigital1 = many1 digit >>= (return . Number. read)

parseDigital2 :: Parser LispVal
parseDigital2 = do try \$ string "#d"
x <-many1 digit
(return . Number . read) x

parseHex :: Parser LispVal
parseHex = do try \$ string "#x"
x <- many1 hexDigit
return  \$ Number (hex2dig x)

parseOct :: Parser LispVal
parseOct = do try \$ string "#o"
x <- many1 octDigit
return \$ Number (oct2dig x)

parseBin :: Parser LispVal
parseBin = do try \$ string "#b"
x <- many1 (oneOf "10")
return \$ Number (bin2dig x)

oct2dig x = fst \$ readOct x !! 0
hex2dig x = fst \$ readHex x !! 0
bin2dig = bin2dig' 0
bin2dig' digint "" = digint
bin2dig' digint (x:xs) = let old = 2 * digint + ( if x == '0' then 0 else 1) in
bin2dig' old xs

parseExpr ::Parser LispVal
parseExpr = parseAtom

<|> parseString
<|> parseRatio
<|> parseComplex
<|> parseFloat
<|> try parseNumber --we need try because they can all start with hash char
<|> try parseBool
<|> try parseCharacter``````