IT練習ノート

IT関連で調べたこと(実際は嵌ったこと)を書いています。

GhcLintでコードをチェックする

結果集計

$ grep "^src" doc/wk_lint_result.md | cut -d " " -f 4- | sort | uniq -c | sort -r
  18 error| Suggestion: Move brackets to avoid $
   8 error| Suggestion: Redundant $
   7 error| Suggestion: Redundant bracket
   4 error| Suggestion: Avoid lambda
   3 warning| Redundant return
   3 warning| Redundant lambda
   3 error| Suggestion: Use String
   2 error| Suggestion: Use infix
   1 warning| Use notElem
   1 warning| Redundant if
   1 warning| Redundant do
   1 warning| Evaluate
   1 warning| Eta reduce
   1 error| Suggestion: Use if

$の無駄使いが多いようです。

また、全体的にRedundantが多いですね。割合を計算してみると。

$ grep "^src" doc/wk_lint_result.md | cut -d " " -f 4- | sort | uniq -c | sort -nr | awk '{a += $1;} END {print a}'
54
$ grep "^src" doc/wk_lint_result.md | cut -d " " -f 4- | sort | uniq -c | sort -nr | grep Redundant
   8 error| Suggestion: Redundant $
   7 error| Suggestion: Redundant bracket
   3 warning| Redundant return
   3 warning| Redundant lambda
   1 warning| Redundant if
   1 warning| Redundant do
$ grep "^src" doc/wk_lint_result.md | cut -d " " -f 4- | sort | uniq -c | sort -nr | grep Redundant | awk '{a += $1;} END {print a}'
23
$ echo "23/54*100" | bc -l
42.59259259259259259200

42%が冗長でした。

結果内容

  • 冗長なラムダ
src/Atoparsec05.hs|72 col 1 warning| Redundant lambda
|| Found:
||   incAndaddBindParserState
||     = \ bind ParserState{..} ->
||         ParserState (markerIdx + 1) (bind : bindList)
|| Why not:
||   incAndaddBindParserState bind ParserState{..}
||     = ParserState (markerIdx + 1) (bind : bindList)
  • エータ簡約する
src/Atoparsec05.hs|110 col 5 warning| Eta reduce
|| Found:
||   mkBin ope x y = mkBinaryOperator (BC.unpack ope) x y
|| Why not:
||   mkBin ope = mkBinaryOperator (BC.unpack ope)
  • [Char]ではなくStringを使う
src/Atoparsec05.hs|117 col 11 error| Suggestion: Use String
|| Found:
||   [Char] -> Parser Char
|| Why not:
||   String -> Parser Char
  • ライブラリにある関数を使う
src/Atoparsec05.hs|118 col 28 warning| Use notElem
|| Found:
||   not (elem c xs)
|| Why not:
||   notElem c xs

notElemなんてあったかなとおもったら、確かにある。

*Atoparsec04> :t elem
elem :: (Foldable t, Eq a) => a -> t a -> Bool
*Atoparsec04> :t notElem
notElem :: (Foldable t, Eq a) => a -> t a -> Bool
src/Atoparsec05.hs|118 col 33 error| Suggestion: Use infix
|| Found:
||   elem c xs
|| Why not:
||   c `elem` xs
  • タプルから値を取り出して関数適用するのではなく、関数をuncurryして直接タプルを関数適用できるようにする。
src/Atoparsec05.hs|268 col 28 warning| Evaluate
|| Found:
||   ope_ lhs (fst $ P.head xs) (snd $ P.head xs)
|| Why not:
||   uncurry (ope_ lhs) (P.head xs)
  • do不要
src/Atoparsec05.hs|331 col 22 warning| Redundant do
|| Found:
||   do case val of
||          Left sch -> do lift $ char '.'
||                         x <- _idenStr
||                         params <- parenExprList
||                         return $ expr $ mkFunctionCall' x sch params
||          Right idn -> do params <- parenExprList
||                          return $ expr $ mkFunctionCall' idn "" params
|| Why not:
||   case val of
||       Left sch -> do lift $ char '.'
||                      x <- _idenStr
||                      params <- parenExprList
||                      return $ expr $ mkFunctionCall' x sch params
||       Right idn -> do params <- parenExprList
||                       return $ expr $ mkFunctionCall' idn "" params
  • 評価結果を返すならif不要
src/Atoparsec05.hs|415 col 11 warning| Redundant if
|| Found:
||   if x == '+' then True else False
|| Why not:
||   x == '+'
  • 不要なかっこ
