本記事は 2026 年 5 月 7 日に公開された “ Full-text, exact-match, range, and hybrid search on Amazon ElastiCache ” を翻訳したものです。 訳者註： 本記事の全文検索は、現時点では言語オプションとして english のみをサポートしており、日本語テキストはスペースや句読点で区切られた単位でインデックスされます。日本語を全文検索する場合は、事前に形態素解析で語ごとにスペースで区切ったテキストをインデックスし、検索クエリも同じ形で渡すようにしてください。 Amazon ElastiCache は、別個の検索サービスを使用することなく、キャッシュ内で直接リアルタイムの全文検索、完全一致検索、数値範囲検索、ハイブリッド検索をサポートするようになりました。低レイテンシーで動的データに対するスケーラブルな検索を必要とするワークロードに対して、アプリケーションはマイクロ秒単位のレイテンシーと毎秒最大数百万回の検索操作のスループットでテラバイト規模のデータを検索できます。これらの新しい検索機能により、開発者は ElastiCache に既に保存されているデータを、単純なキーバリュー検索を超えた属性で柔軟にクエリできるようになります。 完全一致検索は、商品名、カテゴリ、ユーザー ID、注文番号など、テキスト、タグ、数値属性にわたる正確な値の一致によってドキュメントを取得します。数値範囲検索は、価格のしきい値、日付範囲、取引金額などの属性によってドキュメントをフィルタリングします。完全一致に加えて、全文検索はテキスト属性に対して、オートコンプリート (入力補完) 用のプレフィックスマッチング、タイプミス許容のためのファジーマッチング、複数語検索のための近接マッチングを実行します。これらの検索タイプをベクトル類似度と単一のハイブリッドクエリで組み合わせることができ、正確な用語と意味的な意図の両方を捉えることで、いずれかの手法を単独で使用するよりも関連性の高い結果を提供します。ベクトルワークロードにおいて、ElastiCache for Valkey は AWS 上の主要なベクトルデータベースの中で、95% 以上の再現率で最低レイテンシかつ最高スループットのベクトル検索、そして最高の価格性能比を実現します。 これらの検索機能は、ElastiCache version 9.0 for Valkey で利用可能であり、リアルタイム分析やレポーティング向けのサーバーサイド集計機能も併せて提供されています ( Amazon ElastiCache での集計機能のお知らせ を参照)。ElastiCache version 9.0 for Valkey では、個々のフィールドに対するきめ細かい TTL 制御を可能にするハッシュフィールドの有効期限機能や、最大 40% 向上したパイプライン化スループットも導入されています。リリースの詳細については、 Amazon ElastiCache 向け Valkey 9.0 のお知らせ をご覧ください。 この記事では、新しい検索機能を順を追って紹介し、それらがどのように連携するかを示しながら、検索およびレコメンデーションエンジンをゼロから構築していきます。 複数のアプリケーションにわたる強力なリアルタイム検索を実現 お客様からは、アプリケーションがスケールするにつれて、検索ワークフローがビジネスに求められるスループットをサポートしながら、ユーザーが期待する低レイテンシーの体験を維持する必要があるとの声が寄せられています。例えば、決済プラットフォーム、ストリーミングプラットフォーム、オンライン小売業者などは、何百万ものドキュメントを ElastiCache に保存し、マイクロ秒のレイテンシーでメタデータ属性によってデータを取得する必要があります。さらに、ワークロードが進化するにつれて、すでに ElastiCache に保存されているデータに対して新しいユースケースをサポートする豊富な検索クエリが必要だというお客様の声もあります。例えば、アプリケーションはデバイスタイプ、セッション状態、ユーザーアクティビティなどのユーザーおよびセッションコンテキストを ElastiCache に保存し、低レイテンシーの体験を提供することがよくあります。ワークロードが進化するにつれて、お客様はその同じデータをレコメンデーションシステムの基盤として活用したいと考えており、そのためにはこれらの属性をまたいだ検索が必要になります。 ElastiCache では、マイクロ秒単位の低レイテンシーと毎秒数百万クエリ (QPS) のスループットでデータを検索・取得するためのさまざまな方法が提供されるようになりました。書き込みが完了するとすぐにデータが検索可能になるため、アプリケーションは常に最新の結果をクエリできます。これらの機能は、カタログ検索、レコメンデーションエンジン、エージェント型メモリ、リアルタイムのリーダーボード、セッション検索などのユースケースを支えます。 カタログ検索: オンライン小売業者やストリーミングプラットフォームは、顧客が大規模なカタログから商品を見つけられるような検索体験を構築しています。これらのプラットフォームでは、商品名や説明文に対するテキスト検索と、ブランド、カテゴリ、価格、評価によるフィルタを単一のクエリで組み合わせることで、ファセットブラウジング体験を提供できます。プレフィックスマッチングは、ユーザーが入力するにつれて候補を読み込むタイプアヘッド検索を実現し、マイクロ秒単位で結果を返すため、即座に反応するような体験を提供します。さらに、ファジーマッチングを活用したタイプミスに強い検索を組み合わせることで、スペルミスを自動的に処理し、検索体験をより堅牢にできます。ファジーマッチングは完全一致検索よりも計算コストが高いため、ElastiCache のようなインメモリ検索エンジン上で実行することで、高速で応答性の高い体験を維持できます。 レコメンデーションエンジン: カタログが数百万アイテムに拡大するにつれて、ユーザーはデジタルプラットフォームに対して、関連性の高いコンテンツや商品を素早く表示するパーソナライズされた閲覧体験を期待しています。最新のレコメンデーションシステムは、ユーザーとアイテムをベクトル埋め込みとしてエンコードします。これらのシステムは、ベクトル検索と名前、説明、カテゴリ、在庫状況、価格帯などのフィルターを組み合わせて、数百万のアイテムからレコメンデーション候補を取得します。ハイブリッド検索は、テキスト、タグ、数値フィルターをベクトル類似度と単一のクエリで組み合わせることでこれをサポートし、取得される候補は意味的に関連性があり、ビジネス上の制約も満たします。商品ページでは、同じカテゴリと価格帯にフィルタリングしてから埋め込みの類似度でランク付けすることで、「類似アイテム」を表示できます。これを拡張して、行動履歴 (閲覧したアイテムの埋め込みの平均プーリング、アテンションベースのモデル、シーケンシャルモデルなどの手法を使用) からユーザー埋め込みを構築し、それをベクトルクエリとして渡すことで、学習した嗜好に基づいて結果をランク付けするパーソナライズされたレコメンデーションを実現できます。 エージェントメモリ: エージェントメモリは、エージェントが過去のやり取りから学習することで、会話履歴全体を再生することなく応答の関連性を向上させ、トークンコストを削減します。エージェントメモリシステムは、スコープ属性 (ユーザー、エージェント、セッション) と現在のやり取りに対する意味的関連性によってメモリを保存・取得します。ハイブリッド検索を使用することで、これらのシステムはスコープやテキストフィルターとベクトル類似性を 1 つのクエリで組み合わせます。エージェントメモリはライブの会話パス上にあるため、書き込み後すぐに読み取れる可視性が求められ、新しく保存された事実が即座に取得可能である必要があり、新しいメモリの取得と統合のために高い同時読み書き性能が求められます。ElastiCache は書き込み時にメモリを同期的にインデックス化し、マルチスレッディングを活用し、AWS 上の主要なベクトルデータベースの中で最高のスループットをマイクロ秒レベルのレイテンシーで提供します。ElastiCache と Mem0 を使用したステップバイステップの実装については、 Build persistent memory for agentic AI applications with Mem0 Open Source, ElastiCache for Valkey, and Amazon Neptune Analytics をご覧ください。 ElastiCache for Valkey は、セルフマネージドのメモリレイヤーを構築したい場合や、低レイテンシでカスタマイズ可能なインメモリストアが必要な場合に適しています。フルマネージドのアプローチをお好みの場合は、 Amazon Bedrock AgentCore Memory を使用してメモリを管理することもできます。 金融アプリケーションとリーダーボード: 取引プラットフォームやゲームアプリケーションでは、取引金額、タイムスタンプ、リスクスコア、プレイヤーランキングといった数値属性を持つドキュメントを保存し、低レイテンシーで取得する必要があります。ElastiCache の数値範囲クエリは、これらの属性に対する高速な検索をサポートし、時間枠、金額のしきい値、スコア帯によるフィルタリングを可能にします。ゲームアプリケーションでは、スコアの更新を即座に反映するリアルタイムなリーダーボードを維持でき、「自分の地域のトップ 100 プレイヤー」のような範囲クエリにも対応できます。 ユーザーおよびセッション管理: 各業界のアプリケーションは、セッション管理のためにセッション ID、デバイスタイプ、ユーザーハンドルといった構造化属性をキャッシュに保存しています。これらのアプリケーションは、ユーザーがログインするとセッションデータをキャッシュに書き込み、セッションのライフサイクルを通じて更新するため、即時に検索可能な高速書き込みが求められます。ElastiCache は更新を同期的にインデックス化するため、セッション属性に対する検索は遅延なく最新の状態を反映します。完全一致検索により、数百万のドキュメントから正確な識別子に基づいてアクティブなセッションや権限をサブミリ秒のレイテンシーで特定できます。 ElastiCache を使った検索・レコメンデーションエンジンの構築 これらの検索タイプを組み合わせて実演するため、エレクトロニクス、美容、家庭用品など何百万もの製品を販売する e コマースプラットフォーム AnyCompany 向けの検索およびレコメンデーションエンジンを構築します。AnyCompany は、買い物客がキーワードで製品を見つけ、ブランドや価格帯などのフィルターで絞り込み、類似性を通じて関連商品を発見できる検索体験を求めています。AnyCompany は 100 万を超える商品カタログを ElastiCache にハッシュベースのドキュメントとして保存しています (この例では、実際のタイトル、説明、ブランドを含む Amazon ESCI データセット から派生したもの)。次のコードは、このデータに対して 5 つのクエリパターンを構築します: 入力補完検索、全文一致、タイポに強いマッチング、フィルター付きブラウジング、そして類似商品のレコメンデーションです。 前提条件 この記事の例では、 valkey-py クライアントライブラリと Python を使用しています。手順を実行するには、以下が必要です (所要時間の目安: 30 分): AWS アカウント と AWS Command Line Interface (AWS CLI) ElastiCache レプリケーショングループを作成する権限を持つ AWS IAM ロール Amazon ElastiCache クラスターと同じ VPC 内にある Amazon EC2 インスタンス (または Amazon ElastiCache に接続可能 な任意のアプリケーション) Python 3.9 以降および valkey-py バージョン 6.1.1 以降 (pip install valkey) この記事の完全なサンプルコードは、ElastiCache samples GitHub リポジトリで入手できます。 ElastiCache for Valkey クラスターのセットアップ ElastiCache の検索用クラスターは、AWS Management Console または AWS CLI を使用して作成できます。以下の例では CLI を使用しています。検索機能は ElastiCache for Valkey バージョン 9.0 以降で利用可能です。 aws elasticache create-replication-group \ --replication-group-id AnyCompany-cache \ --replication-group-description "AnyCompany Valkey cluster" \ --engine valkey \ --engine-version 9.0 \ --transit-encryption-enabled \ --cache-node-type cache.r7g.large \ --replicas-per-node-group 0 インデックスの作成とデータのロード 商品データを検索可能にするため、 products_vec_index というインデックスを作成します。タイトルと説明は、キーワード、前方一致、あいまい検索をサポートする全文検索可能な属性としてインデックス化されます。ブランドと色は、絞り込み検索のために完全一致タグとしてインデックス化されます。価格、評価、在庫は、範囲クエリやソートのためにソート可能な数値属性としてインデックス化されます。 embedding は、セマンティック類似検索やレコメンデーションのためにベクトル属性としてインデックス化されます。 import gzip import json import struct import urllib.request import valkey from valkey.commands.search.field import TextField, TagField, NumericField, VectorField from valkey.commands.search.indexDefinition import IndexDefinition, IndexType # : Insert your ElastiCache cluster's endpoint VALKEY_HOST = "placeholder_cluster.cnxa6h.clustercfg.use1.cache.amazonaws.com" client = valkey.Valkey(host=VALKEY_HOST, port=6379, decode_responses=False, ssl=True, ssl_cert_reqs="required") # Create the search index with text, tag, numeric, and vector fields try: client.execute_command("FT.DROPINDEX", "products_vec_index") except: pass client.ft("products_vec_index").create_index( fields=[ TextField("title"), TextField("description"), TagField("brand", separator=","), TagField("color", separator=","), NumericField("price"), NumericField("rating"), NumericField("stock"), VectorField("embedding", "FLAT", { "TYPE": "FLOAT32", "DIM": 64, "DISTANCE_METRIC": "COSINE"})], definition=IndexDefinition(prefix=["pv:"], index_type=IndexType.HASH)) ElastiCache ストアに商品データセットを投入します。このデータセットは 130 万件の商品のサブセットで、タイトル、説明、ブランド、および Amazon ESCI Shopping Queries データセットから導出された事前計算済みの 64 次元エンベディングを含む 13.7 万件の商品で構成されています。サンプルリポジトリをクローンし、ロードスクリプトを実行してください： git clone https://github.com/aws-samples/amazon-elasticache-samples.git cd amazon-elasticache-samples/blogs/elasticache-valkey/fts-benchmark # <入力が必要>: VALKEY_HOST 変数をクラスターのエンドポイントで更新して実行: python load_products_blog.py タイプアヘッド検索 (先行入力検索) インデックスとデータが準備できたら、AnyCompany はインデックスに対して実行され、一致するドキュメントを返す FT.SEARCH クエリを使って検索エンジンを構築できます。ユーザーが検索バーに入力すると、アプリケーションはプレフィックスクエリを送信し、リアルタイムで候補を表示します。 from valkey.commands.search.query import Query results = client.ft("products_vec_index").search( Query("wire*").return_fields("title").paging(0, 5)) # User has typed "wire" - prefix match shows suggestions # Output: # [{'title': 'xyz Kids Wireless Headphones'}, # ... # ... # {'title': 'Santas Wire Christmas Lighting Storage Bag'}] フレーズマッチング ユーザーが Enter キーを押すと、アプリケーションはタイトルと説明に対して全文検索を実行します。SLOP は、単語同士がどれだけ離れていても一致と見なすかを制御し、単語がより近接している結果ほど上位にランク付けされます。 # User submits "wireless headphones" # SLOP 2 allows up to 2 words between terms results = client.ft("products_vec_index").search( Query("wireless headphones") .slop(2) .return_fields("title", "brand", "price").paging(0, 5)) # Output: # [{'title': 'xyz Studio3 Wireless Headphones - Gray (Renewed)', # 'brand': 'xyz', 'price': '1928.28'}, # ... # {'title': 'xyz TUNE 220TWS - True Wireless in-Ear Headphone - Blue', # 'brand': 'xyz', 'price': '1121.23'}] タイプミスを許容するマッチング クエリが結果を返さない場合、アプリケーションはタイプミスを修正するためにあいまい一致 (fuzzy matching) で再試行します。あいまい一致は編集距離を計算するためコストが高いので、デフォルトとしてではなくフォールバックとして使うのが最適です。 # Retry with fuzzy matching for "wireles headphoens" results = client.ft("products_vec_index").search( Query("%wireles% %headphoens%") .return_fields("title", "brand", "price").paging(0, 5)) # Output: # [{'title': 'xyz Comfort 35 Wireless Headphones, Noise Cancelling - Silver (Renewed)', # 'brand': 'xyz', 'price': '1811.75'}, # ... # ... # {'title': 'xyz SoundSport Wireless Headphones, Black + Charging Case', # 'brand': 'xyz', 'price': '568.47'}] フィルタリングによる閲覧 買い物客が商品を検索してフィルターを適用すると、アプリケーションはテキスト検索とタグおよび数値フィルターを単一のクエリで組み合わせます。 # ユーザーが「headphones」を検索し、価格 $50-$150、評価 4.0 以上でフィルタリング results = client.ft("products_vec_index").search( Query("@title:headphones @price:[50 150] @rating:[4.0 5.0]") .return_fields("title", "brand", "price", "rating") .paging(0, 5)) # 出力: # [{'title': 'xyz WH1000XM3 Bluetooth Wireless Noise Canceling Headphones', # 'brand': 'xyz', 'price': '102.29', 'rating': '4.8'}, # ... # ... # {'title': 'Bluetooth Earbuds xyz SoundLink .. in Ear Headphones', # 'brand': 'xyz', 'price': '125.45', 'rating': '4.5'}] 類似商品のレコメンデーション 「類似商品」のレコメンデーションを実現するために、AnyCompany はテキストフィルターを使ったハイブリッド検索で結果を該当する商品タイプに絞り込み、ベクトル検索で表示中の商品との類似度に基づいてフィルター済みの結果をランク付けしています。 # Get the embedding of the product the user is currently viewing # for example - "Kids Headphones with Microphone 2 Pack" product_embedding = client.hget("pv:B0825SSTMN", "embedding") # Hybrid: text pre-filter "headphones" + vector KNN for similarity ranking results = client.ft("products_vec_index").search( Query("@title:headphones =>[KNN 5 @embedding $vec AS score]") .return_fields("title", "brand", "price", "score") .dialect(2), query_params={"vec": product_embedding}) # Output: # {'title': 'xyz I35 Kid Headphones with Microphone Volume Limited ...', # 'brand': 'xyz', 'price': '155.06', 'score': '0.293'}, # ... # ... # {'title': 'Kids Headphones with Pouch, xyz Wired ...', # 'brand': 'xyz', 'price': '957.95', 'score': '0.351'}] このパターンを拡張して、埋め込みベースの検索を活用したパーソナライゼーションを実現できます。閲覧したアイテム埋め込みの平均プーリング、アテンションベースのモデル、シーケンスモデルなどの手法を用いて、買い物客のインタラクション履歴からユーザー埋め込みを構築します。単一の商品埋め込みの代わりにユーザー埋め込みをベクトルクエリとして渡すことで、KNN スコアリングがフィルタリングされた集合の中から、買い物客の学習済みの嗜好に基づいて結果をランキングします。 内部の仕組みとパフォーマンス レイテンシーとスループットを、テキストと数値のクエリタイプについて、レプリカなしの単一の cache.r7g.2xlarge ノードを含む 1 シャード構成の ElastiCache for Valkey クラスター上で計測しました。データセットには約 1 GB のデータが含まれており、上記の例で説明したテキスト、タグ、数値、ベクトル属性を持つ 130 万件の製品ドキュメントで構成されています。レイテンシーとスループットの計測には valkey-benchmark を使用しました。 クエリタイプ P50 (ms) 1 クライアント P99 (ms) 1 クライアント QPS 300 クライアント テキスト検索 (完全一致) 0.135 0.255 60,000 前方一致 (タイプアヘッド検索) 0.135 0.279 57,692 数値範囲 (在庫/評価でのフィルタ) 0.175 0.199 24,087 ハイブリッドクエリ – テキスト + 数値範囲 (ファセットブラウジング) 0.135 0.295 52,632 ベクトル検索のレイテンシーとスループットのベンチマークについては、 Announcing vector search for Amazon ElastiCache を参照してください。上記の例では、単一の cache.r7g.2xlarge ノードでのパフォーマンスをテストしています。レプリカ (シャードあたり最大 5 つ) とシャードを追加することで読み取りスループットをスケールし、数百万 QPS に到達できます。各レプリカは独自のインデックスを持ち、独立して検索を処理できますが、レプリカからの読み取りは結果整合性となります。データ容量よりも低レイテンシーを優先する場合は、 single-slot indexes を使用して、インデックス化されたすべてのデータを 1 つのシャードに保持し、ファンアウトのオーバーヘッドを完全に回避してください。シャードを追加することで、クライアントコードを変更せずにメモリ容量を増やすことができます。 ElastiCache はデータの変更をリアルタイムで自動的にインデックス化し、エンジンは各書き込みを確認応答する前にインデックス化します。そのため、それ以降の検索では更新後のデータが返され、read-after-write 整合性が提供されます。この整合性の動作は、マルチキートランザクションや Lua スクリプトでも同様に保たれます。Valkey はマルチスレッドを活用してインデックス処理を複数のスレッドにまたがって実行するため、ElastiCache は書き込みスループットの高いワークロードにおいても検索クエリで高いパフォーマンスを発揮できます。 クリーンアップ このウォークスルーのために ElastiCache クラスターを作成し、不要になった場合は、今後の料金が発生しないように、次の AWS CLI コマンドを使用してクラスターを削除してください。 aws elasticache delete-replication-group --replication-group-id AnyCompany-cache まとめ 本投稿では、ElastiCache における全文検索、完全一致検索、数値範囲検索、およびハイブリッド検索について解説しました。これらの検索タイプのユースケースを取り上げ、検索およびレコメンデーションシステムの構築方法をご紹介しました。全文検索、完全一致検索、数値範囲検索、およびハイブリッド検索は、Valkey 9.0 を実行する ElastiCache のノードベースクラスターにおいて、すべての AWS 商用リージョン、AWS GovCloud (US) リージョン、および中国リージョンで追加費用なしでご利用いただけます。Valkey は、最も制約の少ないオープンソースかつベンダーニュートラルな Redis に代わる選択肢であり、ElastiCache における推奨エンジンです。始めるには、AWS Management Console、AWS SDK、または AWS CLI を使用して、新しい Valkey 9.0 以降のクラスターを作成するか、 既存のクラスターをアップグレード してください。詳細については、 ElastiCache のドキュメント をご覧ください。ご質問やフィードバックは、 AWS re:Post for ElastiCache までお寄せください。 著者について Chaitanya Nuthalapati Chaitanya は AWS インメモリデータベースサービスのシニアテクニカルプロダクトマネージャーで、Amazon ElastiCache for Valkey を担当しています。以前は、生成 AI、機械学習、グラフネットワークを活用したソリューションを構築していました。仕事以外の時間では、Chaitanya は趣味を集めることに忙しく、現在はテニス、スケートボード、パドルボードを楽しんでいます。 Karthik Subbarao Karthik は Amazon ElastiCache のシニアソフトウェアエンジニアで、オープンソースの Valkey プロジェクトに積極的に貢献しています。分散システム、データベース、Rust、そして全般的にソフトウェア開発・技術を通じたイノベーションに情熱を持っています。 Ian Childress Ian は AWS のソフトウェア開発マネージャーで、全文検索インフラストラクチャを含む Valkey モジュールおよび統合機能を構築するチームを率いています。仕事以外では、Ian はホッケーをプレイし、Go 言語で高性能システムを書くことに没頭する飽くなき探求者です。夏になると、氷から湖へと舞台を移し、毎週末家族とウェイクサーフィンを楽しんでいます。 Eran Balan Eran は AWS のスペシャリストソリューションアーキテクトで、インメモリデータベースおよび Amazon ElastiCache を専門としています。EMEA 地域のお客様と協力し、キャッシングアーキテクチャの設計、パフォーマンスの最適化、Redis OSS から Valkey への移行など、さまざまな移行を支援しています。仕事以外では、Eran はミュージカルや演劇の観劇、ハイキング、オープンウォータースイミングを楽しんでいます。 プロジェクト全体を通じて、ビジョン、指導、そして実践的な貢献をいただいた Allen Samuels 氏に心より感謝申し上げます。 本記事は、 Full-text, exact-match, range, and hybrid search on Amazon ElastiCache を翻訳したものです。翻訳は Solutions Architect の Hayato Tsutsumi が担当しました。

