4642 / 2151 / 271
Регистрация: 01.03.2013
Сообщений: 5,725
Записей в блоге: 22
1

Простой интерпретатор Лисп-диалекта

02.06.2015, 18:50. Показов 996. Ответов 9
Метки нет (Все метки)

Вот навелосипедил - первоклассные лямбды, простые рантаймовые макросы, отложенные вычисления и ленивые списки. Многие вещи работают медленно, нет никаких оптимизаций - ни хвостовой рекурсии, ни мемоизации отложенных вычислений. ни сборки мусора - ничего вообще. Но проект делался не для создания промышленного диалекта, а для развлечения и постижения концепций. Либы (на Лисповом скрипте) можно пополнять бесконечно. Ядро тоже можно совершенствовать, реализовывать полноценные макросы, объектную систему, переключение контекста окружений или простые вещи - то же частичное применение (хотя это сахар и тривиально реализуется через анонимную лямбду). Вот ссылка на весь проект на гитхабе https://github.com/Ivana-/Liscript , вот кот ядра:
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
module Liscript where
 
import qualified Data.Map.Strict as Map
import Data.IORef
import System.IO
import Data.Time
 
 
------------------------ ТИП LispVal И ЕГО ИНСТАНСЫ ---------------------
 
 
data LispVal = Atom String
             | List [LispVal]
             | Func { params :: [String], body :: [LispVal], closure :: Env }
             | Macr { params :: [String], body :: [LispVal] }
 
instance Show LispVal where show = showVal
instance Eq   LispVal where (==) = eqVal
 
showVal :: LispVal -> String
showVal (Atom contents) = contents
showVal (List contents) = "(" ++ unwords (map showVal contents) ++ ")"
showVal (Func {params = args, body = body, closure = _}) = "(LAMBDA "
    ++ unwords (map show args)  ++ " (" ++ unwords (map showVal body) ++ "))"
showVal (Macr {params = args, body = body}) = "(MACRO "
    ++ unwords (map show args)  ++ " (" ++ unwords (map showVal body) ++ "))"
 
eqVal :: LispVal -> LispVal -> Bool
eqVal (Atom a)  (Atom b)  = a==b
eqVal (List []) (List []) = True -- тут конечно надо сравнить поэлементно
eqVal _         _         = False
 
 
------------------------------- ОКРУЖЕНИЕ -------------------------------
 
 
type Frame = Map.Map String LispVal -- кадр связывания имен ключ-значение
data Env = NullEnv | Voc (IORef Frame, Env) -- дерево кадров текущий-родитель
 
setVar NullEnv                  _   value = return ()
setVar (Voc (refframe, parenv)) var value = do
    frame <- readIORef refframe
    if Map.member var frame then modifyIORef' refframe $ Map.insert var value
    else setVar parenv var value
 
getVar NullEnv                  var = return $ Atom var
getVar (Voc (refframe, parenv)) var = do
    frame <- readIORef refframe
    maybe (getVar parenv var) return $ Map.lookup var frame
 
defVar NullEnv                  _   value = return ()
defVar (Voc (refframe, parenv)) var value = do
    modifyIORef' refframe $ Map.insert var value
 
 
------------------------------- ПАРСЕР -------------------------------
 
 
mytokens :: String -> [String]
mytokens = go 0 False "" where
    go _ _ t [] = addtoken t []
    go l f t (c:cs)
        | elem c " \n\t" && l==0 && not f = addtoken t $ go 0 False "" cs
        | otherwise = go l' f' (c:t) cs
        where
            l' | f = l | c=='(' = l+1 | c==')' = l-1 | otherwise = l
            f' | c=='"' = not f | otherwise = f
    addtoken t r | null t = r | otherwise = reverse t:r
 
str2LV :: String -> LispVal
str2LV = go . mytokens where
    go [t] | fst == '(' && lst == ')' = List . map str2LV . mytokens $ mid
           | fst == '"' && lst == '"' = Atom mid
           | fst == '\'' = List $ (Atom "quote") : [str2LV $ tail t]
           | otherwise = Atom t
        where fst = head t
              lst = last t
              mid = tail $ init t
    go l = List $ map str2LV l
 
