Functional Programming

Hi /prog/, I needs help.

Could people give me some code in a functional language, specifically, I'd like some Haskell and OCaml. Lisp is also welcome. Other functional languages are also welcome (and appreciated), though I'm most interested in the mentioned ones.

The code snippet I'm looking for is to convert a string to uppercase, but I want the code to do this manually (so no calling some magical toupper function or whatever).
That means, this Haskell code is not valid, since it uses toUpper (though, if you define toUpper, I suppose I'll count it as valid).

import Data.Char
s = "alphaBETA"
upper = map toUpper s
Preferably I'd like code which does not use map or other such constructs (though if thats too dificult, then ignore this requirement). Also, if possible, I'd like code that converts the string both in place and by constructing a new string.


Basically, I want to see different approaches to doing this in different languages. All serious replies are appreciated. Trolls appreciated only if they make me laugh.

>>77

       Identification division.
       Program-ID. Who-the-fuck-are-you.
       Author. UMH memesmith.
       Date-written. September 2009.
       Procedure division.
       Control-paragraph.
           Display "What? Who the fuck are you?"
           Display "You don't even know COBOL."
           Stop run.


up [] = []
up (x:xs) = toUpper x:up xs

>>83
EXPERT UNICODE PROGRAMMER

>>83
up = map toUpper

#include <stdio.h>
#include <stdlib.h>

char to_upper( char foo )
{
    return foo >= 'a' && foo <= 'z' ? foo + ('A' - 'a') : foo;}

char to_lower( char foo )
{
    return foo >= 'A' && foo <= 'Z' ? foo + ('a' - 'A') : foo;}

void map_str( char * str, char (func)(char) )
{
    if ( !*str )
    {
        return;    }
    *str = func(*str);
    map_str( ++str, func );}


void map_str_to( const char * str, char * dst, char (func)(char) )
{
    if ( !*str )
    {
        return;    }
    *dst = func(*str);
    map_str_to( ++str, ++dst, func );}


int main( int argc, char ** argv )
{
    char convert[] = "ZERO 1 infinity";
    char *converted = malloc(sizeof(convert)+1);
    map_str( convert, to_upper );
    puts( convert );
    map_str_to( convert, converted, to_lower );
    puts( converted );
    return 0;}

Let me just EXPERT FORMAT(TM) that for you:

#include <stdio.h>
#include <stdlib.h>

char to_upper( char foo )
{
return foo >= 'a' && foo <= 'z' ? foo + ('A' - 'a') : foo;}

char to_lower( char foo )
{
return foo >= 'A' && foo <= 'Z' ? foo + ('a' - 'A') : foo;}

void map_str( char * str, char (func)(char) )
{
if ( !*str )
{
return;}
*str = func(*str);
map_str( ++str, func );}


void map_str_to( const char * str, char * dst, char (func)(char) )
{
if ( !*str )
{
return;}
*dst = func(*str);
map_str_to( ++str, ++dst, func );}


int main( int argc, char ** argv )
{
char convert[] = "ZERO 1 infinity";
char *converted = malloc(sizeof(convert)+1);
map_str( convert, to_upper );
puts( convert );
map_str_to( convert, converted, to_lower );
puts( converted );
return 0;}

>>87

waste of time, bru, there's probably a pipeable filter for that

>>88
% tr a-z A-Z

(% tr '[:lower:]' '[:upper:]' might do more.)

#define CASE_SINGLE(value,offset) if(code==value) return code+offset;
#define CASE_RANGE(left,right,offset) if(code>=left && code<=right) return code+offset;
#define CASE_RANGE_EVEN(left,right,offset) if(code%2==0 && code>=left && code<=right) return code+offset;
#define CASE_RANGE_ODD(left,right,offset) if(code%2==1 && code>=left && code<=right) return code+offset;

unsigned int ucs_toupper(unsigned int code){
    switch(code>>8){
    case 0x00:
        CASE_RANGE     (0x0061,0x007a,-32)
        CASE_SINGLE    (0x00b5,743)
        CASE_RANGE     (0x00e0,0x00f6,-32)
        CASE_RANGE     (0x00f8,0x00fe,-32)
        CASE_SINGLE    (0x00ff,121)
        break;
    case 0x01:
        CASE_RANGE_ODD (0x0101,0x012f,-1)
        CASE_SINGLE    (0x0131,-232)
        CASE_RANGE_ODD (0x0133,0x0137,-1)
        CASE_RANGE_EVEN(0x013a,0x0148,-1)
        CASE_RANGE_ODD (0x014b,0x0177,-1)
        CASE_RANGE_EVEN(0x017a,0x017e,-1)
        CASE_SINGLE    (0x017f,-300)
        CASE_SINGLE    (0x0180,195)
        CASE_RANGE_ODD (0x0183,0x0185,-1)
        CASE_SINGLE    (0x0188,-1)
        CASE_SINGLE    (0x018c,-1)
        CASE_SINGLE    (0x0192,-1)
        CASE_SINGLE    (0x0195,97)
        CASE_SINGLE    (0x0199,-1)
        CASE_SINGLE    (0x019a,163)
        CASE_SINGLE    (0x019e,130)
        CASE_RANGE_ODD (0x01a1,0x01a5,-1)
        CASE_SINGLE    (0x01a8,-1)
        CASE_SINGLE    (0x01ad,-1)
        CASE_SINGLE    (0x01b0,-1)
        CASE_RANGE_EVEN(0x01b4,0x01b6,-1)
        CASE_SINGLE    (0x01b9,-1)
        CASE_SINGLE    (0x01bd,-1)
        CASE_SINGLE    (0x01bf,56)
        CASE_SINGLE    (0x01c5,-1)
        CASE_SINGLE    (0x01c6,-2)
        CASE_SINGLE    (0x01c8,-1)
        CASE_SINGLE    (0x01c9,-2)
        CASE_SINGLE    (0x01cb,-1)
        CASE_SINGLE    (0x01cc,-2)
        CASE_RANGE_EVEN(0x01ce,0x01dc,-1)
        CASE_SINGLE    (0x01dd,-79)
        CASE_RANGE_ODD (0x01df,0x01ef,-1)
        CASE_SINGLE    (0x01f2,-1)
        CASE_SINGLE    (0x01f3,-2)
        CASE_SINGLE    (0x01f5,-1)
        CASE_RANGE_ODD (0x01f9,0x021f,-1)
        break;
    case 0x02:
        CASE_RANGE_ODD (0x01f9,0x021f,-1)
        CASE_RANGE_ODD (0x0223,0x0233,-1)
        CASE_SINGLE    (0x023c,-1)
        CASE_SINGLE    (0x0242,-1)
        CASE_RANGE_ODD (0x0247,0x024f,-1)
        CASE_SINGLE    (0x0250,10783)
        CASE_SINGLE    (0x0251,10780)
        CASE_SINGLE    (0x0253,-210)
        CASE_SINGLE    (0x0254,-206)
        CASE_RANGE     (0x0256,0x0257,-205)
        CASE_SINGLE    (0x0259,-202)
        CASE_SINGLE    (0x025b,-203)
        CASE_SINGLE    (0x0260,-205)
        CASE_SINGLE    (0x0263,-207)
        CASE_SINGLE    (0x0268,-209)
        CASE_SINGLE    (0x0269,-211)
        CASE_SINGLE    (0x026b,10743)
        CASE_SINGLE    (0x026f,-211)
        CASE_SINGLE    (0x0271,10749)
        CASE_SINGLE    (0x0272,-213)
        CASE_SINGLE    (0x0275,-214)
        CASE_SINGLE    (0x027d,10727)
        CASE_SINGLE    (0x0280,-218)
        CASE_SINGLE    (0x0283,-218)
        CASE_SINGLE    (0x0288,-218)
        CASE_SINGLE    (0x0289,-69)
        CASE_RANGE     (0x028a,0x028b,-217)
        CASE_SINGLE    (0x028c,-71)
        CASE_SINGLE    (0x0292,-219)
        break;
    case 0x03:
        CASE_SINGLE    (0x0345,84)
        CASE_RANGE_ODD (0x0371,0x0373,-1)
        CASE_SINGLE    (0x0377,-1)
        CASE_RANGE     (0x037b,0x037d,130)
        CASE_SINGLE    (0x03ac,-38)
        CASE_RANGE     (0x03ad,0x03af,-37)
        CASE_RANGE     (0x03b1,0x03c1,-32)
        CASE_SINGLE    (0x03c2,-31)
        CASE_RANGE     (0x03c3,0x03cb,-32)
        CASE_SINGLE    (0x03cc,-64)
        CASE_RANGE     (0x03cd,0x03ce,-63)
        CASE_SINGLE    (0x03d0,-62)
        CASE_SINGLE    (0x03d1,-57)
        CASE_SINGLE    (0x03d5,-47)
        CASE_SINGLE    (0x03d6,-54)
        CASE_SINGLE    (0x03d7,-8)
        CASE_RANGE_ODD (0x03d9,0x03ef,-1)
        CASE_SINGLE    (0x03f0,-86)
        CASE_SINGLE    (0x03f1,-80)
        CASE_SINGLE    (0x03f2,7)
        CASE_SINGLE    (0x03f5,-96)
        CASE_SINGLE    (0x03f8,-1)
        CASE_SINGLE    (0x03fb,-1)
        break;
    case 0x04:
        CASE_RANGE     (0x0430,0x044f,-32)
        CASE_RANGE     (0x0450,0x045f,-80)
        CASE_RANGE_ODD (0x0461,0x0481,-1)
        CASE_RANGE_ODD (0x048b,0x04bf,-1)
        CASE_RANGE_EVEN(0x04c2,0x04ce,-1)
        CASE_SINGLE    (0x04cf,-15)
        CASE_RANGE_ODD (0x04d1,0x0523,-1)
        break;
    case 0x05:
        CASE_RANGE_ODD (0x04d1,0x0523,-1)
        CASE_RANGE     (0x0561,0x0586,-48)
        break;
    case 0x1d:
        CASE_SINGLE    (0x1d79,35332)
        CASE_SINGLE    (0x1d7d,3814)
        break;
    case 0x1e:
        CASE_RANGE_ODD (0x1e01,0x1e95,-1)
        CASE_SINGLE    (0x1e9b,-59)
        CASE_RANGE_ODD (0x1ea1,0x1eff,-1)
        break;
    case 0x1f:
        CASE_RANGE     (0x1f00,0x1f07,8)
        CASE_RANGE     (0x1f10,0x1f15,8)
        CASE_RANGE     (0x1f20,0x1f27,8)
        CASE_RANGE     (0x1f30,0x1f37,8)
        CASE_RANGE     (0x1f40,0x1f45,8)
        CASE_RANGE_ODD (0x1f51,0x1f57,8)
        CASE_RANGE     (0x1f60,0x1f67,8)
        CASE_RANGE     (0x1f70,0x1f71,74)
        CASE_RANGE     (0x1f72,0x1f75,86)
        CASE_RANGE     (0x1f76,0x1f77,100)
        CASE_RANGE     (0x1f78,0x1f79,128)
        CASE_RANGE     (0x1f7a,0x1f7b,112)
        CASE_RANGE     (0x1f7c,0x1f7d,126)
        CASE_RANGE     (0x1f80,0x1f87,8)
        CASE_RANGE     (0x1f90,0x1f97,8)
        CASE_RANGE     (0x1fa0,0x1fa7,8)
        CASE_RANGE     (0x1fb0,0x1fb1,8)
        CASE_SINGLE    (0x1fb3,9)
        CASE_SINGLE    (0x1fbe,-7205)
        CASE_SINGLE    (0x1fc3,9)
        CASE_RANGE     (0x1fd0,0x1fd1,8)
        CASE_RANGE     (0x1fe0,0x1fe1,8)
        CASE_SINGLE    (0x1fe5,7)
        CASE_SINGLE    (0x1ff3,9)
        break;
    case 0x21:
        CASE_SINGLE    (0x214e,-28)
        CASE_RANGE     (0x2170,0x217f,-16)
        CASE_SINGLE    (0x2184,-1)
        break;
    case 0x24:
        CASE_RANGE     (0x24d0,0x24e9,-26)
        break;
    case 0x2c:
        CASE_RANGE     (0x2c30,0x2c5e,-48)
        CASE_SINGLE    (0x2c61,-1)
        CASE_SINGLE    (0x2c65,-10795)
        CASE_SINGLE    (0x2c66,-10792)
        CASE_RANGE_EVEN(0x2c68,0x2c6c,-1)
        CASE_SINGLE    (0x2c73,-1)
        CASE_SINGLE    (0x2c76,-1)
        CASE_RANGE_ODD (0x2c81,0x2ce3,-1)
        break;
    case 0x2d:
        CASE_RANGE     (0x2d00,0x2d25,-7264)
        break;
    case 0xa6:
        CASE_RANGE_ODD (0xa641,0xa65f,-1)
        CASE_RANGE_ODD (0xa663,0xa66d,-1)
        CASE_RANGE_ODD (0xa681,0xa697,-1)
        break;
    case 0xa7:
        CASE_RANGE_ODD (0xa723,0xa72f,-1)
        CASE_RANGE_ODD (0xa733,0xa76f,-1)
        CASE_RANGE_EVEN(0xa77a,0xa77c,-1)
        CASE_RANGE_ODD (0xa77f,0xa787,-1)
        CASE_SINGLE    (0xa78c,-1)
        break;
    case 0xff:
        CASE_RANGE     (0xff41,0xff5a,-32)
        break;
    case 0x104:
        CASE_RANGE     (0x10428,0x1044f,-40)
        break;
    }
   
    return code;
}

#include <stdio.h>      // putc
#include <stdint.h>     // SIZE_MAX
#include <ctype.h>      // isalpha

void its_functional(char *arg)
{
    if(*arg != '\0')
    {
        int result = EOF;
        if(isalpha(*arg))
        {
            result = putchar(*arg - 0x20);
        }
        else
        {
            result = putchar(*arg);
        }

        if(result != EOF)
        {
            its_functional(++arg);
        }
    }
}

int main(int argc, char *argv[])
{
    if(argc != 2)
    {
        fprintf(stderr, "Usage: %s <string>\n", argv[0]);
        return -1;
    }

    its_functional(&argv[1][0]);
    return 0;
}

If anyone can provide a working Unicode version then I'm all eyes. My version fails with "Invalid multi-byte character" whenever I try to feed it an actual UTF-8 character. Here it is:

#include <string.h>
#include <stdio.h>
#include <wctype.h>
#include <wchar.h>
#include <limits.h>
#include <errno.h>

void its_functional(wchar_t *arg)
{
    if(*arg != L'\0')
    {
        putwchar(towupper(*arg));
        its_functional(++arg);
    }
}

int main(int argc, char *argv[])
{
    wchar_t arg[_POSIX_ARG_MAX] = {L'\0'};

    if(fwide(stdout, 0) == 0)
    {
        if(fwide(stdout, 1) <= 0)
        {
            fputs("Failed to switch to wide character mode\n", stderr);
            return -1;
        }
    }

    if(argc != 2)
    {
        fwprintf(stderr, L"Usage: %s <string>\n", argv[0]);
        return -1;
    }

    if(mbstowcs(arg, argv[1], strlen(argv[1])) == (size_t)-1)
    {
        fputs(strerror(errno), stderr);
        return -1;
    }
    its_functional(arg);
    return 0;
}

>>15
HOLY SHIT PPPP NO YOU HOT GRIDS