StringsBuiltin.hs

{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Values.Primitive.StringsBuiltin where

import Funcons.EDSL
import Funcons.Types

import Numeric 

library = libFromList [
        ("decimal-natural", ValueOp decimal_natural_op)
    ,   ("string-append", ValueOp string_append_op) 
    ,   ("decimal-rational", ValueOp stepDecimal_Rational)
    ,   ("string-to-list", ValueOp stepString_To_List)
    ,   ("list-to-string", ValueOp stepList_To_String)
    ,   ("to-string", ValueOp stepTo_String)
    ,   ("string", ValueOp stepString)
    ]

stepString_To_List [String s] = rewriteTo $ listval $ map (Ascii . fromEnum) s
stepString_To_List vn = sortErr (applyFuncon "string-to-list" (fvalues vn)) "sort check"


stepString vs 
    | all isChar_ vs = rewriteTo $ string_ (map fromChar vs)
    | otherwise  = sortErr (applyFuncon "string" (fvalues vs)) 
        "string not applied unicode characters"
    where isChar_ v | Char _ <- upcastUnicode v = True
                    | otherwise = False
          fromChar v | Char c <- upcastUnicode v = c
                     | otherwise = error "upcast in 'string'"

decimal_natural_ = FApp "decimal-natural" . FTuple 
decimal_natural_op [String s] = rewriteTo $ nat_ (read s)
decimal_natural_op vs = sortErr (decimal_natural_ (fvalues vs)) 
                            "decimal-natural not applied to strings"


stepDecimal_Rational [String s] = rewriteTo $ rational_ (readRational s)
stepDecimal_Rational v          = sortErr (applyFuncon "decimal-rational" (fvalues v))
                                     "decimal-natural not applied to a string"

stepList_To_String [List cs]    = list_to_string_op cs
stepList_To_String vs            = sortErr (applyFuncon "list-to-string" (fvalues vs)) 
                                    "list-to-string not applied to a list"

-- | 
-- Concatenate a sequence of strings.
string_append_ :: [Funcons] -> Funcons
string_append_ = applyFuncon "string-append"
string_append_op vs = maybe exc (rewriteTo . string_) $ foldr (.++.) (Just []) vs
 where  (.++.) (String s)   = fmap (s ++)
        (.++.) _            = const Nothing
        exc = sortErr (applyFuncon "string-append" [listval vs]) 
                "string-append not applied to strings"

list_to_string_op vs | all isAscii_ vs = rewriteTo $ string_ $  map ascii2char vs
                     | otherwise = sortErr (applyFuncon "list-to-string" (fvalues vs)) 
                            "list-to-string not applied to a list of ascii-characters"
 where ascii2char (Ascii i) = toEnum i
       ascii2char _         = error "list-to-string not applied to a list of ascii-characters"
       isAscii_ (Ascii i) = True
       isAscii_ _         = False

readRational :: String -> Rational
readRational = fst . head . readFloat

stepTo_String [String str]      = rewriteTo $ string_(str)
stepTo_String [Rational r]      = rewriteTo $ string_(show (fromRational r))
stepTo_String [Ascii o]         = rewriteTo $ string_([toEnum o])
stepTo_String vs                = rewriteTo $ string_(showValues (safe_tuple_val vs))