fromAtom (Atom s) = s
prepare = id -- можно написать замену "(" на " (" и т.п. перед парсингом
 
 
------------------------------ МАКРОСЫ -----------------------------
 
 
macroexpand :: (String, LispVal) -> LispVal -> LispVal
macroexpand varval body = go body where
    (var, val) = varval
    go (Atom a) | a==var = val | otherwise = (Atom a)
    go (List l) = List $ map go l
    go        x = x
 
 
------------------------------- ЭВАЛ -------------------------------
 
 
eval :: Env -> LispVal -> IO LispVal
eval env (Atom s) = getVar env s
eval env (List l) = do
    op <- eval env $ head l
    let ls = tail l
 
        foldInteger op = do
            evls <- mapM (eval env) ls
            let l = map ((\s -> read s::Integer) . fromAtom) evls
            return $ Atom $ show $ foldl1 op l
 
        foldDouble op = do
            evls <- mapM (eval env) ls
            let l = map ((\s -> read s::Double) . fromAtom) evls
            return $ Atom $ show $ foldl1 op l
 
        compareInteger op = do
            evls <- mapM (eval env) $ take 2 ls
            let [a,b] = map ((\s -> read s::Integer) . fromAtom) evls
            return $ Atom $ show $ op a b
 
        compareDouble op = do
            evls <- mapM (eval env) $ take 2 ls
            let [a,b] = map ((\s -> read s::Double) . fromAtom) evls
            return $ Atom $ show $ op a b
 
    case op of
 
        Atom "+" -> foldInteger (+)
        Atom "-" -> foldInteger (-)
        Atom "*" -> foldInteger (*)
        Atom "/" -> foldInteger (div)
        Atom "mod" -> foldInteger (mod)
 
        Atom "+'" -> foldDouble (+)
        Atom "-'" -> foldDouble (-)
        Atom "*'" -> foldDouble (*)
        Atom "/'" -> foldDouble (/)
 
        Atom ">"  -> compareInteger (>)
        Atom ">=" -> compareInteger (>=)
        Atom "<"  -> compareInteger (<)
        Atom "<=" -> compareInteger (<=)
        Atom "="  -> compareInteger (==)
        Atom "/=" -> compareInteger (/=)
 
        Atom ">'"  -> compareDouble (>)
        Atom ">='" -> compareDouble (>=)
        Atom "<'"  -> compareDouble (<)
        Atom "<='" -> compareDouble (<=)
        Atom "='"  -> compareDouble (==)
        Atom "/='" -> compareDouble (/=)
 
        Atom "atom?" -> do
            value <- eval env $ head ls
            let go (Atom _) = Atom "True"
                go _        = Atom "False"
            return $ go value
 
        Atom "list?" -> do
            value <- eval env $ head ls
            let go (List _) = Atom "True"
                go _        = Atom "False"
            return $ go value
 
        Atom "eq?" -> do
            [a,b] <- mapM (eval env) $ take 2 ls
            return $ Atom . show $ (==) a b
 
        Atom "quote" -> return $ head ls
 
        Atom "eval" -> do
            value <- eval env $ head ls
            eval env value
 
        Atom "str" -> do
            evls <- mapM (eval env) ls
            return $ List evls
 
        Atom "cond" -> do
            let cond (p:e:xx) = do
                    evp <- eval env p
                    if (\s -> read s::Bool) . fromAtom $ evp
                        then eval env e else cond xx
                cond [e] = eval env e
            cond ls
 
        Atom "printLn" -> do
            value <- eval env $ head ls
            putStrLn $ show value
            return $ Atom ""
 
        Atom "print" -> do
            value <- eval env $ head ls
            putStr $ show value
            return $ Atom ""
 
        Atom "set!" -> do
            value <- eval env $ last ls
            setVar env (fromAtom . head $ ls) value
            return $ Atom ""
 
        Atom "def" -> do
            value <- eval env $ last ls
            defVar env (fromAtom . head $ ls) value
            return $ Atom ""
 
        Atom "defn" -> do
            value <- eval env $ List $ (Atom "lambda") : tail ls
            defVar env (fromAtom . head $ ls) value
            return $ Atom ""
 
        Atom "lambda" -> do
            let
                getargnames (List l) = map fromAtom l
                args = getargnames $ head ls
                getfoobody[List a] = getfoobody a
                getfoobody l = l
                foobody  = getfoobody $ tail ls
            return Func { params = args, body = foobody, closure = env }
 
        Atom "macro" -> do
            let
                getargnames (List l) = map fromAtom l
                args = getargnames $ head ls
                getmacrobody[List a] = getmacrobody a
                getmacrobody l = l
                macrobody  = getmacrobody $ tail ls
            return Macr { params = args, body = macrobody }
 
        Atom "cons" -> do
            evls <- mapM (eval env) ls
            let cons x (List l)  = List (x:l)
