// stmt-s.txt
//   public release som-v2   30 December 2004
//   public release som-v24  10 January 2007
//   public release som v3.0  5 March 2007 (Maka-bucha day)
//   public release som v3.1 	19 Aug 2007 (Draft vote day)

// ---- parser stack  operators -----

to ypush x =
    ysp = ysp + 1
    if ysp >= MAXYSTK
        seterror "parser stack overflow"
    ystack[ysp] = x

to ypop | x =
    if ysp <= 0
        seterror "parser stack underflow"
    x = ystack[ysp]
    ysp = ysp - 1
    x

to ytos = ystack[ysp]

// -------------------------------

to expect tk mess =
    if tok != tk seterror mess

to commit status =
    if status == 0 seterror "syntax error"

// [ idx arity -- idx ]
to setfname type | arity idx =
    arity = ypop
    idx = ytos
    if (getType idx) != tyNEW
        warning (getName idx) "redefine function"
    setType idx type
    setArity idx arity
    setLv idx Nlv

// [idx %ex -- %to]
to dofun tk | idx e a =
    e = ypop
    idx = ypop
    if verbose
        printc 43 prints getName idx nl
    a = cons (newatom GNAME idx) (list e)
    ypush cons (newatom OPER tk) a
//	dumpSym
//	dumpLocal
    clearLocal

//  [ -- %var ]
to dovar idx | type =
    type = getType idx
    if type == tyGVAR
        ypush newatom GNAME idx
    else if type == tyLOCAL
        ypush newatom LNAME (getRef idx)
    else
        seterror "dovar: expect variable"

// [lvidx %ex0 %ex0 %ex -- %for] (for lv ex0 ex0 ex)
to dofor | e idx =
    e = ypop
    e = cons ypop (list e)
    e = cons ypop e		// (ex0 ex0 ex)
    idx = ypop			// lvidx
    if (getType idx) != tyLOCAL
        seterror "index variable must be local"
    dovar idx			// [ -- %var]
    ypush cons (newatom OPER tkFOR) (cons ypop e)

// [%ex0 %ex -- %while] (while ex0 ex)
to dowhile | e =
    e = ypop
    e = cons ypop (list e)
    ypush cons (newatom OPER tkWHILE) e

// [%ex0 %ex [%ex MARK] -- %if/ifelse ]
to doif | e =
    if ytos == MARK
        e = ypop		// throw away MARK
        e = ypop
        e = cons ypop (list e)
        e = cons ypop e	// (ex0 ex ex)
        ypush cons (newatom OPER tkELSE) e
    else
        e = ypop
        e = cons ypop (list e)
        ypush cons (newatom OPER tkIF) e

// [%var %ex -- %vec]
to dovec | e v a =
    e = ypop
    v = ypop
    if isatom v
        a = newatom OPER tkLBRACKET
        ypush cons a (cons v (list e))
    else
        seterror "dovec: expect variable"

// allocate one from DS[]
: newdata = syscall {14 1}

// left variable
// if IDEN: NEW, GVAR, LOCAL then dovar mod else 0
to lval | idx type =
    if tok != tkIDEN
        0 break
    idx = tokvalue
    type = getType idx
    if type == tyNEW 	// new global, be careful !!
        setType idx tyGVAR
        setRef idx newdata
        warning getName idx "new global"
    else
        if !( (type == tyGVAR) | (type == tyLOCAL) )
            0 break
    dovar idx
    lex
    commit mod
    1

to doset | var e a = {}

// assignment, [ -- %var/%vec]
to exas =
    if lval == 1
        if tok == tkEQ
            lex		// skip =
            commit ex0
            doset
        else
            // lval has alread done
            // half of the job, term
            commit terms
        1
    else
        ex0

to doenum =
    if (getType tokvalue) == tyNEW
        setType tokvalue tyENUM
        setRef tokvalue nenum
        nenum = nenum + 1
    else
        seterror "enum: expect unique label"

// function call, parse ex0^arity
// [ -- %call]  (fun name ex .. ex)
to docall idx op | i arity e =
    arity = getArity idx
    for i 1 arity
        commit ex0
    e = NIL
    for i 1 arity
        e = cons ypop e
    e = cons (newatom GNAME idx) e
    ypush cons (newatom OPER op) e

// [ -- %num]
to donum v = ypush newatom NUM v

// already lex the next token
// ID is: var, fun-call, enum
to doiden idx =
    case getType idx
        tyNEW:				// new global, be careful
            warning getName idx "new global"
            setType idx tyGVAR
            setRef idx (array 1)
            dovar idx
            commit mod
        tyGVAR:
            dovar idx
            commit mod
        tyLOCAL:
            dovar idx
            commit mod
        tyFUNC:
            docall idx tkBE
        tyMAC:
            docall idx tkRBRACKET
        tyFULL:
            docall idx tkRBRACKET
        tyENUM:
            donum getRef idx

// [ %var %ex -- %set ]  (= var ex)
to doset | var e a =
    e = ypop
    var = ypop
    a = newatom OPER tkEQ
    ypush cons a (cons var (list e))

// [%ex1 bop %ex2 -- %bop] (bop ex1 ex2)
to dobop | e1 op e2 a =
    e2 = ypop
    op = ypop
    e1 = ypop
    a = newatom OPER op
    ypush cons a (cons e1 (list e2))

// [%ex -- %uop]
to douop uop | e =
    e = ypop
    ypush cons (newatom OPER uop) (list e)

// block = tkBB, simplify block size 0 and 1
to makeblock a =
    if a == NIL
        NIL 		// block size 0 {} => NIL
    else if (cdr a) == NIL
        car a 		// block size 1 {a} => a
    else
        cons (newatom OPER tkBB) a

// [MARK %e1 .. %en -- %block] (block e1 .. en)
to doblock | e a =
    a = NIL
    e = ypop
    while e != MARK
        a = cons e a
        e = ypop
    ypush makeblock a

// convert label to number [ -- %num]
to dolabel =
    if (getType tokvalue) != tyENUM
        seterror "expect label"
    donum getRef tokvalue

// [%ex0 MARK %num %ex .. %-1 %ex -- %case]
to docase | e a =
    a = NIL
    e = ypop
    while e != MARK
        e = cons ypop (list e)	// e = (num ex)
        a = cons e a
        e = ypop
    a = makeblock a
    e = cons ypop (list a)
    ypush cons (newatom OPER tkCASE) e

// [MARK %num %ex0 .. %ex0 -- %sys]
// (sys ex0 .. ex0)
to dosys | a e =
    e = NIL
    a = ypop
    while a != MARK
        e = cons a e
        a = ypop
    ypush cons (newatom OPER tkSYSCALL) e

// [ -- %string]
to dostring | s2 =
    s2 = array ((strlen tokstring) + 1)
    strcpy s2 tokstring
    ypush (newatom STRING s2)

// store tokstring to memory
to akeepStr | i =
    i = 0
    while tokstring[i] != 0
        M[newdata] = tokstring[i]
        i = i + 1
    M[newdata] = 0

// store ref of iden to memory
to akeepIden =
    if (getType tokvalue) == tyNEW
        seterror "unknown identifier"
    M[newdata] = getRef tokvalue

// End