随笔-341  评论-2670  文章-0  trackbacks-0
    这次终于实现了两个exe,一个是编译器,一个是提供控制台API的虚拟机。等提供GUI的虚拟机出来之后就开放出来。

    假设有代码Program.txt:
1 module program
2 import console
3 import list
4 
5 def main = take 10 (iterate finc 1.0||> sqr ||> ftoa ||> writeln |> ioseq

    那么提供Program.xml:
1 <kfpProject>
2   <inherit path="..\..\Include\ConsoleApplication.xml"/>
3   <output path="Executable.xml"/>
4   <report path="Report.txt"/>
5   <code>
6     <include path="Program.txt"/>
7   </code>
8 </kfpProject>

    然后执行:
..\..\Release\KfpCompiler.exe Program.xml
..\..\Release\KfpConsole.exe Executable.xml

    就可以运行一个程序啦!

    让我们分析一下代码。首先finc是一个将浮点数加一的函数,那么iterate finc 1.0就是一个从1.0开始,每次递增1.0的无穷数组,然后take 10返回[1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0]。然后||>sqr将所有数字开方,||>ftoa将所有数字转成字符串,然后||>writeln将所有的字符串变成10个输出字符串的函数,最后|>ioseq运行这10个函数,结果如下:


    接下来打算实现一个VL_CompressedStream用于压缩产生的可执行镜像,然后再开发一个支持简单绘图功能的虚拟机,就开放出来。所需要的时间应该不久,因为一个新的虚拟机只需要实现API就可以了。伟大的插件系统,灭哈哈…… 

    下面是上面MakeFile所引用到的库文件(预定义的):

    ConsoleApplication.xml
1 <kfpProject>
2   <inherit path="Library.xml"/>
3   <code>
4     <include path="ConsoleModule.txt"/>
5   </code>
6 </kfpProject>

    Library.xml
1 <kfpProject>
2   <code>
3     <include path="SysUtils.txt"/>
4     <include path="List.txt"/>
5   </code>
6 </kfpProject>

    所需要的代码文件:

    ConsoleModule.txt
1 module console
2 import system
3 
4 func read :: (IO string) alias "console::read"
5 
6 func write :: (string -> (IO void)) alias "console::write"
7 
8 func writeln :: (string -> (IO void)) alias "console::writeln"
9 

    SysUtils.txt
 1 module sysutils
 2 import system
 3 
 4 def (+= iadd
 5 def (+= fadd
 6 def (-= isub
 7 def (-= fsub
 8 def (*= imul
 9 def (*= fmul
10 def (/= idiv
11 def (/= fdiv
12 def (>= igt
13 def (>= fgt
14 def (>= cgt
15 def (>== iegt
16 def (>== fegt
17 def (>== cegt
18 def (<= ilt
19 def (<= flt
20 def (<= clt
21 def (<== ielt
22 def (<== felt
23 def (<== celt
24 def (=== iequ
25 def (=== fequ
26 def (=== cequ
27 def (!== ineq
28 def (!== fneq
29 def (!== cneq
30 def (&&= and
31 def (||= or
32 def (^= xor
33 def (|>) param op = op param
34 def oprev op a b = op b a
35 
36 def not a = select a of
37               case true : false
38               case false : true
39             end
40 
41 def and a b = select a of
42                 case true : b
43                 case false : false
44               end
45 
46 def or a b = select a of
47                 case true : true
48                 case false : b
49               end
50 
51 def xor a b = select a of
52                 case true : not b
53                 case false : b
54               end
55 
56 def if cond t f = select cond of
57                     case true : t
58                     case false : f
59                   end
60 
61 def ineg num = isub 0 num
62 
63 def fneg num = fsub 0.0 num
64 
65 def inc n = iadd n 1
66 
67 def dec n = isub n 1
68 
69 def finc n = fadd n 1.0
70 
71 def fdec n = fsub n 1.0
72 
73 def pairfirst p = select p of
74   case pair a b : a
75 end
76 
77 def pairsecond p = select p of
78   case pair a b : b
79 end
80 
81 def pairop op =\p->
82     select p of
83         case pair a b : op a b
84     end
85 
86 func return T :: T -> IO T
87 def return x e = success (pair x e)
88 
89 func ioerror T :: string -> IO T
90 def ioerror s = \env->fail(ioemessage s)

    List.txt
  1 module list
  2 import sysutils
  3 
  4 def (+= concat
  5 def (||>) param op = transform op param
  6 
  7 def ioseq = foldr iovoid (>>>)
  8 
  9 {返回列表长度}
 10 def length xs =
 11     select xs of
 12         case list x tail : iadd 1 (length tail)
 13         case empty : 0
 14     end
 15 
 16 {返回列表的第一个元素}
 17 def head xs =
 18     select xs of
 19         case list x tail : x
 20     end
 21 
 22 {返回列表的第二个元素开始的列表}
 23 def tail xs =
 24     select xs of
 25         case list x tail : tail
 26     end
 27 
 28 {连接两个列表}
 29 def concat as bs =
 30     select as of
 31         case list a tail : list a (concat tail bs)
 32         case empty : bs
 33     end
 34 
 35 {判读列表是否为空}
 36 def isempty xs =
 37     select xs of
 38         case list x tail : false
 39         case empty : true
 40     end
 41 
 42 {将列表通过映射函数转换为另一个列表}
 43 def transform mapper xs =
 44     select xs of
 45         case list x tail : list (mapper x) (transform mapper tail)
 46         case empty : empty
 47     end
 48 
 49 {将列表反转}
 50 def reverse xs =
 51     let
 52         def _reverse xs r =
 53             select xs of
 54                 case list x tail : _reverse tail (list x r)
 55                 case empty : r
 56             end
 57     in _reverse xs empty
 58 
 59 {为列表插入分隔符}
 60 def intersperse spliter xs =
 61     select xs of
 62         case list x xtail : 
 63             select xtail of
 64                 case list y ytail : list x (list spliter (intersperse spliter xtail))
 65                 case empty : list x empty
 66             end
 67         case empty : empty
 68     end
 69 
 70 {将“列表的列表”的所有元素连接起来成为一个长的新列表}
 71 def flatten xs =
 72     select xs of
 73         case list x tail : concat x (flatten tail)
 74         case empty : empty
 75     end
 76 
 77 {将两个列表组合成一个pair的列表}
 78 def pairlist as bs =
 79     select as of
 80         case list a atail :
 81             select bs of
 82                 case list b btail : list (pair a b) (pairlist atail btail)
 83                 case empty : empty
 84             end
 85         case empty : empty
 86     end
 87 
 88 {将列表应用到一个左结合操作符上}
 89 def foldl init op xs =
 90     select xs of
 91         case list x tail : foldl (op init x) op tail
 92         case empty : init
 93     end
 94 
 95 {将列表应用到一个右结合操作符上}
 96 def foldr final op xs =
 97     select xs of
 98         case list x tail : op x (foldr final op tail) 
 99         case empty : final
100     end
101 
102 {判断列表的所有元素是否符合某个约束}
103 def all constraint xs = foldl true and (transform constraint xs)
104 
105 {判断列表的是否存在元素是否符合某个约束}
106 def any constraint xs = foldl false or (transform constraint xs)
107 
108 {递归无穷列表}
109 def iterate op init = list init (iterate op (op init))
110 
111 {重复无穷列表}
112 def repeat x = list x (repeat x)
113 
114 {循环无穷列表}
115 def cycle xs = concat xs (cycle xs)
116 
117 {取列表前n个元素组成子列表}
118 def take n xs =
119     if (iequ n 0)
120         empty
121         select xs of
122             case list x tail : list x (take (isub n 1) tail)
123             case empty : empty
124         end
125 
126 {取列表n个元素以后的字列表}
127 def drop n xs =
128     if (iequ n 0)
129         xs
130         select xs of
131             case list x tail : drop (isub n 1) tail
132             case empty : empty
133         end
134 
135 {取列表中符合条件的元素组成的新列表}
136 def takeif constraint xs =
137     select xs of
138         case list x tail : if (constraint x) (list x (takeif constraint tail)) (takeif constraint tail)
139         case empty : empty
140     end
141 
142 {取列表中不符合条件的元素组成的新列表}
143 def dropif constraint xs =
144     select xs of
145         case list x tail : if (constraint x) (dropif constraint tail) (list x (dropif constraint tail))
146         case empty : empty
147     end
148 
149 {判断一个列表是否另一个列表的前缀}
150 def isprefix eq as bs =
151     select as of
152         case list a atail :
153             select bs of
154                 case list b btail : and (eq a b) (isprefix eq atail btail)
155                 case empty : false
156             end
157         case empty : true
158     end
159     
160 {判断一个列表是否另一个列表的后缀}
161 def ispostfix eq as bs = isprefix eq (reverse as) (reverse bs)
162 
163 {取出列表中指定位置的元素}
164 def elemof n xs = if (iequ n 0) (head xs) (elemof (isub n 1) (tail xs))
165 
166 {判断符合条件的元素在列表中的位置}
167 def findfirst constraint xs =
168     let
169         def _findfirst n xs =
170             select xs of
171                 case list x tail : if (constraint x) n (_findfirst (iadd n 1) tail)
172                 case empty : ineg 1
173             end
174     in _findfirst 0 xs
175 
176 {判断符合条件的元素在列表中的位置}
177 def find constraint xs =
178     let
179         def _find indices n xs =
180             select xs of
181                 case list x tail : _find (if (constraint x) (list n indices) indices) (iadd n 1) tail
182                 case empty : indices
183             end
184     in reverse (_find empty 0 xs)
posted on 2008-12-26 08:07 陈梓瀚(vczh) 阅读(2041) 评论(5)  编辑 收藏 引用 所属分类: 脚本技术

评论:
# re: Kernel FP编译器工具实现 2009-01-19 06:36 | jge
你蛮厉害的哦,不过...代码或是思想都挺山寨的...有好处也有坏处,但我的建议是:why not dig into something deeper? i checked out your posts before, of cource you can make your language live easily, but the result is far from satisfaction, especially when you deal with a lazy one:
intuitively a programming language is called `lazy' because it's able to reduce its equivalence relations(say function bindings) from left from right(rewrite) rather than commonly from right to left (calculate). but when we talk about`lazy programming language', we mean `a programming language with full laziness' which ensures every common expression is evaluated at most once. if a full lazy language needs to be *compiled*, the solution is mature and clearly stated in internet known as `super-combinator' which roughly means top level combinator without free variables. to compile your code to `super-combinators', you have to do `lambda-lifting' for all lambda/let/where, then `full-laziness lifting' to all super-combinators, and alpha/beta/eta/peephole reductions. with that super-combinators can be compiled to a VM called G-machine.
well, modern haskell compiler (say GHC) is much more complex from upper process, but the upper one contains *huge* stuff as well and idea is similar: `laziness' composes code node and `pattern matching' decomposes them. i don't even mention the most important stuff: type system. since most memory is located at heap, you can allow every operation that you can imagine in your language because almost everything is the same size : a pointer. like adding two functions, applying a 2-arg function with 3 args. a duck-typeing language simply allows them, but there're more sophisticated solutions. i implied you'd better read some material on Hindley–Milner type system(and System-F) in a previous comment, i don't know if you do, but i don't see much from your posts on the implementions. a flexiable polymorphic type system is the *key* of a functional programming language. if you become a guru on these, then you can contribute to a more modern compiler (say GHC), come on, do learn some lambda-calculus/SystemF first and think deeply, i'm looking forward to your new milestone.
哈哈,我是蛮无聊的,在别人博客上罗嗦,不过思考的深入一点对你有好处,加油。  回复  更多评论
  
# re: Kernel FP编译器工具实现 2009-01-19 06:50 | 陈梓瀚(vczh)
《The Implementation of Functional Programming Language》和类型理论都看过了,G-Machine的指令集根本不算指令,跟x86的模式相差太远了,因此根本就没有解决问题。

不过我这次实现用的是最简单的办法,反正G-Machine的指令集也要构造树,所以我一开始就把树构造好了。这就是我编译的结果是xml的原因了……Kfp是个强类型语言,这造成了一点小麻烦。  回复  更多评论
  
# re: Kernel FP编译器工具实现 2009-01-19 07:28 | jge
G-machine is the only way to effectively *compile* a full-lazy programming language till now, this is also why although haskell development is leaded by MSR Cambridge, but M$ still can't bring it to VisualStudio. interpreting a tree is compilation? and i think the tree G-machine makes during runtime totally differs from your static tree. super-combinators and full-lazy lifting are really slick solutions IMO. you probably need to read the book twice.
i guess `强类型' you mentioned actually means `static typeing', well, according to my knowledge, i don't know any functional pl isn't static...(except LISP which is not only dynamic typeing but also dynamic scopeing, it's not a modern style we want to talk about). type-level polymophism is almost the least requirement for a lazy fp, and this is where the real fun emerges. in modern fp, a type also has `type' called `kind' (although recent haskell implement unifies it with `unsyntactic type coercion'). the book you mentioned is old and uses miranda as example, it can't touch much on type system.
  回复  更多评论
  
# re: Kernel FP编译器工具实现 2009-01-19 07:41 | jge
according to `VisualStudio' above, i mean `dotnet' strictly. 哈哈,不骚扰你了,你的代码让我想起了本科时同样的山寨劲,所以打字多了点。  回复  更多评论
  
# re: Kernel FP编译器工具实现 2009-01-19 07:49 | 陈梓瀚(vczh)
运行时也有一棵树的,所以跟G-Machine是一样的。G-Machine的指令如果你仔细观察的话,会发现分成了两批。至于类型理论,实际上也有另外的两本书讲了,只不过只对语法的设计有指导作用。  回复  更多评论
  

只有注册用户登录后才能发表评论。
网站导航: 博客园   IT新闻   BlogJava   知识库   博问   管理