Kernel FP编译器工具实现

Kernel FP编译器工具实现

    这次终于实现了两个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)