From 9b4ce32280fdc4298cfc7599491d8e8893de6354 Mon Sep 17 00:00:00 2001 From: Jan Tuomi Date: Sun, 4 Dec 2022 22:25:55 +0200 Subject: Remove name mangling and qualified imports because they are hard --- src/Interpreter.hs | 32 ----------------------------- src/Parser.hs | 3 ++- stdlib/common.lisp | 17 ---------------- stdlib/maybe.lisp | 59 +++++++++++++++++++++++------------------------------- todo.md | 3 --- 5 files changed, 27 insertions(+), 87 deletions(-) diff --git a/src/Interpreter.hs b/src/Interpreter.hs index aa61be3..ce68270 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -46,21 +46,6 @@ traverseAndReplace param arg ast@AST { astNode = ASTHashMap hmap } = .> asPairs .> M.fromList } traverseAndReplace _ _ other = other -traverseAndRenameSymbol :: String -> String -> AST -> AST -traverseAndRenameSymbol name1 name2 ast@AST { astNode = ASTSymbol sym } - | sym == name1 = ast { astNode = ASTSymbol name2 } - | otherwise = ast -traverseAndRenameSymbol name1 name2 ast@AST { astNode = ASTFunctionCall body } = - ast { astNode = ASTFunctionCall $ (map (traverseAndRenameSymbol name1 name2) body) } -traverseAndRenameSymbol name1 name2 ast@AST { astNode = ASTVector vec } = - ast { astNode = ASTVector $ (map (traverseAndRenameSymbol name1 name2) vec) } -traverseAndRenameSymbol name1 name2 ast@AST { astNode = ASTHashMap hmap } = - ast { astNode = ASTHashMap $ M.assocs hmap - $> L.concatMap (\(a, b) -> [a, b]) - .> map (traverseAndRenameSymbol name1 name2) - .> asPairs .> M.fromList } -traverseAndRenameSymbol _ _ other = other - foldSymValPairs :: [(String, AST)] -> AST -> AST foldSymValPairs [] body = body foldSymValPairs ((sym, val):rest) body = @@ -227,23 +212,6 @@ evaluateImport asts = do stateEnv = emptyEnv { envImported = builtinEnv } } case args of - -- qualified import - [AST { astNode = ASTSymbol qualifier }, AST { astNode = ASTString path }] -> do - LState { stateEnv = evaledRawEnv } <- lift $ execStateT (runScriptFile path) initialState - let exportedEnvMap = envThis evaledRawEnv - - let mangle k = qualifier ++ ":" ++ k - let mangledExportsMap = M.mapKeys mangle exportedEnvMap - let nonMangledKeys = M.keys exportedEnvMap - let callWithAll (f:fs) x = callWithAll fs (f x) - callWithAll [] x = x - let traverseAndReplaceAllKeys = map (\k -> traverseAndRenameSymbol k (mangle k)) nonMangledKeys - let mangledTraversedMap = M.map (\a -> (callWithAll traverseAndReplaceAllKeys a)) mangledExportsMap - env <- getEnv - let importedEnv = envImported env - putImportedEnv $ M.union importedEnv mangledTraversedMap - return $ importAst { astNode = ASTUnit } - -- non-qualified import [AST { astNode = ASTString path }] -> do LState { stateEnv = evaledRawEnv } <- lift $ execStateT (runScriptFile path) initialState diff --git a/src/Parser.hs b/src/Parser.hs index 20a1454..fa806fd 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -5,6 +5,7 @@ module Parser ( import qualified Data.Map as M import qualified Data.List as L import qualified Data.Maybe as MB +import Control.Monad.State import Control.Monad.Except import Text.Regex.TDFA import Utils @@ -74,4 +75,4 @@ _parse acc (token:rest) = _parse (parseToken token : acc) rest parse :: [Token] -> LContext [AST] -parse = _parse [] \ No newline at end of file +parse = _parse [] diff --git a/stdlib/common.lisp b/stdlib/common.lisp index efb1183..4d5b132 100644 --- a/stdlib/common.lisp +++ b/stdlib/common.lisp @@ -67,20 +67,3 @@ (let! flow (\[fs] (foldr compose id (reverse fs)))) (let! pipe (\[x fs] ((flow fs) x))) - -(let! lazy exports [ - compose - id - mod - not - is-even - is-odd - map - foldr - filter - fibo - reverse_ - reverse - flow - pipe -]) diff --git a/stdlib/maybe.lisp b/stdlib/maybe.lisp index 0bc7ac4..07adaee 100644 --- a/stdlib/maybe.lisp +++ b/stdlib/maybe.lisp @@ -1,60 +1,51 @@ ; LIB -(let! just (\[a] +(let! Maybe/just (\[a] ["maybe" "just" a])) -(let! nothing (\[] +(let! Maybe/nothing (\[] ["maybe" "nothing"])) -(let! unsafe-at (\[n seq] +(let! Maybe/#at (\[n seq] (match seq [] - (fatal! "unsafe-at out of bounds") + (fatal! "Maybe/#at out of bounds") otherwise (match n 0 (head seq) otherwise - (unsafe-at (- n 1) (tail seq)))))) + (Maybe/#at (- n 1) (tail seq)))))) -(let! unpack-just (unsafe-at 2)) -(let! kind (unsafe-at 1)) +(let! Maybe/unpack (Maybe/#at 2)) +(let! Maybe/kind (Maybe/#at 1)) -(let! map (\[f m] - (match (kind m) - "just" (just (f (unpack-just m))) - "nothing" (nothing)))) +(let! Maybe/map (\[f m] + (match (Maybe/kind m) + "just" (Maybe/just (f (Maybe/unpack m))) + "nothing" (Maybe/nothing)))) -(let! and-then (\[f m] - (match (kind m) - "just" (f (unpack-just m)) - "nothing" (nothing)))) +(let! Maybe/and-then (\[f m] + (match (Maybe/kind m) + "just" (f (Maybe/unpack m)) + "nothing" (Maybe/nothing)))) ; TESTING ;; (let! print-line! (\[s] ;; (print! (concat s "\n")))) -;; (let! a (just 10)) -;; (let! b (nothing)) +;; (let! a (Maybe/just 10)) +;; (let! b (Maybe/nothing)) -;; (map (+ 5) a) -;; (map (+ 5) b) +;; (Maybe/map (+ 5) a) +;; (Maybe/map (+ 5) b) -;; (and-then (\[n] (just (+ n 5))) a) -;; (and-then (\[n] (just (+ n 5))) b) +;; (Maybe/and-then (\[n] (Maybe/just (+ n 5))) a) +;; (Maybe/and-then (\[n] (Maybe/just (+ n 5))) b) -;; (let! m (just 10)) +;; (let! m (Maybe/just 10)) ;; (match m -;; (just _) -;; (print-line! (fmt "found just {0}!" [(unpack-just m)])) -;; (nothing) +;; (Maybe/just _) +;; (print-line! (fmt "found just {0}!" [(Maybe/unpack m)])) +;; (Maybe/nothing) ;; (print-line! "found nothing!")) - -(let! lazy exports [ - just - nothing - unpack-just - kind - map - and-then -]) diff --git a/todo.md b/todo.md index 000ad65..231b0b4 100644 --- a/todo.md +++ b/todo.md @@ -3,9 +3,6 @@ In order of priority - Write function let expressions properly using lookups -- Add proper module system - - Make exports a return value of runXXX functions - Write tests! - Come up with a name for the language -- Add auto import for standard library (std) and a flag to disable auto import - Add effects system (see `examples/effects-concept.lisp`) -- cgit v1.3