--                cons x (Atom  s) = List (x:(Atom s):[])
                cons x y = List (x:y:[])
            return $ cons (evls!!0) (evls!!1)
 
        Atom "car" -> do
            value <- eval env $ head ls
            let car (List l)  = if null l then List [] else head l
                car (Atom  s) = Atom ""
            return $ car value
 
        Atom "cdr" -> do
            value <- eval env $ head ls
            let cdr (List l)  = if null l then List [] else List (tail l)
                cdr (Atom  s) = Atom ""
            return $ cdr value
 
        Func {params = args, body = foobody, closure = envfun} -> do
            evls <- mapM (eval env) ls
            reflocalframe <- newIORef $ Map.fromList $ zip args evls
            let envloc = Voc (reflocalframe, envfun)
            eval envloc $ List foobody
 
        Macr {params = args, body = macrobody} -> do
            let body' = foldr macroexpand (List macrobody) $ zip args ls
--            print body'
            eval env $ body'
 
        _ -> do
            let go []  = return op
                go [x] = eval env x
                go (x:xs) = do
                    eval env x
                    go xs
            go ls
 
 
------------------------------- МЭЙН -------------------------------
 
 
loadfile env filename = do
    handle   <- openFile filename ReadMode
    contents <- hGetContents handle
    res      <- eval env . str2LV . prepare $ contents
    print res
    hClose handle
    return res
 
main = do
    begT <- getCurrentTime
 
    refglobalframe <- newIORef $ Map.empty
    let globalframe = Voc (refglobalframe, NullEnv)
 
    loadfile globalframe "lib.txt"
    loadfile globalframe "test.txt"
    loadfile globalframe "test1.txt"
 
    endT <- getCurrentTime
    putStrLn $ "Elapced time: " ++ show (diffUTCTime endT begT)
 
 
-- дополнительные необязательные функции
-- если для отладки надо посмотреть содержимое окружения
 
showEnv NullEnv                  = putStr "Null"
showEnv (Voc (refframe, parenv)) = do
    putStr "("
    frame <- readIORef refframe
    putStr $ show frame
    putStr ","
    showEnv parenv
    putStr ")"
 
myprint f@(Func {params = _, body = _, closure = env}) = do
    print f
    showEnv env
    putStrLn ""
myprint x = print x
ЗЫ у меня на винде русские буквы нормально печатаются Хаскелем если файл в кодировке вин1251, а на гитхабе эта кодировка кривится - туда надо UTF-8. Вроде если сделать ее "без BOM", то должно быть все нормально, но в Идее не нашел такого варианта кодировки. Так что с русскими буквами и кодировкой решайте сами, на Линуксах по слухам этой проблемы нет.
7
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
02.06.2015, 18:50
Ответы с готовыми решениями:

Как переносить код в интерпретатор лисп
Добрый вечер. Я пишу программы на лиспе в текстовом редакторе с подсветкой синтаксиса. У меня...