Google Workspace MCPサーバーの概要 そもそもMCPとは何？ MCPとは、Model Context Protocol（モデル・コンテキスト・プロトコル）の略です。 端的に説明すると、AIエージェントやAIアプリが、外部のデータやツールに安全・標準的につながるための共通規格です。公式ドキュメントでは、AIアプリと外部システムを接続するためのオープンソース標準と説明されています。

こんにちは、モバファクエンジニアの id:knj-mf です。 今回は TypeScript の型レベルプログラミングでちょっと面白いものを作ったので紹介したいと思います。 何を作ったの？ TypeScript の型レベルプログラミングは、予想に反して様々なものが実装できてしまうことで有名だったりします。 type-challenges のように、「これは普通のプログラミングで実装するものでは？」と思ってしまうようなものまで実装できてしまいます。そこで、作ってみたものが下記になります。 早速、動作を紹介します。このような Brainf**k プログラムの文字列型が… このように、型計算上で解釈されてしまう！というものです。 ある程度の形になるものはできたので、この記事では、型レベルプログラミングと書き味の近い (個人差があります) Haskell 実装と照らしながら、どのように考えてこの「型」を実装していったのかを紹介します。 cwd-k2/bf-in-type のリポジトリ に実装があるので、気になる方は手元で動作や実装を見てみてください。 Brainf**k？ たった 8 つの命令からなる難読プログラミング言語です。言語の仕様としてかなり単純明快ではありますが、チューリング完全として知られています。(ちょっと企業の公式ブログには載せづらい表記を含むので、今回は ** という風に伏せさせていただきます…) 要素として、次の 4 つのものを持ちます。 要素 内容 プログラムテープ 実行するプログラム列 メモリテープ 値を記録するセルの列 プログラムポインタ 現在参照しているプログラム命令列上の位置 メモリポインタ 現在参照しているメモリテープの位置 8 つの命令は次のような単純なものです。 命令 内容 > メモリポインタをインクリメント（次のセルへ） < メモリポインタをデクリメント（前のセルへ） + 現在セルの値をインクリメント - 現在セルの値をデクリメント . 現在セルの値を ASCII 文字として出力 , 1 バイト読み込み、現在セルへ格納 [ 現在セルが 0 なら、対応する ] の直後へジャンプ ] 現在セルが 0 でなければ、対応する [ の直後へジャンプ ざっくり、プログラムテープ上に記載された 8 つの命令の列を順次実行しながらメモリテープの値を書き換えつつ、適宜 I/O していく形のプログラミング言語になります。 実際の Brainf**k プログラムそのものはまったく実用性がないのですが、この簡単な命令セットからなる言語処理系の実装には教育的価値があります。結構書いてみたことがあるというエンジニアの方も多いのではないでしょうか。 TypeScript の型レベルプログラミング ところで、TypeScript には (TypeScript に限りませんが) 型レベルプログラミングがあります。本当に単純な例だと、下記のようなものです。 type ExtendsObject < T > = T extends object ? true : false これが何をしているのかというと、型チェックの際に実施される型計算を実装しているということです。上記のような条件分岐などのロジックが型レベルで解決されてしまうということですね。 この型レベルプログラミングなのですが、表現力はさておき、チューリング完全な系になってしまっているとのもっぱらの評判です。 型から型を新たに計算できてしまうということは… 楽しいプログラミングの時間の始まりですね。 実装方針 長くなってしまうので、以降では Brainf**k を BF と記載することにします。 BF 処理系を型レベルに落とし込むにあたって、次の 4 つの要素に分けて考えます。 テープ構造体 ( Tape ) — メモリ・プログラムを共通して表現するデータ構造 現在位置を持ちつつ、前後に移動する能力を持つ 評価器 ( Runner ) — メモリテープとプログラムテープを束ねた実行状態 メモリを変化させつつプログラムポインタを移動するため、同時に扱う アクション ( Action ) — 1 ステップ実行の結果として外界に要求する効果 (なにもしない / 入力 / 出力 / 終了) 評価ループ ( Exec ) — アクションを解釈して評価器を回し、入力を消費しつつ出力を蓄積するメインループ 型レベルプログラミングでは副作用を素直に書けないため、入出力を「アクション型」としてデータに落としておき、外側のループでそれを解釈する形にしたのがポイントです。以降、この順で各要素の実装を見ていきます。 また、適宜参考実装として Haskell の実装も合わせて示しています。 TypeScript 実装は v5.4 以降で動作確認しています。 実装上の制約 制約として、実装レベルに効いてくるものもあります。数値での演算や数値⇔文字の変換が基本的にできない、というものです。不可能ではないですが、タプル (型レベル配列) の length を取るような実装になりがちなのでまわりくどくなります。 今回は ASCII 範囲でインクリメント・デクリメントを考えるだけなので、気合いで誤魔化すことができます。 NumToCharMap[65] のように参照すると 'A' という型に解決される、というマップを定義しました。 数値文字変換、インクリメント・デクリメントマップの実装 export type NumToCharMap = [ '\x00' , '\x01' , '\x02' , '\x03' , '\x04' , '\x05' , '\x06' , '\x07' , '\x08' , '\x09' , '\x0A' , '\x0B' , '\x0C' , '\x0D' , '\x0E' , '\x0F' , '\x10' , '\x11' , '\x12' , '\x13' , '\x14' , '\x15' , '\x16' , '\x17' , '\x18' , '\x19' , '\x1A' , '\x1B' , '\x1C' , '\x1D' , '\x1E' , '\x1F' , '\x20' , '\x21' , '\x22' , '\x23' , '\x24' , '\x25' , '\x26' , '\x27' , '\x28' , '\x29' , '\x2A' , '\x2B' , '\x2C' , '\x2D' , '\x2E' , '\x2F' , '\x30' , '\x31' , '\x32' , '\x33' , '\x34' , '\x35' , '\x36' , '\x37' , '\x38' , '\x39' , '\x3A' , '\x3B' , '\x3C' , '\x3D' , '\x3E' , '\x3F' , '\x40' , '\x41' , '\x42' , '\x43' , '\x44' , '\x45' , '\x46' , '\x47' , '\x48' , '\x49' , '\x4A' , '\x4B' , '\x4C' , '\x4D' , '\x4E' , '\x4F' , '\x50' , '\x51' , '\x52' , '\x53' , '\x54' , '\x55' , '\x56' , '\x57' , '\x58' , '\x59' , '\x5A' , '\x5B' , '\x5C' , '\x5D' , '\x5E' , '\x5F' , '\x60' , '\x61' , '\x62' , '\x63' , '\x64' , '\x65' , '\x66' , '\x67' , '\x68' , '\x69' , '\x6A' , '\x6B' , '\x6C' , '\x6D' , '\x6E' , '\x6F' , '\x70' , '\x71' , '\x72' , '\x73' , '\x74' , '\x75' , '\x76' , '\x77' , '\x78' , '\x79' , '\x7A' , '\x7B' , '\x7C' , '\x7D' , '\x7E' , '\x7F' , ] & { [ i: number ] : ' \x00 ' } ; export type CharToNumMap = { '\x00' : 0 x00 , '\x01' : 0 x01 , '\x02' : 0 x02 , '\x03' : 0 x03 , '\x04' : 0 x04 , '\x05' : 0 x05 , '\x06' : 0 x06 , '\x07' : 0 x07 , '\x08' : 0 x08 , '\x09' : 0 x09 , '\x0A' : 0 x0A , '\x0B' : 0 x0B , '\x0C' : 0 x0C , '\x0D' : 0 x0D , '\x0E' : 0 x0E , '\x0F' : 0 x0F , '\x10' : 0 x10 , '\x11' : 0 x11 , '\x12' : 0 x12 , '\x13' : 0 x13 , '\x14' : 0 x14 , '\x15' : 0 x15 , '\x16' : 0 x16 , '\x17' : 0 x17 , '\x18' : 0 x18 , '\x19' : 0 x19 , '\x1A' : 0 x1A , '\x1B' : 0 x1B , '\x1C' : 0 x1C , '\x1D' : 0 x1D , '\x1E' : 0 x1E , '\x1F' : 0 x1F , '\x20' : 0 x20 , '\x21' : 0 x21 , '\x22' : 0 x22 , '\x23' : 0 x23 , '\x24' : 0 x24 , '\x25' : 0 x25 , '\x26' : 0 x26 , '\x27' : 0 x27 , '\x28' : 0 x28 , '\x29' : 0 x29 , '\x2A' : 0 x2A , '\x2B' : 0 x2B , '\x2C' : 0 x2C , '\x2D' : 0 x2D , '\x2E' : 0 x2E , '\x2F' : 0 x2F , '\x30' : 0 x30 , '\x31' : 0 x31 , '\x32' : 0 x32 , '\x33' : 0 x33 , '\x34' : 0 x34 , '\x35' : 0 x35 , '\x36' : 0 x36 , '\x37' : 0 x37 , '\x38' : 0 x38 , '\x39' : 0 x39 , '\x3A' : 0 x3A , '\x3B' : 0 x3B , '\x3C' : 0 x3C , '\x3D' : 0 x3D , '\x3E' : 0 x3E , '\x3F' : 0 x3F , '\x40' : 0 x40 , '\x41' : 0 x41 , '\x42' : 0 x42 , '\x43' : 0 x43 , '\x44' : 0 x44 , '\x45' : 0 x45 , '\x46' : 0 x46 , '\x47' : 0 x47 , '\x48' : 0 x48 , '\x49' : 0 x49 , '\x4A' : 0 x4A , '\x4B' : 0 x4B , '\x4C' : 0 x4C , '\x4D' : 0 x4D , '\x4E' : 0 x4E , '\x4F' : 0 x4F , '\x50' : 0 x50 , '\x51' : 0 x51 , '\x52' : 0 x52 , '\x53' : 0 x53 , '\x54' : 0 x54 , '\x55' : 0 x55 , '\x56' : 0 x56 , '\x57' : 0 x57 , '\x58' : 0 x58 , '\x59' : 0 x59 , '\x5A' : 0 x5A , '\x5B' : 0 x5B , '\x5C' : 0 x5C , '\x5D' : 0 x5D , '\x5E' : 0 x5E , '\x5F' : 0 x5F , '\x60' : 0 x60 , '\x61' : 0 x61 , '\x62' : 0 x62 , '\x63' : 0 x63 , '\x64' : 0 x64 , '\x65' : 0 x65 , '\x66' : 0 x66 , '\x67' : 0 x67 , '\x68' : 0 x68 , '\x69' : 0 x69 , '\x6A' : 0 x6A , '\x6B' : 0 x6B , '\x6C' : 0 x6C , '\x6D' : 0 x6D , '\x6E' : 0 x6E , '\x6F' : 0 x6F , '\x70' : 0 x70 , '\x71' : 0 x71 , '\x72' : 0 x72 , '\x73' : 0 x73 , '\x74' : 0 x74 , '\x75' : 0 x75 , '\x76' : 0 x76 , '\x77' : 0 x77 , '\x78' : 0 x78 , '\x79' : 0 x79 , '\x7A' : 0 x7A , '\x7B' : 0 x7B , '\x7C' : 0 x7C , '\x7D' : 0 x7D , '\x7E' : 0 x7E , '\x7F' : 0 x7F , } & { [ k : string ]: 0 x00 ; } ; export type DecrementMap = [ 0 x7F , 0 x00 , 0 x01 , 0 x02 , 0 x03 , 0 x04 , 0 x05 , 0 x06 , 0 x07 , 0 x08 , 0 x09 , 0 x0A , 0 x0B , 0 x0C , 0 x0D , 0 x0E , 0 x0F , 0 x10 , 0 x11 , 0 x12 , 0 x13 , 0 x14 , 0 x15 , 0 x16 , 0 x17 , 0 x18 , 0 x19 , 0 x1A , 0 x1B , 0 x1C , 0 x1D , 0 x1E , 0 x1F , 0 x20 , 0 x21 , 0 x22 , 0 x23 , 0 x24 , 0 x25 , 0 x26 , 0 x27 , 0 x28 , 0 x29 , 0 x2A , 0 x2B , 0 x2C , 0 x2D , 0 x2E , 0 x2F , 0 x30 , 0 x31 , 0 x32 , 0 x33 , 0 x34 , 0 x35 , 0 x36 , 0 x37 , 0 x38 , 0 x39 , 0 x3A , 0 x3B , 0 x3C , 0 x3D , 0 x3E , 0 x3F , 0 x40 , 0 x41 , 0 x42 , 0 x43 , 0 x44 , 0 x45 , 0 x46 , 0 x47 , 0 x48 , 0 x49 , 0 x4A , 0 x4B , 0 x4C , 0 x4D , 0 x4E , 0 x4F , 0 x50 , 0 x51 , 0 x52 , 0 x53 , 0 x54 , 0 x55 , 0 x56 , 0 x57 , 0 x58 , 0 x59 , 0 x5A , 0 x5B , 0 x5C , 0 x5D , 0 x5E , 0 x5F , 0 x60 , 0 x61 , 0 x62 , 0 x63 , 0 x64 , 0 x65 , 0 x66 , 0 x67 , 0 x68 , 0 x69 , 0 x6A , 0 x6B , 0 x6C , 0 x6D , 0 x6E , 0 x6F , 0 x70 , 0 x71 , 0 x72 , 0 x73 , 0 x74 , 0 x75 , 0 x76 , 0 x77 , 0 x78 , 0 x79 , 0 x7A , 0 x7B , 0 x7C , 0 x7D , 0 x7E , ] & { [ i: number ] : 0x7F ; } ; export type IncrementMap = [ 0 x01 , 0 x02 , 0 x03 , 0 x04 , 0 x05 , 0 x06 , 0 x07 , 0 x08 , 0 x09 , 0 x0A , 0 x0B , 0 x0C , 0 x0D , 0 x0E , 0 x0F , 0 x10 , 0 x11 , 0 x12 , 0 x13 , 0 x14 , 0 x15 , 0 x16 , 0 x17 , 0 x18 , 0 x19 , 0 x1A , 0 x1B , 0 x1C , 0 x1D , 0 x1E , 0 x1F , 0 x20 , 0 x21 , 0 x22 , 0 x23 , 0 x24 , 0 x25 , 0 x26 , 0 x27 , 0 x28 , 0 x29 , 0 x2A , 0 x2B , 0 x2C , 0 x2D , 0 x2E , 0 x2F , 0 x30 , 0 x31 , 0 x32 , 0 x33 , 0 x34 , 0 x35 , 0 x36 , 0 x37 , 0 x38 , 0 x39 , 0 x3A , 0 x3B , 0 x3C , 0 x3D , 0 x3E , 0 x3F , 0 x40 , 0 x41 , 0 x42 , 0 x43 , 0 x44 , 0 x45 , 0 x46 , 0 x47 , 0 x48 , 0 x49 , 0 x4A , 0 x4B , 0 x4C , 0 x4D , 0 x4E , 0 x4F , 0 x50 , 0 x51 , 0 x52 , 0 x53 , 0 x54 , 0 x55 , 0 x56 , 0 x57 , 0 x58 , 0 x59 , 0 x5A , 0 x5B , 0 x5C , 0 x5D , 0 x5E , 0 x5F , 0 x60 , 0 x61 , 0 x62 , 0 x63 , 0 x64 , 0 x65 , 0 x66 , 0 x67 , 0 x68 , 0 x69 , 0 x6A , 0 x6B , 0 x6C , 0 x6D , 0 x6E , 0 x6F , 0 x70 , 0 x71 , 0 x72 , 0 x73 , 0 x74 , 0 x75 , 0 x76 , 0 x77 , 0 x78 , 0 x79 , 0 x7A , 0 x7B , 0 x7C , 0 x7D , 0 x7E , 0 x7F , 0 x00 , ] & { [ i: number ] : 0x00 ; } ; テープ構造体 BF では、メモリを用意してポインタ操作・ポインタを介した操作が前提になっています。 もちろん型レベルプログラミングで副作用は記述しにくいため、ポインタ前提となっている部分を再考し、同じ表現力の別の形に置き換える必要があります。 メモリ、プログラムを同じテープ構造で捉えます。今着目している値、その左右に列が続いている様子を考えたのが下記のような構造になります。 テープ構造体の実装 このような構造体は、Haskell での data 宣言と同じような形で、TypeScript の型ではオブジェクト型による宣言ができます。 data Tape a = Tape { prevs :: [a] , curr :: a , nexts :: [a] } extends unknown[] によって単なる配列型ではなく、各要素が独立した 型レベル配列としてのタプル を利用できます。 export type Tape < Hs extends unknown [], C , Ts extends unknown []> = { h : Hs c : C t : Ts } ここでいくつかの基本的な操作も定義してしまいましょう。 現在の値に対する操作 インクリメント・デクリメント 読み出し、書き込み テープ上の移動 着目するヘッドを左右に移動する操作 対応する [ , ] へのジャンプは繰り返しによって実現する 基本操作の実装 Tape a から新しい Tape a を作る ( Tape a -> Tape a ) という形の実装となります。 -- | 次の要素に移動 next :: Tape a -> Tape a next (Tape prevs curr (n : nexts)) = Tape (curr : prevs) n nexts -- | 前の要素に移動 prev :: Tape a -> Tape a prev (Tape (p : prevs) curr nexts) = Tape prevs p (curr : nexts) -- | 現在の要素をインクリメント incr :: Enum a => Tape a -> Tape a incr (Tape prevs curr nexts) = Tape prevs (succ curr) nexts -- | 現在の要素をデクリメント decr :: Enum a => Tape a -> Tape a decr (Tape prevs curr nexts) = Tape prevs (pred curr) nexts -- | 現在の要素を取得 get :: Tape a -> a get (Tape _ curr _) = curr -- | 現在の要素を設定 put :: a -> Tape a -> Tape a put a (Tape prevs _ nexts) = Tape prevs a nexts TypeScript の型でも同様に、 Tape を受け取って新しい Tape を作成するという方針で実装できます。 [infer H, ...infer Hs] のパターンマッチングにより、型レベル配列の要素 (head, rest) を扱うことができてしまいます。 export type Prev < M > = M extends Tape < [infer H , ... infer Hs] , infer C , infer Ts > ? Tape< Hs , H , [C , ... Ts] > : never export type Next < M > = M extends Tape < infer Hs , infer C , [infer T , ... infer Ts] > ? Tape< [C , ... Hs] , T , Ts > : never export type Incr < M > = M extends Tape < infer Hs , infer C extends number , infer Ts > ? Tape< Hs , IncrementMap [C], Ts > : never export type Decr < M > = M extends Tape < infer Hs , infer C extends number , infer Ts > ? Tape< Hs , DecrementMap [C], Ts > : never export type PutC < M , C > = M extends Tape < infer Hs , unknown , infer Ts > ? Tape < Hs , C , Ts > : never プログラム実行 基本的な構造、操作は定義してしまったので、次はインタプリタとして重要な実行について考えます。 評価器としての実行系内部 (メモリ・プログラムポインタ) と外界とのやりとりを含む効果の管理の部分を、次のような形で切り分けます。 型レベルプログラミングでは入出力をそのまま扱うことはできないので、入力待ちや出力があるということは特別な状態として表現することにします。 評価器の内部状態 こちらは至ってシンプルです。 状態はメモリ、プログラムのテープ (現在位置を保持する) から成る これを評価に通すことによって、次の実行に関する状態が出てくる data Machine = Machine { memory :: DT.Tape Int , program :: DT.Tape Char } type Runner < M , P > = { mem : M prg : P } 外部とのやりとりを含むアクション 今のメモリ・プログラムを含む、先程の構造を評価して得られるアクションです。 -- | 何もしない、入力要求、出力要求、終了の 4 つのアクションを持つ data WithAction a = ActionN { hold :: a } -- ^ 外部には何もしない | ActionI { hold :: a } -- ^ 入力要求 | ActionO { hold :: a, out :: Int } -- ^ 出力要求 | ActionE -- ^ 終了 これを型レベルプログラミングで再現すると、ADT よりは個別の型として定義してあげて、後で extends などの条件分岐してあげる方が素直になります。 type ActionN < R > = { action : "N" ; runner : R } type ActionI < R > = { action : "I" ; runner : R } type ActionO < R , O > = { action : "O" ; runner : R ; output : O } type ActionE = { action : "E" } 8 つの命令に対する操作の整理 評価器の状態とアクションを型として定義できたので、次はプログラムの示す命令を処理していく実装も考えていきます。 これは最初に確認した BF の 8 つの命令に対して、次の評価器の状態と計算の効果を含む全体を返す形で定義していけば良いです。 インクリメント デクリメント 次を参照 (ポインタインクリメント) 前を参照 (ポインタデクリメント) while (ジャンプ) while end (ジャンプバック) getchar putchar 命令→次の状態・アクション さて、図で整理できたので、実装にそのまま落としていきます。 現在の命令ポインタが指す命令に応じて、次の Action と状態を返します。 -- | 次のステップを実行し、状態とアクションを返す step :: Machine -> WithAction Machine step machine = case pc of '+' -> ActionN $ machine { memory = DT.incr (memory machine), program = DT.next (program machine) } '-' -> ActionN $ machine { memory = DT.decr (memory machine), program = DT.next (program machine) } '>' -> ActionN $ machine { memory = DT.next (memory machine), program = DT.next (program machine) } '<' -> ActionN $ machine { memory = DT.prev (memory machine), program = DT.next (program machine) } '[' -> ActionN $ machine { program = if mc == 0 then skip (program machine) else DT.next (program machine) } ']' -> ActionN $ machine { program = if mc /= 0 then back (program machine) else DT.next (program machine) } ',' -> ActionI { hold = machine { program = DT.next (program machine) } } '.' -> ActionO { hold = machine { program = DT.next (program machine) }, out = DT.get (memory machine) } _ -> ActionE where (pc, mc) = (,) <$> DT.get . program <*> DT.get . memory $ machine TypeScript で書いても、ほとんど同じ対応があります。 type Step < R > = R extends Runner < infer M extends TapeMm , infer P extends TapePg > ? P[ 'c' ] extends '+' ? ActionN< Runner < Incr < M >, Next < P >>> : P[ 'c' ] extends '-' ? ActionN< Runner < Decr < M >, Next < P >>> : P[ 'c' ] extends '>' ? ActionN< Runner < Next < M >, Next < P >>> : P[ 'c' ] extends '<' ? ActionN< Runner < Prev < M >, Next < P >>> : P[ 'c' ] extends '[' ? ActionN< Runner < M , M [ 'c' ] extends 0 ? Skip < P > : Next < P >>> : P[ 'c' ] extends ']' ? ActionN< Runner < M , M [ 'c' ] extends 0 ? Next < P > : Back < P >>> : P[ 'c' ] extends ',' ? ActionI< Runner < M , Next < P >>> : P[ 'c' ] extends '.' ? ActionO< Runner < M , Next < P >>, M [ 'c' ]> : ActionE : never; 状態・アクション→継続 次は状態、アクションを受けて、次のステップに継続していくループを実装していきます。 上記の step を実行し、その Action に応じた操作を実行していきます。 -- | 入力を消費・出力を収集しながら step を繰り返す loop :: (Machine -> WithAction Machine) -> (String, Machine) -> String loop step (input, machine) = go (step machine) where -- アクションに対応した動作を実行し、再帰に進む go (ActionN machine') = loop step (input, machine') -- そのまま次へ go (ActionI machine') = loop step (iTail, machine'') where -- 入力を消費してメモリに書き込み、次に進む (iHead : iTail) = input machine'' = machine' { memory = DT.put (fromEnum iHead) (memory machine') } go (ActionO machine' out) = toEnum out : loop step (input, machine') -- 出力を収集し、次に進む go ActionE = [] -- 終端 TypeScript の型の方では、今回は文字列の累積を保持する形で実装しています。ちょっと命名が異なってしまっていますが、やっていることは同じです。 type Exec < R , I extends string , O extends string = '' > = Step < R > extends infer WithAction ? WithAction extends ActionN< infer Q > ? Exec< Q , I , O > : WithAction extends ActionI< infer Q > ? I extends ` ${ infer F }${ infer S } ` ? Exec< Read < Q , CharToNumMap [F]>, S , O > : Exec< Read < Q , 0>, I , O > : WithAction extends ActionO< infer Q , infer N extends number > ? Exec< Q , I , ` ${ O }${ NumToCharMap [N] } ` > : WithAction extends ActionE ? O : never : never; まとめ TypeScript で Brainf**k 処理系の型レベルプログラムの実装について見ていきました。 補足として、TypeScript の型レベルプログラミング実行系には次のような制約があります。 型の再帰評価回数、つまり実行できるステップ数が制限されている Tape 構造体の保持する要素列の長さに制限がある (どちらも大体 1,000 程度のイメージ) 一方、このような制限がある中でも、冒頭に示した例のように簡単な Hello World の例までは実装できてしまいます。 みなさんもぜひ自分の型レベルプログラミングに挑戦してみてください。 私が今回示した実装も最善ではないと思います。「もっと良いものを書いてみよう」など、楽しんでみてください。 付録 Haskell のコード全文を掲載しておきます。 cwd-k2/bf-in-type のリポジトリ と比較する、または手元でテスト実行するなどしてください。 ディレクトリ構成 . ├── Data │   └── Tape.hs ├── Interpreter.hs └── Main.hs Data/Tape.hs module Data.Tape ( Tape( .. ), zeros, fromList, next, prev, incr, decr, get, put, ) where -- | テープ様構造体 -- * 前後に無限に要素があり、現在要素 (針の先にあるもの) を中心に配置している -- -- > <-prev- ... 4 5 6 <<7>> 8 9 10 ... -next-> data Tape a = Tape { prevs :: [a] , curr :: a , nexts :: [a] } deriving Show -- | ゼロ初期化された無限長のテープ zeros :: Enum a => Tape a zeros = Tape (repeat $ toEnum 0 ) (toEnum 0 ) (repeat $ toEnum 0 ) -- | リストからテープを作成 fromList :: [a] -> Tape a fromList (x : xs) = Tape [] x xs fromList [] = undefined -- 今回は特に考えずに未定義とする -- | 次の要素に移動 next :: Tape a -> Tape a next (Tape prevs curr (n : nexts)) = Tape (curr : prevs) n nexts -- | 前の要素に移動 prev :: Tape a -> Tape a prev (Tape (p : prevs) curr nexts) = Tape prevs p (curr : nexts) -- | 現在の要素をインクリメント incr :: Enum a => Tape a -> Tape a incr (Tape prevs curr nexts) = Tape prevs (succ curr) nexts -- | 現在の要素をデクリメント decr :: Enum a => Tape a -> Tape a decr (Tape prevs curr nexts) = Tape prevs (pred curr) nexts -- | 現在の要素を取得 get :: Tape a -> a get (Tape _ curr _) = curr -- | 現在の要素を設定 put :: a -> Tape a -> Tape a put a (Tape prevs _ nexts) = Tape prevs a nexts Interpreter.hs module Interpreter ( bf ) where import qualified Data.Tape as DT import Data.List (unfoldr) -- | メモリとプログラムを持つ data Machine = Machine { memory :: DT.Tape Int , program :: DT.Tape Char } deriving Show -- | 何もしない、入力要求、出力要求、終了の 4 つのアクションを持つ data WithAction a = ActionN { hold :: a } -- ^ 外部には何もしない | ActionI { hold :: a } -- ^ 入力要求 | ActionO { hold :: a, out :: Int } -- ^ 出力要求 | ActionE -- ^ 終了 deriving Show -- | 対応する @']'@ までプログラムをスキップする skip :: DT.Tape Char -> DT.Tape Char skip = skipInner 0 where skipInner n program = let program' = DT.next program in case DT.get program' of '[' -> skipInner (n + 1 ) program' ']' -> if n == 0 then program' else skipInner (n - 1 ) program' _ -> skipInner n program' -- | 対応する @'['@ までプログラムを戻す back :: DT.Tape Char -> DT.Tape Char back = backInner 0 where backInner n program = let program' = DT.prev program in case DT.get program' of ']' -> backInner (n + 1 ) program' '[' -> if n == 0 then program' else backInner (n - 1 ) program' _ -> backInner n program' -- | 次のステップを実行し、状態とアクションを返す step :: Machine -> WithAction Machine step machine = case pc of '+' -> ActionN $ machine { memory = DT.incr (memory machine), program = DT.next (program machine) } '-' -> ActionN $ machine { memory = DT.decr (memory machine), program = DT.next (program machine) } '>' -> ActionN $ machine { memory = DT.next (memory machine), program = DT.next (program machine) } '<' -> ActionN $ machine { memory = DT.prev (memory machine), program = DT.next (program machine) } '[' -> ActionN $ machine { program = if mc == 0 then skip (program machine) else DT.next (program machine) } ']' -> ActionN $ machine { program = if mc /= 0 then back (program machine) else DT.next (program machine) } ',' -> ActionI { hold = machine { program = DT.next (program machine) } } '.' -> ActionO { hold = machine { program = DT.next (program machine) }, out = DT.get (memory machine) } _ -> ActionE where (pc, mc) = (,) <$> DT.get . program <*> DT.get . memory $ machine -- | 入力を消費・出力を収集しながら step を繰り返す loop :: (Machine -> WithAction Machine) -> (String, Machine) -> String loop step (input, machine) = go (step machine) where -- アクションに対応した動作を実行し、再帰に進む go (ActionN machine') = loop step (input, machine') -- そのまま次へ go (ActionI machine') = loop step (iTail, machine'') where -- 入力を消費してメモリに書き込み、次に進む (iHead : iTail) = input machine'' = machine' { memory = DT.put (fromEnum iHead) (memory machine') } go (ActionO machine' out) = toEnum out : loop step (input, machine') -- 出力を収集し、次に進む go ActionE = [] -- 終端 -- | Bf プログラムから、入力を受け取って出力を返す関数を作る bf :: String -> [Char] -> String bf program input = loop step (input', machine) where input' = input ++ repeat ' \0 ' machine = Machine { memory = DT.zeros , program = DT.next $ DT.fromList ( "#" ++ program ++ "#" ) } Main.hs module Main where import Interpreter -- | ハローワールドする Bf プログラム helloWorld :: String helloWorld = "++++++++++[>+++++++>++++++++++>+++++++++++>+++>+++++++++>+<<<<<<-]>++.>+.>--..+++.>++.>---.<<.+++.------.<-.>>+.>>." -- | エコーする Bf プログラム echo :: String echo = "+[,.]" main :: IO () main = do let getOutputBf = bf helloWorld putStr $ getOutputBf "こんにちは \n "