git @ Cat's Eye Technologies Argyle / cefa5bd
Make the let-form represent only a single binding in AST. Chris Pressey 5 months ago
6 changed file(s) with 103 addition(s) and 144 deletion(s). Raw diff Collapse all Expand all
5353 The `let` special form does have a syntax that you do need to follow.
5454
5555 (let me go)
56 ???> Invalid let bindings
56 ???> Invalid
5757
5858 This is what a valid `let` looks like and parses to.
5959
6060 (let ((x 4) (y 9)) (add x y))
6161 ===> (let ((x 4) (y 9)) (add x y))
62 ===> Let [("x",Number 4),("y",Number 9)] (Apply [Atom "add",Atom "x",Atom "y"])
62 ===> Let "x" (Number 4) (Let "y" (Number 9) (Apply [Atom "add",Atom "x",Atom "y"]))
6363 ===> (quote (let ((x 4) (y 9)) (add x y)))
64 ===> Operator "let" [Binder "x" (Binder "y" (Operator "apply" [Var "add",Var "x",Var "y"])),Operator "values" [Literal 4,Literal 9]]
64 ===> Operator "let" [Binder "x" (Operator "let" [Binder "y" (Operator "apply" [Var "add",Var "x",Var "y"]),Operator "values" [Literal 9]]),Operator "values" [Literal 4]]
6565
6666 If a variable is not bound at the point it appears in a `var` node in an `abt`
6767 value construct, that's a syntax error.
77 | String String
88 | Apply [AST]
99 | Lambda [Name] AST
10 | Let [(Name, AST)] AST
10 | Let Name AST AST
1111 | Quote [String] AST
1212 | Op String [AST]
1313 deriving (Show, Eq)
2222
2323 emptyScope :: Scope
2424 emptyScope = Scope
25 { boundVars = Set.fromList $ Map.keys initialScope -- Add builtins to bound vars
25 { boundVars = Set.fromList $ Map.keys initialScope
2626 , freeVars = Set.empty
2727 }
2828
3737
3838 convertAST :: AST -> ScopeM
3939 convertAST = \case
40 Atom name -> do
41 scope <- ask
42 if Set.member name (boundVars scope)
43 then return $ Right (Var name, scope)
44 else return $ Left $ "Unbound variable: " ++ name
40 Atom name -> do
41 scope <- ask
42 if Set.member name (boundVars scope)
43 then return $ Right (Var name, scope)
44 else return $ Left $ "Unbound variable: " ++ name
4545
46 Number n -> do
47 scope <- ask
48 return $ Right (Literal $ VNum n, scope)
46 Number n -> do
47 scope <- ask
48 return $ Right (Literal $ VNum n, scope)
4949
50 String s -> do
51 scope <- ask
52 return $ Right (Literal $ VString s, scope)
50 String s -> do
51 scope <- ask
52 return $ Right (Literal $ VString s, scope)
5353
54 Quote declaredFreeVars body -> do
55 scope <- ask
56 -- Put the declared free variables in scope before converting the body
57 let declaredFreeVarsSet = Set.fromList declaredFreeVars
58 let scope' = scope {
59 boundVars = Set.union (boundVars scope) declaredFreeVarsSet
54 Quote declaredFreeVars body -> do
55 scope <- ask
56 let declaredFreeVarsSet = Set.fromList declaredFreeVars
57 let scope' = scope {
58 boundVars = Set.union (boundVars scope) declaredFreeVarsSet
6059 }
61 -- Convert the body with the extended scope
62 case runReader (convertAST body) scope' of
63 Left err -> return $ Left err
64 Right (bodyABT, bodyScope) ->
65 let
66 finalScope = scope {
67 boundVars = boundVars scope, -- Don't persist the temporary free vars
68 freeVars = Set.union (freeVars scope)
69 (Set.difference (freeVars bodyScope) declaredFreeVarsSet)
70 }
71 undeclaredFreeVars =
72 Set.difference (collectUnboundVars bodyABT)
73 (Set.union (boundVars scope) declaredFreeVarsSet)
74 in
75 if Set.null undeclaredFreeVars
76 then return $ Right (Literal $ VABT declaredFreeVars bodyABT, finalScope)
77 else return $ Left $ "Unbound variables in quoted ABT: " ++ (show undeclaredFreeVars)
60 case runReader (convertAST body) scope' of
61 Left err -> return $ Left err
62 Right (bodyABT, bodyScope) ->
63 let
64 finalScope = scope {
65 boundVars = boundVars scope,
66 freeVars = Set.union (freeVars scope)
67 (Set.difference (freeVars bodyScope) declaredFreeVarsSet)
68 }
69 undeclaredFreeVars =
70 Set.difference (collectUnboundVars bodyABT)
71 (Set.union (boundVars scope) declaredFreeVarsSet)
72 in
73 if Set.null undeclaredFreeVars
74 then return $ Right (Literal $ VABT declaredFreeVars bodyABT, finalScope)
75 else return $ Left $ "Unbound variables in quoted ABT: " ++ show undeclaredFreeVars
7876
79 Op name args -> do
80 -- Convert each argument, collecting ABTs and scopes
81 argResults <- sequence $ map convertAST args
82 case sequence argResults of
83 Left err -> return $ Left err
84 Right argPairs ->
85 -- Split into lists of ABTs and scopes
86 let (argABTs, argScopes) = unzip argPairs
87 -- Combine all scopes by unioning their free and bound variables
88 finalScope = foldr (\s acc ->
89 Scope {
90 boundVars = Set.union (boundVars s) (boundVars acc),
91 freeVars = Set.union (freeVars s) (freeVars acc)
92 }) emptyScope argScopes
93 in return $ Right (Operator "op" [Operator name argABTs], finalScope)
77 Lambda params body -> do
78 scope <- ask
79 let newBoundVars = Set.union (boundVars scope) (Set.fromList params)
80 let scopeWithParams = scope { boundVars = newBoundVars }
9481
95 Lambda params body -> do
96 scope <- ask
97 -- First extend scope with new bound variables
98 let newBoundVars = Set.union (boundVars scope) (Set.fromList params)
99 let scopeWithParams = scope { boundVars = newBoundVars }
100
101 -- Convert body with updated scope
102 let bodyResult = runReader (convertAST body) scopeWithParams
103 case bodyResult of
104 Left err -> return $ Left err
105 Right (bodyABT, bodyScope) ->
106 -- Return final scope that:
107 -- 1. Keeps the original bound vars plus the lambda parameters
108 -- 2. Includes free vars from the body (except the parameters)
109 let finalFreeVars = Set.difference (freeVars bodyScope) (Set.fromList params)
110 finalScope = scope {
111 boundVars = newBoundVars,
112 freeVars = Set.union (freeVars scope) finalFreeVars
113 }
114 in return $ Right (foldr Binder bodyABT params, finalScope)
82 let bodyResult = runReader (convertAST body) scopeWithParams
83 case bodyResult of
84 Left err -> return $ Left err
85 Right (bodyABT, bodyScope) ->
86 let finalFreeVars = Set.difference (freeVars bodyScope) (Set.fromList params)
87 finalScope = scope {
88 boundVars = newBoundVars,
89 freeVars = Set.union (freeVars scope) finalFreeVars
90 }
91 in return $ Right (foldr Binder bodyABT params, finalScope)
11592
116 Let bindings body -> do
117 scope <- ask
118 -- Process bindings sequentially, building up scope and collecting ABTs
119 let processBindings :: [(Name, AST)] -> Scope -> Either String ([ABT], Scope)
120 processBindings [] currScope = Right ([], currScope)
121 processBindings ((name, val):rest) currScope = do
122 -- Convert the current binding's value using current scope
123 case runReader (convertAST val) currScope of
124 Left err -> Left err
93 Let name val body -> do
94 scope <- ask
95 -- First convert the value expression
96 valueResult <- local (const scope) $ convertAST val
97 case valueResult of
98 Left err -> return $ Left err
12599 Right (valABT, valScope) -> do
126 -- Add the new binding to scope for subsequent bindings
127 let newScope = currScope {
128 boundVars = Set.insert name (boundVars currScope),
129 freeVars = Set.union (freeVars currScope) (freeVars valScope)
130 }
131 -- Process remaining bindings with updated scope
132 case processBindings rest newScope of
133 Left err -> Left err
134 Right (restABTs, finalScope) ->
135 Right (valABT : restABTs, finalScope)
100 -- Then convert body with the new binding in scope
101 let newBoundVars = Set.insert name (boundVars scope)
102 let scopeWithBinding = scope {
103 boundVars = newBoundVars,
104 freeVars = Set.union (freeVars scope) (freeVars valScope)
105 }
106 bodyResult <- local (const scopeWithBinding) $ convertAST body
107 case bodyResult of
108 Left err -> return $ Left err
109 Right (bodyABT, bodyScope) ->
110 let finalScope = scope {
111 boundVars = newBoundVars,
112 freeVars = Set.union (freeVars bodyScope)
113 (Set.difference (freeVars valScope) (Set.singleton name))
114 }
115 in return $ Right (
116 Operator "let" [
117 Binder name bodyABT,
118 Operator "values" [valABT]
119 ],
120 finalScope)
136121
137 case processBindings bindings scope of
138 Left err -> return $ Left err
139 Right (bindingABTs, bindingsScope) -> do
140 -- Convert body using final scope from bindings
141 let bodyResult = runReader (convertAST body) bindingsScope
142 case bodyResult of
143 Left err -> return $ Left err
144 Right (bodyABT, bodyScope) ->
145 let names = map fst bindings
146 finalScope = scope {
147 boundVars = Set.union (boundVars scope) (Set.fromList names),
148 freeVars = Set.union (freeVars bodyScope)
149 (Set.difference (freeVars bindingsScope) (Set.fromList names))
150 }
151 in return $ Right (
152 Operator "let"
153 [ foldr Binder bodyABT names
154 , Operator "values" bindingABTs
155 ],
156 finalScope)
157
158 Apply (f:args) -> do
159 scope <- ask
160 -- Convert function and arguments while accumulating free variables
161 let fResult = runReader (convertAST f) scope
162 let argResults = map (\arg -> runReader (convertAST arg) scope) args
163
164 case sequence (fResult : argResults) of
165 Left err -> return $ Left err
166 Right results ->
167 -- Combine free variables from all subexpressions
168 let subFreeVars = Set.unions (map (freeVars . snd) results)
169 subABTs = map fst results
170 finalScope = scope { freeVars = Set.union (freeVars scope) subFreeVars }
171 in return $ Right (Operator "apply" subABTs, finalScope)
172
173 Apply [] -> return $ Left "Empty apply not allowed"
122 Apply [] -> return $ Left "Empty apply not allowed"
123 Apply (f:args) -> do
124 scope <- ask
125 fResult <- local (const scope) $ convertAST f
126 argResults <- mapM (local (const scope) . convertAST) args
127 case sequence (fResult : argResults) of
128 Left err -> return $ Left err
129 Right results ->
130 let subFreeVars = Set.unions (map (freeVars . snd) results)
131 subABTs = map fst results
132 finalScope = scope { freeVars = Set.union (freeVars scope) subFreeVars }
133 in return $ Right (Operator "apply" subABTs, finalScope)
7777 --
7878 parseLet :: L.ConsList -> Either String AST
7979 parseLet expr = case collectList expr of
80 Right [bindingsList, body] -> case collectBindings bindingsList of
81 Right bindings ->
82 case parseConsListExpr body of
83 Right bodyExpr -> Right $ Let bindings bodyExpr
84 Left err -> Left err
85 Left err -> Left $ "Invalid let bindings: " ++ err
86 _ -> Left $ "Invalid let syntax"
80 Right [bindingsList, body] -> do
81 bindings <- collectBindings bindingsList
82 bodyAST <- parseConsListExpr body
83 -- Convert list of bindings into nested Let expressions
84 return $ foldr (\(name, val) acc -> Let name val acc) bodyAST bindings
85 _ -> Left "Invalid let syntax"
8786
8887 --
8988 -- Helper: Collect consecutive items in a ConsList into a regular list
1010
1111 import Language.Argyle.Parser (sexprToConsList, sexprToAST, sexprToABT)
1212 import Language.Argyle.Value (ABT, showValue, unparseABT)
13 import qualified Language.Argyle.Tests.Runner as TestRunner
13 --import qualified Language.Argyle.Tests.Runner as TestRunner
1414 import qualified Language.Argyle.Interpreter as I
1515 import Language.Argyle.REPL (repl)
1616
3232 putStrLn $ showValue value
3333 ["repl"] -> do
3434 repl
35 ["test"] -> do
36 passed <- TestRunner.runAllTests
37 if not passed
38 then exitWith $ ExitFailure 1
39 else exitSuccess
35 --["test"] -> do
36 -- passed <- TestRunner.runAllTests
37 -- if not passed
38 -- then exitWith $ ExitFailure 1
39 -- else exitSuccess
4040 _ ->
4141 usage
4242
00 #!/bin/sh -e
11
2 ./bin/argyle test
2 #./bin/argyle test
33 falderal doc/Definition-of-Argyle.md