Простой интерпретатор команд
Всем привет. недавно понадобилось динамики добавить из инишника. поискал парсер сценариев, ниче...

Посоветуйте простой оффлайн-интерпретатор С++
Что-то вроде cpp.sh. Просто иногда требуется проверить работу небольшой функции, а захламлять комп...

Обсуждение конструкций диалекта
Коменты вынес в отдельную ветку, тут можно выдвигать различные гипотезы и мнения о конструкциях...

9
Модератор
Эксперт функциональных языков программированияЭксперт Python
30003 / 16478 / 3337
Регистрация: 12.02.2012
Сообщений: 27,430
Записей в блоге: 5
02.06.2015, 19:04 2
_Ivana, просто отлично!
0
_Ivana
02.06.2015, 19:08  [ТС]
  #3

Не по теме:

Catstail, ну, подозреваю, что гораздо слабее Home Lisp-а как по возможностям так и по скорости, но что смог на текущий момент.

0
Модератор
Эксперт функциональных языков программированияЭксперт Python
30003 / 16478 / 3337
Регистрация: 12.02.2012
Сообщений: 27,430
Записей в блоге: 5
02.06.2015, 20:02 4
Цитата Сообщение от _Ivana Посмотреть сообщение
подозреваю, что гораздо слабее Home Lisp-а как по возможностям так и по скорости
- вот по скорости, как раз не факт! HomeLisp - итерпретатор на VB, а Ваш Лисп - на Haskell. Но дело не в этом. У Вас получилась очень красивая и компактная реализация! Завидую белой завистью!
0
4265 / 2802 / 410
Регистрация: 01.06.2013
Сообщений: 5,872
Записей в блоге: 9
03.06.2015, 10:12 5
Цитата Сообщение от _Ivana Посмотреть сообщение
у меня на винде русские буквы нормально печатаются Хаскелем если файл в кодировке вин1251
Где нормально печатаются? Родная кодировка для .hs UTF-8 "без BOM". В консоль windows тогда, как раз перекодирование правильно происходит в putStr. В IDEA то что UTF-8, как раз "без BOM". File - Settings - Editor - FileEncoding. Или в нижней строке справа кодировка для каждого файла.
0
650 / 260 / 16
Регистрация: 02.03.2014
Сообщений: 587
08.06.2015, 09:51 6
По поводу, возможностей. Ваше чудо позволяет писать прототипы функций на хаскеле, а потом вставлять их в кота на лиспе... мечта! Огромное спасибо!
0
4642 / 2151 / 271
Регистрация: 01.03.2013
Сообщений: 5,725
Записей в блоге: 22
08.06.2015, 14:09  [ТС] 7
Хм... Вы его используете "наизнанку" - сначала хаскельным кодом заполняете АТД LispVal (вместо заполнения его через парсинг текстового файла кода скрипта) а потом выводите его на экран методом show и копипастите это в Лисп-кота? Или вы что-то другое имеете в виду? Расскажите поподробнее, мне интересно что умеет мое чудо, а я даже не в курсе
0
650 / 260 / 16
Регистрация: 02.03.2014
Сообщений: 587
08.06.2015, 19:27 8
Пишу функцию обрабатывающую АТД на Хаскеле, потом вставляю её в "eval" в результате список "стандартных" функций расширяется моей собственной, а я могу вызвать функцию написанную на Хаскеле, из лисп кода ))
1
4642 / 2151 / 271
Регистрация: 01.03.2013
Сообщений: 5,725
Записей в блоге: 22
08.06.2015, 22:01  [ТС] 9
А, ну да, так конечно можно Более того, я так и делаю сейчас. Хотя с другой стороны, в традициях Scheme минимализм "особых форм" (стандартных функций), все остальное стараются сделать через них и макросы-библиотечные функции. Например - структуру данных типа двоичного дерева поиска можно реализовать на замыканиях и списках, которые уже реализованы в ядре, а можно сделать отдельный вариант типа LispVal со стандартной хаскелевской Map - так будет быстрее работать, но потребуется добавить несколько стандартных функций для работы с этим типом.

