' uBasic/4tH "Uylhmn n to uBasic" converter - Copyright 2022 J.L. Bezemer
' You can redistribute this file and/or modify it under
' the terms of the GNU General Public License

' Uylhmn n is an esotheric language: https://esolangs.org/wiki/Uyjhmn_n
' This program translates its code to valid uBasic/4tH

' The progam features an actual parser to check its validity and
' reports in detail about any errors.

If Cmd (0) < 3 Then Print "Usage: uyjhmn_n <uyjhmn n file> <ubasic file>" : End
If Set(a, Open (Cmd(2), "r")) < 0 Then Proc _Error (Join ("Cannot open \q", Cmd(2), "\q"))
If Set(b, Open (Cmd(3), "w")) < 0 Then Proc _Error (Join ("Cannot open \q", Cmd(3), "\q"))
                                       ' check parameters and open files
o = 0                                  ' no open variable
s = 0                                  ' no symbols defined
l = 0                                  ' no line processed
v = Ord("A")                           ' first variable is A

Do While Read (a)                      ' while there are lines to process
  l = l + 1                            ' increment number of lines read
  t = Tok (Ord (" "))                  ' get a token
                                       ' check command
  If Comp(t, "PRINT")     = 0 Then Proc _Print    : Continue
  If Comp(t, "END")       = 0 Then Proc _End      : Continue
  If Comp(t, "DECLARE")   = 0 Then Proc _Declare  : Continue
  If Comp(t, "OPEN")      = 0 Then Proc _Open     : Continue
  If Comp(t, "ASSIGN")    = 0 Then Proc _Assign   : Continue
  If Comp(t, "ADD")       = 0 Then Proc _Add      : Continue
  If Comp(t, "MULTIPLY")  = 0 Then Proc _Multiply : Continue
  If Comp(t, "DIVIDE")    = 0 Then Proc _Divide   : Continue
  If Comp(t, "DEFINE")    = 0 Then Proc _Define   : Continue
  If Comp(t, "JUMP")      = 0 Then Proc _Jump     : Continue
  If Comp(t, "GET")       = 0 Then Proc _Get      : Continue
  If Len(t) > 0 THEN Proc _Error (JOIN("Unknown command \q", t, "\q"))
Loop                                   ' if not empty, this is not a command

Close b                                ' close files and exit
Close a

End

_Symbol                                ' add symbol to the symbol table
  Param (2)                            ' symbol and its value
                                       ' increment symbol table pointer
  @(s) = a@ : @(s+1) = b@ : s = s + 2
Return

_Find                                  ' find a symbol
  Param (1)                            ' symbol to be found
  Local (2)

  c@ = (26 * 2) - 1                    ' define end of symbol table

  For b@ = 0 To c@ Step 2              ' loop through all the symbold
    While Comp(@(b@), a@)              ' while there is no match
  Next
                                       ' index exceeded means not found
  If b@ > c@ Then Proc _Error (Join("Can't find symbol \q", a@, "\q"))
Return (@(b@+1))                       ' return the variable character

_ToVariable                            ' parse this lengthy phrase
  Push Dup("VARIABLE"), Dup("OPEN"), Dup("THE"), Dup("TO")
  Proc _Skip                           ' for any discrepancies
Return

_VariableBy                            ' parse this lengthy phrase
  Push Dup("BY"), Dup("VARIABLE"), Dup("OPEN"), Dup("THE")
  Proc _Skip                           ' for any discrepancies
Return

_Arithmetic                            ' perform +, * or /
  Param (1)                            ' assign variable after arithmetic

  Write b, "Let "; Chr (o); " = "; Chr (o); " "; Chr (a@);" ";
  Write b, Chr(FUNC(_Find (Tok (Ord (" ")))))
Return

_Add                                   ' perform an addition
  Proc _Arithmetic (Ord("+"))          ' send addition to arithmetic routine
  Proc _ToVariable                     ' parse lengthy phrase
Return

_Multiply                              ' perform a multiplication
  Proc _VariableBy                     ' parse lengthy phrase
  Proc _Arithmetic (Ord("*"))          ' send multiplication to arithmetic routine
Return

_Divide                                ' perform a division
  Proc _VariableBy                     ' parse lengthy phrase
  Proc _Arithmetic (Ord("/"))          ' send division to arithmetic routine
Return

_InChar                                ' get a character
  Write b, "Let "; Chr (o); " = Peek(Ask(\q<char> \q), 0)"
Return

_InNum                                 ' get a number
  Write b, "Input \q<int>  \q, "; Chr (o)
Return

_Get                                   ' get input
  Local (1)                            ' parsed token
                                       ' parse lenghty phrase
  Push Dup("A"), Dup("AS"), Dup("VARIABLE"), Dup("OPEN")
  Push Dup("INTO"), Dup("STORE"), Dup("AND"), Dup("INPUT")
  Proc _Skip

  a@ = Tok (Ord (" "))                 ' get token and select
  If Comp("CHARACTER", a@) = 0 Then Proc _InChar : Return
  If Comp("NUMBER", a@)    = 0 Then Proc _InNum  : Return
                                       ' wrong keyword in this context
  Proc _Error (Join ("Unexpected \q", a@, "\q"))
