PS: fix string escaping. Passes all tests.

[jackhill/mal.git] / ps / reader.ps

(in reader\n) print

% requires types.ps to be included first

/token_delim (;,"` \n{}\(\)[]) def
/token_number (0123456789-) def

% read_number: read a single number from string/idx
% string idx -> read_number -> number string new_idx
/read_number {
    %(in read_number\n) print
    /idx exch def
    /str exch def
    /start idx def
    /cnt 0 def
    { % loop
        idx str length ge { exit } if % EOF, break loop
        /ch str idx get def  % current character
        ch 48 ge ch 57 le and 45 ch eq or { %if number
            /cnt cnt 1 add def
        }{ % else
            exit
        } ifelse
        /idx idx 1 add def % increment idx
    } loop

    str start cnt getinterval cvi % the matched number
    str idx % return: number string new_idx
} def


% read_symbol: read a single symbol from string/idx
% string idx -> read_symbol -> name string new_idx
/read_symbol {
    %(in read_symbol\n) print
    /idx exch def
    /str exch def
    /start idx def
    /cnt 0 def
    { % loop
        idx str length ge { exit } if % EOF, break loop
        /ch str idx 1 getinterval def
        token_delim ch search { % if token delimeter
            pop pop pop exit
        }{ % else not a delim
            pop
            /cnt cnt 1 add def
        } ifelse
        /idx idx 1 add def % increment idx
    } loop

    str start cnt getinterval cvn % the matched symbol
    str idx % return: symbol string new_idx
} def


% read_string: read a single string from string/idx
% string idx -> read_string -> new_string string new_idx
/read_string {
    %(in read_string\n) print
    /idx exch 1 add def
    /str exch def
    /start idx def
    /cnt 0 def
    { % loop
        idx str length ge { %if EOF
            (unexpected EOF reading string) _throw
        } if
        /ch str idx get def  % current character
        /idx idx 1 add def
        ch 92 eq { % if \
            str idx get 34 eq { %if \"
                /idx idx 1 add def
                /cnt cnt 1 add def % 1 more below
            } if
        } if
        ch 34 eq { exit } if % '"' is end of string
        /cnt cnt 1 add def
    } loop
    str start cnt getinterval % the matched string
    (\\") (") replace
    str idx % return: new_string string new_idx
} def


% read_atom: read a single atom from string/idx
% string idx -> read_atom -> int string new_idx
/read_atom {
    %(in read_atom\n) print
    /idx exch def
    /str exch def
    str length idx le { % ifelse
        exit % EOF
    }{
        /ch str idx get def  % current character
        %ch 48 ge ch 57 le and 45 ch eq or { %if number
        ch 48 ge ch 57 le and { %if number
            str idx read_number
        }{ ch 34 eq { %elseif double-quote
            str idx read_string
        }{
            str idx read_symbol
            /idx exch def pop
            dup /nil eq { %if nil
                pop null str idx
            }{ dup /true eq { %elseif true
                pop true str idx
            }{ dup /false eq { %elseif false
                pop false str idx
            }{ %else
                str idx % return the original symbol/name
            } ifelse } ifelse } ifelse
        } ifelse } ifelse
    }ifelse

    % return: atom string new_idx
} def

% read_until: read a list from string/idx until stopchar is found
% string idx stopchar -> read_until -> list string new_idx
/read_until {
    %(in read_until\n) print
    /stopchar exch def
    /idx exch 1 add def
    /str exch def
    [
    { % loop
        str idx read_spaces /idx exch def pop
        str length idx le { %if EOF
            (unexpected EOF reading list) _throw
        } if
        /ch str idx get def  % current character
        ch stopchar eq { exit } if % stop at stopchar
        str idx read_form /idx exch def pop
    } loop
    ]
    str idx 1 add
} def

% read_spaces: advance idx to the first non-whitespace
% string idx -> read_form -> string new_idx
/read_spaces {
    %(in read_spaces\n) print
    /idx exch def
    /str exch def
    { % loop
        str length idx le { exit } if % EOF, break loop
        /ch str idx get def  % current character
        % if not whitespace then exit
        ch 32 ne ch 10 ne ch 44 ne and and { exit } if
        /idx idx 1 add def % increment idx
    } loop

    str idx % return: string new_idx
} def

% read_form: read the next form from string start at idx
% string idx -> read_form -> ast string new_idx
/read_form { 3 dict begin
    %(in read_form\n) print
    read_spaces
    /idx exch def
    /str exch def

    idx str length ge { (unexpected EOF) _throw } if % EOF
    /ch str idx get def  % current character
    ch 59 eq { %if ';'
        { % loop
            /idx idx 1 add def % increment idx
            str length idx le { exit } if % EOF, break loop
            /ch str idx get def  % current character
            % if newline then add 1 more idx and exit
            ch 10 eq {
                /idx idx 1 add def
                exit
            } if
        } loop
        str idx read_form % recur to get next form
    }{ ch 39 eq { %if '\''
        /idx idx 1 add def
        str idx read_form
        3 -1 roll   /quote exch 2 _list   3 1 roll
    }{ ch 96 eq { %if '`'
        /idx idx 1 add def
        str idx read_form
        3 -1 roll   /quasiquote exch 2 _list   3 1 roll
    }{ ch 126 eq { %if '~'
        /idx idx 1 add def
        /ch str idx get def  % current character
        ch 64 eq { %if '~@'
            /idx idx 1 add def
            str idx read_form
            3 -1 roll   /splice-unquote exch 2 _list   3 1 roll
        }{ %else just '~'
            str idx read_form
            3 -1 roll   /unquote exch 2 _list   3 1 roll
        } ifelse
    }{ ch 94 eq { %if '^'
        /idx idx 1 add def
        str idx read_form read_form % stack: meta form str idx
        4 2 roll exch   /with-meta 3 1 roll 3 _list   3 1 roll
    }{ ch 64 eq { %if '@'
        /idx idx 1 add def
        str idx read_form
        3 -1 roll   /deref exch 2 _list   3 1 roll
    }{ ch 40 eq { %if '('
        str idx 41 read_until
        3 -1 roll   _list_from_array   3 1 roll
    }{ ch 41 eq { %elseif ')'
        (unexpected '\)') _throw
    }{ ch 91 eq { %if '('
        str idx 93 read_until
        3 -1 roll   _vector_from_array   3 1 roll
    }{ ch 93 eq { %elseif ']'
        (unexpected ']') _throw
    }{ ch 123 eq { %elseif '{'
        str idx 125 read_until
        3 -1 roll   _hash_map_from_array   3 1 roll
    }{ ch 125 eq { %elseif '}'
        (unexpected '}') _throw
    }{ % else
        str idx read_atom
    } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse

    % return: ast string new_idx
end } def

% string -> read_str -> ast
/read_str {
    %(in read_str\n) print
    0  % current index into the string
    read_form

    pop pop  % drop the string, idx. return: ast
} def