HSP 対応版 kmyacc を公開しました

• HSP 対応版 kmyacc ダウンロード

Windows 用バイナリアーカイブ とソースアーカイブの二つを用意しました。

他の言語のプロトタイプを参考にやったら出来ました！ kmyacc 本体をイジる必要があったのは改行周りだけでした。（ HSP では改行が文の終わりだから。 Python 版でも同じように改行周りで特別に処理していた。）

-tオプション（デバッグモード）、-aオプション（reduce時のactionを一つ一つサブルーチンに分けてラベル型配列変数を使って実行）に対応しています。

ActionScriptのyaccを作ったよ - yukobaの日記の画像を見ると ActionScript 版のデバッグモードでは accept 後にツリーを表示しているようですね。 HSP 版でも次期バージョンで対応するかもしれません。→対応しました

kmyacc の作者、各言語のプロトタイプの作者に感謝します。

構文木を使ったサンプル

付属のサンプル（ calc.hspy ）では物足りないと思うので、構文木を使ったサンプルも置いておきます。参考にしてみてください。変数の代入とか、if文とか使えます。

%token kNUMBER kIDENT kEOL kIF kELSE kEND

%right '='
%left '+' '-'
%left '*' '/'

%%

program
    : stmt_list { syntaxtree = $1 }

stmt_list
    : { new_list_node $$ }
    | stmt_list stmt kEOL { yylrec++ : append_list_node $$, $2 }
    | stmt_list kEOL

stmt
    : expr
    | if_stmt

if_stmt
    : kIF expr kEOL stmt_list else_stmt kEND
        {
            new_if_node $$, $2, $4, $5
        }

else_stmt
    : kELSE kEOL stmt_list { $$ = $3 }
    | { new_list_node $$ }

expr
    : expr '+' expr { new_operator_node $$, '+', $1, $3 }
    | expr '-' expr { new_operator_node $$, '-', $1, $3 }
    | expr '*' expr { new_operator_node $$, '*', $1, $3 }
    | expr '/' expr { new_operator_node $$, '/', $1, $3 }
    | '(' expr ')' { $$ = $2 }
    | kNUMBER { new_literal_node $$, $1 }
    | kIDENT { new_varref_node $$, $1 }
    | kIDENT '=' expr { new_assign_node $$, $1, $3 }

%%

#runtime "hsp3cl"

if 0 {
#defcfunc varref str varname
    if vars( "Exists", varname ) {
        return vars( "Item", varname )
    }
    mes "undefined variable `"+varname+"'"
    return 0
#deffunc setvar str varname, int val
    if vars( "Exists", varname ) : vars -> "Remove" varname
    vars -> "Add" varname, val
    return
}

#module m_node type, children, val
#enum TYPE_LITERAL = 1
#enum TYPE_VARREF
#enum TYPE_ASSIGN
#enum TYPE_OPERATOR
#enum TYPE_LIST
#enum TYPE_IF

#define last_node (nodes(length(nodes)-1))

#modfunc init_literal_node int _val
    type = TYPE_LITERAL
    val = _val
    return
#deffunc new_literal_node var ret, int _val
    newmod nodes, m_node
    init_literal_node last_node, _val
    ret = last_node
    return

#modfunc init_varref_node str varname
    type = TYPE_VARREF
    val = varname
    return
#deffunc new_varref_node var ret, str varname
    newmod nodes, m_node
    init_varref_node last_node, varname
    ret = last_node
    return

#modfunc init_assign_node str varname, var expr
    type = TYPE_ASSIGN
    val = varname
    children = expr
    return
#deffunc new_assign_node var ret, str varname, var expr
    newmod nodes, m_node
    init_assign_node last_node, varname, expr
    ret = last_node
    return

#modfunc init_operator_node int operator, var lhs, var rhs
    type = TYPE_OPERATOR
    val = operator
    children = lhs, rhs
    return
#deffunc new_operator_node var ret, int operator, var lhs, var rhs
    newmod nodes, m_node
    init_operator_node last_node, operator, lhs, rhs
    ret = last_node
    return

#modfunc init_list_node
    type = TYPE_LIST
    dimtype children, 5
    val = 0 // appended flag
    return
#deffunc new_list_node var ret
    newmod nodes, m_node
    init_list_node last_node
    ret = last_node
    return
#modfunc append_list_node var append_node
    if val {
        children( length( children ) ) = append_node
    } else {
        children = append_node
    }
    val = 1
    return

#modfunc init_if_node var cond, var tstmt, var fstmt
    type = TYPE_IF
    children = cond, tstmt, fstmt
    return
#deffunc new_if_node var ret, var cond, var tstmt, var fstmt
    newmod nodes, m_node
    init_if_node last_node, cond, tstmt, fstmt
    ret = last_node
    return

#defcfunc eval_node modvar m_node@
    if type == TYPE_LITERAL {
        return val
    }
    if type == TYPE_VARREF {
        return varref( val )
    }
    if type == TYPE_ASSIGN {
        v = eval_node( children )
        setvar val, v
        return v
    }
    if type == TYPE_OPERATOR {
        l = eval_node( children.0 )
        r = eval_node( children.1 )
        if val == '+' {
            return l + r
        }
        if val == '-' {
            return l - r
        }
        if val == '*' {
            return l * r
        }
        if val == '/' {
            return l / r
        }
    }
    if type == TYPE_LIST {
        result = 0
        foreach children
            result = eval_node( children.cnt )
        loop
        return result
    }
    if type == TYPE_IF {
        if eval_node( children.0 ) {
            return eval_node( children.1 )
        }
        return eval_node( children.2 )
    }
    mes "must not happen" : stop
#global

    newcom vars, "Scripting.Dictionary"
    vars("compareMode") = 0
    
    newcom reserved, "Scripting.Dictionary"
    reserved -> "Add" "if", kIF
    reserved -> "Add" "else", kELSE
    reserved -> "Add" "end", kEND
    
    yyparse
    if vartype( syntaxtree ) == 5 : mes eval_node( syntaxtree )
    ;end stat
    stop

*yylex
    if start == 0 {
        input expr,, 1
        if peek( expr ) == 0 : return 0
        expr_ptr = 0
        start = 1
    }
    char = peek( expr, expr_ptr )
    if char == 10 || char == 13 {
        start = 0
        return kEOL
    }
    if char == ' ' || char == '\t' {
        expr_ptr ++
        goto *yylex
    }
    if char >= '0' && char <= '9' {
        yylval = char - '0'
        expr_ptr ++
        repeat
            char = peek( expr, expr_ptr )
            if char >= '0' && char <= '9' : else : break
            yylval = yylval * 10 + char - '0'
            expr_ptr ++
        loop
        return kNUMBER
    }
    if ( char >= 'a' && char <= 'z' ) || ( char >= 'A' && char <= 'Z' ) || char == '_' {
        yylval = expr_ptr
        repeat
            char = peek( expr, expr_ptr )
            cond   = char >= 'a' && char <= 'z'
            cond ||= char >= 'A' && char <= 'Z'
            cond ||= char == '_'
            cond ||= char >= '0' && char <= '9'
            if cond : else : break
            expr_ptr ++
        loop
        yylval = strmid( expr, yylval, expr_ptr - yylval )
        if reserved( "Exists", yylval ) {
            return reserved( "Item", yylval )
        }
        return kIDENT
    }
    expr_ptr ++
    return char

*yyerror
    mes yyerrmsg
    return