Добавлено через 4 минуты
Например, функцию запроса ввода значения пользователем и многое подобное я не добавил пока только потому, что это мне пока не требовалось, но это совершенно не сложно сделать по аналогии с существующими функциями.
1
4642 / 2151 / 271
Регистрация: 01.03.2013
Сообщений: 5,725
Записей в блоге: 22
11.06.2015, 23:38  [ТС] 10
На одном форуме зашел разговор про монады и их реализации на разных языках. В качестве примера был выложен следующий код:
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
example n = do
  a <- [1..n]
  b <- [1..a]
  [(a, b), (b, a)]
 
// example 3 = [(1,1),(1,1),(2,1),(1,2),(2,2),(2,2),(3,1),(1,3),(3,2),(2,3),(3,3),(3,3)]
 
example' n =
  [1..n] >>= (\a ->
    [1..a] >>= (\b ->
      [(a, b), (b, a)]))
 
// example' 3 = [(1,1),(1,1),(2,1),(1,2),(2,2),(2,2),(3,1),(1,3),(3,2),(2,3),(3,3),(3,3)]
Я не смог пройти мимо равнодушно, и на скорую руку нацарапал следующее:
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(defn return (x) (cons x nil))
(defn bind (l f) (concat (map f l)))
 
(defn example (n)
    (bind (list-from-to 1 n)
          (lambda (a) (bind (list-from-to 1 a)
                            (lambda (b) (cons (cons a b) (cons (cons b a) nil)))))))
(printLn (example 3))
 
(def <- (macro (_n _v _e) (bind _v (lambda (_n) _e))))
 
(defn do-example (n)
    (<- a (list-from-to 1 n)
    (<- b (list-from-to 1 a)
    (cons (cons a b) (cons (cons b a) nil)) )))
(printLn (do-example 3))
 
((1 1) (1 1) (2 1) (1 2) (2 2) (2 2) (3 1) (1 3) (3 2) (2 3) (3 3) (3 3))
((1 1) (1 1) (2 1) (1 2) (2 2) (2 2) (3 1) (1 3) (3 2) (2 3) (3 3) (3 3))
ЗЫ только в хаскеле можно как угодно менять порядок определения a и b (наверное, не проверял), потому что он декларативный и ленивый, а в лискрипте нет, потому что он императивный и строгий

Добавлено через 23 часа 12 минут
Еще немного макросового сахара для do-нотации
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defn return (x) (cons x nil))
(defn bind (l f) (concat (map f l)))
 
(defn foldapp (l)
    (cond (null? (car (cdr l))) (car l)
          (append (deinfix (take 3 l)) (cons (foldapp (drop 3 l)) nil)) ))
 
(defn deinfix (l) (cons (car (cdr l)) (cons (car l) (cdr (cdr l)))) )
 
(def do (macro (_l) (eval (foldapp '_l))))
 
(def <- (macro (_n _v _e) (bind _v (lambda (_n) _e))))
 
(defn do-example (n) (do (
    a <- (list-from-to 1 n)
    b <- (list-from-to 1 a)
    c <- (list-from-to 1 b)
    (cons (cons c (cons b a)) nil)
)))
(printLn (do-example 3))
 
((1 1 1) (1 1 2) (1 2 2) (2 2 2) (1 1 3) (1 2 3) (2 2 3) (1 3 3) (2 3 3) (3 3 3))
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
11.06.2015, 23:38

Рекурсия. Лисп
Добрый день! Есть такая задача Дан список (a b c d). Необходимо преобразовать его в список (a (b)...

інтерпритатора Лисп
Помогите пожалуйста.Вычислите с помощью інтерпритатора Лисп 77-21.3+1.54*2.5432-32

Цикл в лисп
Здравствуйте. Есть такой код. (setf lst '(x1 x2 x3 x4)) (setf x1 2) (setf x2 3) (setf x3 4)...

Лисп. Функционалы
Здравствуйте , помогите пожалуйста. Задача Написать программу с использованием...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.