2023-05-09 16:25:56 +00:00
package main
import (
2023-05-09 21:07:19 +00:00
"fmt"
"os"
"path/filepath"
2023-05-09 16:25:56 +00:00
"reflect"
2023-05-09 21:07:19 +00:00
"regexp"
"sort"
2023-05-09 16:25:56 +00:00
"strings"
2023-05-09 21:07:19 +00:00
"git.rawtext.club/sloum/slope/termios"
ln "github.com/peterh/liner"
2023-05-09 16:25:56 +00:00
)
func specialAnd ( e [ ] expression , en * env ) expression {
if len ( e ) < 2 {
return exception ( "Invalid 'and' syntax - too few arguments" )
}
var value expression
OuterAnd :
for i := range e [ 1 : ] {
switch item := e [ i + 1 ] . ( type ) {
case [ ] expression :
value = eval ( item , en )
if ! AnythingToBool ( value ) . ( bool ) {
break OuterAnd
}
default :
value = eval ( item , en )
if ! AnythingToBool ( value ) . ( bool ) {
break OuterAnd
}
}
}
return value
}
2023-05-09 21:07:19 +00:00
func specialApply ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "'apply' expects two arguments: a procedure and an argument list, too few arguments were given" )
}
args := eval ( e [ 2 ] , en )
// TODO make this work so that we dont have to eval things here
switch item := args . ( type ) {
case [ ] expression :
return apply ( eval ( e [ 1 ] , en ) , item , true )
default :
return apply ( eval ( e [ 1 ] , en ) , [ ] expression { item } , true )
}
}
2023-05-09 16:25:56 +00:00
func specialBegin0 ( e [ ] expression , en * env ) expression {
var v expression
for ii , i := range e [ 1 : ] {
if ii == 0 {
v = eval ( i , en )
} else {
eval ( i , en )
}
}
return v
}
func specialBegin ( e [ ] expression , en * env ) expression {
var v expression
for _ , i := range e [ 1 : ] {
v = eval ( i , en )
}
return v
}
func specialCase ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "Invalid 'case' syntax - too few arguments" )
}
target := eval ( e [ 1 ] , en )
var value expression
CaseLoop :
for _ , exp := range e [ 2 : ] {
switch i := exp . ( type ) {
case [ ] expression :
if len ( i ) < 2 {
return exception ( "Invalid 'case' case, cases must take the form: `(<test> <expression>)" )
}
if i [ 0 ] == "else" || i [ 0 ] == symbol ( "else" ) {
value = eval ( i [ 1 ] , en )
break CaseLoop
}
if reflect . DeepEqual ( eval ( i [ 0 ] , en ) , target ) {
value = eval ( i [ 1 ] , en )
break CaseLoop
}
default :
return exception ( "Invalid 'case' case, cases must take the form: `(<test> <expression>)" )
}
}
// TODO this may not work
if value == nil {
value = make ( [ ] expression , 0 )
}
return value
}
func specialCond ( e [ ] expression , en * env ) expression {
if len ( e ) < 2 {
return exception ( "Invalid 'cond' syntax - too few arguments" )
}
var value expression
CondLoop :
for _ , exp := range e [ 1 : ] {
switch i := exp . ( type ) {
case [ ] expression :
if len ( i ) < 2 {
return exception ( "Invalid 'cond' case, cases must take the form: `(<test> <expression>)" )
}
if i [ 0 ] == "else" || i [ 0 ] == symbol ( "else" ) {
value = eval ( i [ 1 ] , en )
break CondLoop
}
if AnythingToBool ( eval ( i [ 0 ] , en ) ) . ( bool ) {
value = eval ( i [ 1 ] , en )
break CondLoop
}
default :
return exception ( "Invalid 'cond' case, cases must take the form: `(<test> <expression>)" )
}
}
if value == nil {
value = make ( [ ] expression , 0 )
}
return value
}
func specialDefine ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "Invalid 'define' syntax - too few arguments" )
}
sym , ok := e [ 1 ] . ( symbol )
if ! ok {
e [ 1 ] = eval ( e [ 1 ] , en )
sym , ok = e [ 1 ] . ( symbol )
if ! ok {
return exception ( "'define' expects a symbol as its first argument" )
}
}
if strings . Contains ( string ( sym ) , "::" ) {
return exception ( "'define' cannot create a symbol reference within a module, designated by '::' within a symbol name" )
}
val := eval ( e [ 2 ] , en )
en . vars [ sym ] = val
return val
}
2023-05-09 21:07:19 +00:00
func specialEval ( e [ ] expression , en * env ) expression {
if len ( e ) < 1 {
return exception ( "'eval' expects a string and an optional boolean to indicate that a string should be parsed and evaluated, but was not given any arguments" )
}
sParse := false
if len ( e ) >= 3 {
v , ok := e [ 2 ] . ( bool )
if ok {
sParse = v
}
}
switch item := eval ( e [ 1 ] , en ) . ( type ) {
case [ ] expression :
if _ , ok := item [ 0 ] . ( symbol ) ; ! ok {
return item
} else {
value := eval ( item , en )
v , ok := value . ( string )
if ok && sParse {
p := Parse ( v )
return eval ( p . ( [ ] expression ) [ 0 ] , en )
}
return value
}
case string :
if sParse {
p := Parse ( item )
if l , ok := p . ( [ ] expression ) [ 0 ] . ( [ ] expression ) ; ok {
if _ , ok := l [ 0 ] . ( symbol ) ; ok {
return eval ( p . ( [ ] expression ) [ 0 ] , en )
} else {
return l
}
} else {
return eval ( p . ( [ ] expression ) [ 0 ] , en )
}
} else {
return item
}
default :
return item
}
}
func specialExists ( e [ ] expression , en * env ) expression {
if len ( e ) == 0 {
return exception ( "'exists?' expects at least one symbol or string, no values were given" )
}
var err error
for i := range e [ 1 : ] {
doPanic := panicOnException
if doPanic {
panicOnException = false
}
// TODO make this work with interpreter forms
_ , ok := e [ i ] . ( [ ] expression )
if ok {
_ , err = en . Find ( symbol ( String ( eval ( e [ i + 1 ] , en ) , false ) ) )
} else {
environ := en
symbolAsString := String ( e [ i + 1 ] , false )
if i := strings . Index ( symbolAsString , "::" ) ; i >= 0 {
modname := symbolAsString [ : i ]
alias , ok := altnamespaces [ modname ]
if ! ok {
e , ok2 := namespaces [ modname ]
if ! ok2 {
if doPanic {
panicOnException = true
}
return false
}
environ = & e
} else {
e := namespaces [ alias ]
environ = & e
}
symbolAsString = symbolAsString [ i + 2 : ]
}
_ , err = environ . Find ( symbol ( symbolAsString ) )
}
if doPanic {
panicOnException = true
}
if err != nil {
return false
}
}
return true
}
2023-05-09 16:25:56 +00:00
func specialFor ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "'for' requires at least two arguments: a list of initializers and a test" )
}
// Set up args/iterators
args , ok := e [ 1 ] . ( [ ] expression )
if ! ok {
return exception ( "'for' expected a list of arguments and values as its first argument, a non-list value was received" )
}
newEnv := & env { make ( map [ symbol ] expression ) , en }
updates := [ ] expression { symbol ( "begin" ) }
for _ , v := range args {
arg , ok := v . ( [ ] expression )
if varname , varok := arg [ 0 ] . ( symbol ) ; varok && ok && len ( arg ) >= 2 {
newEnv . vars [ varname ] = eval ( arg [ 1 ] , en )
} else {
return exception ( "'for' expected its first argument to be a list of lists, each with a symbol, a value, and an optional update expression. A list was given, but it contained a non-list value" )
}
if len ( arg ) >= 3 {
updates = append ( updates , [ ] expression { symbol ( "set!" ) , arg [ 0 ] , arg [ 2 ] } )
}
}
// Get test and return expression
testReturn , ok := e [ 2 ] . ( [ ] expression )
if ! ok || len ( testReturn ) == 0 {
return exception ( "'for' expected a list containing a logic test and an optional return value expression for its second argument, a non-list was given" )
}
test := testReturn [ 0 ]
var returnExpression expression = [ ] expression { symbol ( "list" ) }
if len ( testReturn ) > 1 {
returnExpression = testReturn [ 1 ]
}
body := [ ] expression { symbol ( "begin" ) }
body = append ( body , e [ 3 : ] ... )
for {
// Check the condition by evaluating the test
if ! AnythingToBool ( eval ( test , newEnv ) ) . ( bool ) {
break
}
// Run the body code
eval ( body , newEnv )
// Run the iteration updates
eval ( updates , newEnv )
}
return eval ( returnExpression , newEnv )
}
func specialIf ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "Invalid 'if' syntax - too few arguments" )
}
if AnythingToBool ( eval ( e [ 1 ] , en ) ) . ( bool ) {
return eval ( e [ 2 ] , en )
}
if len ( e ) > 3 {
return eval ( e [ 3 ] , en )
}
return make ( [ ] expression , 0 )
}
2023-05-09 21:07:19 +00:00
func specialInspect ( e [ ] expression , en * env ) expression {
// Make sure we are attached to a tty
if fileInfo , _ := os . Stdout . Stat ( ) ; ( fileInfo . Mode ( ) & os . ModeCharDevice ) == 0 {
return false
}
if fileInfo , _ := os . Stdin . Stat ( ) ; ( fileInfo . Mode ( ) & os . ModeCharDevice ) == 0 {
return false
}
initialState , _ := ln . TerminalMode ( )
liner := ln . NewLiner ( )
linerState , _ := ln . TerminalMode ( )
defer liner . Close ( )
histFile := ExpandedAbsFilepath ( filepath . Join ( getModBaseDir ( ) , ".." , historyFilename ) )
if f , e := os . Open ( histFile ) ; e == nil {
liner . ReadHistory ( f )
f . Close ( )
}
// Set up completion
liner . SetTabCompletionStyle ( ln . TabCircular )
liner . SetCompleter ( func ( l string ) ( c [ ] string ) {
if len ( l ) == 0 {
return
}
lastIndex := strings . LastIndexAny ( l , "( \n" )
c = append ( c , completeFromMap ( usageStrings , l , lastIndex ) ... )
c = append ( c , completeFromMap ( getAllModFuncNames ( ) , l , lastIndex ) ... )
sort . Strings ( c )
return
} )
inspectID := "inspect"
if len ( e ) > 1 {
inspectID = String ( eval ( e [ 1 ] , en ) , false )
}
var text strings . Builder
var cont bool
var raw bool
var match bool
for {
globalenv . vars [ symbol ( "slope-interactive?" ) ] = true
if linerState != nil {
linerState . ApplyMode ( )
}
in := prompt ( liner , cont , inspectID )
if initialState != nil {
initialState . ApplyMode ( )
}
if in == "uninspect" || in == "(uninspect)" {
break
}
if len ( strings . TrimSpace ( in ) ) == 0 && ! raw {
continue
}
text . WriteString ( in )
text . WriteRune ( '\n' )
var brokenString bool
match , raw , brokenString = stringParensMatch ( text . String ( ) )
if ! match && ! brokenString {
cont = true
} else {
cont = false
outputResult ( text . String ( ) , en )
text . Reset ( )
}
}
return true
}
2023-05-09 16:25:56 +00:00
func specialLambda ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "'lambda' expects at least three arguments" )
}
b := [ ] expression { symbol ( "begin" ) }
b = append ( b , e [ 2 : ] ... )
predicates := make ( map [ symbol ] symbol )
switch a := e [ 1 ] . ( type ) {
case [ ] expression :
for i , v := range a {
s := String ( v , false )
ind := strings . LastIndex ( s , "@" )
if ind < 1 {
continue
}
a [ i ] = symbol ( s [ : ind ] )
predicates [ a [ i ] . ( symbol ) ] = symbol ( s [ ind + 1 : ] )
}
e [ 1 ] = a
default :
s := String ( e [ 1 ] , false )
ind := strings . LastIndex ( s , "@" )
if ind < 1 {
e [ 1 ] = [ ] expression { e [ 1 ] }
break
}
e [ 1 ] = symbol ( s [ : ind ] )
predicates [ e [ 1 ] . ( symbol ) ] = symbol ( s [ ind + 1 : ] )
e [ 1 ] = [ ] expression { e [ 1 ] }
}
return proc { e [ 1 ] , stringUnescapeEval ( b ) , en , predicates }
}
2023-05-09 21:07:19 +00:00
func specialLoad ( e [ ] expression , en * env ) expression {
if en . outer != nil {
return exception ( "'load' is only callable from the global/top-level" )
}
files := make ( [ ] expression , 0 , len ( e ) - 1 )
for _ , fp := range e [ 1 : ] {
var p string
if _ , ok := fp . ( [ ] expression ) ; ok {
p = String ( eval ( fp , en ) , false )
} else {
p = String ( fp , false )
}
files = append ( files , p )
}
loadFiles ( files )
return true
}
func specialLoadMod ( e [ ] expression , en * env ) expression {
if len ( e ) < 2 {
return exception ( "'load-mod' expected a module name, no value was given" )
}
fullLoadEnv := env { make ( map [ symbol ] expression ) , & globalenv }
modName := e [ 1 ]
var p string
if _ , ok := modName . ( [ ] expression ) ; ok {
p = String ( eval ( modName , en ) , false )
} else {
p = String ( modName , false )
}
modEnv , err := RunModule ( p , false )
if err != nil {
return exception ( fmt . Sprintf ( "'load-mod' failed loading module %s: %s" , p , err . Error ( ) ) )
}
for k , v := range modEnv . vars {
fullLoadEnv . vars [ k ] = v
}
altName := ""
if len ( e ) > 2 {
if _ , ok := modName . ( [ ] expression ) ; ok {
altName = String ( eval ( e [ 2 ] , en ) , false )
} else {
altName = String ( e [ 2 ] , false )
}
}
namespaces [ p ] = fullLoadEnv
if altName != "" {
altnamespaces [ altName ] = p
}
return true
}
func specialLoadModFile ( e [ ] expression , en * env ) expression {
fullLoadEnv := env { make ( map [ symbol ] expression ) , & globalenv }
for _ , fp := range e [ 1 : ] {
var p string
if _ , ok := fp . ( [ ] expression ) ; ok {
p = String ( eval ( fp , en ) , false )
} else {
p = String ( fp , false )
}
modEnv , err := RunModule ( p , true )
if err != nil {
return exception ( fmt . Sprintf ( "'load-mod-file' failed loading module %s: %s" , p , err . Error ( ) ) )
}
for k , v := range modEnv . vars {
fullLoadEnv . vars [ k ] = v
}
}
for k , v := range fullLoadEnv . vars {
globalenv . vars [ k ] = v
}
return true
}
2023-05-09 16:25:56 +00:00
func specialMacro ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "'macro' expects at least three arguments" )
}
b := [ ] expression { symbol ( "begin" ) }
b = append ( b , e [ 2 : ] ... )
return macro { e [ 1 ] , b , en }
}
func specialOr ( e [ ] expression , en * env ) expression {
if len ( e ) < 2 {
return exception ( "Invalid 'or' syntax - too few arguments" )
}
var value expression
OuterOr :
for i := range e [ 1 : ] {
switch item := e [ i + 1 ] . ( type ) {
case [ ] expression :
value = eval ( item , en )
if AnythingToBool ( value ) . ( bool ) {
break OuterOr
}
default :
value = eval ( item , en )
if AnythingToBool ( value ) . ( bool ) {
break OuterOr
}
}
}
return value
}
func specialQuote ( e [ ] expression ) expression {
if len ( e ) < 2 {
return exception ( "Invalid 'quote' syntax - too few arguments" )
}
return stringUnescapeEval ( e [ 1 ] )
}
func specialSet ( e [ ] expression , en * env ) expression {
if len ( e ) < 3 {
return exception ( "Invalid 'set!' syntax - too few arguments" )
}
v , ok := e [ 1 ] . ( symbol )
if ! ok {
e [ 1 ] = eval ( e [ 1 ] , en )
v , ok = e [ 1 ] . ( symbol )
if ! ok {
return exception ( "'set!' expected a symbol as its first argument, a non-symbol was provided" )
}
}
if strings . Contains ( string ( v ) , "::" ) {
return exception ( "'set!' cannot modify a symbol reference within a module, designated by '::' within a symbol name" )
}
val := eval ( e [ 2 ] , en )
ex , err := en . Find ( v )
if err != nil {
return exception ( err . Error ( ) )
}
ex . vars [ v ] = val
return val
}
2023-05-09 21:07:19 +00:00
func specialUsage ( e [ ] expression ) expression {
var procSigRE = regexp . MustCompile ( ` (?s)(\()([^() ]+\b)([^)]*)(\))(?:(\s*=>)([^\n]*))?(.*) ` )
var replacer = "\033[40;33;1m$1\033[95m$2\033[92m$3\033[33m$4\033[94m$5\033[36m$6\033[0m$7"
if len ( e ) < 2 {
// XXX - Branch for viewing list of all std procs
var out strings . Builder
header := "(usage [[procedure: symbol]])\n\n\033[1;4mKnown Symbols\033[0m\n\n"
out . WriteString ( procSigRE . ReplaceAllString ( header , replacer ) )
keys := make ( [ ] string , 0 , len ( usageStrings ) )
for key , _ := range usageStrings {
keys = append ( keys , key )
}
var width int = 60
if globalenv . vars [ symbol ( "slope-interactive?" ) ] != false {
width , _ = termios . GetWindowSize ( )
}
printedWidth := 0
sort . Strings ( keys )
for i := range keys {
if printedWidth + 26 >= width {
out . WriteRune ( '\n' )
printedWidth = 0
}
out . WriteString ( fmt . Sprintf ( "%-26s" , keys [ i ] ) )
printedWidth += 26
}
if len ( namespaces ) > 0 {
out . WriteString ( "\n\n\033[1;4mKnown Modules\033[0m\n\n" )
taken := make ( map [ string ] bool )
for k , v := range altnamespaces {
out . WriteString ( fmt . Sprintf ( "%-12s -> %s\n" , v , k ) )
taken [ v ] = true
}
for k := range namespaces {
if _ , ok := taken [ string ( k ) ] ; ! ok {
out . WriteString ( string ( k ) )
out . WriteRune ( '\n' )
}
}
}
SysoutPrint ( out . String ( ) , Sysout )
return make ( [ ] expression , 0 )
} else if len ( e ) == 2 {
proc , ok := e [ 1 ] . ( string )
if ! ok {
p , ok2 := e [ 1 ] . ( symbol )
if ! ok2 {
return exception ( "'usage' expected a string or symbol as its first argument, a non-string non-symbol value was given" )
}
proc = string ( p )
}
if strings . HasSuffix ( proc , "::" ) {
// XXX - Print list of module procedures
ns := proc [ : len ( proc ) - 2 ]
module := ns
altName , ok := altnamespaces [ ns ]
if ok {
module = altName
}
useMap , err := GetUsageMap ( module )
if err != nil {
return exception ( "'usage' encountered an error: " + err . Error ( ) )
}
SysoutPrint ( fmt . Sprintf ( "\033[1;4m%s's Known Symbols\033[0m\n\n" , ns ) , Sysout )
for k := range useMap {
SysoutPrint ( fmt . Sprintf ( "%v\n" , k ) , Sysout )
}
} else if strings . Contains ( proc , "::" ) {
// XXX - Show info for a module symbol
pair := strings . SplitN ( proc , "::" , 2 )
if len ( pair ) != 2 {
return exception ( "'usage' was given an invalid module/symbol format" )
}
ns := pair [ 0 ]
module := ns
altName , ok := altnamespaces [ ns ]
if ok {
module = altName
}
useMap , err := GetUsageMap ( module )
if err != nil {
return exception ( "'usage' encountered an error: " + err . Error ( ) )
}
subFunc , ok := useMap [ pair [ 1 ] ]
if ! ok {
return exception ( "'usage' could not find the requested symbol within the " + ns + "module's usage data" )
}
SysoutPrint ( fmt . Sprintf ( "%v\n" , procSigRE . ReplaceAllString ( subFunc , replacer ) ) , Sysout )
} else {
// XXX - Show info for a builtin
v , ok := usageStrings [ proc ]
if ! ok {
SysoutPrint ( fmt . Sprintf ( "%q does not have a usage definition\n" , proc ) , Sysout )
} else {
SysoutPrint ( fmt . Sprintf ( "%v\n\n" , procSigRE . ReplaceAllString ( v , replacer ) ) , Sysout )
}
}
}
return make ( [ ] expression , 0 )
}