diff --git a/Language/Huckleberry/V10101.hs b/Language/Huckleberry/V10101.hs --- a/Language/Huckleberry/V10101.hs +++ b/Language/Huckleberry/V10101.hs @@ -1,5 +1,93 @@ {-# LANGUAGE GADTs #-} +{-| +The EDSL Provides bridge between IchigoJam BASIC and Haskell. + +References for IchigoJam BASIC are available at +. + + +For example, +\"Jumping rome girl Sacchan\" +could be expressed like this. + +@ +sacchan = do + label 10 $ y=:25 >> v=:99 >> x=:17 >> u=:5 >> s=:0 + label 20 $ ifThen (v\/=99) $ y=:y+v >> v=:v+1 + label 30 $ ifThen (25\> v=:99 >> s=:s+1 + label 40 $ x=:x+u + label 50 $ ifThen (17\> print "\@" + label 110 $ locate x 25 >> print \"-\" + label 120 $ locate 0 0 >> print (\"SCORE:\" ++ s) + label 130 $ ifThen (pre(y==25)*pre(x==17)) end + label 140 $ wait 2 + label 150 $ goto 20 +@ + + +Get IchigoJam BASIC code like this. + +@ +showSacchan = putStr $ translate sacchan +@ + +Also, you can send the code to IchigoJam directly. + +@ +sendSacchan = do + h \<- IJ.opend "\/dev\/ttyUSB0" + IJ.send h $ translate sacchan + IJ.close h +@ + + +To use this, your code should begin with this code block. + +@ +\{\-\# LANGUAGE OverloadedStrings \#\-\} +import Prelude hiding (print,(++),(+),(-),(*),(\/),(%),(==),(\/=),(>=),(>),(\<=),(\<),(&&),(||),not,abs,return) +import qualified Prelude as P +import qualified IchigoJam as IJ +import Language.Huckleberry.V10101 +@ + +For more example. + + + +() is 'pre'. + +Put line number by 'label'. + +\[n\] is 'arr'. + +LET is 'let''. + +\= is '=:'. + +\; is '++'. + +IN is 'in''. + +& is '.&.'. + +| is '.|.'. + +^ is 'xor'. + +\>\> is 'shiftR'. + +\<\< is 'shiftL'. + +~ is 'complement'. + +-} module Language.Huckleberry.V10101 ( translate ,pre @@ -35,6 +123,7 @@ ,y ,z ,arr + -- * Commands for beginners ,let' ,(=:) ,print @@ -87,6 +176,7 @@ ,(&&) ,(||) ,not + -- * Commands for experts ,clv ,clear ,clk @@ -146,7 +236,7 @@ Number :: (Num r) => r -> Expr r Str :: (S.IsString r) => r -> Expr r - -- 優先して評価(カッコの代わり) + -- Bracket operator Pre :: Expr Int16 -> Expr Int16 A :: Expr Int16 @@ -181,10 +271,10 @@ -- - -- Beginner's + -- Commands for beginners -- - -- [TODO] 数：0(付属ボタン)/UP/DOWN/RIGHT/LEFT/SPACE、省略で0 + -- [TODO] [num]：0(button)/UP/DOWN/RIGHT/LEFT/SPACE, defautl 0 Btn :: Expr Int16 -> Expr Int16 Rnd :: Expr Int16 -> Expr Int16 @@ -203,7 +293,7 @@ Asc :: String -> Expr Int16 Scr :: Expr Int16 -> Expr Int16 -> Expr Int16 - Scr' :: Expr Int16 -- 指定なしで現在位置 + Scr' :: Expr Int16 Equal :: Expr Int16 -> Expr Int16 -> Expr Int16 NotEqual :: Expr Int16 -> Expr Int16 -> Expr Int16 @@ -217,7 +307,7 @@ -- - -- Expert's + -- Commands for experts -- Abs :: Expr Int16 -> Expr Int16 Sound :: Expr Int16 @@ -228,13 +318,13 @@ Ana :: Expr Int16 -> Expr Int16 In' :: Expr Int16 -> Expr Int16 - In'' :: Expr Int16 -- 数を省略してまとめて入力できる + In'' :: Expr Int16 Hex :: Expr Int16 -> Expr Int16 -> Expr String - Hex' :: Expr Int16 -> Expr String -- ２番目の数は桁数、省略可 + Hex' :: Expr Int16 -> Expr String Bin :: Expr Int16 -> Expr Int16 -> Expr String - Bin' :: Expr Int16 -> Expr String -- ２番目の数は桁数、省略可 + Bin' :: Expr Int16 -> Expr String BitAnd :: Expr Int16 -> Expr Int16 -> Expr Int16 BitOr :: Expr Int16 -> Expr Int16 -> Expr Int16 @@ -270,7 +360,7 @@ Label :: Int16 -> [Stmt] -> Stmt - -- IFは入れ子にできる + -- IF could be nested IfThenElse :: Expr Int16 -> [Stmt] -> [Stmt] -> Stmt IfThen :: Expr Int16 -> [Stmt] -> Stmt ForStepNext :: Expr Int16 -> Expr Int16 -> Expr Int16 -> Expr Int16 -> [Stmt] -> Stmt @@ -278,7 +368,7 @@ -- - -- Beginner's + -- Commands for beginners -- Let' :: Expr Int16 -> [Expr Int16] -> Stmt Assign :: Expr Int16 -> Expr Int16 -> Stmt @@ -290,7 +380,7 @@ Run :: Stmt List :: Expr Int16 -> Expr Int16 -> Stmt - List' :: Stmt -- 行番号は共に省略可 + List' :: Stmt Goto :: Expr Int16 -> Stmt @@ -301,18 +391,18 @@ Cls :: Stmt Save :: Expr Int16 -> Stmt - Save' :: Stmt -- 省略で前回使用した数 + Save' :: Stmt Load :: Expr Int16 -> Stmt - Load' :: Stmt -- 省略で前回使用した数 + Load' :: Stmt Files :: Expr Int16 -> Stmt Beep :: Expr Int16 -> Expr Int16 -> Stmt - Beep' :: Stmt -- 周期(1-255)と長さ(1/60秒単位)は省略可 + Beep' :: Stmt Play :: String -> Stmt - Play' :: Stmt -- MML省略で停止 + Play' :: Stmt Tempo :: Expr Int16 -> Stmt @@ -323,7 +413,7 @@ -- - -- Expert's + -- Commands for experts -- Clv :: Stmt Clk :: Stmt @@ -332,7 +422,7 @@ Return :: Stmt Renum :: Expr Int16 -> Stmt - Renum' :: Stmt -- 数省略で10 + Renum' :: Stmt LRun :: Expr Int16 -> Stmt @@ -343,7 +433,7 @@ Help :: Stmt Out :: Expr Int16 -> Expr Int16 -> Stmt - Out' :: Expr Int16 -> Stmt -- 数2を省略でまとめて出力できる + Out' :: Expr Int16 -> Stmt Bps :: Expr Int16 -> Stmt @@ -499,23 +589,68 @@ type Code = Writer [Stmt] +{-| Translate huckleberry code to IchigoJam BASIC code. + +-} translate :: Code() -> String translate c = (intercalate "\n" $ map toString (execWriter c)) P.++ "\n" +{-| Bracket operator. + +the expression + +@ +pre(y==25)*pre(x==17) +@ + +evaluated as this expression in IchigoJam BASIC. + +@ +(Y=25)*(X=17) +@ + +-} pre = Pre +{-| Line number statement. + +this expression + +@ +label 40 $ x=:x+u +@ + +evaluated as this statement in IchigoJam BASIC. + +@ +40 X=X+U +@ + +-} label :: Int16 -> Code() -> Code() label l st = tell [Label l (execWriter st)] +{-| IF .. THEN .. ELSE .. statement. + +-} ifThenElse :: Expr Int16 -> Code() -> Code() -> Code() ifThenElse c st1 st2 = tell [IfThenElse c (execWriter st1) (execWriter st2)] +{-| IF .. THEN .. statement. + +-} ifThen :: Expr Int16 -> Code() -> Code() ifThen c st = tell [IfThen c (execWriter st)] +{-| FOR .. = .. TO .. STEP .. .. NEXT statement. + +-} forStepNext :: Expr Int16 -> Expr Int16 -> Expr Int16 -> Expr Int16 -> Code() -> Code() forStepNext v ini inc step st = tell [ForStepNext v ini inc step (execWriter st)] +{-| FOR .. = .. TO .. .. NEXT statement. + +-} forNext :: Expr Int16 -> Expr Int16 -> Expr Int16 -> Code() -> Code() forNext v ini inc st = tell [ForNext v ini inc (execWriter st)] @@ -546,24 +681,86 @@ x = X y = Y z = Z + +{-| Array valiables expression. + +This expression + +@ +arr 3 +@ + +evaluated as this expression in IchigoJam BASIC. + +@ +\[3\] +@ +-} arr = Array -- --- Beginner's +-- Commands for beginners -- +{-| LET statement. + +This expression + +@ +let' a [3] +@ + +evaluated as this statement in IchigoJam BASIC. + +@ +LET A,3 +@ + +Also, this expression + +@ +let' (arr 3) [11,12,13] +@ + +evaluated as this statement in IchigoJam BASIC. + +@ +LET[3],11,12,13 +@ +-} let' :: Expr Int16 -> [Expr Int16] -> Code() let' v1 v2 = tell [Let' v1 v2] +{-| Assignment operator.(\=) + +This expression + +@ +x =: x+u +@ + +evaluated as this statement in IchigoJam BASIC. + +@ +X=X+U +@ + +-} (=:) :: Expr Int16 -> Expr Int16 -> Code() (=:) v1 v2 = tell [Assign v1 v2] infix 2 =: +{-| PRINT statement. + +-} print :: (Show r) => Expr r -> Code() print x = tell [Print x] +{-| Concatation operator.(;) + +-} (++) :: (Show a, Show b, S.IsString c) => Expr a -> Expr b -> Expr c (++) = Concat infixl 2 ++ @@ -656,7 +853,9 @@ chr :: Expr Int16 -> Expr String chr v = Chr [v] --- コンマ区切りで連続表記可 +{-| + +-} chr' :: [Expr Int16] -> Expr String chr' = Chr @@ -699,7 +898,7 @@ -- --- Expert's +-- Commands for experts -- clv :: Code() @@ -757,6 +956,9 @@ out' :: Expr Int16 -> Code() out' v = tell [Out' v] +{-| IN expression. + +-} in' = In' in'' = In'' @@ -766,21 +968,39 @@ bin = Bin bin' = Bin' +{-| Bitwise AND operator (&) + +-} (.&.) = BitAnd infixl 7 .&. +{-| Bitwise OR operator (|) + +-} (.|.) = BitOr infixl 6 .|. +{-| Bitwise XOR expression (^) + +-} xor = XOr infixl 7 `xor` +{-| Right shift expression (>>) + +-} shiftR = ShiftR infixl 7 `shiftR` +{-| Left shift expression (\<\<) + +-} shiftL = ShiftL infixl 7 `shiftL` +{-| Complement expression (~) + +-} complement = Complement bps :: Expr Int16 -> Code() diff --git a/huckleberry.cabal b/huckleberry.cabal --- a/huckleberry.cabal +++ b/huckleberry.cabal @@ -2,9 +2,9 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: huckleberry -version: 0.9.0.0 -synopsis: haskell EDSL Huckleberry -description: IchigoJam BASIC on haskell +version: 0.9.0.1 +synopsis: IchigoJam BASIC expressed in Haskell. +description: The EDSL Provides bridge between IchigoJam BASIC and Haskell. license: BSD3 license-file: LICENSE author: Takamasa Mitsuji @@ -22,3 +22,19 @@ build-depends: base >=4.7 && <4.8, bytestring >=0.10 && <0.11, serialport >=0.4 && <0.5, mtl >=2.1 -- hs-source-dirs: default-language: Haskell2010 + + +source-repository head + type: git + location: https://github.com/mitsuji/huckleberry.git + + +test-suite test + hs-source-dirs: test + main-is: test_Huckleberry_V10101.hs + type: exitcode-stdio-1.0 + build-depends: base, + HUnit >= 1.2.0.0, + huckleberry + default-language: Haskell2010 + diff --git a/test/test_Huckleberry_V10101.hs b/test/test_Huckleberry_V10101.hs new file mode 100644 --- /dev/null +++ b/test/test_Huckleberry_V10101.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE OverloadedStrings #-} +import Test.HUnit (Assertion, (@=?), runTestTT, Test(..), Counts(..)) +import System.Exit (ExitCode(..), exitWith) +import Data.Char (toUpper) + +import Prelude hiding (print,(++),(+),(-),(*),(/),(%),(==),(/=),(>=),(>),(<=),(<),(&&),(||),not,abs,return) +import qualified Prelude as P +import Language.Huckleberry.V10101 + + +exitProperly :: IO Counts -> IO () +exitProperly m = do + counts <- m + exitWith $ if failures counts P./= 0 P.|| errors counts P./= 0 then ExitFailure 1 else ExitSuccess + +testCase :: String -> Assertion -> Test +testCase label assertion = TestLabel label (TestCase assertion) + +main :: IO () +main = exitProperly $ runTestTT $ TestList [ TestList huckleberryTests ] + +huckleberryTests :: [Test] +huckleberryTests = + [ testCase "number literal" $ "?1234\n" @=? (translate $ print 1234) + , testCase "number literal" $ "?102575\n" @=? (translate $ print 0x190AF) + , testCase "string literal" $ "?\"abcd\"\n" @=? (translate $ print "abcd") + , testCase "variable" $ "?A\n" @=? (translate $ print a) + , testCase "variable" $ "?A+1\n" @=? (translate $ print $ a+1) + , testCase "array" $ "?[8]\n" @=? (translate $ print $ arr 8) + , testCase "array" $ "?[A]\n" @=? (translate $ print $ arr a) + , testCase "array" $ "?[A+1]\n" @=? (translate $ print $ arr (a+1)) + , testCase "++" $ "?\"abc\";\"def\"\n" @=? (translate $ print $ "abc" ++ "def") + , testCase "++" $ "?1234;5678\n" @=? (translate $ print $ 1234 ++ 5678) + , testCase "++" $ "?\"abc\";5678\n" @=? (translate $ print $ "abc" ++ 5678) + , testCase "++" $ "?1234;\"def\"\n" @=? (translate $ print $ 1234 ++ "def") + , testCase "let'" $ "LETA,1\n" @=? (translate $ let' a [1]) + , testCase "let'" $ "LETA+1,1\n" @=? (translate $ let' (a+1) [1]) + , testCase "let'" $ "LETA,1,2,3\n" @=? (translate $ let' a [1,2,3]) + , testCase "let'" $ "LETA+1,1,2,3\n" @=? (translate $ let' (a+1) [1,2,3]) + , testCase "let'" $ "LET[8],1,2,3\n" @=? (translate $ let' (arr 8) [1,2,3]) + , testCase "let'" $ "LET[A],A+1,2,3\n" @=? (translate $ let' (arr a) [a+1,2,3]) + , testCase "let'" $ "LET[A+1],1,2,3\n" @=? (translate $ let' (arr (a+1)) [1,2,3]) + , testCase "=:" $ "A=1\n" @=? (translate $ a=:1) + , testCase "=:" $ "A=B\n" @=? (translate $ a=:b) + , testCase "ifThenElse" $ "IFA=B?\"S\"ELSE?\"N\"\n" + @=? (translate $ ifThenElse (a==b) (print "S") (print "N")) + , testCase "ifThen" $ "IFA=B?\"S\"\n" + @=? (translate $ ifThen (a==b) (print "S")) + , testCase "forStepNext" $ "FORA=0TO99STEP2:?[A+1]+2:NEXT\n" + @=? (translate $ forStepNext a 0 99 2 (print $ arr (a+1) +2)) + , testCase "forNext" $ "FORA=0TO99:?[A+1]+2:NEXT\n" + @=? (translate $ forNext a 0 99 (print $ arr (a+1) +2)) + , testCase "pre" $ "?(A-1)*(B+1)\n" @=? (translate $ print $ pre(a-1)*pre(b+1)) + , testCase "pre" $ "?A-1*B+1\n" @=? (translate $ print $ (a-1)*(b+1)) + , testCase "led" $ "LEDA+1\n" @=? (translate $ led (a+1)) + , testCase "wait" $ "WAITA+1\n" @=? (translate $ wait(a+1)) + , testCase "run" $ "RUN\n" @=? (translate $ run) + , testCase "list" $ "LISTA+1,B+2\n" @=? (translate $ list (a+1) (b+2)) + , testCase "list'" $ "LIST\n" @=? (translate $ list') + , testCase "goto" $ "GOTOA+1\n" @=? (translate $ goto (a+1)) + , testCase "end" $ "END\n" @=? (translate $ end) + , testCase "btn" $ "?BTN(A+1)+2\n" @=? (translate $ print $ (btn (a+1)) +2) + , testCase "new" $ "NEW\n" @=? (translate $ new) + , testCase "locate" $ "LCA+1,B+2\n" @=? (translate $ locate (a+1) (b+2)) + , testCase "cls" $ "CLS\n" @=? (translate $ cls) + , testCase "rnd" $ "?RND(A+1)+2\n" @=? (translate $ print $ (rnd (a+1)) +2) + , testCase "save" $ "SAVEA+1\n" @=? (translate $ save (a+1)) + , testCase "save'" $ "SAVE\n" @=? (translate $ save') + , testCase "load" $ "LOADA+1\n" @=? (translate $ load (a+1)) + , testCase "load'" $ "LOAD\n" @=? (translate $ load') + , testCase "files" $ "FILESA+1\n" @=? (translate $ files (a+1)) + , testCase "beep" $ "BEEPA+1,B+2\n" @=? (translate $ beep (a+1) (b+2)) + , testCase "beep'" $ "BEEP\n" @=? (translate $ beep') + , testCase "play" $ "PLAY\"ABCD\"\n" @=? (translate $ play "ABCD") + , testCase "play'" $ "PLAY\n" @=? (translate $ play') + , testCase "tempo" $ "TEMPOA+1\n" @=? (translate $ tempo (a+1)) + , testCase "+" $ "?A+B\n" @=? (translate $ print $ a+b) + , testCase "-" $ "?A-B\n" @=? (translate $ print $ a-b) + , testCase "*" $ "?A*B\n" @=? (translate $ print $ a*b) + , testCase "/" $ "?A/B\n" @=? (translate $ print $ a/b) + , testCase "%" $ "?A%B\n" @=? (translate $ print $ a%b) + , testCase "input" $ "INPUT\"Q?\",A\n" @=? (translate $ input "Q?" a) + , testCase "tick" $ "?TICK()+1\n" @=? (translate $ print $ tick +1) + , testCase "clt" $ "CLT\n" @=? (translate $ clt) + , testCase "inkey" $ "?INKEY()+1\n" @=? (translate $ print $ inkey +1) + , testCase "chr" $ "?CHR$(A+1);\"def\"\n" @=? (translate $ print $ chr (a+1) ++ "def") + , testCase "chr'" $ "?CHR$(65,66,67)\n" @=? (translate $ print $ chr'[65,66,67]) + , testCase "asc" $ "?ASC(\"abcd\")\n" @=? (translate $ print $ asc "abcd") + , testCase "scroll" $ "SCROLLA+1\n" @=? (translate $ scroll (a+1)) + , testCase "scr" $ "?SCR(A+1,B+2)+2\n" @=? (translate $ print $ (scr (a+1) (b+2))+2) + , testCase "scr'" $ "?SCR()+1\n" @=? (translate $ print $ scr'+1) + , testCase "vpeek" $ "?SCR(A+1,B+2)+2\n" @=? (translate $ print $ (vpeek (a+1) (b+2))+2) + , testCase "vpeek'" $ "?SCR()+1\n" @=? (translate $ print $ vpeek'+1) + , testCase "==" $ "?A=B\n" @=? (translate $ print $ a==b) + , testCase "/=" $ "?A!=B\n" @=? (translate $ print $ a/=b) + , testCase ">=" $ "?A>=B\n" @=? (translate $ print $ a>=b) + , testCase ">" $ "?A>B\n" @=? (translate $ print $ a>b) + , testCase "<=" $ "?A<=B\n" @=? (translate $ print $ a<=b) + , testCase "<" $ "?A>B\n" @=? (translate $ print $ a`shiftR`b) + , testCase "shiftL" $ "?A<