src/Atoparsec05.hs|477 col 14 error| Suggestion: Redundant bracket
|| Found:
||   (lift $ string "json") <|>
||     (lift (string "datetime" <|> "date" <|> "time"))
|| Why not:
||   (lift $ string "json") <|>
||     lift (string "datetime" <|> "date" <|> "time")
  • 不要なラムダ
src/Atoparsec05.hs|570 col 37 error| Suggestion: Avoid lambda
|| Found:
||   \ x -> x == c
|| Why not:
||   (== c)
  • 不要な$
src/Atoparsec05.hs|588 col 8 error| Suggestion: Redundant $
|| Found:
||   lift $ peekChar
|| Why not:
||   lift peekChar
  • caseで評価をTrue/Falseでする場合ifをつかう
src/Atoparsec05.hs|594 col 8 error| Suggestion: Use if
|| Found:
||   case arw of
||       True -> do docPathArrow
||                  docPath <- (lift $ char '$') >> (lift $ char '.') >>
||                               atomDocumentPath
||                  return $
||                    exprColumnIdentifier $
||                      columnIdentifierNameDocumentPahtItem str docPath
||       False -> return $ exprIdentifierName str
|| Why not:
||   if arw then
||     (do docPathArrow
||         docPath <- (lift $ char '$') >> (lift $ char '.') >>
||                      atomDocumentPath
||         return $
||           exprColumnIdentifier $
||             columnIdentifierNameDocumentPahtItem str docPath)
||     else return $ exprIdentifierName str
  • 不要なリターンは避ける。(多分コードを書いていて途中に検証用のロジックをいれいて消したのでこの形になっていたのだと思う。)
src/Atoparsec05.hs|666 col 20 warning| Redundant return
|| Found:
||   do x <- many1 atomPathItem
||      return x
|| Why not:
||   do many1 atomPathItem
  • かっこの範囲は必要最低限に狭くする
src/Atoparsec05.hs|709 col 20 error| Suggestion: Move brackets to avoid $
|| Found:
||   (lift $ string "[*]") >> return '*'
|| Why not:
||   lift (string "[*]") >> return '*'
  • 不要なラムダは避ける
src/Atoparsec05.hs|712 col 20 error| Suggestion: Avoid lambda
|| Found:
||   \ x -> (mkArrayIndex . fromIntegral) x
|| Why not:
||   (mkArrayIndex . fromIntegral)
  • $を避ける
src/Atoparsec05.hs|725 col 18 error| Suggestion: Move brackets to avoid $
|| Found:
||   (lift $ stringCI "asc") <|> lift (stringCI "desc")
|| Why not:
||   lift (stringCI "asc") <|> lift (stringCI "desc")

mysqlshでのアクセス

すぐ忘れるのでメモ

$ mysqlsh -u root -P 8000
Creating a Session to 'root@localhost:8000'
Enter password:
Node Session successfully established. No default schema selected.
Welcome to MySQL Shell 1.0.9

Copyright (c) 2016, 2017, Oracle and/or its affiliates. All rights reserved.

Oracle is a registered trademark of Oracle Corporation and/or its
affiliates. Other names may be trademarks of their respective
owners.

Type '\help', '\h' or '\?' for help, type '\quit' or '\q' to exit.

mysql-js> session
<NodeSession:root@localhost:8000>
mysql-js> \sql
Switching to SQL mode... Commands end with ;
mysql-sql> show schemas;
+--------------------+
| Database           |
+--------------------+
| information_schema |
| performance_schema |
| world_x            |
| x_protocol_test    |
+--------------------+
13 rows in set (0.02 sec)
mysql-sql> use x_protocol_test;
Query OK, 0 rows affected (0.01 sec)
mysql-sql> show tables;
+---------------------------+
| Tables_in_x_protocol_test |
+---------------------------+
| alltypes                  |
| bar                       |
| bazz                      |
| data_type_date            |
| data_type_datetime        |
| data_type_decimal         |
| data_type_decimal1        |
| data_type_decimal2        |
| data_type_enum            |
| data_type_time            |
| data_type_timestamp       |
| data_type_year            |
| foo                       |
| foo_doc                   |
| items                     |
| mydoc                     |
| products                  |
| test_users                |
| users                     |
| yyy                       |
+---------------------------+
20 rows in set (0.01 sec)
mysql-sql>
mysql-sql> \js
Switching to JavaScript mode...
mysql-js> session
<NodeSession:root@localhost:8000>
mysql-js> db = session.getSchema("x_protocol_test")
<Schema:x_protocol_test>
mysql-js> db.yyy.find().limit(1)
[
    {
        "_id": "4661c8c3e971b3fc4dcf4af757297cb5",
        "author": "Theodor Fontane",
        "currentlyReadingPage": 42,
        "isbn": "12345",
        "title": "xxxxx"
    }
]
1 document in set (0.01 sec)
mysql-js>
mysql-js> tbl = db.getTable("foo")
<Table:foo>
mysql-js> db.find().limit(1);
Invalid object member find (AttributeError)
mysql-js> db.select().limit(1);
Invalid object member select (AttributeError)
mysql-js> tbl.select().limit(1);
+-----+-----+
| id  | v   |
+-----+-----+
| 123 | xyz |
+-----+-----+
1 row in set (0.00 sec)
mysql-js>

