lanyon-hakyll: Lanyon Theme on Hakyllhttps://github.com/hahey/lanyon-hakyll/atom.xmlHeuna Kimai@heuna-kim.net2024-03-31T00:00:00Z从零开始的CPS编译之旅https://github.com/hahey/lanyon-hakyll/posts/2024-03-31-compiling-with-cps.html2024-03-31T00:00:00Z2024-03-31T00:00:00ZContinuation很好的捕捉了程序控制状态最基本的概念：下一步该做什么。抽象的概念应该与具体的实现无关，而喜欢用GOTO、指针、PC寄存器作为解释，和万物基于C/C++的人都没有领略到这一点。Continuation在社区中貌似一直和LISP的传说同时出现。作为一门不主流的”失败“的编程语言，经常和它一起出现的东西也被大众们贴上了不好的标签。然而当搜寻和最近PL的热门话题Algebraic effect相关的资料时，就会发现delimited continuation的字眼，甚至还有一篇2018年的论文叫做《Capturing the Future by Replaying the Past》。现实一直很荒诞。
出于对CPS的好奇，2023年我完成毕业设计之后，就计划使用CPS作为IR，写一个函数式的编译器。最早参考的是《Compiling with continuation》这本书，在经历了几个月”使用Haskell还是OCaml来实现“的反复横跳之后，同事告诉我，你看的材料有些过时了，应该使用second class而非first class的continuation在IR中抽象程序的控制流，否则很难做到编译的结果是高效的。
dataValue=VarName|I32Int|Unit|Tuple [Name]|ContNameTerm-- env x e|FnName (MaybeName) [Name] Term-- k env x ederiving (Eq, Show, Ord, Read, Data)typeCont=NametypeFunction=NametypeArgument=NametypeClosure=NamedataTerm=LetValNameValueTerm|LetSelNameIntNameTerm|LetContNameNameTermTerm|LetConts [(Name, Value)] Term|LetFns [(Name, Value)] Term|ContinueNameName|ApplyFunctionCont (MaybeClosure) [Argument]|LetPrimNamePrimitive [Name] Term|SwitchName [C.Constant] [Term] (MaybeTerm)|HaltNamederiving (Eq, Show, Ord, Read, Data)simp ::Census->Env->Subst->Term->CompEnvTermsimp census env s p =case p ofLetVal x v l ->if count census x ==0then simp census env s lelsedo v' <- simpVal census env s vLetVal x v' <$> simp census (addEnv env x v') s lLetSel x i y l ->let y' = applySubst s yincaselookup env y' ofJust (Tuple elems) -> simp census env (extendSubst s x (elems !! i)) l _ ->LetSel x i y' <$> simp census env s lLetCont k x l m ->do l' <- simp census env s lcase count census k of0-> simp census env s m _ ->LetCont k x l' <$> simp census (addEnv env k (Cont x l')) s mLetFns fns m ->do fns' <-mapM (\(x, b) -> (x,) <$> simpVal census env s b) fns m' <- simp census env s mpure$LetFns fns' m'Continue k x ->let x' = applySubst s xinlet k' = applySubst s kincaselookup env k' ofJust (Cont y l) -> inst l >>= simp census env (extendSubst s y x') _ ->pure$Continue k' x'Apply f k _ xs ->let f' = applySubst s f k' = applySubst s k xs' =map (applySubst s) xsincaselookup env f' ofJust (Fn k1 _ xs1 l) -> inst l >>= simp census env (extendSubst (extendSubsts s (zip xs1 xs')) k1 k') _ ->pure$Apply f' k' Nothing xs'LetPrim n op ns t ->let fallback = simp census env s tinif count census n ==0then fallbackelselet ns' =map (applySubst s) nsincase (op, mapM (lookup env) ns') of (Primitive.EQ, Just [I32 a, I32 b]) ->let v =if a == b thenI321elseI320inLetVal n v <$> simp census (addEnv env n v) s t (Add2, Just [I32 a, I32 b]) ->let v =I32$ a + b inLetVal n v <$> simp census (addEnv env n v) s t _ ->LetPrim n op ns' <$> fallback
经过进一步的known function分析可以把一些闭包优化掉（参考《Optimizing Closures in O(0) time》）。但是现在更紧急的是，所有的continuation都带上了闭包，每个控制流的转移都需要传递闭包，这显然是不能接受的。
CPS are SSA done right
如何把continuation的闭包全部优化掉，这部分问题困扰了我一周。目前来看，second class continuation无法被当作函数一样被传递，能不能把cont编译成GOTO label，cont apply编译成Jump？后来群友指路EPFL的课程，Intermediate representations这节课的讲义揭示了modern CPS和SSA的关系：
comparison of IRs
In other words, functional IRs based on continuations, like CPS/L3, are SSA done right, in the sense that they avoid introducing the weird (and ultimetely useless) ϕ-functions.
Sub Swap(a AsInteger, b AsInteger)Dim t AsInteger t = a a = b b = tEnd SubSub SelectionSort(Byval arr AsInteger[])Dim A AsIntegerFor Dim i = 0 To arr.Length()-1Dim m AsInteger m = iFor Dim j = i+1 To arr.Length()-1If arr[m] > arr[j] then m = jNext Swap(arr[i], arr[m])NextEnd SubSub PrintArray(Byval ls AsInteger[])For Dim i = 0 To ls.length()-1 Print(ls[i])Next Println(";")End SubSub Main()Dim a AsInteger[] a = [9,8,7,6,5,4,3,2,1] SelectionSort(a) PrintArray(a)End Sub
使用ebc编译test.eb。
注意目前需要使用-p选项手动添加包依赖文件夹。请确保这个文件夹下包含builtin.bkg
ebc test.eb -p C:/Path/To/Bkg/Folder
使用evm运行output.bkg
下面是evoBasic的详细说明。
一般规则
evoBasic是大小写不敏感的
evoBasic语法严格定义换行
注释的语法是 /* 注释 */ 和 //注释
1 语句
1.1 变量定义语句
Dim a As Integer, b as Long
1.2 流程控制语句
1.2.1 选择结构
if exp1 then
...
else if exp2 then
...
else
...
end if
if exp then statement1() else statement2()
if exp then statement1()
目前不支持Select语句。
1.2.2 循环结构
while exp
...
wend
Dim i As Integer
For i = 0 To 100 Step 2
...
Next
//for循环的迭代变量只能是Integer类型
For Dim i = 100 To 0
...
Next
1.2.3 异常抛出与处理语句
Sub Main()
Try
Test()
Catch a As OutOfRangeException //下标越界异常
...
Catch a As ConversionException //转换异常
...
End Try
End Sub
Sub Test()
Throw New OutOfRangeException(10,5)
End Sub
Class MyClass
Public Static Sub MyStaticSub()
End Sub
Private Static A As Integer
End Class
3.4.3 构造函数
Class Layout
Public New(Byval Width As Integer, Byval Height As Integer)
...
End New
End Class
Class Derived Extend Base
Public New(Byval Label As String, Byval Width As Integer, Byval Height As Ineger) Extend(Width,Height)
...
End New
End Class
Class MyFile
Public New(Optional Byval data As Byte[], Optional Byval Path As String, Optional NetPath As String, Optional Byval Empty As Boolen)
If Optional data Then
Else If Optional Path Then
Else if Optional NetPath Then
Else if Optional Empty Then
Else
// throw Error
End if
End New
End Class
Class MyFile
Private New(Optional Byval data As Byte[], Optional Byval Path As String, Optional NetPath As String, Optional Byval Empty As Boolen)
...
End New
Public Static Function FromPath(Byval Path As String) As MyFile
Return New MyFile(Path: Path)
End Function
Public Static Function FromWeb(Byval NetPath As String) As MyFile
Return New MyFile(NetPath: NetPath)
End Function
Public Static Function FromBytes(Byval data As Bytes) As MyFile
Return New MyFile(data: data)
End Function
Public Static Function Create() As MyFile
Return New MyFile(Empty: True)
End Function
End Class
3.4.4 虚函数与多态
Class Animal
Public Virtual Function Bark() As String
Throw New NotImplementedException("Animal.Bark not implemented")
End Function
End Class
Class Dog Extend Animal
Public Override Function Bark() As String
Return "汪"
End Funtion
End Class
Class Cat Extend Animal
Public Override Function Bark() As String
Return "喵"
End Function
End Class
Sub Foo(Byval n1 As Integer, Byval n2 as Integer, Optional Byval a As Integer, Optional b As Integer)
if optional a,b then
...
end if
end sub
Sub Main()
// Foo(1,2,3,4) 错误
Foo(1,2, a: 3, b: 4) //正确
End Sub
Sub Foo(Byval a As String, ParamArray Byval arr As Object[])
...
End Sub
Sub Main()
Foo("第一次输入:",1,2,3,4,5,6)
Dim arr As Object[]
arr = [1,2,3,4,5,6]
Foo("等效的输入:", arr)
End Sub
int[][] floatingPoint = {/*Boolean Byte Short Rune Integer Long Single Double Object*/
/*Boolean*/new int[]{ NA, NA, NA, NA, NA, NA, N, N, NA },
/*Byte*/ new int[]{ NA, NA, NA, NA, NA, NA, Y, Y, NA },
/*Short*/ new int[]{ NA, NA, NA, NA, NA, NA, Y, Y, NA },
/*Rune*/ new int[]{ NA, NA, NA, NA, NA, NA, N, N, NA },
/*Integer*/new int[]{ NA, NA, NA, NA, NA, NA, Y, Y, NA },
/*Long*/ new int[]{ NA, NA, NA, NA, NA, NA, Y, Y, NA },
/*Single*/ new int[]{ N, Y, Y, N, Y, Y, NA, Y, NA },
/*Double*/ new int[]{ N, Y, Y, N, Y, Y, Y, NA, NA },
/*Object*/ new int[]{ NA, NA, NA, NA, NA, NA, NA, NA, NA }
};
Function Foo(Byval A As Object) As Object
Return 5 //装箱
End Function
Sub Main()
Dim a As Object
a = Foo(3.14) //装箱
If a Is Integer Then
Dim num As Integer
num = a As Integer //拆箱
Println(a) //装箱，因为Println函数的参数是Object类型
End If
End Sub
