JavaでAST作るのは大変
コンパイラの実装言語にあると良い機能でJavaでAST(抽象構文木)作るのが大変だという話に触れたのだけれども、実は自分の知らない良いやり方があるのではないかと思ってClojureなどJavaで実装された処理系のソースを覗いてみました。
結論：やっぱり大変。
Clojureの場合
% ls clojure-1.2.0-RC2/src/jvm/clojure/lang/ AFn.java ILookupSite.java Namespace.java AFunction.java ILookupThunk.java Numbers.java AMapEntry.java IMapEntry.java Obj.java APersistentMap.java IMeta.java PersistentArrayMap.java APersistentSet.java IObj.java PersistentHashMap.java APersistentVector.java IPersistentCollection.java PersistentHashSet.java ARef.java IPersistentList.java PersistentList.java AReference.java IPersistentMap.java PersistentQueue.java ASeq.java IPersistentSet.java PersistentStructMap.java ATransientMap.java IPersistentStack.java PersistentTreeMap.java ATransientSet.java IPersistentVector.java PersistentTreeSet.java Agent.java IProxy.java PersistentVector.java ArrayChunk.java IReduce.java ProxyHandler.java ArraySeq.java IRef.java RT.java Associative.java IReference.java Range.java Atom.java ISeq.java Ratio.java Binding.java ITransientAssociative.java Ref.java Box.java ITransientCollection.java Reflector.java ChunkBuffer.java ITransientMap.java Repl.java ChunkedCons.java ITransientSet.java RestFn.java Compile.java ITransientVector.java Reversible.java Compiler.java Indexed.java Script.java Cons.java IndexedSeq.java SeqEnumeration.java Counted.java IteratorSeq.java SeqIterator.java Delay.java Keyword.java Seqable.java DynamicClassLoader.java KeywordLookupSite.java Sequential.java EnumerationSeq.java LazilyPersistentVector.java Settable.java Fn.java LazySeq.java Sorted.java IChunk.java LineNumberingPushbackReader.java StringSeq.java IChunkedSeq.java LispReader.java Symbol.java IDeref.java LockingTransaction.java TransactionalHashMap.java IEditableCollection.java MapEntry.java Util.java IFn.java MapEquivalence.java Var.java IKeywordLookup.java MethodImplCache.java XMLHandler.java ILookup.java MultiFn.java ILookupHost.java Named.java
JRubyの場合
% ls jruby-1.5.1/src/org/jruby/ast/ AliasNode.java DStrNode.java NilNode.java AndNode.java DSymbolNode.java Node.java ArgAuxillaryNode.java DVarNode.java NodeType.java ArgsCatNode.java DXStrNode.java NonLocalControlFlowNode.java ArgsNoArgNode.java DefinedNode.java NotNode.java ArgsNode.arities.erb DefnNode.java NthRefNode.java ArgsNode.erb DefsNode.java OpAsgnAndNode.java ArgsNode.java DotNode.java OpAsgnNode.java ArgsPreOneArgNode.java EncodingNode.java OpAsgnOrNode.java ArgsPreTwoArgNode.java EnsureNode.java OpElementAsgnNode.java ArgsPushNode.java EvStrNode.java OpElementOneArgAndAsgnNode.java ArgumentNode.java FCallManyArgsBlockNode.java OpElementOneArgAsgnNode.java ArrayNode.java FCallManyArgsBlockPassNode.java OpElementOneArgOrAsgnNode.java AssignableNode.java FCallManyArgsNode.java OptArgNode.java AttrAssignNode.java FCallNoArgBlockNode.java OrNode.java AttrAssignOneArgNode.java FCallNoArgBlockPassNode.java PostExeNode.java AttrAssignThreeArgNode.java FCallNoArgNode.java PreExeNode.java AttrAssignTwoArgNode.java FCallNode.java RedoNode.java BackRefNode.java FCallOneArgBlockNode.java RegexpNode.java BeginNode.java FCallOneArgBlockPassNode.java RescueBodyNode.java BignumNode.java FCallOneArgNode.java RescueNode.java BinaryOperatorNode.java FCallSpecialArgBlockNode.java RestArgNode.java BlockAcceptingNode.java FCallSpecialArgBlockPassNode.java RetryNode.java BlockArg18Node.java FCallSpecialArgNode.java ReturnNode.java BlockArgNode.java FCallThreeArgBlockNode.java RootNode.java BlockNode.java FCallThreeArgBlockPassNode.java SClassNode.java BlockPassNode.java FCallThreeArgNode.java SValue19Node.java BreakNode.java FCallTwoArgBlockNode.java SValueNode.java CallManyArgsBlockNode.java FCallTwoArgBlockPassNode.java SelfNode.java CallManyArgsBlockPassNode.java FCallTwoArgNode.java Splat19Node.java CallManyArgsNode.java FalseNode.java SplatNode.java CallNoArgBlockNode.java FileNode.java StarNode.java CallNoArgBlockPassNode.java FixnumNode.java StrNode.java CallNoArgNode.java FlipNode.java SuperNode.java CallNode.java FloatNode.java SymbolNode.java CallOneArgBlockNode.java ForNode.java ToAryNode.java CallOneArgBlockPassNode.java GlobalAsgnNode.java TrueNode.java CallOneArgFixnumNode.java GlobalVarNode.java TypedArgumentNode.java CallOneArgNode.java Hash19Node.java UndefNode.java CallSpecialArgBlockNode.java HashNode.java UnnamedRestArgNode.java CallSpecialArgBlockPassNode.java IArgumentNode.java UntilNode.java CallSpecialArgNode.java IScopingNode.java VAliasNode.java CallThreeArgBlockNode.java IfNode.java VCallNode.java CallThreeArgBlockPassNode.java InstAsgnNode.java WhenNode.java CallThreeArgNode.java InstVarNode.java WhenOneArgNode.java CallTwoArgBlockNode.java InvisibleNode.java WhileNode.java CallTwoArgBlockPassNode.java IterNode.java XStrNode.java CallTwoArgNode.java LambdaNode.java YieldNode.java CaseNode.java ListNode.java YieldOneNode.java ClassNode.java LiteralNode.java YieldThreeNode.java ClassVarAsgnNode.java LocalAsgnNode.java YieldTwoNode.java ClassVarDeclNode.java LocalVarNode.java ZArrayNode.java ClassVarNode.java Match2Node.java ZSuperNode.java Colon2ConstNode.java Match3Node.java ZYieldNode.java Colon2ImplicitNode.java MatchNode.java ZeroArgNode.java Colon2MethodNode.java MethodDefNode.java executable Colon2Node.java ModuleNode.java java_signature Colon3Node.java MultipleAsgn19Node.java types ConstDeclNode.java MultipleAsgnNode.java util ConstNode.java NewlineNode.java visitor DAsgnNode.java NextNode.java DRegexpNode.java NilImplicitNode.java
Jythonの場合
% ls src/org/python/core/ AbstractArray.java PyClass.java PyReflectedConstructor.java AnnotationReader.java PyClassMethod.java PyReflectedField.java ArgParser.java PyClassMethodDerived.java PyReflectedFunction.java AstList.java PyClassMethodDescr.java PyReversedIterator.java BaseSet.java PyCode.java PyRunnable.java BuiltinDocs.java PyComplex.java PyRunnableBootstrap.java BytecodeLoader.java PyComplexDerived.java PySequence.java ClassDictInit.java PyCompoundCallable.java PySequenceIter.java ClasspathPyImporter.java PyDataDescr.java PySequenceList.java ClasspathPyImporterDerived.java PyDescriptor.java PySet.java CodeBootstrap.java PyDictProxy.java PySetDerived.java CodeFlag.java PyDictionary.java PySingleton.java CodeLoader.java PyDictionaryDerived.java PySlice.java CompileMode.java PyEllipsis.java PySlot.java CompilerFacade.java PyEnumerate.java PyStaticMethod.java CompilerFlags.java PyEnumerateDerived.java PyString.java ContextGuard.java PyException.java PyStringDerived.java ContextManager.java PyFastSequenceIter.java PyStringMap.java Deriveds.java PyFile.java PySuper.java FilelikeInputStream.java PyFileDerived.java PySuperDerived.java FunctionThread.java PyFileReader.java PySyntaxError.java FutureFeature.java PyFileWriter.java PySystemState.java IdImpl.java PyFinalizableInstance.java PyTableCode.java InitModule.java PyFloat.java PyTraceback.java JavaImportHelper.java PyFloatDerived.java PyTuple.java JavaImporter.java PyFrame.java PyTupleDerived.java JythonInitializer.java PyFrozenSet.java PyType.java MakeProxies.java PyFrozenSetDerived.java PyTypeDerived.java NewCompilerResources.java PyFunction.java PyUnicode.java Opcode.java PyFunctionTable.java PyUnicodeDerived.java Options.java PyGenerator.java PyXRange.java ParserFacade.java PyIgnoreMethodTag.java PythonCodeBundle.java Pragma.java PyIndentationError.java PythonCompiler.java PragmaReceiver.java PyInstance.java PythonTraceFunction.java Py.java PyInteger.java ReflectedArgs.java PyArray.java PyIntegerDerived.java ReflectedCallData.java PyArrayDerived.java PyIterator.java SequenceIndexDelegate.java PyBaseCode.java PyJavaPackage.java Slotted.java PyBaseException.java PyJavaType.java StderrWrapper.java PyBaseExceptionDerived.java PyList.java StdoutWrapper.java PyBaseString.java PyListDerived.java SyspathArchive.java PyBeanEvent.java PyLong.java SyspathJavaLoader.java PyBeanEventProperty.java PyLongDerived.java ThreadState.java PyBeanProperty.java PyMethod.java ThreadStateMapping.java PyBoolean.java PyMethodDescr.java TraceFunction.java PyBuiltinCallable.java PyModule.java WrappedIterIterator.java PyBuiltinClassMethodNarrow.java PyModuleDerived.java __builtin__.java PyBuiltinFunction.java PyNewWrapper.java adapter PyBuiltinFunctionNarrow.java PyNone.java codecs.java PyBuiltinFunctionSet.java PyNotImplemented.java exceptions.java PyBuiltinMethod.java PyObject.java imp.java PyBuiltinMethodNarrow.java PyObjectDerived.java io PyBuiltinMethodSet.java PyOverridableNew.java packagecache PyBytecode.java PyProperty.java ucnhashAPI.java PyCallIter.java PyPropertyDerived.java util PyCell.java PyProxy.java
ファイル名を見てもらえれば分かると思いますが、1ノードタイプ⇔1ファイルです。
何故こんなことになるかというと原因は二つあって
- Javaでは1クラスにつき1ファイル必要
- オブジェクト指向言語ではCompositeパターンで木構造を実装する
です。Compositeパターンでは葉の種類毎に１クラスを作るので、抽象構文木のノードタイプ数だけファイルができる事になります。
ソースの自動生成とかの工夫はしているのかもしれないですが未確認です。
ちなみにVariantのある言語だと、例えばOCamlならファイルは一つで良くて(parsetree.mli)
% ls ocaml-3.11.2/parsing/ asttypes.mli lexer.mll linenum.mll location.mli longident.mli parse.mli parsetree.mli printast.mli syntaxerr.mli lexer.mli linenum.mli location.ml longident.ml parse.ml parser.mly printast.ml syntaxerr.ml
以下の様に書けます。
type expression = { pexp_desc: expression_desc; pexp_loc: Location.t } and expression_desc = Pexp_ident of Longident.t | Pexp_constant of constant | Pexp_let of rec_flag * (pattern * expression) list * expression | Pexp_function of label * expression option * (pattern * expression) list | Pexp_apply of expression * (label * expression) list | Pexp_match of expression * (pattern * expression) list | Pexp_try of expression * (pattern * expression) list | Pexp_tuple of expression list | Pexp_construct of Longident.t * expression option * bool | Pexp_variant of label * expression option | Pexp_record of (Longident.t * expression) list * expression option | Pexp_field of expression * Longident.t | Pexp_setfield of expression * Longident.t * expression | Pexp_array of expression list | Pexp_ifthenelse of expression * expression * expression option | Pexp_sequence of expression * expression | Pexp_while of expression * expression | Pexp_for of string * expression * expression * direction_flag * expression | Pexp_constraint of expression * core_type option * core_type option | Pexp_when of expression * expression | Pexp_send of expression * string | Pexp_new of Longident.t | Pexp_setinstvar of string * expression | Pexp_override of (string * expression) list | Pexp_letmodule of string * module_expr * expression | Pexp_assert of expression | Pexp_assertfalse | Pexp_lazy of expression | Pexp_poly of expression * core_type option | Pexp_object of class_structure
brainfuckのコードを自動生成するコンパイラ
S式からbrainfuckのコードを自動生成するプログラムを書いてみました。
コード生成が目的ではなくて単にできるだろうかと気になったのでやってみました。gaucheを使いました。
brainfuck インタプリタをスタックマシンっぽく使って動作します。
変数が使えるところが個人的には面白いかもと思っています。
最適化とか全然考えていないので、大変非効率なコードが出ます。今後これ以上何か改良する予定もありません。
(define vtable `()) (define depth 0) (define (incr) (set! depth (+ depth 1))) (define (decr) (set! depth (- depth 1))) (define (addvar name) (set! vtable (cons `(,name . ,depth) vtable))) (define (delvar) (set! vtable (cdr vtable))) (define (findvar name) (cdr (assoc name vtable))) (define (putn c n) (let loop ((i 0)) (if (< i n) (begin (display c) (loop (+ i 1)) )))) (define (set_int n) (if (> n 0) (if (<= n 20) (putn "+" n) (begin (display ">") (putn "+" (quotient n 10)) (display "[<++++++++++>-]<") (putn "+" (remainder n 10)) )) (if (<= -20 n) (putn "-" (- n)) (begin (display ">") (putn "+" (quotient (- n) 10)) (display "[<---------->-]<") (putn "-" (remainder (- n) 10)) )) )) (define (emit_int n) (begin (display ">") (set_int n) (incr) #t )) (define (emit_puts str) (begin (display ">") (incr) (let ((n (string-length str))) (let loop ((i 0) (v 0)) (if (< i n) (let ((c (string-byte-ref str i))) (begin (set_int (- c v)) (display ".") (loop (+ i 1) c) )) ))) (drop) #f )) (define (emit_var name) (let ((n (- depth (findvar name)))) (begin (putn "<" n) (display "[") (putn ">" (+ n 1)) (display "+>+") (putn "<" (+ n 2)) (display "-]") (putn ">" (+ n 2)) (display "[") (putn "<" (+ n 2)) (display "+") (putn ">" (+ n 2)) (display "-]<") (incr) #t ))) (define (emit_assign name e) (let ((n (- depth (findvar name)))) (begin (transl e) (decr) ; zero-clear (putn "<" (+ n 1)) (display "[-]") (putn ">" (+ n 1)) ; copy value (display "[") (putn "<" (+ n 1)) (display "+") (putn ">" (+ n 1)) (display "-]<") #f ))) (define (drop) (begin (display "[-]<") (decr))) (define (transl expr) (cond ((integer? expr) (emit_int expr)) ((char? expr) (emit_int (char->integer expr))) ((eq? `get expr) (begin (display ">,") (incr) #t)) ((symbol? expr) (emit_var expr)) ((eq? `put (car expr)) (begin (transl (cadr expr)) (display ".") (drop) #f)) ((eq? `puts (car expr)) (emit_puts (cadr expr))) ((eq? `puti (car expr)) (transl `(let v ,(cadr expr) (let x v (do (if (> x 100) (do (put (+ #\0 (/ v 100)) (set v (% v 100))))) (if (> x 10) (do (put (+ #\0 (/ v 10)) (set v (% v 10))))) (put (+ #\0 v)) ))))) ((eq? `+ (car expr)) (begin (transl (cadr expr)) (transl (caddr expr)) (display "[<+>-]<") (decr) #t )) ((eq? `- (car expr)) (begin (transl (cadr expr)) (transl (caddr expr)) (display "[<->-]<") (decr) #t )) ((eq? `* (car expr)) (transl `(let v 0 (let a ,(cadr expr) (let b ,(caddr expr) (do (while (!= b 0) (do (set v (+ v a)) (set b (- b 1)))) v)))))) ((eq? `/ (car expr)) (transl `(let v 0 (let a ,(cadr expr) (let b ,(caddr expr) (do (while (> a b) (do (set v (+ v 1)) (set a (- a b)))) v)))))) ((eq? `% (car expr)) (transl `(let a ,(cadr expr) (let b ,(caddr expr) (do (while (> a b) (set a (- a b))) a))))) ((eq? `sub (car expr)) (begin (transl (cadr expr)) (transl (caddr expr)) (display "[<[>>+>+<<<-]>>>[<<<+>>>-]<[[-]<<->>]<-]<") (decr) #t )) ((eq? `!= (car expr)) (transl `(- ,(cadr expr) ,(caddr expr)))) ((eq? `== (car expr)) (begin (transl `(- ,(cadr expr) ,(caddr expr)))) (emit_int 1) (display "<[>[-]<-]>[<+>-]<") (decr) ) ((eq? `> (car expr)) (transl `(sub ,(cadr expr) ,(caddr expr)))) ((eq? `< (car expr)) (transl `(sub ,(caddr expr) ,(cadr expr)))) ((eq? `>= (car expr)) (transl `(sub (+ ,(cadr expr) 1) ,(caddr expr)))) ((eq? `<= (car expr)) (transl `(sub (+ ,(caddr expr) 1) ,(cadr expr)))) ((eq? `do (car expr)) (let loop ((e (cdr expr)) (r #f)) (if (pair? e) (begin (if r (drop)) (loop (cdr e) (transl (car e))) ) r))) ((eq? `while (car expr)) (begin (transl (cadr expr)) (display "[") (if (transl (caddr expr)) (drop)) (drop) (transl (cadr expr)) (display "]") (drop) #f )) ((eq? `if (car expr)) (if (null? (cdddr expr)) (transl `(if-nonzero ,(cadr expr) (caddr expr))) (transl `(let c ,(cadr expr) (do (if-nonzero c ,(caddr expr)) (if-zero c ,(cadddr expr))))) )) ((eq? `if-nonzero (car expr)) (begin (transl (cadr expr)) (display "[[-]") (if (transl (caddr expr)) (drop)) (display "]") (drop) #f )) ((eq? `if-zero (car expr)) (begin (transl (cadr expr)) (emit_int 1) (display "<[>[-]<-]>[<+>-]<") (decr) (display "[[-]") (if (transl (caddr expr)) (drop)) (display "]") (drop) #f )) ((eq? `let (car expr)) (transl (caddr expr)) (addvar (cadr expr)) (if (transl (cadddr expr)) (display "<[-]>[<+>-]<") ) (delvar) #t ) ((eq? `set (car expr)) (emit_assign (cadr expr) (caddr expr))) )) (define (compile expr) (begin (transl expr) (display "\n")))
使い方
% gosh gosh> (load "./bfgen.scm") #t
表示
gosh> (compile `(put #\x)) >>++++++++++++[<++++++++++>-]<.[-]< #<undef> gosh> (compile `(puts "hello world")) >>++++++++++[<++++++++++>-]<++++.---.+++++++..+++.>+++++++[<---------->-]<---------.>++++++++[<++++++++++>-]<+++++++.--------.+++.------.--------.[-]< #<undef>
入力
gosh> (compile `(put get)) >,.[-]< #<undef>
四則演算(+,-,*,/,%)。乗算は加算、除算は減算で実装しているのでめちゃくちゃ遅いです。
gosh> (compile `(put (+ #\0 3))) >>++++[<++++++++++>-]<++++++++>+++[<+>-]<.[-]< #<undef>
制御構造(do,if,while)。比較演算(==,!=,<,>,<=,>=)も用意しています。
gosh> (compile `(do (puts "hello") (puts " ") (puts "world"))) >>++++++++++[<++++++++++>-]<++++.---.+++++++..+++.[-]<>>+++[<++++++++++>-]<++.[-]<>>+++++++++++[<++++++++++>-]<+++++++++.--------.+++.------.--------.[-]< #<undef> gosh> (compile `(if (< 0 1) (puts "foo") (puts "bar"))) >+>[<[>>+>+<<<-]>>>[<<<+>>>-]<[[-]<<->>]<-]<[>+>+<<-]>>[<<+>>-]<[[-]>>++++++++++[<++++++++++>-]<++.+++++++++..[-]<][-]<[>+>+<<-]>>[<<+>>-]<>+<[>[-]<-]>[<+>-]<[[-]>>+++++++++[<++++++++++>-]<++++++++.-.+++++++++++++++++.[-]<][-]< #<undef> gosh> (compile `(while 1 (puts "foo"))) >+[>>++++++++++[<++++++++++>-]<++.+++++++++..[-]<[-]<>+][-]< #<undef>
変数(定義はlet，破壊的代入はset)
gosh> (compile `(let x 1 (set x (+ x 1) (put #\0 x)))) >+[>+>+<<-]>>[<<+>>-]<>+[<+>-]<<[-]>[<+>-]< #<undef>
以上を使うと例えばHello Worldを10行表示するコードとかをこんな感じで自動生成できます。
gosh> (compile `(let i 0 (while (< i 10) (do (puts "Hello World\n") (set i (+ i 1)))))) >>++++++++++<[>>+>+<<<-]>>>[<<<+>>>-]<[<[>>+>+<<<-]>>>[<<<+>>>-]<[[-]<<->>]<-]<[>>+++++++[<++++++++++>-]<++.>++[<++++++++++>-]<+++++++++.+++++++..+++.>+++++++[<---------->-]<---------.>+++++[<++++++++++>-]<+++++.>++[<++++++++++>-]<++++.+++.------.--------.>+++++++++[<---------->-]<.[-]<<[>>+>+<<<-]>>>[<<<+>>>-]<>+[<+>-]<<<[-]>>[<<+>>-]<[-]<>++++++++++<[>>+>+<<<-]>>>[<<<+>>>-]<[<[>>+>+<<<-]>>>[<<<+>>>-]<[[-]<<->>]<-]<][-]< #<undef>
fizzbuzzとかも書けると思うけど数値の表示で100での除算とかが発生するから、遅すぎて使い物にならなそうです。
純粋関数型言語の処理系を作ってみることにした (その4 : Mark-2 G-machine)
純粋関数型言語の処理系を作ってみることにした (その3 : Mark-1 G-machine)の続き。
教科書P94-P97まで。
http://github.com/nineties/puref/commit/4cd5d92a5f02468929bc2dd2ddafbd363251c86c
Mark-2 G-machineでは遅延評価を行う為の準備として、Update/Popというインストラクションで前回のSlideインストラクションを置き換えます。
また、実行中のVMのインストラクション列・スタック・ヒープの状態を自動的に可視化する機能を実装しました。
ビルド
% git clone git://github.com/nineties/puref.git % cd puref % make
テストコードとしてExcercise 3.11を用意しています。
% cat test.pf twice f x = f (f x); id x = x; main = twice twice id 3
-mark1,-mark2オプションで使用するG-machineを切り替えます。また-vis hogeでVMの状態を可視化したhoge.pdfが生成されます。
% ./puref -mark1 -vis test_mark1 test.pf output: 3 % ./puref -mark2 -vis test_mark2 test.pf output: 3
また-dinsnでコンパイル結果を出力します。
% ./puref -dinsn test.pf === twice [2] === 1: Push 1 2: Push 1 3: Mkapp 4: Push 1 5: Mkapp 6: Update 2 7: Pop 2 8: Unwind === id [1] === 1: Push 0 2: Update 1 3: Pop 1 4: Unwind === main [0] === 1: Num 3 2: SC id 3: SC twice 4: SC twice 5: Mkapp 6: Mkapp 7: Mkapp 8: Update 0 9: Pop 0 10: Unwind output: 3
以下のpdfを読む際の参考になるかと思います。
生成されたpdfがこちら。全ステップを可視化しているので、枚数＝ステップ数となります。
test_mark1.pdf
test_mark2.pdf
Graphvizを使ったのですが、ノードの位置関係が入れ替わったりしてあまり見やすくないです。ごめんなさい。
で、mark1とmark2で何がどう変わったか説明しなければならないのですがそれはまた今度にします。
純粋関数型言語の処理系を作ってみることにした (その3 : Mark-1 G-machine)
純粋関数型言語の処理系を作ってみることにした (その2)の続き。
今日は教科書の第3章P75-P94(Mark1: A MINIMAL G-MACHINE)の実装をしました。
現状では関数適用しかできません。遅延評価はまだ扱っていなくて、次回Mark2で扱うことになると思います。
ただ、現時点で普通のスタックマシンと大分違っているので出来る限りの説明を試みます。
http://github.com/nineties/puref/
minimal G-machineの主要なソースコード
type instruction = | ScI of string | NumI of int | MkappI | PushI of int | SlideI of int | UnwindI type node = | NumN of int | AppN of node * node | ScN of int * instruction list let sctable = Hashtbl.create 0 let arg = function | AppN(f,arg) -> arg | _ -> failwith "arg: not reachable" let rec drop ls n = if n == 0 then ls else drop (List.tl ls) (n - 1) let rec interpret seq stack = match (seq, stack) with | [], NumN n::_ -> n | ScI name::is, _ -> begin try let m = Hashtbl.find sctable name in interpret is (m::stack) with Not_found -> failwith ("undefined super combinator: " ^ name) end | NumI n::is, _ -> interpret is (NumN n::stack) | MkappI::is, a0::a1::ss -> interpret is (AppN(a0, a1)::ss) | PushI n::is, _ -> let app = List.nth stack (n + 1) in interpret is (arg app::stack) | SlideI n::is, a0::ss -> interpret is (a0::drop ss n) | UnwindI::_, NumN n::_ -> n | UnwindI::_, AppN(f,arg)::_ -> interpret seq (f::stack) | UnwindI::is, ScN(n,sc_seq)::s -> interpret sc_seq stack | _ -> failwith "interpret: not reachable" let register_sc (name,narg,seq) = Hashtbl.add sctable name (ScN(narg,seq)) let register_scs scs = ignore( List.map register_sc scs ) let run_main () = interpret [ScI "main"; UnwindI] []
open Syntax open Gmachine let argpos name args = let rec f i ls = match ls with | [] -> failwith ("unknown variable: " ^ name) | v::_ when name = v -> i | _ -> f (i+1) (List.tl ls) in f 0 args let rec compileC base args = function | VarE name when List.mem name args -> [PushI (base + argpos name args)] | VarE name -> [ScI name] | NumE num -> [NumI num] | AppE(e1,e2) -> compileC base args e2 @ compileC (base + 1) args e1 @ [MkappI] | _ -> failwith "not implemented" let compileR args body = compileC 0 args body @ [SlideI (List.length args + 1); UnwindI] let compileSC (name,args,body) = (name, List.length args, compileR args body) let f prog = List.map compileSC prog
まず具体例。
nineties% cat test.pf main = K 1 2; K x y = x nineties% ./puref < test.pf main = K 1 2; K x y = x === main [0] === 1: Num 2 2: Num 1 3: SC K 4: Mkapp 5: Mkapp 6: Slide 1 7: Unwind === K [2] === 1: Push 0 2: Slide 3 3: Unwind result: 1
出力は抽象構文木・インストラクション・結果(整数値)です。普通の仮想マシンでは見慣れない命令が並んでいますが、その挙動を図解で説明します。図の左側が命令列(左端が先頭)、右側がスタック(右端がスタックトップ)です。
G-machineとは項書き換えシステムの実現方法の一つで、Unwindという命令が書き換えを実行する命令です。
まず、一番最初にスタックに"main"という項を積みます(SC main)。次のUnwindで、命令列がmainに束縛された物へと置き換えられます。
次にmainを右辺であるK 1 2に書き換えます。
まず引数を右から順番に積んで、Mkappによって関数適用ノードを作っていきます(1〜3行目)。
カリー化されているので、K 1 2は((K 1) 2)と2回の関数適用になります。
次にSlide命令でmainを取り除きます(4行目)。
最後に、関数適用ノードを展開して書き換え完了です(5〜7行目)。
最後の時点でのスタックの状態は下図のようになっています。従って、スタックをi+1個戻ったとこのAppノードの二番目の子供がi番目の引数になります。
K 1 2はまだ書き換えられるので続きます。Push nはn番目の引数をスタックに積む命令です。
最終的にスタックトップは1となり、これ以上書き換えられないのでこれで実行が完了となります。
以上のように、関数適用ノードを組み立てた後にUnwindで書き換えができなくなるまで書き換えて行くという事を繰り返します。
Unwindの規則を簡単にまとめると、
- スタックトップが定数 : 終了
- スタックトップがスーパーコンビネータ : 命令列を置き換える
- スタックトップが関数適用(f aの形) : スタックトップにfを積む
となります。
後の章でもっと効率の良い実装が出てくると思いますが、基本的な考え方は同じになると思います。
brainfuckOSを作ろうとしてみた
こんなのを見つけたのだけど
http://code.google.com/p/brainfuckos/
中が空っぽでがっかりしたので、自分で何か作ってみようかと思った。
はっきり言ってめんどくさすぎるので続きはやりませんが、こんなの作ってみました。
.code16 .equ SCREEN, 0xb800 .equ WIDTH, 80 .equ HEIGHT, 25 jmp entry entry: movw %cs, %ax movw %ax, %ds movw $SCREEN, %ax movw %ax, %es movl $0, %edi movl $WIDTH*HEIGHT*2, %ecx 1: movb $0, %es:(%edi) incl %edi decl %ecx jnz 1b movl $0, %edi movl $main, %edx eval_loop: movb (%edx), %al cmpb $0, %al je fin cmpb $'>, %al je goforward cmpb $'<, %al je gobackward cmpb $'+, %al je increment cmpb $'-, %al je decrement cmpb $'[, %al je beginloop jmp endloop cmpb $'], %al je endloop jmp error goforward: incl %edi incl %edx jmp eval_loop gobackward: decl %edi incl %edx jmp eval_loop increment: incb %es:(%edi) incl %edx jmp eval_loop decrement: decb %es:(%edi) incl %edx jmp eval_loop beginloop: movl $0, %ecx movb %es:(%edi), %al cmpb $0, %al je 2f 1: incl %edx jmp eval_loop 2: incl %edx movb (%edx), %al cmpb $'], %al je 3f cmpb $'[, %al je 4f jmp 2b 3: cmpl $0, %ecx je 1b decl %ecx jmp 2b 4: incl %ecx jmp 2b endloop: movl $0, %ecx movb %es:(%edi), %al cmpb $0, %al jne 2f 1: incl %edx jmp eval_loop 2: decl %edx movb (%edx), %al cmpb $'[, %al je 3f cmpb $'], %al je 4f jmp 2b 3: cmpl $0, %ecx je 1b decl %ecx jmp 2b 4: incl %ecx jmp 2b error: movl $0, %edi 1: movb errmsg(%edi), %al cmpb $0, %al je fin movb $0x06, %ah movw %ax, %es:(,%edi,2) incl %edi jmp 1b fin: hlt jmp fin errmsg: .string "unknown opcode" main: .ascii ">++++++++[<+++++++++>-]+" .ascii ">+>++++++++++[<++++++++++>-]++" .ascii ">-->++++++++++[<+++++++++++>-]+++" .ascii ">-->++++++++++[<+++++++++++>-]++++" .ascii ">+>++++++++++[<+++++++++++>-]+++++" .ascii ">+++>+++++++" .byte 0 .org 0x1fe .byte 0x55,0xaa
OUTPUT_FORMAT(binary)
OUTPUT_ARCH(i386)
SECTIONS {
. = 0x7c00;
.text : { *(.text) }
}ビルドしてQEMUとかで実行すると
となります。
brainfuckのメモリ空間として物理メモリを使えば画面に何か表示させたり出来る訳なので、0xb800(スクリーン)にマッピングして見たのが上のコード。512バイト制限を超えるのがめんどくさかったのでブートセクタのみでやってます。
brainfuckはチューリング完全なので、特定のアドレスにシステムコールとか画面リフレッシュとかの機能を持たせる最小限のコードを書けば、原理的にはbrainfuckでOSが書けるはずです。この場合入出力オペレータ".と,"はいらないですが、適当なIOポートとかにつないで遊んでみても面白いかも。
オブジェクトファイルの設計
ファイル入出力とか可変長配列とかrowlVMのプリミティブが充実してきたので、現在はrowl-core言語で次期rowl1コンパイラの実装をしています。
ところが、メモリマネージャのないスクリプト言語であるrowl-coreは大量にメモリを消費する為ついに限界がきました。
そこで、この段階で分割コンパイルが出来るようにオブジェクトファイルの設計をしてリンカを作ります。ELFがどうなっているかとか全然調べてなくて適当です。
まず、rowlVMは基本的に相対アドレッシングなので全てのアドレスを書き換える必要はありません。以下をリンク時に修正する必要があります。
- ファイルをまたぐ関数呼び出し
- グローバルboxed変数のインデックス
- グローバルunboxed変数のアドレス
というわけでプログラムの先頭にシンボルテーブルを作成します。
シンボルテーブルの1エントリ
exportされるシンボルのテーブル(exportテーブル)
| シンボル長(2バイト) | シンボル | アドレス(4バイト) |
importされるテーブル(import テーブル)
| シンボル長(2バイト) | シンボル | 書き換え場所の数=N(4バイト) | 書き換え場所のアドレス(4バイト) x N |
シンボルテーブル
| 1のエントリ数(4バイト) | 2のエントリ数(4バイト) | 3のエントリ数(4バイト) | エントリ0 | エントリ1 | ...
オブジェクトファイル
先頭から
- ファイルの総バイト数(4バイト)
- exportテーブル
- importテーブル
- グローバルboxedオブジェクトの数(4バイト)
- グローバルunboxedオブジェクトの総バイト数(4バイト)
- グローバルunboxedオブジェクト領域
- バイトコード本体
純粋関数型言語の処理系を作ってみることにした (その2 : Pretty Printer)
純粋関数型言語の処理系を作ってみることにしたの続き。
先週末はちょっと忙しかったので毎週日曜日の予定がずれてしまいました。
今日はPretty Printerを作りました。G-machineは次回に回します。
http://github.com/nineties/puref/commit/9295d96e1e0adb73dafea06dd716c1aada6c3304
下がPretty Printerのコード。OCamlのFormatモジュールは書式指定文字列の中でボックスを作る事ができるのが特徴で、ちょっとおもしろいです。(@[ ... @])の部分。このボックスを使ってインデントとかの調整をします。
詳しくはhttp://caml.inria.fr/resources/doc/guides/format.html
open Format open Syntax let binop_string = function | Add -> "+" | Sub -> "-" | Mul -> "*" | Div -> "/" | Lt -> "<" | Le -> "<=" | Eq -> "==" | Ne -> "~=" | Ge -> ">=" | Gt -> ">" | And -> "&" | Or -> " | " let rec pp_vars ppf vars = List.iter (fun v -> fprintf ppf "%a@;" pp_print_string v) vars let pp_break_list f ppf elems = pp_open_hvbox ppf 0; f ppf (List.hd elems); List.iter (fun def -> pp_print_break ppf 1 0; f ppf def) (List.tl elems); pp_close_box ppf () let rec pp_expr ppf = function | VarE id -> pp_print_string ppf id | NumE num -> pp_print_int ppf num | PackE (id,arity) -> fprintf ppf "<%d,%d>" id arity | AppE (f,arg) -> fprintf ppf "%a %a" pp_expr f pp_aexpr arg | InfixE (op,lhs,rhs) -> fprintf ppf "@[%a %s %a@]" pp_expr lhs (binop_string op) pp_expr rhs | LetE (defs,cont) -> fprintf ppf "@[@[<hv 4>let %a@]@;in@;%a@]" (pp_break_list pp_def) defs pp_expr cont | LetrecE (defs,cont) -> fprintf ppf "@[@[<hv 4>letrec@;%a@]@;in@;%a@]" (pp_break_list pp_def) defs pp_expr cont | CaseE (expr,alts) -> fprintf ppf "@[@[<hv 4>case %a@]@;of@;%a@]" pp_expr expr (pp_break_list pp_alt) alts | LambdaE (vars,body) -> fprintf ppf "@[@[<hv>%a>. %a@]" pp_vars vars pp_expr body and pp_aexpr ppf exp = match exp with | VarE _ -> pp_expr ppf exp | NumE _ -> pp_expr ppf exp | PackE _ -> pp_expr ppf exp | _ -> fprintf ppf "(%a)" pp_expr exp and pp_def ppf (var,expr) = fprintf ppf "@[%a = %a@]" pp_print_string var pp_expr expr and pp_alt ppf (id,elems,cont) = fprintf ppf "@[<%d> %a-> %a@]" id pp_vars elems pp_expr cont let pp_sc ppf (vars,body) = fprintf ppf "@[%a= %a@]" pp_vars vars pp_expr body let rec pp_program ppf = function | [sc] -> pp_sc ppf sc; pp_print_newline ppf () | sc::scs -> fprintf ppf "@[<v>%a;@;%a@]" pp_sc sc pp_program scs | _ -> failwith "not reachable"
これで、パーサの結果を出力することが出来ます。簡単なテストコードとして教科書10ページのstandard preludeを追加しました。
I x = x; K x y = x; K1 x y = y; S f g x = f x (g x); compose f g x = f (g x); twice f = compose f f
実行結果
% ./puref < prelude.pf I x = x; K x y = x; K1 x y = y; S f g x = f x (g x); compose f g x = f (g x); twice f = compose f f
次回こそはG-machineの実装に入ります。
