Microsoft Small Basic

Program Listing: FCR130

List Program

' Sums Calculator 0.1
' Copyright (c) 2014 Nonki Takahashi. All rights reserved.
'
' History:
' 0.1 2014-01-14 Created. ()
' 0.0 2012-10-18 12:51:09 Code generated by Small Basic Parser Generator 0.4
'
title = "Sums Calculator 0.1"
TextWindow.Title = title
traceC = "False" ' trace subroutine call
traceX = "False" ' trace operation execution
traceV = "False" ' dump variable array after parse
Lex_Init()
TextWindow.Write("Sums filename? ")
fname = TextWindow.Read()
fpath = Program.Directory + "\" + fname
' The following line could be harmful and has been automatically commented.
' buf = File.ReadContents(fpath)
ConvertTextToLines()
sum = 0
For l = 1 To nLines
buf = lines[l]
Calc()
If var["ans"] <> "ERR" Then
TextWindow.WriteLine(buf + "=" + var["ans"])
sum = sum + var["ans"]
EndIf
EndFor
TextWindow.WriteLine("Sum=" + sum)
Sub ConvertTextToLines
len = Text.GetLength(buf)
nLines = 0
ptr = 1
While ptr <= len
eol = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), CRLF)
If eol = 0 Then ' eol not found
nLines = nLines + 1
lines[nLines] = Text.GetSubTextToEnd(buf, ptr)
ptr = len + 1
Else ' eol found
nLines = nLines + 1
lines[nLines] = Text.GetSubText(buf, ptr, eol - 1)
ptr = ptr + eol + 1
EndIf
EndWhile
EndSub
Sub Calc
' param buf - expression
' param var[] - variables
' return var["ans"] - answer
If traceC Then
TextWindow.WriteLine(" " + buf)
EndIf
len = Text.GetLength(buf)
ptr = 1
Parse_Expr()
If ptr <= len Then
TextWindow.WriteLine("Syntax error in expression " + buf + ".")
var["ans"] = "ERR"
Else
var["ans"] = val
EndIf
If traceV Then
TextWindow.WriteLine("var=" + WQ + var + WQ)
EndIf
If traceC Then
TextWindow.WriteLine(" " + val)
EndIf
EndSub
Sub Exec_Expr
' Excecution | Expression
' expr ::= [[]{+|-}[]]
' return val - result of expression
If match Then
If traceX Then
TextWindow.Write("Expr:_opt=" + WQ + _opt + WQ + ",_val=" + WQ + _val + WQ)
EndIf
n = Array.GetItemCount(_opt)
val = _val[1]
For i = 1 To n
If _opt[i] = "+" Then
val = val + _val[i + 1]
ElseIf _opt[i] = "-" Then
val = val - _val[i + 1]
EndIf
EndFor
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Factor
' Excecution | Factor
' factor ::= {||([][])}
If match Then
If traceX Then
TextWindow.Write("Factor:_val=" + WQ + _val + WQ)
EndIf
If (_opt[1] = "func")　Or (_opt[1] = "val") Then
val = _val[1]
ElseIf _opt[1] = ")" Then
val = _val[2]
EndIf
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Func
' Excecution | Function
' func ::= sqrt([][])
If match Then
If traceX Then
TextWindow.Write("Func:_val=" + WQ + _val + WQ)
EndIf
val = Math.SquareRoot(_val[1])
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Literal
' Excecution | Literal
' literal ::= {|<_str>}
If match Then
If traceX Then
TextWindow.Write("Literal:_opt=" + WQ + _opt + WQ + ",_val=" + WQ + _val + WQ)
EndIf
If _opt[1] = "real" Then
val = _val[1]
ElseIf _opt[1] = "_str" Then
val = _val[2]
EndIf
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Real
' Excecution | Real
' real ::= [-]<_num>[.<_num>]
If match Then
If traceX Then
TextWindow.Write("Real:_const=" + WQ + _const + WQ + ",_val=" + WQ + _val + WQ)
EndIf
val = _const[1] + _val[1] ' sign + int
If _const[2] = "." Then
val = Text.Append(val + ".", _val[2]) ' sign + int + "." + frac
EndIf
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Term
' Excecution | Term
' term ::= [[]{'*'|/}[]]
If match Then
If traceX Then
TextWindow.Write("Term:_opt=" + WQ + _opt + WQ + ",_val=" + WQ + _val + WQ)
EndIf
n = Array.GetItemCount(_opt)
val = _val[1]
For i = 1 To n
If _opt[i] = "*" Then
val = val * _val[i + 1]
ElseIf _opt[i] = "/" Then
val = val / _val[i + 1]
EndIf
EndFor
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Lex_Init
UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
LOWER = "abcdefghijklmnopqrstuvwxyz"
DIGIT = "0123456789"
FCHAR = UPPER + LOWER ' first charcters for label/variable/sub
TCHAR = FCHAR + DIGIT + "_" ' trailing characters for label/variable/sub
WQ = Text.GetCharacter(34) ' double quote
SQ = "'" ' single quote
CRLF = Text.GetCharacter(13) + Text.GetCharacter(10) ' carriage return + line feed
Not = "True=False;False=True;"
EndSub
Sub Lex_Label
' param buf - buffer
' param ptr - pointer
' return match - "True" if match
' return ptr - next pointer
' return label[] - label name array
' return val - label name
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
Lex_Name()
If match And (Array.ContainsValue(label, val) = "False") Then
nLabel = nLabel + 1
label[nLabel] = val
EndIf
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Lex_Name
' param buf - buffer
' param ptr - pointer
' return match - "True" if match
' return ptr - next pointer
' return name - name
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(FCHAR, ch) > 0 Then
name = ch
ptr = ptr + 1
match = "True"
While match
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(TCHAR, ch) > 0 Then
ptr = ptr + 1
name = name + ch
Else
match = "False"
EndIf
EndWhile
match = "True"
Else
name = ""
match = "False"
EndIf
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Lex_Num
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
' return val - number
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(DIGIT, ch) > 0 Then
val = ch
ptr = ptr + 1
match = "True"
While match
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(DIGIT, ch) > 0 Then
ptr = ptr + 1
val = Text.Append(val, ch)
Else
match = "False"
EndIf
EndWhile
match = "True"
Else
val = ""
match = "False"
EndIf
EndSub
Sub Lex_Space0
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
txt = " "
match = "True"
While match
Lex_Text()
EndWhile
match = "True"
EndSub
Sub Lex_Space1
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
txt = " "
Lex_Text()
If match Then
While match
Lex_Text()
EndWhile
match = "True"
Else
TextWindow.WriteLine("Syntax Error: space not found")
EndIf
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Lex_Str
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
' return val - string
Stack.PushValue("local", ptr)
txt = WQ
Lex_Text()
If match Then
ch = Text.GetSubText(buf, ptr, 1)
str = ""
While ch <> WQ
str = str + ch
ptr = ptr + 1
ch = Text.GetSubText(buf, ptr, 1)
EndWhile
EndIf
If match Then
txt = WQ
Lex_Text()
EndIf
_ptr = Stack.PopValue("local")
If match Then
val = str
Else
val = ""
ptr = _ptr
EndIf
EndSub
Sub Lex_Text
' param buf - buffer
' param ptr - pointer
' param txt - text to lexical analysis
' return match - "True" if match
' return ptr - next pointer
' return val - txt if match
If traceC Then
If txt = CRLF Then
_txt = "CRLF"
ElseIf txt = WQ Then
_txt = SQ + txt + SQ
Else
_txt = WQ + txt + WQ
EndIf
TextWindow.WriteLine(" " + ptr)
EndIf
val = ""
txtlen = Text.GetLength(txt)
lotxt = Text.ConvertToLowerCase(txt)
lobuf = Text.ConvertToLowerCase(Text.GetSubText(buf, ptr, txtlen))
If lobuf = lotxt Then
match = "True"
ptr = ptr + txtlen
val = txt
Else
match = "False"
EndIf
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Lex_Var
' _var ::= <_name>['['[][]']'['['[][]']']]
' param buf - buffer
' param ptr - pointer
' return match - "True" if match
' return ptr - next pointer
' return var[] - variable name array
' return name - variable name
' return val - variable
Stack.PushValue("local", _val)
_val = ""
Lex_Name()
_val[1] = val
Stack.PushValue("local", name)
If match Then
Stack.PushValue("ptr",ptr)
If match Then
txt = "["
Lex_Text()
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Parse_Val()
_val[2] = val
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
txt = "]"
Lex_Text()
EndIf
If match Then
Stack.PushValue("ptr",ptr)
If match Then
txt = "["
Lex_Text()
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Parse_Val()
_val[3] = val
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
txt = "]"
Lex_Text()
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
match = "True"
EndIf
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
match = "True"
EndIf
EndIf
name = Stack.PopValue("local")
If match Then
If _val[3] <> "" Then
name = name + "[" + _val[2] + "][" + _val[3] + "]"
ElseIf _Val[2] <> "" Then
name = name + "[" + _val[2] + "]
EndIf
If Array.ContainsIndex(var, name) Then
val = var[name]
If val = "N/A" Then
val = ""
EndIf
Else
var[name] = "N/A"
val = ""
EndIf
EndIf
_val = Stack.PopValue("local")
EndSub
Sub Parse_Expr
' expr ::= [[]{+|-}[]]
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Stack.PushValue("ptr",ptr)
Parse_Term()
i = 1
_val[i] = val
If match Then
While match
Stack.PushValue("ptr",ptr)
Lex_Space0()
txt = "+"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "+"
Else
txt = "-"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "-"
EndIf
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Stack.PushValue("local", i)
Parse_Term()
i = Stack.PopValue("local")
_val[i + 1] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
_opt[i] = ""
EndIf
i = i + 1
EndWhile
match = "True"
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
Exec_Expr()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Parse_Term
' term ::= [[]{'*'|/}[]]
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Stack.PushValue("ptr", ptr)
Parse_Factor()
i = 1
_val[i] = val
If match Then
While match
Stack.PushValue("ptr", ptr)
Lex_Space0()
If match Then
txt = "*"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "*"
Else
txt = "/"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "/"
EndIf
EndIf
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Stack.PushValue("local", i)
Parse_Factor()
i = Stack.PopValue("local")
_val[i + 1] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
_opt[i] = ""
EndIf
i = i + 1
EndWhile
match = "True"
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
Exec_Term()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Parse_Factor
' factor ::= {||([][])}
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Parse_Func()
_val[1] = val
If match Then
_opt[1] = "func"
Else
Parse_Literal()
_val[1] = val
If match Then
_opt[1] = "val"
EndIf
EndIf
If Not[match] Then
Stack.PushValue("ptr",ptr)
txt = "("
Lex_Text()
_const[1] = val
If match Then
Lex_Space0()
EndIf
If match Then
Parse_Expr()
_val[2] = val
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
txt = ")"
Lex_Text()
_const[2] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
If match Then
_opt[1] = ")"
EndIf
EndIf
Exec_Factor()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Parse_Func
' func ::= sqrt([][])
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Stack.PushValue("ptr",ptr)
txt = "sqrt("
Lex_Text()
_const[1] = val
If match Then
Lex_Space0()
EndIf
If match Then
Parse_Expr()
_val[1] = val
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
txt = ")"
Lex_Text()
_const[2] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
If match Then
_opt[1] = "func"
EndIf
Exec_Func()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Parse_Val
' val ::= {|<_var>}
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Parse_Literal()
_val[1] = val
If match Then
_opt[1] = "literal"
Else
Lex_Var()
_val[2] = val
If match Then
_opt[1] = "_var"
EndIf
EndIf
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Parse_Literal
' literal ::= {|<_str>}
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Parse_Real()
_val[1] = val
If match Then
_opt[1] = "real"
Else
Lex_Str()
_val[2] = val
If match Then
_opt[1] = "_str"
EndIf
EndIf
Exec_Literal()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub
Sub Parse_Real
' real ::= [-]<_num>[.<_num>]
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Stack.PushValue("ptr",ptr)
txt = "-"
Lex_Text()
_const[1] = val
match = "True"
If match Then
Lex_Num()
_val[1] = val
EndIf
If match Then
Stack.PushValue("ptr",ptr)
txt = "."
Lex_Text()
_const[2] = val
If match Then
Lex_Num()
_val[2] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
match = "True"
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
Exec_Real()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
EndSub