{-- -- 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"] -- wordQuoteStarters = [["vi","vq"],["ki","kq"]] -- commentWordQuoteStarters = [["ji","jq"]] -- stopQuoteStarters = ["ka"] -- langQuoteStarters = (["zu"],[("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?{","-"])] -- 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 -- rpokuBaseWordList str = getBaseWordList str pauseIndicators vowels consonants vowelModifiers -- --rpokuFindFunction aString functionToFind = findFunction aString pauseIndicators vowels consonants vowelModifiers sentenceConnectors rootStarters singleWordQuoteStarters wordQuoteStarters stopQuoteStarters langQuoteStarters functionToFind -- main = do args <- getArgs let fileName = args !! 0 fileStr <- readFile fileName -- get xi xq self sustaining block let noBlanks = clearBlanks fileStr noComments = clearComments noBlanks xixqzduku = xixq noComments aSentence = rpokuSentence noComments-- (drop 2 xixqzduku) aParagraph = rpokuParagraph noComments -- (drop 2 xixqzduku) theRoot = rpokuRoots aSentence theArguments = rpokuArguments aSentence theArgumentList = rpokuArgumentList theArguments theTranslation = translateParagraph aParagraph --functionSentence = rpokuFindFunction 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 $ "0th arg : " ++theArgumentList !! 0 --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" --clearBlanks :: String -- string with blanks -- -> String -- string with no blanks --clearBlanks [] = [] --clearBlanks (x:xs) = -- if elem x " \n\r\t" -- then clearBlanks xs -- else x : clearBlanks xs 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"]] rpokuArgumentList :: String -- argumentsString -> [String] -- output ArgumentList rpokuArgumentList [] = [] rpokuArgumentList arguments = let anArgument = rpokuArgument arguments in anArgument : rpokuArgumentList (drop (length anArgument) arguments) translateSentence :: String -- (root,[arguments]) -> String -- translation result translateSentence sentence = let root = rpokuBaseWordList (rpokuRoots sentence) args = rpokuArgumentList $ rpokuArguments sentence in translateFunction root args translateRestDelimArgs :: [String] -- arguments -> String -- delimiter -> String -- translation translateRestDelimArgs (firstArg:restArgs) delimiter = if restArgs == [] then translateArg firstArg else translateArg firstArg ++ delimiter ++ translateRestDelimArgs restArgs delimiter translateArg :: String -- input argument -> String -- output translation translateArg argument = let argStarter = rpokuWord argument in case argStarter of "vi" -> translateParagraph (take (length argument -4) (drop 2 argument))-- sentences "ki" -> translatekikqToHex argument -- numbers "ka" -> translateName argument-- names "zu" -> translateQuote argument -- quote _ -> " argNil " translateQuote :: String -- input string quote argument -> String -- translation translateQuote 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 ++"\"" translateParagraph :: String -- input string -> String -- output translation translateParagraph paragraph = let aSentence = rpokuSentence paragraph aConnective = rpokuWord (drop (length aSentence) paragraph) aTranParContin = translateSentence aSentence ++ translateParagraph (drop ((length aSentence) + (length aConnective)) paragraph) in if aSentence == [] then [] else if elem aConnective sentenceConnectors then aTranParContin else if aConnective == [] then aTranParContin else " parNil c" ++ aConnective ++ "cS"++ aSentence translatekikqToHex :: String -- kikq quote -> String -- hex number translatekikqToHex kikqQuote = let aBongWord = rpokuWord kikqQuote in case aBongWord of "ki" -> "0x" ++ reverse ( transkikqToHexContinue (drop 2 kikqQuote)) _ -> "" transkikqToHexContinue :: String -- input numbers -> String -- transkikqToHexContinue rpokuNumbers = let aBongWord = rpokuWord rpokuNumbers transContin = transkikqToHexContinue (drop (length aBongWord) rpokuNumbers) 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 translateName :: String -- input argument -> String -- translateName argument = let firstWord = rpokuWord argument contents = drop 3 (take (length argument -1) argument) 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" translateFunction :: [String] -- root -> [String] -- args -> String -- translation translateFunction root args = case head root of "Ba-gbi" -> "section ." ++ translateArg ( args !! 0) ++ ";--part of program " ++ " \n" ++ translateArg (args !! 1) -- then need to recurse translate sentences inside "mu-NJi" -> "global " ++ translateArg (args !! 0) ++ ";-- global univerese " ++ " \n" "va-NJi" -> translateArg (args !! 0) ++ ":\n" ++ translateArg (args !! 1) -- transfer "mo-Vdi" -> "mov " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- move destination,source" ++ "\n" "Ja-Nji" -> "xchg " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- exchange arg1,arg2" ++ "\n" "gv2-xi" -> "stc " ++ ";-- carryFlag CF := 1 " ++ "\n" "gv2-bi" -> "clc " ++ ";-- carryFlag := 0" ++ "\n" "gv2-Ni" -> "cmc " ++ ";-- carryFlag := negate carryFlag" ++ "\n" "Dv2-xi" -> "std " ++ ";-- directionFlag := 1 (string op downwards)" ++ "\n" "Dv2-bi" -> "cld " ++ ";-- directionFlag := 0 (string op upwards)" ++ "\n" "Nv2-xi" -> "sti " ++ ";-- interruptFlag := 1" ++ "\n" "Nv2-bi" -> "cli " ++ ";-- interruptFlag := 0" ++ "\n" "Ju-dzi" -> "push " ++ translateArg (args !! 0) ++ ";-- push source onto stackPointer " ++ "\n" "Ju-dka" -> "pusha "++ ";-- pushAll general registers AX BX CX DX SP BP SI DI" ++ "\n" "Ju-dvu" -> "pushf "++ ";-- pushFlags onto stackPointer " ++ "\n" "bo-bzi" -> "pop " ++ translateArg (args !! 0) ++ ";-- pop from stack to destination" ++ "\n" "bo-bka" -> "popa " ++ ";-- pop all general registers" ++ "\n" "bo-bvu" -> "popf " ++ ";-- pop flags" ++ "\n" "ga-Bwu" -> "cbw " ++ ";-- ax := al -- convert byte to word" ++ "\n" "ga-wDu" -> "cwd " ++ ";-- dx:ax := ax -- convert word to double" ++ "\n" "ge-wDu" -> "cwde " ++ ";-- eax := ax -- convert word to extended double" ++ "\n" "Za-gji" -> "in " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !!1) ++ ";-- suck in dest,port" ++ "\n" "Vi-gmi" -> "out " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !!1) ++ ";-- excrete out port,dest" ++ "\n" -- arithmetic "Zu-mki" -> "add " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !!1) ++ ";-- add dest,source" ++ "\n" "Zu-mga" -> "adc " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !!1) ++ ";-- addWithCarry dest,source carryFlag" ++ "\n" "Vi-mki" -> "sub " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !!1) ++ ";-- subtract dest,source " ++ "\n" "Vi-mga" -> "sbb " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !!1) ++ ";-- subtractWithCarry dest,source carryFlag " ++ "\n" "Di-lki" -> "div " ++ translateArg (args !! 0) ++ ";-- divide unsigned al:=ax/arg ah=rest ; dx:ax:=ax/arg dx=rest ; eax:=edx:eax/op edx=rest " ++ "\n" "Di-lza" -> "idiv " ++ translateArg (args !! 0) ++ ";-- divide signed al:=ax/arg ah=rest ; dx:ax:=ax/arg dx=rest ; eax:=edx:eax/op edx=rest " ++ "\n" "bi-lki" -> "mul " ++ translateArg (args !! 0) ++ ";-- multiply unsigned al:=ax/arg ah=0 ; dx:ax:=ax/arg dx=0 ; eax:=edx:eax/op edx=0 " ++ "\n" "bi-lza" -> "imul " ++ translateArg (args !! 0) ++ ";-- multiply signed al:=ax/arg ah=sufficien ; dx:ax:=ax/arg dx=sufficien ; eax:=edx:eax/op edx=sufficient " ++ "\n" "Za-Nbi" -> "inc " ++ translateArg (args !! 0) ++ ";-- increment arg+1 " ++ "\n" "Jdi-gi" -> "dec " ++ translateArg (args !! 0) ++ ";-- decrement arg-1 " ++ "\n" "Ga-kbi" -> "cmp " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- compare arg1,arg2 arg1-arg2 zeroFlag set or unset " ++ "\n" "Ja-vzi" -> "sal " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- shiftLeft register,quantity " ++ "\n" "Ja-vbi" -> "sar " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- shiftRight register,quanity " ++ "\n" "rgu-zi" -> "rcl " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- rotateLeftThroughCarry register,quantity " ++ "\n" "rgu-bi" -> "rcr " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- rotateRightThroughCarry register,quantity" ++ "\n" "ro-lzi" -> "rol " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- rotateLeft register,quantity " ++ "\n" "ro-rbi" -> "ror " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- rotateRight register,quantity " ++ "\n" -- logic "Ne-Gdi" -> "neg " ++ translateArg (args !! 0) ++ ";-- negate op:=0-op if op=0 then cf:=0 else cf:=1 " ++ "\n" "No-dgi" -> "not " ++ translateArg (args !! 0) ++ ";-- invert op:=not op invert each bit " ++ "\n" "Ga-Nxi" -> "and " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- logical conjunction AND dest,source " ++ "\n" "Vki-Ni" -> "or " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- logical disjunction OR dest,source " ++ "\n" "Gzo-ki" -> "xor " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- logical exclusive disjunction XOR dest,source " ++ "\n" "Ji-vzi" -> "shl " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- shift logical left SHL Op,Quantity " ++ "\n" "Ji-vbi" -> "shr " ++ translateArg (args !! 0) ++ "," ++ translateArg (args !! 1) ++ ";-- shift logical right SHR Op,Quantity " ++ "\n" -- misc "Da-Nbi" -> "nop " ++ ";-- wait pause NOP no operation " ++ "\n" "le-vda" -> "lea " ++ translateArg (args !! 0) ++ translateArg (args !! 1) ++ ";-- load effective address LEA " ++ "\n" "p3-Ndu" -> "int " ++ translateArg (args !! 0) ++ ";-- interrupt (kernel) argument as message " ++ "\n" -- jumps (no change flags) "gq-kDi" -> "call " ++ translateArg (args !! 0) ++ ";-- call subroutine CALL proc " ++ "\n" "kq-gDi" -> "ret " ++ ";-- ret from subroutine " ++ "\n" "Ju-mbi" -> "jmp " ++ translateArg (args !! 0) ++ ";-- leap jump JMP Dest " ++ "\n" "JZe-bi" -> "jz " ++ translateArg (args !! 0) ++ ";-- jump if zeroFlag == 1 JZ JE" ++ "\n" "JZe-Ni" -> "jnz " ++ translateArg (args !! 0) ++ ";-- jump if zeroFlag == 0 JNZ JNE" ++ "\n" "Jba-bi" -> "jp " ++ translateArg (args !! 0) ++ ";-- jump if parityFlag == 1 JPE JP" ++ "\n" "Jba-Ni" -> "jnp " ++ translateArg (args !! 0) ++ ";-- jump if parityFlag == 0 JPO JNP" ++ "\n" -- jumps unsigned cardinal "Jga-bi" -> "jc " ++ translateArg (args !! 0) ++ ";-- jump if carryFlag == 1 JC JB JNAE " ++ "\n" "Jga-Ni" -> "jnc " ++ translateArg (args !! 0) ++ ";-- jump if carryFlag == 0 JNC JNB JAE " ++ "\n" -- jumps signed integer "Ju-ZGi" -> "jg " ++ translateArg (args !! 0) ++ ";-- jump if greater " ++ "\n" "Ju-ZDi" -> "jge " ++ translateArg (args !! 0) ++ ";-- jump if greater or equal to " ++ "\n" "Ju-mli" -> "jl " ++ translateArg (args !! 0) ++ ";-- jump if less " ++ "\n" "Ju-mDi" -> "jle " ++ translateArg (args !! 0) ++ ";-- jump if less or equal to " ++ "\n" "Jvo-bi" -> "jo " ++ translateArg (args !! 0) ++ ";-- jump if overFlowFlag == 1 JO" ++ "\n" "Jvo-Ni" -> "jno " ++ translateArg (args !! 0) ++ ";-- jump if overFlowFlag == 0 JNO" ++ "\n" "Jzq-bi" -> "js " ++ translateArg (args !! 0) ++ ";-- jump if signFlag == 1 JS" ++ "\n" "Jzq-Ni" -> "jns " ++ translateArg (args !! 0) ++ ";-- jump if signFlag == 0 JNS" ++ "\n" -- "DBu-mu" -> translateArg (args !! 0) ++ " db " ++ translateRestDelimArgs (drop 1 args) "," ++ "\n" --"kagkmq-kji" -> translateArg (args !! 0) ++ " equ " ++ translateArg (args !! 1) ++ "\n" --"za-zNi" -> translateArg (args !! 0) ++ "Vi-dNu" -> translateArg (args !! 0) ++ " equ " ++ translateRestDelimArgs (drop 1 args) "," ++ "\n" -- miscelaneous "Vi-dgu" -> translateArg (args !! 0) ++ " equ $ - " ++ translateArg (args !! 1) ++ "\n" _ -> " sentenceNil r" ++ show root ++ "ra" ++ show args