{-# LANGUAGE OverloadedStrings #-}
module Sugar.Scheme where
  
import Sugar
import Language.Scheme.Types
import Language.Scheme.Parser
import Data.Text (unpack)
import qualified Data.Map as Map
import qualified Text.Parsec.Token as P
import Text.ParserCombinators.Parsec
import Text.Parsec.Language ()


toLispVal :: Sugar -> LispVal
toLispVal :: Sugar -> LispVal
toLispVal (Sugar'Unit Note
_) = [LispVal] -> LispVal
List [] -- TODO: should this be 'nil'?
toLispVal (Sugar'Text Text
txt Note
_) =  case Parsec [Char] () LispVal
-> [Char] -> [Char] -> Either ParseError LispVal
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parsec [Char] () LispVal
valParser [Char]
"valParser" (Text -> [Char]
unpack Text
txt) of
  Left ParseError
_ -> [Char] -> LispVal
String (Text -> [Char]
unpack Text
txt)
  Right LispVal
v -> LispVal
v
  where
    lexeme :: ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
lexeme = GenTokenParser [Char] () Identity
-> forall a.
   ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.lexeme GenTokenParser [Char] () Identity
lexer
    lexer :: GenTokenParser [Char] () Identity
lexer = GenLanguageDef [Char] () Identity
-> GenTokenParser [Char] () Identity
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser GenLanguageDef [Char] () Identity
lispDef
    valParser :: Parsec [Char] () LispVal
valParser =
          Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall a.
ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
lexeme Parsec [Char] () LispVal
parseComplexNumber)
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall a.
ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
lexeme Parsec [Char] () LispVal
parseRationalNumber)
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall a.
ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
lexeme Parsec [Char] () LispVal
parseRealNumber)
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall a.
ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
lexeme Parsec [Char] () LispVal
parseNumber)
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parsec [Char] () LispVal
parseAtom
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall a.
ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
lexeme Parsec [Char] () LispVal
parseString
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall a.
ParsecT [Char] () Identity a -> ParsecT [Char] () Identity a
lexeme Parsec [Char] () LispVal
parseBool
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal
parseQuoted
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal
parseQuasiQuoted
      Parsec [Char] () LispVal
-> Parsec [Char] () LispVal -> Parsec [Char] () LispVal
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec [Char] () LispVal
parseUnquoted
toLispVal (Sugar'List [Sugar]
ls Wrap
_ Note
_) = [LispVal] -> LispVal
List ((Sugar -> LispVal) -> [Sugar] -> [LispVal]
forall a b. (a -> b) -> [a] -> [b]
map Sugar -> LispVal
toLispVal [Sugar]
ls)
toLispVal (Sugar'Map [(Sugar, Sugar)]
m Note
_) = Map LispVal LispVal -> LispVal
HashTable (Map LispVal LispVal -> LispVal) -> Map LispVal LispVal -> LispVal
forall a b. (a -> b) -> a -> b
$ [(LispVal, LispVal)] -> Map LispVal LispVal
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(LispVal, LispVal)] -> Map LispVal LispVal)
-> [(LispVal, LispVal)] -> Map LispVal LispVal
forall a b. (a -> b) -> a -> b
$ ((Sugar, Sugar) -> (LispVal, LispVal))
-> [(Sugar, Sugar)] -> [(LispVal, LispVal)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Sugar
x,Sugar
y) -> (Sugar -> LispVal
toLispVal Sugar
x, Sugar -> LispVal
toLispVal Sugar
y)) [(Sugar, Sugar)]
m