Language 84

File

language84-0.4/scan.84

{
: whitespace
: token
}

Where

Define (whitespace text i)
    Let m (STRING.length text)
    In
    Define (chomp_line i)
        Iterate {i}
            Cond
            | [i = m] i
            | [(STRING.fetch text i) = `\n`] [i + 1]
            | True Continue {[i + 1]}
            ;
    In
    Iterate {i}
        Cond
        | [i = m] i
        | True
            Let c (STRING.fetch text i)
            In
            Cond
            | [c = ` `] Continue {[i + 1]}
            | [c = `\n`] Continue {[i + 1]}
            | [c = `\\`] Continue {(chomp_line [i + 1])}
            | True i
            ;
        ;

Define (token text i)
    Let m (STRING.length text)
    In
    Cond
    | [i = m] {i 'eof}
    | True
        Let {i scan}
            Let c (STRING.fetch text i)
            In
            Cond
            | [c = `"`] {[i + 1] scan_string}
            | [c = ```] {[i + 1] scan_character}
            | (ASCII.is_digit c) {i scan_number}
            | (ASCII.is_letter c) {i scan_word}
            | (is_op_symbol c) {i scan_operator}
            | True {i scan_basic_symbol}
            ;
        In
        (scan text i m)
    ;

Where

Define (scan_string text i m)
    Let begin i
    Let end
        Iterate {i is_escaped} From {i False}
            Cond
            | [i = m] (OS.die "Unexpected EOF while scanning string literal.")
            | True
                Let c (STRING.fetch text i)
                In
                Cond
                | is_escaped
                    Let ok
                        Cond
                        | [c = `\\`] True
                        | [c = `"`] True
                        | [c = `n`] True
                        | [c = `0`] True
                        | True False
                        ;
                    In
                    If ok
                        Continue {[i + 1] False}
                        (OS.die "Invalid escape sequence in string literal.")
                | True
                    Cond
                    | [c = `"`] i
                    | [c = `\\`] Continue {[i + 1] True}
                    | [c = `\n`] (OS.die "Incomplete string literal.")
                    | True Continue {[i + 1] False}
                    ;
                ;
            ;
    In
    {[end + 1] 'str.(STRING.clip text [begin - 1] [end + 1])}

Define (scan_character text i m)
    Iterate {i state} From {i 'start}
        Cond
        | [i = m] (OS.die "Unexpected EOF in character literal.")
        | True
            Let c (STRING.fetch text i)
            In
            Match state
            | 'start
                Cond
                | [c = `\\`] Continue {[i + 1] 'escaped}
                | [c = `\n`] (OS.die "Incomplete character literal.")
                | True Continue {[i + 1] 'stop.c}
                ;
            | 'escaped
                Let num
                    Cond
                    | [c = `\\`] `\\`
                    | [c = `n`] `\n`
                    | [c = `0`] `\0`
                    | True (OS.die "Invalid escape sequence in character literal.")
                    ;
                In
                Continue {[i + 1] 'stop.num}
            | 'stop.num
                If [c = ```]
                    {[i + 1] 'num.num}
                    (OS.die "Invalid character literal.")
            ;
        ;

Define (scan_number text i m)
    Iterate {i num} From {i 0}
        Cond
        | [i = m] {i 'num.num}
        | True
            Let c (STRING.fetch text i)
            In
            If (ASCII.is_digit c)
                Continue {[i + 1] [[num * 10] + [c - `0`]]}
                {i 'num.num}
        ;

Define (scan_word text i m)
    Let begin i
    Let {end has_upper has_lower}
        Iterate {i has_upper has_lower} From {i False False}
            Cond
            | [i = m] {i has_upper has_lower}
            | True
                Let c (STRING.fetch text i)
                In
                Cond
                | (ASCII.is_upper c) Continue {[i + 1] True has_lower}
                | (ASCII.is_lower c) Continue {[i + 1] has_upper True}
                | (ASCII.is_digit c) Continue {[i + 1] has_upper has_lower}
                | [c = `_`] Continue {[i + 1] has_upper has_lower}
                | True {i has_upper has_lower}
                ;
            ;
    In
    Let word (STRING.clip text begin end)
    In
    If And has_upper has_lower
        {end 'sym.word}
        {end 'id.word}

Define (scan_operator text i m)
    Let begin i
    Let end
        Iterate {i} From {[i + 1]}
            Cond
            | [i = m] i
            | (is_op_symbol (STRING.fetch text i)) Continue {[i + 1]}
            | True i
            ;
    In
    {end 'op.(STRING.clip text begin end)}

Define (scan_basic_symbol text i m)
    {[i + 1] 'sym.(STRING.clip text i [i + 1])}

Where

Define (is_op_symbol c)
    Cond
    | [c = `+`] True
    | [c = `-`] True
    | [c = `*`] True
    | [c = `/`] True
    | [c = `%`] True
    | [c = `=`] True
    | [c = `<`] True
    | [c = `>`] True
    | [c = `!`] True
    | [c = `&`] True
    | True False
    ;

Where

Let ASCII Package "ascii"
Let OS Package "os"
Let STRING Package "string"