module Casui.Value where import Casui.Name import Data.Ratio import Data.List data Value val = VName Name | VExact Rational | VString String | VList [val] | VStruct FullName [val] | VFun ([val] -> val) -- | VProc ([val] -> Casui val) data Property name val = E name [val] data Expression = Expression { eProperties :: Property FullName Expression, eValue :: Value Expression } type Type = FullName class Val v where val :: v -> Value v class ToValue a where value :: a -> Value v class FromValue a where unvalue :: Value v -> Maybe a instance ToValue Bool where value True = VName $ fullName Builtin "bool:true" value False = VName $ fullName Builtin "bool:false" instance FromValue Bool where unvalue (VName n) | n == builtin "bool:true" = Just True | n == builtin "bool:false" = Just False unvalue _ = Nothing instance ToValue Int where value = VExact . toRational instance FromValue Int where unvalue (VExact r) = if denominator r == 1 then Just . fromInteger $ numerator r else Nothing unvalue _ = Nothing baseType :: Value v -> Type baseType (VName _) = builtin "type:symbol" baseType (VExact _) = builtin "type:rational" baseType (VString _) = builtin "type:string" baseType (VList _) = builtin "type:list" baseType (VFun _) = builtin "type:fun" baseType (VStruct t _) = t isPrimitiveType :: FName n => n -> Bool isPrimitiveType (show -> s) = elem s . map ("builtin:type:"++) $ ["symbol", "rational", "string"] instance Show v => Show (Value v) where show (VName n) = show n show (VExact r) = if denominator r == 1 then show $ numerator r else show $ (fromRational r :: Double) show (VString s) = show s show (VList l) = "(" ++ (concat . intersperse " ") (map show l) ++ ")" show (VFun _) = "#fun" show (VStruct n [a]) | show n == "builtin:script:quote" = "'" ++ show a show (VStruct n [a]) | show n == "builtin:script:unquote" = "," ++ show a show (VStruct n [a]) | show n == "builtin:script:quasiquote" = "`" ++ show a show (VStruct n l) = "(" ++ (concat . intersperse " ") (show n : map show l) ++ ")"