From b70ea890134e49a165cb4767424b511bd5a04087 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 25 Sep 2025 14:01:24 +0200 Subject: [PATCH 01/30] Rename 'Call' to 'StackExpand` in IR, Raw, and Stack This brings the name closer to the actual meaning of this construction. --- compiler/src/ClosureConv.hs | 2 +- compiler/src/IR.hs | 13 +++++++------ compiler/src/IR2Raw.hs | 4 ++-- compiler/src/IROpt.hs | 6 +++--- compiler/src/Raw.hs | 4 ++-- compiler/src/Raw2Stack.hs | 4 ++-- compiler/src/RawDefUse.hs | 2 +- compiler/src/RawOpt.hs | 23 ++++++++++++----------- compiler/src/Stack.hs | 4 ++-- compiler/src/Stack2JS.hs | 2 +- compiler/test/ir2raw-test/testcases/TR.hs | 4 ++-- 11 files changed, 35 insertions(+), 33 deletions(-) diff --git a/compiler/src/ClosureConv.hs b/compiler/src/ClosureConv.hs index d92d4024..4b212f1c 100644 --- a/compiler/src/ClosureConv.hs +++ b/compiler/src/ClosureConv.hs @@ -201,7 +201,7 @@ cpsToIR (CPS.LetSimple vname@(VN ident) st kt) = do cpsToIR (CPS.LetRet (CPS.Cont arg kt') kt) = do t <- cpsToIR kt t' <- local (insVar arg) (cpsToIR kt') - return $ CCIR.BB [] $ Call arg t t' + return $ CCIR.BB [] $ StackExpand arg t t' cpsToIR (CPS.LetFun fdefs kt) = do let vnames_orig = map (\(CPS.Fun fname _) -> fname) fdefs let localExt = local (insVars vnames_orig) diff --git a/compiler/src/IR.hs b/compiler/src/IR.hs index 8621c088..c4836153 100644 --- a/compiler/src/IR.hs +++ b/compiler/src/IR.hs @@ -91,7 +91,7 @@ data IRTerminator -- and then execute the second BB, which can refer to this variable and -- where PC is reset to the level before entering the first BB. -- Represents a "let x = ... in ..." format. - | Call VarName IRBBTree IRBBTree + | StackExpand VarName IRBBTree IRBBTree deriving (Eq,Show,Generic) @@ -147,7 +147,7 @@ instance ComputesDependencies IRBBTree where instance ComputesDependencies IRTerminator where dependencies (If _ bb1 bb2) = mapM_ dependencies [bb1, bb2] dependencies (AssertElseError _ bb1 _ _) = dependencies bb1 - dependencies (Call _ t1 t2) = dependencies t1 >> dependencies t2 + dependencies (StackExpand _ t1 t2) = dependencies t1 >> dependencies t2 dependencies _ = return () instance ComputesDependencies FunDef where @@ -231,15 +231,15 @@ instance WellFormedIRCheck IRInst where wfir (Assign (VN x) e) = do checkId x wfir e wfir (MkFunClosures _ fdefs) = mapM_ (\((VN x), _) -> checkId x) fdefs - + instance WellFormedIRCheck IRTerminator where wfir (If _ bb1 bb2) = do wfir bb1 wfir bb2 wfir (AssertElseError _ bb _ _) = wfir bb - wfir (Call (VN x) bb1 bb2 ) = do - checkId x + wfir (StackExpand (VN x) bb1 bb2 ) = do + checkId x wfir bb1 wfir bb2 @@ -442,7 +442,8 @@ ppIR (MkFunClosures varmap fdefs) = -ppTr (Call vn bb1 bb2) = (ppId vn <+> text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) + +ppTr (StackExpand vn bb1 bb2) = (ppId vn <+> text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) ppTr (AssertElseError va ir va2 _) diff --git a/compiler/src/IR2Raw.hs b/compiler/src/IR2Raw.hs index 7f663c17..6bc633c9 100644 --- a/compiler/src/IR2Raw.hs +++ b/compiler/src/IR2Raw.hs @@ -699,7 +699,7 @@ tr2raw = \case return $ If r bb1' bb2' -- Revision 2023-08: Equivalent, only way of modifying bb2 changed. - IR.Call v irBB1 irBB2 -> do + IR.StackExpand v irBB1 irBB2 -> do bb1 <- tree2raw irBB1 BB insts2 tr2 <- tree2raw irBB2 -- Prepend before insts2 instructions to store in variable v the result @@ -711,7 +711,7 @@ tr2raw = \case -- generally using Sequence (faster concatenation) for instructions -- might improve performance let bb2 = BB insts2' tr2 - return $ Call bb1 bb2 + return $ StackExpand bb1 bb2 -- Note: This is translated into branching and Error for throwing RT exception -- Revision 2023-08: More fine-grained raising of blocking label, see below. diff --git a/compiler/src/IROpt.hs b/compiler/src/IROpt.hs index 610c1f24..f0676ef2 100644 --- a/compiler/src/IROpt.hs +++ b/compiler/src/IROpt.hs @@ -67,7 +67,7 @@ instance Substitutable IRTerminator where AssertElseError (apply subst x) (apply subst bb) (apply subst y) pos LibExport x -> LibExport (apply subst x) Error x pos -> Error (apply subst x) pos - Call decVar bb1 bb2 -> Call decVar (apply subst bb1) (apply subst bb2) + StackExpand decVar bb1 bb2 -> StackExpand decVar (apply subst bb1) (apply subst bb2) instance Substitutable IRBBTree where apply subst (BB insts tr) = @@ -462,7 +462,7 @@ trPeval (AssertElseError x bb y_err pos) = do return $ BB [] (AssertElseError x bb' y_err pos) -trPeval (Call x bb1 bb2) = do +trPeval (StackExpand x bb1 bb2) = do bb1' <- peval bb1 bb2' <- peval bb2 @@ -473,7 +473,7 @@ trPeval (Call x bb1 bb2) = do setChangeFlag return $ BB (insts1 ++ insts2) tr2 _ -> - return $ BB [] (Call x bb1' bb2') + return $ BB [] (StackExpand x bb1' bb2') trPeval tr@(Ret x) = do markUsed' x diff --git a/compiler/src/Raw.hs b/compiler/src/Raw.hs index a9a17046..2f7a5ff9 100644 --- a/compiler/src/Raw.hs +++ b/compiler/src/Raw.hs @@ -158,7 +158,7 @@ data RawTerminator | Error RawVar PosInf -- | Execute the first BB and then execute the second BB where -- PC is reset to the level before entering the first BB. - | Call RawBBTree RawBBTree + | StackExpand RawBBTree RawBBTree deriving (Eq, Show) @@ -341,7 +341,7 @@ ppIR (MkFunClosures varmap fdefs) = -- ppIR (LevelOperations _ insts) = -- text "level operation" $$ nest 2 (vcat (map ppIR insts)) -ppTr (Call bb1 bb2) = (text "call" $$ nest 4 (ppBB bb1)) $$ (ppBB bb2) +ppTr (StackExpand bb1 bb2) = (text "call" $$ nest 4 (ppBB bb1)) $$ (ppBB bb2) -- ppTr (AssertElseError va ir va2 _) diff --git a/compiler/src/Raw2Stack.hs b/compiler/src/Raw2Stack.hs index caf87c3b..b4e892a7 100644 --- a/compiler/src/Raw2Stack.hs +++ b/compiler/src/Raw2Stack.hs @@ -188,7 +188,7 @@ trTr (Raw.LibExport v) = do return $ Stack.LibExport v trTr (Raw.Error r1 p) = do return $ Stack.Error r1 p -trTr (Raw.Call bb1 bb2) = do +trTr (Raw.StackExpand bb1 bb2) = do __callDepth <- localCallDepth <$> ask bb1' <- local (\tenv -> tenv { localCallDepth = __callDepth + 1 } ) $ trBB bb1 n <- getBlockNumber @@ -205,7 +205,7 @@ trTr (Raw.Call bb1 bb2) = do | x <- filter filterConsts (Set.elems varsToLoad) ] bb2'@(Stack.BB inst_2 tr_2) <- trBB bb2 - return $ Stack.Call bb1' (Stack.BB (loads ++ inst_2) tr_2) + return $ Stack.StackExpand bb1' (Stack.BB (loads ++ inst_2) tr_2) trBB :: Raw.RawBBTree -> Tr Stack.StackBBTree diff --git a/compiler/src/RawDefUse.hs b/compiler/src/RawDefUse.hs index c6b7314f..e987b917 100644 --- a/compiler/src/RawDefUse.hs +++ b/compiler/src/RawDefUse.hs @@ -233,7 +233,7 @@ instance Trav RawTerminator where trav bb2 LibExport v -> use v Error r _ -> use r - Call bb1 bb2 -> do + StackExpand bb1 bb2 -> do trav bb1 modify (\s -> let (c, _) = locInfo s diff --git a/compiler/src/RawOpt.hs b/compiler/src/RawOpt.hs index 937dc8be..e7253b77 100644 --- a/compiler/src/RawOpt.hs +++ b/compiler/src/RawOpt.hs @@ -78,7 +78,7 @@ instance Substitutable RawTerminator where If r bb1 bb2 -> If (apply subst r) (apply subst bb1) (apply subst bb2) Error r p -> Error (apply subst r) p - Call bb1 bb2 -> Call (apply subst bb1) (apply subst bb2) + StackExpand bb1 bb2 -> StackExpand (apply subst bb1) (apply subst bb2) _ -> tr instance Substitutable RawBBTree where @@ -420,7 +420,7 @@ instance PEval RawTerminator where } bb2' <- peval bb2 return $ If x bb1' bb2' - Call bb1 bb2 -> do + StackExpand bb1 bb2 -> do s <- get bb1' <- peval bb1 put $ s { stateMon = Map.empty @@ -428,7 +428,7 @@ instance PEval RawTerminator where , stateJoins = stateJoins s } -- reset the monitor state bb2' <- peval bb2 - return $ Call bb1' bb2' + return $ StackExpand bb1' bb2' Ret -> do return tr' TailCall x -> do @@ -470,14 +470,15 @@ filterInstBwd ls = f (Nothing, Nothing) (reverse ls) [] --- | This optimization for 'Call' moves instructions from the continuation to before the 'Call'. --- This can result in a 'Call' which just contains a 'Ret', which is then optimized away. --- The optimization compensates for redundant assignments introduced by the translation. -hoistCalls :: RawBBTree -> RawBBTree -hoistCalls bb@(BB insts tr) = +-- | This optimization for 'StackExpand' moves instructions from the continuation to before the +-- 'StackExpand'. This can result in a 'StackExpand' which just contains a 'Ret', which is then +-- optimized away. The optimization compensates for redundant assignments introduced by the +-- translation. +hoistStackExpand :: RawBBTree -> RawBBTree +hoistStackExpand bb@(BB insts tr) = case tr of -- Here we check which instructions from ii_1 can be moved to before the call - Call (BB ii_1 tr_1) bb2 -> + StackExpand (BB ii_1 tr_1) bb2 -> let isFrameSpecific i = case i of SetBranchFlag -> True @@ -487,7 +488,7 @@ hoistCalls bb@(BB insts tr) = -- jx_1: non-frame-specific instructions, are moved to before the call -- jx_2: frame-specific instructions, stay under the call's instructions (jx_1, jx_2) = Data.List.break isFrameSpecific ii_1 - in BB (insts ++ jx_1) (Call (BB jx_2 tr_1) bb2) + in BB (insts ++ jx_1) (StackExpand (BB jx_2 tr_1) bb2) -- If returning, the current frame will be removed, and thus all PC set instructions -- are redundant and can be removed. Ret -> @@ -537,7 +538,7 @@ instance PEval RawBBTree where If x (BB (set_pc_bl ++ i_then) tr_then) (BB (set_pc_bl ++ i_else) tr_else) - _ -> hoistCalls $ BB (insts_no_ret ++ set_pc_bl) tr'' + _ -> hoistStackExpand $ BB (insts_no_ret ++ set_pc_bl) tr'' let insts_sorted = instOrder insts_ return $ BB insts_sorted bb_ diff --git a/compiler/src/Stack.hs b/compiler/src/Stack.hs index 6427a452..91f3e4f9 100644 --- a/compiler/src/Stack.hs +++ b/compiler/src/Stack.hs @@ -47,7 +47,7 @@ data StackTerminator | If RawVar StackBBTree StackBBTree | LibExport VarAccess | Error RawVar PosInf - | Call StackBBTree StackBBTree + | StackExpand StackBBTree StackBBTree deriving (Eq, Show) @@ -150,7 +150,7 @@ ppIR (MkFunClosures varmap fdefs) = ppIR (LabelGroup insts) = text "group" $$ nest 2 (vcat (map ppIR insts)) -ppTr (Call bb1 bb2) = (text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) +ppTr (StackExpand bb1 bb2) = (text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) -- ppTr (AssertElseError va ir va2 _) diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index 5717b99f..0a11bedd 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -452,7 +452,7 @@ ir2js InvalidateSparseBit = return $ {-- TERMINATORS --} -tr2js (Call bb bb2) = do +tr2js (StackExpand bb bb2) = do _frameSize <- gets frameSize _sparseSlot <- gets sparseSlot _consts <- gets consts diff --git a/compiler/test/ir2raw-test/testcases/TR.hs b/compiler/test/ir2raw-test/testcases/TR.hs index 4800b478..f330a8e0 100644 --- a/compiler/test/ir2raw-test/testcases/TR.hs +++ b/compiler/test/ir2raw-test/testcases/TR.hs @@ -30,8 +30,8 @@ tcs = map (second mkP) (BB [Assign (VN "b1") (Base "v1") ] (LibExport (mkV "b1"))) (BB [Assign (VN "b2") (Base "v2") ] (LibExport (mkV "b2"))) ), - ( "Call" - , Call (VN "x") + ( "StackExpand" + , StackExpand (VN "x") (BB [Assign (VN "b1") (Base "v1") ] (LibExport (mkV "b1"))) (BB [Assign (VN "b2") (Base "v2") ] (LibExport (mkV "b2"))) ), From e2de25d636f1032515c8c43499159b57496e7a5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 25 Sep 2025 16:33:27 +0200 Subject: [PATCH 02/30] Improve lib record export syntax This way, is is less likely one by accident exports the wrong function under a different name --- lib/Hash.trp | 16 +++++++-------- lib/HashMap.trp | 32 +++++++++++++---------------- lib/HashSet.trp | 26 ++++++++++-------------- lib/List.trp | 47 ++++++++++++++++++------------------------- lib/ListPair.trp | 31 +++++++++++++--------------- lib/Number.trp | 39 ++++++++++++++++++----------------- lib/StencilVector.trp | 38 +++++++++++++++++----------------- lib/String.trp | 23 +++++++++++---------- lib/Unit.trp | 14 ++++++------- 9 files changed, 123 insertions(+), 143 deletions(-) diff --git a/lib/Hash.trp b/lib/Hash.trp index 5a4b0d90..f10ec7b0 100644 --- a/lib/Hash.trp +++ b/lib/Hash.trp @@ -68,15 +68,13 @@ let (*--- Module ---*) val Hash = { - hashString = hashString, - hashMultiplyShift = hashMultiplyShift, - hashInt = hashInt, - hashNumber = hashNumber, - hashList = hashList, - hash = hash + hashString, + hashMultiplyShift, + hashInt, + hashNumber, + hashList, + hash } -in [ ("Hash", Hash) - , ("hash", hash) - ] +in [ ("Hash", Hash), ("hash", hash) ] end diff --git a/lib/HashMap.trp b/lib/HashMap.trp index 43358544..a8e25072 100644 --- a/lib/HashMap.trp +++ b/lib/HashMap.trp @@ -202,24 +202,20 @@ let (* NOTE: The map is implemented as a Hash Array Mapped Trie (HAMT), i.e. a p (*--- Module ---*) val HashMap = { - (* Construction *) - empty = empty, - singleton = singleton, - insert = insert, - remove = remove, - (* Queries *) - null = null, - size = size, - findOpt = findOpt, - find = find, - mem = mem, - (* Manipulation *) - fold = fold, - (* List Conversion*) - keys = keys, - values = values, - toList = toList, - fromList = fromList + empty, + singleton, + insert, + remove, + null, + size, + findOpt, + find, + mem, + fold, + keys, + values, + toList, + fromList } in [ ("HashMap", HashMap) ] diff --git a/lib/HashSet.trp b/lib/HashSet.trp index 0ffccbc5..ccad42d0 100644 --- a/lib/HashSet.trp +++ b/lib/HashSet.trp @@ -47,21 +47,17 @@ let (* NOTE: The set is implemented as a HashMap with dummy values, `()`. This i (*--- Module ---*) val HashSet = { - (* Construction *) - empty = empty, - singleton = singleton, - insert = insert, - remove = remove, - (* Queries *) - null = null, - size = size, - mem = mem, - (* Manipulation *) - fold = fold, - (* List Conversion*) - elems = elems, - toList = toList, - fromList = fromList + empty, + singleton, + insert, + remove, + null, + size, + mem, + fold, + elems, + toList, + fromList } in [ ("HashSet", HashSet) ] diff --git a/lib/List.trp b/lib/List.trp index 872936e9..775007e3 100644 --- a/lib/List.trp +++ b/lib/List.trp @@ -169,33 +169,26 @@ let (* -- List Access -- *) (*--- Module ---*) val List = { - head = head, - tail = tail, - nth = nth, - - null = null, - elem = elem, - length = length, - - reverse = reverse, - append = append, - revAppend = revAppend, - appendAt = appendAt, - sublist = sublist, - - map = map, - mapi = mapi, - foldl = foldl, - filter = filter, - filteri = filteri, - partition = partition, - - range = range, - - sort = sort + head, + tail, + nth, + null, + elem, + length, + reverse, + append, + revAppend, + appendAt, + sublist, + map, + mapi, + foldl, + filter, + filteri, + partition, + range, + sort } -in [ ("List", List), - ("length", length) - ] +in [ ("List", List), ("length", length) ] end diff --git a/lib/ListPair.trp b/lib/ListPair.trp index 20d03ca6..94b54eed 100644 --- a/lib/ListPair.trp +++ b/lib/ListPair.trp @@ -64,22 +64,19 @@ let (* -- ListPair Generation -- *) (*--- Module ---*) val ListPair = { - zip = zip, - unzip = unzip, - - null = null, - length = length, - - reverse = reverse, - append = append, - revAppend = revAppend, - - findOpt = findOpt, - find = find, - mem = mem, - - map = map, - foldl = foldl + zip, + unzip, + null, + length, + reverse, + append, + revAppend, + findOpt, + find, + mem, + map, + foldl } -in [ ("ListPair", ListPair) ] end +in [ ("ListPair", ListPair) ] +end diff --git a/lib/Number.trp b/lib/Number.trp index ad9b7527..a8867220 100644 --- a/lib/Number.trp +++ b/lib/Number.trp @@ -93,25 +93,26 @@ let (** Largest (safe) possible integral value. Anything larger than this cannot (*--- Module ---*) val Number = { - maxInt = maxInt, - minInt = minInt, - precision = precision, - maxInt32 = maxInt32, - minInt32 = minInt32, - maxNum = maxNum, - minNum = minNum, - abs = abs, - min = min, - max = max, - ceil = ceil, - floor = floor, - round = round, - sqrt = sqrt, - isInt = isInt, - toInt = toInt, - toInt32 = toInt32, - toString = toString, - fromString = fromString + maxInt, + minInt, + precision, + maxInt32, + minInt32, + maxNum, + minNum, + abs, + min, + max, + ceil, + floor, + round, + sqrt, + isInt, + toInt, + toInt32, + toString, + fromString } + in [("Number", Number)] end diff --git a/lib/StencilVector.trp b/lib/StencilVector.trp index a272bc91..f73701cc 100644 --- a/lib/StencilVector.trp +++ b/lib/StencilVector.trp @@ -146,26 +146,24 @@ let (*--- Constants ---*) (* TODO: Lift list functions `mapi`, `find` and `filter`? *) + (*--- Module ---*) val StencilVector = { - (* Constants *) - maskBits = maskBits, - maskMax = maskMax, - (* Functions *) - empty = empty, - singleton = singleton, - get = get, - getOrDefault = getOrDefault, - set = set, - unset = unset, - mem = mem, - valid = valid, - null = null, - mask = mask, - length = length, - map = map, - fold = fold + maskBits, + maskMax, + empty, + singleton, + get, + getOrDefault, + set, + unset, + mem, + valid, + null, + mask, + length, + map, + fold } -in (* Export public functions *) - [ ("StencilVector", StencilVector) - ] + +in [ ("StencilVector", StencilVector) ] end diff --git a/lib/String.trp b/lib/String.trp index b275f776..2dfe068e 100644 --- a/lib/String.trp +++ b/lib/String.trp @@ -70,17 +70,18 @@ let (** The maximum length of a string. (*--- Module ---*) val String = { - maxSize = maxSize, - size = size, - sub = sub, - subCode = subCode, - substring = substring, - concat = concat, - concatWith = concatWith, - implode = implode, - explode = explode, - map = map, - translate = translate + maxSize, + size, + sub, + subCode, + substring, + concat, + concatWith, + implode, + explode, + map, + translate } + in [("String", String)] end diff --git a/lib/Unit.trp b/lib/Unit.trp index 483d32ac..f4b49eba 100644 --- a/lib/Unit.trp +++ b/lib/Unit.trp @@ -112,13 +112,13 @@ let (*--- Module ---*) val Unit = { - group = group, - it = it, - isEq = isEq, - isTrue = isTrue, - isFalse = isFalse, - isNeq = isNeq, - run = run + group, + it, + isEq, + isTrue, + isFalse, + isNeq, + run } in [ ("Unit", Unit) ] From 4cbdaeef4b6ca96d3e4bf235c7616c2ad36cdc19 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Fri, 26 Sep 2025 10:30:43 +0200 Subject: [PATCH 03/30] Manifest design of the Standard Library in its README --- lib/README.md | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/lib/README.md b/lib/README.md index ea43f188..44119947 100644 --- a/lib/README.md +++ b/lib/README.md @@ -21,13 +21,19 @@ reviewed rigorously rather than depend on the monitor. To compile a module as part of the standard library, add it to the list of files in the `lib` target of the *makefile*. +## Design Principles + +- File names are written in `CamelCase`. This makes them conform to the Standard ML Basis Library. +- It is more important to match the function names and signatures in the Standard ML library than to + improve on them. For example, `String.sub` would make more sense with the type `[Char] -> Int -> + Char` but to match the SML library, we will stick with `[Char] * Int -> Char`. +- Each module exports a single *record* with the same name as the file. This (1) makes it closer to + the SML module system and (2) allows for name resolution, e.g. `HashMap.findOpt` and + `ListPair.findOpt` can be used in the same file. +- Each function that is exported has to be documented (`(** *)`). In the long run, we will + auto-generate documentation for the Standard Library. + ## TODO -- To conform with the Standard ML Basis Library, we should have the files conform to a `CamelCase` - style. -- To fake namespaced import, e.g. `List.length`, the library should export a struct instead. Only - certain functions should "pollute" the global namespace. -- Quite a lot of the standard library is not documented in any way. What is the purpose of each - function and each module? The [modules](#modules) above are the ones that have been updated and - documented. -- There are a lot of things in here - some of it dead. Can we merge/remove some things? +The [modules](#modules) mentioned above already follow the [design principles](#design-principles). +The remaining files either need to be updated or to be removed. From a426bb8140dd32f8b47e9b60f0af9a0610e408a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:36:16 +0200 Subject: [PATCH 04/30] Set up Dependabot to keep an eye on Action dependencies --- .github/dependabot.yml | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 .github/dependabot.yml diff --git a/.github/dependabot.yml b/.github/dependabot.yml new file mode 100644 index 00000000..5ace4600 --- /dev/null +++ b/.github/dependabot.yml @@ -0,0 +1,6 @@ +version: 2 +updates: + - package-ecosystem: "github-actions" + directory: "/" + schedule: + interval: "weekly" From f86177bc770bf398b95857b78946780f9b07b8fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:45:46 +0200 Subject: [PATCH 05/30] Fix 'Data.ByteString.getLine' is deprecated --- compiler/app/Main.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index fd007e2b..400fa6f5 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -21,9 +21,8 @@ import qualified Raw2Stack import qualified Stack2JS import qualified RawOpt -- import System.IO (isEOF) -import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS import Data.ByteString.Base64 (decode) -import qualified Data.ByteString.Char8 as BSChar8 import qualified Data.ByteString.Lazy.Char8 as BSLazyChar8 import System.IO import System.Exit @@ -220,7 +219,7 @@ fromStdinIR = do input <- BS.getLine if BS.isPrefixOf "!ECHO " input then let response = BS.drop 6 input - in do BSChar8.putStrLn response + in do BS.putStrLn response -- debugOut "echo" else case decode input of @@ -244,7 +243,7 @@ fromStdinIRJson = do input <- BS.getLine if BS.isPrefixOf "!ECHO " input then let response = BS.drop 6 input - in BSChar8.putStrLn response + in BS.putStrLn response else case decode input of Right bs -> From fa4c2506ac9b454be06a78c5b6d8edfd624693ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:54:32 +0200 Subject: [PATCH 06/30] Rename 'make all' to 'make build' to match conventions --- Makefile | 2 +- compiler/Makefile | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 0012dafc..ebcdc384 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ rt: COMPILER=./bin/troupec compiler: - cd compiler; $(MAKE) all + cd compiler; $(MAKE) build p2p-tools: cd p2p-tools; tsc diff --git a/compiler/Makefile b/compiler/Makefile index 216554ec..4bacb78d 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,6 +1,6 @@ .PHONY: test -all: +build: stack -v build $(STACK_OPTS) mkdir -p ./../bin stack -v install $(STACK_OPTS) --local-bin-path ./../bin/ From fe29c80afeca16a683fcb658bb72baa0f286a21b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:55:42 +0200 Subject: [PATCH 07/30] Remove verbosity if not otherwise requested --- compiler/Makefile | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/Makefile b/compiler/Makefile index 4bacb78d..2ef4c261 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,9 +1,12 @@ .PHONY: test +build: VERBOSITY_FLAG = build: - stack -v build $(STACK_OPTS) + stack $(VERBOSITY_FLAG) build $(STACK_OPTS) mkdir -p ./../bin - stack -v install $(STACK_OPTS) --local-bin-path ./../bin/ + stack $(VERBOSITY_FLAG) install $(STACK_OPTS) --local-bin-path ./../bin/ +build/verbose: + $(MAKE) $(MAKE_FLAGS) build VERBOSITY_FLAG="-v" clean: rm *.cabal From 98195c12b4082591959c9f63fd20dd7a8e5724a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 17:04:19 +0200 Subject: [PATCH 08/30] Separate build step from installation (readding 'all' target) --- Makefile | 2 +- compiler/Makefile | 12 ++++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index ebcdc384..0012dafc 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ rt: COMPILER=./bin/troupec compiler: - cd compiler; $(MAKE) build + cd compiler; $(MAKE) all p2p-tools: cd p2p-tools; tsc diff --git a/compiler/Makefile b/compiler/Makefile index 2ef4c261..be9ca64e 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,13 +1,21 @@ .PHONY: test +all: build install + build: VERBOSITY_FLAG = build: stack $(VERBOSITY_FLAG) build $(STACK_OPTS) - mkdir -p ./../bin - stack $(VERBOSITY_FLAG) install $(STACK_OPTS) --local-bin-path ./../bin/ build/verbose: $(MAKE) $(MAKE_FLAGS) build VERBOSITY_FLAG="-v" +install: VERBOSITY_FLAG = +install: + $(MAKE) $(MAKE_FLAGS) build + mkdir -p ./../bin + stack $(VERBOSITY_FLAG) install $(STACK_OPTS) --local-bin-path ./../bin/ +install/verbose: + $(MAKE) $(MAKE_FLAGS) install VERBOSITY_FLAG="-v" + clean: rm *.cabal stack clean --full From 9c4c3fa623f36faac5d35855ddd22cb26d57b48f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Tue, 30 Sep 2025 11:00:45 +0200 Subject: [PATCH 09/30] Move 'ghci' targets to the end and differentiate with '/' rather than '-' --- compiler/Makefile | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/Makefile b/compiler/Makefile index be9ca64e..47df99ca 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -22,14 +22,14 @@ clean: rm -rf ../bin # If problems still persist after this, remove all GHC compilers in ~/.stack/programs/**/ -ghci-irtester: - stack ghci --main-is Troupe-compiler:exe:irtester --no-load - -ghci-troupec: - stack ghci --main-is Troupe-compiler:exe:troupec --no-load - test: stack test $(STACK_OPTS) parser-info: stack exec happy -- -i src/Parser.y + +ghci/irtester: + stack ghci --main-is Troupe-compiler:exe:irtester --no-load + +ghci/troupec: + stack ghci --main-is Troupe-compiler:exe:troupec --no-load From c86866dd734c7a5951f8f25f11206ba155305a3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 1 Oct 2025 11:00:15 +0200 Subject: [PATCH 10/30] Some clean up in Stack2JS --- compiler/src/Stack2JS.hs | 40 ++++++++++++++-------------------------- 1 file changed, 14 insertions(+), 26 deletions(-) diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index 0a11bedd..161553e8 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -60,45 +60,33 @@ import DCLabels (dcLabelExpToDCLabel) data LibAccess = LibAccess Basics.LibName Basics.VarName deriving (Eq, Show,Generic) - -data JSOutput = JSOutput { libs :: [LibAccess] - , fname:: Maybe String - , code :: String - , atoms :: [Basics.AtomName] - } deriving (Show, Generic) - -instance Aeson.ToJSON Basics.LibName +instance Aeson.ToJSON Basics.LibName instance Aeson.ToJSON LibAccess -instance Aeson.ToJSON JSOutput - -ppLibAccess :: LibAccess -> PP.Doc -ppLibAccess (LibAccess (Basics.LibName libname) varname) = PP.braces $ - PP.text "lib:" <+> (PP.doubleQuotes. PP.text) libname <+> PP.text "," <+> - PP.text "decl:" <+> (PP.doubleQuotes. PP.text) varname - - -ppLibs :: [LibAccess] -> PP.Doc -ppLibs libs = PP.brackets $ - vcat $ PP.punctuate (text ",") - $ map ppLibAccess (nub libs) jsLoadLibs = vcat $ map text [ "this.libSet = new Set ()", "this.libs = []", "this.addLib = function (lib, decl) { if (!this.libSet.has (lib +'.'+decl)) { this.libSet.add (lib +'.'+decl); this.libs.push ({lib:lib, decl:decl})} }", "this.loadlibs = function (cb) { rt.linkLibs (this.libs, this, cb) }" ] - - -addOneLib (LibAccess (Basics.LibName libname) varname) = - let args = (PP.doubleQuotes.PP.text) libname <+> text "," <+> (PP.doubleQuotes. PP.text) varname - in text "this.addLib " <+> PP.parens args addLibs xs = vcat $ nub (map addOneLib xs) + where addOneLib (LibAccess (Basics.LibName libname) varname) = + let args = (PP.doubleQuotes.PP.text) libname <+> text "," <+> (PP.doubleQuotes. PP.text) varname + in text "this.addLib " <+> PP.parens args + + +data JSOutput = JSOutput { libs :: [LibAccess] + , fname:: Maybe String + , code :: String + , atoms :: [Basics.AtomName] + } deriving (Show, Generic) + +instance Aeson.ToJSON JSOutput data TheState = TheState { freshCounter :: Integer , frameSize :: Int - , sparseSlot :: Int + , sparseSlot :: Int , consts :: Raw.Consts , stHFN :: IR.HFN } From a33a6e9952eb11a85cb1e9a1585352d045349099 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 1 Oct 2025 13:34:41 +0200 Subject: [PATCH 11/30] Fix misalignment --- compiler/app/Main.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index 400fa6f5..092b32b5 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -57,14 +57,14 @@ data Flag options :: [OptDescr Flag] options = - [ Option ['i'] ["ir"] (NoArg IRMode) "ir interactive mode" - , Option ['j'] ["json"] (NoArg JSONIRMode) "ir json interactive mode" - , Option [] ["no-rawopt"] (NoArg NoRawOpt) "disable Raw optimization" - , Option ['v'] ["verbose"] (NoArg Verbose) "verbose output" - , Option ['d'] ["debug"] (NoArg Debug) "debugging information in the .js file" - , Option ['l'] ["lib"] (NoArg LibMode) "compiling a library" - , Option ['h'] ["help"] (NoArg Help) "print usage" - , Option ['o'] ["output"] (ReqArg OutputFile "FILE") "output FILE" + [ Option ['i'] ["ir"] (NoArg IRMode) "ir interactive mode" + , Option ['j'] ["json"] (NoArg JSONIRMode) "ir json interactive mode" + , Option [] ["no-rawopt"] (NoArg NoRawOpt) "disable Raw optimization" + , Option ['v'] ["verbose"] (NoArg Verbose) "verbose output" + , Option ['d'] ["debug"] (NoArg Debug) "debugging information in the .js file" + , Option ['l'] ["lib"] (NoArg LibMode) "compiling a library" + , Option ['h'] ["help"] (NoArg Help) "print usage" + , Option ['o'] ["output"] (ReqArg OutputFile "FILE") "output FILE" ] -- debugTokens (Right tks) = From 61230b631d94ba6de834e9c5b355a61a6f3c5a88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 1 Oct 2025 13:47:39 +0200 Subject: [PATCH 12/30] Fix whitespace and some comments --- compiler/app/Main.hs | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index 092b32b5..55d1726a 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -131,15 +131,11 @@ process flags fname input = do ir <- case runExcept (CC.closureConvert compileMode rwcps) of Right ir -> return ir Left s -> die $ "troupec: " ++ s - - - when verbose $ writeFileD "out/out.ir" (show ir) let iropt = IROpt.iropt ir when verbose $ writeFileD "out/out.iropt" (show iropt) - -------------------------------------------------- let debugOut = elem Debug flags @@ -169,23 +165,19 @@ process flags fname input = do let jsFile = outFile flags (fromJust fname) writeFile jsFile stackjs - + ----- MODULE ---------------------------------------- case exports of Nothing -> return () Just es -> writeExports jsFile es - when verbose printHr + ----- EPILOGUE -------------------------------------- + when verbose printHr exitSuccess - - - writeExports jsF exports = let exF' = if takeExtension jsF == ".js" then dropExtension jsF else jsF in writeFileD (exF' ++ ".exports") (intercalate "\n" exports) - - defaultName f = let ext = ".trp" in concat [ takeDirectory f @@ -193,7 +185,6 @@ defaultName f = , if takeExtension f == ext then takeBaseName f else takeFileName f ] - isOutFlag (OutputFile _) = True isOutFlag _ = False From 2f1fb2b61f46b7516399f6c2d3658651eac83fa6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 1 Oct 2025 13:48:20 +0200 Subject: [PATCH 13/30] Fix typo 'GENARTING' --- compiler/app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index 55d1726a..ae06677e 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -159,7 +159,7 @@ process flags fname input = do ----- STACK ---------------------------------------- let stack = Raw2Stack.rawProg2Stack rawopt - when verbose $ printSep "GENARTING STACK" + when verbose $ printSep "GENERATING STACK" when verbose $ writeFileD "out/out.stack" (show stack) let stackjs = Stack2JS.irProg2JSString compileMode debugOut stack let jsFile = outFile flags (fromJust fname) From 09ea1fe95b306fca6dffaffc993915a626e7d128 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 1 Oct 2025 15:06:19 +0200 Subject: [PATCH 14/30] Comments, formatting, and clean up of Main.hs pipeline --- compiler/app/Main.hs | 163 ++++++++++++++++++------------------------- 1 file changed, 68 insertions(+), 95 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index ae06677e..bd7be1cb 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -38,12 +38,9 @@ import Data.List as List import Data.Maybe (fromJust) import System.FilePath --- import System.Console.Haskeline --- import System.Process +-------------------------------------------------------------------------------- +----- COMPILER FLAGS ----------------------------------------------------------- - --- compiler flags --- data Flag = IRMode | JSONIRMode @@ -67,13 +64,11 @@ options = , Option ['o'] ["output"] (ReqArg OutputFile "FILE") "output FILE" ] --- debugTokens (Right tks) = - -- mapM_ print tks +-------------------------------------------------------------------------------- +----- PIPELINE FROM FLAGS TO IR AND JS ----------------------------------------- process :: [Flag] -> Maybe String -> String -> IO ExitCode process flags fname input = do - -- let tokens = parseTokens input - -- debugTokens tokens let ast = parseProg input let compileMode = @@ -85,49 +80,56 @@ process flags fname input = do case ast of Left err -> do - -- putStrLn ("Tokens: " ++ show tokens) die $ "Parse Error:\n" ++ err Right prog_parsed -> do - let prog_empty_imports = - case compileMode of - Normal -> addAmbientMethods prog_parsed - Export -> prog_parsed - prog <- processImports prog_empty_imports - + let outPath = outFile flags (fromJust fname) + + -- To print all tokens from the parser, uncomment the following line: + -- debugTokens (Right tks) = mapM_ print tks + + ------------------------------------------------------ + -- TROUPE (FRONTEND) --------------------------------- + let prog_without_dependencies = + case compileMode of + Normal -> addAmbientMethods prog_parsed + Export -> prog_parsed + + prog <- (processImports) prog_without_dependencies + exports <- case compileMode of Normal -> return Nothing Export -> case runExcept (extractExports prog) of Right es -> return (Just (es)) Left s -> die s - when verbose $ do printSep "SYNTAX" putStrLn (showIndent 2 prog) - - -------------------------------------------------- + ------------------------------------------------------ prog' <- case runExcept (C.trans compileMode (AF.visitProg prog)) of Right p -> return p Left s -> die s when verbose $ do printSep "PATTERN MATCH ELIMINATION" writeFileD "out/out.nopats" (showIndent 2 prog') - -------------------------------------------------- + ------------------------------------------------------ let lowered = Core.lowerProg prog' when verbose $ do printSep "LOWERING FUNS AND LETS" writeFileD "out/out.lowered" (showIndent 2 lowered) - -------------------------------------------------- + ------------------------------------------------------ let renamed = Core.renameProg lowered when verbose $ do printSep "α RENAMING" writeFileD "out/out.alpha" (showIndent 2 renamed) - -------------------------------------------------- + ------------------------------------------------------ let cpsed = RetDFCPS.transProg renamed when verbose $ do printSep "CPSED" writeFileD "out/out.cps" (showIndent 2 cpsed) - -------------------------------------------------- - let rwcps = CPSOpt.rewrite cpsed -- Rewrite.rewrite cpsed + ------------------------------------------------------ + let rwcps = CPSOpt.rewrite cpsed when verbose $ do printSep "REWRITING CPS" writeFileD "out/out.cpsopt" (showIndent 2 rwcps) - -------------------------------------------------- + + ------------------------------------------------------ + ------ IR (BACKEND) ---------------------------------- ir <- case runExcept (CC.closureConvert compileMode rwcps) of Right ir -> return ir Left s -> die $ "troupec: " ++ s @@ -137,116 +139,87 @@ process flags fname input = do let iropt = IROpt.iropt ir when verbose $ writeFileD "out/out.iropt" (show iropt) - -------------------------------------------------- - let debugOut = elem Debug flags - - - ------ RAW ----------------------------------------- + ------ RAW ------------------------------------------- let raw = IR2Raw.prog2raw iropt when verbose $ printSep "GENERATING RAW" when verbose $ writeFileD "out/out.rawout" (show raw) - ----- RAW OPT -------------------------------------- - + ----- RAW OPT ---------------------------------------- rawopt <- do - if noRawOpt - then return raw - else do - let opt = RawOpt.rawopt raw - when verbose $ printSep "OPTIMIZING RAW OPT" - when verbose $ writeFileD "out/out.rawopt" (show opt) - return opt - - ----- STACK ---------------------------------------- + if noRawOpt + then return raw + else do + let opt = RawOpt.rawopt raw + when verbose $ printSep "OPTIMIZING RAW OPT" + when verbose $ writeFileD "out/out.rawopt" (show opt) + return opt + + ----- STACK ------------------------------------------ let stack = Raw2Stack.rawProg2Stack rawopt when verbose $ printSep "GENERATING STACK" when verbose $ writeFileD "out/out.stack" (show stack) - let stackjs = Stack2JS.irProg2JSString compileMode debugOut stack - let jsFile = outFile flags (fromJust fname) - writeFile jsFile stackjs - ----- MODULE ---------------------------------------- + ----- JAVASCRIPT ------------------------------------- + let stackjs = Stack2JS.irProg2JSString compileMode (Debug `elem` flags) stack + writeFile outPath stackjs + case exports of Nothing -> return () - Just es -> writeExports jsFile es + Just es -> writeExports outPath es ----- EPILOGUE -------------------------------------- when verbose printHr exitSuccess -writeExports jsF exports = - let exF' = if takeExtension jsF == ".js" then dropExtension jsF else jsF - in writeFileD (exF' ++ ".exports") (intercalate "\n" exports) - -defaultName f = - let ext = ".trp" - in concat [ takeDirectory f - , "/out/" - , if takeExtension f == ext then takeBaseName f else takeFileName f - ] - -isOutFlag (OutputFile _) = True -isOutFlag _ = False - +-- TODO: 'where' for all helper functions below? outFile :: [Flag] -> String -> String -outFile flags fname | LibMode `elem` flags = - case List.find isOutFlag flags of +outFile flags fname = case List.find isOutFlag flags of Just (OutputFile s) -> s - _ -> defaultName fname ++ ".js" -outFile flags _ = - case List.find isOutFlag flags of - Just (OutputFile s) -> s - _ -> "out/out.stack.js" + _ -> if LibMode `elem` flags + then defaultName fname ++ ".js" + else "out/out.stack.js" + where isOutFlag (OutputFile _) = True + isOutFlag _ = False + defaultName f = concat [ takeDirectory f + , "/out/" + , if takeExtension f == ".trp" then takeBaseName f else takeFileName f + ] --- AA: 2018-07-15: consider timestamping these entries -debugOut s = - appendFile "/tmp/debug" (s ++ "\n") +writeExports path exports = + let path' = if takeExtension path == ".js" then dropExtension path else path + in writeFileD (path' ++ ".exports") (intercalate "\n" exports) +-------------------------------------------------------------------------------- +----- DESERIALIZATION FOR INTERACTIVE MODES ------------------------------------ -fromStdinIR = do +fromStdin putFormattedLn = do eof <- isEOF if eof then exitSuccess else do input <- BS.getLine if BS.isPrefixOf "!ECHO " input then let response = BS.drop 6 input in do BS.putStrLn response --- debugOut "echo" else case decode input of Right bs -> case CCIR.deserialize bs - of Right x -> do putStrLn (IR2JS.irToJSString x) --- debugOut "deserialization OK" - + of Right x -> do putFormattedLn x Left s -> do putStrLn "ERROR in deserialization" debugOut $ "deserialization error" ++ s Left s -> do putStrLn "ERROR in B64 decoding" debugOut $ "decoding error" ++s putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa hFlush stdout - fromStdinIR + fromStdin putFormattedLn + -- AA: 2018-07-15: consider timestamping these entries + where debugOut s = appendFile "/tmp/debug" (s ++ "\n") +fromStdinIR = fromStdin (putStrLn . IR2JS.irToJSString) +fromStdinIRJson = fromStdin (BSLazyChar8.putStrLn . IR2JS.irToJSON) -fromStdinIRJson = do - eof <- isEOF - if eof then exitSuccess else do - input <- BS.getLine - if BS.isPrefixOf "!ECHO " input - then let response = BS.drop 6 input - in BS.putStrLn response - else - case decode input of - Right bs -> - case CCIR.deserialize bs - of Right x -> BSLazyChar8.putStrLn (IR2JS.irToJSON x) - Left s -> do putStrLn "ERROR in deserialization" - debugOut $ "deserialization error" ++ s - Left s -> do putStrLn "ERROR in B64 decoding" - debugOut $ "decoding error" ++s - putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa - hFlush stdout - fromStdinIRJson +-------------------------------------------------------------------------------- +----- MAIN --------------------------------------------------------------------- main :: IO ExitCode main = do From 91dc8e37703f5f69dd1f13159d431cba7143d4c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 12:18:27 +0200 Subject: [PATCH 15/30] Move compilation of 'trp-rt/' into the subfolder --- .github/workflows/run_tests.yml | 4 ++-- .gitignore | 1 - Makefile | 14 +++++++------- trp-rt/.gitignore | 1 + trp-rt/Makefile | 9 +++++++++ 5 files changed, 19 insertions(+), 10 deletions(-) create mode 100644 trp-rt/.gitignore create mode 100644 trp-rt/Makefile diff --git a/.github/workflows/run_tests.yml b/.github/workflows/run_tests.yml index e1ab935f..154d9dd6 100644 --- a/.github/workflows/run_tests.yml +++ b/.github/workflows/run_tests.yml @@ -108,8 +108,8 @@ jobs: echo "Runtime built successfully, troupe.mjs found" - name: compile lib run: make lib - - name: compile service - run: make service + - name: compile trp-rt + run: make trp-rt - name: run basic test run: ./local.sh tests/rt/pos/core/fib10.trp - name: run ci network test diff --git a/.gitignore b/.gitignore index 3d381d7d..d002a09e 100644 --- a/.gitignore +++ b/.gitignore @@ -31,5 +31,4 @@ yarn-error.log *.swp bin/troupe bin/understudy -trp-rt/out/ *.#* diff --git a/Makefile b/Makefile index 0012dafc..28b76d54 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ -.PHONY: rt compiler lib p2p-tools +.PHONY: rt trp-rt compiler lib p2p-tools # TODO: Rename to 'build/*' ? -all: npm rt compiler p2p-tools lib service +all: npm compiler rt trp-rt p2p-tools lib npm: npm install @@ -20,16 +20,16 @@ p2p-tools: lib: cd lib; $(MAKE) build -service: - mkdir -p ./trp-rt/out - $(COMPILER) ./trp-rt/service.trp -l +trp-rt: + cd trp-rt/; $(MAKE) build -# TODO: Rename to 'clean/*' ? -clean: clean/compiler clean/rt clean/lib +clean: clean/compiler clean/rt clean/trp-rt clean/p2p-tools clean/lib clean/compiler: cd compiler; $(MAKE) clean clean/rt: cd rt; $(MAKE) clean +clean/trp-rt: + cd lib; $(MAKE) clean clean/p2p-tools: cd p2p-tools; $(MAKE) clean clean/lib: diff --git a/trp-rt/.gitignore b/trp-rt/.gitignore new file mode 100644 index 00000000..e2e7327c --- /dev/null +++ b/trp-rt/.gitignore @@ -0,0 +1 @@ +/out diff --git a/trp-rt/Makefile b/trp-rt/Makefile new file mode 100644 index 00000000..84c725c5 --- /dev/null +++ b/trp-rt/Makefile @@ -0,0 +1,9 @@ +COMPILER=../bin/troupec + +build: + mkdir -p out + # Standard Library + $(COMPILER) ./service.trp -l + +clean: + rm -rf out From 168d7d3d320c547c57c1e1543059092a0c96af3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 10:18:46 +0200 Subject: [PATCH 16/30] Remove 'troupec -l' option short-hand This frees '-l' up to be used for a '--link' later --- compiler/app/Main.hs | 2 +- lib/Makefile | 38 +++++++++++++++++++------------------- trp-rt/Makefile | 2 +- 3 files changed, 21 insertions(+), 21 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index bd7be1cb..c700e446 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -59,7 +59,7 @@ options = , Option [] ["no-rawopt"] (NoArg NoRawOpt) "disable Raw optimization" , Option ['v'] ["verbose"] (NoArg Verbose) "verbose output" , Option ['d'] ["debug"] (NoArg Debug) "debugging information in the .js file" - , Option ['l'] ["lib"] (NoArg LibMode) "compiling a library" + , Option [] ["lib"] (NoArg LibMode) "compiling a library" , Option ['h'] ["help"] (NoArg Help) "print usage" , Option ['o'] ["output"] (ReqArg OutputFile "FILE") "output FILE" ] diff --git a/lib/Makefile b/lib/Makefile index e8942aca..c75d4894 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -3,26 +3,26 @@ COMPILER=../bin/troupec build: mkdir -p out # Standard Library - $(COMPILER) ./Number.trp -l - $(COMPILER) ./List.trp -l - $(COMPILER) ./ListPair.trp -l - $(COMPILER) ./String.trp -l - $(COMPILER) ./Hash.trp -l - $(COMPILER) ./Unit.trp -l - $(COMPILER) ./StencilVector.trp -l - $(COMPILER) ./HashMap.trp -l - $(COMPILER) ./HashSet.trp -l + $(COMPILER) --lib ./Number.trp + $(COMPILER) --lib ./List.trp + $(COMPILER) --lib ./ListPair.trp + $(COMPILER) --lib ./String.trp + $(COMPILER) --lib ./Hash.trp + $(COMPILER) --lib ./Unit.trp + $(COMPILER) --lib ./StencilVector.trp + $(COMPILER) --lib ./HashMap.trp + $(COMPILER) --lib ./HashSet.trp # Old stuff, here be dragons... - $(COMPILER) ./nsuref.trp -l - $(COMPILER) ./printService.trp -l - $(COMPILER) ./timeout.trp -l - $(COMPILER) ./NetHealth.trp -l - $(COMPILER) ./declassifyutil.trp -l - $(COMPILER) ./stdio.trp -l - $(COMPILER) ./raft.trp -l - $(COMPILER) ./raft_debug.trp -l - $(COMPILER) ./bst.trp -l - $(COMPILER) ./localregistry.trp -l + $(COMPILER) --lib ./nsuref.trp + $(COMPILER) --lib ./printService.trp + $(COMPILER) --lib ./timeout.trp + $(COMPILER) --lib ./NetHealth.trp + $(COMPILER) --lib ./declassifyutil.trp + $(COMPILER) --lib ./stdio.trp + $(COMPILER) --lib ./raft.trp + $(COMPILER) --lib ./raft_debug.trp + $(COMPILER) --lib ./bst.trp + $(COMPILER) --lib ./localregistry.trp clean: rm -rf out diff --git a/trp-rt/Makefile b/trp-rt/Makefile index 84c725c5..e1f71340 100644 --- a/trp-rt/Makefile +++ b/trp-rt/Makefile @@ -3,7 +3,7 @@ COMPILER=../bin/troupec build: mkdir -p out # Standard Library - $(COMPILER) ./service.trp -l + $(COMPILER) --lib ./service.trp clean: rm -rf out From 49356920ddd031cc068736484352e7199a532cee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 12:20:18 +0200 Subject: [PATCH 17/30] Remove '-i' and '-j' as short-hand options These are (a) only used by the runtime and/or (b) only used seldomly. Hence, we may as well open up for these to be used for something different, e.g. modules --- compiler/app/Main.hs | 25 +++++++++++-------------- rt/src/deserialize.mts | 2 +- 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index c700e446..cf42c0eb 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -42,7 +42,7 @@ import System.FilePath ----- COMPILER FLAGS ----------------------------------------------------------- data Flag - = IRMode + = TextIRMode | JSONIRMode | LibMode | NoRawOpt @@ -54,12 +54,12 @@ data Flag options :: [OptDescr Flag] options = - [ Option ['i'] ["ir"] (NoArg IRMode) "ir interactive mode" - , Option ['j'] ["json"] (NoArg JSONIRMode) "ir json interactive mode" + [ Option [] ["text-ir"] (NoArg TextIRMode) "ir interactive mode (text)" + , Option [] ["json-ir"] (NoArg JSONIRMode) "ir interactive mode (json)" , Option [] ["no-rawopt"] (NoArg NoRawOpt) "disable Raw optimization" , Option ['v'] ["verbose"] (NoArg Verbose) "verbose output" , Option ['d'] ["debug"] (NoArg Debug) "debugging information in the .js file" - , Option [] ["lib"] (NoArg LibMode) "compiling a library" + , Option [] ["lib"] (NoArg LibMode) "compiling a library [deprecated]" , Option ['h'] ["help"] (NoArg Help) "print usage" , Option ['o'] ["output"] (ReqArg OutputFile "FILE") "output FILE" ] @@ -193,7 +193,7 @@ writeExports path exports = -------------------------------------------------------------------------------- ----- DESERIALIZATION FOR INTERACTIVE MODES ------------------------------------ -fromStdin putFormattedLn = do +fromStdinIR putFormattedLn = do eof <- isEOF if eof then exitSuccess else do input <- BS.getLine @@ -211,12 +211,12 @@ fromStdin putFormattedLn = do debugOut $ "decoding error" ++s putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa hFlush stdout - fromStdin putFormattedLn + fromStdinIR putFormattedLn -- AA: 2018-07-15: consider timestamping these entries where debugOut s = appendFile "/tmp/debug" (s ++ "\n") -fromStdinIR = fromStdin (putStrLn . IR2JS.irToJSString) -fromStdinIRJson = fromStdin (BSLazyChar8.putStrLn . IR2JS.irToJSON) +fromStdinTextIR = fromStdinIR (putStrLn . IR2JS.irToJSString) +fromStdinJsonIR = fromStdinIR (BSLazyChar8.putStrLn . IR2JS.irToJSON) -------------------------------------------------------------------------------- ----- MAIN --------------------------------------------------------------------- @@ -233,11 +233,8 @@ main = do putStrLn compilerUsage exitSuccess - ([JSONIRMode], [], []) -> fromStdinIRJson - - ([IRMode], [], []) -> do - fromStdinIR - -- hSetBuffering stdout NoBuffering + ([TextIRMode], [], []) -> fromStdinTextIR + ([JSONIRMode], [], []) -> fromStdinJsonIR (o, [file], []) | optionsOK o -> fromFile o file @@ -253,7 +250,7 @@ main = do optionsOK :: [Flag] -> Bool optionsOK o | length o >=2 = -- certain options must not be combined - not.or $ map (`elem` o) [IRMode, Help] + not.or $ map (`elem` o) [TextIRMode, Help] optionsOK _ = True diff --git a/rt/src/deserialize.mts b/rt/src/deserialize.mts index 2c194875..c1d23013 100644 --- a/rt/src/deserialize.mts +++ b/rt/src/deserialize.mts @@ -39,7 +39,7 @@ const HEADER:string = this.libs.push ({lib:lib, decl:decl})} }\n" function startCompiler() { - __compilerOsProcess = spawn(process.env.TROUPE + '/bin/troupec', ['--json']); + __compilerOsProcess = spawn(process.env.TROUPE + '/bin/troupec', ['--json-ir']); __compilerOsProcess.on('exit', (code: number) => { process.exit(code); }); From 6c456b808ea66ab94cd1fbb24d8a7faf4edd991d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 12:52:14 +0200 Subject: [PATCH 18/30] Clean up in .gitignore --- .gitignore | 73 +++++++++++++++++++++++++++++++-------------- compiler/.gitignore | 15 ++++++++-- 2 files changed, 62 insertions(+), 26 deletions(-) diff --git a/.gitignore b/.gitignore index d002a09e..b7c422ac 100644 --- a/.gitignore +++ b/.gitignore @@ -1,34 +1,61 @@ -dist -dist-* -cabal-dev -*.o -*.hi -*.chi -*.chs.h -*.DS_Store -*.dyn_o -*.dyn_hi -.hpc -.hsenv +TAGS + +################################################## +# NPM +node_modules + +################################################## +# Haskell + +## Cabal Sandbox .cabal-sandbox/ cabal.sandbox.config +cabal.project.local + +## Program Coverage +.hpc *.prof *.aux *.hp *.eventlog -.stack-work/ -cabal.project.local -.HTF/ -TAGS -*.vscode -/out + +## Test Framework +.HTF + +## Virtual Environment +.hsenv + +## Build files *.o *.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi + +################################################## +# Binaries from `compiler` bin/* -node_modules -yarn.lock -yarn-error.log + +################################################## +# Troupe Compiler (`troupec`) output +out/* + +################################################## +# Editors + +## Visual Studio Code +*.vscode + +## Vi *.swp -bin/troupe -bin/understudy + +## Emacs *.#* +*~ + +################################################## +# Operating Systems + +## MacOS +*.DS_Store \ No newline at end of file diff --git a/compiler/.gitignore b/compiler/.gitignore index d5daa3ed..f04c37cb 100644 --- a/compiler/.gitignore +++ b/compiler/.gitignore @@ -1,6 +1,15 @@ +################################################## +# Stack artifacts .stack-work/ +stack.yaml.lock + +################################################## +# Cabal artifacts Troupe-compiler.cabal +dist +dist-* +cabal-dev + +################################################## +# Local compilation output ir2raw-out -stack.yaml.lock -*~ -out From e73f1eb7808f30556f2f5accc69268561cb5419c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 14:00:18 +0200 Subject: [PATCH 19/30] Move ppDeps from IR to Stack2JS This is the only place it is used. Furthermore, having it defined in IR removes it from the context of having to make it be valid JSON; anything that is deemed 'prettier' might by accident be "re"used --- compiler/src/IR.hs | 10 ---------- compiler/src/Stack2JS.hs | 12 +++++++++++- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/src/IR.hs b/compiler/src/IR.hs index c4836153..0ff951d9 100644 --- a/compiler/src/IR.hs +++ b/compiler/src/IR.hs @@ -154,16 +154,6 @@ instance ComputesDependencies FunDef where dependencies (FunDef _ _ _ bb) = dependencies bb -ppDeps :: ComputesDependencies a => a -> (PP.Doc , PP.Doc, PP.Doc) -ppDeps a = let (ffs_0,lls_0, atoms_0) = execWriter (dependencies a) - (ffs, lls, aas) = (nub ffs_0, nub lls_0, nub atoms_0) - - format dd = - let tt = map (PP.doubleQuotes . ppId) dd in - (PP.brackets.PP.hsep) (PP.punctuate PP.comma tt) - in ( format ffs, format lls , format aas ) - - ----------------------------------------------------------- -- Serialization instances ----------------------------------------------------------- diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index 161553e8..db0fd6b3 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -258,7 +258,17 @@ instance ToJS FunDef where let lits = constsToJS consts jj <- toJS bb debug <- ask - let (irdeps, libdeps, atomdeps ) = IR.ppDeps irfdef + + let ppDeps :: IR.ComputesDependencies a => a -> (PP.Doc, PP.Doc, PP.Doc) + ppDeps a = let (ffs_0,lls_0, atoms_0) = execWriter (IR.dependencies a) + + (ffs, lls, aas) = (nub ffs_0, nub lls_0, nub atoms_0) + + format dd = let tt = map (PP.doubleQuotes . ppId) dd + in (PP.brackets.PP.hsep) (PP.punctuate PP.comma tt) + in (format ffs, format lls, format aas) + + let (irdeps, libdeps, atomdeps ) = ppDeps irfdef sparseSlotIdxPP <- ppSparseSlotIdx return $ From 705d40726ac92a2e89eabcd1e3040d18fa5b091d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 14:06:13 +0200 Subject: [PATCH 20/30] Remove/Clean up some dead code --- compiler/src/Stack2JS.hs | 23 ++++------------------- 1 file changed, 4 insertions(+), 19 deletions(-) diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index db0fd6b3..d66827b8 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -137,8 +137,6 @@ instance Identifier Raw.Assignable where class ToJS a where toJS :: a -> W PP.Doc - - irProg2JSString :: CompileMode -> Bool -> StackProgram -> String irProg2JSString compileMode debugOut ir = let (fns, _, (_,_,konts)) = runRWS (toJS ir) debugOut initState @@ -146,17 +144,19 @@ irProg2JSString compileMode debugOut ir = outer = vcat $ stdlib ++ - [ "function" <+> ppNamespaceName <+> text "(rt) {" ] + [ "function" <+> namespaceName <+> text "(rt) {" ] ++ [ nest 2 inner , text "}" ] ++ suffix - in + in PP.render $ case compileMode of Normal -> outer Export -> inner + where -- TODO: should be generating a new namespace per received blob + namespaceName = text "Top" stack2JSString :: StackUnit -> String @@ -191,21 +191,6 @@ instance ToJS IR.VarAccess where return $ text fname --- instance (Identifier a) => ToJS a where --- toJS x = return $ ppId x - -ppNamespaceName = text "Top" -- should be generating a new namespace per received blob - - -irProg2JsWrapped prog = do - inner <- toJS prog - return $ - text "function" <+> ppNamespaceName <+> text "(rt) {" - $$ nest 2 inner - $$ text "}" - - - instance ToJS StackProgram where toJS (StackProgram atoms funs) = do jjA <- toJS atoms From 23674e9329beedca194096d0611dd6b0655a11e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 14:34:04 +0200 Subject: [PATCH 21/30] Simplify 'irProg2JSString' There seems to be some unecessary complexity as a leftover of previous designs? --- compiler/src/Stack2JS.hs | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index d66827b8..ab800415 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -142,21 +142,13 @@ irProg2JSString compileMode debugOut ir = let (fns, _, (_,_,konts)) = runRWS (toJS ir) debugOut initState inner = vcat (fns:konts) outer = vcat $ - stdlib - ++ - [ "function" <+> namespaceName <+> text "(rt) {" ] - ++ - [ nest 2 inner - , text "}" ] - ++ - suffix - in - PP.render $ - case compileMode of - Normal -> outer - Export -> inner - where -- TODO: should be generating a new namespace per received blob - namespaceName = text "Top" + [ "function" <+> text "Top" <+> text "(rt) {" + , nest 2 inner + , text "}" + , "module.exports = Top" + ] + in PP.render $ case compileMode of Normal -> outer + Export -> inner stack2JSString :: StackUnit -> String @@ -615,9 +607,6 @@ ppPosInfo :: GetPosInfo a => a -> PP.Doc ppPosInfo = PP.doubleQuotes . text . show . posInfo pickle = PP.doubleQuotes.text.T.unpack.decodeUtf8.encode -stdlib = [] -- "let runtime = require('../runtimeMonitored.js')"] -suffix = [ "module.exports = Top "] - jsClosure var env f = vcat [ ppLet var <+> ((text "rt.mkVal") <> (PP.parens ((text "rt.RawClosure") <> (PP.parens (PP.hsep $ PP.punctuate "," [ppId env, text "this", text "this." PP.<> ppId f]))))) From f9a04559e16c672f888d0cf02f5e7878e3372b52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 2 Oct 2025 15:31:12 +0200 Subject: [PATCH 22/30] Rename 'debugOut' to 'debugMode' to better convey its meaning --- compiler/src/Stack2JS.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index ab800415..e29d8f67 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -138,8 +138,8 @@ class ToJS a where toJS :: a -> W PP.Doc irProg2JSString :: CompileMode -> Bool -> StackProgram -> String -irProg2JSString compileMode debugOut ir = - let (fns, _, (_,_,konts)) = runRWS (toJS ir) debugOut initState +irProg2JSString compileMode debugMode ir = + let (fns, _, (_,_,konts)) = runRWS (toJS ir) debugMode initState inner = vcat (fns:konts) outer = vcat $ [ "function" <+> text "Top" <+> text "(rt) {" From 8ce865b2a03efe46f2896aab6a4f78d0e70bc784 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Fri, 3 Oct 2025 14:07:00 +0200 Subject: [PATCH 23/30] Remove outdated and empty project files for compiler --- compiler/ChangeLog.md | 0 compiler/LICENSE | 30 ------------------------------ compiler/README.md | 1 - 3 files changed, 31 deletions(-) delete mode 100644 compiler/ChangeLog.md delete mode 100644 compiler/LICENSE delete mode 100644 compiler/README.md diff --git a/compiler/ChangeLog.md b/compiler/ChangeLog.md deleted file mode 100644 index e69de29b..00000000 diff --git a/compiler/LICENSE b/compiler/LICENSE deleted file mode 100644 index e037c729..00000000 --- a/compiler/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright Author name here (c) 2018 - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Author name here nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/compiler/README.md b/compiler/README.md deleted file mode 100644 index a433982a..00000000 --- a/compiler/README.md +++ /dev/null @@ -1 +0,0 @@ -# PicoML-compiler From 3b320c3de3151cdb906ac945778975703816c3f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Sat, 4 Oct 2025 12:09:34 +0200 Subject: [PATCH 24/30] Output parsed syntax when verbose --- compiler/app/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index cf42c0eb..b249a943 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -104,6 +104,7 @@ process flags fname input = do Left s -> die s when verbose $ do printSep "SYNTAX" + writeFileD "out/out.syntax" (showIndent 2 prog) putStrLn (showIndent 2 prog) ------------------------------------------------------ prog' <- case runExcept (C.trans compileMode (AF.visitProg prog)) of From 3d36cbb82c3719576adfc4cf48fb8c8b88195c8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 11:39:21 +0200 Subject: [PATCH 25/30] Remove generation of dead code 'this.loadLibs' preamble of JS output --- compiler/src/Stack2JS.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index e29d8f67..633af650 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -66,8 +66,7 @@ instance Aeson.ToJSON LibAccess jsLoadLibs = vcat $ map text [ "this.libSet = new Set ()", "this.libs = []", - "this.addLib = function (lib, decl) { if (!this.libSet.has (lib +'.'+decl)) { this.libSet.add (lib +'.'+decl); this.libs.push ({lib:lib, decl:decl})} }", - "this.loadlibs = function (cb) { rt.linkLibs (this.libs, this, cb) }" ] + "this.addLib = function (lib, decl) { if (!this.libSet.has (lib +'.'+decl)) { this.libSet.add (lib +'.'+decl); this.libs.push ({lib:lib, decl:decl})} }" ] addLibs xs = vcat $ nub (map addOneLib xs) where addOneLib (LibAccess (Basics.LibName libname) varname) = From db4f7be087fadcd9f18a7457d06b7eb0da4dfbf9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 14:12:17 +0200 Subject: [PATCH 26/30] Remove magic (dependant) constant --- compiler/app/Main.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index b249a943..7b6dc4fa 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -198,8 +198,9 @@ fromStdinIR putFormattedLn = do eof <- isEOF if eof then exitSuccess else do input <- BS.getLine - if BS.isPrefixOf "!ECHO " input - then let response = BS.drop 6 input + let echo = "!ECHO " + if BS.isPrefixOf echo input + then let response = BS.drop (BS.length echo) input in do BS.putStrLn response else case decode input of From 7aecf4bfb369a092081bbdc464ecb879986602ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 14:26:15 +0200 Subject: [PATCH 27/30] Inline 'App.hs/fromFile' to improve code clarity --- compiler/app/Main.hs | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index 7b6dc4fa..c935cb2d 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -238,16 +238,15 @@ main = do ([TextIRMode], [], []) -> fromStdinTextIR ([JSONIRMode], [], []) -> fromStdinJsonIR - (o, [file], []) | optionsOK o -> - fromFile o file - + (o, [file], []) | optionsOK o -> do + input <- readFile file + process o (Just file) input (_,_, errs) -> die $ concat errs ++ compilerUsage where compilerUsage = usageInfo header options where header = "Usage: [OPTION...] file" - -- Check options for consistency optionsOK :: [Flag] -> Bool optionsOK o | length o >=2 = @@ -256,13 +255,6 @@ main = do optionsOK _ = True - -fromFile :: [Flag] -> String -> IO ExitCode -fromFile flags fname = do - input <- readFile fname - process flags (Just fname) input - - -- utility functions for printing things out hrWidth = 70 From c2dbc95c3822231d717b6b2889a180e22bdf9a00 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 14:27:12 +0200 Subject: [PATCH 28/30] Move print helpers up to the function that uses it --- compiler/app/Main.hs | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index c935cb2d..10d08ad3 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -191,6 +191,20 @@ writeExports path exports = let path' = if takeExtension path == ".js" then dropExtension path else path in writeFileD (path' ++ ".exports") (intercalate "\n" exports) +-- Utility functions for printing things out +hrWidth = 70 + +printSep :: String -> IO () +printSep s = do + let prefix = replicate 5 '-' + suffix = replicate (hrWidth - length s - 5 - 2) '-' + s' = prefix ++ " " ++ s ++ " " ++ suffix + putStrLn s' + + +printHr :: IO () +printHr = putStrLn (replicate hrWidth '-') + -------------------------------------------------------------------------------- ----- DESERIALIZATION FOR INTERACTIVE MODES ------------------------------------ @@ -253,21 +267,3 @@ main = do -- certain options must not be combined not.or $ map (`elem` o) [TextIRMode, Help] optionsOK _ = True - - --- utility functions for printing things out - -hrWidth = 70 - -printSep :: String -> IO () -printSep s = do - let prefix = replicate 5 '-' - suffix = replicate (hrWidth - length s - 5 - 2) '-' - s' = prefix ++ " " ++ s ++ " " ++ suffix - putStrLn s' - - -printHr :: IO () -printHr = putStrLn (replicate hrWidth '-') - --------------------------------------------------- From 3ecdd7f754491495a8cd7d0154fc1dbfa09553dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Tue, 14 Oct 2025 11:00:54 +0200 Subject: [PATCH 29/30] Clean up and simplify main interface for Stack2JS.hs --- compiler/app/Main.hs | 26 +++++++++----- compiler/src/IR2JS.hs | 23 ------------- compiler/src/Stack2JS.hs | 73 +++++++++++++++++++++------------------- 3 files changed, 57 insertions(+), 65 deletions(-) delete mode 100644 compiler/src/IR2JS.hs diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index 10d08ad3..ec685fed 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -14,10 +14,9 @@ import qualified IR as CCIR import qualified IROpt -- import qualified RetRewrite as Rewrite import qualified CPSOpt as CPSOpt -import qualified IR2JS import qualified IR2Raw --- import qualified Stack import qualified Raw2Stack +import qualified Stack import qualified Stack2JS import qualified RawOpt -- import System.IO (isEOF) @@ -77,6 +76,7 @@ process flags fname input = do let verbose = Verbose `elem` flags noRawOpt = NoRawOpt `elem` flags + debugJS = Debug `elem` flags case ast of Left err -> do @@ -161,7 +161,9 @@ process flags fname input = do when verbose $ writeFileD "out/out.stack" (show stack) ----- JAVASCRIPT ------------------------------------- - let stackjs = Stack2JS.irProg2JSString compileMode (Debug `elem` flags) stack + let stackjs = Stack2JS.stack2JSString compileMode + debugJS + (Stack.ProgramStackUnit stack) writeFile outPath stackjs case exports of @@ -208,7 +210,7 @@ printHr = putStrLn (replicate hrWidth '-') -------------------------------------------------------------------------------- ----- DESERIALIZATION FOR INTERACTIVE MODES ------------------------------------ -fromStdinIR putFormattedLn = do +fromStdinIR putStrLn format = do eof <- isEOF if eof then exitSuccess else do input <- BS.getLine @@ -220,19 +222,27 @@ fromStdinIR putFormattedLn = do case decode input of Right bs -> case CCIR.deserialize bs - of Right x -> do putFormattedLn x + of Right x -> do (putStrLn . format . ir2Stack) x Left s -> do putStrLn "ERROR in deserialization" debugOut $ "deserialization error" ++ s Left s -> do putStrLn "ERROR in B64 decoding" debugOut $ "decoding error" ++s putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa hFlush stdout - fromStdinIR putFormattedLn + fromStdinIR putStrLn format -- AA: 2018-07-15: consider timestamping these entries where debugOut s = appendFile "/tmp/debug" (s ++ "\n") -fromStdinTextIR = fromStdinIR (putStrLn . IR2JS.irToJSString) -fromStdinJsonIR = fromStdinIR (BSLazyChar8.putStrLn . IR2JS.irToJSON) + ir2Stack = Raw2Stack.raw2Stack . RawOpt.rawopt . IR2Raw.ir2raw + +fromStdinTextIR = + let format = Stack2JS.stack2JSString CompileMode.Normal False + in fromStdinIR putStrLn format + +fromStdinJsonIR = + let putStrLn = BSLazyChar8.putStrLn + format = Stack2JS.stack2JSON CompileMode.Normal False + in fromStdinIR putStrLn format -------------------------------------------------------------------------------- ----- MAIN --------------------------------------------------------------------- diff --git a/compiler/src/IR2JS.hs b/compiler/src/IR2JS.hs deleted file mode 100644 index ab217dd9..00000000 --- a/compiler/src/IR2JS.hs +++ /dev/null @@ -1,23 +0,0 @@ -module IR2JS where - -import Data.ByteString.Lazy (ByteString) -import IR -import qualified IR2Raw (ir2raw) -import qualified RawOpt -import qualified Raw2Stack (raw2Stack) -import qualified Stack -import qualified Stack2JS - - --- RT calls this to compile received code. -ir2Stack :: SerializationUnit -> Stack.StackUnit -ir2Stack = Raw2Stack.raw2Stack . RawOpt.rawopt . IR2Raw.ir2raw - - -irToJSString :: SerializationUnit -> String -irToJSString = Stack2JS.stack2JSString . ir2Stack - - -irToJSON :: SerializationUnit -> ByteString -irToJSON = Stack2JS.stack2JSON . ir2Stack - diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index 633af650..b59d637a 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -91,7 +91,8 @@ data TheState = TheState { freshCounter :: Integer type RetKontText = PP.Doc -type W = RWS Bool ([LibAccess], [Basics.AtomName], [RetKontText]) TheState +type WData = ([LibAccess], [Basics.AtomName], [RetKontText]) +type W = RWS Bool WData TheState initState = TheState { freshCounter = 0 @@ -136,37 +137,48 @@ instance Identifier Raw.Assignable where class ToJS a where toJS :: a -> W PP.Doc -irProg2JSString :: CompileMode -> Bool -> StackProgram -> String -irProg2JSString compileMode debugMode ir = - let (fns, _, (_,_,konts)) = runRWS (toJS ir) debugMode initState - inner = vcat (fns:konts) - outer = vcat $ - [ "function" <+> text "Top" <+> text "(rt) {" - , nest 2 inner - , text "}" - , "module.exports = Top" +stack2PPDoc :: CompileMode -> Bool -> StackUnit -> (PP.Doc, WData) + +stack2PPDoc compileMode debugMode (ProgramStackUnit sp) = + let (fns, _, w@(libs, atoms, konts)) = runRWS (toJS sp) debugMode initState + inner = vcat $ + [ jsLoadLibs + , addLibs libs ] - in PP.render $ case compileMode of Normal -> outer - Export -> inner + ++ (fns:konts) ++ + [ ] + + outer = ("function Top (rt)" <+> PP.lbrace) + $$+ inner + $$ PP.rbrace + $$ PP.text "module.exports = Top" + + ppDoc = case compileMode of CompileMode.Export -> inner + CompileMode.Normal -> outer + in (ppDoc, w) +stack2PPDoc _ debugMode su = + let (inner, _, w@(libs, _, konts)) = runRWS (toJS su) debugMode initState + ppDoc = vcat $ [ addLibs libs ] ++ (inner:konts) + in (ppDoc, w) -stack2JSString :: StackUnit -> String -stack2JSString x = - let (inner, _, (libs, atoms, konts)) = runRWS (toJS x) False initState - in PP.render (addLibs libs $$ (vcat (inner:konts))) +stack2JSString :: CompileMode -> Bool -> StackUnit -> String +stack2JSString compileMode debugMode su = + let (ppDoc, _) = stack2PPDoc compileMode debugMode su + in PP.render ppDoc -stack2JSON :: StackUnit -> ByteString -stack2JSON (ProgramStackUnit _) = error "needs to be ported" -stack2JSON x = - let (inner, _, (libs, atoms, konts)) = runRWS (toJS x) False initState +stack2JSON :: CompileMode -> Bool -> StackUnit -> ByteString +stack2JSON compileMode debugMode su = + let (ppDoc, (libs, atoms, konts)) = stack2PPDoc compileMode debugMode su + fname = case su of FunStackUnit (FunDef (HFN n) _ _ _ _) -> Just n + AtomStackUnit _ -> Nothing in Aeson.encode $ JSOutput { libs = libs - , fname = case x of FunStackUnit (FunDef (HFN n)_ _ _ _) -> Just n - _ -> Nothing - , atoms = atoms - , code = PP.render (addLibs libs $$ (vcat (inner:konts))) - } + , fname = fname + , atoms = atoms + , code = PP.render ppDoc + } instance ToJS StackUnit where @@ -185,15 +197,8 @@ instance ToJS IR.VarAccess where instance ToJS StackProgram where toJS (StackProgram atoms funs) = do jjA <- toJS atoms - (jjF, (libsF, atoms', _)) <- listen $ mapM toJS funs - - return $ - vcat $ [ jsLoadLibs - , addLibs libsF - , jjA - ] ++ jjF - - + jjF <- mapM toJS funs + return $ vcat $ [jjA] ++ jjF instance ToJS C.Atoms where From f29f96dc081fec75033beb97db46b3fa69645cf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Tue, 14 Oct 2025 11:43:55 +0200 Subject: [PATCH 30/30] Extend usage of 'CompileMode' to also accomodate 'Interactive Mode' --- compiler/app/Main.hs | 25 ++++++++++--------------- compiler/src/CaseElimination.hs | 14 +++++++------- compiler/src/ClosureConv.hs | 12 ++++++++---- compiler/src/CompileMode.hs | 8 +++++++- compiler/src/IR.hs | 1 - compiler/src/Raw.hs | 1 - compiler/src/Raw2Stack.hs | 1 - compiler/src/RawDefUse.hs | 1 - compiler/src/Stack.hs | 1 - compiler/src/Stack2JS.hs | 4 ++-- 10 files changed, 34 insertions(+), 34 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index ec685fed..00fb1f78 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -70,9 +70,7 @@ process :: [Flag] -> Maybe String -> String -> IO ExitCode process flags fname input = do let ast = parseProg input - let compileMode = - if elem LibMode flags then Export - else Normal + let compileMode = if LibMode `elem` flags then Library else Normal let verbose = Verbose `elem` flags noRawOpt = NoRawOpt `elem` flags @@ -90,18 +88,15 @@ process flags fname input = do ------------------------------------------------------ -- TROUPE (FRONTEND) --------------------------------- - let prog_without_dependencies = - case compileMode of - Normal -> addAmbientMethods prog_parsed - Export -> prog_parsed + let prog_without_dependencies = case compileMode of Normal -> addAmbientMethods prog_parsed + _ -> prog_parsed prog <- (processImports) prog_without_dependencies - exports <- case compileMode of - Normal -> return Nothing - Export -> case runExcept (extractExports prog) of - Right es -> return (Just (es)) - Left s -> die s + exports <- case compileMode of Library -> case runExcept (extractExports prog) of + Right es -> return (Just (es)) + Left s -> die s + _ -> return Nothing when verbose $ do printSep "SYNTAX" writeFileD "out/out.syntax" (showIndent 2 prog) @@ -166,9 +161,9 @@ process flags fname input = do (Stack.ProgramStackUnit stack) writeFile outPath stackjs - case exports of - Nothing -> return () - Just es -> writeExports outPath es + -- case compileMode of Library -> ... + case exports of Nothing -> return () + Just es -> writeExports outPath es ----- EPILOGUE -------------------------------------- when verbose printHr diff --git a/compiler/src/CaseElimination.hs b/compiler/src/CaseElimination.hs index a50c1547..df470b1a 100644 --- a/compiler/src/CaseElimination.hs +++ b/compiler/src/CaseElimination.hs @@ -21,12 +21,12 @@ import Data.List (nub, (\\)) type Trans = Except String trans :: CompileMode -> S.Prog -> Trans T.Prog -trans mode (S.Prog imports atms tm) = do - let tm' = case mode of - Normal -> - S.Let [ S.ValDecl (S.VarPattern "authority") (S.Var "$$authorityarg") _srcRT ] - tm - Export -> tm +trans compileMode (S.Prog imports atms tm) = do + let tm' = case compileMode of + CompileMode.Library -> tm + _ -> + S.Let [ S.ValDecl (S.VarPattern "authority") (S.Var "$$authorityarg") _srcRT ] + tm atms' <- transAtoms atms tm'' <- transTerm tm' return (T.Prog imports atms' tm'') @@ -302,4 +302,4 @@ transFields = mapM $ \case (f, Nothing) -> return (f, T.Var f) (f, Just t) -> do t' <- transTerm t - return (f, t') \ No newline at end of file + return (f, t') diff --git a/compiler/src/ClosureConv.hs b/compiler/src/ClosureConv.hs index 4b212f1c..f10c7a69 100644 --- a/compiler/src/ClosureConv.hs +++ b/compiler/src/ClosureConv.hs @@ -224,9 +224,10 @@ cpsToIR (CPS.Halt v) = do (compileMode,_ , _ , _, _ ) <- ask let constructor = case compileMode of - Normal -> CCIR.Ret -- Compiling library, then generate export instruction - Export -> CCIR.LibExport + CompileMode.Library -> CCIR.LibExport + -- Otherwise, keep it as a simple return + _ -> CCIR.Ret return $ CCIR.BB [] $ constructor v' @@ -275,8 +276,11 @@ closureConvert compileMode (CPS.Prog (C.Atoms atms) t) = (bb, (fdefs, _, consts_wo_levs)) = evalRWS (cpsToIR t) initEnv initState (argumentName, toplevel) = case compileMode of - Normal -> ("$$authorityarg", "main") -- passing authority through the argument to main - Export -> ("$$dummy", "export") + -- Top level function of a library is named 'export' + CompileMode.Library -> ("$$dummy", "export") + -- Passing authority through the argument to main + _ -> ("$$authorityarg", "main") + -- obs that our 'main' may have two names depending on the compilation mode; 2018-07-02; AA consts = (fst.unzip) consts_wo_levs diff --git a/compiler/src/CompileMode.hs b/compiler/src/CompileMode.hs index e5de67a6..c92f8955 100644 --- a/compiler/src/CompileMode.hs +++ b/compiler/src/CompileMode.hs @@ -1,4 +1,10 @@ module CompileMode where -data CompileMode = Normal | Export +-- | Different modes of compilation. +data CompileMode = -- | Compilation of a single file for a Troupe program + Normal + -- | Compiling a libary (deprecated) + | Library + -- | Interactive deserialization of IR + | Interactive diff --git a/compiler/src/IR.hs b/compiler/src/IR.hs index 0ff951d9..675197a5 100644 --- a/compiler/src/IR.hs +++ b/compiler/src/IR.hs @@ -28,7 +28,6 @@ import Data.Serialize (Serialize) import qualified Data.Serialize as Serialize import GHC.Generics (Generic) -import CompileMode import Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>)) import qualified Text.PrettyPrint.HughesPJ as PP import TroupePositionInfo diff --git a/compiler/src/Raw.hs b/compiler/src/Raw.hs index 2f7a5ff9..a6d94131 100644 --- a/compiler/src/Raw.hs +++ b/compiler/src/Raw.hs @@ -30,7 +30,6 @@ import Control.Monad.Writer import Data.List import qualified Data.ByteString as BS -import CompileMode import Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>)) import qualified Text.PrettyPrint.HughesPJ as PP import TroupePositionInfo diff --git a/compiler/src/Raw2Stack.hs b/compiler/src/Raw2Stack.hs index b4e892a7..54494782 100644 --- a/compiler/src/Raw2Stack.hs +++ b/compiler/src/Raw2Stack.hs @@ -34,7 +34,6 @@ import qualified Data.Text as T import Data.Text.Encoding import Data.ByteString.Lazy (ByteString) import Data.ByteString.Base64 (encode,decode) -import CompileMode import TroupePositionInfo import qualified Data.Aeson as Aeson import GHC.Generics (Generic) diff --git a/compiler/src/RawDefUse.hs b/compiler/src/RawDefUse.hs index e987b917..7c7d4534 100644 --- a/compiler/src/RawDefUse.hs +++ b/compiler/src/RawDefUse.hs @@ -39,7 +39,6 @@ import qualified Data.Text as T import Data.Text.Encoding import Data.ByteString.Lazy (ByteString) import Data.ByteString.Base64 (encode,decode) -import CompileMode import TroupePositionInfo import qualified Data.Aeson as Aeson import GHC.Generics (Generic) diff --git a/compiler/src/Stack.hs b/compiler/src/Stack.hs index 91f3e4f9..4d427a20 100644 --- a/compiler/src/Stack.hs +++ b/compiler/src/Stack.hs @@ -30,7 +30,6 @@ import Control.Monad.Writer import Data.List import qualified Data.ByteString as BS -import CompileMode import Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>)) import qualified Text.PrettyPrint.HughesPJ as PP import TroupePositionInfo diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index b59d637a..b3210355 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -153,8 +153,8 @@ stack2PPDoc compileMode debugMode (ProgramStackUnit sp) = $$ PP.rbrace $$ PP.text "module.exports = Top" - ppDoc = case compileMode of CompileMode.Export -> inner - CompileMode.Normal -> outer + ppDoc = case compileMode of CompileMode.Library -> inner + _ -> outer in (ppDoc, w) stack2PPDoc _ debugMode su =