From bf1000d1749b2c9ac6ea902c1002ce5ce2c8a411 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Thu, 30 Jan 2025 13:56:09 -0600 Subject: [PATCH] Rework module system Don't require/allow naming a module, instead require that the importer names it. Allow importing into the local scope with the name !Local. Simplify namespacing logic. Updates all tests to reflect these changes. --- demos/equality.tri | 10 +-- demos/levelOrderTraversal.tri | 40 +++++----- demos/size.tri | 16 ++-- demos/toSource.tri | 40 +++++----- src/Eval.hs | 15 ++-- src/FileEval.hs | 137 +++++++++++++++------------------- src/Lexer.hs | 124 +++++++++++++++--------------- src/Parser.hs | 26 +++---- src/Research.hs | 4 +- test/Spec.hs | 3 + test/ascii.tri | 1 - test/assignment.tri | 1 - test/cycle-1.tri | 1 - test/cycle-2.tri | 1 - test/lambda-A.tri | 1 - test/local-ns/1.tri | 4 + test/local-ns/2.tri | 2 + test/local-ns/3.tri | 2 + test/modules-1.tri | 5 -- test/modules-2.tri | 1 - test/multi-level-A.tri | 1 - test/multi-level-B.tri | 1 - test/multi-level-C.tri | 1 - test/named-imports/1.tri | 7 ++ test/named-imports/2.tri | 2 + test/named-imports/3.tri | 2 + test/namespace-A.tri | 1 - test/namespace-B.tri | 1 - test/undefined.tri | 1 - test/unresolved-A.tri | 1 - test/vars-A.tri | 1 - test/vars-B.tri | 1 - test/vars-C.tri | 1 - tricu.cabal | 2 +- 34 files changed, 218 insertions(+), 239 deletions(-) delete mode 100644 test/ascii.tri delete mode 100644 test/assignment.tri create mode 100644 test/local-ns/1.tri create mode 100644 test/local-ns/2.tri create mode 100644 test/local-ns/3.tri delete mode 100644 test/modules-1.tri delete mode 100644 test/modules-2.tri create mode 100644 test/named-imports/1.tri create mode 100644 test/named-imports/2.tri create mode 100644 test/named-imports/3.tri delete mode 100644 test/undefined.tri diff --git a/demos/equality.tri b/demos/equality.tri index 196b0bc..d0008bf 100644 --- a/demos/equality.tri +++ b/demos/equality.tri @@ -1,6 +1,4 @@ -!module Equality - -!import "lib/base.tri" Lib +!import "lib/base.tri" !Local main = lambdaEqualsTC @@ -28,7 +26,7 @@ not_Lambda? = demo_matchBool demo_false demo_true -- to different tree representations even if they share extensional behavior. -- Let's see if these are the same: -lambdaEqualsTC = Lib.equal? not_TC? not_Lambda? +lambdaEqualsTC = equal? not_TC? not_Lambda? -- Here are some checks to verify their extensional behavior is the same: true_TC? = not_TC? demo_false @@ -37,5 +35,5 @@ false_TC? = not_TC? demo_true true_Lambda? = not_Lambda? demo_false false_Lambda? = not_Lambda? demo_true -bothTrueEqual? = Lib.equal? true_TC? true_Lambda? -bothFalseEqual? = Lib.equal? false_TC? false_Lambda? +bothTrueEqual? = equal? true_TC? true_Lambda? +bothFalseEqual? = equal? false_TC? false_Lambda? diff --git a/demos/levelOrderTraversal.tri b/demos/levelOrderTraversal.tri index d3f8282..d2b8187 100644 --- a/demos/levelOrderTraversal.tri +++ b/demos/levelOrderTraversal.tri @@ -1,6 +1,4 @@ -!module LOT - -!import "lib/base.tri" Lib +!import "lib/base.tri" !Local main = exampleTwo -- Level Order Traversal of a labelled binary tree @@ -19,41 +17,41 @@ main = exampleTwo -- / / \ -- 4 5 6 -label = \node : Lib.head node +label = \node : head node -left = (\node : Lib.if (Lib.emptyList? node) +left = (\node : if (emptyList? node) [] - (Lib.if (Lib.emptyList? (Lib.tail node)) + (if (emptyList? (tail node)) [] - (Lib.head (Lib.tail node)))) + (head (tail node)))) -right = (\node : Lib.if (Lib.emptyList? node) +right = (\node : if (emptyList? node) [] - (Lib.if (Lib.emptyList? (Lib.tail node)) + (if (emptyList? (tail node)) [] - (Lib.if (Lib.emptyList? (Lib.tail (Lib.tail node))) + (if (emptyList? (tail (tail node))) [] - (Lib.head (Lib.tail (Lib.tail node)))))) + (head (tail (tail node)))))) -processLevel = Lib.y (\self queue : Lib.if (Lib.emptyList? queue) +processLevel = y (\self queue : if (emptyList? queue) [] - (Lib.pair (Lib.map label queue) (self (Lib.filter - (\node : Lib.not? (Lib.emptyList? node)) - (Lib.lconcat (Lib.map left queue) (Lib.map right queue)))))) + (pair (map label queue) (self (filter + (\node : not? (emptyList? node)) + (lconcat (map left queue) (map right queue)))))) levelOrderTraversal_ = \a : processLevel (t a t) -toLineString = Lib.y (\self levels : Lib.if (Lib.emptyList? levels) +toLineString = y (\self levels : if (emptyList? levels) "" - (Lib.lconcat - (Lib.lconcat (Lib.map (\x : Lib.lconcat x " ") (Lib.head levels)) "") - (Lib.if (Lib.emptyList? (Lib.tail levels)) "" (Lib.lconcat (t (t 10 t) t) (self (Lib.tail levels)))))) + (lconcat + (lconcat (map (\x : lconcat x " ") (head levels)) "") + (if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels)))))) levelOrderToString = \s : toLineString (levelOrderTraversal_ s) -flatten = Lib.foldl (\acc x : Lib.lconcat acc x) "" +flatten = foldl (\acc x : lconcat acc x) "" -levelOrderTraversal = \s : Lib.lconcat (t 10 t) (flatten (levelOrderToString s)) +levelOrderTraversal = \s : lconcat (t 10 t) (flatten (levelOrderToString s)) exampleOne = levelOrderTraversal [("1") [("2") [("4") t t] t] diff --git a/demos/size.tri b/demos/size.tri index 77b9625..fe91119 100644 --- a/demos/size.tri +++ b/demos/size.tri @@ -1,24 +1,22 @@ -!module Size - -!import "lib/base.tri" Lib +!import "lib/base.tri" !Local main = size size compose = \f g x : f (g x) -succ = Lib.y (\self : - Lib.triage +succ = y (\self : + triage 1 t - (Lib.triage + (triage (t (t t)) - (\_ Lib.tail : t t (self Lib.tail)) + (\_ tail : t t (self tail)) t)) size = (\x : - (Lib.y (\self x : + (y (\self x : compose succ - (Lib.triage + (triage (\x : x) self (\x y : compose (self x) (self y)) diff --git a/demos/toSource.tri b/demos/toSource.tri index 5a0ad43..f8a65f8 100644 --- a/demos/toSource.tri +++ b/demos/toSource.tri @@ -1,8 +1,6 @@ -!module ToSource +!import "lib/base.tri" !Local -!import "lib/base.tri" Lib - -main = toSource Lib.not? +main = toSource not? -- Thanks to intensionality, we can inspect the structure of a given value -- even if it's a function. This includes lambdas which are eliminated to -- Tree Calculus (TC) terms during evaluation. @@ -16,29 +14,29 @@ main = toSource Lib.not? -- triage = (\leaf stem fork : t (t leaf stem) fork) -- Base case of a single Leaf -sourceLeaf = t (Lib.head "t") +sourceLeaf = t (head "t") -- Stem case sourceStem = (\convert : (\a rest : - t (Lib.head "(") -- Start with a left parenthesis "(". - (t (Lib.head "t") -- Add a "t" - (t (Lib.head " ") -- Add a space. - (convert a -- Recursively convert the argument. - (t (Lib.head ")") rest)))))) -- Close with ")" and append the rest. + t (head "(") -- Start with a left parenthesis "(". + (t (head "t") -- Add a "t" + (t (head " ") -- Add a space. + (convert a -- Recursively convert the argument. + (t (head ")") rest)))))) -- Close with ")" and append the rest. -- Fork case sourceFork = (\convert : (\a b rest : - t (Lib.head "(") -- Start with a left parenthesis "(". - (t (Lib.head "t") -- Add a "t" - (t (Lib.head " ") -- Add a space. - (convert a -- Recursively convert the first arg. - (t (Lib.head " ") -- Add another space. - (convert b -- Recursively convert the second arg. - (t (Lib.head ")") rest)))))))) -- Close with ")" and append the rest. + t (head "(") -- Start with a left parenthesis "(". + (t (head "t") -- Add a "t" + (t (head " ") -- Add a space. + (convert a -- Recursively convert the first arg. + (t (head " ") -- Add another space. + (convert b -- Recursively convert the second arg. + (t (head ")") rest)))))))) -- Close with ")" and append the rest. -- Wrapper around triage -toSource_ = Lib.y (\self arg : - Lib.triage +toSource_ = y (\self arg : + triage sourceLeaf -- `triage` "a" case, Leaf (sourceStem self) -- `triage` "b" case, Stem (sourceFork self) -- `triage` "c" case, Fork @@ -47,5 +45,5 @@ toSource_ = Lib.y (\self arg : -- toSource takes a single TC term and returns a String toSource = \v : toSource_ v "" -exampleOne = toSource Lib.true -- OUT: "(t t)" -exampleTwo = toSource Lib.not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))" +exampleOne = toSource true -- OUT: "(t t)" +exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))" diff --git a/src/Eval.hs b/src/Eval.hs index 1172dbd..c263fd7 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -70,12 +70,12 @@ elimLambda = go | body == triageBody = _TRIAGE where triageBody = - (SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c)) + SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c) -- Composition optimization go (SLambda [f] (SLambda [g] (SLambda [x] body))) - | body == composeBody = _COMPOSE - where - composeBody = SApp (SVar f) (SApp (SVar g) (SVar x)) + | body == SApp (SVar f) (SApp (SVar g) (SVar x)) = _B + go (SLambda [f] (SLambda [x] (SLambda [y] body))) + | body == SApp (SApp (SVar f) (SVar y)) (SVar x) = _C -- General elimination go (SLambda (v:vs) body) | null vs = toSKI v (elimLambda body) @@ -96,8 +96,9 @@ elimLambda = go _S = parseSingle "t (t (t t t)) t" _K = parseSingle "t t" _I = parseSingle "t (t (t t)) t" + _B = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)" + _C = parseSingle "t (t (t (t (t t (t (t (t t t)) t))) (t (t (t t (t t))) (t (t (t t t)) t)))) (t t (t t))" _TRIAGE = parseSingle "t (t (t t (t (t (t t t))))) t" - _COMPOSE = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)" isFree :: String -> TricuAST -> Bool isFree x = Set.member x . freeVars @@ -108,12 +109,12 @@ freeVars (SInt _ ) = Set.empty freeVars (SStr _ ) = Set.empty freeVars (SList s ) = foldMap freeVars s freeVars (SApp f a ) = freeVars f <> freeVars a -freeVars (TLeaf ) = Set.empty +freeVars TLeaf = Set.empty freeVars (SDef _ _ b) = freeVars b freeVars (TStem t ) = freeVars t freeVars (TFork l r ) = freeVars l <> freeVars r freeVars (SLambda v b ) = foldr Set.delete (freeVars b) v -freeVars _ = Set.empty +freeVars _ = Set.empty reorderDefs :: Env -> [TricuAST] -> [TricuAST] reorderDefs env defs diff --git a/src/FileEval.hs b/src/FileEval.hs index 7580499..151dcc6 100644 --- a/src/FileEval.hs +++ b/src/FileEval.hs @@ -16,14 +16,11 @@ evaluateFileResult :: FilePath -> IO T evaluateFileResult filePath = do contents <- readFile filePath let tokens = lexTricu contents - let moduleName = case parseProgram tokens of - Right ((SModule name) : _) -> name - _ -> "" case parseProgram tokens of Left err -> errorWithoutStackTrace (handleParseError err) - Right _ -> do + Right ast -> do ast <- preprocessFile filePath - let finalEnv = mainAlias moduleName $ evalTricu Map.empty ast + let finalEnv = evalTricu Map.empty ast case Map.lookup "main" finalEnv of Just finalResult -> return finalResult Nothing -> errorWithoutStackTrace "No `main` function detected" @@ -32,37 +29,24 @@ evaluateFile :: FilePath -> IO Env evaluateFile filePath = do contents <- readFile filePath let tokens = lexTricu contents - let moduleName = case parseProgram tokens of - Right ((SModule name) : _) -> name - _ -> "" case parseProgram tokens of Left err -> errorWithoutStackTrace (handleParseError err) - Right _ -> do + Right ast -> do ast <- preprocessFile filePath - pure $ mainAlias moduleName $ evalTricu Map.empty ast + pure $ evalTricu Map.empty ast evaluateFileWithContext :: Env -> FilePath -> IO Env evaluateFileWithContext env filePath = do contents <- readFile filePath let tokens = lexTricu contents - let moduleName = case parseProgram tokens of - Right ((SModule name) : _) -> name - _ -> "" case parseProgram tokens of Left err -> errorWithoutStackTrace (handleParseError err) - Right _ -> do + Right ast -> do ast <- preprocessFile filePath - pure $ mainAlias moduleName $ evalTricu env ast - -mainAlias :: String -> Env -> Env -mainAlias "" env = env -mainAlias moduleName env = - case Map.lookup (moduleName ++ ".main") env of - Just value -> Map.insert "main" value env - Nothing -> env + pure $ evalTricu env ast preprocessFile :: FilePath -> IO [TricuAST] -preprocessFile filePath = preprocessFile' Set.empty filePath +preprocessFile = preprocessFile' Set.empty preprocessFile' :: Set.Set FilePath -> FilePath -> IO [TricuAST] preprocessFile' inProgress filePath @@ -74,77 +58,76 @@ preprocessFile' inProgress filePath case parseProgram tokens of Left err -> errorWithoutStackTrace (handleParseError err) Right asts -> do - let (moduleName, restAST) = extractModule asts - let (imports, nonImports) = partition isImport restAST + let (imports, nonImports) = partition isImport asts let newInProgress = Set.insert filePath inProgress - importedASTs <- concat <$> mapM (processImport newInProgress) imports - let namespacedAST = namespaceDefinitions moduleName nonImports - pure $ importedASTs ++ namespacedAST + importedASTs <- concat <$> mapM (processImport newInProgress "") imports + pure $ importedASTs ++ nonImports where - extractModule :: [TricuAST] -> (String, [TricuAST]) - extractModule ((SModule name) : xs) = (name, xs) - extractModule xs = ("", xs) - isImport :: TricuAST -> Bool isImport (SImport _ _) = True isImport _ = False - processImport :: Set.Set FilePath -> TricuAST -> IO [TricuAST] - processImport inProgress (SImport filePath moduleName) = do - importedAST <- preprocessFile' inProgress filePath - pure $ namespaceDefinitions moduleName importedAST - processImport _ _ = error "Unexpected non-import in processImport" + processImport :: Set.Set FilePath -> String -> TricuAST -> IO [TricuAST] + processImport prog currentModule (SImport path "!Local") = do + ast <- preprocessFile' prog path + let defs = filter (not . isImport) ast + pure $ map (nsDefinition currentModule) defs + processImport prog _ (SImport path name) = do + ast <- preprocessFile' prog path + let defs = filter (not . isImport) ast + pure $ map (nsDefinition name) defs + processImport _ _ _ = error "Unexpected non-import in processImport" -namespaceDefinitions :: String -> [TricuAST] -> [TricuAST] -namespaceDefinitions moduleName = map (namespaceDefinition moduleName) +nsDefinitions :: String -> [TricuAST] -> [TricuAST] +nsDefinitions moduleName = map (nsDefinition moduleName) -namespaceDefinition :: String -> TricuAST -> TricuAST -namespaceDefinition "" def = def -namespaceDefinition moduleName (SDef name args body) - | isPrefixed name = SDef name args (namespaceBody moduleName body) - | otherwise = SDef (namespaceVariable moduleName name) - args (namespaceBody moduleName body) -namespaceDefinition moduleName other = - namespaceBody moduleName other +nsDefinition :: String -> TricuAST -> TricuAST +nsDefinition "" def = def +nsDefinition moduleName (SDef name args body) + | isPrefixed name = SDef name args (nsBody moduleName body) + | otherwise = SDef (nsVariable moduleName name) + args (nsBody moduleName body) +nsDefinition moduleName other = + nsBody moduleName other -namespaceBody :: String -> TricuAST -> TricuAST -namespaceBody moduleName (SVar name) +nsBody :: String -> TricuAST -> TricuAST +nsBody moduleName (SVar name) | isPrefixed name = SVar name - | otherwise = SVar (namespaceVariable moduleName name) -namespaceBody moduleName (SApp func arg) = - SApp (namespaceBody moduleName func) (namespaceBody moduleName arg) -namespaceBody moduleName (SLambda args body) = - SLambda args (namespaceBodyScoped moduleName args body) -namespaceBody moduleName (SList items) = - SList (map (namespaceBody moduleName) items) -namespaceBody moduleName (TFork left right) = - TFork (namespaceBody moduleName left) (namespaceBody moduleName right) -namespaceBody moduleName (TStem subtree) = - TStem (namespaceBody moduleName subtree) -namespaceBody moduleName (SDef name args body) - | isPrefixed name = SDef name args (namespaceBody moduleName body) - | otherwise = SDef (namespaceVariable moduleName name) - args (namespaceBody moduleName body) -namespaceBody _ other = other + | otherwise = SVar (nsVariable moduleName name) +nsBody moduleName (SApp func arg) = + SApp (nsBody moduleName func) (nsBody moduleName arg) +nsBody moduleName (SLambda args body) = + SLambda args (nsBodyScoped moduleName args body) +nsBody moduleName (SList items) = + SList (map (nsBody moduleName) items) +nsBody moduleName (TFork left right) = + TFork (nsBody moduleName left) (nsBody moduleName right) +nsBody moduleName (TStem subtree) = + TStem (nsBody moduleName subtree) +nsBody moduleName (SDef name args body) + | isPrefixed name = SDef name args (nsBody moduleName body) + | otherwise = SDef (nsVariable moduleName name) + args (nsBody moduleName body) +nsBody _ other = other -namespaceBodyScoped :: String -> [String] -> TricuAST -> TricuAST -namespaceBodyScoped moduleName args body = case body of +nsBodyScoped :: String -> [String] -> TricuAST -> TricuAST +nsBodyScoped moduleName args body = case body of SVar name -> if name `elem` args then SVar name - else namespaceBody moduleName (SVar name) - SApp func arg -> SApp (namespaceBodyScoped moduleName args func) (namespaceBodyScoped moduleName args arg) - SLambda innerArgs innerBody -> SLambda innerArgs (namespaceBodyScoped moduleName (args ++ innerArgs) innerBody) - SList items -> SList (map (namespaceBodyScoped moduleName args) items) - TFork left right -> TFork (namespaceBodyScoped moduleName args left) (namespaceBodyScoped moduleName args right) - TStem subtree -> TStem (namespaceBodyScoped moduleName args subtree) + else nsBody moduleName (SVar name) + SApp func arg -> SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg) + SLambda innerArgs innerBody -> SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody) + SList items -> SList (map (nsBodyScoped moduleName args) items) + TFork left right -> TFork (nsBodyScoped moduleName args left) (nsBodyScoped moduleName args right) + TStem subtree -> TStem (nsBodyScoped moduleName args subtree) SDef name innerArgs innerBody -> - SDef (namespaceVariable moduleName name) innerArgs (namespaceBodyScoped moduleName (args ++ innerArgs) innerBody) + SDef (nsVariable moduleName name) innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody) other -> other isPrefixed :: String -> Bool isPrefixed name = '.' `elem` name -namespaceVariable :: String -> String -> String -namespaceVariable "" name = name -namespaceVariable moduleName name = moduleName ++ "." ++ name +nsVariable :: String -> String -> String +nsVariable "" name = name +nsVariable moduleName name = moduleName ++ "." ++ name diff --git a/src/Lexer.hs b/src/Lexer.hs index e435569..f881d6f 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -12,39 +12,71 @@ import qualified Data.Set as Set type Lexer = Parsec Void String +tricuLexer :: Lexer [LToken] +tricuLexer = do + sc + header <- many $ do + tok <- choice + [ try lImport + , lnewline + ] + sc + pure tok + tokens <- many $ do + tok <- choice tricuLexer' + sc + pure tok + sc + eof + pure (header ++ tokens) + where + tricuLexer' = + [ try lnewline + , try namespace + , try dot + , try identifier + , try keywordT + , try integerLiteral + , try stringLiteral + , assign + , colon + , backslash + , openParen + , closeParen + , openBracket + , closeBracket + ] + +lexTricu :: String -> [LToken] +lexTricu input = case runParser tricuLexer "" input of + Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err + Right tokens -> tokens + + keywordT :: Lexer LToken keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT identifier :: Lexer LToken identifier = do - first <- letterChar <|> char '_' + first <- lowerChar <|> char '_' rest <- many $ letterChar - <|> digitChar - <|> char '_' <|> char '-' <|> char '?' <|> char '.' - <|> char '$' <|> char '#' <|> char '@' <|> char '%' + <|> digitChar <|> char '_' <|> char '-' <|> char '?' + <|> char '$' <|> char '#' <|> char '@' <|> char '%' let name = first : rest if (name == "t" || name == "!result") then fail "Keywords (`t`, `!result`) cannot be used as an identifier" else return (LIdentifier name) -integerLiteral :: Lexer LToken -integerLiteral = do - num <- some digitChar - return (LIntegerLiteral (read num)) +namespace :: Lexer LToken +namespace = do + name <- try (string "!Local") <|> do + first <- upperChar + rest <- many (letterChar <|> digitChar) + return (first:rest) + return (LNamespace name) -stringLiteral :: Lexer LToken -stringLiteral = do - char '"' - content <- many (noneOf ['"']) - char '"' --" - return (LStringLiteral content) - -lModule :: Lexer LToken -lModule = do - _ <- string "!module" - space1 - LIdentifier moduleName <- identifier - return (LModule moduleName) +dot :: Lexer LToken +dot = char '.' *> pure LDot lImport :: Lexer LToken lImport = do @@ -52,7 +84,7 @@ lImport = do space1 LStringLiteral path <- stringLiteral space1 - LIdentifier name <- identifier + LNamespace name <- namespace return (LImport path name) assign :: Lexer LToken @@ -85,41 +117,15 @@ sc = space (skipLineComment "--") (skipBlockComment "|-" "-|") -tricuLexer :: Lexer [LToken] -tricuLexer = do - sc - header <- many $ do - tok <- choice - [ try lModule - , try lImport - , lnewline - ] - sc - pure tok - tokens <- many $ do - tok <- choice tricuLexer' - sc - pure tok - sc - eof - pure (header ++ tokens) - where - tricuLexer' = - [ try lnewline - , try identifier - , try keywordT - , try integerLiteral - , try stringLiteral - , assign - , colon - , backslash - , openParen - , closeParen - , openBracket - , closeBracket - ] +integerLiteral :: Lexer LToken +integerLiteral = do + num <- some digitChar + return (LIntegerLiteral (read num)) + +stringLiteral :: Lexer LToken +stringLiteral = do + char '"' + content <- many (noneOf ['"']) + char '"' --" + return (LStringLiteral content) -lexTricu :: String -> [LToken] -lexTricu input = case runParser tricuLexer "" input of - Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err - Right tokens -> tokens diff --git a/src/Parser.hs b/src/Parser.hs index dd8dd85..20828a6 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -73,8 +73,6 @@ parseSingle input = parseProgramM :: ParserM [TricuAST] parseProgramM = do - skipMany topLevelNewline - moduleNode <- optional parseModuleM skipMany topLevelNewline importNodes <- many (do node <- parseImportM @@ -83,16 +81,7 @@ parseProgramM = do skipMany topLevelNewline exprs <- sepEndBy parseOneExpression (some topLevelNewline) skipMany topLevelNewline - return (maybe [] (: []) moduleNode ++ importNodes ++ exprs) - - -parseModuleM :: ParserM TricuAST -parseModuleM = do - LModule moduleName <- satisfyM isModule - pure (SModule moduleName) - where - isModule (LModule _) = True - isModule _ = False + return (importNodes ++ exprs) parseImportM :: ParserM TricuAST parseImportM = do @@ -266,12 +255,19 @@ parseSingleItemM = do parseVarM :: ParserM TricuAST parseVarM = do - satisfyM (\case LIdentifier _ -> True; _ -> False) >>= \case + token <- satisfyM (\case + LNamespace _ -> True + LIdentifier _ -> True + _ -> False) + case token of + LNamespace ns -> do + _ <- satisfyM (== LDot) + LIdentifier name <- satisfyM (\case LIdentifier _ -> True; _ -> False) + pure $ SVar (ns ++ "." ++ name) LIdentifier name | name == "t" || name == "!result" -> fail ("Reserved keyword: " ++ name ++ " cannot be assigned.") - | otherwise -> - pure (SVar name) + | otherwise -> pure (SVar name) _ -> fail "Unexpected token while parsing variable" parseIntLiteralM :: ParserM TricuAST diff --git a/src/Research.hs b/src/Research.hs index 6a4234a..e9ae6f7 100644 --- a/src/Research.hs +++ b/src/Research.hs @@ -26,7 +26,6 @@ data TricuAST | TFork TricuAST TricuAST | SLambda [String] TricuAST | SEmpty - | SModule String | SImport String String deriving (Show, Eq, Ord) @@ -34,17 +33,18 @@ data TricuAST data LToken = LKeywordT | LIdentifier String + | LNamespace String | LIntegerLiteral Int | LStringLiteral String | LAssign | LColon + | LDot | LBackslash | LOpenParen | LCloseParen | LOpenBracket | LCloseBracket | LNewline - | LModule String | LImport String String deriving (Show, Eq, Ord) diff --git a/test/Spec.hs b/test/Spec.hs index 7c8f102..2ed06f5 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -532,6 +532,9 @@ modules = testGroup "Test modules" , testCase "Lambda expression namespaces" $ do res <- liftIO $ evaluateFileResult "./test/lambda-A.tri" res @?= Leaf + , testCase "Local namespace import chain" $ do + res <- liftIO $ evaluateFileResult "./test/local-ns/1.tri" + res @?= Fork (Stem Leaf) (Fork (Stem Leaf) Leaf) ] diff --git a/test/ascii.tri b/test/ascii.tri deleted file mode 100644 index ba749a9..0000000 --- a/test/ascii.tri +++ /dev/null @@ -1 +0,0 @@ -t (t (t (t (t t) (t t t)) t) t t) t diff --git a/test/assignment.tri b/test/assignment.tri deleted file mode 100644 index 9749e3b..0000000 --- a/test/assignment.tri +++ /dev/null @@ -1 +0,0 @@ -x = t (t t) t diff --git a/test/cycle-1.tri b/test/cycle-1.tri index 2821bfe..f77d6c1 100644 --- a/test/cycle-1.tri +++ b/test/cycle-1.tri @@ -1,4 +1,3 @@ -!module Cycle !import "test/cycle-2.tri" Cycle2 diff --git a/test/cycle-2.tri b/test/cycle-2.tri index e218ee4..61e911a 100644 --- a/test/cycle-2.tri +++ b/test/cycle-2.tri @@ -1,4 +1,3 @@ -!module Cycle2 !import "test/cycle-1.tri" Cycle1 diff --git a/test/lambda-A.tri b/test/lambda-A.tri index 844f615..da8cc0f 100644 --- a/test/lambda-A.tri +++ b/test/lambda-A.tri @@ -1,2 +1 @@ -!module A main = (\x : x) t diff --git a/test/local-ns/1.tri b/test/local-ns/1.tri new file mode 100644 index 0000000..fd10a99 --- /dev/null +++ b/test/local-ns/1.tri @@ -0,0 +1,4 @@ + +!import "test/local-ns/2.tri" Two + +main = Two.x diff --git a/test/local-ns/2.tri b/test/local-ns/2.tri new file mode 100644 index 0000000..6296138 --- /dev/null +++ b/test/local-ns/2.tri @@ -0,0 +1,2 @@ + +!import "test/local-ns/3.tri" !Local diff --git a/test/local-ns/3.tri b/test/local-ns/3.tri new file mode 100644 index 0000000..6d16539 --- /dev/null +++ b/test/local-ns/3.tri @@ -0,0 +1,2 @@ + +x = 3 diff --git a/test/modules-1.tri b/test/modules-1.tri deleted file mode 100644 index b23784b..0000000 --- a/test/modules-1.tri +++ /dev/null @@ -1,5 +0,0 @@ -!module Test - -!import "lib/base.tri" Lib - -main = Lib.not? t diff --git a/test/modules-2.tri b/test/modules-2.tri deleted file mode 100644 index 1469c24..0000000 --- a/test/modules-2.tri +++ /dev/null @@ -1 +0,0 @@ -n = t t t diff --git a/test/multi-level-A.tri b/test/multi-level-A.tri index 34a85f2..53a23b2 100644 --- a/test/multi-level-A.tri +++ b/test/multi-level-A.tri @@ -1,3 +1,2 @@ -!module A !import "./test/multi-level-B.tri" B main = B.main diff --git a/test/multi-level-B.tri b/test/multi-level-B.tri index 0d92637..63164d0 100644 --- a/test/multi-level-B.tri +++ b/test/multi-level-B.tri @@ -1,3 +1,2 @@ -!module B !import "./test/multi-level-C.tri" C main = C.val diff --git a/test/multi-level-C.tri b/test/multi-level-C.tri index a4005fb..cc31fa8 100644 --- a/test/multi-level-C.tri +++ b/test/multi-level-C.tri @@ -1,2 +1 @@ -!module C val = t diff --git a/test/named-imports/1.tri b/test/named-imports/1.tri new file mode 100644 index 0000000..8fe9296 --- /dev/null +++ b/test/named-imports/1.tri @@ -0,0 +1,7 @@ + +!import "lib/base.tri" + +!import "test/named-imports/2.tri" +!import "test/named-imports/3.tri" ThreeRenamed + +main = equal? (equal? Two.x 2) (equal? ThreeRenamed.x 3) diff --git a/test/named-imports/2.tri b/test/named-imports/2.tri new file mode 100644 index 0000000..76ef185 --- /dev/null +++ b/test/named-imports/2.tri @@ -0,0 +1,2 @@ + +x = 2 diff --git a/test/named-imports/3.tri b/test/named-imports/3.tri new file mode 100644 index 0000000..6d16539 --- /dev/null +++ b/test/named-imports/3.tri @@ -0,0 +1,2 @@ + +x = 3 diff --git a/test/namespace-A.tri b/test/namespace-A.tri index 6185d67..06813f9 100644 --- a/test/namespace-A.tri +++ b/test/namespace-A.tri @@ -1,3 +1,2 @@ -!module A !import "./test/namespace-B.tri" B main = B.x diff --git a/test/namespace-B.tri b/test/namespace-B.tri index 2cda9a7..38887fd 100644 --- a/test/namespace-B.tri +++ b/test/namespace-B.tri @@ -1,2 +1 @@ -!module B x = t diff --git a/test/undefined.tri b/test/undefined.tri deleted file mode 100644 index d09629a..0000000 --- a/test/undefined.tri +++ /dev/null @@ -1 +0,0 @@ -namedTerm = undefinedForTesting diff --git a/test/unresolved-A.tri b/test/unresolved-A.tri index ca19217..49ae52d 100644 --- a/test/unresolved-A.tri +++ b/test/unresolved-A.tri @@ -1,2 +1 @@ -!module A main = undefinedVar diff --git a/test/vars-A.tri b/test/vars-A.tri index 962def7..3336f41 100644 --- a/test/vars-A.tri +++ b/test/vars-A.tri @@ -1,4 +1,3 @@ -!module A !import "./test/vars-B.tri" B diff --git a/test/vars-B.tri b/test/vars-B.tri index b72ee50..765d006 100644 --- a/test/vars-B.tri +++ b/test/vars-B.tri @@ -1,2 +1 @@ -!module B y = \x : x diff --git a/test/vars-C.tri b/test/vars-C.tri index 78d36ce..91c0288 100644 --- a/test/vars-C.tri +++ b/test/vars-C.tri @@ -1,2 +1 @@ -!module C z = t diff --git a/tricu.cabal b/tricu.cabal index ad00528..4c82450 100644 --- a/tricu.cabal +++ b/tricu.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: tricu -version: 0.12.0 +version: 0.13.0 description: A micro-language for exploring Tree Calculus author: James Eversole maintainer: james@eversole.co