UART

UARTについて

http://www.altima.jp/column/fpga_edison/uart.html

UART / USART

https://www.youtube.com/watch?v=FQpbIvhY7es

UART = Universal Asyncronus Receiver-Transmitter

USART = Universal Syncronus / Asyncronus Receiver-Transmitter

RS-232

https://www.youtube.com/watch?v=XVEnxipCIJ0

RS-232 Recommended Standard

Tx <--> Rx

Tx = Transmmit Data Rx = Receive Data

DTR <--> DSR

DTR = Data Terminal Ready DSR = Data Set Ready

RST <--> CTS

RTS = Request To Send CTS = Carrier To Send

DCD = Data Carrier Detect RI = ??

FPGAプログラミング大全 Xilinx編 10章

FPGAプログラミング大全 Xilinx編

FPGAプログラミング大全 Xilinx編

手元の環境Vivado 2017.3と10章で書籍と少し違っていた点

P.503 図10-28 (a) IPの登録

f:id:naotoogawa:20180116171905p:plain

P.504 図10-29 乗加算回路IPを追加したかいあダイアグラムが完成

f:id:naotoogawa:20180116172303p:plain

少し嵌った点

10章の最初のサンプルはFPGA\XilinxFPGA\commonにある。(XilinxFPGA\Zybo\dai10sho\muladd_zqではない)

hetero-mapの使い方

hackage.haskell.org

hetero-mapパッケージを使おうと思ったのですが、サンプルが見つけられず、使い方に悩みました。

このようにして、型の整合はとれても、undefinedをつかっているので実行時にエラーになります。

*Main HeteroMap.Map> let k1 = undefined :: Key Char Char
*Main HeteroMap.Map> let k2 = undefined :: Key Int Int
*Main HeteroMap.Map> let m = insert k2 2 $ insert k1 'a' empty
*Main HeteroMap.Map> :t m
m :: Map
       (Int HeteroMap.Map.:* (Char HeteroMap.Map.:* HeteroMap.Map.Z))
*Main HeteroMap.Map> let v = lookup k1 m
*Main HeteroMap.Map> v
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
  error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
  undefined, called at <interactive>:19:10 in interactive:Ghci2
*Main HeteroMap.Map>

Keyの実装は

data Key x a where
    Key :: Key a a

となっていますが、データコンストラクタは公開されていません。

keyを作る実装も関数ccを与えるだけになっており、関数を与えるけれど、その関数の第1引数はKey固定になっています。これはどのように使うのでしょうか?

-- | Allocate a new key, which is only valid within the passed function
-- (and will be a type error if it tries to escape).
newKey :: (forall x. Key x a -> b) -> b
newKey cc = cc Key

検索しても本当にこのパッケージの情報がなくて、途方に暮れていたところ、HMapexampleがヒントになりました。

Data.HMap

ポイントとしては、

1つの関数の中で閉じて使う。別の関数とMapを共有できない。(<-この理解であってる?)

ということのようです。

import HeteroMap.Map 
import Prelude hiding (lookup)

example :: Key aaa String -> Key bbb Double -> Key ccc Bool -> String
example name salary female =
  format a ++ "\n" ++ format b ++ "\n"
  where a = insert name "Edsger" $
            insert salary 4450.0 $
            insert female False empty
        b = insert name "Ada"    $
            insert salary 5000.0 $
            insert female True empty
        format x = lookup name x ++ ": salary=" ++ show (lookup salary x) ++ ", female="  ++ show (lookup female x)

keyLocal :: String
keyLocal = newKey $ newKey $ newKey example

main = do print "local"
          putStr keyLocal