Return

_Compare
  Param (4)

  Push d@                              ' push comparison word
  Proc _Skip                           ' and check it
                                       ' now write conditional jump
  Write b, "If "; Chr(b@); " "; Chr(c@);" ";
  Write b, Chr(FUNC(_Find (Tok (Ord (" "))))); " Then Goto _"; Show(a@)
Return

_Jump                                  ' jump statement
  Local (3)                            ' label, variable, comparison

  Push Dup("TO")                       ' check TO keyword
  Proc _Skip

  a@ = Tok (Ord (" "))                 ' get the label

  Push Dup("IF")                       ' check IF keyword
  Proc _Skip
                                       ' get variable
  b@ = FUNC(_Find (Tok (Ord (" "))))

  Push Dup("IS")                       ' check IS keyword
  Proc _Skip

  c@ = Tok (Ord (" "))                 ' get comparison
  If Comp("GREATER", c@) = 0 Then Proc _Compare(a@, b@, Ord(">"), Dup ("THAN")) : Return
  If Comp("LESS", c@)    = 0 Then Proc _Compare(a@, b@, Ord("<"), Dup ("THAN")) : Return
  If Comp("EQUAL", c@)   = 0 Then Proc _Compare(a@, b@, Ord("="), Dup ("TO"))   : Return
                                       ' no comparison? that's an error
  Proc _Error (Join ("Unexpected \q", c@, "\q"))
Return

_Define                                ' define a label
  Push Dup("LABEL"), Dup("NEW"), Dup("THE")
  Proc _Skip                           ' parse lengthy phrase

  Write b, ""                          ' write label
  Write b, "_"; Show(Tok (Ord (" ")))
Return

_Assign                                ' assign an open variable
  Write b, "Let "; Chr(o); " = ";Show(Tok (Ord (" ")))
  Proc _ToVariable                     ' parse lenghty phrase
Return

_Open                                  ' open a variable
  Push Dup("VARIABLE"), Dup("THE")     ' parse phrase
  Proc _Skip
                                       ' find variable and open it
  o = FUNC(_Find (Tok (Ord (" "))))
Return

_Declare                               ' declare a variable
  Push Dup("VARIABLE"), Dup("NEW"), Dup("THE")
  Proc _Skip                           ' parse phrase
                                       ' create a new symbol
  If v > Ord ("Z") Then Proc _Error ("Too many variables")
  Proc _Symbol (Tok (Ord (" ")), v)    ' check if any variables available
  v = v + 1
Return

_End                                   ' end the program
  Push Dup("PROGRAM"), Dup("THIS")     ' parse phrase
  Proc _Skip

  Write b, "End"                       ' translates to END
Return

_PChar                                 ' print ASCII value
  Push Dup("VALUE"), Dup("ASCII"), Dup("THE"), Dup("WITH")
  Proc _Skip                           ' skip lengthy phrase
                                       ' print value
  Write b, "Print Chr("; Show(Tok (Ord (" "))); ");"
Return

_POpen                                 ' print variable
  Local (1)                            ' token parsed

  Push Dup("VARIABLE'S")               ' parse keyword
  Proc _Skip

  a@ = Tok (Ord (" "))                 ' get token, print the value
  If Comp(a@, "VALUE")     = 0 Then Write b, "Print "; Chr(o); ";"      : Return
  If Comp(a@, "CHARACTER") = 0 Then Write b, "Print Chr("; Chr(o); ");" : Return
                                       ' print the character  EndIf
  Proc _Error (Join ("Unexpected \q", a@, "\q"))
Return                                 ' everything else is invalid

_Print                                 ' print stuff
  Local (1)                            ' parsed token

  Push Dup("THE")                      ' check keyword
  Proc _Skip

  a@ = Tok (Ord (" "))                 ' parse token
  If Comp(a@, "CHARACTER") = 0 Then Proc _PChar : Return
  If Comp(a@, "OPEN") = 0      Then Proc _POpen : Return
                                       ' select the right routine
  Proc _Error (Join ("Unexpected \q", a@, "\q"))
Return                                 ' everything else is invalid

_Skip
  Local (1)

  Do While Used()                      ' exhaust the stack
    a@ = Pop ()                        ' get keyword
    If Comp (a@, Tok (Ord (" "))) Then Proc _Error (Join ("Expected \q", a@, "\q"))
  Loop                                 ' if parsed token isn't equal, it's an error
Return

_Error                                 ' general error routine
  Param (1)                            ' error message
  Print Show (a@);" at line ";l        ' display it
  Close a : Close b                    ' close the files
End

