Language 84

File

language84-0.7/scan.84

{
:skip_whitespace
:token
:validate_bytes
}

Where

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

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

Define (validate_bytes text)
    Let m (STRING.length text)
    In
    If [m = 0]
        'succeed
        Iterate i From 0
            Cond {
            | [i = m]
                If [(STRING.fetch text [m - 1]) = `\n`]
                    'succeed
                    'fail."Source text encoding: no terminating newline character."
            | True
                Let c (STRING.fetch text i)
                In
                If (Or (ASCII.is_visible c) [c = ` `] [c = `\n`])
                    (Continue [i + 1])
                    'fail.[
                        STDIO.sprintf
                        <- "Source text encoding: forbidden byte (%d)." <- c
                    ]
            }

Where

Define (scan_string text i)
    Let begin i
    In
    Iterate {i mode} From {i 'default}
        Let c (STRING.fetch text i)
        In
        If [c = `\n`]
            {i 'error."Incomplete string literal."}
            Match mode {
            | 'default
                Cond {
                | [c = `\\`]
                    (Continue [i + 1] 'escaped)
                | [c = `"`]
                    Let end i
                    In
                    {[end + 1] 'str.(STRING.clip text [begin - 1] [end + 1])}
                | True
                    (Continue [i + 1] 'default)
                }
            | 'escaped
                Cond {
                | (Or [c = `\\`] [c = `"`] [c = `n`] [c = `r`] [c = `t`])
                    (Continue [i + 1] 'default)
                | True
                    {i 'error."Invalid escape sequence in string literal."}
                }
            }

Define (scan_character text i)
    Let begin i
    In
    Iterate {i mode} From {i 'start}
        Let c (STRING.fetch text i)
        In
        If [c = `\n`]
            {i 'error."Incomplete character literal."}
            Match mode {
            | 'start
                If [c = `\\`]
                    (Continue [i + 1] 'escaped)
                    (Continue [i + 1] 'stop.c)
            | 'escaped
                Let num
                    Cond {
                    | [c = `\\`] `\\`
                    | [c = `n`] `\n`
                    | [c = `r`] `\r`
                    | [c = `t`] `\t`
                    | True `?`
                    }
                In
                If [num = `?`]
                    {i 'error."Invalid escape sequence in character literal."}
                    (Continue [i + 1] 'stop.num)
            | 'stop.num
                If [c = ```]
                    {[i + 1] 'num.num}
                    {i 'error."Invalid character literal."}
            }

Define (scan_number text i)
    Iterate {i num} From {i 0}
        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)
    Let begin i
    Let {end has_upper has_lower}
        Iterate {i has_upper has_lower} From {i False False}
            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)
    Let begin i
    Let end
        Iterate i From [i + 1]
            If (is_op_symbol (STRING.fetch text i))
                (Continue [i + 1])
                i
    In
    {end 'op.(STRING.clip text begin end)}

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

Where

Define (skip_line text i)
    Iterate i
        If [(STRING.fetch text i) = `\n`]
            [i + 1]
            (Continue [i + 1])

Define (skip_spaces text i)
    Iterate i
        If [(STRING.fetch text i) = ` `]
            (Continue [i + 1])
            i

Define (is_op_symbol c)
    (Or [c = `+`] [c = `-`] [c = `*`] [c = `/`] [c = `\\`] [c = `%`]
        [c = `=`] [c = `<`] [c = `>`] [c = `!`] [c = `?`] [c = `^`] [c = `&`])

Where

Open Z
    {
    :Infix =
    :Infix +
    :Infix -
    :Infix *
    }

Open FUNC {:Infix <-}

Where

Let ASCII Package "ascii"
Let FUNC Package "func"
Let STDIO Package "stdio"
Let STRING Package "string"
Let Z Package "z"