{-- -- reads in kbq-gu file first argument *.kb -- -- -- outputs .asm file per function -- compiles with nasm -f elf -o function.o -- links with ld function.o -o function --} module Main where import Tokenizer import Parser import RpokuBase --import System.Environment --import Random --pauseIndicators = "." ---- vowels = "iauq" ---- consonants = "bmdvkNzgjx" --vowels = "a2eiy3fq1ouA@EIY#FQ!OU" -- l3-\Bo 8-bit rpoku --consonants = "klpw4vtzj56xshb7dc8g9KLPW$VTZJ%^XSHB&DC*G([]{};'\\r0:=,`mn/|\"_R)>+<~MN?" -- l3-\Bo 8-bit rpoku --vowelModifiers = "-" -- --rootStarters = ["vu"] --singleWordQuoteStarters = ["za","va","ja","ba"] --wordQuoteStarters = [["vi","vq"],["ki","kq"]] --commentWordQuoteStarters = [["ji","jq"]] --stopQuoteStarters = ["ka"] --langQuoteStarters = (["zu"],[("gki-jq",[" .,\n\r\t","aAeEiIoOuUy","bBcCdDfFgGhHjJkKlLmMnNpPqQrRsStTvVwWxXyYzZ","\'"])]) -- :("kqgb",[". \n\r\t","a2eiy3fq1ouA@EIY#FQ!!OU","klpw]KLPW}b7dc8g9B&DC*G(4vtzj56xh$VTZJ%^XSH;\'\\r0:=,`mn/[|\"_R)>+<~MN?{","-"])] --commentLangQuoteStarters = (["ju"],[("Ngu",[" .,\n\r\t","aAeEiIoOuUy","bBcCdDfFgGhHjJkKlLmMnNpPqQrRsStTvVwWxXyYzZ","\'"])]) -- :("kqgb",[". \n\r\t","a2eiy3fq1ouA@EIY#FQ!!OU","klpw]KLPW}b7dc8g9B&DC*G(4vtzj56xh$VTZJ%^XSH;\'\\r0:=,`mn/[|\"_R)>+<~MN?{","-"])] --sentenceConnectors = [".i",".u",".a",".q"] --singleWordArguments = ["mi","mau","di","da","du","gi","ga","gu","gua","gq"] -- --rpokuWord str = baseWord str pauseIndicators vowels consonants vowelModifiers --rpokuStopQuote str = stopQuote str pauseIndicators vowels consonants vowelModifiers stopQuoteStarters --rpokuLangQuote str = langQuote str pauseIndicators vowels consonants vowelModifiers stopQuoteStarters langQuoteStarters --rpokuWordQuote str wordQuotes = wordQuote str pauseIndicators vowels consonants vowelModifiers wordQuotes stopQuoteStarters langQuoteStarters --rpokuSentence str = sentence str pauseIndicators vowels consonants vowelModifiers rootStarters singleWordQuoteStarters wordQuoteStarters stopQuoteStarters langQuoteStarters singleWordArguments --rpokuParagraph str = paragraph str pauseIndicators vowels consonants vowelModifiers sentenceConnectors rootStarters singleWordQuoteStarters wordQuoteStarters stopQuoteStarters langQuoteStarters singleWordArguments --rpokuRoots str = findRoots str pauseIndicators vowels consonants vowelModifiers rootStarters singleWordQuoteStarters wordQuoteStarters stopQuoteStarters langQuoteStarters singleWordArguments --rpokuArgument str = sentenceArgument str pauseIndicators vowels consonants vowelModifiers singleWordQuoteStarters wordQuoteStarters stopQuoteStarters langQuoteStarters singleWordArguments --rpokuArguments str = findArguments str pauseIndicators vowels consonants vowelModifiers rootStarters singleWordQuoteStarters wordQuoteStarters stopQuoteStarters langQuoteStarters singleWordArguments ---- bongFindFunction aString functionToFind = findFunction aString pauseIndicators vowels consonants vowelModifiers sentenceConnectors rootStarters singleWordQuoteStarters wordQuoteStarters stopQuoteStarters langQuoteStarters functionToFind --rpokuBaseWordList str = getBaseWordList str pauseIndicators vowels consonants vowelModifiers --rpokuSingleWordQuote str = singleWordQuote str singleWordQuoteStarters pauseIndicators vowels consonants vowelModifiers --rpokuBiSyllable str = biSyllable str vowels consonants vowelModifiers --rpokuAffixCompound str = affixCompound str vowels consonants vowelModifiers --rpokuAffix str = affix str vowels consonants -- import System.Environment main = do args <- getArgs if elem "--help" args || length args == 0 then putStrLn "RpokuToLanguageTranslator " else do fileStr <- readFile (args !! 0) if length args == 3 then do translationFile <- readFile (args !! 1) --"English/RpokuToEnglish" numbersFile <- readFile (args !! 2) --"English/EnglishNumbers" translate fileStr translationFile numbersFile else let translationFile = "" numbersFile = "" in translate fileStr translationFile numbersFile translate :: String -- rpokuFile -> String -- translationFile -> String -- numbersFile -> IO () -- output translate fileStr translationFile numbersFile = do -- get xi xq self sustaining block let noBlanks = clearBlanks fileStr noComments = clearComments noBlanks --xixqzduku = xixq noComments -- aSentence = rpokuSentence (drop 2 xixqzduku) aParagraph = rpokuParagraph noComments --theRoot = rpokuRoots aSentence --theArguments = rpokuArguments aSentence --theArgumentList = rpokuArgumentList theArguments unlinedTranslation = lines translationFile rpokuWordList = map (\x -> head $ words x) unlinedTranslation translationWordList = map (\x -> unwords $ tail $ words x) unlinedTranslation numberWordList = lines numbersFile -- theTranslation = translateWord "xi" rpokuWordList translationWordList ++ "\n" ++ translateParagraph aParagraph rpokuWordList translationWordList numberWordList ++ "\n" ++ translateWord "xq" rpokuWordList translationWordList ++ "\n" theTranslation = translateParagraph aParagraph rpokuWordList translationWordList numberWordList ++ "\n" --functionSentence = bongFindFunction aParagraph "mq-kNq" -- get sentence -- get root -- get arguments -- display -- putStrLn $ "fileString : " ++ fileStr -- putStrLn $ "main text : " ++xixqzduku --putStrLn $ "sentence : " ++aSentence -- putStrLn $ "root : " ++theRoot -- putStrLn $ "arguments : " ++theArguments --putStrLn $ "argumentList : " ++ show theArgumentList --putStrLn $ "translation: \n" ++theTranslation putStr theTranslation --putStrLn functionSentence -- so we have a function -- then we look up what it translates to with places for arguments -- we translate the arguments and put them in place -- "za-gju" translates to "section x1 \n x2" -- with import -- mbq-kuka.jmq-Nq. -- xi xq ------------------------------------------------ ----- text pre processing ----------------------------------- -------------------------------------------------------------- clearBlanks :: String -- string with blanks -> String -- string with no blanks clearBlanks [] = [] clearBlanks str = let x = head str xs = tail str aLangQuote = rpokuLangQuote str in if length aLangQuote > 3 then aLangQuote ++ clearBlanks (drop (length aLangQuote) str) else if elem x " \n\r\t" then clearBlanks xs else x : clearBlanks xs clearComments :: String -- string with comments -> String -- string without comments clearComments str = let aWord = rpokuWord str aStopQuote = rpokuStopQuote str aLangQuote = rpokuLangQuote str aCommentLangQuote = langQuote str pauseIndicators vowels consonants vowelModifiers stopQuoteStarters commentLangQuoteStarters aCommentWordQuote = rpokuWordQuote str commentWordQuoteStarters in if length aStopQuote > 3 then aStopQuote ++ clearComments (drop (length aStopQuote) str) else if length aLangQuote > 3 then aLangQuote ++ clearComments (drop (length aLangQuote) str) else if length aCommentLangQuote > 3 then clearComments (drop (length aCommentLangQuote) str) else if length aCommentWordQuote > 3 then clearComments (drop (length aCommentWordQuote) str) else if length aWord > 0 then aWord ++ clearComments (drop (length aWord) str) else "" xixq :: String -- input string -> String -- output xixq block xixq fileStr = rpokuWordQuote fileStr [["xi","xq"]] ----------------------------------------------------------------------- ------------------ text Translation -------------------------------------- -------------------------------------------------------------------- translateSentence :: String -- (root,[arguments]) -> [String] -- rpokuWordList -> [String] -- translationWordList -> [String] -- numberWordList -> String -- translation result translateSentence sentence rpokuWordList translationWordList numberWordList = let root = rpokuBaseWordList (rpokuRoots sentence) args = rpokuArgumentList $ rpokuArguments sentence in translateFunction root args rpokuWordList translationWordList numberWordList -- translateRestDelimArgs :: [String] -- arguments -- -> String -- delimiter -- -> String -- translation -- translateRestDelimArgs (firstArg:restArgs) delimiter = -- if restArgs == [] -- then translateArg firstArg -- else translateArg firstArg ++ delimiter ++ translateRestDelimArgs restArgs delimiter translateParagraph :: String -- input string -> [String] -- rpokuWordList -> [String] -- translationWordList -> [String] -- numberWordList -> String -- output translation translateParagraph paragraph rpokuWordList translationWordList numberWordList = let aSentence = rpokuSentence paragraph -- rpokuWordList translationWordList numberWordList aConnective = rpokuWord (drop (length aSentence) paragraph) translatedSentence = translateSentence aSentence rpokuWordList translationWordList numberWordList aTranParContin = translateParagraph (drop ((length aSentence) + (length aConnective)) paragraph) rpokuWordList translationWordList numberWordList translationPoint = getIndex aConnective rpokuWordList connectiveTranslation = if translationPoint > -1 then translationWordList !! translationPoint else aConnective in if aSentence == [] then [] else if elem aConnective sentenceConnectors then translatedSentence ++ " \n" ++ connectiveTranslation ++ " " ++ aTranParContin else if aConnective == [] then translatedSentence ++ " \n" ++ aTranParContin else " parNil c" ++ aConnective ++ "cS"++ aSentence -- ------------------------------------- -- ---- translate asm paragraph -- ---------------------------- --translateAsmParagraph :: String -- input string -- -> [String] -- rpokuWordList -- -> [String] -- translationWordList -- -> [String] -- numberWordList -- -> String -- output translation --translateAsmParagraph paragraph rpokuWordList translationWordList numberWordList = -- let aSentence = rpokuSentence paragraph -- rpokuWordList translationWordList numberWordList -- aConnective = rpokuWord (drop (length aSentence) paragraph) -- translatedSentence = translateSentence aSentence rpokuWordList translationWordList numberWordList -- aTranParContin = translateAsmParagraph (drop ((length aSentence) + (length aConnective)) paragraph) rpokuWordList translationWordList numberWordList -- translationPoint = getIndex aConnective rpokuWordList -- connectiveTranslation = if translationPoint > -1 then translationWordList !! translationPoint else aConnective -- in -- if aSentence == [] -- then [] -- else -- if elem aConnective sentenceConnectors -- then translatedSentence ++ " \n" ++ aTranParContin -- else if aConnective == [] -- then translatedSentence ++ " \n" ++ aTranParContin -- else " parNil c" ++ aConnective ++ "cS"++ aSentence -- -- {---------------------------------------------------------------------------------------------------------- -----------------------Function Translation ---------------------------- ------------------------------------------------------------------------------------} -- -- translateFunction :: [String] -- roots -- -> [String] -- arguments -- -> [[String]] -- rpoku words in compiler order -- -> [[String]] -- translation words in compiler order -- -> [[String]] -- number word lists -- -> [([String] -- roots -- -> [String] -- arguments -- -> [String] -- rpokuWordList -- -> [String] -- translationWordList -- -> [String] -- number word list -- -> String)] -- compilers result -- -> String -- translation -- translateFunction roots arguments [] transWordLists translators numberWordLists = [] -- --translateFunction roots arguments rpokuWordLists [] translators numberWordLists = [] -- translateFunction roots arguments rpokuWordLists transWordLists numberWordLists [] = [] -- translateFunction roots arguments rpokuWordLists transWordLists numberWordLists translators = -- let rpokuWordList = head rpokuWordLists -- restRpokuWordLists = tail rpokuWordLists -- transWordList = head transWordLists -- restTransWordLists = tail transWordLists -- numberWordList = head numberWordLists -- restNumberWordLists = tail numberWordLists -- translator = head translator -- restTranslators = tail translators -- in -- if fitsIn roots rpokuWordList -- then translator arguments rpokuWordList transWordList numberWordLists -- else translateFunction roots arguments restRpokuWordLists restTransWordLists restNumberWordLists restTranslators translateFunction :: [String] -- roots -> [String] -- arguments -> [String] -- rpokuWordList -> [String] -- translationWordList -> [String] -- numberWordLis -> String -- translation translateFunction roots arguments rpokuWordList translationWordList numberWordList = simpleFunctionTranslate roots arguments rpokuWordList translationWordList numberWordList -- if roots == [] -- then simpleFunctionTranslate roots arguments rpokuWordList translationWordList numberWordList -- else -- let root = head roots -- in -- case root of -- "ba-gbi" -> "section ." ++ translateAsmArg ( arguments !! 0) rpokuWordList translationWordList numberWordList++ ";--part of program " ++ " \n" ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList -- then need to recurse translate sentences inside -- "mu-Nji" -> "global " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- global univerese " ++ " \n" -- "va-Nji" -> translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ":\n" ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList -- -- transfer -- "mu-vdi" -> "mov " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList++ ";-- move destination,source" ++ "\n" -- "ja-Nji" -> "xchg " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList++ ";-- exchange arg1,arg2" ++ "\n" -- "ga-kzi" -> "stc " ++ ";-- carryFlag CF := 1 " ++ "\n" -- "ga-kgi" -> "clc " ++ ";-- carryFlag := 0" ++ "\n" -- "ga-kNi" -> "cmc " ++ ";-- carryFlag := negate carryFlag" ++ "\n" -- "dki-zi" -> "std " ++ ";-- directionFlag := 1 (string op downwards)" ++ "\n" -- "dki-gi" -> "cld " ++ ";-- directionFlag := 0 (string op upwards)" ++ "\n" -- "Ndi-zi" -> "sti " ++ ";-- interruptFlag := 1" ++ "\n" -- "Ndi-gi" -> "cli " ++ ";-- interruptFlag := 0" ++ "\n" -- "ja-dgi" -> "push " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- push source onto stackPointer " ++ "\n" -- "ja-dga" -> "pusha "++ ";-- pushAll general registers AX BX CX DX SP BP SI DI" ++ "\n" -- "ja-dgu" -> "pushf "++ ";-- pushFlags onto stackPointer " ++ "\n" -- "bq-kbi" -> "pop " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- pop from stack to destination" ++ "\n" -- "bq-kba" -> "popa " ++ ";-- pop all general registers" ++ "\n" -- "bq-kbu" -> "popf " ++ ";-- pop flags" ++ "\n" -- "bi-Nxi" -> "cbw " ++ ";-- ax := al -- convert byte to word" ++ "\n" -- "bi-Nxa" -> "cwd " ++ ";-- dx:ax := ax -- convert word to double" ++ "\n" -- "bi-Nxu" -> "cwde " ++ ";-- eax := ax -- convert word to extended double" ++ "\n" -- "za-gji" -> "in " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ "," ++ translateAsmArg (arguments !!1) rpokuWordList translationWordList numberWordList ++ ";-- suck in dest,port" ++ "\n" -- "vi-gmi" -> "out " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !!1) rpokuWordList translationWordList numberWordList ++ ";-- excrete out port,dest" ++ "\n" -- -- arithmetic -- "zu-mji" -> "add " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !!1) rpokuWordList translationWordList numberWordList ++ ";-- add dest,source" ++ "\n" -- "zu-mja" -> "adc " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !!1) rpokuWordList translationWordList numberWordList ++ ";-- addWithCarry dest,source carryFlag" ++ "\n" -- "vi-mji" -> "sub " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !!1) rpokuWordList translationWordList numberWordList ++ ";-- subtract dest,source " ++ "\n" -- "vi-mja" -> "sbb " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !!1) rpokuWordList translationWordList numberWordList ++ ";-- subtractWithCarry dest,source carryFlag " ++ "\n" -- "di-kji" -> "div " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- divide unsigned al:=ax/arg ah=rest ; dx:ax:=ax/arg dx=rest ; eax:=edx:eax/op edx=rest " ++ "\n" -- "di-kja" -> "idiv " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- divide signed al:=ax/arg ah=rest ; dx:ax:=ax/arg dx=rest ; eax:=edx:eax/op edx=rest " ++ "\n" -- "bi-kji" -> "mul " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- multiply unsigned al:=ax/arg ah=0 ; dx:ax:=ax/arg dx=0 ; eax:=edx:eax/op edx=0 " ++ "\n" -- "bi-kja" -> "imul " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- multiply signed al:=ax/arg ah=sufficien ; dx:ax:=ax/arg dx=sufficien ; eax:=edx:eax/op edx=sufficient " ++ "\n" -- "za-Nbi" -> "inc " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- increment arg+1 " ++ "\n" -- "jdi-gi" -> "dec " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- decrement arg-1 " ++ "\n" -- "ga-kbi" -> "cmp " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- compare arg1,arg2 arg1-arg2 zeroFlag set or unset " ++ "\n" -- "ja-vzi" -> "sal " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- shiftLeft register,quantity " ++ "\n" -- "ja-vbi" -> "sar " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- shiftRight register,quanity " ++ "\n" -- "ku-gzi" -> "rcl " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- rotateLeftThroughCarry register,quantity " ++ "\n" -- "ku-gbi" -> "rcr " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- rotateRightThroughCarry register,quantity" ++ "\n" -- "ku-dzi" -> "rol " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- rotateLeft register,quantity " ++ "\n" -- "ku-dbi" -> "ror " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- rotateRight register,quantity " ++ "\n" -- -- logic -- "Na-gdi" -> "neg " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- negate op:=0-op if op=0 then cf:=0 else cf:=1 " ++ "\n" -- "Nq-xdi" -> "not " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ ";-- invert op:=not op invert each bit " ++ "\n" -- "ga-Nxi" -> "and " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- logical conjunction AND dest,source " ++ "\n" -- "vki-Ni" -> "or " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- logical disjunction OR dest,source " ++ "\n" -- "gzq-ki" -> "xor " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- logical exclusive disjunction XOR dest,source " ++ "\n" -- "ji-vzi" -> "shl " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- shift logical left SHL Op,Quantity " ++ "\n" -- "ji-vbi" -> "shr " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ "," ++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- shift logical right SHR Op,Quantity " ++ "\n" -- -- misc -- "da-Nbi" -> "nop " ++ ";-- wait pause NOP no operation " ++ "\n" -- "ki-vdi" -> "lea " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ translateAsmArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ ";-- load effective address LEA " ++ "\n" -- "Ndu-ki" -> "int " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- interrupt (kernel) argument as message " ++ "\n" -- -- jumps (no change flags) -- "gq-kdi" -> "call " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- call subroutine CALL proc " ++ "\n" -- "kq-gdi" -> "ret " ++ ";-- ret from subroutine " ++ "\n" -- "jmi-bi" -> "jmp " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- leap jump JMP Dest " ++ "\n" -- "jzi-bi" -> "jz " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if zeroFlag == 1 JZ JE" ++ "\n" -- "jzi-Ni" -> "jnz " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if zeroFlag == 0 JNZ JNE" ++ "\n" -- "jbi-bi" -> "jp " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if parityFlag == 1 JPE JP" ++ "\n" -- "jbi-Ni" -> "jnp " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if parityFlag == 0 JPO JNP" ++ "\n" -- -- jumps unsigned cardinal -- "jgi-bi" -> "jc " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if carryFlag == 1 JC JB JNAE " ++ "\n" -- "jgi-Ni" -> "jnc " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if carryFlag == 0 JNC JNB JAE " ++ "\n" -- -- jumps signed integer -- "jvi-bi" -> "jo " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if overFlowFlag == 1 JO" ++ "\n" -- "jvi-Ni" -> "jno " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if overFlowFlag == 0 JNO" ++ "\n" -- "jxi-bi" -> "js " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if signFlag == 1 JS" ++ "\n" -- "jxi-Ni" -> "jns " ++ translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList++ ";-- jump if signFlag == 0 JNS" ++ "\n" -- -- -- "bqkdza-zNi" -> translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ " db " ++ translateRestDelimAsmArgs (drop 1 arguments) "," rpokuWordList translationWordList numberWordList ++ "\n" -- --"kagkmq-kji" -> translateArg (arguments !! 0) ++ " equ " ++ translateArg (arguments !! 1) ++ "\n" -- --"za-zNi" -> translateArg (arguments !! 0) ++ -- "vi-dNu" -> translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ " equ " ++ translateRestDelimAsmArgs (drop 1 arguments) "," rpokuWordList translationWordList numberWordList ++ "\n" -- -- miscelaneous -- "kaNgvi-dNi" -> translateAsmArg (arguments !! 0) rpokuWordList translationWordList numberWordList ++ " equ $ - " ++ translateArg (arguments !! 1) rpokuWordList translationWordList numberWordList ++ "\n" -- _ -> simpleFunctionTranslate roots arguments rpokuWordList translationWordList numberWordList -- -- translateRestDelimAsmArgs :: [String] -- arguments -- -> String -- delimiter -- -> [String] -- rpokuWordList -- -> [String] -- translationWordList -- -> [String] -- numberWordList -- -> String -- translation -- translateRestDelimAsmArgs (firstArg:restArgs) delimiter rpokuWordList translationWordList numberWordList = -- if restArgs == [] -- then translateAsmArg firstArg rpokuWordList translationWordList numberWordList -- else translateAsmArg firstArg rpokuWordList translationWordList numberWordList ++ delimiter ++ translateRestDelimAsmArgs restArgs delimiter rpokuWordList translationWordList numberWordList -- simpleFunctionTranslate :: [String] -- roots -> [String] -- arguments -> [String] -- rpokuWordList -> [String] -- translationWordList -> [String] -- numberWordList -> String -- translation simpleFunctionTranslate roots args rpokuWordList translationWordList numberWordList = let firstArg = head args restArgs = tail args firstRoot = head roots restRoots = tail roots reverseRoots = reverse roots -- lastRoot = roots !! (length roots -1) -- firstRoots = take (length roots -1) roots translationPoint = getIndex firstRoot rpokuWordList rootTranslation = translateRoot (firstRoot:[]) rpokuWordList translationWordList vuTranslation = translationWordList !! getIndex "vu" rpokuWordList delimiter = " " argTranslation = translateArg firstArg rpokuWordList translationWordList numberWordList noRootsContinuation = translateFunction [] restArgs rpokuWordList translationWordList numberWordList continuation = translateFunction restRoots restArgs rpokuWordList translationWordList numberWordList in -- need to translate html gda-Gi and dki-Bu -- need to merge in rpokuToAssembler if args == [] then translateRoot roots rpokuWordList translationWordList else if roots == [] then argTranslation ++ delimiter ++ noRootsContinuation else argTranslation ++ delimiter ++ vuTranslation ++ delimiter ++ rootTranslation ++ delimiter ++ continuation translateWord :: String -- inputString -> [String] -- rpokuWordList -> [String] -- translationWordList -> String -- translation translateWord string rpokuWordList translationWordList = let aWord = rpokuWord string translationPoint = getIndex aWord rpokuWordList translation = if translationPoint > -1 then translationWordList !! translationPoint else aWord in translation translateRoot :: [String] -- roots -> [String] -- rpoku word list -> [String] -- translation word list -> String -- translation translateRoot [] rpoku trans = [] translateRoot (firstRoot:restRoots) rpoku trans = let baseTranslation = translateWord firstRoot rpoku trans affixCompoundTranslation = affixCompoundTranslate firstRoot rpoku trans --biSyllableRoot = rpokuBiSyllable firstRoot affixCompoundRoot = rpokuAffixCompound firstRoot firstTranslation = if length affixCompoundRoot > 5 then affixCompoundTranslation else baseTranslation restTranslations = translateRoot restRoots rpoku trans in firstTranslation ++ restTranslations affixCompoundTranslate :: String -- root -> [String] -- rpokuWordList -> [String] -- translationWordList -> String -- translation affixCompoundTranslate root rpokuWordList translationWordList = let anAffix = rpokuAffix root aWord = rpokuBiSyllable root in if length aWord > 5 then translateWord aWord rpokuWordList translationWordList else if length anAffix > 3 then translateAffix anAffix rpokuWordList translationWordList ++ "." ++ affixCompoundTranslate (drop (length anAffix) root) rpokuWordList translationWordList else [] translateAffix :: String -- inputString -> [String] -- rpokuWordList -> [String] -- translationWordList -> String -- translation translateAffix string rpokuWordList translationWordList = let aWord = rpokuAffix string translationPoint = getIndex aWord rpokuWordList translation = if translationPoint > -1 then translationWordList !! translationPoint else aWord in translation ------------------------------------------------------------------------------------------------------ ---------------- Argument Translation ----------------------------------------------- ------------------------------------------------------------------------------------------ -- -- translateArg :: String -- input argument -> [String] -- rpokuWordList -> [String] -- translationWordList -> [String] -- numberWordList -> String -- output translation translateArg argument rpokuWordList translationWordList numberWordList = let argStarter = rpokuWord argument translation = translateWord argStarter rpokuWordList translationWordList in case argStarter of "vi" -> translation ++ " " ++ translateParagraph (take (length argument -4) (drop 2 argument)) rpokuWordList translationWordList numberWordList ++ " " ++ translationWordList !! getIndex "vq" rpokuWordList -- sentences "ki" -> translatekikqToHex argument rpokuWordList translationWordList numberWordList -- numbers "ka" -> translateName argument rpokuWordList translationWordList -- names "zu" -> translateQuote argument rpokuWordList translationWordList -- quote "ju" -> translateQuote argument rpokuWordList translationWordList "va" -> translation ++ " " ++ translateRoot ((drop (length argStarter) argument):[]) rpokuWordList translationWordList ++ " " "ba" -> translation ++ " " ++ translateRoot ((drop (length argStarter) argument):[]) rpokuWordList translationWordList ++ " " _ -> if elem argStarter singleWordArguments then translation else argStarter translateQuote :: String -- input string quote argument -> [String] -- rpokuWordList -> [String] -- translationWordList -> String -- translation translateQuote argument rpokuWordList translationWordList = let aWord = rpokuWord argument translation = translateWord argument rpokuWordList translationWordList aStopQuote = stopQuote argument pauseIndicators vowels consonants vowelModifiers ["zu","ju"] languageLabel = drop 3 (take (length aStopQuote -1) aStopQuote) contents = drop (length aStopQuote) (take (length argument - ((length aStopQuote) - (length aWord))) argument) langQuoteTranslationPoint = getIndex languageLabel rpokuWordList langQuoteTranslation = if langQuoteTranslationPoint > -1 then translationWordList !! langQuoteTranslationPoint else languageLabel in translation ++ "." ++ langQuoteTranslation ++ "." ++ contents ++ "." ++ langQuoteTranslation ++ "." translatekikqToHex :: String -- kikq quote -> [String] -- rpokuWordList -> [String] -- translationWordList -> [String] -- numberWordList -> String -- hex number translatekikqToHex kikqQuote rpokuWordList translationWordList numberWordList = let aBongWord = rpokuWord kikqQuote translation = translationWordList !! getIndex aBongWord rpokuWordList in case aBongWord of "ki" -> translation ++ " " ++ transkikqToHexContinue (drop 2 kikqQuote) rpokuWordList translationWordList numberWordList-- most other languages use arabic right to left _ -> "" transkikqToHexContinue :: String -- input numbers -> [String] -- rpokuWordList -> [String] -- translationWordList -> [String] -- foreign numbers 0 - 15 -> String -- transkikqToHexContinue bongNumbers rpokuWordList translationWordList fornNumbers = let aBongWord = rpokuWord bongNumbers translation = translationWordList !! getIndex aBongWord rpokuWordList transContin = transkikqToHexContinue (drop (length aBongWord) bongNumbers) rpokuWordList translationWordList fornNumbers in case aBongWord of ".i" -> fornNumbers !! 0x0 ++ transContin ".ia" -> fornNumbers !! 0x1 ++ transContin ".au" -> fornNumbers !! 0x2 ++ transContin "bq" -> fornNumbers !! 0x3 ++ transContin ".ui" -> fornNumbers !! 0x4 ++ transContin "ma" -> fornNumbers !! 0x5 ++ transContin "du" -> fornNumbers !! 0x6 ++ transContin "vq" -> fornNumbers !! 0x7 ++ transContin ".qi" -> fornNumbers !! 0x8 ++ transContin "ka" -> fornNumbers !! 0x9 ++ transContin "Nu" -> fornNumbers !! 0xA ++ transContin "zq" -> fornNumbers !! 0xB ++ transContin "gi" -> fornNumbers !! 0xC ++ transContin "ja" -> fornNumbers !! 0xD ++ transContin "xu" -> fornNumbers !! 0xE ++ transContin ".q-" -> fornNumbers !! 0xF ++ transContin ".qq" -> fornNumbers !! 0xF ++ transContin "kq" -> " " ++ translation -- end _ -> [] -- end translateName :: String -- input argument -> [String] -- rpokuWordList -> [String] -- translationWordList -> String -- translateName argument rpokuWordList translationWordList = let firstWord = rpokuWord argument contents = drop 3 (take (length argument -1) argument) katranslation = translationWordList !! getIndex firstWord rpokuWordList translationPoint = getIndex contents rpokuWordList translation = if translationPoint > -1 then translationWordList !! translationPoint else [] in if firstWord == "ka" then if length translation > 0 then katranslation ++ "." ++ translation ++ "." else katranslation ++ "." ++ charTranslate contents rpokuWordList translationWordList ++ "." else "not ka quote" charTranslate :: String -- input contents -> [String] -- rpoku chars -> [String] -- translation chars -> String -- output chars charTranslate [] rpokuChars translationChars = [] charTranslate (firstChar:restChar) rpokuWordList translationWordList = let translationPoint = getIndex (firstChar:[]) rpokuWordList translation = if translationPoint > -1 then translationWordList !! translationPoint ++ charTranslate restChar rpokuWordList translationWordList else (firstChar:[]) ++ charTranslate restChar rpokuWordList translationWordList in translation -- ---------------------------------- -- -- translate Asm args ---------- -- -- ---------------------------- -- --translateAsmArg :: String -- input argument -- -> [String] -- rpokuWordList -- -> [String] -- translationWordList -- -> [String] -- numberWordList -- -> String -- output translation --translateAsmArg argument rpokuWordList translationWordList numberWordList = -- let argStarter = rpokuWord argument -- translation = translateWord argStarter rpokuWordList translationWordList -- in -- case argStarter of -- "vi" -> translateAsmParagraph (take (length argument -4) (drop 2 argument)) rpokuWordList translationWordList numberWordList -- sentences -- "ki" -> translatekikqToAsmHex argument rpokuWordList translationWordList numberWordList -- numbers -- "ka" -> translateAsmName argument --rpokuWordList translationWordList -- names -- "zu" -> translateAsmQuote argument --rpokuWordList translationWordList -- quote -- "ju" -> translateAsmQuote argument --rpokuWordList translationWordList -- "va" -> translation ++ " " ++ translateRoot ((drop (length argStarter) argument):[]) rpokuWordList translationWordList ++ " " -- "ba" -> translation ++ " " ++ translateRoot ((drop (length argStarter) argument):[]) rpokuWordList translationWordList ++ " " -- _ -> if elem argStarter singleWordArguments then translation else argStarter -- -- --translateAsmQuote :: String -- input string quote argument -- -> String -- translation --translateAsmQuote argument = -- let aWord = rpokuWord argument -- aStopQuote = stopQuote argument pauseIndicators vowels consonants vowelModifiers ["zu","ju"] -- contents = drop (length aStopQuote) (take (length argument - ((length aStopQuote) - (length aWord))) argument) -- in "\"" ++ contents ++"\"" -- --translatekikqToAsmHex :: String -- kikq quote -- -> [String] -- rpokuWordList -- -> [String] -- translationWordList -- -> [String] -- numberWordList -- -> String -- hex number --translatekikqToAsmHex kikqQuote rpokuWordList translationWordList numberWordList = -- let aBongWord = rpokuWord kikqQuote -- translation = translationWordList !! getIndex aBongWord rpokuWordList -- in -- case aBongWord of -- "ki" -> "0x" ++ reverse ( transkikqToAsmHexContinue (drop 2 kikqQuote) rpokuWordList translationWordList numberWordList )-- most other languages use arabic right to left -- _ -> "" -- --transkikqToAsmHexContinue :: String -- input numbers -- -> [String] -- rpokuWordList -- -> [String] -- translationWordList -- -> [String] -- foreign numbers 0 - 15 -- -> String -- --transkikqToAsmHexContinue bongNumbers rpokuWordList translationWordList fornNumbers = -- let aBongWord = rpokuWord bongNumbers -- translation = translationWordList !! getIndex aBongWord rpokuWordList -- transContin = transkikqToAsmHexContinue (drop (length aBongWord) bongNumbers) rpokuWordList translationWordList fornNumbers -- in -- case aBongWord of -- ".i" -> "0" ++ transContin -- ".ia" -> "1" ++ transContin -- ".au" -> "2" ++ transContin -- "bq" -> "3" ++ transContin -- ".ui" -> "4" ++ transContin -- "ma" -> "5" ++ transContin -- "du" -> "6" ++ transContin -- "vq" -> "7" ++ transContin -- ".qi" -> "8" ++ transContin -- "ka" -> "9" ++ transContin -- "Nu" -> "A" ++ transContin -- "zq" -> "B" ++ transContin -- "gi" -> "C" ++ transContin -- "ja" -> "D" ++ transContin -- "xu" -> "E" ++ transContin -- ".q-" -> "F" ++ transContin -- ".qq" -> "F" ++ transContin -- "kq" -> ""-- end -- _ -> [] -- end -- -- --translateAsmName :: String -- input argument -- -- -> [String] -- rpokuWordList -- -- -> [String] -- translationWordList -- -> String -- --translateAsmName argument = -- let firstWord = rpokuWord argument -- contents = drop 3 (take (length argument -1) argument) -- --translation = translateWord argument r -- in -- if firstWord == "ka" -- then case contents of -- -- special names -- "dq-dNa" -> "data" -- "da-gzq" -> "text" -- "zdq-ku" -> "_start" -- -- registers -- -- left 8 bit registers -- "ak" -> "al" -- "bk" -> "bl" -- "zk" -> "cl" -- "dk" -> "dl" -- -- right 8 bit registers -- "ax" -> "ah" -- "bx" -> "bh" -- "zx" -> "ch" -- "dx" -> "dh" -- -- 16 bit registers -- "ag" -> "ax" -- "bg" -> "bx" -- "zg" -> "cx" -- "dg" -> "dx" -- -- index registers -- "zi" -> "si" -- stack index -- "di" -> "di" -- data index -- -- pointing registers -- "bb" -> "bp" -- base pointer -- "zb" -> "sp" -- stack pointerr -- "ib" -> "ip" -- instruction pointer -- -- segment registers -- "gz" -> "cs" -- code segment register -- "dz" -> "ds" -- data segment register -- "zz" -> "ss" -- stack segment register -- -- temporary segment registers -- "iz" -> "es" -- "vz" -> "fs" -- "jz" -> "gs" -- -- flags register -- "vkagz" -> "flags" -- -- 32 bit registers -- "iag" -> "eax" -- "ibg" -> "ebx" -- "izg" -> "ecx" -- "idg" -> "edx" -- -- index registers -- "izi" -> "esi" -- stack index -- "idi" -> "edi" -- data index -- -- pointing registers -- "ibb" -> "ebp" -- Base pointer -- "izb" -> "esp" -- stack pointer -- "iib" -> "eip" -- instructiong pointer -- -- flags -- "ivkagz" -> "eflags" -- _ -> contents -- else "not ka quote" -- ------------------------------------------------------------- ---------- miscellaneous functions ------------------------ ------------------------------------------------------------- -- -- rpokuArgumentList :: String -- argumentsString -> [String] -- output ArgumentList rpokuArgumentList [] = [] rpokuArgumentList arguments = let anArgument = rpokuArgument arguments in anArgument : rpokuArgumentList (drop (length anArgument) arguments)