Remove curiosity files from tree
This commit is contained in:
parent
349a42510f
commit
53e6421ce1
|
|
@ -1,47 +0,0 @@
|
|||
iIYVVVVXVVVVVVVVVYVYVYYVYYYYIIIIYYYIYVVVYYYYYYYYYVVYVVVVXVVVVVYI+.
|
||||
tYVXXXXXXVXXXXVVVYVVVVVVVVVVVVYVVVVVVVVVVVVVVVVVXXXXXVXXXXXXXVVYi.
|
||||
iYXRXRRRXXXXXXXXXXXVVXVXVVVVVVVVXXXVXVVXXXXXXXXXXXXXXRRRRRRRRRXVi.
|
||||
tVRRRRRRRRRRRRRRRXRXXXXXXXXXXXXXXRRXXXXRRRRXXXXXXXRRRRRRRRRRRRXV+.
|
||||
tVRRBBBRMBRRRRRRRRRXXRRRRRXt=+;;;;;==iVXRRRRXXXXRRRRRRRRMMBRRRRXi,
|
||||
tVRRBMBBMMBBBBBMBBRBBBRBX++=++;;;;;;:;;;IRRRRXXRRRBBBBBBMMBBBRRXi,
|
||||
iVRMMMMMMMMMMMMMMBRBBMMV==iIVYIi=;;;;:::;;XRRRRRRBBMMMMMMMMBBRRXi.
|
||||
iVRMMMMMMMMMMMMMMMMMMMY;IBWWWWMMXYi=;:::::;RBBBMMMMMMMMMMMMMMBBXi,
|
||||
+VRMMRBMMMMMMMMMMMMMMY+;VMMMMMMMRXIi=;:::::=VVXXXRRRMMMMMMMMBBMXi;
|
||||
=tYYVVVXRRRXXRBMMMMMV+;=RBBMMMXVXXVYt;::::::ttYYVYVVRMMMMMMBXXVI+=
|
||||
;=tIYYVYYYYYYVVVMMMBt=;;+i=IBi+t==;;i;::::::+iitIIttYRMMMMMRXVVI=;
|
||||
;=IIIIYYYIIIIttIYItIt;;=VVYXBIVRXVVXI;::::::;+iitttttVMMBRRRVVVI+,
|
||||
;+++tttIttttiiii+i++==;;RMMMBXXMMMXI+;::::::;+ittttitYVXVYYIYVIi;;
|
||||
;===iiittiiIitiii++;;;;:IVRVi=iBXVIi;::::::::;==+++++iiittii+++=;;
|
||||
;;==+iiiiiiiiii+++=;;;;;;VYVIiiiVVt+;::::::::;++++++++++iti++++=;;
|
||||
;;=++iiii+i+++++iii==;;;::tXYIIYIi+=;:::::,::;+++++++++++++++++=;;
|
||||
;;;+==+ii+++++iiiiit=;;:::::=====;;;::::::::::+++i+++++++++i+++;;;
|
||||
;;;==+=+iiiiitttIIII+;;;:,::,;;;;:;=;;;::,::::=++++++++==++++++;;;
|
||||
:;====+tittiiittttti+;;::::,:=Ytiiiiti=;:::::,:;;==ii+ittItii+==;;
|
||||
;;+iiittIti+ii;;===;;:;::::;+IVXVVVVVVt;;;;;::::;;===;+IIiiti=;;;;
|
||||
;=++++iIti+ii+=;;;=;:::;;+VXBMMBBBBBBXY=;=;;:::::;=iYVIIttii++;;;;
|
||||
;;++iiiItttIi+++=;;:::;=iBMMMMMMMMMMMXI==;;,::;;:;;=+itIttIIti+;;;
|
||||
;=+++++i+tYIIiii;:,::;itXMMMMMMMMMMMBXti==;:;++=;:::::;=+iittti+;;
|
||||
;;+ii+ii+iitiIi;::::;iXBMMMMMWWWWWMMBXti+ii=;::::,,,,:::=;==+tI+;;
|
||||
;;iiiitItttti;:::;::=+itYXXMWWWWWWMBYt+;;::,,,,,,,,,,,,,:==;==;;;;
|
||||
:;=iIIIttIt+:;:::;;;==;+=+iiittttti+;;:,:,,,,::,,,,,,,,:::;=;==::;
|
||||
;::=+ittiii=;:::::;;;:;:;=++==;;==;:,,,,,,:;::::,,,,,,,,::;==;;::;
|
||||
:::;+iiiii=;::::,:;:::::;;:;;::;:::,,,,,,,:::;=;;;:,,,,,:::;;::::;
|
||||
:;;iIIIIII=;:::,:::::::,::::,:::,,,,,,,,,,,:;;=;:,,,,,,::::;=;:::;
|
||||
:;==++ii+;;;:::::::::::,,,,,,::,,,,,,,,,,,::::,,,,,,,,,,:,:::::::;
|
||||
::;;=+=;;;:::;;::,,,,,,,,,,,,,,,,,,,,,,,,,:,,,,,,,,,,,,,,,,,:::::;
|
||||
::;=;;;:;:::;;;;::,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,::,,::::;
|
||||
:;;:;::::::,::,,:,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:::;
|
||||
:::::::::::;;;:,,,,,,,,,,,,,...,...,,,.,,,,,,,,,,,,.,,,,,,,,,,,,:;
|
||||
::::::::;=;;;;;::,,,,,,,,,,,.......,...,,,,,,,,,,,,.,,,,,,,,,,,,,;
|
||||
:::::,,:;=;;;;;;;iVXXXVt+:,,....,,,,....,.,,,,,,,.,.....,,,,,,,,:;
|
||||
:,,::,,:::;;;;;;=IVVVXXXXVXVt:,,,,,..,..,,,,.,,,,,..,.,,,,,,,,,,,;
|
||||
::,::,,,:,:::::,::;=iIYVXVVVVIYIi;,,.,.,,,::,,,,,,,,,,,,,,,,,,,,,.
|
||||
:,,,,,,,,,,,,,,,,::;+itIIIIIIi:;;i++=;;;;;;;;;::,,,...,,..,,,,,,,.
|
||||
:,,,,,,,,,,,,,,=iitVYi++iitt==it;;:;;;;::;;::::,,,......,,,,,,,::.
|
||||
::,,,,,,,,,,,,,++iiIVIi=;;=;+i;:;+:::,,,,,,,,,,,,,.....,,,,,,,,::,
|
||||
,,,,,,,,,,,,,,,;=+it=:::,,,,,,,,,,.,......,,.,..........,,,,,,,,::
|
||||
:,,,,,,,,,,,,,,,,:=:,,,,,,,,,,,,,,......................,.,,.,.,,:
|
||||
:,,,,,,,,,,,,,,,,,:,,,,,,,,,,..,........................,..,...,,:
|
||||
,,,,,,,,,,,,,,,,,,,.....................................,.......,,
|
||||
,,,,,,,,,.,,,,,,,...............................................,,
|
||||
itittiiiii+=++=;;=iiiiiiittiiiiii+iii===;++iiitiiiiiii+=====+ii=+i
|
||||
|
|
@ -1,71 +0,0 @@
|
|||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>''''''<!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!'''''` ``'!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!''` ..... `'!!!!!!!!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!!!!!!!'` . :::::' `'!!!!!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!!!!!' . ' .::::' `!!!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!!!' : ````` `!!!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!!! .,cchcccccc,,. `!!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!!! .-"?$$$$$$$$$$$$$$c, `!!!!!!!!!!!
|
||||
!!!!!!!!!!!!!! ,ccc$$$$$$$$$$$$$$$$$$$, `!!!!!!!!!!
|
||||
!!!!!!!!!!!!! z$$$$$$$$$$$$$$$$$$$$$$$$;. `!!!!!!!!!
|
||||
!!!!!!!!!!!! <$$$$$$$$$$$$$$$$$$$$$$$$$$:. `!!!!!!!!
|
||||
!!!!!!!!!!! $$$$$$$$$$$$$$$$$$$$$$$$$$$h;:. !!!!!!!!
|
||||
!!!!!!!!!!' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$h;. !!!!!!!
|
||||
!!!!!!!!!' <$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ !!!!!!!
|
||||
!!!!!!!!' `$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F `!!!!!!
|
||||
!!!!!!!! c$$$$???$$$$$$$P"" """??????" !!!!!!
|
||||
!!!!!!! `"" .,.. "$$$$F .,zcr !!!!!!
|
||||
!!!!!!! . dL .?$$$ .,cc, .,z$h. !!!!!!
|
||||
!!!!!!!! <. $$c= <$d$$$ <$$$$=-=+"$$$$$$$ !!!!!!
|
||||
!!!!!!! d$$$hcccd$$$$$ d$$$hcccd$$$$$$$F `!!!!!
|
||||
!!!!!! ,$$$$$$$$$$$$$$h d$$$$$$$$$$$$$$$$ `!!!!!
|
||||
!!!!! `$$$$$$$$$$$$$$$<$$$$$$$$$$$$$$$$' !!!!!
|
||||
!!!!! `$$$$$$$$$$$$$$$$"$$$$$$$$$$$$$P> !!!!!
|
||||
!!!!! ?$$$$$$$$$$$$??$c`$$$$$$$$$$$?>' `!!!!
|
||||
!!!!! `?$$$$$$I7?"" ,$$$$$$$$$?>>' !!!!
|
||||
!!!!!. <<?$$$$$$c. ,d$$?$$$$$F>>'' `!!!
|
||||
!!!!!! <i?$P"??$$r--"?"" ,$$$$h;>'' `!!!
|
||||
!!!!!! $$$hccccccccc= cc$$$$$$$>>' !!!
|
||||
!!!!! `?$$$$$$F"""" `"$$$$$>>>'' `!!
|
||||
!!!!! "?$$$$$cccccc$$$$??>>>>' !!
|
||||
!!!!> "$$$$$$$$$$$$$F>>>>'' `!
|
||||
!!!!! "$$$$$$$$???>''' !
|
||||
!!!!!> `""""" `
|
||||
!!!!!!; . `
|
||||
!!!!!!! ?h.
|
||||
!!!!!!!! $$c,
|
||||
!!!!!!!!> ?$$$h. .,c
|
||||
!!!!!!!!! $$$$$$$$$hc,.,,cc$$$$$
|
||||
!!!!!!!!! .,zcc$$$$$$$$$$$$$$$$$$$$$$
|
||||
!!!!!!!!! .z$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
||||
!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ .
|
||||
!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ !!
|
||||
!!!!!!!!! ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ,!'
|
||||
!!!!!!!!> c$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$. !'
|
||||
!!!!!!'' ,d$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> '
|
||||
!!!'' z$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$>
|
||||
!' ,$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> ..
|
||||
z$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' ;!!!!''`
|
||||
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F ,;;!'`' .''
|
||||
<$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$> ,;'`' ,;
|
||||
`$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$F -' ,;!!'
|
||||
"?$$$$$$$$$$?$$$$$$$$$$$$$$$$$$$$$$$$$$F .<!!!''' <!
|
||||
!> ""??$$$?C3$$$$$$$$$$$$$$$$$$$$$$$$"" ;!''' !!!
|
||||
;!!!!;, `"''""????$$$$$$$$$$$$$$$$"" ,;-'' ',!
|
||||
;!!!!<!!!; . `""""""""""" `' ' '
|
||||
!!!! ;!!! ;!!!!>;,;, .. ' . ' '
|
||||
!!' ,;!!! ;'`!!!!!!!!;!!!!!; . >' .'' ;
|
||||
!!' ;!!'!';! !! !!!!!!!!!!!!! ' -'
|
||||
<!! !! `!;! `!' !!!!!!!!!!<! .
|
||||
`! ;! ;!!! <' <!!!! `!!! < /
|
||||
`; !> <!! ;' !!!!' !!';! ;'
|
||||
! ! !!! ! `!!! ;!! ! ' '
|
||||
; `! `!! ,' !' ;!'
|
||||
' /`! ! < !! < '
|
||||
/ ;! >;! ;>
|
||||
!' ; !! '
|
||||
' ;! > ! '
|
||||
'
|
||||
by Allen Mullen
|
||||
212
llt/UTF8.txt
212
llt/UTF8.txt
|
|
@ -1,212 +0,0 @@
|
|||
|
||||
UTF-8 encoded sample plain-text file
|
||||
‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
|
||||
|
||||
|
||||
The ASCII compatible UTF-8 encoding used in this plain-text file
|
||||
is defined in Unicode, ISO 10646-1, and RFC 2279.
|
||||
|
||||
|
||||
Using Unicode/UTF-8, you can write in emails and source code things such as
|
||||
|
||||
Mathematics and sciences:
|
||||
|
||||
∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
|
||||
⎪⎢⎜│a²+b³ ⎟⎥⎪
|
||||
∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
|
||||
⎪⎢⎜⎷ c₈ ⎟⎥⎪
|
||||
ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
|
||||
⎪⎢⎜ ∞ ⎟⎥⎪
|
||||
⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
|
||||
⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
|
||||
2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
|
||||
|
||||
Linguistics and dictionaries:
|
||||
|
||||
ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
|
||||
Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
|
||||
|
||||
APL:
|
||||
|
||||
((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
|
||||
|
||||
Nicer typography in plain text files:
|
||||
|
||||
╔══════════════════════════════════════════╗
|
||||
║ ║
|
||||
║ • ‘single’ and “double” quotes ║
|
||||
║ ║
|
||||
║ • Curly apostrophes: “We’ve been here” ║
|
||||
║ ║
|
||||
║ • Latin-1 apostrophe and accents: '´` ║
|
||||
║ ║
|
||||
║ • ‚deutsche‘ „Anführungszeichen“ ║
|
||||
║ ║
|
||||
║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
|
||||
║ ║
|
||||
║ • ASCII safety test: 1lI|, 0OD, 8B ║
|
||||
║ ╭─────────╮ ║
|
||||
║ • the euro symbol: │ 14.95 € │ ║
|
||||
║ ╰─────────╯ ║
|
||||
╚══════════════════════════════════════════╝
|
||||
|
||||
Combining characters:
|
||||
|
||||
STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
|
||||
|
||||
Greek (in Polytonic):
|
||||
|
||||
The Greek anthem:
|
||||
|
||||
Σὲ γνωρίζω ἀπὸ τὴν κόψη
|
||||
τοῦ σπαθιοῦ τὴν τρομερή,
|
||||
σὲ γνωρίζω ἀπὸ τὴν ὄψη
|
||||
ποὺ μὲ βία μετράει τὴ γῆ.
|
||||
|
||||
᾿Απ᾿ τὰ κόκκαλα βγαλμένη
|
||||
τῶν ῾Ελλήνων τὰ ἱερά
|
||||
καὶ σὰν πρῶτα ἀνδρειωμένη
|
||||
χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
|
||||
|
||||
From a speech of Demosthenes in the 4th century BC:
|
||||
|
||||
Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
|
||||
ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
|
||||
λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
|
||||
τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
|
||||
εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
|
||||
πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
|
||||
οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
|
||||
οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
|
||||
ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
|
||||
τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
|
||||
γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
|
||||
προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
|
||||
σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
|
||||
τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
|
||||
τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
|
||||
τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
|
||||
|
||||
Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
|
||||
|
||||
Georgian:
|
||||
|
||||
From a Unicode conference invitation:
|
||||
|
||||
გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
|
||||
კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
|
||||
ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
|
||||
ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
|
||||
ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
|
||||
ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
|
||||
ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
|
||||
|
||||
Russian:
|
||||
|
||||
From a Unicode conference invitation:
|
||||
|
||||
Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
|
||||
Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
|
||||
Конференция соберет широкий круг экспертов по вопросам глобального
|
||||
Интернета и Unicode, локализации и интернационализации, воплощению и
|
||||
применению Unicode в различных операционных системах и программных
|
||||
приложениях, шрифтах, верстке и многоязычных компьютерных системах.
|
||||
|
||||
Thai (UCS Level 2):
|
||||
|
||||
Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
|
||||
classic 'San Gua'):
|
||||
|
||||
[----------------------------|------------------------]
|
||||
๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
|
||||
สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
|
||||
ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
|
||||
โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
|
||||
เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
|
||||
ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
|
||||
พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
|
||||
ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
|
||||
|
||||
(The above is a two-column text. If combining characters are handled
|
||||
correctly, the lines of the second column should be aligned with the
|
||||
| character above.)
|
||||
|
||||
Ethiopian:
|
||||
|
||||
Proverbs in the Amharic language:
|
||||
|
||||
ሰማይ አይታረስ ንጉሥ አይከሰስ።
|
||||
ብላ ካለኝ እንደአባቴ በቆመጠኝ።
|
||||
ጌጥ ያለቤቱ ቁምጥና ነው።
|
||||
ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
|
||||
የአፍ ወለምታ በቅቤ አይታሽም።
|
||||
አይጥ በበላ ዳዋ ተመታ።
|
||||
ሲተረጉሙ ይደረግሙ።
|
||||
ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
|
||||
ድር ቢያብር አንበሳ ያስር።
|
||||
ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
|
||||
እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
|
||||
የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
|
||||
ሥራ ከመፍታት ልጄን ላፋታት።
|
||||
ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
|
||||
የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
|
||||
ተንጋሎ ቢተፉ ተመልሶ ባፉ።
|
||||
ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
|
||||
እግርህን በፍራሽህ ልክ ዘርጋ።
|
||||
|
||||
Runes:
|
||||
|
||||
ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
|
||||
|
||||
(Old English, which transcribed into Latin reads 'He cwaeth that he
|
||||
bude thaem lande northweardum with tha Westsae.' and means 'He said
|
||||
that he lived in the northern land near the Western Sea.')
|
||||
|
||||
Braille:
|
||||
|
||||
⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
|
||||
|
||||
⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
|
||||
⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
|
||||
⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
|
||||
⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
|
||||
⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
|
||||
⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
|
||||
|
||||
⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
|
||||
|
||||
⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
|
||||
⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
|
||||
⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
|
||||
⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
|
||||
⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
|
||||
⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
|
||||
⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
|
||||
⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
|
||||
⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
|
||||
|
||||
(The first couple of paragraphs of "A Christmas Carol" by Dickens)
|
||||
|
||||
Compact font selection example text:
|
||||
|
||||
ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
|
||||
abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
|
||||
–—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
|
||||
∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi<>⑀₂ἠḂӥẄɐː⍎אԱა
|
||||
|
||||
Greetings in various languages:
|
||||
|
||||
Hello world, Καλημέρα κόσμε, コンニチハ
|
||||
|
||||
Box drawing alignment tests: █
|
||||
▉
|
||||
╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
|
||||
║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
|
||||
║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
|
||||
╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
|
||||
║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
|
||||
║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
|
||||
╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
|
||||
▝▀▘▙▄▟
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
FREEBSD-GE-10 = $(shell test `uname` = FreeBSD -a `uname -r | cut -d. -f1` -ge 10 && echo YES)
|
||||
CC = $(if $(FREEBSD-GE-10),clang,gcc)
|
||||
|
||||
NAME = lisp
|
||||
SRC = $(NAME).c
|
||||
EXENAME = $(NAME)
|
||||
|
||||
FLAGS = -Wall -Wextra
|
||||
LIBS =
|
||||
|
||||
DEBUGFLAGS = -g -DDEBUG $(FLAGS)
|
||||
SHIPFLAGS = -O3 -fomit-frame-pointer $(FLAGS)
|
||||
|
||||
default: release
|
||||
|
||||
debug: $(SRC)
|
||||
$(CC) $(DEBUGFLAGS) $(SRC) -o $(EXENAME) $(LIBS)
|
||||
|
||||
release: $(SRC)
|
||||
$(CC) $(SHIPFLAGS) $(SRC) -o $(EXENAME) $(LIBS)
|
||||
|
||||
clean:
|
||||
rm -f $(EXENAME)
|
||||
390
tiny/eval1
390
tiny/eval1
|
|
@ -1,390 +0,0 @@
|
|||
value_t eval_sexpr(value_t e, value_t *penv)
|
||||
{
|
||||
value_t f, v, bind, headsym, asym, labl=0, *pv, *argsyms, *body, *lenv;
|
||||
value_t *rest;
|
||||
cons_t *c;
|
||||
symbol_t *sym;
|
||||
u_int32_t saveSP;
|
||||
int i, nargs, noeval=0;
|
||||
number_t s, n;
|
||||
|
||||
if (issymbol(e)) {
|
||||
sym = (symbol_t*)ptr(e);
|
||||
if (sym->constant != UNBOUND) return sym->constant;
|
||||
v = *penv;
|
||||
while (iscons(v)) {
|
||||
bind = car_(v);
|
||||
if (iscons(bind) && car_(bind) == e)
|
||||
return cdr_(bind);
|
||||
v = cdr_(v);
|
||||
}
|
||||
if ((v = sym->binding) == UNBOUND)
|
||||
lerror("eval: error: variable %s has no value\n", sym->name);
|
||||
return v;
|
||||
}
|
||||
if ((unsigned)(char*)&nargs < (unsigned)stack_bottom || SP>=(N_STACK-100))
|
||||
lerror("eval: error: stack overflow\n");
|
||||
saveSP = SP;
|
||||
PUSH(e);
|
||||
f = eval(car_(e), penv);
|
||||
if (isbuiltin(f)) {
|
||||
// handle builtin function
|
||||
if (!isspecial(f)) {
|
||||
// evaluate argument list, placing arguments on stack
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
while (iscons(v)) {
|
||||
v = eval(car_(v), penv);
|
||||
PUSH(v);
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
}
|
||||
apply_builtin:
|
||||
nargs = SP - saveSP - 1;
|
||||
switch (intval(f)) {
|
||||
// special forms
|
||||
case F_QUOTE:
|
||||
v = cdr_(Stack[saveSP]);
|
||||
if (!iscons(v))
|
||||
lerror("quote: error: expected argument\n");
|
||||
v = car_(v);
|
||||
break;
|
||||
case F_MACRO:
|
||||
case F_LAMBDA:
|
||||
v = Stack[saveSP];
|
||||
if (*penv != NIL) {
|
||||
// build a closure (lambda args body . env)
|
||||
v = cdr_(v);
|
||||
PUSH(car(v));
|
||||
argsyms = &Stack[SP-1];
|
||||
PUSH(car(cdr_(v)));
|
||||
body = &Stack[SP-1];
|
||||
v = cons_(intval(f)==F_LAMBDA ? &LAMBDA : &MACRO,
|
||||
cons(argsyms, cons(body, penv)));
|
||||
}
|
||||
break;
|
||||
case F_LABEL:
|
||||
v = Stack[saveSP];
|
||||
if (*penv != NIL) {
|
||||
v = cdr_(v);
|
||||
PUSH(car(v)); // name
|
||||
pv = &Stack[SP-1];
|
||||
PUSH(car(cdr_(v))); // function
|
||||
body = &Stack[SP-1];
|
||||
*body = eval(*body, penv); // evaluate lambda
|
||||
v = cons_(&LABEL, cons(pv, cons(body, &NIL)));
|
||||
}
|
||||
break;
|
||||
case F_IF:
|
||||
v = car(cdr_(Stack[saveSP]));
|
||||
if (eval(v, penv) != NIL)
|
||||
v = car(cdr_(cdr_(Stack[saveSP])));
|
||||
else
|
||||
v = car(cdr(cdr_(cdr_(Stack[saveSP]))));
|
||||
v = eval(v, penv);
|
||||
break;
|
||||
case F_COND:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
while (iscons(*pv)) {
|
||||
c = tocons(car_(*pv), "cond");
|
||||
if ((v=eval(c->car, penv)) != NIL) {
|
||||
*pv = cdr_(car_(*pv));
|
||||
// evaluate body forms
|
||||
while (iscons(*pv)) {
|
||||
v = eval(car_(*pv), penv);
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
}
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
case F_AND:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = T;
|
||||
while (iscons(*pv)) {
|
||||
if ((v=eval(car_(*pv), penv)) == NIL)
|
||||
break;
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
case F_OR:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
while (iscons(*pv)) {
|
||||
if ((v=eval(car_(*pv), penv)) != NIL)
|
||||
break;
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
case F_WHILE:
|
||||
PUSH(car(cdr(cdr_(Stack[saveSP]))));
|
||||
body = &Stack[SP-1];
|
||||
Stack[saveSP] = car_(cdr_(Stack[saveSP]));
|
||||
value_t *cond = &Stack[saveSP];
|
||||
PUSH(NIL); pv = &Stack[SP-1];
|
||||
while (eval(*cond, penv) != NIL)
|
||||
*pv = eval(*body, penv);
|
||||
v = *pv;
|
||||
break;
|
||||
case F_PROGN:
|
||||
// return last arg
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
while (iscons(*pv)) {
|
||||
v = eval(car_(*pv), penv);
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
|
||||
// ordinary functions
|
||||
case F_SET:
|
||||
argcount("set", nargs, 2);
|
||||
e = Stack[SP-2];
|
||||
v = *penv;
|
||||
while (iscons(v)) {
|
||||
bind = car_(v);
|
||||
if (iscons(bind) && car_(bind) == e) {
|
||||
cdr_(bind) = (v=Stack[SP-1]);
|
||||
SP=saveSP; return v;
|
||||
}
|
||||
v = cdr_(v);
|
||||
}
|
||||
tosymbol(e, "set")->binding = (v=Stack[SP-1]);
|
||||
break;
|
||||
case F_BOUNDP:
|
||||
argcount("boundp", nargs, 1);
|
||||
if (tosymbol(Stack[SP-1], "boundp")->binding == UNBOUND)
|
||||
v = NIL;
|
||||
else
|
||||
v = T;
|
||||
break;
|
||||
case F_EQ:
|
||||
argcount("eq", nargs, 2);
|
||||
v = ((Stack[SP-2] == Stack[SP-1]) ? T : NIL);
|
||||
break;
|
||||
case F_CONS:
|
||||
argcount("cons", nargs, 2);
|
||||
v = mk_cons();
|
||||
car_(v) = Stack[SP-2];
|
||||
cdr_(v) = Stack[SP-1];
|
||||
break;
|
||||
case F_CAR:
|
||||
argcount("car", nargs, 1);
|
||||
v = car(Stack[SP-1]);
|
||||
break;
|
||||
case F_CDR:
|
||||
argcount("cdr", nargs, 1);
|
||||
v = cdr(Stack[SP-1]);
|
||||
break;
|
||||
case F_RPLACA:
|
||||
argcount("rplaca", nargs, 2);
|
||||
car(v=Stack[SP-2]) = Stack[SP-1];
|
||||
break;
|
||||
case F_RPLACD:
|
||||
argcount("rplacd", nargs, 2);
|
||||
cdr(v=Stack[SP-2]) = Stack[SP-1];
|
||||
break;
|
||||
case F_ATOM:
|
||||
argcount("atom", nargs, 1);
|
||||
v = ((!iscons(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_SYMBOLP:
|
||||
argcount("symbolp", nargs, 1);
|
||||
v = ((issymbol(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_NUMBERP:
|
||||
argcount("numberp", nargs, 1);
|
||||
v = ((isnumber(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_ADD:
|
||||
s = 0;
|
||||
for (i=saveSP+1; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "+");
|
||||
s += n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_SUB:
|
||||
if (nargs < 1)
|
||||
lerror("-: error: too few arguments\n");
|
||||
i = saveSP+1;
|
||||
s = (nargs==1) ? 0 : tonumber(Stack[i++], "-");
|
||||
for (; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "-");
|
||||
s -= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_MUL:
|
||||
s = 1;
|
||||
for (i=saveSP+1; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "*");
|
||||
s *= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_DIV:
|
||||
if (nargs < 1)
|
||||
lerror("/: error: too few arguments\n");
|
||||
i = saveSP+1;
|
||||
s = (nargs==1) ? 1 : tonumber(Stack[i++], "/");
|
||||
for (; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "/");
|
||||
if (n == 0)
|
||||
lerror("/: error: division by zero\n");
|
||||
s /= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_LT:
|
||||
argcount("<", nargs, 2);
|
||||
if (tonumber(Stack[SP-2],"<") < tonumber(Stack[SP-1],"<"))
|
||||
v = T;
|
||||
else
|
||||
v = NIL;
|
||||
break;
|
||||
case F_NOT:
|
||||
argcount("not", nargs, 1);
|
||||
v = ((Stack[SP-1] == NIL) ? T : NIL);
|
||||
break;
|
||||
case F_EVAL:
|
||||
argcount("eval", nargs, 1);
|
||||
v = eval(Stack[SP-1], &NIL);
|
||||
break;
|
||||
case F_PRINT:
|
||||
for (i=saveSP+1; i < (int)SP; i++)
|
||||
print(stdout, v=Stack[i]);
|
||||
break;
|
||||
case F_READ:
|
||||
argcount("read", nargs, 0);
|
||||
v = read_sexpr(stdin);
|
||||
break;
|
||||
case F_LOAD:
|
||||
argcount("load", nargs, 1);
|
||||
v = load_file(tosymbol(Stack[SP-1], "load")->name);
|
||||
break;
|
||||
case F_PROG1:
|
||||
// return first arg
|
||||
if (nargs < 1)
|
||||
lerror("prog1: error: too few arguments\n");
|
||||
v = Stack[saveSP+1];
|
||||
break;
|
||||
case F_APPLY:
|
||||
// unpack a list onto the stack
|
||||
argcount("apply", nargs, 2);
|
||||
v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist
|
||||
f = Stack[SP-2]; // first arg is new function
|
||||
POPN(2); // pop apply's args
|
||||
if (isbuiltin(f)) {
|
||||
if (isspecial(f))
|
||||
lerror("apply: error: cannot apply special operator "
|
||||
"%s\n", builtin_names[intval(f)]);
|
||||
while (iscons(v)) {
|
||||
PUSH(car_(v));
|
||||
v = cdr_(v);
|
||||
}
|
||||
goto apply_builtin;
|
||||
}
|
||||
noeval = 1;
|
||||
goto apply_lambda;
|
||||
}
|
||||
SP = saveSP;
|
||||
return v;
|
||||
}
|
||||
else {
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
apply_lambda:
|
||||
if (iscons(f)) {
|
||||
headsym = car_(f);
|
||||
if (headsym == LABEL) {
|
||||
// (label name (lambda ...)) behaves the same as the lambda
|
||||
// alone, except with name bound to the whole label expression
|
||||
labl = f;
|
||||
f = car(cdr(cdr_(labl)));
|
||||
headsym = car(f);
|
||||
}
|
||||
// apply lambda or macro expression
|
||||
PUSH(cdr(cdr(cdr_(f))));
|
||||
lenv = &Stack[SP-1];
|
||||
PUSH(car_(cdr_(f)));
|
||||
argsyms = &Stack[SP-1];
|
||||
PUSH(car_(cdr_(cdr_(f))));
|
||||
body = &Stack[SP-1];
|
||||
if (labl) {
|
||||
// add label binding to environment
|
||||
PUSH(labl);
|
||||
PUSH(car_(cdr_(labl)));
|
||||
*lenv = cons_(cons(&Stack[SP-1], &Stack[SP-2]), lenv);
|
||||
POPN(3);
|
||||
v = Stack[saveSP]; // refetch arglist
|
||||
}
|
||||
if (headsym == MACRO)
|
||||
noeval = 1;
|
||||
else if (headsym != LAMBDA)
|
||||
lerror("apply: error: head must be lambda, macro, or label\n");
|
||||
// build a calling environment for the lambda
|
||||
// the environment is the argument binds on top of the captured
|
||||
// environment
|
||||
while (iscons(v)) {
|
||||
// bind args
|
||||
if (!iscons(*argsyms)) {
|
||||
if (*argsyms == NIL)
|
||||
lerror("apply: error: too many arguments\n");
|
||||
break;
|
||||
}
|
||||
asym = car_(*argsyms);
|
||||
if (!issymbol(asym))
|
||||
lerror("apply: error: formal argument not a symbol\n");
|
||||
v = car_(v);
|
||||
if (!noeval) v = eval(v, penv);
|
||||
PUSH(v);
|
||||
*lenv = cons_(cons(&asym, &Stack[SP-1]), lenv);
|
||||
POPN(2);
|
||||
*argsyms = cdr_(*argsyms);
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
if (*argsyms != NIL) {
|
||||
if (issymbol(*argsyms)) {
|
||||
if (noeval) {
|
||||
*lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv);
|
||||
}
|
||||
else {
|
||||
PUSH(NIL);
|
||||
PUSH(NIL);
|
||||
rest = &Stack[SP-1];
|
||||
// build list of rest arguments
|
||||
// we have to build it forwards, which is tricky
|
||||
while (iscons(v)) {
|
||||
v = eval(car_(v), penv);
|
||||
PUSH(v);
|
||||
v = cons_(&Stack[SP-1], &NIL);
|
||||
POP();
|
||||
if (iscons(*rest))
|
||||
cdr_(*rest) = v;
|
||||
else
|
||||
Stack[SP-2] = v;
|
||||
*rest = v;
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
*lenv = cons_(cons(argsyms, &Stack[SP-2]), lenv);
|
||||
}
|
||||
}
|
||||
else if (iscons(*argsyms)) {
|
||||
lerror("apply: error: too few arguments\n");
|
||||
}
|
||||
}
|
||||
SP = saveSP; // free temporary stack space
|
||||
PUSH(*lenv); // preserve environment on stack
|
||||
lenv = &Stack[SP-1];
|
||||
v = eval(*body, lenv);
|
||||
POP();
|
||||
// macro: evaluate expansion in the calling environment
|
||||
if (headsym == MACRO)
|
||||
return eval(v, penv);
|
||||
return v;
|
||||
}
|
||||
type_error("apply", "function", f);
|
||||
return NIL;
|
||||
}
|
||||
407
tiny/eval2
407
tiny/eval2
|
|
@ -1,407 +0,0 @@
|
|||
value_t eval_sexpr(value_t e, value_t *penv)
|
||||
{
|
||||
value_t f, v, bind, headsym, asym, labl=0, *pv, *argsyms, *body, *lenv;
|
||||
value_t *rest;
|
||||
cons_t *c;
|
||||
symbol_t *sym;
|
||||
u_int32_t saveSP;
|
||||
int i, nargs, noeval=0;
|
||||
number_t s, n;
|
||||
|
||||
if (issymbol(e)) {
|
||||
sym = (symbol_t*)ptr(e);
|
||||
if (sym->constant != UNBOUND) return sym->constant;
|
||||
v = *penv;
|
||||
while (iscons(v)) {
|
||||
bind = car_(v);
|
||||
if (iscons(bind) && car_(bind) == e)
|
||||
return cdr_(bind);
|
||||
v = cdr_(v);
|
||||
}
|
||||
if ((v = sym->binding) == UNBOUND)
|
||||
lerror("eval: error: variable %s has no value\n", sym->name);
|
||||
return v;
|
||||
}
|
||||
if ((unsigned)(char*)&nargs < (unsigned)stack_bottom || SP>=(N_STACK-100))
|
||||
lerror("eval: error: stack overflow\n");
|
||||
saveSP = SP;
|
||||
PUSH(e);
|
||||
f = eval(car_(e), penv);
|
||||
if (isbuiltin(f)) {
|
||||
// handle builtin function
|
||||
if (!isspecial(f)) {
|
||||
// evaluate argument list, placing arguments on stack
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
while (iscons(v)) {
|
||||
v = eval(car_(v), penv);
|
||||
PUSH(v);
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
}
|
||||
apply_builtin:
|
||||
nargs = SP - saveSP - 1;
|
||||
switch (intval(f)) {
|
||||
// special forms
|
||||
case F_QUOTE:
|
||||
v = cdr_(Stack[saveSP]);
|
||||
if (!iscons(v))
|
||||
lerror("quote: error: expected argument\n");
|
||||
v = car_(v);
|
||||
break;
|
||||
case F_MACRO:
|
||||
case F_LAMBDA:
|
||||
v = Stack[saveSP];
|
||||
if (*penv != NIL) {
|
||||
// build a closure (lambda args body . env)
|
||||
v = cdr_(v);
|
||||
PUSH(car(v));
|
||||
argsyms = &Stack[SP-1];
|
||||
PUSH(car(cdr_(v)));
|
||||
body = &Stack[SP-1];
|
||||
v = cons_(intval(f)==F_LAMBDA ? &LAMBDA : &MACRO,
|
||||
cons(argsyms, cons(body, penv)));
|
||||
}
|
||||
break;
|
||||
case F_LABEL:
|
||||
v = Stack[saveSP];
|
||||
if (*penv != NIL) {
|
||||
v = cdr_(v);
|
||||
PUSH(car(v)); // name
|
||||
pv = &Stack[SP-1];
|
||||
PUSH(car(cdr_(v))); // function
|
||||
body = &Stack[SP-1];
|
||||
*body = eval(*body, penv); // evaluate lambda
|
||||
v = cons_(&LABEL, cons(pv, cons(body, &NIL)));
|
||||
}
|
||||
break;
|
||||
case F_IF:
|
||||
v = car(cdr_(Stack[saveSP]));
|
||||
if (eval(v, penv) != NIL)
|
||||
v = car(cdr_(cdr_(Stack[saveSP])));
|
||||
else
|
||||
v = car(cdr(cdr_(cdr_(Stack[saveSP]))));
|
||||
v = eval(v, penv);
|
||||
break;
|
||||
case F_COND:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
while (iscons(*pv)) {
|
||||
c = tocons(car_(*pv), "cond");
|
||||
if ((v=eval(c->car, penv)) != NIL) {
|
||||
*pv = cdr_(car_(*pv));
|
||||
// evaluate body forms
|
||||
while (iscons(*pv)) {
|
||||
v = eval(car_(*pv), penv);
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
}
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
case F_AND:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = T;
|
||||
while (iscons(*pv)) {
|
||||
if ((v=eval(car_(*pv), penv)) == NIL)
|
||||
break;
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
case F_OR:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
while (iscons(*pv)) {
|
||||
if ((v=eval(car_(*pv), penv)) != NIL)
|
||||
break;
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
case F_WHILE:
|
||||
PUSH(car(cdr(cdr_(Stack[saveSP]))));
|
||||
body = &Stack[SP-1];
|
||||
Stack[saveSP] = car_(cdr_(Stack[saveSP]));
|
||||
value_t *cond = &Stack[saveSP];
|
||||
PUSH(NIL); pv = &Stack[SP-1];
|
||||
while (eval(*cond, penv) != NIL)
|
||||
*pv = eval(*body, penv);
|
||||
v = *pv;
|
||||
break;
|
||||
case F_PROGN:
|
||||
// return last arg
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
while (iscons(*pv)) {
|
||||
v = eval(car_(*pv), penv);
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
|
||||
// ordinary functions
|
||||
case F_SET:
|
||||
argcount("set", nargs, 2);
|
||||
e = Stack[SP-2];
|
||||
v = *penv;
|
||||
while (iscons(v)) {
|
||||
bind = car_(v);
|
||||
if (iscons(bind) && car_(bind) == e) {
|
||||
cdr_(bind) = (v=Stack[SP-1]);
|
||||
SP=saveSP; return v;
|
||||
}
|
||||
v = cdr_(v);
|
||||
}
|
||||
tosymbol(e, "set")->binding = (v=Stack[SP-1]);
|
||||
break;
|
||||
case F_BOUNDP:
|
||||
argcount("boundp", nargs, 1);
|
||||
if (tosymbol(Stack[SP-1], "boundp")->binding == UNBOUND)
|
||||
v = NIL;
|
||||
else
|
||||
v = T;
|
||||
break;
|
||||
case F_EQ:
|
||||
argcount("eq", nargs, 2);
|
||||
v = ((Stack[SP-2] == Stack[SP-1]) ? T : NIL);
|
||||
break;
|
||||
case F_CONS:
|
||||
argcount("cons", nargs, 2);
|
||||
v = mk_cons();
|
||||
car_(v) = Stack[SP-2];
|
||||
cdr_(v) = Stack[SP-1];
|
||||
break;
|
||||
case F_CAR:
|
||||
argcount("car", nargs, 1);
|
||||
v = car(Stack[SP-1]);
|
||||
break;
|
||||
case F_CDR:
|
||||
argcount("cdr", nargs, 1);
|
||||
v = cdr(Stack[SP-1]);
|
||||
break;
|
||||
case F_RPLACA:
|
||||
argcount("rplaca", nargs, 2);
|
||||
car(v=Stack[SP-2]) = Stack[SP-1];
|
||||
break;
|
||||
case F_RPLACD:
|
||||
argcount("rplacd", nargs, 2);
|
||||
cdr(v=Stack[SP-2]) = Stack[SP-1];
|
||||
break;
|
||||
case F_ATOM:
|
||||
argcount("atom", nargs, 1);
|
||||
v = ((!iscons(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_CONSP:
|
||||
argcount("consp", nargs, 1);
|
||||
v = (iscons(Stack[SP-1]) ? T : NIL);
|
||||
break;
|
||||
case F_SYMBOLP:
|
||||
argcount("symbolp", nargs, 1);
|
||||
v = ((issymbol(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_NUMBERP:
|
||||
argcount("numberp", nargs, 1);
|
||||
v = ((isnumber(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_ADD:
|
||||
s = 0;
|
||||
for (i=saveSP+1; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "+");
|
||||
s += n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_SUB:
|
||||
if (nargs < 1)
|
||||
lerror("-: error: too few arguments\n");
|
||||
i = saveSP+1;
|
||||
s = (nargs==1) ? 0 : tonumber(Stack[i++], "-");
|
||||
for (; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "-");
|
||||
s -= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_MUL:
|
||||
s = 1;
|
||||
for (i=saveSP+1; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "*");
|
||||
s *= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_DIV:
|
||||
if (nargs < 1)
|
||||
lerror("/: error: too few arguments\n");
|
||||
i = saveSP+1;
|
||||
s = (nargs==1) ? 1 : tonumber(Stack[i++], "/");
|
||||
for (; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "/");
|
||||
if (n == 0)
|
||||
lerror("/: error: division by zero\n");
|
||||
s /= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_LT:
|
||||
argcount("<", nargs, 2);
|
||||
if (tonumber(Stack[SP-2],"<") < tonumber(Stack[SP-1],"<"))
|
||||
v = T;
|
||||
else
|
||||
v = NIL;
|
||||
break;
|
||||
case F_NOT:
|
||||
argcount("not", nargs, 1);
|
||||
v = ((Stack[SP-1] == NIL) ? T : NIL);
|
||||
break;
|
||||
case F_EVAL:
|
||||
argcount("eval", nargs, 1);
|
||||
v = eval(Stack[SP-1], &NIL);
|
||||
break;
|
||||
case F_PRINT:
|
||||
for (i=saveSP+1; i < (int)SP; i++)
|
||||
print(stdout, v=Stack[i], 0);
|
||||
fprintf(stdout, "\n");
|
||||
break;
|
||||
case F_PRINC:
|
||||
for (i=saveSP+1; i < (int)SP; i++)
|
||||
print(stdout, v=Stack[i], 1);
|
||||
break;
|
||||
case F_READ:
|
||||
argcount("read", nargs, 0);
|
||||
v = read_sexpr(stdin);
|
||||
break;
|
||||
case F_LOAD:
|
||||
argcount("load", nargs, 1);
|
||||
v = load_file(tosymbol(Stack[SP-1], "load")->name);
|
||||
break;
|
||||
case F_EXIT:
|
||||
exit(0);
|
||||
break;
|
||||
case F_ERROR:
|
||||
for (i=saveSP+1; i < (int)SP; i++)
|
||||
print(stderr, Stack[i], 1);
|
||||
lerror("\n");
|
||||
break;
|
||||
case F_PROG1:
|
||||
// return first arg
|
||||
if (nargs < 1)
|
||||
lerror("prog1: error: too few arguments\n");
|
||||
v = Stack[saveSP+1];
|
||||
break;
|
||||
case F_APPLY:
|
||||
// unpack a list onto the stack
|
||||
argcount("apply", nargs, 2);
|
||||
v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist
|
||||
f = Stack[SP-2]; // first arg is new function
|
||||
POPN(2); // pop apply's args
|
||||
if (isbuiltin(f)) {
|
||||
if (isspecial(f))
|
||||
lerror("apply: error: cannot apply special operator "
|
||||
"%s\n", builtin_names[intval(f)]);
|
||||
while (iscons(v)) {
|
||||
PUSH(car_(v));
|
||||
v = cdr_(v);
|
||||
}
|
||||
goto apply_builtin;
|
||||
}
|
||||
noeval = 1;
|
||||
goto apply_lambda;
|
||||
}
|
||||
SP = saveSP;
|
||||
return v;
|
||||
}
|
||||
else {
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
apply_lambda:
|
||||
if (iscons(f)) {
|
||||
headsym = car_(f);
|
||||
if (headsym == LABEL) {
|
||||
// (label name (lambda ...)) behaves the same as the lambda
|
||||
// alone, except with name bound to the whole label expression
|
||||
labl = f;
|
||||
f = car(cdr(cdr_(labl)));
|
||||
headsym = car(f);
|
||||
}
|
||||
// apply lambda or macro expression
|
||||
PUSH(cdr(cdr(cdr_(f))));
|
||||
lenv = &Stack[SP-1];
|
||||
PUSH(car_(cdr_(f)));
|
||||
argsyms = &Stack[SP-1];
|
||||
PUSH(car_(cdr_(cdr_(f))));
|
||||
body = &Stack[SP-1];
|
||||
if (labl) {
|
||||
// add label binding to environment
|
||||
PUSH(labl);
|
||||
PUSH(car_(cdr_(labl)));
|
||||
*lenv = cons_(cons(&Stack[SP-1], &Stack[SP-2]), lenv);
|
||||
POPN(3);
|
||||
v = Stack[saveSP]; // refetch arglist
|
||||
}
|
||||
if (headsym == MACRO)
|
||||
noeval = 1;
|
||||
else if (headsym != LAMBDA)
|
||||
lerror("apply: error: head must be lambda, macro, or label\n");
|
||||
// build a calling environment for the lambda
|
||||
// the environment is the argument binds on top of the captured
|
||||
// environment
|
||||
while (iscons(v)) {
|
||||
// bind args
|
||||
if (!iscons(*argsyms)) {
|
||||
if (*argsyms == NIL)
|
||||
lerror("apply: error: too many arguments\n");
|
||||
break;
|
||||
}
|
||||
asym = car_(*argsyms);
|
||||
if (!issymbol(asym))
|
||||
lerror("apply: error: formal argument not a symbol\n");
|
||||
v = car_(v);
|
||||
if (!noeval) v = eval(v, penv);
|
||||
PUSH(v);
|
||||
*lenv = cons_(cons(&asym, &Stack[SP-1]), lenv);
|
||||
POPN(2);
|
||||
*argsyms = cdr_(*argsyms);
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
if (*argsyms != NIL) {
|
||||
if (issymbol(*argsyms)) {
|
||||
if (noeval) {
|
||||
*lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv);
|
||||
}
|
||||
else {
|
||||
PUSH(NIL);
|
||||
PUSH(NIL);
|
||||
rest = &Stack[SP-1];
|
||||
// build list of rest arguments
|
||||
// we have to build it forwards, which is tricky
|
||||
while (iscons(v)) {
|
||||
v = eval(car_(v), penv);
|
||||
PUSH(v);
|
||||
v = cons_(&Stack[SP-1], &NIL);
|
||||
POP();
|
||||
if (iscons(*rest))
|
||||
cdr_(*rest) = v;
|
||||
else
|
||||
Stack[SP-2] = v;
|
||||
*rest = v;
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
*lenv = cons_(cons(argsyms, &Stack[SP-2]), lenv);
|
||||
}
|
||||
}
|
||||
else if (iscons(*argsyms)) {
|
||||
lerror("apply: error: too few arguments\n");
|
||||
}
|
||||
}
|
||||
SP = saveSP; // free temporary stack space
|
||||
PUSH(*lenv); // preserve environment on stack
|
||||
lenv = &Stack[SP-1];
|
||||
v = eval(*body, lenv);
|
||||
POP();
|
||||
// macro: evaluate expansion in the calling environment
|
||||
if (headsym == MACRO)
|
||||
return eval(v, penv);
|
||||
return v;
|
||||
}
|
||||
type_error("apply", "function", f);
|
||||
return NIL;
|
||||
}
|
||||
443
tiny/evalt
443
tiny/evalt
|
|
@ -1,443 +0,0 @@
|
|||
value_t eval_sexpr(value_t e, value_t *penv)
|
||||
{
|
||||
value_t f, v, bind, headsym, asym, labl=0, *pv, *argsyms, *body, *lenv;
|
||||
value_t *rest;
|
||||
cons_t *c;
|
||||
symbol_t *sym;
|
||||
u_int32_t saveSP;
|
||||
int i, nargs, noeval=0;
|
||||
number_t s, n;
|
||||
|
||||
eval_top:
|
||||
if (issymbol(e)) {
|
||||
sym = (symbol_t*)ptr(e);
|
||||
if (sym->constant != UNBOUND) return sym->constant;
|
||||
v = *penv;
|
||||
while (iscons(v)) {
|
||||
bind = car_(v);
|
||||
if (iscons(bind) && car_(bind) == e)
|
||||
return cdr_(bind);
|
||||
v = cdr_(v);
|
||||
}
|
||||
if ((v = sym->binding) == UNBOUND)
|
||||
lerror("eval: error: variable %s has no value\n", sym->name);
|
||||
return v;
|
||||
}
|
||||
if ((unsigned)(char*)&nargs < (unsigned)stack_bottom || SP>=(N_STACK-100))
|
||||
lerror("eval: error: stack overflow\n");
|
||||
saveSP = SP;
|
||||
PUSH(e);
|
||||
PUSH(*penv);
|
||||
f = eval(car_(e), penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
if (isbuiltin(f)) {
|
||||
// handle builtin function
|
||||
if (!isspecial(f)) {
|
||||
// evaluate argument list, placing arguments on stack
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
while (iscons(v)) {
|
||||
v = eval(car_(v), penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
PUSH(v);
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
}
|
||||
apply_builtin:
|
||||
nargs = SP - saveSP - 2;
|
||||
switch (intval(f)) {
|
||||
// special forms
|
||||
case F_QUOTE:
|
||||
v = cdr_(Stack[saveSP]);
|
||||
if (!iscons(v))
|
||||
lerror("quote: error: expected argument\n");
|
||||
v = car_(v);
|
||||
break;
|
||||
case F_MACRO:
|
||||
case F_LAMBDA:
|
||||
v = Stack[saveSP];
|
||||
if (*penv != NIL) {
|
||||
// build a closure (lambda args body . env)
|
||||
v = cdr_(v);
|
||||
PUSH(car(v));
|
||||
argsyms = &Stack[SP-1];
|
||||
PUSH(car(cdr_(v)));
|
||||
body = &Stack[SP-1];
|
||||
v = cons_(intval(f)==F_LAMBDA ? &LAMBDA : &MACRO,
|
||||
cons(argsyms, cons(body, penv)));
|
||||
}
|
||||
break;
|
||||
case F_LABEL:
|
||||
v = Stack[saveSP];
|
||||
if (*penv != NIL) {
|
||||
v = cdr_(v);
|
||||
PUSH(car(v)); // name
|
||||
pv = &Stack[SP-1];
|
||||
PUSH(car(cdr_(v))); // function
|
||||
body = &Stack[SP-1];
|
||||
*body = eval(*body, penv); // evaluate lambda
|
||||
v = cons_(&LABEL, cons(pv, cons(body, &NIL)));
|
||||
}
|
||||
break;
|
||||
case F_IF:
|
||||
v = car(cdr_(Stack[saveSP]));
|
||||
if (eval(v, penv) != NIL)
|
||||
v = car(cdr_(cdr_(Stack[saveSP])));
|
||||
else
|
||||
v = car(cdr(cdr_(cdr_(Stack[saveSP]))));
|
||||
tail_eval(v, Stack[saveSP+1]);
|
||||
break;
|
||||
case F_COND:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
while (iscons(*pv)) {
|
||||
c = tocons(car_(*pv), "cond");
|
||||
v = eval(c->car, penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
if (v != NIL) {
|
||||
*pv = cdr_(car_(*pv));
|
||||
// evaluate body forms
|
||||
if (iscons(*pv)) {
|
||||
while (iscons(cdr_(*pv))) {
|
||||
v = eval(car_(*pv), penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
tail_eval(car_(*pv), *penv);
|
||||
}
|
||||
break;
|
||||
}
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
break;
|
||||
case F_AND:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = T;
|
||||
if (iscons(*pv)) {
|
||||
while (iscons(cdr_(*pv))) {
|
||||
if ((v=eval(car_(*pv), penv)) == NIL) {
|
||||
SP = saveSP; return NIL;
|
||||
}
|
||||
*penv = Stack[saveSP+1];
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
tail_eval(car_(*pv), *penv);
|
||||
}
|
||||
break;
|
||||
case F_OR:
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
if (iscons(*pv)) {
|
||||
while (iscons(cdr_(*pv))) {
|
||||
if ((v=eval(car_(*pv), penv)) != NIL) {
|
||||
SP = saveSP; return v;
|
||||
}
|
||||
*penv = Stack[saveSP+1];
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
tail_eval(car_(*pv), *penv);
|
||||
}
|
||||
break;
|
||||
case F_WHILE:
|
||||
PUSH(car(cdr(cdr_(Stack[saveSP]))));
|
||||
body = &Stack[SP-1];
|
||||
Stack[saveSP] = car_(cdr_(Stack[saveSP]));
|
||||
value_t *cond = &Stack[saveSP];
|
||||
PUSH(NIL); pv = &Stack[SP-1];
|
||||
while (eval(*cond, penv) != NIL) {
|
||||
*penv = Stack[saveSP+1];
|
||||
*pv = eval(*body, penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
}
|
||||
v = *pv;
|
||||
break;
|
||||
case F_PROGN:
|
||||
// return last arg
|
||||
Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
pv = &Stack[saveSP]; v = NIL;
|
||||
if (iscons(*pv)) {
|
||||
while (iscons(cdr_(*pv))) {
|
||||
v = eval(car_(*pv), penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
*pv = cdr_(*pv);
|
||||
}
|
||||
tail_eval(car_(*pv), *penv);
|
||||
}
|
||||
break;
|
||||
|
||||
// ordinary functions
|
||||
case F_SET:
|
||||
argcount("set", nargs, 2);
|
||||
e = Stack[SP-2];
|
||||
v = *penv;
|
||||
while (iscons(v)) {
|
||||
bind = car_(v);
|
||||
if (iscons(bind) && car_(bind) == e) {
|
||||
cdr_(bind) = (v=Stack[SP-1]);
|
||||
SP=saveSP; return v;
|
||||
}
|
||||
v = cdr_(v);
|
||||
}
|
||||
tosymbol(e, "set")->binding = (v=Stack[SP-1]);
|
||||
break;
|
||||
case F_BOUNDP:
|
||||
argcount("boundp", nargs, 1);
|
||||
if (tosymbol(Stack[SP-1], "boundp")->binding == UNBOUND)
|
||||
v = NIL;
|
||||
else
|
||||
v = T;
|
||||
break;
|
||||
case F_EQ:
|
||||
argcount("eq", nargs, 2);
|
||||
v = ((Stack[SP-2] == Stack[SP-1]) ? T : NIL);
|
||||
break;
|
||||
case F_CONS:
|
||||
argcount("cons", nargs, 2);
|
||||
v = mk_cons();
|
||||
car_(v) = Stack[SP-2];
|
||||
cdr_(v) = Stack[SP-1];
|
||||
break;
|
||||
case F_CAR:
|
||||
argcount("car", nargs, 1);
|
||||
v = car(Stack[SP-1]);
|
||||
break;
|
||||
case F_CDR:
|
||||
argcount("cdr", nargs, 1);
|
||||
v = cdr(Stack[SP-1]);
|
||||
break;
|
||||
case F_RPLACA:
|
||||
argcount("rplaca", nargs, 2);
|
||||
car(v=Stack[SP-2]) = Stack[SP-1];
|
||||
break;
|
||||
case F_RPLACD:
|
||||
argcount("rplacd", nargs, 2);
|
||||
cdr(v=Stack[SP-2]) = Stack[SP-1];
|
||||
break;
|
||||
case F_ATOM:
|
||||
argcount("atom", nargs, 1);
|
||||
v = ((!iscons(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_CONSP:
|
||||
argcount("consp", nargs, 1);
|
||||
v = (iscons(Stack[SP-1]) ? T : NIL);
|
||||
break;
|
||||
case F_SYMBOLP:
|
||||
argcount("symbolp", nargs, 1);
|
||||
v = ((issymbol(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_NUMBERP:
|
||||
argcount("numberp", nargs, 1);
|
||||
v = ((isnumber(Stack[SP-1])) ? T : NIL);
|
||||
break;
|
||||
case F_ADD:
|
||||
s = 0;
|
||||
for (i=saveSP+2; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "+");
|
||||
s += n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_SUB:
|
||||
if (nargs < 1)
|
||||
lerror("-: error: too few arguments\n");
|
||||
i = saveSP+2;
|
||||
s = (nargs==1) ? 0 : tonumber(Stack[i++], "-");
|
||||
for (; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "-");
|
||||
s -= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_MUL:
|
||||
s = 1;
|
||||
for (i=saveSP+2; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "*");
|
||||
s *= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_DIV:
|
||||
if (nargs < 1)
|
||||
lerror("/: error: too few arguments\n");
|
||||
i = saveSP+2;
|
||||
s = (nargs==1) ? 1 : tonumber(Stack[i++], "/");
|
||||
for (; i < (int)SP; i++) {
|
||||
n = tonumber(Stack[i], "/");
|
||||
if (n == 0)
|
||||
lerror("/: error: division by zero\n");
|
||||
s /= n;
|
||||
}
|
||||
v = number(s);
|
||||
break;
|
||||
case F_LT:
|
||||
argcount("<", nargs, 2);
|
||||
if (tonumber(Stack[SP-2],"<") < tonumber(Stack[SP-1],"<"))
|
||||
v = T;
|
||||
else
|
||||
v = NIL;
|
||||
break;
|
||||
case F_NOT:
|
||||
argcount("not", nargs, 1);
|
||||
v = ((Stack[SP-1] == NIL) ? T : NIL);
|
||||
break;
|
||||
case F_EVAL:
|
||||
argcount("eval", nargs, 1);
|
||||
v = Stack[SP-1];
|
||||
tail_eval(v, NIL);
|
||||
break;
|
||||
case F_PRINT:
|
||||
for (i=saveSP+2; i < (int)SP; i++)
|
||||
print(stdout, v=Stack[i], 0);
|
||||
fprintf(stdout, "\n");
|
||||
break;
|
||||
case F_PRINC:
|
||||
for (i=saveSP+2; i < (int)SP; i++)
|
||||
print(stdout, v=Stack[i], 1);
|
||||
break;
|
||||
case F_READ:
|
||||
argcount("read", nargs, 0);
|
||||
v = read_sexpr(stdin);
|
||||
break;
|
||||
case F_LOAD:
|
||||
argcount("load", nargs, 1);
|
||||
v = load_file(tosymbol(Stack[SP-1], "load")->name);
|
||||
break;
|
||||
case F_EXIT:
|
||||
exit(0);
|
||||
break;
|
||||
case F_ERROR:
|
||||
for (i=saveSP+2; i < (int)SP; i++)
|
||||
print(stderr, Stack[i], 1);
|
||||
lerror("\n");
|
||||
break;
|
||||
case F_PROG1:
|
||||
// return first arg
|
||||
if (nargs < 1)
|
||||
lerror("prog1: error: too few arguments\n");
|
||||
v = Stack[saveSP+2];
|
||||
break;
|
||||
case F_APPLY:
|
||||
argcount("apply", nargs, 2);
|
||||
v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist
|
||||
f = Stack[SP-2]; // first arg is new function
|
||||
POPN(2); // pop apply's args
|
||||
if (isbuiltin(f)) {
|
||||
if (isspecial(f))
|
||||
lerror("apply: error: cannot apply special operator "
|
||||
"%s\n", builtin_names[intval(f)]);
|
||||
// unpack arglist onto the stack
|
||||
while (iscons(v)) {
|
||||
PUSH(car_(v));
|
||||
v = cdr_(v);
|
||||
}
|
||||
goto apply_builtin;
|
||||
}
|
||||
noeval = 1;
|
||||
goto apply_lambda;
|
||||
}
|
||||
SP = saveSP;
|
||||
return v;
|
||||
}
|
||||
else {
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
apply_lambda:
|
||||
if (iscons(f)) {
|
||||
headsym = car_(f);
|
||||
if (headsym == LABEL) {
|
||||
// (label name (lambda ...)) behaves the same as the lambda
|
||||
// alone, except with name bound to the whole label expression
|
||||
labl = f;
|
||||
f = car(cdr(cdr_(labl)));
|
||||
headsym = car(f);
|
||||
}
|
||||
// apply lambda or macro expression
|
||||
PUSH(cdr(cdr(cdr_(f))));
|
||||
lenv = &Stack[SP-1];
|
||||
PUSH(car_(cdr_(f)));
|
||||
argsyms = &Stack[SP-1];
|
||||
PUSH(car_(cdr_(cdr_(f))));
|
||||
body = &Stack[SP-1];
|
||||
if (labl) {
|
||||
// add label binding to environment
|
||||
PUSH(labl);
|
||||
PUSH(car_(cdr_(labl)));
|
||||
*lenv = cons_(cons(&Stack[SP-1], &Stack[SP-2]), lenv);
|
||||
POPN(3);
|
||||
v = Stack[saveSP]; // refetch arglist
|
||||
}
|
||||
if (headsym == MACRO)
|
||||
noeval = 1;
|
||||
else if (headsym != LAMBDA)
|
||||
lerror("apply: error: head must be lambda, macro, or label\n");
|
||||
// build a calling environment for the lambda
|
||||
// the environment is the argument binds on top of the captured
|
||||
// environment
|
||||
while (iscons(v)) {
|
||||
// bind args
|
||||
if (!iscons(*argsyms)) {
|
||||
if (*argsyms == NIL)
|
||||
lerror("apply: error: too many arguments\n");
|
||||
break;
|
||||
}
|
||||
asym = car_(*argsyms);
|
||||
if (!issymbol(asym))
|
||||
lerror("apply: error: formal argument not a symbol\n");
|
||||
v = car_(v);
|
||||
if (!noeval) {
|
||||
v = eval(v, penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
}
|
||||
PUSH(v);
|
||||
*lenv = cons_(cons(&asym, &Stack[SP-1]), lenv);
|
||||
POPN(2);
|
||||
*argsyms = cdr_(*argsyms);
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
if (*argsyms != NIL) {
|
||||
if (issymbol(*argsyms)) {
|
||||
if (noeval) {
|
||||
*lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv);
|
||||
}
|
||||
else {
|
||||
PUSH(NIL);
|
||||
PUSH(NIL);
|
||||
rest = &Stack[SP-1];
|
||||
// build list of rest arguments
|
||||
// we have to build it forwards, which is tricky
|
||||
while (iscons(v)) {
|
||||
v = eval(car_(v), penv);
|
||||
*penv = Stack[saveSP+1];
|
||||
PUSH(v);
|
||||
v = cons_(&Stack[SP-1], &NIL);
|
||||
POP();
|
||||
if (iscons(*rest))
|
||||
cdr_(*rest) = v;
|
||||
else
|
||||
Stack[SP-2] = v;
|
||||
*rest = v;
|
||||
v = Stack[saveSP] = cdr_(Stack[saveSP]);
|
||||
}
|
||||
*lenv = cons_(cons(argsyms, &Stack[SP-2]), lenv);
|
||||
}
|
||||
}
|
||||
else if (iscons(*argsyms)) {
|
||||
lerror("apply: error: too few arguments\n");
|
||||
}
|
||||
}
|
||||
noeval = 0;
|
||||
// macro: evaluate expansion in the calling environment
|
||||
if (headsym == MACRO) {
|
||||
SP = saveSP;
|
||||
PUSH(*lenv);
|
||||
lenv = &Stack[SP-1];
|
||||
v = eval(*body, lenv);
|
||||
tail_eval(v, *penv);
|
||||
}
|
||||
else {
|
||||
tail_eval(*body, *lenv);
|
||||
}
|
||||
// not reached
|
||||
}
|
||||
type_error("apply", "function", f);
|
||||
return NIL;
|
||||
}
|
||||
117
tiny/flutils.c
117
tiny/flutils.c
|
|
@ -1,117 +0,0 @@
|
|||
u_int32_t *bitvector_resize(u_int32_t *b, size_t n)
|
||||
{
|
||||
u_int32_t *p;
|
||||
size_t sz = ((n + 31) >> 5) * 4;
|
||||
p = realloc(b, sz);
|
||||
if (p == NULL)
|
||||
return NULL;
|
||||
memset(p, 0, sz);
|
||||
return p;
|
||||
}
|
||||
|
||||
u_int32_t *mk_bitvector(size_t n) { return bitvector_resize(NULL, n); }
|
||||
|
||||
void bitvector_set(u_int32_t *b, u_int32_t n, u_int32_t c)
|
||||
{
|
||||
if (c)
|
||||
b[n >> 5] |= (1 << (n & 31));
|
||||
else
|
||||
b[n >> 5] &= ~(1 << (n & 31));
|
||||
}
|
||||
|
||||
u_int32_t bitvector_get(u_int32_t *b, u_int32_t n)
|
||||
{
|
||||
return b[n >> 5] & (1 << (n & 31));
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
size_t n, maxsize;
|
||||
unsigned long *items;
|
||||
} ltable_t;
|
||||
|
||||
void ltable_init(ltable_t *t, size_t n)
|
||||
{
|
||||
t->n = 0;
|
||||
t->maxsize = n;
|
||||
t->items = (unsigned long *)malloc(n * sizeof(unsigned long));
|
||||
}
|
||||
|
||||
void ltable_clear(ltable_t *t) { t->n = 0; }
|
||||
|
||||
void ltable_insert(ltable_t *t, unsigned long item)
|
||||
{
|
||||
unsigned long *p;
|
||||
|
||||
if (t->n == t->maxsize) {
|
||||
p = realloc(t->items, (t->maxsize * 2) * sizeof(unsigned long));
|
||||
if (p == NULL)
|
||||
return;
|
||||
t->items = p;
|
||||
t->maxsize *= 2;
|
||||
}
|
||||
t->items[t->n++] = item;
|
||||
}
|
||||
|
||||
#define NOTFOUND ((int)-1)
|
||||
|
||||
int ltable_lookup(ltable_t *t, unsigned long item)
|
||||
{
|
||||
int i;
|
||||
for (i = 0; i < (int)t->n; i++)
|
||||
if (t->items[i] == item)
|
||||
return i;
|
||||
return NOTFOUND;
|
||||
}
|
||||
|
||||
void ltable_adjoin(ltable_t *t, unsigned long item)
|
||||
{
|
||||
if (ltable_lookup(t, item) == NOTFOUND)
|
||||
ltable_insert(t, item);
|
||||
}
|
||||
|
||||
static const u_int32_t offsetsFromUTF8[6] = { 0x00000000UL, 0x00003080UL,
|
||||
0x000E2080UL, 0x03C82080UL,
|
||||
0xFA082080UL, 0x82082080UL };
|
||||
|
||||
static const char trailingBytesForUTF8[256] = {
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
||||
3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5
|
||||
};
|
||||
|
||||
int u8_seqlen(const char c)
|
||||
{
|
||||
return trailingBytesForUTF8[(unsigned int)(unsigned char)c] + 1;
|
||||
}
|
||||
|
||||
#define UEOF ((u_int32_t)EOF)
|
||||
|
||||
u_int32_t u8_fgetc(FILE *f)
|
||||
{
|
||||
int amt = 0, sz, c;
|
||||
u_int32_t ch = 0;
|
||||
|
||||
c = fgetc(f);
|
||||
if (c == EOF)
|
||||
return UEOF;
|
||||
ch = (u_int32_t)c;
|
||||
amt = sz = u8_seqlen(ch);
|
||||
while (--amt) {
|
||||
ch <<= 6;
|
||||
c = fgetc(f);
|
||||
if (c == EOF)
|
||||
return UEOF;
|
||||
ch += (u_int32_t)c;
|
||||
}
|
||||
ch -= offsetsFromUTF8[sz - 1];
|
||||
|
||||
return ch;
|
||||
}
|
||||
1032
tiny/lisp-nontail.c
1032
tiny/lisp-nontail.c
File diff suppressed because it is too large
Load Diff
1099
tiny/lisp.c
1099
tiny/lisp.c
File diff suppressed because it is too large
Load Diff
1525
tiny/lisp2.c
1525
tiny/lisp2.c
File diff suppressed because it is too large
Load Diff
1109
tiny/lispf.c
1109
tiny/lispf.c
File diff suppressed because it is too large
Load Diff
426
tiny/system.lsp
426
tiny/system.lsp
|
|
@ -1,426 +0,0 @@
|
|||
; femtoLisp standard library
|
||||
; by Jeff Bezanson
|
||||
; Public Domain
|
||||
|
||||
(set 'list (lambda args args))
|
||||
|
||||
(set 'setq (macro (name val)
|
||||
(list set (list quote name) val)))
|
||||
|
||||
(setq sp '| |)
|
||||
(setq nl '|
|
||||
|)
|
||||
|
||||
; convert a sequence of body statements to a single expression.
|
||||
; this allows define, defun, defmacro, let, etc. to contain multiple
|
||||
; body expressions as in Common Lisp.
|
||||
(setq f-body (lambda (e)
|
||||
(cond ((atom e) e)
|
||||
((eq (cdr e) ()) (car e))
|
||||
(t (cons progn e)))))
|
||||
|
||||
(setq defmacro
|
||||
(macro (name args . body)
|
||||
(list 'setq name (list 'macro args (f-body body)))))
|
||||
|
||||
; support both CL defun and Scheme-style define
|
||||
(defmacro defun (name args . body)
|
||||
(list 'setq name (list 'lambda args (f-body body))))
|
||||
|
||||
(defmacro define (name . body)
|
||||
(if (symbolp name)
|
||||
(list 'setq name (car body))
|
||||
(cons 'defun (cons (car name) (cons (cdr name) body)))))
|
||||
|
||||
(defun identity (x) x)
|
||||
(setq null not)
|
||||
(defun consp (x) (not (atom x)))
|
||||
|
||||
(defun map (f lst)
|
||||
(if (atom lst) lst
|
||||
(cons (f (car lst)) (map f (cdr lst)))))
|
||||
|
||||
(defmacro let (binds . body)
|
||||
(cons (list 'lambda (map car binds) (f-body body))
|
||||
(map cadr binds)))
|
||||
|
||||
(defun nconc lsts
|
||||
(cond ((null lsts) ())
|
||||
((null (cdr lsts)) (car lsts))
|
||||
(t ((lambda (l d) (if (null l) d
|
||||
(prog1 l
|
||||
(while (consp (cdr l)) (set 'l (cdr l)))
|
||||
(rplacd l d))))
|
||||
(car lsts) (apply nconc (cdr lsts))))))
|
||||
|
||||
(defun append lsts
|
||||
(cond ((null lsts) ())
|
||||
((null (cdr lsts)) (car lsts))
|
||||
(t ((label append2 (lambda (l d)
|
||||
(if (null l) d
|
||||
(cons (car l)
|
||||
(append2 (cdr l) d)))))
|
||||
(car lsts) (apply append (cdr lsts))))))
|
||||
|
||||
(defun member (item lst)
|
||||
(cond ((atom lst) ())
|
||||
((eq (car lst) item) lst)
|
||||
(t (member item (cdr lst)))))
|
||||
|
||||
(defun macrop (e) (and (consp e) (eq (car e) 'macro) e))
|
||||
(defun macrocallp (e) (and (symbolp (car e))
|
||||
(boundp (car e))
|
||||
(macrop (eval (car e)))))
|
||||
(defun macroapply (m args) (apply (cons 'lambda (cdr m)) args))
|
||||
|
||||
(defun macroexpand-1 (e)
|
||||
(if (atom e) e
|
||||
(let ((f (macrocallp e)))
|
||||
(if f (macroapply f (cdr e))
|
||||
e))))
|
||||
|
||||
; convert to proper list, i.e. remove "dots", and append
|
||||
(defun append.2 (l tail)
|
||||
(cond ((null l) tail)
|
||||
((atom l) (cons l tail))
|
||||
(t (cons (car l) (append.2 (cdr l) tail)))))
|
||||
|
||||
(defun macroexpand (e)
|
||||
((label mexpand
|
||||
(lambda (e env f)
|
||||
(progn
|
||||
(while (and (consp e)
|
||||
(not (member (car e) env))
|
||||
(set 'f (macrocallp e)))
|
||||
(set 'e (macroapply f (cdr e))))
|
||||
(if (and (consp e)
|
||||
(not (or (eq (car e) 'quote)
|
||||
(eq (car e) quote))))
|
||||
(let ((newenv
|
||||
(if (and (or (eq (car e) 'lambda) (eq (car e) 'macro))
|
||||
(consp (cdr e)))
|
||||
(append.2 (cadr e) env)
|
||||
env)))
|
||||
(map (lambda (x) (mexpand x newenv nil)) e))
|
||||
e))))
|
||||
e nil nil))
|
||||
|
||||
; uncomment this to macroexpand functions at definition time.
|
||||
; makes typical code ~25% faster, but only works for defun expressions
|
||||
; at the top level.
|
||||
;(defmacro defun (name args . body)
|
||||
; (list 'setq name (list 'lambda args (macroexpand (f-body body)))))
|
||||
|
||||
; same thing for macros. enabled by default because macros are usually
|
||||
; defined at the top level.
|
||||
(defmacro defmacro (name args . body)
|
||||
(list 'setq name (list 'macro args (macroexpand (f-body body)))))
|
||||
|
||||
(setq = eq)
|
||||
(setq eql eq)
|
||||
(define (/= a b) (not (eq a b)))
|
||||
(define != /=)
|
||||
(define (> a b) (< b a))
|
||||
(define (<= a b) (not (< b a)))
|
||||
(define (>= a b) (not (< a b)))
|
||||
(define (mod x y) (- x (* (/ x y) y)))
|
||||
(define (abs x) (if (< x 0) (- x) x))
|
||||
(define (truncate x) x)
|
||||
(setq K prog1) ; K combinator ;)
|
||||
(define (funcall f . args) (apply f args))
|
||||
(define (symbol-function sym) (eval sym))
|
||||
(define (symbol-value sym) (eval sym))
|
||||
|
||||
(define (caar x) (car (car x)))
|
||||
(define (cadr x) (car (cdr x)))
|
||||
(define (cdar x) (cdr (car x)))
|
||||
(define (cddr x) (cdr (cdr x)))
|
||||
(define (caaar x) (car (car (car x))))
|
||||
(define (caadr x) (car (car (cdr x))))
|
||||
(define (cadar x) (car (cdr (car x))))
|
||||
(define (caddr x) (car (cdr (cdr x))))
|
||||
(define (cdaar x) (cdr (car (car x))))
|
||||
(define (cdadr x) (cdr (car (cdr x))))
|
||||
(define (cddar x) (cdr (cdr (car x))))
|
||||
(define (cdddr x) (cdr (cdr (cdr x))))
|
||||
|
||||
(define (equal a b)
|
||||
(if (and (consp a) (consp b))
|
||||
(and (equal (car a) (car b))
|
||||
(equal (cdr a) (cdr b)))
|
||||
(eq a b)))
|
||||
|
||||
; compare imposes an ordering on all values. yields -1 for a<b,
|
||||
; 0 for a==b, and 1 for a>b. lists are compared up to the first
|
||||
; point of difference.
|
||||
(defun compare (a b)
|
||||
(cond ((eq a b) 0)
|
||||
((or (atom a) (atom b)) (if (< a b) -1 1))
|
||||
(t (let ((c (compare (car a) (car b))))
|
||||
(if (not (eq c 0))
|
||||
c
|
||||
(compare (cdr a) (cdr b)))))))
|
||||
|
||||
(defun every (pred lst)
|
||||
(or (atom lst)
|
||||
(and (pred (car lst))
|
||||
(every pred (cdr lst)))))
|
||||
|
||||
(defun any (pred lst)
|
||||
(and (consp lst)
|
||||
(or (pred (car lst))
|
||||
(any pred (cdr lst)))))
|
||||
|
||||
(defun listp (a) (or (eq a ()) (consp a)))
|
||||
|
||||
(defun length (l)
|
||||
(if (null l) 0
|
||||
(+ 1 (length (cdr l)))))
|
||||
|
||||
(defun nthcdr (n lst)
|
||||
(if (<= n 0) lst
|
||||
(nthcdr (- n 1) (cdr lst))))
|
||||
|
||||
(defun list-ref (lst n)
|
||||
(car (nthcdr n lst)))
|
||||
|
||||
(defun list* l
|
||||
(if (atom (cdr l))
|
||||
(car l)
|
||||
(cons (car l) (apply list* (cdr l)))))
|
||||
|
||||
(defun nlist* l
|
||||
(if (atom (cdr l))
|
||||
(car l)
|
||||
(rplacd l (apply nlist* (cdr l)))))
|
||||
|
||||
(defun lastcdr (l)
|
||||
(if (atom l) l
|
||||
(lastcdr (cdr l))))
|
||||
|
||||
(defun last (l)
|
||||
(cond ((atom l) l)
|
||||
((atom (cdr l)) l)
|
||||
(t (last (cdr l)))))
|
||||
|
||||
(defun map! (f lst)
|
||||
(prog1 lst
|
||||
(while (consp lst)
|
||||
(rplaca lst (f (car lst)))
|
||||
(set 'lst (cdr lst)))))
|
||||
|
||||
(defun mapcar (f . lsts)
|
||||
((label mapcar-
|
||||
(lambda (lsts)
|
||||
(cond ((null lsts) (f))
|
||||
((atom (car lsts)) (car lsts))
|
||||
(t (cons (apply f (map car lsts))
|
||||
(mapcar- (map cdr lsts)))))))
|
||||
lsts))
|
||||
|
||||
(defun transpose (M) (apply mapcar (cons list M)))
|
||||
|
||||
(defun filter (pred lst)
|
||||
(cond ((null lst) ())
|
||||
((not (pred (car lst))) (filter pred (cdr lst)))
|
||||
(t (cons (car lst) (filter pred (cdr lst))))))
|
||||
|
||||
(define (foldr f zero lst)
|
||||
(if (null lst) zero
|
||||
(f (car lst) (foldr f zero (cdr lst)))))
|
||||
|
||||
(define (foldl f zero lst)
|
||||
(if (null lst) zero
|
||||
(foldl f (f (car lst) zero) (cdr lst))))
|
||||
|
||||
(define (reverse lst) (foldl cons nil lst))
|
||||
|
||||
(define (reduce0 f zero lst)
|
||||
(if (null lst) zero
|
||||
(reduce0 f (f zero (car lst)) (cdr lst))))
|
||||
|
||||
(defun reduce (f lst)
|
||||
(reduce0 f (car lst) (cdr lst)))
|
||||
|
||||
(define (copy-list l) (map identity l))
|
||||
(define (copy-tree l)
|
||||
(if (atom l) l
|
||||
(cons (copy-tree (car l))
|
||||
(copy-tree (cdr l)))))
|
||||
|
||||
(define (assoc item lst)
|
||||
(cond ((atom lst) ())
|
||||
((eq (caar lst) item) (car lst))
|
||||
(t (assoc item (cdr lst)))))
|
||||
|
||||
(define (nreverse l)
|
||||
(let ((prev nil))
|
||||
(while (consp l)
|
||||
(set 'l (prog1 (cdr l)
|
||||
(rplacd l (prog1 prev
|
||||
(set 'prev l))))))
|
||||
prev))
|
||||
|
||||
(defmacro let* (binds . body)
|
||||
(cons (list 'lambda (map car binds)
|
||||
(cons progn
|
||||
(nconc (map (lambda (b) (cons 'setq b)) binds)
|
||||
body)))
|
||||
(map (lambda (x) nil) binds)))
|
||||
|
||||
(defmacro labels (binds . body)
|
||||
(cons (list 'lambda (map car binds)
|
||||
(cons progn
|
||||
(nconc (map (lambda (b)
|
||||
(list 'setq (car b) (cons 'lambda (cdr b))))
|
||||
binds)
|
||||
body)))
|
||||
(map (lambda (x) nil) binds)))
|
||||
|
||||
(defmacro when (c . body) (list if c (f-body body) nil))
|
||||
(defmacro unless (c . body) (list if c nil (f-body body)))
|
||||
|
||||
(defmacro dotimes (var . body)
|
||||
(let ((v (car var))
|
||||
(cnt (cadr var)))
|
||||
(list 'let (list (list v 0))
|
||||
(list while (list < v cnt)
|
||||
(list prog1 (f-body body) (list 'setq v (list + v 1)))))))
|
||||
|
||||
(defun map-int (f n)
|
||||
(let ((acc nil))
|
||||
(dotimes (i n)
|
||||
(setq acc (cons (f i) acc)))
|
||||
(nreverse acc)))
|
||||
|
||||
; property lists
|
||||
(setq *plists* nil)
|
||||
|
||||
(defun symbol-plist (sym)
|
||||
(cdr (or (assoc sym *plists*) '(()))))
|
||||
|
||||
(defun set-symbol-plist (sym lst)
|
||||
(let ((p (assoc sym *plists*)))
|
||||
(if (null p) ; sym has no plist yet
|
||||
(setq *plists* (cons (cons sym lst) *plists*))
|
||||
(rplacd p lst))))
|
||||
|
||||
(defun get (sym prop)
|
||||
(let ((pl (symbol-plist sym)))
|
||||
(if pl
|
||||
(let ((pr (member prop pl)))
|
||||
(if pr (cadr pr) nil))
|
||||
nil)))
|
||||
|
||||
(defun put (sym prop val)
|
||||
(let ((p (assoc sym *plists*)))
|
||||
(if (null p) ; sym has no plist yet
|
||||
(setq *plists* (cons (list sym prop val) *plists*))
|
||||
(let ((pr (member prop p)))
|
||||
(if (null pr) ; sym doesn't have this property yet
|
||||
(rplacd p (cons prop (cons val (cdr p))))
|
||||
(rplaca (cdr pr) val)))))
|
||||
val)
|
||||
|
||||
; setf
|
||||
; expands (setf (place x ...) v) to (mutator (f x ...) v)
|
||||
; (mutator (identity x ...) v) is interpreted as (mutator x ... v)
|
||||
(setq *setf-place-list*
|
||||
; place mutator f
|
||||
'((car rplaca identity)
|
||||
(cdr rplacd identity)
|
||||
(caar rplaca car)
|
||||
(cadr rplaca cdr)
|
||||
(cdar rplacd car)
|
||||
(cddr rplacd cdr)
|
||||
(caaar rplaca caar)
|
||||
(caadr rplaca cadr)
|
||||
(cadar rplaca cdar)
|
||||
(caddr rplaca cddr)
|
||||
(cdaar rplacd caar)
|
||||
(cdadr rplacd cadr)
|
||||
(cddar rplacd cdar)
|
||||
(cdddr rplacd cddr)
|
||||
(get put identity)
|
||||
(aref aset identity)
|
||||
(symbol-function set identity)
|
||||
(symbol-value set identity)
|
||||
(symbol-plist set-symbol-plist identity)))
|
||||
|
||||
(defun setf-place-mutator (place val)
|
||||
(if (symbolp place)
|
||||
(list 'setq place val)
|
||||
(let ((mutator (assoc (car place) *setf-place-list*)))
|
||||
(if (null mutator)
|
||||
(error '|setf: error: unknown place | (car place))
|
||||
(if (eq (caddr mutator) 'identity)
|
||||
(cons (cadr mutator) (append (cdr place) (list val)))
|
||||
(list (cadr mutator)
|
||||
(cons (caddr mutator) (cdr place))
|
||||
val))))))
|
||||
|
||||
(defmacro setf args
|
||||
(f-body
|
||||
((label setf-
|
||||
(lambda (args)
|
||||
(if (null args)
|
||||
nil
|
||||
(cons (setf-place-mutator (car args) (cadr args))
|
||||
(setf- (cddr args))))))
|
||||
args)))
|
||||
|
||||
(defun revappend (l1 l2) (nconc (reverse l1) l2))
|
||||
(defun nreconc (l1 l2) (nconc (nreverse l1) l2))
|
||||
|
||||
(defun builtinp (x)
|
||||
(and (atom x)
|
||||
(not (symbolp x))
|
||||
(not (numberp x))))
|
||||
|
||||
(defun self-evaluating-p (x)
|
||||
(or (eq x nil)
|
||||
(eq x t)
|
||||
(and (atom x)
|
||||
(not (symbolp x)))))
|
||||
|
||||
; backquote
|
||||
(defmacro backquote (x) (bq-process x))
|
||||
|
||||
(defun splice-form-p (x)
|
||||
(or (and (consp x) (or (eq (car x) '*comma-at*)
|
||||
(eq (car x) '*comma-dot*)))
|
||||
(eq x '*comma*)))
|
||||
|
||||
(defun bq-process (x)
|
||||
(cond ((self-evaluating-p x) x)
|
||||
((atom x) (list quote x))
|
||||
((eq (car x) 'backquote) (bq-process (bq-process (cadr x))))
|
||||
((eq (car x) '*comma*) (cadr x))
|
||||
((not (any splice-form-p x))
|
||||
(let ((lc (lastcdr x))
|
||||
(forms (map bq-bracket1 x)))
|
||||
(if (null lc)
|
||||
(cons 'list forms)
|
||||
(nconc (cons 'nlist* forms) (list (bq-process lc))))))
|
||||
(t (let ((p x) (q '()))
|
||||
(while (and (consp p)
|
||||
(not (eq (car p) '*comma*)))
|
||||
(setq q (cons (bq-bracket (car p)) q))
|
||||
(setq p (cdr p)))
|
||||
(cons 'nconc
|
||||
(cond ((consp p) (nreconc q (list (cadr p))))
|
||||
((null p) (nreverse q))
|
||||
(t (nreconc q (list (bq-process p))))))))))
|
||||
|
||||
(defun bq-bracket (x)
|
||||
(cond ((atom x) (list cons (bq-process x) nil))
|
||||
((eq (car x) '*comma*) (list cons (cadr x) nil))
|
||||
((eq (car x) '*comma-at*) (list 'copy-list (cadr x)))
|
||||
((eq (car x) '*comma-dot*) (cadr x))
|
||||
(t (list cons (bq-process x) nil))))
|
||||
|
||||
; bracket without splicing
|
||||
(defun bq-bracket1 (x)
|
||||
(if (and (consp x) (eq (car x) '*comma*))
|
||||
(cadr x)
|
||||
(bq-process x)))
|
||||
41
todo-scrap
41
todo-scrap
|
|
@ -1,41 +0,0 @@
|
|||
- readable gensyms. have uninterned symbols, but have all same-named
|
||||
gensyms read to the same (eq) symbol within an expression.
|
||||
- fat pointers, i.e. 64 bits on 32-bit platforms. we could have full 32-bit
|
||||
integers too. the mind boggles at the possibilities.
|
||||
(it would be great if everybody decided that pointer types should forever
|
||||
be wider than address spaces, with some bits reserved for application use)
|
||||
- any way at all to provide O(1) computed lookups (i.e. indexing).
|
||||
CL uses vectors for this. once you have it, it's sufficient to get
|
||||
efficient hash tables and everything else.
|
||||
- could be done just by generalizing cons cells to have more than
|
||||
car, cdr: c2r, c3r, etc. maybe (1 . 2 . 3 . 4 . ...)
|
||||
all you need is a tag+size on the front of the object so the collector
|
||||
knows how to deal with it.
|
||||
(car x) == (ref x 0), etc.
|
||||
(rplaca x v) == (rplac x 0 v), etc.
|
||||
(size (cons 1 2)) == 2, etc.
|
||||
- one possibility: if we see a cons whose CAR is tagptr(0x10,TAG_SYM),
|
||||
then the CDR is the size and the following words are the elements.
|
||||
. this approach is especially good if vectors are separate types from
|
||||
conses
|
||||
- another: add u_int32_t size to cons_t, making them all 50% bigger.
|
||||
access is simpler and more uniform, without fully doubling the size like
|
||||
we'd get with fat pointers.
|
||||
|
||||
Notice that the size is one byte more than the number of characters in
|
||||
the string. This is because femtoLisp adds a NUL terminator to make its
|
||||
strings compatible with C. No effort is made to hide this fact.
|
||||
But since femtoLisp tracks the sizes of cvalues, it doesn't need the
|
||||
terminator itself. Therefore it treats zero bytes specially as rarely
|
||||
as possible. In particular, zeros are only special in values whose type
|
||||
is exactly <tt>(array char)</tt>, and are only interpreted in the
|
||||
following cases:
|
||||
<ul>
|
||||
<li>When printing strings, a final NUL is never printed. NULs in the
|
||||
middle of a string are printed though.
|
||||
<li>String constructors NUL-terminate their output.
|
||||
<li>Explicit string functions (like <tt>strlen</tt>) treat NULs the same
|
||||
way equivalent C functions would.
|
||||
</ul>
|
||||
Arrays of uchar, int8, etc. are treated as raw data and zero bytes are
|
||||
never special.
|
||||
Loading…
Reference in New Issue